Mega Code Archive
Start a program and wait for its termination
<![CDATA[
// 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: string; const 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;
]]>