Compiler.ExeUpdateFunc.pas 42 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107
  1. unit Compiler.ExeUpdateFunc;
  2. {
  3. Inno Setup
  4. Copyright (C) 1997-2026 Jordan Russell
  5. Portions by Martijn Laan
  6. For conditions of distribution and use, see LICENSE.TXT.
  7. PE header and resource update functions used by the compiler only
  8. }
  9. interface
  10. uses
  11. Windows, SysUtils, Shared.FileClass, Shared.VerInfoFunc, Shared.Struct;
  12. type
  13. TUpdateIconsAndStyleFile = (uisfSetup, uisfSetupCustomStyle, uisfSetupLdr);
  14. TUpdateIconsAndStyleOperation = (uisoIcoFileName, uisoWizardDarkStyle, uisoStyleFileName, uisoStyleFileNameDynamicDark, uisoDone);
  15. TOnUpdateIconsAndStyle = procedure(const Operation: TUpdateIconsAndStyleOperation) of object;
  16. EResUpdateError = class(Exception)
  17. private
  18. FErrorCode: DWORD;
  19. public
  20. property ErrorCode: DWORD read FErrorCode;
  21. end;
  22. function ReadSignatureAndChecksumFields(const F: TCustomFile;
  23. var ASignatureAddress, ASignatureSize, AChecksum: DWORD): Boolean;
  24. function SeekToResourceData(const F: TCustomFile; const ResType, ResId: Cardinal): Cardinal;
  25. function UpdateSignatureAndChecksumFields(const F: TCustomFile;
  26. const ASignatureAddress, ASignatureSize, AChecksum: DWORD): Boolean;
  27. procedure UpdateSetupPEHeaderFields(const F: TCustomFile;
  28. const IsTSAware, IsDEPCompatible, IsASLRCompatible: Boolean);
  29. procedure UpdateIconsAndStyle(const FileName: String; const Uisf: TUpdateIconsAndStyleFile; const IcoFileName: String;
  30. const WizardDarkStyle: TSetupWizardDarkStyle; const StyleFileName, StyleFileNameDynamicDark: String;
  31. const OnUpdateIconsAndStyle: TOnUpdateIconsAndStyle);
  32. procedure UpdateVersionInfo(const F: TCustomFile;
  33. const NewBinaryFileVersion, NewBinaryProductVersion: TFileVersionNumbers;
  34. const NewCompanyName, NewFileDescription, NewTextFileVersion, NewLegalCopyright,
  35. NewProductName, NewTextProductVersion, NewOriginalFileName: String;
  36. const SetFileVersionAndDescription: Boolean);
  37. procedure PreventCOMCTL32Sideloading(const F: TCustomFile);
  38. implementation
  39. uses
  40. Math,
  41. UnsignedFunc;
  42. const
  43. IMAGE_NT_SIGNATURE = $00004550;
  44. IMAGE_NT_OPTIONAL_HDR32_MAGIC = $10b;
  45. IMAGE_NT_OPTIONAL_HDR64_MAGIC = $20b;
  46. IMAGE_NUMBEROF_DIRECTORY_ENTRIES = 16;
  47. IMAGE_SIZEOF_SHORT_NAME = 8;
  48. IMAGE_DIRECTORY_ENTRY_RESOURCE = 2;
  49. IMAGE_DIRECTORY_ENTRY_SECURITY = 4;
  50. type
  51. PImageFileHeader = ^TImageFileHeader;
  52. TImageFileHeader = packed record
  53. Machine: Word;
  54. NumberOfSections: Word;
  55. TimeDateStamp: DWORD;
  56. PointerToSymbolTable: DWORD;
  57. NumberOfSymbols: DWORD;
  58. SizeOfOptionalHeader: Word;
  59. Characteristics: Word;
  60. end;
  61. PImageDataDirectory = ^TImageDataDirectory;
  62. TImageDataDirectory = record
  63. VirtualAddress: DWORD;
  64. Size: DWORD;
  65. end;
  66. TDataDirectory = packed array[0..IMAGE_NUMBEROF_DIRECTORY_ENTRIES-1] of TImageDataDirectory;
  67. PImageOptionalHeader = ^TImageOptionalHeader;
  68. TImageOptionalHeader = packed record
  69. { Standard fields. }
  70. Magic: Word;
  71. MajorLinkerVersion: Byte;
  72. MinorLinkerVersion: Byte;
  73. SizeOfCode: DWORD;
  74. SizeOfInitializedData: DWORD;
  75. SizeOfUninitializedData: DWORD;
  76. AddressOfEntryPoint: DWORD;
  77. BaseOfCode: DWORD;
  78. BaseOfData: DWORD;
  79. { NT additional fields. }
  80. ImageBase: DWORD;
  81. SectionAlignment: DWORD;
  82. FileAlignment: DWORD;
  83. MajorOperatingSystemVersion: Word;
  84. MinorOperatingSystemVersion: Word;
  85. MajorImageVersion: Word;
  86. MinorImageVersion: Word;
  87. MajorSubsystemVersion: Word;
  88. MinorSubsystemVersion: Word;
  89. Win32VersionValue: DWORD;
  90. SizeOfImage: DWORD;
  91. SizeOfHeaders: DWORD;
  92. CheckSum: DWORD;
  93. Subsystem: Word;
  94. DllCharacteristics: Word;
  95. SizeOfStackReserve: DWORD;
  96. SizeOfStackCommit: DWORD;
  97. SizeOfHeapReserve: DWORD;
  98. SizeOfHeapCommit: DWORD;
  99. LoaderFlags: DWORD;
  100. NumberOfRvaAndSizes: DWORD;
  101. DataDirectory: TDataDirectory;
  102. end;
  103. PImageOptionalHeader64 = ^TImageOptionalHeader64;
  104. TImageOptionalHeader64 = packed record
  105. { Standard fields. }
  106. Magic: Word;
  107. MajorLinkerVersion: Byte;
  108. MinorLinkerVersion: Byte;
  109. SizeOfCode: DWORD;
  110. SizeOfInitializedData: DWORD;
  111. SizeOfUninitializedData: DWORD;
  112. AddressOfEntryPoint: DWORD;
  113. BaseOfCode: DWORD;
  114. { NT additional fields. }
  115. ImageBase: Int64;
  116. SectionAlignment: DWORD;
  117. FileAlignment: DWORD;
  118. MajorOperatingSystemVersion: Word;
  119. MinorOperatingSystemVersion: Word;
  120. MajorImageVersion: Word;
  121. MinorImageVersion: Word;
  122. MajorSubsystemVersion: Word;
  123. MinorSubsystemVersion: Word;
  124. Win32VersionValue: DWORD;
  125. SizeOfImage: DWORD;
  126. SizeOfHeaders: DWORD;
  127. CheckSum: DWORD;
  128. Subsystem: Word;
  129. DllCharacteristics: Word;
  130. SizeOfStackReserve: Int64;
  131. SizeOfStackCommit: Int64;
  132. SizeOfHeapReserve: Int64;
  133. SizeOfHeapCommit: Int64;
  134. LoaderFlags: DWORD;
  135. NumberOfRvaAndSizes: DWORD;
  136. DataDirectory: TDataDirectory;
  137. end;
  138. TISHMisc = packed record
  139. case Integer of
  140. 0: (PhysicalAddress: DWORD);
  141. 1: (VirtualSize: DWORD);
  142. end;
  143. PImageSectionHeader = ^TImageSectionHeader;
  144. TImageSectionHeader = packed record
  145. Name: packed array[0..IMAGE_SIZEOF_SHORT_NAME-1] of Byte;
  146. Misc: TISHMisc;
  147. VirtualAddress: DWORD;
  148. SizeOfRawData: DWORD;
  149. PointerToRawData: DWORD;
  150. PointerToRelocations: DWORD;
  151. PointerToLinenumbers: DWORD;
  152. NumberOfRelocations: Word;
  153. NumberOfLinenumbers: Word;
  154. Characteristics: DWORD;
  155. end;
  156. TImageResourceDirectory = packed record
  157. Characteristics: DWORD;
  158. TimeDateStamp: DWORD;
  159. MajorVersion: Word;
  160. MinorVersion: Word;
  161. NumberOfNamedEntries: Word;
  162. NumberOfIdEntries: Word;
  163. end;
  164. TImageResourceDirectoryEntry = packed record
  165. Id: DWORD;
  166. Offset: DWORD;
  167. end;
  168. TImageResourceDataEntry = packed record
  169. OffsetToData: DWORD;
  170. Size: DWORD;
  171. CodePage: DWORD;
  172. Reserved: DWORD;
  173. end;
  174. procedure Error(const Msg: String);
  175. begin
  176. raise Exception.Create('Resource update error: ' + Msg);
  177. end;
  178. function SeekToPEHeader(const F: TCustomFile): Boolean;
  179. var
  180. DosHeader: packed record
  181. Sig: array[0..1] of AnsiChar;
  182. Other: array[0..57] of Byte;
  183. PEHeaderOffset: LongWord;
  184. end;
  185. Sig: DWORD;
  186. begin
  187. Result := False;
  188. F.Seek(0);
  189. if F.Read(DosHeader, SizeOf(DosHeader)) = SizeOf(DosHeader) then begin
  190. if (DosHeader.Sig[0] = 'M') and (DosHeader.Sig[1] = 'Z') and
  191. (DosHeader.PEHeaderOffset <> 0) then begin
  192. F.Seek(DosHeader.PEHeaderOffset);
  193. if F.Read(Sig, SizeOf(Sig)) = SizeOf(Sig) then
  194. if Sig = IMAGE_NT_SIGNATURE then
  195. Result := True;
  196. end;
  197. end;
  198. end;
  199. type
  200. TOptionalHeader = (ohNone, oh32, oh64);
  201. function SeekToAndReadPEOptionalHeader(const F: TCustomFile;
  202. var OptHeader32: TImageOptionalHeader; var OptHeader64: TImageOptionalHeader64;
  203. var OptHeaderOffset: Int64): TOptionalHeader;
  204. begin
  205. Result := ohNone;
  206. if SeekToPEHeader(F) then begin
  207. var Header: TImageFileHeader;
  208. if (F.Read(Header, SizeOf(Header)) = SizeOf(Header)) and
  209. ((Header.SizeOfOptionalHeader = SizeOf(OptHeader32)) or
  210. (Header.SizeOfOptionalHeader = SizeOf(OptHeader64))) then begin
  211. OptHeaderOffset := F.Position;
  212. if Header.SizeOfOptionalHeader = SizeOf(OptHeader32) then begin
  213. if (F.Read(OptHeader32, SizeOf(OptHeader32)) = SizeOf(OptHeader32)) and
  214. (OptHeader32.Magic = IMAGE_NT_OPTIONAL_HDR32_MAGIC) then
  215. Result := oh32;
  216. end else begin
  217. if (F.Read(OptHeader64, SizeOf(OptHeader64)) = SizeOf(OptHeader64)) and
  218. (OptHeader64.Magic = IMAGE_NT_OPTIONAL_HDR64_MAGIC) then
  219. Result := oh64;
  220. end;
  221. end;
  222. end;
  223. end;
  224. procedure FindResourceSection(const F: TCustomFile;
  225. var SectionVirtualAddr, SectionPhysOffset, SectionPhysSize: Cardinal);
  226. var
  227. EXESig: Word;
  228. PEHeaderOffset, PESig: Cardinal;
  229. PEHeader: TImageFileHeader;
  230. PEOptHeader: TImageOptionalHeader;
  231. PEOptHeader64: TImageOptionalHeader64;
  232. PESectionHeader: TImageSectionHeader;
  233. I: Integer;
  234. begin
  235. { Read DOS header }
  236. F.Seek(0);
  237. F.ReadBuffer(EXESig, SizeOf(EXESig));
  238. if EXESig <> $5A4D {'MZ'} then
  239. Error('File isn''t an EXE file (1)');
  240. F.Seek($3C);
  241. F.ReadBuffer(PEHeaderOffset, SizeOf(PEHeaderOffset));
  242. if PEHeaderOffset = 0 then
  243. Error('File isn''t a PE file (1)');
  244. { Read PE header & optional header }
  245. F.Seek(PEHeaderOffset);
  246. F.ReadBuffer(PESig, SizeOf(PESig));
  247. if PESig <> $00004550 {'PE'#0#0} then
  248. Error('File isn''t a PE file (2)');
  249. F.ReadBuffer(PEHeader, SizeOf(PEHeader));
  250. const PE32 = PEHeader.SizeOfOptionalHeader = SizeOf(PEOptHeader);
  251. const PE32Plus = PEHeader.SizeOfOptionalHeader = SizeOf(PEOptHeader64);
  252. if not PE32 and not PE32Plus then
  253. Error('File isn''t a PE file (3)');
  254. var DataDirectory: TDataDirectory;
  255. if PE32 then begin
  256. F.ReadBuffer(PEOptHeader, SizeOf(PEOptHeader));
  257. if PEOptHeader.Magic <> IMAGE_NT_OPTIONAL_HDR32_MAGIC then
  258. Error('File isn''t a PE file (4)');
  259. DataDirectory := PEOptHeader.DataDirectory;
  260. end else begin
  261. F.ReadBuffer(PEOptHeader64, SizeOf(PEOptHeader64));
  262. if PEOptHeader64.Magic <> IMAGE_NT_OPTIONAL_HDR64_MAGIC then
  263. Error('File isn''t a PE file (5)');
  264. DataDirectory := PEOptHeader64.DataDirectory;
  265. end;
  266. { Scan section headers for resource section }
  267. if (DataDirectory[IMAGE_DIRECTORY_ENTRY_RESOURCE].VirtualAddress = 0) or
  268. (DataDirectory[IMAGE_DIRECTORY_ENTRY_RESOURCE].Size = 0) then
  269. Error('No resources (1)');
  270. SectionVirtualAddr := DataDirectory[IMAGE_DIRECTORY_ENTRY_RESOURCE].VirtualAddress;
  271. SectionPhysOffset := 0;
  272. for I := 0 to PEHeader.NumberOfSections-1 do begin
  273. F.ReadBuffer(PESectionHeader, SizeOf(PESectionHeader));
  274. if (PESectionHeader.VirtualAddress = SectionVirtualAddr) and
  275. (PESectionHeader.SizeOfRawData <> 0) then begin
  276. SectionPhysOffset := PESectionHeader.PointerToRawData;
  277. SectionPhysSize := PESectionHeader.SizeOfRawData;
  278. Break;
  279. end;
  280. end;
  281. if SectionPhysOffset = 0 then
  282. Error('No resources (2)');
  283. end;
  284. function FindResOffset(const F: TCustomFile; const AnyId: Boolean;
  285. const Id: Cardinal; const FindSubdir: Boolean; var Offset: Cardinal): Boolean;
  286. var
  287. Dir: TImageResourceDirectory;
  288. Entry: TImageResourceDirectoryEntry;
  289. I: Integer;
  290. begin
  291. F.ReadBuffer(Dir, SizeOf(Dir));
  292. { Skip over named entries }
  293. for I := 0 to Dir.NumberOfNamedEntries-1 do
  294. F.ReadBuffer(Entry, SizeOf(Entry));
  295. { Now process ID entries }
  296. Result := False;
  297. for I := 0 to Dir.NumberOfIdEntries-1 do begin
  298. F.ReadBuffer(Entry, SizeOf(Entry));
  299. if (AnyId or (Entry.Id = Id)) and
  300. ((Entry.Offset and $80000000 <> 0) = FindSubdir) then begin
  301. Offset := Entry.Offset and $7FFFFFFF;
  302. Result := True;
  303. Break;
  304. end;
  305. end;
  306. end;
  307. function SeekToResourceData(const F: TCustomFile; const ResType, ResId: Cardinal): Cardinal;
  308. { Seeks to the specified resource's data, and returns its size. Raises an
  309. exception if the resource cannot be found. }
  310. var
  311. SectionVirtualAddr, SectionPhysOffset, SectionPhysSize, Ofs: Cardinal;
  312. DataEntry: TImageResourceDataEntry;
  313. begin
  314. FindResourceSection(F, SectionVirtualAddr, SectionPhysOffset, SectionPhysSize);
  315. { Scan the resource directory }
  316. F.Seek(SectionPhysOffset);
  317. if not FindResOffset(F, False, ResType, True, Ofs) then
  318. Error('Can''t find resource (1)');
  319. F.Seek(SectionPhysOffset + Ofs);
  320. if not FindResOffset(F, False, ResId, True, Ofs) then
  321. Error('Can''t find resource (2)');
  322. F.Seek(SectionPhysOffset + Ofs);
  323. if not FindResOffset(F, True, 0, False, Ofs) then
  324. Error('Can''t find resource (3).');
  325. F.Seek(SectionPhysOffset + Ofs);
  326. F.ReadBuffer(DataEntry, SizeOf(DataEntry));
  327. { Sanity check: DataEntry.OffsetToData is an RVA. It's technically possible
  328. for the RVA to point to a different section, but we don't support that. }
  329. if Cardinal(DataEntry.OffsetToData) < SectionVirtualAddr then
  330. Error('Invalid resource (1)');
  331. if Cardinal(DataEntry.OffsetToData - SectionVirtualAddr + DataEntry.Size) > SectionPhysSize then
  332. Error('Invalid resource (2)');
  333. { Seek to the resource }
  334. F.Seek(SectionPhysOffset + (DataEntry.OffsetToData - SectionVirtualAddr));
  335. Result := DataEntry.Size;
  336. end;
  337. function ReadSignatureAndChecksumFields(const F: TCustomFile;
  338. var ASignatureAddress, ASignatureSize, AChecksum: DWORD): Boolean;
  339. { Reads the signature and checksum fields in the specified file's header.
  340. If the file is not a valid PE32 or PE32+ executable, False is returned. }
  341. begin
  342. var OptHeader32: TImageOptionalHeader;
  343. var OptHeader64: TImageOptionalHeader64;
  344. var OptHeaderOffset: Int64;
  345. const OptHeader = SeekToAndReadPEOptionalHeader(F, OptHeader32, OptHeader64, OptHeaderOffset);
  346. Result := OptHeader <> ohNone;
  347. if Result then begin
  348. if OptHeader = oh32 then begin
  349. ASignatureAddress := OptHeader32.DataDirectory[IMAGE_DIRECTORY_ENTRY_SECURITY].VirtualAddress;
  350. ASignatureSize := OptHeader32.DataDirectory[IMAGE_DIRECTORY_ENTRY_SECURITY].Size;
  351. AChecksum := OptHeader32.CheckSum;
  352. end else begin
  353. ASignatureAddress := OptHeader64.DataDirectory[IMAGE_DIRECTORY_ENTRY_SECURITY].VirtualAddress;
  354. ASignatureSize := OptHeader64.DataDirectory[IMAGE_DIRECTORY_ENTRY_SECURITY].Size;
  355. AChecksum := OptHeader64.CheckSum;
  356. end;
  357. end;
  358. end;
  359. function UpdateSignatureAndChecksumFields(const F: TCustomFile;
  360. const ASignatureAddress, ASignatureSize, AChecksum: DWORD): Boolean;
  361. { Sets the signature and checksum fields in the specified file's header.
  362. If the file is not a valid PE32 or PE32+ executable, False is returned. }
  363. begin
  364. var OptHeader32: TImageOptionalHeader;
  365. var OptHeader64: TImageOptionalHeader64;
  366. var OptHeaderOffset: Int64;
  367. const OptHeader = SeekToAndReadPEOptionalHeader(F, OptHeader32, OptHeader64, OptHeaderOffset);
  368. Result := OptHeader <> ohNone;
  369. if Result then begin
  370. F.Seek(OptHeaderOffset);
  371. if OptHeader = oh32 then begin
  372. OptHeader32.DataDirectory[IMAGE_DIRECTORY_ENTRY_SECURITY].VirtualAddress := ASignatureAddress;
  373. OptHeader32.DataDirectory[IMAGE_DIRECTORY_ENTRY_SECURITY].Size := ASignatureSize;
  374. OptHeader32.CheckSum := AChecksum;
  375. F.WriteBuffer(OptHeader32, SizeOf(OptHeader32));
  376. end else begin
  377. OptHeader64.DataDirectory[IMAGE_DIRECTORY_ENTRY_SECURITY].VirtualAddress := ASignatureAddress;
  378. OptHeader64.DataDirectory[IMAGE_DIRECTORY_ENTRY_SECURITY].Size := ASignatureSize;
  379. OptHeader64.CheckSum := AChecksum;
  380. F.WriteBuffer(OptHeader64, SizeOf(OptHeader64));
  381. end;
  382. end;
  383. end;
  384. procedure UpdateSetupPEHeaderFields(const F: TCustomFile;
  385. const IsTSAware, IsDEPCompatible, IsASLRCompatible: Boolean);
  386. const
  387. IMAGE_DLLCHARACTERISTICS_HIGH_ENTROPY_VA = $0020;
  388. IMAGE_DLLCHARACTERISTICS_DYNAMIC_BASE = $0040;
  389. IMAGE_DLLCHARACTERISTICS_NX_COMPAT = $0100;
  390. IMAGE_DLLCHARACTERISTICS_TERMINAL_SERVER_AWARE = $8000;
  391. OffsetOfDllCharacteristics = $46; { Valid for both PE32 and PE32+ }
  392. var
  393. Header: TImageFileHeader;
  394. OptMagic, DllChars, OrigDllChars: Word;
  395. begin
  396. if SeekToPEHeader(F) then begin
  397. if (F.Read(Header, SizeOf(Header)) = SizeOf(Header)) then begin
  398. const PE32 = Header.SizeOfOptionalHeader = SizeOf(TImageOptionalHeader);
  399. const PE32Plus = Header.SizeOfOptionalHeader = SizeOf(TImageOptionalHeader64);
  400. if PE32 or PE32Plus then begin
  401. const Ofs = F.Position;
  402. if (F.Read(OptMagic, SizeOf(OptMagic)) = SizeOf(OptMagic)) and
  403. ((PE32 and (OptMagic = IMAGE_NT_OPTIONAL_HDR32_MAGIC)) or
  404. (PE32Plus and (OptMagic = IMAGE_NT_OPTIONAL_HDR64_MAGIC))) then begin
  405. { Update DllCharacteristics }
  406. F.Seek(Ofs + OffsetOfDllCharacteristics);
  407. if F.Read(DllChars, SizeOf(DllChars)) = SizeOf(DllChars) then begin
  408. OrigDllChars := DllChars;
  409. if IsTSAware then
  410. DllChars := DllChars or IMAGE_DLLCHARACTERISTICS_TERMINAL_SERVER_AWARE
  411. else
  412. DllChars := Word(DllChars and not IMAGE_DLLCHARACTERISTICS_TERMINAL_SERVER_AWARE);
  413. if IsDEPCompatible then
  414. DllChars := DllChars or IMAGE_DLLCHARACTERISTICS_NX_COMPAT
  415. else
  416. DllChars := Word(DllChars and not IMAGE_DLLCHARACTERISTICS_NX_COMPAT);
  417. var ASLRFlags: Word := IMAGE_DLLCHARACTERISTICS_DYNAMIC_BASE;
  418. if Header.Machine = IMAGE_FILE_MACHINE_AMD64 then
  419. ASLRFlags := ASLRFlags or IMAGE_DLLCHARACTERISTICS_HIGH_ENTROPY_VA;
  420. if IsASLRCompatible then
  421. DllChars := DllChars or ASLRFlags
  422. else
  423. DllChars := DllChars and not ASLRFlags;
  424. if DllChars <> OrigDllChars then begin
  425. F.Seek(Ofs + OffsetOfDllCharacteristics);
  426. F.WriteBuffer(DllChars, SizeOf(DllChars));
  427. end;
  428. Exit;
  429. end;
  430. end;
  431. end;
  432. end;
  433. end;
  434. raise Exception.Create('UpdateSetupPEHeaderFields failed');
  435. end;
  436. procedure ResUpdateError(const Msg: String; const ResourceName: String = ''; const ErrorCode: DWORD = ERROR_INVALID_DATA);
  437. begin
  438. var S: String;
  439. if ResourceName <> '' then
  440. S := Format('Resource %s update error: %s', [ResourceName, Msg])
  441. else
  442. S := Format('Resource update error: %s', [Msg]);
  443. const E = EResUpdateError.Create(S);
  444. E.FErrorCode := ErrorCode;
  445. raise E;
  446. end;
  447. procedure ResUpdateErrorWithLastError(const Msg: String; const ResourceName: String = '');
  448. begin
  449. const ErrorCode = GetLastError;
  450. ResUpdateError(Msg + ' (' + IntToStr(ErrorCode) + ')', ResourceName, ErrorCode);
  451. end;
  452. procedure UpdateVersionInfo(const F: TCustomFile;
  453. const NewBinaryFileVersion, NewBinaryProductVersion: TFileVersionNumbers;
  454. const NewCompanyName, NewFileDescription, NewTextFileVersion, NewLegalCopyright,
  455. NewProductName, NewTextProductVersion, NewOriginalFileName: String;
  456. const SetFileVersionAndDescription: Boolean);
  457. function WideStrsEqual(P1, P2: PWideChar): Boolean;
  458. function WideUpCase(C: WideChar): WideChar;
  459. begin
  460. Result := C;
  461. if (Result >= 'a') and (Result <= 'z') then
  462. Dec(Result, Ord('a') - Ord('A'));
  463. end;
  464. begin
  465. while True do begin
  466. if WideUpCase(P1^) <> WideUpCase(P2^) then begin
  467. Result := False;
  468. Exit;
  469. end;
  470. if P1^ = #0 then
  471. Break;
  472. Inc(P1);
  473. Inc(P2);
  474. end;
  475. Result := True;
  476. end;
  477. procedure BumpToDWordBoundary(var P: Pointer);
  478. begin
  479. if NativeUInt(P) and 3 <> 0 then
  480. NativeUInt(P) := (NativeUInt(P) or 3) + 1;
  481. end;
  482. function QueryValue(P: Pointer; Path: PWideChar; var Buf: Pointer;
  483. var BufLen: Cardinal): Boolean;
  484. var
  485. EndP: Pointer;
  486. ValueLength: Cardinal;
  487. begin
  488. Result := False;
  489. EndP := PByte(P) + PWord(P)^;
  490. Inc(PWord(P));
  491. ValueLength := PWord(P)^;
  492. Inc(PWord(P));
  493. Inc(PWord(P));
  494. if WideStrsEqual(PWideChar(P), Path) then begin
  495. Inc(PWideChar(P), lstrlenW(P) + 1);
  496. BumpToDWordBoundary(P);
  497. Inc(Path, lstrlenW(Path) + 1);
  498. if Path^ = #0 then begin
  499. { Found the requested value }
  500. Buf := P;
  501. BufLen := ValueLength;
  502. Result := True;
  503. end
  504. else begin
  505. { Handle children.
  506. Note: Like VerQueryValue, we always treat ValueLength as a byte count
  507. when looking for child nodes. Many resource compilers, including
  508. Borland's, wrongly set ValueLength to a *character* count on string
  509. nodes. But since we never try to query for a child of a string node,
  510. that doesn't matter here. }
  511. Inc(PByte(P), ValueLength);
  512. BumpToDWordBoundary(P);
  513. while PByte(P) < PByte(EndP) do begin
  514. Result := QueryValue(P, Path, Buf, BufLen);
  515. if Result then
  516. Exit;
  517. Inc(PByte(P), PWord(P)^);
  518. BumpToDWordBoundary(P);
  519. end;
  520. end;
  521. end;
  522. end;
  523. procedure ReplaceWithRealCopyrightSymbols(const Value: PWideChar);
  524. var
  525. Len, I, J: Integer;
  526. begin
  527. Len := lstrlenW(Value);
  528. for I := 0 to Len-3 do begin
  529. if (Value[I] = '(') and (Value[I+1] = 'C') and (Value[I+2] = ')') then begin
  530. Value[I] := WideChar($00A9);
  531. { Shift back two characters }
  532. for J := I+1 to Len-3 do
  533. Value[J] := Value[J+2];
  534. Value[Len-2] := ' ';
  535. Value[Len-1] := ' ';
  536. end;
  537. end;
  538. end;
  539. procedure UpdateStringValue(P: Pointer; const Path: PWideChar; NewValue: String);
  540. var
  541. Value: PWideChar;
  542. ValueLen: Cardinal;
  543. begin
  544. if not QueryValue(P, Path, Pointer(Value), ValueLen) then
  545. ResUpdateError('Unexpected version resource format (1)');
  546. Move(Pointer(NewValue)^, Value^, (Min(Length(NewValue), lstrlenW(Value)))*SizeOf(Char));
  547. ReplaceWithRealCopyrightSymbols(Value);
  548. end;
  549. procedure UpdateFixedFileInfo(P: Pointer; const Path: PWideChar;
  550. const NewFileVersion, NewProductVersion: TFileVersionNumbers;
  551. const SetFileVersion: Boolean);
  552. var
  553. FixedFileInfo: PVSFixedFileInfo;
  554. ValueLen: Cardinal;
  555. begin
  556. if not QueryValue(P, Path, Pointer(FixedFileInfo), ValueLen) then
  557. ResUpdateError('Unexpected version resource format (2)');
  558. if FixedFileInfo.dwSignature <> $FEEF04BD then
  559. ResUpdateError('Unexpected version resource format (3)');
  560. if SetFileVersion then begin
  561. FixedFileInfo.dwFileVersionLS := NewFileVersion.LS;
  562. FixedFileInfo.dwFileVersionMS := NewFileVersion.MS;
  563. end;
  564. FixedFileInfo.dwProductVersionLS := NewProductVersion.LS;
  565. FixedFileInfo.dwProductVersionMS := NewProductVersion.MS;
  566. end;
  567. var
  568. ResSize: Cardinal;
  569. VersRes: Pointer;
  570. begin
  571. { Locate the resource }
  572. ResSize := SeekToResourceData(F, Cardinal(RT_VERSION), 1);
  573. const ResOffset = F.Position;
  574. GetMem(VersRes, ResSize);
  575. try
  576. { Read the resource }
  577. F.ReadBuffer(VersRes^, ResSize);
  578. { Update the resource }
  579. UpdateStringValue(VersRes, 'VS_VERSION_INFO'#0'StringFileInfo'#0'000004b0'#0'CompanyName'#0, NewCompanyName);
  580. if SetFileVersionAndDescription then begin
  581. UpdateStringValue(VersRes, 'VS_VERSION_INFO'#0'StringFileInfo'#0'000004b0'#0'FileDescription'#0, NewFileDescription);
  582. UpdateStringValue(VersRes, 'VS_VERSION_INFO'#0'StringFileInfo'#0'000004b0'#0'FileVersion'#0, NewTextFileVersion);
  583. end;
  584. UpdateStringValue(VersRes, 'VS_VERSION_INFO'#0'StringFileInfo'#0'000004b0'#0'LegalCopyright'#0, NewLegalCopyright);
  585. UpdateStringValue(VersRes, 'VS_VERSION_INFO'#0'StringFileInfo'#0'000004b0'#0'ProductName'#0, NewProductName);
  586. UpdateStringValue(VersRes, 'VS_VERSION_INFO'#0'StringFileInfo'#0'000004b0'#0'OriginalFileName'#0, NewOriginalFileName);
  587. UpdateStringValue(VersRes, 'VS_VERSION_INFO'#0'StringFileInfo'#0'000004b0'#0'ProductVersion'#0, NewTextProductVersion);
  588. UpdateFixedFileInfo(VersRes, 'VS_VERSION_INFO'#0, NewBinaryFileVersion, NewBinaryProductVersion, SetFileVersionAndDescription);
  589. { Write the updated resource }
  590. F.Seek(ResOffset);
  591. F.WriteBuffer(VersRes^, ResSize);
  592. finally
  593. FreeMem(VersRes);
  594. end;
  595. end;
  596. function EnumLangsFunc(M: HMODULE; lpType, lpName: PAnsiChar; wLanguage: Word; lParam: IntPtr): BOOL; stdcall;
  597. begin
  598. PWord(lParam)^ := wLanguage;
  599. Result := False;
  600. end;
  601. function GetResourceLanguage(M: HMODULE; lpType, lpName: PChar; var wLanguage: Word): Boolean;
  602. begin
  603. wLanguage := 0;
  604. EnumResourceLanguages(M, lpType, lpName, @EnumLangsFunc, IntPtr(@wLanguage));
  605. Result := True;
  606. end;
  607. procedure UpdateIconsAndStyle(const FileName: String; const Uisf: TUpdateIconsAndStyleFile; const IcoFileName: String;
  608. const WizardDarkStyle: TSetupWizardDarkStyle; const StyleFileName, StyleFileNameDynamicDark: String;
  609. const OnUpdateIconsAndStyle: TOnUpdateIconsAndStyle);
  610. type
  611. PIcoItemHeader = ^TIcoItemHeader;
  612. TIcoItemHeader = packed record
  613. Width: Byte;
  614. Height: Byte;
  615. Colors: Byte;
  616. Reserved: Byte;
  617. Planes: Word;
  618. BitCount: Word;
  619. ImageSize: DWORD;
  620. end;
  621. PIcoItem = ^TIcoItem;
  622. TIcoItem = packed record
  623. Header: TIcoItemHeader;
  624. Offset: DWORD;
  625. end;
  626. PIcoHeader = ^TIcoHeader;
  627. TIcoHeader = packed record
  628. Reserved: Word;
  629. Typ: Word;
  630. ItemCount: Word;
  631. Items: array [0..MaxInt shr 4 - 1] of TIcoItem;
  632. end;
  633. PGroupIconDirItem = ^TGroupIconDirItem;
  634. TGroupIconDirItem = packed record
  635. Header: TIcoItemHeader;
  636. Id: Word;
  637. end;
  638. PGroupIconDir = ^TGroupIconDir;
  639. TGroupIconDir = packed record
  640. Reserved: Word;
  641. Typ: Word;
  642. ItemCount: Word;
  643. Items: array [0..MaxInt shr 4 - 1] of TGroupIconDirItem;
  644. end;
  645. procedure TriggerOnUpdateIconsAndStyle(const Operation: TUpdateIconsAndStyleOperation);
  646. begin
  647. if Assigned(OnUpdateIconsAndStyle) then
  648. OnUpdateIconsAndStyle(Operation);
  649. end;
  650. function LoadFileIntoMemory(const FileName: String; var P: Pointer): Cardinal;
  651. begin
  652. const F = TFile.Create(FileName, fdOpenExisting, faRead, fsRead);
  653. try
  654. const N = F.CappedSize;
  655. if Cardinal(N) > Cardinal($100000) then { sanity check }
  656. ResUpdateError('File is too large', '', ERROR_INVALID_PARAMETER);
  657. GetMem(P, N);
  658. F.ReadBuffer(P^, N);
  659. Result := N;
  660. finally
  661. F.Free;
  662. end;
  663. end;
  664. function IsValidIcon(P: Pointer; Size: Cardinal): Boolean;
  665. var
  666. ItemCount: Cardinal;
  667. begin
  668. Result := False;
  669. if Size < Cardinal(SizeOf(Word) * 3) then
  670. Exit;
  671. if (PChar(P)[0] = 'M') and (PChar(P)[1] = 'Z') then
  672. Exit;
  673. ItemCount := PIcoHeader(P).ItemCount;
  674. if Size < Cardinal((SizeOf(Word) * 3) + (ItemCount * SizeOf(TIcoItem))) then
  675. Exit;
  676. P := @PIcoHeader(P).Items;
  677. while ItemCount > Cardinal(0) do begin
  678. if (Cardinal(PIcoItem(P).Offset + PIcoItem(P).Header.ImageSize) < Cardinal(PIcoItem(P).Offset)) or
  679. (Cardinal(PIcoItem(P).Offset + PIcoItem(P).Header.ImageSize) > Cardinal(Size)) then
  680. Exit;
  681. Inc(PIcoItem(P));
  682. Dec(ItemCount);
  683. end;
  684. Result := True;
  685. end;
  686. function LoadResourcePointer(const M: HMODULE; const ResourceType, ResourceName: PChar;
  687. const WantSize: Boolean; out Size: DWORD): Pointer; overload;
  688. begin
  689. var R := FindResource(M, ResourceName, ResourceType);
  690. if R = 0 then
  691. ResUpdateErrorWithLastError('FindResource failed (1)', ResourceName);
  692. if WantSize then begin
  693. Size := SizeofResource(M, R);
  694. if Size = 0 then
  695. ResUpdateErrorWithLastError('SizeofResource failed (1)', ResourceName);
  696. end;
  697. var Res := LoadResource(M, R);
  698. if Res = 0 then
  699. ResUpdateErrorWithLastError('LoadResource failed (1)', ResourceName);
  700. Result := LockResource(Res);
  701. if Result = nil then
  702. ResUpdateErrorWithLastError('LockResource failed (1)', ResourceName);
  703. end;
  704. function LoadResourcePointer(const M: HMODULE; const ResourceType, ResourceName: PChar): Pointer; overload;
  705. begin
  706. var Dummy: DWORD;
  707. Result := LoadResourcePointer(M, ResourceType, ResourceName, False, Dummy);
  708. end;
  709. procedure DeleteResource(const H: THandle; const M: HMODULE; const ResourceType, ResourceName: PChar);
  710. var
  711. wLanguage: Word;
  712. begin
  713. if not GetResourceLanguage(M, ResourceType, ResourceName, wLanguage) then
  714. ResUpdateError('GetResourceLanguage failed (1)', ResourceName);
  715. if not UpdateResource(H, ResourceType, ResourceName, wLanguage, nil, 0) then
  716. ResUpdateErrorWithLastError('UpdateResource failed (1)', ResourceName);
  717. end;
  718. procedure RenameResource(const H: THandle; const M: HMODULE; const ResourceType, OldResourceName, NewResourceName: PChar);
  719. var
  720. Size: DWORD;
  721. P: Pointer;
  722. wLanguage: Word;
  723. begin
  724. { Load the resource }
  725. P := LoadResourcePointer(M, ResourceType, OldResourceName, True, Size);
  726. { Create a copy resource with the new name }
  727. if not GetResourceLanguage(M, ResourceType, OldResourceName, wLanguage) then
  728. ResUpdateError('GetResourceLanguage failed (2)', OldResourceName);
  729. if not UpdateResource(H, ResourceType, NewResourceName, wLanguage, P, Size) then
  730. ResUpdateErrorWithLastError('UpdateResource failed (2)', NewResourceName);
  731. { Delete the old resource }
  732. if not UpdateResource(H, ResourceType, OldResourceName, wLanguage, nil, 0) then
  733. ResUpdateErrorWithLastError('UpdateResource failed (3)', OldResourceName);
  734. end;
  735. function DeleteIcon(const H: THandle; const M: HMODULE; const ResourceName: PChar): PGroupIconDir;
  736. var
  737. GroupIconDir: PGroupIconDir;
  738. I: Integer;
  739. wLanguage: Word;
  740. begin
  741. { Load the group icon resource }
  742. GroupIconDir := LoadResourcePointer(M, RT_GROUP_ICON, ResourceName);
  743. { Delete the group icon resource }
  744. DeleteResource(H, M, RT_GROUP_ICON, ResourceName);
  745. { Delete the icon resources that belonged to the group }
  746. for I := 0 to GroupIconDir.ItemCount-1 do begin
  747. if not GetResourceLanguage(M, RT_ICON, MakeIntResource(GroupIconDir.Items[I].Id), wLanguage) then
  748. ResUpdateError('GetResourceLanguage failed (3)', ResourceName);
  749. if not UpdateResource(H, RT_ICON, MakeIntResource(GroupIconDir.Items[I].Id), wLanguage, nil, 0) then
  750. ResUpdateErrorWithLastError('UpdateResource failed (4)', ResourceName);
  751. end;
  752. Result := GroupIconDir;
  753. end;
  754. function DeleteIconIfExists(const H: THandle; const M: HMODULE; const ResourceName: PChar): PGroupIconDir;
  755. begin
  756. if FindResource(M, ResourceName, RT_GROUP_ICON) <> 0 then
  757. Result := DeleteIcon(H, M, ResourceName)
  758. else
  759. Result := nil;
  760. end;
  761. function RenameIconWithOverwrite(const H: THandle; const M: HMODULE; const OldResourceName, NewResourceName: PChar): PGroupIconDir;
  762. var
  763. GroupIconDir: PGroupIconDir;
  764. GroupIconDirSize: DWORD;
  765. wLanguage: Word;
  766. begin
  767. DeleteIconIfExists(H, M, NewResourceName);
  768. { Load the group icon resource }
  769. GroupIconDir := LoadResourcePointer(M, RT_GROUP_ICON, OldResourceName);
  770. GroupIconDirSize := Sizeof(Word)*3 + GroupIconDir.ItemCount*Sizeof(TGroupIconDirItem);
  771. { Create a copy group icon resource with the new name - existing icon resources will belong to
  772. it automatically }
  773. if not GetResourceLanguage(M, RT_GROUP_ICON, OldResourceName, wLanguage) then
  774. ResUpdateError('GetResourceLanguage failed (4)', OldResourceName);
  775. if not UpdateResource(H, RT_GROUP_ICON, NewResourceName, wLanguage, GroupIconDir, GroupIconDirSize) then
  776. ResUpdateErrorWithLastError('UpdateResource failed (5)', NewResourceName);
  777. { Delete the old group icon resource }
  778. if not UpdateResource(H, RT_GROUP_ICON, OldResourceName, wLanguage, nil, 0) then
  779. ResUpdateErrorWithLastError('UpdateResource failed (6)', OldResourceName);
  780. Result := GroupIconDir;
  781. end;
  782. function HandleBuiltinStyle(const M: HMODULE; const StyleFileName: String; var Vsf: Pointer; var VsfSize: Cardinal; const Dark: Boolean): Boolean;
  783. begin
  784. { Also see DeleteResource calls below }
  785. var StyleName: PChar := nil;
  786. if SameText(StyleFileName, 'builtin:polar') then begin
  787. if Dark then
  788. StyleName := 'WINDOWSPOLARDARK'
  789. else
  790. StyleName := 'WINDOWSPOLARLIGHT';
  791. end else if SameText(StyleFileName, 'builtin:windows11') then begin
  792. if Dark then
  793. StyleName := 'WINDOWSMODERNDARK'
  794. else
  795. StyleName := 'WINDOWSMODERNLIGHT';
  796. end else if SameText(StyleFileName, 'builtin:slate') then
  797. StyleName := 'SLATECLASSICO'
  798. else if SameText(StyleFileName, 'builtin:zircon') then
  799. StyleName := 'ZIRCON';
  800. Result := StyleName <> nil;
  801. if Result then
  802. Vsf := LoadResourcePointer(M, 'VCLSTYLE', StyleName, True, VsfSize)
  803. end;
  804. var
  805. H: THandle;
  806. M: HMODULE;
  807. OldGroupIconDir, NewGroupIconDir: PGroupIconDir;
  808. I: Integer;
  809. begin
  810. var Ico: PIcoHeader := nil;
  811. var Vsf := nil;
  812. var ShouldFreeVsf := False;
  813. var VsfDynamicDark := nil;
  814. var ShouldFreeVsfDynamicDark := False;
  815. try
  816. if IcoFileName <> '' then begin
  817. TriggerOnUpdateIconsAndStyle(uisoIcoFileName);
  818. { Load the icons }
  819. var P: Pointer;
  820. const IcoSize = LoadFileIntoMemory(IcoFileName, P);
  821. Ico := P;
  822. { Ensure the icon is valid }
  823. if not IsValidIcon(Ico, IcoSize) then
  824. ResUpdateError('Icon file is invalid', '', ERROR_INVALID_PARAMETER);
  825. end;
  826. { Update the resources }
  827. var ChangedMainIcon := False;
  828. H := BeginUpdateResource(PChar(FileName), False);
  829. if H = 0 then
  830. ResUpdateErrorWithLastError('BeginUpdateResource failed (1)');
  831. try
  832. M := LoadLibraryEx(PChar(FileName), 0, LOAD_LIBRARY_AS_DATAFILE);
  833. if M = 0 then
  834. ResUpdateErrorWithLastError('LoadLibraryEx failed (1)');
  835. try
  836. { Load the styles. Could be checked using TStyleManager.IsValidStyle but that requires using VCL units. }
  837. var VsfSize: Cardinal := 0;
  838. if StyleFileName <> '' then begin
  839. TriggerOnUpdateIconsAndStyle(uisoStyleFileName);
  840. if not HandleBuiltinStyle(M, StyleFileName, Vsf, VsfSize, WizardDarkStyle = wdsDark) then begin
  841. VsfSize := LoadFileIntoMemory(StyleFileName, Vsf);
  842. ShouldFreeVsf := True;
  843. end;
  844. end;
  845. var VsfSizeDynamicDark: Cardinal := 0;
  846. if StyleFileNameDynamicDark <> '' then begin
  847. TriggerOnUpdateIconsAndStyle(uisoStyleFileNameDynamicDark);
  848. if not HandleBuiltinStyle(M, StyleFileNameDynamicDark, VsfDynamicDark, VsfSizeDynamicDark, True) then begin
  849. VsfSizeDynamicDark := LoadFileIntoMemory(StyleFileNameDynamicDark, VsfDynamicDark);
  850. ShouldFreeVsfDynamicDark := True;
  851. end;
  852. end;
  853. { All of the following changes must be independent because updates are not immediate. For
  854. example, if you call DeleteIcon followed by FindResource then resource will still be found,
  855. until you call EndUpdateResource *and* reload the file using LoadLibrary }
  856. if IcoFileName <> '' then begin
  857. TriggerOnUpdateIconsAndStyle(uisoIcoFileName);
  858. const ResourceName = 'MAINICON';
  859. { Delete default icons }
  860. OldGroupIconDir := DeleteIcon(H, M, PChar(ResourceName));
  861. DeleteIconIfExists(H, M, PChar(ResourceName + '_DARK'));
  862. { Build the new group icon resource }
  863. const NewGroupIconDirSize: DWORD = 3*SizeOf(Word)+Ico.ItemCount*SizeOf(TGroupIconDirItem);
  864. GetMem(NewGroupIconDir, NewGroupIconDirSize);
  865. try
  866. { Build the new group icon resource }
  867. NewGroupIconDir.Reserved := OldGroupIconDir.Reserved;
  868. NewGroupIconDir.Typ := OldGroupIconDir.Typ;
  869. NewGroupIconDir.ItemCount := Ico.ItemCount;
  870. for I := 0 to NewGroupIconDir.ItemCount-1 do begin
  871. NewGroupIconDir.Items[I].Header := Ico.Items[I].Header;
  872. const Id = I+100; //start at 100 to avoid overwriting other icons that may exist
  873. if Id > High(Word) then
  874. ResUpdateErrorWithLastError('UpdateResource failed (7)', ResourceName);
  875. NewGroupIconDir.Items[I].Id := Word(Id);
  876. end;
  877. { Update 'MAINICON' }
  878. for I := 0 to NewGroupIconDir.ItemCount-1 do
  879. 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
  880. ResUpdateErrorWithLastError('UpdateResource failed (8)', ResourceName);
  881. { Update the icons }
  882. if not UpdateResource(H, RT_GROUP_ICON, 'MAINICON', 1033, NewGroupIconDir, NewGroupIconDirSize) then
  883. ResUpdateErrorWithLastError('UpdateResource failed (9)', ResourceName);
  884. ChangedMainIcon := True;
  885. finally
  886. FreeMem(NewGroupIconDir);
  887. end;
  888. end else begin
  889. if WizardDarkStyle <> wdsDynamic then begin
  890. TriggerOnUpdateIconsAndStyle(uisoWizardDarkStyle);
  891. if WizardDarkStyle = wdsLight then begin
  892. { Forced light: remove dark main icon }
  893. DeleteIconIfExists(H, M, 'MAINICON_DARK')
  894. end else begin
  895. { Forced dark: rename dark main icon to be the regular main icon }
  896. RenameIconWithOverwrite(H, M, 'MAINICON_DARK', 'MAINICON');
  897. ChangedMainIcon := True;
  898. end;
  899. end; { Else keep both main icons }
  900. end;
  901. if Uisf in [uisfSetup, uisfSetupCustomStyle] then begin
  902. const DeleteUninstallIcon = IcoFileName <> '';
  903. if DeleteUninstallIcon then begin
  904. TriggerOnUpdateIconsAndStyle(uisoIcoFileName);
  905. { Make UninstallProgressForm use the custom icon }
  906. DeleteIcon(H, M, 'Z_UNINSTALLICON');
  907. DeleteIconIfExists(H, M, 'Z_UNINSTALLICON_DARK');
  908. end;
  909. if WizardDarkStyle <> wdsDynamic then begin
  910. TriggerOnUpdateIconsAndStyle(uisoWizardDarkStyle);
  911. { Unlike for MAINICON (for which we don't have the choice) here it always uses DeleteIcon
  912. instead of also using RenameIcon, to avoid issues with Windows' icon cache }
  913. var Postfix := '';
  914. if WizardDarkStyle = wdsLight then
  915. Postfix := '_DARK';
  916. { Delete the icons we don't need: either the light ones or the dark ones }
  917. DeleteIconIfExists(H, M, PChar('Z_GROUPICON' + Postfix));
  918. if not DeleteUninstallIcon then
  919. DeleteIconIfExists(H, M, PChar('Z_UNINSTALLICON' + Postfix));
  920. end;
  921. if Uisf = uisfSetupCustomStyle then begin
  922. if Vsf <> nil then begin
  923. TriggerOnUpdateIconsAndStyle(uisoStyleFileName);
  924. { Add the regular custom style, used by forced light, forced dark and dynamic light }
  925. if not UpdateResource(H, 'VCLSTYLE', 'MYSTYLE1', 1033, Vsf, VsfSize) then
  926. ResUpdateErrorWithLastError('UpdateResource failed (10)', 'MYSTYLE1');
  927. end;
  928. if VsfDynamicDark <> nil then begin
  929. TriggerOnUpdateIconsAndStyle(uisoStyleFileNameDynamicDark);
  930. { Add the dark custom style, used by dynamic dark only }
  931. if not UpdateResource(H, 'VCLSTYLE', 'MYSTYLE1_DARK', 1033, VsfDynamicDark, VsfSizeDynamicDark) then
  932. ResUpdateErrorWithLastError('UpdateResource failed (11)', 'MYSTYLE1_DARK');
  933. end;
  934. { See if we need to keep the built-in dark style }
  935. if (Vsf = nil) and (WizardDarkStyle = wdsDark) then begin
  936. TriggerOnUpdateIconsAndStyle(uisoWizardDarkStyle);
  937. { Forced dark without a custom style: make the built-in dark style the regular one }
  938. RenameResource(H, M, 'VCLSTYLE', 'WINDOWSMODERNDARK', 'MYSTYLE1');
  939. end else if (VsfDynamicDark = nil) and (WizardDarkStyle = wdsDynamic) then begin
  940. TriggerOnUpdateIconsAndStyle(uisoWizardDarkStyle);
  941. { Dynamic without a custom dark style: make the built-in dark style the dark one }
  942. RenameResource(H, M, 'VCLSTYLE', 'WINDOWSMODERNDARK', 'MYSTYLE1_DARK');
  943. end else begin
  944. TriggerOnUpdateIconsAndStyle(uisoWizardDarkStyle);
  945. { Forced dark with a custom style: delete the built-in dark style
  946. Or, dynamic with a custom dark style: same
  947. Or, forced light with or without a custom style: same
  948. Note: forced light without a custom style doesn't actually use SetupCustomStyle.e32/64 at the moment so won't get here }
  949. DeleteResource(H, M, 'VCLSTYLE', 'WINDOWSMODERNDARK');
  950. end;
  951. { Delete additional styles - they are handled above }
  952. DeleteResource(H, M, 'VCLSTYLE', 'WINDOWSMODERNLIGHT');
  953. DeleteResource(H, M, 'VCLSTYLE', 'WINDOWSPOLARLIGHT');
  954. DeleteResource(H, M, 'VCLSTYLE', 'WINDOWSPOLARDARK');
  955. DeleteResource(H, M, 'VCLSTYLE', 'SLATECLASSICO');
  956. DeleteResource(H, M, 'VCLSTYLE', 'ZIRCON');
  957. end;
  958. end;
  959. TriggerOnUpdateIconsAndStyle(uisoDone);
  960. finally
  961. FreeLibrary(M);
  962. end;
  963. except
  964. EndUpdateResource(H, True); { discard changes }
  965. raise;
  966. end;
  967. if not EndUpdateResource(H, False) then
  968. if ChangedMainIcon then { Only allow errors (likely from faulty AV software) if the update actually is important }
  969. ResUpdateErrorWithLastError('EndUpdateResource failed, try excluding the Output folder from your antivirus software');
  970. finally
  971. if ShouldFreeVsfDynamicDark then
  972. FreeMem(VsfDynamicDark);
  973. if ShouldFreeVsf then
  974. FreeMem(Vsf);
  975. if Ico <> nil then
  976. FreeMem(Ico);
  977. end;
  978. end;
  979. { Replaces the entire comctl32 dependency section of the manifest with spaces, then inserts a
  980. comctl32 file entry before the other entries. Intended for SetupLdr only. Note: The exact number
  981. of spaces is calculated to allow seamless in-place editing. }
  982. procedure PreventCOMCTL32Sideloading(const F: TCustomFile);
  983. const
  984. DependencyStartTag: AnsiString = '<dependency>';
  985. DependencyEndTag: AnsiString = '</dependency>';
  986. FileStartTag: AnsiString = '<file name="';
  987. COMCTL32Entry: AnsiString = '<file name="comctl32.dll" loadFrom="%SystemRoot%\system32\" />'#13#10;
  988. var
  989. S: AnsiString;
  990. P,Q,R: Integer;
  991. begin
  992. { Read the manifest resource into a string }
  993. SetString(S, nil, SeekToResourceData(F, 24, 1));
  994. var Offset := F.Position;
  995. F.ReadBuffer(S[1], ULength(S));
  996. { Locate and update the <dependency> tag }
  997. P := Pos(DependencyStartTag, S);
  998. if P = 0 then
  999. ResUpdateError('<dependency> tag not found');
  1000. Q := Pos(DependencyEndTag, S);
  1001. if Q <= P then
  1002. ResUpdateError('<dependency> end tag not found');
  1003. Q := Q+Length(DependencyEndTag);
  1004. if Length(COMCTL32Entry) > Q-P then
  1005. ResUpdateError('<dependency> tag shorter than replacement');
  1006. R := Pos(FileStartTag, S);
  1007. if R <= Q then
  1008. ResUpdateError('<dependency> end tag after <file>?');
  1009. Inc(Offset, P-1);
  1010. F.Seek(Offset);
  1011. F.WriteAnsiString(AnsiString(Format('%*s', [Q-P-Length(COMCTL32Entry), ' '])));
  1012. F.WriteAnsiString(AnsiString(Copy(S, Q, R-Q)));
  1013. F.WriteAnsiString(COMCTL32Entry);
  1014. end;
  1015. end.