stat.asp

依蓝旅游网站管理系统Elan2008.SP2

<%
Option Explicit
Response.Expires = 0
%>
<!--#Include File="Counter_Conn.asp"-->
<%
On Error Resume Next
Dim RemoteIp, RemoteIpCode, Agent, BcType
Dim Referer, ScreenWidth, ScreenHeight, Screen, Color, Mozilla, System, Browser
Dim UserID

UserID = ELClng(Request.Cookies("EL_User_Counter")("UserID"))

Referer = Request.QueryString("Referer")
ScreenWidth = Request.QueryString("Width")
ScreenHeight = Request.QueryString("Height")
Color = Request.QueryString("Color")

RemoteIp = Request.ServerVariables("HTTP_X_FORWARDED_FOR")
If RemoteIp = "" Then RemoteIp = Request.ServerVariables("REMOTE_ADDR")
RemoteIp = Trim(RemoteIp)
RemoteIpCode = IpEncode(RemoteIp)

If Referer="" Then Referer="直接输入或书签导入"
If ScreenHeight = "" Or IsNumeric(ScreenHeight) = 0 Or ScreenWidth = "" Or IsNumeric(ScreenWidth) = 0 Then 
   Screen = "其它"
Else
   Screen = ScreenWidth &"x"& ScreenHeight
End If

Color = Request.QueryString("Color")
If Color = "" Or IsNumeric(Color) = 0 Then 
   Color = "其它"
Else
   Select Case Color
      Case 4:
	     Color = "16 色"
      Case 8:
	     Color = "256 色"
      Case 16:
	     Color = "增强色16位）"
      Case 24:
	     Color = "真彩色（24位）"
      Case 32:
	     Color = "真彩色（32位）"
   End Select
End If

Mozilla = Request.ServerVariables("HTTP_USER_AGENT")
Agent = Request.ServerVariables("HTTP_USER_AGENT")
Agent = Split(Agent,";")
BcType = 0
If Instr(Agent(1), "U") Or Instr(Agent(1), "I") Then BcType = 1
If InStr(Agent(1), "MSIE") Then BcType = 2
Select Case BcType
   Case 0:
      Browser = "其它"
      System = "其它"
   Case 1:
      Browser = "Netscape"& Mid(Mid(Agent(0), InStr(Agent(0), "/") + 1), 1, InStr(Mid(Agent(0), InStr(Agent(0), "/") + 1), " ") - 1)
      System = Mid(Agent(0), InStr(Agent(0), "(") + 1)		
   Case 2:
      Browser = Agent(1)
      System = Agent(2)
      System = Replace(System, ")", "")		 
End Select
System = Replace(Replace(Replace(Replace(Replace(Replace(System, " ", ""), "Win", "Windows"), "NT5.0", "2000"), "NT5.1", "XP"), "NT5.2", "2003"), "dowsdows", "dows")
Browser = Replace(Browser," ","")

Call OpenConnection()

Dim CounterCmd
Set CounterCmd = Server.CreateObject("ADODB.COMMAND")
With CounterCmd
   .ActiveConnection = Conn
   .CommandText = "EL_SP_Counter"
   .CommandType = 4
   .Prepared = True
   
   .Parameters.Append .CreateParameter("@RemoteIp", 200, 1, 15, RemoteIp)
   .Parameters.Append .CreateParameter("@RemoteIpCode", 6, 1, 8, RemoteIpCode)
   .Parameters.Append .CreateParameter("@Referer", 200, 1, 255, Referer)
   .Parameters.Append .CreateParameter("@Screen", 200, 1, 20, Screen)
   .Parameters.Append .CreateParameter("@Color", 200, 1, 20, Color)
   .Parameters.Append .CreateParameter("@Mozilla", 200, 1, 255, Mozilla)
   .Parameters.Append .CreateParameter("@System", 200, 1, 20, System)
   .Parameters.Append .CreateParameter("@Browser", 200, 1, 20, Browser)
   .Parameters.Append .CreateParameter("@UserID", 3, 1, 4, UserID)
   .Execute()
End With
Set CounterCmd = Nothing
Call CloseConn()   

Function IpEncode(ip)
    On Error Resume Next
	Dim ArrIp
    ArrIp = Split(ip, ".")    
	IpEncode = Clng(ArrIp(0)) * 256 * 256 * 256 + Clng(ArrIp(1)) * 256 * 256 + Clng(ArrIp(2)) * 256 + Clng(ArrIp(3)) - 1
    If Err Then
	   Err.Clear()
	   IpEncode = 0
	End If
End Function

Function ELClng(ByVal lng)
   If IsNumeric(lng) Then
      ELClng = Clng(lng)
   Else
      ELClng = 0
   End If
End Function
%>