Planet Source Code Jumbo …e CD Visual Basic 1 to 7/1_2002.ISO/Data/Zips/CODE_UPLOAD5511552000.psc/New_Server.frm

Visual Basic Form | 2000-05-06 | 62.1 KB | 1,841 lines

VERSION 5.00
Object = "{248DD890-BB45-11CF-9ABC-0080C7E7B78D}#1.0#0"; "MSWINSCK.OCX"
Object = "{BDC217C8-ED16-11CD-956C-0000C04E4C0A}#1.1#0"; "TABCTL32.OCX"
Begin VB.Form frm_NewServer
   Caption         =   "[ Server / Client ] Multi - User Chat Program v1.0"
   ClientHeight    =   6015
   ClientLeft      =   270
   ClientTop       =   750
   ClientWidth     =   11790
   Icon            =   "New_Server.frx":0000
   LinkTopic       =   "Form2"
   MaxButton       =   0   'False
   ScaleHeight     =   6015
   ScaleWidth      =   11790
   StartUpPosition =   2  'CenterScreen
   Begin VB.ListBox Database
      Height          =   5325
      Left            =   13800
      TabIndex        =   50
      Top             =   480
      Visible         =   0   'False
      Width           =   1575
   End
   Begin TabDlg.SSTab SSTab1
      Height          =   5775
      Left            =   120
      TabIndex        =   0
      Top             =   120
      Width           =   11535
      _ExtentX        =   20346
      _ExtentY        =   10186
      _Version        =   393216
      TabHeight       =   520
      BackColor       =   -2147483638
      TabCaption(0)   =   "&Server"
      TabPicture(0)   =   "New_Server.frx":030A
      Tab(0).ControlEnabled=   -1  'True
      Tab(0).Control(0)=   "Frame4"
      Tab(0).Control(0).Enabled=   0   'False
      Tab(0).Control(1)=   "Frame1"
      Tab(0).Control(1).Enabled=   0   'False
      Tab(0).Control(2)=   "Frame3"
      Tab(0).Control(2).Enabled=   0   'False
      Tab(0).Control(3)=   "Frame5"
      Tab(0).Control(3).Enabled=   0   'False
      Tab(0).Control(4)=   "Winsock3"
      Tab(0).Control(4).Enabled=   0   'False
      Tab(0).Control(5)=   "Winsock2(0)"
      Tab(0).Control(5).Enabled=   0   'False
      Tab(0).Control(6)=   "Timer1"
      Tab(0).Control(6).Enabled=   0   'False
      Tab(0).Control(7)=   "AServer"
      Tab(0).Control(7).Enabled=   0   'False
      Tab(0).ControlCount=   8
      TabCaption(1)   =   "&Client"
      TabPicture(1)   =   "New_Server.frx":0326
      Tab(1).ControlEnabled=   0   'False
      Tab(1).Control(0)=   "Frame2"
      Tab(1).Control(1)=   "Frame7"
      Tab(1).Control(2)=   "Frame9"
      Tab(1).Control(3)=   "Frame10"
      Tab(1).Control(4)=   "Winsock1"
      Tab(1).Control(5)=   "fSend"
      Tab(1).Control(6)=   "fReceive"
      Tab(1).Control(7)=   "Timer2"
      Tab(1).ControlCount=   8
      TabCaption(2)   =   "&About"
      TabPicture(2)   =   "New_Server.frx":0342
      Tab(2).ControlEnabled=   0   'False
      Tab(2).Control(0)=   "Label15"
      Tab(2).Control(1)=   "Label17"
      Tab(2).Control(2)=   "Label18"
      Tab(2).Control(3)=   "Label19"
      Tab(2).Control(4)=   "Label16"
      Tab(2).Control(5)=   "Text3"
      Tab(2).ControlCount=   6
      Begin MSWinsockLib.Winsock AServer
         Left            =   2760
         Top             =   120
         _ExtentX        =   741
         _ExtentY        =   741
         _Version        =   393216
         LocalPort       =   12340
      End
      Begin VB.Timer Timer2
         Interval        =   400
         Left            =   -70560
         Top             =   120
      End
      Begin VB.Timer Timer1
         Interval        =   400
         Left            =   3240
         Top             =   120
      End
      Begin MSWinsockLib.Winsock fReceive
         Left            =   -68160
         Top             =   120
         _ExtentX        =   741
         _ExtentY        =   741
         _Version        =   393216
      End
      Begin MSWinsockLib.Winsock fSend
         Left            =   -68640
         Top             =   120
         _ExtentX        =   741
         _ExtentY        =   741
         _Version        =   393216
         LocalPort       =   30000
      End
      Begin MSWinsockLib.Winsock Winsock1
         Left            =   -71040
         Top             =   120
         _ExtentX        =   741
         _ExtentY        =   741
         _Version        =   393216
      End
      Begin MSWinsockLib.Winsock Winsock2
         Index           =   0
         Left            =   720
         Top             =   120
         _ExtentX        =   741
         _ExtentY        =   741
         _Version        =   393216
      End
      Begin MSWinsockLib.Winsock Winsock3
         Left            =   240
         Top             =   120
         _ExtentX        =   741
         _ExtentY        =   741
         _Version        =   393216
      End
      Begin VB.TextBox Text3
         Appearance      =   0  'Flat
         BackColor       =   &H80000004&
         Height          =   1815
         Left            =   -73200
         Locked          =   -1  'True
         MultiLine       =   -1  'True
         ScrollBars      =   2  'Vertical
         TabIndex        =   46
         Text            =   "New_Server.frx":035E
         Top             =   2880
         Width           =   7695
      End
      Begin VB.Frame Frame10
         BeginProperty Font
            Name            =   "Arial"
            Size            =   8.25
            Charset         =   0
            Weight          =   400
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         Height          =   1575
         Left            =   -74760
         TabIndex        =   33
         Top             =   480
         Width           =   5055
         Begin VB.TextBox Text3_
            Height          =   285
            Left            =   240
            TabIndex        =   37
            Text            =   "127.0.0.1"
            Top             =   480
            Width           =   2655
         End
         Begin VB.TextBox Text4_
            Height          =   285
            Left            =   3120
            TabIndex        =   36
            Text            =   "20000"
            Top             =   480
            Width           =   1695
         End
         Begin VB.TextBox Text2_
            Height          =   285
            Left            =   3120
            MaxLength       =   20
            TabIndex        =   35
            Text            =   "Password"
            Top             =   1080
            Width           =   1695
         End
         Begin VB.TextBox Text1_
            Height          =   285
            Left            =   240
            MaxLength       =   40
            MultiLine       =   -1  'True
            TabIndex        =   34
            Text            =   "New_Server.frx":0645
            Top             =   1080
            Width           =   2655
         End
         Begin VB.Label Label14
            Caption         =   "Server Hostname / IP Address :"
            BeginProperty Font
               Name            =   "Arial"
               Size            =   8.25
               Charset         =   0
               Weight          =   400
               Underline       =   0   'False
               Italic          =   0   'False
               Strikethrough   =   0   'False
            EndProperty
            Height          =   255
            Left            =   240
            TabIndex        =   41
            Top             =   240
            Width           =   2295
         End
         Begin VB.Label Label13
            Caption         =   "Server Port :"
            BeginProperty Font
               Name            =   "Arial"
               Size            =   8.25
               Charset         =   0
               Weight          =   400
               Underline       =   0   'False
               Italic          =   0   'False
               Strikethrough   =   0   'False
            EndProperty
            Height          =   255
            Left            =   3120
            TabIndex        =   40
            Top             =   240
            Width           =   1095
         End
         Begin VB.Label Label12
            Caption         =   "Password :"
            BeginProperty Font
               Name            =   "Arial"
               Size            =   8.25
               Charset         =   0
               Weight          =   400
               Underline       =   0   'False
               Italic          =   0   'False
               Strikethrough   =   0   'False
            EndProperty
            Height          =   255
            Left            =   3120
            TabIndex        =   39
            Top             =   840
            Width           =   1095
         End
         Begin VB.Label Label11
            Caption         =   "Username  :"
            BeginProperty Font
               Name            =   "Arial"
               Size            =   8.25
               Charset         =   0
               Weight          =   400
               Underline       =   0   'False
               Italic          =   0   'False
               Strikethrough   =   0   'False
            EndProperty
            Height          =   255
            Left            =   240
            TabIndex        =   38
            Top             =   840
            Width           =   1095
         End
      End
      Begin VB.Frame Frame9
         BeginProperty Font
            Name            =   "Arial"
            Size            =   8.25
            Charset         =   0
            Weight          =   400
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         Height          =   5055
         Left            =   -66840
         TabIndex        =   30
         Top             =   480
         Width           =   3135
         Begin VB.ListBox IPList
            Height          =   4350
            Left            =   1920
            TabIndex        =   47
            Top             =   480
            Width           =   1095
         End
         Begin VB.ListBox UserList_
            Height          =   4350
            Left            =   120
            TabIndex        =   31
            Top             =   480
            Width           =   1695
         End
         Begin VB.Label Label20
            Caption         =   "IP List :"
            Height          =   255
            Left            =   1920
            TabIndex        =   48
            Top             =   240
            Width           =   855
         End
         Begin VB.Label Label10
            Caption         =   "User List :"
            BeginProperty Font
               Name            =   "Arial"
               Size            =   8.25
               Charset         =   0
               Weight          =   400
               Underline       =   0   'False
               Italic          =   0   'False
               Strikethrough   =   0   'False
            EndProperty
            Height          =   255
            Left            =   120
            TabIndex        =   32
            Top             =   240
            Width           =   975
         End
      End
      Begin VB.Frame Frame7
         BeginProperty Font
            Name            =   "Arial"
            Size            =   8.25
            Charset         =   0
            Weight          =   400
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         Height          =   1575
         Left            =   -69600
         TabIndex        =   26
         Top             =   480
         Width           =   2655
         Begin VB.CommandButton Command9
            Caption         =   "&Account"
            Height          =   420
            Left            =   1440
            TabIndex        =   49
            Top             =   330
            Width           =   975
         End
         Begin VB.CommandButton Command7_
            Caption         =   "&Connect"
            Height          =   420
            Left            =   240
            TabIndex        =   29
            Top             =   330
            Width           =   975
         End
         Begin VB.Frame Frame8
            Caption         =   "Status :"
            Height          =   615
            Left            =   240
            TabIndex        =   27
            Top             =   840
            Width           =   2175
            Begin VB.Label Label6_
               Caption         =   "Closed."
               Height          =   255
               Left            =   120
               TabIndex        =   28
               Top             =   240
               Width           =   1935
            End
         End
      End
      Begin VB.Frame Frame2
         Height          =   3375
         Left            =   -74760
         TabIndex        =   22
         Top             =   2160
         Width           =   7815
         Begin VB.TextBox Text6_
            Height          =   315
            Left            =   240
            MaxLength       =   200
            TabIndex        =   24
            Top             =   2880
            Width           =   7335
         End
         Begin VB.TextBox Text5_
            Height          =   2295
            Left            =   240
            MultiLine       =   -1  'True
            ScrollBars      =   2  'Vertical
            TabIndex        =   23
            Top             =   480
            Width           =   7335
         End
         Begin VB.Label Label9
            Caption         =   "Chat Window :"
            BeginProperty Font
               Name            =   "Arial"
               Size            =   8.25
               Charset         =   0
               Weight          =   400
               Underline       =   0   'False
               Italic          =   0   'False
               Strikethrough   =   0   'False
            EndProperty
            Height          =   255
            Left            =   240
            TabIndex        =   25
            Top             =   240
            Width           =   1575
         End
      End
      Begin VB.Frame Frame5
         BeginProperty Font
            Name            =   "Arial"
            Size            =   8.25
            Charset         =   0
            Weight          =   400
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         Height          =   1575
         Left            =   5400
         TabIndex        =   17
         Top             =   480
         Width           =   2655
         Begin VB.CommandButton Command7
            Caption         =   "&Listen"
            Height          =   420
            Left            =   240
            TabIndex        =   21
            Top             =   330
            Width           =   975
         End
         Begin VB.CommandButton Command6
            Caption         =   "&Close"
            Height          =   420
            Left            =   1440
            TabIndex        =   20
            Top             =   330
            Width           =   975
         End
         Begin VB.Frame Frame6
            Caption         =   "Status :"
            Height          =   615
            Left            =   240
            TabIndex        =   18
            Top             =   840
            Width           =   2175
            Begin VB.Label Label6
               Caption         =   "Closed."
               Height          =   255
               Left            =   120
               TabIndex        =   19
               Top             =   240
               Width           =   1935
            End
         End
      End
      Begin VB.Frame Frame3
         BeginProperty Font
            Name            =   "Arial"
            Size            =   8.25
            Charset         =   0
            Weight          =   400
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         Height          =   5055
         Left            =   8160
         TabIndex        =   12
         Top             =   480
         Width           =   3135
         Begin VB.ListBox UserList
            Height          =   4350
            Left            =   120
            TabIndex        =   14
            Top             =   480
            Width           =   1695
         End
         Begin VB.ListBox BanList
            Height          =   4350
            Left            =   1920
            TabIndex        =   13
            Top             =   480
            Width           =   1095
         End
         Begin VB.Label Label7
            Caption         =   "User List :"
            Height          =   255
            Left            =   120
            TabIndex        =   16
            Top             =   240
            Width           =   735
         End
         Begin VB.Label Label3
            Caption         =   "Ban List :"
            Height          =   255
            Left            =   1920
            TabIndex        =   15
            Top             =   240
            Width           =   735
         End
      End
      Begin VB.Frame Frame1
         BeginProperty Font
            Name            =   "Arial"
            Size            =   8.25
            Charset         =   0
            Weight          =   400
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         Height          =   1575
         Left            =   240
         TabIndex        =   5
         Top             =   480
         Width           =   5055
         Begin VB.TextBox Text4
            Height          =   285
            Left            =   3000
            TabIndex        =   8
            Text            =   "20000"
            Top             =   480
            Width           =   1815
         End
         Begin VB.TextBox Text2
            BackColor       =   &H80000000&
            Height          =   285
            Left            =   240
            MaxLength       =   20
            TabIndex        =   7
            Top             =   480
            Width           =   2535
         End
         Begin VB.TextBox Text1
            Height          =   285
            Left            =   240
            TabIndex        =   6
            Text            =   "@Coozzzzz"
            Top             =   1080
            Width           =   4575
         End
         Begin VB.Label Label4
            Caption         =   "Server Port  :"
            Height          =   255
            Left            =   3000
            TabIndex        =   11
            Top             =   240
            Width           =   1095
         End
         Begin VB.Label Label2
            Caption         =   "Server IP Address :"
            Height          =   255
            Left            =   240
            TabIndex        =   10
            Top             =   240
            Width           =   2535
         End
         Begin VB.Label Label1
            Caption         =   "System Operator Name :"
            Height          =   255
            Left            =   240
            TabIndex        =   9
            Top             =   840
            Width           =   1815
         End
      End
      Begin VB.Frame Frame4
         Height          =   3375
         Left            =   240
         TabIndex        =   1
         Top             =   2160
         Width           =   7815
         Begin VB.TextBox Text5
            Height          =   2295
            Left            =   240
            Locked          =   -1  'True
            MultiLine       =   -1  'True
            ScrollBars      =   2  'Vertical
            TabIndex        =   3
            Top             =   480
            Width           =   7335
         End
         Begin VB.TextBox Text6
            Height          =   315
            Left            =   240
            TabIndex        =   2
            Top             =   2880
            Width           =   7335
         End
         Begin VB.Label Label5
            Caption         =   "Chat Window :"
            BeginProperty Font
               Name            =   "Arial"
               Size            =   8.25
               Charset         =   0
               Weight          =   400
               Underline       =   0   'False
               Italic          =   0   'False
               Strikethrough   =   0   'False
            EndProperty
            Height          =   255
            Left            =   240
            TabIndex        =   4
            Top             =   240
            Width           =   4455
         End
      End
      Begin VB.Label Label16
         Alignment       =   2  'Center
         Caption         =   "Present..."
         BeginProperty Font
            Name            =   "MS Sans Serif"
            Size            =   8.25
            Charset         =   0
            Weight          =   700
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         Height          =   255
         Left            =   -73200
         TabIndex        =   51
         Top             =   1800
         Width           =   7695
      End
      Begin VB.Label Label19
         Caption         =   "http://TrickSoft.cjb.net"
         BeginProperty Font
            Name            =   "MS Serif"
            Size            =   13.5
            Charset         =   0
            Weight          =   400
            Underline       =   -1  'True
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         Height          =   375
         Left            =   -68040
         TabIndex        =   45
         Top             =   5040
         Width           =   2655
      End
      Begin VB.Label Label18
         Caption         =   "http://BCProd.cjb.net"
         BeginProperty Font
            Name            =   "MS Serif"
            Size            =   13.5
            Charset         =   0
            Weight          =   400
            Underline       =   -1  'True
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         Height          =   375
         Left            =   -73200
         TabIndex        =   44
         Top             =   5040
         Width           =   3015
      End
      Begin VB.Label Label17
         Caption         =   "[ Server / Client ] Multi - User Chat Program v1.0"
         BeginProperty Font
            Name            =   "MS Sans Serif"
            Size            =   18
            Charset         =   0
            Weight          =   400
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         Height          =   495
         Left            =   -73200
         TabIndex        =   43
         Top             =   2160
         Width           =   7695
      End
      Begin VB.Label Label15
         Alignment       =   2  'Center
         Caption         =   "BC  +  TrickSoft Productions"
         BeginProperty Font
            Name            =   "MS Sans Serif"
            Size            =   24
            Charset         =   0
            Weight          =   400
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         Height          =   495
         Left            =   -73080
         TabIndex        =   42
         Top             =   1080
         Width           =   7455
      End
   End
   Begin VB.Menu mnu_UserList
      Caption         =   "UserList"
      Visible         =   0   'False
      Begin VB.Menu mnu_OP
         Caption         =   "@"
         Begin VB.Menu mnu_DEOP
            Caption         =   "DeOp @"
         End
         Begin VB.Menu mnu_line1
            Caption         =   "-"
         End
         Begin VB.Menu mnu_OP1
            Caption         =   "Level &1"
         End
         Begin VB.Menu mnu_OP2
            Caption         =   "Level &2"
         End
         Begin VB.Menu mnu_OP3
            Caption         =   "Level &3"
         End
         Begin VB.Menu mnu_line2
            Caption         =   "-"
         End
         Begin VB.Menu mnu_OPHelp
            Caption         =   "&Help"
         End
      End
      Begin VB.Menu mnu_line5
         Caption         =   "-"
      End
      Begin VB.Menu mnu_ServerBan
         Caption         =   "Ba&n"
         Begin VB.Menu mnu_ServerBanIP
            Caption         =   "&IP Address"
         End
         Begin VB.Menu mnu_ServerBanUsername
            Caption         =   "&Username"
         End
      End
      Begin VB.Menu mnu_Boot
         Caption         =   "Boot"
      End
      Begin VB.Menu mnu_Warn
         Caption         =   "&Warn"
      End
      Begin VB.Menu mnu_line6
         Caption         =   "-"
      End
      Begin VB.Menu mnu_CopyIP
         Caption         =   "&Copy IP"
      End
   End
   Begin VB.Menu mnu_UnbanTop
      Caption         =   "UnBan"
      Visible         =   0   'False
      Begin VB.Menu mnu_Unban
         Caption         =   "&Unban"
      End
   End
   Begin VB.Menu mnu_UserList_
      Caption         =   "UserList_"
      Visible         =   0   'False
      Begin VB.Menu mnu_Boot2
         Caption         =   "&Boot"
         Enabled         =   0   'False
      End
      Begin VB.Menu mnu_Warn2
         Caption         =   "&Warn"
         Enabled         =   0   'False
      End
      Begin VB.Menu mnu_line4
         Caption         =   "-"
      End
      Begin VB.Menu mnu_Games
         Caption         =   "&Games"
         Begin VB.Menu mnu_TicTacToe
            Caption         =   "&Tic-Tac-Toe"
         End
      End
      Begin VB.Menu mnu_line3
         Caption         =   "-"
      End
      Begin VB.Menu mnu_SendFile
         Caption         =   "&Send File..."
      End
   End
Attribute VB_Name = "frm_NewServer"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim cc As New frm_SendFile
Dim dd As New frm_SendFile
Dim tttPlayer1 As New frm_TTT
Dim tttPlayer2 As New frm_TTT
Dim ips(0 To 50) As Boolean
Dim op As Boolean
Dim pass$, port$, sFilename$, lasttext$
Dim lPos&
Dim buffer() As Byte
Dim inc%, lastsec%
Private Sub AServer_ConnectionRequest(ByVal requestID As Long)
AServer.Close
AServer.Accept requestID
End Sub
Private Sub AServer_DataArrival(ByVal bytesTotal As Long)
Dim data$
AServer.GetData data$
If Mid(data$, 1, 5) = "@name" Then
pos1% = InStr(1, data$, "@password")
dbname$ = Mid(data$, 6, pos1% - 6)
dbpw$ = Mid(data$, pos1% + 9)
datasyn$ = dbname$ & " " & dbpw$
For i = 0 To Database.ListCount
If Database.List(i) = datasyn$ Then AServer.SendData "dupe": Exit Sub
Next i
Database.AddItem datasyn$
AServer.SendData "success"
End If
If Mid(data$, 1, 5) = "@came" Then
pos1% = InStr(1, data$, "@password")
dbname$ = Mid(data$, 6, pos1% - 6)
dbpw$ = Mid(data$, pos1% + 9)
datasyn$ = dbname$ & " " & dbpw$
For i = 0 To Database.ListCount
If Database.List(i) = datasyn$ Then AServer.SendData "v": Exit Sub
Next i
AServer.SendData "nov"
End If
If Mid(data$, 1, 5) = "@chng" Then
pos1% = InStr(1, data$, "@password")
dbname$ = Mid(data$, 6, pos1% - 6)
dbpw$ = Mid(data$, pos1% + 9)
datasyn$ = dbname$ & " " & dbpw$
For i = 0 To Database.ListCount
If frm_NewServer.GetListData(Database, True, False, i) = dbname$ Then Database.List(i) = datasyn$: AServer.SendData "@changed": Exit Sub
Next i
AServer.SendData "nc"
End If
End Sub
Private Sub BanList_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button = 2 Then PopupMenu mnu_UnbanTop
End Sub
Private Sub Command6_Click()
Unload Me
End Sub
Private Sub Command7_Click()
If Command7.Caption = "&Listen" Then
If Winsock3.State <> 0 Then Winsock3.Close
Winsock3.LocalPort = Text4: Winsock3.Listen
Command7.Caption = "&Stop"
Text4.Enabled = False
pass$ = Text2: port$ = Text4
AServer.Listen
Winsock3.Close
AServer.Close
For i = 0 To 50
Winsock2(i).Close
Next i
Text4.Enabled = True:
UserList.Clear
Command7.Caption = "&Listen"
End If
End Sub
Private Sub Command9_Click()
Load frm_CreateAccount
frm_CreateAccount.Show
End Sub
Private Sub Form_Load()
UserList.Clear
UserList_.Clear
Me.Show
Me.SetFocus
For i = 1 To 50
Load Winsock2(i)
ips(i) = False
Next i
If Dir(App.Path & "/Database.db") = "" Then GoTo bottom2
Open App.Path & "/Database.db" For Input As 1
Do While Not EOF(1)
Line Input #1, up
If up <> "" And up <> " " Then Database.AddItem up
Close 1
bottom2:
Text2 = Winsock3.LocalIP
lPos = 1
End Sub
Private Sub Form_Unload(Cancel As Integer)
For i = 0 To 50
Winsock2(i).Close
If i <> 0 Then Unload Winsock2(i)
Next i
Open App.Path & "\Database.db" For Output As 1
For i = 0 To Database.ListCount
If Database.List(i) <> "" Then Print #1, Database.List(i)
Next i
Close 1
End Sub
Private Sub fSend_SendProgress(ByVal bytesSent As Long, ByVal bytesRemaining As Long)
Winsock1.SendData "@prog" & bytesRemaining & "@to" & fSend.RemoteHostIP
dd.Text2 = "Bytes Remaining : " & bytesRemaining
End Sub
Private Sub IPList_Click()
UserList_.Selected(IPList.ListIndex) = True
End Sub
Private Sub IPList_DblClick()
If IPList.ListIndex = -1 Then Exit Sub
MsgBox IPList.List(IPList.ListIndex), vbInformation
End Sub
Private Sub mnu_Boot_Click()
If UserList.ListIndex = -1 Then Exit Sub
pos1% = InStr(1, UserList.List(UserList.ListIndex), " ")
If pos1% = 0 Then Exit Sub
ctrl = Mid(UserList.List(UserList.ListIndex), 1, pos1% - 1)
bname$ = GetListData(UserList, False, True, UserList.ListIndex)
X$ = InputBox("Enter reason for booting this user.", "Reason?", "Flooded.")
If Len(X$) = 0 Then
Winsock2(ctrl).SendData "@boot"
Winsock2(ctrl).SendData "@mboot" & X$
End If
Pause 0.1
For i = 0 To 50
If Winsock2(i).State = 7 Then Winsock2(i).SendData "@smsg" & " ** Server has booted user " & bname$ & " ** " & vbCrLf: Pause 0.1
Next i
End Sub
Private Sub mnu_Boot2_Click()
If UserList_.ListIndex = -1 Or Winsock1.State <> 7 Or op = False Then Exit Sub
Winsock1.SendData "@userboot" & UserList_.List(UserList_.ListIndex)
End Sub
Private Sub mnu_CopyIP_Click()
Clipboard.SetText IPList.List(IPList.ListIndex)
End Sub
Private Sub mnu_DEOP_Click()
If UserList.ListIndex = -1 Then Exit Sub
ctrl = GetListData(UserList, True, False, UserList.ListIndex)
uname$ = GetListData(UserList, False, True, UserList.ListIndex)
If Mid(uname$, 1, 1) = "@" Then
Winsock2(ctrl).SendData "@OPtake"
Pause 0.1
For i = 0 To 50
If Winsock2(i).State = 7 Then Winsock2(i).SendData "@old" & "@" & Mid(uname$, 2) & "@new" & Mid(uname$, 2): Pause 0.1
Next i
UserList.List(UserList.ListIndex) = ctrl & " " & Mid(uname$, 2)
End If
End Sub
Private Sub mnu_OP1_Click()
If UserList.ListIndex = -1 Then Exit Sub
ctrl = GetListData(UserList, True, False, UserList.ListIndex)
uname$ = GetListData(UserList, False, True, UserList.ListIndex)
Dim wasop As Boolean
If Mid(uname$, 1, 1) = "@" Then wasop = True
If wasop <> True Then
uname2$ = "@" & uname$
uname2$ = uname$
End If
Winsock2(ctrl).SendData "@OPgive1"
Pause 0.1
For i = 0 To 50
If Winsock2(i).State = 7 Then Winsock2(i).SendData "@old" & uname$ & "@new" & uname2$: Pause 0.1
Next i
UserList.List(UserList.ListIndex) = ctrl & " " & uname2$
End Sub
Private Sub mnu_OP2_Click()
If UserList.ListIndex = -1 Then Exit Sub
ctrl = GetListData(UserList, True, False, UserList.ListIndex)
uname$ = GetListData(UserList, False, True, UserList.ListIndex)
Dim wasop As Boolean
If Mid(uname$, 1, 1) = "@" Then wasop = True
If wasop <> True Then
uname2$ = "@" & uname$
uname2$ = uname$
End If
Winsock2(ctrl).SendData "@OPgive2"
Pause 0.1
For i = 0 To 50
If Winsock2(i).State = 7 Then Winsock2(i).SendData "@old" & uname$ & "@new" & uname2$: Pause 0.1
Next i
UserList.List(UserList.ListIndex) = ctrl & " " & uname2$
End Sub
Private Sub mnu_OP3_Click()
If UserList.ListIndex = -1 Then Exit Sub
ctrl = GetListData(UserList, True, False, UserList.ListIndex)
uname$ = GetListData(UserList, False, True, UserList.ListIndex)
Dim wasop As Boolean
If Mid(uname$, 1, 1) = "@" Then wasop = True
If wasop <> True Then
uname2$ = "@" & uname$
uname2$ = uname$
End If
Winsock2(ctrl).SendData "@OPgive3"
Pause 0.1
For i = 0 To 50
If Winsock2(i).State = 7 Then Winsock2(i).SendData "@old" & uname$ & "@new" & uname2$: Pause 0.1
Next i
UserList.List(UserList.ListIndex) = ctrl & " " & uname2$
End Sub
Private Sub mnu_OPHelp_Click()
msg$ = "Level 1 - Enable Warning" & vbCrLf
msg$ = msg$ & "Level 2 - Enable Booting" & vbCrLf
msg$ = msg$ & "Level 3 - Enable Warning & Booting" & vbCrLf
MsgBox msg$, vbInformation
End Sub
Private Sub mnu_SendFile_Click()
If IPList.ListIndex = -1 Or IPList.List(IPList.ListIndex) = "" Or Winsock1.State <> 7 Then MsgBox "Please select a valid IP address.", vbInformation: Exit Sub
sFilename$ = OpenDialog(Me, "All Files|*.*", "Locate file to Send...", App.Path)
If Len(sFilename$) = 0 Then Exit Sub
If fSend.State <> 0 Then fSend.Close
fSend.Listen
data2send$ = "@fsip" & IPList.List(IPList.ListIndex) & "@file" & sFilename$
Winsock1.SendData data2send$
End Sub
Private Sub mnu_ServerBanIP_Click()
If UserList.ListIndex = -1 Then Exit Sub
pos1% = InStr(1, UserList.List(UserList.ListIndex), " ")
If pos1% = 0 Then Exit Sub
ctrl = Mid(UserList.List(UserList.ListIndex), 1, pos1% - 1)
IP$ = Winsock2(ctrl).RemoteHostIP
ippos$ = InStrRev(IP$, ".", -1)
For i = 0 To BanList.ListCount
If BanList.List(i) = Mid(IP$, 1, ippos$ - 1) Then Exit Sub
Next i
X$ = InputBox("Enter reason for banning this user.", "Reason?", "Flooded too many times.")
If Len(X$) = 0 Then
Winsock2(ctrl).SendData "@banned"
Winsock2(ctrl).SendData "@mbanned" & X$
End If
BanList.AddItem Mid(IP$, 1, ippos$ - 1)
End Sub
Private Sub mnu_ServerBanUsername_Click()
If UserList.ListIndex = -1 Then Exit Sub
bname$ = GetListData(UserList, False, True, UserList.ListIndex)
For i = 0 To BanList.ListCount
If BanList.List(i) = bname$ Then Exit Sub
Next i
X$ = InputBox("Enter reason for banning this user.", "Reason?", "Flooded too many times.")
If Len(X$) = 0 Then
Winsock2(ctrl).SendData "@banned"
Winsock2(ctrl).SendData "@mbanned" & X$
End If
BanList.AddItem bname$
End Sub
Private Sub mnu_TicTacToe_Click()
If IPList.ListIndex = -1 Or IPList.List(IPList.ListIndex) = "" Or Winsock1.State <> 7 Then MsgBox "Please select a valid IP address.", vbInformation: Exit Sub
Winsock1.SendData "@reqttt" & IPList.List(IPList.ListIndex) & "@from" & Text1_
End Sub
Private Sub mnu_Unban_Click()
If BanList.ListIndex = -1 Then Exit Sub
BanList.RemoveItem BanList.ListIndex
End Sub
Private Sub mnu_Warn_Click()
If UserList.ListIndex = -1 Then Exit Sub
pos1% = InStr(1, UserList.List(UserList.ListIndex), " ")
If pos1% = 0 Then Exit Sub
ctrl = Mid(UserList.List(UserList.ListIndex), 1, pos1% - 1)
X$ = InputBox("Warning Message", App.Title, "This is your 1st warning! Cease your actions immediately.")
Winsock2(ctrl).SendData "@warn" & X$
End Sub
Private Sub mnu_Warn2_Click()
If UserList_.ListIndex = -1 Or Winsock1.State <> 7 Or op = False Then Exit Sub
dat$ = InputBox("Warning Message", App.Title, "This is your 1st warning! Cease your actions immediately.")
If Len(dat$) = 0 Then Exit Sub
Winsock1.SendData "@userwarn" & UserList_.List(UserList_.ListIndex) & "@msg" & dat$
End Sub
Private Sub SSTab1_Click(PreviousTab As Integer)
If SSTab1.Caption = "&Server" Then
Text6.SetFocus
ElseIf SSTab1.Caption = "&Client" Then
Text6_.SetFocus
End If
End Sub
Private Sub Text4__Change()
stringcheck$ = "1234567890"
If Len(Text4_) = 0 Then Command7_.Enabled = False: Exit Sub
For i = 1 To Len(Text4_)
If InStr(stringcheck$, Mid(Text4_, i, 1)) = 0 Then Command7_.Enabled = False: Exit Sub
Next i
If Text4_ < 65000 And Text4_ > 0 Then
Command7_.Enabled = True
Command7_.Enabled = False
End If
End Sub
Private Sub Text4_Change()
stringcheck$ = "1234567890"
If Len(Text4) = 0 Then Command7.Enabled = False: Exit Sub
For i = 1 To Len(Text4)
If InStr(stringcheck$, Mid(Text4, i, 1)) = 0 Then Command7.Enabled = False: Exit Sub
Next i
If Text4 < 65000 And Text4 > 0 Then
Command7.Enabled = True
Command7.Enabled = False
End If
End Sub
Private Sub Text6_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
KeyAscii = 0
If Mid(Text6, 1, 1) = "/" Then
pos4% = InStr(1, Text6, " ")
If pos4% = 0 Then Text5 = Text5 & " ** Illegal Command **" & vbCrLf: Text5.SelStart = Len(Text5): Exit Sub
afterc$ = LCase(Mid(Text6, 2, pos4% - 2))
If afterc$ <> "msg" Then pos5% = 0: GoTo 9
pos5% = InStr(pos4% + 1, Text6, " ")
If pos5% = 0 Then
afterd$ = Mid(Text6, pos4% + 1)
afterd$ = Mid(Text6, pos4% + 1, pos5% - 5)
End If
If afterc$ <> "msg" Then afterd$ = LCase(afterd$)
aftere$ = Mid(Text6, pos5% + 1)
Select Case afterc$
Case "action"
Text5 = Text5 & Text1 & " " & afterd$ & vbCrLf: Text5.SelStart = Len(Text5)
datastring$ = "@action" & Text1 & " " & afterd$ & vbCrLf
Case "msg"
If pos5% = 0 Then Text5 = Text5 & " ** Not enough parameters **" & vbCrLf: Text5.SelStart = Len(Text5): Exit Sub
For i = 0 To UserList.ListCount
pos1% = InStr(1, UserList.List(i), " ")
If pos1% = 0 Then GoTo doover
ctrl = Mid(UserList.List(i), 1, pos1% - 1)
uname$ = Mid(UserList.List(i), pos1% + 1)
If Mid(afterd$, 1, Len(afterd$) - 1) = uname$ Then
Winsock2(ctrl).SendData "@2msg" & "@msg" & aftere$ & "@uname" & Mid(afterd$, 1, Len(afterd$) - 1) & "@fname" & Text1
Text5 = Text5 & " ** Message Sent to " & Mid(afterd$, 1, Len(afterd$) - 1) & " : " & aftere$ & msg$ & " ** " & vbCrLf: Text5.SelStart = Len(Text5)
If inc% > 50 Then Text5.Text = "": inc% = 0
inc% = inc% + 1
GoTo finishmsg
End If
doover:
Next i
Text5 = Text5 & " ** User does not exist **" & vbCrLf:: Text5.SelStart = Len(Text5): Exit Sub
Case Else
Text5 = Text5 & " ** Illegal Command **" & vbCrLf:: Text5.SelStart = Len(Text5): Exit Sub
End Select
If inc% > 50 Then Text5.Text = "": inc% = 0
inc% = inc% + 1
For i = 0 To 50
If Winsock2(i).State = 7 Then Winsock2(i).SendData datastring$: Pause 0.1
Next i
finishmsg:
Text6 = ""
Text5 = Text5 & Text1 & " > " & Text6 & vbCrLf: Text5.SelStart = Len(Text5)
If inc% > 50 Then Text5.Text = "": inc% = 0
inc% = inc% + 1
For i = 0 To 50
If Winsock2(i).State = 7 Then Winsock2(i).SendData "@msg" & Text1 & " > " & Text6 & vbCrLf: Pause 0.1
Next i
Text6 = ""
End If
End If
End Sub
Private Sub Timer1_Timer()
If AServer.State = 8 Or AServer.State = 9 Then
If Command7.Caption <> "&Listen" Then
AServer.Close
AServer.Listen
AServer.Close
End If
End If
For i = 0 To UserList.ListCount
pos1% = InStr(1, UserList.List(i), " ")
If pos1% = 0 Then GoTo checkstat
ctrl = Mid(UserList.List(i), 1, pos1% - 1)
If Winsock2(ctrl).State <> 7 And UserList.List(b) <> "" Then
uname$ = Mid(UserList.List(i), pos1% + 1)
For b = 0 To 50
If Winsock2(b).State = 7 And b <> ctrl And UserList.List(b) <> "" Then Winsock2(b).SendData "@del" & uname$: Pause 0.1
Next b
UserList.RemoveItem i
Winsock2(ctrl).Close
ips(ctrl) = False
End If
DoEvents
Next i
DoEvents
checkstat:
GetState Winsock3, Label6
For i = 0 To 50
If Winsock2(i).State <> 7 Then Winsock2(i).Close
Next i
End Sub
Private Sub Timer2_Timer()
If Winsock1.State = 9 Or Winsock1.State = 8 Then SetValues False
If fSend.State = 8 Then fSend.Close: Close 1, 2
If fReceive.State = 8 Then fReceive.Close: Close 1, 2: lPos = 1: cc.Command1.Enabled = True: cc.Text2 = "Done."
GetState Winsock1, Label6_
End Sub
Private Sub UserList__Click()
If UserList_.ListIndex = -1 Then Exit Sub
IPList.Selected(UserList_.ListIndex) = True
End Sub
Private Sub UserList__MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button = 2 Then PopupMenu mnu_UserList_
End Sub
Private Sub UserList_Click()
If UserList.ListIndex <> -1 Then
pos1% = InStr(1, UserList.List(UserList.ListIndex), " ")
If pos1% = 0 Then Exit Sub
ctrl = Mid(UserList.List(UserList.ListIndex), 1, pos1% - 1)
End If
End Sub
Private Sub UserList_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button = 2 Then PopupMenu mnu_UserList
End Sub
Private Sub Winsock3_ConnectionRequest(ByVal requestID As Long)
For i = 0 To 50
If Winsock2(i).State = 0 Then
Winsock2(i).Accept requestID
ips(i) = False
GoTo ending
End If
DoEvents
Next i
ending:
End Sub
Private Sub Winsock2_DataArrival(Index As Integer, ByVal bytesTotal As Long)
Dim data$
Winsock2(Index).GetData data$
''''''''''''''''''''''''''''''''''''''''''
If Mid(data$, 1, 5) = "@pass" Then
IP$ = Winsock2(Index).RemoteHostIP
ippos$ = InStrRev(IP$, ".", -1)
pos1% = InStr(1, data$, "@name")
inname$ = Mid(data$, 6, Len(data$) - Len(Mid(data$, pos1%)) - 5)
inpass$ = Mid(data$, pos1% + 5)
For i = 0 To BanList.ListCount
If BanList.List(i) = Mid(IP$, 1, ippos$ - 1) Or BanList.List(i) = inname$ Then Winsock2(Index).SendData "@ubanned": Exit Sub
Next i
For z = 0 To Database.ListCount
outname$ = GetListData(Database, True, False, z)
outpw$ = GetListData(Database, False, True, z)
If inpass$ = outpw$ And inname$ = outname$ Then
For i = 0 To UserList.ListCount - 1
currname$ = GetListData(UserList, False, True, i)
If Mid(currname$, 1, 1) = "@" Then currname$ = Mid(currname$, 2)
If currname$ = inname$ Then
Winsock2(Index).SendData "@nameused"
Do Until Winsock2(Index).State <> 7
Pause 0.2
Winsock2(Index).Close: Exit Sub
End If
Next i
UserList.AddItem Index & " " & inname$
For i = 0 To 50
If i = Index Then GoTo skipit
If Winsock2(i).State = 7 Then Winsock2(i).SendData "@newuser" & inname$: Pause 0.1
skipit:
Next i
For i = 0 To UserList.ListCount - 1
pos1% = InStr(1, UserList.List(i), " ")
users$ = users$ & "@user" & Mid(UserList.List(i), pos1% + 1)
Next i
ips(Index) = True
Winsock2(Index).SendData users$
GoTo verified
End If
Next z
Winsock2(Index).SendData "@outpw": Exit Sub
End If
If ips(Index) = True Then
GoTo verified
Winsock2(Index).Close: Exit Sub
End If
verified:
If Mid(data$, 1, 4) = "@old" Then
pos9% = InStr(1, data$, "@new")
If pos9% = 0 Then Exit Sub
oldname$ = Mid(data$, 5, pos9% - 5)
newname$ = Mid(data$, pos9% + 4)
For i = 0 To UserList.ListCount
pos1% = InStr(1, UserList.List(i), " ")
If pos1% = 0 Then GoTo doover3
pname$ = Mid(UserList.List(i), 1, pos1%)
uname$ = Mid(UserList.List(i), pos1% + 1)
If uname$ = oldname$ Then UserList.List(i) = pname$ & newname$: GoTo next2
doover3:
Next i
next2:
For d = 0 To 50
If Winsock2(d).State = 7 Then Winsock2(d).SendData data$: Pause 0.1
Next d
End If
If Mid(data$, 1, 4) = "@msg" Then
Text5 = Text5 & Mid(data$, 5): Text5.SelStart = Len(Text5)
For i = 0 To 50
If Winsock2(i).State = 7 Then Winsock2(i).SendData "@msg" & Mid(data$, 5): Pause 0.1
Next i
End If
If Mid(data$, 1, 7) = "@action" Then
If inc% > 50 Then Text5.Text = "": inc% = 0
Text5 = Text5 & Mid(data$, 8): Text5.SelStart = Len(Text5): inc% = inc% + 1
For i = 0 To 50
If Winsock2(i).State = 7 Then Winsock2(i).SendData data$: Pause 0.1
Next i
End If
If Mid(data$, 1, 5) = "@2msg" Then
pos6% = InStr(5, data$, "@msg")
If pos6% = 0 Then Exit Sub
pos7% = InStr(5, data$, "@uname")
If pos7% = 0 Then Exit Sub
pos8% = InStr(5, data$, "@fname")
If pos8% = 0 Then Exit Sub
tmsg$ = Mid(data$, pos6% + 4, pos7% - 10)
tuname$ = Mid(data$, pos7% + 6, pos8% - pos7% - 6)
fname$ = Mid(data, pos8% + 6)
For i = 0 To UserList.ListCount
pos1% = InStr(1, UserList.List(i), " ")
If pos1% = 0 Then GoTo doover
ctrl = Mid(UserList.List(i), 1, pos1% - 1)
uname$ = Mid(UserList.List(i), pos1% + 1)
If fname$ = uname$ Then
Winsock2(ctrl).SendData "@2msg" & "@msg" & tmsg$ & "@uname" & tuname$ & "@fname" & fname$
If inc% > 50 Then Text5.Text = "": inc% = 0
inc% = inc% + 1
End If
doover:
Next i
End If
''''''''''''''''''''''''''''''''''''''''''
If Mid(data$, 1, 8) = "@fdenied" Then
For i = 0 To UserList.ListCount
pos1% = InStr(1, UserList.List(i), " ")
If pos1% = 0 Then GoTo nextone2
ctrl = Mid(UserList.List(i), 1, pos1% - 1)
If Mid(data$, 9) = Winsock2(ctrl).RemoteHostIP Then
Winsock2(ctrl).SendData "@fdenied"
End If
nextone2:
DoEvents
Next i
End If
If Mid(data$, 1, 5) = "@fsip" Then
fpos1% = InStr(1, data$, "@file"): If fpos1% = 0 Then Exit Sub
fsip$ = Mid(data$, 6, fpos1% - 6)
fsfile$ = Mid(data$, fpos1% + 5)
For i = 0 To UserList.ListCount
If GetListData(UserList, True, False, i) = Index Then sname$ = GetListData(UserList, False, True, i): GoTo skip2:
Next i
skip2:
For i = 0 To UserList.ListCount
ctrl = GetListData(UserList, True, False, i)
If fsip$ = Winsock2(ctrl).RemoteHostIP And Winsock2(ctrl).State = 7 Then
Winsock2(ctrl).SendData "@fip" & Winsock2(Index).RemoteHostIP & "@file" & fsfile$ & "@from" & sname$: Exit Sub
End If
nextone:
DoEvents
Next i
End If
If Mid(data$, 1, 5) = "@prog" Then
pos1% = InStr(1, data$, "@to"): If pos1% = 0 Then Exit Sub
brem$ = Mid(data$, 6, pos1% - 6)
toip$ = Mid(data$, pos1% + 3)
For i = 0 To UserList.ListCount
ctrl = GetListData(UserList, True, False, i)
If Winsock2(ctrl).RemoteHostIP = toip$ Then Winsock2(Index).SendData "@fprog" & brem$
Next i
End If
'''' User @ Commands
If Mid(data$, 1, 6) = "@getip" Then
For v% = 0 To UserList.ListCount
If GetListData(UserList, False, True, v%) = Mid(data$, 7) Then Winsock2(Index).SendData "@ipuser" & Winsock2(GetListData(UserList, True, False, v%)).RemoteHostIP & "@username" & Mid(data$, 7)
DoEvents
Next v%
End If
If Mid(data$, 1, 9) = "@userboot" Then
For i = 0 To UserList.ListCount
pos0% = InStr(1, UserList.List(i), " ")
If pos0% = 0 Then GoTo nextone6
ctrl = Mid(UserList.List(i), 1, pos0% - 1)
usename$ = Mid(UserList.List(i), pos0% + 1)
If ctrl = Index Then tusername$ = usename$
nextone6:
DoEvents
Next i
For i = 0 To UserList.ListCount
pos1% = InStr(1, UserList.List(i), " ")
If pos1% = 0 Then GoTo nextone4
ctrl = Mid(UserList.List(i), 1, pos1% - 1)
If Mid(data$, 10) = Mid(UserList.List(i), pos1% + 1) Then
Winsock2(ctrl).SendData "@boot"
For c = 0 To 50
If Winsock2(c).State = 7 Then Winsock2(c).SendData "@smsg" & " ** " & tusername$ & " has booted user " & Mid(data$, 10) & " ** " & vbCrLf: Pause 0.1
Next c
Exit Sub
End If
nextone4:
DoEvents
Next i
End If
If Mid(data$, 1, 9) = "@userwarn" Then
pos2% = InStr(1, data$, "@msg")
If pos2% = 0 Then Exit Sub
usernam$ = Mid(data$, 10, pos2% - 10)
messag$ = Mid(data$, pos2% + 4)
For i = 0 To UserList.ListCount
pos1% = InStr(1, UserList.List(i), " ")
If pos1% = 0 Then GoTo nextone5
ctrl = Mid(UserList.List(i), 1, pos1% - 1)
If usernam$ = Mid(UserList.List(UserList.ListIndex), pos1% + 1) Then Winsock2(ctrl).SendData "@warn" & messag$
nextone5:
DoEvents
Next i
End If
''''''''''' Tic - Tac - Toe
If Mid(data$, 1, 7) = "@reqttt" Then
pos13% = InStr(8, data$, "@from"): If pos13% = 0 Then Exit Sub
toip$ = Mid(data$, 8, pos13% - 8)
fromname$ = Mid(data$, pos13% + 5)
For i = 0 To UserList.ListCount
If Winsock2(GetListData(UserList, True, False, i)).RemoteHostIP = toip$ Then
Winsock2(GetListData(UserList, True, False, i)).SendData "@reqttt" & fromname$
Exit Sub
End If
Next i
End If
If Mid(data$, 1, 7) = "@accttt" Then
For i = 0 To UserList.ListCount
If GetListData(UserList, False, True, i) = Mid(data$, 8) Then Winsock2(GetListData(UserList, True, False, i)).SendData "@accttt" & Winsock2(Index).RemoteHostIP:  Exit Sub
Next i
End If
If Mid(data$, 1, 7) = "@denttt" Then
For i = 0 To UserList.ListCount
If GetListData(UserList, False, True, i) = Mid(data$, 8) Then Winsock2(GetListData(UserList, True, False, i)).SendData "@denttt": Exit Sub
Next i
End If
If Mid(data$, 1, 9) = "@tttclick" Then
pos1% = InStr(1, data$, "@spot")
playerip$ = Mid(data$, 10, pos1% - 10)
spotclick$ = Mid(data, pos1% + 5)
For i = 0 To UserList.ListCount
ctrl = GetListData(UserList, True, False, i)
If Winsock2(ctrl).RemoteHostIP = playerip$ Then Winsock2(ctrl).SendData "@tttclick" & spotclick$:  Exit Sub
Next i
End If
If Mid(data$, 1, 7) = "@tttend" Then
For i = 0 To UserList.ListCount
ctrl = GetListData(UserList, True, False, i)
If Winsock2(ctrl).RemoteHostIP = Mid(data$, 8) Then Winsock2(ctrl).SendData "@tttend": Exit Sub
Next i
End If
If Mid(data$, 1, 7) = "@tttwin" Then
pos1% = InStr(1, data$, "@who")
userip$ = Mid(data$, 8, pos1% - 7)
whowon$ = Mid(data$, pos1% + 4)
For i = 0 To UserList.ListCount
ctrl = GetListData(UserList, True, False, i)
If Winsock2(ctrl).RemoteHostIP = userip$ Then Winsock2(ctrl).SendData "@tttwin" & whowon$: Exit Sub
Next i
End If
End Sub
Private Sub Command7__Click()
If Command7_.Caption = "&Connect" Then
If Winsock1.State <> 0 Then Winsock1.Close
Winsock1.Connect Text3_, Text4_
Command7_.Caption = "&Disconn."
TextNable False
SetValues False
End If
End Sub
Sub TextNable(choice As Boolean)
Text1_.Enabled = choice
Text2_.Enabled = choice
Text3_.Enabled = choice
Text4_.Enabled = choice
End Sub
Private Sub fReceive_DataArrival(ByVal bytesTotal As Long)
Dim buffer2() As Byte
fReceive.GetData buffer2()
Put #2, lPos, buffer2()
lPos = lPos + UBound(buffer2) + 1
End Sub
Private Sub fSend_ConnectionRequest(ByVal requestID As Long)
fSend.Close
fSend.Accept requestID
dd.Show
dd.Caption = "Sending File..."
dd.Text1 = sFilename$
Open sFilename$ For Binary Access Read As 1
ReDim buffer(LOF(1))
Get #1, 1, buffer()
Close 1
fSend.SendData buffer()
End Sub
Private Sub fSend_SendComplete()
fSend.Close
ReDim buffer(0)
Text5_ = Text5_ & " ** Send File : File Sent **" & vbCrLf: Text5_.SelStart = Len(Text5_)
dd.Command1.Enabled = True
dd.Text2 = "Done."
End Sub
Private Sub Text1__Change()
txt$ = Text1_
Text1_ = StringChange(txt$)
End Sub
Private Sub Text6__KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
KeyAscii = 0
If Winsock1.State <> 7 Then Text6_ = "": Exit Sub
If lasttext$ = Text6_ Then MsgBox "Why are you saying the same thing?", vbQuestion: Text6_ = "": Exit Sub
lasttext$ = Text6_
If Mid(Text6_, 1, 1) = "/" Then
pos4% = InStr(1, Text6_, " ")
If pos4% = 0 Then Text5_ = Text5_ & " ** Illegal Command **" & vbCrLf: Text5_.SelStart = Len(Text5_): Exit Sub
afterc$ = LCase(Mid(Text6_, 2, pos4% - 2))
If afterc$ <> "msg" Then pos5% = 0: GoTo 9
pos5% = InStr(pos4% + 1, Text6_, " ")
If pos5% = 0 Then
afterd$ = Mid(Text6_, pos4% + 1)
afterd$ = Mid(Text6_, pos4% + 1, pos5% - 5)
End If
If afterc$ <> "msg" And afterc$ <> "change" Then afterd$ = LCase(afterd$)
aftere$ = Mid(Text6_, pos5% + 1)
Select Case afterc$
Case "action"
datastring$ = "@action" & Text1_ & " " & afterd$ & vbCrLf
Case "msg"
If pos5% = 0 Then Text5_ = Text5_ & " ** Not enough parameters **" & vbCrLf: Text5_.SelStart = Len(Text5_): Exit Sub
For i = 0 To UserList_.ListCount
uname$ = UserList_.List(i)
If Mid(afterd$, 1, Len(afterd$) - 1) = uname$ Then
Winsock1.SendData "@2msg" & "@msg" & aftere$ & "@uname" & Text1_ & "@fname" & Mid(afterd$, 1, Len(afterd$) - 1)
Text5_ = Text5_ & " ** Message Sent to " & Mid(afterd$, 1, Len(afterd$) - 1) & " : " & aftere$ & msg$ & " ** " & vbCrLf: Text5_.SelStart = Len(Text5_)
If inc% > 50 Then Text5_.Text = "": inc% = 0
inc% = inc% + 1
GoTo finishmsg
End If
doover:
Next i
Text5_ = Text5_ & " ** User does not exist **" & vbCrLf: Text5_.SelStart = Len(Text5_): Exit Sub
Case "change"
oldname$ = Text1_
newname$ = StringChange(afterd$)
If Mid(newname$, 1, 1) = "@" Then newname$ = Mid(newname$, 2)
For i = 0 To UserList_.ListCount
currname2$ = UserList_.List(i)
If Mid(currname2$, 1, 1) = "@" Then currname2$ = Mid(currname2$, 2)
If currname2$ = newname$ Or currname1$ = newname$ Then Text5_ = Text5_ & " ** User already exists in list **" & vbCrLf: Text5_.SelStart = Len(Text5_): Exit Sub
Next i
If op = True Then newname$ = "@" & newname$
For i = 0 To UserList_.ListCount
If UserList_.List(i) = oldname$ Then UserList_.List(i) = newname$: Text1_ = newname$
Next i
Winsock1.SendData "@old" & oldname$ & "@new" & newname$: Text6_ = "": Exit Sub
Case Else
Text5_ = Text5_ & " ** Illegal Command **" & vbCrLf:: Text5_.SelStart = Len(Text5_): Exit Sub
End Select
If inc% > 50 Then Text5_.Text = "": inc% = 0
inc% = inc% + 1
If Winsock1.State = 7 Then Winsock1.SendData datastring$
finishmsg:
Text6_ = ""
If inc% > 50 Then Text5_.Text = "": inc% = 0
inc% = inc% + 1
If Winsock1.State = 7 Then Winsock1.SendData "@msg" & Text1_ & " > " & Text6_ & vbCrLf
Text6_ = ""
End If
Text6_.Enabled = False
Text6_ = "Sending Message..."
Pause 1.2
Text6_.Enabled = True
Text6_ = ""
Text6_.SetFocus
End If
End Sub
Private Sub winsock1_Connect()
data$ = "@pass" & Text1_ & "@name" & Text2_
Winsock1.SendData data$
End Sub
Private Sub Winsock1_DataArrival(ByVal bytesTotal As Long)
Dim data$
Winsock1.GetData data$
'' Server Responses
If data$ = "@outpw" Then Winsock1.Close: MsgBox "Incorrect Username/Password.", vbInformation: SetValues False
If InStr(1, data$, "@nameused") > 0 Then Winsock1.Close: MsgBox "Name currently in use.", vbInformation: SetValues False
If data$ = "@ubanned" Then Winsock1.Close: MsgBox "Cannot connect  & Text1 " & vbCrLf
Msg2a File Sent *' Server Rea
Ife Then newname$ = "@tValues False
If InStr(1, rrival(ByVck1_DataArrivalN
If ,8= "@ubanned" Then Winsock
If pos1%8= "@uba,8= "@udma "@old" &  Winsock Then Winsock
If pos1%8= " &  UserList.Li_): Exip_xt iea
Ife Then newna8:t()
data$ = "@pass"  CrLfhThen newna8:t()
dl  Caption         =   "-"
Ilma "@ol0 To  me$ = sname$: Exi&"Canno1anno1an@pass"  CrLfhTheass"  CrLfhT w me$e_ & " ** xt5_ = Text5_ & " **  "-"
Ilma "@ol 5_ = Text5_ & " **  "-"
Ilma "@ol 5_ = Text5_ & " **  "-"
Ilma .Enabled = choice
Text3   Begind If
doover:sgBox "Cann%sTotal A Text5f otal text$ = Ttal A Te + 1)
on: Sete1.Closd") > 0 Then Winsock1.C.SendData "@wao0Wb
Private Sub winsock1_Connect()
data$ = "@pass" & Text1_ect()
Data datastring$
Dim data$
Winsock1.GetData data$
'' Server Responses
If ef pos1% = 0 Then GoTo d"@password")dlhe" Then
verified
East False
I**  "-"dn%sTotal A Ts1% - 1)
rip$ = f WinsocA Ts1% - 1)
rip$ = f
dl  C) > 0 Then W.Closd")d" Then Winsock1.Close: Mpe
Text3   Begiu)lename$y1ext5_ & " **(ext3   Begiu)lename$y1ext5_ & " **(exd If
0 **(ext3   Begiu)le Exip_xt iea
Ife Then newna8:t()
 **(%8= "@ubt iea
Ife Then _ + 5)
Fo Tet5_ = T Exip_xt iea
Ife Then new**(% = InStr(dc% = inc% +9[  Beg  Beg  BegtCount
  BegtCount
  BegtCo wname$, en newna8:t()
 **(%8= "@u(exext6_ = "": Exit5_): Exitd" Then Winsock1._ = Text5_ & " **  tn Winsock1._ = Text5_ &Tet5_ = T **  tn WinsockRegtCo wnamn1O
dl  C)If data$ = "@outpw" Then WiY1W5Ut5_ &T1f
  BegtCo w _ + 5)
Fo Tet5_ = T Exip
: _ + 5)
If&T1f
  BegtCo w _ + 5)W+ 1
If Winsock1.State = 7 Then Winsock1.SendData datastring$
rList.List(8a0Ilma2 newna8:t(ta data"WhyeDattringChange= Text5 & " **)Qonamn1O
dl  C) Then Wi
endi8f2ext3   Begiu)le Exips **)Qon1hange= Text5 & " **)Qonamn1O
dl  C) nsock1.GetDs1hange= Text5 & " **)Qo_gubanneewna data"WhyeDattsck1._ = Text5_  ppos1%)data$ = "@outpw" ptastrin C) nsock1.GetDs1hange= Text5 & "name$ = Getu& Text1_ & n6 & Text CrLfh7List.RemoveIormatpockf pos1% = 0 Then E+lc Winsock1.Close: Mpe
If veIormatpockf pos1%
If v]vwveIormatpoeockf pos1%
9tart =se
 _ +f v]vwveIormat =se
 _ +f v]vwveIormat =se
 _ +f v]vwveIormat =se
 _ +f v]vwveIormat =se
 _ +f v]vwveIormat =s**)Qon1hange=  w _ + ct  & Text1 tart =*)Qon1hange=  w _ + ct  & Text1
If Winsock1.State <> 7 Then Text6_ = ""d
East False
I**  + ct  & Text1
If Winsock1.State <> 7u**  + ct  & Text1
:vI7pta$
Winkw> 7u**
I**  +uest(BF1)
If&T1f
  Brx0s_ = ""d
East False
I**  + ct  & Text1
If Winsock1.State <> 7 i17oays" & Text1_eused")1.State <> 7n1hange=  w _  - 1
pos1% ="ocus
End If
 TextNable(choice As Boolean)
Text1_.EnabState <> 7 Then Text6_ = ""d
East False
I**  + ct  & Text1C _ +f v]A Ts1% - 1)
rip$ = f WinsocA Ts1% - 1)
rip$ = f
If Mid(Teen WiY1W5Ut5_ &T1f
  BegtCo w _ + 5)
Fo Tet5_ = T Exip
: _ + 5)
If&T1f
   v]A Tf
If Mid(Teen WiY1W5Ut5_ &Tna data"WhyeDattsck1._ = Text5_  ppos1% &Tna data"W8t5_ &Tnaattsck1._ = tCo wst =*)Qon1hangext$ = Ttal A Te + 1)
EBeg  Beg  Begt2sT1f
   v]A Tf 2(ippos$ = InStrRev(IP$, ".", -1)
pos1% = InStr(1, data$,5eg  Beg  BtCo wst =*)Qon1hanMid(Teen WiY1W5Ut5_ &T1f
  BegtCo w _ + 5)
Fo Tet,ct
5_ &T1f
  k2(ctrl).SendData "@ttten
 Wif% + 19dMid(-
If&T1f
vt5_ Ts1% - 1C) nsoc WiY1W5e
 _ +f v]&"":insocA Ts1% C7erified
East False%
SIPList.List(IPList.Lis _ + 5)
UserList.A5_ &Tna data"WiY1W5e
 _ +f ss"  CrLfhTheass"  CrLfhT w me$e_ & " ** xt5_ =ext1_.Enaip
: _ Seas8Text1
, 1, ippos$ iY1W5Ut5_ &Tu False%
SIPdState  as8Text&T1f
  BegtCo w _ + 5)
Fo Tet,ct
5_ &T1f
  k2(ctrl).SendData "@ttten
 Wif% + 19dMid(-
IWhyeDattsck1._ =to.ListIndex) = Trues, 5, postInn
IWhyeDattsck1._ =to.Li
drt = a@tt k2rt = a@ttyTeen WiY1W5Ut5_ &T1f
  Beg0c
For i = 0 TUd Su +f v]1% =  Beg0c
For i = 0 S1W5Ut5_ &T1f
  formation: SetValues False
If data$ = "@ubann data"WiY1W5e
 _ +f ss"  CrLfhTheass"  CrLfhT f
  k2(ct5_ = T Edata$, pos9% f6serLSub
2Malse%
9BWQon1hange=u75choice 3aub wi% =  Beg,5eg  Beg  Bte%
SIPdStatemation: S?u75ch5% =  Be4 "":ewna8:t(Rch5data$ = "@ubann data"pos9%   Be4 " = InStr(1, dZw"@ttt= "@uba"@outpw" UserLdata"pos9e, True, i) = Mid()rd$ = Mid(Text6id(Text6, pos4opupMenu mnu_U data$,5eg  Beg  Bt6cessag)n1hange= Text5 & " **)Qonamn1O
dl  C) nsock1.GetDs1hange= & " ** xse% N C) nsock(daistInde2SText1_ = newname$
Next i
nn data"WiY1W5e
 _ +f s1)
IWhyeDatts= Mid(data$, pos1% + 4)
For i = 0n da
Private Sub mnu_TicTacToe, "FloZUd Su +for ihR1Text1_ = n _ +f v]vw,i
End If
 Wik2(c If
F22 0 S1W5Ut5_ &T1f
  formation: SetValues False
If i = 0 To U]eues False
I0 mnusuccess"
End If
IMid(Text 1)
EietVal:
End If
IMid(Text 1)
EietV-(i), 1, pos1% - 1)
If Mid(da = 0 Then Gopd(Text6, pos4opupMenu mnu_U datb5 & Ti
EietV  v]A Tfe$, 1, 1) erList), 1, pos1% - 1)
dd.Show
dd.m9BWQon1hange=
CasegdIf Winsock1.State <> 7 i17oays"e Sub mn i = 0 Tv$
Next i
nn data"WiY1W5e
 _ +f s1)
IWxGopd(Text6, pos4opa:t(Rch5data$ =xit5_): Exitd" Then Winsock1._ = Text5_ & "e(da = 0 a$
End S+ ct  &-tpockf pos1%
Iot5_ & "e(da k1.Stat
Dck1.Close: M...""""""tate <> 7 i17_mUsText1
hSvwve
Dck1.Close
cess"
Eio Usmtd" Then
cess"
hSvwve
Dck1.Close
cess"
Eio Usmsnsock1.
I)=02t1._ = Text5_ & "e(da = 0 aer2_p) ns_ & "e(da = 0 a$
End S+ ct  &-tpocnu_Warn2_ 0 a$,x((uvw,i
Ens4opupMe_Tn Text6_ =
I)=02ts@ubann data"pos9%   Be4 " = InStr(1, dZw"@ttt= "
Command7_.Caption Me_Tn Textw"@ttt= "
Command7_.Caption Me_Tn TWinsock1.State <> 7 Then Text6_ n TButton As Inr s1)
IWxGopEnd S 7 Thenan
& " ** Illegal CommanWion Me_T 7 Thent False
I**  + ct  & Text1
If Winsock1xt1
I**  + ct  & Text1
If Winsock1xt1
I**  + ct  & Text1
If Winsn = "@uba _ +f v +f v0:Rch5 Then Text6_1+f v0:R= "
Cotten
 Wif% + 19dMid(-
If&T1f
vt5_ Ts1% - 1C) nsoc WiY1W5e
 _ +f  aftxemation: S?u75ch5% =  Be4 "":ewna8:t(Rch5ot.ListIndex), " ")
If po S?u75ch1"rhT f
  Tfet(Rch5data$ = InStrRev( es1%8= " &  7u*te Sub mn.Close
xitd" ThcQText6, pos
 Wif% + 19dMid(-
IWhyeD+Tn Text6_ =
I)=02ts@ubann data"pos9%   Be4 " = I ="ocus
End If
02ts@ubs9%   Be4 " = Ismta"pos9%   Be4 smta"pos9tt= "
CommrEos1% - 1)
dd.Show
dd.mserLdata"pos9e, True, i) = Mid()rd$ = Mf4% - 2))
If afters9%  3sep(u75ch1"rhT ffextioc W.Close
19dMid(-
F1)82uo
1, dZend": Exit Sub
Nextp fromname$
Exit Sub
  Be4 " = I =Valuefname$, 2)
If currname$ = inname$ Then
Winsock2(Index).SendData "@nameus Exit Sub1t5_ Ts1% - 1C) ns(id(-
F'pos9%   Be4 smt4 " = Ients
Next i
End If" 5)
If aftt5_ & "e(da = = Ients)ext5_ = Text5_   3sep(u75ch1"rhT ffextioc W"FloZUd)82uo
1, dZend")s
If aaaaaaaaa Mid(Text6_ts
Next i
End If" 5)
 Wif% + 19endDxt1
Iactif" 5)
 Wif% )
DoEvei) = old
Iac 5)
If aaaaaaaaa Mi
Iac 5)
))d S+ ct  &-tpocnu_Waaaaa Mi
Iac 5)
))d2DoEvei) = old
Iac 5)
I) = old
ComsMid(-
If G)
_*  +ues
EasOr currBWQon1hange=
CasegdIf Winsock1.State <> 7 i17oays"e Sud.Text2 = f Wtart 1, pos1mmand7_.CaptsOr crrBWQon1hand2DoEvei) = old
Iac 5)
f af1)
EietQon1hand2Do1d
Iac 5)
f af1)
(1, UserList.List(i), " ")
If pos?u75ch1(Rch5ot.n Me old
0ngle, Y"  Cch1"rhT ffextioc W"FloZUd)
If pos?u75c=o.n Me old
0ngle, Y"  Cch1"rhT ffe}:
If ^t6_ = "S0mxt i
En|49BWQon1hange=u75choice 3aubemoteHostIP = Mid(data$, 8) Then Winsock2(ctrl).SendDaln1hange=
End If
o.n Me o
  1hange=
End If
Prihent False
I** Enabled = choMf4% - 2)) fromname$
d choa75c=o.n Mef
o.n Me o
  1h:lse
SetV fromname$
d fied
Ear " &  7u*te Sub mn.Close
x UserList.List(i), " ")
nabled = lse
on:ast(i), " ")
If poal Commate Su_]
End If
Prihent Fals(i), " ), " ")
If pos?u75ch1(RuU fro( af1)
EietQon1hand2Do1d
Iac- o( af1)
EiestIP 2Do1dT 7 Thent Fals1hange=
End Id Su +f v]1% = 8e)old
0ng3f1)
EietQon1hand2Do1d
Iac Snd Sub
Private Sub IPList_Click()
Ux("Warning Message", App.Title, "This is your 1st warning! Ceasegiu)G2pp.Tit
Iac 5)
If aaaaaaaaa Mi
Iac 5)
))el" & uname$  InStr(1, UserList.List(i)se
x Use$ Tv:s1hange=
End sf4% - 22 "e(da = 0 aR
oe$ Tv:s1hange=
End sf4% - 22 "e(da = 0 a_yVal b