Baidu搜索小偷ASP完美版

< %
' --------------------------------
' Baidu搜索小偷ASP完美版
' 作者：勇敢的风
' Blog：http://feng.cnblog.com.cn
' 使用或转载请保留这些信息
'    Var VBScript 1.0
'          2006.3
' 由于Baidu经常修改界面，该版仅适用于2006年3月之前的最后一次该版
' 如搜索时出现错误或者提取的内容混乱则表示该版本寿命已用尽。
' --------------------------------
Function  bytes2BSTR(vIn)
  strReturn  =   ""
   For  i  =   1   To  LenB(vIn)
    ThisCharCode  =  AscB(MidB(vIn,i, 1 ))
     If  ThisCharCode  <   & H80  Then
      strReturn  =  strReturn  &   Chr (ThisCharCode)
     Else
      NextCharCode  =  AscB(MidB(vIn,i + 1 , 1 ))
      strReturn  =  strReturn  &   Chr ( CLng (ThisCharCode)  *   & H100  +   CInt (NextCharCode))
      i  =  i  +   1
     End   If
   Next
  bytes2BSTR  =  ubb(strReturn)
End Function

Function  dq(key)
   dim  XmlHttp
   set  XmlHttp  =   CreateObject ( " Microsoft.XMLHTTP " )
  XmlHttp.Open  " GET " , " http://www.baidu.com/s?wd= " & key & " &pn= " & request( " pn " ),  false
  XmlHttp.setRequestHeader  " Content-Type " , " text/XML "
  XmlHttp.Send
  dq  =  bytes2BSTR(XmlHttp.responseBody)
End Function

Function  BR(Str)
  Str  =   Replace (Str, " {br} " , " <br> " )
  Str  =   Replace (Str,vbcrlf, " <br> " )
  Str  =   Replace (Str, " <br> <br> " , " <br> " )
  Str  =   Replace (Str, " <br><br> " , " <br> " )
  Str  =   Replace (Str, " <br><br> " , " <br> " )
  BR  =  Str
End Function


function  ubb(str)

   if   instr (str, " 找到相关网页 " )  =   0   then
    ubb  =   " 没有搜索到任何内容 "
     exit   function
   end   if


str  =   Replace (str,vbcrlf, " {br} " )
  str  =   Replace (str, " <br> " , " {br} " )
  str  =   Replace (str, " </td> " , " </td> " & vbcrlf)
  str  =   Replace (str, " <td " ,vbcrlf & " <td " )

   dim  re,Match,Matches
   set  re  =   New  RegExp
    re.Global  =   True
    re.IgnoreCase  =   True

  re.Pattern = " .*<td class=f>(.*)</td> "

   Set  Matches  =  re.Execute(str)

   For   Each  Match in Matches
    ubb = ubb & BR(Match.value)
   next
  re.Pattern = " (- <a .[^<]*>百度快照</a>) "
  ubb  =  re.replace(ubb, "" )
  re.Pattern = " (<a class=""m"".[^<]*>.[^<]*</a>) "
  ubb  =  re.replace(ubb, "" )
  re.Pattern = " (<font color=#008000>.[^<]*</font>) "
  ubb  =  re.replace(ubb, " <hr> " )  ' 每一条信息的间隔
  ubb  =   Replace (ubb, " <td class=f> " , "" )
  ubb  =   Replace (ubb, " </td> " , "" )
  ubb  =  BR(UBB)

 

  re.Pattern = " (找到相关网页.*秒) "
   Set  Matches  =  re.Execute(str)
   set  Match  =  Matches( 0 )
  ubb  =  ubb  &  Match  &   " <br> "

  str  =   Replace (str, " </div> " , " </div> " & vbcrlf)
 

  re.Pattern = " <div class=""p"">(.*)</div> "
   Set  Matches  =  re.Execute(str)
   set  Match  =  Matches( 0 )
   Dim  TheLink
  TheLink  =  Match
  re.Pattern = " href=s?(.[^>]*) "
  TheLink  =  re.replace(TheLink, " href=""$1"" " )

  ubb  =  ubb  &  TheLink
end function

if   len (request( " wd " ))  >   0   then
  response.write dq(request( " wd " ))
end   if
% >
< form method = post action = " ? " >
< input type = " text "  name = " wd " >   < input type = " submit " >
</ form >

 
<script type="text/javascript"> </script><script type="text/javascript" src="http://pagead2.googlesyndication.com/pagead/show_ads.js"> </script>