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

File Contents

# Content
1 unit ShellEraseMain;
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 = '{6B422248-BB90-4682-A128-F088E99AB520}';
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('ShlErase', '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 procedure ProcessMessages(hWnd: DWORD);
56 var
57 Msg: TMsg;
58 begin
59 while PeekMessage(Msg, hWnd, 0, 0, PM_REMOVE) do
60 begin
61 TranslateMessage(Msg);
62 DispatchMessage(Msg);
63 end;
64 end;
65
66 function ExecuteWithExitCode(filename, params, dir: string): integer;
67 var
68 proc_info: TProcessInformation;
69 startinfo: TStartupInfo;
70 ExitCode: longword;
71 begin
72 FillChar(proc_info, sizeof(TProcessInformation), 0);
73 FillChar(startinfo, sizeof(TStartupInfo), 0);
74 startinfo.cb := sizeof(TStartupInfo);
75
76 if CreateProcess(nil, pchar(Format('"%s" %s', [filename, TrimRight(pchar(params))])), nil,
77 nil, false, NORMAL_PRIORITY_CLASS, nil, pchar(path),
78 startinfo, proc_info) <> False then
79 begin
80 // WaitForSingleObject(proc_info.hProcess, INFINITE);
81 while WaitForSingleObject(proc_info.hProcess, 0) = WAIT_TIMEOUT do
82 begin
83 ProcessMessages(0);
84 Sleep(50);
85 end;
86 GetExitCodeProcess(proc_info.hProcess, ExitCode);
87 CloseHandle(proc_info.hThread);
88 CloseHandle(proc_info.hProcess);
89 result := ExitCode;
90 end
91 else
92 begin
93 result := -1;
94 end;
95 end;
96
97 function TDFKontextMenuShellExt.InvokeCommand(var lpici: TCMInvokeCommandInfo): HResult;
98 var
99 i, res: integer;
100 fehler: boolean;
101 begin
102 Result := E_FAIL;
103 if (HiWord(Integer(lpici.lpVerb)) <> 0) then
104 Exit;
105
106 if not (LoWord(lpici.lpVerb) in [0, 1, 2]) then
107 begin
108 Result := E_INVALIDARG;
109 Exit;
110 end;
111
112 res := Messagebox(handle, pchar(langini.ReadString('ShlErase', 'sicherheitsfrage', '?')), pchar(langini.ReadString('ShlErase', 'sicherheitsfragecaption', '?')), MB_ICONQUESTION or MB_YESNO);
113
114 if res = ID_YES then
115 begin
116 if not fileexists(path+'Coder.exe') then
117 Messagebox(handle, pchar(langini.ReadString('ShlErase', 'codermissing', '?')), pchar(langini.ReadString('ShlErase', 'error', '?')), MB_ICONERROR or MB_OK)
118 else
119 begin
120 fehler := false;
121 for i := 0 to vsl.count-1 do
122 begin
123 // ShellExecute(handle, 'open', PChar(path+'Coder.exe'), PChar('"'+vsl.Strings[i]+'" /e /notsilent'), pchar(path), SW_NORMAL);
124 if ExecuteWithExitCode(path+'Coder.exe', '"'+vsl.Strings[i]+'" /e', path) = 8 then
125 fehler := true;
126 end;
127 if fehler then
128 MessageBox(handle, pchar(langini.ReadString('ShlErase', 'delerror', '?')), pchar(langini.ReadString('ShlErase', 'error', '?')), MB_OK + MB_ICONERROR)
129 else
130 MessageBox(handle, pchar(langini.ReadString('ShlErase', 'delok', '?')), pchar(langini.ReadString('ShlErase', 'information', '?')), MB_OK + MB_ICONINFORMATION);
131 end;
132 end;
133
134 Result := NOERROR;
135 end;
136
137 function TDFKontextMenuShellExt.QueryContextMenu(Menu: HMENU; indexMenu,
138 idCmdFirst, idCmdLast, uflags: UINT): HResult;
139 begin
140 Result := 0;
141
142 if ((uFlags and $0000000F) = CMF_NORMAL) or
143 ((uFlags and CMF_EXPLORE) <> 0) or
144 ((uFlags and CMF_VERBSONLY <> 0)) then
145 begin
146 InsertMenu(Menu, indexMenu, MF_STRING or MF_BYPOSITION, idCmdFirst, pchar(langini.readstring('ShlErase', 'context', '?')));
147
148 if hBmp.Handle <> 0 then
149 SetMenuItemBitmaps(Menu, indexMenu, MF_BYPOSITION, hBmp.Handle, hBmp.Handle);
150
151 Result := 1;
152 end;
153 end;
154
155 function TDFKontextMenuShellExt.SEInitialize(pidlFolder: PItemIDList;
156 lpdobj: IDataObject; hKeyProgID: HKEY): HResult;
157 var
158 StgMedium: TStgMedium;
159 FormatEtc: TFormatEtc;
160 FFileName: array[0..MAX_PATH] of Char;
161 i: Integer;
162 begin
163 if (lpdobj = nil) then
164 begin
165 Result := E_INVALIDARG;
166 Exit;
167 end;
168
169 with FormatEtc do
170 begin
171 cfFormat := CF_HDROP;
172 ptd := nil;
173 dwAspect := DVASPECT_CONTENT;
174 lindex := -1;
175 tymed := TYMED_HGLOBAL;
176 end;
177
178 Result := lpdobj.GetData(FormatEtc, StgMedium);
179 if Failed(Result) then
180 Exit;
181
182 vsl := tstringlist.Create;
183
184 vSL.Clear;
185 for i := 0 to DragQueryFile(StgMedium.hGlobal, $FFFFFFFF, nil, 0) - 1 do
186 begin
187 DragQueryFile(StgMedium.hGlobal, i, FFileName, SizeOf(FFileName));
188 vSl.Add(FFileName);
189 end;
190
191 ReleaseStgMedium(StgMedium);
192 Result := NOERROR;
193 end;
194
195 procedure TDFKontextMenuShellExtFactory.UpdateRegistry(Register: boolean);
196 var
197 ClassID: string;
198 begin
199 ClassID := GUIDToString(GUID_TDFKontextMenuShellExt);
200
201 if Register then
202 begin
203 inherited UpdateRegistry(Register);
204
205 CreateRegKey('Folder\shellex', '', '');
206 CreateRegKey('Folder\shellex\ContextMenuHandlers', '', '');
207 CreateRegKey('Folder\shellex\ContextMenuHandlers\(De)Coder-Erase', '', ClassID);
208
209 CreateRegKey('*\shellex', '', '');
210 CreateRegKey('*\shellex\ContextMenuHandlers', '', '');
211 CreateRegKey('*\shellex\ContextMenuHandlers\(De)Coder-Erase', '', ClassID);
212
213 if (Win32Platform = VER_PLATFORM_WIN32_NT) then
214 with TRegistry.Create do
215 try
216 RootKey := HKEY_LOCAL_MACHINE;
217 OpenKey('SOFTWARE\Microsoft\Windows\CurrentVersion\Shell Extensions\Approved', True);
218 WriteString(ClassID, '(De)Coder-Erase');
219 CloseKey;
220 finally
221 Free;
222 end;
223 end
224 else
225 begin
226 DeleteRegKey('Folder\shellex\ContextMenuHandlers\(De)Coder-Erase');
227 DeleteRegKey('Folder\shellex\ContextMenuHandlers');
228 DeleteRegKey('Folder\shellex');
229
230 DeleteRegKey('*\shellex\ContextMenuHandlers\(De)Coder-Erase');
231 DeleteRegKey('*\shellex\ContextMenuHandlers');
232 DeleteRegKey('*\shellex');
233
234 if (Win32Platform = VER_PLATFORM_WIN32_NT) then
235 with TRegistry.Create do
236 try
237 RootKey := HKEY_LOCAL_MACHINE;
238 OpenKey('SOFTWARE\Microsoft\Windows\CurrentVersion\Shell Extensions\Approved', True);
239 DeleteValue(ClassID);
240 CloseKey;
241 finally
242 Free;
243 end;
244
245 inherited UpdateRegistry(Register);
246 end;
247 end;
248
249 initialization
250 // Initialisierung
251 TDFKontextMenuShellExtFactory.Create(ComServer, TDFKontextMenuShellExt, GUID_TDFKontextMenuShellExt,
252 '', '(De)Coder Eraser', ciMultiInstance, tmApartment);
253 hBmp := TBitmap.Create;
254 hBmp.LoadFromResourceName(hInstance, 'KONTEXTICON');
255
256 path := '';
257
258 // Pfad ermitteln
259 with TRegistry.Create do
260 try
261 RootKey := HKEY_CURRENT_USER;
262 OpenKeyReadOnly('SOFTWARE\Microsoft\Windows\CurrentVersion\Uninstall\(De)Coder_is1');
263 path := ReadString('InstallLocation');
264 CloseKey;
265 if path = '' then
266 begin
267 RootKey := HKEY_LOCAL_MACHINE;
268 OpenKeyReadOnly('SOFTWARE\Microsoft\Windows\CurrentVersion\Uninstall\(De)Coder_is1');
269 path := ReadString('InstallLocation');
270 CloseKey;
271 end;
272 finally
273 free;
274 end;
275
276 // Language.ini öffnen
277 langini := TIniFile.Create(path+'Language.ini');
278
279 finalization
280 hBmp.Free;
281 langini.Free;
282 end.
283