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

　　<%@LANGUAGE="VBSCRIPT" CODEPAGE=""%>
<%
ResponseWrite(ServerHTMLEncode(GetHttpPage("教程""GB")))
==============================
函 數 名GetHttpPage
作 用獲取頁面源代碼函數
參 數網址HttpUrl
==============================
Function GetHttpPage(HttpUrlCode)
If IsNull(HttpUrl)=True Or HttpUrl="" Then
GetHttpPage="A站點維護中！"
Exit Function
End If
On Error Resume Next
Dim Http
Set Http=servercreateobject("MSX"&"MLXML"&"HTTP")
Httpopen "GET"HttpUrlFalse
HttpSend()
If HttpReadystate<> then
Set Http=Nothing
GetHttpPage="B站點維護中！"
Exit function
End if
GetHttpPage=BytesToBSTR(HttpresponseBodyCode)
Set Http=Nothing
If Errnumber<> then
ErrClear
GetHttpPage="C站點維護中！"
Exit function
End If
End Function
==============================
函 數 名BytesToBstr
作 用轉換編碼函數
參 數字符串Body編碼Cset
==============================
Function BytesToBstr(BodyCset)
Dim Objstream
Set Objstream = ServerCreateObject("ado"&"d"&"bst"&"re"&"am")
ObjstreamType =
ObjstreamMode =
ObjstreamOpen
ObjstreamWrite body
ObjstreamPosition =
ObjstreamType =
ObjstreamCharset = Cset
BytesToBstr = ObjstreamReadText
ObjstreamClose
set Objstream = nothing
End Function
%>
<%
Dim ConnRsSqlstrIp
Set Conn = ServerCreateObject("AdodbConnection")
Set Rs=ServerCreateobject("AdodbRecordSet")
ConnStr="Provider=MicrosoftJetOLEDB;Data Source=" & ServerMapPath("Datamdb")
ConnOpen ConnStr
Ip=RequestServerVariables("REMOTE_ADDR")
Sqlstr="Select * From [Ip]"
RsOpen SqlstrConn
ApplicationLock()
RsAddNew()
Rs("Ip_Address")=Ip
RsUpdate()
ApplicationUnLock()
RsClose
%>
<%@LANGUAGE="VBSCRIPT" CODEPAGE=""%>
<%
Dim ConnRsSqlstrIpIpTimeIpTimeNewUser
NewUser=
Set Conn = ServerCreateObject("AdodbConnection")
Set Rs=ServerCreateobject("AdodbRecordSet")
ConnStr="Provider=MicrosoftJetOLEDB;Data Source=" & ServerMapPath("Datamdb")
ConnOpen ConnStr
Ip=RequestServerVariables("REMOTE_ADDR")
Sqlstr="Select * From [Ip] Where Ip_Address="&Ip&" Order By Ip_Id Desc"
RsOpen SqlstrConn
If RsEof Then
NewUser=
ApplicationLock()
RsAddNew()
Rs("Ip_Address")=Ip
RsUpdate()
ApplicationUnLock()
Else
IpTime=Rs("Ip_Time")
ApplicationLock()
RsAddNew()
Rs("Ip_Address")=Ip
RsUpdate()
ApplicationUnLock()
End If
RsClose
If NewUser= Then
Sqlstr="Select * From [Ip] Where Ip_Address="&Ip&" Order By Ip_Id Desc"
RsOpen SqlstrConn
If RsEof Then
RsClose
ResponseWrite("請勿采集！")
ResponseEnd()
Else
IpTime=Rs("Ip_Time")
If DateDiff("s"IpTimeIpTime)> Then
RsClose
ResponseWrite("教程提示你請采集！")
ResponseEnd()
End If
End If
RsClose
End If
%>

From:http://tw.wingwit.com/Article/program/net/201311/13898.html