{************************************************************************}
{* *}
{* file : Launch.PAS *}
{* *}
{* type : unit *}
{* *}
{* location : \QUIRT\SRC\DELPHI *}
{* *}
{* purpose : Launch external programs *}
{* *}
{* author : Lennert Ploeger (NKI / AVL) *}
{* *}
{* date : 19980325 *}
{* *}
{* portability: 32 bit delphi only (V2.0 up) *}
{* *}
{* notes : None *}
{* *}
{************************************************************************}
{* Updates:
When Who What
19980325 lsp Created
19980331 lsp Search for programs in PATH using SearchPath()
19980609 lsp Allow white-spaces for the program to launch
19980709 lsp Allow 'prog' to be empty in StartProgram
19980731 lsp Enclose both file and directory names in double quotes
19980901 lsp Removed some obsolete functions
19981004 mvh Added RunProgram (waits until ready)
19981005 mvh Renamed to RunProgramBlocking (waits until ready)
19981020 lsp Program launched in RunProgramBlocking() is started
minimized and not given focus
19990110 mvh RunProgramBlocking returns value
19990111 lsp Fixed comment about CloseHandle()
19990112 mvh Added RunProgramWaiting, shortened code by reuse
19990425 lsp FileUtil -> QFileUtil
19990609 lsp Removed QFileUtil dependency
20000114 lsp Added show option to StartProgram
20000502 lsp+mvh Fixed argument passing for batch files
20020802 lsp More tweaking on passing command line arguments: only
enclose file names when they contain spaces
20021024 lsp Implemented show=false by passing
SW_HIDE instead of SW_SHOWMINNOACTIVE
20040427 mvh ELEKTA NKI-XVI0.1a RELEASE
20040608 mvh WBH NKI-XVI0.1b RELEASE (for testing only)
20041024 lsp Also pass SW_HIDE instead of SW_SHOWMINNOACTIVE when
started from RunProgramBlocking()
20060521 mvh Merged
20060817 mvh ELEKTA NKI-XVI3.01 RESEARCHRELEASE
20080306 lsp Added bSilent option
20080415 mvh Return -1 status if program could not be started
20080522 mvh ELEKTA NKI-XVI4.13alpha RELEASE
20080716 lsp Corrected error handling
20081102 mvh ELEKTA NKI-XVI4.15alpha RELEASE
20081112 lsp Allow to pass extra params as part of "prog"
20081128 sr Added RunMultipleProgramsWaiting
20090114 mvh ELEKTA NKI-XVI4.22 RELEASE
20090302 sr Added bSequential option to RunMultipleProgramsWaiting
20090319 mvh ELEKTA NKI-XVI4.23 RELEASE
20090730 lsp Blocked out FileDirNameWin32FindData()
20090805 mvh+lsp ELEKTA NKI-XVI4.29 RELEASE
20091027 jn Added $mode delphi to be able to compile in Lazarus
20091029 sr Added mode option to RunProgramBlocking
20100916 jd Made compatible with Delphi XE (2011)
20101105 jn Added sleeptime parameter for runmultipleprogramswaiting, default 0
20101129 lsp Append .exe when prog is not found, prefix long paths,
solve Delphi XE (20100916) problem by excluding FileCtrl
20110103 jn Merged
20110216 lsp Removed QFileUtil dependency once again (sorry Marcel):
on Vista (x64) there are no programs that accept a path
exceeding MAX_PATH characters, FileCtrl still needed for D5
20110324 lsp Do not add extra parameters to each file in ProgramStarter(),
allow to leave out the .exe extension, added info about
starting batch files.
20110325 lsp Pass nil for the first argument to CreateProcess() to
be able to start batch files containing spaces,
no longer call LongToShortPath() for batch files (not
needed on XP and Vista),
enclose all arguments containing spaces in double quotes,
not only existing files or directories
20110516 lsp Removed unused TestExistence(), LongToShortFileName() and
LongToShortPath()
20120302 lsp Require quotes for program file names containing spaces
with implicit arguments (See 20081128)
20121127 lsp Add quote characters only when necessary in ProgramStarter()
20140710 lsp Resolved XE6 warnings
*}
unit Launch;
{$ifndef VER130}
{$WARN UNIT_PLATFORM OFF}
{$WARN SYMBOL_PLATFORM OFF}
{$warn unsafe_type off}
{$warn unsafe_code off}
{$warn unsafe_cast off}
{$endif}
{$IFDEF FPC}
{$mode delphi}
{$ENDIF}
interface
uses
Windows;
type
TStringDynArray = array of string;
function LocateProgramInSearchPath(ProgramName: string): string;
function StartProgram(prog, workdir: string; params: array of string; show: boolean = true; const bSilent: boolean=False): boolean;
function RunProgramBlocking(prog, workdir: string; params: array of string; mode: integer=SW_HIDE): integer;
function RunProgramWaiting(prog, workdir: string; params: array of string): integer;
function RunMultipleProgramsWaiting(prog, workdir: string; params: array of TStringDynArray; bSequential: boolean=false; sleeptime : integer=0): boolean;
implementation
uses
System.UITypes,
SysUtils, Dialogs, Forms{, Compatibility}
{$IFDEF VER130}
, FileCtrl
{$ENDIF VER130}
;
// Routine to retrieve file information using a file/dirname
(*function FileDirNameWin32FindData(FullPathName: string; var Win32FindData: TWin32FindData): boolean;
var
Handle: THandle;
begin
Handle := FindFirstFile(PChar(FullPathName), Win32FindData);
if Handle <> INVALID_HANDLE_VALUE then
begin
Windows.FindClose(Handle);
Result := True;
end
else
Result := False;
end;*)
// Search for 'ProgramName' in %PATH% using Win API function 'SearchPath'
function LocateProgramInSearchPath(ProgramName: string): string;
type
BufType = array[0..MAX_PATH] of char;
var
SPPath: BufType;
PathPtr: PChar;
begin
PathPtr := nil;
if SearchPath(nil, PChar(ProgramName), '.exe', MAX_PATH, SPPath, PathPtr)>0 then
Result := StrPas(SPPath)
else
Result := ProgramName;
end;
// Internal common code for the 3 exported program starters
function ProgramStarter(prog, workdir: string;
params: array of string; showmode: integer; const bSilent: boolean=False): integer;
var
StartInf : TStartupInfo;
ProcInf : TProcessInformation;
args : string;
pworkdir : PChar;
i : integer;
begin
// It appears that it is also possible to call ShellExecute, what seems
// to be a bit a higher level function:
// ShellExecute(handle, "open", path_to_file, NULL, NULL, SW_SHOWNORMAL);
// Another alternative can be calling WinExec, but with the drawback of
// not having the possibility to specify the work directory.
ZeroMemory(@StartInf, sizeof(TStartupInfo));
ZeroMemory(@ProcInf, sizeof(TProcessInformation));
StartInf.cb := sizeof(TStartupInfo);
StartInf.dwFlags := STARTF_USESHOWWINDOW;
StartInf.wShowWindow := showmode;
// prog may include implicit arguments. When the program file name contains
// spaces, the program file in prog should be surrounded with quotes. When
// prog contains spaces but no quotes, this function will add surrounding quotes.
if (Pos(' ', prog)>0) and (Pos('"', prog)<=0) then
args := '"' + prog + '"'
else
args := prog;
for i:=low(params) to high(params) do
begin
// Enclose arguments containing spaces in double quotes to get them
// seperated properly
if Pos(' ', params[i])>0 then
begin
if (Length(args)>0) then // Try to add spaces only when necessary
args := args + ' ' + AnsiQuotedStr(AnsiDequotedStr(params[i], '"'), '"')
else
args := AnsiQuotedStr(AnsiDequotedStr(params[i], '"'), '"');
end
else
begin
if Length(args)>0 then // Try to add spaces only when necessary
args := args + ' ' + params[i]
else
args := params[i]
end
end;
if Length(workdir)>0 then
pworkdir := PChar(workdir)
else
pworkdir := nil;
// According to MSDN batch files need special treatment:
// <q http://msdn.microsoft.com/en-us/library/ms682425%28v=vs.85%29.aspx>
// To run a batch file, you must start the command interpreter; set
// lpApplicationName to cmd.exe and set lpCommandLine to the following arguments:
// /c plus the name of the batch file.
// </q>
// On Vista x64 this does not work directly. Instead of cmd.exe one should pass
// the full path (e.g. c:\Windows\System32\cmd.exe), as follows from "The function
// will not use the search path".
//
// However, it is also possible to run the batch file just like any other
// executable (although pre-XP versions did not always allow spaces, which
// were converted to short paths), so we will not call cmd.exe here.
if not CreateProcess(nil, PChar(args), nil, nil, False, 0, nil,
pworkdir, StartInf, ProcInf) then
begin
if not bSilent then
MessageDlg('Unable to run: '#13#10'''' + args + '''', mtError, [mbOk], 0);
result := 0; // ProcInf.hProcess turns out to be 0 when CreateProcess() fails
end
else
result := ProcInf.hProcess;
// The handles for both the process and the main thread must be closed through
// calls to CloseHandle. The handle to ProcInf.hThread is not needed, so it is
// best to close it immediately after the process is created. ProcInf.hProcess
// may be needed by the caller.
CloseHandle(ProcInf.hThread);
end;
// routine to start program 'prog' using the file-parameters in 'params'.
// Be carefull with passing [] for the params, since the stackpointer seems
// to get corrupt. However, starting a program with no arguments can be done
// using StartProgram(program, workdir, [ ' ' ]).
function StartProgram(prog, workdir: string; params: array of string; show: boolean=True; const bSilent: boolean=False): boolean;
var
hProcess: integer;
begin
if show then
hProcess := ProgramStarter(prog, workdir, params, SW_SHOWDEFAULT, bSilent)
else
hProcess := ProgramStarter(prog, workdir, params, SW_HIDE, bSilent);
CloseHandle(hProcess);
Result := hProcess<>0
end;
// routine to run program 'prog' using the file-parameters in 'params'.
// and wait until it is finished
// Be careful with passing [] for the params, since the stackpointer seems
// to get corrupt. However, starting a program with no arguments can be done
// using StartProgram(program, workdir, [ ' ' ]).
function RunProgramBlocking(prog, workdir: string; params: array of string; mode: integer=SW_HIDE): integer;
var
hProcess: integer;
j : Cardinal;
begin
hProcess := ProgramStarter(prog, workdir, params, mode { use SW_SHOWMINNOACTIVE when more feed back is desired });
if hProcess=0 then
begin
result := -1; // The return value of this function is the exit code of the process.
exit; // Because exit codes are stored as an unsigned integer, we use -1 to
end; // indicate an error.
WaitForSingleObject(hProcess, INFINITE);
GetExitCodeProcess(hProcess, j);
result := integer(j);
CloseHandle(hProcess);
end;
// routine to run program 'prog' using the file-parameters in 'params'.
// and wait until it is finished. During the wait, however, messages are
// processed so that the user interface remains 'live'.
function RunProgramWaiting(prog, workdir: string; params: array of string): integer;
var
hProcess: integer;
j : Cardinal;
begin
hProcess := ProgramStarter(prog, workdir, params, SW_SHOWMINNOACTIVE);
if hProcess=0 then
begin
result := -1; // The return value of this function is the exit code of the process.
exit; // Because exit codes are stored as an unsigned integer, we use -1 to
end; // indicate an error.
while WaitForSingleObject(hProcess, 10) = WAIT_TIMEOUT do
Application.ProcessMessages;
GetExitCodeProcess(hProcess, j);
result := integer(j);
CloseHandle(hProcess);
end;
// routine to run program 'prog' using the file-parameters in 'params'.
// and wait until it is finished. During the wait, however, messages are
// processed so that the user interface remains 'live'.
function RunMultipleProgramsWaiting(prog, workdir: string; params: array of TStringDynArray; bSequential: boolean=false; sleeptime : integer=0): boolean;
var
hProcess: array of integer;
j : Cardinal;
i : integer;
begin
result := true;
SetLength(hProcess,Length(params));
//Run all
for i:=0 to Length(params)-1 do
begin
hProcess[i] := ProgramStarter(prog, workdir, params[i], SW_SHOWMINNOACTIVE);
if sleeptime > 0 then
sleep(sleeptime);
if hProcess[i]=0 then
begin
result := false;
exit;
end;
if bSequential then
begin
while WaitForSingleObject(hProcess[i], 10) = WAIT_TIMEOUT do
Application.ProcessMessages;
GetExitCodeProcess(hProcess[i], j);
if (hProcess[i]=0) then
begin
CloseHandle(hProcess[i]);
result := false;
exit;
end;
CloseHandle(hProcess[i]);
end;
end;
//Wait all
if not bSequential then
for i:=0 to Length(params)-1 do
begin
while WaitForSingleObject(hProcess[i], 10) = WAIT_TIMEOUT do
Application.ProcessMessages;
GetExitCodeProcess(hProcess[i], j);
result := result and (hProcess[i]<>0);
CloseHandle(hProcess[i]);
end;
end;
end.
TreeComp is an example of a Delphi program using this code.
Thanks to Jimmy Harlindong for the program to generate the HTML-code out of the pascal source file (PastaHTML).