Solved

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

Posted on 2003-10-28
5
1,018 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
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
  • 2
5 Comments
 
LVL 34

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 34

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

On Demand Webinar - Networking for the Cloud Era

This webinar discusses:
-Common barriers companies experience when moving to the cloud
-How SD-WAN changes the way we look at networks
-Best practices customers should employ moving forward with cloud migration
-What happens behind the scenes of SteelConnect’s one-click button

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Objective: - This article will help user in how to convert their numeric value become words. How to use 1. You can copy this code in your Unit as function 2. than you can perform your function by type this code The Code   (CODE) The Im…
Creating an auto free TStringList The TStringList is a basic and frequently used object in Delphi. On many occasions, you may want to create a temporary list, process some items in the list and be done with the list. In such cases, you have to…
This video Micro Tutorial shows how to password-protect PDF files with free software. Many software products can do this, such as Adobe Acrobat (but not Adobe Reader), Nuance PaperPort, and Nuance Power PDF, but they are not free products. This vide…
In this video we outline the Physical Segments view of NetCrunch network monitor. By following this brief how-to video, you will be able to learn how NetCrunch visualizes your network, how granular is the information collected, as well as where to f…

691 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