Visual Basic Source Code/Visual Basic Source Code.iso/vbsource/vbchat1a/frmmain.frm

Visual Basic Form | 1999-08-30 | 4.7 KB | 196 lines

VERSION 5.00
Object = "{248DD890-BB45-11CF-9ABC-0080C7E7B78D}#1.0#0"; "MSWINSCK.OCX"
Begin VB.Form Form1
   BorderStyle     =   4  'Fixed ToolWindow
   Caption         =   "Vb chat Server"
   ClientHeight    =   4365
   ClientLeft      =   6420
   ClientTop       =   165
   ClientWidth     =   5550
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   4365
   ScaleWidth      =   5550
   ShowInTaskbar   =   0   'False
   Begin VB.Timer Timer3
      Enabled         =   0   'False
      Interval        =   10
      Left            =   4200
      Top             =   600
   End
   Begin VB.Timer Timer2
      Enabled         =   0   'False
      Interval        =   10
      Left            =   4200
      Top             =   0
   End
   Begin VB.Timer Timer1
      Enabled         =   0   'False
      Interval        =   10
      Left            =   3840
      Top             =   0
   End
   Begin MSWinsockLib.Winsock snd
      Index           =   0
      Left            =   3480
      Top             =   0
      _ExtentX        =   741
      _ExtentY        =   741
      _Version        =   393216
   End
   Begin MSWinsockLib.Winsock srvlesn
      Left            =   3120
      Top             =   0
      _ExtentX        =   741
      _ExtentY        =   741
      _Version        =   393216
      RemoteHost      =   "6000"
   End
   Begin VB.TextBox Text1
      Height          =   285
      Left            =   0
      TabIndex        =   1
      Top             =   4080
      Width           =   5535
   End
   Begin VB.ListBox List1
      Height          =   3960
      Left            =   0
      TabIndex        =   0
      Top             =   0
      Width           =   5535
   End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim g As Integer
Dim hf As Integer
Dim usr As String
Dim l As Integer
Dim ind As Integer
Dim txt As String
Dim txt0 As String
Private Sub Form_Load()
Me.Caption = "Vb chat server at(" & srvlesn.LocalIP & ")"
srvlesn.LocalPort = 1000
srvlesn.Listen
For i = 1 To 49
Load snd(i)
user(i).free = True
Next i
user(0).free = True
End Sub
Private Sub snd_DataArrival(Index As Integer, ByVal bytesTotal As Long)
On Error Resume Next
Dim arriveddata As String, splited() As String
snd(Index).GetData arriveddata, vbString
List1.AddItem arriveddata
splited() = Split(arriveddata, "=>:")
Select Case splited(0)
Case "adduser"
user(Index).Name = splited(1)
user(Index).Nickname = splited(2)
user(Index).ip = splited(3)
List1.AddItem "User=>:" & user(Index).Nickname
ind = Index
Timer1.Enabled = True
Case "mess"
For i = 0 To 50
If user(i).Nickname = splited(1) Then
snd(i).SendData "|mssg=>:" & splited(2) & "=>:" & splited(3) & "|"
Exit For
End If
Next i
Case "ping"
For i = 0 To 50
If user(i).Nickname = splited(1) Then
snd(i).SendData "|ping=>:" & splited(2) & "|"
Exit For
End If
Next i
Case "kick"
For i = 0 To 50
If user(i).Nickname = splited(1) Then
snd(i).SendData "|kicked=>:" & splited(2) & "|"
Exit For
End If
Next i
Case "serv"
txt0 = "message=>:"
txt = "from " & splited(1) & ": " & splited(2)
Timer3.Enabled = True
Case "closed"
For i = 0 To 50
If user(i).Nickname = splited(1) Then
usr = splited(1)
Timer2.Enabled = True
snd(Index).Close
user(i).Name = ""
Exit For
End If
Next i
End Select
End Sub
Private Sub srvlesn_ConnectionRequest(ByVal requestID As Long)
On Error Resume Next
For i = 0 To 50
If user(i).free = True Then
user(i).free = False
snd(i).Accept requestID
'MsgBox "reguest accepted)"
snd(i).SendData "|serverinfo=>:connection accepted|"
For x = 0 To 49
If user(x).free = False Then
snd(i).SendData "|user=>:" & user(x).Nickname & "|"
End If
Next x
Exit For
End If
Next i
End Sub
Private Sub Text1_KeyDown(KeyCode As Integer, Shift As Integer)
On Error Resume Next
If KeyCode = vbKeyReturn Then
txt0 = "serverinfo=>:"
txt = Text1.Text
Text1.Text = ""
Timer3.Enabled = True
End If
End Sub
Private Sub Timer1_Timer()
On Error Resume Next
g = g + 1
If g = 50 Then
g = 0
Timer1.Enabled = False
End If
If user(g).Name <> "" Then
snd(g).SendData "|user=>:" & user(ind).Nickname & "|"
End If
End Sub
Private Sub Timer2_Timer()
On Error Resume Next
hf = hf + 1
If hf = 50 Then
hf = 0
Timer2.Enabled = False
End If
If user(hf).Name <> "" Then
snd(hf).SendData "|leave=>:" & usr & "|"
End If
End Sub
Private Sub Timer3_Timer()
On Error Resume Next
l = l + 1
If l = 50 Then
l = 0
Timer3.Enabled = False
End If
If user(l).Nickname <> "" Then
snd(l).SendData "|" & txt0 & txt & "|"
End If
End Sub