form1.frm

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

Dim gCurrentRecord As Long
Dim gLastRecord As Long
Dim LastConnection As Integer
Dim u As Integer
Dim a As Integer

Private Sub Command1_Click() 'Shut Down/Start Server button
    On Error Resume Next
    If Command1.Caption = "Start Server" Then
        Command1.Caption = "Shut Down"
    Else
        Command1.Caption = "Start Server"
        For u = 0 To Val(Word(Label3.Caption, 1))
            ServiceSocket(u).SendData ".LogOff"
            RichTextBox1.SelText = Now & ": User " & ServiceSocket(u).Name & " logged off from " & ServiceSocket(u).RemoteHostIP & vbCrLf
        Next u
    End If
End Sub

Private Sub Command2_Click()
    If Text1.Text = "" Then
        MsgBox "You didn't enter a message!"
    Else
        For u = 0 To intMax
            If ServiceSocket(u).State = 7 Then
                ServiceSocket(u).SendData ".ServerMessage " & Text1.Text
            End If
        Next
        Text1.Text = ""
    End If
End Sub

Private Sub Command3_Click()
    Dim TempInt As Integer
    On Error GoTo PMessageError
    TempInt = List1.ItemData(List1.ListIndex)
    If ServiceSocket(TempInt).State = 7 Then
        If Text2.Text = "" Then
            MsgBox "You didn't enter a message!"
        Else
            ServiceSocket(TempInt).SendData ".ServerMessage " & Text2.Text
        End If
    End If
    Text2.Text = ""
    Exit Sub
PMessageError:
    Select Case Err.Number
        Case 381
            MsgBox "You didn't chose a person to message!"
    End Select
End Sub

Private Sub Command4_Click()
    Dim ComplaintsCount As Integer
    ComplaintsCount = Val(LoadINI("Reports", "Complaints", "Count"))
    If ComplaintsCount = 0 Then
        RichTextBox1.SelColor = vbBlue
        RichTextBox1.SelText = "There are no complaints to report." & vbCrLf
        RichTextBox1.SelColor = vbBlack
    End If
    If ComplaintsCount > 0 Then
        RichTextBox1.SelColor = vbBlue
        RichTextBox1.SelText = "There are " & ComplaintsCount & " complaints to report." & vbCrLf
        RichTextBox1.SelColor = vbBlack
        For a = 1 To ComplaintsCount
            RichTextBox1.SelText = LoadINI("Reports", "Complaints", "Complaint" & a) & vbCrLf
            RichTextBox1.SelText = vbCrLf
        Next
    End If
End Sub

Private Sub Command5_Click()
    Dim BugCount As Integer
    BugCount = Val(LoadINI("Reports", "Bugs", "Count"))
    If BugCount = 0 Then
        RichTextBox1.SelColor = vbBlue
        RichTextBox1.SelText = "There are no bugs to report." & vbCrLf
        RichTextBox1.SelColor = vbBlack
    End If
    If BugCount > 0 Then
        RichTextBox1.SelColor = vbBlue
        RichTextBox1.SelText = "There are " & BugCount & " bugs to report." & vbCrLf
        RichTextBox1.SelColor = vbBlack
        For a = 1 To BugCount
            RichTextBox1.SelText = LoadINI("Reports", "Bugs", "Bug" & a) & vbCrLf
            RichTextBox1.SelText = vbCrLf
        Next
    End If
End Sub

Private Sub Command6_Click()
    Dim CommentsCount As Integer
    CommentsCount = Val(LoadINI("Reports", "Comments", "Count"))
    If CommentsCount = 0 Then
        RichTextBox1.SelColor = vbBlue
        RichTextBox1.SelText = "There are no comments to report." & vbCrLf
        RichTextBox1.SelColor = vbBlack
    End If
    If CommentsCount > 0 Then
        RichTextBox1.SelColor = vbBlue
        RichTextBox1.SelText = "There are " & CommentsCount & " comments to report." & vbCrLf
        RichTextBox1.SelColor = vbBlack
        For a = 1 To CommentsCount
            RichTextBox1.SelText = LoadINI("Reports", "Comments", "Comment" & a) & vbCrLf
            RichTextBox1.SelText = vbCrLf
        Next
    End If
End Sub

Private Sub Command7_Click()
    Dim ComplaintsCount As Integer
    ComplaintsCount = Val(LoadINI("Reports", "Complaints", "Count"))
    If ComplaintsCount = 0 Then
        RichTextBox1.SelColor = vbBlue
        RichTextBox1.SelText = "There are no complaints to delete!" & vbCrLf
        RichTextBox1.SelColor = vbBlack
    End If
    If ComplaintsCount > 0 Then
        For a = 1 To ComplaintsCount
            SaveINI "Reports", "Complaints", "Complaint" & a, vbNullString
        Next
        SaveINI "Reports", "Complaints", "Count", 0
        RichTextBox1.SelColor = vbBlue
        RichTextBox1.SelText = "Deleted all complaint reports successfully!" & vbCrLf
        RichTextBox1.SelColor = vbBlack
    End If
    Text3.Text = "0"
End Sub

Private Sub Command8_Click()
    Dim BugCount As Integer
    BugCount = Val(LoadINI("Reports", "Bugs", "Count"))
    If BugCount = 0 Then
        RichTextBox1.SelColor = vbBlue
        RichTextBox1.SelText = "There are no bugs to delete!" & vbCrLf
        RichTextBox1.SelColor = vbBlack
    End If
    If BugCount > 0 Then
        For a = 1 To BugCount
            SaveINI "Reports", "Bugs", "Bug" & a, vbNullString
        Next
        SaveINI "Reports", "Bugs", "Count", 0
        RichTextBox1.SelColor = vbBlue
        RichTextBox1.SelText = "Deleted all bug reports successfully!" & vbCrLf
        RichTextBox1.SelColor = vbBlack
    End If
    Text4.Text = "0"
End Sub

Private Sub Command9_Click()
    Dim CommentsCount As Integer
    CommentsCount = Val(LoadINI("Reports", "Comments", "Count"))
    If CommentsCount = 0 Then
        RichTextBox1.SelColor = vbBlue
        RichTextBox1.SelText = "There are no comments to delete!" & vbCrLf
        RichTextBox1.SelColor = vbBlack
    End If
    If CommentsCount > 0 Then
        For a = 1 To CommentsCount
            SaveINI "Reports", "Comments", "Comment" & a, vbNullString
        Next
        SaveINI "Reports", "Comments", "Count", 0
        RichTextBox1.SelColor = vbBlue
        RichTextBox1.SelText = "Deleted all comment reports successfully!" & vbCrLf
        RichTextBox1.SelColor = vbBlack
    End If
    Text5.Text = "0"
End Sub

Private Sub Form_Load()
   
   gFileNum = FreeFile
   
   Label3.Caption = "0 /" & MaxUsers

   sckListen(0).Listen

   FilePath = App.Path & "\"
   
   Me.Caption = "ComX Server Version " & App.Major & "." & App.Minor & App.Revision
   
   Text3.Text = Val(LoadINI("Reports", "Complaints", "Count"))
   Text4.Text = Val(LoadINI("Reports", "Bugs", "Count"))
   Text5.Text = Val(LoadINI("Reports", "Comments", "Count"))

End Sub

Private Sub Form_Unload(Cancel As Integer)
    Command1_Click
End Sub

Private Sub List1_Click()
'
End Sub

Private Sub List1_MouseDown(Button As Integer, Shift As Integer, x As Single, Y As Single)
    If Button = 2 Then PopupMenu mnuUsers
End Sub

Private Sub mnuFileBan_Click()
    Form2.Show
End Sub

Private Sub mnuUsersBan_Click()
    On Error GoTo BanErr
    Form2.Text1.Text = UserInfo(List1.ListIndex).UserID
    Form2.Show
    Exit Sub
BanErr:
    Select Case Err.Number
        Case 9
            MsgBox Err.Description & ", you didn't select anyone silly!"
    End Select
End Sub

Private Sub mnuUsersKick_Click()
    On Error GoTo KickErr
    ServiceSocket(List1.ListIndex).SendData ".ServerMessage You have been booted!"
    ServiceSocket(List1.ListIndex).Close
KickErr:
    Select Case Err.Number
        Case 9
            MsgBox Err.Description & ", you didn't select anyone silly!"
    End Select
End Sub

Private Sub RichTextBox1_Change()

   RichTextBox1.SelStart = Len(RichTextBox1)

End Sub


Private Sub RichTextBox1_MouseMove(Button As Integer, Shift As Integer, x As Single, Y As Single)

    RichTextBox1.SelStart = Len(RichTextBox1)

End Sub

Private Sub sckListen_ConnectionRequest(Index As Integer, ByVal requestID As Long)
    If Command1.Caption = "Start Server" Then Exit Sub
    Call GetFreeWinsockIndex
    ServiceSocket(LastConnection).Close
    ServiceSocket(LastConnection).Accept requestID
    If Index = 0 Then
        If Command1.Caption = "Start Server" Then ServiceSocket(LastConnection).SendData ".LoginBad 7 "
        If intMax < LastConnection Then intMax = LastConnection
        TotalUsersOnline = TotalUsersOnline + 1

        If intMax < MaxUsers + 1 Then
            Label3.Caption = Word(Label3.Caption, 1) + 1 & " /200"
    
            RichTextBox1.SelText = Now & ": New connection request from " & ServiceSocket(intMax).RemoteHostIP & vbCrLf
            
            List1.AddItem "(" & LastConnection & ") Unknown"
            List1.ItemData(List1.NewIndex) = LastConnection
            ServiceSocket(LastConnection).SendData ".Connected"
        Else
            RichTextBox1.SelText = Now & ": Server is full: Closing connection for " & ServiceSocket(intMax).RemoteHostIP & vbCrLf
            ServiceSocket(LastConnection).SendData ".LoginBad 5"
            intMax = intMax - 1
        End If
    End If
End Sub

Private Sub ServiceSocket_Close(Index As Integer)

   RichTextBox1.SelColor = &H80FF&
   RichTextBox1.SelText = Now & ": User " & UserInfo(Index).UserID & " logged off." & vbCrLf
   RichTextBox1.SelColor = vbBlack
    
   TotalUsersOnline = TotalUsersOnline - 1
   ServiceSocket(Index).Close
   UserInfo(Index).InUse = False
   UserInfo(Index).InRoom = ""
   UserInfo(Index).NickColor = ""
   UserInfo(Index).Nickname = ""
   UserInfo(Index).Password = ""
   UserInfo(Index).Status = ""
   UserInfo(Index).UserID = "N/A"
   UserInfo(Index).UserName = ""
   UserInfo(Index).UserIP = ""

   RichTextBox1.SelText = Now & ": Connection closed for " & ServiceSocket(Index).RemoteHostIP & vbCrLf

   Label3.Caption = Word(Label3.Caption, 1) - 1 & " /200"
   
   For a = 0 To List1.ListCount - 1
    If List1.ItemData(a) = Index Then
        List1.RemoveItem a
        Exit For
    End If
   Next
   'List1.RemoveItem Index

End Sub

Private Sub ServiceSocket_ConnectionRequest(Index As Integer, ByVal requestID As Long)
'
End Sub

Private Sub ServiceSocket_DataArrival(Index As Integer, ByVal bytesTotal As Long)
Dim UserCommand As String
ServiceSocket(Index).GetData UserCommand
Select Case Word(UserCommand, 1)
    Case ".login"
        LogIn UserCommand, Index
    Case ".getbuddys"