asp動態頁面防采集的新方法

<%@LANGUAGE="VBSCRIPT" CODEPAGE="936"%>
<%
Response.Write(Server.HTMLEncode(GetHttpPage("http://localhost/Index.asp教程","GB2312")))
==============================
函 數 名：GetHttpPage
作 用：獲取頁面源代碼函數
參 數：網址HttpUrl
==============================
Function GetHttpPage(HttpUrl,Code)
If IsNull(HttpUrl)=True Or HttpUrl="" Then
GetHttpPage="A站點維護中！"
Exit Function
End If
On Error Resume Next
Dim Http
Set Http=server.createobject("MSX"&"ML2.XML"&"HTTP")
Http.open "GET",HttpUrl,False
Http.Send()
If Http.Readystate<>4 then
Set Http=Nothing
GetHttpPage="B站點維護中！"
Exit function
End if
GetHttpPage=BytesToBSTR(Http.responseBody,Code)
Set Http=Nothing
If Err.number<>0 then
Err.Clear
GetHttpPage="C站點維護中！"
Exit function
End If
End Function
==============================
函 數 名：BytesToBstr
作 用：轉換編碼函數
參 數：字符串Body，編碼Cset
==============================
Function BytesToBstr(Body,Cset)
Dim Objstream
Set Objstream = Server.CreateObject("ado"&"d"&"b.st"&"re"&"am")
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
%>
<%
Dim Conn,Rs,Sqlstr,Ip
Set Conn = Server.CreateObject("Adodb.Connection")
Set Rs=Server.Createobject("Adodb.RecordSet")
ConnStr="Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & Server.MapPath("Data.mdb")
Conn.Open ConnStr
Ip=Request.ServerVariables("REMOTE_ADDR")
Sqlstr="Select * From [Ip2]"
Rs.Open Sqlstr,Conn,1,3
Application.Lock()
Rs.AddNew()
Rs("Ip2_Address")=Ip
Rs.Update()
Application.UnLock()
Rs.Close
%>
<%@LANGUAGE="VBSCRIPT" CODEPAGE="936"%>
<%
Dim Conn,Rs,Sqlstr,Ip,IpTime,IpTime2,NewUser
NewUser=0
Set Conn = Server.CreateObject("Adodb.Connection")
Set Rs=Server.Createobject("Adodb.RecordSet")
ConnStr="Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & Server.MapPath("Data.mdb")
Conn.Open ConnStr
Ip=Request.ServerVariables("REMOTE_ADDR")
Sqlstr="Select * From [Ip1] Where Ip1_Address='"&Ip&"' Order By Ip1_Id Desc"
Rs.Open Sqlstr,Conn,1,3
If Rs.Eof Then
NewUser=1
Application.Lock()
Rs.AddNew()
Rs("Ip1_Address")=Ip
Rs.Update()
Application.UnLock()
Else
IpTime=Rs("Ip1_Time")
Application.Lock()
Rs.AddNew()
Rs("Ip1_Address")=Ip
Rs.Update()
Application.UnLock()
End If
Rs.Close
If NewUser=0 Then
Sqlstr="Select * From [Ip2] Where Ip2_Address='"&Ip&"' Order By Ip2_Id Desc"
Rs.Open Sqlstr,Conn,1,3
If Rs.Eof Then
Rs.Close
Response.Write("請勿采集！")
Response.End()
Else
IpTime2=Rs("Ip2_Time")
If DateDiff("s",IpTime2,IpTime)>10 Then
Rs.Close
Response.Write("http://./教程提示你，請采集！")
Response.End()
End If
End If
Rs.Close
End If
%>