417 lines
12 KiB
Plaintext
417 lines
12 KiB
Plaintext
{*******************************************************}
|
|
{ }
|
|
{ Tocsg.Shell }
|
|
{ }
|
|
{ Copyright (C) 2022 kkuzil }
|
|
{ }
|
|
{*******************************************************}
|
|
|
|
unit Tocsg.Shell;
|
|
|
|
interface
|
|
|
|
uses
|
|
System.SysUtils, System.Classes, Winapi.Messages, Winapi.Windows,
|
|
Vcl.Controls, Vcl.Graphics;
|
|
|
|
const
|
|
TB_ENABLEBUTTON = WM_USER + 1;
|
|
TB_CHECKBUTTON = WM_USER + 2;
|
|
TB_PRESSBUTTON = WM_USER + 3;
|
|
TB_HIDEBUTTON = WM_USER + 4;
|
|
TB_INDETERMINATE = WM_USER + 5;
|
|
TB_MARKBUTTON = WM_USER + 6;
|
|
TB_ISBUTTONENABLED = WM_USER + 9;
|
|
TB_ISBUTTONCHECKED = WM_USER + 10;
|
|
TB_ISBUTTONPRESSED = WM_USER + 11;
|
|
TB_ISBUTTONHIDDEN = WM_USER + 12;
|
|
TB_ISBUTTONINDETERMINATE = WM_USER + 13;
|
|
TB_ISBUTTONHIGHLIGHTED = WM_USER + 14;
|
|
TB_SETSTATE = WM_USER + 17;
|
|
TB_GETSTATE = WM_USER + 18;
|
|
TB_ADDBITMAP = WM_USER + 19;
|
|
TB_ADDBUTTONSA = WM_USER + 20;
|
|
TB_INSERTBUTTONA = WM_USER + 21;
|
|
TB_DELETEBUTTON = WM_USER + 22;
|
|
TB_GETBUTTON = WM_USER + 23;
|
|
TB_BUTTONCOUNT = WM_USER + 24;
|
|
TB_COMMANDTOINDEX = WM_USER + 25;
|
|
|
|
TB_SAVERESTOREA = WM_USER + 26;
|
|
TB_ADDSTRINGA = WM_USER + 28;
|
|
TB_GETBUTTONTEXTA = WM_USER + 45;
|
|
// TBN_GETBUTTONINFOA = TBN_FIRST-0;
|
|
|
|
type
|
|
TBBUTTON = packed record
|
|
iBitmap: Integer;
|
|
idCommand: Integer;
|
|
fsState: BYTE;
|
|
fsStyle: BYTE;
|
|
bReserved: array [0..1] of BYTE; // padding for alignment
|
|
dwData: Pointer; //DWORD_PTR;
|
|
iString: Pointer; //INT_PTR;
|
|
end;
|
|
|
|
TBBUTTON64 = packed record
|
|
iBitmap: Integer;
|
|
idCommand: Integer;
|
|
fsState: BYTE;
|
|
fsStyle: BYTE;
|
|
bReserved: array [0..5] of BYTE; // padding for alignment 64bit
|
|
dwData: Pointer; //DWORD_PTR;
|
|
iString: Pointer; //INT_PTR;
|
|
end;
|
|
|
|
TRAYDATA = packed record
|
|
wnd: HWND;
|
|
uID: UINT;
|
|
uCallbackMessage: UINT;
|
|
Reserved: array [0..1] of DWORD;
|
|
hIcon: HICON;
|
|
end;
|
|
|
|
function GetShellImageHandle(bSmall: Boolean = true; dwFileAttr: DWORD = 0): THandle;
|
|
function GetShellImageIndex_path(const sPath: String): Integer;
|
|
|
|
procedure OpenPath(const sPath: String; hParent: HWND = 0);
|
|
procedure ExecutePath(const sPath: String; sParam: String = ''; hParent: HWND = 0); inline;
|
|
procedure ExecutePath_hide(const sPath: String; sParam: String = ''); inline;
|
|
procedure ExecutePath_runAs(const sPath: String; sParam: String = '';
|
|
nShowMode: Integer = SW_SHOWNORMAL);
|
|
procedure ExecuteExplorerOpen(const sPath: String); inline;
|
|
|
|
procedure ExplorerSelectedPath(sPath: String; bCheckFileExists: Boolean = true);
|
|
|
|
function GetShellExePathFromExt(sExt: String): String;
|
|
function GetTargetExeFromLink(const sPath: String): String;
|
|
|
|
function ClearZombieTray(hTray: HWND): Integer;
|
|
function AddFileSmallIconToImageList(aList: TImageList; const sPath: string): Integer;
|
|
function GetFileSmallIcon(const sPath: String): TIcon;
|
|
|
|
implementation
|
|
|
|
uses
|
|
Winapi.ShellAPI, Tocsg.Exception, System.Win.Registry, Tocsg.Safe,
|
|
Tocsg.Strings, Tocsg.Registry, Tocsg.Process, Winapi.ShlObj, Winapi.ActiveX,
|
|
Tocsg.Trace;
|
|
|
|
function GetShellImageHandle(bSmall: Boolean = true; dwFileAttr: DWORD = 0): THandle;
|
|
var
|
|
SFI: TSHFileInfo;
|
|
dwIconSize: DWORD;
|
|
begin
|
|
if bSmall then
|
|
dwIconSize := SHGFI_SMALLICON
|
|
else
|
|
dwIconSize := SHGFI_LARGEICON;
|
|
|
|
Result := SHGetFileInfo('', dwFileAttr, SFI, SizeOf(SFI), SHGFI_ICON or SHGFI_SYSICONINDEX or dwIconSize);
|
|
end;
|
|
|
|
// 11.1 기준, 64비트에서는 Range check error 에러가 뜬다...
|
|
// 10.x에서 만든 .dproj로 프로젝트를 다시 만들면 해결된다.. 델파이 버그...
|
|
// SearchLight.dproj로 해결함 22_0713 11:31:14 kku
|
|
function GetShellImageIndex_path(const sPath: String): Integer;
|
|
var
|
|
SFI: TSHFileInfo;
|
|
dwResult: DWORD;
|
|
begin
|
|
Result := 0;
|
|
|
|
try
|
|
// 이걸로 체크하면 가상파일, 재문 분석이 필요한 파일 (드롭박스, 구글드라이브)의 경우
|
|
// 파일이 바로 동기화 되어버린다. 23_0111 09:41:13 kku
|
|
// if FileExists(sPath) or DirectoryExists(sPath) then
|
|
|
|
if GetFileAttributes(PChar(sPath)) <> INVALID_FILE_ATTRIBUTES then
|
|
begin
|
|
ZeroMemory(@SFI, SizeOf(SFI));
|
|
dwResult := SHGetFileInfo(PChar(sPath), 0, SFI, SizeOf(SFI),
|
|
// SHGFI_ICON or SHGFI_SYSICONINDEX or dwIconSize);
|
|
SHGFI_SYSICONINDEX); // 이렇게 해야 엄청 많이 시도했을때 out of system resources 오류 안난다... 22_0628 14:37:54 kku
|
|
|
|
// if Succeeded(dwResult) then // 64 환경에서는 계속 실패 뜬다.. 그런데 SFI.iIcon 값은 잘 나옴 22_0705 17:02:16 kku
|
|
Result := SFI.iIcon;
|
|
end;
|
|
except
|
|
on E: Exception do
|
|
ETgException.TraceException(E, 'Fail .. GetShellImageIndex_path()');
|
|
end;
|
|
end;
|
|
|
|
procedure OpenPath(const sPath: String; hParent: HWND = 0);
|
|
//var
|
|
// sCmd: String;
|
|
// StrList: TStringList;
|
|
begin
|
|
// Guard(StrList, TStringList.Create);
|
|
//
|
|
// StrList.Add(Format('start "" "%s"', [sPath]));
|
|
// StrList.Add('pause');
|
|
//
|
|
// sCmd := 'C:\ProgramData\HE\test.cmd';
|
|
// StrList.SaveToFile(sCmd, TEncoding.ANSI);
|
|
// ShellExecute(hParent, nil, PChar(sCmd), nil, nil, SW_SHOWNORMAL);
|
|
|
|
// BSOne DRM 파일을 열람 하려면 start "" "경로" 이렇게 해야 실시간 복호화 열람이 가능하다
|
|
// 실행 기준 디렉토리를 일반사용자 권한으로 접근 가능한 곳으로 설정해야 정상 동작한다.
|
|
ShellExecute(hParent, nil, 'cmd.exe', PChar(Format('/c start "" "%s"', [sPath])), 'C:\ProgramData\', SW_HIDE);
|
|
end;
|
|
|
|
procedure ExecutePath(const sPath: String; sParam: String = ''; hParent: HWND = 0);
|
|
begin
|
|
ShellExecute(hParent, nil, PChar(sPath), PChar(sParam), '', SW_SHOWNORMAL);
|
|
end;
|
|
|
|
procedure ExecutePath_hide(const sPath: String; sParam: String = '');
|
|
begin
|
|
ShellExecute(0, nil, PChar(sPath), PChar(sParam), '', SW_HIDE);
|
|
end;
|
|
|
|
procedure ExecutePath_runAs(const sPath: String; sParam: String = '';
|
|
nShowMode: Integer = SW_SHOWNORMAL);
|
|
const
|
|
RUN_AS: String = 'runas';
|
|
var
|
|
ShellExecuteInfo: TShellExecuteInfo;
|
|
begin
|
|
ZeroMemory(@ShellExecuteInfo, SizeOf(ShellExecuteInfo));
|
|
with ShellExecuteInfo do
|
|
begin
|
|
cbSize := SizeOf(ShellExecuteInfo);
|
|
fMask := SEE_MASK_FLAG_DDEWAIT or SEE_MASK_FLAG_NO_UI;
|
|
Wnd := 0;
|
|
lpVerb := PChar(RUN_AS);
|
|
lpFile := PChar(Format('"%s"', [sPath]));
|
|
lpParameters := PChar(sParam);
|
|
lpDirectory := nil;
|
|
nShow := nShowMode;
|
|
hInstApp := 0;
|
|
end;
|
|
ShellExecuteEx(@ShellExecuteInfo);
|
|
end;
|
|
|
|
procedure ExecuteExplorerOpen(const sPath: String); inline;
|
|
begin
|
|
// ShellExecute(0, 'open', PChar(sPath), PChar(sVPath), '', SW_SHOWNORMAL);
|
|
end;
|
|
|
|
procedure ExplorerSelectedPath(sPath: String; bCheckFileExists: Boolean = true);
|
|
begin
|
|
if not bCheckFileExists or (bCheckFileExists and FileExists(sPath)) then
|
|
begin
|
|
sPath := '/select, "' + sPath + '"';
|
|
ShellExecute(0, 'open', 'explorer.exe', PChar(sPath), nil, SW_SHOWNORMAL);
|
|
end;
|
|
end;
|
|
|
|
function GetShellExePathFromExt(sExt: String): String;
|
|
var
|
|
Reg: TRegistry;
|
|
sVal,
|
|
sUserSid: String;
|
|
StrList: TStringList;
|
|
begin
|
|
Result := '';
|
|
if sExt = '' then
|
|
exit;
|
|
|
|
if sExt[1] <> '.' then
|
|
sExt := '.' + sExt;
|
|
|
|
sUserSid := GetProcesssUserSidFromName('explorer.exe');
|
|
if sUserSid = '' then
|
|
sUserSid := GetRegRecentUserSid;
|
|
|
|
Guard(Reg, TRegistry.Create);
|
|
|
|
sVal := '';
|
|
if sUserSid <> '' then
|
|
begin
|
|
Reg.RootKey := HKEY_USERS;
|
|
|
|
if Reg.OpenKeyReadOnly(Format('%s\SOFTWARE\Microsoft\Windows\CurrentVersion\' +
|
|
'Explorer\FileExts\%s\UserChoice', [sUserSid, sExt])) then
|
|
sVal := Reg.ReadString('ProgId');
|
|
|
|
Reg.CloseKey;
|
|
end;
|
|
|
|
Reg.RootKey := HKEY_CLASSES_ROOT;
|
|
if sVal = '' then
|
|
begin
|
|
if not Reg.OpenKeyReadOnly(sExt) then
|
|
exit;
|
|
|
|
sVal := Reg.ReadString('');
|
|
if sVal = '' then
|
|
exit;
|
|
|
|
Reg.CloseKey;
|
|
end;
|
|
|
|
if not Reg.OpenKeyReadOnly(sVal + '\shell\Open\command') then
|
|
exit;
|
|
|
|
sVal := Reg.ReadString('');
|
|
if sVal = '' then
|
|
exit;
|
|
|
|
Guard(StrList, TStringList.Create);
|
|
SplitString2(sVal, ' ', StrList);
|
|
if StrList.Count > 0 then
|
|
Result := StringReplace(StrList[0], '"', '', [rfReplaceAll]);
|
|
end;
|
|
|
|
function GetTargetExeFromLink(const sPath: String): String;
|
|
var
|
|
psl: IShellLink;
|
|
ppf: IPersistFile;
|
|
info: array [0..MAX_PATH] of Char;
|
|
wfs: TWin32FindData;
|
|
begin
|
|
Result := '';
|
|
|
|
try
|
|
if not FileExists(sPath) then
|
|
exit;
|
|
|
|
CoCreateInstance(CLSID_SHELLLINK, nil, CLSCTX_INPROC_SERVER, IShellLink, psl);
|
|
if (psl <> nil) and (psl.QueryInterface(IPersistFile, ppf) = 0) then
|
|
begin
|
|
ppf.Load(PWideChar(sPath), STGM_READ);
|
|
psl.GetPath((@info), MAX_PATH, wfs, SLGP_UNCPRIORITY);
|
|
// psl.GetPath((@info), MAX_PATH, wfs, SLGP_RELATIVEPRIORITY);
|
|
Result := info;
|
|
// if Result = '' then
|
|
// begin
|
|
// psl.GetPath((@info), MAX_PATH, wfs, SLGP_RELATIVEPRIORITY);
|
|
// Result := info;
|
|
// end;
|
|
end;
|
|
except
|
|
on E: Exception do
|
|
ETgException.TraceException(E, 'Fail .. GetTargetExeFromLink()');
|
|
end;
|
|
end;
|
|
|
|
function ClearZombieTray(hTray: HWND): Integer;
|
|
var
|
|
h: HWND;
|
|
i, nCnt: Integer;
|
|
dwTrayPid, dwPid: DWORD;
|
|
hTrayProc: THandle;
|
|
pData: ^TBBUTTON64; //^TBBUTTON;
|
|
tb: TBBUTTON64; // TBBUTTON;
|
|
tray: TRAYDATA;
|
|
IconData: NOTIFYICONDATA;
|
|
nRead: NativeUInt;
|
|
sPName: String;
|
|
begin
|
|
Result := 0;
|
|
try
|
|
nCnt := SendMessage(h, TB_BUTTONCOUNT, 0, 0);
|
|
|
|
dwTrayPid := 0;
|
|
GetWindowThreadProcessId(h, dwTrayPid);
|
|
if dwTrayPid = 0 then
|
|
exit;
|
|
|
|
hTrayProc := OpenProcess(PROCESS_ALL_ACCESS, FALSE, dwTrayPid);
|
|
if hTrayProc = 0 then
|
|
exit;
|
|
|
|
try
|
|
pData := VirtualAllocEx(hTrayProc, nil, sizeof(TBBUTTON), MEM_COMMIT, PAGE_READWRITE);
|
|
if pData = nil then
|
|
exit;
|
|
|
|
for i := 0 to nCnt - 1 do
|
|
begin
|
|
SendMessage(h, TB_GETBUTTON, i, NativeUInt(pData));
|
|
|
|
ReadProcessMemory(hTrayProc, pData, @tb, sizeof(TBBUTTON), nRead);
|
|
ReadProcessMemory(hTrayProc, tb.dwData, @tray, sizeof(tray), nRead);
|
|
|
|
dwPid := 0;
|
|
GetWindowThreadProcessId(tray.Wnd, dwPid);
|
|
if dwPid <> 0 then
|
|
begin
|
|
// sPName := GetProcessNameByPid(dwPid);
|
|
// mmInfo.Lines.Add(sPName);
|
|
end else begin
|
|
Inc(Result);
|
|
// mmInfo.Lines.Add('삭제됨 : ' + IntToStr(tray.wnd));
|
|
// ZeroMemory(@IconData, SizeOf(IconData));
|
|
// IconData.cbSize := SizeOf(IconData);
|
|
// IconData.hIcon := tray.hIcon;
|
|
// IconData.Wnd := tray.wnd;
|
|
// IconData.uCallbackMessage := tray.uCallbackMessage;
|
|
// IconData.uID := tray.uID;
|
|
// Shell_NotifyIcon(NIM_DELETE, @IconData);
|
|
end;
|
|
end;
|
|
finally
|
|
if pData <> nil then
|
|
VirtualFreeEx(hTrayProc, pData, 0, MEM_RELEASE);
|
|
if hTrayProc <> 0 then
|
|
CloseHandle(hTrayProc);
|
|
end;
|
|
except
|
|
on E: Exception do
|
|
ETgException.TraceException(E, 'Fail .. ClearZombieTray()');
|
|
end;
|
|
end;
|
|
|
|
function AddFileSmallIconToImageList(aList: TImageList; const sPath: string): Integer;
|
|
var
|
|
ico: TICon;
|
|
FileInfo: TSHFileInfo;
|
|
dwFlags: UINT;
|
|
begin
|
|
Result := -1;
|
|
|
|
try
|
|
dwFlags := SHGFI_ICON or SHGFI_USEFILEATTRIBUTES;
|
|
dwFlags := dwFlags or SHGFI_SMALLICON;
|
|
// Flags := Flags or SHGFI_LARGEICON;
|
|
|
|
// SHGFI_USEFILEATTRIBUTES를 써야 실제 파일이 없어도 확장자만으로 아이콘을 얻을 수 있음
|
|
if SHGetFileInfo(PChar(sPath), FILE_ATTRIBUTE_NORMAL, FileInfo, SizeOf(FileInfo), dwFlags) <> 0 then
|
|
begin
|
|
Guard(ico, TIcon.Create);
|
|
ico.Handle := FileInfo.hIcon;
|
|
Result := aList.AddIcon(ico);
|
|
end;
|
|
except
|
|
// ..
|
|
end;
|
|
end;
|
|
|
|
function GetFileSmallIcon(const sPath: String): TIcon;
|
|
var
|
|
FileInfo: TSHFileInfo;
|
|
dwFlags: UINT;
|
|
begin
|
|
Result := nil;
|
|
|
|
try
|
|
dwFlags := SHGFI_ICON or SHGFI_USEFILEATTRIBUTES;
|
|
dwFlags := dwFlags or SHGFI_SMALLICON;
|
|
// Flags := Flags or SHGFI_LARGEICON;
|
|
|
|
// SHGFI_USEFILEATTRIBUTES를 써야 실제 파일이 없어도 확장자만으로 아이콘을 얻을 수 있음
|
|
if SHGetFileInfo(PChar(sPath), FILE_ATTRIBUTE_NORMAL, FileInfo, SizeOf(FileInfo), dwFlags) <> 0 then
|
|
begin
|
|
Result := TIcon.Create;
|
|
Result.Handle := FileInfo.hIcon;
|
|
end;
|
|
except
|
|
// ..
|
|
end;
|
|
end;
|
|
|
|
end.
|