ASP模拟POST提交请求上传文件

最新推荐文章于 2024-02-19 16:21:34 发布

weixin_30619101

最新推荐文章于 2024-02-19 16:21:34 发布

阅读量438

点赞数

文章标签：数据库

原文链接：http://www.cnblogs.com/ableid/archive/2010/04/08/1707498.html

版权

出处：http://www.hiahia.org/post/ASP模拟POST提交请求上传文件.html

ASP模拟POST提交请求，可以支持文件上传的multipart/form-data表单方式。其实就是熟悉HTTP协议，构造请求头部，原理清晰，关键是细节的构造过程，可以举一反三，推广到其他语言中去。这是相当经典的代码，好好搜藏吧，哈哈！

发送端，构造头部脚本：

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

'字节数组转指定字符集的字符串
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

'字节字符串转字节数组，即经过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

'指定字符集的字符串转字节数组
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

'获取文件内容的字节数组
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

'获取自定义的表单数据分界线
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)   '改进之后可以输出cookie session登录，哈哈
    Call AddEnd
    xmlHttp.Open "POST", strURL, False

    if cookiename<>"" and cookiecontent<>"" then
       xmlHttp.setRequestHeader "Cookie",cookiename&"="&cookiecontent&"; path=/; "    '登录的cookie信息，以后可以用用户名密码来尝试读取登录信息
    end if
       xmlHttp.setRequestHeader "User-Agent", "User-Agent: Mozilla/4.0 (compatible; OpenOffice.org)"     '伪装浏览器
       xmlHttp.setRequestHeader "Connection", "Keep-Alive"

xmlHttp.setRequestHeader "Content-Type", "multipart/form-data; boundary="&strBoundary 'PHP的问题就出在这里，没有指定分隔符号，自己不会分析读取，哈哈！搞定
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") 获取cookie字符串
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, vtValue)
    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)
    If VarType(vtValue) = (vbByte Or vbArray) Then
        objTemp.Write vtValue
    Else
        objTemp.Write GetFileBinary(vtValue)
    End If
End Sub

'设置multipart/form-data结束标记
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

'上传到指定的URL，并返回服务器应答
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
%>

<%
'在包含该文件后用以下代码调用
'VB code

Dim UploadData
Set UploadData = New XMLUploadImpl
UploadData.Charset = "gb2312"
UploadData.AddForm "Test", "123456" '文本域的名称和内容
'UploadData.AddFile "ImgFile", "F:\test.jpg", "image/jpg", GetFileBinary("F:\test.jpg")'图片或者其它文件
UploadData.AddFile "ImgFile", Server.MapPath("test.jpg"), "image/jpg", GetFileBinary(Server.MapPath("test.jpg"))'图片或者其它文件
Response.Write UploadData.Upload("http://localhost/receive.asp") 'receive.asp为接收页面
Set UploadData = Nothing

接收端，剥离读取头部字段：

<%
Sub BuildUploadRequest(RequestBin)

    'Get the boundary
    PosBeg = 1
    PosEnd = InstrB(PosBeg,RequestBin,getByteString(chr(13)))
    boundary = MidB(RequestBin,PosBeg,PosEnd-PosBeg)
    boundaryPos = InstrB(1,RequestBin,boundary)
    'Get all data inside the boundaries
    Do until (boundaryPos=InstrB(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 = InstrB(BoundaryPos,RequestBin,getByteString("Content-Disposition"))
        Pos = InstrB(Pos,RequestBin,getByteString("name="))
        PosBeg = Pos+6
        PosEnd = InstrB(PosBeg,RequestBin,getByteString(chr(34)))
        Name = getString(MidB(RequestBin,PosBeg,PosEnd-PosBeg))
        PosFile = InstrB(BoundaryPos,RequestBin,getByteString("filename="))
        PosBound = InstrB(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 = InstrB(PosBeg,RequestBin,getByteString(chr(34)))
            FileName = getString(MidB(RequestBin,PosBeg,PosEnd-PosBeg))
            'Add filename to dictionary object
            UploadControl.Add "FileName", FileName
            Pos = InstrB(PosEnd,RequestBin,getByteString("Content-Type:"))
            PosBeg = Pos+14
            PosEnd = InstrB(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 = InstrB(PosBeg,RequestBin,boundary)-2
            Value = MidB(RequestBin,PosBeg,PosEnd-PosBeg)
            Else
            'Get content of object
            Pos = InstrB(Pos,RequestBin,getByteString(chr(13)))
            PosBeg = Pos+4
            PosEnd = InstrB(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=InstrB(BoundaryPos+LenB(boundary),RequestBin,boundary)
    Loop
End Sub

'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

Response.Buffer = TRUE
Response.Clear
byteCount = Request.TotalBytes
'获得字节数
RequestBin = Request.BinaryRead(byteCount)
Dim UploadRequest
Set UploadRequest = CreateObject("Scripting.Dictionary")

BuildUploadRequest RequestBin

filepath= UploadRequest.Item("ImgFile").Item("FileName") '获取上传文件的完整目录名字
compoundpic = UploadRequest.Item("ImgFile").Item("Value")
response.write(filepath&" size:"&len(compoundpic))
%>

转载于:https://www.cnblogs.com/ableid/archive/2010/04/08/1707498.html

weixin_30619101

关注

0
点赞
踩
1

收藏

觉得还不错? 一键收藏
0
评论
ASP模拟POST提交请求上传文件

出处：http://www.hiahia.org/post/ASP模拟POST提交请求上传文件.html ASP模拟POST提交请求，可以支持文件上传的multipart/form-data表单方式。其实就是熟悉HTTP协议，构造请求头部，原理清晰，关键是细节的构造过程，可以举一反三，推广到其他语言中去。这是相当经典的代码，好好搜藏吧，哈哈！发送端，构造头部脚本： <% ...
复制链接

扫一扫