復制代碼 代碼如下: '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
'設置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
