Solved

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

Posted on 2003-10-28
5
988 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

Is Your Active Directory as Secure as You Think?

More than 75% of all records are compromised because of the loss or theft of a privileged credential. Experts have been exploring Active Directory infrastructure to identify key threats and establish best practices for keeping data safe. Attend this month’s webinar to learn more.

Question has a verified solution.

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

Suggested Solutions

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…
Have you ever had your Delphi form/application just hanging while waiting for data to load? This is the article to read if you want to learn some things about adding threads for data loading in the background. First, I'll setup a general applica…
This Micro Tutorial will give you a basic overview how to record your screen with Microsoft Expression Encoder. This program is still free and open for the public to download. This will be demonstrated using Microsoft Expression Encoder 4.
Windows 10 is mostly good. However the one thing that annoys me is how many clicks you have to do to dial a VPN connection. You have to go to settings from the start menu, (2 clicks), Network and Internet (1 click), Click VPN (another click) then fi…

911 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

17 Experts available now in Live!

Get 1:1 Help Now