Socket Communication in Delphi

The clientsocket component is a client component. It is the requester of the communication, that is, it actively establishes a connection with the server.
The serversocket component is a server component. It is the communication responder, that is, It listens to and passively accepts client connection requests and replies to requests.
The serversocket component can receive connection requests from one or more clientsocket components at the same time, and establish separate connections with each clientsocket component for separate communication. Therefore, a server can serve multiple clients.
Design Concept
This example includes a server-side program and a client program. The client program can run on multiple computers and communicate with the server.
The focus of this example is to demonstrate how the client communicates with the server, and how the server identifies each client when multiple clients connect to the server at the same time, and give a response to the request. To ensure that communication between other clients and the server is not affected when a client is disconnected, and to ensure that the server can correctly reply to the client request, a record type is defined in this example:
Type
Client_record = record
Chandle: integer; // client socket handle
Csocket: tcustomwinsocket; // client socket
Cname: string; // the name of the client.
Caddress: string; // ip address of the client computer
Cused: Boolean; // client online flag
End;
This record type is used to save client information and the connection status of the current client. Here, chandle stores the client socket handle to accurately locate each client that maintains a connection with the server; csocket stores the client socket and can reply to the client through it. Cused records whether the current client is connected to the server.
The following describes how to set the attributes of the serversocket and clientsocket components.
Serversocket attributes:
· Port, which is the communication port and must be set. In this example, set it to 1025;
· Servertypt: the type of server-side read/write information. Set it to stnonblocking to indicate asynchronous read/write information. This method is used in this example.
· Threadcachesize: the maximum number of connections on the client, that is, the maximum number of concurrent connections allowed on the server. In this example, the default value is 10.
Use the default settings for other attributes.
Clientsocket attributes:
· Port: the communication port. It must be set the same as the server. In this example, set it to 1025;
· Clienttype: the client-side read/write information type, which must be the same as the server-side setting. stnonblocking indicates asynchronous read/write information.
· HOST: the IP address of the server to be connected to by the client. It must be set. You can also set it dynamically in the code.
Use the default settings for other attributes.
Program source code:
· Server Source Code (uservermain. Pas ):
Unit uservermain;
Interface
Uses
Windows, messages, sysutils, classes, graphics, controls, forms, dialogs,
Scktcomp, toolwin, comctrls, extctrls, stdctrls, buttons;
Const
Cmax = 10; // maximum number of client connections
Type
Client_record = record
Chandle: integer; // client socket handle
Csocket: tcustomwinsocket; // client socket
Cname: string; // the name of the client.
Caddress: string; // ip address of the client computer
Cused: Boolean; // client online flag
End;
Type
Tfrmservermain = Class (tform)
Serversocket: tserversocket;
Controlbar1: tcontrolbar;
Toolbar1: ttoolbar;
Tbconnect: ttoolbutton;
Tbclose: ttoolbutton;
Tbdisconnected: ttoolbutton;
Edit1: tedit;
Memo1: tmemo;
Statusbar: tstatusbar;
Procedure tbconnectclick (Sender: tobject );
Procedure tbdisconnectedclick (Sender: tobject );
Procedure serversocketclientread (Sender: tobject;
Socket: tcustomwinsocket );
Procedure serversocketlisten (Sender: tobject;
Socket: tcustomwinsocket );
Procedure serversocketclientconnect (Sender: tobject;
Socket: tcustomwinsocket );
Procedure serversocketclientdisconnect (Sender: tobject;
Socket: tcustomwinsocket );
Procedure tbcloseclick (Sender: tobject );
Procedure formcreate (Sender: tobject );
Procedure formclose (Sender: tobject; var action: tcloseaction );
Procedure serversocketgetsocket (Sender: tobject; socket: integer;
VaR clientsocket: tserverclientwinsocket );
Procedure serversocketclienterror (Sender: tobject;
Socket: tcustomwinsocket; errorevent: terrorevent;
VaR errorcode: integer );
Private
{Private Declarations}
Public
{Public declarations}
Session: array [0 .. Cmax] of client_record; // client connection Array
Sessions: integer; // number of client connections
End;
VaR
Frmservermain: tfrmservermain;
Implementation
{$ R *. DFM}
// Enable the socket connection and enable the socket to enter the listening status
Procedure tfrmservermain. tbconnectclick (Sender: tobject );
Begin
Serversocket. open;
End;
// Close the socket connection and no longer listen to client requests
Procedure tfrmservermain. tbdisconnectedclick (Sender: tobject );
Begin
Serversocket. close;
Statusbar. Panels [0]. Text: = 'the server socket connection has been closed and cannot accept client connection requests .';
End;
// Read information from the client
Procedure tfrmservermain. serversocketclientread (Sender: tobject;
Socket: tcustomwinsocket );
VaR
I: integer;
Begin
// Add the Information read from the client to memo1
Memo1.lines. Add (socket. receivetext );
For I: = 0 to sessions do
Begin
// Obtain the matched Client
If session [I]. chandle = socket. sockethandle then
Begin
Session [I]. csocket. sendtext ('reply Client '+ session [I]. caddress +' => '+ edit1.text );
End;
End;
End;
// The server socket enters the listening state to listen for client connection
Procedure tfrmservermain. serversocketlisten (Sender: tobject;
Socket: tcustomwinsocket );
Begin
Statusbar. Panels [0]. Text: = 'Wait for the client to connect ...';
End;
// After the client is connected to the server
Procedure tfrmservermain. serversocketclientconnect (Sender: tobject;
Socket: tcustomwinsocket );
VaR
I, J: integer;
Begin
J: =-1;
For I: = 0 to sessions do
Begin
// Interrupted client connection in the original client connection Array
If not session [I]. cused then
Begin
Session [I]. chandle: = socket. sockethandle; // client socket handle
Session [I]. csocket: = socket; // client socket
Session [I]. cname: = socket. remotehost; // client computer name
Session [I]. caddress: = socket. remoteaddress; // client computer ip address
Session [I]. cused: = true; // the current position of the connected array is occupied.
Break;
End;
J: = I;
End;
If J = sessions then
Begin
INC (sessions );
Session [J]. chandle: = socket. sockethandle;
Session [J]. csocket: = socket;
Session [J]. cname: = socket. remotehost;
Session [J]. caddress: = socket. remoteaddress;
Session [J]. cused: = true;
End;
Statusbar. Panels [0]. Text: = 'client' + socket. remotehost + 'connected ';
End;
// When the client is disconnected
Procedure tfrmservermain. serversocketclientdisconnect (Sender: tobject;
Socket: tcustomwinsocket );
VaR
I: integer;
Begin
For I: = 0 to sessions do
Begin
If session [I]. chandle = socket. sockethandle then
Begin
Session [I]. chandle: = 0;
Session [I]. cused: = false;
Break;
End;
End;
Statusbar. Panels [0]. Text: = 'client' + socket. remotehost + 'disconnected ';
End;
// Close the window
Procedure tfrmservermain. tbcloseclick (Sender: tobject );
Begin
Close;
End;
Procedure tfrmservermain. formcreate (Sender: tobject );
Begin
Sessions: = 0;
End;
Procedure tfrmservermain. formclose (Sender: tobject;
VaR action: tcloseaction );
Begin
Serversocket. close;
End;
// When the client is connected to the server
Procedure tfrmservermain. serversocketgetsocket (Sender: tobject;
Socket: integer; var clientsocket: tserverclientwinsocket );
Begin
Statusbar. Panels [0]. Text: = 'client is connected ...';
End;
// Client Error
Procedure tfrmservermain. serversocketclienterror (Sender: tobject;
Socket: tcustomwinsocket; errorevent: terrorevent;
VaR errorcode: integer );
Begin
Statusbar. Panels [0]. Text: = 'client' + socket. remotehost + 'error! ';
Errorcode: = 0;
End;
End.
· Client source code (uclientmain. Pas ):
Unit uclientmain;
Interface
Uses
Windows, messages, sysutils, classes, graphics, controls, forms, dialogs,
Scktcomp, comctrls, toolwin, extctrls, stdctrls, buttons;
Const
Sockethost = '192. 16.1.6 '; // server address
Type
Tfrmclientmain = Class (tform)
Controlbar1: tcontrolbar;
Toolbar1: ttoolbar;
Tbconnected: ttoolbutton;
Tbsend: ttoolbutton;
Tbclose: ttoolbutton;
Tbdisconnected: ttoolbutton;
Clientsocket: tclientsocket;
Edit1: tedit;
Memo1: tmemo;
Statusbar: tstatusbar;
Btnsend: tbitbtn;
Procedure tbconnectedclick (Sender: tobject );
Procedure tbdisconnectedclick (Sender: tobject );
Procedure clientsocketread (Sender: tobject; socket: tcustomwinsocket );
Procedure tbsendclick (Sender: tobject );
Procedure tbcloseclick (Sender: tobject );
Procedure formshow (Sender: tobject );
Procedure clientsocketconnect (Sender: tobject;
Socket: tcustomwinsocket );
Procedure clientsocketconnecting (Sender: tobject;
Socket: tcustomwinsocket );
Procedure clientsocketdisconnect (Sender: tobject;
Socket: tcustomwinsocket );
Procedure formclose (Sender: tobject; var action: tcloseaction );
Procedure clientsocketerror (Sender: tobject; socket: tcustomwinsocket;
Errorevent: terrorevent; var errorcode: integer );
Private
{Private Declarations}
Public
{Public declarations}
End;
VaR
Frmclientmain: tfrmclientmain;
Implementation
{$ R *. DFM}
// Open the socket connection
Procedure tfrmclientmain. tbconnectedclick (Sender: tobject );
Begin
Clientsocket. open;
End;
// Close the socket connection
Procedure tfrmclientmain. tbdisconnectedclick (Sender: tobject );
Begin
Clientsocket. close;
End;
// Accept the reply from the server
Procedure tfrmclientmain. clientsocketread (Sender: tobject;
Socket: tcustomwinsocket );
Begin
Memo1.lines. Add (socket. receivetext );
End;
// Send the message to the server
Procedure tfrmclientmain. tbsendclick (Sender: tobject );
Begin
Clientsocket. Socket. sendtext (edit1.text );
End;
Procedure tfrmclientmain. tbcloseclick (Sender: tobject );
Begin
Close;
End;
// Set the server address to be connected
Procedure tfrmclientmain. formshow (Sender: tobject );
Begin
Clientsocket. HOST: = sockethost;
End;
// Already connected to the server
Procedure tfrmclientmain. clientsocketconnect (Sender: tobject;
Socket: tcustomwinsocket );
Begin
Tbsend. Enabled: = true;
Tbdisconnected. Enabled: = true;
Btnsend. Enabled: = true;
Statusbar. Panels [0]. Text: = 'connected to' + socket. remotehost;
End;
// Connecting to the server
Procedure tfrmclientmain. clientsocketconnecting (Sender: tobject;
Socket: tcustomwinsocket );
Begin
Statusbar. Panels [0]. Text: = 'connecting to the server ...';
End;
// Occurs when the connection to the server is disconnected.
Procedure tfrmclientmain. clientsocketdisconnect (Sender: tobject;
Socket: tcustomwinsocket );
Begin
Tbsend. Enabled: = false;
Btnsend. Enabled: = false;
Tbdisconnected. Enabled: = false;
Statusbar. Panels [0]. Text: = 'disconnected from '+ socket. remotehost + ';
End;
Procedure tfrmclientmain. formclose (Sender: tobject;
VaR action: tcloseaction );
Begin
Clientsocket. close;
End;
// When an error occurs in connection with the server
Procedure tfrmclientmain. clientsocketerror (Sender: tobject;
Socket: tcustomwinsocket; errorevent: terrorevent;
VaR errorcode: integer );
Begin
Statusbar. Panels [0]. Text: = 'Connection to server error ';
Errorcode: = 0;
End;
End.
Summary
The preceding method is a simple implementation method and easier to understand. Through this method, I have successfully implemented the socket communication function between multiple clients in the LAN and the server, at the same time, it can ensure that the connection, communication, or disconnection of one client does not affect the normal communication of other clients.
Appendix:
The server-side form and client form and Component Attribute settings are used in the corresponding DFM file.
DFM file corresponding to uservermain. PAS (uservermain. DFM)
Object frmservermain: tfrmservermain
Left = 1, 297
Maximum = 258
Bordericons = [bisystemmenu, biminimize]
Borderstyle = bssingle
Caption = 'serversocket'
Clientheight = 1, 279
Clientwidth = 476
Color = clbtnface
Font. charset = default_charset
Font. Color = clwindowtext
Font. Height =-11
Font. Name = 'Ms sans serif'
Font. Style = []
Oldcreateorder = false
Onclose = formclose
Oncreate = formcreate
Pixelsperinch = 96
Textheight = 13
Object controlbar1: tcontrolbar
Left = 0
Top = 0
Width = 476
Height = 30
Align = altop
Autosize = true
Taborder = 0
Object toolbar1: ttoolbar
Left = 11
Top = 2
Width = 459
Height = 22
Buttonheight = 21
Buttonwidth = 55
Caption = 'toolbar1'
Edgeinner = esnone
Edgeouter = esnone
Flat = true
Showcaptions = true
Taborder = 0
Object tbconnect: ttoolbutton
Left = 0
Top = 0
Caption = 'connection'
Imageindex = 0
Onclick = tbconnectclick
End
Object tbdisconnected: ttoolbutton
Left = 55
Top = 0
Caption = 'stopped'
Imageindex = 4
Onclick = tbdisconnectedclick
End
Object tbclose: ttoolbutton
Left = 1, 110
Top = 0
Caption = 'offset'
Imageindex = 3
Onclick = tbcloseclick
End
End
End
Object edit1: tedit
Left = 0
Maximum = 232
Width = 473
Height = 21
Taborder = 1
TEXT = 'Hello! '
End
Object memo1: tmemo
Left = 0
Top = 30
Width = 476
Height = 195
Align = altop
Taborder = 2
End
Object statusbar: tstatusbar
Left = 0
Maximum = 257
Width = 476
Height = 22
Panels = <
Item
Width = 50
End>
Simplepanel = false
End
Object serversocket: tserversocket
Active = false
Port = 1025
Servertype = stnonblocking
Onlisten = serversocketlisten
Ongetsocket = serversocketgetsocket
Onclientconnect = serversocketclientconnect
Onclientdisconnect = serversocketclientdisconnect
Onclientread = serversocketclientread
Onclienterror = serversocketclienterror
Left = 1, 368
End
End
DFM file corresponding to uclientmain. PAS (uclientmain. DFM)
Object frmclientmain: tfrmclientmain
Left = 1, 361
Maximum = 290
Bordericons = [bisystemmenu, biminimize]
Borderstyle = bssingle
Caption = 'clientsocket'
Clientheight = 1, 230
Clientwidth = 402
Color = clbtnface
Font. charset = default_charset
Font. Color = clwindowtext
Font. Height =-11
Font. Name = 'Ms sans serif'
Font. Style = []
Oldcreateorder = false
Position = poscreencenter
Onclose = formclose
Onshow = formshow
Pixelsperinch = 96
Textheight = 13
Object controlbar1: tcontrolbar
Left = 0
Top = 0
Width = 402
Height = 30
Align = altop
Autosize = true
Taborder = 0
Object toolbar1: ttoolbar
Left = 11
Top = 2
Width = 385
Height = 22
Buttonheight = 21
Buttonwidth = 55
Caption = 'toolbar1'
Edgeinner = esnone
Edgeouter = esnone
Flat = true
Showcaptions = true
Taborder = 0
Object tbconnected: ttoolbutton
Left = 0
Top = 0
Caption = 'connection'
Imageindex = 0
Onclick = tbconnectedclick
End
Object tbsend: ttoolbutton
Left = 55
Top = 0
Caption = 'send'
Enabled = false
Imageindex = 1
Onclick = tbsendclick
End
Object tbdisconnected: ttoolbutton
Left = 1, 110
Top = 0
Caption = 'stopped'
Enabled = false
Imageindex = 3
Onclick = tbdisconnectedclick
End
Object tbclose: ttoolbutton
Left = 1, 165
Top = 0
Caption = 'logout'
Imageindex = 2
Onclick = tbcloseclick
End
End
End
Object edit1: tedit
Left = 0
Maximum = 184
Width = 321
Height = 21
Taborder = 1
TEXT = 'greeting'
End
Object memo1: tmemo
Left = 0
Top = 30
Width = 402
Height = 147
Align = altop
Taborder = 2
End
Object statusbar: tstatusbar
Left = 0
Maximum = 208
Width = 402
Height = 22
Panels = <
Item
Width = 50
End>
Simplepanel = false
End
Object btnsend: tbitbtn
Left = 1, 336
Maximum = 183
Width = 60
Height = 22
Caption = 'send'
Enabled = false
Taborder = 4
Onclick = tbsendclick
End
Object clientsocket: tclientsocket
Active = false
Clienttype = ctnonblocking
Port = 1025
Onconnecting = clientsocketconnecting
Onconnect = clientsocketconnect
Ondisconnect = clientsocketdisconnect
Onread = clientsocketread
Onerror = clientsocketerror
Left = 1, 320
End
End