Link to home
Start Free TrialLog in
Avatar of klompen
klompen

asked on

Simple client/server application

Hello,

I need help on making my application. It is a client/server application. It is quite simple, but I am not sure how it should be done.

The requirements are like this :

1. SERVER will wait for a client connection.

2. CLIENT will connect to the server and send a command "PROCESS_THIS".

3. SERVER will respond to the client by sending text "PLEASE_WAIT, YOUR JOB_ID=<number>".

4. Then the CLIENT should WAIT until the SERVER has finished the job. The waiting time could take between 15 minutes up to 1 hour.

5. When the SERVER has finished, it will inform the CLIENT by sending text "JOB_ID=<number> IS DONE".

6. Then the CLIENT will close the socket connection.

I am thinking of using the Indy components, but I cant figure out the step 4, the CLIENT waiting process. Because from all the examples in Indy, client server application is very straight forward :

1. SERVER is waiting
2. CLIENT is connecting and sending command
3. SERVER is sending a response
4. CLIENT close the connection

In my situation, the CLIENT waiting is required because it should wait the SERVER to finish the job.

To make it more complex, while processing a job from a CLIENT, the SERVER can receive another job from OTHER CLIENT.

Could you please help? Which one is more suitable, UDP or TCP?

Example of codes are really appreciated.

Thank you.
Avatar of Scay7
Scay7
Flag of South Africa image

See if this is what you need, its a full blown client/server demo from TheRealLoki

Using the standard sockets in delphi.

unit sockettestmain;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, ScktComp;
(* demo by }-=Loki=-{ lokiwashere@yahoo.co.nz *)
type
  TForm2 = class(TForm)
    mLog: TMemo;
    ClientSocket1: TClientSocket;
    gbServer: TGroupBox;
    rbServer: TRadioButton;
    ServerSocket1: TServerSocket;
    eServerPort: TEdit;
    Label1: TLabel;
    bListen: TButton;
    eServerSend: TEdit;
    bServerSendToAll: TButton;
    gbClient: TGroupBox;
    Label2: TLabel;
    eClientPort: TEdit;
    bConnect: TButton;
    eClientSend: TEdit;
    bClientSend: TButton;
    rbClient: TRadioButton;
    Label3: TLabel;
    eAddress: TEdit;
    bOffline: TButton;
    bDisconnect: TButton;
    procedure bListenClick(Sender: TObject);
    procedure bServerSendToAllClick(Sender: TObject);
    procedure rbServerClick(Sender: TObject);
    procedure rbClientClick(Sender: TObject);
    procedure bConnectClick(Sender: TObject);
    procedure bClientSendClick(Sender: TObject);
    procedure ServerSocket1ClientRead(Sender: TObject;
      Socket: TCustomWinSocket);
    procedure ClientSocket1Read(Sender: TObject; Socket: TCustomWinSocket);
    procedure bOfflineClick(Sender: TObject);
    procedure bDisconnectClick(Sender: TObject);
    procedure ServerSocket1ClientConnect(Sender: TObject;
      Socket: TCustomWinSocket);
    procedure ServerSocket1ClientDisconnect(Sender: TObject;
      Socket: TCustomWinSocket);
    procedure ClientSocket1Connecting(Sender: TObject;
      Socket: TCustomWinSocket);
    procedure ClientSocket1Connect(Sender: TObject;
      Socket: TCustomWinSocket);
    procedure ClientSocket1Disconnect(Sender: TObject;
      Socket: TCustomWinSocket);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form2: TForm2;

IMPLEMENTATION

{$R *.DFM}

procedure TForm2.rbServerClick(Sender: TObject);
    begin
        gbServer.Enabled := True;
        gbClient.Enabled := False;
    end;

procedure TForm2.rbClientClick(Sender: TObject);
    begin
        gbServer.Enabled := False;
        gbClient.Enabled := True;
    end;


// ********************************     server code here
procedure TForm2.bListenClick(Sender: TObject);
    begin
        ServerSocket1.Port := StrToIntDef(eServerPort.Text, 2000);
        ServerSocket1.Active := True;
    end;

procedure TForm2.bOfflineClick(Sender: TObject);
    begin
        ServerSocket1.Active := True;
    end;

procedure TForm2.ServerSocket1ClientConnect(Sender: TObject; Socket: TCustomWinSocket);
    begin
        mLog.lines.add('connection from ' + Socket.RemoteAddress);
        mLog.Perform(EM_SCROLL,SB_LINEDOWN,0);
    end;

procedure TForm2.ServerSocket1ClientDisconnect(Sender: TObject; Socket: TCustomWinSocket);
    begin
        mLog.lines.add('disconnection from ' + Socket.RemoteAddress);
        mLog.Perform(EM_SCROLL,SB_LINEDOWN,0);
    end;

procedure TForm2.ServerSocket1ClientRead(Sender: TObject; Socket: TCustomWinSocket);
    begin
        mLog.lines.add(Socket.ReceiveText);
    end;

procedure TForm2.bServerSendToAllClick(Sender: TObject);
    var
        i: integer;
    begin
        for i := 0 to pred(ServerSocket1.Socket.ActiveConnections) do
         ServerSocket1.Socket.Connections[i].SendText(eServerSend.Text);
    end;

// ********************************     client code here
procedure TForm2.bConnectClick(Sender: TObject);
    begin
        ClientSocket1.Address := eAddress.Text;
        ClientSocket1.Port := StrToIntDef(eClientPort.Text, 2000);
        ClientSocket1.Open;
    end;

procedure TForm2.bClientSendClick(Sender: TObject);
    begin
        ClientSocket1.Socket.SendText(eClientSend.Text);
    end;

procedure TForm2.bDisconnectClick(Sender: TObject);
    begin
        ClientSocket1.Close;
    end;

procedure TForm2.ClientSocket1Read(Sender: TObject; Socket: TCustomWinSocket);
    begin
        mLog.lines.add(Socket.ReceiveText);
        mLog.Perform(EM_SCROLL,SB_LINEDOWN,0);
    end;

procedure TForm2.ClientSocket1Connecting(Sender: TObject; Socket: TCustomWinSocket);
    begin
        mLog.lines.add('connecting to ' + ClientSocket1.Address + ':' + IntToStr(ClientSocket1.Port));
        mLog.Perform(EM_SCROLL,SB_LINEDOWN,0);
    end;

procedure TForm2.ClientSocket1Connect(Sender: TObject; Socket: TCustomWinSocket);
    begin
        mLog.lines.add('connected to ' + ClientSocket1.Address + ':' + IntToStr(ClientSocket1.Port));
        mLog.Perform(EM_SCROLL,SB_LINEDOWN,0);
    end;

procedure TForm2.ClientSocket1Disconnect(Sender: TObject; Socket: TCustomWinSocket);
    begin
        mLog.lines.add('disconnected from ' + ClientSocket1.Address + ':' + IntToStr(ClientSocket1.Port));
        mLog.Perform(EM_SCROLL,SB_LINEDOWN,0);
    end;

end.


********************************** FORM FOLLOWS
********************************** FORM FOLLOWS


object Form2: TForm2
  Left = 345
  Top = 300
  BorderStyle = bsSingle
  Caption = 'Form2'
  ClientHeight = 323
  ClientWidth = 641
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'MS Sans Serif'
  Font.Style = []
  OldCreateOrder = False
  Position = poDefault
  PixelsPerInch = 96
  TextHeight = 13
  object mLog: TMemo
    Left = 372
    Top = 48
    Width = 261
    Height = 265
    TabOrder = 0
  end
  object gbServer: TGroupBox
    Left = 16
    Top = 40
    Width = 337
    Height = 105
    Caption = 'Server'
    TabOrder = 1
    object Label1: TLabel
      Left = 16
      Top = 28
      Width = 19
      Height = 13
      Caption = 'Port'
    end
    object eServerPort: TEdit
      Left = 72
      Top = 24
      Width = 41
      Height = 21
      TabOrder = 0
      Text = '2000'
    end
    object bListen: TButton
      Left = 224
      Top = 16
      Width = 75
      Height = 25
      Caption = 'Listen'
      TabOrder = 1
      OnClick = bListenClick
    end
    object eServerSend: TEdit
      Left = 8
      Top = 72
      Width = 193
      Height = 21
      TabOrder = 2
      Text = 'Text to send from server'
    end
    object bServerSendToAll: TButton
      Left = 224
      Top = 72
      Width = 75
      Height = 25
      Caption = 'Send to all'
      TabOrder = 3
      OnClick = bServerSendToAllClick
    end
    object bOffline: TButton
      Left = 224
      Top = 40
      Width = 75
      Height = 25
      Caption = 'Offline'
      TabOrder = 4
      OnClick = bOfflineClick
    end
  end
  object rbServer: TRadioButton
    Left = 16
    Top = 8
    Width = 113
    Height = 17
    Caption = 'Server'
    TabOrder = 2
    OnClick = rbServerClick
  end
  object gbClient: TGroupBox
    Left = 16
    Top = 176
    Width = 337
    Height = 137
    Caption = 'Client'
    TabOrder = 3
    object Label2: TLabel
      Left = 16
      Top = 44
      Width = 19
      Height = 13
      Caption = 'Port'
    end
    object Label3: TLabel
      Left = 16
      Top = 20
      Width = 38
      Height = 13
      Caption = 'Address'
    end
    object eClientPort: TEdit
      Left = 72
      Top = 40
      Width = 41
      Height = 21
      TabOrder = 1
      Text = '2000'
    end
    object bConnect: TButton
      Left = 224
      Top = 16
      Width = 75
      Height = 25
      Caption = 'Connect'
      TabOrder = 2
      OnClick = bConnectClick
    end
    object eClientSend: TEdit
      Left = 8
      Top = 88
      Width = 193
      Height = 21
      TabOrder = 3
      Text = 'Text to send from server'
    end
    object bClientSend: TButton
      Left = 224
      Top = 88
      Width = 75
      Height = 25
      Caption = 'Send'
      TabOrder = 4
      OnClick = bClientSendClick
    end
    object eAddress: TEdit
      Left = 72
      Top = 16
      Width = 113
      Height = 21
      TabOrder = 0
      Text = '127.0.0.1'
    end
    object bDisconnect: TButton
      Left = 224
      Top = 40
      Width = 75
      Height = 25
      Caption = 'Disconnect'
      TabOrder = 5
      OnClick = bDisconnectClick
    end
  end
  object rbClient: TRadioButton
    Left = 16
    Top = 152
    Width = 113
    Height = 17
    Caption = 'Client'
    Checked = True
    TabOrder = 4
    TabStop = True
    OnClick = rbClientClick
  end
  object ClientSocket1: TClientSocket
    Active = False
    ClientType = ctNonBlocking
    Host = 'localhost'
    Port = 2000
    OnConnecting = ClientSocket1Connecting
    OnConnect = ClientSocket1Connect
    OnDisconnect = ClientSocket1Disconnect
    OnRead = ClientSocket1Read
    Left = 356
    Top = 164
  end
  object ServerSocket1: TServerSocket
    Active = False
    Port = 2000
    ServerType = stNonBlocking
    OnClientConnect = ServerSocket1ClientConnect
    OnClientDisconnect = ServerSocket1ClientDisconnect
    OnClientRead = ServerSocket1ClientRead
    Left = 360
    Top = 88
  end
end

Peace Scay7
Avatar of TheRealLoki
Since you want Indy, I am assuming you are using Indy 10 (downloadable for free)
Here's a demo I wrote for you today
You can send various commands from the client without it blocking the client app.
(including an example of how to send a file)
To have the server do "some big process"
you would use a command similar to the "TIMER" command
where the client sends PROCESS_THIS
and the server does it, and then sends "JOB_IS=<> is done
simply put the "big process" before you send teh "TIMER_DONE" message

e.g. replace the line
sleep(5000); // wait for 5 seconds, then send a TIMER_STOPPED
in servermain.pas with your big process code

Put your command sequence in the clientmain:TIndyInaThread.Execute method
and set the available commands and what they do in the servermain:IdTCPServer1Execute method
hopefully my demo will give you enough to muddle through, and then some.
If not, give me a yell

//************************ SERVER UNIT **************************

unit servermain;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  IdBaseComponent, IdComponent, IdTCPServer, ComCtrls, StdCtrls, FileCtrl,
  IDContext, IDThread, IdIOHandlerSocket, IDStack, IDException, IdStreamVCL;

Const
  WM_LogMessage = WM_user + 100;

// used in the lParam for threads sending log messages
  tlmtinformation = 1;
  tlmtWarning = 2;
  tlmtError = 4;

  tldNone = 8;
  tldIn = 16;
  tldOut = 32;

type TLogMessageType = (lmtInformation, lmtWarning, lmtError);
type TLogDirection = (ldNone, ldIn, ldOut);

type TClientStage = (csNone, csLoggedIn);
type
    TClientSpecificData = class(TObject)
        public
            ClientStage: TClientStage;
            ID: string; // just the unique id we create for each connection
            Username: string;


            Constructor CreateWithSettings(ID_: string);
            Destructor Destroy; override;
        end;

type
  TfServerMain = class(TForm)
    IdTCPServer1: TIdTCPServer;
    ListBox1: TListBox;
    gbSettings: TGroupBox;
    Label1: TLabel;
    ePort: TEdit;
    bListen: TButton;
    bOffline: TButton;
    procedure IdTCPServer1AfterBind(Sender: TObject);
    procedure bListenClick(Sender: TObject);
    procedure bOfflineClick(Sender: TObject);
    procedure IdTCPServer1BeforeListenerRun(AThread: TIdThread);
    procedure IdTCPServer1Connect(AContext: TIdContext);
    procedure IdTCPServer1Disconnect(AContext: TIdContext);
    procedure IdTCPServer1Execute(AContext: TIdContext);
  private
    { Private declarations }
  public
    { Public declarations }
    procedure LogMessage(LogMessageType: TLogMessageType; LogDirection: TLogDirection; S: string);
    procedure SendStringWithLogging(AContext: TIdContext; S: string);
    function ReceiveStringWithLogging(AContext: TIdContext): string;
    Procedure WriteLog(var Msg:TMessage);Message WM_LogMessage;
    procedure ThreadLogMessage(LogMessageType: TLogMessageType; LogDirection: TLogDirection; S: string);
  end;

var
  fServerMain: TfServerMain;

IMPLEMENTATION

{$R *.DFM}

procedure TfServerMain.LogMessage(LogMessageType: TLogMessageType;
LogDirection: TLogDirection; S: string);
    var
        FullMsg: string;
    begin
        FullMSg := '';
        case LogMessageType of
            lmtInformation: FullMsg := '  ';
            lmtWarning: FullMsg := '? ';
            lmtError: FullMsg := '!  ';
        end;
       
        case LogDirection of
            ldNone: FullMsg := FullMsg + '   ';
            ldIn: FullMsg := FullMsg + '<- ';
            ldOut: FullMsg := FullMsg + '-> ';
        end;
        FullMsg := FullMsg + FormatDateTime('hh":"nn":"ss', Now) + ' ' + S;
        Listbox1.Items.Add(FullMsg);
        while Listbox1.Items.Count > 1000 do Listbox1.Items.Delete(0);
    end;

procedure TfServerMain.SendStringWithLogging(AContext: TIdContext; S: string);
    begin
        AContext.Connection.IOHandler.WriteLn(S);
        ThreadLogMessage(lmtInformation, ldOut, (AContext.Data as TClientSpecificData).ID + ' - ' + S);
    end;

function TfServerMain.ReceiveStringWithLogging(AContext: TIdContext): string;
    begin
        result := AContext.Connection.IOHandler.ReadLn;
        ThreadLogMessage(lmtInformation, ldIn, (AContext.Data as TClientSpecificData).ID + ' - ' + result);
    end;

//used to catch logging from thread
procedure TfServerMain.WriteLog(var Msg: TMessage);
    var
        PS:PString;
        S: string;
        i: integer;
        LogMessageType: TLogMessageType;
        LogDirection: TLogDirection;
    begin
       
        PS:=Pointer(Msg.WParam);
        S := PS^;
       
        i := Msg.LParam;
        if (i and tlmtinformation) = tlmtinformation then LogMessageType := lmtInformation;
        if (i and tlmtwarning) = tlmtwarning then LogMessageType := lmtWarning;
        if (i and tlmterror) = tlmterror then LogMessageType := lmtError;
       
        if (i and tldNone) = tldNone then LogDirection := ldNone;
        if (i and tldIn) = tldIn then LogDirection := ldIn;
        if (i and tldOut) = tldOut then LogDirection := ldOut;
        LogMessage(LogMessageType, LogDirection, S);
       
        //        FS.WriteBuffer(S^[1],Length(S^));
        Dispose(PS);
    end;


procedure TfServerMain.IdTCPServer1AfterBind(Sender: TObject);
    begin
        LogMessage(lmtInformation, ldNone, 'BOUND TO PORT ' + IntToStr(IdTCPServer1.DefaultPort));
    end;

procedure TfServerMain.bListenClick(Sender: TObject);
    begin
        IdTCPServer1.DefaultPort := StrToIntDef(ePort.Text, 2000);
        IdTCPServer1.Active := True;
    end;

procedure TfServerMain.bOfflineClick(Sender: TObject);
    begin
        IdTCPServer1.Active := False;
        LogMessage(lmtInformation, ldNone, 'OFFLINE');
    end;

procedure TfServerMain.IdTCPServer1BeforeListenerRun(AThread: TIdThread);
    begin
        LogMessage(lmtInformation, ldNone, 'LISTENING');
    end;

procedure TfServerMain.IdTCPServer1Connect(AContext: TIdContext);
    var
        ID_: string;
    begin
        ID_ := AContext.Connection.Socket.Binding.PeerIP + ':' + IntToStr(AContext.Connection.Socket.Binding.PeerPort);
        AContext.Data := TClientSpecificData.CreateWithSettings(ID_);
        LogMessage(lmtInformation, ldNone, ID_ + ' Connected');
    end;

procedure TfServerMain.IdTCPServer1Disconnect(AContext: TIdContext);
    begin
        if assigned(AContext.Data) then
        begin
            (AContext.Data as TClientSpecificData).Free;
            AContext.Data := nil;
        end;
        LogMessage(lmtInformation, ldNone, AContext.Connection.Socket.Binding.PeerIP + ':' + IntToStr(AContext.Connection.Socket.Binding.PeerPort) + ' Disconnected');
    end;

{ TClientSpecificData }


constructor TClientSpecificData.CreateWithSettings(ID_: string);
    begin
        Inherited Create;
        ID := ID_;
        ClientStage := csNone;
        Username := '';
    end;

destructor TClientSpecificData.Destroy;
    begin
//
        inherited;
    end;

procedure TfServerMain.IdTCPServer1Execute(AContext: TIdContext);
    var
        i: integer;
        S, S2: string;
        InCmd: string;
        AStream: TIdStreamVCL;
// for file receiving
        Filename: string;
        FileSize: Int64;

    begin
// send the ID command and the user's unique "ID"
        try
    // Main Command Loop
            while AContext.Connection.Connected do
            begin
// check if user is logged in
                InCmd := ReceiveStringWithLogging(AContext);
                case (AContext.Data as TClientSpecificData).ClientStage of
                    csNone:
                    begin
                        if pos('LOGIN', uppercase(InCmd)) = 1 then // LOGIN username password
                        begin
                            delete(InCmd, 1, length('LOGIN ')); // remove the LOGIN part
                            i := pos(' ', InCmd);
                            if i = 0 then
                              SendStringWithLogging(AContext, 'ERROR Not enough parameters for "LOGIN" command. expecting LOGIN <username> <password>')
                            else
                            begin
                                S := copy(InCmd, 1, i-1);
                                S2 := copy(InCmd, i+1, maxint);
// check login details here, e.g. fatabase, ini file, whatever. for now we will just always accept
                                (AContext.Data as TClientSpecificData).Username := S;
                                (AContext.Data as TClientSpecificData).ClientStage := csLoggedIn; // allows other commands
// send the "ID" command, this means login was successful (could just send "OK" if you like
                                SendStringWithLogging(AContext, 'ID ' + (AContext.Data as TClientSpecificData).ID);

                            end;
                        end
                        else
                          SendStringWithLogging(AContext, 'ERROR Not logged in. Can not use "' + InCmd +'" command');

                    end;
                    csLoggedIn:
                    begin

    // we are not currently in a command sequesnce, so do what you like
                        if InCmd = 'JUMP' then
                          SendStringWithLogging(AContext, 'Whee!')
                        else if InCmd = 'TIMER' then
                        begin
sleep(5000); // wait for 5 seconds, then send a TIMER_STOPPED
//    sleep(1000 * 60 * 30); // test - sleep for 30 minutes
                            SendStringWithLogging(AContext, 'TIMER_STOPPED');
                        end
                        else if InCmd = 'COUNTDOWN' then
                        begin
                            for i:= 10 downto 1 do
                            begin
                                SendStringWithLogging(AContext, 'COUNTDOWN: ' + inttostr(i));
            //            acontext.Connection.Socket.WriteLn('countdown: ' + inttostr(i));
                                sleep(1000);
                            end;
                            SendStringWithLogging(AContext, 'COUNTDOWN_END')
                        end
                        else if InCmd = 'FILE' then
                        begin
                            Filename := ReceiveStringWithLogging(AContext);
                            S := ReceiveStringWithLogging(AContext); // filesize
                            FileSize := StrToInt(S);
                            ForceDirectories(ExtractFilePath(Paramstr(0)) + 'In');
                            AStream := TIDStreamVCL.Create(
                            TFileStream.Create(ExtractFilePath(Paramstr(0)) + 'In\' + Filename, fmCreate), True);
                            try
                                ThreadlogMessage(lmtInformation, ldNone, (AContext.Data as TClientSpecificData).ID + ' - Receiving file "' + Filename + '" ' + IntToStr(Filesize) + ' bytes');
                                AContext.Connection.IOHandler.ReadStream(AStream, Filesize, False);
                                ThreadLogMessage(lmtInformation, ldNone, (AContext.Data as TClientSpecificData).ID + ' - Received file "' + Filename + '"');
                            finally
                                FreeAndNil(AStream);
                            end;
                            SendStringWithLogging(AContext, 'FILE_OK');
                        end
                        else if InCmd = 'QUIT' then
                          aContext.Connection.Disconnect
                        else
                          SendStringWithLogging(AContext, 'ERROR Unknown command "' + InCmd +'"');
                    end; // of ClientStage = csLoggedIn
                end; // of case notlogged in, or logged in
            end; // of while doing commands loop
        except
            on e: EIdSocketError do
            begin
                if pos('10053', E.Message) > 0 then
                  ThreadLogMessage(lmtInformation, ldNone, 'Client disconnected')
                else
                  ThreadLogMessage(lmtError, ldNone, E.Message);
            end;
            on e: exception do
            begin
                if pos('CONNECTION CLOSED GRACEFULLY', uppercase(e.Message)) > 0 then
                  ThreadLogMessage(lmtInformation, ldNone, 'Client disconnected gracefully')
                else
                  ThreadLogMessage(lmtError, ldNone, E.Message);
            end;
        end;
    end;
procedure TfServerMain.ThreadLogMessage(LogMessageType: TLogMessageType; LogDirection: TLogDirection; S: string);
    var
        i: Integer;
        PS: PString;
    begin
        New(PS);
        PS^ := S;
        i := 0;
        if LogMessageType = lmtInformation then i := tlmtInformation;
        if LogMessageType = lmtWarning then i := tlmtWarning;
        if LogMessageType = lmtError then i := tlmtError;
       
        if LogDirection = ldNone then i := i + tldNone;
        if LogDirection = ldIn then i := i + tldIn;
        if LogDirection = ldOut then i := i + tldOut;
        PostMessage(fServerMain.Handle, WM_LogMessage, Integer(PS), i);
    end;

end.


//******************************** SERVER FORM **************

object fServerMain: TfServerMain
  Left = 274
  Top = 107
  Width = 569
  Height = 411
  Caption = 'Server - }-Loki=-{ lokiwashere@yahoo.co.nz'
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'MS Sans Serif'
  Font.Style = []
  OldCreateOrder = False
  PixelsPerInch = 96
  TextHeight = 13
  object ListBox1: TListBox
    Left = 0
    Top = 49
    Width = 561
    Height = 335
    Align = alClient
    Font.Charset = DEFAULT_CHARSET
    Font.Color = clWindowText
    Font.Height = -11
    Font.Name = 'Courier New'
    Font.Style = []
    ItemHeight = 14
    ParentFont = False
    TabOrder = 0
  end
  object gbSettings: TGroupBox
    Left = 0
    Top = 0
    Width = 561
    Height = 49
    Align = alTop
    Caption = 'Server'
    TabOrder = 1
    object Label1: TLabel
      Left = 16
      Top = 20
      Width = 19
      Height = 13
      Caption = 'Port'
    end
    object ePort: TEdit
      Left = 40
      Top = 16
      Width = 41
      Height = 21
      TabOrder = 0
      Text = '2000'
    end
    object bListen: TButton
      Left = 88
      Top = 16
      Width = 75
      Height = 25
      Caption = 'Listen'
      TabOrder = 1
      OnClick = bListenClick
    end
    object bOffline: TButton
      Left = 168
      Top = 16
      Width = 75
      Height = 25
      Caption = 'Offline'
      TabOrder = 2
      OnClick = bOfflineClick
    end
  end
  object IdTCPServer1: TIdTCPServer
    Bindings = <>
    DefaultPort = 0
    OnAfterBind = IdTCPServer1AfterBind
    OnBeforeListenerRun = IdTCPServer1BeforeListenerRun
    OnConnect = IdTCPServer1Connect
    OnExecute = IdTCPServer1Execute
    OnDisconnect = IdTCPServer1Disconnect
    Left = 112
    Top = 56
  end
end




//************************ CLIENT UNIT **************************


unit clientmain;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, IdBaseComponent, IdComponent, IdTCPConnection, IdTCPClient,
  IDStreamVCL, ComCtrls;

type TLogMessageType = (lmtInformation, lmtWarning, lmtError);
type TLogDirection = (ldNone, ldIn, ldOut);

type
    TIndyInaThread = class(TThread)
    public
        TCPClientInsideThread: TIdTCPClient;
        ID: string; // unique ID given to us by the server
        LogMessageType: TLogMessageType;
        LogDirection: TLogDirection;
        MessageText: string;

// next 3 properties are for file sending
        ShowProgress: boolean; // flag to synchronize progress data for file sending
        ProgressMax: integer;
        CurrentProgress: integer;
        constructor Create(Host: string; Port: integer; OnCompleteEvent: TNotifyEvent);
        procedure SendStringWithLogging(S: string);
        function ReceiveStringWithLogging: string;
        procedure ThreadLogMessage(LogMessageType_: TLogMessageType; LogDirection_: TLogDirection; S: string);

        procedure TCPClientInsideThreadWorkBegin(ASender: TObject; AWorkMode: TWorkMode; AWorkCountMax: Integer);
        procedure TCPClientInsideThreadWorkEnd(ASender: TObject; AWorkMode: TWorkMode);
        procedure TCPClientInsideThreadWork(ASender: TObject; AWorkMode: TWorkMode; AWorkCount: Integer);

        procedure Execute; override;
//synchronized methods
        procedure SyncLogMessage;
        procedure SyncStartProgress;
        procedure SyncProgress;
        procedure SyncStopProgress;

    end;


type
  TfClientMain = class(TForm)
    gbSettings: TGroupBox;
    Label1: TLabel;
    eAddress: TEdit;
    bConnect: TButton;
    ListBox1: TListBox;
    Label2: TLabel;
    ePort: TEdit;
    ProgressBar1: TProgressBar;
    procedure bConnectClick(Sender: TObject);
    procedure bDisconnectClick(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
    IndyInAThread: TIndyInAThread;
    procedure LogMessage(const LogMessageType: TLogMessageType; const LogDirection: TLogDirection; S: string);
    procedure TCPThreadComplete(Sender: TObject);
  end;

var
  fClientMain: TfClientMain;

IMPLEMENTATION

{$R *.DFM}

procedure TfClientMain.LogMessage(const LogMessageType: TLogMessageType;
    const LogDirection: TLogDirection; S: string);
    var
        FullMsg: string;
    begin
        FullMSg := '';
        case LogMessageType of
            lmtInformation: FullMsg := '  ';
            lmtWarning: FullMsg := '? ';
            lmtError: FullMsg := '!  ';
        end;
       
        case LogDirection of
            ldNone: FullMsg := FullMsg + '   ';
            ldIn: FullMsg := FullMsg + '<- ';
            ldOut: FullMsg := FullMsg + '-> ';
        end;
        FullMsg := FullMsg + FormatDateTime('hh":"nn":"ss', Now) + ' ' + S;
        Listbox1.Items.Add(FullMsg);
        while Listbox1.Items.Count > 1000 do Listbox1.Items.Delete(0);
    end;

procedure TfClientMain.bConnectClick(Sender: TObject);
    begin
        try
            bConnect.Enabled := False;
            IndyInAThread := TIndyInaThread.Create(eAddress.Text, StrToIntDef(ePort.Text, 2000), TCPThreadComplete);

        except
            on e: exception do
              LogMessage(lmtError, ldNone, E.Message);
        end;
    end;

procedure TfClientMain.bDisconnectClick(Sender: TObject);
    begin
//        IdTCPClient1.Disconnect;
    end;


{ TIndyInaThread }

constructor TIndyInaThread.Create(Host: string; Port: integer; OnCompleteEvent: TNotifyEvent);
    begin
        inherited Create(True);
        OnTerminate := OnCompleteEvent;
        TCPClientInsideThread := TIdTCPClient.Create(nil);
        TCPClientInsideThread.ConnectTimeout := 0;
        TCPClientInsideThread.ReadTimeout := 0; // this means we never disconnect while waiting to read something
        TCPClientInsideThread.Host := Host;
        TCPClientInsideThread.Port := Port;
        TCPClientInsideThread.OnWorkBegin := TCPClientInsideThreadWorkBegin;
        TCPClientInsideThread.OnWorkEnd := TCPClientInsideThreadWorkEnd;
        TCPClientInsideThread.OnWork := TCPClientInsideThreadWork;
        resume;
    end;

procedure TIndyInaThread.Execute;
    var
        s: string;
        filename: string;
        AStream: TIDStreamVCL;
    begin
        try
            try
                TCPClientInsideThread.Connect;
                ThreadLogMessage(lmtInformation, ldNone, 'Connected to ' + TCPClientInsideThread.Host + ':' + IntToStr(TCPClientInsideThread.Port) );
                SendStringWithLogging('LOGIN TestUser password'); // login with dummy details
                S := ReceiveStringWithLogging;
                if pos('ERROR', S) = 1 then
                  ThreadLogMessage(lmtWarning, ldNone, 'Login failed:' + S)
                else
                begin // login successful
// Store unique ID
                    if pos('ID ', s) <> 1 then
                      ThreadLogMessage(lmtWarning, ldNone, 'Expected "ID" command from server')
                    else
                    begin
                        ID := copy(S, 4, maxint);
// send some test commands
// send JUMP command and get 1 line respomse from server
                        SendStringWithLogging('JUMP'); //
                        S := ReceiveStringWithLogging;
// send TIMER command and wait for a TIMER_STOPPED respomse from server
                        SendStringWithLogging('TIMER');
                        S := ReceiveStringWithLogging;
// send TIMER command and wait for a TIMER_STOPPED respomse from server
                        SendStringWithLogging('COUNTDOWN');
                        repeat
                            S := ReceiveStringWithLogging;
                        until S = 'COUNTDOWN_END';
                       
                       
// Send a FILE (this .exe in fact for a test)
                        filename := Paramstr(0); // the filename of this exe
                        AStream := TIDStreamVCL.Create(TFileStream.Create(filename, fmOpenRead + fmShareDenyNone), True);
                        try
                            SendStringWithLogging('FILE'); //send command "FILE"
                            SendStringWithLogging(ExtractFilename(filename)); // send file name
                            SendStringWithLogging(IntToStr(AStream.VCLStream.Size)); //send file size
                            ThreadLogMessage(lmtInformation, ldNone, 'Sending file "' + ExtractFilename(filename) + '"');
                            ShowProgress := True;
                            TCPClientInsideThread.IOHandler.Write(AStream);
                            S := ReceiveStringWithLogging;
                            if S = 'FILE_OK' then
                              ThreadLogMessage(lmtInformation, ldNone, 'Sent file "' + ExtractFilename(filename) + '"')
                            else
                              ThreadLogMessage(lmtWarning, ldNone, 'Failed to send file "' + ExtractFilename(filename) + '": ' + S)
                        finally
                            FreeAndNil(AStream);
                            ShowProgress := False;
                        end;
                       
                       
//                    SendStringWithLogging('QUIT');
                       
                       
                    end;
                end;
            except
                on e: exception do
                  ThreadLogMessage(lmtError, ldNone, E.Message);
            end;
        finally
            TCPClientInsideThread.Disconnect;
            ThreadLogMessage(lmtInformation, ldNone, 'Disconnected');
            TCPClientInsideThread.Free;
        end;
    end;

procedure TIndyInaThread.SyncLogMessage;
    begin
        if not Terminated then
          fClientMain.LogMessage(LogMessageType, LogDirection, MessageText);
    end;

procedure TIndyInaThread.SendStringWithLogging(S: string);
    begin
        TCPClientInsideThread.IOHandler.WriteLn(S);
        ThreadLogMessage(lmtInformation, ldOut, S);
    end;

function TIndyInaThread.ReceiveStringWithLogging: string;
    begin
        result := TCPClientInsideThread.IOHandler.ReadLn;
        ThreadLogMessage(lmtInformation, ldIn, result);
    end;

procedure TIndyInaThread.TCPClientInsideThreadWorkBegin(ASender: TObject; AWorkMode: TWorkMode; AWorkCountMax: Integer);
    begin
        if ShowProgress then
        begin
            ProgressMax := AWorkCountMax;
            CurrentProgress := 0;
            Synchronize(SyncStartProgress);
        end;
    end;

procedure TIndyInaThread.TCPClientInsideThreadWork(ASender: TObject; AWorkMode: TWorkMode; AWorkCount: Integer);
    begin
        if ShowProgress then
        begin
            CurrentProgress := CurrentProgress + AWorkCount;
            Synchronize(SyncProgress);
        end;
       
    end;

procedure TIndyInaThread.TCPClientInsideThreadWorkEnd(ASender: TObject;
AWorkMode: TWorkMode);
    begin
        if ShowProgress then
        begin
            CurrentProgress := 0;
            Synchronize(SyncStopProgress);
        end;
    end;

procedure TIndyInaThread.ThreadLogMessage(LogMessageType_: TLogMessageType; LogDirection_: TLogDirection; S: string);
    begin
        LogMessageType := LogMessageType_;
        LogDirection := LogDirection_;
        MessageText := S;
        Synchronize(SyncLogMessage);
    end;

procedure TIndyInaThread.SyncStartProgress;
    begin
        fClientMain.ProgressBar1.Position := 0;
        fClientMain.ProgressBar1.Max := ProgressMax;
        fClientMain.ProgressBar1.Visible := True;
    end;

procedure TIndyInaThread.SyncProgress;
    begin
        fClientMain.ProgressBar1.Position := CurrentProgress;
    end;

procedure TIndyInaThread.SyncStopProgress;
    begin
        fClientMain.ProgressBar1.Position := 0;
        fClientMain.ProgressBar1.Visible := False;
    end;

procedure TfClientMain.TCPThreadComplete(Sender: TObject);
    begin
        bConnect.Enabled := True;
    end;

end.
//******************************** CLIENT FORM **************


object fClientMain: TfClientMain
  Left = 328
  Top = 183
  Width = 618
  Height = 453
  Caption = 'Client }-=Loki=-{ lokiwashere@yahoo.co.nz'
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'MS Sans Serif'
  Font.Style = []
  OldCreateOrder = False
  PixelsPerInch = 96
  TextHeight = 13
  object gbSettings: TGroupBox
    Left = 0
    Top = 0
    Width = 610
    Height = 73
    Align = alTop
    Caption = 'Client'
    TabOrder = 0
    object Label1: TLabel
      Left = 16
      Top = 20
      Width = 38
      Height = 13
      Caption = 'Address'
    end
    object Label2: TLabel
      Left = 160
      Top = 20
      Width = 19
      Height = 13
      Caption = 'Port'
    end
    object eAddress: TEdit
      Left = 56
      Top = 16
      Width = 89
      Height = 21
      TabOrder = 0
      Text = 'localhost'
    end
    object bConnect: TButton
      Left = 256
      Top = 16
      Width = 75
      Height = 25
      Caption = 'bConnect'
      TabOrder = 2
      OnClick = bConnectClick
    end
    object ePort: TEdit
      Left = 184
      Top = 16
      Width = 41
      Height = 21
      TabOrder = 1
      Text = '2000'
    end
    object ProgressBar1: TProgressBar
      Left = 8
      Top = 48
      Width = 281
      Height = 16
      Min = 0
      Max = 100
      TabOrder = 3
      Visible = False
    end
  end
  object ListBox1: TListBox
    Left = 0
    Top = 73
    Width = 610
    Height = 353
    Align = alClient
    Font.Charset = DEFAULT_CHARSET
    Font.Color = clWindowText
    Font.Height = -11
    Font.Name = 'Courier New'
    Font.Style = []
    ItemHeight = 14
    ParentFont = False
    TabOrder = 1
  end
end
btw, i tested by having the server take 30 minutes, and all was fine.
basically you set the TCPClient.ReadTimeout to zero (infinite) so it does not time out.
I would still suggest you use TCP for this, UDP is not as reliable, and you can in fact get packets in totally different orders, so you'd need some sort of packet sequencing, which defeats the purpose. it is marginally faster,but since you're spending a lot of time doing nothing, there's no reason to be concerened about speed.
Avatar of klompen
klompen

ASKER

Thanks TheRealLoki,

I will print, learn and test your demo tonight. I am interested in Indy because I am quite familiar with it :)

This is not multi-threaded right ? I meant, each client connection is handled in its own thread or not ?

Indy uses threading for the server, so yes, it is mutithreaded.
the server can take as many clients as you like
To test, just start up 1 server - click listen, and 2 or more clients, and hit connect
all the "threading" for each client is performed in teh servers execute method
It is easy to serialise part of it if you like, i.e. so that you do not porocess more than 1 "big job" at a time, simply by telling extra clients that you are "busy, try again later" e.g. return "BUSY" instead of "PLEASE_WAIT" or something like that
Avatar of klompen

ASKER

Thanks TheRealLoki,

I cant test your code because my current Indy version is not the same with yours. It gave me error "OnAfterBind" property does not exists.

Which version do you use ? I think, I have to update my Indy.

Btw, I have once more request (and I will increase the point by 100 for this).

Actually, in the SERVER part, I would like to execute another application using CreateProcess API, in its own THREAD.

1. SERVER waits
2. CLIENT connected
3. SERVER creates a new THREAD for this client and CALL "APP.EXE"
4. After the SERVER finished, inform the CLIENT and KILL that THREAD

I have the function of the CreateProcess, but I dont know where should I put the created THREAD in this case.

And I need a way to test the client connection, somekind of PING :

.. SERVER send PING to CLIENT
.. CLIENT response with "PING REPLY"
.. if CLIENT does not response then close connection and KILL the THREAD (thread that is used to call "APP.EXE").

Could you please help me with this part ?
Ah yes TheReadLoki master of sockets :P by the way Loki you didnt get back to my question...

Peace Scay7
Indy 10 can be downloaded from http://www.indyproject.org/Sockets/index.en.iwp
but do _not_ download it unless you wish to rewrite _all_ of your existing Indy projects
There have been some big changes
I will try to set up an indy 9 lab today, and add "ping" and the createorcess you entioned, shouldn't be too dificult
Here's pretty much how you'd do it though

-Client app-
var: BeforePing, AfterPing: Int64;

BeforePing := Now;
TCPClientInsideThread.IOHandler.WriteLn('PING');
S := TCPClientInsideThread.IOHandler.ReadLn; // get "PONG" response
AfterPing := Now;
ThreadLogMessage(lmtInformation, ldNone, 'Ping Time = ' + IntToStr(AFterPing - BeforePing) + 'ms'); //the difference is the # of milliseconds the ping/pong took
With 'pinging' I find it more accurate to do several pings and take the average result.

To convert my demo to Indy 9 you will have to change a few things
Some of the events used different parameters, and the OnAfterBind event did not exist, but you dont need that one anyway.
drop a TIdTCPServer and TIdTCPClient on a blank form and double click the events to see what the procedures should look like in Indy 9, then you can replace the events in my demo
All references to "IOHandler.WriteLn" were just "WriteLn"
All references to "IOHandler.Write(AStream) were "WriteStream(AStream)
"AStream := TIDStreamVCL.Create(TFileStream.Create(" was "AStream := TFileStream.Create("
You can try to do this by yourself if you like, but I'll make an Indy 9 lab here and do the changes you mentioned if I have time

-scay7 once you closed your question, EE would no longer let me write replies. you can use my email (included in the source code above to continue on your project. If you come across a general problem that the EE community might benefit from (i.e not just a typo in my code) It might be wise to start a new question in case it helps others. But if it's just a few changes to your project, drop me a line
Avatar of klompen

ASKER

TheRealLoki,

Dont change it to Indy 9 because I will update my Indy to version 10. It is better to stay this way I think, and basically all my Indy projects are testing and learning process.

Thanks for the modification of the PING and CreateProcess, I will wait for it.


ASKER CERTIFIED SOLUTION
Avatar of TheRealLoki
TheRealLoki
Flag of New Zealand image

Link to home
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Start Free Trial
Avatar of klompen

ASKER

Thanks TheRealLoki,

The new thread for CreateProcess is mandatory because the application that will be started requires to run directX driver. It was created using VC++ and the developer suggested to run it in a separated thread. I think I need to add something like this :

TMyThread = class(TThread)
   protected
     procedure Execute; override;
   public
     Constructor Create;
end;

TClientSpecificData = class(TObject)
        public
            ClientStage: TClientStage;
            ID: string; // just the unique id we create for each connection
            Username: string;
           
            ProcessThread: TMyThread;

            Constructor CreateWithSettings(ID_: string);
            Destructor Destroy; override;
        end;

constructor TClientSpecificData.CreateWithSettings(ID_: string);
    begin
        Inherited Create;
        ID := ID_;
        ClientStage := csNone;
        Username := '';

        ProcessThread := TMyThread.Create;
    end;

destructor TClientSpecificData.Destroy;
    begin
//
        inherited;
        ProcessThread.Destroy
    end;

But again, I am not sure with this. Because you said that Indy is multithreaded, the CreateProcess should already be executed in its own thread, right ??? Or if you have time, please if you could modify the server code to move the CreateProcess in its own thread :)

Btw, from your expert opinion, do you think that Indy 9 is still realiable for production ??? Or should I go with Indy 10 ...  
each client is already in it's own thread (IdTCPServer1Execute(AThread: TIdPeerThread); )
so I'm pretty sure you wont need to make another one,
if you do it's easy enough
just put it in place of the createprocess lines, and do the waitforsingle object typr thing on the thread instead of the createprocess
and terminate the thread if the client fails to reply to the ping

I have used both indy 9 and indy 10 extensively.
While indy 10 is "the latest and greatest" it still has bugs. I found indy 9 more stable (tried and tested) so there's no _need_ to upgrade imo
Avatar of klompen

ASKER

TheRealLoki, thanks for your help.

It is difficult to choose then. I agree that Indy 9 is more stable, but it is not supported anymore. What happen if there will be a future bug?

I have experience with their other product, Intraweb. I tought it is a good product, but I cant stand with the bugs :( If they upgrade to a new version, I have to change my code (not backward compatible). There is not "stable" version.

If I have to go with Indy 9, then I wasted my 40 euro because I just purchased a support option for Indy 10 :)
To change my code above to Indy 10, simply put those other units into the "uses clause"
IDContext, IDThread, IdIOHandlerSocket, IDStack, IDException, IdStreamVCL;

and change each instance of
"ReadLn" to "IOHandler.ReadLn"
"WriteLn" to "IOHandler.WriteLn"
and the other tricky bit is the Streaming (but you wil only need this if you want to send files or other streams)
change
var
 AStream: TFileStream;
to
var
 AStream: TIDStreamVCL;


AStream := TFileStream.Create(filename, fmOpenRead + fmShareDenyNone);
to
AStream := TIDStreamVCL.Create(TFileStream.Create(filename, fmOpenRead + fmShareDenyNone), True);

and anywhere else it says
AStream.Size
to
AStream.VCLStream.Size

Those are the main changes from typical indy 9 stuff to indy 10
I don't yet understand the TIdYarn stuff, or the TIdPeerThread thoroughly. but I have enough knowledge to make things work :-/
Avatar of klompen

ASKER

TheRealLoki,

Thanks for all your helps, it is valuable and very good stuffs that I learned.

I decided to stick with Indy 9 because it is proven to be very stable (asked the developer and from most information that I gather).