frmserver.frm

这是一个用vb 写的聊天室

VERSION 5.00
Object = "{248DD890-BB45-11CF-9ABC-0080C7E7B78D}#1.0#0"; "MSWINSCK.OCX"
Begin VB.Form frmServer 
   BorderStyle     =   1  'Fixed Single
   Caption         =   "Amojeba Server"
   ClientHeight    =   5550
   ClientLeft      =   4230
   ClientTop       =   3495
   ClientWidth     =   7140
   Icon            =   "frmServer.frx":0000
   LinkTopic       =   "Form1"
   LockControls    =   -1  'True
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   5550
   ScaleWidth      =   7140
   Begin VB.Frame Frame6 
      Caption         =   "Controls:"
      Height          =   2130
      Left            =   5010
      TabIndex        =   15
      Top             =   45
      Width           =   2100
      Begin VB.CommandButton cmdEditUsr 
         Caption         =   "Edit User"
         Height          =   315
         Left            =   240
         TabIndex        =   18
         Top             =   1365
         Width           =   1620
      End
      Begin VB.CommandButton cmdRemUsr 
         Caption         =   "Remove User"
         Height          =   315
         Left            =   240
         TabIndex        =   17
         Top             =   900
         Width           =   1620
      End
      Begin VB.CommandButton cmdAddUsr 
         Caption         =   "Add User"
         Height          =   315
         Left            =   240
         TabIndex        =   16
         Top             =   435
         Width           =   1620
      End
   End
   Begin VB.Frame Frame4 
      Caption         =   "Log:"
      Height          =   2490
      Left            =   60
      TabIndex        =   7
      Top             =   45
      Width           =   4845
      Begin VB.TextBox txtHistory 
         Height          =   2160
         Left            =   105
         Locked          =   -1  'True
         MultiLine       =   -1  'True
         ScrollBars      =   3  'Both
         TabIndex        =   8
         ToolTipText     =   "Click the right mouse button to clear the log window"
         Top             =   225
         Width           =   4650
      End
   End
   Begin VB.Frame Frame2 
      Caption         =   "Server Control:"
      Height          =   2940
      Left            =   60
      TabIndex        =   2
      Top             =   2595
      Width           =   4860
      Begin VB.Frame Frame5 
         Caption         =   "Debug Text:"
         Height          =   720
         Left            =   90
         TabIndex        =   13
         Top             =   2130
         Width           =   3180
         Begin VB.TextBox txtDebug 
            Height          =   315
            Left            =   60
            TabIndex        =   14
            Top             =   255
            Width           =   3060
         End
      End
      Begin VB.Frame Frame3 
         Caption         =   "Status:"
         Height          =   2700
         Left            =   3315
         TabIndex        =   3
         Top             =   150
         Width           =   1440
         Begin VB.CommandButton cmdOffline 
            Caption         =   "Offline"
            Height          =   315
            Left            =   90
            TabIndex        =   5
            Top             =   2295
            Width           =   1290
         End
         Begin VB.CommandButton cmdOnline 
            Caption         =   "Online"
            Enabled         =   0   'False
            Height          =   315
            Left            =   90
            TabIndex        =   4
            Top             =   1980
            Width           =   1290
         End
         Begin VB.Label Label1 
            Alignment       =   2  'Center
            Caption         =   "Use the online command button to turn the server online and the offline command to turn the server offline (no users can connect)"
            Height          =   1620
            Left            =   105
            TabIndex        =   6
            Top             =   285
            Width           =   1245
         End
      End
      Begin VB.Label Label2 
         Alignment       =   2  'Center
         Caption         =   "User control updated, everything is now working!"
         ForeColor       =   &H00800000&
         Height          =   690
         Left            =   330
         TabIndex        =   19
         Top             =   1215
         Width           =   2760
      End
      Begin VB.Label lblPort 
         AutoSize        =   -1  'True
         Caption         =   "Server Port:"
         Height          =   195
         Left            =   90
         TabIndex        =   11
         Top             =   750
         Width           =   840
      End
      Begin VB.Label lblIP 
         AutoSize        =   -1  'True
         Caption         =   "IP Address:"
         Height          =   195
         Left            =   105
         TabIndex        =   10
         Top             =   510
         Width           =   810
      End
      Begin VB.Label lblHost 
         AutoSize        =   -1  'True
         Caption         =   "Host:"
         Height          =   195
         Left            =   105
         TabIndex        =   9
         Top             =   270
         Width           =   375
      End
   End
   Begin VB.Frame Frame1 
      Caption         =   "Online Users:"
      Height          =   3285
      Left            =   4995
      TabIndex        =   0
      Top             =   2250
      Width           =   2115
      Begin VB.Timer Timer1 
         Interval        =   2000
         Left            =   1470
         Top             =   2865
      End
      Begin VB.CommandButton cmdKick 
         Caption         =   "Kick"
         Enabled         =   0   'False
         Height          =   315
         Left            =   120
         TabIndex        =   12
         Top             =   2895
         Width           =   795
      End
      Begin VB.ListBox lstUsers 
         Height          =   2595
         Left            =   120
         TabIndex        =   1
         Top             =   240
         Width           =   1905
      End
   End
   Begin MSWinsockLib.Winsock sockServer 
      Index           =   0
      Left            =   2565
      Top             =   4860
      _ExtentX        =   741
      _ExtentY        =   741
      _Version        =   393216
      LocalPort       =   9456
   End
End
Attribute VB_Name = "frmServer"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

Private Sub cmdAddUsr_Click()
    frmOptions.Show
End Sub

Private Sub cmdEditUsr_Click()
    frmOptions.Show
End Sub

Private Sub cmdKick_Click()
If lstUsers.ListCount > 0 Then
  If lstUsers.ListIndex <> -1 Then
    Dim UsrNfo As Variant, Indexnum As Integer, KillUser As Integer, KillIndex As Variant
    UsrNfo = Split(lstUsers.Text, "/")
    Indexnum = UsrNfo(1)
    For KillUser = 0 To lstUsers.ListCount - 1
      KillIndex = Split(lstUsers.List(KillUser), "/")
      KillIndex = KillIndex(1)
        If LCase(Indexnum) = LCase(KillIndex) Then
            lstUsers.RemoveItem KillUser
            Exit For
        End If
    Next KillUser
    sockServer(Indexnum).Close
    Unload sockServer(Indexnum)
  Else
    MsgBox "No user selected to kill", vbOKOnly, "Kill User"
  End If