改寫自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

'指定字符集的字符串轉(zhuǎn)字節(jié)數(shù)組

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

'獲取文件內(nèi)容的字節(jié)數(shù)組

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

'獲取自定義的表單數(shù)據(jù)分界線

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

'設(shè)置上傳使用的字符集

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

'設(shè)置文件域的名稱/文件名稱/文件MIME類型/文件路徑或文件字節(jié)數(shù)組

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

'設(shè)置multipart/form-data結(jié)束標(biāo)記

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，并返回服務(wù)器應(yīng)答

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" '文本域的名稱和內(nèi)容

UploadData.AddFile "file", "test.jpg", "image/jpg", "test.jpg"

WScript.Echo UploadData.Upload("http://example.com/takeupload.php")

Set UploadData = Nothing