Solved

[Q] QueryContextMenu and Context Menu Handlers....

Posted on 2003-10-28
5
983 Views
Last Modified: 2010-04-16
G'Day,

I am attempting to add a shell extension to explorer that adds a single menu item to explorer's context menu and then a sub menu off that of my own. I include my code below. However I need the following solved for the points:

1. Is QueryContextMenu() correct and in particular have I retrurned the correct result to the function and stored the right offset.
2. What should the case statement in GetCommandString look like to return the correct string for the status bar
3. What should the case statement in InvokeCommand look like?

TIA

<Code>

unit uContextMenu;

interface

uses
  ActiveX,
  Classes,
  ComObj,
  ShlObj,
  Windows;

type
  TFileAssistant = class(TComObject, IShellExtInit, IContextMenu)
  private
    FFilesSelected: TStringList;
    FMenuOffSetID: UINT;
  protected
    //-- IShellExtInit ---------------------------------------------------------
    function IShellExtInit.Initialize = SEIInitialize; // Avoid compiler warning
    function SEIInitialize(ApidlFolder: PItemIDList; Alpdobj: IDataObject;
      AhKeyProgID: HKEY): HResult; stdcall;
    //-- IShellExtInit ---------------------------------------------------------
    //-- IContextMenu ----------------------------------------------------------
    function QueryContextMenu(AMenu: HMENU; AindexMenu, AidCmdFirst, AidCmdLast,
      AuFlags: UINT): HResult; stdcall;
    function InvokeCommand(var Alpici: TCMInvokeCommandInfo): HResult; stdcall;
    function GetCommandString(AidCmd, AuType: UINT; ApwReserved: PUINT;
      ApszName: LPSTR; AcchMax: UINT): HResult; stdcall;
    //-- IContextMenu ----------------------------------------------------------
  public
    destructor Destroy; override;
  end;

implementation

uses
  ComServ,
  Dialogs,
  nluOSWindows,
  Registry,
  SysUtils,
  ShellAPI;

type
  TContextMenuFactory = class(TComObjectFactory)
    //////////////////////////////////////////////////////////////////////////////
    // Class that handles registration and deregistration of the context menu
    // within the shell
  public
    procedure UpdateRegistry(ARegister: Boolean); override;
  end;

const
  CLASS_FILEASSISTANT: TGUID = '{936AB18A-7F2B-4513-98C1-7FDB106C8C52}';

  //Identifiers for the various commands
  ID_TOP            = 0;
  ID_FILE_RENAME    = 1;
  ID_FILE_SELECT    = 2;

  { TFileAssistant }

function TFileAssistant.SEIInitialize(ApidlFolder: PItemIDList; Alpdobj: IDataObject;
  AhKeyProgID: HKEY): HResult;
var
  feFormatEtc       : TFormatEtc; //Generalised clipboard format
  iCount, iFileCount: integer;
  pcTmp             : array[0..MAX_PATH] of Char;
  smStageMedium     : TStgMedium; //Generalised memory handle for data transfer
const
  GET_FILECOUNT     = $FFFFFFFF;
begin
  // Fail the call if Alpdobj is Nil.
  if (Alpdobj = nil) then
  begin
    Result := E_INVALIDARG;
    Exit;
  end;

  with feFormatEtc do
  begin
    cfFormat := CF_HDROP;     //Clipboard format for transferring location group files
    ptd := nil;
    dwAspect := DVASPECT_CONTENT;
    lindex := -1;             //Specifies ALL data
    tymed := TYMED_HGLOBAL;   //Use a global memory handle
  end;

  // Render the data referenced by the IDataObject pointer to an HGLOBAL
  // storage medium in CF_HDROP format.
  result := Alpdobj.GetData(feFormatEtc, smStageMedium);
  if Failed(result) then
    Exit;

  try
    //Create our internal list should we not have one
    if not Assigned(FFilesSelected) then
      FFilesSelected := TStringList.Create;

    //Always clear our internal list
    FFilesSelected.Clear;

    //Retrieve the files
    iFileCount := DragQueryFile(smStageMedium.hGlobal, GET_FILECOUNT, nil, 0);

    if iFileCount > 0 then
    begin
      for iCount := 0 to Pred(iFileCount) do
      begin
        //Clear our the temp storage
        pcTmp[0] := #0;
        DragQueryFile(smStageMedium.hGlobal, iCount, pcTmp, SizeOf(pcTmp));
        FFilesSelected.Add(pcTmp);
      end;
    end;

    //We always return success
    result := NOERROR;
  finally
    ReleaseStgMedium(smStageMedium);
  end;
end;

function TFileAssistant.GetCommandString(AidCmd, AuType: UINT; ApwReserved: PUINT;
  ApszName: LPSTR; AcchMax: UINT): HResult;
begin
  //Return success
  result := S_OK;

  //Ensure we are doing help context
  if (AuType AND GCS_HELPTEXT) <> 0 then
  begin
  //ShowMessage(IntToStr(AidCmd));

    // return help string for menu item
    case (AidCmd - FMenuOffSetID) of
      ID_TOP:
        begin
          StrCopy(ApszName, 'File assistant');
          result := NOERROR;
        end;
      ID_FILE_RENAME:
        begin
          StrCopy(ApszName, 'Renamed the selected files');
          result := NOERROR;
        end;
      ID_FILE_SELECT:
        begin
          StrCopy(ApszName, 'Select some files');
          result := NOERROR;
        end;
    else
      result := E_INVALIDARG;
    end;
  end;
end;

function TFileAssistant.InvokeCommand(var Alpici: TCMInvokeCommandInfo): HResult;
begin
  ShowMessage(Alpici.lpVerb);

  result := E_FAIL;
  // Make sure we are not being called by an application
  if (HiWord(Integer(Alpici.lpVerb)) <> 0) then
    Exit;

  // Make sure we aren't being passed an invalid argument number
  if (LoWord(Alpici.lpVerb) < ID_FILE_RENAME) then
  begin
    Result := E_INVALIDARG;
    Exit;
  end;

  //Now finally do the command and pass it the list of files
  //selected
  //FFilesSelected
end;

function TFileAssistant.QueryContextMenu(AMenu: HMENU; AindexMenu,
  AidCmdFirst, AidCmdLast, AuFlags: UINT): HResult;
var
  miInfo            : TMenuItemInfo;
  popMenu           : HMenu;
const
  MENU_TOP_NAME     = 'File Assistant';
  MENU_SUB_REMAME   = 'Rename...';
  MENU_SUB_SELECT   = 'Select...';
begin
  //Show we have not added anything at this point
  result := 0;

  if ((AuFlags and $0000000F) = CMF_NORMAL) or
    ((AuFlags and CMF_EXPLORE) <> 0) then
  begin
    //Ensure we save the offset
    FMenuOffSetID := AidCmdFirst;

    //First off we need to create the popup menu for the submenu
    popMenu := CreatePopupMenu;
    FillChar(miInfo, SizeOf(miInfo), 0);
    with miInfo do
    begin
      cbSize := SizeOf(MenuItemInfo);
      fMask := MIIM_TYPE or MIIM_ID;
      fType := MFT_STRING;
      wID := FMenuOffSetID + ID_TOP;
      dwTypeData := PChar(MENU_TOP_NAME);
      cch := Length(MENU_TOP_NAME);
    end;
    SetMenuItemInfo(popMenu, 0, TRUE, miInfo);

    //Add items into the popup menu
    //-- Rename ----------------------------------------------------------------
    FillChar(miInfo, SizeOf(miInfo), 0);
    with miInfo do
    begin
      cbSize := SizeOf(MenuItemInfo);
      fMask := MIIM_TYPE or MIIM_ID;
      fType := MFT_STRING;
      wID := FMenuOffSetID + ID_FILE_RENAME;
      dwTypeData := PChar(MENU_SUB_REMAME);
      cch := Length(MENU_SUB_REMAME);
    end;
    InsertMenuItem(popMenu, 0, TRUE, miInfo);
    //-- /Rename ---------------------------------------------------------------
    //-- Select ----------------------------------------------------------------
    FillChar(miInfo, SizeOf(miInfo), 0);
    with miInfo do
    begin
      cbSize := SizeOf(MenuItemInfo);
      fMask := MIIM_TYPE or MIIM_ID;
      fType := MFT_STRING;
      wID := FMenuOffSetID + ID_FILE_SELECT;
      dwTypeData := PChar(MENU_SUB_SELECT);
      cch := Length(MENU_SUB_SELECT);
    end;
    InsertMenuItem(popMenu, 0, TRUE, miInfo);
    //-- /Select ---------------------------------------------------------------


    //Add top level item
    //if InsertMenu(AMenu, AindexMenu, MF_STRING or MF_BYPOSITION, AidCmdFirst, MENU_TOP_NAME) then
    if InsertMenu(AMenu, AindexMenu, MF_STRING or MF_BYPOSITION or MF_POPUP, popMenu, MENU_TOP_NAME) then
       result := FMenuOffSetID + 3;
    ShowMessage('MO: ' + IntToStr(FMenuOffSetID));
  end;
end;

destructor TFileAssistant.Destroy;
begin
  //Free resources created
  FreeAndNil(FFilesSelected);

  inherited;
end;

{ TContextMenuFactory }

procedure TContextMenuFactory.UpdateRegistry(ARegister: Boolean);
var
  sClassID          : string;
  regClassesRoot    : TRegistry;
const
  COMPANY_NAME      = 'UpsideDownCoding';
  SOFTWARE_NAME     = 'FileAssistant';
begin

  //Init for ALL_ACCESS
  regClassesRoot := TRegistry.Create;
  try
    if ARegister then
    begin
      inherited UpdateRegistry(ARegister);

      sClassID := GUIDToString(CLASS_FILEASSISTANT);

      regClassesRoot.RootKey := HKEY_CLASSES_ROOT;
      //Associate with all files
      regClassesRoot.OpenKey('\*\shellex\ContextMenuHandlers\' + SOFTWARE_NAME, TRUE);
      regClassesRoot.WriteString('', sClassID);

      //Associate with all directories
      regClassesRoot.OpenKey('\Directory\shellex\ContextMenuHandlers\' + SOFTWARE_NAME, TRUE);
      regClassesRoot.WriteString('', sClassID);

      //Associate with all folders
      regClassesRoot.OpenKey('\Folder\shellex\ContextMenuHandlers\' + SOFTWARE_NAME, TRUE);
      regClassesRoot.WriteString('', sClassID);

      //Associate with all drives
      regClassesRoot.OpenKey('\Drive\shellex\ContextMenuHandlers\' + SOFTWARE_NAME, TRUE);
      regClassesRoot.WriteString('', sClassID);

      //COM Registration
      CreateRegKey(COMPANY_NAME + '\shellex', '', '');
      CreateRegKey(COMPANY_NAME + '\shellex\ContextMenuHandlers', '', '');
      CreateRegKey(COMPANY_NAME + '\shellex\ContextMenuHandlers\ContMenu', '', sClassID);

      //Registry specific stuff for NT
      if (Win32Platform = VER_PLATFORM_WIN32_NT) then
      begin
        with TRegistry.Create do
        begin
          try
            RootKey := HKEY_LOCAL_MACHINE;
            OpenKey('SOFTWARE\Microsoft\Windows\CurrentVersion\Shell Extensions', True);
            OpenKey('Approved', True);
            WriteString(sClassID, 'File Assistant Context Menu');
          finally
            Free;
          end;
        end;
      end;
    end
    else
    begin
      DeleteRegKey(COMPANY_NAME + '\shellex\ContextMenuHandlers\ContMenu');
      DeleteRegKey(COMPANY_NAME + '\shellex\ContextMenuHandlers');
      DeleteRegKey(COMPANY_NAME + '\shellex');

      //Remove all the shell associations
      regClassesRoot.DeleteKey('\*\shellex\ContextMenuHandlers\' + SOFTWARE_NAME);
      regClassesRoot.DeleteKey('\Directory\shellex\ContextMenuHandlers\' + SOFTWARE_NAME);
      regClassesRoot.DeleteKey('\Folder\shellex\ContextMenuHandlers\' + SOFTWARE_NAME);
      regClassesRoot.DeleteKey('\Drive\shellex\ContextMenuHandlers\' + SOFTWARE_NAME);

      inherited UpdateRegistry(ARegister);
    end;
  finally
    regClassesRoot.CloseKey;
    FreeAndNil(regClassesRoot);
  end;
end;

initialization
  TContextMenuFactory.Create(ComServer, TFileAssistant, CLASS_FILEASSISTANT,
    '', 'File Assistant Context Menu', ciMultiInstance, tmApartment);
end.

</Code>
0
Comment
Question by:the_edge
  • 2
5 Comments
 
LVL 33

Accepted Solution

by:
Slick812 earned 150 total points
ID: 9638295
hello the_edge, this is quite a complex problem for 150 points. . . I have not compleatly gone over your code, but I can see several places where you are may not be using to correct methods. . . You might look at the code in this next unit and see if you can get any ideas to help you - - - - - -



unit ConMenu;

interface

uses
  Windows, SysUtils, Classes, Graphics, ExtCtrls,
 ActiveX, ComObj, ShlObj, ShellApi;

type
  TContextMenu = class(TComObject, IShellExtInit, IContextMenu)
  private
       FileName: array[0..MAX_PATH] of Char;
       FBuf : array[ 0..1024] of Char;
       Match1: Boolean;
       //PFileName2: Pointer;
       MIndex1, MIndex2, MIndex3, Mindex4, MID1, MID2, MID3, MID4: Cardinal;
       //PopupMenu_ : HMenu;
   protected
       function IShellExtInit.Initialize = SEIInitialize;
       function SEIInitialize(pidlFolder: PItemIDList; lpdobj: IDataObject;
              hKeyProgID: HKEY): HResult; stdcall;
       function QueryContextMenu(Menu: HMENU; indexMenu, idCmdFirst, idCmdLast,
              uFlags: UINT): HResult; stdcall;
       function InvokeCommand(var lpici: TCMInvokeCommandInfo): HResult; stdcall;
       function GetCommandString(idCmd, uType: UINT; pwReserved: PUINT;
              pszName: LPSTR; cchMax: UINT): HResult; stdcall;
   public
       //destructor Destroy; override;
end;

const
  Class_ContextMenu: TGUID = '{A2C45DE1-AEB5-11D6-B120-C3192AD13D41}';

var
  Buffer: array[1..1024] of char;

implementation

uses ComServ, Registry;

function TContextMenu.SEIInitialize(pidlFolder: PItemIDList; lpdobj: IDataObject;
  hKeyProgID: HKEY): HResult;
var StgMedium: TStgMedium;
   FormatEtc: TFormatEtc;
   TempKey: HKEY;
begin
FBuf[0] := #0;
SHGetPathFromIDList(pidlFolder, @FBuf[0]);
Match1 := False;
if RegOpenKeyEx(HKEY_CLASSES_ROOT, '.lnk', 0,
      KEY_READ, TempKey) = ERROR_SUCCESS then
  begin
  If TempKey = hKeyProgID then
  Match1 := True;
  RegCloseKey(TempKey);
  end;

   if lpdobj = nil then
       begin
       Result := E_FAIL;
       Exit;
       end;
   with FormatEtc do
       begin
       cfFormat := CF_HDROP;
       ptd      := nil;
       dwAspect := DVASPECT_CONTENT;
       lindex   := -1;
       tymed    := TYMED_HGLOBAL;
       end;

   Result := lpdobj.GetData(FormatEtc, StgMedium);
   if Failed(Result) then Exit;
   if (DragQueryFile(StgMedium.hGlobal, $FFFFFFFF, nil, 0) = 1) then
     begin
     DragQueryFile(StgMedium.hGlobal, 0, FileName, SizeOf(FileName));
     //PFileName2 := StgMedium.lpszFileName;
     Result := NOERROR;        
     end else
     begin
       FileName[0] := #0;
       Result := E_FAIL;
     end;
   ReleaseStgMedium(StgMedium);
end;

function TContextMenu.QueryContextMenu(Menu: HMENU; indexMenu, idCmdFirst,
  idCmdLast, uFlags: UINT): HResult;
var
CID, hSubMenu: Cardinal;
MenuInfo: TMenuItemInfo;
begin
   Result:= 0;
MIndex1 := indexMenu;
   CID := idCmdFirst;
   if ((uFlags and $0000000F) = CMF_NORMAL) or ((uFlags and CMF_VERBSONLY) <> 0) or ((uFlags and CMF_EXPLORE) <> 0) then
     begin
       //idCmd_:= idCmdFirst;
      // try
         //PopupMenu_ := CreatePopupMenu;
           //InsertMenu(Menu, indexMenu, MF_STRING or MF_BYPOSITION or MF_POPUP, PopupMenu_, PChar('I am so sad ...'));
           MenuInfo.cbSize := SizeOf(MenuInfo);
hSubMenu := CreateMenu;
Inc(CID);
MIndex2 := MIndex1+1;
MID2 := CID;
InsertMenu(hSubMenu,MIndex2,MF_BYPOSITION or MF_STRING,CID,'First menu item');
Inc(CID);
MIndex3 := MIndex2+1;
MID3 := CID;
InsertMenu(hSubMenu,MIndex3,MF_BYPOSITION or MF_STRING,CID,'Second menu Item');
Inc(CID);
MIndex4 := MIndex3+1;
MID4 := CID;
InsertMenu(hSubMenu,MIndex4,MF_BYPOSITION or MF_STRING,CID,'Third Memu Itrm');

MenuInfo.fMask := MIIM_ID or MIIM_SUBMENU or MIIM_TYPE;
MenuInfo.fType := MFT_STRING;
MenuInfo.fState := 0;
MenuInfo.dwTypeData := 'Rain Stuff';
MenuInfo.cch := 12;
MenuInfo.hSubMenu := hSubMenu;
MenuInfo.wID := idCmdFirst;
    MID1 := idCmdFirst;
MenuInfo.hbmpChecked := 0;
MenuInfo.hbmpUnchecked := 0;
           InsertMenuItem(Menu,MIndex1,True,MenuInfo);
           //InsertMenu(Menu, MIndex, MF_STRING or MF_BYPOSITION, idCmdFirst, 'Record File date');
           //Inc(idCmd_);
       //finally
           Result := 4{idCmd_ - idCmdFirst};
       //end;
     end;
end;

function TContextMenu.InvokeCommand(var lpici: TCMInvokeCommandInfo): HResult;
var //idCmd_ : cardinal;
MenuI: Integer;
begin
  Result := S_OK;
MenuI := Integer(lpici.lpVerb);
   Result := E_INVALIDARG;
   if (HiWord(MenuI) <> 0) then
   begin
       //idCmd_ := LoWord(Integer(lpici.lpVerb));
       Result := E_FAIL;
       Exit;
     // case idCmd of ...
   end;
if LOWORD(MenuI) = MIndex2 then
  begin
  Result := S_OK;
  MessageBox(lpici.hwnd,FileName{'this is the Context Menu Message Box'},'Message Box', MB_OK or MB_ICONINFORMATION);
  end else
  if LOWORD(MenuI) = MIndex3 then
  begin
  Result := S_OK;
  MessageBox(lpici.hwnd,FBuf{'this is the Context Menu Message Box'},'Message Box', MB_OK or MB_ICONINFORMATION);
  end else
  if LOWORD(MenuI) = MIndex4 then
  begin
  Result := S_OK;
  if Match1 then
  MessageBox(lpici.hwnd,'Match1 is True','Message Box', MB_OK or MB_ICONINFORMATION)
  else
  MessageBox(lpici.hwnd,'Match1 is False','Message Box', MB_OK or MB_ICONINFORMATION);
  end else
  begin
  Result := E_INVALIDARG;
  End;
end;

function TContextMenu.GetCommandString(idCmd, uType: UINT; pwReserved: PUINT;
        pszName: LPSTR; cchMax: UINT): HRESULT;
begin
Result := S_OK;
if ((uType and GCS_HELPTEXT) <> 0) then
  begin
  if (idCmd = MIndex2) then
  lstrcpyn(pszName, 'First do of Selected Items', cchMax)
   else
   if (idCmd = MIndex3) then
    lstrcpyn(pszName, 'Second do of Selected Items', cchMax)
   else
   if (idCmd = MIndex4) then
  lstrcpyn(pszName, 'Third do of Selected Items', cchMax)
   else
   Result := E_INVALIDARG;
   end else Result := E_INVALIDARG;
  { if (uType = GCS_HELPTEXT) then begin
       // case idCmd of ...
       Result := NOERROR;
   end
   else Result := E_INVALIDARG;}
end;

type
  TContextMenuFactory = class(TComObjectFactory)
  public
  procedure UpdateRegistry(Register: Boolean); override;
end;

procedure TContextMenuFactory.UpdateRegistry(Register: Boolean);
var ClassID: string;
begin
   if Register then
     try
       inherited UpdateRegistry(Register);

       ClassID := GUIDToString(Class_ContextMenu);
       CreateRegKey('*\shellex', '', '');
       CreateRegKey('*\shellex\ContextMenuHandlers', '', '');
       CreateRegKey('*\shellex\ContextMenuHandlers\Rain', '', ClassID);

       if (Win32Platform = VER_PLATFORM_WIN32_NT) then
       with TRegistry.Create do
         try
           RootKey := HKEY_LOCAL_MACHINE;
           OpenKey('SOFTWARE\Microsoft\Windows\CurrentVersion\Shell Extensions', False);
           OpenKey('Approved', True);
           WriteString(ClassID, 'Rain');
         finally
           Free;
         end;
     except
     end
     else
     try
       DeleteRegKey('*\shellex\ContextMenuHandlers\Rain');
       inherited UpdateRegistry(Register);
     except
     end;
end;

initialization
  TContextMenuFactory.Create(ComServer, TContextMenu, Class_ContextMenu,
    'ContextMenu', '', ciMultiInstance, tmApartment);
end.

- - - - - - - - - - - - - - - - - - - - - - - - - - -  - - - - - - -

ask questions if you need more info
0
 

Author Comment

by:the_edge
ID: 9639797
Slick82,

Thanks that gives me something to look at. A quick copy and paste and at least it brings up the 3 sub menu items and the InvokeCmd seems to work as expected. However what I did notice is that if I put the mouse pointer over "First Menu Item" then the text that is displayed in the status bar for explorer is just a set of boxes which seems to indicate an issue with the help text either being gibberish or UNICODE or something.

This is under Windows XP Pro with all patches applied.

I will continue looking at your code, but if you could shed some light on this I would be much obliged.
0
 
LVL 33

Expert Comment

by:Slick812
ID: 9644116
???
in both your's and my code the

ApszName: LPSTR;

is the same a LPSTR or pascal PChar, not a LPWSTR, which would be a wide charater deal
although , I will not have the time to test this for a day or two, but you might try the wide PWChar type, but I think it will need a lstrcpyW( ) function to copy the text string, you could try it for a short string, I forget how many char the cchMax was, , and see if it will help
I am guessing you used code similar to
lstrcpyn(pszName, 'First do of Selected Items', cchMax)

you might also try something like
pszName[0] := 'A';
pszName[1] := 'n';
pszName[2] := #0;
0

Featured Post

Better Security Awareness With Threat Intelligence

See how one of the leading financial services organizations uses Recorded Future as part of a holistic threat intelligence program to promote security awareness and proactively and efficiently identify threats.

Join & Write a Comment

The uses clause is one of those things that just tends to grow and grow. Most of the time this is in the main form, as it's from this form that all others are called. If you have a big application (including many forms), the uses clause in the in…
Introduction Raise your hands if you were as upset with FireMonkey as I was when I discovered that there was no TListview.  I use TListView in almost all of my applications I've written, and I was not going to compromise by resorting to TStringGrid…
In this tutorial you'll learn about bandwidth monitoring with flows and packet sniffing with our network monitoring solution PRTG Network Monitor (https://www.paessler.com/prtg). If you're interested in additional methods for monitoring bandwidt…
When you create an app prototype with Adobe XD, you can insert system screens -- sharing or Control Center, for example -- with just a few clicks. This video shows you how. You can take the full course on Experts Exchange at http://bit.ly/XDcourse.

743 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

16 Experts available now in Live!

Get 1:1 Help Now