ContextMenuHandlers in eigene PopupMenüs einbinden

[franz]

Derzeit arbeite ich an einem Explorer. Dabei ist folgendes Problem aufgetreten.
:( Ich möchte, wie der Windows Explorer, Context Menu Handlers in mein PopupMenu einbinden. Allerdings ist bisher jeder Versuch gescheitert.

Über die CLSID des Handlers erhalte ich die dazugehörige DLL. Nun folgendes Problem. Zur Entwurfszeit ist es wunderbar möglich Funktionen aus DLLs einzubinden. Aber die DLL ist erst zur Laufzeit bekannt.

Es geht mir nur um die Einbindung der Context Menu Handlers. Der übrige Teil des Menüs, der auf der Dateitypdeklaration basiert, ist kein Problem.

Meine Fragen:
1. Wie werden Funktionen aus DLLs zur Laufzeit eingebunden?
2. Kann ich die folgende Funktion verwenden, um die Menüeinträge aus der DLL in mein Menü einzubinden?

Delphi-Quellcode:

function QueryContextMenu(const IMenu: IContextMenu; Menu: HMENU;
 ixMenu, idCmdFirst, idCmdLast, uFlags: UINT): HResult; stdcall; external 'Pfad der DLL';

Vielleicht weiß es jemand?

[cheatzs]

Hi.
kenn mich nich so wahnsinnig gut mit DLL's aus, auf jeden Fall findest du hier ein gutes Tutorial für dynamische Einbindung von DLLs: http://www.luckie-online.de/tutorials/assarbad/

Ist allerdings etwas komplizierter als die statische Einbindung.

Auf die 2. Frage weiß ich keinen Rat, wie gesagt, kenn mich nich so aus in dem Bereich, wollt bloß schnell ne Ansatz für dich schreiben :wink:

Viel Glück :thuimb:

[franz]

:thuimb: Danke für den Tipp.

Das dynamische Einbinden von DLLs ist jetzt kein Problem mehr. Doch die Erstellung des Menüs, abhängig vom Handler, funktioniert noch nicht.

:gruebel: Beim Aufruf von GetProcAdress wird immer nil zurückgegeben.

Ich habe folgendes geschrieben:

Delphi-Quellcode:

type
  TFNCreateMenuItems = function (Menu: HMENU; indexMenu, idCmdFirst, 
    uFlags: UINT): HResult;

var
  CreateMenuItems: TFNCreateMenuItems;

var
  libHandle: THandle;
begin
  libHandle := LoadLibrary(PChar('C:\PROGRAMME\ULTIMATEZIP\UZSHLEX.DLL'));
  if libHandle <> 0 then
     begin
       @CreateMenuItems := GetProcAddress(libHandle,PChar('QueryContextMenu'));
       if @CreateMenuItems <> nil then
          begin
            CreateMenuItems(PopupMenu1.Handle,0,0,0,CMF_NORMAL);
            PopupMenu1.Popup(Mouse.CursorPos.x,Mouse.CursorPos.y);
          end
       else
         ShowMessage('Fehler (@CreateMenuItems = nil): ' + IntToStr(GetLastError));
     end
  else
    ShowMessage('Fehler (libHandle = 0): ' + IntToStr(GetLastError));
  FreeLibrary(libHandle);
end;

[franz]

Klar, dass das obere Beispiel nicht funktioniert.
ContextMenuHandler DLLs exportieren die notwendigen Funktionen nicht! Wäre ja auch viel zu einfach.

Werde es mal über die Schnittstellen IShellExtInit und IContextMenu versuchen. Irgendwie muss der Windows Explorer das auch hinkriegen.

[franz]

Noch einmal zu meiner Frage:
Wie kann ich Context Menu Handler in eigenen PopupMenüs verwenden?
Mein größtes Problem ist es einen geeigneten Ansatz zu finden.

Bisher habe ich folgendes geschrieben:

Delphi-Quellcode:

const
  GUID: TGUID = '{2F860D81-AF3C-11D4-BDB3-00E0987D8540}'; // CLSID des Handlers
var
  Handler: Variant;
begin
  Handler := CreateComObject(GUID);
  Handler.QueryContextMenu(PopupMenu1.Handle,0,0,0, CMF_NORMAL); // Fehler an dieser Stelle
end;

Allerdings hat diese nichts geholfen. Ich erhalte jetzt die Fehlermeldung „Variante referenziert kein Automatisierungsobjekt“. Könnte das daran liegen, dass CreateComObject eine IUnknown Schnittstelle zurückgibt?

[franz]

Ich habe jetzt eine halbwegs akzeptable Lösung, die auf dem Source von edosoft aufbaut. Allerdings funktioniert diese noch nicht richtig.

Weiteres in Kürze.

[franz]

Nachtrag:
Ich habe jetzt das selbe Problem, das edosoft hatte.

Da ich allerdings mit Delphi5 arbeite steht mir die Unit ShellCtrls nicht zur Verfügung.

[franz]

:coder: Bin jetzt etwas weiter.

Allerdings gibt es immer noch 5 Probleme.

:gruebel: 1. Problem
Die Menüeinträge, die vor dem Hinzufügen der Handler, sich im Menu befinden, reagieren auf die falschen Ereignisse. Wenn auf einen eigenen Menüeintrag geklickt wird, wird das Ereignis ausgelöst, das der zuletzt angeklickte Handler Menüeintrag ausgelöst hat.
Wenn noch kein Handler Menüeintrag angeklickt wurde, wird z. B. statt einen Dialog anzuzeigen, nach einer Diskette gefragt, die zugrundeliegende Datei gelöscht oder es geschieht gar nichts und das alles beim gleichen Menüeintrag. Dann kommt auch noch dazu, dass das falsche Ereignis bei allen eigenen Menüeinträgen auftritt. Wenn z. B. bei Menüeintrag „A“ eine Datei gelöscht wird, wird auch bei Menüeintrag „B“ eine Datei gelöscht u. s. w.

Ich habe folgende Liste aufgestellt, die die Rückgabewerte von mCmd in ContextMenuForFile enthält:

Zitat:

Virensuche 68
Zu Zip Archiv hinzufügen 67
Hinzufügen zu Zip 66
Zip und E-Mail 65
Senden an - Diskette 2
Senden an -Desktop Verknüpfung 2
Senden an - Eigene Dateien 2
Senden an - E-Mail Empfänger 2
Senden an - Web Publish Assistent 2

Eigener Menüeintrag „A“ 1
Eigener Menüeintrag „B“ 2

Natürlich kann man mCmd mit einer Case Anweisung abarbeiten und die notwendigen Ereignisse aufrufen. Allerdings gibt es nun wieder folgendes Problem. Der eigene Menüeintrag „B“ hat den gleichen Wert, wie die Menüeinträge des „Senden an“ Menüs. Dadurch werden die falschen Ereignisse für die Menüeinträge im „Senden an“ Menü aufgerufen.

Frage: Was muss man ändern, damit die richtigen Ereignisse aufgerufen werden?


:gruebel: 2. Problem (Dieses Problem tritt nur auf, wenn das Menü auf seine Handler beschränkt angezeigt wird (idCmdLast = 0))
Wenn das eigene PopupMenu Untermenüs enthält, tritt eine Zugriffsverletzung in „SHDOC401.dll“ auf, wenn die Maus auf den Menüeintrag geführt wird, der weitere Untereinträge enthält. Manchmal stürzt Windows ( 98 ) sogar mit einer schweren Ausnahmefehler ab.



:gruebel: 3. Problem (Dieses Problem tritt nur auf, wenn das Menü auf seine Handler beschränkt angezeigt wird (idCmdLast = 0))
Die Handler lassen sich nur an erster Stelle (0) in das Menü einfügen. Wenn die Handler an Stelle 1 eingefügt werden sollen, gerät die Menüordnung durcheinander und der erste eigene Menüeintrag „A“ löst sich im Nichts auf. Außerdem enthält der Menüeintrag „Senden an“ wieder den Eintrag „Senden an“. Wenn für den Index 2 oder eine höhere Zahl verwendet wird, tritt beim Anzeigen des Menüs eine Zugriffsverletzung auf.



:gruebel: 4. Problem
Die hinzugefügten Menüeinträge lassen sich nicht mehr entfernen. Sie verschwinden erst wieder, wenn das PopupMenu angezeigt wird, ohne die Handler Menüeinträge einzufügen. Wahrscheinlich wird dabei nicht einmal der belegte Speicherplatz der Handler Menüeinträge freigegeben.


:gruebel: 5. Problem (weniger wichtig)
Im Windows Explorer werden in der Statusleiste Hints zu den ausgewählten Menüeinträgen angezeigt. Dazu muss „GetCommandString“ aufgerufen werden. Allerdings liefert der Aufruf entweder einen leeren String, den Pfad der Ursprungsdatei oder sogar „C:\Server nicht gefunden!“. Auch zu Menüeinträgen, die bereits vorhanden sind und einen Hint besitzen, wird in der Statusleiste nichts angezeigt. Das liegt allerdings nicht daran, dass ich vergessen hätte „AutoHint“ auf true zu setzen. Außerdem weiß ich nicht, wann ich „GetCommandString“ aufrufen soll.


Ich habe bisher folgendes geschrieben (Auch wenn es noch unvorteilhaft aussieht – wird später geändert, wenn es endlich funktioniert, falls dies möglich ist):

Delphi-Quellcode:

uses ShellApi, ShlObj, ComObj, FileCtrl, ActiveX;
{$R *.DFM}

var
  mContextMenu:  IContextMenu;
  mContextMenu2: IContextMenu2;

function SHGetIDListFromPath(FileName: TFileName; var ShellFolder: IShellFolder): PItemIDList;
var
  sParseName: String;
  mTempPath, mNextDir: TFileName;
  iScanParam: Integer;
  iDidGet: Cardinal;
  mFolder, mSubFolder: IShellFolder;
  mPIDL, mPIDLbase: PItemIDList;
  mParseStruct: TStrRet;
  mEList: IEnumIDList;

  procedure GetDirs(var TempPath, NextDir: TFileName);
  var
    iSlashPos: Integer;

    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;
  begin
    iSlashPos := Pos('\', TempPath);
    if iSlashPos > 0 then
       begin
         if Pos(':', TempPath) > 0 then
            NextDir := Copy(TempPath, 1, 3)
         else
           NextDir := SlashDirName(NextDir) + Copy(TempPath, 1, iSlashPos - 1);
         TempPath := Copy(TempPath, iSlashPos + 1, Length(TempPath));
       end
    else
      begin
        if NextDir = '' then
           NextDir := TempPath
        else
          NextDir := SlashDirName(NextDir) + TempPath;
        TempPath := '';
      end;
  end;
begin
  SHGetDesktopFolder(mFolder);
  SHGetSpecialFolderLocation(0, CSIDL_DRIVES, mPIDLbase);

  OLECheck(mFolder.BindToObject(mPIDLbase, nil, IID_IShellFolder, Pointer(mSubFolder)));
  mTempPath := FileName;
  mNextDir  := '';

  while Length(mTempPath) > 0 do
    begin
      GetDirs(mTempPath,mNextDir);

      mPIDL := mPidlBase;
      iScanParam := SHCONTF_FOLDERS or SHCONTF_INCLUDEHIDDEN;
      if (mNextDir = FileName) and (not DirectoryExists(FileName)) then
         iScanParam := iScanParam or SHCONTF_NONFOLDERS;

      if S_OK = mSubFolder.EnumObjects(0, iScanParam, mEList) then
         while S_OK = mEList.Next(1, mPIDL, iDidGet) do
           begin
             OLECheck(mSubFolder.GetDisplayNameOf(mPIDL, SHGDN_FORPARSING, mParseStruct));
             case mParseStruct.uType of
               STRRET_CSTR:   sParseName := mParseStruct.cStr;
               STRRET_WSTR:   sParseName := WideCharToString(mParseStruct.pOleStr);
               STRRET_OFFSET: sParseName := PChar(DWORD(mPIDL) + mParseStruct.uOffset);
             end;

             if UpperCase(sParseName) = UpperCase(mNextDir) then
                Break;
           end
      else
        begin
          mFolder := nil;
          Result  := nil;
          Exit;
        end;

      if iDidGet = 0 then
         begin
           mFolder := nil;
           Result  := nil;
           Exit;
         end;

      mPIDLBase := mPIDL;
      mFolder   := mSubFolder;

      if not FileExists(mNextDir) then
         OLECheck(mFolder.BindToObject(mPIDL, nil, IID_IShellFolder, Pointer(mSubFolder)));
    end;

  ShellFolder := mFolder;
  if ShellFolder = nil then
     Result := nil
  else
    Result := mPIDL;
end;

procedure ContextMenuForFile(FileName: TFileName; X, Y: Integer; Handle: HWND);
var
  mPopup: HMENU;
  mCmd: Integer;
  mCmdInfo: TCMInvokeCommandInfo;
  mPIDL: PItemIDList;
  mShellFolder: IShellFolder;
  S: String;
begin
  mPIDL := SHGetIDListFromPath(FileName, mShellFolder);
  if not Assigned(mPIDL) then
     Exit;

  OLECheck(mShellFolder.GetUIObjectOf(Handle, 1, mPIDL, IID_IContextMenu, nil,
    Pointer(mContextMenu)));

  mPopup := CreatePopUpMenu;
  if mPopup = 0 then
     Exit;
  try
    OLECheck(mContextMenu.QueryContextMenu(Form1.PopupMenu1.Handle {mPopup}, 0 {Index}, 1 {idCmdFirst}, 0 {_$7FFF}{idCmdLast}, CMF_NORMAL));
    OLECheck(mContextMenu.QueryInterface(IID_IContextMenu2, mContextMenu2));

    try
      mCmd := Integer(TrackPopupMenuEx(Form1.PopupMenu1.Handle {mPopup}, TPM_LEFTALIGN or
                TPM_RIGHTBUTTON or TPM_HORIZONTAL or TPM_VERTICAL or TPM_RETURNCMD, X, Y, Handle, nil));

      // Hint anzeigen
      SetLength(S,40);
      mContextMenu.GetCommandString(mCmd,GCS_HELPTEXT,nil,PChar(S),SizeOf(S));
      Form1.StatusBar1.Panels[0].Text := S;

      // "OnClick" Ereignisse ausführen
      if mCmd <> 0 then
         case mCmd of
           1: Form1.A1.Click;
           2: Form1.B1.Click;
         else
           begin
             FillChar(mCmdInfo, SizeOf(mCmdInfo), 0);
             with mCmdInfo do
               begin
                 cbSize := SizeOf(TCMInvokeCommandInfo);
                 lpVerb := MakeIntResource(mCmd - 1);
                 nShow  := SW_SHOWNORMAL;
               end;
             try
               mContextMenu.InvokeCommand(mCmdInfo);
             except
               // nichts tun
             end;
           end;
         end;
    finally
      mContextMenu2 := nil;
    end;
  finally
    DestroyMenu(mPopup);
  end;
end;

procedure TForm1.WndProc(var Message: TMessage);
begin
  case Message.Msg of
    WM_INITMENUPOPUP,
    WM_DRAWITEM,
    WM_MENUCHAR,
    WM_MEASUREITEM: begin
                      if Assigned(mContextMenu2) then
                         begin
                           If (mContextMenu2.HandleMenuMsg(Message.Msg, Message.wParam, Message.lParam) <> NOERROR) then
                              inherited WndProc(Message)
                           else
                             Message.Result := 0;
                         end
                      else
                        inherited WndProc(Message);
                    end;
  else
    inherited WndProc(Message);
  end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  mContextMenu2 := nil;
end;

// Aufruf
procedure TForm1.Button1Click(Sender: TObject);
begin
  ContextMenuForFile('C:\Eigene Dateien\_Test\Test.txt',Mouse.CursorPos.x,Mouse.CursorPos.y,Handle);
end;

[franz]

Ich habe das erste Problem folgendermaßen gelöst:

Delphi-Quellcode:

function ExecMenuItemAction(Cmd: Integer; var Count: Integer; Item: TMenuItem): Boolean;
var
  ix: Integer;
begin
  Result := false;

  ix := 0;
  while ix < Item.Count do
    begin
      Application.ProcessMessages;

      if Cmd = Count then
         begin
           Item[ix].Click;
           Result := true;
           Exit;
         end;

      if Item.Items[ix].Count > 0 then
         ExecMenuItemAction(Cmd,Count,Item.Items[ix]);

      Inc(Count);
      Inc(ix);
    end;
end;

procedure ContextMenuForFile(FileName: TFileName; X, Y: Integer; Handle: HWND);
var
  mPopup: HMENU;
  iCmd, iCount: Integer;
  mCmdInfo: TCMInvokeCommandInfo;
  mPIDL: PItemIDList;
  mShellFolder: IShellFolder;
  S: String;
begin
  mPIDL := SHGetIDListFromPath(FileName, mShellFolder);
  if not Assigned(mPIDL) then
     Exit;

  OLECheck(mShellFolder.GetUIObjectOf(Handle, 1, mPIDL, IID_IContextMenu, nil,
    Pointer(mContextMenu)));

  mPopup := CreatePopUpMenu;
  if mPopup = 0 then
     Exit;
  try
    OLECheck(mContextMenu.QueryContextMenu(Form1.PopupMenu1.Handle {mPopup}, 0 {Index}, 0 {idCmdFirst}, 0 {_$7FFF}{idCmdLast}, CMF_NORMAL));
    OLECheck(mContextMenu.QueryInterface(IID_IContextMenu2, mContextMenu2));

    try
      iCmd := Integer(TrackPopupMenuEx(Form1.PopupMenu1.Handle {mPopup}, TPM_LEFTALIGN or
                TPM_RIGHTBUTTON or TPM_HORIZONTAL or TPM_VERTICAL or TPM_RETURNCMD, X, Y, Handle, nil));

      // Hint anzeigen
      SetLength(S,40);
      mContextMenu.GetCommandString(iCmd,GCS_HELPTEXT,nil,PChar(S),SizeOf(S));
      Form1.StatusBar1.Panels[0].Text := S;

      // "OnClick" Ereignisse ausführen
      if iCmd <> 0 then
         begin
           FillChar(mCmdInfo, SizeOf(mCmdInfo), 0);
           with mCmdInfo do
             begin
               cbSize := SizeOf(TCMInvokeCommandInfo);
               lpVerb := MakeIntResource(iCmd - 1);
               nShow  := SW_SHOWNORMAL;
             end;
           try
             if not Succeeded(mContextMenu.InvokeCommand(mCmdInfo)) then
                begin
                  iCount := 1;
                  ExecMenuItemAction(iCmd,iCount,Form1.PopupMenu1.Items);
                end;
           except
             // nichts tun
           end;
         end;
    finally
      mContextMenu  := nil;
      mContextMenu2 := nil;
    end;
  finally
    DestroyMenu(mPopup);
  end;
end;

Beleiben noch Probleme 2 – 5.

Ich wäre ja schon zufrieden, wenn sich eine Lösung für Problem 4 finden würde.

[franz]

Es funktioniert jetzt soweit.
Nur noch ein kleines Problem: Wenn die Maus über das „Senden an“ Menü geführt wird, klappt dieses mit allen Einträgen auf. Wenn der Benutzer allerdings mit der Tastatur den Menüeintrag ansteuert, enthält es wieder den Eintrag „Senden an“. Der Grund dafür ist, dass in der „WndProc“ folgendes steht:

Delphi-Quellcode:

WM_MENUSELECT:
  begin
    // Prüfen, ob das Owner Draw Shell Popup Menü (mPopupMenu2) gezeichnet werden kann
    iMenuPos := Integer(MenuItemFromPoint(Handle,HMENU Message.LParam),TPoint(Mouse.CursorPos)));
    if GetSubMenu(HMENU(Message.LParam),iMenuPos) > 0 then
       CanDraw := iMenuPos in [(iHandlerIndex)..(iHandlerIndex + iHandlerCount)];
    ValidCmdArea := CanDraw;
    inherited WndProc(Message);
  end;

:gruebel: Meine Frage: Wie kann ich den Index des ausgewählten Menüeintrags ermitteln ohne mit der Maus darüber zufahren?

Hinweis:
Es handelt sich um ein reines API Menü.