ASP + XMLHTTP get webpage code

Source: Internet
Author: User

<%
'*************************************** **************
'Function name: xmlreadurl (URL)
'Function: Read the HTML of the URL
'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' send request

'Response. addheader "content-disposition", "attachment?filename=*ell-pres.zip" 'Add a header to this file

'Response. contenttype = "application/zip" 'sets the output type

'Response. binarywrite XML. responsebody' outputs binary data to the browser.

Xmlreadurl = xml. responsebody

Set xml = nothing
End Function

'*************************************** **************
'Function name: urlencoding (vstrin)
'Function: encodes a URL string into hexadecimal notation
'*************************************** *************
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)
'Function: converts a binary string to a common character.
'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, L3, PL1, pl2, pl3
dim L
cl1 = 1
Cl2 = 1
l3 = 1
L = lenb (Binary)
do While cl1 <= L
pl3 = pl3 & CHR (ASCB (midb (binary, cl1, 1 )))
cl1 = cl1 + 1
l3 = L3 + 1
If L3> 300 then
pl2 = pl2 & pl3
pl3 = ""
l3 = 1
Cl2 = Cl2 + 1
If Cl2> 200 then
PL1 = PL1 & pl2
pl2 = ""
Cl2 = 1
end if
loop
binarytostring = PL1 & pl2 & pl3
end function
'binarytostring method is better than simplebinarytostring method. the performance is 20 times higher. It is recommended to process data below 2 MB.

'Use ADODB. recordset
'ADODB. recordset allows you to support almost all data types supported by variant. You can use it to convert between string and 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>"
%>

Contact Us

The content source of this page is from Internet, which doesn't represent Alibaba Cloud's opinion; products and services mentioned on that page don't have any relationship with Alibaba Cloud. If the content of the page makes you feel confusing, please write us an email, we will handle the problem within 5 days after receiving your email.

If you find any instances of plagiarism from the community, please send an email to: info-contact@alibabacloud.com and provide relevant evidence. A staff member will contact you within 5 working days.

A Free Trial That Lets You Build Big!

Start building with 50+ products and up to 12 months usage for Elastic Compute Service

  • Sales Support

    1 on 1 presale consultation

  • After-Sales Support

    24/7 Technical Support 6 Free Tickets per Quarter Faster Response

  • Alibaba Cloud offers highly flexible support services tailored to meet your exact needs.