?
Solved

SHELL EXECUTE NEED QUICK ANSWER!

Posted on 2000-01-20
30
Medium Priority
?
351 Views
Last Modified: 2010-04-04


How do I get a return code from a program that I am using"//        ShellExecute(Application.Handle,'Open',PChar(MergeCmd), nil, nil, 5 );" to call.  The program that I am executing is sending back a return code of "0" for successfull or "1" for failing.  How do I capture that return code?  Using SHELLEXEC or some other method?

TJ
0
Comment
Question by:aj85
  • 15
  • 14
30 Comments
 
LVL 12

Accepted Solution

by:
rwilson032697 earned 1600 total points
ID: 2372901
You can use this to wait for the process to complete and examine its return code (GetExitCodeProcess).

This will block - I'll dig out a non-blocking version for you as well...

Cheers,

Raymond.
0
 
LVL 12

Expert Comment

by:rwilson032697
ID: 2372905
Oops. Here are the two code snippets:

Blocking:

To execute a programa and wait the end try the follow
function WinExecAndWait32(ExeName : string; Visibility : WORD; ProcMessages : boolean) : DWORD;
{-------------------------------------------------------------------------------------------------------------}
var
  zAppName:array[0..512] of char;
  zCurDir:array[0..255] of char;
  WorkDir:String;
  StartupInfo:TStartupInfo;
  ProcessInfo:TProcessInformation;
begin
StrPCopy(zAppName,ExeName);
GetDir(0,WorkDir);
StrPCopy(zCurDir,WorkDir);

FillChar(StartupInfo,Sizeof(StartupInfo),#0);
StartupInfo.cb := Sizeof(StartupInfo);
StartupInfo.dwFlags := STARTF_USESHOWWINDOW;
StartupInfo.wShowWindow := Visibility;
if not CreateProcess( nil, zAppName, nil, nil, False, CREATE_NEW_CONSOLE or NORMAL_PRIORITY_CLASS, nil, nil,
  StartupInfo, ProcessInfo) then  begin
Result := 0;
end else begin
if ProcMessages then begin
Result:=WAIT_TIMEOUT;
while Result = WAIT_TIMEOUT do begin
Result:=WaitforSingleObject(ProcessInfo.hProcess,1000);
if Result = WAIT_FAILED then begin
RaiseLastWin32Error; //**
end;
Application.ProcessMessages;
end;
end else begin
WaitforSingleObject(ProcessInfo.hProcess,INFINITE);
GetExitCodeProcess(ProcessInfo.hProcess,Result);
end;
end;
end;

if you use ShellExecuteEx the hInstApp inside struct passed will used like ProcessInfo.hProcess.

--------------------------------------
Non Blocking:

unit runThread_;

interface

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

type
  TForm1 = class(TForm)
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
  private
    { Private-Deklarationen}
  public
    { Public-Deklarationen}
  end;

var Form1 : TForm1 = nil;

implementation

{$R *.DFM}

const unitName = 'runThread_.';

type TRunThread = class(TThread)
  private
    processHandle : cardinal;
    processReady  : boolean;
    waitingThread : cardinal;
    procedure Execute; override;
  end;

procedure TRunThread.Execute;
begin
  WaitForSingleObject(processHandle,INFINITE);   // This call does not return, unless copy is stopped
  processReady:=true;                            // Set "processReady" flag for main thread
  PostThreadMessage(waitingThread,WM_NULL,0,0);  // Wake up main thread
                                                 // If you call Application.HandleMessage (see below) in the
                                                 // main thread, the main thread is sleeping the most time in
                                                 // winAPI "waitMessage". So we send a "dummy" message in order
                                                 // to let the main thread return from Application.HandleMessage
end;

procedure TForm1.Button1Click(Sender: TObject);
var si  : TStartupInfo;
    pi  : TProcessInformation;
    dw1 : dword;
begin
  enabled:=false;
  caption:='start copy...';
  ZeroMemory(@si,sizeOf(si)); si.cb:=sizeOf(si);
  si.dwFlags:=STARTF_USESHOWWINDOW; si.wShowWindow:=SW_HIDE;
  if CreateProcess(nil,'c:\command.com /c copy c:\autoexec.bat c:\test.bat >c:\output.txt',nil,nil,false,0,nil,nil,si,pi) then begin
    caption:='copy started...';
    with TRunThread.Create(true) do         // create the thread object, but do not start it now...
      try
        processHandle:=pi.hProcess;         // tell the thread what process it has to watch
        processReady:=false;                // flag for the loop (see below)
        waitingThread:=GetCurrentThreadID;  // the current threadID for the wakeup message (see above)
        caption:='wait for copy...';
        Resume;                             // now all information is prepared; so let's start the thread
        repeat
          Application.HandleMessage;        // message loop
        until Application.Terminated or processReady;  // continue with normal program when either the
                                                       // started process has stopped or our program is closed
        caption:='copy stopped...';
      finally Free end;
    GetExitCodeProcess(pi.hProcess,dw1);
    CloseHandle(pi.hThread); CloseHandle(pi.hProcess); // Never forget to close handles...
    caption:='ready... (exitCode='+IntToStr(dw1)+')';
  end else caption:='could not start copy...';
  enabled:=true;
end;

end.

Cheers,

Raymond.
0
 

Author Comment

by:aj85
ID: 2372963


Can you give me an example using  ShellExecute(Application.Handle,'Open',PChar(MergeCmd), nil, nil, 5 ) they way that I am?  Maybe you already have but I am not clear on just how to implement the example code you provided to me.  

Thanks
TJ
0
The 14th Annual Expert Award Winners

The results are in! Meet the top members of our 2017 Expert Awards. Congratulations to all who qualified!

 
LVL 12

Expert Comment

by:rwilson032697
ID: 2372982
The RunThread unit probably gives you the best picture - it shows how to use the exitcode returned by the process.

Bascially, just change this line:

  if CreateProcess(nil,'c:\command.com /c copy c:\autoexec.bat c:\test.bat >c:\output.txt',nil,nil,false,0,nil,nil,si,pi)

To something like this

  if CreateProcess(nil,PChar(MergeCmd),nil,nil,false,0,nil,nil,si,pi)

Obviously you will want to remove some of the messages that appear (as this code was originally for a copy command).

Otherwise you should be able to use the code verbatim (perhaps wrap the code in teh Button click hander into a generic procedure such as:

Function RunMyProcess(ProcessCommand : String) : integer;

Where the result of the function is the value retuned by GetExitCodeProcess.

Does that help?

Cheers,

Raymond.
0
 

Author Comment

by:aj85
ID: 2373033


Raymond,

Thanks, I am very close, however when I added:
if CreateProcess(nil,PChar(MergeCmd),nil,nil,false,0,nil,nil,si,pi)
with MergeCmd equal to 'C:\Merge.Exe'  the program that I was calling did not execute?  I know that is must be something very small that I am doing, but I am not sure what?

Thanks again,
TJ
0
 
LVL 12

Expert Comment

by:rwilson032697
ID: 2373048
This should be fine... Do you have huge strings enabled? Does merge.exe exist in the root of C:?

Cheers,

Raymond.
0
 

Author Comment

by:aj85
ID: 2373072

First question, no, second question, I am not sure.  Using ShellExec, I see my application executing in the background.  Now I don't see anything happening that tells me the app executed properly.  Your example ends with the successful message, so I am not fully sure that it did not execute.

TJ
0
 

Author Comment

by:aj85
ID: 2373077

First question, no, second question, I am not sure.  Using ShellExec, I see my application executing in the background.  Now I don't see anything happening that tells me the app executed properly.  Your example ends with the successful message, so I am not fully sure that it did not execute.

TJ
0
 
LVL 12

Expert Comment

by:rwilson032697
ID: 2373079
Declare mergeCmd as an ANSIString (this is a huge string and can be cast to a PChar).

Cheers,

Raymond.
0
 
LVL 20

Expert Comment

by:Madshi
ID: 2373830
Both of Raymond's code snippets should just work fine, I guess you've given in the wrong exe file name or path.

Raymond, hmm... one addition to the "WinExecAndWait32" code snippet: PLEASE don't forget to close the handles!!!!

CloseHandle(pi.hProcess);
CloseHandle(pi.hThread);

Regards, Madshi.
0
 

Author Comment

by:aj85
ID: 2375230


Raymond,

You are right!  Thanks.  I have another question for you that if you answer I will increase the points by 150.  How can I have a "ShowMessage('End')" for example that is erased after 5 minutes, or allows the user to click the "OK" button and clear it?

Thanks again,
TJ
0
 
LVL 12

Expert Comment

by:rwilson032697
ID: 2375465
You can do it like this. In Dialogs.pas there is this function:

function CreateMessageDialog(const Msg: string; DlgType: TMsgDlgType;
  Buttons: TMsgDlgButtons): TForm;

It is called by the ShowMessage (eventually) function like this:

  with CreateMessageDialog(Msg, DlgType, Buttons) do
    try
      HelpContext := HelpCtx;
      HelpFile := HelpFileName;
      if X >= 0 then Left := X;
      if Y >= 0 then Top := Y;
      if (Y < 0) and (X < 0) then Position := poScreenCenter;
      Result := ShowModal;
    finally
      Free;
    end;

If you don't want to set the help context just comment out those two lines.

So you can write a procedure like this:

var
  MsgDlg : TForm;

procedure TSomeClass.RemoveMessageForm(Sender : TObject);
begin
  MsgDlg.ModalResult := mrOK;
OR
  MsgDlg.Close;
end;

procedure ShowTimedMessage(msg : String;
Delay : Seconds);
var
  Timer : TTimer;
begin
  Timer := TTimer.Create;
  Timer.Interval := delay * 1000;
  Timer.OnTimer := TSomeClass.RemoveMessageForm;
  Timer.Enabled := True;
  MsgDlg := CreateMessageDialog(Msg, mtCustom, [mbOK]);
  with MsgDlgdo
    try
      HelpContext := HelpCtx;
      HelpFile := HelpFileName;
      if X >= 0 then Left := X;
      if Y >= 0 then Top := Y;
      if (Y < 0) and (X < 0) then Position := poScreenCenter;
      Result := ShowModal;
      Timer.Enabled := False;
    finally
      Free;
      Timer.Free;
    end;

Cheers,

Raymond.
0
 

Author Comment

by:aj85
ID: 2375966
I get a DLL error message when I try to call the procedure that shows the message.  What am I doing wrong?  This happens when the TTimer Interval is started.

TJ
0
 
LVL 12

Expert Comment

by:rwilson032697
ID: 2376047
Well, that will teach,me to write code on the fly! Here is the code from a form.pas which compiles and works in D4:

unit unit7;

interface

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

type
  TForm1 = class(TForm)
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
    procedure RemoveMessageForm(Sender : TObject);
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

uses
  extctrls;

var
  MsgDlg : TForm;

rocedure TForm1.RemoveMessageForm(Sender : TObject);
egin
 MsgDlg.ModalResult := mrOK;
nd;

rocedure ShowTimedMessage(msg : String;
elay : Integer);
ar
 Timer : TTimer;
egin
 Timer := TTimer.Create(Nil);
 Timer.Interval := delay * 1000;
 Timer.OnTimer := Form1.RemoveMessageForm;
 Timer.Enabled := True;
 MsgDlg := CreateMessageDialog(Msg, mtCustom, [mbOK]);
 with MsgDlg do
   try
     Position := poScreenCenter;
     ShowModal;
     Timer.Enabled := False;
   finally
     Free;
     Timer.Free;
   end;
 end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  ShowTimedMessage('Fred', 5);
end;

end.

Cheers,

Raymond.

0
 
LVL 12

Expert Comment

by:rwilson032697
ID: 2376055
Oh, for pities sake!

procedure TForm1.RemoveMessageForm(Sender : TObject);
begin
  MsgDlg.ModalResult := mrOK;
end;

procedure ShowTimedMessage(msg : String;
delay : Integer);
var
  Timer : TTimer;
begin
  Timer := TTimer.Create(Nil);
  Timer.Interval := delay * 1000;
  Timer.OnTimer := Form1.RemoveMessageForm;
  Timer.Enabled := True;
  MsgDlg := CreateMessageDialog(Msg, mtCustom, [mbOK]);
  with MsgDlg do
    try
      Position := poScreenCenter;
      ShowModal;
      Timer.Enabled := False;
    finally
      Free;
      Timer.Free;
    end;
end;

Cheers,

Raymond.
0
 

Author Comment

by:aj85
ID: 2382384


Everything appears to work except for this line:
 Timer.OnTimer := Form1.RemoveMessageForm;
  It will not compile on that line it says that they are incompatible types.  What do I need to do so that I can give you your well deserved points.


Thanks,
TJ
0
 
LVL 12

Expert Comment

by:rwilson032697
ID: 2382801
Where have you declared RemoveMessageForm? Can you show me the code you use?

It needs to be declared in a class as events are all 'of object', ie: methods.

Cheers,

Raymond.
0
 

Author Comment

by:aj85
ID: 2383269
procedure RemoveMessageForm(Move : TNotifyEvent);
0
 
LVL 12

Expert Comment

by:rwilson032697
ID: 2383310
Make that:

procedure RemoveMessageForm(Sender : TObject);

Cheers,

Raymond.



0
 

Author Comment

by:aj85
ID: 2383327
Timer.OnTimer :=  RemoveMessageForm(Sender : TObject);

Undeclaired Idenitfier Error.
0
 
LVL 12

Expert Comment

by:rwilson032697
ID: 2383338
Sorry, I meant declare it like this:

procedure RemoveMessageForm(Sender : TObject);

But still use it like this:

Timer.OnTimer := Form1.RemoveMessageForm;

Just like in the code I posted.

Cheers,

Raymond.
0
 

Author Comment

by:aj85
ID: 2383380
Incompatible types TObject and TNotifyEvent.  What am I doing wrong
0
 
LVL 12

Expert Comment

by:rwilson032697
ID: 2383391
Can you post the code you have now - its hard to tell...

Cheers,

Raymond.
0
 

Author Comment

by:aj85
ID: 2383402
type
  TForm1 = class(TForm)
  Button1: TButton;
  TRunThread: TThread;
  procedure RemoveMessageForm(Move : TNotifyEvent);


procedure ShowTimedMessage(msg : String;
delay : Integer);
var
  Timer : TTimer;
begin
  Timer := TTimer.Create(Nil);
  Timer.Interval := delay * 1000;
  Timer.OnTimer := TForm1.RemoveMessageForm;
  Timer.Enabled := True;
  MsgDlg := CreateMessageDialog(Msg, mtCustom, [mbOK]);
  with MsgDlg do
    try
      Position := poScreenCenter;
      ShowModal;
      Timer.Enabled := False;
    finally
      Free;
      Timer.Free;
    end;
end;
0
 
LVL 12

Expert Comment

by:rwilson032697
ID: 2383420
You need to have all these elements in my code (repeated here with the two correct sections combined)

unit unit7;

interface

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

type
  TForm1 = class(TForm)
  private
    { Private declarations }
  public
    { Public declarations }
    procedure RemoveMessageForm(Sender : TObject);
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

uses
  extctrls;

var
  MsgDlg : TForm;

procedure TForm1.RemoveMessageForm(Sender : TObject);
begin
  MsgDlg.ModalResult := mrOK;
end;

procedure ShowTimedMessage(msg : String;
delay : Integer);
var
  Timer : TTimer;
begin
  Timer := TTimer.Create(Nil);
  Timer.Interval := delay * 1000;
  Timer.OnTimer := Form1.RemoveMessageForm;
  Timer.Enabled := True;
  MsgDlg := CreateMessageDialog(Msg, mtCustom, [mbOK]);
  with MsgDlg do
    try
      Position := poScreenCenter;
      ShowModal;
      Timer.Enabled := False;
    finally
      Free;
      Timer.Free;
    end;
end;

end.

Cheers,

Raymond.
0
 

Author Comment

by:aj85
ID: 2383502

Have you tested this code?  I am only asking and do not mean anything by asking.  I am just still getting the same incompatibility errors. Only now it is procedure and TNotify.


Thanks,
TJ
0
 
LVL 12

Expert Comment

by:rwilson032697
ID: 2383528
Yes, I compiled and ran this code (there was a button click method you see in one of the earlier comments, but I removed it for clarity.)

Can you post (again!) all the code you are now using to do this. Your last post of the code looked imcomplete.

Cheers,

Raymond.
0
 

Author Comment

by:aj85
ID: 2383539
Here it is...

unit gmsdbint;    

interface

uses Gauges, StdCtrls, Forms, ShellAPI, Windows, ExtCtrls, Messages, ComCtrls, Controls,
Graphics,  Classes;




 type
  TForm1 = class(TForm)
  Button1: TButton;
  TRunThread: TThread;
  procedure RemoveMessageForm(Sender: TObject) of object;


  //private

 // public


  end;

  var
  Form1 : TForm1;
  MsgDlg : TForm;

procedure BuildUpload ( progressGauge:TGauge; statusLabel: TLabel);
procedure BuildDownload ( progressGauge:TGauge; statusLabel: TLabel);
procedure CheckDatabase ( progressGauge:TGauge; statusLabel: TLabel);
Function  RunMyProcess : integer;
procedure ShowTimedMessage(msg : String; delay : Integer);
procedure RemoveMessageForm(Sender : TObject);






implementation


uses Dialogs, UpDown, SysUtils;

const unitName = 'gmsdbint';

type TRunThread = class(TThread)
     TMove :TNotifyEvent;



private
 processHandle : cardinal;
 processReady  : boolean;
 waitingThread : cardinal;

procedure Execute; override;
  end;



procedure TRunThread.Execute;
   begin
   WaitForSingleObject(processHandle,INFINITE);   // This call does not return, unless copy is stopped
   processReady:=true;                            // Set "processReady" flag for main thread
   PostThreadMessage(waitingThread,WM_NULL,0,0);  // Wake up main thread
                                                  // If you call Application.HandleMessage (see below) in the
                                                  // main thread, the main thread is sleeping the most time in
                                                 // winAPI "waitMessage". So we send a "dummy" message in order
                                               // to let the main thread return from Application.HandleMessage
        end;


procedure BuildUpload ( progressGauge:TGauge; statusLabel: TLabel);
var
      myUpDown: TUpDown;
        MergeCmd: String;
begin
   myUpDown := TUpDown.Create( progressGauge, statusLabel );

   try
         myUpDown.BuildUpload;
      except
         on E: Exception do
            begin
               ShowMessage( 'Error in processing upload. ' + #10#13 + E.message );
         end;
   end;
      myUpDown.Free;
//        ShellExecute(Application.Handle,'Open',PChar(MergeCmd), nil, nil, 5 );

end;


procedure BuildDownload ( progressGauge:TGauge; statusLabel: TLabel);
var
      myUpDown: TUpDown;
        MergeCmd: String;
        Timer1: TTimer;
        Timer2: TTimer;
        IsItTime: TDateTime;

 begin
   myUpDown := TUpDown.Create( progressGauge, statusLabel );

   try
         myUpDown.BuildDownload;
      except
         on E: Exception do
            begin
               ShowMessage( 'Error in processing download. ' + #10#13 + E.message );
         end;
   end;
      myUpDown.Free;
//        RunMyProcess;    {Call Function to execute Merge app. and start timer process //TJ}

   end;

procedure CheckDatabase ( progressGauge:TGauge; statusLabel: TLabel);
var
          myUpDown: TUpDown;
          MergeCmd: String;
begin
   myUpDown := TUpDown.Create( progressGauge, statusLabel );
 //  MergeCmd := 'C:\FCIS\MERGE\MERGE.EXE';  {Path to the Merge application //TJ}

   try
         myUpDown.CheckDatabase;
      except
         on E: Exception do
            begin
               ShowMessage( 'Error in database check. ' + #10#13 + E.message );
         end;
   end;
           myUpDown.Free;
        RunMyProcess;

end;

Function RunMyProcess : integer;            //TJ
 var           si  : TStartupInfo;
               pi  : TProcessInformation;
               dw1 : dword;
               MergeCmd: ANSIString;
               enabled: boolean;
        begin
        enabled:=false;
        MergeCmd:= 'C:\MSSQL7\MERGE\Merge.Exe';
        ZeroMemory(@si,sizeOf(si)); si.cb:=sizeOf(si);
        si.dwFlags:=STARTF_USESHOWWINDOW; si.wShowWindow:=SW_HIDE;
     if CreateProcess(nil,PChar(MergeCmd),nil,nil,false,0,nil,nil,si,pi)
          then begin
                   with TRunThread.Create(true) do         // create the thread object, but do not start it now...
                 try
                 processHandle:=pi.hProcess;         // tell the thread what process it has to watch
                 processReady:=false;                // flag for the loop (see below)
                 waitingThread:=GetCurrentThreadID;  // the current threadID for the wakeup message (see above)
                 Resume;                             // now all information is prepared; so let's start the thread
           repeat
                 Application.HandleMessage;        // message loop
           until Application.Terminated or processReady;  // continue with normal program when either the
                                                        // started process has stopped or our program is closed
     finally Free end;
          GetExitCodeProcess(pi.hProcess,dw1);
          CloseHandle(pi.hThread);
          CloseHandle(pi.hProcess); // Never forget to close handles... //TJ
          begin
          if (dw1) = 0 then
          ShowTimedMessage('Merge Successful!', 5)
          else
          if (dw1) = 1 then
          ShowTimedMessage('Merge Unsuccessful! Please retry....', 5);
      //   ShowTimedMessage('Test (exitCode='+IntToStr(dw1)+')', 5);
            end;
        end;
     end;

procedure TForm1.RemoveMessageForm(Sender : TObject);

begin
  MsgDlg.ModalResult := mrOK;
end;

procedure ShowTimedMessage(msg : String;
delay : Integer);
var
  Timer : TTimer;
begin
  Timer := TTimer.Create(Nil);
  Timer.Interval := delay * 1000;
  Timer.OnTimer := Form1.RemoveMessageForm;
  Timer.Enabled := True;
  MsgDlg := CreateMessageDialog(Msg, mtCustom, [mbOK]);
  with MsgDlg do
    try
      Position := poScreenCenter;
      ShowModal;
      Timer.Enabled := False;
    finally
      Free;
      Timer.Free;
    end;
end;




   end.
0
 

Author Comment

by:aj85
ID: 2383547

Raymond,

Sorry, to put you through that, I made a typo and found the error.  You were right all along.  I am going to increase your points by an extra 50 for putting up with my dumb questions.  

Thank you very much.

TJ
0
 
LVL 12

Expert Comment

by:rwilson032697
ID: 2383556
I'm glad you found it! I don't believe there are dumb questions - sometimes the obvious problems are the hardest to find!

Good luck!

Cheers,

Raymond.
0

Featured Post

Get your problem seen by more experts

Be seen. Boost your question’s priority for more expert views and faster solutions

Question has a verified solution.

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

Introduction The parallel port is a very commonly known port, it was widely used to connect a printer to the PC, if you look at the back of your computer, for those who don't have newer computers, there will be a port with 25 pins and a small print…
Hello everybody This Article will show you how to validate number with TEdit control, What's the TEdit control? TEdit is a standard Windows edit control on a form, it allows to user to write, read and copy/paste single line of text. Usua…
Enter Foreign and Special Characters Enter characters you can't find on a keyboard using its ASCII code ... and learn how to make a handy reference for yourself using Excel ~ Use these codes in any Windows application! ... whether it is a Micr…
Is your organization moving toward a cloud and mobile-first environment? In this transition, your IT department will encounter many challenges, such as navigating how to: Deploy new applications and services to a growing team Accommodate employee…

599 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