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.