unit Unit25;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls;
type
TForm25 =
class(TForm)
Button1: TButton;
procedure Button1Click(Sender: TObject);
private
{ Private-Deklarationen }
public
{ Public-Deklarationen }
end;
var
Form25: TForm25;
implementation
{$R *.dfm}
type
TExecuteWaitEvent =
procedure(
const ProcessInfo: TProcessInformation;
var ATerminate: Boolean)
of object;
procedure ExecuteFile(
const AFilename:
String;
AParameter, ACurrentDir:
String; AWait: Boolean;
AOnWaitProc: TExecuteWaitEvent=nil);
var
si: TStartupInfo;
pi: TProcessInformation;
bTerminate: Boolean;
begin
bTerminate := False;
if Length(ACurrentDir) = 0
then
ACurrentDir := ExtractFilePath(AFilename);
if AnsiLastChar(ACurrentDir) = '
\'
then
Delete(ACurrentDir, Length(ACurrentDir), 1);
FillChar(si, SizeOf(si), 0);
with si
do begin
cb := SizeOf(si);
dwFlags := STARTF_USESHOWWINDOW;
wShowWindow := SW_NORMAL;
end;
FillChar(pi, SizeOf(pi), 0);
AParameter := Format('
"%s" %s', [AFilename, TrimRight(AParameter)]);
if CreateProcess(
Nil, PChar(AParameter),
Nil,
Nil, False,
CREATE_DEFAULT_ERROR_MODE
or CREATE_NEW_CONSOLE
or
NORMAL_PRIORITY_CLASS,
Nil, PChar(ACurrentDir), si, pi)
then
try
if AWait
then
while WaitForSingleObject(pi.hProcess, 50) <> Wait_Object_0
do
begin
if Assigned(AOnWaitProc)
then
begin
AOnWaitProc(pi, bTerminate);
if bTerminate
then
TerminateProcess(pi.hProcess, Cardinal(-1));
end;
Application.ProcessMessages;
end;
finally
CloseHandle(pi.hProcess);
CloseHandle(pi.hThread);
end;
end;
procedure TForm25.Button1Click(Sender: TObject);
begin
ExecuteFile('
c:\hhm.exe', '
', '
', false);
end;
end.