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>"
%>