Die folgenden Angaben beziehen sich auf Delphi 5, sollten aber auch unter anderen Versionen auf die eine oder andere Weise funktionieren.
Folgende Arbeitsschritte sind notwendig:
library DFKontextMenu;
uses
Windows,
ComServ,
untMain in 'untMain.pas';
// Bildressource einbinden
// 12 x 12 Pixel
// Name = DFKONTEXTMENU oder ein anderer Name
{$R DFKontextMenu.res}
exports
DllGetClassObject,
DllCanUnloadNow,
DllRegisterServer,
DllUnregisterServer;
begin
end.
unit untMain;
interface
uses
ComServ, SysUtils, ShellAPI, Registry, Classes, Windows, ActiveX, ComObj, ShlObj,
Graphics, Dialogs;
const
// Die GUID wird für die eindeutige Registrierung der Shell-Erweiterung benötigt
GUID_TDFKontextMenuShellExt: TGUID = '{E8308BE3-0C9A-4429-9A3C-3F06E778C2DC}';
type
TDFKontextMenuShellExt = class(TComObject, IShellExtInit, IContextMenu)
protected
function IShellExtInit.Initialize = SEInitialize;
function SEInitialize(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;
implementation
var
// Aufnahme der selektierten Dateinamen
FFileName: array[0..MAX_PATH] of Char;
// für das Bild im Kontextmenü
hBmp: TBitmap;
type
TDFKontextMenuShellExtFactory = class(TComObjectFactory)
public
procedure UpdateRegistry(Register: boolean); override;
end;
// wird aufgerufen, um einen Hilfetext zum Menü abzufragen, z. B. beim Überfahren
// des Menüs im Explorer wird in dessen Statuszeile dieser Text angezeigt
function TDFKontextMenuShellExt.GetCommandString(idCmd, uType: UINT; pwReserved: PUINT;
pszName: LPSTR; cchMax: UINT): HResult;
begin
Result := S_OK;
try
if(idCmd = 0) then
begin
if(uType = GCS_HELPTEXT) then
StrCopy(pszName, 'DF KontextMenu');
Result := NOERROR;
end
else
Result := E_INVALIDARG;
except
Result := E_UNEXPECTED;
end;
end;
// wird aufgerufen, wenn ein Menüpunkt des Kontextmenüs gewählt wurde
function TDFKontextMenuShellExt.InvokeCommand(var lpici: TCMInvokeCommandInfo): HResult;
begin
Result := E_FAIL;
if (HiWord(Integer(lpici.lpVerb)) <> 0) then // kein Anwendungsaufruf
Exit;
// überprüfe den Index (0..Anzahl Menüpunkte - 1)
if LoWord(lpici.lpVerb) > 4 then
begin
Result := E_INVALIDARG;
Exit;
end;
// Zeige je nach gewählten Menüpunkt eine Info an
case LoWord(lpici.lpVerb) of
0: ShowMessage('Menüpunkt 1');
1: ShowMessage('Menüpunkt 2');
3: ShowMessage('Menüpunkt 3');
end;
Result := NOERROR;
end;
// wird aufgerufen, wenn das Kontextmenü erstellt werden soll
// es wird dann in das Kontextmenü des Explorers integriert
function TDFKontextMenuShellExt.QueryContextMenu(Menu: HMENU; indexMenu,
idCmdFirst, idCmdLast, uflags: UINT): HResult;
var
hMnu: HMENU;
hMnu2: HMENU;
vReg: TRegistry;
Idx: Integer;
mii: TMenuItemInfo;
begin
if ((uFlags and $0000000F) = CMF_NORMAL) or ((uFlags and CMF_EXPLORE) <> 0) or
((uFlags and CMF_VERBSONLY) <> 0) then // VERBS -- auch für Desktop-Icons
begin
// ffg. Menüstruktur soll erzeugt werden =>
// DFKontextMenü - Hauptmenüeintrag (kein Index) - kann keine Aktion auslösen
// Menüpunkt 1 - Index 0
// Menüpunkt 2 - Index 1
// Menüpunkt 4 - weiteres Untermenü (Index 2 - kann aber keine Aktion auslösen)
// Untermenü - Index 3
hMnu := CreatePopupMenu();
AppendMenu(hMnu, MF_STRING, idCmdFirst, 'Menüpunkt 1');
AppendMenu(hMnu, MF_STRING, idCmdFirst + 1, 'Menüpunkt 2');
// Untermenü erzeugen - dies hat dann den "virtuellen" Index von 2
hMnu2 := CreatePopupMenu();
// das ist der dritte Menüpunkt
AppendMenu(hMnu2, MF_STRING, idCmdFirst + 3, 'Untermenü');
// Das Untermenü erhält den Text Menüpunkt 4
mii.cbSize := sizeof(TMenuItemInfo);
mii.fMask := MIIM_SUBMENU or MIIM_STRING or MIIM_ID;
mii.wID := idCmdFirst + 2;
mii.hSubMenu := hMnu2;
mii.dwTypeData := PAnsiChar('Untermenü');
InsertMenu(hMnu, idCmdFirst + 2, MF_STRING or MF_BYPOSITION or MF_POPUP,
hMnu2, 'Menüpunkt 4'); // 2
mii.cbSize := sizeof(TMenuItemInfo);
mii.fMask := MIIM_SUBMENU or MIIM_STRING or MIIM_ID;
mii.wID := idCmdFirst + 4;
mii.hSubMenu := hMnu;
mii.dwTypeData := PAnsiChar('DF KontextMenü');
// die folgenden Anweisungen sind wichtig, damit das Bild korrekt erscheint.
InsertMenuItem(Menu, indexMenu, True, mii);
if hBmp.Handle <> 0 then
SetMenuItemBitmaps(Menu, indexMenu, MF_BYPOSITION, hBmp.Handle, hBmp.Handle);
Result := 4 // Anzahl der zusätzlichen Menüpunkte
end
else
Result := 0;
end;
// es können 1-n Dateien/Ordner markiert werden, wenn ein Menüpunkt aufgerufen
// wird - hier werden diese Dateien ermittelt
function TDFKontextMenuShellExt.SEInitialize(pidlFolder: PItemIDList;
lpdobj: IDataObject; hKeyProgID: HKEY): HResult;
var
StgMedium: TStgMedium;
FormatEtc: TFormatEtc;
Idx: Integer;
begin
if (lpdobj = nil) then
begin
Result := E_INVALIDARG;
Exit;
end;
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;
// alle ausgewählten Dateien ermitteln
for Idx := 0 to DragQueryFile(StgMedium.hGlobal, $FFFFFFFF, nil, 0) - 1 do
begin
DragQueryFile(StgMedium.hGlobal, Idx, FFileName, SizeOf(FFileName));
// hier können die Dateinamen eingesammelt werden, z. B.
// StringListe.Add(FFileName);
end;
ReleaseStgMedium(StgMedium);
Result := NOERROR;
end;
// Hier legen Sie die Einträge in der Registrierung fest
procedure TDFKontextMenuShellExtFactory.UpdateRegistry(Register: boolean);
var
ClassID: string;
begin
if Register then
begin
inherited UpdateRegistry(Register);
ClassID := GUIDToString(GUID_TDFKontextMenuShellExt);
// Die Shell-Erweiterung wird hier für Ordner (Folder) registriert
// Der Text DFKontextMenu ist frei wählbar und charakterisier die eigene Erweiterung
CreateRegKey('Folder\shellex', '', '');
CreateRegKey('Folder\shellex\ContextMenuHandlers', '', '');
CreateRegKey('Folder\shellex\ContextMenuHandlers\DFKontextMenu', '', ClassID);
// Die Shell-Erweiterung wird hier für alle Dateien registriert
// ansonsten muss statt des Sterns (alle Dateien) die konkrete Dateiendung
// stehen, z. B. '.zip'
// Der Text DFKontextMenu ist frei wählbar und charakterisier die eigene Erweiterung
CreateRegKey('*\shellex', '', '');
CreateRegKey('*\shellex\ContextMenuHandlers', '', '');
CreateRegKey('*\shellex\ContextMenuHandlers\DFKontextMenu', '', ClassID);
// Shell-Erweiterung als "genehmigt" eintragen
if (Win32Platform = VER_PLATFORM_WIN32_NT) then
with TRegistry.Create do
try
RootKey := HKEY_LOCAL_MACHINE;
OpenKey('SOFTWARE\Microsoft\Windows\CurrentVersion\Shell Extensions', True);
OpenKey('Approved', True);
WriteString(ClassID, 'DFKontextMenu');
finally
Free;
end;
end
else
begin
// wird die Shell-Erweiterung wieder entfernt, werden die Einträge der
// Registrierung gelöscht
DeleteRegKey('Folder\shellex\ContextMenuHandlers\DFKontextMenu');
DeleteRegKey('Folder\shellex\ContextMenuHandlers');
DeleteRegKey('Folder\shellex');
DeleteRegKey('*\shellex\ContextMenuHandlers\DFKontextMenu');
DeleteRegKey('*\shellex\ContextMenuHandlers');
DeleteRegKey('*\shellex');
inherited UpdateRegistry(Register);
end;
end;
initialization
// hier wird die Erweiterung registriert
TDFKontextMenuShellExtFactory.Create(ComServer, TDFKontextMenuShellExt,
GUID_TDFKontextMenuShellExt, '', 'DFKontextMenu',
ciMultiInstance, tmApartment);
// Bitmap erzeugen
hBmp := TBitmap.Create;
// Bild aus Ressourcendatei laden (der Name der Bildressource muss als 2. Parameter ange-
// geben werden - auf keinen Fall den DefaultNamen belassen, den der Bildeditor vergibt!
hBmp.LoadFromResourceName(hInstance, 'DFKONTEXTMENU');
finalization
// Bitmap wieder freigeben
hBmp.Free;
end.