function SlashDirName(ADir: String): String;
var
  S: String;
  RootDir: Boolean;
begin
if ADir<>'' then
  begin
  S:=ADir;
  RootDir:=((Length(S)=3) and (S[2]=':')) or (S='\');
  if not RootDir then
    if S[Length(S)]<>'\' then S:=S+'\';
  Result:=S;
  end;
end;

function SHGetIDListFromPath(Path: TFileName; var ShellFolder: IShellFolder): PItemIDList;
var
  TempPath, NextDir: TFileName;
  SlashPos: Integer;
  Folder, subFolder: IShellFolder;
  PIDL, PIDLbase: PItemIDList;
  ParseStruct: TStrRet;
  ParseNAme: String;
  EList: IEnumIDList;
  DidGet: Cardinal;
  ScanParam: Integer;
begin
SHGetDesktopFolder(Folder);
SHGetSpecialFolderLocation(0, CSIDL_DRIVES, PIDLbase);

OLECheck(Folder.BindToObject(PIDLbase, nil, IID_IShellFolder, Pointer(SubFolder)));
TempPath:=Path;
NextDir:='';

while Length(TempPath)>0 do
  begin
  SlashPos:=Pos('\', TempPath);
  if SlashPos > 0 then
    begin
    if Pos(':', TempPath) > 0 then NextDir:=Copy(TempPath, 1, 3)
      else NextDir:=SlashDirName(NextDir)+Copy(TempPath, 1, SlashPos-1);
    TempPath:=Copy(TempPath, SlashPos+1, Length(TempPath));
    end
  else
    begin
    if NextDir='' then NextDir:=TempPath
      else NextDir:=SlashDirName(NextDir)+TempPath;
    TempPath:='';
    end;
  PIDL:=PidlBase;
  ScanParam:=SHCONTF_FOLDERS or SHCONTF_INCLUDEHIDDEN;
  if (NextDir=Path) and (not DirectoryExists(Path)) then
    ScanParam:=ScanParam or SHCONTF_NONFOLDERS;

  if S_OK=SubFolder.EnumObjects(0, ScanParam, EList) then
    while S_OK=EList.Next(1, pidl, DidGet) do
      begin
      OLECheck(SubFolder.GetDisplayNameOf(PIDL, SHGDN_FORPARSING, ParseStruct));
      case ParseStruct.uType of
        STRRET_CSTR: ParseName:=ParseStruct.cStr;
        STRRET_WSTR: ParseName:=WideCharToString(ParseStruct.pOleStr);
        STRRET_OFFSET: Parsename:=PChar(DWORD(Pidl)+ParseStruct.uOffset);
        end;
      if UpperCase(Parsename)=UpperCase(NextDir) then Break;
      end
    else
      begin
      Folder:=nil;
      Result:=nil;
      Exit;
      end;

  if DidGet=0 then
    begin
    Folder:=nil;
    Result:=nil;
    Exit;
    end;
  PIDLBase:=PIDL;
  Folder:=subFolder;

  if not FileExists(NextDir) then
    OLECheck(Folder.BindToObject(Pidl, nil, IID_IShellFolder, Pointer(SubFolder)));
  end;
ShellFolder:=Folder;
if ShellFolder=nil then Result:=nil
  else Result:=PIDL;
end;

procedure ContextMenuForFile(FileName: TFileName; X, Y: Integer; Handle: HWND);
var
  aContextMenu: IContextMenu;
  aPrgOut: Pointer;
  aPopup: HMENU;
  aCmd: Integer;
  aCmdInfo: TCMInvokeCommandInfo;
  PIDL: PItemIDList;
  ShellFolder: IShellFolder;
begin
PIDL:=SHGetIDListFromPath(FileName, ShellFolder);
if not Assigned(PIDL) then Exit;
aPrgOut:=nil;
OLECheck(ShellFolder.GetUIObjectOf(0, 1, PIDL, IID_IContextMenu, aPrgOut, Pointer(aContextMenu)));
aPopup:=CreatePopUpMenu;
if aPopup=0 then Exit;
try
  OLECheck(aContextMenu.QueryContextMenu(aPopup, 0, 1, $7FFF, CMF_NORMAL));
  aCmd:=Integer(TrackPopupMenuEx(aPopup, TPM_LEFTALIGN or TPM_RETURNCMD or TPM_RIGHTBUTTON or TPM_HORIZONTAL or TPM_VERTICAL, X, Y, Handle, nil));
  if aCmd<>0 then
    begin
    FillChar(aCmdInfo, Sizeof(aCmdInfo), 0);
    with aCmdInfo do
      begin
      cbSize:=SizeOf(TCMInvokeCommandInfo);
      lpVerb:=MakeIntResource(aCmd-1);
      nShow:=SW_SHOWNORMAL;
      end;
    try
      aContextMenu.InvokeCommand(aCmdInfo);
      except
      end;
    end;
  finally
    DestroyMenu(aPopup);
  end;
end;

var
  aContextMenu: IContextMenu;
  aContextMenu2: IContextMenu2;
// ...
begin
// ...
    aContextMenu.QueryContextMenu(aPopup, 0, 1, $7FFF, CMF_EXPLORE or CMF_CANRENAME);
    aContextMenu.QueryInterface(IID_IContextMenu2, aContextMenu2); //To handle submenus.
    try
      aCmd:=Integer(TrackPopupMenu(aPopup, TPM_LEFTALIGN or TPM_LEFTBUTTON or TPM_RIGHTBUTTON or
        TPM_RETURNCMD, X, Y, 0, Handle, nil));
    finally
      aContextMenu2 := nil;
    end;

    if aCmd<>0 then
// ...

type
  TForm1 = class(TForm)
//...
    procedure WndProc(var Message: TMessage); override;
  private
    { Private-Deklarationen }
  public
    { Public-Deklarationen }
  end;
//...

implementation

{$R *.dfm}

uses
  ComObj, ShlObj, ActiveX;

function SlashDirName(ADir: String): String;
//wie oben
//...

function SHGetIDListFromPath(Path: TFileName; var ShellFolder: IShellFolder): PItemIDList;
//wie oben
//...

var
  aContextMenu: IContextMenu;
  aContextMenu2: IContextMenu2;

procedure ContextMenuForFile(FileName: TFileName; X, Y: Integer; Handle: HWND);
var
  aPrgOut: Pointer;
  aPopup: HMENU;
  aCmd: Integer;
  aCmdInfo: TCMInvokeCommandInfo;
  PIDL: PItemIDList;
  ShellFolder: IShellFolder;
begin
PIDL:=SHGetIDListFromPath(FileName, ShellFolder);
if not Assigned(PIDL) then Exit;
aPrgOut:=nil;
OLECheck(ShellFolder.GetUIObjectOf(0, 1, PIDL, IID_IContextMenu, aPrgOut, Pointer(aContextMenu)));
aPopup:=CreatePopUpMenu;
if aPopup=0 then Exit;
try
  OLECheck(aContextMenu.QueryContextMenu(aPopup, 0, 1, $7FFF, CMF_EXPLORE or CMF_CANRENAME));
  OLECheck(aContextMenu.QueryInterface(IID_IContextMenu2, aContextMenu2)); //To handle submenus.

  try
  aCmd:=Integer(TrackPopupMenu(aPopup, TPM_LEFTALIGN or TPM_LEFTBUTTON or TPM_RIGHTBUTTON or TPM_RETURNCMD, X, Y, 0, Handle, nil));
  if aCmd<>0 then
    begin
    FillChar(aCmdInfo, Sizeof(aCmdInfo), 0);
    with aCmdInfo do
      begin
      cbSize:=SizeOf(TCMInvokeCommandInfo);
      lpVerb:=MakeIntResource(aCmd-1);
      nShow:=SW_SHOWNORMAL;
      end;
    try
      aContextMenu.InvokeCommand(aCmdInfo);
      except
      end;
    end;
  finally
    aContextMenu2 := nil;
  end;
finally
  DestroyMenu(aPopup);
end;
end;

procedure TForm1.WndProc(var Message: TMessage);
begin
  case Message.Msg of
    WM_INITMENUPOPUP,
    WM_DRAWITEM,
    WM_MENUCHAR,
    WM_MEASUREITEM:
      if Assigned(aContextMenu2) then
      begin
        If (aContextMenu2.HandleMenuMsg(Message.Msg, Message.wParam, Message.lParam) <> NOERROR) then
          inherited WndProc(Message)
        else
          Message.Result := 0;
      end
      else
      inherited WndProc(Message);
  else
    inherited WndProc(Message);
  end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  aContextMenu2 := nil;
end;

PIDL:=SHGetIDListFromPath(FileName, ShellFolder);