[Last Call] Learn how to a build a cloud-first strategyRegister Now

x
  • Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 336
  • Last Modified:

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.
0
nova2002
Asked:
nova2002
  • 3
1 Solution
 
TheRealLokiSenior DeveloperCommented:
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;
0
 
TheRealLokiSenior DeveloperCommented:
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
0
 
nova2002Author Commented:
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 ?
0
 
TheRealLokiSenior DeveloperCommented:
I removed it because I went for the "batched" comands method, where the client connects in a thread, does it's thing and comes back (connect button reenabled). There is no user interaction so the disconnect didn't make sense.
The IdTCPClient1 was what I had on the main form when I began the demo, before I put it in a thread.
I am writing a client demo atm that allows user interaction, but still does the comms within the thread to make it more user friendly.

your disconnect code above is not thread safe. Unfortunately you'd either have to have the "client thread" polling to see if it was asked to disconnect, or post the thread a message telling it to disconnect.
If the tcpclient was not in a thread, you could happily just say "disconnect" though.

It should be pointed out that you do not "need" to have the indy TCP client in a thread.
You can do away with the thread entirely and use TidAntiFreeze, but a long process like sending a file, will still cause a delay on your "button push of something else". Using a thread, it wont.
0

Featured Post

[Webinar] Cloud and Mobile-First Strategy

Maybe you’ve fully adopted the cloud since the beginning. Or maybe you started with on-prem resources but are pursuing a “cloud and mobile first” strategy. Getting to that end state has its challenges. Discover how to build out a 100% cloud and mobile IT strategy in this webinar.

  • 3
Tackle projects and never again get stuck behind a technical roadblock.
Join Now