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.
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.
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:IdTCPServer1Exe cute 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(Send er: TObject);
procedure bListenClick(Sender: TObject);
procedure bOfflineClick(Sender: TObject);
procedure IdTCPServer1BeforeListener Run(AThrea d: TIdThread);
procedure IdTCPServer1Connect(AConte xt: TIdContext);
procedure IdTCPServer1Disconnect(ACo ntext: TIdContext);
procedure IdTCPServer1Execute(AConte xt: TIdContext);
private
{ Private declarations }
public
{ Public declarations }
procedure LogMessage(LogMessageType: TLogMessageType; LogDirection: TLogDirection; S: string);
procedure SendStringWithLogging(ACon text: TIdContext; S: string);
function ReceiveStringWithLogging(A Context: TIdContext): string;
Procedure WriteLog(var Msg:TMessage);Message WM_LogMessage;
procedure ThreadLogMessage(LogMessag eType: TLogMessageType; LogDirection: TLogDirection; S: string);
end;
var
fServerMain: TfServerMain;
IMPLEMENTATION
{$R *.DFM}
procedure TfServerMain.LogMessage(Lo gMessageTy pe: 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.SendStringWit hLogging(A Context: TIdContext; S: string);
begin
AContext.Connection.IOHand ler.WriteL n(S);
ThreadLogMessage(lmtInform ation, ldOut, (AContext.Data as TClientSpecificData).ID + ' - ' + S);
end;
function TfServerMain.ReceiveString WithLoggin g(AContext : TIdContext): string;
begin
result := AContext.Connection.IOHand ler.ReadLn ;
ThreadLogMessage(lmtInform ation, 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],Lengt h(S^));
Dispose(PS);
end;
procedure TfServerMain.IdTCPServer1A fterBind(S ender: TObject);
begin
LogMessage(lmtInformation, ldNone, 'BOUND TO PORT ' + IntToStr(IdTCPServer1.Defa ultPort));
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.IdTCPServer1B eforeListe nerRun(ATh read: TIdThread);
begin
LogMessage(lmtInformation, ldNone, 'LISTENING');
end;
procedure TfServerMain.IdTCPServer1C onnect(ACo ntext: TIdContext);
var
ID_: string;
begin
ID_ := AContext.Connection.Socket .Binding.P eerIP + ':' + IntToStr(AContext.Connecti on.Socket. Binding.Pe erPort);
AContext.Data := TClientSpecificData.Create WithSettin gs(ID_);
LogMessage(lmtInformation, ldNone, ID_ + ' Connected');
end;
procedure TfServerMain.IdTCPServer1D isconnect( 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.P eerIP + ':' + IntToStr(AContext.Connecti on.Socket. Binding.Pe erPort) + ' Disconnected');
end;
{ TClientSpecificData }
constructor TClientSpecificData.Create WithSettin gs(ID_: string);
begin
Inherited Create;
ID := ID_;
ClientStage := csNone;
Username := '';
end;
destructor TClientSpecificData.Destro y;
begin
//
inherited;
end;
procedure TfServerMain.IdTCPServer1E xecute(ACo ntext: 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.Connec ted do
begin
// check if user is logged in
InCmd := ReceiveStringWithLogging(A Context);
case (AContext.Data as TClientSpecificData).Clien tStage 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(ACon text, '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).Usern ame := S;
(AContext.Data as TClientSpecificData).Clien tStage := csLoggedIn; // allows other commands
// send the "ID" command, this means login was successful (could just send "OK" if you like
SendStringWithLogging(ACon text, 'ID ' + (AContext.Data as TClientSpecificData).ID);
end;
end
else
SendStringWithLogging(ACon text, '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(ACon text, '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(ACon text, 'TIMER_STOPPED');
end
else if InCmd = 'COUNTDOWN' then
begin
for i:= 10 downto 1 do
begin
SendStringWithLogging(ACon text, 'COUNTDOWN: ' + inttostr(i));
// acontext.Connection.Socket .WriteLn(' countdown: ' + inttostr(i));
sleep(1000);
end;
SendStringWithLogging(ACon text, 'COUNTDOWN_END')
end
else if InCmd = 'FILE' then
begin
Filename := ReceiveStringWithLogging(A Context);
S := ReceiveStringWithLogging(A Context); // filesize
FileSize := StrToInt(S);
ForceDirectories(ExtractFi lePath(Par amstr(0)) + 'In');
AStream := TIDStreamVCL.Create(
TFileStream.Create(Extract FilePath(P aramstr(0) ) + 'In\' + Filename, fmCreate), True);
try
ThreadlogMessage(lmtInform ation, ldNone, (AContext.Data as TClientSpecificData).ID + ' - Receiving file "' + Filename + '" ' + IntToStr(Filesize) + ' bytes');
AContext.Connection.IOHand ler.ReadSt ream(AStre am, Filesize, False);
ThreadLogMessage(lmtInform ation, ldNone, (AContext.Data as TClientSpecificData).ID + ' - Received file "' + Filename + '"');
finally
FreeAndNil(AStream);
end;
SendStringWithLogging(ACon text, 'FILE_OK');
end
else if InCmd = 'QUIT' then
aContext.Connection.Discon nect
else
SendStringWithLogging(ACon text, '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(lmtInform ation, 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(lmtInform ation, ldNone, 'Client disconnected gracefully')
else
ThreadLogMessage(lmtError, ldNone, E.Message);
end;
end;
end;
procedure TfServerMain.ThreadLogMess age(LogMes sageType: 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.Ha ndle, 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 = IdTCPServer1BeforeListener Run
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(LogMessag eType_: TLogMessageType; LogDirection_: TLogDirection; S: string);
procedure TCPClientInsideThreadWorkB egin(ASend er: TObject; AWorkMode: TWorkMode; AWorkCountMax: Integer);
procedure TCPClientInsideThreadWorkE nd(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(co nst 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(eAdd ress.Text, StrToIntDef(ePort.Text, 2000), TCPThreadComplete);
except
on e: exception do
LogMessage(lmtError, ldNone, E.Message);
end;
end;
procedure TfClientMain.bDisconnectCl ick(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.Conn ectTimeout := 0;
TCPClientInsideThread.Read Timeout := 0; // this means we never disconnect while waiting to read something
TCPClientInsideThread.Host := Host;
TCPClientInsideThread.Port := Port;
TCPClientInsideThread.OnWo rkBegin := TCPClientInsideThreadWorkB egin;
TCPClientInsideThread.OnWo rkEnd := TCPClientInsideThreadWorkE nd;
TCPClientInsideThread.OnWo rk := TCPClientInsideThreadWork;
resume;
end;
procedure TIndyInaThread.Execute;
var
s: string;
filename: string;
AStream: TIDStreamVCL;
begin
try
try
TCPClientInsideThread.Conn ect;
ThreadLogMessage(lmtInform ation, ldNone, 'Connected to ' + TCPClientInsideThread.Host + ':' + IntToStr(TCPClientInsideTh read.Port) );
SendStringWithLogging('LOG IN TestUser password'); // login with dummy details
S := ReceiveStringWithLogging;
if pos('ERROR', S) = 1 then
ThreadLogMessage(lmtWarnin g, ldNone, 'Login failed:' + S)
else
begin // login successful
// Store unique ID
if pos('ID ', s) <> 1 then
ThreadLogMessage(lmtWarnin g, 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('JUM P'); //
S := ReceiveStringWithLogging;
// send TIMER command and wait for a TIMER_STOPPED respomse from server
SendStringWithLogging('TIM ER');
S := ReceiveStringWithLogging;
// send TIMER command and wait for a TIMER_STOPPED respomse from server
SendStringWithLogging('COU NTDOWN');
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(TFileS tream.Crea te(filenam e, fmOpenRead + fmShareDenyNone), True);
try
SendStringWithLogging('FIL E'); //send command "FILE"
SendStringWithLogging(Extr actFilenam e(filename )); // send file name
SendStringWithLogging(IntT oStr(AStre am.VCLStre am.Size)); //send file size
ThreadLogMessage(lmtInform ation, ldNone, 'Sending file "' + ExtractFilename(filename) + '"');
ShowProgress := True;
TCPClientInsideThread.IOHa ndler.Writ e(AStream) ;
S := ReceiveStringWithLogging;
if S = 'FILE_OK' then
ThreadLogMessage(lmtInform ation, ldNone, 'Sent file "' + ExtractFilename(filename) + '"')
else
ThreadLogMessage(lmtWarnin g, ldNone, 'Failed to send file "' + ExtractFilename(filename) + '": ' + S)
finally
FreeAndNil(AStream);
ShowProgress := False;
end;
// SendStringWithLogging('QUI T');
end;
end;
except
on e: exception do
ThreadLogMessage(lmtError, ldNone, E.Message);
end;
finally
TCPClientInsideThread.Disc onnect;
ThreadLogMessage(lmtInform ation, ldNone, 'Disconnected');
TCPClientInsideThread.Free ;
end;
end;
procedure TIndyInaThread.SyncLogMess age;
begin
if not Terminated then
fClientMain.LogMessage(Log MessageTyp e, LogDirection, MessageText);
end;
procedure TIndyInaThread.SendStringW ithLogging (S: string);
begin
TCPClientInsideThread.IOHa ndler.Writ eLn(S);
ThreadLogMessage(lmtInform ation, ldOut, S);
end;
function TIndyInaThread.ReceiveStri ngWithLogg ing: string;
begin
result := TCPClientInsideThread.IOHa ndler.Read Ln;
ThreadLogMessage(lmtInform ation, ldIn, result);
end;
procedure TIndyInaThread.TCPClientIn sideThread WorkBegin( ASender: TObject; AWorkMode: TWorkMode; AWorkCountMax: Integer);
begin
if ShowProgress then
begin
ProgressMax := AWorkCountMax;
CurrentProgress := 0;
Synchronize(SyncStartProgr ess);
end;
end;
procedure TIndyInaThread.TCPClientIn sideThread Work(ASend er: TObject; AWorkMode: TWorkMode; AWorkCount: Integer);
begin
if ShowProgress then
begin
CurrentProgress := CurrentProgress + AWorkCount;
Synchronize(SyncProgress);
end;
end;
procedure TIndyInaThread.TCPClientIn sideThread WorkEnd(AS ender: TObject;
AWorkMode: TWorkMode);
begin
if ShowProgress then
begin
CurrentProgress := 0;
Synchronize(SyncStopProgre ss);
end;
end;
procedure TIndyInaThread.ThreadLogMe ssage(LogM essageType _: TLogMessageType; LogDirection_: TLogDirection; S: string);
begin
LogMessageType := LogMessageType_;
LogDirection := LogDirection_;
MessageText := S;
Synchronize(SyncLogMessage );
end;
procedure TIndyInaThread.SyncStartPr ogress;
begin
fClientMain.ProgressBar1.P osition := 0;
fClientMain.ProgressBar1.M ax := ProgressMax;
fClientMain.ProgressBar1.V isible := True;
end;
procedure TIndyInaThread.SyncProgres s;
begin
fClientMain.ProgressBar1.P osition := CurrentProgress;
end;
procedure TIndyInaThread.SyncStopPro gress;
begin
fClientMain.ProgressBar1.P osition := 0;
fClientMain.ProgressBar1.V isible := False;
end;
procedure TfClientMain.TCPThreadComp lete(Sende r: 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
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.
and set the available commands and what they do in the servermain:IdTCPServer1Exe
hopefully my demo will give you enough to muddle through, and then some.
If not, give me a yell
//************************
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(Send
procedure bListenClick(Sender: TObject);
procedure bOfflineClick(Sender: TObject);
procedure IdTCPServer1BeforeListener
procedure IdTCPServer1Connect(AConte
procedure IdTCPServer1Disconnect(ACo
procedure IdTCPServer1Execute(AConte
private
{ Private declarations }
public
{ Public declarations }
procedure LogMessage(LogMessageType:
procedure SendStringWithLogging(ACon
function ReceiveStringWithLogging(A
Procedure WriteLog(var Msg:TMessage);Message WM_LogMessage;
procedure ThreadLogMessage(LogMessag
end;
var
fServerMain: TfServerMain;
IMPLEMENTATION
{$R *.DFM}
procedure TfServerMain.LogMessage(Lo
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":"
Listbox1.Items.Add(FullMsg
while Listbox1.Items.Count > 1000 do Listbox1.Items.Delete(0);
end;
procedure TfServerMain.SendStringWit
begin
AContext.Connection.IOHand
ThreadLogMessage(lmtInform
end;
function TfServerMain.ReceiveString
begin
result := AContext.Connection.IOHand
ThreadLogMessage(lmtInform
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,
// FS.WriteBuffer(S^[1],Lengt
Dispose(PS);
end;
procedure TfServerMain.IdTCPServer1A
begin
LogMessage(lmtInformation,
end;
procedure TfServerMain.bListenClick(
begin
IdTCPServer1.DefaultPort := StrToIntDef(ePort.Text, 2000);
IdTCPServer1.Active := True;
end;
procedure TfServerMain.bOfflineClick
begin
IdTCPServer1.Active := False;
LogMessage(lmtInformation,
end;
procedure TfServerMain.IdTCPServer1B
begin
LogMessage(lmtInformation,
end;
procedure TfServerMain.IdTCPServer1C
var
ID_: string;
begin
ID_ := AContext.Connection.Socket
AContext.Data := TClientSpecificData.Create
LogMessage(lmtInformation,
end;
procedure TfServerMain.IdTCPServer1D
begin
if assigned(AContext.Data) then
begin
(AContext.Data as TClientSpecificData).Free;
AContext.Data := nil;
end;
LogMessage(lmtInformation,
end;
{ TClientSpecificData }
constructor TClientSpecificData.Create
begin
Inherited Create;
ID := ID_;
ClientStage := csNone;
Username := '';
end;
destructor TClientSpecificData.Destro
begin
//
inherited;
end;
procedure TfServerMain.IdTCPServer1E
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.Connec
begin
// check if user is logged in
InCmd := ReceiveStringWithLogging(A
case (AContext.Data as TClientSpecificData).Clien
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(ACon
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).Usern
(AContext.Data as TClientSpecificData).Clien
// send the "ID" command, this means login was successful (could just send "OK" if you like
SendStringWithLogging(ACon
end;
end
else
SendStringWithLogging(ACon
end;
csLoggedIn:
begin
// we are not currently in a command sequesnce, so do what you like
if InCmd = 'JUMP' then
SendStringWithLogging(ACon
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(ACon
end
else if InCmd = 'COUNTDOWN' then
begin
for i:= 10 downto 1 do
begin
SendStringWithLogging(ACon
// acontext.Connection.Socket
sleep(1000);
end;
SendStringWithLogging(ACon
end
else if InCmd = 'FILE' then
begin
Filename := ReceiveStringWithLogging(A
S := ReceiveStringWithLogging(A
FileSize := StrToInt(S);
ForceDirectories(ExtractFi
AStream := TIDStreamVCL.Create(
TFileStream.Create(Extract
try
ThreadlogMessage(lmtInform
AContext.Connection.IOHand
ThreadLogMessage(lmtInform
finally
FreeAndNil(AStream);
end;
SendStringWithLogging(ACon
end
else if InCmd = 'QUIT' then
aContext.Connection.Discon
else
SendStringWithLogging(ACon
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(lmtInform
else
ThreadLogMessage(lmtError,
end;
on e: exception do
begin
if pos('CONNECTION CLOSED GRACEFULLY', uppercase(e.Message)) > 0 then
ThreadLogMessage(lmtInform
else
ThreadLogMessage(lmtError,
end;
end;
end;
procedure TfServerMain.ThreadLogMess
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.Ha
end;
end.
//************************
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 = IdTCPServer1BeforeListener
OnConnect = IdTCPServer1Connect
OnExecute = IdTCPServer1Execute
OnDisconnect = IdTCPServer1Disconnect
Left = 112
Top = 56
end
end
//************************
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(LogMessag
procedure TCPClientInsideThreadWorkB
procedure TCPClientInsideThreadWorkE
procedure TCPClientInsideThreadWork(
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(co
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":"
Listbox1.Items.Add(FullMsg
while Listbox1.Items.Count > 1000 do Listbox1.Items.Delete(0);
end;
procedure TfClientMain.bConnectClick
begin
try
bConnect.Enabled := False;
IndyInAThread := TIndyInaThread.Create(eAdd
except
on e: exception do
LogMessage(lmtError, ldNone, E.Message);
end;
end;
procedure TfClientMain.bDisconnectCl
begin
// IdTCPClient1.Disconnect;
end;
{ TIndyInaThread }
constructor TIndyInaThread.Create(Host
begin
inherited Create(True);
OnTerminate := OnCompleteEvent;
TCPClientInsideThread := TIdTCPClient.Create(nil);
TCPClientInsideThread.Conn
TCPClientInsideThread.Read
TCPClientInsideThread.Host
TCPClientInsideThread.Port
TCPClientInsideThread.OnWo
TCPClientInsideThread.OnWo
TCPClientInsideThread.OnWo
resume;
end;
procedure TIndyInaThread.Execute;
var
s: string;
filename: string;
AStream: TIDStreamVCL;
begin
try
try
TCPClientInsideThread.Conn
ThreadLogMessage(lmtInform
SendStringWithLogging('LOG
S := ReceiveStringWithLogging;
if pos('ERROR', S) = 1 then
ThreadLogMessage(lmtWarnin
else
begin // login successful
// Store unique ID
if pos('ID ', s) <> 1 then
ThreadLogMessage(lmtWarnin
else
begin
ID := copy(S, 4, maxint);
// send some test commands
// send JUMP command and get 1 line respomse from server
SendStringWithLogging('JUM
S := ReceiveStringWithLogging;
// send TIMER command and wait for a TIMER_STOPPED respomse from server
SendStringWithLogging('TIM
S := ReceiveStringWithLogging;
// send TIMER command and wait for a TIMER_STOPPED respomse from server
SendStringWithLogging('COU
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(TFileS
try
SendStringWithLogging('FIL
SendStringWithLogging(Extr
SendStringWithLogging(IntT
ThreadLogMessage(lmtInform
ShowProgress := True;
TCPClientInsideThread.IOHa
S := ReceiveStringWithLogging;
if S = 'FILE_OK' then
ThreadLogMessage(lmtInform
else
ThreadLogMessage(lmtWarnin
finally
FreeAndNil(AStream);
ShowProgress := False;
end;
// SendStringWithLogging('QUI
end;
end;
except
on e: exception do
ThreadLogMessage(lmtError,
end;
finally
TCPClientInsideThread.Disc
ThreadLogMessage(lmtInform
TCPClientInsideThread.Free
end;
end;
procedure TIndyInaThread.SyncLogMess
begin
if not Terminated then
fClientMain.LogMessage(Log
end;
procedure TIndyInaThread.SendStringW
begin
TCPClientInsideThread.IOHa
ThreadLogMessage(lmtInform
end;
function TIndyInaThread.ReceiveStri
begin
result := TCPClientInsideThread.IOHa
ThreadLogMessage(lmtInform
end;
procedure TIndyInaThread.TCPClientIn
begin
if ShowProgress then
begin
ProgressMax := AWorkCountMax;
CurrentProgress := 0;
Synchronize(SyncStartProgr
end;
end;
procedure TIndyInaThread.TCPClientIn
begin
if ShowProgress then
begin
CurrentProgress := CurrentProgress + AWorkCount;
Synchronize(SyncProgress);
end;
end;
procedure TIndyInaThread.TCPClientIn
AWorkMode: TWorkMode);
begin
if ShowProgress then
begin
CurrentProgress := 0;
Synchronize(SyncStopProgre
end;
end;
procedure TIndyInaThread.ThreadLogMe
begin
LogMessageType := LogMessageType_;
LogDirection := LogDirection_;
MessageText := S;
Synchronize(SyncLogMessage
end;
procedure TIndyInaThread.SyncStartPr
begin
fClientMain.ProgressBar1.P
fClientMain.ProgressBar1.M
fClientMain.ProgressBar1.V
end;
procedure TIndyInaThread.SyncProgres
begin
fClientMain.ProgressBar1.P
end;
procedure TIndyInaThread.SyncStopPro
begin
fClientMain.ProgressBar1.P
fClientMain.ProgressBar1.V
end;
procedure TfClientMain.TCPThreadComp
begin
bConnect.Enabled := True;
end;
end.
//************************
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.
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.
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 ?
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
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
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 ?
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
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.IOHa ndler.Writ eLn('PING' );
S := TCPClientInsideThread.IOHa ndler.Read Ln; // get "PONG" response
AfterPing := Now;
ThreadLogMessage(lmtInform ation, 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(TFileS tream.Crea te(" 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
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.IOHa
S := TCPClientInsideThread.IOHa
AfterPing := Now;
ThreadLogMessage(lmtInform
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(TFileS
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
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.
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
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
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.Create WithSettin gs(ID_: string);
begin
Inherited Create;
ID := ID_;
ClientStage := csNone;
Username := '';
ProcessThread := TMyThread.Create;
end;
destructor TClientSpecificData.Destro y;
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 ...
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.Create
begin
Inherited Create;
ID := ID_;
ClientStage := csNone;
Username := '';
ProcessThread := TMyThread.Create;
end;
destructor TClientSpecificData.Destro
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(AThre ad: 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
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
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 :)
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(filenam e, fmOpenRead + fmShareDenyNone);
to
AStream := TIDStreamVCL.Create(TFileS tream.Crea te(filenam e, 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 :-/
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(filenam
to
AStream := TIDStreamVCL.Create(TFileS
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 :-/
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).
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).
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(Send
procedure rbServerClick(Sender: TObject);
procedure rbClientClick(Sender: TObject);
procedure bConnectClick(Sender: TObject);
procedure bClientSendClick(Sender: TObject);
procedure ServerSocket1ClientRead(Se
Socket: TCustomWinSocket);
procedure ClientSocket1Read(Sender: TObject; Socket: TCustomWinSocket);
procedure bOfflineClick(Sender: TObject);
procedure bDisconnectClick(Sender: TObject);
procedure ServerSocket1ClientConnect
Socket: TCustomWinSocket);
procedure ServerSocket1ClientDisconn
Socket: TCustomWinSocket);
procedure ClientSocket1Connecting(Se
Socket: TCustomWinSocket);
procedure ClientSocket1Connect(Sende
Socket: TCustomWinSocket);
procedure ClientSocket1Disconnect(Se
Socket: TCustomWinSocket);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form2: TForm2;
IMPLEMENTATION
{$R *.DFM}
procedure TForm2.rbServerClick(Sende
begin
gbServer.Enabled := True;
gbClient.Enabled := False;
end;
procedure TForm2.rbClientClick(Sende
begin
gbServer.Enabled := False;
gbClient.Enabled := True;
end;
// **************************
procedure TForm2.bListenClick(Sender
begin
ServerSocket1.Port := StrToIntDef(eServerPort.Te
ServerSocket1.Active := True;
end;
procedure TForm2.bOfflineClick(Sende
begin
ServerSocket1.Active := True;
end;
procedure TForm2.ServerSocket1Client
begin
mLog.lines.add('connection
mLog.Perform(EM_SCROLL,SB_
end;
procedure TForm2.ServerSocket1Client
begin
mLog.lines.add('disconnect
mLog.Perform(EM_SCROLL,SB_
end;
procedure TForm2.ServerSocket1Client
begin
mLog.lines.add(Socket.Rece
end;
procedure TForm2.bServerSendToAllCli
var
i: integer;
begin
for i := 0 to pred(ServerSocket1.Socket.
ServerSocket1.Socket.Conne
end;
// **************************
procedure TForm2.bConnectClick(Sende
begin
ClientSocket1.Address := eAddress.Text;
ClientSocket1.Port := StrToIntDef(eClientPort.Te
ClientSocket1.Open;
end;
procedure TForm2.bClientSendClick(Se
begin
ClientSocket1.Socket.SendT
end;
procedure TForm2.bDisconnectClick(Se
begin
ClientSocket1.Close;
end;
procedure TForm2.ClientSocket1Read(S
begin
mLog.lines.add(Socket.Rece
mLog.Perform(EM_SCROLL,SB_
end;
procedure TForm2.ClientSocket1Connec
begin
mLog.lines.add('connecting
mLog.Perform(EM_SCROLL,SB_
end;
procedure TForm2.ClientSocket1Connec
begin
mLog.lines.add('connected to ' + ClientSocket1.Address + ':' + IntToStr(ClientSocket1.Por
mLog.Perform(EM_SCROLL,SB_
end;
procedure TForm2.ClientSocket1Discon
begin
mLog.lines.add('disconnect
mLog.Perform(EM_SCROLL,SB_
end;
end.
**************************
**************************
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 = ServerSocket1ClientDisconn
OnClientRead = ServerSocket1ClientRead
Left = 360
Top = 88
end
end
Peace Scay7