• Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 1054
  • Last Modified:

CreateProcess in multithreading application

Hi,

Is it possible to use CreateProcess API in multithreading application ?

I would like to create a simple multithreading application which each thread will execute an application called "TESTCONSOLE.EXE".

This TESTCONSOLE.EXE writes several random text to the console (command prompt), then terminated.

The main application needs to "catch" that output (random text) and display it in a TMemo.

Please if you can give me a simple demo source code that demonstrate this task.

Limit the number of thread = 10.

When the TESTCONSOLE.EXE terminated, the associated thread MUST be killed.

The main application should run in loop, until terminated. So, in this case, new thread will be created because old thread will be killed (after TESTCONSOLE.EXE terminated).

Thanks in advance.
0
muis2002
Asked:
muis2002
  • 4
  • 3
1 Solution
 
Scay7Commented:
Mabey this might help lots of people asking something along the same lines

http://search.experts-exchange.com/jsp/search.jsp?query=multithreading%20application&topics=85#topSearch

Peace Scay7
0
 
TheRealLokiSenior DeveloperCommented:
This should do what you want.
I've made two thread classes, 1 for starting normal apps, and 1 for starting a console app and catching the output
(comment the console one, and uncomment the
//            TRunAndWaitThread.Create(i, 'Notepad.exe', '', SpecificInstanceThreadComplete)
in the button1lick() event if you want to test with just notepade.exe)

don't forget to change it to SW_HIDE if you do not wish to see the process
(FYI: my form has a button, and 2 memos on it)

the "SpecificInstanceThreadCurrentData" method will report back data from the console as it happens
the "SpecificInstanceThreadAllData" method will report "all" the data from the console once only, when it ends
Also, my "dir" demo (for the console style app) is not a good example, since the dir takes a while, and does some locking, but your own console app should not have this issue

hth, Loki


unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls;

type TSpecificInstanceThreadComplete = procedure(Sender: TObject; const InternalNumber: integer) of object;
type TSpecificInstanceThreadData = procedure(Sender: TObject; const InternalNumber: integer; Data: string) of object;

type TRunAndWaitThread = class(TThread)
    private
        InternalNumber: integer;
        CommandLine, Parameters: string;
        fSpecificInstanceThreadComplete: TSpecificInstanceThreadComplete;
        procedure NotifyComplete;
    public
        procedure execute; override;
        constructor Create(InternalNumber_: integer; CommandLine_, Parameters_: string; SpecificInstanceThreadComplete_: TSpecificInstanceThreadComplete);
    end;

type TRunConsoleAndCaptureThread = class(TThread)
    private
        InternalNumber: integer;
        CommandLine, Parameters: string;
        Data: string;
        AllData: string;
        fSpecificInstanceThreadComplete: TSpecificInstanceThreadComplete;
        fCurrentDataEvent: TSpecificInstanceThreadData;
        fAllDataEvent: TSpecificInstanceThreadData;
        procedure NotifyComplete;
        procedure NotifyCurrentData;
        procedure NotifyAllData;
    public
        procedure execute; override;
        constructor Create(InternalNumber_: integer; CommandLine_, Parameters_: string; SpecificInstanceThreadComplete_: TSpecificInstanceThreadComplete; CurrentDataEvent_, AllDataEvent_: TSpecificInstanceThreadData);
    end;

type
  TForm1 = class(TForm)
    Button1: TButton;
    lThreads: TLabel;
    Memo1: TMemo;
    Memo2: TMemo;
    procedure Button1Click(Sender: TObject);
    procedure SpecificInstanceThreadComplete(Sender: TObject; const InternalNumber: integer);
    procedure SpecificInstanceThreadCurrentData(Sender: TObject; const InternalNumber: integer; Data: string);
    procedure SpecificInstanceThreadAllData(Sender: TObject; const InternalNumber: integer; Data: string);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
  private
    { Private declarations }
    fRunningThreadsCount: integer;
    SimpleThreadList: TList;
    procedure SetRunningThreadsCount(const Value: integer);
  public
    { Public declarations }
    property RunningThreadsCount: integer read fRunningThreadsCount write SetRunningThreadsCount;
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

// ***************   TRunAndWaitThread

constructor TRunAndWaitThread.Create(InternalNumber_: integer; CommandLine_, Parameters_: string; SpecificInstanceThreadComplete_: TSpecificInstanceThreadComplete);
    begin
        inherited Create(True);
        FreeOnTerminate := True;
        InternalNumber := InternalNumber_;
        CommandLine := CommandLine_;
        Parameters := Parameters_;
        fSpecificInstanceThreadComplete := SpecificInstanceThreadComplete_;
        Resume;
    end;

procedure TRunAndWaitThread.execute;
    var
        WaitResult : integer;
        StartupInfo: TStartupInfo;
        ProcessInfo: TProcessInformation;
        iResult : integer;
        Success: Boolean;
    begin
        try
            FillChar(StartupInfo, SizeOf(TStartupInfo), 0);
            StartupInfo.cb := SizeOf(TStartupInfo);
            StartupInfo.dwFlags := STARTF_USESHOWWINDOW or STARTF_FORCEONFEEDBACK;
                                { you could pass sw_show or sw_hide as parameter: }
            StartupInfo.wShowWindow := SW_SHOW; // SET THIS TO "SW_HIDE" IF YOU DO NOT WANT TO SEE THE PROCESS
            if (CommandLine <> '') and (Parameters <> '') then
              Success := CreateProcess( pChar(CommandLine), pChar( Parameters ), nil, nil, False, NORMAL_PRIORITY_CLASS, nil, nil, StartupInfo, ProcessInfo )
            else if (CommandLine <> '') and (Parameters = '') then
              Success := CreateProcess( pChar(CommandLine), nil, nil, nil, False, NORMAL_PRIORITY_CLASS, nil, nil, StartupInfo, ProcessInfo )
            else if (CommandLine = '') and (Parameters <> '') then
              Success := CreateProcess( nil, pChar( Parameters ), nil, nil, False, NORMAL_PRIORITY_CLASS, nil, nil, StartupInfo, ProcessInfo )
            else
              Success := False;

            if Success then
            begin
                repeat
                    WaitResult := WaitForSingleObject(ProcessInfo.hProcess, 1000);
                until Terminated or (WaitResult <> WAIT_TIMEOUT);
{ timeout is in miliseconds or INFINITE if you want to wait forever }
                if Terminated then
                begin // terminate this process
                    iresult := Integer(TerminateProcess(ProcessInfo.hProcess, 0));
                end;
            end
            else //error occurs during CreateProcess see help for details }
              iresult := GetLastError;
            if ProcessInfo.hProcess <> 0 then
              CloseHandle(ProcessInfo.hProcess);
            if ProcessInfo.hThread <> 0 then
              CloseHandle(ProcessInfo.hThread);

        except
            on e: exception do
            begin
//
            end;
        end;

        Synchronize(NotifyComplete);
    end;

procedure TRunAndWaitThread.NotifyComplete;
    begin
        fSpecificInstanceThreadComplete(self, InternalNumber);
    end;

// ***************   TRunConsoleAndCaptureThread
constructor TRunConsoleAndCaptureThread.Create(InternalNumber_: integer; CommandLine_, Parameters_: string; SpecificInstanceThreadComplete_: TSpecificInstanceThreadComplete; CurrentDataEvent_, AllDataEvent_: TSpecificInstanceThreadData);
    begin
        inherited Create(True);
        FreeOnTerminate := True;
        InternalNumber := InternalNumber_;
        CommandLine := CommandLine_;
        Parameters := Parameters_;
        Data := '';
        AllData := '';
        fSpecificInstanceThreadComplete := SpecificInstanceThreadComplete_;
        fCurrentDataEvent := CurrentDataEvent_;
        fAllDataEvent := AllDataEvent_;
        Resume;
    end;

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_SHOW; // 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;

procedure TRunConsoleAndCaptureThread.NotifyCurrentData;
    begin
        fCurrentDataEvent(self, InternalNumber, Data);
    end;

procedure TRunConsoleAndCaptureThread.NotifyAllData;
    begin
        fAllDataEvent(self, InternalNumber, AllData);
    end;


procedure TRunConsoleAndCaptureThread.NotifyComplete;
    begin
        fSpecificInstanceThreadComplete(self, InternalNumber);
    end;



// ***************   TForm1
procedure TForm1.FormCreate(Sender: TObject);
    begin
        SimpleThreadList :=TList.Create;
    end;

procedure TForm1.FormDestroy(Sender: TObject);
    begin
        SimpleThreadList.Clear;
        SimpleThreadList.Free;
    end;

procedure TForm1.SetRunningThreadsCount(const Value: integer);
    begin
        fRunningThreadsCount := Value;
        lThreads.Caption := inttostr(value) + ' threads';
    end;

procedure TForm1.SpecificInstanceThreadComplete(Sender: TObject; const InternalNumber: integer);
    var
        i: integer;
    begin
        RunningThreadsCount := RunningThreadsCount - 1;
        i := pred(SimpleThreadList.Count);
        while (i >= 0) do
        begin
            if Sender = SimpleThreadList[i] then
              SimpleThreadList.Delete(i);
            dec(i);
        end;
    end;

procedure TForm1.SpecificInstanceThreadAllData(Sender: TObject;
  const InternalNumber: integer; Data: string);
begin
    memo1.lines.add('********  PROCESS THREAD ' + IntToStr(InternalNumber));
    memo1.lines.Add(Data);
end;

procedure TForm1.SpecificInstanceThreadCurrentData(Sender: TObject;
  const InternalNumber: integer; Data: string);
begin
    memo2.lines.add('********  PROCESS THREAD ' + IntToStr(InternalNumber));
    memo2.lines.Add(Data);
end;

procedure TForm1.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
var
    i: integer;
    j: integer;
begin
    for i := Pred(SimpleThreadList.Count) downto 0 do
    begin
        if TThread(SimpleThreadList[i]) is TRunConsoleAndCaptureThread then
          TRunConsoleAndCaptureThread(SimpleThreadList[i]).Terminate
        else if TThread(SimpleThreadList[i]) is TRunAndWaitThread then
          TRunAndWaitThread(SimpleThreadList[i]).Terminate
    end;
// give the thread a chance to close, but give up after 5 seconds
    j := 50;
    while ( (SimpleThreadList.Count > 0) and (j > 0) ) do
    begin
        sleep(100);
        application.processmessages;
    end;
end;

procedure TForm1.Button1Click(Sender: TObject);
    var
        i: integer;
    begin
        for i := 1 to 5 do
        begin
            RunningThreadsCount := RunningThreadsCount + 1;
            SimpleThreadList.Add(
            TRunConsoleAndCaptureThread.Create(i, '', 'c:\winnt\system32\cmd.exe /c dir c:\', SpecificInstanceThreadComplete, SpecificInstanceThreadCurrentData, SpecificInstanceThreadAllData)
//            TRunAndWaitThread.Create(i, 'Notepad.exe', '', SpecificInstanceThreadComplete)
            );
        end;
    end;

end.
0
 
muis2002Author Commented:
Thanks TheRealLoki,

I tested your demo, it seems works well as I expected (your demo quality is very excellent!).

But, the SW_HIDE does not work. I set it to SW_HIDE and still see the console (black window).

Here is my console app (I put it in the same folder of the demo.exe) :

program ConsoleApp;

{$APPTYPE CONSOLE}

uses
  SysUtils;

var
  n,i,j: integer;

begin
  { TODO -oUser -cConsole Main : Insert code here }
  Randomize;
  i := Trunc(Random(100));
  n := 1000000+Trunc(Random(999999));
  Writeln (IntToStr(n)+' i='+IntToStr(i));
  for j := 0 to i do
  begin
    if (j mod 10 = 0) then Sleep(1000 + Trunc(Random(3000)));
    Writeln (IntToStr(n)+' => '+IntToStr(j));
  end;
  Writeln (IntToStr(n)+' EXIT');
end.

And in your code, I changed this :

            StartupInfo.wShowWindow := SW_HIDE;

And in the Button1Click :

procedure TForm1.Button1Click(Sender: TObject);
    var
        i: integer;
    begin
        for i := 1 to 5 do
        begin
            RunningThreadsCount := RunningThreadsCount + 1;
            SimpleThreadList.Add(

            TRunConsoleAndCaptureThread.Create(i, '', 'ConsoleApp.exe', SpecificInstanceThreadComplete, SpecificInstanceThreadCurrentData, SpecificInstanceThreadAllData)

//            TRunConsoleAndCaptureThread.Create(i, '', 'c:\winnt\system32\cmd.exe /c  dir c:\', SpecificInstanceThreadComplete, SpecificInstanceThreadCurrentData, SpecificInstanceThreadAllData)
//            TRunAndWaitThread.Create(i, 'Notepad.exe', '', SpecificInstanceThreadComplete)
            );
        end;
    end;

end.

What could be the reason ?
0
Introducing Cloud Class® training courses

Tech changes fast. You can learn faster. That’s why we’re bringing professional training courses to Experts Exchange. With a subscription, you can access all the Cloud Class® courses to expand your education, prep for certifications, and get top-notch instructions.

 
muis2002Author Commented:
One more thing, I found the CPU usage was 100% when processing all threads. I tried to add :

    Application.ProcessMessage;

In the for loop of Button1Click, but it does not help.

Is this normal ? I meant, the demo.exe will use all available CPU resources while its not used, thats why we will see 100% CPU time.

Or is this something to do with the ConsoleApp.exe ?
0
 
TheRealLokiSenior DeveloperCommented:
i have 2 example threads thre, 1 does the console style with capturing output, the other does normal processes. did you set the right one to to sw_hide?
also, yes, I noticed, when spawning a command shell, the system churns up a lot of cpu. I think this is an OS thing, you could try setting the thread priority to low in the create process to counteract it
0
 
muis2002Author Commented:
Ok, my mistake. Now I set both to SW_HIDE.

The demo runs fine, ConsoleApp.exe executed without that black Window.

But, if I changed the ConsoleApp.exe to a simple Delphi form application like below, it does not hide and the taskbar was filled with its icon.

Any more tricks ?

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls;

type
  TForm1 = class(TForm)
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    procedure FormActivate(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.FormActivate(Sender: TObject);
var
  i,j: integer;
begin
  Randomize;
  j := Trunc(Random(100));
  label3.Caption := IntToStr(j);
  for i := 0 to j do
  begin
    Application.ProcessMessages;
    label1.Caption := IntToStr(Trunc(Random(1000000)));
    label2.Caption := IntToStr(i);
    if (i mod 15 = 0) then Sleep(1000 + Trunc(Random(500)));
  end;
  Close;
end;

end.

0
 
TheRealLokiSenior DeveloperCommented:
if you are running a console app, where you require the output you do this part

          TRunConsoleAndCaptureThread.Create(i, '', 'c:\winnt\system32\cmd.exe /c dir c:\', SpecificInstanceThreadComplete, SpecificInstanceThreadCurrentData, SpecificInstanceThreadAllData)

However, if you are running just a normal application, you do _not_ capture the output in the same manner, so you run this instead
            TRunAndWaitThread.Create(i, 'Notepad.exe', '', SpecificInstanceThreadComplete)
Do not try to run a normal app, with the console capturing method :-)
0
 
muis2002Author Commented:
Thanks Loki :) Great helps !
0
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

Join & Write a Comment

Featured Post

Upgrade your Question Security!

Your question, your audience. Choose who sees your identity—and your question—with question security.

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