{ Arabic Programmer; }

... ShlObj, ActiveX, ComObj, shellapi

IShellCommandVerb = interface
    ['{7D2A7245-2376-4D33-8008-A130935A2E8B}']
    procedure ExecuteCommand(Verb: string; var Handled: boolean);
    procedure CommandCompleted(Verb: string; Succeeded: boolean);
  end;

  PArrayOfPItemIDList = ^TArrayOfPItemIDList;
  TArrayOfPItemIDList = array[0..0] of PItemIDList;

procedure ShowSysPopup(aFileList: TStrings; x, y: integer; HND: HWND);
var
  Root: IShellFolder;
  ShellParentFolder: IShellFolder;
  chEaten,dwAttributes: ULONG;
  FilePIDL,ParentFolderPIDL: PItemIDList;
  CM: IContextMenu;
  Menu: HMenu;
  Command: LongBool;
  ICM2: IContextMenu2;

  ICI: TCMInvokeCommandInfo;
  ICmd: integer;
  ZVerb: array[0..255] of AnsiChar;
  Verb: string;
  Handled: boolean;
  SCV: IShellCommandVerb;
  HR: HResult;
  P: TPoint;

  ItemIDListArray: PArrayOfPItemIDList;
  idx: Integer;
Begin
  if aFileList.Count = 0 then
    Exit;

  OleCheck(SHGetDesktopFolder(Root));//Get the Desktop IShellFolder interface

  OleCheck(Root.ParseDisplayName(HND, nil,
    PWideChar(WideString(ExtractFilePath(aFileList[0]))),
    chEaten, ParentFolderPIDL, dwAttributes)); // Get the PItemIDList of the parent folder

  OleCheck(Root.BindToObject(ParentFolderPIDL, nil, IShellFolder,
  ShellParentFolder)); // Get the IShellFolder Interface  of the Parent Folder

  //allocate memory for the PItemIDList array
  ItemIDListArray := AllocMem(SizeOf(PItemIDList) * aFileList.Count);
  try
  for idx := 0 to aFileList.Count - 1 do
  Begin
    // Get the relative  PItemIDList of each file in the list
    OleCheck(ShellParentFolder.ParseDisplayName(HND, nil,
      PWideChar(WideString(ExtractFileName(aFileList[idx]))),
      chEaten, FilePIDL, dwAttributes));
    ItemIDListArray^[idx] := FilePIDL;
  End;
  // get the IContextMenu Interace for the file array
  ShellParentFolder.GetUIObjectOf(hnd, aFileList.Count, ItemIDListArray^[0], IID_IContextMenu, nil, CM);
  finally
    FreeMem(ItemIDListArray);
  end;



  if CM = nil then Exit;
  P.X := X;
  P.Y := Y;

  Windows.ClientToScreen(HND, P);

  Menu := CreatePopupMenu;

  try
    CM.QueryContextMenu(Menu, 0, 1, $7FFF, CMF_EXPLORE or CMF_CANRENAME);
    CM.QueryInterface(IID_IContextMenu2, ICM2); //To handle submenus.
    try
      Command := TrackPopupMenu(Menu, TPM_LEFTALIGN or TPM_LEFTBUTTON or TPM_RIGHTBUTTON or
        TPM_RETURNCMD, p.X, p.Y, 0, HND, nil);
    finally
      ICM2 := nil;
    end;

    if Command then
    begin
      ICmd := LongInt(Command) - 1;
      HR := CM.GetCommandString(ICmd, GCS_VERBA, nil, ZVerb, SizeOf(ZVerb));
      Verb := StrPas(ZVerb);
      Handled := False;
      if Supports(nil, IShellCommandVerb, SCV) then
      begin
        HR := 0;
        SCV.ExecuteCommand(Verb, Handled);
      end;

      if not Handled then
      begin
        FillChar(ICI, SizeOf(ICI), #0);
        with ICI do
        begin
          cbSize := SizeOf(ICI);
          hWND := 0;
          lpVerb := MakeIntResourceA(ICmd);
          nShow := SW_SHOWNORMAL;
        end;
        HR := CM.InvokeCommand(ICI);
      end;

      if Assigned(SCV) then
        SCV.CommandCompleted(Verb, HR = S_OK);
    end;
  finally
     DestroyMenu(Menu)
  end;
End;

procedure TForm2.btnAddFilesToListClick(Sender: TObject);
var
  idx: Integer;
begin
  ListBox1.Clear;
  with  TOpenDialog.Create(self) do
  try
    Options := [ofReadOnly, ofAllowMultiSelect, ofEnableSizing];
    if Execute then
      for idx := 0 to Files.Count - 1 do
        ListBox1.Items.Add(Files[idx])
  finally
    free;
  end;
end;

procedure TForm2.btnShowMenuClick(Sender: TObject);
begin
    ShowSysPopup(ListBox1.Items,btnShowMenu.Left,btnShowMenu.Top, Handle);
end;

initialization
  OleInitialize(nil);
finalization
  OleUninitialize;