ASP simulates POST submission request to upload files

Source: http://www.hiahia.org/post/aspsimulate postsubmission request file upload .html

 

ASP simulates POST submission requests and supports multipart/form-data form for file upload. In fact, we are familiar with the HTTP protocol and construct the request header. The principle is clear. The key is the detailed construction process, which can be generalized to other languages. This is quite a classic code. Please search for it, haha!

Sender, and construct the header script:

<%
Public Const adTypeBinary = 1
Public Const adTypeText = 2
Public Const adLongVarBinary = 205

 

'Byte array to Character Set string
Public Function BytesToString (vtData, ByVal strCharset)
Dim objFile
Set objFile = Server. CreateObject ("ADODB. Stream ")
ObjFile. Type = adTypeBinary
ObjFile. Open
If VarType (vtData) = vbString Then
ObjFile. Write BinaryToBytes (vtData)
Else
ObjFile. Write vtData
End If
ObjFile. Position = 0
ObjFile. Type = adTypeText
ObjFile. Charset = strCharset
BytesToString = objFile. ReadText (-1)
ObjFile. Close
Set objFile = Nothing
End Function

 

'Byte string to byte array, that is, processed strings such as MidB/LeftB/RightB/ChrB
Public Function BinaryToBytes (vtData)
Dim rs
Dim lSize
LSize = LenB (vtData)
Set rs = Server. CreateObject ("ADODB. RecordSet ")
Rs. Fields. Append "Content", adLongVarBinary, lSize
Rs. Open
Rs. AddNew
Rs ("Content"). AppendChunk vtData
Rs. Update
BinaryToBytes = rs ("Content"). GetChunk (lSize)
Rs. Close
Set rs = Nothing
End Function

 

'Convert Character Set strings to byte Arrays
Public Function StringToBytes (ByVal strData, ByVal strCharset)
Dim objFile
Set objFile = Server. 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 the byte array of File Content
Public Function GetFileBinary (ByVal strPath)
Dim objFile
Set objFile = Server. CreateObject ("ADODB. Stream ")
ObjFile. Type = adTypeBinary
ObjFile. Open
ObjFile. LoadFromFile strPath
GetFileBinary = objFile. Read (-1)
ObjFile. Close
Set objFile = Nothing
End Function

 

'Xml Upload Class
Class XMLUploadImpl
Private xmlHttp
Private objTemp
Private strCharset, strBoundary

Private Sub Class_Initialize ()
Set xmlHttp = Server. CreateObject ("MSXML2.ServerXMLHTTP ")
Set objTemp = Server. CreateObject ("ADODB. Stream ")
ObjTemp. Type = adTypeBinary
ObjTemp. Open
StrCharset = "GBK"
StrBoundary = GetBoundary ()
End Sub

Private Sub Class_Terminate ()
ObjTemp. Close
Set objTemp = Nothing
Set xmlHttp = Nothing
End Sub

 

'Get custom form data demarcation line
Private Function GetBoundary ()
Dim ret (24)
Dim table
Dim I
Table = "ABCDEFGHIJKLMNOPQRSTUVWXZYabcdefghijklmnopqrstuvwxzy0123456789"
Randomize
For I = 0 To UBound (ret)
Ret (I) = Mid (table, Int (Rnd () * Len (table) + 1), 1)
Next
GetBoundary = "_ NextPart _" & Join (ret, Empty)
End Function

Public Function Upload (ByVal strURL, ByVal cookiename, ByVal cookiecontent) 'can output cookie session login after improvement, haha
Call AddEnd
XmlHttp. Open "POST", strURL, False

If cookiename <> "" and cookiecontent <> "then
XmlHttp. setRequestHeader "Cookie", cookiename & "=" & cookiecontent & "; path =/;" 'indicates the cookie information for Logon. You can use the username and password to try to read the logon information.
End if
XmlHttp. setRequestHeader "User-Agent", "User-Agent: Mozilla/4.0 (compatible; OpenOffice.org)" 'camouflage Browser
XmlHttp. setRequestHeader "Connection", "Keep-Alive"

XmlHttp. setRequestHeader "Content-Type", "multipart/form-data; boundary =" & strBoundary 'php's problem is that no separator is specified and it will not be analyzed and read by itself. Haha! Done
XmlHttp. setRequestHeader "Content-Length", objTemp. size

XmlHttp. Send objTemp
If VarType (xmlHttp. responseBody) = (vbByte Or vbArray) Then
Upload = BytesToString (xmlHttp. responseBody, strCharset)
End If
End Function

Public Function GetResponse ()
GetResponse = xmlHttp. getResponseHeader ("Set-Cookie") 'getallresponseheaders ("Set-Cookie") Get the cookie string
End Function

'Sets the character set used for upload.
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 =" "$2" "\ 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

 

'Set the file domain name/file MIME type/file path or file byte array
Public Sub AddFile (ByVal strName, ByVal strFileName, ByVal strFileType, vtValue)
Dim tmp
Tmp = "\ r \ n -- $1 \ r \ nContent-Disposition: form-data; name =" "$2 ""; filename = "" $3 "" \ r \ nContent-Type: $4 \ 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)
If VarType (vtValue) = (vbByte Or vbArray) Then
ObjTemp. Write vtValue
Else
ObjTemp. Write GetFileBinary (vtValue)
End If
End Sub

 

'Set the multipart/form-data end flag
Private Sub AddEnd ()
Dim tmp
'Tmp = Replace ("\ r \ n -- $1 -- \ r \ n", "$1", strBoundary)
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

 

'Upload to the specified URL and return the Server Response
Public Function Upload (ByVal strURL)
Call AddEnd
XmlHttp. Open "POST", strURL, False
XmlHttp. setRequestHeader "Content-Type", "multipart/form-data"
XmlHttp. setRequestHeader "Content-Length", objTemp. size
XmlHttp. Send objTemp
If VarType (xmlHttp. responseBody) = (vbByte Or vbArray) Then
Upload = BytesToString (xmlHttp. responseBody, strCharset)
End If
End Function
End Class
%>

 

<%
'Use the following code to call the file after it is contained:
'Vb code

Dim UploadData
Set UploadData = New XMLUploadImpl
UploadData. Charset = "gb2312"
UploadData. AddForm "Test", "123456" 'text field name and content
'Uploaddata. AddFile "ImgFile", "F: \ test.jpg", "image/jpg", GetFileBinary ("F: \ test.jpg") 'image or other files
UploadData. AddFile "ImgFile", Server. MapPath ("test.jpg"), "image/jpg", GetFileBinary (Server. MapPath ("test.jpg") 'image or other files
Response. Write UploadData. Upload ("http: // localhost/receive. asp") 'receive. asp is the receiving page
Set UploadData = Nothing

%>

 

Acceptor, stripping the read header field:

<Meta http-equiv = "Content-Type" content = "text/html; charset = GB2312"/>

<%
Sub BuildUploadRequest (RequestBin)

'Get the boundary
PosBeg = 1
PosEnd = Consumer B (PosBeg, RequestBin, getByteString (chr (13 )))
Boundary = MidB (RequestBin, PosBeg, PosEnd-PosBeg)
BoundaryPos = callback B (1, RequestBin, boundary)
'Get all data inside the boundaries
Do until (boundaryPos = RequestBin, boundary & getByteString ("--")))
'Members variable of objects are put in a dictionary object
Dim UploadControl
Set UploadControl = CreateObject ("Scripting. Dictionary ")

'Get an object name
Pos = bytes B (BoundaryPos, RequestBin, getByteString ("Content-Disposition "))
Pos = bytes B (Pos, RequestBin, getByteString ("name = "))
PosBeg = Pos + 6
PosEnd = Consumer B (PosBeg, RequestBin, getByteString (chr (34 )))
Name = getString (MidB (RequestBin, PosBeg, PosEnd-PosBeg ))
PosFile = bytes B (BoundaryPos, RequestBin, getByteString ("filename = "))
PosBound = merge B (PosEnd, RequestBin, boundary)
'Test if object is of file type
If PosFile <> 0 AND (PosFile <PosBound) Then
'Get Filename, content-type and content of file
PosBeg = PosFile + 10
PosEnd = Consumer B (PosBeg, RequestBin, getByteString (chr (34 )))
FileName = getString (MidB (RequestBin, PosBeg, PosEnd-PosBeg ))
'Add filename to dictionary object
UploadControl. Add "FileName", FileName
Pos = Consumer B (PosEnd, RequestBin, getByteString ("Content-Type :"))
PosBeg = Pos + 14
PosEnd = Consumer B (PosBeg, RequestBin, getByteString (chr (13 )))
'Add content-type to dictionary object
ContentType = getString (MidB (RequestBin, PosBeg, PosEnd-PosBeg ))
UploadControl. Add "ContentType", ContentType
'Get content of object
PosBeg = PosEnd + 4
PosEnd = semi B (PosBeg, RequestBin, boundary)-2
Value = MidB (RequestBin, PosBeg, PosEnd-PosBeg)
Else
'Get content of object
Pos = sort B (Pos, RequestBin, getByteString (chr (13 )))
PosBeg = Pos + 4
PosEnd = semi B (PosBeg, RequestBin, boundary)-2
Value = getString (MidB (RequestBin, PosBeg, PosEnd-PosBeg ))
End If
'Add content to dictionary object
UploadControl. Add "Value", Value
'Add dictionary object to main dictionary
UploadRequest. Add name, UploadControl
'Loop to next object
BoundaryPos = BoundaryPos (BoundaryPos + LenB (boundary), RequestBin, boundary)
Loop
End Sub

<! -- Webbot bot = "PurpleText" PREVIEW = "end of the function used to upload data dictionaries" -->

'String to byte String conversion
Function getByteString (StringStr)
For I = 1 to Len (StringStr)
Char = Mid (StringStr, I, 1)
GetByteString = getByteString & chrB (AscB (char ))
Next
End Function

'Byte string to string conversion (hoho, this can deal with chinese !!!)
Function getString (str)
Strto = ""
For I = 1 to lenb (str)
If AscB (MidB (str, I, 1)> 127 then
Strto = strto & chr (Ascb (MidB (str, I, 1) * 256 + Ascb (MidB (str, I + 1, 1 )))
I = I + 1
Else
Strto = strto & Chr (AscB (MidB (str, I, 1 )))
End if
Next
GetString = strto
End Function

Function getStringold (StringBin)
GetString = ""
For intCount = 1 to LenB (StringBin)
GetString = getString & chr (AscB (MidB (StringBin, intCount, 1 )))
Next
End Function

<! -- Webbot = "PurpleText" PREVIEW = "start adding to Database" -->

Response. Buffer = TRUE
Response. Clear
ByteCount = Request. TotalBytes
'Get Byte Count
RequestBin = Request. BinaryRead (byteCount)
Dim UploadRequest
Set UploadRequest = CreateObject ("Scripting. Dictionary ")

BuildUploadRequest RequestBin

Filepath = UploadRequest. Item ("ImgFile"). Item ("FileName") 'get the complete Directory Name of the uploaded file
Compoundpic = UploadRequest. Item ("ImgFile"). Item ("Value ")
Response. write (filepath & "size:" & len (compoundpic ))
%>