function DriveToPidlBind(const DriveName: string; out Folder: IShellFolder):
  PItemIdList;
var
  Attr: ULONG;
  Eaten: ULONG;
  DesktopFolder: IShellFolder;
  Drives: PItemIdList;
  Path: TUnicodePath;
begin
  Result := nil;
  if Succeeded(SHGetDesktopFolder(DesktopFolder)) then begin
　　if Succeeded(SHGetSpecialFolderLocation(0, CSIDL_DRIVES, Drives)) then begin
  　　if Succeeded(DesktopFolder.BindToObject(Drives, nil, IID_IShellFolder, Pointer(Folder))) then  begin
    　　MultiByteToWideChar(CP_ACP, MB_PRECOMPOSED, PChar(PathAddSeparator(DriveName)), -1, Path, MAX_PATH);
    　　if FAILED(Folder.ParseDisplayName(0, nil, Path, Eaten, Result, Attr)) then begin
      　　Folder := nil;
    　　end;
  　　end;
　　end;
　　PidlFree(Drives);
  end;
end;

function PathToPidlBind(const FileName: string; out Folder: IShellFolder):
  PItemIdList;
var
  Attr, Eaten: ULONG;
  PathIdList: PItemIdList;
  DesktopFolder: IShellFolder;
  Path, ItemName: pwidechar;
  s1,s2: string;
  k: integer;
begin
  Result := nil;
 
  s1:= ExtractFilePath(FileName);
  s2:= ExtractFileName(FileName);
  Path:= a2u(s1);
  ItemName:= a2u(s2);

if Succeeded(SHGetDesktopFolder(DesktopFolder)) then begin
　　if Succeeded(DesktopFolder.ParseDisplayName(0, nil, Path, Eaten, PathIdList, Attr)) then begin // FAIL
  　　if Succeeded(DesktopFolder.BindToObject(PathIdList, nil, IID_IShellFolder, Pointer(Folder))) then begin
    　　if FAILED(Folder.ParseDisplayName(0, nil, ItemName, Eaten, Result, Attr)) then begin
      　　Folder := nil;
      　　Result := DriveToPidlBind(FileName, Folder);
    　　end;
  　　end;
  　　PidlFree(PathIdList);
　　end
　　else
  　　Result := DriveToPidlBind(FileName, Folder);
  end;

FreeMem(Path);
  FreeMem(ItemName);
end;

function LANToPidlBind(NetPath: string; out Folder: IShellFolder): PItemIdList;
var
  Attr, Eaten: ULONG;
  DesktopFolder: IShellFolder;
  nt,pid1,pid2: PItemIdList;
  Path,FullPath: pwidechar;
  s1,s2: string;
  k: integer;
  err: HResult;
begin
  Result := nil;
end;

function DisplayContextMenu(const Handle: Thandle; const FileName: string; Pos: TPoint): Boolean;
var
  ItemIdList: PItemIdList;
  Folder: IShellFolder;
begin
  Result := False;
  ItemIdList := PathToPidlBind(FileName, Folder);

if ItemIdList <> nil then
  begin
　　Result := DisplayContextMenuPidl(Handle, Folder, ItemIdList, Pos);
　　PidlFree(ItemIdList);
　　//Folder:= nil;
  end;
end;

end.

// ========================================= //

procedure TFormTest.Button59Click(Sender: TObject);
var
  pos: TPoint;
begin
  GetCursorPos(pos);
  pos:= ScreenToClient(pos);
  DisplayContextMenu(handle, 'c:\tools\setup', pos);
end;