Skip to content

cWinsock 用户绑定与组管理 ​

📋 功能概述 ​

用户绑定和组管理功能提供了一套完整的用户身份管理和消息分发机制:

  • 用户绑定:将用户身份与 socket 连接关联,支持按用户名发送消息
  • 组管理:将用户分组,支持批量消息发送和管理操作
  • 双向同步:组操作自动同步服务器端和客户端的 CurrentGroups
  • 自动清理:用户断开时自动解绑,无需手动处理

关键属性 ​

属性类型说明
CurrentUserVariant客户端实例上绑定的用户名
CurrentUserTokenString客户端实例上绑定的用户 Token(如认证令牌)
CurrentUserInfocJson客户端实例上绑定的用户扩展信息(JSON 对象)
CurrentGroupsDictionary客户端实例上所属的组列表(组名 → True)

👤 用户绑定 ​

BindUser 方法 ​

说明 ​

将用户绑定到客户端连接,实现用户身份与 socket 连接的关联。

语法 ​

vb
Public Sub BindUser(ByVal User As Variant, Client As cWinsock, Optional ByVal Token As String, Optional Info As cJson)

参数 ​

参数类型说明
UserVariant用户标识(字符串或其他唯一值)
ClientcWinsock客户端 socket 实例
TokenString(可选)用户认证令牌,绑定后可通过 Client.CurrentUserToken 获取
InfocJson(可选)用户扩展信息(JSON 对象),绑定后可通过 Client.CurrentUserInfo 获取

使用示例 ​

vb
' 服务器端:客户端连接时绑定用户
Private Sub m_oServer_DataArrival(Client As cWinsock, ByVal bytesTotal As Long)
    Dim sData As String
    Client.GetData sData
    
    ' 解析登录消息,假设格式为 "LOGIN:username"
    If Left$(sData, 6) = "LOGIN:" Then
        Dim sUsername As String
        sUsername = Mid$(sData, 7)
        
        ' 绑定用户到客户端(带 Token 和扩展信息)
        Dim oInfo As New cJson
        oInfo.Add "loginTime", Now
        oInfo.Add "ip", Client.RemoteHostIP
        m_oServer.BindUser sUsername, Client, "secret_token_123", oInfo
        
        Client.SendData "LOGIN:OK"
        Debug.Print "用户 " & sUsername & " 已登录,Token: " & Client.CurrentUserToken
    End If
End Sub

ExistsUser 方法 ​

说明 ​

检查指定用户是否已绑定。

语法 ​

vb
Public Function ExistsUser(ByVal User As Variant) As Boolean

使用示例 ​

vb
If m_oServer.ExistsUser("alice") Then
    Debug.Print "用户在线"
Else
    Debug.Print "用户不在线"
End If

UnbindUser 方法 ​

说明 ​

解绑指定用户。

语法 ​

vb
Public Sub UnbindUser(ByVal User As Variant)

使用示例 ​

vb
' 手动踢出用户
If m_oServer.ExistsUser("alice") Then
    m_oServer.UnbindUser "alice"
    Debug.Print "用户已解绑"
End If

自动解绑 ​

用户断开连接时,系统会自动从用户列表中移除,无需手动调用。


SendToUser 方法 ​

说明 ​

向绑定的用户发送数据。

语法 ​

vb
Public Sub SendToUser(ByVal User As Variant, Data As Variant, Optional ByVal CodePage As EnumScpCodePage = wcpAcp)

参数 ​

参数类型说明
UserVariant用户标识
DataVariant要发送的数据(字符串或字节数组)
CodePageEnumScpCodePage(可选)文本编码,默认 wcpAcp

使用示例 ​

vb
' 向指定用户发送消息
m_oServer.SendToUser "alice", "Hello, Alice!"

' 使用 UTF-8 编码发送
m_oServer.SendToUser "alice", "你好,爱丽丝!", wcpUtf8

' 广播消息给所有在线用户
Dim vUser As Variant
For Each vUser In m_oServer.m_Users.Keys
    m_oServer.SendToUser vUser, "系统公告:服务器将在5分钟后维护"
Next

错误处理 ​

如果用户不存在,会抛出错误:

vb
On Error GoTo EH
m_oServer.SendToUser "bob", "Hello!"
Exit Sub
EH:
If Err.Number = vbObjectError Then
    MsgBox "用户不在线"
End If

👥 组管理 ​

组管理功能允许将用户分组,方便批量发送消息和管理。

前提条件 ​

绑定组之前,用户必须先绑定到客户端:

vb
' ✅ 正确流程:先绑定用户,再绑定组
m_oServer.BindUser "alice", Client
m_oServer.BindGroup "admins", Client

' ❌ 错误:用户未绑定,无法绑定组
m_oServer.BindGroup "admins", Client  ' 会报错

BindGroup 方法 ​

说明 ​

将已绑定用户的客户端加入指定组。

语法 ​

vb
Public Sub BindGroup(ByVal GroupName As String, Client As cWinsock)

参数 ​

参数类型说明
GroupNameString组名称
ClientcWinsock已绑定用户的客户端实例

使用示例 ​

vb
Private Sub m_oServer_DataArrival(Client As cWinsock, ByVal bytesTotal As Long)
    Dim sData As String
    Client.GetData sData
    
    ' 解析加入组请求,格式为 "JOIN_GROUP:groupname"
    If Left$(sData, 11) = "JOIN_GROUP:" Then
        Dim sGroup As String
        sGroup = Mid$(sData, 12)
        
        ' 检查用户是否已绑定
        If LenB(CStr(Client.CurrentUser)) = 0 Then
            Client.SendData "ERROR: Please login first"
            Exit Sub
        End If
        
        ' 加入组
        m_oServer.BindGroup sGroup, Client
        Client.SendData "JOIN_GROUP:OK:" & sGroup
        Debug.Print Client.CurrentUser & " 加入了组: " & sGroup
    End If
End Sub

同一用户多次加入同一组 ​

同一个用户可以多次调用 BindGroup 加入同一个组,但不会重复添加。


ExistsGroup 方法 ​

说明 ​

检查指定组是否存在。

语法 ​

vb
Public Function ExistsGroup(ByVal GroupName As String) As Boolean

使用示例 ​

vb
If m_oServer.ExistsGroup("admins") Then
    Debug.Print "管理员组存在,成员数: " & m_oServer.GetGroupMembers("admins").Count
Else
    Debug.Print "管理员组不存在"
End If

UnbindGroup 方法 ​

说明 ​

从指定组中移除用户。

语法 ​

vb
Public Sub UnbindGroup(ByVal GroupName As String, ByVal User As Variant)

使用示例 ​

vb
' 从组中移除用户
m_oServer.UnbindGroup "admins", "alice"

' 组长踢人
Private Sub m_oServer_DataArrival(Client As cWinsock, ByVal bytesTotal As Long)
    Dim sData As String
    Client.GetData sData
    
    If Left$(sData, 13) = "KICK_FROM_GROUP" Then
        Dim sGroup As String, sTarget As String
        sGroup = Mid$(sData, 14, InStr(sData, ":") - 14)
        sTarget = Mid$(sData, InStr(sData, ":") + 1)
        
        m_oServer.UnbindGroup sGroup, sTarget
        Debug.Print sTarget & " 已被移出组: " & sGroup
    End If
End Sub

自动清理 ​

当组内成员全部离开时,组会自动删除。


GetGroupMembers 方法 ​

说明 ​

获取指定组的所有成员用户名列表。

语法 ​

vb
Public Function GetGroupMembers(ByVal GroupName As String) As String()

返回值 ​

返回包含所有成员用户名的字符串数组。如果组不存在或为空,返回空数组。

使用示例 ​

vb
Dim aMembers() As String
Dim sMember As String

aMembers = m_oServer.GetGroupMembers("admins")

If UBound(aMembers) >= 0 Then
    Debug.Print "管理员组共有 " & (UBound(aMembers) + 1) & " 人:"
    For Each sMember In aMembers
        Debug.Print "  - " & sMember
    Next
Else
    Debug.Print "管理员组为空"
End If

SendToGroup 方法 ​

说明 ​

向指定组内的所有成员发送数据。

语法 ​

vb
Public Sub SendToGroup(ByVal GroupName As String, Data As Variant, Optional ByVal CodePage As EnumScpCodePage = wcpAcp)

参数 ​

参数类型说明
GroupNameString组名称
DataVariant要发送的数据
CodePageEnumScpCodePage(可选)文本编码

使用示例 ​

vb
' 发送群消息
m_oServer.SendToGroup "developers", "各位同事,下午3点有技术分享会"

' 广播系统公告给所有组
Dim sGroup As Variant
For Each sGroup In m_oServer.m_Groups.Keys
    m_oServer.SendToGroup CStr(sGroup), "【系统公告】服务器将在10分钟后重启"
Next

智能处理 ​

  • 如果组不存在,不发送任何数据
  • 如果组内某些用户已离线,会自动跳过,只发送给在线用户

GetUserGroups 方法 ​

说明 ​

获取指定用户所属的所有组的列表。

语法 ​

vb
Public Function GetUserGroups(ByVal User As Variant) As String()

返回值 ​

返回包含所有组名的字符串数组。

使用示例 ​

vb
' 查看用户所在的组
Dim aGroups() As String
Dim sGroup As String

aGroups = m_oServer.GetUserGroups("alice")

If UBound(aGroups) >= 0 Then
    Debug.Print "alice 属于以下组:"
    For Each sGroup In aGroups
        Debug.Print "  - " & sGroup
    Next
Else
    Debug.Print "alice 不在任何组中"
End If

DeleteGroup 方法 ​

说明 ​

解散指定组,从所有成员的 CurrentGroups 中同步删除该组。

语法 ​

vb
Public Sub DeleteGroup(ByVal GroupName As String)

使用示例 ​

vb
' 解散组
m_oServer.DeleteGroup "temp_group"
Debug.Print "组已解散"

' 管理员解散组
Private Sub m_oServer_DataArrival(Client As cWinsock, ByVal bytesTotal As Long)
    Dim sData As String
    Client.GetData sData
    
    If Left$(sData, 12) = "DELETE_GROUP" Then
        Dim sGroup As String
        sGroup = Mid$(sData, 14)
        
        If m_oServer.ExistsGroup(sGroup) Then
            m_oServer.DeleteGroup sGroup
            Debug.Print "组 " & sGroup & " 已被解散"
        End If
    End If
End Sub

同步机制 ​

解散组时,系统会自动遍历所有组成员,从每个成员的 CurrentGroups 中移除该组名。


CloseUser 方法 ​

说明 ​

强制下线指定用户,关闭其客户端连接。

语法 ​

vb
Public Sub CloseUser(ByVal User As Variant)

使用示例 ​

vb
' 踢出指定用户
m_oServer.CloseUser "alice"
Debug.Print "用户已下线"

' 管理员踢人
Private Sub m_oServer_DataArrival(Client As cWinsock, ByVal bytesTotal As Long)
    Dim sData As String
    Client.GetData sData
    
    If Left$(sData, 5) = "KICK:" Then
        Dim sTarget As String
        sTarget = Mid$(sData, 6)
        
        If m_oServer.ExistsUser(sTarget) Then
            m_oServer.CloseUser sTarget
            Debug.Print sTarget & " 已被管理员踢出"
        End If
    End If
End Sub

清理流程 ​

调用 CloseUser 会触发客户端的 Class_Terminate,自动完成以下清理:

  • 从所有组中解绑
  • 从用户列表中移除
  • 清空 CurrentGroups

🔧 内部方法 ​

以下方法是内部使用的方法,通常不需要直接调用:

UnbindUserFromAllGroups ​

将用户从所有组中解绑(由 Class_Terminate 调用,用户断开连接时自动触发)。会同步更新客户端的 CurrentGroups。


📊 数据结构与同步机制 ​

服务器端存储结构 ​

m_Users (Dictionary)
  └── 用户名 → cWinsock 客户端实例

m_Groups (Dictionary)
  └── 组名 → Dictionary(用户名 → True)

客户端实例属性 ​

CurrentUser (Variant)
  └── 绑定的用户名

CurrentUserToken (String)
  └── 用户认证令牌(BindUser 时传入的 Token)

CurrentUserInfo (cJson)
  └── 用户扩展信息(BindUser 时传入的 Info)

CurrentGroups (Dictionary)
  └── 组名 → True

双向同步 ​

所有组操作都会自动同步服务器端和客户端的数据:

操作服务器端客户端
BindGroup添加到 m_Groups[组名]添加到 CurrentGroups
UnbindGroup从 m_Groups[组名] 移除从 CurrentGroups 移除
DeleteGroup删除 m_Groups[组名]从所有成员 CurrentGroups 移除
UnbindUserFromAllGroups从所有组移除用户清空 CurrentGroups

📊 自动清理机制 ​

用户断开时的清理流程 ​

当客户端断开连接时,系统会自动执行以下清理:

1. 客户端 Close_() 或 Class_Terminate() 被调用
2. 检查 CurrentUser 是否为空
3. 如果不为空:
   a. 调用 UnbindUserFromAllGroups() 从所有组移除
   b. 调用 UnbindUser() 从用户列表移除
   c. 清空 CurrentGroups
   d. 清空 CurrentUser
   e. 清空 CurrentUserToken(置为空字符串)
   f. 清空 CurrentUserInfo(调用 Clear)

内存管理注意事项 ​

用户绑定功能使用 Dictionary 存储用户和组的引用。为避免内存泄漏:

  1. 始终通过服务器对象绑定和解绑:不要直接操作内部的 m_Users 和 m_Groups
  2. 使用 RemoveClient:客户端断开时应调用服务器的 RemoveClient 方法
  3. 避免循环引用:服务器持有客户端引用,客户端持有父服务器引用(通过 ParentServer)

💬 完整聊天服务器示例 ​

vb
' 服务器端完整示例
Dim WithEvents m_oServer As cWinsock

Private Sub Form_Load()
    Set m_oServer = New cWinsock
    m_oServer.Protocol = sckTCPProtocol
    m_oServer.Listen 8080
End Sub

' 处理连接请求
Private Sub m_oServer_ConnectionRequest(Client As cWinsock, ByRef DisConnect As Boolean)
    Debug.Print "新连接: " & Client.RemoteHostIP
End Sub

' 处理数据到达
Private Sub m_oServer_DataArrival(Client As cWinsock, ByVal bytesTotal As Long)
    Dim sData As String
    Client.GetData sData
    
    ' 解析命令
    Select Case Left$(sData, InStr(sData, ":") - 1)
        Case "LOGIN"
            HandleLogin Client, Mid$(sData, 7)
            
        Case "JOIN_GROUP"
            HandleJoinGroup Client, Mid$(sData, 12)
            
        Case "MSG"
            HandleMessage Client, Mid$(sData, 5)
            
        Case "BROADCAST"
            HandleBroadcast Client, Mid$(sData, 11)
    End Select
End Sub

Private Sub HandleLogin(Client As cWinsock, ByVal sUsername As String)
    If m_oServer.ExistsUser(sUsername) Then
        Client.SendData "LOGIN:ERROR:User already logged in"
        Exit Sub
    End If
    
    ' 绑定用户,附带 Token 和扩展信息
    Dim oInfo As New cJson
    oInfo.Add "loginTime", Now
    oInfo.Add "ip", Client.RemoteHostIP
    m_oServer.BindUser sUsername, Client, "secret_token_123", oInfo
    
    Client.SendData "LOGIN:OK"
    Debug.Print sUsername & " 登录成功,Token: " & Client.CurrentUserToken
End Sub

Private Sub HandleJoinGroup(Client As cWinsock, ByVal sGroup As String)
    If LenB(CStr(Client.CurrentUser)) = 0 Then
        Client.SendData "ERROR:Please login first"
        Exit Sub
    End If
    
    m_oServer.BindGroup sGroup, Client
    Client.SendData "JOIN_GROUP:OK:" & sGroup
    Debug.Print Client.CurrentUser & " 加入组: " & sGroup
End Sub

Private Sub HandleMessage(Client As cWinsock, ByVal sMsg As String)
    If LenB(CStr(Client.CurrentUser)) = 0 Then
        Client.SendData "ERROR:Please login first"
        Exit Sub
    End If
    
    ' 向所有组员发送消息
    m_oServer.SendToGroup "general", Client.CurrentUser & ": " & sMsg
End Sub

Private Sub HandleBroadcast(Client As cWinsock, ByVal sMsg As String)
    If LenB(CStr(Client.CurrentUser)) = 0 Then
        Client.SendData "ERROR:Please login first"
        Exit Sub
    End If
    
    ' 向所有组广播
    Dim sGroup As Variant
    For Each sGroup In m_oServer.m_Groups.Keys
        m_oServer.SendToGroup CStr(sGroup), "[广播] " & Client.CurrentUser & ": " & sMsg
    Next
End Sub

' 处理客户端断开
Private Sub m_oServer_CloseEvent(Client As cWinsock)
    If LenB(CStr(Client.CurrentUser)) <> 0 Then
        Debug.Print Client.CurrentUser & " 已离线"
        ' 无需手动解绑,系统会自动处理
    End If
End Sub

最后更新: 2026-04-26

VB6及其LOGO版权为微软公司所有