unit Main;
interface
uses
ComServ, SysUtils, ShellAPI, Registry, Classes, Windows,
ActiveX, ComObj, ShlObj, Graphics, Dialogs;
// Die GUID wird für die eindeutige Registrierung der Shell-Erweiterung benötigt
const
GUID_TDFKontextMenuShellExt: TGUID = '
{C97326B2-8812-49C9-9606-2E2EDF05D7DA}';
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 - hier kommt ein 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 angegeben
// werden - auf keinen Fall den DefaultNamen belassen, den der Bildeditor vergibt!
hBmp.LoadFromResourceName(hInstance, '
DFKONTEXTMENU');
finalization
// Bitmap wieder freigeben
hBmp.Free;
end.