Advertisement
omegastripes

simple_host_file_upload.vbs

Jan 7th, 2016
339
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
  1. strFilePath = "C:\Users\DELL\Desktop\gt.png"
  2. UploadFile strFilePath, strUplStatus, strUplResponse
  3. MsgBox strUplStatus & vbCrLf & strUplResponse
  4.  
  5. Sub UploadFile(strPath, strStatus, strResponse)
  6.    
  7.     Dim strFile, strExt, strContentType, strBoundary, bytData, bytPayLoad
  8.    
  9.     On Error Resume Next
  10.     With CreateObject("Scripting.FileSystemObject")
  11.         If .FileExists(strPath) Then
  12.             strFile = .GetFileName(strPath)
  13.             strExt = .GetExtensionName(strPath)
  14.         Else
  15.             strStatus = "File not found"
  16.             Exit Sub
  17.         End IF
  18.     End With
  19.     With CreateObject("Scripting.Dictionary")
  20.         .Add "txt", "text/plain"
  21.         .Add "html", "text/html"
  22.         .Add "php", "application/x-php"
  23.         .Add "js", "application/x-javascript"
  24.         .Add "vbs", "application/x-vbs"
  25.         .Add "bat", "application/x-bat"
  26.         .Add "jpeg", "image/jpeg"
  27.         .Add "jpg", "image/jpeg"
  28.         .Add "png", "image/png"
  29.         .Add "exe", "application/exe"
  30.         .Add "doc", "application/msword"
  31.         .Add "docx", "application/vnd.openxmlformats-officedocument.wordprocessingml.document"
  32.         .Add "xls", "application/vnd.ms-excel"
  33.         .Add "xlsx", "application/vnd.openxmlformats-officedocument.spreadsheetml.sheet"
  34.         strContentType = .Item(LCase(strExt))
  35.     End With
  36.     If strContentType = "" Then
  37.         strStatus = "Invalid file type"
  38.         Exit Sub
  39.     End If
  40.     With CreateObject("ADODB.Stream")
  41.         .Type = 1
  42.         .Mode = 3
  43.         .Open
  44.         .LoadFromFile strPath
  45.         If Err.Number <> 0 Then
  46.             strStatus = Err.Description & " (" & Err.Number & ")"
  47.             Exit Sub
  48.         End If
  49.         bytData = .Read
  50.     End With
  51.     strBoundary = String(6, "-") & Replace(Mid(CreateObject("Scriptlet.TypeLib").Guid, 2, 36), "-", "")
  52.     With CreateObject("ADODB.Stream")
  53.         .Mode = 3
  54.         .Charset = "Windows-1251"
  55.         .Open
  56.         .Type = 2
  57.         .WriteText "--" & strBoundary & vbCrLf
  58.         .WriteText "Content-Disposition: form-data; name=""upload_file""; filename=""" & strFile & """" & vbCrLf
  59.         .WriteText "Content-Type: """ & strContentType & """" & vbCrLf & vbCrLf
  60.         .Position = 0
  61.         .Type = 1
  62.         .Position = .Size
  63.         .Write bytData
  64.         .Position = 0
  65.         .Type = 2
  66.         .Position = .Size
  67.         .WriteText vbCrLf & "--" & strBoundary & "--"
  68.         .Position = 0
  69.         .Type = 1
  70.         bytPayLoad = .Read
  71.     End With
  72.     With CreateObject("MSXML2.ServerXMLHTTP")
  73.         .SetTimeouts 0, 60000, 300000, 300000
  74.         .Open "POST", "http://tessstt.esy.es/upload.php", False
  75.         .SetRequestHeader "Content-type", "multipart/form-data; boundary=" & strBoundary
  76.         .Send bytPayLoad
  77.         If Err.Number <> 0 Then
  78.             strStatus = Err.Description & " (" & Err.Number & ")"
  79.         Else
  80.             strStatus = .StatusText & " (" & .Status & ")"
  81.         End If
  82.         If .Status = "200" Then strResponse = .ResponseText
  83.     End With
  84.    
  85. End Sub
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement