wuziserver.frm

vb游戏程序代码

    TalkStyle = Index
End Sub


'下面为管理员的发送信息
Private Sub Send_Click()
If MessageSend.Text <> "" Then
    If Left(MessageSend.Text, 1) <> "/" Then
        Select Case TalkStyle
            Case 0
                For i = 1 To MaxConnect
                    If UsersConnect(i) Then
                        Winsocks(i).SendData "/3:" & MessageSend.Text
                        DoEvents
                    End If
                Next i
                
            Case 1
                tempname = List(UserName.ListIndex)
                For j = 1 To MaxConnect
                    If UsersConnect(j) Then
                        If UserInformation(j).NickName = tempname Then
                            Winsocks(j).SendData "/4:管理员<只对你说>" & MessageSend.Text
                            Exit For
                        End If
                    End If
                Next j
                
        End Select
                

End Sub

'当有用户连接上时发生的事件
Private Sub TCP1_ConnectionRequest(ByVal requestID As Long)

Dim i As Long
'MaxConnect为最大连接数

For i = 1 To MaxConnect
    '利用usersconnect（i）数组来保存winsock控件数组得使用情况
    If Not UsersConnect(i) Then
        UsersConnect(i) = True
        Exit For
    End If
    
Next i

If i > MaxConnect Then
    Exit Sub
End If

'winsocks（i）为控件数组
Load Winsocks(i)

If Winsocks(i).State <> sckClosed Then
    Winsocks(i).Close
End If
Winsocks(i).Accept requestID

'实际登陆人数
UserId = UserId + 1

'实际建立连接
'Winsocks(i).Accept requestID

'开始发送数据,发送某个用户的索引号
Winsocks(i).SendData "/0:" & i


    
End Sub



'Private Sub Wuziserver_ConnectionRequest _
'(Index As Integer, ByVal requestID As Long)
'   If Index = 0 Then
'      intMax = intMax + 1
'      Load sckServer(intMax)
'      sckServer(intMax).LocalPort = 0
'      sckServer(intMax).Accept requestID
'      Load txtData(intMax)
'   End If
'End Sub


'显示上网用户
Private Sub Users_Click()
For i = 1 To MaxConnect
    If UsersConnect(i) Then
        MessageBox.Text = MessageBox.Text + UserInformation(i).NickName + Chr$(13) + Chr$(10)
        UserName.AddItem UserInformation(i).NickName
    End If
Next
End Sub

Private Sub Winsocks_Close(Index As Integer)
'关闭连接
    Winsocks(Index).Close
    
'卸栽winsock控件
    Unload Winsocks(Index)
    UsersConnect(Index) = False
    For i = 1 To MaxConnect
        If UsersConnect(i) Then
            Winsocks(i).SendData "/Q:" & UserInformation(Index).NickName
            DoEvents
        End If
    Next i
    
End Sub

Private Sub Winsocks_DataArrival(Index As Integer, ByVal bytesTotal As Long)
Dim Information As String
'Dim TempNum As Integer
Dim TempNum1 As Integer
Dim Alluser As String
Alluser = ""

Winsocks(Index).GetData Information

'提取出功能字符
If Left(Information, 1) = "/" Then
   Select Case Mid$(Information, 2, 1)
        '如果是1,表示某人注册上网
        Case 1
           
            TempNum1 = InStr(1, Information, ":", vbTextCompare)
            UserInformation(Index).NickName = Mid$(Information, TempNum1 _
            + 1, InStr(TempNum1 + 1, Information, ":", vbTextCompare) - _
            TempNum1 - 1)
            
            TempNum1 = InStr(TempNum1 + 1, Information, ":", vbTextCompare)
            UserInformation(Index).PassWord = Mid$(Information, TempNum1 _
            + 1, InStr(TempNum1 + 1, Information, ":", vbTextCompare) - _
            TempNum1 - 1)
            
            TempNum1 = InStr(TempNum1 + 1, Information, ":", vbTextCompare)
            UserInformation(Index).EMail = Mid$(Information, TempNum1 + 1)
            
            UserInformation(Index).UserNumber = Index
            
            
            UserInformation(Index).IpAddress = TCP1.RemoteHostIP
            
            Winsocks(Index).SendData "/1:" & UserId
            DoEvents
            
            For i = 1 To MaxConnect
                If UsersConnect(i) Then
                    Winsocks(i).SendData "/R:" & UserInformation(Index).NickName
                    DoEvents
                End If
            Next i
            
            MessageBox.Text = MessageBox.Text & UserInformation(Index).NickName & _
             "注册上网！" & "------" & Format(Time, "hh:mm:ss") & Chr(13) & Chr(10)
        '如果是2,则表示某个用户正在请求查看所有网上用户
        Case 2
            For i = 1 To MaxConnect
                If UsersConnect(i) Then
                    Alluser = Alluser + UserInformation(i).NickName & Format(i, "000") & "|"
                End If
            Next
            If Alluser <> "" Then
                Winsocks(Index).SendData "/2:" & Alluser
            Else
                Winsocks(Index).SendData "/2:现在没有用户"
            
            End If
            
            MessageBox.Text = MessageBox.Text & UserInformation(Index).NickName & _
                            "查看全体用户" & "------" & Format(Time, "hh:mm:ss") & _
                            Chr(13) & Chr(10)
            
                            
        '表示某个用户正在shout    
        Case 3
            
            MessageBox.Text = MessageBox.Text & Mid$(Information, 4) & _
            Chr$(13) & Chr$(10)
            For i = 1 To MaxConnect
                If UsersConnect(i) Then
                        
                        Winsocks(i).SendData "/3:" & Mid$(Information, 4) & _
                        Chr$(13) & Chr$(10)
                        DoEvents
                End If
            Next
            
            
        '表示某个用户想对另外一个人私聊    
        Case 4
            
            talkto = CInt(Right(Information, 3))
            
            If UsersConnect(talkto) Then
                Winsocks(talkto).SendData "/4:" & Mid$(Information, _
                    4, Len(Information) - 6)
                
                DoEvents
                
                Winsocks(Index).SendData "/4:" & Mid$(Information, _
                    4, Len(Information) - 6)
                MessageBox.Text = MessageBox.Text & _
                    Mid$(Information, 4, Len(Information) - 6) & _
                    "------" & Format(Time, "hh:mm:ss") & Chr$(13) & Chr$(10)
                    
               
                    

            Else
                Winsocks(Index).SendData "/4:对不起,你聊天的对象已" & _
                "经下网!"
                MessageBox.Text = MessageBox.Text & _
                    Mid$(Information, 4, Len(Information) - 6) & _
                    "(对方已经下网)" & "------" & _
                    Chr$(13) & Chr$(10)

            End If
            
        '表示有人在某个棋局上chat
        Case 5
            Dim WatchQiJu As Integer
            
            WatchQiJu = CInt(Right$(Information, 3))
            For i = 1 To MaxConnect
                If Buffer(i) <> "" Then
                    If CInt(Left$(Buffer(i), 3)) = WatchQiJu Then
                       For j = 1 To MaxConnect
                            If PlayInfoNum(j) = i Then
                                For k = 1 To MaxConnect
                                   If Watchers(j, k) <> 0 Then
                                        Winsocks(k).SendData "/5:" & _
                                        Mid$(Information, 4, InStr(4, Information, ":", vbTextCompare) - 4)
                                    End If
                                Next k
                            Exit For
                            End If
                        Next j
                     Exit For
                     End If
                End If
            Next i
                            
            MessageBox.Text = MessageBox.Text & _
            UserInformation(Index).NickName & "<chat>" & Mid$(Information, _
            4, InStr(4, Information, ":", vbTextCompare) - 4) & "-----" & _
            Format(Time, "000") & Chr(10) & Chr(13)
            
            
        '找个对手下棋
        Case "P"
            Onename = Mid$(Information, 4, InStr(4, Information, _
            ":", vbTextCompare) - 4)
            num1 = InStr(4, Information, ":", vbTextCompare)
            opponentnum = CInt(Mid$(Information, num1 + 1, InStr(num1 + 1, Information, _
                ":", vbTextCompare) - num1 - 1))
                
            'OpponentPlayNum数组用来记录对手的用户代号,比如1的对手为2,则
            OpponentPlayNum(Index) = opponentnum
            OpponentPlayNum(opponentnum) = Index
            
            num1 = InStr(num1 + 1, Information, _
                ":", vbTextCompare)
            Playstyle = CInt(Mid$(Information, num1 + 1, InStr(num1 + 1, Information, _
                ":", vbTextCompare) - num1 - 1))
            num1 = InStr(num1 + 1, Information, _
                ":", vbTextCompare)
            
            choosecolor = Mid$(Information, num1 + 1)
            
            
            If UsersConnect(opponentnum) Then
                If EveryOnePlaying(OpponentPlayNum(Index)) = False Then
                    Winsocks(opponentnum).SendData "/P:" & Onename & ":" & Playstyle & ":" & choosecolor
                    UserInformation(Index).PlayColor = choosecolor
                
                    MessageBox.Text = MessageBox.Text & UserInformation(Index).NickName & "找" & _
                    UserInformation(opponentnum).NickName & "对局!" & "------" & _
                    Chr(10) & Chr(13)
                
                Else