Solved

Context Menu Handler Example

Posted on 1998-08-25
7
1,671 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
  • 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
What Should I Do With This Threat Intelligence?

Are you wondering if you actually need threat intelligence? The answer is yes. We explain the basics for creating useful threat intelligence.

 

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

How to run any project with ease

Manage projects of all sizes how you want. Great for personal to-do lists, project milestones, team priorities and launch plans.
- Combine task lists, docs, spreadsheets, and chat in one
- View and edit from mobile/offline
- Cut down on emails

Join & Write a Comment

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…
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…
Internet Business Fax to Email Made Easy - With eFax Corporate (http://www.enterprise.efax.com), you'll receive a dedicated online fax number, which is used the same way as a typical analog fax number. You'll receive secure faxes in your email, fr…
This demo shows you how to set up the containerized NetScaler CPX with NetScaler Management and Analytics System in a non-routable Mesos/Marathon environment for use with Micro-Services applications.

706 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

22 Experts available now in Live!

Get 1:1 Help Now