/ide/w32manifest.pas
Pascal | 208 lines | 154 code | 20 blank | 34 comment | 6 complexity | 5d3e932ce54ca5a73b4428ce070fde9e MD5 | raw file
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., 59 Temple Place - Suite 330, Boston, MA 02111-1307, 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} 33unit W32Manifest; 34 35{$mode objfpc}{$H+} 36 37interface 38 39uses 40 Classes, SysUtils, FileUtil, Laz2_XMLCfg, LCLProc, Controls, Forms, 41 CodeToolManager, LazConf, LResources, 42 ProjectResourcesIntf, resource; 43 44type 45 TXPManifestExecutionLevel = ( 46 xmelAsInvoker, 47 xmelHighestAvailable, 48 xmelRequireAdministrator 49 ); 50 51 { TProjectXPManifest } 52 53 TProjectXPManifest = class(TAbstractProjectResource) 54 private 55 FExecutionLevel: TXPManifestExecutionLevel; 56 FIsDpiaAware: boolean; 57 FUIAccess: Boolean; 58 FUseManifest: boolean; 59 procedure SetDpiAware(const AValue: boolean); 60 procedure SetExecutionLevel(AValue: TXPManifestExecutionLevel); 61 procedure SetUIAccess(AValue: Boolean); 62 procedure SetUseManifest(const AValue: boolean); 63 public 64 constructor Create; override; 65 function UpdateResources(AResources: TAbstractProjectResources; const {%H-}MainFilename: string): Boolean; override; 66 procedure WriteToProjectFile(AConfig: {TXMLConfig}TObject; const Path: String); override; 67 procedure ReadFromProjectFile(AConfig: {TXMLConfig}TObject; const Path: String); override; 68 69 property UseManifest: boolean read FUseManifest write SetUseManifest; 70 property DpiAware: boolean read FIsDpiaAware write SetDpiAware; 71 property ExecutionLevel: TXPManifestExecutionLevel read FExecutionLevel write SetExecutionLevel; 72 property UIAccess: Boolean read FUIAccess write SetUIAccess; 73 end; 74 75const 76 ExecutionLevelToStr: array[TXPManifestExecutionLevel] of String = ( 77 'asInvoker', 78 'highestAvailable', 79 'requireAdministrator' 80 ); 81implementation 82 83const 84 sManifestFileDataStart: String = 85 '<?xml version="1.0" encoding="UTF-8" standalone="yes"?>'#$D#$A+ 86 '<assembly xmlns="urn:schemas-microsoft-com:asm.v1" manifestVersion="1.0">'#$D#$A+ 87 ' <assemblyIdentity version="1.0.0.0" processorArchitecture="*" name="CompanyName.ProductName.YourApp" type="win32"/>'#$D#$A+ 88 ' <description>Your application description here.</description>'#$D#$A+ 89 ' <dependency>'#$D#$A+ 90 ' <dependentAssembly>'#$D#$A+ 91 ' <assemblyIdentity type="win32" name="Microsoft.Windows.Common-Controls" version="6.0.0.0" processorArchitecture="*" publicKeyToken="6595b64144ccf1df" language="*"/>'#$D#$A+ 92 ' </dependentAssembly>'#$D#$A+ 93 ' </dependency>'#$D#$A+ 94 ' <trustInfo xmlns="urn:schemas-microsoft-com:asm.v3">'#$D#$A+ 95 ' <security>'#$D#$A+ 96 ' <requestedPrivileges>'#$D#$A+ 97 ' <requestedExecutionLevel level="%s" uiAccess="%s"/>'#$D#$A+ 98 ' </requestedPrivileges>'#$D#$A+ 99 ' </security>'#$D#$A+ 100 ' </trustInfo>'#$D#$A+ 101 ' <compatibility xmlns="urn:schemas-microsoft-com:compatibility.v1">'#$D#$A+ 102 ' <application>'#$D#$A+ 103 ' <!-- Windows Vista -->'#$D#$A+ 104 ' <supportedOS Id="{e2011457-1546-43c5-a5fe-008deee3d3f0}" />'#$D#$A+ 105 ' <!-- Windows 7 -->'#$D#$A+ 106 ' <supportedOS Id="{35138b9a-5d96-4fbd-8e2d-a2440225f93a}" />'#$D#$A+ 107 ' <!-- Windows 8 -->'#$D#$A+ 108 ' <supportedOS Id="{4a2f28e3-53b9-4441-ba9c-d69d4a4a6e38}" />'#$D#$A+ 109 ' <!-- Windows 8.1 -->'#$D#$A+ 110 ' <supportedOS Id="{1f676c76-80e1-4239-95bb-83d0f6d0da78}" />'#$D#$A+ 111 ' <!-- Windows 10 -->'#$D#$A+ 112 ' <supportedOS Id="{8e0f7a12-bfb3-4fe8-b9a5-48fd50a15a9a}" />'#$D#$A+ 113 ' </application>'#$D#$A+ 114 ' </compatibility>'#$D#$A; 115 sManifestFileDataEnd: String = 116 '</assembly>'; 117 sManifestFileDataDpiAware: String = 118 ' <asmv3:application xmlns:asmv3="urn:schemas-microsoft-com:asm.v3">'#$D#$A+ 119 ' <asmv3:windowsSettings xmlns="http://schemas.microsoft.com/SMI/2005/WindowsSettings">'#$D#$A+ 120 ' <dpiAware>true</dpiAware>'#$D#$A+ 121 ' </asmv3:windowsSettings>'#$D#$A+ 122 ' </asmv3:application>'#$D#$A; 123 124procedure TProjectXPManifest.SetUseManifest(const AValue: boolean); 125begin 126 if FUseManifest = AValue then exit; 127 FUseManifest := AValue; 128 Modified := True; 129end; 130 131procedure TProjectXPManifest.SetDpiAware(const AValue: boolean); 132begin 133 if FIsDpiaAware = AValue then exit; 134 FIsDpiaAware := AValue; 135 Modified := True; 136end; 137 138procedure TProjectXPManifest.SetExecutionLevel(AValue: TXPManifestExecutionLevel); 139begin 140 if FExecutionLevel = AValue then Exit; 141 FExecutionLevel := AValue; 142 Modified := True; 143end; 144 145procedure TProjectXPManifest.SetUIAccess(AValue: Boolean); 146begin 147 if FUIAccess = AValue then Exit; 148 FUIAccess := AValue; 149 Modified := True; 150end; 151 152constructor TProjectXPManifest.Create; 153begin 154 inherited Create; 155 FIsDefaultOption := True; 156 UseManifest := False; 157 DpiAware := False; 158 ExecutionLevel := xmelAsInvoker; 159 UIAccess := False; 160end; 161 162function TProjectXPManifest.UpdateResources(AResources: TAbstractProjectResources; 163 const MainFilename: string): Boolean; 164var 165 Res: TGenericResource; 166 RName, RType: TResourceDesc; 167 ManifestFileData: String; 168begin 169 Result := True; 170 if UseManifest then 171 begin 172 RType := TResourceDesc.Create(RT_MANIFEST); 173 RName := TResourceDesc.Create(1); 174 Res := TGenericResource.Create(RType, RName); 175 RType.Free; //no longer needed 176 RName.Free; 177 ManifestFileData := Format(sManifestFileDataStart, [ExecutionLevelToStr[ExecutionLevel], BoolToStr(UIAccess, 'true', 'false')]); 178 if DpiAware then 179 ManifestFileData := ManifestFileData + sManifestFileDataDpiAware; 180 ManifestFileData := ManifestFileData + sManifestFileDataEnd; 181 Res.RawData.Write(ManifestFileData[1], Length(ManifestFileData)); 182 AResources.AddSystemResource(Res); 183 end; 184end; 185 186procedure TProjectXPManifest.WriteToProjectFile(AConfig: TObject; 187 const Path: String); 188begin 189 TXMLConfig(AConfig).SetDeleteValue(Path+'General/UseXPManifest/Value', UseManifest, False); 190 TXMLConfig(AConfig).SetDeleteValue(Path+'General/XPManifest/DpiAware/Value', DpiAware, False); 191 TXMLConfig(AConfig).SetDeleteValue(Path+'General/XPManifest/ExecutionLevel/Value', Ord(ExecutionLevel), 0); 192 TXMLConfig(AConfig).SetDeleteValue(Path+'General/XPManifest/UIAccess/Value', UIAccess, False); 193end; 194 195procedure TProjectXPManifest.ReadFromProjectFile(AConfig: TObject; 196 const Path: String); 197begin 198 UseManifest := TXMLConfig(AConfig).GetValue(Path+'General/UseXPManifest/Value', False); 199 DpiAware := TXMLConfig(AConfig).GetValue(Path+'General/XPManifest/DpiAware/Value', False); 200 ExecutionLevel := TXPManifestExecutionLevel(TXMLConfig(AConfig).GetValue(Path+'General/XPManifest/ExecutionLevel/Value', 0)); 201 UIAccess := TXMLConfig(AConfig).GetValue(Path+'General/XPManifest/UIAccess/Value', False); 202end; 203 204initialization 205 RegisterProjectResource(TProjectXPManifest); 206 207end. 208