asp仿采集程序

<%@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
%>

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
%> 皮皮学习网 it教程

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
%>