cf.asp

物流管理系统

<%
'==================================
' 乘风多用户计数器v3.8
' 制　作：乘　风
' 开发网站：http://www.qqcf.com
' 程序演示：http://www.qqcf.com/?action=try
' 最新版本下载：http://www.qqcf.com/?action=down
' 声 明:	
' 本软件系免费程序,提供给个人免费使用,除保留版权外无其它任何限制。
' 我们为付费版用户提供升级服务和技术支持。
' 在程序首页保留乘风原创程序版权和链接的免费用户我们也提供一些的升级服务和技术支持。
' 未经作者许可禁止用于任何商业用途。
' 乘风多用户计数器特有的功能：
' 1.计数器数字图片和统计图标两种机制共存，众多设置可调。
' 2.Script脚本和Img非脚本两种方式调用计数器，Img非脚本方式计数器可以在任何能插入图片的地方使用。
' 3.独有的错误自动修复机制，能在计数器发生错误后自动修复。
' 4.完全杜绝并发线程容易对数据库造成的损坏，在流量大的网站上使用表现很稳定。
' 5.缓存机制，在缓存中保存数据，操作常见动作，大量减少对数据库的增加，删除频繁的操作。
' 6.稳定性、安全性、速度上表现都很优秀，功能齐全，代码集成程度高、完全公开，专业制作，完全免费。
' 乘风其它作品：乘风多用户计数器MsSql版、乘风多用户记数器php版、乘风电影程序、
'　　　　　　　 乘风网站推广系统、乘风网址程序，乘风广告管理系统、乘风论坛等。
' 此段版权注释不会影响网页打开速度，请勿删除!
'　　　　　　　　　　　2006年7月19日									
'===================================
%>
<!--#include file="QQCF_Myfunction.asp"-->
<%Action=Request.QueryString("Action")
Assort=Int(Request.QueryString("Assort"))
Tmp=HttpPath(2)
If Action="" And Assort=0 Then%>
var ly=escape(document.referrer);
var currweb=location.href;
ly=ly.replace(/\&/g,"|");
currweb=currweb.replace(/\&/g,"|");
document.write("<script src=<%=Tmp%>cf.asp?Action=getcount&User_Name=<%=Request.QueryString("User_Name")%>&Ly="+ly+"&CurrWeb="+currweb+"></script>");
<%End if
If Action="getcount" Or Assort=1 Then%>
<!--#include file="QQCF_Conn.asp"-->
<%User_Name=ChkStr(Request.QueryString("User_Name"))
If Assort=0 Then
Ly=ChkStr(Server.HtmlEncode(Request.QueryString("Ly")))
Else
Ly=ChkStr(Server.HtmlEncode(Request.ServerVariables("Http_Referer")))
End if
CurrWeb=ChkStr(Server.HtmlEncode(Request.QueryString("CurrWeb")))
If Ly="" Then Ly="-"
If CurrWeb="" Then CurrWeb="-"
Ly=Left(Replace(Ly,"|","&"),255)
Ly=Replace(Ly,",","")
CurrWeb=Left(Replace(CurrWeb,"|","&"),255)
CurrWeb=Replace(CurrWeb,",","")
Ip=Request.ServerVariables("HTTP_X_FORWARDED_FOR")
If Ip= "" Then Ip= Request.ServerVariables("REMOTE_ADDR")
AgentStr=Lcase(Request.ServerVariables("HTTP_USER_AGENT"))
If BreakUrl(CurrWeb,1)=HttpPath(1) Then
CookieType=1
If Request.Cookies("CfCountCookie")="" Then
CfCount=0
Else
CfCount=Int(Request.Cookies("CfCountCookie"))
End if 
Else
CookieType=2
Randomize
RanNum=int(5*rnd)+1
End if
If IsEmpty(Application("CfCountStartTime")) Then Application("CfCountStartTime")=Date()
If Application("CfCountStartTime")<>Date() Then
Application("CfCountStartTime")=Date()  
Sql="Delete From WWW_QQCF_COM_CfCount_Hour_Count Where DateDiff('d',AddDate,Now())>1"
Conn.ExeCute Sql
Sql="Delete From WWW_QQCF_COM_CfCount_WebCount Where DateDiff('d',AddDate,Now())>1"
Conn.ExeCute Sql
Sql="Delete From WWW_QQCF_COM_CfCount_Ly Where DateDiff('d',AddDate,Now())>1"
Conn.ExeCute Sql
Sql="Delete From WWW_QQCF_COM_CfCount_Search_Count Where DateDiff('d',AddDate,Now())>6"
Conn.ExeCute Sql
Sql="Delete From WWW_QQCF_COM_Cfcount_SearchKeywrod_Count Where DateDiff('d',LastTime,Now())>1"
Conn.ExeCute Sql
Sql="Delete From WWW_QQCF_COM_CfCount_Site Where DateDiff('d',LastTime,Now())>6"
Conn.ExeCute Sql
Sql="Delete From WWW_QQCF_COM_CfCount_Day_Count Where DateDiff('m',AddDate,Now())>1"
Conn.ExeCute Sql
End If  
If IsEmpty(Application(User_Name&"_StartTime")) Then Application(User_Name&"_StartTime")=Date()
If Application(User_Name&"_StartTime")<>Date() Then
Application(User_Name&"_StartTime")=Date()
Application.Lock
Application(User_Name&"_AllIp") = Empty
Application(User_Name&"_Ly") = Empty
Application(User_Name&"_Online") = Empty
Application.UnLock
End If
If Instr(Application(User_Name&"_AllIp"),Ip)=0 Then
If CookieType=2 Then CfCount=0
Application.Lock
Application(User_Name&"_AllIp") = Application(User_Name&"_AllIp")&Ip&"|"
Application.UnLock
Else
If CookieType=2 Then Cfcount=-1
End If
Myarray=Split(Application(User_Name&"_AllIp"),"|")
If Ubound(Myarray)>10000 Then
Application.Lock
Application(User_Name&"_AllIp") = Mid(Application(User_Name&"_AllIp"),Instr(Application(User_Name&"_AllIp"),"|")+1,Len(Application(User_Name&"_AllIp")))
Application.UnLock
End if
If Request.Cookies("CfCountVisitTotalCookie")="" Then
CfCountVisitTotal=1
Else
CfCountVisitTotal=Int(Request.Cookies("CfCountVisitTotalCookie"))+1
End if
If CfCount=0 Then
If Instr(Application(User_Name&"_Ly"),Ip)=0 Then
Application(User_Name&"_Ly")=Application(User_Name&"_Ly")&Ip&"\"&CfCountVisitTotal&"\"&Now()&"\"&Ly&"\"&Now()&"\"&CurrWeb&"\1"&"|"
End If
Else
If Instr(Application(User_Name&"_Ly"),Ip)>0 Then
Application(User_Name&"_Ly")=GetAppChange(User_Name,IP,CfCountVisitTotal,Currweb)
End If
End If
Myarray=Split(Application(User_Name&"_Ly"),"|")
If Ubound(Myarray)>100 Then
Application.Lock
Application(User_Name&"_Ly") = Mid(Application(User_Name&"_Ly"),Instr(Application(User_Name&"_Ly"),"|")+1,Len(Application(User_Name&"_Ly")))
Application.UnLock
End if
TimeStr=Cstr(Timer())
If Instr(TimeStr,".")=0 Then
TimeNum=TimeStr&"00"
Else
If Len(Mid(TimeStr,Instr(TimeStr,".")+1))=1 Then
TimeNum=Replace(TimeStr&"0",".","")
ElseIf Len(Mid(TimeStr,Instr(TimeStr,".")+1))>=2 Then
TimeNum=Mid(TimeStr,1,Instr(TimeStr,".")+2)
TimeNum=Replace(TimeNum,".","")
End If
End if
If IsEmpty(Application("LastUser")) Then Application("LastUser")=TimeNum
If Application("LastUser")<>TimeNum And Abs(Int(TimeNum)-Int(Application("LastUser")))<30 Then
Response.End
End If
Application.Lock
Application("LastUser")=TimeNum
Application.UnLock
If IsEmpty(Application("ErrorNum")) Then Application("ErrorNum")=1
If Application("ErrorNum") Mod 10 = 0 Then
Application.Lock
Application("CfCountDo") = 0
Application("ErrorNum") = 1
Application.UnLock
End If
If Int(Application("CfCountDo"))=0 Then
Application.Lock
Application("CfCountDo") = 1
Application.UnLock
Set RsUser=Server.CreateObject("Adodb.RecordSet")
Sql="Select * From WWW_QQCF_COM_CfCount_RegUser Where User_Name='"&User_Name&"'"
RsUser.Open sql,conn,1,1
If RsUser.Eof Then
ShowText="<a href="&Tmp&" target=_blank>计数器系统中没有此用户，请先注册！</a>"
Response.Write("document.write("& chr(34) & ShowText & chr(34) &");")
Application.Lock
Application("CfCountDo") = 0
Application.UnLock
Response.End
End if 
If RsUser("State")=0 Then
ShowText="<a href="&Tmp&" target=_blank><font color=#ff0000>你的计数器账号已被禁用！</font></a>"
Response.Write("document.write("& chr(34) & ShowText & chr(34) &");")
Application.Lock
Application("CfCountDo") = 0
Application.UnLock
Response.End
End if
If RsSet("OnlineKeep")=-1 Then
If RsUser("online")=-1 Then
If CfCount=0 Then
If Instr(Application(User_Name&"_Online"),Ip)=0 Then
Application(User_Name&"_Online")=Application(User_Name&"_Online")&Ip&"\"&CfCountVisitTotal&"\"&Now()&"\"&Ly&"\"&Now()&"\"&CurrWeb&"\1"&"|"
End If
Else
If Instr(Application(User_Name&"_Online"),Ip)>0 Then
Application(User_Name&"_Online")=GetAppChange_2(User_Name,IP,CfCountVisitTotal,Currweb,RsUser("OnlineTime"))
End If
End If
End If
End If
Sql="Select Count(*) From WWW_QQCF_COM_CfCount_Back Where User_Name='"&User_Name&"'"
Set Rs=Conn.Execute(Sql)
IF Rs(0)=0 Then
Sql="Insert Into WWW_QQCF_COM_CfCount_Back (User_Name,BackNum_1) values('"&User_Name&"',1)"
Conn.ExeCute Sql
Else
If CfCountVisitTotal=1 And Cfcount=0 Then
Sql="Update WWW_QQCF_COM_CfCount_Back Set BackNum_1=BackNum_1+1 Where User_Name='"&User_Name&"'"
Elseif CfCountVisitTotal>1 And CfCountVisitTotal<11 And Cfcount=0 Then
Sql="Update WWW_QQCF_COM_CfCount_Back Set BackNum_"&CfCountVisitTotal&"=BackNum_"&CfCountVisitTotal&"+1,BackNum_"&CfCountVisitTotal-1&"=BackNum_"&CfCountVisitTotal-1&"-1 Where User_Name='"&User_Name&"'"
ElseIf CfCountVisitTotal=11 And Cfcount=0 Then
Sql="Update WWW_QQCF_COM_CfCount_Back Set BackNum_Higher=BackNum_Higher+1,BackNum_10=BackNum_10-1 Where User_Name='"&User_Name&"'"
End if
Conn.ExeCute Sql
End if
If RsSet("AllSearch")<>"-" And Cfcount=0 Then
MyArray=Split(RsSet("AllSearch"),"|")   
For I=0 To Ubound(MyArray)
SiteFlag=Left(MyArray(I),Instr(MyArray(I),",")-1)
KeyWordFlag=Mid(MyArray(I),Instr(MyArray(I),",")+1,1000)
If Instr(BreakUrl(Ly,1),SiteFlag)>0 Then
Sql = "Select Count(ID) From WWW_QQCF_COM_CfCount_Search_Count Where SiteFlag = '"& SiteFlag &"' And User_Name='"&User_Name&"' And AddDate=#"&Date()&"#"
Set Rs=Conn.Execute(Sql)
If Rs(0)=0 Then
Sql="Insert Into WWW_QQCF_COM_CfCount_Search_Count (User_Name,SiteFlag) values ('"&User_Name&"','"&SiteFlag&"')"
Else
Sql="Update WWW_QQCF_COM_CfCount_Search_Count Set Counter = Counter+1 Where SiteFlag = '"&SiteFlag& "' And User_Name='"&User_Name&"' And AddDate=#"&Date()&"#"
End If   
Conn.ExeCute Sql
If Instr(Lcase(Ly),KeyWordFlag&"=")>0 Then
KeyWord=GetSearchKeyword(Ly,KeyWordFlag)
Sql = "Select Count(ID) From WWW_QQCF_COM_Cfcount_SearchKeywrod_Count Where KeyWord = '"& KeyWord &"' And User_Name='"&User_Name&"'"
Set Rs=Conn.Execute(Sql)
If Rs(0)=0 Then
Sql="Insert Into WWW_QQCF_COM_Cfcount_SearchKeywrod_Count (User_Name,KeyWord,LastLy) values ('"&User_Name&"','"&KeyWord&"','"&Ly&"')"
Else
Sql="Update WWW_QQCF_COM_Cfcount_SearchKeywrod_Count Set Counter = Counter+1,LastTime=#"&Now()&"#,LastLy='"&Ly&"' Where KeyWord = '"&KeyWord& "' And User_Name='"&User_Name&"'"
End If
Conn.ExeCute Sql
End if
Exit For
End If
Next
End if
If Instr(AgentStr,"alexa")>0 And Cfcount=0 Then
Set Rs=Server.CreateObject("Adodb.RecordSet")
Sql="Select Count(ID) From WWW_QQCF_COM_CfCount_Alexa_Count Where User_Name='"&User_Name&"' And AddDate=#"&Date()&"#"
Rs.Open Sql,Conn,1,1
If Rs(0)=0 Then
Sql="Insert Into WWW_QQCF_COM_CfCount_Alexa_Count (User_Name) Values ('"&User_Name&"')"
Conn.ExeCute Sql
Else
If CfCount=0 Then
Sql="Update WWW_QQCF_COM_CfCount_Alexa_Count Set Counter=Counter+1 Where User_Name='"&User_Name&"' And AddDate=#"&Date()&"#"
Conn.ExeCute Sql
End If
End If
ENd If
If RsSet("WebKeep")=-1 And CurrWeb<>"-" Then
Sql = "Select Count(ID) From WWW_QQCF_COM_CfCount_WebCount Where WebUrl = '"& Lcase(CurrWeb) &"' And User_Name='"&User_Name&"' And AddDate=#"&Date()&"# And WebUrl<>'-'"
Set Rs=Conn.Execute(Sql)
If Rs(0)=0 Then
Sql="Insert Into WWW_QQCF_COM_CfCount_WebCount (User_Name,WebUrl) values ('"&User_Name&"','"&Lcase(CurrWeb)&"')"
Else
Sql="Update WWW_QQCF_COM_CfCount_WebCount Set Counter = Counter+1,LastTime=#"&Now()&"# Where WebUrl = '"&Lcase(CurrWeb)& "' And User_Name='"&User_Name&"' And AddDate=#"&Date()&"#"
End If
Conn.ExeCute Sql
End if
Set Rs=Server.CreateObject("Adodb.RecordSet")
Sql="Select Count(ID) From WWW_QQCF_COM_CfCount_Day_Count Where User_Name='"&User_Name&"' And AddDate=#"&Date()&"#"
Rs.Open Sql,Conn,1,1
If Rs(0)=0 Then
Sql="Insert Into WWW_QQCF_COM_CfCount_Day_Count (User_Name) Values ('"&User_Name&"')"
Conn.ExeCute Sql
Else
Sql="Update WWW_QQCF_COM_CfCount_Day_Count Set Counter=Counter+1 Where User_Name='"&User_Name&"' And AddDate=#"&Date()&"#"
Conn.ExeCute Sql
If CfCount=0 Then
Sql="Update WWW_QQCF_COM_CfCount_Day_Count Set IpCounter=IpCounter+1 Where User_Name='"&User_Name&"' And AddDate=#"&Date()&"#"
Conn.ExeCute Sql
End If
End If
Set Rs=Server.CreateObject("Adodb.RecordSet")
Sql="Select Count(ID) From WWW_QQCF_COM_CfCount_Hour_Count Where User_Name='"&User_Name&"' And AddDate=#"&Date()&"# And AddHour="&Hour(Now)
Rs.Open Sql,Conn,1,1
IF Rs(0)=0 Then
Sql="Insert Into WWW_QQCF_COM_CfCount_Hour_Count (User_Name,AddHour) Values ('"&User_Name&"',"&Hour(Now)&")"
Conn.ExeCute Sql
Else
Sql="Update WWW_QQCF_COM_CfCount_Hour_Count Set Counter=Counter+1 Where User_Name='"&User_Name&"' And AddDate=#"&Date()&"# And AddHour="&Hour(Now)
Conn.ExeCute Sql
If CfCount=0 Then
Sql="Update WWW_QQCF_COM_CfCount_Hour_Count Set IpCounter=IpCounter+1 Where User_Name='"&User_Name&"' And AddDate=#"&Date()&"# And AddHour="&Hour(Now)
Conn.ExeCute Sql
End if
End If
If CfCount=0 Then
If RsSet("LyKeep")=-1 Then
If Ly<>"-" Then
LyHead=BreakUrl(Ly,1)
Else
LyHead="-"
End if
Set Rs=Server.CreateObject("Adodb.RecordSet")
Sql="Select Count(ID) From WWW_QQCF_COM_CfCount_Ly Where User_Name='"&User_Name&"' And LyHead='"&LyHead&"' And DateDiff('d',AddDate,Date())=0"
Rs.Open Sql,Conn,3,2
IF Rs(0)=0 Then
Sql="Insert Into WWW_QQCF_COM_CfCount_Ly (User_Name,Ip,LyHead,Ly) Values ('"&User_Name&"','"&Ip&"','"&LyHead&"','"&Ly&"')"
Conn.ExeCute Sql
Sql="Update WWW_QQCF_COM_CfCount_Admin Set Store_Ly=Store_Ly+1,Store_TotalLy=Store_TotalLy+1"
Conn.ExeCute Sql
Else
Sql="Update WWW_QQCF_COM_CfCount_Ly Set Counter=Counter+1,Ip='"&Ip&"',Ly='"&Ly&"',LastTime=#"&Now()&"# Where User_Name='"&User_Name&"' And LyHead='"&LyHead&"' And DateDiff('d',AddDate,Date())=0"
End If
Conn.ExeCute Sql
Set Rs=Server.CreateObject("Adodb.RecordSet")
Sql="Select Count(ID) From WWW_QQCF_COM_CfCount_Site Where User_Name='"&User_Name&"' And Site='"&LyHead&"'"
Rs.Open Sql,Conn,3,2
IF Rs(0)=0 Then
Sql="Insert Into WWW_QQCF_COM_CfCount_Site (User_Name,Site,Ly) Values ('"&User_Name&"','"&LyHead&"','"&Ly&"')"
Else
Sql="Update WWW_QQCF_COM_CfCount_Site Set Counter=Counter+1,Ly='"&Ly&"',LastTime=#"&Now()&"# Where User_Name='"&User_Name&"' And Site='"&LyHead&"'"
End If
Conn.ExeCute Sql
End If
End if
If CfCount=0 Then
Sql="Update WWW_QQCF_COM_CfCount_RegUser Set ShowTotal=ShowTotal+1,RealShowTotal=RealShowTotal+1,RealIpTotal=RealIpTotal+1 Where User_Name='"&User_Name&"'"
Else
Sql="Update WWW_QQCF_COM_CfCount_RegUser Set ShowTotal=ShowTotal+1,RealShowTotal=RealShowTotal+1 Where User_Name='"&User_Name&"'"
End if
Conn.ExeCute Sql
If RsSet("Store_Ly")>6000 Then
Sql="Select Min(id) As MyID From WWW_QQCF_COM_CfCount_Ly Where ID In (Select Top 2000 Id From WWW_QQCF_COM_CfCount_Ly Order By Id Desc)"
Set Rs=Conn.Execute(Sql)
Sql="Delete From WWW_QQCF_COM_CfCount_Ly Where ID<"&Rs("MyID")
Conn.ExeCute Sql
Sql="Update WWW_QQCF_COM_CfCount_Admin Set Store_Ly=0"
Conn.ExeCute Sql
End if
If RsUser("Tjopen")=-1 Or RsUser("OnlineShow")=-1 Then
If IsEmpty(Application(User_Name&"_Online")) Then
OnlineTotal=0
Else
Myarray=Split(Application(User_Name&"_Online"),"|")
OnlineTotal=Ubound(Myarray)
End If
End if
If  RsUser("Tjopen")=-1 Or RsUser("TodayShow")=-1 Or RsUser("TodayIpShow")=-1 Then