| 标题 | VBS模拟POST上传文件的代码 |
| 范文 | 改写自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 |
| 随便看 |
|
在线学习网范文大全提供好词好句、学习总结、工作总结、演讲稿等写作素材及范文模板，是学习及工作的有利工具。