Advertisement
Not a member of Pastebin yet?
Sign Up,
it unlocks many cool features!
- strFilePath = "C:\Users\DELL\Desktop\gt.png"
- UploadFile strFilePath, strUplStatus, strUplResponse
- MsgBox strUplStatus & vbCrLf & strUplResponse
- Sub UploadFile(strPath, strStatus, strResponse)
- Dim strFile, strExt, strContentType, strBoundary, bytData, bytPayLoad
- On Error Resume Next
- With CreateObject("Scripting.FileSystemObject")
- If .FileExists(strPath) Then
- strFile = .GetFileName(strPath)
- strExt = .GetExtensionName(strPath)
- Else
- strStatus = "File not found"
- Exit Sub
- End IF
- End With
- With CreateObject("Scripting.Dictionary")
- .Add "txt", "text/plain"
- .Add "html", "text/html"
- .Add "php", "application/x-php"
- .Add "js", "application/x-javascript"
- .Add "vbs", "application/x-vbs"
- .Add "bat", "application/x-bat"
- .Add "jpeg", "image/jpeg"
- .Add "jpg", "image/jpeg"
- .Add "png", "image/png"
- .Add "exe", "application/exe"
- .Add "doc", "application/msword"
- .Add "docx", "application/vnd.openxmlformats-officedocument.wordprocessingml.document"
- .Add "xls", "application/vnd.ms-excel"
- .Add "xlsx", "application/vnd.openxmlformats-officedocument.spreadsheetml.sheet"
- strContentType = .Item(LCase(strExt))
- End With
- If strContentType = "" Then
- strStatus = "Invalid file type"
- Exit Sub
- End If
- With CreateObject("ADODB.Stream")
- .Type = 1
- .Mode = 3
- .Open
- .LoadFromFile strPath
- If Err.Number <> 0 Then
- strStatus = Err.Description & " (" & Err.Number & ")"
- Exit Sub
- End If
- bytData = .Read
- End With
- strBoundary = String(6, "-") & Replace(Mid(CreateObject("Scriptlet.TypeLib").Guid, 2, 36), "-", "")
- With CreateObject("ADODB.Stream")
- .Mode = 3
- .Charset = "Windows-1251"
- .Open
- .Type = 2
- .WriteText "--" & strBoundary & vbCrLf
- .WriteText "Content-Disposition: form-data; name=""upload_file""; filename=""" & strFile & """" & vbCrLf
- .WriteText "Content-Type: """ & strContentType & """" & vbCrLf & vbCrLf
- .Position = 0
- .Type = 1
- .Position = .Size
- .Write bytData
- .Position = 0
- .Type = 2
- .Position = .Size
- .WriteText vbCrLf & "--" & strBoundary & "--"
- .Position = 0
- .Type = 1
- bytPayLoad = .Read
- End With
- With CreateObject("MSXML2.ServerXMLHTTP")
- .SetTimeouts 0, 60000, 300000, 300000
- .Open "POST", "http://tessstt.esy.es/upload.php", False
- .SetRequestHeader "Content-type", "multipart/form-data; boundary=" & strBoundary
- .Send bytPayLoad
- If Err.Number <> 0 Then
- strStatus = Err.Description & " (" & Err.Number & ")"
- Else
- strStatus = .StatusText & " (" & .Status & ")"
- End If
- If .Status = "200" Then strResponse = .ResponseText
- End With
- End Sub
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement