[转]ASP实现关键词获取(各搜索引擎,GB2312及UTF-8)

不知道为什么现在各大搜索引擎编码居然不一样.当然不是GB2312就是UTF-8了.编码问题是比较头疼的问题...头疼的不要命...
 我们获得关键词,一般是通过来访页面的url进行分析的.比如
 http://www.google.com/search?hl=zh-CN&q=%E5%AD%A4%E7%8B%AC&lr=
 各位肯定知道这个是通过urlencode编码的.
 我们得到其中的信息,需要进行2步.第一步是进行urldecode,在我们普通参数活得的时候,这个是由ASP自己来进行的,但是现在我们不得不进行手工解码.
 网上函数很多,但都是针对于GB2312页面解GB2312.UTF-8的.对于这个,我们可以很轻松的先进行解码,然后根据搜索引擎判断它的编码,如果是UTF-8就再转换为GB2312.
 但是由于我的网站是UTF-8页面的.而UTF-8页面我找到的只有解UTF-8字符的urldecode编码的.在这里停顿了很久,最后我只能用最糟糕的方法,把拆分出来的关键词用xmlhttp提交到一个GB2312的ASP页面,然后活得乱码(GB2312)后再进行GB2312 to UTF-8的转换.
 下面主要实现代码.
 Public Function GetSearchKeyword(RefererUrl) ’搜索关键词
  if RefererUrl="" or len(RefererUrl)<1 then exit function
   on error resume next
   Dim re
   Set re = New RegExp
   re.IgnoreCase = True
   re.Global = True
   Dim a,b,j
   ’模糊查找关键词，此方法速度较快，范围也较大
   re.Pattern = "(word=([^&]*)|q=([^&]*)|p=([^&]*)|query=([^&]*)|name=([^&]*)|_searchkey=([^&]*)|baidu.*?w=([^&]*))"
   Set a = re.Execute(RefererUrl)
   If a.Count>0 then
    Set b = a(a.Count-1).SubMatches
    For j=1 to b.Count
     If Len(b(j))>0 then 
      if instr(1,RefererUrl,"google",1) then 
        GetSearchKeyword=Trim(U8Decode(b(j)))
       elseif instr(1,refererurl,"yahoo",1) then 
        GetSearchKeyword=Trim(U8Decode(b(j)))
       elseif instr(1,refererurl,"yisou",1) then
        GetSearchKeyword=Trim(getkey(b(j)))
       elseif instr(1,refererurl,"3721",1) then
        GetSearchKeyword=Trim(getkey(b(j)))
       else 
        GetSearchKeyword=Trim(getkey(b(j)))
      end if
      Exit Function
     end if
    Next
   End If
   if err then
   err.clear
   GetSearchKeyword = RefererUrl
   else
   GetSearchKeyword = ""  
   end if  
  End Function
  Function URLEncoding(vstrIn)
   dim strReturn,i,thischr
     strReturn = ""
     For i = 1 To Len(vstrIn)
         ThisChr = Mid(vStrIn,i,1)
         If Abs(Asc(ThisChr)) < &HFF Then
             strReturn = strReturn & ThisChr
         Else
             innerCode = Asc(ThisChr)
             If innerCode < 0 Then
                 innerCode = innerCode + &H10000
             End If
             Hight8 = (innerCode  And &HFF00)\ &HFF
             Low8 = innerCode And &HFF
             strReturn = strReturn & "%" & Hex(Hight8) &  "%" & Hex(Low8)
         End If
     Next
     URLEncoding = strReturn
 End Function
 function getkey(key)
 dim oreq
 set oreq = CreateObject("MSXML2.XMLHTTP")
 oReq.open "POST","http://&qu

[转]ASP实现关键词获取(各搜索引擎,GB2312及UTF-8)

浏览过的版块