Mega Code Archive
Client-server with sockets
<![CDATA[
This code example demonstrates a Client/Server application using
socket-connections. The Server consists of a Form with a Memo,
which shows connection-status and recieved text. If the words:
'DELPHI' or 'Conn?' are sent from the client, the server will answer back.
Multiple clients could connect to this Server. When a client tries to connect
a new clientsocket is created on the Server-side.
The Client consists of a Form with an EditBox for messages to be sent and
a memo for status and sent/recieved messages.
Use the network-name for the computer with the Server, when connecting.
If you want to download the project it's here:
The Server
{***************************************************************
*
* Unit Name: Unit1
* Purpose : A WinSocket server for multiple client connections.
* Author : Mats Asplund, http://go.to/masdp
* History : Ver 1.0 / 2001-03-01
*
****************************************************************}
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, ScktComp, ExtCtrls, ComCtrls;
type
TForm1 = class(TForm)
ServerSocket1: TServerSocket;
Memo1: TMemo;
Timer1: TTimer;
Label1: TLabel;
StatusBar1: TStatusBar;
Timer2: TTimer;
procedure FormActivate(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure ServerSocket1ClientRead(Sender: TObject;
Socket: TCustomWinSocket);
procedure ServerSocket1ClientConnect(Sender: TObject;
Socket: TCustomWinSocket);
procedure ServerSocket1ClientDisconnect(Sender: TObject;
Socket: TCustomWinSocket);
procedure Timer1Timer(Sender: TObject);
procedure ServerSocket1GetSocket(Sender: TObject; Socket: Integer;
var ClientSocket: TServerClientWinSocket);
procedure FormCreate(Sender: TObject);
procedure Timer2Timer(Sender: TObject);
private
ClientNo: Integer;
Clients: TStringList;
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
uses Unit2;
{$R *.DFM}
const KeyWord = 'DELPHI';
KeyAnswer = 'THE BEST AND FASTEST WINDOWS PROGRAMMING TOOL EVER MADE !';
Conn = 'CONN?';
procedure TForm1.FormActivate(Sender: TObject);
begin
ServerSocket1.Active:= true;
end;
procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
if Clients.Count > 0 then
if MessageDlg('There are ' + IntToStr(Clients.Count) +
' clients connected. Close anyway?', mtConfirmation, [mbYes, mbNo], 0) =
mrYes then
begin
ServerSocket1.Close;
Action:= caFree;
end
else
Action:= caNone;
end;
procedure TForm1.ServerSocket1ClientRead(Sender: TObject;
Socket: TCustomWinSocket);
var RecText: string;
n: Integer;
begin
RecText:= Socket.ReceiveText;
for n:= 0 to Clients.Count - 1 do
if Socket.Data = PChar(StrToInt(Clients[n])) then
if Uppercase(RecText) = KeyWord then
begin
ServerSocket1.Socket.Connections[n].SendText(KeyAnswer);
Memo1.Lines.Add('Client' + IntToStr(StrToInt(Clients[n]) + 1)
+ ': Recieved KEYWORD');
end
else
if Uppercase(RecText) = 'CONN?' then
ServerSocket1.Socket.Connections[n].SendText('Active connections: '
+ IntToStr(Clients.Count))
else
Memo1.Lines.Add('Client' + IntToStr(StrToInt(Clients[n]) + 1)
+ ': ' + RecText);
end;
procedure TForm1.ServerSocket1ClientConnect(Sender: TObject;
Socket: TCustomWinSocket);
begin
Form2.Label1.Caption:= 'Client' + IntToStr(ClientNo + 1) + ' connecting...';
Form2.Show;
Timer1.Enabled:= true;
Memo1.Lines.Add('Client' + IntToStr(ClientNo + 1) + ' connected: ' + TimeToStr(Now));
end;
procedure TForm1.ServerSocket1ClientDisconnect(Sender: TObject;
Socket: TCustomWinSocket);
var n: Integer;
Data: PChar;
begin
Data:= Socket.Data;
for n:= 0 to ClientNo do
if Data = PChar(n) then
begin
Form2.Label1.Caption:= 'Client' + IntToStr(n + 1) + ' disconnecting...';
Form2.Show;
Timer1.Enabled:= true;
Memo1.Lines.Add('Client' + IntToStr(n + 1) + ' disconnected: ' + TimeToStr(Now));
end;
for n:= 0 to Clients.Count - 1 do
if Data = PChar(StrToInt(Clients[n])) then
begin
Clients.Delete(n);
Break;
end;
StatusBar1.Panels[0].Text:= ' Active connections: ' + IntToStr(Clients.Count);
end;
procedure TForm1.Timer1Timer(Sender: TObject);
begin
Timer1.Enabled:= false;
Form2.Hide;
end;
procedure TForm1.ServerSocket1GetSocket(Sender: TObject; Socket: Integer;
var ClientSocket: TServerClientWinSocket);
begin
ClientSocket:= TServerClientWinSocket.Create(Socket, ServerSocket1.Socket);
ClientSocket.Data:= PChar(ClientNo);
Clients.Add(IntToStr(ClientNo));
Inc(ClientNo);
StatusBar1.Panels[0].Text:= ' Active connections: ' + IntToStr(Clients.Count);
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
ClientNo:= 0;
Clients:= TStringList.Create;
end;
procedure TForm1.Timer2Timer(Sender: TObject);
begin
StatusBar1.Panels[1].Text:= ' ' + DateTimeToStr(Now);
end;
end.
unit Unit2;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, ExtCtr;
type
TForm2 = class(TForm)
Image1: TImage;
Label1: TLabel;
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form2: TForm2;
implementation
{$R *.DFM}
end.
The Client
{***************************************************************
*
* Unit Name: clUnit1
* Purpose : Client for a SocketServer connection
* Author : Mats Asplund, http://go.to/masdp
* History : Ver. 1.0 / 2001-03-01
*
****************************************************************}
unit clUnit1;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
ScktComp, StdCtrls, ExtCtrls, ComCtrls;
type
TForm1 = class(TForm)
Edit1: TEdit;
Button1: TButton;
ClientSocket1: TClientSocket;
Timer1: TTimer;
Button2: TButton;
Edit2: TEdit;
Label1: TLabel;
Button3: TButton;
Memo1: TMemo;
StatusBar1: TStatusBar;
Timer2: TTimer;
procedure Button1Click(Sender: TObject);
procedure ClientSocket1Connect(Sender: TObject;
Socket: TCustomWinSocket);
procedure ClientSocket1Error(Sender: TObject; Socket: TCustomWinSocket;
ErrorEvent: TErrorEvent; var ErrorCode: Integer);
procedure Timer1Timer(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure ClientSocket1Read(Sender: TObject; Socket: TCustomWinSocket);
procedure Button3Click(Sender: TObject);
procedure Edit1KeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
procedure ClientSocket1Disconnect(Sender: TObject;
Socket: TCustomWinSocket);
procedure FormCreate(Sender: TObject);
procedure Timer2Timer(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
uses clUnit2;
{$R *.DFM}
procedure TForm1.Button1Click(Sender: TObject);
begin
if ClientSocket1.Socket.Connected then
begin
ClientSocket1.Socket.SendText(Edit1.Text);
Memo1.Lines.Add('Sending: ' + Edit1.Text);
Edit1.Text:= '';
end;
end;
procedure TForm1.ClientSocket1Connect(Sender: TObject;
Socket: TCustomWinSocket);
begin
Form2.Label1.Caption:= 'Connected to: ' + Socket.RemoteHost;
Form2.Show;
Timer1.Enabled:= true;
StatusBar1.Panels[0].Text:= ' Connected to: ' + Socket.RemoteHost;
end;
procedure TForm1.ClientSocket1Error(Sender: TObject;
Socket: TCustomWinSocket; ErrorEvent: TErrorEvent;
var ErrorCode: Integer);
begin
if ErrorEvent = eeConnect then
begin
Form2.Label1.Caption:= 'Error connecting to: ' + Edit2.Text;
Form2.Show;
Timer1.Enabled:= true;
StatusBar1.Panels[0].Text:= ' Disconnected';
ErrorCode:= 0;
end;
end;
procedure TForm1.Timer1Timer(Sender: TObject);
begin
Timer1.Enabled:= false;
Form2.Hide;
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
ClientSocket1.Host:= Edit2.Text;
ClientSocket1.Active:= true;
end;
procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
ClientSocket1.Close;
Action:= caFree;
end;
procedure TForm1.ClientSocket1Read(Sender: TObject;
Socket: TCustomWinSocket);
begin
Memo1.Lines.Add('Recieving: ' + ClientSocket1.Socket.ReceiveText);
end;
procedure TForm1.Button3Click(Sender: TObject);
begin
ClientSocket1.Active:= false;
end;
procedure TForm1.Edit1KeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
begin
if Key = 13 then Button1.Click;
end;
procedure TForm1.ClientSocket1Disconnect(Sender: TObject;
Socket: TCustomWinSocket);
begin
Form2.Label1.Caption:= 'Disconnected from: ' + Socket.RemoteHost;
Form2.Show;
Timer1.Enabled:= true;
StatusBar1.Panels[0].Text:= ' Disconnected';
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
StatusBar1.Panels[0].Text:= ' Disconnected';
end;
procedure TForm1.Timer2Timer(Sender: TObject);
begin
StatusBar1.Panels[1].Text:= ' ' + DateTimeToStr(Now);
end;
end.
unit clUnit2;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, ExtCtrls;
type
TForm2 = class(TForm)
Image1: TImage;
Label1: TLabel;
Bevel1: TBevel;
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form2: TForm2;
implementation
{$R *.DFM}
end.
]]>