form1.frm

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

                End If
            End If
        End If
    Next
    ServiceSocket(Index).SendData ".pushbuddyupdate " & Word(UserCommand, 2) & " Offline"
    DoEvents
End Function

Public Function Message(UserCommand As String, Index As Integer)
    On Error Resume Next
    Dim IMMyName As String
    IMMyName = Replace(UserInfo(Index).Nickname, " ", "_._")
    Dim TempUserID As Variant
    For u = 0 To intMax
        If InStr(1, Word(UserCommand, Words(UserCommand)), UserInfo(u).UserID) Then
            For a = 1 To Val(LoadINI(UserInfo(u).UserID, "Count", "IgnoreList"))
                Open UserInfo(u).UserID & "3.dat" For Random As gFileNum Len = Len(Ignore)
                    Get #gFileNum, a, Ignore
                Close #gFileNum
                If Trim(Ignore) = UserInfo(Index).UserID Then Exit Function
            Next
            If ServiceSocket(u).State = 7 Then
                If Not UserInfo(u).Status = "Offline" Then
                    timedPause 1
                    TempUserID = UserInfo(Index).UserID
                    ServiceSocket(u).SendData ".msg " & TempUserID & " " & IMMyName & " ..//.. " & MidWord(UserCommand, 2, Words(UserCommand) - 1)
                    Exit Function
                End If
            End If
        End If
    Next
    ServiceSocket(Index).SendData ".ServerMessage User is not online."
End Function

Public Function GetIPForFileSend(UserCommand As String, Index As Integer)
    For u = 0 To intMax
        If UserInfo(u).UserID = "" Then
            UserInfo(u).UserID = "N/A"
        End If
        For a = 1 To Val(LoadINI(UserInfo(u).UserID, "Count", "IgnoreList"))
            Open UserInfo(u).UserID & "3.dat" For Random As gFileNum Len = Len(Ignore)
                Get #gFileNum, a, Ignore
            Close #gFileNum
            If Trim(Ignore) = UserInfo(Index).UserID Then Exit Function
        Next
        If InStr(1, Word(Trim(UserCommand), 2), UserInfo(u).UserID) Then
            ServiceSocket(Index).SendData ".SendFile " & UserInfo(u).UserIP
            Exit Function
        End If
    Next
    ServiceSocket(Index).SendData ".ServerMessage User not online."
End Function

Public Function RecieveFile(UserCommand As String, Index As Integer)
    For u = 0 To intMax
        If UserInfo(u).UserID = "" Then
            UserInfo(u).UserID = "N/A"
        End If
        If InStr(1, Word(Trim(UserCommand), 2), UserInfo(u).UserID) Then
            ServiceSocket(u).SendData ".RecieveFile " & UserInfo(Index).UserIP
        End If
    Next
End Function

Public Function GetIPForRTChat(UserCommand As String, Index As Integer)
    For u = 0 To intMax
        If UserInfo(u).UserID = "" Then
            UserInfo(u).UserID = "N/A"
        End If
        If Word(UserCommand, 2) = UserInfo(u).UserID Then
            For a = 1 To Val(LoadINI(UserInfo(u).UserID, "Count", "IgnoreList"))
                Open UserInfo(u).UserID & "3.dat" For Random As gFileNum Len = Len(Ignore)
                    Get #gFileNum, a, Ignore
                Close #gFileNum
                If Trim(Ignore) = UserInfo(Index).UserID Then Exit Function
            Next
            ServiceSocket(u).SendData ".RTChat2 " & UserInfo(Index).UserID
            Exit Function
        End If
    Next
    ServiceSocket(Index).SendData ".ServerMessage User not online."
End Function

Public Function BeginRTChat(UserCommand As String, Index As Integer)
    For u = 0 To intMax
        If UserInfo(u).UserID = "" Then
            UserInfo(u).UserID = "N/A"
        End If
        If Word(UserCommand, 2) = UserInfo(u).UserID Then
            ServiceSocket(u).SendData ".RTChat " & UserInfo(Index).UserIP
            Exit Function
        End If
    Next
    ServiceSocket(Index).SendData ".ServerMessage User not online."
End Function

Public Function CancelRTChat(UserCommand As String, Index As Integer)
    For u = 0 To intMax
        If UserInfo(u).UserID = "" Then
            UserInfo(u).UserID = "N/A"
        End If
        If Word(UserCommand, 2) = UserInfo(u).UserID Then
            ServiceSocket(u).SendData ".ServerMessage User cancelled chat."
            Exit Function
        End If
    Next
    ServiceSocket(Index).SendData ".ServerMessage User not online."
End Function

Public Function SaveInfo(UserCommand As String, Index As Integer)
    UserPersonalInfo.Sex = Word(UserCommand, 3)
    UserPersonalInfo.Country = Word(UserCommand, 4)
    UserPersonalInfo.BirthDay = Word(UserCommand, 5)
    UserPersonalInfo.Age = Word(UserCommand, 6)
    UserPersonalInfo.Webpage = Word(UserCommand, 7)
    UserPersonalInfo.About = MidWord(UserCommand, 8, Val(Words(UserCommand)) - 7)
    Open Word(UserCommand, 2) & ".dat" For Random As gFileNum Len = Len(UserPersonalInfo)
        Put #gFileNum, 1, UserPersonalInfo
    Close #gFileNum
End Function

Public Function GetBuddyInfo(UserCommand As String, Index As Integer)
    Dim UserCount As Integer
    UserCount = Val(LoadINI("Count", "UserCount", "TotalUsers"))
    Dim TempUser As String
    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
        If InStr(1, Word(UserCommand, 2), TempUser) Then
            Open TempUser & ".dat" For Random As gFileNum Len = Len(UserPersonalInfo)
                Get #gFileNum, 1, UserPersonalInfo
                ServiceSocket(Index).SendData ".UserInfo " & Trim(UserPersonalInfo.Country) & " " & Trim(UserPersonalInfo.BirthDay) & " " & Trim(UserPersonalInfo.Age) & " " & Trim(UserPersonalInfo.Webpage) & " " & Trim(UserPersonalInfo.About) & " " & Trim(UserPersonalInfo.Sex)
            Close #gFileNum
            Exit Function
        End If
    Next
End Function

Public Function Report(UserCommand As String, Index As Integer)
    Select Case Word(UserCommand, 2)
        Case "Complaint"
            FileComplaint UserCommand, Index
        Case "Bug"
            FileBug UserCommand, Index
        Case "Comment"
            FileComment UserCommand, Index
        Case Else
            ServiceSocket(Index).SendData ".ServerMessage Err: Was unable to determine what kind of report you were trying to file!"
    End Select
End Function

Public Function FileComplaint(UserCommand As String, Index As Integer)
    Dim ComplaintsCount As Integer
    ComplaintsCount = Val(LoadINI("Reports", "Complaints", "Count"))
    ComplaintsCount = ComplaintsCount + 1
    SaveINI "Reports", "Complaints", "Count", Str(ComplaintsCount)
    SaveINI "Reports", "Complaints", "Complaint" & ComplaintsCount, Now & ":" & UserInfo(Index).UserID & ": " & MidWord(UserCommand, 3, Words(UserCommand) - 2)
    RichTextBox1.SelColor = vbOrange
    RichTextBox1.SelText = Now & ":" & UserInfo(Index).UserID & ":Filed the complaint: " & MidWord(UserCommand, 3, Words(UserCommand) - 2) & vbCrLf
    RichTextBox1.SelColor = vbBlack
    ServiceSocket(Index).SendData ".ServerMessage Your report was filed correctly."
    Text3.Text = ComplaintsCount
End Function

Public Function FileBug(UserCommand As String, Index As Integer)
    Dim BugCount As Integer
    BugCount = Val(LoadINI("Reports", "Bugs", "Count"))
    BugCount = BugCount + 1
    SaveINI "Reports", "Bugs", "Count", Str(BugCount)
    SaveINI "Reports", "Bugs", "Bug" & BugCount, Now & ":" & UserInfo(Index).UserID & ": " & MidWord(UserCommand, 3, Words(UserCommand) - 2)
    RichTextBox1.SelColor = vbOrange
    RichTextBox1.SelText = Now & ":" & UserInfo(Index).UserID & ":Filed the bug: " & MidWord(UserCommand, 3, Words(UserCommand) - 2) & vbCrLf
    RichTextBox1.SelColor = vbBlack
    ServiceSocket(Index).SendData ".ServerMessage Your report was filed correctly."
    Text4.Text = BugCount
End Function

Public Function FileComment(UserCommand As String, Index As Integer)
    Dim CommentsCount As Integer
    CommentsCount = Val(LoadINI("Reports", "Comments", "Count"))
    CommentsCount = CommentsCount + 1
    SaveINI "Reports", "Comments", "Count", Str(CommentsCount)
    SaveINI "Reports", "Comments", "Comment" & CommentsCount, Now & ":" & UserInfo(Index).UserID & ": " & MidWord(UserCommand, 3, Words(UserCommand) - 2)
    RichTextBox1.SelColor = vbOrange
    RichTextBox1.SelText = Now & ":" & UserInfo(Index).UserID & ":Filed the comment: " & MidWord(UserCommand, 3, Words(UserCommand) - 2) & vbCrLf
    RichTextBox1.SelColor = vbBlack
    ServiceSocket(Index).SendData ".ServerMessage Your report was filed correctly."
    Text5.Text = CommentsCount
End Function

Public Function Password(UserCommand As String, Index As Integer)
    Dim UserCount As Integer
    UserCount = Val(LoadINI("Count", "UserCount", "TotalUsers"))
    For a = 1 To UserCount
        Open "Server.dat" For Random As gFileNum Len = Len(SavedUserInfo)
            Get #gFileNum, a, SavedUserInfo
            If UCase(Trim(SavedUserInfo.UserID)) = UCase(UserInfo(Index).UserID) Then
                SavedUserInfo.Password = Word(UserCommand, 2)
                Put #gFileNum, a, SavedUserInfo
                ServiceSocket(Index).SendData ".ServerMessage Password changed correctly!"
                Close #gFileNum
                Exit Function
            End If
        Close #gFileNum
    Next
    ServiceSocket(Index).SendData ".ServerMessage Password not changed!"
    Beep
    RichTextBox1.SelColor = vbRed
    RichTextBox1.SelText = Now & ":" & UserInfo(Index).UserID & ":POSSIBLE HACKING ATTEMPT: User failed to change password!" & vbCrLf
    RichTextBox1.SelColor = vbBlack
End Function

Public Function AddIgnore(UserCommand As String, Index As Integer)
    Dim UserCount As Integer
    Dim IgnoreCount As Integer
    Dim g As Integer
    IgnoreCount = Val(LoadINI(UserInfo(Index).UserID, "Count", "IgnoreList"))
    If IgnoreCount > 0 Then
        Open UserInfo(Index).UserID & "3.dat" For Random As gFileNum Len = Len(Ignore)
        For g = 1 To IgnoreCount
            Get #gFileNum, g, Ignore
            If Trim(Ignore) = Word(UserCommand, 2) 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, 2) 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, 2) Then GoTo ContAdd
    Next
    ServiceSocket(Index).SendData ".ServerMessage User does not exist!"
    Exit Function
ContAdd:
    IgnoreCount = Val(LoadINI(UserInfo(Index).UserID, "Count", "IgnoreList")) + 1
    SaveINI UserInfo(Index).UserID, "Count", "IgnoreList", Str(IgnoreCount)
    Open UserInfo(Index).UserID & "3.dat" For Random As gFileNum Len = Len(Ignore)
        Ignore = Word(UserCommand, 2)
        Put #gFileNum, IgnoreCount, Ignore
    Close #gFileNum
    ServiceSocket(Index).SendData ".AddIgnore " & TempUser
    DoEvents
End Function

Public Function RemoveIgnore(UserCommand As String, Index As Integer)
    On Error Resume Next
    Dim IgnoreCount As Integer
    Dim TempIgnore As String
    IgnoreCount = Val(LoadINI(UserInfo(Index).UserID, "Count", "IgnoreList"))
    If IgnoreCount = 0 Then Exit Function
    If Val(Word(UserCommand, 2)) < 0 Then Exit Function
    For a = Val(Word(UserCommand, 2)) + 1 To IgnoreCount - 1
        Open UserInfo(Index).UserID & "3.dat" For Random As gFileNum Len = Len(Ignore)
            Get #gFileNum, a + 1, Ignore
            Put #gFileNum, a, Ignore
        Close #gFileNum
        DoEvents
    Next
    Open UserInfo(Index).UserID & "3.dat" For Random As gFileNum Len = Len(Ignore)
         Put #gFileNum, IgnoreCount, vbNullString
    Close #gFileNum
    DoEvents
    IgnoreCount = IgnoreCount - 1
    SaveINI UserInfo(Index).UserID, "Count", "IgnoreList", Str(IgnoreCount)
    GetIgnoreList UserCommand, Index
End Function

Public Function GetIgnoreList(UserCommand As String, Index As Integer)
    On Error Resume Next
    Dim IgnoreCount As Integer
    IgnoreCount = Val(LoadINI(UserInfo(Index).UserID, "Count", "IgnoreList"))
    DoEvents
    ServiceSocket(Index).SendData ".ClearIgnoreList"
    DoEvents
    If IgnoreCount > 0 Then
        For a = 1 To IgnoreCount
            Open UserInfo(Index).UserID & "3.dat" For Random As gFileNum Len = Len(Ignore)
                Get #gFileNum, a, Ignore
                DoEvents
                Temp = Ignore
                DoEvents
            Close #gFileNum
            If Not Temp = Ignore Then Temp = Ignore
            DoEvents
            ServiceSocket(Index).SendData ".AddIgnore " & Temp
            timedPause 1
        Next
    End If
End Function