Compiler.ExeUpdateFunc.pas 42 KB

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