...start a program and wait for its termination?

Author: Thomas Stutz

Category: Files

// With CreateProcess:
//*****************************************************

{1}

function WinExecAndWait32(FileName: string; Visibility: Integer): Longword;
var { by Pat Ritchey }
  
zAppName: array[0..512] of Char;
  zCurDir: array[0..255] of Char;
  WorkDir: string;
  StartupInfo: TStartupInfo;
  ProcessInfo: TProcessInformation;
begin
  
StrPCopy(zAppName, FileName);
  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, // pointer to command line string
    
nil// pointer to process security attributes
    
nil// pointer to thread security attributes
    
False, // handle inheritance flag
    
CREATE_NEW_CONSOLE or // creation flags
    
NORMAL_PRIORITY_CLASS,
    nil//pointer to new environment block
    
nil// pointer to current directory name
    
StartupInfo, // pointer to STARTUPINFO
    
ProcessInfo) // pointer to PROCESS_INF
    
then Result := WAIT_FAILED
  else
  begin
    
WaitForSingleObject(ProcessInfo.hProcess, INFINITE);
    GetExitCodeProcess(ProcessInfo.hProcess, Result);
    CloseHandle(ProcessInfo.hProcess);
    CloseHandle(ProcessInfo.hThread);
  end;
end{ WinExecAndWait32 }


procedure TForm1.Button1Click(Sender: TObject);
begin
  
WinExecAndWait32('notepad.exe', False, True);
end;

{*******************************}

{2} 
"Anti-Freezing":

function ExecAndWait(const FileName: stringconst CmdShow: Integer): Longword;
var { by Pat Ritchey }
  
zAppName: array[0..512] of Char;
  zCurDir: array[0..255] of Char;
  WorkDir: string;
  StartupInfo: TStartupInfo;
  ProcessInfo: TProcessInformation;
  AppIsRunning: DWORD;
begin
  
StrPCopy(zAppName, FileName);
  GetDir(0, WorkDir);
  StrPCopy(zCurDir, WorkDir);
  FillChar(StartupInfo, SizeOf(StartupInfo), #0);
  StartupInfo.cb          := SizeOf(StartupInfo);
  StartupInfo.dwFlags     := STARTF_USESHOWWINDOW;
  StartupInfo.wShowWindow := CmdShow;
  if not CreateProcess(nil,
    zAppName, // pointer to command line string
    
nil// pointer to process security attributes
    
nil// pointer to thread security attributes
    
False, // handle inheritance flag
    
CREATE_NEW_CONSOLE or // creation flags
    
NORMAL_PRIORITY_CLASS,
    nil//pointer to new environment block
    
nil// pointer to current directory name
    
StartupInfo, // pointer to STARTUPINFO
    
ProcessInfo) // pointer to PROCESS_INF
    
then Result := WAIT_FAILED
  else
  begin
    while 
WaitForSingleObject(ProcessInfo.hProcess, 0) = WAIT_TIMEOUT do
    begin
      
Application.ProcessMessages;
      Sleep(50);
    end;
    {
    // or:
    repeat
      AppIsRunning := WaitForSingleObject(ProcessInfo.hProcess, 100);
      Application.ProcessMessages;
      Sleep(50);
    until (AppIsRunning <> WAIT_TIMEOUT);
    }

    
WaitForSingleObject(ProcessInfo.hProcess, INFINITE);
    GetExitCodeProcess(ProcessInfo.hProcess, Result);
    CloseHandle(ProcessInfo.hProcess);
    CloseHandle(ProcessInfo.hThread);
  end;
end{ WinExecAndWait32 }

procedure TForm1.Button1Click(Sender: TObject);
begin
  
ExecAndWait('C:\Programme\WinZip\WINZIP32.EXE', SW_SHOW);
end;


{3}

{--WinExecAndWait32V2 ------------------------------------------------}
{: Executes a program and waits for it to terminate
@Param FileName contains executable + any parameters
@Param Visibility is one of the ShowWindow options, e.g. SW_SHOWNORMAL
@Returns -1 in case of error, otherwise the programs exit code
@Desc In case of error SysErrorMessage( GetlastError ) will return an
  error message. The routine will process paint messages and messages
  send from other threads while it waits.
}{ Created 27.10.2000 by P. Below
-----------------------------------------------------------------------}

function WinExecAndWait32V2(FileName: string; Visibility: Integer): DWORD;
  procedure WaitFor(processHandle: THandle);
  var
    
Msg: TMsg;
    ret: DWORD;
  begin
    repeat
      
ret := MsgWaitForMultipleObjects(1, { 1 handle to wait on }
        
processHandle, { the handle }
        
False, { wake on any event }
        
INFINITE, { wait without timeout }
        
QS_PAINT or { wake on paint messages }
        
QS_SENDMESSAGE { or messages from other threads }
        
);
      if ret = WAIT_FAILED then Exit; { can do little here }
      
if ret = (WAIT_OBJECT_0 + 1) then
      begin
          
{ Woke on a message, process paint messages only. Calling
            PeekMessage gets messages send from other threads processed. }
        
while PeekMessage(Msg, 0, WM_PAINT, WM_PAINT, PM_REMOVE) do
          
DispatchMessage(Msg);
      end;
    until ret = WAIT_OBJECT_0;
  end{ Waitfor }
var { V1 by Pat Ritchey, V2 by P.Below }
  
zAppName: array[0..512] of char;
  StartupInfo: TStartupInfo;
  ProcessInfo: TProcessInformation;
begin { WinExecAndWait32V2 }
  
StrPCopy(zAppName, FileName);
  FillChar(StartupInfo, SizeOf(StartupInfo), #0);
  StartupInfo.cb          := SizeOf(StartupInfo);
  StartupInfo.dwFlags     := STARTF_USESHOWWINDOW;
  StartupInfo.wShowWindow := Visibility;
  if not CreateProcess(nil,
    zAppName, { pointer to command line string }
    
nil{ pointer to process security attributes }
    
nil{ pointer to thread security attributes }
    
False, { handle inheritance flag }
    
CREATE_NEW_CONSOLE or { creation flags }
    
NORMAL_PRIORITY_CLASS,
    nil{ pointer to new environment block }
    
nil{ pointer to current directory name }
    
StartupInfo, { pointer to STARTUPINFO }
    
ProcessInfo) { pointer to PROCESS_INF } then
    
Result := DWORD(-1) { failed, GetLastError has error code }
  
else
  begin
    
Waitfor(ProcessInfo.hProcess);
    GetExitCodeProcess(ProcessInfo.hProcess, Result);
    CloseHandle(ProcessInfo.hProcess);
    CloseHandle(ProcessInfo.hThread);
  end{ Else }
end{ WinExecAndWait32V2 }


procedure TForm1.Button1Click(Sender: TObject);
begin
  
WinExecAndWait32V2('notepad.exe', SW_SHOWNORMAL);
end;


// With ShellExecuteEx:
//*****************************************************

{1}

uses
  
ShellApi;

procedure ShellExecute_AndWait(FileName: string; Params: string);
var
  
exInfo: TShellExecuteInfo;
  Ph: DWORD;
begin
  
FillChar(exInfo, SizeOf(exInfo), 0);
  with exInfo do
  begin
    
cbSize := SizeOf(exInfo);
    fMask := SEE_MASK_NOCLOSEPROCESS or SEE_MASK_FLAG_DDEWAIT;
    Wnd := GetActiveWindow();
    ExInfo.lpVerb := 'open';
    ExInfo.lpParameters := PChar(Params);
    lpFile := PChar(FileName);
    nShow := SW_SHOWNORMAL;
  end;
  if ShellExecuteEx(@exInfo) then
    
Ph := exInfo.HProcess
  else
  begin
    
ShowMessage(SysErrorMessage(GetLastError));
    Exit;
  end;
  while WaitForSingleObject(ExInfo.hProcess, 50) <> WAIT_OBJECT_0 do
    
Application.ProcessMessages;
  CloseHandle(Ph);
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  
ShellExecute_AndWait('FileName', 'Parameter');
end;



{*******************************}

{2}

function ShellExecute_AndWait(Operation, FileName, Parameter, Directory: string;
  Show: Word; bWait: Boolean): Longint;
var
  
bOK: Boolean;
  Info: TShellExecuteInfo;
{
  ****** Parameters ******
  Operation:

  edit  Launches an editor and opens the document for editing.
  explore Explores the folder specified by lpFile.
  find Initiates a search starting from the specified directory.
  open Opens the file, folder specified by the lpFile parameter.
  print Prints the document file specified by lpFile.
  properties Displays the file or folder's properties.

  FileName:

  Specifies the name of the file or object on which
  ShellExecuteEx will perform the action specified by the lpVerb parameter.

  Parameter:

  String that contains the application parameters.
  The parameters must be separated by spaces.

  Directory:

  specifies the name of the working directory.
  If this member is not specified, the current directory is used as the working directory.

  Show:

  Flags that specify how an application is to be shown when it is opened.
  It can be one of the SW_ values

  bWait:

  If true, the function waits for the process to terminate
}
begin
  
FillChar(Info, SizeOf(Info), Chr(0));
  Info.cbSize := SizeOf(Info);
  Info.fMask := SEE_MASK_NOCLOSEPROCESS;
  Info.lpVerb := PChar(Operation);
  Info.lpFile := PChar(FileName);
  Info.lpParameters := PChar(Parameter);
  Info.lpDirectory := PChar(Directory);
  Info.nShow := Show;
  bOK := Boolean(ShellExecuteEx(@Info));
  if bOK then
  begin
    if 
bWait then
    begin
      while
        
WaitForSingleObject(Info.hProcess, 100) = WAIT_TIMEOUT
        do Application.ProcessMessages;
      bOK := GetExitCodeProcess(Info.hProcess, DWORD(Result));
    end
    else
      
Result := 0;
  end;
  if not bOK then Result := -1;
end;

 

printed from
www.swissdelphicenter.ch
developers knowledge base