[Lazarus] Windows context menu for files and directories

[Jürgen Hestermann]

 From internet sources (mostly from
http://bcbjournal.org/articles/vol4/0006/Using_the_shell_context_menu.htm )
I have scraped together a routine to display
the Windows context menu for a given file or directory name (see below).
This works okay but (at least) one issue appears:

On Windows XP, when clicking on the context menu entry "Send to" another submenu "Send to"
is shown instead of a list of programs to select. When clicking on this second "Send to" nothing happens.
On Windows 7 everything works ok and the list of programs is displayed!
Also, selecting other entries like "Properties" work ok on both platforms.

Any Windows gurus who know why this is the case (and how to fix it)?



//-------------------------------------------------------------------------------------
procedure FileShowContextMenuOK(Handle : HWND; const Path,Name : UTF8String; const PosX,PosY : SizeInt);
var DesktopFolder : IShellFolder = nil;
     ParentFolder  : IShellFolder = nil;
     Attr,
     Eaten,
     Flags         : DWord;
     B             : WinBool;
     CM            : IContextMenu;
     CI            : TCMINVOKECOMMANDINFO;
     hM            : HMENU;
     WidePath,
     WideName      : WideString;
     Pidl,
     ParentPidl    : LPITEMIDLIST;

begin // FileShowContextMenuOK
SHGetDesktopFolder(DesktopFolder);
if not assigned(DesktopFolder) then
    Exit;
WidePath := UTF8Decode(Path);
Attr     := 0;
if DesktopFolder.ParseDisplayName(Handle,nil,pwidechar(WidePath),Eaten,ParentPidl,Attr)<>0 then
    Exit;
if DesktopFolder.BindToObject(ParentPidl,nil,IID_IShellFolder,ParentFolder)<>0 then
    Exit;
WideName := UTF8Decode(Name);
if ParentFolder.ParseDisplayName(Handle,nil,pwidechar(WideName),Eaten,Pidl,Attr)<>0 then
    Exit;
if ParentFolder.GetUIObjectOf(Handle,1,Pidl,IID_IContextMenu,nil,CM)<>0 then
    Exit;
hM    := CreatePopupMenu;
Flags := CMF_EXTENDEDVERBS; //CMF_EXPLORE; // CMF_NORMAL; //CMF_ASYNCVERBSTATE; // CMF_EXPLORE;
CM.QueryContextMenu(hM,0,1,$7FFF,Flags);
B := TrackPopupMenu(hM,TPM_LEFTALIGN or TPM_LEFTBUTTON or TPM_RIGHTBUTTON or TPM_RETURNCMD { or TPM_NONOTIFY or TPM_RETURNCMD},
                     PosX,PosY,0,Handle,nil);
if not B then
    exit;
fillchar(CI,sizeof(CI),0);
with CI do
    begin
    cbSize       := SizeOf(CI);
    lpVerb       := MAKEINTRESOURCE(Integer(B)-1);
    lpParameters := '';
    lpDirectory  := '';
    hwnd         := Handle;
    nShow        := SW_SHOWNORMAL;
    end;
CM.InvokeCommand(CI);
CoTaskMemFree(Pidl);
CoTaskMemFree(ParentPidl);
end;  // FileShowContextMenuOK
//-------------------------------------------------------------------------------------