main.frm

用VB开发的聊天室

VERSION 5.00
Object = "{248DD890-BB45-11CF-9ABC-0080C7E7B78D}#1.0#0"; "MSWINSCK.OCX"
Object = "{3B7C8863-D78F-101B-B9B5-04021C009402}#1.1#0"; "RICHTX32.OCX"
Begin VB.Form Main 
   BorderStyle     =   1  'Fixed Single
   Caption         =   "Whisper:"
   ClientHeight    =   3345
   ClientLeft      =   150
   ClientTop       =   435
   ClientWidth     =   8985
   Icon            =   "Main.frx":0000
   LinkTopic       =   "Form1"
   LockControls    =   -1  'True
   MaxButton       =   0   'False
   Picture         =   "Main.frx":08CA
   ScaleHeight     =   3716.667
   ScaleMode       =   0  'User
   ScaleWidth      =   9066.806
   StartUpPosition =   3  'Windows Default
   Begin VB.Timer Timer2 
      Enabled         =   0   'False
      Interval        =   200
      Left            =   0
      Top             =   0
   End
   Begin VB.Timer Timer1 
      Enabled         =   0   'False
      Interval        =   1
      Left            =   3900
      Top             =   1440
   End
   Begin RichTextLib.RichTextBox conversation 
      Height          =   2790
      Left            =   99
      TabIndex        =   1
      Top             =   90
      Width           =   6735
      _ExtentX        =   11880
      _ExtentY        =   4921
      _Version        =   327680
      BackColor       =   0
      BorderStyle     =   0
      ReadOnly        =   -1  'True
      ScrollBars      =   2
      TextRTF         =   $"Main.frx":34FD
   End
   Begin MSWinsockLib.Winsock whispertcp 
      Index           =   0
      Left            =   2340
      Top             =   930
      _ExtentX        =   741
      _ExtentY        =   741
      RemotePort      =   50400
   End
   Begin VB.TextBox Say 
      BackColor       =   &H00000000&
      ForeColor       =   &H00FFFF00&
      Height          =   285
      Left            =   99
      TabIndex        =   0
      Top             =   2970
      Width           =   8799
   End
   Begin VB.ListBox peeplist 
      BackColor       =   &H00000000&
      ForeColor       =   &H0000FF00&
      Height          =   2790
      Left            =   6933
      Sorted          =   -1  'True
      TabIndex        =   3
      TabStop         =   0   'False
      Top             =   90
      Width           =   1965
   End
   Begin VB.CommandButton Command1 
      Caption         =   "Say"
      Default         =   -1  'True
      Enabled         =   0   'False
      Height          =   315
      Left            =   4380
      TabIndex        =   2
      TabStop         =   0   'False
      Top             =   1710
      Width           =   615
   End
   Begin VB.Menu whispermen 
      Caption         =   "whisper"
      Visible         =   0   'False
      Begin VB.Menu Cls 
         Caption         =   "&Clear"
      End
      Begin VB.Menu logmen 
         Caption         =   "&Logging"
         Begin VB.Menu logon 
            Caption         =   "&On "
         End
         Begin VB.Menu logoff 
            Caption         =   "O&ff"
            Checked         =   -1  'True
         End
      End
      Begin VB.Menu sepone 
         Caption         =   "-"
      End
      Begin VB.Menu gethelp 
         Caption         =   "&Help"
      End
      Begin VB.Menu septwo 
         Caption         =   "-"
      End
      Begin VB.Menu Quitwhisper 
         Caption         =   "&Exit"
      End
   End
   Begin VB.Menu peepop 
      Caption         =   "peeplist"
      Visible         =   0   'False
      Begin VB.Menu kick 
         Caption         =   "&Kick"
      End
   End
End
Attribute VB_Name = "Main"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private prev As String
Private users As Integer
Private timers As Integer
Private peeplisting As Integer
Private timerstwo As Integer

Private Sub Cls_Click()
conversation.Text = ""
End Sub

Private Sub Command1_Click()
On Error Resume Next
prev = Say.Text
commands$ = LCase(Say)
speek$ = "(" & whispertcp(0).Tag & ") " & Say.Text & Chr(10)
If Left(commands$, 5) = "/msg " Then
    For X = 0 To peeplist.ListCount - 1
        peepsthere$ = peeplist.List(X)
        If X = 0 Then peepsthere$ = Mid(peeplist.List(X), 2)
        Y = InStr(6, LCase(Say.Text), LCase(peepsthere))
        Dim target As String * 11
        If Y <> 0 Then
            If X <> 0 Then target = peeplist.List(X)
            If X = 0 Then target = Mid(peeplist.List(X), 2)
        End If
    Next
    If Trim(target) = "" Or Trim(target) = whispertcp(0).Tag Then
        Say.Text = ""
        Say.SetFocus
        Exit Sub
    End If
    Dim myname As String * 11
    If Setup.Combo1.ListIndex = 0 Then
        myname = whispertcp(0).Tag
        speek$ = "msg:" & target & myname & Mid(Say, 6 + Len(Trim(target)))
        whispertcp(0).SendData speek$
        If logon.Checked = True Then
            speek$ = ">>Private message to " & Trim(target) & ": " & Mid(Say, 6 + Len(Trim(target)))
            Print #1, speek$
        End If
        speek$ = ">>" & Trim(target) & "<< " & Mid(Say, 6 + Len(Trim(target))) & Chr(10)
        conversation.Text = conversation.Text & speek$
        conversation.SelStart = Len(conversation.Text)
        Say.Text = ""
        Say.SetFocus
        Exit Sub
    End If
    If Setup.Combo1.ListIndex = 1 Then
        myname = whispertcp(0).Tag
        speek$ = "msg:" & target & myname & Mid(Say, 6 + Len(Trim(target)))
        Timer1.Tag = speek$
        timers = 1
        Timer1.Enabled = True
        If logon.Checked = True Then
            speek$ = ">>Private message to " & Trim(target) & ": " & Mid(Say, 6 + Len(Trim(target)))
            Print #1, speek$
        End If
        speek$ = ">>" & Trim(target) & "<< " & Mid(Say, 6 + Len(Trim(target))) & Chr(10)
        conversation.Text = conversation.Text & speek$
        conversation.SelStart = Len(conversation.Text)
        Say.Text = ""
        Say.SetFocus
        Exit Sub
    End If
End If
If Left(commands$, 4) = "/cls" Then
    conversation.Text = ""
    Say.Text = ""
    Say.SetFocus
    Exit Sub
End If
If Left(commands$, 4) = "/log" Then
    If logon.Checked = False Then
        logon_Click
        Say.Text = ""
        Say.SetFocus
        Exit Sub
    End If
    If logoff.Checked = False Then
        logoff_Click
        Say.Text = ""
        Say.SetFocus
        Exit Sub
    End If
End If
If Left(commands$, 5) = "/quit" Then End
If Left(commands$, 6) = "/kick " Then
    Say.Text = ""
    Say.SetFocus
    If Setup.Combo1.ListIndex <> 1 Then Exit Sub
    kicked$ = Mid(commands, 7)
    For X = 1 To peeplist.ListCount - 1
        If LCase(peeplist.List(X)) = LCase(kicked) Then peeplist.ListIndex = X: kick_Click
    Next
    Exit Sub
End If
If commands$ = "/help" Then gethelp_Click
If Left(commands, 6) = "/nick " Then
    Dim oldnick As String * 11
    Dim newnick As String * 11
    newname = Trim(Mid(Say, 7))
    If newname = whispertcp(0).Tag Then
        Say.Text = ""
        Say.SetFocus
        Exit Sub
    End If
    good$ = "true"
    X = InStr(1, newname, "!")
    If X <> 0 Then good$ = "false"
    X = InStr(1, newname, "