huoqu.asp

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

<%
Datas123="DataDatas/Data123sasdasd.asa11111111111.mdb"
set dsns1=server.createobject("adodb.connection")    
dsns1.open "DBQ="&Server.MapPath(""&Datas123&"")&";Driver={Microsoft Access Driver (*.mdb)}"    
%>
<%'转换。。。。。。。。。。。。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) To 1 Step -1

M = Instr(NewCont(I),Chr(34)) 
NewCont(I) = Left(NewCont(I),M-1) 
if Instr(GetAddress&NewCont(I), "baidutop10")>0 then




set rstping=server.createobject("adodb.recordset")
sqlping="select * from Ckk_BaiDu Where Key='"&replace(replace(URLDecode(replace(GetAddress&NewCont(I),"http://www.baidu.com/baidu?cl=3&amp;tn=baidutop10&amp;wd=","")),"