<%@ Language=VBScript %>
<%
' 从URL中获取关键词
function findKeystr(urlstr)
dim regEx,vKey,vP,findKeystr1
findkeystr=""
vP = "(?:yahoo.+?[\?|&]p=|openfind.+&q=|google.+[\?|&]q=|lycos.+?query=|aol.+?query=|onseek.+?keyword=|search\.tom.+?word=|search\.qq\.com.+?word=|zhongsou\.com.+?word=|search\.msn\.com.+?q=|yisou\.com.+?p=|sina.+?word=|sina.+?query=|sina.+?_searchkey=|sohu.+?word=|sohu.+?key_word=|sohu.+?query=|163.+?q=|baidu.+[\?|&]wd=|3721\.com.+?name=|Alltheweb.+?q=)([^&]*)"
set regEx=new regexp
regEx.Global = true
regEx.IgnoreCase = true
regEx.Pattern = vP
set Matches = regEx.Execute(urlstr)
for each Match in Matches
' 没有使用subMatches是因为有的服务器可能并没有安装VBS5.5版本
findKeystr1 = regEx.replace(Match.value,"$1")
next
if findKeystr1<> "" then
findkeystr=lcase(decodeURI(findkeystr1))
if findkeystr = "undefined" then
findkeystr = URLDecode(findKeystr1)
end if
end if
end function
' 解开URL编码的函数(这是别人写的,我查到的地方标注为: 来源: CSDN 作者: dyydyy )
Function URLDecode(enStr)
dim deStr
dim c,i,v
deStr=""
for i=1 to len(enStr)
c=Mid(enStr,i,1)
if c="%" then
v=eval("&h"+Mid(enStr,i+1,2))
if v<128 then
deStr=deStr&chr(v)
i=i+2
else
if isvalidhex(mid(enstr,i,3)) then
if isvalidhex(mid(enstr,i+3,3)) then
v=eval("&h"+Mid(enStr,i+1,2)+Mid(enStr,i+4,2))
deStr=deStr&chr(v)
i=i+5
else
v=eval("&h"+Mid(enStr,i+1,2)+cstr(hex(asc(Mid(enStr,i+3,1)))))
deStr=deStr&chr(v)
i=i+3
end if
else
destr=destr&c
end if
end if
else
if c="+" then
deStr=deStr&" "
else
deStr=deStr&c
end if
end if
next
URLDecode=deStr
end function
function isvalidhex(str)
isvalidhex=true
str=ucase(str)
if len(str)<>3 then isvalidhex=false:exit function
if left(str,1)<>"%" then isvalidhex=false:exit function
c=mid(str,2,1)
if not (((c>="0") and (c<="9")) or ((c>="A") and (c<="Z"))) then isvalidhex=false:exit function
c=mid(str,3,1)
if not (((c>="0") and (c<="9")) or ((c>="A") and (c<="Z"))) then isvalidhex=false:exit function
end function