Login | ViewVC Help
View File | Revision Log | Show Annotations | Download File | View Changeset | Root Listing
root/decoder/trunk/Quelltext/ShellExtMain.pas
Revision: 2
Committed: Thu Nov 8 11:09:30 2018 UTC (22 months, 2 weeks ago) by daniel-marschall
Content type: text/x-pascal
File size: 6495 byte(s)
Log Message:
Published revision 01 March 2007 to SVN.
Added disclaimer.
Changed the license to Apache2.

File Contents

# Content
1 unit ShellExtMain;
2
3 interface
4
5 uses
6 ComServ, SysUtils, ShellAPI, Windows, Registry, ActiveX, ComObj, ShlObj,
7 Graphics, classes, inifiles;
8
9 const
10 GUID_TDFKontextMenuShellExt: TGUID = '{C30DC498-38EA-4DED-8AD4-E302CE094892}';
11
12 type
13 TDFKontextMenuShellExt = class(TComObject, IShellExtInit, IContextMenu)
14 protected
15 function IShellExtInit.Initialize = SEInitialize;
16 function SEInitialize(pidlFolder: PItemIDList; lpdobj: IDataObject; hKeyProgID: HKEY): HResult; stdcall;
17 function QueryContextMenu(Menu: HMENU; indexMenu, idCmdFirst, idCmdLast, uflags: UINT): HResult; stdcall;
18 function InvokeCommand(var lpici: TCMInvokeCommandInfo): HResult; stdcall;
19 function GetCommandString(idCmd, uType: UINT; pwReserved: PUINT; pszName: LPSTR; cchMax: UINT): HResult; stdcall;
20 end;
21
22 implementation
23
24 var
25 hBmp: TBitmap;
26 handle: hwnd;
27 vsl: tstringlist;
28 path: string;
29 langini: TIniFile;
30
31 type
32 TDFKontextMenuShellExtFactory = class(TComObjectFactory)
33 public
34 procedure UpdateRegistry(Register: boolean); override;
35 end;
36
37 function TDFKontextMenuShellExt.GetCommandString(idCmd, uType: UINT; pwReserved: PUINT;
38 pszName: LPSTR; cchMax: UINT): HResult;
39 begin
40 try
41 if (idCmd = 0) then
42 begin
43 if (uType = GCS_HELPTEXT) then
44 StrCopy(pszName, pchar(langini.ReadString('ShlExt', 'openwith', '?')));
45
46 Result := NOERROR;
47 end
48 else
49 Result := E_INVALIDARG;
50 except
51 Result := E_UNEXPECTED;
52 end;
53 end;
54
55 function TDFKontextMenuShellExt.InvokeCommand(var lpici: TCMInvokeCommandInfo): HResult;
56 var
57 i: integer;
58 para: string;
59 begin
60 Result := E_FAIL;
61 if (HiWord(Integer(lpici.lpVerb)) <> 0) then
62 Exit;
63
64 if not (LoWord(lpici.lpVerb) in [0, 1, 2]) then
65 begin
66 Result := E_INVALIDARG;
67 Exit;
68 end;
69
70 if not fileexists(path+'Coder.exe') then
71 Messagebox(handle, pchar(langini.ReadString('ShlExt', 'codermissing', '?')), pchar(langini.ReadString('ShlExt', 'error', '?')), MB_ICONERROR or MB_OK)
72 else
73 begin
74 para := '';
75 for i := 0 to vsl.count - 1 do
76 para := para + '"'+vsl.strings[i]+'" ';
77 para := copy(para, 0, length(para)-1);
78
79 ShellExecute(handle, 'open', PChar(path+'Coder.exe'), PChar(para), pchar(path), SW_NORMAL);
80 end;
81
82 Result := NOERROR;
83 end;
84
85 function TDFKontextMenuShellExt.QueryContextMenu(Menu: HMENU; indexMenu,
86 idCmdFirst, idCmdLast, uflags: UINT): HResult;
87 begin
88 Result := 0;
89
90 if ((uFlags and $0000000F) = CMF_NORMAL) or
91 ((uFlags and CMF_EXPLORE) <> 0) or
92 ((uFlags and CMF_VERBSONLY <> 0)) then
93 begin
94 InsertMenu(Menu, indexMenu, MF_STRING or MF_BYPOSITION, idCmdFirst, pchar(langini.readstring('ShlExt', 'context', '?')));
95
96 if hBmp.Handle <> 0 then
97 SetMenuItemBitmaps(Menu, indexMenu, MF_BYPOSITION, hBmp.Handle, hBmp.Handle);
98
99 Result := 1;
100 end;
101 end;
102
103 function TDFKontextMenuShellExt.SEInitialize(pidlFolder: PItemIDList;
104 lpdobj: IDataObject; hKeyProgID: HKEY): HResult;
105 var
106 StgMedium: TStgMedium;
107 FormatEtc: TFormatEtc;
108 FFileName: array[0..MAX_PATH] of Char;
109 i: Integer;
110 begin
111 if (lpdobj = nil) then
112 begin
113 Result := E_INVALIDARG;
114 Exit;
115 end;
116
117 with FormatEtc do
118 begin
119 cfFormat := CF_HDROP;
120 ptd := nil;
121 dwAspect := DVASPECT_CONTENT;
122 lindex := -1;
123 tymed := TYMED_HGLOBAL;
124 end;
125
126 Result := lpdobj.GetData(FormatEtc, StgMedium);
127 if Failed(Result) then
128 Exit;
129
130 vsl := tstringlist.Create;
131
132 vSL.Clear;
133 for i := 0 to DragQueryFile(StgMedium.hGlobal, $FFFFFFFF, nil, 0) - 1 do
134 begin
135 DragQueryFile(StgMedium.hGlobal, i, FFileName, SizeOf(FFileName));
136 vSl.Add(FFileName);
137 end;
138
139 ReleaseStgMedium(StgMedium);
140 Result := NOERROR;
141 end;
142
143 procedure TDFKontextMenuShellExtFactory.UpdateRegistry(Register: boolean);
144 var
145 ClassID: string;
146 begin
147 ClassID := GUIDToString(GUID_TDFKontextMenuShellExt);
148
149 if Register then
150 begin
151 inherited UpdateRegistry(Register);
152
153 CreateRegKey('Folder\shellex', '', '');
154 CreateRegKey('Folder\shellex\ContextMenuHandlers', '', '');
155 CreateRegKey('Folder\shellex\ContextMenuHandlers\(De)Coder', '', ClassID);
156
157 CreateRegKey('*\shellex', '', '');
158 CreateRegKey('*\shellex\ContextMenuHandlers', '', '');
159 CreateRegKey('*\shellex\ContextMenuHandlers\(De)Coder', '', ClassID);
160
161 if (Win32Platform = VER_PLATFORM_WIN32_NT) then
162 with TRegistry.Create do
163 try
164 RootKey := HKEY_LOCAL_MACHINE;
165 OpenKey('SOFTWARE\Microsoft\Windows\CurrentVersion\Shell Extensions\Approved', True);
166 WriteString(ClassID, '(De)Coder');
167 CloseKey;
168 finally
169 Free;
170 end;
171 end
172 else
173 begin
174 DeleteRegKey('Folder\shellex\ContextMenuHandlers\(De)Coder');
175 DeleteRegKey('Folder\shellex\ContextMenuHandlers');
176 DeleteRegKey('Folder\shellex');
177
178 DeleteRegKey('*\shellex\ContextMenuHandlers\(De)Coder');
179 DeleteRegKey('*\shellex\ContextMenuHandlers');
180 DeleteRegKey('*\shellex');
181
182 if (Win32Platform = VER_PLATFORM_WIN32_NT) then
183 with TRegistry.Create do
184 try
185 RootKey := HKEY_LOCAL_MACHINE;
186 OpenKey('SOFTWARE\Microsoft\Windows\CurrentVersion\Shell Extensions\Approved', True);
187 DeleteValue(ClassID);
188 CloseKey;
189 finally
190 Free;
191 end;
192
193 inherited UpdateRegistry(Register);
194 end;
195 end;
196
197 initialization
198 // Initialisierung
199 TDFKontextMenuShellExtFactory.Create(ComServer, TDFKontextMenuShellExt, GUID_TDFKontextMenuShellExt,
200 '', '(De)Coder', ciMultiInstance, tmApartment);
201 hBmp := TBitmap.Create;
202 hBmp.LoadFromResourceName(hInstance, 'KONTEXTICON');
203
204 path := '';
205
206 // Pfad ermitteln
207 with TRegistry.Create do
208 try
209 RootKey := HKEY_CURRENT_USER;
210 OpenKeyReadOnly('SOFTWARE\Microsoft\Windows\CurrentVersion\Uninstall\(De)Coder_is1');
211 path := ReadString('InstallLocation');
212 CloseKey;
213 if path = '' then
214 begin
215 RootKey := HKEY_LOCAL_MACHINE;
216 OpenKeyReadOnly('SOFTWARE\Microsoft\Windows\CurrentVersion\Uninstall\(De)Coder_is1');
217 path := ReadString('InstallLocation');
218 CloseKey;
219 end;
220 finally
221 free;
222 end;
223
224 // Language.ini öffnen
225 langini := TIniFile.Create(path+'Language.ini');
226
227 finalization
228 hBmp.Free;
229 langini.Free;
230 end.
231