vbs模擬post請求上傳文件

''' VBS文件上傳類，二進制方式上傳
Class vbsFileUpload
    Public c_strDestURL      ' 文件上傳URL http://127.0.0.1:8080/AirportPro/widetable/uploadFile
    Public c_strFileName     ' 要上傳的本地文件名
    Public c_strFieldName    ' 字段名，類似HTML表單Form中的input name
    Public c_strBoundary     ' 文件上傳Post數據包中的分隔符
    Public c_strContentType  ' text/plain or image/pjpeg and so on "application/upload"
    Public c_strResponseText ' 文件上傳後，服務器返回的信息
    Public c_boolPrepared    '
    Public c_strErrMsg       ' 可能的錯誤信息

    Public Sub Class_Initialize()
        c_strDestURL     = "http://127.0.0.1:8080/AirportPro/widetable/uploadFile"
        c_strFileName    = "E:\1tyd\tyd.xls"
        c_strContentType = "application/upload"
        c_strFieldName   = "file"
        c_strBoundary    = "---------------------------7da1c52160186"
        c_boolPrepared   = false
    End Sub
   
    Public Sub Class_Terminate
    End Sub
   
    ''' 公共調用函數,文件上傳
    Public Function vbsUpload
        CheckRequirements()
        If  c_boolPrepared Then
            UploadFile c_strDestURL, c_strFileName, c_strFieldName
        Else
            'WScript.Echo c_strErrMsg
        End If
    End Function
   
    ''' 檢查程序工作環境
    Private Function CheckRequirements
        Dim objFSO
        Set objFSO = CreateObject("Scripting.FileSystemObject")
        If Not objFSO.FileExists(c_strFileName) Then
            c_strErrMsg = c_strErrMsg & vbCrLf & "wen jian bu cun zai.."
        Else
            On Error Resume Next
              CreateObject "MSXML2.XMLHTTP"
              If Not Err = 0 Then
                  c_strErrMsg = c_strErrMsg & vbCrLf & Err.Descriptiof
              Else
                  c_boolPrepared = True
              End If
          End If       
    End Function
   
   
    ''' 文件上傳
    Private Function UploadFile(DestURL, FileName, FieldName)
        Dim FileContents, FormData,Boundary
        Boundary     = c_strBoundary
        FileContents = GetFile(FileName) ' 二進制文件內容
        FormData     = BuildFormData(FileContents, Boundary, FileName, FieldName)
        WinHTTPPostRequest DestURL, FormData, Boundary
    End Function
   
    ''' WinHTTPPostRequest
    Private Function WinHTTPPostRequest(URL, FormData, Boundary)
        Dim xmlhttp
          Set xmlhttp = CreateObject("MSXML2.XMLHTTP")
          On Error Resume Next
          xmlhttp.Open "POST", URL, False
         xmlhttp.setRequestHeader "Content-Type", "multipart/form-data; boundary=" + Boundary
          xmlhttp.send FormData
          c_strResponseText = xmlhttp.responseText ' 服務端返回信息
          Set xmlhttp = Nothing
    End Function

    '''組合上傳數據包 multipart/form-data document Header + Content
    Private Function BuildFormData(FileContents, Boundary, FileName, FieldName)
      Dim FormData, Pre, Po, ContentType
      ContentType = c_strContentType
     
      'The two parts around file contents In the multipart-form data.
      Pre = "--" + Boundary + vbCrLf + mpFields(FieldName, FileName, ContentType)
      Po = vbCrLf + "--" + Boundary + "--" + vbCrLf
     
      'Build form data using recordset binary field
      Const adLongVarBinary = 205
      Dim RS: Set RS = CreateObject("ADODB.Recordset")
      RS.Fields.Append "b", adLongVarBinary, Len(Pre) + LenB(FileContents) + Len(Po)
      RS.Open
      RS.AddNew
        Dim LenData
        'Convert Pre string value To a binary data
        LenData = Len(Pre)
        RS("b").AppendChunk (StringToMB(Pre) & ChrB(0))
        Pre = RS("b").GetChunk(LenData)
        RS("b") = ""
       
        'Convert Po string value To a binary data
        LenData = Len(Po)
        RS("b").AppendChunk (StringToMB(Po) & ChrB(0))
        Po = RS("b").GetChunk(LenData)
        RS("b") = ""
       
        'Join Pre + FileContents + Po binary data
        RS("b").AppendChunk (Pre)
        RS("b").AppendChunk (FileContents)
        RS("b").AppendChunk (Po)
      RS.Update
      FormData = RS("b")
      RS.Close
      BuildFormData = FormData
    End Function
   
    'Converts OLE string To multibyte string
    Private Function StringToMB(S)
      Dim I, B
      For I = 1 To Len(S)
        B = B & ChrB(Asc(Mid(S, I, 1)))
      Next
      StringToMB = B
    End Function

   
    ''' 組織HTTP頭
    Private Function mpFields(FieldName, FileName, ContentType)
      Dim MPTemplate 'template For multipart header
      MPTemplate = "Content-Disposition: form-data; name=""{field}"";" + _
       " filename=""{file}""" + vbCrLf + _
       "Content-Type: {ct}" + vbCrLf + vbCrLf
      Dim Out
      Out = Replace(MPTemplate, "{field}", FieldName)
      Out = Replace(Out, "{file}", FileName)
      mpFields = Replace(Out, "{ct}", ContentType)
    End Function
   
    ''' 二進制載入文件內容
    Private Function GetFile(FileName)
      Dim Stream: Set Stream = CreateObject("ADODB.Stream")
      Stream.Type = 1 'Binary
      Stream.Open
      Stream.LoadFromFile FileName
      GetFile = Stream.Read
      Stream.Close
    End Function
End Class

 

Dim myUpload
Set myUpload = New vbsFileUpload
myUpload.c_strDestURL     = "http://127.0.0.1:8080/AirportPro/widetable/uploadFile?"  ' 必選
myUpload.c_strFileName    = "E:\1tyd\tyd.xls"   ' 必選
myUpload.c_strFieldName   = "file"                                      ' 必選
myUpload.c_strContentType = "application/upload"                               ' 可選
myUpload.vbsUpload()
'''WScript.Echo myUpload.c_strResponseText
'''WScript.Echo myUpload.c_strErrMsg
Set myUpload = Nothing