frmclient.frm

来自「使用VB仿QQ界面开发的ICQ程序,采用C/S结架,实现简单文字聊天.」· FRM 代码 · 共 1,190 行 · 第 1/3 页

                        tn.Key = NewString
                        tn.Text = NewString
                        Winsock1.SendData ".updateBuddy " & YourSN & " " & oldLabel & " " & NewString
                        WaitFor (".statusUpdate")
                        Exit For
                    End If
                Next
            Else
                MsgBox "A buddy with the user name " & UCase(NewString) & " already exists.", vbOKOnly + vbCritical
                Cancel = 1
            End If
            Else
                Cancel = 1
            End If
        Else
            Cancel = 1
        End If
    Else
        Cancel = 1
End If
End Sub

Private Function check_for_duplicate(user As String) As Boolean
Dim tn As Node
Dim flag As Integer
    For Each tn In TreeView1.Nodes
        If UCase(tn.Key) = UCase(user) Then
            flag = 1
            check_for_duplicate = False
            Exit For
        Else
            flag = 0
        End If
    Next
If flag = 0 Then
    check_for_duplicate = True
End If
End Function

Private Sub cmdDelBuddy_Click()
Dim reply As String
Dim tn As Node
    reply = MsgBox("Are you sure you want to delete the following buddy from your list?" & vbCrLf & TreeView2.SelectedItem.Key, vbYesNo + vbCritical)
    If reply = vbYes Then
       Winsock1.SendData ".delBuddy " & YourSN & " " & TreeView2.SelectedItem.Key
       WaitFor (".statusUpdate")
        TreeView1.Nodes.Remove TreeView2.SelectedItem.Key
        TreeView2.Nodes.Remove TreeView2.SelectedItem.Key
       cmdDelBuddy.Enabled = False
       Call Online_Offline_Text
    End If
End Sub

Private Sub cmdNewBuddy_Click()
Dim newbuddy As String
    cmdNewBuddy.Enabled = False
    newbuddy = InputBox("Enter user name:", cmdNewBuddy.ToolTipText)
    If StrPtr(newbuddy) = 0 Then
        cmdNewBuddy.Enabled = True
    Else
        If Correct_Screenname(newbuddy) = True Then
            If check_for_duplicate(newbuddy) = True Then
                TreeView1.Nodes.Add "Offline", tvwChild, newbuddy, newbuddy
                TreeView2.Nodes.Add "Buddies", tvwChild, newbuddy, newbuddy
                Winsock1.SendData ".newBuddy " & YourSN & " " & newbuddy
                WaitFor (".statusUpdate")
                cmdNewBuddy.Enabled = True
            Else
               MsgBox "A buddy with the user name " & UCase(newbuddy) & " already exists.", vbOKOnly + vbCritical
               Call cmdNewBuddy_Click
            End If
        Else
            Call cmdNewBuddy_Click
        End If
    End If
End Sub

Private Function Correct_Screenname(screenname As String) As Boolean
Dim i As Integer
Dim flag As Integer
If LCase(screenname) <> YourSN And Len(screenname) >= 5 And Len(screenname) <= 15 And Not IsNumeric(Left(screenname, 1)) Then
For i = 1 To Len(screenname)
    If (Asc(Mid(screenname, i, 1)) >= vbKey1 And Asc(Mid(screenname, i, 1)) <= vbKey9) Then
        flag = 0
    ElseIf (Asc(UCase(Mid(screenname, i, 1))) >= vbKeyA And Asc(UCase(Mid(screenname, i, 1))) <= vbKeyZ) Then
        flag = 0
    Else
        flag = 1
        MsgBox "A screen name in your list is too short or contains invalid" & vbCrLf & "characters.", vbOKOnly + vbCritical
        Correct_Screenname = False
        Exit For
    End If
Next i
Else
    flag = 1
    MsgBox "A screen name in your list is too short or contains invalid" & vbCrLf & "characters.", vbOKOnly + vbCritical
    Correct_Screenname = False
End If
If flag = 0 Then
    Correct_Screenname = True
End If
End Function

Private Sub Winsock1_DataArrival(ByVal bytesTotal As Long)
    Dim i As Long
    Winsock1.GetData strIncoming
   
    If strIncoming = ".badlogin" Then
        MsgBox "The screen name or password you entered is not valid. ", vbOKOnly + vbCritical: SignOn.Image3.Picture = SignOn.Red.Picture
        If Winsock1.State <> sckClosed Then
            Winsock1.Close
        End If
    ElseIf strIncoming = ".goodlogin" Then
        Call good_login
        
    ElseIf Word(strIncoming, 1) = ".showonline" And Word(strIncoming, 2) <> "0" Then
        Call Show_Online_buddies(strIncoming)
        
    ElseIf Word(strIncoming, 1) = ".statusUpdate" And Word(strIncoming, 2) <> "0" Then
        Call status_update(Word(strIncoming, 3), Word(strIncoming, 4))
        
    ElseIf Word(strIncoming, 1) = ".msg" Then
        Call get_message(Word(strIncoming, 2), strIncoming)
        
  ' ElseIf Word(strIncoming, 1) = ".define" Then
       ' Call get_definition(Word(strIncoming, 2), Word(strIncoming, 3), strIncoming)
        
   ' ElseIf Word(strIncoming, 1) = ".spell" Then
        '    Call get_spelling(Word(strIncoming, 2), strIncoming)

    End If
End Sub

'Private Function get_spelling(buddy As String, msg As String)
'Dim formNum As Integer
'Dim definition As String
'formNum = GetFormNumber(buddy)
'If formNum <> 0 Then
'    definition = SplitString(msg, "..//..")
'    Forms(formNum).showmsg.SelStart = Len(Forms(formNum).showmsg.Text)
'    Forms(formNum).showmsg.SelBold = True
'    Forms(formNum).showmsg.SelText = "spellcheck: "
    
'    Forms(formNum).showmsg.SelStart = Len(Forms(formNum).showmsg.Text)
'    Forms(formNum).showmsg.SelBold = False
'    Forms(formNum).showmsg.SelText = definition & vbCrLf
'End If
'End Function

'Private Function get_definition(buddy As String, Word As String, msg As String)
'Dim formNum As Integer
'Dim definition As String
'formNum = GetFormNumber(buddy)
'If formNum <> 0 Then
'    definition = SplitString(msg, "..//..")
'    Forms(formNum).showmsg.SelStart = Len(Forms(formNum).showmsg.Text)
'    Forms(formNum).showmsg.SelBold = True
'    Forms(formNum).showmsg.SelText = Word & ": "
    
'    Forms(formNum).showmsg.SelStart = Len(Forms(formNum).showmsg.Text)
'    Forms(formNum).showmsg.SelBold = False
'    Forms(formNum).showmsg.SelText = definition & vbCrLf
'End If
'End Function

Private Function get_message(mfrom As String, msg As String)
Dim i As Long
Dim formNum As Integer
Dim sendMsg As String
    sndPlaySound App.Path + "\sounds\imrcv.wav", 1
    FormIsLoaded (mfrom)
    formNum = GetFormNumber(mfrom)
    sendMsg = SplitString(msg, "..//..")
    Forms(formNum).ShowMsg.SelStart = Len(Forms(formNum).ShowMsg.Text)
    Forms(formNum).ShowMsg.SelBold = True
    Forms(formNum).ShowMsg.SelColor = vbBlue
    Forms(formNum).ShowMsg.SelText = mfrom & ": "
    
    Forms(formNum).ShowMsg.SelStart = Len(Forms(formNum).ShowMsg.Text)
    Forms(formNum).ShowMsg.SelBold = False
    Forms(formNum).ShowMsg.SelColor = vbBlack
    Forms(formNum).ShowMsg.SelText = sendMsg & vbCrLf
End Function

Private Sub good_login()

        Me.Caption = YourSN
        Me.Caption = Me.Caption + " - Kaotix Instant Messenger"
        
'        SignOn.Visible = False
'        Client.Visible = True
        frmLogin.Visible = False
        frmClient.Visible = True
        
        DoSystrayIcon
        
        strIncoming = ""
            TreeView1.Nodes.Add , , "Online", "Buddies", "down"
            TreeView1.Nodes.Add , , "Offline", "Offline", "down"
            TreeView2.Nodes.Add , , "Buddies", "Buddies"
            
            TreeView1.Nodes.Item(1).Expanded = True
            TreeView1.Nodes.Item(2).Expanded = True
            TreeView2.Nodes.Item(1).Expanded = True
            
            TreeView1.Nodes.Item(1).Bold = True
            TreeView2.Nodes.Item(1).Bold = True
            
            TreeView1.Nodes.Item(2).ForeColor = vbButtonShadow
            
                        
            Winsock1.SendData ".updateStatus" & " " & "1" & " " & YourSN
            WaitFor (".statusUpdate")
                       
            Winsock1.SendData ".getonlinebuddies" & " " & YourSN
            WaitFor (".showonline")
End Sub

Private Function Show_Online_buddies(buddies As String)
    Dim i As Long, oncount As Integer
    Dim status As Integer
    Dim n As String
    oncount = 0
    For i = 3 To Words(strIncoming)
        status = Right(Word(buddies, i), 1)
        If status = 2 Then
            n = "Offline"
        Else
            n = "Online"
        End If
        TreeView1.Nodes.Add n, tvwChild, Left(Word(buddies, i), Len(Word(buddies, i)) - 1), Left(Word(buddies, i), Len(Word(buddies, i)) - 1), status, status
        TreeView2.Nodes.Add "Buddies", tvwChild, Left(Word(buddies, i), Len(Word(buddies, i)) - 1), Left(Word(buddies, i), Len(Word(buddies, i)) - 1)
    Next i
    Call Online_Offline_Text
End Function

Private Function status_update(buddy As String, status As Integer)
    Dim tn As Node
    Dim n As String
    Dim frmNum As Integer

        If status = 2 Then
            n = "Offline"
        Else
            n = "Online"
        End If
    For Each tn In TreeView1.Nodes
        If LCase(tn.Key) = LCase(buddy) Then
            'TreeView1.Nodes.Remove tn.Key
            'TreeView1.Nodes.Add n, tvwChild, buddy, buddy, status, status
            If Word(TreeView1.Nodes(tn.Key).Parent, 1) <> "Buddies" Then
                If status = 1 Then
                    sndPlaySound App.Path + "\sounds\dooropen.wav", 1
                    runlog.SelStart = Len(runlog.Text)
                    runlog.SelColor = vbBlue
                    runlog.SelText = buddy & " has signed on (" & Time & ")" & vbCrLf
                End If
                If status <> 2 Then
                    frmNum = GetFormNumber(LCase(buddy))
                    If frmNum <> 0 Then
                        Forms(frmNum).cmdSend.Enabled = True
                        Forms(frmNum).TypeMsg.Enabled = True
                        Forms(frmNum).tbFonts.Enabled = True
                        Forms(frmNum).ShowMsg.SelStart = Len(Forms(frmNum).ShowMsg.Text)
                        Forms(frmNum).ShowMsg.SelColor = vbBlue
                        Forms(frmNum).ShowMsg.SelText = buddy & " has signed on (" & Time & ")." & vbCrLf
                    End If
                End If
            End If
            If Word(TreeView1.Nodes(tn.Key).Parent, 1) <> "Offline" Then
                If status = 2 Then
                    sndPlaySound App.Path + "\sounds\doorslam.wav", 1
                    runlog.SelStart = Len(runlog.Text)
                    runlog.SelColor = vbRed
                    runlog.SelText = buddy & " has signed off (" & Time & ")" & vbCrLf
                    frmNum = GetFormNumber(LCase(buddy))
                    If frmNum <> 0 Then
                        Forms(frmNum).cmdSend.Enabled = False
                        Forms(frmNum).TypeMsg.Enabled = False
                        Forms(frmNum).tbFonts.Enabled = False
                        Forms(frmNum).ShowMsg.SelStart = Len(Forms(frmNum).ShowMsg.Text)
                        Forms(frmNum).ShowMsg.SelColor = vbRed
                        Forms(frmNum).ShowMsg.SelText = buddy & " has signed off (" & Time & ")." & vbCrLf
                    End If
                End If
            End If
            TreeView1.Nodes.Remove tn.Key
            TreeView1.Nodes.Add n, tvwChild, buddy, buddy, status, status
            Call Online_Offline_Text
            Exit For
        End If
    Next
End Function

Private Function Online_Offline_Text()
Dim tn As Node
Dim oncount
Dim offcount
oncount = 0
offcount = 0
TreeView1.Nodes.Item(1).Selected = True
    oncount = TreeView1.SelectedItem.Children
TreeView1.Nodes.Item(2).Selected = True
    offcount = TreeView1.SelectedItem.Children

    TreeView1.Nodes.Item(1).Text = "Buddies (" & oncount & "/" & oncount + offcount & ")"
    TreeView1.Nodes.Item(2).Text = "Offline (" & offcount & "/" & oncount + offcount & ")"
End Function

Private Sub mnuFileLogOut_Click()
    If Winsock1.State <> sckClosed Then Winsock1.Close
    Me.Width = 2700
    Me.Height = 6000
    Client.Visible = False
    SignOn.Visible = True
    TreeView1.Nodes.Clear
    TreeView2.Nodes.Clear
    SignOn.txtPassword.Text = ""
    mnuStatusAway.Checked = False
    mnuStatusOnline.Checked = True
Dim i As Integer
    For i = 0 To Forms.Count - 1
    If Forms.Count <> 1 Then
        Unload Forms(1)
    End If
    Next i
End Sub

Private Sub mnuFileClose_Click()
Dim Ans2 As Byte
Ans2 = MsgBox("Are you sure you would like to end this session?", vbYesNo + vbQuestion, "Are you sure?")
If Ans2 = vbYes Then
FinalClose = True
Shell_NotifyIcon NIM_DELETE, Tic
Unload Me
Else
Exit Sub
End If
End Sub

Private Sub mnuStatusOnline_Click()
    If mnuStatusOnline.Checked = False Then
        mnuStatusOnline.Checked = True
        mnuStatusAway.Checked = False
        lblStatus.Caption = YourSN & "-Online"
        Winsock1.SendData ".updateStatus" & " " & "1" & " " & YourSN
        WaitFor (".statusUpdate")
    End If
End Sub

Private Sub mnuStatusAway_Click()
    If mnuStatusAway.Checked = False Then
        mnuStatusAway.Checked = True
        mnuStatusOnline.Checked = False
        lblStatus.Caption = YourSN & "-Away"
        Winsock1.SendData ".updateStatus" & " " & "3" & " " & YourSN
        WaitFor (".statusUpdate")
    End If
End Sub

Sub WaitFor(ResponseCode As String)
    Start = 0
    tmrTimeout.Enabled = True
    While Len(strIncoming) = 0
        DoEvents
        If Start > 20 Then
            MsgBox "Service error, timed out while waiting for response", 64, MsgTitle
            Exit Sub
            Call mnuFileLogOut_Click
        End If
    Wend
    Start = 0
    While Word(strIncoming, 1) <> ResponseCode
        DoEvents
        If Start > 20 Then
           MsgBox "Service error, impromper response code. Code should have been: " + ResponseCode + " Code recieved: " + strIncoming, 64, MsgTitle
           Exit Sub
           Call mnuFileLogOut_Click
        End If
    Wend
    strIncoming = ""
    tmrTimeout.Enabled = False
End Sub

Private Sub tmrTimeout_Timer()
    Start = Start + 1
End Sub

Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
  If Not FinalClose Then
    'Me.WindowState = 1
     Me.Hide
     Cancel = 1
  End If
End Sub