📄 web_online.aspx.vb
字号:
'===============================================================================
'
' ProjectName:在线人数统计 V1.0
' Author:pcsky(进哥)
' CreatedTime:
' ModifiedTime:
' Contact:lee2001xp@163.com
' CopyRight 2005 www.soft123.com
'
'===============================================================================
Public Class web_Online
Inherits System.Web.UI.Page
Dim strSql, strNumOnline As String
Dim username As String
Dim KickTime As Integer
Dim myCmd As New SqlCommand
Dim dr As SqlDataReader
#Region " Web 窗体设计器生成的代码 "
'该调用是 Web 窗体设计器所必需的。
<System.Diagnostics.DebuggerStepThrough()> Private Sub InitializeComponent()
Me.myConn = New System.Data.SqlClient.SqlConnection
Me.cmdInsert = New System.Data.SqlClient.SqlCommand
Me.cmdUpdate = New System.Data.SqlClient.SqlCommand
'
'cmdInsert
'
Me.cmdInsert.CommandText = "INSERT INTO rz_online (ID, UserName, ip, startime, lastimebk, browser, actforip) " & _
"VALUES (@ID, @UserName, @ip, @startime, @lastimebk, @browser, @actforip)"
Me.cmdInsert.Connection = Me.myConn
Me.cmdInsert.Parameters.Add(New System.Data.SqlClient.SqlParameter("@ID", System.Data.SqlDbType.Float, 8, "ID"))
Me.cmdInsert.Parameters.Add(New System.Data.SqlClient.SqlParameter("@UserName", System.Data.SqlDbType.VarChar, 50, "UserName"))
Me.cmdInsert.Parameters.Add(New System.Data.SqlClient.SqlParameter("@ip", System.Data.SqlDbType.VarChar, 20, "ip"))
Me.cmdInsert.Parameters.Add(New System.Data.SqlClient.SqlParameter("@startime", System.Data.SqlDbType.DateTime, 4, "startime"))
Me.cmdInsert.Parameters.Add(New System.Data.SqlClient.SqlParameter("@lastimebk", System.Data.SqlDbType.DateTime, 4, "lastimebk"))
Me.cmdInsert.Parameters.Add(New System.Data.SqlClient.SqlParameter("@browser", System.Data.SqlDbType.VarChar, 100, "browser"))
Me.cmdInsert.Parameters.Add(New System.Data.SqlClient.SqlParameter("@actforip", System.Data.SqlDbType.VarChar, 20, "actforip"))
'
'cmdUpdate
'
Me.cmdUpdate.CommandText = "UPDATE rz_online SET lastimebk = @lastimebk, UserName = @UserName WHERE (ID = @ID" & _
") and datediff(ss, lastimebk, getdate()) > 60"
Me.cmdUpdate.Connection = Me.myConn
Me.cmdUpdate.Parameters.Add(New System.Data.SqlClient.SqlParameter("@lastimebk", System.Data.SqlDbType.DateTime, 4, "lastimebk"))
Me.cmdUpdate.Parameters.Add(New System.Data.SqlClient.SqlParameter("@UserName", System.Data.SqlDbType.VarChar, 50, "UserName"))
Me.cmdUpdate.Parameters.Add(New System.Data.SqlClient.SqlParameter("@ID", System.Data.SqlDbType.Float, 8, System.Data.ParameterDirection.Input, False, CType(0, Byte), CType(0, Byte), "ID", System.Data.DataRowVersion.Original, Nothing))
End Sub
Protected WithEvents myConn As System.Data.SqlClient.SqlConnection
Protected WithEvents cmdUpdate As System.Data.SqlClient.SqlCommand
Protected WithEvents cmdInsert As System.Data.SqlClient.SqlCommand
'注意: 以下占位符声明是 Web 窗体设计器所必需的。
'不要删除或移动它。
Private designerPlaceholderDeclaration As System.Object
Private Sub Page_Init(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Init
'CODEGEN: 此方法调用是 Web 窗体设计器所必需的
'不要使用代码编辑器修改它。
InitializeComponent()
End Sub
#End Region
Private Sub Page_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
'定义数据库连接字符串
myConn.ConnectionString = connStr()
myCmd.Connection = myConn
'设置删除在线数据表中多少分钟内不活动用户,单位为分钟
KickTime = GetAppSetting("KickTime")
username = Session(GetAppSetting("CookieUser")) '登陆的用户名
If username = "" Then
username = "客人"
End If
myConn.Open()
ProcessOnline()
strNumOnline = GetOnline()
myConn.Close()
'处理在线统计
Response.Write("document.write(" & strNumOnline & ")")
End Sub
'统计在线人数
Function GetOnline() As Integer
Dim intOutput As Integer
strSql = "select isnull(count(id),0) cnt from rz_online"
myCmd.CommandText = strSql
intOutput = myCmd.ExecuteScalar
Return intOutput
End Function
'新建本页的Cookies
Sub AddPageCook(ByVal str As String)
Dim objCookie As HttpCookie = New HttpCookie("myweb")
objCookie.Values.Add("onlineid", str)
Response.AppendCookie(objCookie)
objCookie.Expires = DateTime.Now.AddMinutes(KickTime)
End Sub
'处理在线统计
Sub ProcessOnline()
Dim bolRecord As Boolean '是否有记录
Dim strStatUserid As String '用户IP
Dim strForWard As String '用户内网IP
Dim strREMOTE_HOST As String '发出请求的主机(client)名称
Dim tmpCmd As New SqlCommand
strREMOTE_HOST = Request.ServerVariables("REMOTE_HOST")
'增加Cookie
strStatUserid = Replace(strREMOTE_HOST, ".", "")
AddPageCook(strStatUserid)
'检查当前用户是否已经在线
strSql = "select id from rz_online where id=@id"
tmpCmd.CommandText = strSql
tmpCmd.Connection = myConn
tmpCmd.Parameters.Add("@id", SqlDbType.Float, 8, "id")
tmpCmd.Parameters("@id").Value = Request.Cookies("myweb")("onlineid")
dr = tmpCmd.ExecuteReader
If dr.HasRows Then
bolRecord = True
End If
dr.Close()
'增加记录或更新最新访问时间
If bolRecord = False Then
cmdInsert.Parameters("@id").Value = strStatUserid
cmdInsert.Parameters("@UserName").Value = username
cmdInsert.Parameters("@ip").Value = strREMOTE_HOST
cmdInsert.Parameters("@startime").Value = Now()
cmdInsert.Parameters("@lastimebk").Value = Now()
cmdInsert.Parameters("@browser").Value = Request.ServerVariables("HTTP_USER_AGENT")
strForWard = Request.ServerVariables("HTTP_X_FORWARDED_FOR")
If strForWard = "" Then
strForWard = "空"
End If
cmdInsert.Parameters("@actforip").Value = strForWard
cmdInsert.ExecuteNonQuery()
Else
cmdUpdate.Parameters("@lastimebk").Value = Now()
cmdUpdate.Parameters("@UserName").Value = username
cmdUpdate.Parameters("@id").Value = CStr(Request.Cookies("myweb")("onlineid"))
cmdUpdate.ExecuteNonQuery()
End If
'删除超时用户
strSql = "delete from rz_online where datediff(ss, lastimebk, getdate()) > " & KickTime & "*60"
myCmd.CommandText = strSql
myCmd.ExecuteNonQuery()
End Sub
End Class
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -