Articles   Members Online:
-Article/Tip Search
-News Group Search over 21 Million news group articles.
-Delphi/Pascal
-CBuilder/C++
-C#Builder/C#
-JBuilder/Java
-Kylix
Member Area
-Home
-Account Center
-Top 10 NEW!!
-Submit Article/Tip
-Forums Upgraded!!
-My Articles
-Edit Information
-Login/Logout
-Become a Member
-Why sign up!
-Newsletter
-Chat Online!
-Indexes NEW!!
Employment
-Build your resume
-Find a job
-Post a job
-Resume Search
Contacts
-Contacts
-Feedbacks
-Link to us
-Privacy/Disclaimer
Embarcadero
Visit Embarcadero
Embarcadero Community
JEDI
Links
How to add menu items to windows explorer / desktop context menu Turn on/off line numbers in source code. Switch to Orginial background IDE or DSP color Comment or reply to this aritlce/tip for discussion. Bookmark this article to my favorite article(s). Print this article
09-Nov-03
Category
COM+
Language
Delphi 2.x
Views
257
User Rating
No Votes
# Votes
0
Replies
0
Publisher:
DSP, Administrator
Reference URL:
DKB
			Author: Jonas Bilinkevicius

How to add menu items to windows explorer / desktop context menu

Answer:

1   // Open Delphi select dynamic link library
2   // Copy / paste this into the DLL
3   // Then compile
4   // You will have to customize this code. To suite your needs.
5   // once the dll has been compiled you will now have to register this
6   // com server.
7   // Use regsvr32.exe sendtoweb.dll
8   // now open windows explorer and you will see a new menu item
9   // which can be accessed by the desktop also..
10  
11  unit Sendtoweb;
12  
13  // Author C Pringle Cjpsoftware.com
14  
15  { Implementation of the context menu shell extension COM object. This
16    COM object is responsible for forwarding requests to its partner
17    TPopupMenu component. The TPopupMenu component must reside on the
18    MenuComponentForm, and is referred to explicitly in this example.
19    You can modify this code to make it more flexible and generic in
20    the future.
21  
22    The TContextMenu component registers itself as a global context menu
23    handler. This is accomplished by adding a key to the
24    HKEY_CLASSES_ROOT\*\ShellEx\ContextMenuHandlers key in the registry.
25  
26    jfl
27  }
28  
29  interface
30  
31  uses
32  
33    Classes, ComServ, ComObj, ActiveX, Windows, ShlObj, Interfaces, Menus,
34    ShellAPI, SysUtils, registry;
35  
36  type
37    TContextMenuFactory = class(TComObjectFactory)
38    public
39      procedure UpdateRegistry(register: Boolean); override;
40    end;
41  
42    TContextMenu = class(TComObject, IShellExtInit, IContextMenu)
43    private
44      FFileName: string;
45      function BuildSubMenu(Menu: HMENU; IndexMenu: Integer;
46        var IDCmdFirst: Integer): HMENU;
47    protected
48      szFile: array[0..MAX_PATH] of Char;
49      // Required to disambiguate TComObject.Initialize otherwise a compiler
50      // warning will result.
51      function IShellExtInit.Initialize = IShellExtInit_Initialize;
52    public
53      { IShellExtInit members }
54      function IShellExtInit_Initialize(pidlFolder: PItemIDList; lpdobj: IDataObject;
55        hKeyProgID: HKEY): HResult; stdcall;
56      { IContextMenu }
57      function QueryContextMenu(Menu: HMENU;
58        indexMenu, idCmdFirst, idCmdLast, uFlags: UINT): HResult; stdcall;
59      function InvokeCommand(var lpici: TCMInvokeCommandInfo): HResult; stdcall;
60      function GetCommandString(idCmd, uType: UINT; pwReserved: PUINT;
61        pszName: LPSTR; cchMax: UINT): HResult; stdcall;
62    end;
63  
64  var
65    // Must be set prior to instantiation of TContextMenu!
66    GFileExtensions: TStringList;
67  
68  const
69    MenuCommandStrings: array[0..3] of string = (
70      '', '&STW Web Upload', '&STW FTPClient', '&STW Setup'
71      );
72  
73  implementation
74  
75  { TContextMenuFactory }
76  { Public }
77  
78  function ReadDefaultPAth: string;
79  var
80    path: string;
81    Reg: TRegistry;
82  begin
83  
84    Reg := TRegistry.CReate;
85    try
86      with Reg do
87      begin
88        RootKey := HKEY_LOCAL_MACHINE;
89        Path := 'SOFTWARE\Microsoft\Windows\CurrentVersion\App Paths';
90  
91        if KeyExists(Path) then
92        begin
93          OpenKey(Path + '\sendtoweb.exe', false);
94          Result := ReadString(#0);
95          closekey;
96        end;
97  
98        // Key Added to shell ext.
99  
100     end;
101   finally
102     Reg.CloseKey;
103     Reg.Free;
104   end;
105 
106 end; // Custom registration code
107 
108 procedure TContextMenuFactory.UpdateRegistry(register: Boolean);
109 begin
110   inherited UpdateRegistry(register);
111 
112   // Register our global context menu handler
113   if register then
114   begin
115     CreateRegKey('*\ShellEx\ContextMenuHandlers\SendToWeb', '',
116       GUIDToString(Class_ContextMenu));
117     CreateRegKey('CLSID\' + GUIDToString(ClassID) + '\' +
118       ComServer.ServerKey, 'ThreadingModel', 'Apartment');
119   end
120   else
121   begin
122     DeleteRegKey('*\ShellEx\ContextMenuHandlers\SendToWeb');
123   end;
124 end;
125 
126 { TContextMenu }
127 { Private }
128 
129 { Build a context menu using the existing Menu handle. If Menu is nil,
130   we create a new menu handle and return it in the function's return
131   value. Note that this function does not handle nested (recursive)
132   menus. This exercise is left to the reader. }
133 
134 function TContextMenu.BuildSubMenu(Menu: HMENU; IndexMenu: Integer;
135   var IDCmdFirst: Integer): HMENU;
136 var
137   i: Integer;
138   menuItemInfo: TMenuItemInfo;
139 begin
140   if Menu = 0 then
141     Result := CreateMenu
142   else
143     Result := Menu;
144 
145   // Build the menu items here
146   with menuitemInfo do
147   begin
148     cbSize := SizeOf(TMenuItemInfo);
149     fMask := MIIM_CHECKMARKS or MIIM_DATA or MIIM_ID or
150       MIIM_STATE or MIIM_SUBMENU or MIIM_TYPE or MIIM_CHECKMARKS;
151     fType := MFT_STRING;
152     fState := MFS_ENABLED;
153     hSubMenu := 0;
154     hbmpChecked := 0;
155     hbmpUnchecked := 0;
156   end;
157 
158   for i := 0 to High(MenuCommandStrings) do
159   begin
160     if i = 0 then
161       menuitemInfo.fType := MFT_SEPARATOR
162     else
163       menuiteminfo.ftype := MFT_String;
164     if i = 1 then
165       menuitemInfo.fstate := MFS_ENABLED or MFS_DEFAULT
166     else
167       menuitemInfo.fstate := MFS_ENABLED;
168 
169     menuitemInfo.dwTypeData := PChar(MenuCommandStrings[i]);
170     menuitemInfo.wID := IDCmdFirst;
171     InsertMenuItem(Result, IndexMenu + i, True, menuItemInfo);
172     Inc(IDCmdFirst);
173   end;
174 end;
175 
176 { IShellExtInit }
177 
178 function TContextMenu.IShellExtInit_Initialize(pidlFolder: PItemIDList;
179   lpdobj: IDataObject; hKeyProgID: HKEY): HResult;
180 var
181   medium: TStgMedium;
182   fe: TFormatEtc;
183 
184 begin
185   with fe do
186   begin
187     cfFormat := CF_HDROP;
188     ptd := nil;
189     dwAspect := DVASPECT_CONTENT;
190     lindex := -1;
191     tymed := TYMED_HGLOBAL;
192   end;
193   // Fail the call if lpdobj is Nil.
194   if lpdobj = nil then
195   begin
196     Result := E_FAIL;
197     Exit;
198   end;
199   // Render the data referenced by the IDataObject pointer to an HGLOBAL
200   // storage medium in CF_HDROP format.
201   Result := lpdobj.GetData(fe, medium);
202   if Failed(Result) then
203     Exit;
204   // If only one file is selected, retrieve the file name and store it in
205   // szFile. Otherwise fail the call.
206   if DragQueryFile(medium.hGlobal, $FFFFFFFF, nil, 0) = 1 then
207   begin
208     DragQueryFile(medium.hGlobal, 0, szFile, SizeOf(szFile));
209     Result := NOERROR;
210   end
211   else
212     Result := E_FAIL;
213   ReleaseStgMedium(medium);
214 end;
215 
216 { IContextMenu }
217 
218 function TContextMenu.QueryContextMenu(Menu: HMENU;
219   indexMenu, idCmdFirst, idCmdLast, uFlags: UINT): HResult;
220 var
221   extension: string;
222   I: Integer;
223   idLastCommand: Integer;
224 begin
225   Result := E_FAIL;
226   idLastCommand := idCmdFirst;
227 
228   // Extract the filename extension from the file dropped, and see if we
229   // have a handler registered for it
230 //  extension := UpperCase( ( FFileName ) );
231 
232 //for i := 0 to GFileExtensions.Count - 1 do
233 //   if Pos(Lowercase(GFileExtensions[ i ]),lowercase(extension))=0 then
234   //  begin
235   BuildSubMenu(Menu, indexMenu, idLastCommand);
236   // Return value is number of items added to context menu
237   Result := idLastCommand - idCmdFirst;
238   //      Exit;
239   //    end;
240 end;
241 
242 function TContextMenu.InvokeCommand(var lpici:
243   TCMInvokeCommandInfo): HResult;
244 var
245   idCmd: UINT;
246 begin
247   if HIWORD(Integer(lpici.lpVerb)) <> 0 then
248     Result := E_FAIL
249   else
250   begin
251     idCmd := LOWORD(lpici.lpVerb);
252     Result := S_OK;
253 
254     // Activate the Dialog And prepare to send data to the
255     // web
256 
257     case idCmd of
258       1:
259         begin
260 
261           ShellExecute(GetDesktopWindow, nil, 
262 Pchar(ExtractFileName(ReadDefaultPath)),
263             Pchar('Direct' + '"' + szfile + '"'), nil, SW_SHOW);
264 
265         end;
266       3:
267         begin
268           ShellExecute(GetDesktopWindow, nil, 
269 Pchar(ExtractFileName(ReadDefaultPath)),
270             Pchar('Path'), nil, SW_SHOW);
271 
272         end;
273       2:
274         ShellExecute(GetDesktopWindow, nil, Pchar(ExtractFileName(ReadDefaultPath)),
275           PChar(''), nil, SW_SHOW);
276     else
277       Result := E_FAIL;
278     end;
279   end;
280 end;
281 
282 function TContextMenu.GetCommandString(idCmd, uType: UINT;
283   pwReserved: PUINT; pszName: LPSTR; cchMax: UINT): HResult;
284 
285 begin
286   //  StrCopy( pszName, 'Send To The Web') ;
287 
288   Result := S_OK;
289 end;
290 
291 initialization
292   { Note that we create an instance of TContextMenuFactory here rather
293     than TComObjectFactory. This is necessary so that we can add some
294     custom registry entries by overriding the UpdateRegistry virtual
295     function. }
296   TContextMenuFactory.Create(ComServer, TContextMenu, Class_ContextMenu,
297     'ContextMenu', 'Send To The Web', ciMultiInstance);
298 
299   // Initialize the file extension list
300   GFileExtensions := TStringList.Create;
301   // GFileExtensions.Add( 'setup msn' );
302 
303 finalization
304   GFileExtensions.Free;
305 
306 end.


			
Vote: How useful do you find this Article/Tip?
Bad Excellent
1 2 3 4 5 6 7 8 9 10

 

Advertisement
Share this page
Advertisement
Download from Google

Copyright © Mendozi Enterprises LLC