• There is NO official Otland's Discord server and NO official Otland's server list. The Otland's Staff does not manage any Discord server or server list. Moderators or administrator of any Discord server or server lists have NO connection to the Otland's Staff. Do not get scammed!

[VB6] Simple client-server chatting program

Delirium

Delirium

OTLand veteran
Staff member
Global Moderator
Joined
May 28, 2007
Messages
3,365
Solutions
1
Reaction score
289
Location
Athens, Greece
This is a client-server chatting program. It is made solely by me and no one else. It is written in VB6

Features:

  • Server
  • Client
  • Multiple Clients can connect on a single server


Client:

Needed Controls:
  • txtName (TextBox) - Username
  • Text1 (TextBox) - Host of the server
  • Text2 (TextBox) - Port of the server
  • Command1 (CommandButton) - Connects to the server
  • Command2 (CommandButton) - Closes the program
  • Command3 (CommandButton) - Send the message written on txtSend
  • Command4 (CommandButton) - Sets a username
  • Winsock1 (WinSock) - A Windows Socket
  • txtChat (TextBox) - Received & Sent Messages are displayed here
  • txtSys (textBox) - System Messages
  • txtSend (TextBox) - A Box to write your message


Code: 
Option Explicit
Dim sckStatusConnected As Boolean
Dim userName As String
Dim nameSet As Boolean

Private Sub Command1_Click()
If nameSet = True Then
On Error GoTo t

Winsock1.Close
Winsock1.RemoteHost = Text1.Text
Winsock1.RemotePort = Text2.Text
Winsock1.Connect

Exit Sub
Else
MsgBox "A username must be set before connecting.", vbCritical, "Error!"
Exit Sub
End If

t:
MsgBox "Error: " & Err.Description, vbCritical
End Sub

Private Sub Command2_Click()
MsgBox ("Created by Nikolas (KuGaSh1rA)" & vbNewLine & "http://otland.net/")
End
End Sub

Private Sub Command3_Click()
On Error GoTo e

Winsock1.SendData userName & ": " & txtSend
txtChat = txtChat & userName & ": " & txtSend & vbCrLf
txtSend = ""

Exit Sub
e:
MsgBox "Error: " & Err.Description
Winsock1.Close
End Sub

Private Sub Command4_Click()

userName = txtName
Me.Caption = "Client Application - Username: " & userName & " - Status: Disconnected"
txtSys = txtSys & "Your username is: " & userName & vbCrLf
nameSet = True
txtName.Enabled = False
Command4.Enabled = False

End Sub

Private Sub Form_Load()
sckStatusConnected = False
nameSet = False
Me.Caption = "Client Application - Status: Disconnected"
End Sub


Private Sub Winsock1_Close()
Winsock1.Close
txtSys.Text = "Disconnected from server."
End Sub

Private Sub Winsock1_Connect()
txtSys = txtSys & "Connected on IP: " & Text1.Text & " and on port " & Text2.Text & vbCrLf
sckStatusConnected = True
Me.Caption = "Client Application - Username: " & userName & " - Status: Connected"
End Sub

Private Sub Winsock1_DataArrival(ByVal bytesTotal As Long)
Dim data As String

Winsock1.GetData data, vbString
txtChat = txtChat & "Server: " & data & vbCrLf

End Sub

Private Sub Winsock1_Error(ByVal Number As Integer, Description As String, ByVal Scode As Long, ByVal Source As String, ByVal HelpFile As String, ByVal HelpContext As Long, CancelDisplay As Boolean)
txtSys.Text = txtSys & "Error: " & Description & vbCrLf
Winsock1.Close
End Sub

Server:

Needed Controls:
  • txtPort (TextBox) - The port where the server will listen on
  • Command1 (CommandButton) - Triggers the server's listening
  • Command2 (CommandButton) - Exits the program
  • Winsock1(0) (WinSock) - Windows Socket array, to add a socket array on your form,add a simple windows socket and then on the control's property window find "index" and set it to 0
  • txtSys (TextBox) - System Messages TextBox
  • txtChat (TextBox) - Received & Send Messages are displayed there
  • txtSend (TextBox) - A box to write a message
  • cmdSend (CommandButton) - Send the message you typed

Code: 
Option Explicit
Private SocketCounter As Integer
Private sckListening As Boolean

Private Sub Form_Load()
sckListening = False
Me.Caption = Me.Caption & " - Status: Not Listening"
End Sub

Private Sub Winsock1_ConnectionRequest(Index As Integer, ByVal requestID As Long)
SocketCounter = SocketCounter + 1
Load Winsock1(SocketCounter)

Dim name As String
Dim n As Integer


Winsock1(SocketCounter).Accept requestID

txtSys = txtSys & "Client connected - IP: " & Winsock1(0).RemoteHostIP & vbCrLf

End Sub


Private Sub Winsock1_DataArrival(Index As Integer, ByVal bytesTotal As Long)
Dim data As String
Dim n As Integer

For n = 1 To SocketCounter
Winsock1(n).GetData data, vbString
Next n

txtChat = txtChat & data & vbCrLf

On Error Resume Next
For n = 1 To SocketCounter
If Not n = Index Then
If Winsock1(n).State = sckConnected Then
Winsock1(n).SendData "Client" & Index & " says:" & data & vbCrLf
End If
End If
Next

End Sub

Private Sub cmdSend_Click()
On Error GoTo e
Dim n As Integer
For n = 1 To SocketCounter
Winsock1(n).SendData txtSend
Next n

txtChat = txtChat & "Server: " & txtSend & vbCrLf
txtSend = ""
Exit Sub
e:
MsgBox "Error: " & Err.Description & vbCrLf
End Sub

Private Sub Command1_Click()
If sckListening = False Then
On Error Resume Next
Dim n As Integer
For n = 1 To SocketCounter
Winsock1(n).Close
Unload Winsock1
Next

On Error GoTo t
Winsock1(0).Close
Winsock1(0).LocalPort = txtPort

Winsock1(0).Listen
sckListening = True


txtSys = txtSys & "Listening on Port: " & txtPort & vbCrLf
Me.Caption = "Server Application" & " - Status: Listening on port: " & txtPort
Exit Sub

t:
MsgBox "Error: " & Err.Description & vbCrLf
Else
MsgBox "Server already listening to port: " & Winsock1(0).LocalPort & ".", vbCritical, "Error!"
txtSys = txtSys & "Listening failed because the socket is already listening." & vbCrLf
End If
End Sub

Private Sub Command2_Click()
MsgBox "Created by Nikolas (KuGaSh1rA)" & vbNewLine & "http://otland.net/, vbOKOnly, "Info"
End
End Sub


Private Sub Winsock1_Close(Index As Integer)
Winsock1(Index).Close
Unload Winsock1(Index)

txtSys = txtSys & "Disconnected: " & Index & vbCrLf
End Sub


Private Sub Winsock1_Error(Index As Integer, ByVal Number As Integer, Description As String, ByVal Scode As Long, ByVal Source As String, ByVal HelpFile As String, ByVal HelpContext As Long, CancelDisplay As Boolean)
txtSys = txtSys & "Error of Client" & Index & " Description: " & Description & vbCrLf
Winsock1(0).Close
End Sub
 
Last edited:
Elvang said:
Screens?
Click to expand...

I've lost the compilled files because I formatted my pc. It looks like tibia's chatting system with an additional box above the messages list which shows system messages like errors.
 
Back
Top