myim.frm

ICQ通讯程序 ICQ通讯程序 ICQ通讯程序

    frmReport.Show
End Sub

Private Sub mnuFileToggleLog_Click()

If mnuFileToggleLog.Caption = "&Log Off" Then

   mnuFileToggleLog.Caption = "&Log On"
   Winsock1.Close
   BuddyUpdater.Enabled = False
   Command1.Enabled = False
   Command2.Enabled = False
   Label1.Caption = "Offline"
   TreeView1.Nodes.Clear
   mnuBuddyMessage.Enabled = False
   mnuStatus.Enabled = False
   mnuBuddyFile.Enabled = False
   mnuBuddyChat.Enabled = False
   mnuBuddyInfo.Enabled = False
   mnuFileChangeInfo.Enabled = False
   mnuBuddyAdd.Enabled = False
   mnuOtherChatFile = False
   mnuFilePassword.Enabled = False
   mnuBuddyRemove.Enabled = False
   mnuBuddyIgnore.Enabled = False
   mnuFileReport.Enabled = False

ElseIf mnuFileToggleLog.Caption = "&Log On" Then

   Connect.Show 'ownerform:=Me
   Me.Hide

End If

End Sub

Private Sub mnuFileChangeInfo_Click()
    frmSetInfo.Show
    Open "Info.dat" For Random As gFileNum Len = Len(MyPersonalInfo)
        Get #gFileNum, 1, MyPersonalInfo
        Dim Sex As String
        Dim Temp As String
        If MyPersonalInfo.Sex = "Male" Then
            frmSetInfo.Option1.value = True
        Else
            frmSetInfo.Option2.value = False
        End If
        frmSetInfo.Text1.Text = Trim(MyPersonalInfo.Country)
        frmSetInfo.Text2.Text = Trim(MyPersonalInfo.BirthDay)
        frmSetInfo.Text3.Text = Trim(MyPersonalInfo.Age)
        frmSetInfo.Text4.Text = Trim(MyPersonalInfo.Webpage)
        Temp = Replace(Trim(MyPersonalInfo.About), "//crlf\\", vbCrLf)
        frmSetInfo.RichTextBox1.Text = Temp
    Close #gFileNum
End Sub

Private Sub mnuHelpHomePage_Click()
    Shell "start http://www.members.home.com/amjeb/index3.htm"
End Sub

Private Sub mnuOtherChatFile_Click()
    frmChatFile.Show
End Sub

Private Sub mnuStatusAway_Click()

mnuStatusOnline.Checked = False
mnuStatusAway.Checked = True
mnuStatusDND.Checked = False
mnuStatusInvisible.Checked = False

Label1.Caption = "Away"
Winsock1.SendData ".status Away"

End Sub

Private Sub mnuStatusDND_Click()

mnuStatusOnline.Checked = False
mnuStatusAway.Checked = False
mnuStatusDND.Checked = True
mnuStatusInvisible.Checked = False

Label1.Caption = "DND"
Winsock1.SendData ".status DND"

End Sub


Private Sub mnuStatusInvisible_Click()

mnuStatusOnline.Checked = False
mnuStatusAway.Checked = False
mnuStatusDND.Checked = False
mnuStatusInvisible.Checked = True

Label1.Caption = "Invisible"
Winsock1.SendData ".status Invisible"

End Sub


Private Sub mnuStatusOnline_Click()

mnuStatusOnline.Checked = True
mnuStatusAway.Checked = False
mnuStatusDND.Checked = False
mnuStatusInvisible.Checked = False

Label1.Caption = "Online"
Winsock1.SendData ".status Online"

End Sub

Private Sub TreeView1_DblClick()
On Error Resume Next

If TreeView1.SelectedItem.Text <> "" Then
   Dim NewIMessage As New IMessage
   NewIMessage.Show ownerform:=Me
   
   NewIMessage.Label2.Caption = TreeView1.SelectedItem
   NewIMessage.RecieversID = TreeView1.SelectedItem.Key
End If

End Sub

Private Sub TreeView1_NodeClick(ByVal Node As MSComctlLib.Node)

On Error Resume Next

If TreeView1.SelectedItem.Text <> "" Then
   PopupMenu mnuBuddy
End If

End Sub


Private Sub Winsock1_Close()

   mnuStatus.Enabled = False
   mnuBuddyMessage.Enabled = False
   Label1.Caption = "Offline"
   Command1.Enabled = False
   Command2.Enabled = False
   BuddyUpdater.Enabled = False
   mnuFileToggleLog.Caption = "&Log On"
   TreeView1.Nodes.Clear
   Winsock1.Close

End Sub

Private Sub Winsock1_Connect()

   Command1.Enabled = True
   Command2.Enabled = True
   mnuFileToggleLog.Caption = "&Log Off"

End Sub


Private Sub Winsock1_DataArrival(ByVal bytesTotal As Long)

If Winsock1.State = 7 Then
    Dim ServerCommand As String
    Winsock1.GetData ServerCommand
    'MsgBox ServerCommand
        If Word(ServerCommand, 1) = ".FillOutForm" Then
            frmSetInfo.Show
            Connect.Hide
        End If
        
        If Word(ServerCommand, 1) = ".ClearIgnoreList" Then frmIgnore.List1.Clear
        
        If Word(ServerCommand, 1) = ".AddIgnore" Then frmIgnore.List1.AddItem Word(ServerCommand, 2)
        
        If Word(ServerCommand, 1) = ".Connected" Then
            Connect.Label1.Caption = "Verifying ID and Password..."
            Dim Temp2 As String
            If Connect.Check1.value = 1 Then
                Temp2 = "Yes"
            Else
                Temp2 = "No"
            End If
            Winsock1.SendData ".login " & Connect.Text1 & " " & Connect.Text2 & " " & Temp2
        End If

        
        If Word(ServerCommand, 1) = ".LogOff" Then
        
            mnuFileToggleLog.Caption = "&Log On"
            Winsock1.Close
            BuddyUpdater.Enabled = False
            Command1.Enabled = False
            Command2.Enabled = False
            Label1.Caption = "Offline"
            TreeView1.Nodes.Clear
            mnuBuddyMessage.Enabled = False
            mnuStatus.Enabled = False
            'MsgBox "Server shutdown ... so now, so must you."
            'End
            
        End If
        
        If Word(ServerCommand, 1) = ".AlreadyOnList" Then
            MsgBox "That user is already on your list!"
        End If
        
        If Word(ServerCommand, 1) = ".UserInfo" Then
            Dim NewfrmInfo As New frmInfo
            NewfrmInfo.Caption = "Info on " & RemoteNick
            NewfrmInfo.Text1.Text = Word(ServerCommand, 2)
            NewfrmInfo.Text2.Text = Word(ServerCommand, 3)
            NewfrmInfo.Text3.Text = Word(ServerCommand, 4)
            NewfrmInfo.Text4.Text = Word(ServerCommand, 5)
            NewfrmInfo.RichTextBox1.TextRTF = MidWord(Replace(ServerCommand, "//crlf\\", vbCrLf), 6, Val(Words(ServerCommand)) - 6)
            NewfrmInfo.Text6.Text = Word(ServerCommand, Words(ServerCommand))
            NewfrmInfo.Show
        End If
        
        If Word(ServerCommand, 1) = ".SendFile" Then
            
            FileSendRemoteIP = Word(ServerCommand, 2)
            
            On Error Resume Next
            CommonDialog.CancelError = True
            CommonDialog.ShowOpen
            
            If CommonDialog.fileName = "" Then Exit Sub
            
            Winsock1.SendData ".RecieveFile " & FileSendRemoteNick
            
            sendFile_01 CommonDialog.FileTitle, CommonDialog.fileName, FileSendRemoteIP, "1982", Connect.Text1.Text
            
        End If
        
        If Word(ServerCommand, 1) = ".RecieveFile" Then
            
            receiveFile_01 Word(ServerCommand, 2), "1983"
            
        End If

        If Word(ServerCommand, 1) = ".RTChat" Then
            
            Dim NewRTChat As New frmRTChat
            
            'RTCListen = False
            RTChatRemoteIP = Word(ServerCommand, 2)
            NewRTChat.Show
            NewRTChat.Caption = RTChatRemoteNick
            On Error Resume Next ' If there's an error, resume the next command.
            NewRTChat.Winsock1.Close ' Close any open ports (just in case).
            NewRTChat.Winsock1.RemotePort = "1981"
            NewRTChat.Winsock1.Connect RTChatRemoteIP ' Try to connect to the computer IP address specified in the txtRemoteIP text box, on the port specified in the txtPort text box.
            NewRTChat.lblStatus.Caption = "Connecting to " + txtRemoteIP.Text ' Inform the user we are trying to connect to the specified IP address.
            
        End If
        
        If Word(ServerCommand, 1) = ".RTChat2" Then
            
            Dim NewRTChat2 As New frmRTChat
            
            RTChatTemp = Word(ServerCommand, 2)
            If Not RTChatTemp = Word(ServerCommand, 2) Then RTChatTemp = Word(ServerCommand, 2)
            Dim TempAnswer As Integer
            TempAnswer = MsgBox("Will you accept this chat request from " & RTChatTemp & ".", vbYesNo)
            DoEvents
            If TempAnswer = vbYes Then
                NewRTChat.Show
                NewRTChat.Caption = Word(ServerCommand, 2)
                NewRTChat.Winsock1.Close
                NewRTChat.Winsock1.LocalPort = "1981" ' Set the local port to listen on by getting the value from the txtPort text box.
                NewRTChat.Winsock1.Listen ' Listen for the connection request by the other computer.
                DoEvents
                Winsock1.SendData ".BeginRTChat " & RTChatTemp
                NewRTChat.lblStatus.Caption = "Listening For Connection Request" ' Inform the user that we are listening for a connection request.
            Else
                Winsock1.SendData ".CancelRTChat " & RTChatTemp
            End If
            'RTCListen = True
            'RTChatTemp = Me.Caption
        
        End If
        
        If Word(ServerCommand, 1) = ".RemoveBuddy" Then
        
          On Error Resume Next
          
          For i = 1 To TreeView1.Nodes.Count
             If InStr(1, TreeView1.Nodes(i).Key, Word(ServerCommand, 2)) Then
                TreeView1.Nodes.Remove i
                Exit For
             End If
          Next
          
        End If
        
       If Word(ServerCommand, 1) = ".LoginGood" Then
    
          Connect.Label1.Caption = "Entering Service..."
          Unload Connect
          Me.Show

          Winsock1.SendData ".status Online"
          Label1.Caption = "Online"
          mnuStatusOnline.Checked = True
          mnuBuddyMessage.Enabled = True
          mnuBuddyFile.Enabled = True
          mnuBuddyChat.Enabled = True
          mnuBuddyInfo.Enabled = True
          mnuFileChangeInfo.Enabled = True
          mnuBuddyAdd.Enabled = True
          mnuOtherChatFile = True
          mnuStatus.Enabled = True
          mnuFilePassword.Enabled = True
          mnuBuddyRemove.Enabled = True
          mnuBuddyIgnore.Enabled = True
          mnuFileReport.Enabled = True
          mnuStatusOnline.Checked = True
          mnuStatusAway.Checked = False
          mnuStatusDND.Checked = False
          mnuStatusInvisible.Checked = False
          
          DoEvents

          Winsock1.SendData ".getbuddys"

          BuddyUpdater.Enabled = True
    
       ElseIf Word(ServerCommand, 1) = ".LoginBad" Then
    
          Dim reason As String
          
          reason = MidWord(ServerCommand, 4, Words(ServerCommand) - 4)
          
          Connect.Label1.Caption = "Oops!"
          Connect.Label2.Caption = "Uh oh! Sorry, but it looks like "
          
          If Word(ServerCommand, 2) = "0" Then
             Connect.Label2.Caption = Connect.Label2.Caption & "your account couldn't be found! Try re-entering your username."
          ElseIf Word(ServerCommand, 2) = "1" Then
             Connect.Label2.Caption = Connect.Label2.Caption & "your password is wrong! Try re-entering it."
          ElseIf Word(ServerCommand, 2) = "2" Then
             Connect.Label2.Caption = Connect.Label2.Caption & "your account has been temporarily banned, for " & reason & ". The time remaining on your ban is " & Word(ServerCommand, 3) & " days."
          ElseIf Word(ServerCommand, 2) = "3" Then
             Connect.Label2.Caption = Connect.Label2.Caption & "your account has been banned, for " & reason & "."
          ElseIf Word(ServerCommand, 2) = "4" Then
             Connect.Label2.Caption = Connect.Label2.Caption & "your account has been frozen, for " & reason & "."
          ElseIf Word(ServerCommand, 2) = "5" Then
             Connect.Label2.Caption = Connect.Label2.Caption & "the server is full. Please try again in a little while."
          ElseIf Word(ServerCommand, 2) = "6" Then
             Connect.Label2.Caption = Connect.Label2.Caption & "that name is already taken."
          ElseIf Word(ServerCommand, 2) = "7" Then
             Connect.Label2.Caption = Connect.Label2.Caption & "the server is down!"
          End If
          
          Connect.Label3.ForeColor = vbBlack
          Connect.Label4.ForeColor = vbBlack
          Connect.Text1.Enabled = True
          Connect.Text2.Enabled = True
          Connect.Command1.Enabled = True
          Connect.Command2.Caption = "&Close"
          Winsock1.Close
    
       ElseIf Word(ServerCommand, 1) = ".msg" Then
    
          Dim NewReponseMessage As New GotMessage
          NewReponseMessage.Show ownerform:=Me
    
          NewReponseMessage.Caption = "Message from " & Trim(Replace(Word(ServerCommand, 3), "_._", " "))
    
          NewReponseMessage.Label2.Caption = Trim(Replace(Word(ServerCommand, 3), "_._", " ")) & " (" & Trim(Word(ServerCommand, 2) & ")")
          NewReponseMessage.SenderID = Trim(Word(ServerCommand, 2))
          NewReponseMessage.SenderName = Trim(Replace(Word(ServerCommand, 3), "_._", " "))

          NewReponseMessage.RichTextBox1.TextRTF = Trim(Replace(SplitString(ServerCommand, "..//.."), "//crlf\\", vbCrLf))

       ElseIf Word(ServerCommand, 1) = ".pushbuddyupdate" Then
          On Error Resume Next
          
          For i = 1 To TreeView1.Nodes.Count
             If InStr(1, TreeView1.Nodes(i).Key, Word(ServerCommand, 2)) Then
                TreeView1.Nodes(i).Image = Word(ServerCommand, 3)
                TreeView1.Nodes(i).SelectedImage = Word(ServerCommand, 3)
                TreeView1.Refresh
                Exit For
             End If
          Next

       ElseIf Word(ServerCommand, 1) = ".pushbuddy" Then
          Dim BuddyUserID
          Dim BuddyUserTitle
          
          'MsgBox ServerCommand
       
          BuddyStatus = Word(ServerCommand, 2)
          BuddyUserID = Word(ServerCommand, 3)
          BuddyUserTitle = SplitString(ServerCommand, Word(ServerCommand, 3))
    
          'MsgBox "Server pushed user " & SplitString(ServerCommand, ".pushbuddy") & " to me!"
          On Error Resume Next
          TreeView1.Nodes.Add , tvwChild, BuddyUserID, BuddyUserTitle, BuddyStatus, BuddyStatus

       End If
       If Word(ServerCommand, 1) = ".ClearBuddys" Then
       
          TreeView1.Nodes.Clear
          
       End If
       If Word(ServerCommand, 1) = ".msg2" Then
            
          NewReponseMessage.Show ownerform:=Me
          NewReponseMessage.Caption = "Message from " & Word(ServerCommand, 2)
          NewReponseMessage.Label2 = Word(ServerCommand, 2)
          NewReponseMessage.SenderID = Word(ServerCommand, 2)
          NewReponseMessage.SenderName = Word(ServerCommand, 2)
          NewReponseMessage.RichTextBox1.TextRTF = MidWord(ServerCommand, 3, Words(ServerCommand))
          
       End If
       If Word(ServerCommand, 1) = ".ServerMessage" Then
          MsgBox "ServerMessage:  " & MidWord(ServerCommand, 2, Words(ServerCommand))
       End If
End If
Exit Sub
DoNothing:
    If Err.Number = cdlCancel Then
        Exit Sub
    Else
        MsgBox Err.Description
    End If
End Sub