cWinsock 用户绑定与组管理
📋 功能概述
用户绑定和组管理功能提供了一套完整的用户身份管理和消息分发机制:
- 用户绑定:将用户身份与 socket 连接关联,支持按用户名发送消息
- 组管理:将用户分组,支持批量消息发送和管理操作
- 双向同步:组操作自动同步服务器端和客户端的
CurrentGroups - 自动清理:用户断开时自动解绑,无需手动处理
关键属性
| 属性 | 类型 | 说明 |
|---|---|---|
CurrentUser | Variant | 客户端实例上绑定的用户名 |
CurrentUserToken | String | 客户端实例上绑定的用户 Token(如认证令牌) |
CurrentUserInfo | cJson | 客户端实例上绑定的用户扩展信息(JSON 对象) |
CurrentGroups | Dictionary | 客户端实例上所属的组列表(组名 → True) |
👤 用户绑定
BindUser 方法
说明
将用户绑定到客户端连接,实现用户身份与 socket 连接的关联。
语法
vb
Public Sub BindUser(ByVal User As Variant, Client As cWinsock, Optional ByVal Token As String, Optional Info As cJson)参数
| 参数 | 类型 | 说明 |
|---|---|---|
User | Variant | 用户标识(字符串或其他唯一值) |
Client | cWinsock | 客户端 socket 实例 |
Token | String(可选) | 用户认证令牌,绑定后可通过 Client.CurrentUserToken 获取 |
Info | cJson(可选) | 用户扩展信息(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 SubExistsUser 方法
说明
检查指定用户是否已绑定。
语法
vb
Public Function ExistsUser(ByVal User As Variant) As Boolean使用示例
vb
If m_oServer.ExistsUser("alice") Then
Debug.Print "用户在线"
Else
Debug.Print "用户不在线"
End IfUnbindUser 方法
说明
解绑指定用户。
语法
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)参数
| 参数 | 类型 | 说明 |
|---|---|---|
User | Variant | 用户标识 |
Data | Variant | 要发送的数据(字符串或字节数组) |
CodePage | EnumScpCodePage(可选) | 文本编码,默认 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)参数
| 参数 | 类型 | 说明 |
|---|---|---|
GroupName | String | 组名称 |
Client | cWinsock | 已绑定用户的客户端实例 |
使用示例
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 IfUnbindGroup 方法
说明
从指定组中移除用户。
语法
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 IfSendToGroup 方法
说明
向指定组内的所有成员发送数据。
语法
vb
Public Sub SendToGroup(ByVal GroupName As String, Data As Variant, Optional ByVal CodePage As EnumScpCodePage = wcpAcp)参数
| 参数 | 类型 | 说明 |
|---|---|---|
GroupName | String | 组名称 |
Data | Variant | 要发送的数据 |
CodePage | EnumScpCodePage(可选) | 文本编码 |
使用示例
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 IfDeleteGroup 方法
说明
解散指定组,从所有成员的 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 存储用户和组的引用。为避免内存泄漏:
- 始终通过服务器对象绑定和解绑:不要直接操作内部的
m_Users和m_Groups - 使用 RemoveClient:客户端断开时应调用服务器的
RemoveClient方法 - 避免循环引用:服务器持有客户端引用,客户端持有父服务器引用(通过
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