How to stop an application and make it wait until the BDE is installed

Problem/Question/Abstract:

I have a CD-ROM catalog Paradox application. When it is run, it checks if the BDE is installed. If it raises an exception, I do:

ShellExecute(handle, 'open', PChar(ExtractFilePath(Application.ExeName) +
  'BDESetup\Setup.exe), '', nil , SW_SW_SHOWMINNOACTIVE);

My problem is, that the application continues to run before the BDE is installed.

Answer:

The following unit contains two functions that might solve your problem.

The two functions defined in the unit below provide two alternative ways to allow an application to call another application and wait for it to exit before continuing. The called application can be a Win32 app, a Win16 app, or a DOS app. To call a batch file or an internal command.com or cmd.exe command, use something like: 'command.com' or 'cmd.exe' as the app, and '/c dir' as the parameter.

If you want the user to see the app's window, then pass SW_SHOW as the Visibility parameter. If you want to hide it, pass SW_HIDE (defined in Windows.pas).

If the called application cannot be run, then the function returns false, and you can use GetLastError to get an error code, and use SysErrorMessage to turn that into a text error message, if necessary.

If the called application runs, then the function returns true. If the called application runs, but signals an abnormal termination by setting its Exit Code to a non-zero value (rare among Windows applications) but common among DOS utilities), then this Exit Code can be seen in the final var parameter ResultingExitCode.

The wait loop includes a Windows message loop which explicitly looks out for a wm_Quit message to allow the calling application to be closed even if the called application hangs.

unit Exec;

{
Author: Bill Sparrow (bsparrow@cix.co.uk)
Revision history in reverse chronological order:-
13/10/1999  WFS  Original version, tested only in Delphi 3 on NT4 SP3.

Acknowledgements: the code borrows heaviliy from two contributions
posted on the CIX Conferencing system, one of which in turn borrows
from a Compuserve posting:

  magsys@cix.co.uk cix:borland/3delphi32:3488 29/07/1998.
  Francis PARLANT CIS : 100113,3015.
  jatkins@cix.co.uk cix:borland/6delphi:3540 01/11/1998
}

interface

uses Windows;

function ShellExecAndWait(App, Params: string; Visibility: Integer;
  var ResultingExitCode: DWord): Boolean;

function CreateProcAndWait(App, Params: string; Visibility: Word;
  var ResultingExitCode: DWord): Boolean;

implementation

uses
  shellAPI, {for ShellExecuteEx, TShellExecuteInfo, etc.}
  Messages; {for WM_QUIT}

{
Based on a version from jatkins@cix.co.uk cix: borland / 6 delphi: 3540
01 / 11 / 1998
}

{
One advantage of ShellExecuteEx is that it can find the path to the executable without you having to specify it in full, so long as the app has set a registry key under the appropriate App Paths branch.

Another is that instead of passing an application name plus a document filename as a parameter, you can just pass the document name. So long as the document file type has an association, Windows will find the appropriate application to open the document.

ShellExecuteEx is presumably what gets called when you double click a file in Windows Explorer to open it.

Without SEE_MASK_FLAG_NO_UI, if ShellExecuteEx encounters an error, it will display an error dialog to the user before returning False. Furthermore, the text of the error dialog may be an inappropriate level for the user. For instance, if you try to open a document for which there is no association, the error dialog tells the user to set up an association. Turning off the UI allows us to handle the error ourselves and put up an error dialog if appropriate.
}

function ShellExecAndWait(App, Params: string; Visibility: Integer;
  var ResultingExitCode: DWord): Boolean;
var
  Msg: TMsg;
  E: TShellExecuteInfo;
begin
  FillChar(E, SizeOf(E), 0); {Superfulous, but what the heck!}
  E.cbSize := sizeof(E);
  E.fMask := SEE_MASK_NOCLOSEPROCESS or SEE_MASK_FLAG_NO_UI;
  E.wnd := 0; {Still not sure about leaving this at zero}
  E.lpVerb := nil; {Defaults to 'open'}
  E.lpFile := PChar(App); {Application or document to open}
  E.lpParameters := PChar(Params); {Optional Command line parameter to pass}
  E.lpDirectory := nil; {Defaults to current directory}
  E.nShow := Visibility; {E.g. SW_SHOW or SW_HIDE}
  if ShellExecuteEx(@E) then
  begin
    repeat
      while PeekMessage(Msg, 0, 0, 0, pm_Remove) do
      begin
        if Msg.Message = wm_Quit then
          Halt(Msg.WParam);
        TranslateMessage(Msg);
        DispatchMessage(Msg);
      end;
    until
      WaitForSingleObject(E.hProcess, 50) <> WAIT_TIMEOUT;
    GetExitCodeProcess(E.hProcess, ResultingExitCode);
    CloseHandle(E.hProcess); {Prevent leakage}
    Result := True; {ShellExecuteEx succeeded}
  end
  else
  begin
    ResultingExitCode := 1; {Just so that it is not left undefined}
    Result := False; {ShellExecuteEx failed}
  end;
end;

{From the Win32 help for CreateProcess...

"The created process remains in the system until all threads within the process have
  terminated and all handles to the process and any of its threads have been closed
  through calls to CloseHandle.The handles for both the process and the main
        thread must be closed through calls to CloseHandle.If these handles are not needed,
        it is best to close them immediately after the process is created."

Testing this under NT4 shows a memory leak of 12 K if you don't close the handles.
}

{Based on a version from magsys@cix.co.uk cix:borland/3delphi32:3488
29/07/1998.}

function CreateProcAndWait(App, Params: string; Visibility: Word;
  var ResultingExitCode: DWord): Boolean;
var
  Msg: TMsg;
  SI: TStartupInfo;
  PI: TProcessInformation;
  CommandLine: string;
begin
  FillChar(SI, SizeOf(SI), 0);
  SI.cb := SizeOf(SI);
  SI.dwFlags := STARTF_USESHOWWINDOW or STARTF_FORCEONFEEDBACK;
  SI.wShowWindow := Visibility; {E.g. SW_SHOW or SW_HIDE}

  {The first whitespace-delimited 'parameter' in the lpCommandLine needs to be the
  app's path and file name if any following 'real' parameters are to be correctly
  seen by the called application.
  Setting lpApplicationName is optional so long as we comply with the above. If
  we did also set lpApplicationName, however, we would have to ensure that the copy in
  lpCommandLine was in quotes in case it contains a space. If we leave
        lpApplicationName as nil, Windows takes care of this problem for us. Also, if the
   called app is 16 bit, we have to do it this way! On second thoughts, relying on
   Windows to do the quoting would leave us
  open to an ambiguity, so do it explicitly.}

  {If the app's filename contains a space, and is not already quoted, then quote it...}
  if (Pos(' ', App) <> 0) and (Pos('"', App) = 0) then
    CommandLine := '"' + App + '"'
  else
    CommandLine := App;
  {Join the App and the Params into one string with a space between them...}
  if (App <> '') and (Params <> '') then
    CommandLine := CommandLine + ' ';
  CommandLine := CommandLine + Params;
  if CreateProcess(nil, PChar(CommandLine), nil, nil, False, 0, nil, nil, SI, PI) then
  begin
    repeat
      while PeekMessage(Msg, 0, 0, 0, pm_Remove) do
      begin
        if Msg.Message = wm_Quit then
          Halt(Msg.WParam);
        TranslateMessage(Msg);
        DispatchMessage(Msg);
      end;
    until
      WaitForSingleObject(PI.hProcess, 50) <> WAIT_TIMEOUT;
    GetExitCodeProcess(PI.hProcess, ResultingExitCode);
    CloseHandle(PI.hThread); {Prevent leakage}
    CloseHandle(PI.hProcess); {Prevent leakage}
    Result := True; {CreateProcess succeeded}
  end
  else
  begin
    ResultingExitCode := 1; {Just so that it is not left undefined}
    Result := False; {CreateProcess failed}
  end;
end;

end.