<%
If Trim (request.form ("url")) <> "Then
Dim Vbody:vbody=getresstr (Trim (request.form ("url"))
Dim res:res=vbody
Dim Code:code=getcode (Vbody, "charset= {0,}" ([^]+) {0,} "")
End If
%>
Crawl Page
Please enter%20name= "Type=text value=" <%=trim (Request.Form ("P >>? Size= "Url?>"
Page encoding:<%=code%>
<%=res%>
<%
Function Getresstr (URL)
Dim Resbody, resstr, pagecode
Set http=server.createobject ("msxml2.serverxmlhttp.3.0")
Http.settimeouts 10000, 10000, 10000, 10000
Http.open "Get", Url, false
Http.send ()
If http.readystate =4 Then
If http.status=200 Then
Resstr=http.responsetext
Resbody=http.responsebody
Pagecode=replace (GetCode (Resstr, "charset= ([^\" "].*" ""), Chr (10), "" "
Getresstr=bytestobstr (Http.responsebody,trim (Pagecode))
End If
End If
End Function
' Function name: bytestobstr
' Function: Convert binary data to characters
' Parameters: body-binary data, cset-text encoding method
Function Bytestobstr (Body, cset)
Dim objstream
Set objstream = Server.CreateObject ("ADODB.stream")
Objstream. Type = 1
Objstream. Mode = 3
Objstream. Open
Objstream. Write body
Objstream. Position = 0
Objstream. Type = 2
Objstream. Charset = Cset
Bytestobstr = objstream. ReadText
Objstream. Close
Set objstream = Nothing
End Function
' Function name: GetCode
' function: Convert binary to character
' Parameters: str-to query string, regstr-regular expression
Function GetCode (STR, REGSTR)
Dim Reg
Set reg= new REGEXP
Reg.ignorecase = True
Reg.multiline = True
Reg.pattern =regstr
Set Cols = Reg.execute (str)
Str=cols (0). Submatches (0)
Getcode=str
End Function
%>