1 {
2 /***************************************************************************
3 w32manifest.pas - Lazarus IDE unit
4 ---------------------------------------
5 TProjectXPManifest is responsible for the inclusion of the
6 manifest in windows executables.
7
8
9 ***************************************************************************/
10
11 ***************************************************************************
12 * *
13 * This source is free software; you can redistribute it and/or modify *
14 * it under the terms of the GNU General Public License as published by *
15 * the Free Software Foundation; either version 2 of the License, or *
16 * (at your option) any later version. *
17 * *
18 * This code is distributed in the hope that it will be useful, but *
19 * WITHOUT ANY WARRANTY; without even the implied warranty of *
20 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU *
21 * General Public License for more details. *
22 * *
23 * A copy of the GNU General Public License is available on the World *
24 * Wide Web at <http://www.gnu.org/copyleft/gpl.html>. You can also *
25 * obtain it by writing to the Free Software Foundation, *
26 * Inc., 51 Franklin Street - Fifth Floor, Boston, MA 02110-1335, USA. *
27 * *
28 ***************************************************************************
29
30 The manifest file is needed for windows XP themes.
31 The file is created in the directory, where the project exe is created.
32 }
33 unit W32Manifest;
34
35 {$mode objfpc}{$H+}
36
37 interface
38
39 uses
40 Classes, SysUtils, FileUtil, Laz2_XMLCfg, LCLProc, Controls, Forms,
41 CodeToolManager, LazConf, LResources,
42 ProjectResourcesIntf, resource;
43
44 const
45 DefaultXPManifestTextName = 'CompanyName.ProductName.AppName';
46 DefaultXPManifestTextDesc = 'Your application description.';
47 type
48 TXPManifestExecutionLevel = (
49 xmelAsInvoker,
50 xmelHighestAvailable,
51 xmelRequireAdministrator
52 );
53
54 TXPManifestDpiAware = (
55 xmdaFalse,
56 xmdaTrue,
57 xmdaPerMonitor,
58 xmdaTruePM,
59 xmdaPerMonitorV2
60 );
61
62 type
63 { TProjectXPManifest }
64
65 TProjectXPManifest = class(TAbstractProjectResource)
66 private
67 FExecutionLevel: TXPManifestExecutionLevel;
68 FDpiAware: TXPManifestDpiAware;
69 FUIAccess: Boolean;
70 FUseManifest: boolean;
71 FTextName: string;
72 FTextDesc: string;
73 procedure SetDpiAware(AValue: TXPManifestDpiAware);
74 procedure SetExecutionLevel(AValue: TXPManifestExecutionLevel);
75 procedure SetUIAccess(AValue: Boolean);
76 procedure SetUseManifest(const AValue: boolean);
77 procedure SetTextName(const AValue: string);
78 procedure SetTextDesc(const AValue: string);
79 public
80 constructor Create; override;
UpdateResourcesnull81 function UpdateResources(AResources: TAbstractProjectResources; const {%H-}MainFilename: string): Boolean; override;
82 procedure WriteToProjectFile(AConfig: {TXMLConfig}TObject; const Path: String); override;
83 procedure ReadFromProjectFile(AConfig: {TXMLConfig}TObject; const Path: String); override;
84
85 property UseManifest: boolean read FUseManifest write SetUseManifest;
86 property DpiAware: TXPManifestDpiAware read FDpiAware write SetDpiAware;
87 property ExecutionLevel: TXPManifestExecutionLevel read FExecutionLevel write SetExecutionLevel;
88 property UIAccess: Boolean read FUIAccess write SetUIAccess;
89 property TextName: string read FTextName write SetTextName;
90 property TextDesc: string read FTextDesc write SetTextDesc;
91 end;
92
93 const
94 ExecutionLevelToStr: array[TXPManifestExecutionLevel] of String = (
95 'asInvoker',
96 'highestAvailable',
97 'requireAdministrator'
98 );
99
100 ManifestDpiAwareValues: array[TXPManifestDpiAware] of string = (
101 'False',
102 'True',
103 'Per-monitor',
104 'True/PM',
105 'True/PM'
106 );
107
108 ManifestDpiAwarenessValues: array[TXPManifestDpiAware] of string = (
109 '',
110 '',
111 '',
112 '',
113 '<dpiAwareness>PerMonitorV2, PerMonitor</dpiAwareness>'
114 );
115
116 implementation
117
118 const
119 sManifestFileData: String =
120 '<?xml version="1.0" encoding="UTF-8" standalone="yes"?>'#$D#$A+
121 '<assembly xmlns="urn:schemas-microsoft-com:asm.v1" manifestVersion="1.0">'#$D#$A+
122 ' <assemblyIdentity version="1.0.0.0" processorArchitecture="*" name="%s" type="win32"/>'#$D#$A+
123 ' <description>%s</description>'#$D#$A+
124 ' <dependency>'#$D#$A+
125 ' <dependentAssembly>'#$D#$A+
126 ' <assemblyIdentity type="win32" name="Microsoft.Windows.Common-Controls" version="6.0.0.0" processorArchitecture="*" publicKeyToken="6595b64144ccf1df" language="*"/>'#$D#$A+
127 ' </dependentAssembly>'#$D#$A+
128 ' </dependency>'#$D#$A+
129 ' <trustInfo xmlns="urn:schemas-microsoft-com:asm.v3">'#$D#$A+
130 ' <security>'#$D#$A+
131 ' <requestedPrivileges>'#$D#$A+
132 ' <requestedExecutionLevel level="%s" uiAccess="%s"/>'#$D#$A+
133 ' </requestedPrivileges>'#$D#$A+
134 ' </security>'#$D#$A+
135 ' </trustInfo>'#$D#$A+
136 ' <compatibility xmlns="urn:schemas-microsoft-com:compatibility.v1">'#$D#$A+
137 ' <application>'#$D#$A+
138 ' <!-- Windows Vista -->'#$D#$A+
139 ' <supportedOS Id="{e2011457-1546-43c5-a5fe-008deee3d3f0}" />'#$D#$A+
140 ' <!-- Windows 7 -->'#$D#$A+
141 ' <supportedOS Id="{35138b9a-5d96-4fbd-8e2d-a2440225f93a}" />'#$D#$A+
142 ' <!-- Windows 8 -->'#$D#$A+
143 ' <supportedOS Id="{4a2f28e3-53b9-4441-ba9c-d69d4a4a6e38}" />'#$D#$A+
144 ' <!-- Windows 8.1 -->'#$D#$A+
145 ' <supportedOS Id="{1f676c76-80e1-4239-95bb-83d0f6d0da78}" />'#$D#$A+
146 ' <!-- Windows 10 -->'#$D#$A+
147 ' <supportedOS Id="{8e0f7a12-bfb3-4fe8-b9a5-48fd50a15a9a}" />'#$D#$A+
148 ' </application>'#$D#$A+
149 ' </compatibility>'#$D#$A+
150 ' <asmv3:application xmlns:asmv3="urn:schemas-microsoft-com:asm.v3">'#$D#$A+
151 ' <asmv3:windowsSettings xmlns="http://schemas.microsoft.com/SMI/2005/WindowsSettings">'#$D#$A+
152 ' <dpiAware>%s</dpiAware>'#$D#$A+
153 ' </asmv3:windowsSettings>'#$D#$A+
154 ' <asmv3:windowsSettings xmlns="http://schemas.microsoft.com/SMI/2016/WindowsSettings">'#$D#$A+
155 ' %s'#$D#$A+
156 ' </asmv3:windowsSettings>'#$D#$A+
157 ' </asmv3:application>'#$D#$A+
158 '</assembly>';
159
StrToXPManifestDpiAwarenull160 function StrToXPManifestDpiAware(const s: string): TXPManifestDpiAware;
161 begin
162 for Result:=Low(TXPManifestDpiAware) to High(TXPManifestDpiAware) do
163 if CompareText(s,ManifestDpiAwareValues[Result])=0 then exit;
164 Result:=xmdaFalse;
165 end;
166
StrToXPManifestExecutionLevelnull167 function StrToXPManifestExecutionLevel(const s: string): TXPManifestExecutionLevel;
168 begin
169 for Result:=Low(TXPManifestExecutionLevel) to High(TXPManifestExecutionLevel) do
170 if CompareText(s,ExecutionLevelToStr[Result])=0 then exit;
171 Result:=xmelAsInvoker;
172 end;
173
174 procedure TProjectXPManifest.SetUseManifest(const AValue: boolean);
175 begin
176 if FUseManifest = AValue then exit;
177 FUseManifest := AValue;
178 Modified := True;
179 end;
180
181 procedure TProjectXPManifest.SetDpiAware(AValue: TXPManifestDpiAware);
182 begin
183 if FDpiAware = AValue then Exit;
184 FDpiAware := AValue;
185 Modified := True;
186 end;
187
188 procedure TProjectXPManifest.SetExecutionLevel(AValue: TXPManifestExecutionLevel);
189 begin
190 if FExecutionLevel = AValue then Exit;
191 FExecutionLevel := AValue;
192 Modified := True;
193 end;
194
195 procedure TProjectXPManifest.SetTextDesc(const AValue: string);
196 begin
197 if FTextDesc = AValue then Exit;
198 FTextDesc := AValue;
199 Modified := True;
200 end;
201
202 procedure TProjectXPManifest.SetTextName(const AValue: string);
203 begin
204 if FTextName = AValue then Exit;
205 FTextName := AValue;
206 Modified := True;
207 end;
208
209 procedure TProjectXPManifest.SetUIAccess(AValue: Boolean);
210 begin
211 if FUIAccess = AValue then Exit;
212 FUIAccess := AValue;
213 Modified := True;
214 end;
215
216 constructor TProjectXPManifest.Create;
217 begin
218 inherited Create;
219 FIsDefaultOption := True;
220 UseManifest := False;
221 DpiAware := xmdaFalse;
222 ExecutionLevel := xmelAsInvoker;
223 UIAccess := False;
224 TextName := DefaultXPManifestTextName;
225 TextDesc := DefaultXPManifestTextDesc;
226 end;
227
TProjectXPManifest.UpdateResourcesnull228 function TProjectXPManifest.UpdateResources(AResources: TAbstractProjectResources;
229 const MainFilename: string): Boolean;
230 var
231 Res: TGenericResource;
232 RName, RType: TResourceDesc;
233 ManifestFileData: String;
234 begin
235 Result := True;
236 if UseManifest then
237 begin
238 RType := TResourceDesc.Create(RT_MANIFEST);
239 RName := TResourceDesc.Create(1);
240 Res := TGenericResource.Create(RType, RName);
241 RType.Free; //no longer needed
242 RName.Free;
243 ManifestFileData := Format(sManifestFileData, [
244 TextName,
245 TextDesc,
246 ExecutionLevelToStr[ExecutionLevel],
247 BoolToStr(UIAccess, 'true', 'false'),
248 ManifestDpiAwareValues[DpiAware],
249 ManifestDpiAwarenessValues[DpiAware]]);
250 Res.RawData.Write(ManifestFileData[1], Length(ManifestFileData));
251 AResources.AddSystemResource(Res);
252 end;
253 end;
254
255 procedure TProjectXPManifest.WriteToProjectFile(AConfig: TObject;
256 const Path: String);
257 begin
258 TXMLConfig(AConfig).SetDeleteValue(Path+'General/UseXPManifest/Value', UseManifest, False);
259 TXMLConfig(AConfig).SetDeleteValue(Path+'General/XPManifest/DpiAware/Value', ManifestDpiAwareValues[DpiAware], ManifestDpiAwareValues[xmdaFalse]);
260 TXMLConfig(AConfig).SetDeleteValue(Path+'General/XPManifest/ExecutionLevel/Value', ExecutionLevelToStr[ExecutionLevel], ExecutionLevelToStr[xmelAsInvoker]);
261 TXMLConfig(AConfig).SetDeleteValue(Path+'General/XPManifest/UIAccess/Value', UIAccess, False);
262 TXMLConfig(AConfig).SetDeleteValue(Path+'General/XPManifest/TextName/Value', TextName, DefaultXPManifestTextName);
263 TXMLConfig(AConfig).SetDeleteValue(Path+'General/XPManifest/TextDesc/Value', TextDesc, DefaultXPManifestTextDesc);
264 end;
265
266 procedure TProjectXPManifest.ReadFromProjectFile(AConfig: TObject;
267 const Path: String);
268 var
269 Cfg: TXMLConfig;
270 begin
271 Cfg := TXMLConfig(AConfig);
272 UseManifest := Cfg.GetValue(Path+'General/UseXPManifest/Value', False);
273
274 //support prev values "True/False"
275 if Cfg.GetValue(Path+'Version/Value',0)<=9 then
276 begin
277 if Cfg.GetValue(Path+'General/XPManifest/DpiAware/Value', False) then
278 DpiAware := xmdaTrue
279 else
280 DpiAware := xmdaFalse;
281 end else
282 DpiAware := StrToXPManifestDpiAware(Cfg.GetValue(Path+'General/XPManifest/DpiAware/Value', ''));
283
284 if Cfg.GetValue(Path+'Version/Value',0)<=9 then
285 ExecutionLevel := TXPManifestExecutionLevel(Cfg.GetValue(Path+'General/XPManifest/ExecutionLevel/Value', 0))
286 else
287 ExecutionLevel := StrToXPManifestExecutionLevel(Cfg.GetValue(Path+'General/XPManifest/ExecutionLevel/Value', ''));
288
289 UIAccess := Cfg.GetValue(Path+'General/XPManifest/UIAccess/Value', False);
290 TextName := Cfg.GetValue(Path+'General/XPManifest/TextName/Value', TextName);
291 TextDesc := Cfg.GetValue(Path+'General/XPManifest/TextDesc/Value', TextDesc);
292 end;
293
294 initialization
295 RegisterProjectResource(TProjectXPManifest);
296
297 end.
298
299