asked on

More on Basic Client/Server Application

Hi,

I hope TheRealLoki is arround :)

First of all, Loki, I tried to download your examples from :

https://sourceforge.net/projects/internetdemos/

For Delphi 7, but the zip files are corrupted. They cant be unzipped.

Second, I tried to capture the output of CreateProcess, but I cant find if TIdTCPServer has "Synchronize" procedure. Do we need to use "PostMessage" then ?

Here is the CMD_PROCESS procedure :

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;

I just want to addapt with one of your other demo (multithreading CreateProcess) that is capable to capture the output of CreateProcess :

procedure TRunConsoleAndCaptureThread.execute;
var
StartupInfo: TStartupInfo;
SecurityAttributes: TSecurityAttributes;
ProcessInfo: TProcessInformation;
hReadStdOut, hNewStdOut: THandle;
buf: string;
statusCode, bread, bavail: cardinal;
Success: boolean;
iresult: integer;
begin
try
SecurityAttributes.nLength := sizeOf(SecurityAttributes);
SecurityAttributes.bInheritHandle := True;
SecurityAttributes.lpSecurityDescriptor := nil;
if not CreatePipe(hReadStdOut, hNewStdOut, @SecurityAttributes, 0) then
raise Exception.Create('Can not create a pipe for STDOUT!');
try
GetStartupInfo(StartupInfo);
StartupInfo.cb := sizeOf(StartupInfo);
StartupInfo.wShowWindow := SW_HIDE; // SET THIS TO "SW_HIDE" IF YOU DO NOT WANT TO SEE THE PROCESS
StartupInfo.hStdOutput := hNewStdOut;
StartupInfo.hStdError := hNewStdOut;
// StartupInfo.hStdInput := 0;
StartupInfo.hStdInput := hNewStdOut;
StartupInfo.dwFlags := STARTF_USESHOWWINDOW or STARTF_USESTDHANDLES;

//e.g. for a dos call to get the dir of c:\ you would have
// CommandLine := ''
// Parameters := 'c:\winnt\system32\cmd.exe /c dir c:\';

if (CommandLine <> '') and (Parameters <> '') then
Success := CreateProcess( pChar(CommandLine), pChar( Parameters ), @SecurityAttributes, nil, True, 0, nil, nil, StartupInfo, ProcessInfo )
else if (CommandLine <> '') and (Parameters = '') then
Success := CreateProcess( pChar(CommandLine), nil, @SecurityAttributes, nil, True, 0, nil, nil, StartupInfo, ProcessInfo )
else if (CommandLine = '') and (Parameters <> '') then
Success := CreateProcess( nil, pChar( Parameters ), @SecurityAttributes, nil, True, 0, nil, nil, StartupInfo, ProcessInfo )
else
Success := False;

if Success then
begin
// give CPU time to really running processes
Sleep(100);
// save spawned processes state
repeat
GetExitCodeProcess(ProcessInfo.hProcess, statusCode);

PeekNamedPipe(hReadStdOut, nil, 0, nil, @bavail, nil);
while bavail > 0 do
begin
SetLength(buf, bavail);
ReadFile(hReadStdOut, buf[1], bavail, bread, nil);
// remove those ugly double CR
Data := StringReplace(buf, #13#13, #13, [rfReplaceAll]);
AllData := AllData + Data;
if ( (not Terminated) and (assigned(fCurrentDataEvent) ) ) then
Synchronize(NotifyCurrentData);
PeekNamedPipe(hReadStdOut, nil, 0, nil, @bavail, nil);
end;

until ( Terminated or (statusCode <> STILL_ACTIVE)); // if not active - exit;
SetLength(buf, 0);
if Terminated then
begin // terminate this process
iresult := Integer(TerminateProcess(ProcessInfo.hProcess, 0));
end;
end;
finally
CloseHandle(ProcessInfo.hThread);
CloseHandle(ProcessInfo.hProcess);
CloseHandle(hReadStdOut);
CloseHandle(hNewStdOut);
end;
except
on e: exception do
begin
//
end;
end;
if ( (not Terminated) and (AllData <> '') and (assigned(fAllDataEvent) ) ) then
Synchronize(NotifyAllData);
Synchronize(NotifyComplete);
end;

I need help with the "synchronize" procedure, or maybe I have to do it differently ???

Thanks for any help.

TheRealLoki

you probably just tried to download the demos while they were being updated, I had the same problem, it came right as soon as the mirrors got populated.
Try downloading them again

To get any message from the console back to the main thread, while running in an Indy Thread,
you could do a Postmessage
as demonstrated in the ThreadLogMessage()
e.g. you could call
ThreadLogMessage(mtInformation, ldNone, Data);
or
ThreadLogMessage(mtInformation, ldNone, AllData); // whichever you want

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;

TheRealLoki

further:-
Indy 9 does have a synchronize, you need to override the class and call it yourself
Indy 10 uses TIdYarn, which is more complicated.
This is why i just use PostMessage instead, becuase it works with both versions

nova2002

ASKER

Thanks Loki, I will try to redownload it again later.

Btw, in the Client side, I noticed that you have put a "disconnect" button but you removed it.

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

I would enable it like this :

procedure TfClientMain.bDisconnectClick(Sender: TObject);
begin
with IndyInAThread do begin
TCPClientInsideThread.Disconnect;
ThreadLogMessage(lmtInformation, ldNone, 'Disconnected');
TCPClientInsideThread.Free;
end;
end;

In this case, the object IdTCPClient1 is not necessary at all, right ?

ASKER CERTIFIED SOLUTION

TheRealLoki

membership

This solution is only available to members.

To access this solution, you must be a member of Experts Exchange.

Start Free Trial