- добавить иконку;
- добавить в верхнюю часть меню (а не под конец, как сейчас!);
- добавить с несколькими пунктами во вложении;
- отображать только для конкретных типов файлов (например, *.doc, *.pdf, ...).
- Код: Выделить всё
unit ShellUnit;
interface
uses Windows, Forms, StdCtrls, ShellApi, SysUtils, Classes, Controls, ComServ, ComObj, ShlObj, ActiveX, Dialogs, TlHelp32;
const CLSID_ContextMenu: TGUID = '{F68D582B-A418-4707-8607-85C1BDB7E996}';
type
TFormViewContextMenu = class(TComObject, IShellExtInit, IContextMenu)
private
FFileName: string;
public
function IShellExtInit.Initialize = ShellInit;
function ShellInit(Folder: PItemIDList; DataObject: IDataObject; ProgID: HKEY): HResult; stdcall;
function QueryContextMenu(Menu: HMENU; Index, CmdFirst, CmdLast, Flags: UINT): HResult; stdcall;
function GetCommandString(idCmd: UINT_PTR; uFlags: UINT; pwReserved: PUINT; pszName: LPSTR; cchMax: UINT): HResult; stdcall;
function InvokeCommand(var CommandInfo: TCMInvokeCommandInfo): HResult; stdcall;
end;
implementation
uses Registry, INIFiles;
{Get sfp installed path...}
function SFPPath: string;
var Reg: TRegistry;
begin
Reg:= TRegistry.Create(KEY_READ);
with Reg do
begin
RootKey:= HKEY_LOCAL_MACHINE;
if OpenKeyReadOnly('Software\ANB\SFP_SHELL\') then
Result:= IncludeTrailingBackslash(ReadString('sfp_dir'))
else
Result:= 'C:\Program Files\ANB\SFP\';
CloseKey;
end;
end;
{lang}
function GetLocalStr(const AMsgName: string): string;
var INI: TIniFile;
begin
INI:= TIniFile.Create(SFPPath + 'Languages\system.lng');
with INI do
begin
Result:= ReadString(IntToStr(GetSystemDefaultLangID), AMsgName, '<ERROR READING LOCAL STR!>');
Free;
end;
end;
{Shell}
function TFormViewContextMenu.ShellInit(Folder: PItemIDList; DataObject: IDataObject; ProgID: HKEY): HResult;
var Medium: TStgMedium;
FE: TFormatEtc;
begin
if DataObject = nil then
begin
Result:= E_FAIL;
Exit;
end;
with FE do
begin
cfFormat:= CF_HDROP;
ptd:= nil;
dwAspect:= DVASPECT_CONTENT;
lindex:= -1;
tymed:= TYMED_HGLOBAL;
end;
Result:= DataObject.GetData(FE, Medium);
if Failed(Result) then
Exit;
try
if DragQueryFile(Medium.hGlobal, $FFFFFFFF, nil, 0) = 1 then
begin
SetLength(FFileName, MAX_PATH);
DragQueryFile(Medium.hGlobal, 0, PChar(FFileName), MAX_PATH);
Result:= NOERROR;
end
else
Result:= E_FAIL;
finally
ReleaseStgMedium(Medium);
end;
end;
function TFormViewContextMenu.QueryContextMenu(Menu: HMENU; Index, CmdFirst, CmdLast, Flags: UINT): HResult;
begin
Result:= 0;
if ((Flags and $0000000F) = CMF_NORMAL) or ((Flags and CMF_EXPLORE) <> 0) or ((Flags and CMF_VERBSONLY) <> 0) then
begin
InsertMenu(Menu, 0, MF_STRING or MF_BYPOSITION, CmdFirst, PChar(GetLocalStr('shell_open')));
Result:= 1;
end;
end;
function TFormViewContextMenu.GetCommandString(idCmd: UINT_PTR; uFlags: UINT; pwReserved: PUINT; pszName: LPSTR; cchMax: UINT): HResult; stdcall;
begin
case idCmd of
0: begin
if uFlags = GCS_HELPTEXT then
begin
StrCopy(pszName, '');
end;
Result:= NOERROR;
end;
else
Result:= E_INVALIDARG;
end;
end;
function TFormViewContextMenu.InvokeCommand(var CommandInfo: TCMInvokeCommandInfo): HResult;
begin
if HiWord(Integer(CommandInfo.lpVerb)) <> 0 then
begin
Result:= E_FAIL;
Exit;
end;
case LoWord(CommandInfo.lpVerb) of
0: ShellExecute(0, 'open', pchar(SFPPath + 'tools\sfp_shell\sfp_shell_gui.exe'), pchar('/fn="' + FFileName + '"'), pchar(SFPPath), SW_SHOWNORMAL);
else
Result:= E_INVALIDARG;
end;
end;
initialization
TComObjectFactory.Create(ComServer, TFormViewContextMenu, CLSID_ContextMenu, '', '', ciMultiInstance);
end.