frmicqserver.frm

计算机网络与通信的知识

                DoEvents
            Loop Until .blnSendComplete
                '+++++++++++++++/////////////////////
        End If
    End With
Next intTp
lstEventLog.AddItem CStr(Now) + " ICQ服务器给所有用户发送公共信息！"
txtPublic.Text = ""
Exit Sub
WSK_SERVER_ERR:
    wskServerErr intTp
End Sub

'=================================
'   载入窗体
'=================================
Private Sub Form_Load()
Set obtWskLink = New clsWskChainQueue
Set obtExeCommand = New clsWskCommandProcess
          '设置客户端命令分隔符和服务器返回命令结果分隔符
obtExeCommand.SetCommandDiv strCommandDiv, CmdResultDiv
InitLinkUserArray   '初始化用户数组
        '####################################################################
        '#       连接多用户，服务器全局只在此处设置wskServer(0)为侦听状态， #
        '#   其余地方不可设置                                               #
        '####################################################################
wskServer(0).LocalPort = 1001
wskServer(0).Listen
intAllUserNum = 0
fmeUser.Caption = "在线用户(0人)"
txtPrivate.Text = ""
txtPublic.Text = ""
ResizeInit Me
End Sub

Private Sub Form_Resize()
ResizeForm Me
End Sub

'=================================
'   卸  载  窗  体
'=================================
Private Sub Form_Unload(Cancel As Integer)
Set obtWskLink = Nothing
Set obtExeCommand = Nothing
End Sub

'==========================
' 注册用户查询
'==========================
Private Sub mnuFileAllUsers_Click()
frmAllUsers.Show
End Sub

'==========================
' 服务器退出
'==========================
Private Sub mnuFileExit_Click()
Unload Me
End Sub

'=================================
'   wskServer（0） 接受连接请求
'=================================
Private Sub wskServer_ConnectionRequest(Index As Integer, ByVal requestID As Long)
Dim intTp As Integer, intOldlen As Integer
If Index <> 0 Then Exit Sub
intOldlen = obtWskLink.LenWskChainQueue
intTp = obtWskLink.AllocateUsableWsk
Load wskServer(intTp)    '加载一个新的WinSock，分配给新的客户端连接，arrayLinkUser数组互动
If intTp > intOldlen Then ReDim Preserve arrayLinkUser(intTp)
With arrayLinkUser(intTp)
    .blnOnline = False
    .blnSendComplete = False
    .lngAccount = 0
    .strName = ""
End With
If wskServer(intTp).State <> sckClosed Then wskServer(intTp).Close
wskServer(intTp).LocalPort = 0
wskServer(intTp).Accept requestID  '新的winSock接受连接请求
End Sub
'============================================================================
'   wskServer 数据到达
'============================================================================
Private Sub wskServer_DataArrival(Index As Integer, ByVal bytesTotal As Long)
Dim strClientCommand As String

            '--------------------------------\
            '   接收客户端送来的命令
On Error GoTo WSK_SERVER_ERR
wskServer(Index).GetData strClientCommand, vbString
            '--------------------------------/

    '将客户端送来的命令提交命令层进行执行
obtExeCommand.CommandProcess Index, strClientCommand
Exit Sub
WSK_SERVER_ERR:
    wskServerErr Index
End Sub
'=================================
'   命令处理完毕事件
' 入口参数：
'     intSendToWskIdx  将客户端指令执行结果返回给相应客户端所对应的wskServer序号
'=================================
Private Sub obtExeCommand_CommandProcessFinish(ByVal intSendToWskIdx As Integer)
Dim strCmdResultFlag As String * 1, strCmdResult As String
Dim intTp As Integer

    '得到命令处理结果
strCmdResult = obtExeCommand.GetCommandResult
    '得到命令处理结果标志
strCmdResultFlag = Mid(strCmdResult, 1, CmdResultFlagNum)
    '在线用户退出单独处理
If strCmdResultFlag = UserExit Then
    SetEventLogUsersList ClientExit, wskServer(intSendToWskIdx).RemoteHostIP, arrayLinkUser(intSendToWskIdx).lngAccount, arrayLinkUser(intSendToWskIdx).strName
    UnloadWskServer intSendToWskIdx   '卸载相应的WskServer
    Exit Sub
End If
    '++++++++++++++++++++++++++++++++++++++++++++++++++++\\\\\\\\\\\\\\\\\\
    '               向客户端发送命令执行结果
    '*注意：必须有下面的DoEvents循环语句，并在wskServer_SendComplete事件中
    '改变发送完成标志blnSendComplete的值，以结束DoEvents循环，这样才能完成
    '一个完整的发送过程。
arrayLinkUser(intSendToWskIdx).blnSendComplete = False
On Error GoTo WSK_SERVER_ERR
wskServer(intSendToWskIdx).SendData strCmdResult
Do
    DoEvents
Loop Until arrayLinkUser(intSendToWskIdx).blnSendComplete
    '++++++++++++++++++++++++++++++++++++++++++++++++++++//////////////////
    
    '/////根据服务器端命令执行结果更改服务器端相应设置////
Select Case strCmdResultFlag
    Case UserRegister  '注册成功
            '置相应节点为在线标志
        arrayLinkUser(intSendToWskIdx).blnOnline = True
        arrayLinkUser(intSendToWskIdx).strName = obtExeCommand.GetName(arrayLinkUser(intSendToWskIdx).lngAccount)
            '++++++++++++++++++++++++++++++++++++++++++++\\\\\\\\\\\\\\\\\\
            '注册成功，给用户返回用户号
            '注释同上，完整的发送过程
        arrayLinkUser(intSendToWskIdx).blnSendComplete = False
        On Error GoTo WSK_SERVER_ERR
        wskServer(intSendToWskIdx).SendData UserRegisterAccount + CStr(arrayLinkUser(intSendToWskIdx).lngAccount)
        Do
            DoEvents
        Loop Until arrayLinkUser(intSendToWskIdx).blnSendComplete
            '+++++++++++++++++++++++++++++++++++++++++++++/////////////////
        SetEventLogUsersList ClientRegister, wskServer(intSendToWskIdx).RemoteHostIP, arrayLinkUser(intSendToWskIdx).lngAccount, arrayLinkUser(intSendToWskIdx).strName
    Case UserLogin  '登录成功
            '置相应节点为在线标志
        arrayLinkUser(intSendToWskIdx).blnOnline = True
        arrayLinkUser(intSendToWskIdx).strName = obtExeCommand.GetName(arrayLinkUser(intSendToWskIdx).lngAccount)
        SetEventLogUsersList ClientLogin, wskServer(intSendToWskIdx).RemoteHostIP, arrayLinkUser(intSendToWskIdx).lngAccount, arrayLinkUser(intSendToWskIdx).strName
    Case UserOnline, UserNoExist, UserPwdErr, UserNoRegister  '假如用户登录或注册失败
        UnloadWskServer intSendToWskIdx
End Select
Exit Sub
WSK_SERVER_ERR:
    wskServerErr intSendToWskIdx
End Sub


'=================================
'   wskServer 发送完成事件
'=================================
Private Sub wskServer_SendComplete(Index As Integer)
arrayLinkUser(Index).blnSendComplete = True   '更改发送完成标志
End Sub
'===================================
' 设置事件列表 和 在线用户列表(自定义)
'===================================
Private Sub SetEventLogUsersList(ByVal strFlag As String, _
                                 ByVal strClientIP As String, _
                                 ByVal lngAccount As Long, _
                                 ByVal strName As String)
Dim strTp As String, strLst As String
Dim intTp As Integer, intC As Integer, intF As Integer

intF = 1
Select Case strFlag
    Case ClientLogin
        strTp = " 成功登录！"
    Case ClientRegister
        strTp = " 注册成功！"
    Case ClientExit
        strTp = " 退出ICQ网络系统！"
        intF = -1
End Select
strLst = strName + "(" + CStr(lngAccount) + ")"
lstEventLog.AddItem CStr(Now) + " IP地址为 " + strClientIP + " 的用户 " + strLst + strTp
If strFlag = ClientExit Then
    intC = lstUsers.ListCount - 1
    For intTp = 0 To intC
        If StrComp(lstUsers.List(intTp), strLst) = 0 Then Exit For
    Next intTp
    lstUsers.RemoveItem intTp
Else
    lstUsers.AddItem strLst
End If
intAllUserNum = intAllUserNum + intF
fmeUser.Caption = "在线用户(" + CStr(intAllUserNum) + "人)"
End Sub
'=======================================
' 卸载WskServer(Index)，并调整连接数组
'=======================================
Private Sub UnloadWskServer(ByVal Index As Integer)
Dim intTp As Integer
Unload wskServer(Index)   '无条件卸载新连接的wskServer
obtWskLink.RecycleUnUsedWsk Index   '回收新连接的wskServer标号
intTp = obtWskLink.LenWskChainQueue
     '及时调整 用户连接数组arrayLinkUser 的大小 或节点状态
If obtWskLink.CompressArray Then
    ReDim Preserve arrayLinkUser(intTp)
Else
    With arrayLinkUser(Index)
        .blnOnline = False
        .lngAccount = 0
        .blnSendComplete = False
        .strName = ""
    End With
End If
End Sub
'================================
' 得到注册用户查询字符串
' 给 frmAllUsers 传递
'================================
Public Function GetAllUsers() As String
GetAllUsers = obtExeCommand.GetAllUsers
End Function
'============================
' 服务器和客户端通讯出错
'============================
Private Sub wskServerErr(ByVal intIdx As Integer)
Dim strTp As String
Dim intLstUserIdx As Integer, intTp As Integer

strTp = arrayLinkUser(intIdx).strName + "(" + CStr(arrayLinkUser(intIdx).lngAccount) + ")"
For intTp = 0 To lstUsers.ListCount - 1
    If StrComp(strTp, lstUsers.List(intTp), vbTextCompare) = 0 Then Exit For
Next intTp
lstEventLog.AddItem CStr(Now) + " 服务器和用户 " + strTp + " 的通讯出现故障！删除用户 " + strTp
lstUsers.RemoveItem intTp
intAllUserNum = intAllUserNum - 1
fmeUser.Caption = "在线用户(" + CStr(intAllUserNum) + "人)"
UnloadWskServer intIdx
End Sub