使用 VBA 以 HTML 格式通过 <input \input> 上传文件

Question

我正在尝试将图片文件上传到OCR Site，但是，PDF 文件没有上传到网站。

我正在使用下面的代码来实现它，下面是 HTML 段：

Sub DownPDF()

    Dim FileName As String: FileName = "C:\Users\310217955\Documents\pdfdown\SGSSI001_HL1464_2011.pdf"
    Dim DestURL As String: DestURL = "https://www.newocr.com/"
    Dim FieldName As String: FieldName = "userfile"
    Call UploadFile(DestURL, FileName, FieldName)

End Sub


'******************* upload - begin
'Upload file using input type=file
Sub UploadFile(DestURL, FileName, FieldName)
  'Boundary of fields.
  'Be sure this string is Not In the source file
  Const Boundary = "---------------------------0123456789012"

  Dim FileContents, FormData
  'Get source file As a binary data.
  FileContents = GetFile(FileName)

  'Build multipart/form-data document
  FormData = BuildFormData(FileContents, Boundary, FileName, FieldName)

  'Post the data To the destination URL
  IEPostBinaryRequest DestURL, FormData, Boundary
End Sub

'Build multipart/form-data document with file contents And header info
Function BuildFormData(FileContents, Boundary, FileName, FieldName)
  Dim FormData, Pre, Po
  Const ContentType = "application/upload"

  '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

'sends multipart/form-data To the URL using IE
Function IEPostBinaryRequest(URL, FormData, Boundary)
  'Create InternetExplorer
  Dim IE: Set IE = CreateObject("InternetExplorer.Application")

  'You can uncoment Next line To see form results
  IE.Visible = True

  'Send the form data To URL As POST multipart/form-data request
  IE.Navigate URL, , , FormData, _
    "Content-Type: multipart/form-data; boundary=" + Boundary + vbCrLf

  Do While IE.Busy Or IE.readyState <> 4
    Wait 1, "Upload To " & URL
  Loop

  'Get a result of the script which has received upload
  On Error Resume Next
  IEPostBinaryRequest = IE.document.body.innerHTML
  'IE.Quit
End Function

'Infrormations In form field header.
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


Sub Wait(Seconds, Message)
  On Error Resume Next
  CreateObject("wscript.shell").Popup Message, Seconds, "", 64
End Sub


'Returns file contents As a binary data
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

'Converts OLE string To multibyte string
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
'******************* upload - end

'******************* Support
'Basic script info
Sub InfoEcho()
  Dim Msg
  Msg = Msg + "Upload file using http And multipart/form-data" & vbCrLf
  Msg = Msg + "Copyright (C) 2001 Antonin Foller, PSTRUH Software" & vbCrLf
  Msg = Msg + "use" & vbCrLf
  Msg = Msg + "[cscript|wscript] fupload.vbs file url [fieldname]" & vbCrLf
  Msg = Msg + "  file ... Local file To upload" & vbCrLf
  Msg = Msg + "  url ... URL which can accept uploaded data" & vbCrLf
  Msg = Msg + "  fieldname ... Name of the source form field." & vbCrLf
  Msg = Msg + vbCrLf + CheckRequirements
  WScript.Echo Msg
  WScript.Quit
End Sub

'Checks If all of required objects are installed
Function CheckRequirements()
  Dim Msg
  Msg = "This script requires some objects installed To run properly." & vbCrLf
  Msg = Msg & CheckOneObject("ADODB.Recordset")
  Msg = Msg & CheckOneObject("ADODB.Stream")
  Msg = Msg & CheckOneObject("InternetExplorer.Application")
  CheckRequirements = Msg
'  MsgBox Msg
End Function

'Checks If the one object is installed.
Function CheckOneObject(oClass)
  Dim Msg
  On Error Resume Next
  CreateObject oClass
  If Err = 0 Then Msg = "OK" Else Msg = "Error:" & Err.Description
  CheckOneObject = oClass & " - " & Msg & vbCrLf
End Function

这是 HTML 片段。

<input name="userfile" id="userfile" type="file">

Answer 1

我花了几天时间试验相同的技术 - 使用 InternetExplorer.Application COM 接口的 Navigate 方法来上传文件。
Navigate 的文档表明指定 postdata 参数将触发 HTTP POST，但根据我的经验，Content-Type 也是一个决定因素。使用 Fiddler 我发现当 Content-Type = multipart/form-data 时它始终发送 GET HTTP 方法而不是 POST。

发送 GET 动词将告诉服务器忽略任何表单数据，只处理 URI。

This page 表示他在 XMLHTTP 对象方面取得了一些成功，该对象允许更好地控制 HTTP 请求。下面是一些演示此技术的 Powershell 代码：

$http = (New-Object -ComObject "MSXML2.XMLHTTP") 
$http.Open("POST",$DestURL,$false)
$http.SetRequestHeader("Content-Type", "multipart/form-data; boundary=" + $boundary)
$http.Send($PostData) 

Answer 2

您可以使用 ScriptUtils.ASPForm 在 ASP 中接受上传的文件。 ScriptUtils.ASPForm 包含高性能、低资源消耗的算法，可以接受高达 2GB 的数据。

1. 使用 http 和 multipart/form-data 文档上传文件有一些步骤。首先，我们必须从磁盘读取文件。我们可以使用 Scripting.FileSystemObject 读取文本数据，或使用 ADODB.Stream 读取任何文件。 GetFile 函数使用 ADODB.Stream 完成工作。

2. 我们需要完成的第二个任务是构建 multipart/form-data 文档。该文档包含由边界分隔的几个字段。每个字段都有自己的标题，其中包含有关源文件的字段名称、文件名和内容类型的信息。 ADO Recordset 对象有一个很棒的 AppendChunk 方法，它可以让您连接多部分/表单数据文档的各个部分（打开边界 + 标题 + 文件内容 + 关闭边界）。您可以在 BuildFormData 函数中看到代码。

3. 最后一项任务是将 multipart/form-data 文档作为 post 请求发送到带有 multipart/form-data Content-Type 标头的服务器。我们可以使用至少两个对象来发送 POST 请求——XMLHttp 或 InternetExplorer。该脚本使用 InternetExplorer.Application 对象的 Navigate 方法。可以在 IEPostBinaryRequest 函数中看到代码

请查看以下链接以获取更多信息。

http://www.motobit.com/tips/detpg_uploadvbsie/

GetFile 方法正在将文件转换为 UTF-8。 Pdf 将有超过 128 个字节， 您需要将其转换为多字节字符串

'Converts OLE string To multibyte stringFunction 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://www.mrexcel.com/forum/excel-questions/861695-using-xmlhttp-upload-file-api.html#post4192153