'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