Archivio

Archive for luglio 2017

[ DELPHI & EMBARCADERO ] – Client and Server using TIdTCPServer and TIdTCPClient components

An easy example of a Server and Client using indy components : TIdTCPServer, TIdTCPClientTIdThreadComponent.

 

// *****************************************************************************
//   File    : UServer.pas
//   Project : MicroServer.dpr
//             Easy example of TCP Server with indy component : TidTCPSever
//
//   see indy doc: http://www.indyproject.org/sockets/docs/index.en.aspx
//
// *****************************************************************************
unit UServer;

interface

uses
    Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
    Vcl.Controls, Vcl.Forms, Vcl.Dialogs, IdContext, IdComponent, Vcl.StdCtrls,
    IdBaseComponent, IdCustomTCPServer, IdTCPServer, Vcl.ExtCtrls;

type
    TFServer = class(TForm)
    
        Title         : TLabel;

        btn_start     : TButton;
        btn_stop      : TButton;
        btn_clear     : TButton;

        clients_connected : TLabel;

        IdTCPServer   : TIdTCPServer;
        Label1        : TLabel;
        Panel1        : TPanel;
        messagesLog   : TMemo;

        procedure FormShow(Sender: TObject);
        
        procedure btn_startClick(Sender: TObject);
        procedure btn_stopClick(Sender: TObject);
        procedure btn_clearClick(Sender: TObject);

        procedure IdTCPServerConnect(AContext: TIdContext);
        procedure IdTCPServerDisconnect(AContext: TIdContext);
        procedure IdTCPServerExecute(AContext: TIdContext);
        procedure IdTCPServerStatus(ASender: TObject; const AStatus: TIdStatus;
                                    const AStatusText: string);

        function  getNow():String;
        procedure broadcastMessage(p_message : string);

        private
            { Private declarations }
            
        public
            { Public declarations }
            
    end;
    // ...

    // ... listening port
    const GUEST_CLIENT_PORT    = 20010;

    var
        FServer     : TFServer;


implementation

{$R *.dfm}

// *****************************************************************************
//   EVENT : onShow()
//           ON FORM SHOW
// *****************************************************************************
procedure TFServer.FormShow(Sender: TObject);
begin
    // ... INITIALIZE:

    // ... clear message log
    messagesLog.Lines.Clear;

    // ... zero to clients connected
    clients_connected.Caption := inttostr(0);

    // ... set buttons
    btn_start.visible := true;
    btn_stop.visible  := false;
end;
// .............................................................................


// *****************************************************************************
//   EVENT : btn_startClick()
//           CLICK ON START BUTTON
// *****************************************************************************
procedure TFServer.btn_startClick(Sender: TObject);
begin
    // ... START SERVER:

    // ... clear the Bindings property ( ... Socket Handles )
    IdTCPServer.Bindings.Clear;
    // ... Bindings is a property of class: TIdSocketHandles;

    // ... add listening ports:

    // ... add a port for connections from guest clients.
    IdTCPServer.Bindings.Add.Port := GUEST_CLIENT_PORT;
    // ... etc..


    // ... ok, Active the Server!
    IdTCPServer.Active  := true;

    // ... hide start button
    btn_start.visible   := false;

    // ... show stop button
    btn_stop.visible    := true;

    // ... message log
    MessagesLog.Lines.add('[SERVER] - ' + getNow() + 'STARTED!');

end;
// .............................................................................


// *****************************************************************************
//   EVENT : btn_stopClick()
//           CLICK ON STOP BUTTON
// *****************************************************************************
procedure TFServer.btn_stopClick(Sender: TObject);
begin

    // ... before stopping the server ... send 'good bye' to all clients connected
    broadcastMessage( 'Goodbye my Clients :)');

    // ...
    // broadcastMessage( 'Goodbye');

    // ... stop server!
    IdTCPServer.Active := false;

    // ... hide stop button
    btn_stop.visible   := false;

    // ... show start button
    btn_start.visible  := true;

    // ... message log
    MessagesLog.Lines.add('[SERVER] - ' + getNow() + 'STOPPED!');

end;
// .............................................................................


// *****************************************************************************
//   EVENT : btn_clearClick()
//           CLICK ON CLEAR BUTTON
// *****************************************************************************
procedure TFServer.btn_clearClick(Sender: TObject);
begin
    //... clear messages log
    MessagesLog.Lines.Clear;
end;
// .............................................................................


// *****************************************************************************
//   EVENT : onConnect()
//           OCCURS ANY TIME A CLIENT IS CONNECTED
// *****************************************************************************
procedure TFServer.IdTCPServerConnect(AContext: TIdContext);
var
    Ip          : string;
    Port        : Integer;
    PeerIP      : string;
    PeerPort    : Integer;

    msgToClient : string;
    typeClient  : string;

begin

    // ... OnConnect is a TIdServerThreadEvent property that represents the event
    //     handler signalled when a new client connection is connected to the server.

    // ... Use OnConnect to perform actions for the client after it is connected
    //     and prior to execution in the OnExecute event handler.

    // ... see indy doc:
    //     http://www.indyproject.org/sockets/docs/index.en.aspx


    // ... getting IP address and Port of Client that connected
    Ip        := AContext.Binding.IP;
    Port      := AContext.Binding.Port;
    PeerIP    := AContext.Binding.PeerIP;
    PeerPort  := AContext.Binding.PeerPort;

    // ... message log ...........................................................

    MessagesLog.Lines.add('[SERVER] - ' + getNow() + 'Client Connected!)');


    MessagesLog.Lines.add('           ' + 'Port='     + IntToStr(Port) + ' '
                                      + '(PeerIP='  + PeerIP + '-'
                                      + 'PeerPort=' + IntToStr(PeerPort) + ')');
    // ...

    // ... update number of clients connected
    try
    clients_connected.Caption := IntToStr(IdTCPServer.Contexts.LockList.Count);
    finally
    IdTCPServer.Contexts.UnlockList;
    end;
    // ...

    // ... CLIENT CONNECTED:
    case Port of
    GUEST_CLIENT_PORT   : begin
                            // ... GUEST CLIENTS
                            typeClient := 'GUEST';
                          end;

                          // ...
    end;


    // ... send the Welcome message to Client connected
    msgToClient := 'Welcome ' + typeClient + ' ' + 'Client :)';
    AContext.Connection.IOHandler.WriteLn( msgToClient );

end;
// .............................................................................


// *****************************************************************************
//   EVENT : onDisconnect()
//           OCCURS ANY TIME A CLIENT IS DISCONNECTED
// *****************************************************************************
procedure TFServer.IdTCPServerDisconnect(AContext: TIdContext);
var
    Ip          : string;
    Port        : Integer;
    PeerIP      : string;
    PeerPort    : Integer;

    // msgToClient : string;
    // typeClient  : string;

begin


    // ... getting IP address and Port of Client that connected
    Ip        := AContext.Binding.IP;
    Port      := AContext.Binding.Port;
    PeerIP    := AContext.Binding.PeerIP;
    PeerPort  := AContext.Binding.PeerPort;

    // ... message log ...........................................................
    MessagesLog.Lines.add('[SERVER] - ' + getNow() + 'Client Disconnected!)!');
    MessagesLog.Lines.add('           ' + 'Port='     + IntToStr(Port) + ' '
                                      + '(PeerIP='  + PeerIP + '-'
                                      + 'PeerPort=' + IntToStr(PeerPort) + ')');
    // ...

    // ... update number of clients connected
    try
        clients_connected.Caption := IntToStr(IdTCPServer.Contexts.LockList.Count-1);
    finally
        IdTCPServer.Contexts.UnlockList;
    end;

end;
// .............................................................................


// *****************************************************************************
//   EVENT : onExecute()
//           ON EXECUTE THREAD CLIENT
// *****************************************************************************
procedure TFServer.IdTCPServerExecute(AContext: TIdContext);
var
    Port          : Integer;
    PeerPort      : Integer;
    PeerIP        : string;

    msgFromClient : string;

    msgToClient   : string;

begin

    // ... OnExecute is a TIdServerThreadEvents event handler used to execute
    //     the task for a client connection to the server.

    // ... received a message from a client

    // ... getting IP address, Port and PeerPort from Client that connected
    Port      := AContext.Binding.Port;
    PeerIP    := AContext.Binding.PeerIP;
    PeerPort  := AContext.Binding.PeerPort;


    // ... get message from client
    msgFromClient := AContext.Connection.IOHandler.ReadLn;

    // ... message log ...........................................................
    messagesLog.Lines.add('[CLIENT] - ' + getNow() + msgFromClient);
    MessagesLog.Lines.add('           ' + 'Port='     + IntToStr(Port) + ' '
                                      + '(PeerIP='  + PeerIP + '-'
                                      + 'PeerPort=' + IntToStr(PeerPort) + ')');

    // ...

    // ... process message (request) from Client

    // ...

    // ... send response to Client
    msgToClient := '... response from server :)';

    AContext.Connection.IOHandler.WriteLn( msgToClient );

end;
// .............................................................................


// *****************************************************************************
//   EVENT : onStatus()
//           ON STATUS CONNECTION
// *****************************************************************************
procedure TFServer.IdTCPServerStatus(ASender: TObject; const AStatus: TIdStatus;
                                     const AStatusText: string);
begin

    // ... OnStatus is a TIdStatusEvent property that represents the event handler
    //     triggered when the current connection state is changed...

    // ... message log
    MessagesLog.Lines.add('[SERVER] - ' + getNow() + AStatusText);
end;
// .............................................................................


// *****************************************************************************
//   FUNCTION : getNow()
//              GET MOW DATE TIME
// *****************************************************************************
function TFServer.getNow() : String;
begin
    Result := FormatDateTime('yyyy-mm-dd hh:nn:ss', Now) + ': ';
end;
// .............................................................................


// *****************************************************************************
//   PROCEDURE : broadcastMessage()
//               BROADCAST A MESSAGE TO ALL CLIENTS CONNECTED
// *****************************************************************************
procedure TFServer.broadcastMessage( p_message : string );
var
    tmpList      : TList;
    contexClient : TidContext;
    i            : integer;
begin

    // ... send a message to all clients connected

    // ... get context Locklist
    try
        tmpList := IdTCPServer.Contexts.LockList;
    finally
        // ... unlock list of clients!
        IdTCPServer.Contexts.UnlockList;
    end;

    i := 0;
    while ( i < tmpList.Count ) do begin

        // ... get context ( thread of i-client )
        contexClient := tmpList[i];

        // ... send message to client
        contexClient.Connection.IOHandler.WriteLn(p_message);

        // ... next client thread
        i := i + 1;
    end;

end;
// .............................................................................

end.

 

 

 

// *****************************************************************************
//   File    : UClient.pas
//   Project : MicroServer.dpr
//             Easy example of TCP Client with indy component : TidTCPSever
//
//   see indy doc: http://www.indyproject.org/sockets/docs/index.en.aspx
//
// *****************************************************************************
unit UClient;

interface

uses
    Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
    Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, IdBaseComponent,
    IdComponent, IdTCPConnection, IdTCPClient, IdThreadComponent;

type
    TFClient = class(TForm)

    Label1        : TLabel;
    Label2        : TLabel;

    messageToSend : TMemo;
    messagesLog   : TMemo;

    btn_connect   : TButton;
    btn_disconnect: TButton;
    btn_send      : TButton;

    // ... TIdTCPClient
    IdTCPClient       : TIdTCPClient;

    // ... TIdThreadComponent
    IdThreadComponent : TIdThreadComponent;


    procedure FormShow(Sender: TObject);

    procedure btn_connectClick(Sender: TObject);
    procedure btn_disconnectClick(Sender: TObject);
    procedure btn_sendClick(Sender: TObject);

    procedure IdTCPClientConnected(Sender: TObject);
    procedure IdTCPClientDisconnected(Sender: TObject);

    procedure IdThreadComponentRun(Sender: TIdThreadComponent);

    function  getNow() : String;

    private
        { Private declarations }
    public
        { Public declarations }
    end;

    // ... listening port : GUEST CLIENT
    const GUEST_PORT = 20010;

    var
      FClient     : TFClient;

implementation

{$R *.dfm}


// *****************************************************************************
//   EVENT : onShow()
//           ON SHOW FORM
// *****************************************************************************
procedure TFClient.FormShow(Sender: TObject);
begin

    // ... INITAILIZE

    // ... message to send
    messageToSend.Clear;
    messageToSend.Enabled     := false;

    // ... log
    messagesLog.Clear;

    // ... buttons
    btn_connect.Enabled       := true;
    btn_disconnect.Enabled    := false;
    btn_send.Enabled          := false;

end;
// .............................................................................


// *****************************************************************************
//   EVENT : btn_connectClick()
//           CLICK ON CONNECT BUTTON
// *****************************************************************************
procedure TFClient.btn_connectClick(Sender: TObject);
begin

    // ... try to connect to Server
    try
        IdTCPClient.Connect;

        // ... buttons
        btn_connect.Enabled       := false;
        btn_disconnect.Enabled    := true;
        btn_send.Enabled          := true;

    except
        on E: Exception do begin
            MessagesLog.Lines.add('[CLIENT] - CONNECTION ERROR!' + E.Message );
        end;
    end;

end;
// .............................................................................


// *****************************************************************************
//   EVENT : btn_disconnectClick()
//           CLICK ON DISCONNECT BUTTON
// *****************************************************************************
procedure TFClient.btn_disconnectClick(Sender: TObject);
begin
    // ... is connected ?
    if IdTCPClient.Connected then begin

        // ... disconnect from Server
        IdTCPClient.Disconnect;

        // ... set buttons
        btn_connect.Enabled       := true;
        btn_disconnect.Enabled    := false;
        btn_send.Enabled          := false;

        // ... message to send
        messageToSend.Enabled     := false;
    end;
end;
// .............................................................................


// *****************************************************************************
//   EVENT : onConnected()
//           OCCURS WHEN A CLIENT IS CONNETED
// *****************************************************************************
procedure TFClient.IdTCPClientConnected(Sender: TObject);
begin

    // ... messages log
    MessagesLog.Lines.add('[CLIENT] - ' + getNow() + 'CONNECTED!');

    // ... after connection is ok, run the Thread ... waiting messages from server
    IdThreadComponent.Active := true;

    // ... set buttons
    btn_connect.Enabled       := false;
    btn_disconnect.Enabled    := true;
    btn_send.Enabled          := true;

    // ... enable message to send
    messageToSend.Enabled     := true;

end;
// .............................................................................


// *****************************************************************************
//   EVENT : onDisconnected()
//           OCCURS WHEN CLIENT IS DISCONNECTED
// *****************************************************************************
procedure TFClient.IdTCPClientDisconnected(Sender: TObject);
begin
    // ... message log
    MessagesLog.Lines.add('[CLIENT] - ' + getNow() + ' : DISCONNECTED!');
end;
// .............................................................................


// *****************************************************************************
//   EVENT : btn_sendClick()
//           CLICK ON SEND BUTTON
// *****************************************************************************
procedure TFClient.btn_sendClick(Sender: TObject);
begin
    // ... send message to Server
    IdTCPClient.IOHandler.WriteLn(messageToSend.Text);
end;
// .............................................................................


// *****************************************************************************
//   EVENT : onRun()
//           OCCURS WHEN THE SERVER SEND A MESSAGE TO CLIENT
// *****************************************************************************
procedure TFClient.IdThreadComponentRun(Sender: TIdThreadComponent);
var
    msgFromServer : string;
begin
    // ... read message from server
    msgFromServer := IdTCPClient.IOHandler.ReadLn();

    // ... messages log
    messagesLog.Lines.add('[SERVER] - ' + getNow() + msgFromServer);
end;
// .............................................................................


// *****************************************************************************
//   FUNCTION : getNow()
//              GET MOW DATE TIME
// *****************************************************************************
function TFClient.getNow() : String;
begin
    Result := FormatDateTime('yyyy-mm-dd hh:nn:ss', Now) + ': ';
end;
// .............................................................................

end.


… here you can download .dpr files: microserver.zip   –  microclient.zip   

 

 

 

Annunci