原文
<!--#include file="conn.asp"-->
<%
Dbmdb_Urls=Session("Dbmdb_Urls")
dim conn
dim connstr
dim db
db=Dbmdb_Urls
Set conn = Server.CreateObject("ADODB.Connection")
connstr="Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & Server.MapPath(db)
conn.Open connstr
On error resume next
function CloseDatabase
Conn.close
Set conn = Nothing
End Function
Response.Expires = -1
Response.ExpiresAbsolute = Now() - 1
Response.cachecontrol = "no-cache"
%>
<HTML>
<HEAD>
<TITLE>关键字词管理</TITLE>
<STYLE>
TD{FONT-SIZE: 9pt}
</STYLE>
<%
Yid=trim(request.form("Yid"))
Jsyid=trim(request.form("Jsyid"))
if trim(request.form("Gjc"))="" then
Gjc=request("Gjc")
else
Gjc=trim(request.form("Gjc"))
end if
if request("Yid")="" then
response.write "<SCRIPT language=JavaScript>alert('抓取关连词起始ID不能为空');location.replace(""?抓取关连词起始ID不能为空！"");</SCRIPT>"
Response.End
end if
if request("Jsyid")="" then
response.write "<SCRIPT language=JavaScript>alert('抓取关连词结束ID不能为空');location.replace(""?抓取关连词结束ID不能为空！"");</SCRIPT>"
Response.End
end if
'if request("Yid")>request("Jsyid")
then
'response.write "<SCRIPT language=JavaScript>alert('抓取关连词起始ID不能大于结束ID');location.replace(""?抓取关连词起始ID不能大于结束ID！"");</SCRIPT>"
'Response.End
'end if
set rs = server.createobject ("adodb.recordset")
rs.open "select * from Y where Yid="&request("Yid")&"",conn,1,3
if not Rs.eof then
Y=rs("Y")
rs("Yrq")=now
rs.update
end if
rs.close
response.write "<SPAN STYLE=""font-size: 9pt"">正在抓取“"&Y&"”的关连词（黑色表示录入成功，红色表示数据库已有记录不重复录入）：</SPAN><br><br>"
Server.ScriptTimeOut=120
on error resume next
url="http://d.baidu.com/rs.php?q="&Y&"&tn=baidu"
softcode=getHTTPPage(url)
if err.number=0 then
start=Instr(softcode,"<HTML>")
over=Instr(softcode,"</html>")
musicOverId=ubound(Split(mid(softcode,start,over-start),"<li class=ls>"))-1
if musicOverId<>"" then
for MusicStartID=1 to Gjc
start=Instr(softcode,"<li class=ls>"&MusicStartID&"</li>")
if musicOverId=musicOverId then
over=Instr(softcode,"</body>")
else
over=Instr(softcode,"<li class=ls>"&MusicStartID+1&"</li>")
end if
Txt=mid(softcode,start,over-start)
start=Instr(Txt,"tn=baidur>")+10
over=Instr(Txt,"</a>")
Txts=mid(Txt,start,over-start)
if Txts="" then
else
Set Rs = Server.CreateObject("ADODB.RecordSet")
Rs.Open "select * from E where E = '"&Txts&"'",Conn,1,3
If Rs.Eof Then
Rs.Addnew
Rs("E")=Txts
Rs("Yid")=request("Yid")
Eid=rs("Eid")
Rs.Update
response.write "<SPAN STYLE=""font-size: 9pt"">"&MusicStartID&"."&Txts&"("&Eid&")</SPAN><BR>"
Else
response.write "<SPAN STYLE=""font-size: 9pt""><FONT COLOR=#FF0000>"&MusicStartID&"."&Txts&"</SPAN><BR></FONT>"
End If
end if
NEXT
wscript.echo err.description
end if
end if
function getHTTPPage(url)
on error resume next
dim http
set http=Server.createobject("Microsoft.XMLHTTP")
Http.open "GET",url,false
Http.send()
if Http.readystate<>4 then
exit function
end if
getHTTPPage=bytes2BSTR(Http.responseBody)
set http=nothing
if err.number<>0 then err.Clear
end function
Function bytes2BSTR(vIn)
dim strReturn
dim i1,ThisCharCode,NextCharCode
strReturn = ""
For i1 = 1 To LenB(vIn)
ThisCharCode = AscB(MidB(vIn,i1,1))
If ThisCharCode < &H80 Then
strReturn = strReturn & Chr(ThisCharCode)
Else
NextCharCode = AscB(MidB(vIn,i1+1,1))
strReturn = strReturn & Chr(CLng(ThisCharCode) * &H100 + CInt(NextCharCode))
i1 = i1 + 1
End If
Next
bytes2BSTR = strReturn
End Function
if request("Yid")=request("Jsyid") then
response.write "<SCRIPT language=JavaScript>alert('抓取关连词操作成功');location.replace(""Gjzcgl.asp?Zid="&request("Zid")&""");</SCRIPT>"
Response.End
Else
response.write "<script language=JavaScript>{window.location.href='"
response.write "?Yid="&request("Yid")+1&"&Jsyid="&request("Jsyid")&"&Gjc="&request("Gjc")&"&Zid="&request("Zid")
response.write "'}</script>"
Response.End
End If
%>
