<%@LANGUAGE="VBSCRIPT" CODEPAGE="65001"%> <% rem 猪头,别偷看看人家统计~~嘿! server.scripttimeout=300 response.flush() dim king,action:action=request("action") set king=new kingcms king.head 0,0 select case action case"" king_def'跳转 case"count" king_count'统计 case"hit","revert" king_hit case else king.error("system/error") end select set king=nothing 'hit *** *** www.KingCMS.com *** *** sub king_hit() dim artid,topicid,rs dim I1'输出 artid=l1ll("artid",2) topicid=l1ll("topicid",2) if len(artid)>0 then set rs=conn.execute("select arthit,artrehit from kingart where artid="&artid&";") if not rs.eof and not rs.bof then if ll11(action,"hit") then I1=cdbl(rs(0))+1 else I1=rs(1) end if rs.close set rs=nothing end if if len(topicid)>0 then set rs=conn.execute("select topichit,topicreply from kingtopic where topicid="&topicid&";") if not rs.eof and not rs.bof then if ll11(action,"hit") then I1=cdbl(rs(0))+1 else I1=rs(1) end if rs.close set rs=nothing end if if II11(I1,2) then Il "document.write("""&I1&""");" end sub 'outhtm *** *** www.KingCMS.com *** *** sub king_outhtm() response.write ol end sub 'def *** *** www.KingCMS.com *** *** sub king_def() dim countpath:countpath = request.servervariables("path_info") Il"document.write("""");" dim artid,topicid dim rs '获得参数 artid=l1ll("artid",2) topicid=l1ll("topicid",2) '数据更新 if len(artid)>0 then set rs=conn.execute("select top 1 artid from kingart where artid="&artid&";") if not rs.eof and not rs.bof then conn.execute "update kingart set arthit=arthit+1 where artid="&artid&";" end if set rs=nothing end if if len(topicid)>0 then set rs=conn.execute("select top 1 userid,isview from kingtopic where topicid="&topicid&";") if not rs.eof and not rs.bof then if cstr(rs(0))=cstr(king.id) then conn.execute "update kingtopic set topichit=topichit+1,isview=0 where topicid="&topicid&";"'如果自己的帖子被预览过,就取消加粗 else conn.execute "update kingtopic set topichit=topichit+1 where topicid="&topicid&";" end if end if set rs=nothing end if '在线时间统计 if king.id>0 then'只有会员刷 dim timediff:timediff=datediff("s",king.lastdate,tnow) if timediff<=900 and timediff>0 then'如果上次刷新的时间小于15分钟,就加.. conn.execute "update kinguser set onlinetime=onlinetime+"&timediff&",lastdate='"&tnow&"' where userid="&king.id&";" else if timediff>=21600 then'如果六个小时后访问,算登录一次,加分 conn.execute "update kinguser set lastdate='"&tnow&"',usermark=usermark+"&mark_login&",userprestige=userprestige+"&prestige_login&",userlogins=userlogins+1 where userid="&king.id&";" else conn.execute "update kinguser set lastdate='"&tnow&"' where userid="&king.id&";" end if end if end if end sub 'count *** *** www.KingCMS.com *** *** sub king_count() dim today:today=year(tnow)&"-"&month(tnow)&"-"&day(tnow)'日期格式为 2005-12-23 dim visit:visit=request.ServerVariables("http_referer")'被访页面 if visit<>"" then visit=right(visit,len(visit)-7):visit=right(visit,len(visit)-instr(visit,"/")+1) dim urlstring:urlstring=request.servervariables("query_string") dim outcaidan:outcaidan="猪头,别偷看看人家统计~~嘿!"&string(2,10)&"Powered by KingCMS " outcaidan=outcaidan&king.version&string(2,10)&"Database Version: "&king.dbver&string(2,10)&"Author: Sin.CS" if len(urlstring)<17 then out outcaidan dim refer:refer=request("url")':refer=right(urlstring,len(urlstring)-17) dim tpath tpath="log/"&today&".asp" Ill "log" if lllll(tpath)=false then king.copyfile "counter.asp",tpath '如果没有日志文件就拷贝过来 king.topen tpath tconn.execute "insert into kinglog (username,userip,logrefer,logvisit,logdate) values ('"&king.name&"','"&left(king.ip,30)&"','"&left(refer,255)&"','"&left(visit,255)&"','"&time()&"')" dim rs,iptext,varhour,varmonth,blnip,blndate,mrs'判断ip,日期 varhour=hour(tnow) blndate=false'默认无改变 varmonth=year(today)&"-"&month(today) set rs=conn.execute("select iptext from kingday where ipdate='"&today&"';") '判断是否存在今日的数据表，有：＋＋ if not rs.eof and not rs.bof then iptext=rs(0) blnip=ll11(iptext,king.ip) dim hourcount'当前时间段内访问的人数，如果访问人数为0,则要自动更新页面，这两行和end sub前面的是对应的。 hourcount=conn.execute("select hourpv"&varhour&" from kingday where ipdate='"&today&"';")(0) if blnip then'如果存在相同ip，只更新pv值 conn.execute "update kingsystem set pvall=pvall+1 where systemname='KingCMS';" conn.execute "update kingday set pvday=pvday+1,hourpv"&varhour&"=hourpv"&varhour&"+1 where ipdate='"&today&"';" conn.execute "update kingmonth set pvmonth=pvmonth+1 where ipdate='"&varmonth&"';" else conn.execute "update kingsystem set ipall=ipall+1,pvall=pvall+1 where systemname='KingCMS';" conn.execute "update kingday set pvday=pvday+1,ipday=ipday+1,hourpv"&varhour&"=hourpv"&varhour&"+1,hourip"&varhour&"=hourip"&varhour&"+1,iptext='"&iptext&","&king.ip&"' where ipdate='"&today&"';" conn.execute "update kingmonth set pvmonth=pvmonth+1,ipmonth=ipmonth+1 where ipdate='"&varmonth&"';" end if else '如果没有今日的数据表，就创建 conn.execute "update kingsystem set pvall=pvall+1,ipall=ipall+1 where systemname='KingCMS';" conn.execute "insert into kingday (ipdate,hourpv"&varhour&",hourip"&varhour&",iptext) values ('"&today&"',1,1,'"&king.ip&"');" conn.execute "update kingmonth set pvmonth=pvmonth+1 where ipdate='"&varmonth&"';" '判断是否有本月数据表 set mrs=conn.execute("select id from kingmonth where ipdate='"&varmonth&"';") if not mrs.eof and not mrs.bof then else conn.execute "insert into kingmonth (ipdate) values ('"&varmonth&"')" conn.execute "update kinglink set linkhit=0;"'每月清空一次kinglink end if set mrs=nothing blndate=true'没有今日数据，就是说日期有变化 end if set rs=nothing if blndate then'日期有变化------------------ conn.execute "update kingrefer set refertoday=0;"'来源清零 conn.execute "update kingkey set keytoday=0;"'关键字清零 '论坛今日发帖更新 conn.execute "update kingmenu set menucount=0 where classid=10;" else conn.execute "update kingrefer set refernum=refernum+1,refertoday=refertoday+1,referdate='"&tnow&"' where referurl='"&referurl&"';" end if '来源页面 if instr(lcase(refer),"://")>0 then dim referurl referurl=l11(refer,"://","/") if lcase(left(referurl,4))="www." then referurl=right(referurl,len(referurl)-4) referurl=left(referurl,100)'来源url if II11(referurl,"^[a-zA-z0-9\:\-\_\.]+$")=false then out outcaidan conn.execute "update kinglink set linkhit=linkhit+1,linkdate='"&tnow&"' where linkurl like '%"&referurl&"%';" '关键字分析 king_keyword referurl,refer '来源 set rs=conn.execute("select referid from kingrefer where referurl='"&referurl&"';") if not rs.eof and not rs.bof then conn.execute "update kingrefer set refernum=refernum+1,refertoday=refertoday+1,referdate='"&tnow&"' where referurl='"&referurl&"';" else conn.execute "insert into kingrefer (referurl,referdate) values ('"&referurl&"','"&tnow&"')" end if set rs=nothing end if '浏览器统计,重点统计搜索引擎的来访次数，可获取的bot为google，baidu，msnbot dim browname:browname=lIII() dim countbrow,iscodata:iscodata=true dim sql,irs,data,artkeyword,artdescription,artpath,artmax,artorder,menuid sql="artguide,arttitle,artauthor,artfrom,sysdate,artcontent,artid"'6 countbrow=conn.execute("select count(browid) from kingbrow where browname='"&browname&"'")(0) if cstr(countbrow)="0" then '如果不存在，就创建 conn.execute "insert into kingbrow (browname,browdate) values ('"&browname&"','"&tnow&"')" else '判断是否为已存在的ip if blnip=false then'如果已经存在的ip访问就跳过 if blndate then'日期有变化 conn.execute "update kingbrow set browtoday=0;"'浏览器清零 end if conn.execute "update kingbrow set brownum=brownum+1,browtoday=browtoday+1,browdate='"&tnow&"' where browname='"&browname&"';" end if end if if blndate then'日期有变化 king_sub1:king_bbs set rs=conn.execute("select menuid from kingmenu where classid=10 and bbstype in (0,1);") while (not rs.eof) king_sitemaps rs(0) rs.movenext wend rs.close set rs=nothing else if hourcount=1 then if lllll("db#collect.asp") then artmax=conn.execute("select max(artorder) from kingart;")(0)'先获得artorder if len(artmax)>0 then artorder=artmax+1 else artorder=1 while iscodata king.topen "db#collect.asp" set rs=tconn.execute("select top 1 "&sql&" from kingart;")'读取文章，如果文章存在，就继续 if not rs.eof and not rs.bof then data=rs.getrows() set irs=tconn.execute("select menuid from kinglinked where artguide='"&lll1(data(0,0))&"';")'读取对应的栏目 if not irs.eof and not irs.bof then menuid=irs(0) if conn.execute("select count(*) from kingmenu where menuid="&menuid&" and classid=2;")(0)=1 then '如果有对应的栏目存在 '对应的文章是否存在 if conn.execute("select count(*) from kingart where menuid="&menuid&" and arttitle='"&lll1(data(1,0))&"';")(0)>0 then tconn.execute "delete from kingart where artid="&data(6,0)&";" else artkeyword=left(I1111(data(1,0),0),50) artdescription=left(llIIl(data(5,0)),250) artpath=king.geteng(data(1,0))'标题里获得artpath if len(artpath)>0 then artpath=artpath&"_"&llIl(4) else artpath=right(year(tnow),2)&month(tnow)&day(tnow)&replace(cstr(timer()),".","")'如果标题非英文,就赋日期 end if artpath=left(artpath,255)'要注释掉 conn.execute "insert into kingart (arttitle,artauthor,artfrom,artcontent,artshow,artinput,artkeyword,artdescription,artpath,artdate,sysdate,menuid,artorder) values ('"&lll1(data(1,0))&"','"&lll1(left(data(2,0),30))&"','"&lll1(left(data(3,0),50))&"','"&lll1(data(5,0))&"',1,'admin','"&lll1(artkeyword)&"','"&lll1(artdescription)&"','"&lll1(artpath)&"','"&lll1(tnow)&"','"&lll1(tnow)&"',"&menuid&","&artorder&")"'这个数据更新比较长:( tconn.execute "delete from kingart where artid="&data(6,0)&";" iscodata=false king_sub2_list menuid end if else tconn.execute "delete from kingart where artid="&data(6,0)&";" end if else tconn.execute "delete from kingart where artid="&data(6,0)&";" end if irs.close set irs=nothing else iscodata=false II1 "db#collect.asp"'如果文章数据为空，就删除文件 end if rs.close set rs=nothing king.tclose wend end if king_sub1:king_bbs end if end if end sub 'key *** *** www.KingCMS.com *** *** sub king_keyword(l1,l2)'分析关键字 l1:来源url, l2:完整来源路径 if len(l1)<3 then exit sub dim I1,I2,I3'关键字,搜索引擎名称,排名 dim l3:l3=l2&"&" dim rs'l4,l5,l6, ' l4=split(l1,"."):l5=ubound(l4):if l5>=1 then l6=lcase(l4(l5-1)&"."&l4(l5)) select case lcase(l1) case"baidu.com" I1=l11(l3,"(wd=|word=)","(&)"):I2="BAIDU":I3=king_order("baidu",l11(l3,"pn=","&")) case"google.com","google.cn" I1=l11(l3,"q=","&"):I2="Google":I3=king_order("google",l11(l3,"start=","&")) case"yahoo.com","search.cn.yahoo.com" I1=l11(l3,"p=","&"):I2="Yahoo":I3=king_order("yahoo",l11(l3,"b=","&"))',"1sou.com","yisou.com" case"1sou.com","yisou.com" I1=l11(l3,"p=","&"):I2="YiSou":I3=king_order("yahoo",l11(l3,"b=","&")) case"msn.com" I1=l11(l3,"q=","&"):I2="MSN":I3=king_order("msn",l11(l3,"first=","&")) case"3721.com" I1=l11(l3,"(p=|name=)","(&)"):I2="3721":I3=king_order("3721",l11(l3,"page=","&")) case"sohu.com" I1=l11(l3,"query=","&"):I2="Sohu":I3=king_order("sohu",l11(l3,"page=","&")) case"sogou.com" I1=l11(l3,"query=","&"):I2="Sogou":I3=king_order("sohu",l11(l3,"page=","&")) case"qq.com" I1=l11(l3,"w=","&"):I2="QQ":I3=king_order("qq",l11(l3,"page_no=","&")) case else exit sub end select I1=left(I1,250) if I1<>"" and I2<>"" and II11(I3,2) then'只支持这些搜索引擎 set rs=conn.execute("select keyid from kingkey where keyname='"&I2&"' and keyword='"&I1&"';") if not rs.eof and not rs.bof then conn.execute "update kingkey set keynum=keynum+1,keytoday=keytoday+1,keyorder="&I3&",keydate='"&tnow&"' where keyname='"&I2&"' and keyword='"&I1&"';" else conn.execute "insert into kingkey (keyname,keyword,keyorder,keydate,keytoday) values ('"&I2&"','"&I1&"',"&I3&",'"&tnow&"',1);" end if set rs=nothing end if end sub 'order *** *** www.KingCMS.com *** *** function king_order(l1,l2)'搜索引擎名称,数量 dim I1,I2 if II11(l2,2) then I1=l2 else I1=0 select case l1 case"baidu","google","yahoo","msn" I2=int(I1/10)+1 case"3721","sohu","qq":if I1=0 then I2=1 else I2=I1 end select king_order=I2 end function %>