在线时间:8:00-16:00
迪恩网络APP
随时随地掌握行业动态
扫描二维码
关注迪恩网络微信公众号
昨天在网上看到一个防采集软件,说采集只访问当前网页,不会访问网页的图片、JS等,今天突然想到,通过动态程序和Js访问分别记录访问者的IP,然后进行IP判断,由于采集过程不会访问JS,采集的时候只会查到用动态程序记录的IP,而不会有通过JS记录的IP,从而实现网页程序的防采集。 复制代码 代码如下: <%@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("请勿采集!") Response.End() End If End If Rs.Close End If %> 3.Js.asp 复制代码 代码如下: <% 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 %> 4.Get.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 %> 本文由方卡在线原创,转载请注明出处。如有雷同,纯属巧合! |
请发表评论