标题: VBS模拟POST上传文件
作者: Demon
链接: https://demon.tw/programming/vbs-post-file.html
版权: 本博客的所有文章,都遵守“署名-非商业性使用-相同方式共享 2.5 中国大陆”协议条款。
改写自CSDN上的一个ASP中模拟form上传文件,即(multipart/form-data)的表单的程序。原程序有些地方写错了,还一大堆人复制粘贴,真受不了。
赞赏'XML Upload Class Class XMLUpload Private xmlHttp Private objTemp Private adTypeBinary, adTypeText Private strCharset, strBoundary Private Sub Class_Initialize() adTypeBinary = 1 adTypeText = 2 Set xmlHttp = CreateObject("Msxml2.XMLHTTP") Set objTemp = CreateObject("ADODB.Stream") objTemp.Type = adTypeBinary objTemp.Open strCharset = "utf-8" strBoundary = GetBoundary() End Sub Private Sub Class_Terminate() objTemp.Close Set objTemp = Nothing Set xmlHttp = Nothing End Sub '指定字符集的字符串转字节数组 Public Function StringToBytes(ByVal strData, ByVal strCharset) Dim objFile Set objFile = CreateObject("ADODB.Stream") objFile.Type = adTypeText objFile.Charset = strCharset objFile.Open objFile.WriteText strData objFile.Position = 0 objFile.Type = adTypeBinary If UCase(strCharset) = "UNICODE" Then objFile.Position = 2 'delete UNICODE BOM ElseIf UCase(strCharset) = "UTF-8" Then objFile.Position = 3 'delete UTF-8 BOM End If StringToBytes = objFile.Read(-1) objFile.Close Set objFile = Nothing End Function '获取文件内容的字节数组 Private Function GetFileBinary(ByVal strPath) Dim objFile Set objFile = CreateObject("ADODB.Stream") objFile.Type = adTypeBinary objFile.Open objFile.LoadFromFile strPath GetFileBinary = objFile.Read(-1) objFile.Close Set objFile = Nothing End Function '获取自定义的表单数据分界线 Private Function GetBoundary() Dim ret(12) Dim table Dim i table = "abcdefghijklmnopqrstuvwxzy0123456789" Randomize For i = 0 To UBound(ret) ret(i) = Mid(table, Int(Rnd() * Len(table) + 1), 1) Next GetBoundary = "---------------------------" & Join(ret, Empty) End Function '设置上传使用的字符集 Public Property Let Charset(ByVal strValue) strCharset = strValue End Property '添加文本域的名称和值 Public Sub AddForm(ByVal strName, ByVal strValue) Dim tmp tmp = "\r\n--$1\r\nContent-Disposition: form-data; name=""$2""\r\n\r\n$3" tmp = Replace(tmp, "\r\n", vbCrLf) tmp = Replace(tmp, "$1", strBoundary) tmp = Replace(tmp, "$2", strName) tmp = Replace(tmp, "$3", strValue) objTemp.Write StringToBytes(tmp, strCharset) End Sub '设置文件域的名称/文件名称/文件MIME类型/文件路径或文件字节数组 Public Sub AddFile(ByVal strName, ByVal strFileName, ByVal strFileType, ByVal strFilePath) Dim tmp tmp = "\r\n--$1\r\nContent-Disposition: form-data; name=""$2""; filename=""$3""\r\nContent-Type: $4\r\n\r\n" tmp = Replace(tmp, "\r\n", vbCrLf) tmp = Replace(tmp, "$1", strBoundary) tmp = Replace(tmp, "$2", strName) tmp = Replace(tmp, "$3", strFileName) tmp = Replace(tmp, "$4", strFileType) objTemp.Write StringToBytes(tmp, strCharset) objTemp.Write GetFileBinary(strFilePath) End Sub '设置multipart/form-data结束标记 Private Sub AddEnd() Dim tmp tmp = "\r\n--$1--\r\n" tmp = Replace(tmp, "\r\n", vbCrLf) tmp = Replace(tmp, "$1", strBoundary) objTemp.Write StringToBytes(tmp, strCharset) objTemp.Position = 2 End Sub '上传到指定的URL,并返回服务器应答 Public Function Upload(ByVal strURL) Call AddEnd xmlHttp.Open "POST", strURL, False xmlHttp.setRequestHeader "Content-Type", "multipart/form-data; boundary=" & strBoundary 'xmlHttp.setRequestHeader "Content-Length", objTemp.size xmlHttp.Send objTemp Upload = xmlHttp.responseText End Function End Class Dim UploadData Set UploadData = New XMLUpload UploadData.Charset = "utf-8" UploadData.AddForm "content", "Hello world" '文本域的名称和内容 UploadData.AddFile "file", "test.jpg", "image/jpg", "test.jpg" WScript.Echo UploadData.Upload("http://example.com/takeupload.php") Set UploadData = Nothing
微信赞赏支付宝赞赏
随机文章:
高手可以加QQ交流吗
1487960792
addfrom 和 addfile 没看懂
是上传的固定形式么?
博主 居然 这么多 vbs的文章…
不知道博主干什么工作??
无业游民。
按照这个方法,上传时出现http Erro 500错误,具体为 stream ended unexpectedly。
为什么?
不知道您是否上线,您的脚本很好用,但是只能Wscript.Echo UploadData.Upload(“”)如果返回页面较多看到显示不完全的html。无法实现WriteLine写到文档文件中作为后期字符处理。
感谢博主,非常好的代码
感谢Demon兄弟的无私奉献以及严谨务求实的态度,你的代码帮了大忙,万分感谢!