chat.frm

这是一个用vb 写的聊天室

VERSION 5.00
Object = "{3B7C8863-D78F-101B-B9B5-04021C009402}#1.2#0"; "RICHTX32.OCX"
Begin VB.Form Chat 
   BorderStyle     =   1  'Fixed Single
   Caption         =   "Amojeba Message"
   ClientHeight    =   3180
   ClientLeft      =   150
   ClientTop       =   435
   ClientWidth     =   4395
   Icon            =   "Chat.frx":0000
   LinkTopic       =   "Form1"
   LockControls    =   -1  'True
   MaxButton       =   0   'False
   ScaleHeight     =   3180
   ScaleWidth      =   4395
   StartUpPosition =   3  'Windows Default
   Begin VB.TextBox txtEncCode 
      Height          =   330
      Left            =   3240
      TabIndex        =   9
      Top             =   5550
      Width           =   1155
   End
   Begin VB.TextBox txtLast 
      Height          =   315
      Left            =   1260
      TabIndex        =   7
      Text            =   "Text1"
      Top             =   5295
      Width           =   1605
   End
   Begin VB.ComboBox cboUsers 
      BeginProperty Font 
         Name            =   "MS Sans Serif"
         Size            =   8.25
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   315
      Left            =   390
      TabIndex        =   3
      Top             =   135
      Width           =   2670
   End
   Begin RichTextLib.RichTextBox rtxtRecv 
      Height          =   1830
      Left            =   405
      TabIndex        =   0
      Top             =   3450
      Visible         =   0   'False
      Width           =   4395
      _ExtentX        =   7752
      _ExtentY        =   3228
      _Version        =   393217
      Enabled         =   -1  'True
      ReadOnly        =   -1  'True
      ScrollBars      =   2
      TextRTF         =   $"Chat.frx":030A
   End
   Begin RichTextLib.RichTextBox rtxtSend 
      Height          =   1290
      Left            =   0
      TabIndex        =   1
      Top             =   1020
      Width           =   4395
      _ExtentX        =   7752
      _ExtentY        =   2275
      _Version        =   393217
      Enabled         =   -1  'True
      ScrollBars      =   2
      TextRTF         =   $"Chat.frx":03B8
   End
   Begin VB.Frame fraCommand 
      Height          =   870
      Left            =   15
      TabIndex        =   4
      Top             =   2265
      Width           =   4380
      Begin VB.CommandButton cmdSend 
         Default         =   -1  'True
         DisabledPicture =   "Chat.frx":0466
         Enabled         =   0   'False
         Height          =   675
         Left            =   3645
         Picture         =   "Chat.frx":15E0
         Style           =   1  'Graphical
         TabIndex        =   5
         Top             =   150
         Width           =   645
      End
      Begin VB.Line Line4 
         BorderColor     =   &H00FFFFFF&
         X1              =   3570
         X2              =   3570
         Y1              =   180
         Y2              =   825
      End
      Begin VB.Line Line3 
         BorderColor     =   &H00808080&
         X1              =   3555
         X2              =   3555
         Y1              =   150
         Y2              =   810
      End
   End
   Begin VB.Frame fraText 
      Height          =   525
      Left            =   30
      TabIndex        =   6
      Top             =   450
      Width           =   4355
      Begin VB.CommandButton cmdCrypt 
         Caption         =   "Encryption Off"
         Height          =   285
         Left            =   90
         TabIndex        =   8
         Top             =   165
         Width           =   1260
      End
   End
   Begin VB.Label lblTo 
      AutoSize        =   -1  'True
      BackStyle       =   0  'Transparent
      Caption         =   "To:"
      Height          =   195
      Left            =   90
      TabIndex        =   2
      Top             =   180
      Width           =   240
   End
End
Attribute VB_Name = "Chat"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False

Private Sub cmdCrypt_Click()
    If cmdCrypt.Caption = "Encryption Off" Then                                         ' If encryption is off, turn it on!
        cmdCrypt.Caption = "Encryption On"                                              ' CHange the caption (just to make the user happy)
        frmLogin.sockUser.SendData "Cryption:" & Me.Tag & ":" & frmLogin.txtName.Text   ' Tell the server to turn it on (yippie)
    Else
        cmdCrypt.Caption = "Encryption Off"                                             ' User wants to be public about his chat (whatever)
        frmLogin.sockUser.SendData "NoCrypt:" & Me.Tag & ":" & frmLogin.txtName.Text    ' Tell the server he wants to go public
        Me.txtEncCode.Text = ""                                                         ' Let my computer know there is no pass anymore
    End If
End Sub

Private Sub cmdSend_Click()
If Me.Height = 5025 Then                        ' Checks to see if its a new msg

Else
    lblTo.Visible = False                       ' ******************************
    cboUsers.Visible = False                    '
    fraText.Top = fraText.Top + 1450            '
    rtxtSend.Top = rtxtSend.Top + 1450          '
    fraCommand.Top = fraCommand.Top + 1450      '       Sets the form to look
    rtxtRecv.Top = 125                          '                good
    rtxtRecv.Left = 0                           '
    rtxtRecv.Visible = True                     '
    Me.Height = 5025                            '
End If                                          ' ******************************
 If Me.rtxtSend.Text = "" Then
 
 ElseIf LCase(rtxtSend.Text) = LCase(txtLast.Text) Then     ' If its the same message stop it
    MsgBox "No Repeating", vbOKOnly, "Function Chat"        ' Tell the user no repeating
    Me.rtxtSend.Text = ""                                   ' Reset the send box
 Else
    Call AddMessage(Me, frmLogin.txtName.Text, Me.rtxtSend.Text)    ' Good message, add it
  If Me.txtEncCode.Text = "" Then                                   ' Check to see if using encryption
    frmLogin.sockUser.SendData "Message~~" & Me.Tag & "~~" & frmLogin.txtName.Text & "~~" & rtxtSend.Text   ' Nope, send it plain
  Else
    frmLogin.sockUser.SendData "Message~~" & Me.Tag & "~~" & frmLogin.txtName.Text & "~~" & Encrypt(Me.rtxtSend.Text, Me.txtEncCode.Text)   ' yup encrypt it
  End If
    txtLast.Text = rtxtSend.Text    ' Save the sent messsage to see if they send it again
    rtxtSend.Text = ""              ' Clear the send txt box
 End If
End Sub

Private Sub Form_Load()
Dim i As Integer
    For i = 0 To frmFriends.lstUsers.ListCount - 1          ' Adds all the online users to the combo box
        cboUsers.AddItem frmFriends.lstUsers.List(i)        ' -^
    Next i
cmdSend.Enabled = False                                     ' Disable the send button
End Sub

Private Sub Form_Unload(Cancel As Integer)
    If frmLogin.sockUser.State <> 0 Then                                                ' If i close the window and am still online
        frmLogin.sockUser.SendData "CloseWin:" & Me.Tag & ":" & frmLogin.txtName.Text   ' tell the person im chatting with (just for fun)
    End If
End Sub

Private Sub rtxtRecv_Change()
    rtxtRecv.SelStart = Len(rtxtRecv)   ' So dont let them.. Set the focus for them on the send txt bot
End Sub

Private Sub rtxtSend_Change()
If rtxtSend.Text = "" Then          ' If there is no text in the box disable the send button
    cmdSend.Enabled = False         ' -^
Else
    cmdSend.Enabled = True          ' There is text, enable the send button
End If
End Sub

Private Sub rtxtSend_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then               ' Makes it so the user doesnt have to use the mouse
    cmdSend_Click                   ' Just hit enter and it sends it
KeyAscii = 0                        ' Kills the beep
End If
End Sub