Explorer Popup

[edosoft]

Diese Funktion zeigt das Windows-Explorer-Kontextmenü für eine bestimmte Datei an.

Hier die Kontextmenü-Funktion: (eigentlich sinds 3 funktionen)

Delphi-Quellcode:

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;

Beispielaufruf:
ContextMenuForFile('Dateiname', 100, 200, Form1.Handle); Wenn ich jetzt des Kontextmenü anzeige funktioniert des zwar ganz gut, bloß gibts den "Umbenennen" Eintrag nicht und wenn ich auf "Senden an" fahr klappt sich das Senden-An Menü nicht aus (bei WinRar klappt sichs aus).

Hat jemand eine Idee wie ich dieses Problem lösen kann?
thnx schon mal im Vorraus!