Add items to the Windows Explorer right-click menu (2)

Problem/Question/Abstract:

Does anybody know how to write a Delphi program that can add itself to the Windows Explorer right-click menu? I have seen some simple cases like adding NotePad for txt files but that only works on one file (if you highlight many files then many instances of Notepad will be created). I want to be able to highlight a group of files and then pass all of them (probably through a command line argument) to my progam so it can act on the group of them.

Answer:

Implement IContextMenu and IShellExtInit:

TOFCContextMenu = class(TComObject, IContextMenu, IShellExtInit)
private
  FileList: TStringList;
protected
  function IShellExtInit.Initialize = IShellExtInit_Initialize;
  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;
  function IShellExtInit_Initialize(pidlFolder: PItemIDList; lpdobj: IDataObject;
    hKeyProgID: HKEY): HResult; stdcall;
public
  destructor Destroy; override;
end;

In the Initialize method of the IShellExtInit interface you can determine which files are selected:

function TOFCContextMenu.IShellExtInit_Initialize(pidlFolder: PItemIDList;
  lpdobj: IDataObject; hKeyProgID: HKEY): HResult; stdcall;
var
  StgMedium: TStgMedium;
  FormatEtc: TFormatEtc;
  szFile: array[0..MAX_PATH + 1] of Char;
  FileCount: Integer;
  FileCounter: Integer;
begin
  try
    if (lpdobj <> nil) then
    begin
      with FormatEtc do
      begin
        cfFormat := CF_HDROP;
        ptd := nil;
        dwAspect := DVASPECT_CONTENT;
        lindex := -1;
        tymed := TYMED_HGLOBAL;
      end;
      Result := lpdobj.GetData(FormatEtc, StgMedium);
      if (not Failed(Result)) then
      begin
        FileList := TStringList.Create;
        FileList.Clear;
        FileList.Sorted := True;
        FileList.Duplicates := dupIgnore;
        FileCount := DragQueryFile(stgmedium.hGlobal, $FFFFFFFF, nil, 0);
        for FileCounter := 0 to FileCount - 1 do
        begin
          DragQueryFile(stgmedium.hGlobal, FileCounter, szFile, SizeOf(szFile));
          FileList.Add(StrPas(szFile));
        end;
        Result := NOERROR;
        ReleaseStgMedium(StgMedium);
      end;
    end
    else
      Result := E_INVALIDARG;
  except
    Result := E_FAIL;
  end;
end;

The file list must be freed in the destructor:

destructor TOFCContextMenu.Destroy;
begin
  try
    FileList.Free;
  except
  end;
  inherited Destroy;
end;

Now implement the other methods:

QueryContextMenu
InvokeCommand
GetCommandString

At the end of the unit you can register the extension:

initialization
  TRegisterContextMenuFactory.Create(ComServer, TOFCContextMenu, Class_OFCContextMenu,
    'OFCContextMenu', 'A description', ciMultiInstance, tmApartment);

Remember to protect every method with try..except or try..finally. The main application is the explorer. It doesn't support exception handling like a delphi application does. An exception outside a try..except/finally compound causes the explorer to crash.

The TRegisterContextMenuFactory object looks something like this:

type
  TRegisterContextMenuFactory = class(TComObjectFactory)
  protected
    function GetProgID: string; override;
  public
    procedure UpdateRegistry(Register: Boolean); override;
  end;

function TRegisterContextMenuFactory.GetProgID: string;
begin
  Result := '';
end;

procedure TRegisterContextMenuFactory.UpdateRegistry(Register: Boolean);
const
  ApproveKey = 'SOFTWARE\Microsoft\Windows\CurrentVersion\ShellExtensions\Approved\';
var
  ClsID: string;
begin
  inherited UpdateRegistry(Register);
  ClsID := GUIDToString(ClassID);
  if (Register) then
  try
    {Additional registry settings }
    if Win32Platform = VER_PLATFORM_WIN32_NT then
      CreateRegKeyEx(ApproveKey, ClsId, PChar(Description), REG_SZ,                                                              Length(Description) + 1, HKEY_LOCAL_MACHINE);
  except
  end
  else
  try
    if Win32Platform = VER_PLATFORM_WIN32_NT then
      DeleteRegValue(ApproveKey, ClsId, HKEY_LOCAL_MACHINE);
    {Delete additional registry settings }
  except
  end;
end;

Instead of {Additional registry settings } you must add the registry keys for the extension. Like which file exctension is associated. You can use HKEY_LOCAL_MACHINE\* for all extensions.