通过referer url获取用户在搜索引擎中输入的关键字和关键字所在页数[asp]

首先必须分析referer url中哪部分是关键字，哪部分是页数。例如在hao123输入关键字"我们"，在搜索结果中的第7页访问你的网站，那么来源的url就是:http://www.baidu.com/s?lm=0&si=&rn=10&tn=sitehao123&ie=gb2312&ct=0&wd=%CE%D2%C3%C7&pn=60&cl=3
上面的url中,wd=%CE%D2%C3%C7就是关键字部分，其中%CE%D2%C3%C7是"我们"两字通过urlencode得到的CED2是"我"字的GB编码,C3C7是"们"字的GB编码,只要使用urlDecode我们就可以得到原来用户输入了什么关键字访问了自己的网站。而pn=60则是你网站所在的页数，百度是每页10条记录，因此pn=0就是第一页，pn=60是第7页。若url中没有pn部分，则表示是第一页。一般来说，百度对关键字是使用GB编码(如"我们"二字编码成%CE%D2%C3%C7),除非url中含有ie=utf8，那么将采用utf8对关键字编码("我们"二字将编译成%E6%88%91%E4%BB%AC)。相对于百度，google则默认采用utf8对关键字编码,那么就需要将utf8编码转为unicode再通过chrw还原为原来的文字。

一下列出各个搜索引擎的关键字和页数的String表示

名称	关键字String	页数String
www.baidu	wd/word	pn
image.baidu	word	pn
cache.baidu	word	pn
tom	word	pn
sou.china	query	pgNum
sogou	query	page
114.vnet	kw	start
seek.3721	name/p	page
sj53	wd	pn
iask	k	p

------------------------------------上面为多数采用gb对关键字进行编码,下面为多数采用utf8对关键字进行编码

yahoo	p	b
google	q	start
baidugoo	Keyword	pn
search.msn	q	first

以上只是大致的结果，其实还有很多细致的地方，需要大家自己去发现，我不多说了。

下面是原程序

 

<%
function shortAgent(agentString)
shortAgent="Other"
if instr(agentString,"MSIE")>=1 then
shortAgent=mid(agentString,instr(agentString,"MSIE"),8)
end if
if instr(agentString,"Opera")>=1 then
shortAgent="Opera"
end if
end function
%>
<%
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

function getKw(URLString,kwString)
getKw=""
kwString=kwString&"="
kwArray=split(URLString,"&")
for i=0 to UBound(kwArray)
kwStart=instr(kwArray(i),kwString)
if kwStart=1 then
getKw=mid(kwArray(i),kwStart+len(kwString),len(kwArray(i)))
end if
next
end function

function getPn(URLString,pnString)
getPn=0
pnString=pnString&"="
pnArray=split(URLString,"&")
for i=0 to UBound(pnArray)
pnStart=instr(pnArray(i),pnString)
if pnStart=1 then
getPn=mid(pnArray(i),pnStart+len(pnString),len(pnArray(i)))
end if
next
end function

function calculatePn(pn_tmp,pn_type,pn_beg,pn_base)
if pn_type=0 then
if pn_tmp=0 then pn_tmp=1
calculatePn=pn_tmp
else
if pn_beg=0 then calculatePn=Int((pn_tmp+1)/pn_base)+1
if pn_beg=1 then calculatePn=Int(pn_tmp/pn_base)+1
end if
end function
%>
<%
function UTF2GB(UTFStr)

for Dig=1 to len(UTFStr)
'如果UTF8编码文字以%开头则进行转换
if mid(UTFStr,Dig,1)="%" then
'UTF8编码文字大于8则转换为汉字
if len(UTFStr) >= Dig+8 then
GBStr=GBStr & ConvChinese(mid(UTFStr,Dig,9))
Dig=Dig+8
else
GBStr=GBStr & mid(UTFStr,Dig,1)
end if
else
GBStr=GBStr & mid(UTFStr,Dig,1)
end if
next
UTF2GB=GBStr
end function

'UTF8编码文字将转换为汉字
function ConvChinese(x)
A=split(mid(x,2),"%")
i=0
j=0
for i=0 to ubound(A)
A(i)=c16to2(A(i))
' Response.Write(A(i)&"<br/>")
next
for i=0 to ubound(A)-1
DigS=instr(A(i),"0")
Unicode=""
for j=1 to DigS-1
if j=1 then
A(i)=right(A(i),len(A(i))-DigS)
Unicode=Unicode & A(i)
else
i=i+1
A(i)=right(A(i),len(A(i))-2)
Unicode=Unicode & A(i)
end if
'Response.Write(Unicode&"<br/>")
next
'Response.Write(c2to16(Unicode))
if len(c2to16(Unicode))=4 then
ConvChinese=ConvChinese & chrw(int("&H" & c2to16(Unicode)))
else
ConvChinese=ConvChinese & chr(int("&H" & c2to16(Unicode)))
end if
next
end function

'二进制代码转换为十六进制代码
function c2to16(x)
i=1
for i=1 to len(x) step 4
c2to16=c2to16 & hex(c2to10(mid(x,i,4)))
next
end function

'二进制代码转换为十进制代码
function c2to10(x)
c2to10=0
if x="0" then exit function
i=0
for i= 0 to len(x) -1
if mid(x,len(x)-i,1)="1" then c2to10=c2to10+2^(i)
next
end function

'十六进制代码转换为二进制代码
function c16to2(x)
i=0
for i=1 to len(trim(x))
tempstr= c10to2(cint(int("&h" & mid(x,i,1))))
do while len(tempstr)<4
tempstr="0" & tempstr
loop
c16to2=c16to2 & tempstr
next
end function

'十进制代码转换为二进制代码
function c10to2(x)
mysign=sgn(x)
x=abs(x)
DigS=1
do
if x<2^DigS then
exit do
else
DigS=DigS+1
end if
loop
tempnum=x

i=0
for i=DigS to 1 step-1
if tempnum>=2^(i-1) then
tempnum=tempnum-2^(i-1)
c10to2=c10to2 & "1"
else
c10to2=c10to2 & "0"
end if
next
if mysign=-1 then c10to2="-" & c10to2
end function
%>
<%
function resolveRef(URLStringAll)
URLString=split(URLStringAll,"?")(1)
URLHead=split(URLStringAll,"?")(0)
if instr(URLHead,"http://www.baidu.com")>=1 or instr(URLHead,"http://www1.baidu.com")>=1 then
if getKw(URLString,"wd")="" then
kw=URLDecode(getKw(URLString,"word"))
else
kw=URLDecode(getKw(URLString,"wd"))
end if
pn=calculatePn(getPn(URLString,"pn"),1,0,10)
exit function
end if
if instr(URLHead,"http://image.baidu.com")>=1 then
kw=URLDecode(getKw(URLString,"word"))
pn=calculatePn(getPn(URLString,"pn"),1,0,16)
exit function
end if
if instr(URLHead,"http://cache.baidu.com")>=1 then
kw=URLDecode(getKw(URLString,"word"))
kw=replace(kw,";","")
kw=replace(kw,","," ")
exit function
end if
if instr(URLHead,"http://search.tom.com")>=1 then
if getKw(URLString,"word")="" then
kw=URLDecode(getKw(URLString,"w"))
else
kw=URLDecode(getKw(URLString,"word"))
end if
pn=calculatePn(getPn(URLString,"pn"),1,0,10)
exit function
end if
if instr(URLHead,"http://sou.china.com")>=1 then
kw=URLDecode(getKw(URLString,"query"))
pn=calculatePn(getPn(URLString,"pgNum"),0,0,10)
exit function
end if
if instr(URLHead,"sogou.com")>=1 then
kw=URLDecode(getKw(URLString,"query"))
pn=calculatePn(getPn(URLString,"page"),0,0,10)
exit function
end if
if instr(URLHead,"http://search.114.vnet.cn")>=1 then
kw=URLDecode(getKw(URLString,"kw"))
pn=calculatePn(getPn(URLString,"start"),1,0,10)
exit function
end if
if instr(URLHead,"http://seek.3721.com")>=1 then
kw=URLDecode(getKw(URLString,"name"))
if kw="" then kw=URLDecode(getKw(URLString,"p"))
pn=calculatePn(getPn(URLString,"page"),0,0,10)
exit function
end if
if instr(URLHead,"http://search.msn.com.cn")>=1 then
kw=UTF2GB(getKw(URLString,"q"))
pn=calculatePn(getPn(URLString,"first"),1,1,10)
exit function
end if
if instr(URLHead,"http://www.sj53.com")>=1 then
kw=URLDecode(getKw(URLString,"wd"))
pn=calculatePn(getPn(URLString,"pn"),1,0,10)
exit function
end if
if instr(URLHead,"iask.com")>=1 then
kw=URLDecode(getKw(URLString,"k"))
pn=calculatePn(getPn(URLString,"p"),0,0,10)
exit function
end if
if instr(URLHead,"http://www.baidugoo.com")>=1 then
kw=UTF2GB(getKw(URLString,"Keyword"))
pn=calculatePn(getPn(URLString,"pn"),0,0,10)
exit function
end if
if instr(URLHead,"yahoo.com")>=1 then
if instr(LCase(URLStringAll),"ei=utf-8")>=1 then
if getKw(URLString,"p")="" then
kw=UTF2GB(getKw(URLString,"keyword"))
else
kw=UTF2GB(getKw(URLString,"p"))
end if
pn=calculatePn(getPn(URLString,"b"),1,1,10)
else
if getKw(URLString,"p")="" then
kw=URLDecode(getKw(URLString,"keyword"))
else
kw=URLDecode(getKw(URLString,"p"))
end if
pn=calculatePn(getPn(URLString,"b"),1,1,10)
end if
exit function
end if
if instr(URLStringAll,"http://www.google")>=1 then
kw=UTF2GB(getKw(URLString,"q"))
pn=calculatePn(getPn(URLString,"start"),1,0,10)
exit function
end if
end function
%>