Extension du shell - Menu contextuel

Date de publication : 24/02/2005

Par Pierre Castelain (Contributions)
 

Tutoriel sur l'ajout d'éléments dans le menu contextuel du shell de Windows en utilisant la technique des extensions du shell

I. Introduction

II. Principe

• Initialize : qui permet d'obtenir le nom des fichiers sélectionnés (entre autres),
• QueryContextMenu : qui permet à notre objet d'ajouter ces items de menu dans le menu contextuel,
• GetCommandString : appelée pour obtenir une chaîne de description de notre extension,
• InvokeCommand : quand l'utilisateur clique sur un de nos items.

III. Mise en oeuvre

unit ShellExtTesterImpl; 

interface 

uses 
  Windows, ActiveX, Classes, ComObj, ShellExtTest_TLB, StdVcl, 
  ShlObj; 

type 
  TShellExtTester = class(TTypedComObject, IShellExtTester, IShellExtInit, 
    IContextMenu) 
  private 
    FFilenames: array of PChar; // Tableau qui va contenir le nom des fichiers 
  protected 
    {Déclarez les méthodes IShellExtTester ici} 

    { Méthode de l'interface IShellExtInit } 
    { La méthode Initialize existe déja dans notre objet COM, il nous faut 
      donc changer le nom de la méthode Initialize de IShellExtInit } 
    function IShellExtInit.Initialize = ShellInit; 
    function ShellInit(pidlFolder: PItemIDList; lpdobj: IDataObject; 
      hKeyProgID: HKEY): HResult; stdcall; 

    { Méthode de l'interface IContextMenu } 
    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; 

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


implementation 

uses 
  ComServ, ShellAPI, SysUtils, Registry, Dialogs; 

{ TShellExtTester } 

destructor TShellExtTester.Destroy; 
{ Destruction de notre objet } 
var 
  i: integer; 
begin 
  for i:=0 to Length(FFilenames) - 1 do 
    StrDispose(FFilenames[i]); 
  inherited; 
end; 

function TShellExtTester.GetCommandString(idCmd, uType: UINT; pwReserved: PUINT; 
  pszName: LPSTR; cchMax: UINT): HResult; 
{ Récupération de la chaîne d'aide (affichée dans les statusbar)} 
begin 
  if uType = GCS_HELPTEXT then 
  begin 
    StrLCopy(pszName, 'Un test d''extension du shell', cchMax); 
    result:= NOERROR; 
  end 
  else 
    result:= E_INVALIDARG; 
end; 

function TShellExtTester.InvokeCommand( 
  var lpici: TCMInvokeCommandInfo): HResult; 
{ Méthode appelée si l'utilisateur a cliqué sur notre item de menu } 
var 
  i: integer; 
  s: string; 
begin 
  { Vérifier que l'on n'est pas appelé par une application } 
  if (HiWord(Integer(lpici.lpVerb)) <> 0) then 
  begin 
    result := E_FAIL; 
    Exit; 
  end; 

  if Length(FFileNames) > 0 then 
  begin 
    s:= ''; 
    for i:=0 to Length(FFilenames)-1 do 
      s:= s + FFilenames[i] + #13#10; 
    MessageDlg(s, mtInformation, [mbOK], 0); 
  end; 
  result := NOERROR; 
end; 

function TShellExtTester.QueryContextMenu(Menu: HMENU; indexMenu, idCmdFirst, 
  idCmdLast, uFlags: UINT): HResult; 
{ Méthode appelée par le shell pour ajouter notre item de menu } 
begin 
  if (uFlags and CMF_DEFAULTONLY)=0 then 
  begin 
    InsertMenu(Menu, IndexMenu, MF_STRING or MF_BYPOSITION, idCmdFirst, 
      'Tester l''extension du shell'); 
    result:= 1; 
  end 
  else 
    result:= NOERROR; 
end; 

function TShellExtTester.ShellInit(pidlFolder: PItemIDList; lpdobj: IDataObject; 
  hKeyProgID: HKEY): HResult; 
{ C'est la première méthode appelée par le Shell après la création de l'instance 
  de notre classe. } 
var 
  StgMedium: TStgMedium; 
  FormatEtc: TFormatEtc; 
  filesnum, i: integer; 
  filename: PChar; 
  nameLength: UInt; 
begin 
  { Si lpdobj est nil, retourner un code d'erreur } 
  if lpdobj = nil then 
  begin 
    Result := E_INVALIDARG; 
    Exit; 
  end; 

  { On prépare la structure } 
  with FormatEtc do 
  begin 
    cfFormat := CF_HDROP; 
    ptd      := nil; 
    dwAspect := DVASPECT_CONTENT; 
    lindex   := -1; 
    tymed    := TYMED_HGLOBAL; 
  end; 

  { Récupération des données contenues dans lpdobj } 
  Result := lpdobj.GetData(FormatEtc, StgMedium); 
  if Failed(Result) then 
    Exit; 

  try 
    { Si on a au moins un fichier, stocker les noms dans le tableau } 
    filesnum:= DragQueryFile(StgMedium.hGlobal, $FFFFFFFF, nil, 0); 
    if filesnum > 0 then 
    begin 
      SetLength(FFileNames, filesnum); 
      for i:= 0 to filesnum-1 do 
      begin 
        { On fait un premier tour pour avoir la longueur du nom } 
        nameLength:= DragQueryFile(StgMedium.hGlobal, i, nil, 0) + 1; 
        filename:= StrAlloc(nameLength); 
        DragQueryFile(StgMedium.hGlobal, i, filename, nameLength); 
        FFilenames[i]:= filename; 
        Result := NOERROR; 
      end; 
    end 
    else 
    begin 
      SetLength(FFileNames, 0); 
      Result := E_FAIL; 
    end; 
  finally 
    ReleaseStgMedium(StgMedium); 
  end; 
end; 

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

    ClassID := GUIDToString(Class_ShellExtTester); 

    with TRegistry.Create do 
    try 
      RootKey:= HKEY_CLASSES_ROOT; 
      if OpenKey('.txt', false) then 
        DocumentName:= ReadString(''); 
    finally 
      Free; 
    end; 

    CreateRegKey(DocumentName+'\shellex', '', ''); 
    CreateRegKey(DocumentName+'\shellex\ContextMenuHandlers', '', ''); 
    CreateRegKey(DocumentName+'\shellex\ContextMenuHandlers\ShellExtTester', '', ClassID); 

    if (Win32Platform = VER_PLATFORM_WIN32_NT) then 
      with TRegistry.Create do 
        try 
          RootKey := HKEY_LOCAL_MACHINE; 
          OpenKey('SOFTWARE\Microsoft\Windows\CurrentVersion\Shell Extensions', True); 
          OpenKey('Approved', True); 
          WriteString(ClassID, 'ShellExtTester Context Menu Extension'); 
        finally 
          Free; 
        end; 
  end 
  else 
  begin 
    DeleteRegKey(DocumentName+'\shellex\ContextMenuHandlers\ShellExtTester'); 
    inherited UpdateRegistry(Register); 
  end; 
end; 

initialization 
  TShellExtTesterFactory.Create(ComServer, TShellExtTester, Class_ShellExtTester, 
    'ShellExtTester', 'Test d''extension du shell', ciMultiInstance, tmApartment); 
end.