ASP+XMLHTTP取得网页代码
<%
'*****************************************************
' Function Name:xmlReadUrl(url)
' 功能:读取Url的HTML
' Input Url
' Output to Function Name xmlReadUrl as a binstr
' ****************************************************
Function xmlReadUrl(url)
Response.Buffer = True
Dim xml
Set xml = Server.CreateObject("Microsoft.XMLHTTP")
'Set xml = Server.CreateObject("MSXML2.XMLHTTP")
'Set xml = Server.CreateObject("MSXML2.XMLHTTP.4.0")
xml.Open "GET",url,False
xml.Send '发送请求
'Response.AddHeader "Content-Disposition", "attachment;filename=mitchell-pres.zip" '添加头给这个文件
'Response.ContentType = "application/zip" '设置输出类型
'Response.Binarywrite xml.ResponseBody '输出二进制到浏览器
xmlReadUrl=xml.ResponseBody
Set xml = Nothing
End Function
'*****************************************************
' Function Name:URLEncoding(vstrIn)
' 功能:将URL字符串编码成16进制
' ****************************************************
Function URLEncoding(vstrIn)
strReturn = ""
For i = 1 To Len(vstrIn)
ThisChr = Mid(vStrIn,i,1)
If Abs(Asc(ThisChr)) < &HFF Then
strReturn = strReturn & ThisChr
Else
innerCode = Asc(ThisChr)
If innerCode < 0 Then
innerCode = innerCode + &H10000
End If
Hight8 = (innerCode And &HFF00)\ &HFF
Low8 = innerCode And &HFF
strReturn = strReturn & "%" & Hex(Hight8) & "%" & Hex(Low8)
End If
Next
URLEncoding = strReturn
End Function
'*****************************************************
'Function Name:Bytes2Str(BStr)
'Convert Bstr to Text Str In Unicode
'*****************************************************
Function Bytes2STR(vIn)
strReturn = ""
For i = 1 To LenB(vIn)
ThisCharCode = AscB(MidB(vIn,i,1))
If ThisCharCode < &H80 Then
strReturn = strReturn & Chr(ThisCharCode)
Else
NextCharCode = AscB(MidB(vIn,i+1,1))
strReturn = strReturn & Chr(CLng(ThisCharCode) * &H100 + CInt(NextCharCode))
i = i + 1
End If
Next
Bytes2STR = strReturn
End Function
' Function Name:Bin2Str(binstr)
' 功能:将二进制字符转换成普通字符
' Input binstr as bin stream
' Output to Function Name Bin2Str as a text stream
' ****************************************************
Function Bin2Str(binstr)
Dim binlen,clow,str,skipflag
skipflag=0
str = ""
binlen=LenB(binstr)
For i=1 To binlen
IF skipflag=0 Then
clow = MidB(binstr,i,1)
IF AscB(clow)>127 Then
str =str & Chr(AscW(MidB(binstr,i+1,1) & clow))
skipflag=1
Else
str = str & Chr(AscB(clow))
End If
Else
skipflag=0
End If
Next
Bin2Str = str
End Function
'*******************************************************************
' Function Name:SimpleBin2Str()
' Convert binstr to Unicode str Just for English words and Little words
'*******************************************************************
Function SimpleBin2Str(Binary)
Dim I, S
For I = 1 To LenB(Binary)
S = S & Chr(AscB(MidB(Binary, I, 1)))
Next
SimpleBin2Str = S
End Function
'*******************************************************************
' Function Name:BinaryToString()
' Convert binstr to Unicode str Just for English words and Little words
'*******************************************************************
Function BinaryToString(Binary)
Dim cl1, cl2, cl3, pl1, pl2, pl3
Dim L
cl1 = 1
cl2 = 1
cl3 = 1
L = LenB(Binary)
Do While cl1<=L
pl3 = pl3 & Chr(AscB(MidB(Binary,cl1,1)))
cl1 = cl1 + 1
cl3 = cl3 + 1
If cl3>300 Then
pl2 = pl2 & pl3
pl3 = ""
cl3 = 1
cl2 = cl2 + 1
If cl2>200 Then
pl1 = pl1 & pl2
pl2 = ""
cl2 = 1
End If
End If
Loop
BinaryToString = pl1 & pl2 & pl3
End Function
'BinaryToString方法比SimpleBinaryToString方法性能高20倍。建议用来处理2MB以下的数据。
'使用ADODB.Recordset
'ADODB.Recordset 可以让你支持几乎所有VARIANT支持的数据类型，你可以用它在string和binary之间转换。
Function RSBinaryToString(xBinary)
Dim Binary
If vartype(xBinary)=8 Then Binary = MultiByteToBinary(xBinary) Else Binary = xBinary
Dim RS, LBinary
Const adLongVarChar = 201
Set RS = CreateObject("ADODB.Recordset")
LBinary = LenB(Binary)
If LBinary>0 Then
RS.Fields.Append "mBinary", adLongVarChar, LBinary
RS.Open
RS.AddNew
RS("mBinary").AppendChunk Binary
RS.Update
RSBinaryToString = RS("mBinary")
Else
RSBinaryToString = ""
End If
End Function
Response.write "<textarea rows=25 cols=100>" & Bytes2Str(xmlReadUrl(URLEncoding("http://Localhost"))) & "</textarea>"
%>
