日期:2013-06-13  浏览次数:20962 次

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
 &n