/ide/w32manifest.pas

http://github.com/graemeg/lazarus · 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. * This source is free software; you can redistribute it and/or modify *
  11. * it under the terms of the GNU General Public License as published by *
  12. * the Free Software Foundation; either version 2 of the License, or *
  13. * (at your option) any later version. *
  14. * *
  15. * This code is distributed in the hope that it will be useful, but *
  16. * WITHOUT ANY WARRANTY; without even the implied warranty of *
  17. * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU *
  18. * General Public License for more details. *
  19. * *
  20. * A copy of the GNU General Public License is available on the World *
  21. * Wide Web at <http://www.gnu.org/copyleft/gpl.html>. You can also *
  22. * obtain it by writing to the Free Software Foundation, *
  23. * Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *
  24. * *
  25. ***************************************************************************
  26. The manifest file is needed for windows XP themes.
  27. The file is created in the directory, where the project exe is created.
  28. }
  29. unit W32Manifest;
  30. {$mode objfpc}{$H+}
  31. interface
  32. uses
  33. Classes, SysUtils, FileUtil, Laz2_XMLCfg, LCLProc, Controls, Forms,
  34. CodeToolManager, LazConf, LResources,
  35. ProjectResourcesIntf, resource;
  36. type
  37. TXPManifestExecutionLevel = (
  38. xmelAsInvoker,
  39. xmelHighestAvailable,
  40. xmelRequireAdministrator
  41. );
  42. { TProjectXPManifest }
  43. TProjectXPManifest = class(TAbstractProjectResource)
  44. private
  45. FExecutionLevel: TXPManifestExecutionLevel;
  46. FIsDpiaAware: boolean;
  47. FUIAccess: Boolean;
  48. FUseManifest: boolean;
  49. procedure SetDpiAware(const AValue: boolean);
  50. procedure SetExecutionLevel(AValue: TXPManifestExecutionLevel);
  51. procedure SetUIAccess(AValue: Boolean);
  52. procedure SetUseManifest(const AValue: boolean);
  53. public
  54. constructor Create; override;
  55. function UpdateResources(AResources: TAbstractProjectResources; const {%H-}MainFilename: string): Boolean; override;
  56. procedure WriteToProjectFile(AConfig: {TXMLConfig}TObject; const Path: String); override;
  57. procedure ReadFromProjectFile(AConfig: {TXMLConfig}TObject; const Path: String); override;
  58. property UseManifest: boolean read FUseManifest write SetUseManifest;
  59. property DpiAware: boolean read FIsDpiaAware write SetDpiAware;
  60. property ExecutionLevel: TXPManifestExecutionLevel read FExecutionLevel write SetExecutionLevel;
  61. property UIAccess: Boolean read FUIAccess write SetUIAccess;
  62. end;
  63. const
  64. ExecutionLevelToStr: array[TXPManifestExecutionLevel] of String = (
  65. 'asInvoker',
  66. 'highestAvailable',
  67. 'requireAdministrator'
  68. );
  69. implementation
  70. const
  71. sManifestFileDataStart: String =
  72. '<?xml version="1.0" encoding="UTF-8" standalone="yes"?>'#$D#$A+
  73. '<assembly xmlns="urn:schemas-microsoft-com:asm.v1" manifestVersion="1.0">'#$D#$A+
  74. ' <assemblyIdentity version="1.0.0.0" processorArchitecture="*" name="CompanyName.ProductName.YourApp" type="win32"/>'#$D#$A+
  75. ' <description>Your application description here.</description>'#$D#$A+
  76. ' <dependency>'#$D#$A+
  77. ' <dependentAssembly>'#$D#$A+
  78. ' <assemblyIdentity type="win32" name="Microsoft.Windows.Common-Controls" version="6.0.0.0" processorArchitecture="*" publicKeyToken="6595b64144ccf1df" language="*"/>'#$D#$A+
  79. ' </dependentAssembly>'#$D#$A+
  80. ' </dependency>'#$D#$A+
  81. ' <trustInfo xmlns="urn:schemas-microsoft-com:asm.v3">'#$D#$A+
  82. ' <security>'#$D#$A+
  83. ' <requestedPrivileges>'#$D#$A+
  84. ' <requestedExecutionLevel level="%s" uiAccess="%s"/>'#$D#$A+
  85. ' </requestedPrivileges>'#$D#$A+
  86. ' </security>'#$D#$A+
  87. ' </trustInfo>'#$D#$A+
  88. ' <compatibility xmlns="urn:schemas-microsoft-com:compatibility.v1">'#$D#$A+
  89. ' <application>'#$D#$A+
  90. ' <!-- Windows Vista -->'#$D#$A+
  91. ' <supportedOS Id="{e2011457-1546-43c5-a5fe-008deee3d3f0}" />'#$D#$A+
  92. ' <!-- Windows 7 -->'#$D#$A+
  93. ' <supportedOS Id="{35138b9a-5d96-4fbd-8e2d-a2440225f93a}" />'#$D#$A+
  94. ' <!-- Windows 8 -->'#$D#$A+
  95. ' <supportedOS Id="{4a2f28e3-53b9-4441-ba9c-d69d4a4a6e38}" />'#$D#$A+
  96. ' <!-- Windows 8.1 -->'#$D#$A+
  97. ' <supportedOS Id="{1f676c76-80e1-4239-95bb-83d0f6d0da78}" />'#$D#$A+
  98. ' <!-- Windows 10 -->'#$D#$A+
  99. ' <supportedOS Id="{8e0f7a12-bfb3-4fe8-b9a5-48fd50a15a9a}" />'#$D#$A+
  100. ' </application>'#$D#$A+
  101. ' </compatibility>'#$D#$A;
  102. sManifestFileDataEnd: String =
  103. '</assembly>';
  104. sManifestFileDataDpiAware: String =
  105. ' <asmv3:application xmlns:asmv3="urn:schemas-microsoft-com:asm.v3">'#$D#$A+
  106. ' <asmv3:windowsSettings xmlns="http://schemas.microsoft.com/SMI/2005/WindowsSettings">'#$D#$A+
  107. ' <dpiAware>true</dpiAware>'#$D#$A+
  108. ' </asmv3:windowsSettings>'#$D#$A+
  109. ' </asmv3:application>'#$D#$A;
  110. procedure TProjectXPManifest.SetUseManifest(const AValue: boolean);
  111. begin
  112. if FUseManifest = AValue then exit;
  113. FUseManifest := AValue;
  114. Modified := True;
  115. end;
  116. procedure TProjectXPManifest.SetDpiAware(const AValue: boolean);
  117. begin
  118. if FIsDpiaAware = AValue then exit;
  119. FIsDpiaAware := AValue;
  120. Modified := True;
  121. end;
  122. procedure TProjectXPManifest.SetExecutionLevel(AValue: TXPManifestExecutionLevel);
  123. begin
  124. if FExecutionLevel = AValue then Exit;
  125. FExecutionLevel := AValue;
  126. Modified := True;
  127. end;
  128. procedure TProjectXPManifest.SetUIAccess(AValue: Boolean);
  129. begin
  130. if FUIAccess = AValue then Exit;
  131. FUIAccess := AValue;
  132. Modified := True;
  133. end;
  134. constructor TProjectXPManifest.Create;
  135. begin
  136. inherited Create;
  137. FIsDefaultOption := True;
  138. UseManifest := False;
  139. DpiAware := False;
  140. ExecutionLevel := xmelAsInvoker;
  141. UIAccess := False;
  142. end;
  143. function TProjectXPManifest.UpdateResources(AResources: TAbstractProjectResources;
  144. const MainFilename: string): Boolean;
  145. var
  146. Res: TGenericResource;
  147. RName, RType: TResourceDesc;
  148. ManifestFileData: String;
  149. begin
  150. Result := True;
  151. if UseManifest then
  152. begin
  153. RType := TResourceDesc.Create(RT_MANIFEST);
  154. RName := TResourceDesc.Create(1);
  155. Res := TGenericResource.Create(RType, RName);
  156. RType.Free; //no longer needed
  157. RName.Free;
  158. ManifestFileData := Format(sManifestFileDataStart, [ExecutionLevelToStr[ExecutionLevel], BoolToStr(UIAccess, 'true', 'false')]);
  159. if DpiAware then
  160. ManifestFileData := ManifestFileData + sManifestFileDataDpiAware;
  161. ManifestFileData := ManifestFileData + sManifestFileDataEnd;
  162. Res.RawData.Write(ManifestFileData[1], Length(ManifestFileData));
  163. AResources.AddSystemResource(Res);
  164. end;
  165. end;
  166. procedure TProjectXPManifest.WriteToProjectFile(AConfig: TObject;
  167. const Path: String);
  168. begin
  169. TXMLConfig(AConfig).SetDeleteValue(Path+'General/UseXPManifest/Value', UseManifest, False);
  170. TXMLConfig(AConfig).SetDeleteValue(Path+'General/XPManifest/DpiAware/Value', DpiAware, False);
  171. TXMLConfig(AConfig).SetDeleteValue(Path+'General/XPManifest/ExecutionLevel/Value', Ord(ExecutionLevel), 0);
  172. TXMLConfig(AConfig).SetDeleteValue(Path+'General/XPManifest/UIAccess/Value', UIAccess, False);
  173. end;
  174. procedure TProjectXPManifest.ReadFromProjectFile(AConfig: TObject;
  175. const Path: String);
  176. begin
  177. UseManifest := TXMLConfig(AConfig).GetValue(Path+'General/UseXPManifest/Value', False);
  178. DpiAware := TXMLConfig(AConfig).GetValue(Path+'General/XPManifest/DpiAware/Value', False);
  179. ExecutionLevel := TXPManifestExecutionLevel(TXMLConfig(AConfig).GetValue(Path+'General/XPManifest/ExecutionLevel/Value', 0));
  180. UIAccess := TXMLConfig(AConfig).GetValue(Path+'General/XPManifest/UIAccess/Value', False);
  181. end;
  182. initialization
  183. RegisterProjectResource(TProjectXPManifest);
  184. end.