但是由于我的网站是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
