| 123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107 |
- unit Compiler.ExeUpdateFunc;
- {
- Inno Setup
- Copyright (C) 1997-2026 Jordan Russell
- Portions by Martijn Laan
- For conditions of distribution and use, see LICENSE.TXT.
- PE header and resource update functions used by the compiler only
- }
- interface
- uses
- Windows, SysUtils, Shared.FileClass, Shared.VerInfoFunc, Shared.Struct;
- type
- TUpdateIconsAndStyleFile = (uisfSetup, uisfSetupCustomStyle, uisfSetupLdr);
- TUpdateIconsAndStyleOperation = (uisoIcoFileName, uisoWizardDarkStyle, uisoStyleFileName, uisoStyleFileNameDynamicDark, uisoDone);
- TOnUpdateIconsAndStyle = procedure(const Operation: TUpdateIconsAndStyleOperation) of object;
- EResUpdateError = class(Exception)
- private
- FErrorCode: DWORD;
- public
- property ErrorCode: DWORD read FErrorCode;
- end;
- function ReadSignatureAndChecksumFields(const F: TCustomFile;
- var ASignatureAddress, ASignatureSize, AChecksum: DWORD): Boolean;
- function SeekToResourceData(const F: TCustomFile; const ResType, ResId: Cardinal): Cardinal;
- function UpdateSignatureAndChecksumFields(const F: TCustomFile;
- const ASignatureAddress, ASignatureSize, AChecksum: DWORD): Boolean;
-
- procedure UpdateSetupPEHeaderFields(const F: TCustomFile;
- const IsTSAware, IsDEPCompatible, IsASLRCompatible: Boolean);
- procedure UpdateIconsAndStyle(const FileName: String; const Uisf: TUpdateIconsAndStyleFile; const IcoFileName: String;
- const WizardDarkStyle: TSetupWizardDarkStyle; const StyleFileName, StyleFileNameDynamicDark: String;
- const OnUpdateIconsAndStyle: TOnUpdateIconsAndStyle);
- procedure UpdateVersionInfo(const F: TCustomFile;
- const NewBinaryFileVersion, NewBinaryProductVersion: TFileVersionNumbers;
- const NewCompanyName, NewFileDescription, NewTextFileVersion, NewLegalCopyright,
- NewProductName, NewTextProductVersion, NewOriginalFileName: String;
- const SetFileVersionAndDescription: Boolean);
- procedure PreventCOMCTL32Sideloading(const F: TCustomFile);
- implementation
- uses
- Math,
- UnsignedFunc;
- const
- IMAGE_NT_SIGNATURE = $00004550;
- IMAGE_NT_OPTIONAL_HDR32_MAGIC = $10b;
- IMAGE_NT_OPTIONAL_HDR64_MAGIC = $20b;
- IMAGE_NUMBEROF_DIRECTORY_ENTRIES = 16;
- IMAGE_SIZEOF_SHORT_NAME = 8;
- IMAGE_DIRECTORY_ENTRY_RESOURCE = 2;
- IMAGE_DIRECTORY_ENTRY_SECURITY = 4;
- type
- PImageFileHeader = ^TImageFileHeader;
- TImageFileHeader = packed record
- Machine: Word;
- NumberOfSections: Word;
- TimeDateStamp: DWORD;
- PointerToSymbolTable: DWORD;
- NumberOfSymbols: DWORD;
- SizeOfOptionalHeader: Word;
- Characteristics: Word;
- end;
- PImageDataDirectory = ^TImageDataDirectory;
- TImageDataDirectory = record
- VirtualAddress: DWORD;
- Size: DWORD;
- end;
- TDataDirectory = packed array[0..IMAGE_NUMBEROF_DIRECTORY_ENTRIES-1] of TImageDataDirectory;
- PImageOptionalHeader = ^TImageOptionalHeader;
- TImageOptionalHeader = packed record
- { Standard fields. }
- Magic: Word;
- MajorLinkerVersion: Byte;
- MinorLinkerVersion: Byte;
- SizeOfCode: DWORD;
- SizeOfInitializedData: DWORD;
- SizeOfUninitializedData: DWORD;
- AddressOfEntryPoint: DWORD;
- BaseOfCode: DWORD;
- BaseOfData: DWORD;
- { NT additional fields. }
- ImageBase: DWORD;
- SectionAlignment: DWORD;
- FileAlignment: DWORD;
- MajorOperatingSystemVersion: Word;
- MinorOperatingSystemVersion: Word;
- MajorImageVersion: Word;
- MinorImageVersion: Word;
- MajorSubsystemVersion: Word;
- MinorSubsystemVersion: Word;
- Win32VersionValue: DWORD;
- SizeOfImage: DWORD;
- SizeOfHeaders: DWORD;
- CheckSum: DWORD;
- Subsystem: Word;
- DllCharacteristics: Word;
- SizeOfStackReserve: DWORD;
- SizeOfStackCommit: DWORD;
- SizeOfHeapReserve: DWORD;
- SizeOfHeapCommit: DWORD;
- LoaderFlags: DWORD;
- NumberOfRvaAndSizes: DWORD;
- DataDirectory: TDataDirectory;
- end;
- PImageOptionalHeader64 = ^TImageOptionalHeader64;
- TImageOptionalHeader64 = packed record
- { Standard fields. }
- Magic: Word;
- MajorLinkerVersion: Byte;
- MinorLinkerVersion: Byte;
- SizeOfCode: DWORD;
- SizeOfInitializedData: DWORD;
- SizeOfUninitializedData: DWORD;
- AddressOfEntryPoint: DWORD;
- BaseOfCode: DWORD;
- { NT additional fields. }
- ImageBase: Int64;
- SectionAlignment: DWORD;
- FileAlignment: DWORD;
- MajorOperatingSystemVersion: Word;
- MinorOperatingSystemVersion: Word;
- MajorImageVersion: Word;
- MinorImageVersion: Word;
- MajorSubsystemVersion: Word;
- MinorSubsystemVersion: Word;
- Win32VersionValue: DWORD;
- SizeOfImage: DWORD;
- SizeOfHeaders: DWORD;
- CheckSum: DWORD;
- Subsystem: Word;
- DllCharacteristics: Word;
- SizeOfStackReserve: Int64;
- SizeOfStackCommit: Int64;
- SizeOfHeapReserve: Int64;
- SizeOfHeapCommit: Int64;
- LoaderFlags: DWORD;
- NumberOfRvaAndSizes: DWORD;
- DataDirectory: TDataDirectory;
- end;
- TISHMisc = packed record
- case Integer of
- 0: (PhysicalAddress: DWORD);
- 1: (VirtualSize: DWORD);
- end;
- PImageSectionHeader = ^TImageSectionHeader;
- TImageSectionHeader = packed record
- Name: packed array[0..IMAGE_SIZEOF_SHORT_NAME-1] of Byte;
- Misc: TISHMisc;
- VirtualAddress: DWORD;
- SizeOfRawData: DWORD;
- PointerToRawData: DWORD;
- PointerToRelocations: DWORD;
- PointerToLinenumbers: DWORD;
- NumberOfRelocations: Word;
- NumberOfLinenumbers: Word;
- Characteristics: DWORD;
- end;
- TImageResourceDirectory = packed record
- Characteristics: DWORD;
- TimeDateStamp: DWORD;
- MajorVersion: Word;
- MinorVersion: Word;
- NumberOfNamedEntries: Word;
- NumberOfIdEntries: Word;
- end;
- TImageResourceDirectoryEntry = packed record
- Id: DWORD;
- Offset: DWORD;
- end;
- TImageResourceDataEntry = packed record
- OffsetToData: DWORD;
- Size: DWORD;
- CodePage: DWORD;
- Reserved: DWORD;
- end;
- procedure Error(const Msg: String);
- begin
- raise Exception.Create('Resource update error: ' + Msg);
- end;
- function SeekToPEHeader(const F: TCustomFile): Boolean;
- var
- DosHeader: packed record
- Sig: array[0..1] of AnsiChar;
- Other: array[0..57] of Byte;
- PEHeaderOffset: LongWord;
- end;
- Sig: DWORD;
- begin
- Result := False;
- F.Seek(0);
- if F.Read(DosHeader, SizeOf(DosHeader)) = SizeOf(DosHeader) then begin
- if (DosHeader.Sig[0] = 'M') and (DosHeader.Sig[1] = 'Z') and
- (DosHeader.PEHeaderOffset <> 0) then begin
- F.Seek(DosHeader.PEHeaderOffset);
- if F.Read(Sig, SizeOf(Sig)) = SizeOf(Sig) then
- if Sig = IMAGE_NT_SIGNATURE then
- Result := True;
- end;
- end;
- end;
- type
- TOptionalHeader = (ohNone, oh32, oh64);
- function SeekToAndReadPEOptionalHeader(const F: TCustomFile;
- var OptHeader32: TImageOptionalHeader; var OptHeader64: TImageOptionalHeader64;
- var OptHeaderOffset: Int64): TOptionalHeader;
- begin
- Result := ohNone;
- if SeekToPEHeader(F) then begin
- var Header: TImageFileHeader;
- if (F.Read(Header, SizeOf(Header)) = SizeOf(Header)) and
- ((Header.SizeOfOptionalHeader = SizeOf(OptHeader32)) or
- (Header.SizeOfOptionalHeader = SizeOf(OptHeader64))) then begin
- OptHeaderOffset := F.Position;
- if Header.SizeOfOptionalHeader = SizeOf(OptHeader32) then begin
- if (F.Read(OptHeader32, SizeOf(OptHeader32)) = SizeOf(OptHeader32)) and
- (OptHeader32.Magic = IMAGE_NT_OPTIONAL_HDR32_MAGIC) then
- Result := oh32;
- end else begin
- if (F.Read(OptHeader64, SizeOf(OptHeader64)) = SizeOf(OptHeader64)) and
- (OptHeader64.Magic = IMAGE_NT_OPTIONAL_HDR64_MAGIC) then
- Result := oh64;
- end;
- end;
- end;
- end;
- procedure FindResourceSection(const F: TCustomFile;
- var SectionVirtualAddr, SectionPhysOffset, SectionPhysSize: Cardinal);
- var
- EXESig: Word;
- PEHeaderOffset, PESig: Cardinal;
- PEHeader: TImageFileHeader;
- PEOptHeader: TImageOptionalHeader;
- PEOptHeader64: TImageOptionalHeader64;
- PESectionHeader: TImageSectionHeader;
- I: Integer;
- begin
- { Read DOS header }
- F.Seek(0);
- F.ReadBuffer(EXESig, SizeOf(EXESig));
- if EXESig <> $5A4D {'MZ'} then
- Error('File isn''t an EXE file (1)');
- F.Seek($3C);
- F.ReadBuffer(PEHeaderOffset, SizeOf(PEHeaderOffset));
- if PEHeaderOffset = 0 then
- Error('File isn''t a PE file (1)');
- { Read PE header & optional header }
- F.Seek(PEHeaderOffset);
- F.ReadBuffer(PESig, SizeOf(PESig));
- if PESig <> $00004550 {'PE'#0#0} then
- Error('File isn''t a PE file (2)');
- F.ReadBuffer(PEHeader, SizeOf(PEHeader));
- const PE32 = PEHeader.SizeOfOptionalHeader = SizeOf(PEOptHeader);
- const PE32Plus = PEHeader.SizeOfOptionalHeader = SizeOf(PEOptHeader64);
- if not PE32 and not PE32Plus then
- Error('File isn''t a PE file (3)');
- var DataDirectory: TDataDirectory;
- if PE32 then begin
- F.ReadBuffer(PEOptHeader, SizeOf(PEOptHeader));
- if PEOptHeader.Magic <> IMAGE_NT_OPTIONAL_HDR32_MAGIC then
- Error('File isn''t a PE file (4)');
- DataDirectory := PEOptHeader.DataDirectory;
- end else begin
- F.ReadBuffer(PEOptHeader64, SizeOf(PEOptHeader64));
- if PEOptHeader64.Magic <> IMAGE_NT_OPTIONAL_HDR64_MAGIC then
- Error('File isn''t a PE file (5)');
- DataDirectory := PEOptHeader64.DataDirectory;
- end;
- { Scan section headers for resource section }
- if (DataDirectory[IMAGE_DIRECTORY_ENTRY_RESOURCE].VirtualAddress = 0) or
- (DataDirectory[IMAGE_DIRECTORY_ENTRY_RESOURCE].Size = 0) then
- Error('No resources (1)');
- SectionVirtualAddr := DataDirectory[IMAGE_DIRECTORY_ENTRY_RESOURCE].VirtualAddress;
- SectionPhysOffset := 0;
- for I := 0 to PEHeader.NumberOfSections-1 do begin
- F.ReadBuffer(PESectionHeader, SizeOf(PESectionHeader));
- if (PESectionHeader.VirtualAddress = SectionVirtualAddr) and
- (PESectionHeader.SizeOfRawData <> 0) then begin
- SectionPhysOffset := PESectionHeader.PointerToRawData;
- SectionPhysSize := PESectionHeader.SizeOfRawData;
- Break;
- end;
- end;
- if SectionPhysOffset = 0 then
- Error('No resources (2)');
- end;
- function FindResOffset(const F: TCustomFile; const AnyId: Boolean;
- const Id: Cardinal; const FindSubdir: Boolean; var Offset: Cardinal): Boolean;
- var
- Dir: TImageResourceDirectory;
- Entry: TImageResourceDirectoryEntry;
- I: Integer;
- begin
- F.ReadBuffer(Dir, SizeOf(Dir));
- { Skip over named entries }
- for I := 0 to Dir.NumberOfNamedEntries-1 do
- F.ReadBuffer(Entry, SizeOf(Entry));
- { Now process ID entries }
- Result := False;
- for I := 0 to Dir.NumberOfIdEntries-1 do begin
- F.ReadBuffer(Entry, SizeOf(Entry));
- if (AnyId or (Entry.Id = Id)) and
- ((Entry.Offset and $80000000 <> 0) = FindSubdir) then begin
- Offset := Entry.Offset and $7FFFFFFF;
- Result := True;
- Break;
- end;
- end;
- end;
- function SeekToResourceData(const F: TCustomFile; const ResType, ResId: Cardinal): Cardinal;
- { Seeks to the specified resource's data, and returns its size. Raises an
- exception if the resource cannot be found. }
- var
- SectionVirtualAddr, SectionPhysOffset, SectionPhysSize, Ofs: Cardinal;
- DataEntry: TImageResourceDataEntry;
- begin
- FindResourceSection(F, SectionVirtualAddr, SectionPhysOffset, SectionPhysSize);
- { Scan the resource directory }
- F.Seek(SectionPhysOffset);
- if not FindResOffset(F, False, ResType, True, Ofs) then
- Error('Can''t find resource (1)');
- F.Seek(SectionPhysOffset + Ofs);
- if not FindResOffset(F, False, ResId, True, Ofs) then
- Error('Can''t find resource (2)');
- F.Seek(SectionPhysOffset + Ofs);
- if not FindResOffset(F, True, 0, False, Ofs) then
- Error('Can''t find resource (3).');
- F.Seek(SectionPhysOffset + Ofs);
- F.ReadBuffer(DataEntry, SizeOf(DataEntry));
- { Sanity check: DataEntry.OffsetToData is an RVA. It's technically possible
- for the RVA to point to a different section, but we don't support that. }
- if Cardinal(DataEntry.OffsetToData) < SectionVirtualAddr then
- Error('Invalid resource (1)');
- if Cardinal(DataEntry.OffsetToData - SectionVirtualAddr + DataEntry.Size) > SectionPhysSize then
- Error('Invalid resource (2)');
- { Seek to the resource }
- F.Seek(SectionPhysOffset + (DataEntry.OffsetToData - SectionVirtualAddr));
- Result := DataEntry.Size;
- end;
- function ReadSignatureAndChecksumFields(const F: TCustomFile;
- var ASignatureAddress, ASignatureSize, AChecksum: DWORD): Boolean;
- { Reads the signature and checksum fields in the specified file's header.
- If the file is not a valid PE32 or PE32+ executable, False is returned. }
- begin
- var OptHeader32: TImageOptionalHeader;
- var OptHeader64: TImageOptionalHeader64;
- var OptHeaderOffset: Int64;
- const OptHeader = SeekToAndReadPEOptionalHeader(F, OptHeader32, OptHeader64, OptHeaderOffset);
- Result := OptHeader <> ohNone;
- if Result then begin
- if OptHeader = oh32 then begin
- ASignatureAddress := OptHeader32.DataDirectory[IMAGE_DIRECTORY_ENTRY_SECURITY].VirtualAddress;
- ASignatureSize := OptHeader32.DataDirectory[IMAGE_DIRECTORY_ENTRY_SECURITY].Size;
- AChecksum := OptHeader32.CheckSum;
- end else begin
- ASignatureAddress := OptHeader64.DataDirectory[IMAGE_DIRECTORY_ENTRY_SECURITY].VirtualAddress;
- ASignatureSize := OptHeader64.DataDirectory[IMAGE_DIRECTORY_ENTRY_SECURITY].Size;
- AChecksum := OptHeader64.CheckSum;
- end;
- end;
- end;
- function UpdateSignatureAndChecksumFields(const F: TCustomFile;
- const ASignatureAddress, ASignatureSize, AChecksum: DWORD): Boolean;
- { Sets the signature and checksum fields in the specified file's header.
- If the file is not a valid PE32 or PE32+ executable, False is returned. }
- begin
- var OptHeader32: TImageOptionalHeader;
- var OptHeader64: TImageOptionalHeader64;
- var OptHeaderOffset: Int64;
- const OptHeader = SeekToAndReadPEOptionalHeader(F, OptHeader32, OptHeader64, OptHeaderOffset);
- Result := OptHeader <> ohNone;
- if Result then begin
- F.Seek(OptHeaderOffset);
- if OptHeader = oh32 then begin
- OptHeader32.DataDirectory[IMAGE_DIRECTORY_ENTRY_SECURITY].VirtualAddress := ASignatureAddress;
- OptHeader32.DataDirectory[IMAGE_DIRECTORY_ENTRY_SECURITY].Size := ASignatureSize;
- OptHeader32.CheckSum := AChecksum;
- F.WriteBuffer(OptHeader32, SizeOf(OptHeader32));
- end else begin
- OptHeader64.DataDirectory[IMAGE_DIRECTORY_ENTRY_SECURITY].VirtualAddress := ASignatureAddress;
- OptHeader64.DataDirectory[IMAGE_DIRECTORY_ENTRY_SECURITY].Size := ASignatureSize;
- OptHeader64.CheckSum := AChecksum;
- F.WriteBuffer(OptHeader64, SizeOf(OptHeader64));
- end;
- end;
- end;
- procedure UpdateSetupPEHeaderFields(const F: TCustomFile;
- const IsTSAware, IsDEPCompatible, IsASLRCompatible: Boolean);
- const
- IMAGE_DLLCHARACTERISTICS_HIGH_ENTROPY_VA = $0020;
- IMAGE_DLLCHARACTERISTICS_DYNAMIC_BASE = $0040;
- IMAGE_DLLCHARACTERISTICS_NX_COMPAT = $0100;
- IMAGE_DLLCHARACTERISTICS_TERMINAL_SERVER_AWARE = $8000;
- OffsetOfDllCharacteristics = $46; { Valid for both PE32 and PE32+ }
- var
- Header: TImageFileHeader;
- OptMagic, DllChars, OrigDllChars: Word;
- begin
- if SeekToPEHeader(F) then begin
- if (F.Read(Header, SizeOf(Header)) = SizeOf(Header)) then begin
- const PE32 = Header.SizeOfOptionalHeader = SizeOf(TImageOptionalHeader);
- const PE32Plus = Header.SizeOfOptionalHeader = SizeOf(TImageOptionalHeader64);
- if PE32 or PE32Plus then begin
- const Ofs = F.Position;
- if (F.Read(OptMagic, SizeOf(OptMagic)) = SizeOf(OptMagic)) and
- ((PE32 and (OptMagic = IMAGE_NT_OPTIONAL_HDR32_MAGIC)) or
- (PE32Plus and (OptMagic = IMAGE_NT_OPTIONAL_HDR64_MAGIC))) then begin
- { Update DllCharacteristics }
- F.Seek(Ofs + OffsetOfDllCharacteristics);
- if F.Read(DllChars, SizeOf(DllChars)) = SizeOf(DllChars) then begin
- OrigDllChars := DllChars;
- if IsTSAware then
- DllChars := DllChars or IMAGE_DLLCHARACTERISTICS_TERMINAL_SERVER_AWARE
- else
- DllChars := Word(DllChars and not IMAGE_DLLCHARACTERISTICS_TERMINAL_SERVER_AWARE);
- if IsDEPCompatible then
- DllChars := DllChars or IMAGE_DLLCHARACTERISTICS_NX_COMPAT
- else
- DllChars := Word(DllChars and not IMAGE_DLLCHARACTERISTICS_NX_COMPAT);
- var ASLRFlags: Word := IMAGE_DLLCHARACTERISTICS_DYNAMIC_BASE;
- if Header.Machine = IMAGE_FILE_MACHINE_AMD64 then
- ASLRFlags := ASLRFlags or IMAGE_DLLCHARACTERISTICS_HIGH_ENTROPY_VA;
- if IsASLRCompatible then
- DllChars := DllChars or ASLRFlags
- else
- DllChars := DllChars and not ASLRFlags;
- if DllChars <> OrigDllChars then begin
- F.Seek(Ofs + OffsetOfDllCharacteristics);
- F.WriteBuffer(DllChars, SizeOf(DllChars));
- end;
- Exit;
- end;
- end;
- end;
- end;
- end;
- raise Exception.Create('UpdateSetupPEHeaderFields failed');
- end;
- procedure ResUpdateError(const Msg: String; const ResourceName: String = ''; const ErrorCode: DWORD = ERROR_INVALID_DATA);
- begin
- var S: String;
- if ResourceName <> '' then
- S := Format('Resource %s update error: %s', [ResourceName, Msg])
- else
- S := Format('Resource update error: %s', [Msg]);
- const E = EResUpdateError.Create(S);
- E.FErrorCode := ErrorCode;
- raise E;
- end;
- procedure ResUpdateErrorWithLastError(const Msg: String; const ResourceName: String = '');
- begin
- const ErrorCode = GetLastError;
- ResUpdateError(Msg + ' (' + IntToStr(ErrorCode) + ')', ResourceName, ErrorCode);
- end;
- procedure UpdateVersionInfo(const F: TCustomFile;
- const NewBinaryFileVersion, NewBinaryProductVersion: TFileVersionNumbers;
- const NewCompanyName, NewFileDescription, NewTextFileVersion, NewLegalCopyright,
- NewProductName, NewTextProductVersion, NewOriginalFileName: String;
- const SetFileVersionAndDescription: Boolean);
- function WideStrsEqual(P1, P2: PWideChar): Boolean;
- function WideUpCase(C: WideChar): WideChar;
- begin
- Result := C;
- if (Result >= 'a') and (Result <= 'z') then
- Dec(Result, Ord('a') - Ord('A'));
- end;
- begin
- while True do begin
- if WideUpCase(P1^) <> WideUpCase(P2^) then begin
- Result := False;
- Exit;
- end;
- if P1^ = #0 then
- Break;
- Inc(P1);
- Inc(P2);
- end;
- Result := True;
- end;
- procedure BumpToDWordBoundary(var P: Pointer);
- begin
- if NativeUInt(P) and 3 <> 0 then
- NativeUInt(P) := (NativeUInt(P) or 3) + 1;
- end;
- function QueryValue(P: Pointer; Path: PWideChar; var Buf: Pointer;
- var BufLen: Cardinal): Boolean;
- var
- EndP: Pointer;
- ValueLength: Cardinal;
- begin
- Result := False;
- EndP := PByte(P) + PWord(P)^;
- Inc(PWord(P));
- ValueLength := PWord(P)^;
- Inc(PWord(P));
- Inc(PWord(P));
- if WideStrsEqual(PWideChar(P), Path) then begin
- Inc(PWideChar(P), lstrlenW(P) + 1);
- BumpToDWordBoundary(P);
- Inc(Path, lstrlenW(Path) + 1);
- if Path^ = #0 then begin
- { Found the requested value }
- Buf := P;
- BufLen := ValueLength;
- Result := True;
- end
- else begin
- { Handle children.
- Note: Like VerQueryValue, we always treat ValueLength as a byte count
- when looking for child nodes. Many resource compilers, including
- Borland's, wrongly set ValueLength to a *character* count on string
- nodes. But since we never try to query for a child of a string node,
- that doesn't matter here. }
- Inc(PByte(P), ValueLength);
- BumpToDWordBoundary(P);
- while PByte(P) < PByte(EndP) do begin
- Result := QueryValue(P, Path, Buf, BufLen);
- if Result then
- Exit;
- Inc(PByte(P), PWord(P)^);
- BumpToDWordBoundary(P);
- end;
- end;
- end;
- end;
- procedure ReplaceWithRealCopyrightSymbols(const Value: PWideChar);
- var
- Len, I, J: Integer;
- begin
- Len := lstrlenW(Value);
- for I := 0 to Len-3 do begin
- if (Value[I] = '(') and (Value[I+1] = 'C') and (Value[I+2] = ')') then begin
- Value[I] := WideChar($00A9);
- { Shift back two characters }
- for J := I+1 to Len-3 do
- Value[J] := Value[J+2];
- Value[Len-2] := ' ';
- Value[Len-1] := ' ';
- end;
- end;
- end;
- procedure UpdateStringValue(P: Pointer; const Path: PWideChar; NewValue: String);
- var
- Value: PWideChar;
- ValueLen: Cardinal;
- begin
- if not QueryValue(P, Path, Pointer(Value), ValueLen) then
- ResUpdateError('Unexpected version resource format (1)');
- Move(Pointer(NewValue)^, Value^, (Min(Length(NewValue), lstrlenW(Value)))*SizeOf(Char));
- ReplaceWithRealCopyrightSymbols(Value);
- end;
- procedure UpdateFixedFileInfo(P: Pointer; const Path: PWideChar;
- const NewFileVersion, NewProductVersion: TFileVersionNumbers;
- const SetFileVersion: Boolean);
- var
- FixedFileInfo: PVSFixedFileInfo;
- ValueLen: Cardinal;
- begin
- if not QueryValue(P, Path, Pointer(FixedFileInfo), ValueLen) then
- ResUpdateError('Unexpected version resource format (2)');
- if FixedFileInfo.dwSignature <> $FEEF04BD then
- ResUpdateError('Unexpected version resource format (3)');
- if SetFileVersion then begin
- FixedFileInfo.dwFileVersionLS := NewFileVersion.LS;
- FixedFileInfo.dwFileVersionMS := NewFileVersion.MS;
- end;
- FixedFileInfo.dwProductVersionLS := NewProductVersion.LS;
- FixedFileInfo.dwProductVersionMS := NewProductVersion.MS;
- end;
- var
- ResSize: Cardinal;
- VersRes: Pointer;
- begin
- { Locate the resource }
- ResSize := SeekToResourceData(F, Cardinal(RT_VERSION), 1);
- const ResOffset = F.Position;
- GetMem(VersRes, ResSize);
- try
- { Read the resource }
- F.ReadBuffer(VersRes^, ResSize);
- { Update the resource }
- UpdateStringValue(VersRes, 'VS_VERSION_INFO'#0'StringFileInfo'#0'000004b0'#0'CompanyName'#0, NewCompanyName);
- if SetFileVersionAndDescription then begin
- UpdateStringValue(VersRes, 'VS_VERSION_INFO'#0'StringFileInfo'#0'000004b0'#0'FileDescription'#0, NewFileDescription);
- UpdateStringValue(VersRes, 'VS_VERSION_INFO'#0'StringFileInfo'#0'000004b0'#0'FileVersion'#0, NewTextFileVersion);
- end;
- UpdateStringValue(VersRes, 'VS_VERSION_INFO'#0'StringFileInfo'#0'000004b0'#0'LegalCopyright'#0, NewLegalCopyright);
- UpdateStringValue(VersRes, 'VS_VERSION_INFO'#0'StringFileInfo'#0'000004b0'#0'ProductName'#0, NewProductName);
- UpdateStringValue(VersRes, 'VS_VERSION_INFO'#0'StringFileInfo'#0'000004b0'#0'OriginalFileName'#0, NewOriginalFileName);
- UpdateStringValue(VersRes, 'VS_VERSION_INFO'#0'StringFileInfo'#0'000004b0'#0'ProductVersion'#0, NewTextProductVersion);
- UpdateFixedFileInfo(VersRes, 'VS_VERSION_INFO'#0, NewBinaryFileVersion, NewBinaryProductVersion, SetFileVersionAndDescription);
- { Write the updated resource }
- F.Seek(ResOffset);
- F.WriteBuffer(VersRes^, ResSize);
- finally
- FreeMem(VersRes);
- end;
- end;
- function EnumLangsFunc(M: HMODULE; lpType, lpName: PAnsiChar; wLanguage: Word; lParam: IntPtr): BOOL; stdcall;
- begin
- PWord(lParam)^ := wLanguage;
- Result := False;
- end;
- function GetResourceLanguage(M: HMODULE; lpType, lpName: PChar; var wLanguage: Word): Boolean;
- begin
- wLanguage := 0;
- EnumResourceLanguages(M, lpType, lpName, @EnumLangsFunc, IntPtr(@wLanguage));
- Result := True;
- end;
- procedure UpdateIconsAndStyle(const FileName: String; const Uisf: TUpdateIconsAndStyleFile; const IcoFileName: String;
- const WizardDarkStyle: TSetupWizardDarkStyle; const StyleFileName, StyleFileNameDynamicDark: String;
- const OnUpdateIconsAndStyle: TOnUpdateIconsAndStyle);
- type
- PIcoItemHeader = ^TIcoItemHeader;
- TIcoItemHeader = packed record
- Width: Byte;
- Height: Byte;
- Colors: Byte;
- Reserved: Byte;
- Planes: Word;
- BitCount: Word;
- ImageSize: DWORD;
- end;
- PIcoItem = ^TIcoItem;
- TIcoItem = packed record
- Header: TIcoItemHeader;
- Offset: DWORD;
- end;
- PIcoHeader = ^TIcoHeader;
- TIcoHeader = packed record
- Reserved: Word;
- Typ: Word;
- ItemCount: Word;
- Items: array [0..MaxInt shr 4 - 1] of TIcoItem;
- end;
- PGroupIconDirItem = ^TGroupIconDirItem;
- TGroupIconDirItem = packed record
- Header: TIcoItemHeader;
- Id: Word;
- end;
- PGroupIconDir = ^TGroupIconDir;
- TGroupIconDir = packed record
- Reserved: Word;
- Typ: Word;
- ItemCount: Word;
- Items: array [0..MaxInt shr 4 - 1] of TGroupIconDirItem;
- end;
- procedure TriggerOnUpdateIconsAndStyle(const Operation: TUpdateIconsAndStyleOperation);
- begin
- if Assigned(OnUpdateIconsAndStyle) then
- OnUpdateIconsAndStyle(Operation);
- end;
- function LoadFileIntoMemory(const FileName: String; var P: Pointer): Cardinal;
- begin
- const F = TFile.Create(FileName, fdOpenExisting, faRead, fsRead);
- try
- const N = F.CappedSize;
- if Cardinal(N) > Cardinal($100000) then { sanity check }
- ResUpdateError('File is too large', '', ERROR_INVALID_PARAMETER);
- GetMem(P, N);
- F.ReadBuffer(P^, N);
- Result := N;
- finally
- F.Free;
- end;
- end;
- function IsValidIcon(P: Pointer; Size: Cardinal): Boolean;
- var
- ItemCount: Cardinal;
- begin
- Result := False;
- if Size < Cardinal(SizeOf(Word) * 3) then
- Exit;
- if (PChar(P)[0] = 'M') and (PChar(P)[1] = 'Z') then
- Exit;
- ItemCount := PIcoHeader(P).ItemCount;
- if Size < Cardinal((SizeOf(Word) * 3) + (ItemCount * SizeOf(TIcoItem))) then
- Exit;
- P := @PIcoHeader(P).Items;
- while ItemCount > Cardinal(0) do begin
- if (Cardinal(PIcoItem(P).Offset + PIcoItem(P).Header.ImageSize) < Cardinal(PIcoItem(P).Offset)) or
- (Cardinal(PIcoItem(P).Offset + PIcoItem(P).Header.ImageSize) > Cardinal(Size)) then
- Exit;
- Inc(PIcoItem(P));
- Dec(ItemCount);
- end;
- Result := True;
- end;
- function LoadResourcePointer(const M: HMODULE; const ResourceType, ResourceName: PChar;
- const WantSize: Boolean; out Size: DWORD): Pointer; overload;
- begin
- var R := FindResource(M, ResourceName, ResourceType);
- if R = 0 then
- ResUpdateErrorWithLastError('FindResource failed (1)', ResourceName);
- if WantSize then begin
- Size := SizeofResource(M, R);
- if Size = 0 then
- ResUpdateErrorWithLastError('SizeofResource failed (1)', ResourceName);
- end;
- var Res := LoadResource(M, R);
- if Res = 0 then
- ResUpdateErrorWithLastError('LoadResource failed (1)', ResourceName);
- Result := LockResource(Res);
- if Result = nil then
- ResUpdateErrorWithLastError('LockResource failed (1)', ResourceName);
- end;
- function LoadResourcePointer(const M: HMODULE; const ResourceType, ResourceName: PChar): Pointer; overload;
- begin
- var Dummy: DWORD;
- Result := LoadResourcePointer(M, ResourceType, ResourceName, False, Dummy);
- end;
- procedure DeleteResource(const H: THandle; const M: HMODULE; const ResourceType, ResourceName: PChar);
- var
- wLanguage: Word;
- begin
- if not GetResourceLanguage(M, ResourceType, ResourceName, wLanguage) then
- ResUpdateError('GetResourceLanguage failed (1)', ResourceName);
- if not UpdateResource(H, ResourceType, ResourceName, wLanguage, nil, 0) then
- ResUpdateErrorWithLastError('UpdateResource failed (1)', ResourceName);
- end;
- procedure RenameResource(const H: THandle; const M: HMODULE; const ResourceType, OldResourceName, NewResourceName: PChar);
- var
- Size: DWORD;
- P: Pointer;
- wLanguage: Word;
- begin
- { Load the resource }
- P := LoadResourcePointer(M, ResourceType, OldResourceName, True, Size);
- { Create a copy resource with the new name }
- if not GetResourceLanguage(M, ResourceType, OldResourceName, wLanguage) then
- ResUpdateError('GetResourceLanguage failed (2)', OldResourceName);
- if not UpdateResource(H, ResourceType, NewResourceName, wLanguage, P, Size) then
- ResUpdateErrorWithLastError('UpdateResource failed (2)', NewResourceName);
- { Delete the old resource }
- if not UpdateResource(H, ResourceType, OldResourceName, wLanguage, nil, 0) then
- ResUpdateErrorWithLastError('UpdateResource failed (3)', OldResourceName);
- end;
- function DeleteIcon(const H: THandle; const M: HMODULE; const ResourceName: PChar): PGroupIconDir;
- var
- GroupIconDir: PGroupIconDir;
- I: Integer;
- wLanguage: Word;
- begin
- { Load the group icon resource }
- GroupIconDir := LoadResourcePointer(M, RT_GROUP_ICON, ResourceName);
- { Delete the group icon resource }
- DeleteResource(H, M, RT_GROUP_ICON, ResourceName);
- { Delete the icon resources that belonged to the group }
- for I := 0 to GroupIconDir.ItemCount-1 do begin
- if not GetResourceLanguage(M, RT_ICON, MakeIntResource(GroupIconDir.Items[I].Id), wLanguage) then
- ResUpdateError('GetResourceLanguage failed (3)', ResourceName);
- if not UpdateResource(H, RT_ICON, MakeIntResource(GroupIconDir.Items[I].Id), wLanguage, nil, 0) then
- ResUpdateErrorWithLastError('UpdateResource failed (4)', ResourceName);
- end;
- Result := GroupIconDir;
- end;
- function DeleteIconIfExists(const H: THandle; const M: HMODULE; const ResourceName: PChar): PGroupIconDir;
- begin
- if FindResource(M, ResourceName, RT_GROUP_ICON) <> 0 then
- Result := DeleteIcon(H, M, ResourceName)
- else
- Result := nil;
- end;
- function RenameIconWithOverwrite(const H: THandle; const M: HMODULE; const OldResourceName, NewResourceName: PChar): PGroupIconDir;
- var
- GroupIconDir: PGroupIconDir;
- GroupIconDirSize: DWORD;
- wLanguage: Word;
- begin
- DeleteIconIfExists(H, M, NewResourceName);
- { Load the group icon resource }
- GroupIconDir := LoadResourcePointer(M, RT_GROUP_ICON, OldResourceName);
- GroupIconDirSize := Sizeof(Word)*3 + GroupIconDir.ItemCount*Sizeof(TGroupIconDirItem);
- { Create a copy group icon resource with the new name - existing icon resources will belong to
- it automatically }
- if not GetResourceLanguage(M, RT_GROUP_ICON, OldResourceName, wLanguage) then
- ResUpdateError('GetResourceLanguage failed (4)', OldResourceName);
- if not UpdateResource(H, RT_GROUP_ICON, NewResourceName, wLanguage, GroupIconDir, GroupIconDirSize) then
- ResUpdateErrorWithLastError('UpdateResource failed (5)', NewResourceName);
- { Delete the old group icon resource }
- if not UpdateResource(H, RT_GROUP_ICON, OldResourceName, wLanguage, nil, 0) then
- ResUpdateErrorWithLastError('UpdateResource failed (6)', OldResourceName);
- Result := GroupIconDir;
- end;
- function HandleBuiltinStyle(const M: HMODULE; const StyleFileName: String; var Vsf: Pointer; var VsfSize: Cardinal; const Dark: Boolean): Boolean;
- begin
- { Also see DeleteResource calls below }
- var StyleName: PChar := nil;
- if SameText(StyleFileName, 'builtin:polar') then begin
- if Dark then
- StyleName := 'WINDOWSPOLARDARK'
- else
- StyleName := 'WINDOWSPOLARLIGHT';
- end else if SameText(StyleFileName, 'builtin:windows11') then begin
- if Dark then
- StyleName := 'WINDOWSMODERNDARK'
- else
- StyleName := 'WINDOWSMODERNLIGHT';
- end else if SameText(StyleFileName, 'builtin:slate') then
- StyleName := 'SLATECLASSICO'
- else if SameText(StyleFileName, 'builtin:zircon') then
- StyleName := 'ZIRCON';
- Result := StyleName <> nil;
- if Result then
- Vsf := LoadResourcePointer(M, 'VCLSTYLE', StyleName, True, VsfSize)
- end;
- var
- H: THandle;
- M: HMODULE;
- OldGroupIconDir, NewGroupIconDir: PGroupIconDir;
- I: Integer;
- begin
- var Ico: PIcoHeader := nil;
- var Vsf := nil;
- var ShouldFreeVsf := False;
- var VsfDynamicDark := nil;
- var ShouldFreeVsfDynamicDark := False;
- try
- if IcoFileName <> '' then begin
- TriggerOnUpdateIconsAndStyle(uisoIcoFileName);
- { Load the icons }
- var P: Pointer;
- const IcoSize = LoadFileIntoMemory(IcoFileName, P);
- Ico := P;
- { Ensure the icon is valid }
- if not IsValidIcon(Ico, IcoSize) then
- ResUpdateError('Icon file is invalid', '', ERROR_INVALID_PARAMETER);
- end;
- { Update the resources }
- var ChangedMainIcon := False;
- H := BeginUpdateResource(PChar(FileName), False);
- if H = 0 then
- ResUpdateErrorWithLastError('BeginUpdateResource failed (1)');
- try
- M := LoadLibraryEx(PChar(FileName), 0, LOAD_LIBRARY_AS_DATAFILE);
- if M = 0 then
- ResUpdateErrorWithLastError('LoadLibraryEx failed (1)');
- try
- { Load the styles. Could be checked using TStyleManager.IsValidStyle but that requires using VCL units. }
- var VsfSize: Cardinal := 0;
- if StyleFileName <> '' then begin
- TriggerOnUpdateIconsAndStyle(uisoStyleFileName);
- if not HandleBuiltinStyle(M, StyleFileName, Vsf, VsfSize, WizardDarkStyle = wdsDark) then begin
- VsfSize := LoadFileIntoMemory(StyleFileName, Vsf);
- ShouldFreeVsf := True;
- end;
- end;
- var VsfSizeDynamicDark: Cardinal := 0;
- if StyleFileNameDynamicDark <> '' then begin
- TriggerOnUpdateIconsAndStyle(uisoStyleFileNameDynamicDark);
- if not HandleBuiltinStyle(M, StyleFileNameDynamicDark, VsfDynamicDark, VsfSizeDynamicDark, True) then begin
- VsfSizeDynamicDark := LoadFileIntoMemory(StyleFileNameDynamicDark, VsfDynamicDark);
- ShouldFreeVsfDynamicDark := True;
- end;
- end;
- { All of the following changes must be independent because updates are not immediate. For
- example, if you call DeleteIcon followed by FindResource then resource will still be found,
- until you call EndUpdateResource *and* reload the file using LoadLibrary }
- if IcoFileName <> '' then begin
- TriggerOnUpdateIconsAndStyle(uisoIcoFileName);
- const ResourceName = 'MAINICON';
- { Delete default icons }
- OldGroupIconDir := DeleteIcon(H, M, PChar(ResourceName));
- DeleteIconIfExists(H, M, PChar(ResourceName + '_DARK'));
- { Build the new group icon resource }
- const NewGroupIconDirSize: DWORD = 3*SizeOf(Word)+Ico.ItemCount*SizeOf(TGroupIconDirItem);
- GetMem(NewGroupIconDir, NewGroupIconDirSize);
- try
- { Build the new group icon resource }
- NewGroupIconDir.Reserved := OldGroupIconDir.Reserved;
- NewGroupIconDir.Typ := OldGroupIconDir.Typ;
- NewGroupIconDir.ItemCount := Ico.ItemCount;
- for I := 0 to NewGroupIconDir.ItemCount-1 do begin
- NewGroupIconDir.Items[I].Header := Ico.Items[I].Header;
- const Id = I+100; //start at 100 to avoid overwriting other icons that may exist
- if Id > High(Word) then
- ResUpdateErrorWithLastError('UpdateResource failed (7)', ResourceName);
- NewGroupIconDir.Items[I].Id := Word(Id);
- end;
- { Update 'MAINICON' }
- for I := 0 to NewGroupIconDir.ItemCount-1 do
- if not UpdateResource(H, RT_ICON, MakeIntResource(NewGroupIconDir.Items[I].Id), 1033, Pointer(PByte(Ico) + Ico.Items[I].Offset), Ico.Items[I].Header.ImageSize) then
- ResUpdateErrorWithLastError('UpdateResource failed (8)', ResourceName);
- { Update the icons }
- if not UpdateResource(H, RT_GROUP_ICON, 'MAINICON', 1033, NewGroupIconDir, NewGroupIconDirSize) then
- ResUpdateErrorWithLastError('UpdateResource failed (9)', ResourceName);
- ChangedMainIcon := True;
- finally
- FreeMem(NewGroupIconDir);
- end;
- end else begin
- if WizardDarkStyle <> wdsDynamic then begin
- TriggerOnUpdateIconsAndStyle(uisoWizardDarkStyle);
- if WizardDarkStyle = wdsLight then begin
- { Forced light: remove dark main icon }
- DeleteIconIfExists(H, M, 'MAINICON_DARK')
- end else begin
- { Forced dark: rename dark main icon to be the regular main icon }
- RenameIconWithOverwrite(H, M, 'MAINICON_DARK', 'MAINICON');
- ChangedMainIcon := True;
- end;
- end; { Else keep both main icons }
- end;
- if Uisf in [uisfSetup, uisfSetupCustomStyle] then begin
- const DeleteUninstallIcon = IcoFileName <> '';
- if DeleteUninstallIcon then begin
- TriggerOnUpdateIconsAndStyle(uisoIcoFileName);
- { Make UninstallProgressForm use the custom icon }
- DeleteIcon(H, M, 'Z_UNINSTALLICON');
- DeleteIconIfExists(H, M, 'Z_UNINSTALLICON_DARK');
- end;
- if WizardDarkStyle <> wdsDynamic then begin
- TriggerOnUpdateIconsAndStyle(uisoWizardDarkStyle);
- { Unlike for MAINICON (for which we don't have the choice) here it always uses DeleteIcon
- instead of also using RenameIcon, to avoid issues with Windows' icon cache }
- var Postfix := '';
- if WizardDarkStyle = wdsLight then
- Postfix := '_DARK';
- { Delete the icons we don't need: either the light ones or the dark ones }
- DeleteIconIfExists(H, M, PChar('Z_GROUPICON' + Postfix));
- if not DeleteUninstallIcon then
- DeleteIconIfExists(H, M, PChar('Z_UNINSTALLICON' + Postfix));
- end;
- if Uisf = uisfSetupCustomStyle then begin
- if Vsf <> nil then begin
- TriggerOnUpdateIconsAndStyle(uisoStyleFileName);
- { Add the regular custom style, used by forced light, forced dark and dynamic light }
- if not UpdateResource(H, 'VCLSTYLE', 'MYSTYLE1', 1033, Vsf, VsfSize) then
- ResUpdateErrorWithLastError('UpdateResource failed (10)', 'MYSTYLE1');
- end;
- if VsfDynamicDark <> nil then begin
- TriggerOnUpdateIconsAndStyle(uisoStyleFileNameDynamicDark);
- { Add the dark custom style, used by dynamic dark only }
- if not UpdateResource(H, 'VCLSTYLE', 'MYSTYLE1_DARK', 1033, VsfDynamicDark, VsfSizeDynamicDark) then
- ResUpdateErrorWithLastError('UpdateResource failed (11)', 'MYSTYLE1_DARK');
- end;
- { See if we need to keep the built-in dark style }
- if (Vsf = nil) and (WizardDarkStyle = wdsDark) then begin
- TriggerOnUpdateIconsAndStyle(uisoWizardDarkStyle);
- { Forced dark without a custom style: make the built-in dark style the regular one }
- RenameResource(H, M, 'VCLSTYLE', 'WINDOWSMODERNDARK', 'MYSTYLE1');
- end else if (VsfDynamicDark = nil) and (WizardDarkStyle = wdsDynamic) then begin
- TriggerOnUpdateIconsAndStyle(uisoWizardDarkStyle);
- { Dynamic without a custom dark style: make the built-in dark style the dark one }
- RenameResource(H, M, 'VCLSTYLE', 'WINDOWSMODERNDARK', 'MYSTYLE1_DARK');
- end else begin
- TriggerOnUpdateIconsAndStyle(uisoWizardDarkStyle);
- { Forced dark with a custom style: delete the built-in dark style
- Or, dynamic with a custom dark style: same
- Or, forced light with or without a custom style: same
- Note: forced light without a custom style doesn't actually use SetupCustomStyle.e32/64 at the moment so won't get here }
- DeleteResource(H, M, 'VCLSTYLE', 'WINDOWSMODERNDARK');
- end;
- { Delete additional styles - they are handled above }
- DeleteResource(H, M, 'VCLSTYLE', 'WINDOWSMODERNLIGHT');
- DeleteResource(H, M, 'VCLSTYLE', 'WINDOWSPOLARLIGHT');
- DeleteResource(H, M, 'VCLSTYLE', 'WINDOWSPOLARDARK');
- DeleteResource(H, M, 'VCLSTYLE', 'SLATECLASSICO');
- DeleteResource(H, M, 'VCLSTYLE', 'ZIRCON');
- end;
- end;
- TriggerOnUpdateIconsAndStyle(uisoDone);
- finally
- FreeLibrary(M);
- end;
- except
- EndUpdateResource(H, True); { discard changes }
- raise;
- end;
- if not EndUpdateResource(H, False) then
- if ChangedMainIcon then { Only allow errors (likely from faulty AV software) if the update actually is important }
- ResUpdateErrorWithLastError('EndUpdateResource failed, try excluding the Output folder from your antivirus software');
- finally
- if ShouldFreeVsfDynamicDark then
- FreeMem(VsfDynamicDark);
- if ShouldFreeVsf then
- FreeMem(Vsf);
- if Ico <> nil then
- FreeMem(Ico);
- end;
- end;
- { Replaces the entire comctl32 dependency section of the manifest with spaces, then inserts a
- comctl32 file entry before the other entries. Intended for SetupLdr only. Note: The exact number
- of spaces is calculated to allow seamless in-place editing. }
- procedure PreventCOMCTL32Sideloading(const F: TCustomFile);
- const
- DependencyStartTag: AnsiString = '<dependency>';
- DependencyEndTag: AnsiString = '</dependency>';
- FileStartTag: AnsiString = '<file name="';
- COMCTL32Entry: AnsiString = '<file name="comctl32.dll" loadFrom="%SystemRoot%\system32\" />'#13#10;
- var
- S: AnsiString;
- P,Q,R: Integer;
- begin
- { Read the manifest resource into a string }
- SetString(S, nil, SeekToResourceData(F, 24, 1));
- var Offset := F.Position;
- F.ReadBuffer(S[1], ULength(S));
- { Locate and update the <dependency> tag }
- P := Pos(DependencyStartTag, S);
- if P = 0 then
- ResUpdateError('<dependency> tag not found');
- Q := Pos(DependencyEndTag, S);
- if Q <= P then
- ResUpdateError('<dependency> end tag not found');
- Q := Q+Length(DependencyEndTag);
- if Length(COMCTL32Entry) > Q-P then
- ResUpdateError('<dependency> tag shorter than replacement');
- R := Pos(FileStartTag, S);
- if R <= Q then
- ResUpdateError('<dependency> end tag after <file>?');
- Inc(Offset, P-1);
- F.Seek(Offset);
- F.WriteAnsiString(AnsiString(Format('%*s', [Q-P-Length(COMCTL32Entry), ' '])));
- F.WriteAnsiString(AnsiString(Copy(S, Q, R-Q)));
- F.WriteAnsiString(COMCTL32Entry);
- end;
- end.
|