VBS模拟POST上传文件的代码

'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 = "rn--$1rnContent-Disposition: form-data; name=""$2""rnrn$3" 
tmp = Replace(tmp, "rn", 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 = "rn--$1rnContent-Disposition: form-data; name=""$2""; filename=""$3""rnContent-Type: $4rnrn" 
tmp = Replace(tmp, "rn", 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 = "rn--$1--rn" 
tmp = Replace(tmp, "rn", 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