Delphi中利用Windows API添加右键菜单之子菜单

unit ContextMenuHandler;
interface
uses
Windows, ActiveX, ComObj, ShlObj, Classes, Dialogs, Forms;
type
TContextMenu = class(TComObject, IShellExtInit, IContextMenu)
private
FFileName: array[0..MAX_PATH] of Char;
protected
function IShellExtInit.Initialize = SEIInitialize; // Avoid compiler warning
function SEIInitialize(pidlFolder: PItemIDList; lpdobj: IDataObject; hKeyProgID: HKEY): HResult; stdcall;
function QueryContextMenu(Menu: HMENU; indexMenu, idCmdFirst, idCmdLast, uFlags: UINT): HResult; stdcall;
function InvokeCommand(var lpici: TCMInvokeCommandInfo): HResult; stdcall;
function GetCommandString(idCmd, uType: UINT; pwReserved: PUINT; pszName: LPSTR; cchMax: UINT): HResult; stdcall;
end;
const
Class_ContextMenu: TGUID = '{1224EC18-217B-9826-58D7-69EB1DBC9A30}';
var
FileList: TStringList;
Buffer: array[1..1024] of char;
implementation
uses ComServ, SysUtils, ShellApi, Registry, Graphics;

function TContextMenu.SEIInitialize(pidlFolder: PItemIDList; lpdobj: IDataObject; hKeyProgID: HKEY): HResult;
var
StgMedium: TStgMedium;
FormatEtc: TFormatEtc;
FileNumber, i: Integer;
begin
//如果lpdobj等于Nil，则本调用失败
if (lpdobj = nil) then begin
Result := E_INVALIDARG;
Exit;
end;
//首先初始化并清空FileList以添加文件
FileList := TStringList.Create;
FileList.Clear;
//初始化剪贴版格式文件
with FormatEtc do begin
cfFormat := CF_HDROP;
ptd := nil;
dwAspect := DVASPECT_CONTENT;
lindex := -1;
tymed := TYMED_HGLOBAL;
end;
Result := lpdobj.GetData(FormatEtc, StgMedium);
if Failed(Result) then Exit;
//首先查询用户选中的文件的个数
{$IFDEF WIN32}
FileNumber := DragQueryFile(StgMedium.hGlobal, $FFFFFFFF, nil, 0);
{$ELSE}
FileNumber := DragQueryFile(StgMedium.hGlobal, $FFFF, nil, 0);
{$ENDIF}
//循环读取，将所有用户选中的文件保存到FileList中
for i := 0 to FileNumber - 1 do begin
DragQueryFile(StgMedium.hGlobal, i, FFileName, SizeOf(FFileName));
FileList.Add(FFileName);
Result := NOERROR;
end;

ReleaseStgMedium(StgMedium);
end;

function TContextMenu.QueryContextMenu(Menu: HMENU; indexMenu, idCmdFirst, idCmdLast, uFlags: UINT): HResult;
var
bmp: tpicture;
asubmenu: integer;
FMenuIdx: integer;
begin
Result := 0;
FMenuIdx := indexMenu;
if ((uFlags and $0000000F) = CMF_NORMAL) or ((uFlags and CMF_EXPLORE) <> 0) then begin
asubmenu := CreateMenu;
//子菜单
InsertMenu(asubmenu, FMenuIdx, MF_BYPOSITION or MF_STRING, idCmdFirst + 1, '文件备份解密');
InsertMenu(asubmenu, FMenuIdx, MF_BYPOSITION or MF_STRING, idCmdFirst + 2, '文件解密');
InsertMenu(asubmenu, FMenuIdx, MF_SEPARATOR or MF_BYPOSITION, 0, nil);
InsertMenu(asubmenu, FMenuIdx, MF_BYPOSITION or MF_STRING, idCmdFirst + 3, '文件备份加密');
InsertMenu(asubmenu, FMenuIdx, MF_BYPOSITION or MF_STRING, idCmdFirst + 4, '文件加密');
//插入子菜单
InsertMenu(Menu, FMenuIdx, MF_SEPARATOR or MF_BYPOSITION, idCmdLast, nil);
InsertMenu(menu, FMenuIdx, MF_BYPOSITION or MF_STRING or MF_Popup, asubmenu, 'jSafeFile文件加密');
InsertMenu(Menu, FMenuIdx, MF_SEPARATOR or MF_BYPOSITION, idCmdLast, nil);
if fileexists(ExtractFilePath(GetModuleName(HInstance)) + 'ico.bmp') then begin
bmp := tpicture.create;
bmp.LoadFromFile(ExtractFilePath(GetModuleName(HInstance)) + 'ico.bmp');
SetMenuItemBitmaps(Menu, indexMenu, MF_BYPOSITION, bmp.Bitmap.handle, bmp.bitmap.handle);
end;
Result := 5; // 返回增加菜单项的个数
end;
end;

function TContextMenu.InvokeCommand(var lpici: TCMInvokeCommandInfo): HResult;
var
//sFile:TFileStream;
charTempPath: array[0..1023] of char;
sSaveFile: string;
i: Integer;
F: TextFile;
FirstLine: string;
idCmd: integer;
tmpfilename: string;
AGuid: TGuid;
begin
//首先确定该过程是被资源管理器而不是被一个程序所调用
if (HiWord(Integer(lpici.lpVerb)) <> 0) then begin
showmessage(char(lpici.lpVerb));
Result := E_FAIL;
Exit;
end;
//确定传递的参数的有效性
{if (LoWord(lpici.lpVerb) <> 0) then begin
Result := E_INVALIDARG;
Exit;
end; }
//建立一个临时文件保存用户选中的文件名
OLECheck(CreateGUID(AGuid));
tmpfilename := 'jSaf_' + Copy(GUIDToString(AGuid), 2, 4) + '.tmp';
GetTempPath(1024, charTempPath);
sSaveFile := charTempPath + tmpfilename;
AssignFile(F, sSaveFile);
ReWrite(F);
for i := 0 to FileList.Count - 1 do begin
FirstLine := FileList.Strings[i];
Writeln(F, FirstLine);
end;
CloseFile(F);
//调用文件操作程序对用户选中的文件进行操作
idCmd := LoWord(lpici.lpVerb);
//showmessage(IntToStr(idCmd));
case idCmd of
4: ShellExecute(0, nil, PChar(ExtractFilePath(GetModuleName(HInstance)) + 'jSafeFile.exe'), PChar('-d ' + tmpfilename), charTempPath, SW_NORMAL);
3: ShellExecute(0, nil, PChar(ExtractFilePath(GetModuleName(HInstance)) + 'jSafeFile.exe'), PChar('-e ' + tmpfilename), charTempPath, SW_NORMAL);
2: ShellExecute(0, nil, PChar(ExtractFilePath(GetModuleName(HInstance)) + 'jSafeFile.exe'), PChar('-f ' + tmpfilename), charTempPath, SW_NORMAL);
1: ShellExecute(0, nil, PChar(ExtractFilePath(GetModuleName(HInstance)) + 'jSafeFile.exe'), PChar('-h ' + tmpfilename), charTempPath, SW_NORMAL);
end;
{case idCmd of
4: showmessage('文件加密');
3: showmessage('文件备份加密');
2: showmessage('文件解密');
1: showmessage('文件备份解密');
end; }
Result := NOERROR;
end;

function TContextMenu.GetCommandString(idCmd, uType: UINT; pwReserved: PUINT; pszName: LPSTR; cchMax: UINT): HRESULT;
begin
if (idCmd = 0) then
Result := NOERROR
else
Result := E_INVALIDARG;
end;

type
TContextMenuFactory = class(TComObjectFactory)
private
public
procedure UpdateRegistry(Register: Boolean); override;
end;

procedure TContextMenuFactory.UpdateRegistry(Register: Boolean);
var
ClassID: string;
lphKey: HKEY;
begin
if Register then begin
inherited UpdateRegistry(Register);
ClassID := GUIDToString(Class_ContextMenu);
CreateRegKey('*\shellex\ContextMenuHandlers\jSafeFile', '', ClassID);
//CreateRegKey('Directory\shellex\ContextMenuHandlers\jSafeFile', '', ClassID);
//CreateRegKey('Folder\shellex\ContextMenuHandlers\jSafeFile', '', ClassID);

if (Win32Platform = VER_PLATFORM_WIN32_NT) then //如果操作系统为Windows NT的话
with TRegistry.Create do
try
RootKey := HKEY_LOCAL_MACHINE;
OpenKey('SOFTWARE\Microsoft\Windows\CurrentVersion\Shell Extensions', True);
OpenKey('Approved', True);
WriteString(ClassID, 'jSafeFile');
finally
Free;
end;
RegCreateKey(HKEY_CLASSES_ROOT, pchar('jSafeFile'), lphKey);
RegSetValue(lphKey, '', REG_SZ, pchar('jSafeFile 加密格式文件'), 0);

RegCreateKey(HKEY_CLASSES_ROOT, pchar('.jxy'), lphKey);
RegSetValue(lphKey, '', REG_SZ, pchar('jSafeFile'), 0);

RegCreateKey(HKEY_CLASSES_ROOT, pchar('jSafeFile\DefaultIcon'), lphKey);
RegSetValue(lphKey, '', REG_SZ, pchar(ExtractFilePath(GetModuleName(HInstance)) + 'jSafeFile.exe,0'), 0);

RegCreateKey(HKEY_CLASSES_ROOT, pchar('jSafeFile'), lphKey);
RegSetValue(lphKey, 'shell\open\command', REG_SZ, pchar(ExtractFilePath(GetModuleName(HInstance)) + 'jSafeFile.exe "%1"'), MAX_PATH);
SHChangeNotify(SHCNE_ASSOCCHANGED, SHCNF_IDLIST, nil, nil);
end
else begin
DeleteRegKey('*\shellex\ContextMenuHandlers\jSafeFile');
//DeleteRegKey('Directory\shellex\ContextMenuHandlers\jSafeFile');
//DeleteRegKey('Folder\shellex\ContextMenuHandlers\jSafeFile');

DeleteRegKey('.jxy');
DeleteRegKey('jSafeFile');
SHChangeNotify(SHCNE_ASSOCCHANGED, SHCNF_IDLIST, nil, nil);
inherited UpdateRegistry(Register);
end;
end;

initialization
TContextMenuFactory.Create(ComServer, TContextMenu, Class_ContextMenu, '', 'jSafeFile', ciMultiInstance, tmApartment);
end.

转载于:https://www.cnblogs.com/lzj1981/archive/2013/05/01/3053214.html