<%
Public Const adTypeBinary = 1
Public Const adTypeText = 2
Public Const adLongVarBinary = 205
'字節(jié)數(shù)組轉(zhuǎn)指定字符集的字符串
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
'字節(jié)字符串轉(zhuǎn)字節(jié)數(shù)組,即經(jīng)過(guò)MidB/LeftB/RightB/ChrB等處理過(guò)的字符串
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
'指定字符集的字符串轉(zhuǎn)字節(jié)數(shù)組
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
'獲取文件內(nèi)容的字節(jié)數(shù)組
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
'獲取自定義的表單數(shù)據(jù)分界線
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
'設(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, 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
'設(shè)置multipart/form-data結(jié)束標(biāo)記
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,并返回服務(wù)器應(yīng)答
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
%>
本文地址:http:///news/n08/201203/6925.html,如要轉(zhuǎn)載,請(qǐng)注明轉(zhuǎn)載自5A農(nóng)業(yè)人才網(wǎng)