| 1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889909192939495969798991001011021031041051061071081091101111121131141151161171181191201211221231241251261271281291301311321331341351361371381391401411421431441451461471481491501511521531541551561571581591601611621631641651661671681691701711721731741751761771781791801811821831841851861871881891901911921931941951961971981992002012022032042052062072082092102112122132142152162172182192202212222232242252262272282292302312322332342352362372382392402412422432442452462472482492502512522532542552562572582592602612622632642652662672682692702712722732742752762772782792802812822832842852862872882892902912922932942952962972982993003013023033043053063073083093103113123133143153163173183193203213223233243253263273283293303313323333343353363373383393403413423433443453463473483493503513523533543553563573583593603613623633643653663673683693703713723733743753763773783793803813823833843853863873883893903913923933943953963973983994004014024034044054064074084094104114124134144154164174184194204214224234244254264274284294304314324334344354364374384394404414424434444454464474484494504514524534544554564574584594604614624634644654664674684694704714724734744754764774784794804814824834844854864874884894904914924934944954964974984995005015025035045055065075085095105115125135145155165175185195205215225235245255265275285295305315325335345355365375385395405415425435445455465475485495505515525535545555565575585595605615625635645655665675685695705715725735745755765775785795805815825835845855865875885895905915925935945955965975985996006016026036046056066076086096106116126136146156166176186196206216226236246256266276286296306316326336346356366376386396406416426436446456466476486496506516526536546556566576586596606616626636646656666676686696706716726736746756766776786796806816826836846856866876886896906916926936946956966976986997007017027037047057067077087097107117127137147157167177187197207217227237247257267277287297307317327337347357367377387397407417427437447457467477487497507517527537547557567577587597607617627637647657667677687697707717727737747757767777787797807817827837847857867877887897907917927937947957967977987998008018028038048058068078088098108118128138148158168178188198208218228238248258268278288298308318328338348358368378388398408418428438448458468478488498508518528538548558568578588598608618628638648658668678688698708718728738748758768778788798808818828838848858868878888898908918928938948958968978988999009019029039049059069079089099109119129139149159169179189199209219229239249259269279289299309319329339349359369379389399409419429439449459469479489499509519529539549559569579589599609619629639649659669679689699709719729739749759769779789799809819829839849859869879889899909919929939949959969979989991000100110021003100410051006100710081009101010111012101310141015101610171018101910201021102210231024102510261027102810291030103110321033103410351036103710381039104010411042104310441045104610471048104910501051105210531054105510561057105810591060106110621063106410651066106710681069107010711072107310741075107610771078107910801081108210831084108510861087108810891090109110921093109410951096109710981099110011011102110311041105110611071108110911101111111211131114111511161117 |
- unit Compiler.ExeUpdateFunc;
- {
- Inno Setup
- Copyright (C) 1997-2025 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 ReadSignatureAndChecksumFields64(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;
- function SeekToAndReadPEOptionalHeader(const F: TCustomFile;
- var OptHeader: TImageOptionalHeader; var OptHeaderOffset: Int64): Boolean;
- var
- Header: TImageFileHeader;
- begin
- Result := False;
- if SeekToPEHeader(F) then begin
- if (F.Read(Header, SizeOf(Header)) = SizeOf(Header)) and
- (Header.SizeOfOptionalHeader = SizeOf(OptHeader)) then begin
- OptHeaderOffset := F.Position;
- if F.Read(OptHeader, SizeOf(OptHeader)) = SizeOf(OptHeader) then
- if OptHeader.Magic = IMAGE_NT_OPTIONAL_HDR32_MAGIC then
- Result := True;
- end;
- end;
- end;
- function SeekToAndReadPEOptionalHeader64(const F: TCustomFile;
- var OptHeader: TImageOptionalHeader64; var OptHeaderOffset: Int64): Boolean;
- var
- Header: TImageFileHeader;
- begin
- Result := False;
- if SeekToPEHeader(F) then begin
- if (F.Read(Header, SizeOf(Header)) = SizeOf(Header)) and
- (Header.SizeOfOptionalHeader = SizeOf(OptHeader)) then begin
- OptHeaderOffset := F.Position;
- if F.Read(OptHeader, SizeOf(OptHeader)) = SizeOf(OptHeader) then
- if OptHeader.Magic = IMAGE_NT_OPTIONAL_HDR64_MAGIC then
- Result := True;
- 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 executable, False is returned. }
- var
- OptHeader: TImageOptionalHeader;
- OptHeaderOffset: Int64;
- begin
- Result := SeekToAndReadPEOptionalHeader(F, OptHeader, OptHeaderOffset);
- if Result then begin
- ASignatureAddress := OptHeader.DataDirectory[IMAGE_DIRECTORY_ENTRY_SECURITY].VirtualAddress;
- ASignatureSize := OptHeader.DataDirectory[IMAGE_DIRECTORY_ENTRY_SECURITY].Size;
- AChecksum := OptHeader.CheckSum;
- end;
- end;
- function ReadSignatureAndChecksumFields64(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+ executable, False is returned. }
- var
- OptHeader: TImageOptionalHeader64;
- OptHeaderOffset: Int64;
- begin
- Result := SeekToAndReadPEOptionalHeader64(F, OptHeader, OptHeaderOffset);
- if Result then begin
- ASignatureAddress := OptHeader.DataDirectory[IMAGE_DIRECTORY_ENTRY_SECURITY].VirtualAddress;
- ASignatureSize := OptHeader.DataDirectory[IMAGE_DIRECTORY_ENTRY_SECURITY].Size;
- AChecksum := OptHeader.CheckSum;
- 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 executable, False is returned. }
- var
- OptHeader: TImageOptionalHeader;
- OptHeaderOffset: Int64;
- begin
- Result := SeekToAndReadPEOptionalHeader(F, OptHeader, OptHeaderOffset);
- if Result then begin
- OptHeader.DataDirectory[IMAGE_DIRECTORY_ENTRY_SECURITY].VirtualAddress := ASignatureAddress;
- OptHeader.DataDirectory[IMAGE_DIRECTORY_ENTRY_SECURITY].Size := ASignatureSize;
- OptHeader.CheckSum := AChecksum;
- F.Seek(OptHeaderOffset);
- F.WriteBuffer(OptHeader, SizeOf(OptHeader));
- 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 Cardinal(P) and 3 <> 0 then
- Cardinal(P) := (Cardinal(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;
- Cardinal(EndP) := Cardinal(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(Cardinal(P), ValueLength);
- BumpToDWordBoundary(P);
- while Cardinal(P) < Cardinal(EndP) do begin
- Result := QueryValue(P, Path, Buf, BufLen);
- if Result then
- Exit;
- Inc(Cardinal(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(hModule: Cardinal; lpType, lpName: PAnsiChar; wLanguage: Word; lParam: Integer): BOOL; stdcall;
- begin
- PWord(lParam)^ := wLanguage;
- Result := False;
- end;
- function GetResourceLanguage(hModule: Cardinal; lpType, lpName: PChar; var wLanguage: Word): Boolean;
- begin
- wLanguage := 0;
- EnumResourceLanguages(hModule, lpType, lpName, @EnumLangsFunc, Integer(@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(DWORD(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 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.
|