使用POST方法上传文件到file.io

Question

使用POST方法上传文件到file.io

3

我在stackoverflow上找到了一个链接，可能会对这个查询有所帮助：使用VBA将图片上传到file.io（HTTP Post）该链接提供的代码如下：

Sub UploadFilesUsingVBAORIGINAL()
     'this proc will upload below files to https://file.io/
          '  png, jpg, txt

        Dim fileFullPath As String
        fileFullPath = ThisWorkbook.Path & "\Sample.txt"

        POST_multipart_form_dataO fileFullPath
    End Sub

Private Function GetGUID() As String
    ' Generate uuid version 4 using VBA
    GetGUID = WorksheetFunction.Concat(WorksheetFunction.Dec2Hex(WorksheetFunction.RandBetween(0, 4294967295#), 8), "-", WorksheetFunction.Dec2Hex(WorksheetFunction.RandBetween(0, 65535), 4), "-", WorksheetFunction.Dec2Hex(WorksheetFunction.RandBetween(16384, 20479), 4), "-", WorksheetFunction.Dec2Hex(WorksheetFunction.RandBetween(32768, 49151), 4), "-", WorksheetFunction.Dec2Hex(WorksheetFunction.RandBetween(0, 65535), 4), WorksheetFunction.Dec2Hex(WorksheetFunction.RandBetween(0, 4294967295#), 8))

End Function

Private Function GetFileSize(fileFullPath As String) As Long

    Dim lngFSize As Long, lngDSize As Long
    Dim oFO As Object, OFS As Object

    lngFSize = 0
    Set OFS = CreateObject("Scripting.FileSystemObject")

    If OFS.FileExists(fileFullPath) Then
        Set oFO = OFS.GetFile(fileFullPath)
        GetFileSize = oFO.Size
    Else
        GetFileSize = 0
    End If

    Set oFO = Nothing
    Set OFS = Nothing
End Function



Private Function ReadBinary(strFilePath As String)
    Dim ado As Object, bytFile
    Set ado = CreateObject("ADODB.Stream")
    ado.Type = 1
    ado.Open
    ado.LoadFromFile strFilePath
    bytFile = ado.Read
    ado.Close

    ReadBinary = bytFile

    Set ado = Nothing
End Function


Private Function toArray(str)
    Dim ado As Object
     Set ado = CreateObject("ADODB.Stream")
     ado.Type = 2
     ado.Charset = "_autodetect"
     ado.Open
     ado.WriteText (str)
     ado.Position = 0
     ado.Type = 1
     toArray = ado.Read()
     Set ado = Nothing
End Function


Sub POST_multipart_form_dataO(filePath As String)

    Dim oFields As Object, ado As Object
    Dim sBoundary As String, sPayLoad As String, GUID As String
    Dim fileType As String, fileExtn As String, fileName As String
    Dim sName As Variant

    fileName = Right(filePath, Len(filePath) - InStrRev(filePath, "\"))
    fileExtn = Right(filePath, Len(fileName) - InStrRev(fileName, "."))

    Select Case fileExtn
     Case "png"
        fileType = "image/png"
     Case "jpg"
        fileType = "image/jpeg"
     Case "txt"
        fileType = "text/plain"
    End Select

    Set oFields = CreateObject("Scripting.Dictionary")
    With oFields
        .Add "qquuid", LCase(GetGUID)
        .Add "qqtotalfilesize", GetFileSize(filePath)
    End With

    sBoundary = String(27, "-") & "7e234f1f1d0654"
    sPayLoad = ""
    For Each sName In oFields
        sPayLoad = sPayLoad & "--" & sBoundary & vbCrLf
        sPayLoad = sPayLoad & "Content-Disposition: form-data; name=""" & sName & """" & vbCrLf & vbCrLf
        sPayLoad = sPayLoad & oFields(sName) & vbCrLf
    Next

    sPayLoad = sPayLoad & "--" & sBoundary & vbCrLf
    sPayLoad = sPayLoad & "Content-Disposition: form-data; name=""file""; " & "filename=""" & fileName & """" & vbCrLf
    sPayLoad = sPayLoad & "Content-Type: " & fileType & vbCrLf & vbCrLf & vbCrLf & vbCrLf & vbCrLf



     sPayLoad = sPayLoad & "--" & sBoundary & "--"


      Set ado = CreateObject("ADODB.Stream")
      ado.Type = 1
      ado.Open
      ado.Write toArray(sPayLoad)
      ado.Write ReadBinary(filePath)
      ado.Position = 0

    With CreateObject("MSXML2.ServerXMLHTTP")
        .Open "POST", "https://file.io", False
        .setRequestHeader "Content-Type", "multipart/form-data; boundary=" & sBoundary
        .send (ado.Read())
        Debug.Print .responseText
    End With

End Sub

任何人都可以免费尝试此代码。当我运行代码时，立即窗口中出现"Success"并获得上传文件的链接。

这似乎没有问题，但是当我将链接复制到浏览器中时，出现了404页面未找到的错误。

我尝试手动上传同样的文件，并没有任何问题，可以正常使用从手动步骤中获得的链接。

请求帮助，谢谢！

也发布在这里： https://chandoo.org/forum/threads/upload-file-to-file-io-using-post-method.43925/

- YasserKhalil

1个回答

网页内容由stack overflow 提供, 点击上面的

可以查看英文原文，
原文链接

- CDP1802 · Accepted Answer

在我看来，最终边界放错了位置，即在文件内容之前。请尝试：

Sub UploadToIO()

    Const PATH = "c:\tmp\"
    Const FILENAME = "testimage.png"
    Const CONTENT = "image/png"
    Const URL = "https://file.io"
    
    ' generate boundary
    Dim BOUNDARY, s As String, n As Integer
    For n = 1 To 16: s = s & Chr(65 + Int(Rnd * 25)): Next
    BOUNDARY = s & CDbl(Now)
    
    Dim part As String, ado As Object
    part = "--" & BOUNDARY & vbCrLf
    part = part & "Content-Disposition: form-data; name=""file""; filename=""" & FILENAME & """" & vbCrLf
    part = part & "Content-Type: " & CONTENT & vbCrLf & vbCrLf
           
    ' read file into image
    Dim image
    Set ado = CreateObject("ADODB.Stream")
    ado.Type = 1 'binary
    ado.Open
    ado.LoadFromFile PATH & FILENAME
    ado.Position = 0
    image = ado.read
    ado.Close
        
    ' combine part, image , end
    ado.Open
    ado.Position = 0
    ado.Type = 1 ' binary
    ado.Write ToBytes(part)
    ado.Write image
    ado.Write ToBytes(vbCrLf & "--" & BOUNDARY & "--")
    ado.Position = 0
    'ado.savetofile "c:\tmp\debug.bin", 2 ' overwrite
    
    ' send request
    With CreateObject("MSXML2.ServerXMLHTTP")
        .Open "POST", URL, False
        .setRequestHeader "Content-Type", "multipart/form-data; boundary=" & BOUNDARY
        .send ado.read
        Debug.Print .responseText
    End With

    MsgBox "File: " & PATH & FILENAME & vbCrLf & _
           "Boundary: " & BOUNDARY, vbInformation, "Uploaded to " & URL

End Sub

Function ToBytes(str As String) As Variant

    Dim ado As Object
    Set ado = CreateObject("ADODB.Stream")
    ado.Open
    ado.Type = 2 ' text
    ado.Charset = "_autodetect"
    ado.WriteText str
    ado.Position = 0
    ado.Type = 1
    ToBytes = ado.read
    ado.Close

End Function