mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-04-06 12:58:15 +02:00
336 lines
12 KiB
ObjectPascal
336 lines
12 KiB
ObjectPascal
{
|
|
/***************************************************************************
|
|
w32manifest.pas - Lazarus IDE unit
|
|
---------------------------------------
|
|
TProjectXPManifest is responsible for the inclusion of the
|
|
manifest in windows executables.
|
|
|
|
|
|
***************************************************************************/
|
|
|
|
***************************************************************************
|
|
* *
|
|
* This source is free software; you can redistribute it and/or modify *
|
|
* it under the terms of the GNU General Public License as published by *
|
|
* the Free Software Foundation; either version 2 of the License, or *
|
|
* (at your option) any later version. *
|
|
* *
|
|
* This code is distributed in the hope that it will be useful, but *
|
|
* WITHOUT ANY WARRANTY; without even the implied warranty of *
|
|
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU *
|
|
* General Public License for more details. *
|
|
* *
|
|
* A copy of the GNU General Public License is available on the World *
|
|
* Wide Web at <http://www.gnu.org/copyleft/gpl.html>. You can also *
|
|
* obtain it by writing to the Free Software Foundation, *
|
|
* Inc., 51 Franklin Street - Fifth Floor, Boston, MA 02110-1335, USA. *
|
|
* *
|
|
***************************************************************************
|
|
|
|
The manifest file is needed for windows XP themes.
|
|
The file is created in the directory, where the project exe is created.
|
|
}
|
|
unit W32Manifest;
|
|
|
|
{$mode objfpc}{$H+}
|
|
|
|
interface
|
|
|
|
uses
|
|
Classes, SysUtils, FileUtil, Laz2_XMLCfg, LCLProc, Controls, Forms,
|
|
CodeToolManager, LazConf, LResources,
|
|
ProjectResourcesIntf, resource;
|
|
|
|
const
|
|
DefaultXPManifestTextName = 'CompanyName.ProductName.AppName';
|
|
DefaultXPManifestTextDesc = 'Your application description.';
|
|
type
|
|
TXPManifestExecutionLevel = (
|
|
xmelAsInvoker,
|
|
xmelHighestAvailable,
|
|
xmelRequireAdministrator
|
|
);
|
|
|
|
TXPManifestDpiAware = (
|
|
xmdaFalse,
|
|
xmdaTrue,
|
|
xmdaPerMonitor,
|
|
xmdaTruePM,
|
|
xmdaPerMonitorV2
|
|
);
|
|
|
|
type
|
|
{ TProjectXPManifest }
|
|
|
|
TProjectXPManifest = class(TAbstractProjectResource)
|
|
private
|
|
FExecutionLevel: TXPManifestExecutionLevel;
|
|
FDpiAware: TXPManifestDpiAware;
|
|
FUIAccess: Boolean;
|
|
FUseManifest: boolean;
|
|
FLongPathAware: Boolean;
|
|
FAnsiUTF8 : Boolean;
|
|
FTextName: string;
|
|
FTextDesc: string;
|
|
procedure SetDpiAware(AValue: TXPManifestDpiAware);
|
|
procedure SetExecutionLevel(AValue: TXPManifestExecutionLevel);
|
|
procedure SetUIAccess(AValue: Boolean);
|
|
procedure SetUseManifest(const AValue: boolean);
|
|
procedure SetLongPathAware(AValue: Boolean);
|
|
procedure SetAnsiUTF8(AValue: Boolean);
|
|
procedure SetTextName(const AValue: string);
|
|
procedure SetTextDesc(const AValue: string);
|
|
public
|
|
constructor Create; override;
|
|
function UpdateResources(AResources: TAbstractProjectResources; const {%H-}MainFilename: string): Boolean; override;
|
|
procedure WriteToProjectFile(AConfig: {TXMLConfig}TObject; const Path: String); override;
|
|
procedure ReadFromProjectFile(AConfig: {TXMLConfig}TObject; const Path: String); override;
|
|
|
|
property UseManifest: boolean read FUseManifest write SetUseManifest;
|
|
property DpiAware: TXPManifestDpiAware read FDpiAware write SetDpiAware;
|
|
property ExecutionLevel: TXPManifestExecutionLevel read FExecutionLevel write SetExecutionLevel;
|
|
property UIAccess: Boolean read FUIAccess write SetUIAccess;
|
|
property LongPathAware: Boolean read FLongPathAware write SetLongPathAware;
|
|
property AnsiUTF8 : Boolean read FAnsiUTF8 write SetAnsiUTF8;
|
|
property TextName: string read FTextName write SetTextName;
|
|
property TextDesc: string read FTextDesc write SetTextDesc;
|
|
end;
|
|
|
|
const
|
|
ExecutionLevelToStr: array[TXPManifestExecutionLevel] of String = (
|
|
'asInvoker',
|
|
'highestAvailable',
|
|
'requireAdministrator'
|
|
);
|
|
|
|
ManifestDpiAwareValues: array[TXPManifestDpiAware] of string = (
|
|
'False',
|
|
'True',
|
|
'Per-monitor',
|
|
'True/PM',
|
|
'True/PM_V2'
|
|
);
|
|
|
|
ManifestDpiAwarenessValues: array[TXPManifestDpiAware] of string = (
|
|
'',
|
|
'',
|
|
'',
|
|
'',
|
|
'<dpiAwareness>PerMonitorV2, PerMonitor</dpiAwareness>'
|
|
);
|
|
|
|
ManifestActiveCodepageUtf8 : array [boolean] of string = (
|
|
'',
|
|
'<activeCodePage xmlns="http://schemas.microsoft.com/SMI/2019/WindowsSettings">UTF-8</activeCodePage>'
|
|
);
|
|
|
|
|
|
implementation
|
|
|
|
const
|
|
sManifestFileData: String =
|
|
'<?xml version="1.0" encoding="UTF-8" standalone="yes"?>'#$D#$A+
|
|
'<assembly xmlns="urn:schemas-microsoft-com:asm.v1" manifestVersion="1.0">'#$D#$A+
|
|
' <assemblyIdentity version="1.0.0.0" processorArchitecture="*" name="%s" type="win32"/>'#$D#$A+
|
|
' <description>%s</description>'#$D#$A+
|
|
' <dependency>'#$D#$A+
|
|
' <dependentAssembly>'#$D#$A+
|
|
' <assemblyIdentity type="win32" name="Microsoft.Windows.Common-Controls" version="6.0.0.0" processorArchitecture="*" publicKeyToken="6595b64144ccf1df" language="*"/>'#$D#$A+
|
|
' </dependentAssembly>'#$D#$A+
|
|
' </dependency>'#$D#$A+
|
|
' <trustInfo xmlns="urn:schemas-microsoft-com:asm.v3">'#$D#$A+
|
|
' <security>'#$D#$A+
|
|
' <requestedPrivileges>'#$D#$A+
|
|
' <requestedExecutionLevel level="%s" uiAccess="%s"/>'#$D#$A+
|
|
' </requestedPrivileges>'#$D#$A+
|
|
' </security>'#$D#$A+
|
|
' </trustInfo>'#$D#$A+
|
|
' <compatibility xmlns="urn:schemas-microsoft-com:compatibility.v1">'#$D#$A+
|
|
' <application>'#$D#$A+
|
|
' <!-- Windows Vista -->'#$D#$A+
|
|
' <supportedOS Id="{e2011457-1546-43c5-a5fe-008deee3d3f0}" />'#$D#$A+
|
|
' <!-- Windows 7 -->'#$D#$A+
|
|
' <supportedOS Id="{35138b9a-5d96-4fbd-8e2d-a2440225f93a}" />'#$D#$A+
|
|
' <!-- Windows 8 -->'#$D#$A+
|
|
' <supportedOS Id="{4a2f28e3-53b9-4441-ba9c-d69d4a4a6e38}" />'#$D#$A+
|
|
' <!-- Windows 8.1 -->'#$D#$A+
|
|
' <supportedOS Id="{1f676c76-80e1-4239-95bb-83d0f6d0da78}" />'#$D#$A+
|
|
' <!-- Windows 10 -->'#$D#$A+
|
|
' <supportedOS Id="{8e0f7a12-bfb3-4fe8-b9a5-48fd50a15a9a}" />'#$D#$A+
|
|
' </application>'#$D#$A+
|
|
' </compatibility>'#$D#$A+
|
|
' <asmv3:application xmlns:asmv3="urn:schemas-microsoft-com:asm.v3">'#$D#$A+
|
|
' <asmv3:windowsSettings xmlns="http://schemas.microsoft.com/SMI/2005/WindowsSettings">'#$D#$A+
|
|
' <dpiAware>%s</dpiAware>'#$D#$A+
|
|
' </asmv3:windowsSettings>'#$D#$A+
|
|
' <asmv3:windowsSettings xmlns="http://schemas.microsoft.com/SMI/2016/WindowsSettings">'#$D#$A+
|
|
' %s'#$D#$A+
|
|
' <longPathAware>%s</longPathAware>'#$D#$A+
|
|
' %s'#$D#$A+
|
|
' </asmv3:windowsSettings>'#$D#$A+
|
|
' </asmv3:application>'#$D#$A+
|
|
'</assembly>';
|
|
|
|
function StrToXPManifestDpiAware(const s: string): TXPManifestDpiAware;
|
|
begin
|
|
for Result:=Low(TXPManifestDpiAware) to High(TXPManifestDpiAware) do
|
|
if CompareText(s,ManifestDpiAwareValues[Result])=0 then exit;
|
|
Result:=xmdaFalse;
|
|
end;
|
|
|
|
function StrToXPManifestExecutionLevel(const s: string): TXPManifestExecutionLevel;
|
|
begin
|
|
for Result:=Low(TXPManifestExecutionLevel) to High(TXPManifestExecutionLevel) do
|
|
if CompareText(s,ExecutionLevelToStr[Result])=0 then exit;
|
|
Result:=xmelAsInvoker;
|
|
end;
|
|
|
|
procedure TProjectXPManifest.SetUseManifest(const AValue: boolean);
|
|
begin
|
|
if FUseManifest = AValue then exit;
|
|
FUseManifest := AValue;
|
|
Modified := True;
|
|
end;
|
|
|
|
procedure TProjectXPManifest.SetLongPathAware(AValue: Boolean);
|
|
begin
|
|
if FLongPathAware = AValue then exit;
|
|
FLongPathAware := AValue;
|
|
Modified := True;
|
|
end;
|
|
|
|
procedure TProjectXPManifest.SetAnsiUTF8(AValue: Boolean);
|
|
begin
|
|
if FAnsiUTF8 = AValue then exit;
|
|
FAnsiUTF8:= AValue;
|
|
Modified := True;
|
|
end;
|
|
|
|
procedure TProjectXPManifest.SetDpiAware(AValue: TXPManifestDpiAware);
|
|
begin
|
|
if FDpiAware = AValue then Exit;
|
|
FDpiAware := AValue;
|
|
Modified := True;
|
|
end;
|
|
|
|
procedure TProjectXPManifest.SetExecutionLevel(AValue: TXPManifestExecutionLevel);
|
|
begin
|
|
if FExecutionLevel = AValue then Exit;
|
|
FExecutionLevel := AValue;
|
|
Modified := True;
|
|
end;
|
|
|
|
procedure TProjectXPManifest.SetTextDesc(const AValue: string);
|
|
begin
|
|
if FTextDesc = AValue then Exit;
|
|
FTextDesc := AValue;
|
|
Modified := True;
|
|
end;
|
|
|
|
procedure TProjectXPManifest.SetTextName(const AValue: string);
|
|
begin
|
|
if FTextName = AValue then Exit;
|
|
FTextName := AValue;
|
|
Modified := True;
|
|
end;
|
|
|
|
procedure TProjectXPManifest.SetUIAccess(AValue: Boolean);
|
|
begin
|
|
if FUIAccess = AValue then Exit;
|
|
FUIAccess := AValue;
|
|
Modified := True;
|
|
end;
|
|
|
|
constructor TProjectXPManifest.Create;
|
|
begin
|
|
inherited Create;
|
|
FIsDefaultOption := True;
|
|
UseManifest := False;
|
|
DpiAware := xmdaFalse;
|
|
ExecutionLevel := xmelAsInvoker;
|
|
UIAccess := False;
|
|
LongPathAware := False;
|
|
AnsiUTF8 := False;
|
|
TextName := DefaultXPManifestTextName;
|
|
TextDesc := DefaultXPManifestTextDesc;
|
|
end;
|
|
|
|
function TProjectXPManifest.UpdateResources(AResources: TAbstractProjectResources;
|
|
const MainFilename: string): Boolean;
|
|
var
|
|
Res: TGenericResource;
|
|
RName, RType: TResourceDesc;
|
|
ManifestFileData: String;
|
|
begin
|
|
Result := True;
|
|
if UseManifest then
|
|
begin
|
|
RType := TResourceDesc.Create(RT_MANIFEST);
|
|
RName := TResourceDesc.Create(1);
|
|
Res := TGenericResource.Create(RType, RName);
|
|
RType.Free; //no longer needed
|
|
RName.Free;
|
|
ManifestFileData := Format(sManifestFileData, [
|
|
TextName,
|
|
TextDesc,
|
|
ExecutionLevelToStr[ExecutionLevel],
|
|
BoolToStr(UIAccess, 'true', 'false'),
|
|
ManifestDpiAwareValues[DpiAware],
|
|
ManifestDpiAwarenessValues[DpiAware],
|
|
BoolToStr(LongPathAware, 'true', 'false'),
|
|
ManifestActiveCodepageUtf8[FAnsiUTF8]
|
|
]);
|
|
Res.RawData.Write(ManifestFileData[1], Length(ManifestFileData));
|
|
AResources.AddSystemResource(Res);
|
|
end;
|
|
end;
|
|
|
|
procedure TProjectXPManifest.WriteToProjectFile(AConfig: TObject;
|
|
const Path: String);
|
|
begin
|
|
TXMLConfig(AConfig).SetDeleteValue(Path+'General/UseXPManifest/Value', UseManifest, False);
|
|
TXMLConfig(AConfig).SetDeleteValue(Path+'General/XPManifest/DpiAware/Value', ManifestDpiAwareValues[DpiAware], ManifestDpiAwareValues[xmdaFalse]);
|
|
TXMLConfig(AConfig).SetDeleteValue(Path+'General/XPManifest/ExecutionLevel/Value', ExecutionLevelToStr[ExecutionLevel], ExecutionLevelToStr[xmelAsInvoker]);
|
|
TXMLConfig(AConfig).SetDeleteValue(Path+'General/XPManifest/UIAccess/Value', UIAccess, False);
|
|
TXMLConfig(AConfig).SetDeleteValue(Path+'General/XPManifest/LongPathAware/Value', LongPathAware, False);
|
|
TXMLConfig(AConfig).SetDeleteValue(Path+'General/XPManifest/AnsiUTF8/Value', AnsiUTF8, False);
|
|
TXMLConfig(AConfig).SetDeleteValue(Path+'General/XPManifest/TextName/Value', TextName, DefaultXPManifestTextName);
|
|
TXMLConfig(AConfig).SetDeleteValue(Path+'General/XPManifest/TextDesc/Value', TextDesc, DefaultXPManifestTextDesc);
|
|
end;
|
|
|
|
procedure TProjectXPManifest.ReadFromProjectFile(AConfig: TObject;
|
|
const Path: String);
|
|
var
|
|
Cfg: TXMLConfig;
|
|
begin
|
|
Cfg := TXMLConfig(AConfig);
|
|
UseManifest := Cfg.GetValue(Path+'General/UseXPManifest/Value', False);
|
|
|
|
//support prev values "True/False"
|
|
if Cfg.GetValue(Path+'Version/Value',0)<=9 then
|
|
begin
|
|
if Cfg.GetValue(Path+'General/XPManifest/DpiAware/Value', False) then
|
|
DpiAware := xmdaTrue
|
|
else
|
|
DpiAware := xmdaFalse;
|
|
end else
|
|
DpiAware := StrToXPManifestDpiAware(Cfg.GetValue(Path+'General/XPManifest/DpiAware/Value', ''));
|
|
|
|
if Cfg.GetValue(Path+'Version/Value',0)<=9 then
|
|
ExecutionLevel := TXPManifestExecutionLevel(Cfg.GetValue(Path+'General/XPManifest/ExecutionLevel/Value', 0))
|
|
else
|
|
ExecutionLevel := StrToXPManifestExecutionLevel(Cfg.GetValue(Path+'General/XPManifest/ExecutionLevel/Value', ''));
|
|
|
|
UIAccess := Cfg.GetValue(Path+'General/XPManifest/UIAccess/Value', False);
|
|
LongPathAware := Cfg.GetValue(Path+'General/XPManifest/LongPathAware/Value', False);
|
|
AnsiUTF8 := Cfg.GetValue(Path+'General/XPManifest/AnsiUTF8/Value', False);
|
|
TextName := Cfg.GetValue(Path+'General/XPManifest/TextName/Value', TextName);
|
|
TextDesc := Cfg.GetValue(Path+'General/XPManifest/TextDesc/Value', TextDesc);
|
|
end;
|
|
|
|
initialization
|
|
RegisterProjectResource(TProjectXPManifest);
|
|
|
|
end.
|
|
|