Hi there,
Me and a buddy are having trouble in getting shellexecute to work in delphi 7. No matter what permetation of the word shellexecute i use, when i want to run the app shellexecute is not recognized. so how do i get shellexecute to work. been trying to get it to open an exe on my hdd. say something like winamp just to test it out.
Can anybody please help us with this.
Thank you in advance,
Vdub.za
Here is d6 code demonstrating how to call shell execute:
procedure TMainFm.Button1Click(Sender: TObject);
Var
p: PChar;
begin
p := 'C:\file path\appname.exe';
ShellExecute(
0,
'open',
p,
nil,
nil,
SW_SHOW);
end;You also need to add ShellApi to the uses statement for the unit.
Hi
I tried it, but is stopped at VAR and reported procedure expected, but variable found. doesnt want to run. what did i do wrong?
Hi
I tried it, but is stopped at VAR and reported procedure expected, but variable found. doesnt want to run. what did i do wrong?
try:
procedure TMainFm.Button1Click(Sender: TObject);
Var p : string;
begin
p := 'C:\file path\appname.exe';
ShellExecute(0,'open',pchar(p),nil,nil,SW_SHOWNORMAL);
end;Gianni
There is a very good unit called Launch.pas out there in the net, i grabbed it time ago and have added more functions over the time (not in the authors initial text, sorry), like one to wait until some exe drop below 1%CPU usage.
I copy it here so you can add to your app if useful:
{************************************************************************}
{* *}
{* 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
*}
unit Launch;
interface
//Para pasar de ProcId a THandle
type
TWindowRec = record
Handle: THandle;
ProcessId: Cardinal;
WindowName: PChar;
end;
PWindowRec = ^TWindowRec;
function LocateProgramInSearchPath(ProgramName: string): string;
procedure StartProgram(prog, workdir: string; params: array of string);
function RunProgramBlocking(prog, workdir: string; params: array of string): integer;
function RunFileBlocking(fichero: string): boolean;
function RunProgramWaiting(prog, workdir: string; params: array of string): integer;
function ProgramStarter(prog, workdir: string; params: array of string; showmode: integer): integer;
//HCSoft...
//Localizar Handler de un proceso a partir del filename del ejecutable
function GetProcHandle(ExeFileName: string): THandle;
//Hacer cosas a partir del THandle...
function KillProc(H: THandle): boolean;
function WaitProcIddle(H: THandle; MinSeg: double = 1; MaxSeg: double = 30): double;
//Hacer cosas a partir del FileName...
function WaitExeIddle(ExeFileName: string; MinSeg: double = 0.1; MaxSeg: double = 10): double;
function KillTask(ExeFileName: string): boolean;
implementation
uses
SysUtils, Dialogs, Windows, Forms, FileCtrl, ShellAPI, HCBase, Tlhelp32;
// 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..255] of char;
var
SPPath: BufType;
PathPtr: PChar;
begin
if SearchPath(nil, PChar(ProgramName), nil, 255, SPPath, PathPtr)>0 then
Result := StrPas(SPPath)
else
Result := ProgramName;
end;
function TestExistence(const Name: string): boolean;
begin
Result := FileExists(Name) or DirectoryExists(Name);
end;
// Internal common code for the 3 exported program starters
function ProgramStarter(prog, workdir: string;
params: array of string; showmode: integer): integer;
var
StartInf : TStartupInfo;
ProcInf : TProcessInformation;
args : string;
progtmp : string;
pAppName : PChar;
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;
// To call CreateProcess() we should be carefull to enclose files
// passed in 'lpCommandLine' in double quotes ('"') to make sure that
// it understands where one starts and ends. The pecularity is that the
// name of the executable should NOT be enclosed in double quotes. Passing
// both the file and the arguments in lpCommandLine and leaving
// lpApplicationName empty is no option, since the application and
// arguments should be white-space delimited that way.
progtmp := prog;
if not FileExists(progtmp) then
progtmp := LocateProgramInSearchPath(progtmp);
if Length(prog)>0 then
args := '"' + prog + '"';
for i:=low(params) to high(params) do
begin
// Enclose file and directory names in double quotes to get them seperated properly
if TestExistence(params[i]) then
begin
if Length(args)>0 then // Try to add spaces only when necessary
args := args + ' "' + params[i] + '"'
else
args := '"' + params[i] + '"'
end
else if Length(params[i])>0 then
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;
if Length(progtmp)>0 then
pAppName := PChar(progtmp)
else
pAppName := nil;
if not CreateProcess(pAppName, PChar(args), nil, nil, False, 0, nil,
pworkdir, StartInf, ProcInf) then
MessageDlg('El programa ' + prog + ' no ha podido ser ejecutado', mtError, [mbOk], 0);
// The handles for both the process and the main thread must be closed through
// calls to CloseHandle. These handles are not needed, so it is best to close
// them immediately after the process is created.
result := ProcInf.hProcess;
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, [ ' ' ]).
procedure StartProgram(prog, workdir: string; params: array of string);
var
hProcess: integer;
begin
hProcess := ProgramStarter(prog, workdir, params, SW_SHOWDEFAULT);
CloseHandle(hProcess);
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): integer;
var
hProcess: integer;
j : Cardinal;
begin
hProcess := ProgramStarter(prog, workdir, params, SW_SHOWMINNOACTIVE);
WaitForSingleObject(hProcess, INFINITE);
GetExitCodeProcess(hProcess, j);
result := integer(j);
CloseHandle(hProcess);
end;
function RunFileBlocking(fichero: string): boolean;
var
SEI: TShellExecuteInfo;
begin
//Ejecuto el fichero con el programa adecuado...
FillChar(SEI, SizeOf(SEI), 0); // Wipe the record to start with
Result:= true;
with SEI do
begin
cbSize := SizeOf(SEI);
fMask := see_Mask_NoCloseProcess;
Wnd := Application.MainForm.Handle;
lpVerb := 'open';
lpFile := PAnsiChar(fichero);
lpDirectory := PChar(ExtractFilePath(fichero));
nShow := sw_ShowNormal;
if not ShellExecuteEx(@SEI) then
Result:= False;
end;
//Espero a que liberen el fichero...
//WaitForSingleObjet no se debe usar si se va a abrir una ventana porque
//el proceso que llama deja de procesar mensajes y la ventana nueva cuelga:
//http://msdn.microsoft.com/en-us/library/ms687032%28VS.85%29.aspx
while WaitForSingleObject(SEI.hProcess, 100) = WAIT_TIMEOUT do
Application.ProcessMessages;
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);
while WaitForSingleObject(hProcess, 10) = WAIT_TIMEOUT do
Application.ProcessMessages;
GetExitCodeProcess(hProcess, j);
result := integer(j);
CloseHandle(hProcess);
end;
// **************************************************************************
// ** AÑADIDO SERGIO PARA MENEJAR PROCESOS POR SU HANDLE O SU EXE FILENAME **
// **************************************************************************
function FileTime2Milliseconds(FileTime: TFileTime): integer;
var ST: TSystemTime;
begin
FileTimeToSystemTime(FileTime, ST);
result:= ST.wMilliseconds + 1000 *
(ST.wSecond + 60 * (ST.wMinute + 60 * ST.wHour)) ;
end;
//Sabemos 'WINWORD.EXE', dame un THandle del proceso para hacerle putadillas
function GetProcHandle(ExeFileName: string): THandle;
var
ContinueLoop: BOOL;
FSnapshotHandle: THandle;
FProcessEntry32: TProcessEntry32;
begin
result:= 0;
FSnapshotHandle:= CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0);
FProcessEntry32.dwSize:= Sizeof(FProcessEntry32);
ContinueLoop:= Process32First(FSnapshotHandle, FProcessEntry32);
while integer(ContinueLoop) <> 0 do begin
if ((UpperCase(ExtractFileName(FProcessEntry32.szExeFile)) = UpperCase(ExeFileName))
or (UpperCase(FProcessEntry32.szExeFile) = UpperCase(ExeFileName))) then begin
result:= OpenProcess(PROCESS_ALL_ACCESS, FALSE, FProcessEntry32.th32ProcessID);
break;
end;
ContinueLoop:= Process32Next(FSnapshotHandle, FProcessEntry32);
end;
CloseHandle(FSnapshotHandle);
end;
//Mata este proceso!
function KillProc(H: THandle): boolean;
const PROCESS_TERMINATE=$0001;
begin
result:= (Integer(TerminateProcess(H, 0))<>0);
end;
//Espera a que un Proceso use menos del 1% de la CPU.
//Si no encuentra el proceso, esperara MinSeg, y si lo encuentra pero no baja
//del 1%, se esperara un maximo de MaxSeg.
function WaitProcIddle(H: THandle; MinSeg: double = 1; MaxSeg: double = 30): double;
var
LastProcTime, NewProcTime, UsedTime: integer; //Milisegundos todo
CreaTime, ExitTime, UserTime, KernelTime: TFileTime;
const
WAIT_FOR_MS: integer = 1000; //Cada 1 segundo (1000 ms) vuelves a mirar
IDDLE_LOWER: integer = 5; //Usados < 5 ms = (%CPU<0.5) salimos
begin
//Llevo esperando 0 segundos...
result:= 0;
//Igual no lo encuentro...
if (H=0) then begin
//Pues no esta, espero algo y me voy...
sleep(round(MinSeg*1000));
end else begin
//Proceso encontrado, a esperar...
if GetProcessTimes(H, CreaTime, ExitTime, KernelTime, UserTime)=BOOL(0) then exit;
LastProcTime:= FileTime2Milliseconds(KernelTime) + FileTime2Milliseconds(UserTime);
//Cada decima de segundo, recalculo...
repeat
sleep(WAIT_FOR_MS);
result:= result + (WAIT_FOR_MS/1000);
//Rescato tiempo dle proceso actualizado...
if GetProcessTimes(H, CreaTime, ExitTime, KernelTime, UserTime)=BOOL(0) then exit;
NewProcTime:= FileTime2Milliseconds(KernelTime) + FileTime2Milliseconds(UserTime);
UsedTime:= (NewProcTime - LastProcTime);
if (UsedTime) < IDDLE_LOWER then
break;
LastProcTime:= NewProcTime;
until (result >= MaxSeg);
end;
end;
// ***************************************************
// ** MANEJO PROCESOS SABIENDO SU NOMBRE DE FICHERO **
// ***************************************************
//Espera a que una tarea baje del 1%CPU usando su filename
function WaitExeIddle(ExeFileName: string; MinSeg: double = 0.1; MaxSeg: double = 10): double;
begin
result:= WaitProcIddle(GetProcHandle(ExeFileName), MinSeg, MaxSeg);
end;
//Mata programa por su nombre...
function KillTask(ExeFileName: string): boolean;
begin
result:= KillProc(GetProcHandle(ExeFileName));
end;
end.We're a friendly, industry-focused community of developers, IT pros, digital marketers, and technology enthusiasts meeting, networking, learning, and sharing knowledge.