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

# User Rev Content
1 daniel-marschall 2 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