另一控件 fiveserver

Option Explicit
Public HostIp As String
Public HostPort As String
'服务器启动的时间
Dim StartTime As Date
'登录到服务器的玩家人数
Dim VisitNum As Integer
'定义可登录的最大玩家数
Const MaxConnect = 20
'定义记录已经加载的winsock控件数
Dim WsockNum As Integer
'定义存储玩家信息的数组
Dim mUser(MaxConnect) As userInfo
'定义存储棋局信息的数组
Dim mtwoUser(MaxConnect / 2) As twoUser

Private Sub TcpWsock_ConnectionRequest(ByVal requestID As Long)
Dim i As Long
i = 1
Dim free As Boolean
free = False
'wsocknum为目前已经加载的winsock的数目
'在已经加载的控件数组中检查没有链接的控件
For i = 1 To WsockNum
    If Wsock(i).State = sckClosed Then
        free = True
        Exit For
    End If
Next i
'MaxConnect为最大连接数，如果已经加载的winsock控件达到最大，退出
If WsockNum = MaxConnect And free = False Then
    Exit Sub
End If
'如果所有已经加载的winsock控件都在连接，加载新的控件
If free = False Then
    'wsock（i）为控件数组
    WsockNum = WsockNum + 1
    Load Wsock(WsockNum)
    i = WsockNum
End If
If Wsock(i).State <> sckClosed Then
    Wsock(i).Close
End If
Wsock(i).Accept requestID
Wsock(i).SendData "/LgOn你已经连上BusyAnts的五子棋服务器了"
'保存玩家的上站时间、ip地址
mUser(i).mLogonTime = Now()
'登录到服务器的玩家人数+1
VisitNum = VisitNum + 1
mUser(i).muserIP = Wsock(i).RemoteHostIP
mUser(i).mConnected = True
End Sub

Private Sub txtTalk_Change()
If Len(txtTalk.Text) > 1000 Then
    txtTalk.Text = ""
End If
End Sub

Private Sub UserControl_Initialize()
'利用tcpwsock侦听是否有客户端的请求
HostIp = TcpWsock.LocalIP
TcpWsock.LocalPort = 1001
HostPort = 1001
TcpWsock.Listen
WsockNum = 1
VisitNum = 0
StartTime = Now()
End Sub

Private Sub Wsock_Close(Index As Integer)
'与玩家的连接中断的处理
Wsock(Index).Close
'清理保存玩家状态的变量
mUser(Index).moppIndex = 0
mUser(Index).mConnected = False
If mtwoUser(mUser(Index).mIndex).Fight = True Then
    mtwoUser(mUser(Index).mIndex).Fight = False
    '如果断线的玩家正在下棋，则以下的程序通知对手自己已经退出系统了
    If mtwoUser(mUser(Index).mIndex).moppIndex1 = Index Then
        mUser(mtwoUser(mUser(Index).mIndex).moppIndex2).mIndex = 0
        Wsock(mtwoUser(mUser(Index).mIndex).moppIndex2).SendData "/Quit"
    Else
        mUser(mtwoUser(mUser(Index).mIndex).moppIndex1).mIndex = 0
        Wsock(mtwoUser(mUser(Index).mIndex).moppIndex1).SendData "/Quit"
    End If
    mUser(mtwoUser(mUser(Index).mIndex).moppIndex1).mIndex = 0
End If
mUser(Index).mIndex = 0
SendtoAll mUser(Index).nickName & "离开了BusyAnts五子棋系统"
txtTalk.Text = txtTalk.Text & "（" & Time() & "）" & mUser(Index).nickName & "离开了BusyAnts五子棋系统" & vbCrLf
End Sub


Private Sub Wsock_DataArrival(Index As Integer, ByVal bytesTotal As Long)
Dim Information As String
Dim i As Integer
Dim tempStr As String
Dim pos As Integer
Wsock(Index).GetData Information
Dim header As String
header = Left$(Information, 5)
Select Case header
    Case "/Call"
    '客户端呼叫处理
        Dim callName As String
        callName = Mid(Information, 6)
        For i = 1 To MaxConnect
            If mUser(i).nickName = callName And mUser(i).mConnected = True Then
                Exit For
            End If
        Next
        If i > MaxConnect Then
            Wsock(Index).SendData "/Play" & "NO" & Index & ";没有此人！！"
            Exit Sub
        End If
        If mtwoUser(mUser(i).mIndex).Fight = True Then
        '如果对手正与他人进行比赛，则通知呼叫者该玩家不能与他进行比赛
            Wsock(Index).SendData "/Play" & "NO" & Index & ";" & callName & "已经与别人进行比赛了！！"
        Else
            Wsock(i).SendData "/Call" & mUser(Index).nickName & ";" & Index
        End If
        txtTalk.Text = txtTalk.Text & "（" & Time() & "）" & mUser(Index).nickName & "呼叫" & callName & "与他下棋。" & vbCrLf
    Case "/FndP"
    Case "/Talk"
        '发送谈话内容
        tempStr = Mid(Information, 6, Len(Information) - 5)
        txtTalk.Text = txtTalk.Text & "（" & Time() & "）" & mUser(Index).nickName & "：" & tempStr & vbCrLf
        SendtoAll mUser(Index).nickName & "：" & tempStr
    Case "/ToSg"
        '只是与对手聊天
        tempStr = Mid(Information, 6, Len(Information) - 5)
        txtTalk.Text = txtTalk.Text & "（" & Time() & "）" & mUser(Index).nickName & "：" & tempStr & vbCrLf
        If mUser(Index).mIndex > 0 Then
            Wsock(mUser(Index).moppIndex).SendData mUser(Index).nickName & "：" & tempStr
        End If
    Case "/Data"
    '接收对方下子后的位置
        Wsock(mUser(Index).moppIndex).SendData Information
        '查询是否有观战者，如果有则将下棋的结果发送给他
        DoEvents
        For i = 1 To WsockNum
            If mUser(i).mLook = True And mUser(i).mIndex = mUser(Index).mIndex Then
                Wsock(i).SendData Information
                DoEvents
            End If
        Next i
            
    Case "/Regi"
        '处理玩家注册请求
        pos = InStr(6, Information, ";")
        mUser(Index).nickName = Mid(Information, 6, pos - 6)
        mUser(Index).mColor = Mid(Information, pos + 1)
        Wsock(Index).SendData "/Regi" & "欢迎你进入BusyAnts五子棋系统" & mUser(Index).nickName & vbCrLf
        SendtoAll mUser(Index).nickName & "偷偷的进入了BusyAnts五子棋系统"
        txtTalk.Text = txtTalk.Text & "（" & Time() & "）" & mUser(Index).nickName & "偷偷的进入了BusyAnts五子棋系统" & vbCrLf
    Case "/LstP"
        '处理玩家请求列出登录者名单
        For i = 1 To MaxConnect
            If mUser(i).mConnected Then
'                If tempStr = "" Then
'                    tempStr = mUser(i).nickName
'                Else
                    If mUser(i).mIndex > 0 Then
                    '玩家是在某个棋局里
                        If mUser(i).mLook = True Then
                        '玩家在观看下棋
                            tempStr = tempStr & ";" & mUser(i).nickName & ":正在聚精会神的看" & mtwoUser(mUser(i).mIndex).mNickname1 & "与" & _
                            mtwoUser(mUser(i).mIndex).mNickname2 & "下棋"
                        Else
                            tempStr = tempStr & ";" & mUser(i).nickName & ":正在与" & mUser(mUser(i).moppIndex).nickName & "拼杀的难解难分！"
                        End If
                    Else
                        tempStr = tempStr & ";" & mUser(i).nickName & ":正在环顾四方，寻找好手比一高低。"
                    End If
                    
               ' End If
            End If
        Next i
        Wsock(Index).SendData "/User" & tempStr
        txtTalk.Text = txtTalk.Text & "（" & Time() & "）" & mUser(Index).nickName & "贼眉鼠眼地四周看了看，看来他想刺探玩家的情况" & vbCrLf
    Case "/Play"
    '处理玩家呼叫后响应
        pos = InStr(7, Information, ";")
        tempStr = Mid(Information, 6, 2)
        Dim mIndex As Integer
        mIndex = CInt(Mid(Information, 8, pos - 8))
        '在呼叫者等待对方回应的时候呼叫者有可能关机，
        '被呼叫者发送回来的信息要检查呼叫者是否断线
        If Wsock(mIndex).State <> sckClosed Then
            If tempStr = "OK" Then
                For i = 1 To MaxConnect / 2
                    If mtwoUser(i).Fight <> True Then
                        mtwoUser(i).Fight = True
                        mtwoUser(i).mNickname1 = mUser(Index).nickName
                        mtwoUser(i).moppIndex1 = Index
                        mtwoUser(i).mNickname2 = mUser(mIndex).nickName
                        mtwoUser(i).moppIndex2 = mIndex
                        mUser(Index).mIndex = i
                        mUser(mIndex).mIndex = i
                        mUser(Index).moppIndex = mIndex
                        mUser(mIndex).moppIndex = Index
                    Exit For
                    End If
                Next i
                mUser(Index).moppIndex = mIndex
                mUser(mIndex).moppIndex = Index
            End If
            Wsock(mIndex).SendData Information
            txtTalk.Text = txtTalk.Text & "（" & Time() & "）" & mUser(Index).nickName & "答应与" & mUser(mIndex).nickName & "下棋" & vbCrLf
        Else
            Wsock(Index).SendData "/Quit"
        End If
    Case "/AllP"
    '列出所有棋局对奕者名单
        For i = 1 To MaxConnect / 2
            If mtwoUser(i).Fight Then
                tempStr = tempStr & i & ":" & mtwoUser(i).mNickname1 & "和" & mtwoUser(i).mNickname2 & "对奕" & ";"
            End If
        Next i
        If tempStr = "" Then
            Wsock(Index).SendData "目前没有人在对奕"
        Else
            Wsock(Index).SendData "/AllP" & tempStr
        End If
    Case "/Quit"
        '玩家退出棋局
        Dim index1, index2 As Integer
        '取得棋局中对奕者的索引号
        index1 = mtwoUser(mUser(Index).mIndex).moppIndex1
        index2 = mtwoUser(mUser(Index).mIndex).moppIndex2
        '将棋局正在对奕标志设置为false
        mtwoUser(mUser(Index).mIndex).Fight = False
        '向对奕者发送退出棋局信息
        If Wsock(index1).State <> sckClosed Then
            Wsock(index1).SendData "/Quit"
        End If
        DoEvents
        If Wsock(index2).State <> sckClosed Then
            Wsock(index2).SendData "/Quit"
        End If
    Case "/Look"
        '玩家请求观战棋局
        mUser(Index).mLook = True
        '观战的棋局编号
        mUser(Index).mIndex = CInt(Mid(Information, 6))
        '向下棋玩家取得下棋的信息
        Wsock(mtwoUser(mUser(Index).mIndex).moppIndex1).SendData "/Grid" & Index
        txtTalk.Text = txtTalk.Text & "（" & Time() & "）" & mUser(Index).nickName & "观看其他玩家下棋" & vbCrLf
    Case "/Grid"
        pos = InStr(1, Information, ";")
        Dim toIndex As Integer
        toIndex = CInt(Mid(Information, 6, pos - 6))
        Wsock(toIndex).SendData "/GetG" & Mid(Information, pos + 1)
    Case "/QtLk"
    '处理玩家退出观战请求
        mUser(Index).mIndex = 0
        txtTalk.Text = txtTalk.Text & "（" & Time() & "）" & mUser(Index).nickName & "退出观战" & vbCrLf
End Select
End Sub

Private Sub SendtoAll(Message As String)
'将字符串message的信息发送给所有的玩家
Dim i As Integer
For i = 1 To MaxConnect
    If mUser(i).mConnected Then
        Wsock(i).SendData Message
        DoEvents
    End If
Next i
End Sub

Public Function GetAllPlayer()
Dim i As Integer
Dim retStr As String
'处理玩家请求列出登录者名单
For i = 1 To MaxConnect
    If mUser(i).mConnected Then
         If mUser(i).mIndex > 0 Then
         '玩家是在某个棋局里
             If mUser(i).mLook = True Then
             '玩家在观看下棋
                 retStr = retStr & ";" & mUser(i).nickName & ":正在聚精会神的看" & mtwoUser(mUser(i).mIndex).mNickname1 & "与" & _
                 mtwoUser(mUser(i).mIndex).mNickname2 & "下棋"
             Else
                 retStr = retStr & ";" & mUser(i).nickName & ":正在与" & mUser(mUser(i).moppIndex).nickName & "拼杀的难解难分！"
             End If
         Else
             retStr = retStr & ";" & mUser(i).nickName & ":正在环顾四方，寻找好手比一高低。"
         End If
    End If
Next i
GetAllPlayer = retStr
End Function

Public Function GetAllFight()
Dim i As Integer
Dim retStr
'列出所有棋局对奕者名单
For i = 1 To MaxConnect / 2
    If mtwoUser(i).Fight Then
        retStr = retStr & i & ":" & mtwoUser(i).mNickname1 & "和" & mtwoUser(i).mNickname2 & "对奕" & ";"
    End If
Next i
If retStr = "" Then
    GetAllFight = "目前没有人在对奕"
Else
    GetAllFight = retStr
End If
End Function


Public Function GetAllState()
'获得每个玩家的登录时间、ip地址的状态信息
Dim i As Integer
Dim retStr As String
For i = 1 To MaxConnect
    If mUser(i).mConnected Then
         retStr = retStr & mUser(i).nickName & ":" & mUser(i).mLogonTime & "," & mUser(i).muserIP & ";"
    End If
Next i
GetAllState = retStr
End Function

Private Sub Wsock_Error(Index As Integer, ByVal Number As Integer, Description As String, ByVal Scode As Long, ByVal Source As String, ByVal HelpFile As String, ByVal HelpContext As Long, CancelDisplay As Boolean)
Wsock(Index).Close
mUser(Index).mConnected = False
mUser(Index).mIndex = 0
mUser(Index).mLook = False
End Sub

Public Function GetMessage()
GetMessage = txtTalk.Text
End Function

Public Function GetStartTime() As String
GetStartTime = StartTime
End Function

Public Function GetVisitNum()
GetVisitNum = VisitNum
End Function