⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 web_online.aspx.vb

📁 Asp.Net+SQL Server 2000的学生信息管理系统!有三个用户权限
💻 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 + -