Control Execute from other Programms

Das Ausführen von Programmen aus dem eigenen Programm heraus kann auf verschiedene Arten und Weise gestaltet werden. Das eigene Programm ist auch in der Lage, den anderen Prozess abzuwarten oder auch nicht.

Die folgenden Funktionen demonstrieren das Verhalten des eigenen Programms gegenüber den Programmen, die ausgeführt werden. 

Starten und warten bis Programm beendet wird :

function WinExecAndWait32(FileName: string; Visibility: Integer): Longword;
var
  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,nil,nil,False,CREATE_NEW_CONSOLE or
    NORMAL_PRIORITY_CLASS,nil,nil,StartupInfo,ProcessInfo)
    then Result := WAIT_FAILED
  else
  begin
    WaitForSingleObject(ProcessInfo.hProcess, INFINITE);
    GetExitCodeProcess(ProcessInfo.hProcess, Result);
    CloseHandle(ProcessInfo.hProcess);
    CloseHandle(ProcessInfo.hThread);
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  WinExecAndWait32('c:\windows\Sysnative\notepad.exe', 1);
end;

Das warten verhindern und eigenes Programm Steuerbar machen :

function ExecAndWait(const FileName: string; const CmdShow: Integer): Longword;
var
  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,nil,nil,False,CREATE_NEW_CONSOLE or
    NORMAL_PRIORITY_CLASS,nil,nil,StartupInfo,ProcessInfo)
    then Result := WAIT_FAILED
  else
  begin
    while WaitForSingleObject(ProcessInfo.hProcess, 0) = WAIT_TIMEOUT do
    begin
      Application.ProcessMessages;
      Sleep(50);
    end;
    WaitForSingleObject(ProcessInfo.hProcess, INFINITE);
    GetExitCodeProcess(ProcessInfo.hProcess, Result);
    CloseHandle(ProcessInfo.hProcess);
    CloseHandle(ProcessInfo.hThread);
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  ExecAndWait('c:\windows\Sysnative\notepad.exe', SW_SHOW);
end;

Warten bis Programm beendet wird :

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,False,INFINITE,QS_PAINT or
        QS_SENDMESSAGE);
      if ret = WAIT_FAILED then Exit;
      if ret = (WAIT_OBJECT_0 + 1) then
      begin
        while PeekMessage(Msg, 0, WM_PAINT, WM_PAINT, PM_REMOVE) do
          DispatchMessage(Msg);
      end;
    until ret = WAIT_OBJECT_0;
  end;
var
  zAppName: array[0..512] of char;
  StartupInfo: TStartupInfo;
  ProcessInfo: TProcessInformation;
begin
  StrPCopy(zAppName, FileName);
  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
    Result := DWORD(-1)
  else
  begin
    Waitfor(ProcessInfo.hProcess);
    GetExitCodeProcess(ProcessInfo.hProcess, Result);
    CloseHandle(ProcessInfo.hProcess);
    CloseHandle(ProcessInfo.hThread);
  end;
end;

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

Mit ShellExecute Programm weiter Steuerbar machen :

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('c:\windows\Sysnative\notepad.exe', 'Parameter');
end;

Mit ShellExecute warten bis Programm beendet wird :

uses ShellApi

function ShellExecute_Wait(Operation, FileName, Parameter, Directory: string;
  Show: Word; bWait: Boolean): Longint;
var
  bOK: Boolean;
  Info: TShellExecuteInfo;
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;

procedure TForm1.Button1Click(Sender: TObject);
begin
  ShellExecute_AndWait('notepad.exe', 'c:\windows\Sysnative\notepad.exe')
end;