Want to protect your cyber security and still get fast solutions? Ask a secure question today.Go Premium

x
?
Solved

CreateProcess in multithreading application

Posted on 2006-05-17
8
Medium Priority
?
997 Views
Last Modified: 2010-04-16
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
Comment
Question by:muis2002
  • 4
  • 3
8 Comments
 
LVL 5

Expert Comment

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

Expert Comment

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

Author Comment

by:muis2002
ID: 16723717
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
What does it mean to be "Always On"?

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

 

Author Comment

by:muis2002
ID: 16723740
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
 
LVL 17

Expert Comment

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

Author Comment

by:muis2002
ID: 16727453
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
 
LVL 17

Accepted Solution

by:
TheRealLoki earned 2000 total points
ID: 16730331
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
 

Author Comment

by:muis2002
ID: 16736922
Thanks Loki :) Great helps !
0

Featured Post

Concerto Cloud for Software Providers & ISVs

Can Concerto Cloud Services help you focus on evolving your application offerings, while delivering the best cloud experience to your customers? From DevOps to revenue models and customer support, the answer is yes!

Learn how Concerto can help you.

Question has a verified solution.

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

Objective: - This article will help user in how to convert their numeric value become words. How to use 1. You can copy this code in your Unit as function 2. than you can perform your function by type this code The Code   (CODE) The Im…
This is an update to some code that someone else posted on Experts Exchange. It is an alternate approach, I think a little easier to use, & makes sure that things like the Task Bar will update.
Screencast - Getting to Know the Pipeline
Kernel Data Recovery is a renowned Data Recovery solution provider which offers wide range of softwares for both enterprise and home users with its cost-effective solutions. Let's have a quick overview of the journey and data recovery tools range he…
Suggested Courses
Course of the Month14 days, 21 hours left to enroll

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

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

Join & Ask a Question