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.