Solved

Context Menu Handler Example

Posted on 1998-08-25
7
1,688 Views
Last Modified: 2008-02-01
Could some one supply an example of how to implement a Context menu handler in delphi. That is the DLL that is used to generate dynamic menu items for the right clicking on given file types in explorer
0
Comment
Question by:RoryBecker
[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
  • 5
7 Comments
 

Author Comment

by:RoryBecker
ID: 1337686
Edited text of question
0
 
LVL 4

Expert Comment

by:BoRiS
ID: 1337687
rorybecker

here is a snippet form the delphi contextmenu stuff...

unit ContextM;


interface
uses
    Windows, ComObj, ComServ, ShlObj, ActiveX, ShellApi, SysUtils, Registry;

Const
   CLSID_ContextMenuShellExtension: TGUID = (
    D1:$8e3e0f0a; D2:$0fcc; D3:$11ce; D4:($bc, $b0, $b3, $fd, $0e, $25, $38, $1a));

type
    TContextMenu = class(TComObject, IShellExtInit, IContextMenu)
    private
      szFile: array[0..MAX_PATH] of Char;
    public
      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;
      function Initialize(pidlFolder: PItemIDList; lpdobj: IDataObject;
        hKeyProgID: HKEY): HResult; stdcall;
    end;



implementation

function GetCompilerPath: string;
// Returns string containing path to Delphi command line compiler
var
  Reg: TRegistry;
begin
  Reg := TRegistry.Create;
  try
    with Reg do
    begin
      RootKey := HKEY_LOCAL_MACHINE;
      OpenKey('\SOFTWARE\Borland\Delphi\3.0', False);
      Result := ReadString('RootDir');
    end;
    Result := Result + '\bin\dcc32.exe %s';
  finally
    Reg.Free;
  end;
end;

function TContextMenu.QueryContextMenu(Menu: HMENU; indexMenu, idCmdFirst,
          idCmdLast, uFlags: UINT): HResult;
begin
  // Add one menu item to context menu
  InsertMenu (Menu, indexMenu, MF_STRING or MF_BYPOSITION, idCmdFirst,
    'Compile...');
  // Return number of menu items added
  Result := 1;
end;

function TContextMenu.InvokeCommand(var lpici: TCMInvokeCommandInfo): HResult;
var
  H: THandle;
begin
  // Make sure we are not being called by an application
  if HiWord(Integer(lpici.lpVerb)) <> 0 then
  begin
    Result := E_FAIL;
    Exit;
  end;
  // Make sure we aren't being passed an invalid argument number
  if LoWord(lpici.lpVerb) > 0 then
  begin
    Result := E_INVALIDARG;
    Exit;
  end;
  // Execute the command specified by lpici.lpVerb.
  if LoWord(lpici.lpVerb) = 0 then
  begin
    // invoke Delphi command line compiler
    H := WinExec(PChar(Format(GetCompilerPath, [szFile])), lpici.nShow);
    if H < 32 then
      MessageBox(lpici.hWnd, 'Error executing Delphi compiler.', 'Error',
        MB_ICONERROR or MB_OK);
  end;
  Result := NOERROR;
end;

function TContextMenu.GetCommandString(idCmd, uType: UINT; pwReserved: PUINT;
  pszName: LPSTR; cchMax: UINT): HRESULT;
begin
  if idCmd = 0 then
  begin
    // return help string for menu item
    strCopy(pszName, 'Compile the selected Delphi project');
    Result := NOERROR;
  end
  else
    Result := E_INVALIDARG;
end;

function TContextMenu.Initialize(pidlFolder: PItemIDList; lpdobj: IDataObject;
  hKeyProgID: HKEY): HResult;
var
  medium: TStgMedium;
  fe: TFormatEtc;
begin
  with fe do
  begin
    cfFormat := CF_HDROP;
    ptd := Nil;
    dwAspect := DVASPECT_CONTENT;
    lindex := -1;
    tymed := TYMED_HGLOBAL;
  end;
  // Fail the call if lpdobj is Nil.
  if lpdobj = Nil then
  begin
    Result := E_FAIL;
    Exit;
  end;
  // Render the data referenced by the IDataObject pointer to an HGLOBAL
  // storage medium in CF_HDROP format.
  Result := lpdobj.GetData(fe, medium);
  if Failed(Result) then Exit;
  // If only one file is selected, retrieve the file name and store it in
  // szFile. Otherwise fail the call.
  if DragQueryFile(medium.hGlobal, $FFFFFFFF, Nil, 0) = 1 then
  begin
    DragQueryFile(medium.hGlobal, 0, szFile, SizeOf(szFile));
    Result := NOERROR;
  end
  else
    Result := E_FAIL;
  ReleaseStgMedium(medium);
end;

initialization
    TComObjectFactory.Create(ComServer, TContextMenu, CLSID_ContextMenuShellExtension,
         '', 'Delphi 3.0 ContextMenu Example', ciMultiInstance);

end.

Check out the project it explains everything, if found under....
.\delphi 3\demos\shellext\

Later
BoRiS
0
 

Author Comment

by:RoryBecker
ID: 1337688
The delphi Example only shows how to provide one extra item. I should like to understand how to add more than one and ideally how to add a submenu.


0
Independent Software Vendors: We Want Your Opinion

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

 

Author Comment

by:RoryBecker
ID: 1337689
Not sure if my first comment reached this forum so.....

I am really looking to produce more than one menu item at a time and so need to be able to tell which item was clicked i would guess in the invoke command procedure above

But I would ideally like to learn how to add one or more submenus ala Winzip 6.3


TIA

Rory
0
 

Author Comment

by:RoryBecker
ID: 1337690
See Previous comment
0
 

Author Comment

by:RoryBecker
ID: 1337691
Adjusted points to 80
0
 

Accepted Solution

by:
Jam earned 80 total points
ID: 1337692
Hi.

I created small example of work with IContextMenu.
This implementation in _PURE_ COM (Delphi 2, without Delphi 3 features)

Something is take from Microsoft Win 32 SDK.

Here is it:

//**********************************************************************
// File: shl_menu.dpr
//**********************
library shl_menu;

uses
  Ole2, OleAuto, SysUtils,
  shell_ctx;

{$R *.RES}

function DllGetClassObject(const rclsid: TCLSID; const riid: TGUID;
                           var ppv): hResult; stdcall export;
var
  HR:  HRESULT;
  ShellExtClassFactory: TClassFactory;
begin
  if not IsEqualIID(CLSID_ShellExtension, rclsid) then begin
    Result := E_FAIL;
    Exit;
  end;

  try
    ShellExtClassFactory := TClassFactory.Create;
  except
    Result := E_OUTOFMEMORY;
    Exit;
  end;

  hr := ShellExtClassFactory.QueryInterface(riid, ppv);

  if (FAILED(hr)) then begin
    ShellExtClassFactory.Free;
    Result := hr;
    Exit;
  end;
  Result := hr;
end;

function DllCanUnloadNow: hResult;
begin
  if (LockCount = 0) and (ObjCount = 0) then
    Result := S_Ok
  else
    Result := S_False;
end;

exports
  DllGetClassObject name 'DllGetClassObject',
  DllCanUnloadNow name 'DllCanUnloadNow';

begin
end.

//********************************************
// File: shell_ctx.pas
// 1998 by Michael Jastrebtsoff   M_Jastrebtsoff@yahoo.com
// This code based on Microsoft Win 32 SDK
// Copyright (C) 1993-1995  Microsoft Corporation.  All Rights Reserved.

unit Shell_Ctx;

interface

uses
  Ole2, Windows, SysUtils, ShlObj;

const
  // GUID
  CLSID_ShellExtension: TGUID = (
    D1:$C9B0B160;
    D2:$1308;
    D3:$11cf;
    D4:($AB,$35,$00,$00,$C0,$7E,$BA,$2B)
  );

type
  TObjectDestroyed = procedure;

  // This interface need for a correctly initialization for shell
  // context menu's
  TShellExtInit = class(IShellExtInit)
  private
    FRefCount: LongInt;
    FObjectDestroyed: TObjectDestroyed;
    m_pDataObj: IDataObject;
  public
    constructor Create(ObjectDestroyed: TObjectDestroyed);
    destructor  Destroy;
    // IUnknown
    function QueryInterface(const iid: TIID; var obj): HResult; override;
    function AddRef: Longint; override;
    function Release: Longint; override;
    // IShellExtInit
    function Initialize(pidlFolder: PItemIDList; lpdobj: IDataObject;
                        hKeyProgID: HKEY): HResult; override;
  end;

  // implementation of IContextMenu
  TContextMenu = class(IContextMenu)
  private
    FRefCount: LongInt;
    FObjectDestroyed: TObjectDestroyed;
  public
    // IUnknown
    constructor Create(ObjectDestroyed: TObjectDestroyed);
    function QueryInterface(const iid: TIID; var obj): HResult; override;
    function AddRef: Longint; override;
    function Release: Longint; override;
    // IContextMenu
    function QueryContextMenu(Menu: HMENU;
      indexMenu, idCmdFirst, idCmdLast, uFlags: UINT): HResult; override;
    function InvokeCommand(var lpici: TCMInvokeCommandInfo): HResult; override;
    function GetCommandString(idCmd, uType: UINT; pwReserved: PUINT;
      pszName: LPSTR; cchMax: UINT): HResult; override;
  end;

  // Class factory for DLL-objects
  TClassFactory = class(IClassFactory)
  private
    FRefCount: LongInt;
  public
    constructor Create;
    function QueryInterface(const iid: TIID; var obj): HResult; override;
    function AddRef: Longint; override;
    function Release: Longint; override;
    function CreateInstance(unkOuter: IUnknown; const iid: TIID;
      var obj): HResult; override;
    function LockServer(fLock: BOOL): HResult; override;
  end;

var
  LockCount: Integer;
  ObjCount: Integer;

implementation

{$R m_bmps.res }  // bitmaps for menu items

procedure ObjectDestroyed;
begin
  Dec(ObjCount)
end;

{TShellExtInit}
constructor TShellExtInit.Create(ObjectDestroyed: TObjectDestroyed);
begin
  inherited Create;
  FObjectDestroyed := ObjectDestroyed;
  FRefCount := 0;
  m_pDataObj := nil;
end;

destructor TShellExtInit.Destroy;
begin
  if m_pDataObj <> nil then
     m_pDataObj.Release;
end;

function TShellExtInit.QueryInterface(const iid: TIID; var obj): HResult;
var
  ictx_menu: TContextMenu;
  hr: HResult;
begin
  if IsEqualIID(iid, IID_IUnknown) or
     IsEqualIID(iid, IID_IShellExtInit) then
  begin
    Pointer(obj) := Self;
    AddRef;
    Result := S_OK;
  end
  else if IsEqualIID(iid, IID_IContextMenu) then
  begin
    ictx_menu := TContextMenu.Create(ObjectDestroyed);
    if ictx_menu = nil then
    begin
      Pointer(Obj) := nil;
      Result := E_OutOfMemory;
      Exit;
    end;
    hr := ictx_menu.QueryInterface(iid, Obj);
    if Failed(hr) then
      ictx_menu.Free
    else
      Inc(ObjCount);
    Result := hr;
  end
  else
    Result := E_NOINTERFACE;
end;

function TShellExtInit.Initialize(pidlFolder: PItemIDList; lpdobj: IDataObject;
                                  hKeyProgID: HKEY): HResult;
begin
  if m_pDataObj <> nil then
      m_pDataObj.Release;

  // duplicate the object pointer and registry handle
  if lpdobj <> nil then
  begin
    m_pDataObj := lpdobj;
    lpdobj.AddRef;
  end;

  Result := NOERROR;
end;

function TShellExtInit.AddRef: Longint;
begin
  Inc(FRefCount);
  Result := FRefCount;
end;

function TShellExtInit.Release: Longint;
begin
  Dec(FRefCount);
  if FRefCount = 0 then begin
    FObjectDestroyed;
    Free;
    Result := 0;
  end else
    Result := FRefCount;
end;

{ TContextMenu }
constructor TContextMenu.Create(ObjectDestroyed: TObjectDestroyed);
begin
  inherited Create;
  FObjectDestroyed := ObjectDestroyed;
  FRefCount := 0;
end;

function TContextMenu.QueryInterface(const iid: TIID; var obj): HResult;
var
  hr: HResult;
begin
  if IsEqualIID(iid, IID_IUnknown) or
     IsEqualIID(iid, IID_IContextMenu) then
  begin
    Pointer(obj) := Self;
    AddRef;
    Result := S_OK;
  end
  else
    Result := E_NOINTERFACE;
end;

function TContextMenu.AddRef: Longint;
begin
  Inc(FRefCount);
  Result := FRefCount;
end;

function TContextMenu.Release: Longint;
begin
  Dec(FRefCount);
  if FRefCount = 0 then begin
    FObjectDestroyed;
    Free;
    Result := 0;
  end else
    Result := FRefCount;
end;


function TContextMenu.QueryContextMenu(Menu: HMENU; indexMenu, idCmdFirst,
                                       idCmdLast, uFlags: UINT): HResult;
const
  ITEMS_COUNT = 4; // number of menu items (separators included)
var
  MenuText1, MenuText2, MenuText3, MenuText4: string;
  bAppendItems: boolean;
  MenuBmp: HBITMAP;
begin
  Result := NOERROR;

  bAppendItems := true;

  if ((uFlags and $000F) = CMF_NORMAL)  then  //Check == here, since CMF_NORMAL=0
  begin
      MenuText1 := '&New menuitem 1, Normal File';
      MenuText2 := '&New menuitem 2, Normal File';
      MenuText3 := '&New menuitem 3, Normal File';
      MenuText4 := '&New menuitem 4, Normal File';
  end
  else if (uFlags and CMF_VERBSONLY) <> 0 then
  begin
      MenuText1 := '&New menuitem 1, Shortcut File';
      MenuText2 := '&New menuitem 2, Shortcut File';
      MenuText3 := '&New menuitem 3, Shortcut File';
      MenuText4 := '&New menuitem 4, Shortcut File';
  end
  else if (uFlags and CMF_EXPLORE) <> 0 then
  begin
      MenuText1 := '&New menuitem 1, Normal File right click in Explorer';
      MenuText2 := '&New menuitem 2, Normal File right click in Explorer';
      MenuText3 := '&New menuitem 3, Normal File right click in Explorer';
      MenuText4 := '&New menuitem 4, Normal File right click in Explorer';
  end
  else if (uFlags and CMF_DEFAULTONLY) <> 0 then
  begin
    bAppendItems := false;
  end
  else // unknown flag
  begin
    bAppendItems := false;
  end;

  // If all Okey insert menu items
  if bAppendItems then
  begin
    InsertMenu(Menu,
                indexMenu,
                MF_STRING or MF_BYPOSITION,
                idCmdFirst,
                PChar(MenuText1)
              );
    InsertMenu(Menu,
                indexMenu + 1,
                MF_STRING or MF_BYPOSITION,
                idCmdFirst + 1,
                PChar(MenuText2)
              );

    InsertMenu(Menu,
                indexMenu + 2,
                MF_STRING or MF_BYPOSITION,
                idCmdFirst + 2,
                PChar(MenuText3)
              );
    InsertMenu(Menu, indexMenu + 3, MF_SEPARATOR or MF_BYPOSITION, 0, Pointer(0));

    InsertMenu(Menu,
                indexMenu + 4,
                MF_STRING or MF_BYPOSITION,
                idCmdFirst + 3,
                PChar(MenuText4)
              );
    Result := ITEMS_COUNT; //Must return number of menu
                           //items we added.
   
    // Set image for menu item 1
    MenuBmp := LoadBitmap(hInstance, 'M_BMP1'); // load from *.res
    SetMenuItemBitmaps( Menu,      // menu handle
            indexMenu,            
            MF_BYPOSITION,
            MenuBmp,              // Bitmap handle for uncheked item
            MenuBmp);             // Bitmap handle for checked item

    // Set image for menu item 2
    MenuBmp := LoadBitmap(hInstance, 'M_BMP2');
    SetMenuItemBitmaps( Menu,
            indexMenu+1,
            MF_BYPOSITION,
            MenuBmp,
            MenuBmp);

    // Set image for menu item 3
    MenuBmp := LoadBitmap(hInstance, 'M_BMP3');
    SetMenuItemBitmaps( Menu,
            indexMenu+2,
            MF_BYPOSITION,
            MenuBmp,
            MenuBmp);
  end;
end;

function TContextMenu.InvokeCommand(var lpici: TCMInvokeCommandInfo): HResult;
var
  hr: HResult;
  idCmd: cardinal;
begin
  Result := E_INVALIDARG;

  //If HIWORD(lpcmi->lpVerb) then we have been called programmatically
  //and lpVerb is a command that should be invoked.  Otherwise, the shell
  //has called us, and LOWORD(lpcmi->lpVerb) is the menu ID the user has
  //selected.  Actually, it's (menu ID - idCmdFirst) from QueryContextMenu().
  if  not HiWord(Integer(lpici.lpVerb)) <> 0 then
  begin
    idCmd := LoWord(Integer(lpici.lpVerb));

    Result := NOERROR;
    MessageBox(lpici.hwnd, PChar('Invoke menu item ' + IntToStr(idCmd+1)), 'Shell Extension Sample', MB_OK);

    {** Realistic handling:
     case idCmd of
       0: begin SomethingDo; end;  // Click on menu item 1
       1: begin ....         end;  // Click on menu item 2
       2: begin ....         end;  // ..........
       3: begin ....         end;
     end;
    **}
  end;
end;

function TContextMenu.GetCommandString(idCmd, uType: UINT; pwReserved: PUINT;
      pszName: LPSTR; cchMax: UINT): HResult;
begin
  case idCmd of
    0: StrCopy(pszName, 'New menu item number 1');
    1: StrCopy(pszName, 'New menu item number 2');
    2: StrCopy(pszName, 'New menu item number 3');
    3: StrCopy(pszName, 'New menu item number 4');
  end;
  Result := NOERROR;
end;

{ --- TClassFactory --- }

constructor TClassFactory.Create;
begin
  inherited Create;
  FRefCount := 0;
end;

function TClassFactory.QueryInterface(const iid: TIID; var obj): HResult;
begin
  if IsEqualIID(iid, IID_IClassFactory) or
     IsEqualIID(iid, IID_IUnknown) then begin
    Pointer(obj) := Self;
    AddRef;
    Result := S_OK;
  end else begin
    Pointer(obj) := nil;
    Result := E_NOINTERFACE;
  end;
end;

function TClassFactory.AddRef: Longint;
begin
  Inc(FRefCount);
  Result := FRefCount;
end;

function TClassFactory.Release: Longint;
begin
  Dec(FRefCount);
  if FRefCount = 0 then begin
    Destroy;
    Result := 0;
  end else
    Result := FRefCount;
end;

function TClassFactory.CreateInstance(UnkOuter: IUnknown;
                                        const iid: Tiid;
                                        var Obj): hResult;
var
  hr: HResult;
  ShellExt: TShellExtInit;
  ShellMenu: TContextMenu;
begin
  if UnkOuter <> nil then begin
    Result := E_Fail;
    Exit;
  end;
  if (not isEqualIID(iid, IID_IUnknown)) and
     (not isEqualIID(iid, IID_IShellExtInit)) then begin
    Result := E_Fail;
    Exit;
  end;

  ShellExt := TShellExtInit.Create(ObjectDestroyed);

  if ShellExt = nil then
  begin
    Pointer(Obj) := nil;
    Result := E_OutOfMemory;
    Exit;
  end;

  hr := ShellExt.QueryInterface(iid, Obj);
  if Failed(hr) then
    ShellExt.Free
  else
    Inc(ObjCount);

  Result := hr;
end;

function TClassFactory.LockServer(fLock: BOOL): HResult;
begin
  if fLock then
    Inc(LockCount)
  else
    Dec(LockCount);
  Result := S_Ok;
end;


initialization
  LockCount := 0;
  ObjCount := 0;
end.

;********************
; File: shl_ctx.reg

REGEDIT4

[HKEY_CLASSES_ROOT\CLSID\{C9B0B160-1308-11cf-AB35-0000c07eba2b}]
   @="Shell context menu's sample"
[HKEY_CLASSES_ROOT\CLSID\{C9B0B160-1308-11cf-AB35-0000c07eba2b}\InProcServer32]
   @="E:\\PROJECTS\\SHELL\\SHELL_CTX\\shl_menu.dll"
     "ThreadingModel"="Apartment"

[HKEY_CLASSES_ROOT\directory\shellex\ContextMenuHandlers\ShellCtxSample]
   @="{C9B0B160-1308-11cf-AB35-0000c07eba2b}"

[HKEY_CLASSES_ROOT\*\shellex\ContextMenuHandlers\ShellCtxSample]
   @="{C9B0B160-1308-11cf-AB35-0000c07eba2b}"

[HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows\CurrentVersion\Shell Extensions\Approved]
   "{C9B0B160-1308-11cf-AB35-0000c07eba2b}"="Shell context menu's sample"

// File: m_bmps.rc (anything bitmaps here)
M_BMP1 BITMAP "M1.BMP"
M_BMP2 BITMAP "M2.BMP"
M_BMP3 BITMAP "M3.BMP"

--------------------------------------END------------------------------------
0

Featured Post

[Webinar] How Hackers Steal Your Credentials

Do You Know How Hackers Steal Your Credentials? Join us and Skyport Systems to learn how hackers steal your credentials and why Active Directory must be secure to stop them. Thursday, July 13, 2017 10:00 A.M. PDT

Question has a verified solution.

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

A lot of questions regard threads in Delphi.   One of the more specific questions is how to show progress of the thread.   Updating a progressbar from inside a thread is a mistake. A solution to this would be to send a synchronized message to the…
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…
There's a multitude of different network monitoring solutions out there, and you're probably wondering what makes NetCrunch so special. It's completely agentless, but does let you create an agent, if you desire. It offers powerful scalability …
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…
Suggested Courses
Course of the Month4 days, 13 hours left to enroll

636 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