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.
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.
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.
J'aimerais mieux la deuxième solution : l'extention shell.
Merci d'avance
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:
Voila pour la théorie, maintenant un peu de pratique.
- 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.
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é):
Voila, c'est fini. Il ne reste plus qu'à compiler et à recenser le serveur (par le menu exécuter ou par RegScr32).
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.
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.
Je viens d'essayer, et au moment de compiler, j'obtiens l'erreur suivante :Envoyé par Pierre Castelain
Y a t'il quelque chose auquel il faut faire attention ?Envoyé par Delphi
:
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?
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.Envoyé par lil_jam63
Non, rien.Envoyé par lil_jam63
C'est ce que j'ai fais, et c'est ca qui donne l'erreur.Envoyé par lil_jam63
Ca, ca se passe avec succès, mais le recensement avait échoué ...Envoyé par lil_jam63
C'est le recensement qui donne l'erreur.Envoyé par lil_jam63
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.
![]()
![]()
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).
![]()
Vous avez un bloqueur de publicités installé.
Le Club Developpez.com n'affiche que des publicités IT, discrètes et non intrusives.
Afin que nous puissions continuer à vous fournir gratuitement du contenu de qualité, merci de nous soutenir en désactivant votre bloqueur de publicités sur Developpez.com.
Partager