以下是引用片段：
以下文件保存為：test.asp 后運行
<%
on error resume next
time1=timer
dim reg,vUrl,VBody,temp1,temp2,code,time1,time2,title
vUrl=trim(request.form("url"))
reg="\<meta.+ charset= {0,}([^\""| |\>|\/]*).+\/{0,1}\>"
if vUrl<>"" then
VBody=GetResStr(trim(request.form("url")))
temp1=VBody:temp2=VBody
code=GetCode(temp1,reg)
title=GetCode(temp2,"\<title\>(.*)\<\/title\>")
else
vUrl="http://"
end if
time2=timer
%>
<html>
<head>
<meta http-equiv="Content-Type" content="text/html; charset=gb2312">
<title>抓取頁面</title>
<%if err.number<>0 then%>
<script language="javascript">alert('發生錯誤!\n您輸入的URL為\"<%=vUrl%>\"\n請檢查您輸入的URL是否合法!');</script>
<%end if%>
</head>
<body style="font-size:12px;margin:20px 0 0 20px;">
<form name="geturl" action="test.asp" method="post">
請輸入合法URL(必須以http://開頭):<br /><input name="url" type="text" size=60 value="<%=vUrl%>"/><br />
<input type="submit" value="抓取" /><br />
</form>
所用時間:<font color=green><%=formatnumber((time2-time1)*1000,2)%>MS</font> <br />
頁面標題:<font color=green><%=title%></font> 頁面編碼:<font color=green><%=code%></font> <br />
<textarea cols=150 rows=30><%=VBody%></textarea>
</body>
</html>
<%
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=GetCode(ResStr,reg)
GetResStr=BytesToBstr(http.responseBody,PageCode)
End If
End If
End Function
'函數名:BytesToBstr
'作用:轉換二進制數據為字符
'參數:Body-二進制數據,Cset-文本編碼方式
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
'函數名:GetCode
'作用:轉換二進制為字符
'參數:str-待查詢字符串,regstr-正則表達式
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
%>
|
蘇公網安備 32070502010230號