forked from jrsoftware/issrc
-
Notifications
You must be signed in to change notification settings - Fork 0
/
Copy pathDotNet.pas
288 lines (253 loc) · 10.8 KB
/
DotNet.pas
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
unit DotNet;
{
Inno Setup
Copyright (C) 1997-2020 Jordan Russell
Portions by Martijn Laan
For conditions of distribution and use, see LICENSE.TXT.
.NET functions
Fusion code based on LibFusion.pas by RemObject Software
License:
// LibFusion.pas
// copyright (c) 2009 by RemObjects Software
//
// Uses InnoSetup License
Also see https://docs.microsoft.com/en-us/dotnet/framework/unmanaged-api/fusion
https://docs.microsoft.com/en-us/windows/win32/sbscs/side-by-side-assembly-api
IsDotNetInstalled code based on http://www.kynosarges.de/DotNetVersion.html by Cristoph Nahr
License:
// I’m placing this small bit of code in the public domain, so you may embed it in your own
// projects, modify and redistribute it as you see fit.
Also see https://docs.microsoft.com/en-us/dotnet/framework/migration-guide/how-to-determine-which-versions-are-installed
}
interface
uses
Ole2, SysUtils, Windows, CmnFunc2;
type
IAssemblyCache = class(Ole2.IUnknown)
function UninstallAssembly(dwFlags: Integer; pszAssemblyName: PWideChar; pvReserved: Integer; var pulDisposition: Integer): Integer; virtual; stdcall; abstract;
function QueryAssemblyInfo(dwFlags: Integer; pszAssemblyName: PWideChar; pAsmInfo: Integer): Integer; virtual; stdcall; abstract;
function CreateAssemblyCacheItem(dwFlags: Integer; pvReserved: Integer; var ppAsmItem: Integer; pszAssemblyName: PWideChar): Integer; virtual; stdcall; abstract;
function CreateAssemblyScavenger(var ppAsmScavenger: Pointer): Integer; virtual; stdcall; abstract;
function InstallAssembly(dwFlags: Integer; pszManifestFilePath: PWideChar; pvReserved: Integer): Integer; virtual; stdcall; abstract;
end;
TAssemblyCacheInfo = class
private
fDll: THandle;
fCache: IAssemblyCache;
public
constructor Create(const RegView: TRegView);
destructor Destroy; override;
property Cache: IAssemblyCache read FCache;
procedure InstallAssembly(const FileName: string);
procedure UninstallAssembly(const StrongAssemblyName: string); // Full name! in 'AssemblyName, version=1.0.0.0, culture=neutral, publickeytoken=abcdef123456' format
end;
TDotNetBaseVersion = (netbase11, netbase20, netbase40, netbaseHighestKnown);
TDotNetVersion = (net11, net20, net30, net35, net4Client, net4Full, net45, net451, net452, net46, net461, net462, net47, net471, net472, net48);
function GetDotNetInstallRoot(const RegView: TRegView): String;
function GetDotNetVersionInstallRoot(const RegView: TRegView; const Version: TDotNetBaseVersion): String;
function IsDotNetInstalled(const RegView: TRegView; const MinVersion: TDotNetVersion; const MinServicePack: DWORD): Boolean;
implementation
uses
InstFunc, PathFunc;
var
DotNetRoot: array [TRegView] of String;
DotNetVersionRoot: array [TRegView, TDotNetBaseVersion] of String;
{ GetDotNet(Version)InstallRoot }
function GetDotNetInstallRoot(const RegView: TRegView): String;
var
K: HKEY;
begin
if DotNetRoot[RegView] = '' then begin
if RegOpenKeyExView(RegView, HKEY_LOCAL_MACHINE, 'SOFTWARE\Microsoft\.NETFramework', 0, KEY_QUERY_VALUE, K) = ERROR_SUCCESS then begin
RegQueryStringValue(K, 'InstallRoot', DotNetRoot[RegView]);
RegCloseKey(K);
end;
if DotNetRoot[RegView] = '' then
InternalError('.NET Framework not found');
end;
Result := DotNetRoot[RegView];
end;
function GetDotNetVersionInstallRoot(const RegView: TRegView; const Version: TDotNetBaseVersion): String;
const
VersionStrings: array [TDotNetBaseVersion] of String = ('1.1', '2.0', '4.0', '');
var
K: HKEY;
begin
if DotNetVersionRoot[RegView, Version] = '' then begin
GetDotNetInstallRoot(RegView);
if (Version in [netbase40, netbaseHighestKnown]) and (RegOpenKeyExView(RegView, HKEY_LOCAL_MACHINE, 'SOFTWARE\Microsoft\.NETFramework\Policy\v4.0', 0, KEY_QUERY_VALUE, K) = ERROR_SUCCESS) then begin
DotNetVersionRoot[RegView, Version] := AddBackslash(DotNetRoot[RegView]) + 'v4.0.30319';
RegCloseKey(K);
end else if (Version in [netbase20, netbaseHighestKnown]) and (RegOpenKeyExView(RegView, HKEY_LOCAL_MACHINE, 'SOFTWARE\Microsoft\.NETFramework\Policy\v2.0', 0, KEY_QUERY_VALUE, K) = ERROR_SUCCESS) then begin
DotNetVersionRoot[RegView, Version] := AddBackslash(DotNetRoot[RegView]) + 'v2.0.50727';
RegCloseKey(K);
end else if (Version in [netbase11, netbaseHighestKnown]) and (RegOpenKeyExView(RegView, HKEY_LOCAL_MACHINE, 'SOFTWARE\Microsoft\.NETFramework\Policy\v1.1', 0, KEY_QUERY_VALUE, K) = ERROR_SUCCESS) then begin
DotNetVersionRoot[RegView, Version] := AddBackslash(DotNetRoot[RegView]) + 'v1.1.4322';
RegCloseKey(K);
end;
if DotNetVersionRoot[RegView, Version] = '' then begin
if Version <> netbaseHighestKnown then
InternalError(Format('.NET Framework version %s not found', [VersionStrings[Version]]))
else
InternalError('.NET Framework not found');
end;
end;
Result := DotNetVersionRoot[RegView, Version];
end;
{ TAssemblyCacheInfo }
constructor TAssemblyCacheInfo.Create(const RegView: TRegView);
type
TCreateAssemblyCache = function (var ppAsmCache: IAssemblyCache; dwReserved: Integer): Integer; stdcall;
var
FileName: string;
Proc: TCreateAssemblyCache;
begin
inherited Create;
FileName := AddBackslash(GetDotNetVersionInstallRoot(RegView, netbaseHighestKnown)) + 'Fusion.dll';
fDll := SafeLoadLibrary(PChar(FileName), SEM_NOOPENFILEERRORBOX);
if fDll = 0 then
InternalError(Format('Failed to load .NET Framework DLL "%s"', [FileName]));
Proc := GetProcAddress(fDll, 'CreateAssemblyCache');
if not Assigned(Proc) then
InternalError('Failed to get address of .NET Framework CreateAssemblyCache function');
Proc(fCache, 0);
if fCache = nil then
InternalError('.NET Framework CreateAssemblyCache function failed');
end;
destructor TAssemblyCacheInfo.Destroy;
begin
if fCache <> nil then
fCache.Release;
fCache := nil;
FreeLibrary(fDll);
inherited Destroy;
end;
procedure TAssemblyCacheInfo.InstallAssembly(const FileName: string);
const
IASSEMBLYCACHE_INSTALL_FLAG_FORCE_REFRESH = 2;
var
lOleString: PWideChar;
OleResult: HRESULT;
begin
lOleString := StringToOleStr(FileName);
try
OleResult := fCache.InstallAssembly(IASSEMBLYCACHE_INSTALL_FLAG_FORCE_REFRESH, lOleString, 0);
if Failed(OleResult) then
RaiseOleError('InstallAssembly', OleResult);
finally
SysFreeString(lOleString);
end;
end;
procedure TAssemblyCacheInfo.UninstallAssembly(
const StrongAssemblyName: string);
var
lOleString: PWideChar;
OleResult: HRESULT;
begin
lOleString := StringToOleStr(StrongAssemblyName);
try
OleResult := fCache.UninstallAssembly(0, lOleString, 0, Integer(nil^));
if Failed(OleResult) then
RaiseOleError('UninstallAssembly', OleResult);
finally
SysFreeString(lOleString);
end;
end;
{ IsDotNetDetected }
function IsDotNetInstalled(const RegView: TRegView; const MinVersion: TDotNetVersion; const MinServicePack: DWORD): Boolean;
function GetVersionString(const Version: TDotNetVersion): String;
begin
case Version of
net11: Result := 'v1.1';
net20: Result := 'v2.0';
net30: Result := 'v3.0';
net35: Result := 'v3.5';
net4Client: Result := 'v4\Client';
net4Full: Result := 'v4\Full';
net45: Result := 'v4.5';
net451: Result := 'v4.5.1';
net452: Result := 'v4.5.2';
net46: Result := 'v4.6';
net461: Result := 'v4.6.1';
net462: Result := 'v4.6.2';
net47: Result := 'v4.7';
net471: Result := 'v4.7.1';
net472: Result := 'v4.7.2';
net48: Result := 'v4.8';
else
InternalError('IsDotNetDetected: Invalid Version');
end;
end;
function QueryDWord(const SubKey, ValueName: String; var Value: DWORD): Boolean;
var
K: HKEY;
Typ, Size: DWORD;
begin
if RegOpenKeyExView(RegView, HKEY_LOCAL_MACHINE, PChar(SubKey), 0, KEY_QUERY_VALUE, K) = ERROR_SUCCESS then begin
Size := SizeOf(Value);
Result := (RegQueryValueEx(K, PChar(ValueName), nil, @Typ, @Value, @Size) = ERROR_SUCCESS) and (Typ = REG_DWORD);
RegCloseKey(K);
end else
Result := False;
end;
var
VersionString, VersionKey, SubKey: String;
Install, InstalledRelease, InstalledServicePack, RequiredRelease: DWORD;
Success: Boolean;
begin
VersionString := GetVersionString(MinVersion);
RequiredRelease := 0;
// .NET 1.1 and 2.0 embed release number in version key
if VersionString = 'v1.1' then
VersionKey := 'v1.1.4322'
else if VersionString = 'v2.0' then
VersionKey := 'v2.0.50727'
else begin
// .NET 4.5 and newer install as update to .NET 4.0 Full
if Pos('v4.', VersionString) = 1 then begin
VersionKey := 'v4\Full';
if VersionString = 'v4.5' then
RequiredRelease := 378389
else if VersionString = 'v4.5.1' then
RequiredRelease := 378675 // 378758 on Windows 8 and older
else if VersionString = 'v4.5.2' then
RequiredRelease := 379893
else if VersionString = 'v4.6' then
RequiredRelease := 393295 // 393297 on Windows 8.1 and older
else if VersionString = 'v4.6.1' then
RequiredRelease := 394254 // 394271 before Win10 November Update
else if VersionString = 'v4.6.2' then
RequiredRelease := 394802 // 394806 before Win10 Anniversary Update
else if VersionString = 'v4.7' then
RequiredRelease := 460798 // 460805 before Win10 Creators Update
else if VersionString = 'v4.7.1' then
RequiredRelease := 461308 // 461310 before Win10 Fall Creators Update
else if VersionString = 'v4.7.2' then
RequiredRelease := 461808 // 461814 before Win10 April 2018 Update
else if VersionString = 'v4.8' then
RequiredRelease := 528040 // 528049 before Win10 May 2019 Update
else
InternalError('IsDotNetDetected: Invalid VersionString');
end else
VersionKey := VersionString;
end;
SubKey := 'SOFTWARE\Microsoft\NET Framework Setup\NDP\' + VersionKey;
if Pos('v3.0', VersionString) = 1 then
Success := QueryDWord(SubKey + '\Setup', 'InstallSuccess', Install)
else
Success := QueryDWord(SubKey, 'Install', Install);
if Success and (Install = 1) then begin
if Pos('v4', VersionString) = 1 then
Success := QueryDWord(SubKey, 'Servicing', InstalledServicePack)
else
Success := QueryDWord(SubKey, 'SP', InstalledServicePack);
if Success and (InstalledServicePack >= MinServicePack) then begin
if RequiredRelease > 0 then
Success := QueryDWord(SubKey, 'Release', InstalledRelease) and (InstalledRelease >= RequiredRelease);
Result := Success;
end else
Result := False;
end else
Result := False;
end;
end.