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

File Contents

# Content
1 // Activator.exe wird für Windows Vista benötigt und aktiviert Konfigurationseinstellungen
2 // Diese Anwendung besitzt durch den Kompatibilitätsmodus volle Adminrechte
3
4 program Activator;
5
6 uses
7 SysUtils,
8 Windows,
9 IniFiles,
10 Classes,
11 Registry;
12
13 {$R Activator.res}
14
15 type
16 TLanguageEntry = record
17 name: string;
18 text: string;
19 end;
20
21 var
22 LangArray: array of TLanguageEntry;
23 ini: TIniFile;
24 str: TStringList;
25 i: integer;
26
27 const
28 Name: String = 'Activator';
29 DC4Ver: String = '4.1';
30
31 function GetLangEntry(name: string): string;
32 var
33 i: integer;
34 begin
35 for i := 0 to high(LangArray) do
36 begin
37 if LangArray[i].name = name then
38 begin
39 result := LangArray[i].text;
40 break;
41 end;
42 end;
43 end;
44
45 function DLLRegister(dll: string; doregister: boolean): boolean;
46 type
47 DllReg = function: HResult; stdcall;
48 var
49 hDll: THandle;
50 dr: DllReg;
51 begin
52 result := false;
53 hDll := LoadLibrary(PChar(dll));
54 if hDll <> 0 then
55 begin
56 if doregister then
57 @dr := GetProcAddress(hDll, 'DllRegisterServer')
58 else
59 @dr := GetProcAddress(hDll, 'DllUnregisterServer');
60 if assigned(dr) then
61 begin
62 dr;
63 result := true;
64 end;
65 end;
66 end;
67
68 function TypeRegistry(App, IconIndex, Extension, InternalName, Name: string): boolean;
69 var
70 reg: TRegistry;
71 c1, c2, c3, c4, l1, l2, l3, l4: boolean;
72 begin
73 Reg := TRegistry.Create;
74 try
75 Reg.RootKey := HKEY_CLASSES_ROOT;
76
77 l1 := false;
78 if Reg.OpenKey('\'+Extension, true) then
79 begin
80 Reg.WriteString('', InternalName);
81 l1 := reg.ReadString('') = InternalName;
82 Reg.CloseKey();
83 end;
84 c1 := reg.KeyExists('\'+Extension);
85
86 l2 := false;
87 if Reg.OpenKey('\'+InternalName, true) then
88 begin
89 Reg.WriteString('', Name);
90 l2 := reg.ReadString('') = Name;
91 Reg.CloseKey();
92 end;
93 c2 := reg.KeyExists('\'+InternalName);
94
95 l3 := false;
96 if Reg.OpenKey('\'+InternalName+'\DefaultIcon', true) then
97 begin
98 Reg.WriteString('', App+','+IconIndex);
99 l3 := reg.ReadString('') = App+','+IconIndex;
100 Reg.CloseKey();
101 end;
102 c3 := reg.KeyExists('\'+InternalName+'\DefaultIcon');
103
104 l4 := false;
105 if Reg.OpenKey('\'+InternalName+'\shell\open\command', true) then
106 begin
107 Reg.WriteString('', '"'+App+'" "%1"');
108 l4 := reg.ReadString('') = '"'+App+'" "%1"';
109 Reg.CloseKey();
110 end;
111 c4 := reg.KeyExists('\'+InternalName+'\shell\open\command');
112 finally
113 Reg.Free;
114 end;
115
116 result := c1 and c2 and c3 and c4 and l1 and l2 and l3 and l4;
117 end;
118
119 function TypeUnregistry(Extension: string): boolean;
120 var
121 reg: TRegistry;
122 temp: string;
123 c1, c2: boolean;
124 begin
125 c1 := false;
126 c2 := false;
127 Reg := TRegistry.Create;
128 try
129 Reg.RootKey := HKEY_CLASSES_ROOT;
130
131 if Reg.OpenKey('\'+Extension, false) then
132 begin
133 temp := Reg.ReadString('');
134 Reg.CloseKey();
135 if reg.KeyExists('\'+temp) then Reg.DeleteKey('\'+temp);
136 c1 := not reg.KeyExists('\'+temp);
137 if reg.KeyExists('\'+Extension) then Reg.DeleteKey('\'+Extension);
138 c2 := not reg.KeyExists('\'+Extension);
139 end;
140 finally
141 Reg.Free;
142 end;
143
144 result := c1 and c2;
145 end;
146
147 begin
148 // Sprachdatei auslesen
149
150 ini := TIniFile.Create(ExtractFilePath(paramstr(0))+'Language.ini');
151 str := TStringList.Create();
152 try
153 ini.ReadSection(Name, str);
154 for i := 0 to str.count-1 do
155 begin
156 setlength(LangArray, length(LangArray)+1);
157 LangArray[length(LangArray)-1].name := str.strings[i];
158 LangArray[length(LangArray)-1].text := ini.ReadString(name, str.strings[i], '');
159 LangArray[length(LangArray)-1].text := StringReplace(LangArray[length(LangArray)-1].text, '###', #13#10, [rfReplaceAll]);
160 end;
161 finally
162 ini.free;
163 str.Free;
164 end;
165
166 // Ausführung
167
168 if paramstr(1) = '/dllreg' then
169 begin
170 if not DLLRegister(paramstr(2), true) then
171 MessageBox(0, pchar(GetLangEntry('failed')), pchar(GetLangEntry('error')), MB_OK + MB_ICONERROR);
172 end;
173 if paramstr(1) = '/dllunreg' then
174 begin
175 if not DLLRegister(paramstr(2), false) then
176 MessageBox(0, pchar(GetLangEntry('failed')), pchar(GetLangEntry('error')), MB_OK + MB_ICONERROR);
177 end;
178 if paramstr(1) = '/typereg' then
179 begin
180 if not TypeRegistry(paramstr(3), paramstr(4), paramstr(2), paramstr(5), paramstr(6)) then
181 MessageBox(0, pchar(GetLangEntry('failed')), pchar(GetLangEntry('error')), MB_OK + MB_ICONERROR);
182 end;
183 if paramstr(1) = '/typeunreg' then
184 begin
185 if not TypeUnregistry(paramstr(2)) then
186 MessageBox(0, pchar(GetLangEntry('failed')), pchar(GetLangEntry('error')), MB_OK + MB_ICONERROR);
187 end;
188 end.