form1.frm

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

        GetBuddys UserCommand, Index
    Case ".AddBuddy"
        AddBuddy UserCommand, Index
    Case ".RemoveBuddy"
        RemoveBuddy UserCommand, Index
    Case ".status"
        Status UserCommand, Index
    Case ".getstatus"
        GetStatus UserCommand, Index
    Case ".msg"
        Message UserCommand, Index
    Case ".GetIPForFileSend"
        GetIPForFileSend UserCommand, Index
    Case ".RecieveFile"
        RecieveFile UserCommand, Index
    Case ".GetIPForRTChat"
        GetIPForRTChat UserCommand, Index
    Case ".BeginRTChat"
        BeginRTChat UserCommand, Index
    Case ".CancelRTChat"
        CancelRTChat UserCommand, Index
    Case ".SaveInfo"
        SaveInfo UserCommand, Index
    Case ".GetBuddyInfo"
        GetBuddyInfo UserCommand, Index
    Case ".Report"
        Report UserCommand, Index
    Case ".ChangePassword"
        Password UserCommand, Index
    Case ".AddIgnore"
        AddIgnore UserCommand, Index
    Case ".RemoveIgnore"
        RemoveIgnore UserCommand, Index
    Case ".GetIgnoreList"
        GetIgnoreList UserCommand, Index
    Case Else
        ServiceSocket(Index).SendData ".ServerMessage Err: Command not recognized."
End Select
End Sub

Private Sub ServiceSocket_Error(Index As Integer, ByVal Number As Integer, Description As String, ByVal Scode As Long, ByVal Source As String, ByVal HelpFile As String, ByVal HelpContext As Long, CancelDisplay As Boolean)

   RichTextBox1.SelColor = vbRed
   RichTextBox1.SelText = Now & ": Encountered error #" & Number & ", " & Description & ", from " & ServiceSocket(intMax).RemoteHostIP & vbCrLf
   RichTextBox1.SelColor = vbBlack
   
   TotalUsersOnline = TotalUsersOnline - 1
   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 = ""

   ServiceSocket_Close Index

End Sub

Sub GetFreeWinsockIndex()
    For LastConnection = ServiceSocket.LBound To ServiceSocket.UBound
        If ServiceSocket(LastConnection).State = sckClosed Then Exit Sub
    Next
    Load ServiceSocket(LastConnection)
End Sub

Public Function LogIn(UserCommand As String, Index As Integer)
    If InStr(1, Word(UserCommand, 4), "Yes") Then
        If InStr(1, Word(UserCommand, 2), "N/A") Then
            ServiceSocket(Index).SendData ".LoginBad 6"
            Exit Function
        End If
        Dim UserCount As Integer
        UserCount = Val(LoadINI("Count", "UserCount", "TotalUsers"))
        Open "Server.dat" For Random As gFileNum Len = Len(SavedUserInfo)
        For a = 1 To UserCount
            Get #gFileNum, a, SavedUserInfo
            If UCase(Trim(SavedUserInfo.UserID)) = UCase(Word(UserCommand, 2)) Then
                RichTextBox1.SelText = Now & ": User " & Word(UserCommand, 2) & " failed to create account: " & "This account already exists." & vbCrLf
                ServiceSocket(Index).SendData ".LoginBad 6"
                Close #gFileNum
                Exit Function
            End If
        Next a
        Close #gFileNum
        UserCount = UserCount + 1
        SaveINI "Count", "UserCount", "TotalUsers", Str(UserCount)
        SavedUserInfo.UserID = Word(UserCommand, 2)
        SavedUserInfo.Password = Word(UserCommand, 3)
        SavedUserInfo.Nickname = Word(UserCommand, 2)
        SavedUserInfo.LastUserIP = ServiceSocket(Index).RemoteHostIP
        Open "Server.dat" For Random As gFileNum Len = Len(SavedUserInfo)
            Put #gFileNum, UserCount, SavedUserInfo
        Close #gFileNum
        UserPersonalInfo.Sex = "N/A"
        UserPersonalInfo.Country = "N/A"
        UserPersonalInfo.BirthDay = "N/A"
        UserPersonalInfo.Age = "N/A"
        UserPersonalInfo.Webpage = "N/A"
        UserPersonalInfo.About = "N/A"
        Open Word(UserCommand, 2) & ".dat" For Random As gFileNum Len = Len(UserPersonalInfo)
            Put #gFileNum, 1, UserPersonalInfo
        Close #gFileNum
        RichTextBox1.SelText = Now & ": New User " & Word(UserCommand, 2) & vbCrLf
    End If
    UserCount = Val(LoadINI("Count", "UserCount", "TotalUsers"))
    Dim LogName As String
    Dim LogCount As Integer
    Open "Server.dat" For Random As gFileNum Len = Len(SavedUserInfo)
        For a = 1 To UserCount
            Get #gFileNum, a, SavedUserInfo
            If Trim(SavedUserInfo.UserID) = Word(UserCommand, 2) Then
                LogName = "Good"
                LogCount = a
                Exit For
            End If
        Next a
    Close #gFileNum
    If Not LogName = "Good" Then
        RichTextBox1.SelText = Now & ": User " & Word(UserCommand, 2) & " failed to login: " & "account couldn't be found." & vbCrLf
        ServiceSocket(Index).SendData ".LoginBad 0"
        Exit Function
    End If
    Open "Server.dat" For Random As gFileNum Len = Len(SavedUserInfo)
        Get #gFileNum, LogCount, SavedUserInfo
        If Trim(SavedUserInfo.Password) = Word(UserCommand, 3) Then
            ServiceSocket(Index).SendData ".LoginGood"
            RichTextBox1.SelColor = &H80FF&
            RichTextBox1.SelText = Now & ": User " & Word(UserCommand, 2) & " logged in from " & ServiceSocket(intMax).RemoteHostIP & vbCrLf
            RichTextBox1.SelColor = vbBlack
            For a = 0 To List1.ListCount - 1
                If List1.ItemData(a) = Index Then List1.List(a) = "(" & Index & ")" & Word(UserCommand, 2)
            Next
            UserInfo(Index).Nickname = Word(UserCommand, 2)
            UserInfo(Index).UserID = Word(UserCommand, 2)
            UserInfo(Index).Status = "Online"
            UserInfo(Index).InUse = True
            UserInfo(Index).UserIP = ServiceSocket(Index).RemoteHostIP
            SavedUserInfo.LastUserIP = ServiceSocket(Index).RemoteHostIP
            Put #gFileNum, LogCount, SavedUserInfo
        Else
            RichTextBox1.SelText = Now & ": User " & Word(UserCommand, 2) & " failed to login: " & "wrong password" & vbCrLf
            ServiceSocket(Index).SendData ".LoginBad 1"
        End If
    Close #gFileNum
End Function

Public Function GetBuddys(UserCommand As String, Index As Integer)
    On Error Resume Next
    Dim BuddyCount As Integer
    Dim BuddyUserID As String
    Dim BuddyUserFound As Boolean
    Dim BuddyUserTitle As String
    BuddyCount = Val(LoadINI(UserInfo(Index).UserID, "Count", "BuddyList"))
    Dim g As Integer
    Dim Temp3 As Integer
    If BuddyCount > 0 Then
        For a = 1 To BuddyCount
            If ServiceSocket(Index).State = 7 Then
                Open UserInfo(Index).UserID & "2.dat" For Random As gFileNum Len = Len(Buddy)
                    Get #gFileNum, a, Buddy
                    BuddyUserID = Trim(Buddy)
                    BuddyUserTitle = Trim(Buddy)
                Close #gFileNum
                DoEvents
                If BuddyCount > intMax Then
                    Temp3 = BuddyCount
                Else
                    Temp3 = intMax
                End If
                    For u = 0 To intMax
                        BuddyUserFound = False
                        Dim Temp4 As String
                        If UserInfo(u).UserID = "" Then
                            Temp4 = "N/A"
                        Else
                            Temp4 = UserInfo(u).UserID
                        End If
                        If BuddyUserID = Temp4 Then
                            If Not Word(UserInfo(u).UserID, 1) = Word(UserInfo(Index).UserID, 1) Then
                                If ServiceSocket(u).State = 7 Then
                                    BuddyUserFound = True
                                    ServiceSocket(Index).SendData ".pushbuddy " & TranslateStatus(UserInfo(u).Status) & " " & BuddyUserID & " " & BuddyUserTitle
                                    DoEvents
                                    Exit For
                                Else
                                    BuddyUserFound = True
                                    ServiceSocket(Index).SendData ".pushbuddy Offline " & BuddyUserID & " " & BuddyUserTitle
                                    DoEvents
                                    Exit For
                                End If
                            End If
                        End If
                    Next
                If BuddyUserFound = False Then
                    ServiceSocket(Index).SendData ".pushbuddy Offline " & BuddyUserID & " " & BuddyUserTitle
                End If
                DoEvents
            End If
            timedPause 1
        Next
    End If
End Function

Public Function AddBuddy(UserCommand As String, Index As Integer)
    Dim UserCount As Integer
    Dim BuddyCount As Integer
    Dim g As Integer
    BuddyCount = Val(LoadINI(UserInfo(Index).UserID, "Count", "BuddyList"))
    If BuddyCount > 0 Then
        Open UserInfo(Index).UserID & "2.dat" For Random As gFileNum Len = Len(Buddy)
        For g = 1 To BuddyCount
            Get #gFileNum, g, Buddy
            If Trim(Buddy) = Word(UserCommand, 3) Then
                ServiceSocket(Index).SendData ".AlreadyOnList"
                Exit Function
            End If
        Next g
        Close #gFileNum
    End If
    UserCount = Val(LoadINI("Count", "UserCount", "TotalUsers"))
    Dim TempUser As String
    Dim TempIndex As Integer
    If UserInfo(Index).UserID = Word(UserCommand, 3) Then
        ServiceSocket(Index).SendData ".ServerMessage You can not add yourself!  =P"
        Exit Function
    End If
    For u = 1 To UserCount
        Open "Server.dat" For Random As gFileNum Len = Len(SavedUserInfo)
            Get #gFileNum, u, SavedUserInfo
            TempUser = Trim(SavedUserInfo.UserID)
        Close #gFileNum
        DoEvents
        TempIndex = u
        If TempUser = Word(UserCommand, 3) Then GoTo ContAdd
    Next
    ServiceSocket(Index).SendData ".ServerMessage User does not exist!"
    Exit Function
ContAdd:
    BuddyCount = Val(LoadINI(UserInfo(Index).UserID, "Count", "BuddyList")) + 1
    SaveINI UserInfo(Index).UserID, "Count", "BuddyList", Str(BuddyCount)
    Open UserInfo(Index).UserID & "2.dat" For Random As gFileNum Len = Len(Buddy)
        Buddy = Word(UserCommand, 3)
        Put #gFileNum, BuddyCount, Buddy
    Close #gFileNum
    ServiceSocket(Index).SendData ".pushbuddy Offline " & TempUser & " " & TempUser
    DoEvents
End Function

Public Function RemoveBuddy(UserCommand As String, Index As Integer)
    Dim BuddyCount As Integer
    Dim TempBuddy As String
    Dim TempBuddyID As String
    Dim TempBuddyName As String
    BuddyCount = LoadINI(UserInfo(Index).UserID, "Count", "BuddyList")
    If BuddyCount = 0 Then Exit Function
    For a = 1 To BuddyCount
        Open UserInfo(Index).UserID & "2.dat" For Random As gFileNum Len = Len(Buddy)
            Get #gFileNum, a, Buddy
            TempBuddy = Trim(Buddy)
        Close #gFileNum
        If TempBuddy = Word(UserCommand, 2) Then
            For u = a To BuddyCount - 1
                Open UserInfo(Index).UserID & "2.dat" For Random As gFileNum Len = Len(Buddy)
                    Get #gFileNum, u + 1, Buddy
                    Put #gFileNum, u, Buddy
                Close #gFileNum
                DoEvents
            Next
            Open UserInfo(Index).UserID & "2.dat" For Random As gFileNum Len = Len(Buddy)
                Put #gFileNum, BuddyCount, vbNullString
            Close #gFileNum
            DoEvents
            SaveINI UserInfo(Index).UserID, "Count", "BuddyList", BuddyCount - 1
            ServiceSocket(Index).SendData ".RemoveBuddy " & Word(UserCommand, 2)
            Exit Function
        End If
    Next
End Function

Public Function Status(UserCommand As String, Index As Integer)
    UserInfo(Index).Status = Word(UserCommand, 2)
    If UserInfo(Index).Status = "Invisible" Then UserInfo(Index).Status = "Offline"
End Function

Public Function GetStatus(UserCommand As String, Index As Integer)
    For u = 0 To intMax
        If WordIndex(" ", Trim(UserInfo(u).UserID)) Then
            UserInfo(u).UserID = "N/A"
        End If
        If InStr(1, Trim(Word(UserCommand, 2)), Trim(UserInfo(u).UserID)) Then
            If Not UserInfo(u).UserID = UserInfo(Index).UserID Then
                If ServiceSocket(u).State = 7 Then
                    If InStr(1, UserInfo(u).Status, "Invisible") Then
                        ServiceSocket(Index).SendData ".pushbuddyupdate " & UserInfo(u).UserID & " Offline"
                        DoEvents
                        Exit Function
                    Else
                        ServiceSocket(Index).SendData ".pushbuddyupdate " & UserInfo(u).UserID & " " & UserInfo(u).Status
                        DoEvents
                        Exit Function
                    End If
                Else
                    ServiceSocket(Index).SendData ".pushbuddyupdate " & UserInfo(u).UserID & " Offline"
                    DoEvents
                    Exit Function