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:

Delphi-Quellcode:

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! :-D

[scp]

Bau das ganze mal so etwa so um:

Delphi-Quellcode:

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
// ...

Ungetestet. genaueres erfährst du in der ShellCtrls.pas im Delphi-Ordner unter Demos\ShellControls, wenn du nach InvokeContextMenu suchst.

[edosoft]

Damit gings leider nicht...
Ich habs jetzt rausgefunden: man muss noch sone Windows-Message machen und solche Sachen, aber jetzt funktionierts.
Allerdings kann ich nur ein Popup für eine einzelne Datei anzeigen. Weisst du vielleicht noch wie ich da mehrere Dateien einfügen kann?

Ansonsten hab ich bis jetzt mal ein KOmponent gebaut mit dem kann man des dann aufrufen...
(Ist allerdings ein bissle umständlich weil man dafür ein eigenes Handle braucht deshalb hab ich ein TWinComponent genommen und den so gemacht dass er aussieht wie ein TComponent :-D )

Wenn ihr des haben wollt kann ichs ja mal uploaden, habs jetzt grad bloß aufnem anderen Rechner...

[scp]

So, habs raus, da ist tatsächlich ne WndProc nötig:

Delphi-Quellcode:

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;

[Codehunter]

Hallo!

Ich tu jetzt mal was böses und krame einen 8 Jahre alten Thread wieder hoch :-)

Ich habe mich mit dem Code befasst und wollte ihn in ein Projekt einbauen. Dabei ist mir aufgefallen, dass der Code nur bei lokalen Dateien funktioniert. Liegen die Dateien aber auf einer Netzwerkfreigabe und der Pfad lautet nicht C:\Irgendwo\Irgendwas.file sondern \\Server\Irgendwo\Irgendwas.file dann liefert folgende Zeile immer NIL zurück:

Code:

PIDL:=SHGetIDListFromPath(FileName, ShellFolder);

Jetzt steck ich aber auch nicht so tief in der Shellprogrammierung drin dass ich SHGetIDListFromPath durchschauen würde. Das einzige was ich bisher rausgefunden habe ist, dass die WHILE-Schleife lediglich durch lokale Laufwerke scannt, nicht durch Netshares.

Ich hoffe es hilft hier noch jemand ein wenig mit :-)

Grüße
Cody