File updload в форме сообщения в VBS

Question

Я хочу автоматизировать с помощью Visual Basic Script загрузку файлов, которые у меня есть в форме HTML.

Я пытаюсь сделать сообщение в форме html, где я должен загрузить файл. Мне удалось сделать вызов HTTP с этим кодом:

sFile = sFolder & "file.txt" 
    sBoundary = "-ooo-" 
    Set req = CreateObject("MSXML2.XMLHTTP") 
    req.open "POST", SIGNurl, False 
    req.setRequestHeader "Content-Type", "multipart/form-data; boundary=" + sBoundary 

    inByteArray = readBytes(sFile) 
    base64Encoded = encodeBase64(inByteArray) 

    request = request & sBoundary & vbCrLf 
    request = request & "Content-Disposition: form-data; name=file; filename=" & sFile & vbCrLf 
    request = request & "Content-Type: application/x-object" & vbCrLf 
    request = request & base64Encoded & vbCrLf 
    request = request & sBoundary & vbCrLf 

    req.setRequestHeader "Content-Length", Len(request) 
    req.send request 
    WScript.Echo req.responseText 
    Set req = Nothing 

Private function readBytes(file) 
    dim inStream 
    ' ADODB stream object used 
    set inStream = WScript.CreateObject("ADODB.Stream") 
    ' open with no arguments makes the stream an empty container 
    inStream.Open 
    inStream.type= 1 
    inStream.LoadFromFile(file) 
    readBytes = inStream.Read() 
end function 

Private function encodeBase64(bytes) 
    dim DM, EL 
    Set DM = CreateObject("Microsoft.XMLDOM") 
    ' Create temporary node with Base64 data type 
    Set EL = DM.createElement("tmp") 
    EL.DataType = "bin.base64" 
    ' Set bytes, get encoded String 
    EL.NodeTypedValue = bytes 
    encodeBase64 = EL.Text 
end function 

Я получаю ошибку 400 сервера, говоря «недостающее содержимое файла в загрузке». Я не уверен, что мне не хватает, но что-то должно быть не так.

Любая помощь?

Answer 1

Вы пытаетесь загрузить содержимое двоичного файла в кодировке base64 текст, поэтому необходимо указать соответствующий MIME header, здесь фиксируется фрагмент кода:

request = request & sBoundary & vbCrLf 
    request = request & "Content-Disposition: form-data; name=file; filename=" & sFile & vbCrLf 
    request = request & "Content-Type: application/x-object" & vbCrLf 
    request = request & "Content-Transfer-Encoding: base64" & vbCrLf & vbCrLf 
    request = request & base64Encoded & vbCrLf 
    request = request & sBoundary & vbCrLf 

Также вы можете загрузить двоичный содержание файл, вот простейший пример:

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-1252" 
     .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://example.com/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