Copy Code code as follows:
' 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
' A string-byte array of the specified character set
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
' Get a byte array of the contents of the file
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
' Get a custom form data line
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
' Set the character set used for uploading
Public Property Let Charset (ByVal strvalue)
strCharSet = strvalue
End Property
' Add the name and value of the text field
Public Sub AddForm (ByVal strName, ByVal strvalue)
Dim tmp
TMP = "\r\n--$1\r\ncontent-disposition:form-data; Name= "" $ "" \r\n\r\n$3 "
TMP = Replace (tmp, "\ r \ n", vbCrLf)
TMP = Replace (TMP, "$", strboundary)
TMP = Replace (tmp, $, strName)
TMP = Replace (TMP, "$", strvalue)
Objtemp.write stringtobytes (tmp, strCharSet)
End Sub
' Set file field name/file name/file MIME type/file path or file byte array
Public Sub AddFile (ByVal strName, ByVal strFileName, ByVal strfiletype, ByVal strFilePath)
Dim tmp
TMP = "\r\n--$1\r\ncontent-disposition:form-data; Name= "" $ ""; Filename= "" $ "" \r\ncontent-type: $4\r\n\r\n "
TMP = Replace (tmp, "\ r \ n", vbCrLf)
TMP = Replace (TMP, "$", strboundary)
TMP = Replace (tmp, $, strName)
TMP = Replace (TMP, "$", strFileName)
TMP = Replace (TMP, "$", Strfiletype)
Objtemp.write stringtobytes (tmp, strCharSet)
Objtemp.write getfilebinary (strFilePath)
End Sub
' Set Multipart/form-data end tag
Private Sub Addend ()
Dim tmp
TMP = "\r\n--$1--\r\n"
TMP = Replace (tmp, "\ r \ n", vbCrLf)
TMP = Replace (TMP, "$", strboundary)
Objtemp.write stringtobytes (tmp, strCharSet)
Objtemp.position = 2
End Sub
' Upload to the specified URL and return to the server reply
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 the name and content of "content", "Hello World" text field
Uploaddata.addfile "File", "Test.jpg", "image/jpg", "test.jpg"
WScript.Echo Uploaddata.upload ("http://example.com/takeupload.php")
Set Uploaddata = Nothing
Original: http://demon.tw/programming/vbs-post-file.html