wuziserver.frm

vb编程+从基础到实践光盘代码

            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") & vbCrLf
        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") & _
                            vbCrLf
            
                            
            
        Case 3
            
            MessageBox.Text = MessageBox.Text & Mid$(Information, 4) & _
            vbCrLf
            For i = 1 To MaxConnect
                If UsersConnect(i) Then
                        
                        Winsocks(i).SendData "/3:" & Mid$(Information, 4) & _
                        vbCrLf
                        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") & vbCrLf
                    
               
                    

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

            End If
            
            
        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(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
                    Winsocks(Index).SendData "/N:" & "对不起,对方已经参加了一个棋局!"
                
                    MessageBox.Text = MessageBox.Text & UserInformation(Index).NickName & "找" & _
                    UserInformation(opponentnum).NickName & "对局!(对方已经参加一个棋局)" & "------" & _
                    Chr(10) & Chr(13)
                
                End If
            
            Else
                Winsocks(Index).SendData "/N:对方不在网上!"
                
                MessageBox.Text = MessageBox.Text & UserInformation(Index).NickName & "找" & _
                UserInformation(opponentnum).NickName & "对局!(对方不在)" & "------" & _
                Chr(10) & Chr(13)
                
            End If
            
            
            
        
        '对方对你请战的态度
        Case "A"
            Onename = Mid$(Information, 4, InStr(4, Information, _
            ":", vbTextCompare) - 4)
            num1 = InStr(4, Information, ":", vbTextCompare)
            
            Anothername = Mid$(Information, num1 + 1, InStr(num1 + 1, Information, ":", vbTextCompare) - num1 - 1)
            
            num1 = InStr(num1 + 1, Information, ":", vbTextCompare)
            answernum = CInt(Mid$(Information, num1 + 1))
            
            For i = 1 To MaxConnect
                If UsersConnect(i) Then
                    If UserInformation(i).NickName = Onename Then
                        opponentnum = UserInformation(i).UserNumber
                        Exit For
                    End If
                End If
            Next
            
            If answernum = 1 Then
                TotalQiJuShu = TotalQiJuShu + 1
                
                UserInformation(Index).QiJuNum = TotalQiJuShu
                UserInformation(OpponentPlayNum(Index)).QiJuNum = TotalQiJuShu
                EveryOnePlaying(Index) = True
                EveryOnePlaying(OpponentPlayNum(Index)) = True
                
                For i = 1 To MaxConnect
                    If Buffer(i) = "" Then
                        Buffer(i) = Format(TotalQiJuShu, "000") & ":"
                        PlayInfoNum(Index) = i
                        PlayInfoNum(OpponentPlayNum(Index)) = i
                        Exit For
                    End If
                Next i
                
                If CInt(UserInformation(OpponentPlayNum(Index)).PlayColor) = 0 Then
                    
                     UserInformation(Index).PlayColor = "1"
                Else
                     UserInformation(Index).PlayColor = "0"
                     
                End If
                
                MessageBox.Text = MessageBox.Text & UserInformation(Index).NickName & _
                "接受" & UserInformation(OpponentPlayNum(Index)).NickName & _
                "的挑战" & "------" & Format(Time, "hh:mm:ss") & Chr(10) & Chr(13)
                
            Else
               
                UserInformation(OpponentPlayNum(Index)).PlayColor = ""
                OpponentPlayNum(Index) = 0
                OpponentPlayNum(opponentnum) = 0
                
                MessageBox.Text = MessageBox.Text & UserInformation(Index).NickName & _
                "不接受" & UserInformation(OpponentPlayNum(Index)).NickName & _
                "的挑战" & "------" & Format(Time, "hh:mm:ss") & Chr(10) & Chr(13)

               
            End If
                
            Winsocks(opponentnum).SendData "/A:" & answernum & ":" & Anothername
          
                        
            
          Case "D"
                Dim X As Integer
                Dim Y As Integer
                Dim TempNum5 As Integer
                Dim TempNum6 As Integer
                
                X = CInt(Mid$(Information, 4, InStr(4, _
                Information, ":", vbTextCompare) - 4))
           
                TempNum5 = InStr(4, Information, ":", vbTextCompare)
                TempNum6 = InStr(TempNum5 + 1, Information, ":", vbTextCompare)
                
                Y = CInt(Mid$(Information, TempNum5 + 1, TempNum6 - TempNum5 - 1))
                
                Buffer(PlayInfoNum(Index)) = Buffer(PlayInfoNum(Index)) & _
                Format(Str(X), "00") & "-" & Format(Str(Y), "00") & ":"
                
                
                Histime = Mid$(Information, TempNum6 + 1)
                Winsocks(OpponentPlayNum(Index)).SendData _
                "/D:" & Str(X) & ":" & Str(Y) & ":" & Histime
                DoEvents
                
                For i = 1 To MaxConnect
                    If Watchers(Index, i) <> 0 Then
                  
                        Winsocks(Watchers(Index, i)).SendData _
                        "/S:" & Format(Str(X), "00") & ":" & Format(Str(Y), "00")
                        DoEvents
                    End If
                Next i
                      
                
                
            Case "L"
                
                EveryOnePlaying(Index) = False
                EveryOnePlaying(OpponentPlayNum(Index)) = False
                
                For i = 1 To MaxConnect
                    Watchers(Index, i) = 0
                    Watchers(OpponentPlayNum(Index), i) = 0
                Next
                
                UserInformation(Index).QiJuNum = 0
                UserInformation(OpponentPlayNum(Index)).UserNumber = 0
                
                Buffer(PlayInfoNum(Index)) = ""
                PlayInfoNum(Index) = 0
                PlayInfoNum(OpponentPlayNum(Index)) = 0
                
                MessageBox.Text = MessageBox.Text & UserInformation(Index).NickName & _
                "输给了" & UserInformation(OpponentPlayNum(Index)).NickName & _
                "------" & Format(Time, "hh:mm:ss") & Chr(10) & Chr(13)
                
                OpponentPlayNum(Index) = 0
                OpponentPlayNum(OpponentPlayNum(Index)) = 0
                
                    
                Winsocks(OpponentPlayNum(Index)).SendData "/L"
                
            Case "W"
                EveryOnePlaying(Index) = False
                EveryOnePlaying(OpponentPlayNum(Index)) = False
                
                Winsocks(OpponentPlayNum(Index)).SendData "/W"
                
                For i = 1 To MaxConnect
                    Watchers(Index, i) = 0
                    Watchers(OpponentPlayNum(Index), i) = 0
                Next
                
                UserInformation(Index).QiJuNum = 0
                UserInformation(OpponentPlayNum(Index)).UserNumber = 0
                
                Buffer(PlayInfoNum(Index)) = ""
                PlayInfoNum(Index) = 0
                PlayInfoNum(OpponentPlayNum(Index)) = 0
                
                MessageBox.Text = MessageBox.Text & UserInformation(Index).NickName & _
                "战胜了" & UserInformation(OpponentPlayNum(Index)).NickName & _
                "------" & Format(Time, "hh:mm:ss") & Chr(10) & Chr(13)
                
                OpponentPlayNum(Index) = 0
                OpponentPlayNum(OpponentPlayNum(Index)) = 0
                
            Case "G"
                
                Dim TempIndex As Boolean
                Dim ColorJudge As Integer
                Dim WatchNum As Integer
                WatchNum = CInt(Mid$(Information, 4))
                
                For i = 1 To MaxConnect
                    If Buffer(i) <> "" And Not TempIndex Then
                        If CInt(Left$(Buffer(i), 3)) = WatchNum Then
                                           
                        For j = 1 To MaxConnect
                            If UserInformation(j).QiJuNum = WatchNum And Not TempIndex Then
                                For k = 1 To MaxConnect
                                    If Watchers(j, k) = 0 Then
                                        Watchers(j, k) = Index
                                        Watchers(OpponentPlayNum(j), k) = Index
                                        
                                        ColorJudge = j
                                        TempIndex = True
                                        Exit For
                                    End If
                                Next k
                            
                            End If
                        Next j
                
                        If CInt(UserInformation(ColorJudge).PlayColor) = 0 Then
                                       
                            Winsocks(Index).SendData "/G:" & Mid$(Buffer(i), 5) & ":" & _
                                UserInformation(ColorJudge).NickName & "|" & _
                                UserInformation(OpponentPlayNum(ColorJudge)).NickName
                        Else
                            Winsocks(Index).SendData "/G:" & Mid$(Buffer(i), 5) & ":" & _
                                UserInformation(OpponentPlayNum(ColorJudge)).NickName & "|" & _
                                UserInformation(ColorJudge).NickName
                        End If
                        
                        End If
                
                    End If
                
                Next i
                
                If Not TempIndex Then
                
                    MessageBox.Text = MessageBox.Text & UserInformation(Index).NickName & _
                    "想观看第" & WatchNum & "局的比赛(暂时没有此局)" & "------" & Format(Time, "hh:mm:ss") & _
                    Chr(10) & Chr(13)
                    
                    Winsocks(Index).SendData "/g:"
                Else
                    
                    MessageBox.Text = MessageBox.Text & UserInformation(Index).NickName & _
                    "想观看第" & WatchNum & "局的比赛(暂时没有此局)" & "------" & Format(Time, "hh:mm:ss") & _
                    Chr(10) & Chr(13)
                    
                End If
            
            Case "H"
                    
                Winsocks(Index).SendData "/H:"
                
            Case "T"
                Dim AnswerNumber As Integer
                 AnswerNumber = Mid$(Information, 4)
                 
                 If AnswerNumber = vbYes Then
                    '将存储在buffer中的棋局信息去掉一步
                    Buffer(PlayInfoNum(Index)) = Mid$(Buffer(PlayInfoNum(Index)), _
                    Len(Buffer(PlayInfoNum(Index))) - 6)
                    
                    Winsocks(OpponentPlayNum(Index)).SendData "/T:" & AnswerNumber
                    
                 Else
                    Winsocks(OpponentPlayNum(Index)).SendData "/T:" & AnswerNumber
                    
                End If
                 
            
            
    End Select


Else
    

End If


End Sub