[Okta Webinar] Learn how to a build a cloud-first strategyRegister Now

x
?
Solved

Simple client/server application

Posted on 2006-05-08
15
Medium Priority
?
1,522 Views
Last Modified: 2012-05-05
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.
0
Comment
Question by:klompen
  • 7
  • 6
  • 2
15 Comments
 
LVL 5

Expert Comment

by:Scay7
ID: 16634883
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
0
 
LVL 17

Expert Comment

by:TheRealLoki
ID: 16635944
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
0
 
LVL 17

Expert Comment

by:TheRealLoki
ID: 16635980
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.
0
What does it mean to be "Always On"?

Is your cloud always on? With an Always On cloud you won't have to worry about downtime for maintenance or software application code updates, ensuring that your bottom line isn't affected.

 

Author Comment

by:klompen
ID: 16636620
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 ?

0
 
LVL 17

Expert Comment

by:TheRealLoki
ID: 16643525
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
0
 

Author Comment

by:klompen
ID: 16645520
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 ?
0
 
LVL 5

Expert Comment

by:Scay7
ID: 16651142
Ah yes TheReadLoki master of sockets :P by the way Loki you didnt get back to my question...

Peace Scay7
0
 
LVL 17

Expert Comment

by:TheRealLoki
ID: 16652136
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
0
 

Author Comment

by:klompen
ID: 16653453
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.


0
 
LVL 17

Accepted Solution

by:
TheRealLoki earned 2000 total points
ID: 16653699
Too late :-)
I already had an indy 9 setup, so I have made the changes.
It does the "process" (currently just opens a notepad.exe)
and continuously "pings" the client every 10 seconds.
if the client does not respond in 10 seconds, it terminates the process (notepad.exe)
If you manually close the notepad.exe (i.e. the "process ends"), then the server sends a PROCESS_DONE message
I didn't see a need to start a new thread for this, but you can see how it works
If you do need to use a separate thread, i'd put it in the TClientSpecificData object I create
(which is assigned to TIdPeerThread.Data so it can be accessed al over the place)
I've done some rudimentary testing, but it looks ok so far

***************************** SERVER UNIT **********
unit servermain;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs,
  IdBaseComponent, IdComponent, IdTCPServer, ComCtrls, StdCtrls, FileCtrl,
  IDStack, IDException;

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 bListenClick(Sender: TObject);
    procedure bOfflineClick(Sender: TObject);
    procedure IdTCPServer1Connect(AThread: TIdPeerThread);
    procedure IdTCPServer1Disconnect(AThread: TIdPeerThread);
    procedure IdTCPServer1Execute(AThread: TIdPeerThread);
  private
    { Private declarations }
    procedure CMD_LOGIN(AThread: TIdPeerThread; InCmd: string);
    procedure CMD_TIMER(AThread: TIdPeerThread; InCmd: string);
    procedure CMD_COUNTDOWN(AThread: TIdPeerThread; InCmd: string);
    procedure CMD_FILE(AThread: TIdPeerThread);
    procedure CMD_PROCESS(AThread: TIdPeerThread; InCmd: string);
  public
    { Public declarations }
    procedure LogMessage(LogMessageType: TLogMessageType; LogDirection: TLogDirection; S: string);
    procedure SendStringWithLogging(AThread: TIdPeerThread; S: string);
    function ReceiveStringWithLogging(AThread: TIdPeerThread): 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(AThread: TIdPeerThread; S: string);
    begin
        AThread.Connection.WriteLn(S);
        ThreadLogMessage(lmtInformation, ldOut, (AThread.Data as TClientSpecificData).ID + ' - ' + S);
    end;

function TfServerMain.ReceiveStringWithLogging(AThread: TIdPeerThread): string;
    begin
        result := AThread.Connection.ReadLn;
        ThreadLogMessage(lmtInformation, ldIn, (AThread.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.bListenClick(Sender: TObject);
    begin
        IdTCPServer1.DefaultPort := StrToIntDef(ePort.Text, 2000);
        IdTCPServer1.Active := True;
        LogMessage(lmtInformation, ldNone, 'BOUND TO PORT ' + IntToStr(IdTCPServer1.DefaultPort));
        LogMessage(lmtInformation, ldNone, 'LISTENING');
    end;

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



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

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

procedure TfServerMain.IdTCPServer1Execute(AThread: TIdPeerThread);
    var
        i: integer;
        S, S2: string;
        InCmd: string;
    begin
// send the ID command and the user's unique "ID"
        try
    // Main Command Loop
            while AThread.Connection.Connected do
            begin
// check if user is logged in
                InCmd := ReceiveStringWithLogging(AThread);
                case (AThread.Data as TClientSpecificData).ClientStage of
                    csNone:
                    begin //LOGIN username password
                        if (pos('LOGIN', uppercase(InCmd)) = 1) then CMD_LOGIN(AThread, copy(InCmd, pos(' ', InCmd) + 1, maxint))
                        else SendStringWithLogging(AThread, 'ERROR Not logged in. Can not use "' + InCmd +'" command');
                    end;
                    csLoggedIn:
                    begin
                        if InCmd = 'PING' then  SendStringWithLogging(AThread, 'PONG') //Note: we do not show logging for this, becaue we want it as fast as possible
                        else if InCmd = 'JUMP' then SendStringWithLogging(AThread, 'Whee!')
                        else if (pos('TIMER ', InCmd) = 1) then CMD_TIMER(AThread, copy(InCmd, pos(' ', InCmd) + 1, maxint))
                        else if (pos('COUNTDOWN ', InCmd) = 1) then CMD_COUNTDOWN(AThread, copy(InCmd, pos(' ', InCmd) + 1, maxint))
                        else if InCmd = 'FILE' then CMD_FILE(AThread)
                        else if (pos('PROCESS ', InCmd) = 1) then CMD_PROCESS(AThread, copy(InCmd, pos(' ', InCmd) + 1, maxint))
                        else if InCmd = 'QUIT' then AThread.Connection.Disconnect
                        else SendStringWithLogging(AThread, '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;

// HANDLE EACH COMMAND IN ITS' OWN PROCEDURE (JUST TO BE TIDY)

//LOGIN USERNAME PASSWORD
procedure TfServerMain.CMD_LOGIN(AThread: TIdPeerThread; InCmd: string);
    var
        s, s2: string;
        i: integer;
    begin
          delete(InCmd, 1, length('LOGIN ')); // remove the LOGIN part
          i := pos(' ', InCmd);
          if i = 0 then
            SendStringWithLogging(AThread, '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
              (AThread.Data as TClientSpecificData).Username := S;
              (AThread.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(AThread, 'ID ' + (AThread.Data as TClientSpecificData).ID);

          end;
    end;

//TIMER SECONDS
procedure TfServerMain.CMD_TIMER(AThread: TIdPeerThread; InCmd: string);
    begin
        sleep(StrToIntDef(InCmd, 5) * 1000); //wait for x seconds, then send a TIMER_STOPPED
        SendStringWithLogging(AThread, 'TIMER_STOPPED');
    end;

//COUNTDOWN SECONDS
procedure TfServerMain.CMD_COUNTDOWN(AThread: TIdPeerThread; InCmd: string);
    var
        i: integer;
    begin
        for i:= StrToIntDef(InCmd, 5) downto 1 do
        begin
            SendStringWithLogging(AThread, 'COUNTDOWN: ' + inttostr(i));
//            AThread.Connection.Socket.WriteLn('countdown: ' + inttostr(i));
            sleep(1000);
        end;
        SendStringWithLogging(AThread, 'COUNTDOWN_END')
    end;

//FILE
//followed by separate FILENAME, then FILESIZE, then the actual STREAM
procedure TfServerMain.CMD_FILE(AThread: TIdPeerThread);
    var
        AStream: TFileStream;
        S: string;
        FileSize: Int64;
        Filename: string;
    begin
        Filename := ReceiveStringWithLogging(AThread);
        S := ReceiveStringWithLogging(AThread); // filesize
        FileSize := StrToInt(S);
        ForceDirectories(ExtractFilePath(Paramstr(0)) + 'In');
        AStream := TFileStream.Create(ExtractFilePath(Paramstr(0)) + 'In\' + Filename, fmCreate);
        try
            ThreadlogMessage(lmtInformation, ldNone, (AThread.Data as TClientSpecificData).ID + ' - Receiving file "' + Filename + '" ' + IntToStr(Filesize) + ' bytes');
            AThread.Connection.ReadStream(AStream, Filesize, False);
            ThreadLogMessage(lmtInformation, ldNone, (AThread.Data as TClientSpecificData).ID + ' - Received file "' + Filename + '"');
        finally
            FreeAndNil(AStream);
        end;
        SendStringWithLogging(AThread, 'FILE_OK');
    end;

//PROCESS JOB
procedure TfServerMain.CMD_PROCESS(AThread: TIdPeerThread; InCmd: string);
    const
        PingInterval = 10; // ping every "x" seconds
        PingTimeout = 10; // if no response to "ping" in "x" seconds, then fail
    var
        WaitResult : integer;
        StartupInfo: TStartupInfo;
        ProcessInfo: TProcessInformation;
        iResult : integer;
        Filename: string;
        ClientResponding: Boolean;
        Counter: integer;
        S: string;
        BeforePing, AfterPing: Int64;
    begin
        try
            AThread.Connection.ReadTimeout := PingTimeout * 1000;
            if (uppercase(InCmd) = 'TEST') then
            begin
              if FileExists('C:\Windows\Notepad.exe') then Filename := 'C:\Windows\Notepad.exe'
              else if FileExists('C:\WinNT\Notepad.exe') then Filename := 'C:\WinNT\Notepad.exe';
            end
            else
              Filename := '';
            ClientResponding := True; // default
            Counter := 0;
// for this example we will just run notepad
            if Filename <> '' then
            try
                FillChar(StartupInfo, SizeOf(TStartupInfo), 0);
                with StartupInfo do
                begin
                    cb := SizeOf(TStartupInfo);
                    dwFlags := STARTF_USESHOWWINDOW or STARTF_FORCEONFEEDBACK;
(* you could pass sw_show or sw_hide as parameter
sw_hide would make more sense if you do not wish to see anything on the screen
but not a good idea if the application doe not close itself*)
                    wShowWindow := SW_SHOW; //visibility;
                end;
                if CreateProcess(nil,PChar(Filename), nil, nil, False,
                NORMAL_PRIORITY_CLASS, nil, nil,
                StartupInfo, ProcessInfo) then
                repeat
// we are going to check the process is still running
// however, every 10 seconds, we will send a "PING" to the client
// if we do not receive a "PONG" response, we will terminate the process
                    WaitResult := WaitForSingleObject(ProcessInfo.hProcess, 1000); //Wait for 1 seconds at a time.
                    inc(Counter);
                    if Counter >= PingInterval then
                    begin
                        Counter := 0;
                        try
                            BeforePing := GetTickCount;
                            SendStringWithLogging(AThread, 'PING');
                            S := AThread.Connection.ReadLn; // readtimeout is set above (10 seconds)
                            AfterPing := GetTickCount;
                            ThreadLogMessage(lmtInformation, ldIn, (AThread.Data as TClientSpecificData).ID + ' - ' + S + ' (' + IntToStr(AfterPing-BeforePing) + 'ms)');
                        except
                            on e: exception do
                            begin // assume any error is a read timeout
                                ClientResponding := False;
                                ThreadLogMessage(lmtInformation, ldIn, (AThread.Data as TClientSpecificData).ID + ' - Ping Failed: ' + E.Message);
//Terminate the process
                                iresult := Integer(TerminateProcess(ProcessInfo.hProcess, 0));

                            end;
                        end;
                    end; //of check ping
                until ( (WaitResult <> WAIT_TIMEOUT) or (not ClientResponding) )
                else
                iresult := GetLastError; //eror occurs during CreateProcess see help for details }
                if ProcessInfo.hProcess <> 0 then
                  CloseHandle(ProcessInfo.hProcess);
                if ProcessInfo.hThread <> 0 then
                  CloseHandle(ProcessInfo.hThread);

            except
                on e: exception do
                begin
                    ThreadLogMessage(lmtInformation, ldNone, (AThread.Data as TClientSpecificData).ID + 'Process error: ' + E.Message);
                end;
            end;
        finally
            if ClientResponding then
            begin
                AThread.Connection.ReadTimeout := 0; // reset to infinite
                SendStringWithLogging(AThread, 'PROCESS_DONE');
            end;
        end;
    end;

{ TClientSpecificData }

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

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

end.

********************* SERVER FORM ***********

object fServerMain: TfServerMain
  Left = 274
  Top = 107
  Width = 569
  Height = 507
  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 = 431
    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 = <>
    CommandHandlers = <>
    DefaultPort = 0
    Greeting.NumericCode = 0
    MaxConnectionReply.NumericCode = 0
    OnConnect = IdTCPServer1Connect
    OnExecute = IdTCPServer1Execute
    OnDisconnect = IdTCPServer1Disconnect
    ReplyExceptionCode = 0
    ReplyTexts = <>
    ReplyUnknownCommand.NumericCode = 0
    Left = 112
    Top = 56
  end
end


***************************** CLIENT UNIT*****************

unit clientmain;

interface

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

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

type
    TIndyInaThread = class(TThread)
    private
        procedure TCPClientInsideThreadWork(Sender: TObject; AWorkMode: TWorkMode; const AWorkCount: Integer);
        procedure TCPClientInsideThreadWorkBegin(Sender: TObject; AWorkMode: TWorkMode; const AWorkCountMax: Integer);
        procedure TCPClientInsideThreadWorkEnd(Sender: TObject; AWorkMode: TWorkMode);
        procedure SendStringWithLogging(S: string);
        function ReceiveStringWithLogging: string;
        procedure ThreadLogMessage(LogMessageType_: TLogMessageType; LogDirection_: TLogDirection; S: string);
    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 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;
    IdTCPClient1: TIdTCPClient;
    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.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: TFileStream;
        BeforePing, AfterPing: Int64;
    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 PING command to server, this is just an example
                        BeforePing := GetTickCount;
                        SendStringWithLogging('PING');
                        S := ReceiveStringWithLogging;
                        AfterPing := GetTickCount; // the "PONG" responsse
                        ThreadLogMessage(lmtInformation, ldNone, 'Ping time is ' + IntToStr(AfterPing-BeforePing) + 'ms');
// 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 5');
                        S := ReceiveStringWithLogging;
// send TIMER command and wait for a TIMER_STOPPED respomse from server
                        SendStringWithLogging('COUNTDOWN 3');
                        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 := TFileStream.Create(filename, fmOpenRead + fmShareDenyNone);
                        try
                            SendStringWithLogging('FILE'); //send command "FILE"
                            SendStringWithLogging(ExtractFilename(filename)); // send file name
                            SendStringWithLogging(IntToStr(AStream.Size)); //send file size
                            ThreadLogMessage(lmtInformation, ldNone, 'Sending file "' + ExtractFilename(filename) + '"');
                            ShowProgress := True;
                            TCPClientInsideThread.WriteStream(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;
// send PROCESS command and wait for the process to finish on the server
// we will be receiving "PING" messages frm teh server to check if we are still alive
                        SendStringWithLogging('PROCESS TEST');
                        repeat
                            S := ReceiveStringWithLogging;
                            if S = 'PING' then SendStringWithLogging('PONG');
                        until S = 'PROCESS_DONE';

//                    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.WriteLn(S);
        ThreadLogMessage(lmtInformation, ldOut, S);
    end;

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

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

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

    end;

procedure TIndyInaThread.TCPClientInsideThreadWorkEnd(Sender: 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 = 539
  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
      TabOrder = 3
      Visible = False
    end
  end
  object ListBox1: TListBox
    Left = 0
    Top = 73
    Width = 610
    Height = 439
    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
  object IdTCPClient1: TIdTCPClient
    MaxLineAction = maException
    ReadTimeout = 0
    Port = 0
    Left = 400
    Top = 16
  end
end


0
 

Author Comment

by:klompen
ID: 16657919
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 ...  
0
 
LVL 17

Expert Comment

by:TheRealLoki
ID: 16662060
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
0
 

Author Comment

by:klompen
ID: 16666663
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 :)
0
 
LVL 17

Expert Comment

by:TheRealLoki
ID: 16673172
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 :-/
0
 

Author Comment

by:klompen
ID: 16676532
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).

0

Featured Post

Free Tool: Path Explorer

An intuitive utility to help find the CSS path to UI elements on a webpage. These paths are used frequently in a variety of front-end development and QA automation tasks.

One of a set of tools we're offering as a way of saying thank you for being a part of the community.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Hello everybody This Article will show you how to validate number with TEdit control, What's the TEdit control? TEdit is a standard Windows edit control on a form, it allows to user to write, read and copy/paste single line of text. Usua…
Introduction I have seen many questions in this Delphi topic area where queries in threads are needed or suggested. I know bumped into a similar need. This article will address some of the concepts when dealing with a multithreaded delphi database…
Exchange organizations may use the Journaling Agent of the Transport Service to archive messages going through Exchange. However, if the Transport Service is integrated with some email content management application (such as an anti-spam), the admin…
When cloud platforms entered the scene, users and companies jumped on board to take advantage of the many benefits, like the ability to work and connect with company information from various locations. What many didn't foresee was the increased risk…
Suggested Courses
Course of the Month19 days, 13 hours left to enroll

873 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question