Discussion :

[ddmicrolog]

Bonjour,

j'aimerais ajouter un liens vers une de mes application dans le popup menu de windows comme le fait winzip ou ultra edit.

Merci d'avance.

[Pierre Castelain]

Il existe au moins 2 solutions.
La première et la plus simple est d'ajouter une commande associée à un type de fichier (spécifié pas son extension). Tu peux le faire depuis le menu Outils->Options des dossiers->Types de fichiers dans l'explorateur ou manipuler la base de registre manuellement.
La deuxième solution (celle utilisée par Winzip par exemple) est d'ajouter une extension du shell. C'est un peu plus compliqué car il faut coder cette extension. Par contre, cela permet une plus grande maitrise du processus puisque ton application peut décider ou non d'afficher un item de menu en fonction des fichiers sélectionnés (entre autres).
Dis-nous ce que tu cherche à faire et on verra quelle est la meilleure solution.

[ddmicrolog]

J'aimerais mieux la deuxième solution : l'extention shell.

Merci d'avance

[Pierre Castelain]

OK, c'est parti!

On va commencer par le principe général:
Une extension du shell est un objet COM qui implémente certaines interfaces spécifiques (IShellExtInit et IContextMenu). Pour que cet objet soit utilisé par le shell, il faut bien sur que la dll qui le contient soit enregistrée (regsvr32 ou directement depuis Delphi par le menu Exécuter->Recenser le serveur ActiveX). De plus, il faut que l'extension soit également inscrite dans la base de registre (voir la méthode UpdateRegistry).
Lorsque l'utilisateur sélectionne des fichiers et fait un clic droit, le shell instancie un objet de notre classe et appelle les méthodes suivantes:

• 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.

Voila pour la théorie, maintenant un peu de pratique.

Il faut commencer par créer une bibliothèque ActiveX (menu Fichier->Nouveau->ActiveX). Nous allons l'appeller ShellExtTest.
Ensuite, il nous faut un objet COM (menu Fichier->Nouveau->ActiveX) que nous appelerons ShellExtTester (Delphi va automatiquement ajouter un I devant le nom de l'interface).
La nouvelle unité créée sera enregistrée sous le nom ShellExtTesterImpl.
Il ne reste plus qu'à recopier le code suivant (légèrement commenté):

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
 
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.

Voila, c'est fini. Il ne reste plus qu'à compiler et à recenser le serveur (par le menu exécuter ou par RegScr32).
Attention, une fois recensé vous ne pourrez pas recompiler si le shell est ouvert, c'est à dire si une fenêtre de l'explorateur est ouverte.

[ddmicrolog]

merci pour votre réponse

[Lung]

Voila, c'est fini. Il ne reste plus qu'à compiler et à recenser le serveur (par le menu exécuter

Je viens d'essayer, et au moment de compiler, j'obtiens l'erreur suivante :

Erreur non spécifiée

Y a t'il quelque chose auquel il faut faire attention ?

:

[lil_jam63]

Normalement si tu a suivi à la lettre ce que Pierre à écrit plus haut, tu ne devrais pas avoir de problèmes. Est ce que tu as rajouté des choses? passe directement par "Recenser le serveur ActiveX" et dérecense une fois que tu as fait ton test, ou alors ferme la fenêtre où tu viens de faire ton test.
Tu peux nous en dire plus sur ton erreur?

[Lung]

Normalement si tu a suivi à la lettre ce que Pierre à écrit plus haut, tu ne devrais pas avoir de problèmes.

C'est ce que j'ai fais, pour partir d'un exemple qui fonctionnerait. J'ai utilisé les même noms que lui, j'ai copier-coller son code pour ne pas avoir d'erreur de saisie.

Est ce que tu as rajouté des choses?

Non, rien.

passe directement par "Recenser le serveur ActiveX"

C'est ce que j'ai fais, et c'est ca qui donne l'erreur.

et dérecense une fois que tu as fait ton test

Ca, ca se passe avec succès, mais le recensement avait échoué ...

Tu peux nous en dire plus sur ton erreur?

C'est le recensement qui donne l'erreur.
Pourtant, j'ai bien créé l'activeX avec le même nom ; la bibliothèque (COM) avec le même non ; j'ai copier-coller le code.

[Lung]

Je viens de réessayer de recenser l'activeX sur un autre poste, et là, tout fonctionne.

Pourquoi, ca ne fonctionnerait pas sur certains postes ?
Sachant, que ce sont 2 XP Pro, avec le même Delphi (même version).