simple_host_text_upload_octet_stream.vbs

Option Explicit

Dim strUplURL, strUplText, strUplStatus, strUplResponse

strUplURL = "http://vhost4353.cpsite.ru/upload.php"
strUplText = "TEST STRING" & vbCrLf & "Этот текст загружен c помощью скрипта http://pastebin.com/Z3Yyu7e4"
UploadText strUplURL, strUplText, strUplStatus, strUplResponse
MsgBox strUplStatus & vbCrLf & strUplResponse

Sub UploadText(strURL, strText, strStatus, strResponse)

    Dim strBoundary, bytPayLoad

    On Error Resume Next
    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=""content.txt""" & vbCrLf
        .WriteText "Content-Type: octet/stream" & vbCrLf & vbCrLf
        .WriteText strText
        .WriteText vbCrLf & "--" & strBoundary & "--"
        .Position = 0
        .Type = 1
        bytPayLoad = .Read
    End With
    With CreateObject("MSXML2.ServerXMLHTTP")
        .SetTimeouts 0, 60000, 300000, 300000
        .Open "POST", strURL, 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
        strResponse = .ResponseText
    End With

End Sub