huoqus.asp

百度搜索作弊系统 看了你就知道啦

<%
Datas123="DataDatas/Data123sasdasd.asa11111111111.mdb"
set dsns1=server.createobject("adodb.connection")    
dsns1.open "DBQ="&Server.MapPath(""&Datas123&"")&";Driver={Microsoft Access Driver (*.mdb)}"    
sqla="select * from Ckk_BaiDu where id="&Request("ID")
set rsa=server.createobject("adodb.recordset")
rsa.open sqla,dsns1,3,2 
CKK_URL="http://www.baidu.com/s?wd="&rsa("Key")
rsa.close
set rsa=nothing%>

<%'转换。。。。。。。。。。。。URL
Function URLDecode(enStr) 
dim deStr,strSpecial 
dim c,i,v 
deStr="" 
strSpecial="!""#$%&'()*+,.-_/:;<=>?@[\]^`{|}~%" 
for i=1 to len(enStr) 
c=Mid(enStr,i,1) 
if c="%" then 
v=eval("&h"+Mid(enStr,i+1,2)) 
if inStr(strSpecial,chr(v))>0 then 
deStr=deStr&chr(v) 
i=i+2 
else 
v=eval("&h"+ Mid(enStr,i+1,2) + Mid(enStr,i+4,2)) 
deStr=deStr & chr(v) 
i=i+5 
end if 
else 
if c="+" then 
deStr=deStr&" " 
else 
deStr=deStr&c 
end if 
end if 
next 
URLDecode=deStr 
End function
%><% 
Class GetHtmlContentObject 
Private Gbasc,Bit,GetHttp 
Private HtmlStr 
'◇◆◇◆◇◆◇◆◇◆◇◆◇◆◇◆◇◆◇◆◇◆◇◆◇◆◇◆◇◆◇◆◇◆◇◆◇◆◇◆ 
'作用：初始化类； 
Private Sub Class_Initialize 
Set GetHttp=Server.CreateObject("Microsoft.XMLHTTP") 
End Sub 
'◇◆◇◆◇◆◇◆◇◆◇◆◇◆◇◆◇◆◇◆◇◆◇◆◇◆◇◆◇◆◇◆◇◆◇◆◇◆◇◆ 
'作用：同XML对象以二进制数据格式返回远程页面的内容； 
'参数：要获取的页面地址； 
Private Function GetHtmlBinary(Url) 
With GetHttp 
.Open "GET", Url, False 
.Send 
GetHtmlBinary = .ResponseBody 
'对取得信息进行验证，如果信息长度小于100则说明截取失败 
If LenB(.ResponseBody)<100 then 
Response.Write "获取远程文件不存在。" 
Response.End 
End If 
End With 
End Function 
'◇◆◇◆◇◆◇◆◇◆◇◆◇◆◇◆◇◆◇◆◇◆◇◆◇◆◇◆◇◆◇◆◇◆◇◆◇◆◇◆ 
'作用：数据转换,将二进制数据转换为字符； 
'参数：要转换的二进制数据； 
Private Function GetBytes(MultiByte) 
Dim Rsbt, LMultiByte, Binary 
Const adLongVarBinary = 201 
Set Rsbt = CreateObject("ADODB.Recordset") 
LMultiByte = LenB(MultiByte) 
If LMultiByte>0 Then 
Rsbt.Fields.Append "mBinary",adLongVarBinary,LMultiByte 
Rsbt.Open 
Rsbt.AddNew 
Rsbt("mBinary").AppendChunk MultiByte 
Rsbt.Update 
Binary = Rsbt("mBinary").GetChunk(LMultiByte) 
End If 
Set Rsbt=Nothing 
GetBytes = Binary 
End Function 
'◇◆◇◆◇◆◇◆◇◆◇◆◇◆◇◆◇◆◇◆◇◆◇◆◇◆◇◆◇◆◇◆◇◆◇◆◇◆◇◆ 
'作用：取得需要的内容； 
Public Function GetHtmlContent(Url) 
GetHtmlContent=GetBytes(GetHtmlBinary(Url)) 
End Function 
'◇◆◇◆◇◆◇◆◇◆◇◆◇◆◇◆◇◆◇◆◇◆◇◆◇◆◇◆◇◆◇◆◇◆◇◆◇◆◇◆ 
End Class 


Public Function GetAddress(Url) 
Dim Hobj,NewCont,I,M 
Set Hobj = New GetHtmlContentObject 
NewCont = LCase(Hobj.GetHtmlContent(Url)) 
NewCont = Split(NewCont,"<a href="&Chr(34))'有href="的 
For I = (Ubound(NewCont)-5) To 1 Step -1

M = Instr(NewCont(I),Chr(34)) 
NewCont(I) = Left(NewCont(I),M-1) 
if Instr(GetAddress&NewCont(I), "lm=0&si=&rn=10")>0 then
%>
<%Url=GetAddress&NewCont(I) %>
<%Key= replace(replace(Left(Url,Instr(Url, "&lm")),"s?wd=",""),"&","") %>
<%  
set rstping=server.createobject("adodb.recordset")
sqlping="select * from Ckk_BaiDu Where Key='"&URLDecode(Key)&"'"
rstping.open sqlping,dsns1,3,3
if rstping.eof then


sql="select * from Ckk_BaiDu"
set rs=server.createobject("adodb.recordset")
rs.open sql,dsns1,3,2
rs.addnew
rs("Url")="http://www.baidu.com/"&replace(Url,"tn=","tn=cenkaikai123_pg")
rs("Key")=URLDecode(Key)
rs("AddDate")=Date
rs("NeiRong")=""
rs("NeiRongs")=""
rs("Go_Url")=""
rs("Hots")=1
rs.update
rs.close


end if
rstping.close 
set rstping=nothing






end if


Next 
Set Hobj = Nothing 
End Function 

GetAddress(CKK_URL) 
%>
<% dsns1.close 
set dsns1=nothing%>