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 = "\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

原文：http://demon.tw/programming/vbs-post-file.html