unit ShellExecEx;
interface
uses
Winapi.Windows,
Winapi.ShellAPI,
Winapi.ShlObj,
Winapi.TlHelp32,
Vcl.Forms, System.SysUtils;
type
TShellExecEx =
record
private
class procedure seDelay(Milliseconds: Integer);
static;
class function FileExists(
const aFileName:
string): Boolean;
static;
class function IsDirectory(
const aFileName:
string): Boolean;
static;
public
class function OpenFolderAndSelectFile(
const FileName:
string): Boolean;
static;
class function ShellExecEx(lphWnd: HWND; lpVerb, lpFile, lpParameters, lpDirectory: PChar; nShowCommand: Integer; bWaitForCompletion: Boolean = False;
bProcessMessages: Boolean = False; bUseExeIsRunningCheck: Boolean = False): Boolean;
static;
end;
implementation
class procedure TShellExecEx.seDelay(Milliseconds: Integer);
const
WM_QUIT = 18;
var
Tick: DWord;
Event: THandle;
Msg: TMsg;
begin
Event := CreateEvent(
nil, False, False,
nil);
try
Tick := GetTickCount + DWord(Milliseconds);
while (Milliseconds > 0)
and (MsgWaitForMultipleObjects(1, Event, False, Milliseconds, QS_ALLINPUT) <> WAIT_TIMEOUT)
do
begin
if PeekMessage(Msg, 0, 0, 0, PM_REMOVE)
then
begin
if Msg.
message = WM_QUIT
then
begin
PostQuitMessage(Msg.wParam);
Break;
end;
TranslateMessage(Msg);
DispatchMessage(Msg);
end;
Milliseconds := Tick - GetTickCount;
end;
finally
CloseHandle(Event);
end;
end;
class function TShellExecEx.FileExists(
const aFileName:
string): Boolean;
var
i: Cardinal;
begin
Result := False;
i := GetFileAttributes(PChar(aFileName));
if i <> INVALID_FILE_ATTRIBUTES
then
begin
Result := True;
end;
end;
class function TShellExecEx.IsDirectory(
const aFileName:
string): Boolean;
var
R: DWord;
begin
R := GetFileAttributes(PChar(aFileName));
Result := (R <> DWord(-1))
and ((R
and FILE_ATTRIBUTE_DIRECTORY) <> 0);
end;
class function TShellExecEx.OpenFolderAndSelectFile(
const FileName:
string): Boolean;
var
IIDL: PItemIDList;
begin
Result := False;
IIDL := ILCreateFromPath(PChar(FileName));
if IIDL <>
nil then
try
Result := SHOpenFolderAndSelectItems(IIDL, 0,
nil, 0) = S_OK;
finally
ILFree(IIDL);
end;
end;
function IsExeRunning(
const AExeName:
string): Boolean;
var
h: THandle;
p: TProcessEntry32;
bRes: Boolean;
begin
p.dwSize := SizeOf(p);
h := CreateToolHelp32Snapshot(TH32CS_SnapProcess, 0);
try
Process32First(h, p);
repeat
bRes := AnsiUpperCase(AExeName) = AnsiUpperCase(p.szExeFile);
until bRes
or (
not Process32Next(h, p));
finally
CloseHandle(h);
end;
Result := bRes;
end;
class function TShellExecEx.ShellExecEx(lphWnd: HWND; lpVerb, lpFile, lpParameters, lpDirectory: PChar; nShowCommand: Integer; bWaitForCompletion: Boolean = False;
bProcessMessages: Boolean = False; bUseExeIsRunningCheck: Boolean = False): Boolean;
var
ShExecInfoW: ShellExecuteInfoW;
lpExitCode: Cardinal;
bIsHTTP, bIsCMD, bResShellExecEx: Boolean;
begin
bIsHTTP :=
string(lpFile).StartsWith('
http://')
or string(lpFile).StartsWith('
https://');
if bIsHTTP
then
begin
Result := ShellExecute(0, '
open', PChar(lpFile),
nil,
nil, SW_SHOWNORMAL) >= 32;
Exit
end;
bIsCMD := AnsiSameText(lpFile, '
cmd')
or AnsiSameText(lpFile, '
cmd.exe');
if (
not bIsCMD)
and (
not bIsHTTP)
and (
not TShellExecEx.IsDirectory(lpFile))
and (
not TShellExecEx.FileExists(lpFile))
then
begin
Result := False;
Exit;
end;
if bIsCMD
and (
not string(lpParameters).StartsWith('
/C '))
then
lpParameters := PChar('
/C ' + lpParameters);
ZeroMemory(@ShExecInfoW, SizeOf(ShExecInfoW));
ShExecInfoW.Wnd := lphWnd;
ShExecInfoW.cbSize := SizeOf(ShellExecuteInfoW);
ShExecInfoW.fMask := SEE_MASK_NOCLOSEPROCESS;
ShExecInfoW.lpVerb := lpVerb;
ShExecInfoW.lpFile := PChar('
"' + lpFile + '
"');
ShExecInfoW.lpParameters := lpParameters;
ShExecInfoW.lpDirectory := lpDirectory;
ShExecInfoW.nShow := nShowCommand;
bResShellExecEx := ShellExecuteExW(@ShExecInfoW);
Result := bResShellExecEx;
try
if (bResShellExecEx)
and (bWaitForCompletion)
then
begin
if not bUseExeIsRunningCheck
then
begin
WaitForInputIdle(ShExecInfoW.hProcess, INFINITE);
repeat
TShellExecEx.seDelay(25);
GetExitCodeProcess(ShExecInfoW.hProcess, lpExitCode);
if bProcessMessages
then
Application.ProcessMessages;
until (lpExitCode <> STILL_ACTIVE);
end
else
begin
while IsExeRunning(ExtractFileName(lpFile))
do
begin
TShellExecEx.seDelay(25);
if bProcessMessages
then
Application.ProcessMessages;
end;
end;
end;
finally
CloseHandle(ShExecInfoW.hProcess)
end;
end;
end.