gpt4 book ai didi

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

转载 作者:行者123 更新时间:2023-12-04 19:58:26 26 4
gpt4 key购买 nike

我在 SO 上找到了一个链接,它可能在这个查询中有所不同
Upload a Picture to file.io (HTTP Post) in VBA
此链接中的代码

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


任何人都可以尝试此代码,因为该网站是免费的。当我运行代码时,我在即时窗口中获得了“成功”,并获得了上传文件的链接。
这似乎没有问题,但是当获取链接并将其放入浏览器时,我得到 404 Page not found

我尝试手动上传相同的文件,它运行良好,没有任何问题,因为我从这个手动步骤获得的链接

请问有什么帮助吗?

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

最佳答案

在我看来,最终边界位于错误的位置,即在文件内容之前。尝试

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

关于excel - 使用 POST 方法将文件上传到 file.io,我们在Stack Overflow上找到一个类似的问题: https://stackoverflow.com/questions/60890492/

26 4 0
Copyright 2021 - 2024 cfsdn All Rights Reserved 蜀ICP备2022000587号
广告合作:1813099741@qq.com 6ren.com