Setup.Install.pas 127 KB

1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889909192939495969798991001011021031041051061071081091101111121131141151161171181191201211221231241251261271281291301311321331341351361371381391401411421431441451461471481491501511521531541551561571581591601611621631641651661671681691701711721731741751761771781791801811821831841851861871881891901911921931941951961971981992002012022032042052062072082092102112122132142152162172182192202212222232242252262272282292302312322332342352362372382392402412422432442452462472482492502512522532542552562572582592602612622632642652662672682692702712722732742752762772782792802812822832842852862872882892902912922932942952962972982993003013023033043053063073083093103113123133143153163173183193203213223233243253263273283293303313323333343353363373383393403413423433443453463473483493503513523533543553563573583593603613623633643653663673683693703713723733743753763773783793803813823833843853863873883893903913923933943953963973983994004014024034044054064074084094104114124134144154164174184194204214224234244254264274284294304314324334344354364374384394404414424434444454464474484494504514524534544554564574584594604614624634644654664674684694704714724734744754764774784794804814824834844854864874884894904914924934944954964974984995005015025035045055065075085095105115125135145155165175185195205215225235245255265275285295305315325335345355365375385395405415425435445455465475485495505515525535545555565575585595605615625635645655665675685695705715725735745755765775785795805815825835845855865875885895905915925935945955965975985996006016026036046056066076086096106116126136146156166176186196206216226236246256266276286296306316326336346356366376386396406416426436446456466476486496506516526536546556566576586596606616626636646656666676686696706716726736746756766776786796806816826836846856866876886896906916926936946956966976986997007017027037047057067077087097107117127137147157167177187197207217227237247257267277287297307317327337347357367377387397407417427437447457467477487497507517527537547557567577587597607617627637647657667677687697707717727737747757767777787797807817827837847857867877887897907917927937947957967977987998008018028038048058068078088098108118128138148158168178188198208218228238248258268278288298308318328338348358368378388398408418428438448458468478488498508518528538548558568578588598608618628638648658668678688698708718728738748758768778788798808818828838848858868878888898908918928938948958968978988999009019029039049059069079089099109119129139149159169179189199209219229239249259269279289299309319329339349359369379389399409419429439449459469479489499509519529539549559569579589599609619629639649659669679689699709719729739749759769779789799809819829839849859869879889899909919929939949959969979989991000100110021003100410051006100710081009101010111012101310141015101610171018101910201021102210231024102510261027102810291030103110321033103410351036103710381039104010411042104310441045104610471048104910501051105210531054105510561057105810591060106110621063106410651066106710681069107010711072107310741075107610771078107910801081108210831084108510861087108810891090109110921093109410951096109710981099110011011102110311041105110611071108110911101111111211131114111511161117111811191120112111221123112411251126112711281129113011311132113311341135113611371138113911401141114211431144114511461147114811491150115111521153115411551156115711581159116011611162116311641165116611671168116911701171117211731174117511761177117811791180118111821183118411851186118711881189119011911192119311941195119611971198119912001201120212031204120512061207120812091210121112121213121412151216121712181219122012211222122312241225122612271228122912301231123212331234123512361237123812391240124112421243124412451246124712481249125012511252125312541255125612571258125912601261126212631264126512661267126812691270127112721273127412751276127712781279128012811282128312841285128612871288128912901291129212931294129512961297129812991300130113021303130413051306130713081309131013111312131313141315131613171318131913201321132213231324132513261327132813291330133113321333133413351336133713381339134013411342134313441345134613471348134913501351135213531354135513561357135813591360136113621363136413651366136713681369137013711372137313741375137613771378137913801381138213831384138513861387138813891390139113921393139413951396139713981399140014011402140314041405140614071408140914101411141214131414141514161417141814191420142114221423142414251426142714281429143014311432143314341435143614371438143914401441144214431444144514461447144814491450145114521453145414551456145714581459146014611462146314641465146614671468146914701471147214731474147514761477147814791480148114821483148414851486148714881489149014911492149314941495149614971498149915001501150215031504150515061507150815091510151115121513151415151516151715181519152015211522152315241525152615271528152915301531153215331534153515361537153815391540154115421543154415451546154715481549155015511552155315541555155615571558155915601561156215631564156515661567156815691570157115721573157415751576157715781579158015811582158315841585158615871588158915901591159215931594159515961597159815991600160116021603160416051606160716081609161016111612161316141615161616171618161916201621162216231624162516261627162816291630163116321633163416351636163716381639164016411642164316441645164616471648164916501651165216531654165516561657165816591660166116621663166416651666166716681669167016711672167316741675167616771678167916801681168216831684168516861687168816891690169116921693169416951696169716981699170017011702170317041705170617071708170917101711171217131714171517161717171817191720172117221723172417251726172717281729173017311732173317341735173617371738173917401741174217431744174517461747174817491750175117521753175417551756175717581759176017611762176317641765176617671768176917701771177217731774177517761777177817791780178117821783178417851786178717881789179017911792179317941795179617971798179918001801180218031804180518061807180818091810181118121813181418151816181718181819182018211822182318241825182618271828182918301831183218331834183518361837183818391840184118421843184418451846184718481849185018511852185318541855185618571858185918601861186218631864186518661867186818691870187118721873187418751876187718781879188018811882188318841885188618871888188918901891189218931894189518961897189818991900190119021903190419051906190719081909191019111912191319141915191619171918191919201921192219231924192519261927192819291930193119321933193419351936193719381939194019411942194319441945194619471948194919501951195219531954195519561957195819591960196119621963196419651966196719681969197019711972197319741975197619771978197919801981198219831984198519861987198819891990199119921993199419951996199719981999200020012002200320042005200620072008200920102011201220132014201520162017201820192020202120222023202420252026202720282029203020312032203320342035203620372038203920402041204220432044204520462047204820492050205120522053205420552056205720582059206020612062206320642065206620672068206920702071207220732074207520762077207820792080208120822083208420852086208720882089209020912092209320942095209620972098209921002101210221032104210521062107210821092110211121122113211421152116211721182119212021212122212321242125212621272128212921302131213221332134213521362137213821392140214121422143214421452146214721482149215021512152215321542155215621572158215921602161216221632164216521662167216821692170217121722173217421752176217721782179218021812182218321842185218621872188218921902191219221932194219521962197219821992200220122022203220422052206220722082209221022112212221322142215221622172218221922202221222222232224222522262227222822292230223122322233223422352236223722382239224022412242224322442245224622472248224922502251225222532254225522562257225822592260226122622263226422652266226722682269227022712272227322742275227622772278227922802281228222832284228522862287228822892290229122922293229422952296229722982299230023012302230323042305230623072308230923102311231223132314231523162317231823192320232123222323232423252326232723282329233023312332233323342335233623372338233923402341234223432344234523462347234823492350235123522353235423552356235723582359236023612362236323642365236623672368236923702371237223732374237523762377237823792380238123822383238423852386238723882389239023912392239323942395239623972398239924002401240224032404240524062407240824092410241124122413241424152416241724182419242024212422242324242425242624272428242924302431243224332434243524362437243824392440244124422443244424452446244724482449245024512452245324542455245624572458245924602461246224632464246524662467246824692470247124722473247424752476247724782479248024812482248324842485248624872488248924902491249224932494249524962497249824992500250125022503250425052506250725082509251025112512251325142515251625172518251925202521252225232524252525262527252825292530253125322533253425352536253725382539254025412542254325442545254625472548254925502551255225532554255525562557255825592560256125622563256425652566256725682569257025712572257325742575257625772578257925802581258225832584258525862587258825892590259125922593259425952596259725982599260026012602260326042605260626072608260926102611261226132614261526162617261826192620262126222623262426252626262726282629263026312632263326342635263626372638263926402641264226432644264526462647264826492650265126522653265426552656265726582659266026612662266326642665266626672668266926702671267226732674267526762677267826792680268126822683268426852686268726882689269026912692269326942695269626972698269927002701270227032704270527062707270827092710271127122713271427152716271727182719272027212722272327242725272627272728272927302731273227332734273527362737273827392740274127422743274427452746274727482749275027512752275327542755275627572758275927602761276227632764276527662767276827692770277127722773277427752776277727782779278027812782278327842785278627872788278927902791279227932794279527962797279827992800280128022803280428052806280728082809281028112812281328142815281628172818281928202821282228232824282528262827282828292830283128322833283428352836283728382839284028412842284328442845284628472848284928502851285228532854285528562857285828592860286128622863286428652866286728682869287028712872287328742875287628772878287928802881288228832884288528862887288828892890289128922893289428952896289728982899290029012902290329042905290629072908290929102911291229132914291529162917291829192920292129222923292429252926292729282929293029312932293329342935293629372938293929402941294229432944294529462947294829492950295129522953295429552956295729582959296029612962296329642965296629672968296929702971297229732974297529762977297829792980298129822983298429852986298729882989299029912992299329942995
  1. unit Setup.Install;
  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. Installation procedures
  8. }
  9. interface
  10. procedure PerformInstall(var Succeeded: Boolean; const ChangesEnvironment,
  11. ChangesAssociations: Boolean);
  12. implementation
  13. uses
  14. Windows, Messages, ShlObj, RegStr, Classes, SysUtils, Forms,
  15. ISSigFunc, PathFunc, SHA256,
  16. Shared.CommonFunc, Shared.CommonFunc.Vcl, Shared.FileClass,
  17. Shared.SetupMessageIDs, Shared.SetupTypes, Shared.Struct, Shared.VerInfoFunc,
  18. Compression.Base, Compression.SevenZipDLLDecoder,
  19. SetupLdrAndSetup.InstFunc, SetupLdrAndSetup.Messages, Setup.RedirFunc,
  20. Setup.DebugClient, Setup.DotNetFunc, Setup.DownloadFileFunc, Setup.InstFunc, Setup.InstFunc.Ole,
  21. Setup.ISSigVerifyFunc, Setup.FileExtractor, Setup.Install.HelperFunc, Setup.Helper,
  22. Setup.MainFunc, Setup.LoggingFunc, Setup.RegDLL, Setup.SecurityFunc,
  23. Setup.UninstallLog, Setup.WizardForm;
  24. type
  25. PRegisterFilesListRec = ^TRegisterFilesListRec;
  26. TRegisterFilesListRec = record
  27. Filename: String;
  28. Is64Bit, TypeLib, NoErrorMessages: Boolean;
  29. end;
  30. var
  31. UninstallTempExeFilename, UninstallDataFilename, UninstallMsgFilename: String;
  32. UninstallExeCreated: (ueNone, ueNew, ueReplaced);
  33. UninstallDataCreated, AppendUninstallData: Boolean;
  34. procedure RecordStartInstall(const UninstLog: TUninstallLog);
  35. var
  36. AppDir: String;
  37. begin
  38. if shCreateAppDir in SetupHeader.Options then
  39. AppDir := WizardDirValue
  40. else
  41. AppDir := '';
  42. UninstLog.Add(utStartInstall, [GetComputerNameString, GetUserNameString,
  43. AppDir, GetLocalTimeAsStr], 0);
  44. end;
  45. procedure RecordCompiledCode(const UninstLog: TUninstallLog);
  46. var
  47. LeadBytesStr, ExpandedApp, ExpandedGroup, CustomMessagesStr: String;
  48. begin
  49. { Only use app if Setup creates one }
  50. if shCreateAppDir in SetupHeader.Options then
  51. ExpandedApp := ExpandConst('{app}')
  52. else
  53. ExpandedApp := '';
  54. try
  55. ExpandedGroup := ExpandConst('{group}');
  56. except
  57. { Yep, expanding "group" might fail with an exception }
  58. ExpandedGroup := '';
  59. end;
  60. if SetupHeader.CompiledCodeText <> '' then
  61. PackCustomMessagesIntoString(CustomMessagesStr);
  62. { Record [Code] even if empty to 'overwrite' old versions }
  63. UninstLog.Add(utCompiledCode, [PackCompiledCodeTextIntoString(SetupHeader.CompiledCodeText),
  64. LeadBytesStr, ExpandedApp, ExpandedGroup, WizardGroupValue,
  65. ExpandConst('{language}'), CustomMessagesStr], SetupBinVersion or Longint($80000000));
  66. end;
  67. procedure RegisterUninstallInfo(const UninstLog: TUninstallLog; const UninstallRegKeyBaseName: String;
  68. const AfterInstallFilesSize: Int64);
  69. { Stores uninstall information in the Registry so that the program can be
  70. uninstalled through the Control Panel Add/Remove Programs applet. }
  71. const
  72. AdminInstallModeNames: array [Boolean] of String =
  73. ('non administrative', 'administrative');
  74. BitInstallModeNames: array [Boolean] of String =
  75. ('32-bit', '64-bit');
  76. var
  77. RegView, OppositeRegView: TRegView;
  78. RegViewIs64Bit, OppositeRegViewIs64Bit: Boolean;
  79. RootKey, OppositeRootKey: HKEY;
  80. RootKeyIsHKLM, OppositeRootKeyIsHKLM: Boolean;
  81. SubkeyName: String;
  82. procedure SetStringValue(const K: HKEY; const ValueName: PChar;
  83. const Data: String);
  84. var
  85. ErrorCode: Longint;
  86. begin
  87. ErrorCode := RegSetValueEx(K, ValueName, 0, REG_SZ, PChar(Data),
  88. (Length(Data)+1)*SizeOf(Data[1]));
  89. if ErrorCode <> ERROR_SUCCESS then
  90. RegError(reRegSetValueEx, RootKey, SubkeyName, ErrorCode);
  91. end;
  92. procedure SetStringValueUnlessEmpty(const K: HKEY; const ValueName: PChar;
  93. const Data: String);
  94. begin
  95. if Data <> '' then
  96. SetStringValue(K, ValueName, Data);
  97. end;
  98. procedure SetDWordValue(const K: HKEY; const ValueName: PChar;
  99. const Data: DWord);
  100. var
  101. ErrorCode: Longint;
  102. begin
  103. ErrorCode := RegSetValueEx(K, ValueName, 0, REG_DWORD, @Data,
  104. SizeOf(Data));
  105. if ErrorCode <> ERROR_SUCCESS then
  106. RegError(reRegSetValueEx, RootKey, SubkeyName, ErrorCode);
  107. end;
  108. function GetInstallDateString: String;
  109. var
  110. ST: TSystemTime;
  111. begin
  112. GetLocalTime(ST);
  113. Result := Format('%.4u%.2u%.2u', [ST.wYear, ST.wMonth, ST.wDay]);
  114. end;
  115. function ExtractMajorMinorVersion(Version: String; var Major, Minor: Integer): Boolean;
  116. var
  117. P, I: Integer;
  118. begin
  119. P := Pos('.', Version);
  120. if P <> 0 then begin
  121. Val(Copy(Version, 1, P-1), Major, I);
  122. if I = 0 then begin
  123. Delete(Version, 1, P);
  124. P := Pos('.', Version);
  125. if P <> 0 then
  126. Val(Copy(Version, 1, P-1), Minor, I)
  127. else
  128. Val(Version, Minor, I);
  129. end;
  130. end else begin
  131. Val(Version, Major, I);
  132. Minor := 0;
  133. end;
  134. Result := I = 0;
  135. end;
  136. { Also see Main.pas }
  137. function ExistingInstallationAt(const RegView: TRegView; const RootKey: HKEY): Boolean;
  138. var
  139. K: HKEY;
  140. begin
  141. if RegOpenKeyExView(RegView, RootKey, PChar(SubkeyName), 0, KEY_QUERY_VALUE, K) = ERROR_SUCCESS then begin
  142. Result := True;
  143. RegCloseKey(K);
  144. end else
  145. Result := False;
  146. end;
  147. procedure HandleDuplicateDisplayNames(var DisplayName: String);
  148. const
  149. UninstallDisplayNameMarksUser: array [Boolean] of TSetupMessageId =
  150. (msgUninstallDisplayNameMarkCurrentUser, msgUninstallDisplayNameMarkAllUsers);
  151. UninstallDisplayNameMarksBits: array [Boolean] of TSetupMessageId =
  152. (msgUninstallDisplayNameMark32Bit, msgUninstallDisplayNameMark64Bit);
  153. var
  154. ExistingAtOppositeAdminInstallMode, ExistingAtOpposite64BitInstallMode: Boolean;
  155. begin
  156. { Check opposite administrative install mode. }
  157. ExistingAtOppositeAdminInstallMode := ExistingInstallationAt(RegView, OppositeRootKey);
  158. if RootKeyIsHKLM or not IsWin64 then begin
  159. { Opposite (HKCU) is shared for 32-bit and 64-bit so don't log bitness. Also don't log bitness on a 32-bit system. }
  160. LogFmt('Detected previous %s install? %s',
  161. [AdminInstallModeNames[OppositeRootKeyIsHKLM {always False}], SYesNo[ExistingAtOppositeAdminInstallMode]])
  162. end else begin
  163. { Opposite (HKLM) is not shared for 32-bit and 64-bit so log bitness. }
  164. LogFmt('Detected previous %s %s install? %s',
  165. [AdminInstallModeNames[OppositeRootKeyIsHKLM {always True}], BitInstallModeNames[RegViewIs64Bit], SYesNo[ExistingAtOppositeAdminInstallMode]]);
  166. end;
  167. if IsWin64 then begin
  168. { Check opposite 32-bit or 64-bit install mode. }
  169. if RootKeyIsHKLM then begin
  170. { HKLM is not shared for 32-bit and 64-bit so check it for opposite 32-bit or 64-bit install mode. Not checking HKCU
  171. since HKCU is shared for 32-bit and 64-bit mode and we already checked HKCU above. }
  172. ExistingAtOpposite64BitInstallMode := ExistingInstallationAt(OppositeRegView, RootKey {always HKLM});
  173. LogFmt('Detected previous %s %s install? %s',
  174. [AdminInstallModeNames[RootKeyIsHKLM {always True}], BitInstallModeNames[OppositeRegViewIs64Bit], SYesNo[ExistingAtOpposite64BitInstallMode]]);
  175. end else begin
  176. { HKCU is shared for 32-bit and 64-bit so not checking it but we do still need to check HKLM for opposite 32-bit or
  177. 64-bit install mode since we haven't already done that. }
  178. ExistingAtOpposite64BitInstallMode := ExistingInstallationAt(OppositeRegView, OppositeRootKey {always HKLM});
  179. if ExistingAtOpposite64BitInstallMode then
  180. ExistingAtOppositeAdminInstallMode := True;
  181. LogFmt('Detected previous %s %s install? %s',
  182. [AdminInstallModeNames[OppositeRootKeyIsHKLM {always True}], BitInstallModeNames[OppositeRegViewIs64Bit], SYesNo[ExistingAtOpposite64BitInstallMode]]);
  183. end;
  184. end else
  185. ExistingAtOpposite64BitInstallMode := False;
  186. { Mark new display name if needed. Note: currently we don't attempt to mark existing display names as well. }
  187. if ExistingAtOppositeAdminInstallMode or ExistingAtOpposite64BitInstallMode then begin
  188. if ExistingAtOppositeAdminInstallMode and ExistingAtOpposite64BitInstallMode then
  189. DisplayName := FmtSetupMessage(msgUninstallDisplayNameMarks,
  190. [DisplayName, SetupMessages[UninstallDisplayNameMarksUser[RootKeyIsHKLM]],
  191. SetupMessages[UninstallDisplayNameMarksBits[RegViewIs64Bit]]])
  192. else if ExistingAtOppositeAdminInstallMode then
  193. DisplayName := FmtSetupMessage(msgUninstallDisplayNameMark,
  194. [DisplayName, SetupMessages[UninstallDisplayNameMarksUser[RootKeyIsHKLM]]])
  195. else
  196. DisplayName := FmtSetupMessage(msgUninstallDisplayNameMark,
  197. [DisplayName, SetupMessages[UninstallDisplayNameMarksBits[RegViewIs64Bit]]]);
  198. LogFmt('Marked uninstall display name to avoid duplicate entries. New display name: %s', [DisplayName]);
  199. end;
  200. end;
  201. var
  202. H2: HKEY;
  203. ErrorCode: Longint;
  204. Z: String;
  205. MajorVersion, MinorVersion, I: Integer;
  206. EstimatedSize: Int64;
  207. begin
  208. RegView := InstallDefaultRegView;
  209. RegViewIs64Bit := RegView = rv64Bit;
  210. if RegViewIs64Bit then
  211. OppositeRegView := rv32Bit
  212. else
  213. OppositeRegView := rv64Bit;
  214. OppositeRegViewIs64Bit := not RegViewIs64Bit;
  215. RootKey := InstallModeRootKey;
  216. RootKeyIsHKLM := RootKey = HKEY_LOCAL_MACHINE;
  217. if RootKeyIsHKLM then
  218. OppositeRootKey := HKEY_CURRENT_USER
  219. else
  220. OppositeRootKey := HKEY_LOCAL_MACHINE;
  221. OppositeRootKeyIsHKLM := not RootKeyIsHKLM;
  222. SubkeyName := GetUninstallRegSubkeyName(UninstallRegKeyBaseName);
  223. if ExistingInstallationAt(RegView, RootKey) then begin
  224. if RootKeyIsHKLM then begin
  225. { HKLM is not shared for 32-bit and 64-bit so log bitness. }
  226. LogFmt('Deleting uninstall key left over from previous %s %s install.',
  227. [AdminInstallModeNames[RootKeyIsHKLM {always True}], BitInstallModeNames[RegViewIs64Bit]]);
  228. end else begin
  229. { HKCU is shared for 32-bit and 64-bit so don't log bitness. }
  230. LogFmt('Deleting uninstall key left over from previous %s install.',
  231. [AdminInstallModeNames[RootKeyIsHKLM {always False}]])
  232. end;
  233. RegDeleteKeyIncludingSubkeys(RegView, RootKey, PChar(SubkeyName));
  234. end;
  235. LogFmt('Creating new uninstall key: %s\%s', [GetRegRootKeyName(RootKey), SubkeyName]);
  236. { Create uninstall key }
  237. ErrorCode := RegCreateKeyExView(RegView, RootKey, PChar(SubkeyName),
  238. 0, nil, REG_OPTION_NON_VOLATILE, KEY_SET_VALUE, nil, H2, nil);
  239. if ErrorCode <> ERROR_SUCCESS then
  240. RegError(reRegCreateKeyEx, RootKey, SubkeyName, ErrorCode);
  241. try
  242. Log('Writing uninstall key values.');
  243. { do not localize or change any of the following strings }
  244. SetStringValue(H2, 'Inno Setup: Setup Version', SetupVersion);
  245. if shCreateAppDir in SetupHeader.Options then
  246. Z := WizardDirValue
  247. else
  248. Z := '';
  249. SetStringValue(H2, 'Inno Setup: App Path', Z);
  250. SetStringValueUnlessEmpty(H2, 'InstallLocation', AddBackslash(Z));
  251. SetStringValue(H2, 'Inno Setup: Icon Group', WizardGroupValue);
  252. if WizardNoIcons then
  253. SetDWordValue(H2, 'Inno Setup: No Icons', 1);
  254. SetStringValue(H2, 'Inno Setup: User', GetUserNameString);
  255. if WizardSetupType <> nil then begin
  256. SetStringValue(H2, 'Inno Setup: Setup Type', WizardSetupType.Name);
  257. SetStringValue(H2, 'Inno Setup: Selected Components', StringsToCommaString(WizardComponents));
  258. SetStringValue(H2, 'Inno Setup: Deselected Components', StringsToCommaString(WizardDeselectedComponents));
  259. end;
  260. if HasTasks then begin
  261. SetStringValue(H2, 'Inno Setup: Selected Tasks', StringsToCommaString(WizardTasks));
  262. SetStringValue(H2, 'Inno Setup: Deselected Tasks', StringsToCommaString(WizardDeselectedTasks));
  263. end;
  264. if shUserInfoPage in SetupHeader.Options then begin
  265. SetStringValue(H2, 'Inno Setup: User Info: Name', WizardUserInfoName);
  266. SetStringValue(H2, 'Inno Setup: User Info: Organization', WizardUserInfoOrg);
  267. SetStringValue(H2, 'Inno Setup: User Info: Serial', WizardUserInfoSerial);
  268. end;
  269. SetStringValue(H2, 'Inno Setup: Language', PSetupLanguageEntry(Entries[seLanguage][ActiveLanguage]).Name);
  270. if SetupHeader.UninstallDisplayName <> '' then
  271. Z := ExpandConst(SetupHeader.UninstallDisplayName)
  272. else
  273. Z := ExpandedAppVerName;
  274. HandleDuplicateDisplayNames(Z);
  275. { For the entry to appear in ARP, DisplayName cannot exceed 259 characters
  276. on Windows 2000 and later. }
  277. SetStringValue(H2, 'DisplayName', Copy(Z, 1, 259));
  278. SetStringValueUnlessEmpty(H2, 'DisplayIcon', ExpandConst(SetupHeader.UninstallDisplayIcon));
  279. var ExtraUninstallString: String;
  280. if shUninstallLogging in SetupHeader.Options then
  281. ExtraUninstallString := ' /LOG'
  282. else
  283. ExtraUninstallString := '';
  284. SetStringValue(H2, 'UninstallString', '"' + UninstallExeFilename + '"' + ExtraUninstallString);
  285. SetStringValue(H2, 'QuietUninstallString', '"' + UninstallExeFilename + '" /SILENT' + ExtraUninstallString);
  286. SetStringValueUnlessEmpty(H2, 'DisplayVersion', ExpandConst(SetupHeader.AppVersion));
  287. SetStringValueUnlessEmpty(H2, 'Publisher', ExpandConst(SetupHeader.AppPublisher));
  288. SetStringValueUnlessEmpty(H2, 'URLInfoAbout', ExpandConst(SetupHeader.AppPublisherURL));
  289. SetStringValueUnlessEmpty(H2, 'HelpTelephone', ExpandConst(SetupHeader.AppSupportPhone));
  290. SetStringValueUnlessEmpty(H2, 'HelpLink', ExpandConst(SetupHeader.AppSupportURL));
  291. SetStringValueUnlessEmpty(H2, 'URLUpdateInfo', ExpandConst(SetupHeader.AppUpdatesURL));
  292. SetStringValueUnlessEmpty(H2, 'Readme', ExpandConst(SetupHeader.AppReadmeFile));
  293. SetStringValueUnlessEmpty(H2, 'Contact', ExpandConst(SetupHeader.AppContact));
  294. SetStringValueUnlessEmpty(H2, 'Comments', ExpandConst(SetupHeader.AppComments));
  295. Z := ExpandConst(SetupHeader.AppModifyPath);
  296. if Z <> '' then
  297. SetStringValue(H2, 'ModifyPath', Z)
  298. else
  299. SetDWordValue(H2, 'NoModify', 1);
  300. SetDWordValue(H2, 'NoRepair', 1);
  301. SetStringValue(H2, 'InstallDate', GetInstallDateString);
  302. if ExtractMajorMinorVersion(ExpandConst(SetupHeader.AppVersion), MajorVersion, MinorVersion) then begin
  303. { Originally MSDN said to write to Major/MinorVersion, now it says to write to VersionMajor/Minor. So write to both. }
  304. SetDWordValue(H2, 'MajorVersion', MajorVersion);
  305. SetDWordValue(H2, 'MinorVersion', MinorVersion);
  306. SetDWordValue(H2, 'VersionMajor', MajorVersion);
  307. SetDWordValue(H2, 'VersionMinor', MinorVersion);
  308. end;
  309. { Note: Windows 7 (and later?) doesn't automatically calculate sizes so set EstimatedSize ourselves. }
  310. if SetupHeader.UninstallDisplaySize = 0 then begin
  311. { Estimate the size by taking the size of all files and adding any ExtraDiskSpaceRequired. }
  312. EstimatedSize := AfterInstallFilesSize + SetupHeader.ExtraDiskSpaceRequired;
  313. for I := 0 to Entries[seComponent].Count-1 do begin
  314. with PSetupComponentEntry(Entries[seComponent][I])^ do begin
  315. if ShouldProcessEntry(WizardComponents, nil, Name, '', Languages, '') then
  316. Inc(EstimatedSize, ExtraDiskSpaceRequired);
  317. end;
  318. end;
  319. end else
  320. EstimatedSize := SetupHeader.UninstallDisplaySize;
  321. { ARP on Windows 7 without SP1 only pays attention to the lower 6 bytes of EstimatedSize and
  322. throws away the rest. For example putting in $4000001 (=4GB + 1KB) displays as 1 KB.
  323. So we need to check for this. }
  324. if (Hi(NTServicePackLevel) > 0) or IsWindows8 or (EstimatedSize <= High(Cardinal)) then begin
  325. EstimatedSize := EstimatedSize div 1024;
  326. SetDWordValue(H2, 'EstimatedSize', DWORD(EstimatedSize));
  327. end;
  328. { Also see SetPreviousData in ScriptFunc.pas }
  329. if CodeRunner <> nil then begin
  330. try
  331. CodeRunner.RunProcedures('RegisterPreviousData', [Integer(H2)], False);
  332. except
  333. Log('RegisterPreviousData raised an exception.');
  334. Application.HandleException(nil);
  335. end;
  336. end;
  337. finally
  338. RegCloseKey(H2);
  339. end;
  340. UninstLog.AddReg(utRegDeleteEntireKey, RegView, RootKey,
  341. [SubkeyName]);
  342. end;
  343. type
  344. TMakeDirFlags = set of (mdNoUninstall, mdAlwaysUninstall, mdDeleteAfterInstall,
  345. mdNotifyChange);
  346. function MakeDir(const UninstLog: TUninstallLog; const DisableFsRedir: Boolean; Dir: String;
  347. const Flags: TMakeDirFlags): Boolean;
  348. { Returns True if a new directory was created.
  349. Note: If DisableFsRedir is True, the mdNotifyChange flag should not be
  350. specified; it won't work properly. }
  351. var
  352. ErrorCode: DWORD;
  353. UninstFlags: Longint;
  354. begin
  355. Result := False;
  356. Dir := RemoveBackslashUnlessRoot(PathExpand(Dir));
  357. if PathExtractName(Dir) = '' then { reached root? }
  358. Exit;
  359. if DirExistsRedir(DisableFsRedir, Dir) then begin
  360. if not(mdAlwaysUninstall in Flags) then
  361. Exit;
  362. end
  363. else begin
  364. MakeDir(UninstLog, DisableFsRedir, PathExtractDir(Dir), Flags - [mdAlwaysUninstall]);
  365. LogFmt('Creating directory: %s', [Dir]);
  366. if not CreateDirectoryRedir(DisableFsRedir, Dir) then begin
  367. ErrorCode := GetLastError;
  368. raise Exception.Create(FmtSetupMessage(msgLastErrorMessage,
  369. [FmtSetupMessage1(msgErrorCreatingDir, Dir), IntToStr(ErrorCode),
  370. Win32ErrorString(ErrorCode)]));
  371. end;
  372. Result := True;
  373. if mdNotifyChange in Flags then begin
  374. SHChangeNotify(SHCNE_MKDIR, SHCNF_PATH, PChar(Dir), nil);
  375. SHChangeNotify(SHCNE_UPDATEDIR, SHCNF_PATH or SHCNF_FLUSH,
  376. PChar(PathExtractDir(Dir)), nil);
  377. end;
  378. end;
  379. if mdDeleteAfterInstall in Flags then
  380. DeleteDirsAfterInstallList.AddObject(Dir, Pointer(Ord(DisableFsRedir)))
  381. else begin
  382. if not(mdNoUninstall in Flags) then begin
  383. UninstFlags := utDeleteDirOrFiles_IsDir;
  384. if DisableFsRedir then
  385. UninstFlags := UninstFlags or utDeleteDirOrFiles_DisableFsRedir;
  386. if mdNotifyChange in Flags then
  387. UninstFlags := UninstFlags or utDeleteDirOrFiles_CallChangeNotify;
  388. UninstLog.Add(utDeleteDirOrFiles, [Dir], UninstFlags);
  389. end;
  390. end;
  391. end;
  392. procedure CreateDirs(const UninstLog: TUninstallLog);
  393. { Creates the application's directories }
  394. procedure ApplyPermissions(const DisableFsRedir: Boolean;
  395. const Filename: String; const PermsEntry: Integer);
  396. var
  397. P: PSetupPermissionEntry;
  398. begin
  399. if PermsEntry <> -1 then begin
  400. LogFmt('Setting permissions on directory: %s', [Filename]);
  401. P := Entries[sePermission][PermsEntry];
  402. if not GrantPermissionOnFile(DisableFsRedir, Filename,
  403. TGrantPermissionEntry(Pointer(P.Permissions)^),
  404. Length(P.Permissions) div SizeOf(TGrantPermissionEntry)) then
  405. LogFmt('Failed to set permissions on directory (%d).', [GetLastError]);
  406. end;
  407. end;
  408. procedure ApplyNTFSCompression(const DisableFsRedir: Boolean;
  409. const Filename: String; const Compress: Boolean);
  410. begin
  411. if Compress then
  412. LogFmt('Setting NTFS compression on directory: %s', [Filename])
  413. else
  414. LogFmt('Unsetting NTFS compression on directory: %s', [Filename]);
  415. if not SetNTFSCompressionRedir(DisableFsRedir, Filename, Compress) then
  416. LogFmt('Failed to set NTFS compression state (%d).', [GetLastError]);
  417. end;
  418. var
  419. CurDirNumber: Integer;
  420. Flags: TMakeDirFlags;
  421. N: String;
  422. begin
  423. { Create main application directory }
  424. MakeDir(UninstLog, InstallDefaultDisableFsRedir, WizardDirValue, []);
  425. { Create the rest of the directories, if any }
  426. for CurDirNumber := 0 to Entries[seDir].Count-1 do
  427. with PSetupDirEntry(Entries[seDir][CurDirNumber])^ do begin
  428. if ShouldProcessEntry(WizardComponents, WizardTasks, Components, Tasks, Languages, Check) then begin
  429. DebugNotifyEntry(seDir, CurDirNumber);
  430. NotifyBeforeInstallEntry(BeforeInstall);
  431. Flags := [];
  432. if doUninsNeverUninstall in Options then Include(Flags, mdNoUninstall);
  433. if doDeleteAfterInstall in Options then Include(Flags, mdDeleteAfterInstall);
  434. if doUninsAlwaysUninstall in Options then Include(Flags, mdAlwaysUninstall);
  435. N := RemoveBackslashUnlessRoot(PathExpand(ExpandConst(DirName)));
  436. MakeDir(UninstLog, InstallDefaultDisableFsRedir, N, Flags);
  437. AddAttributesToFile(InstallDefaultDisableFsRedir, N, Attribs);
  438. ApplyPermissions(InstallDefaultDisableFsRedir, N, PermissionsEntry);
  439. if (doSetNTFSCompression in Options) or (doUnsetNTFSCompression in Options) then
  440. ApplyNTFSCompression(InstallDefaultDisableFsRedir, N, doSetNTFSCompression in Options);
  441. NotifyAfterInstallEntry(AfterInstall);
  442. end;
  443. end;
  444. end;
  445. procedure BindUninstallMsgDataToExe(const ExpandedAppId: String; const F: TFile);
  446. var
  447. UniqueValue: TSHA256Digest;
  448. UninstallerMsgTail: TUninstallerMsgTail;
  449. begin
  450. F.SeekToEnd;
  451. { First append the hash of AppId so that unins*.exe files from different
  452. applications won't have the same file hash. This is done to combat broken
  453. anti-spyware programs that catch all unins*.exe files with certain hash
  454. sums just because some piece of spyware was deployed with Inno Setup and
  455. had the unins*.exe file in its directory. }
  456. UniqueValue := GetSHA256OfUnicodeString(ExpandedAppId);
  457. F.WriteBuffer(UniqueValue, SizeOf(UniqueValue));
  458. UninstallerMsgTail.ID := UninstallerMsgTailID;
  459. UninstallerMsgTail.Offset := F.Position;
  460. WriteMsgData(F);
  461. F.WriteBuffer(UninstallerMsgTail, SizeOf(UninstallerMsgTail));
  462. end;
  463. type
  464. TOverwriteAll = (oaUnknown, oaOverwrite, oaKeep);
  465. procedure ProcessFileEntry(const UninstLog: TUninstallLog; const ExpandedAppId: String;
  466. const RegisterFilesList: TList; const CurFile: PSetupFileEntry;
  467. const DisableFsRedir: Boolean; AExternalSourceFile, ADestFile: String;
  468. const FileLocationFilenames: TStringList; const AExternalSize: Int64;
  469. var ConfirmOverwriteOverwriteAll, PromptIfOlderOverwriteAll: TOverwriteAll;
  470. var WarnedPerUserFonts: Boolean; const AExternalFileDate: PFileTime);
  471. { Not external: AExternalSourceFile and ADestFile should be empty strings,
  472. FileLocationFilenames should be set, AExternalSize is unused,
  473. AExternalFileDate should not be set
  474. External : Opposite except AExternalFileDate still not set
  475. Ext. Archive: Same as external except AExternalFileDate set and
  476. AExternalSourceFile should be set to ArchiveFindHandle as a string
  477. Ext. Downl. : Same as external except
  478. AExternalSourceFile should be set to an URL }
  479. procedure InstallFont(const Filename, FontName: String;
  480. const PerUserFont, AddToFontTableNow: Boolean; var WarnedPerUserFonts: Boolean);
  481. var
  482. RootKey, K: HKEY;
  483. begin
  484. if PerUserFont and not WindowsVersionAtLeast(10, 0, 17134) then begin
  485. { Per-user fonts require Windows 10 Version 1803 (10.0.17134) or newer. }
  486. if not WarnedPerUserFonts then begin
  487. Log('Failed to set value in Fonts registry key: per-user fonts are not supported by this version of Windows.');
  488. WarnedPerUserFonts := True;
  489. end;
  490. end else begin
  491. { 64-bit Windows note: The Fonts key is evidently exempt from registry
  492. redirection. When a 32-bit app writes to the Fonts key, it's the main
  493. 64-bit key that is modified. (There is actually a Fonts key under
  494. Wow6432Node but it appears it's never used or updated.)
  495. Also: We don't bother with any FS redirection stuff here. I'm not sure
  496. it's safe to disable FS redirection when calling AddFontResource, or
  497. if it would even work. Users should be installing their fonts to the
  498. Fonts directory instead of the System directory anyway. }
  499. if PerUserFont then
  500. RootKey := HKEY_CURRENT_USER
  501. else
  502. RootKey := HKEY_LOCAL_MACHINE;
  503. if RegOpenKeyExView(rvDefault, RootKey, 'Software\Microsoft\Windows NT\CurrentVersion\Fonts', 0,
  504. KEY_SET_VALUE, K) = ERROR_SUCCESS then begin
  505. if RegSetValueEx(K, PChar(FontName), 0, REG_SZ, PChar(Filename),
  506. (Length(Filename)+1)*SizeOf(Filename[1])) <> ERROR_SUCCESS then
  507. Log('Failed to set value in Fonts registry key.');
  508. RegCloseKey(K);
  509. end
  510. else
  511. Log('Failed to open Fonts registry key.');
  512. end;
  513. if AddToFontTableNow then begin
  514. repeat
  515. { Note: AddFontResource doesn't set the thread's last error code }
  516. if AddFontResource(PChar(Filename)) <> 0 then begin
  517. SendNotifyMessage(HWND_BROADCAST, WM_FONTCHANGE, 0, 0);
  518. Break;
  519. end;
  520. until AbortRetryIgnoreTaskDialogMsgBox(
  521. AddPeriod(FmtSetupMessage1(msgErrorFunctionFailedNoCode, 'AddFontResource')),
  522. [SetupMessages[msgAbortRetryIgnoreRetry], SetupMessages[msgAbortRetryIgnoreIgnore], SetupMessages[msgAbortRetryIgnoreCancel]]);
  523. end;
  524. end;
  525. procedure SetFileLocationFilename(const LocationEntry: Integer;
  526. Filename: String);
  527. var
  528. LowercaseFilename: String;
  529. Hash: Longint;
  530. I: Integer;
  531. begin
  532. Filename := PathExpand(Filename);
  533. LowercaseFilename := PathLowercase(Filename);
  534. Hash := GetCRC32(LowercaseFilename[1], Length(LowercaseFilename)*SizeOf(LowercaseFilename[1]));
  535. { If Filename was already associated with another LocationEntry,
  536. disassociate it. If we *don't* do this, then this script won't
  537. produce the expected result:
  538. [Files]
  539. Source: "fileA"; DestName: "file2"
  540. Source: "fileB"; DestName: "file2"
  541. Source: "fileA"; DestName: "file1"
  542. 1. It extracts fileA under the name "file2"
  543. 2. It extracts fileB under the name "file2"
  544. 3. It copies file2 to file1, thinking a copy of fileA was still
  545. stored in file2.
  546. }
  547. for I := 0 to FileLocationFilenames.Count-1 do
  548. if (Longint(FileLocationFilenames.Objects[I]) = Hash) and
  549. (PathLowercase(FileLocationFilenames[I]) = LowercaseFilename) then begin
  550. FileLocationFilenames[I] := '';
  551. FileLocationFilenames.Objects[I] := nil;
  552. Break;
  553. end;
  554. FileLocationFilenames[LocationEntry] := Filename;
  555. FileLocationFilenames.Objects[LocationEntry] := Pointer(Hash);
  556. end;
  557. procedure ApplyPermissions(const DisableFsRedir: Boolean;
  558. const Filename: String; const PermsEntry: Integer);
  559. var
  560. Attr: DWORD;
  561. P: PSetupPermissionEntry;
  562. begin
  563. if PermsEntry <> -1 then begin
  564. Attr := GetFileAttributesRedir(DisableFsRedir, Filename);
  565. if (Attr <> INVALID_FILE_ATTRIBUTES) and (Attr and FILE_ATTRIBUTE_DIRECTORY = 0) then begin
  566. LogFmt('Setting permissions on file: %s', [Filename]);
  567. P := Entries[sePermission][PermsEntry];
  568. if not GrantPermissionOnFile(DisableFsRedir, Filename,
  569. TGrantPermissionEntry(Pointer(P.Permissions)^),
  570. Length(P.Permissions) div SizeOf(TGrantPermissionEntry)) then
  571. LogFmt('Failed to set permissions on file (%d).', [GetLastError]);
  572. end;
  573. end;
  574. end;
  575. procedure ApplyNTFSCompression(const DisableFsRedir: Boolean;
  576. const Filename: String; const Compress: Boolean);
  577. begin
  578. if Compress then
  579. LogFmt('Setting NTFS compression on file: %s', [Filename])
  580. else
  581. LogFmt('Unsetting NTFS compression on file: %s', [Filename]);
  582. if not SetNTFSCompressionRedir(DisableFsRedir, Filename, Compress) then
  583. LogFmt('Failed to set NTFS compression state (%d).', [GetLastError]);
  584. end;
  585. procedure DoHandleFailedDeleteOrMoveFileTry(const Func, TempFile, DestFile: String;
  586. const LastError: DWORD; var RetriesLeft: Integer; var LastOperation: String;
  587. var NeedsRestart, ReplaceOnRestart, DoBreak, DoContinue: Boolean);
  588. begin
  589. { Automatically retry. Wait with replace on restart until no
  590. retries left, unless we already know we're going to restart. }
  591. if ((RetriesLeft = 0) or NeedsRestart) and
  592. (foRestartReplace in CurFile^.Options) and IsAdmin then begin
  593. LogFmt('%s: The existing file appears to be in use (%d). ' +
  594. 'Will replace on restart.', [Func, LastError]);
  595. LastOperation := SetupMessages[msgErrorRestartReplace];
  596. NeedsRestart := True;
  597. RestartReplace(DisableFsRedir, TempFile, DestFile);
  598. ReplaceOnRestart := True;
  599. DoBreak := True;
  600. DoContinue := False;
  601. end else if RetriesLeft > 0 then begin
  602. LogFmt('%s: The existing file appears to be in use (%d). ' +
  603. 'Retrying.', [Func, LastError]);
  604. Dec(RetriesLeft);
  605. Sleep(1000);
  606. ProcessEvents;
  607. DoBreak := False;
  608. DoContinue := True;
  609. end else begin
  610. DoBreak := False;
  611. DoContinue := False;
  612. end;
  613. end;
  614. function AskOverwrite(const DestFile, Instruction, Caption: string; const ButtonLabels: array of String;
  615. const VerificationText: String; const Typ: TMsgBoxType; const Default, Overwrite: Integer;
  616. var OverwriteAll: TOverwriteAll): Boolean;
  617. var
  618. VerificationFlagChecked: BOOL;
  619. begin
  620. if OverwriteAll = oaKeep then
  621. Result := False { The user already said to keep (=not overwrite) all }
  622. else begin
  623. Result := LoggedTaskDialogMsgBox('', Instruction, DestFile + SNewLine2 + Caption, '',
  624. Typ, MB_YESNO, ButtonLabels, 0, True, Default, VerificationText, @VerificationFlagChecked) = Overwrite;
  625. if VerificationFlagChecked then begin
  626. if Result then
  627. OverwriteAll := oaOverwrite
  628. else
  629. OverwriteAll := oaKeep;
  630. end;
  631. end;
  632. end;
  633. var
  634. ProgressUpdated: Boolean;
  635. LastOperation: String;
  636. CurFileLocation: PSetupFileLocationEntry;
  637. SourceFile, DestFile, TempFile, FontFilename: String;
  638. DestFileExists, DestFileExistedBefore, CheckedDestFileExistedBefore,
  639. TempFileLeftOver, AllowFileToBeDuplicated, ReplaceOnRestart, DoBreak,
  640. DoContinue: Boolean;
  641. Failed: String;
  642. CurFileVersionInfoValid: Boolean;
  643. CurFileVersionInfo, ExistingVersionInfo: TFileVersionNumbers;
  644. CurFileDateValid, ExistingFileDateValid: Boolean;
  645. IsProtectedFile, AllowTimeStampComparison: Boolean;
  646. DeleteFlags: Longint;
  647. CurFileDate, ExistingFileDate: TFileTime;
  648. RegisterRec: PRegisterFilesListRec;
  649. RetriesLeft: Integer;
  650. LastError: DWORD;
  651. DestF, SourceF: TFile;
  652. Flags: TMakeDirFlags;
  653. Overwrite, PerUserFont: Boolean;
  654. label Retry, Skip;
  655. begin
  656. Log('-- File entry --');
  657. CheckedDestFileExistedBefore := False;
  658. DestFileExistedBefore := False; { prevent warning }
  659. if CurFile^.LocationEntry <> -1 then
  660. CurFileLocation := PSetupFileLocationEntry(Entries[seFileLocation][CurFile^.LocationEntry])
  661. else
  662. CurFileLocation := nil;
  663. Retry:
  664. DestFile := '';
  665. TempFile := '';
  666. TempFileLeftOver := False;
  667. ProgressUpdated := False;
  668. var PreviousProgress := CurProgress;
  669. LastOperation := '';
  670. Failed := '';
  671. try
  672. try
  673. ReplaceOnRestart := False;
  674. DeleteFlags := 0;
  675. if DisableFsRedir then
  676. DeleteFlags := DeleteFlags or utDeleteFile_DisableFsRedir;
  677. if foRegisterServer in CurFile^.Options then
  678. DeleteFlags := DeleteFlags or utDeleteFile_RegisteredServer;
  679. if foRegisterTypeLib in CurFile^.Options then
  680. DeleteFlags := DeleteFlags or utDeleteFile_RegisteredTypeLib;
  681. if foUninsRestartDelete in CurFile^.Options then
  682. DeleteFlags := DeleteFlags or utDeleteFile_RestartDelete;
  683. if foUninsRemoveReadOnly in CurFile^.Options then
  684. DeleteFlags := DeleteFlags or utDeleteFile_RemoveReadOnly;
  685. if foGacInstall in CurFile^.Options then
  686. DeleteFlags := DeleteFlags or utDeleteFile_GacInstalled;
  687. FontFilename := '';
  688. { Determine the destination filename }
  689. try
  690. case CurFile^.FileType of
  691. ftUninstExe: DestFile := UninstallExeFilename;
  692. else
  693. if ADestFile = '' then
  694. DestFile := ExpandConst(CurFile^.DestName)
  695. else
  696. DestFile := ADestFile;
  697. end;
  698. DestFile := PathExpand(DestFile);
  699. except
  700. { If an exception occurred, reset DestFile back to an empty string
  701. so the error message doesn't show an unexpanded name }
  702. DestFile := '';
  703. raise;
  704. end;
  705. { Update the status and filename labels }
  706. if foDownload in CurFile^.Options then
  707. SetStatusLabelText(SetupMessages[msgStatusDownloadFiles], False)
  708. else
  709. SetStatusLabelText(SetupMessages[msgStatusExtractFiles], False);
  710. SetFilenameLabelText(DestFile, True);
  711. LogFmt('Dest filename: %s', [DestFile]);
  712. if DisableFsRedir <> InstallDefaultDisableFsRedir then begin
  713. if DisableFsRedir then
  714. Log('Non-default bitness: 64-bit')
  715. else
  716. Log('Non-default bitness: 32-bit');
  717. end;
  718. { See if it's a protected system file. }
  719. if IsProtectedSystemFile(DisableFsRedir, DestFile) then begin
  720. Log('Dest file is protected by Windows File Protection.');
  721. IsProtectedFile := (CurFile^.FileType = ftUserFile);
  722. end else
  723. IsProtectedFile := False;
  724. DestFileExists := NewFileExistsRedir(DisableFsRedir, DestFile);
  725. if not CheckedDestFileExistedBefore then begin
  726. DestFileExistedBefore := DestFileExists;
  727. CheckedDestFileExistedBefore := True;
  728. end;
  729. if DestFileExistedBefore then
  730. DeleteFlags := DeleteFlags or utDeleteFile_ExistedBeforeInstall;
  731. var CurFileDateDidRead := True; { Set to False later if needed }
  732. if Assigned(CurFileLocation) then begin
  733. if floTimeStampInUTC in CurFileLocation^.Flags then
  734. CurFileDate := CurFileLocation^.SourceTimeStamp
  735. else
  736. LocalFileTimeToFileTime(CurFileLocation^.SourceTimeStamp, CurFileDate);
  737. CurFileDateValid := True;
  738. end else if Assigned(AExternalFileDate) then begin
  739. CurFileDate := AExternalFileDate^;
  740. CurFileDateValid := CurFileDate.HasTime;
  741. end else if not(foDownload in CurFile^.Options) then
  742. CurFileDateValid := GetFileDateTime(DisableFsRedir, AExternalSourceFile, CurFileDate)
  743. else begin
  744. CurFileDateValid := False;
  745. CurFileDateDidRead := False;
  746. end;
  747. if CurFileDateValid then
  748. LogFmt('Time stamp of our file: %s', [FileTimeToStr(CurFileDate)])
  749. else if CurFileDateDidRead then
  750. Log('Time stamp of our file: (failed to read)');
  751. if DestFileExists then begin
  752. Log('Dest file exists.');
  753. if foOnlyIfDoesntExist in CurFile^.Options then begin
  754. Log('Skipping due to "onlyifdoesntexist" flag.');
  755. goto Skip;
  756. end;
  757. LastOperation := SetupMessages[msgErrorReadingExistingDest];
  758. ExistingFileDateValid := GetFileDateTime(DisableFsRedir, DestFile, ExistingFileDate);
  759. if ExistingFileDateValid then
  760. LogFmt('Time stamp of existing file: %s', [FileTimeToStr(ExistingFileDate)])
  761. else
  762. Log('Time stamp of existing file: (failed to read)');
  763. { Compare version info }
  764. if not(foIgnoreVersion in CurFile^.Options) then begin
  765. AllowTimeStampComparison := False;
  766. { Read version info of file being installed }
  767. if foDownload in CurFile^.Options then
  768. InternalError('Unexpected Download flag');
  769. if foExtractArchive in CurFile^.Options then
  770. InternalError('Unexpected ExtractArchive flag');
  771. if Assigned(CurFileLocation) then begin
  772. CurFileVersionInfoValid := floVersionInfoValid in CurFileLocation^.Flags;
  773. CurFileVersionInfo.MS := CurFileLocation^.FileVersionMS;
  774. CurFileVersionInfo.LS := CurFileLocation^.FileVersionLS;
  775. end
  776. else
  777. CurFileVersionInfoValid := GetVersionNumbersRedir(DisableFsRedir,
  778. PathExpand(AExternalSourceFile), CurFileVersionInfo);
  779. if CurFileVersionInfoValid then
  780. LogFmt('Version of our file: %u.%u.%u.%u',
  781. [LongRec(CurFileVersionInfo.MS).Hi, LongRec(CurFileVersionInfo.MS).Lo,
  782. LongRec(CurFileVersionInfo.LS).Hi, LongRec(CurFileVersionInfo.LS).Lo])
  783. else
  784. Log('Version of our file: (none)');
  785. { Does the existing file have version info? }
  786. if GetVersionNumbersRedir(DisableFsRedir, PathExpand(DestFile), ExistingVersionInfo) then begin
  787. { If the file being installed has no version info, or the existing
  788. file is a newer version... }
  789. LogFmt('Version of existing file: %u.%u.%u.%u',
  790. [LongRec(ExistingVersionInfo.MS).Hi, LongRec(ExistingVersionInfo.MS).Lo,
  791. LongRec(ExistingVersionInfo.LS).Hi, LongRec(ExistingVersionInfo.LS).Lo]);
  792. if not CurFileVersionInfoValid or
  793. ((ExistingVersionInfo.MS > CurFileVersionInfo.MS) or
  794. ((ExistingVersionInfo.MS = CurFileVersionInfo.MS) and
  795. (ExistingVersionInfo.LS > CurFileVersionInfo.LS))) then begin
  796. { No version info, or existing file is newer, ask user what to do unless we shouldn't }
  797. if (foPromptIfOlder in CurFile^.Options) and not IsProtectedFile then begin
  798. if PromptIfOlderOverwriteAll <> oaOverwrite then begin
  799. Overwrite := AskOverwrite(DestFile, SetupMessages[msgExistingFileNewerSelectAction],
  800. SetupMessages[msgExistingFileNewer2],
  801. [SetupMessages[msgExistingFileNewerKeepExisting], SetupMessages[msgExistingFileNewerOverwriteExisting]],
  802. SetupMessages[msgExistingFileNewerOverwriteOrKeepAll],
  803. mbError, IDYES, IDNO, PromptIfOlderOverwriteAll);
  804. if not Overwrite then begin
  805. Log('User opted not to overwrite the existing file. Skipping.');
  806. goto Skip;
  807. end;
  808. end;
  809. end else begin
  810. Log('Existing file is a newer version. Skipping.');
  811. goto Skip;
  812. end;
  813. end
  814. else begin
  815. { If the existing file and the file being installed are the same
  816. version... }
  817. if (ExistingVersionInfo.MS = CurFileVersionInfo.MS) and
  818. (ExistingVersionInfo.LS = CurFileVersionInfo.LS) and
  819. not(foOverwriteSameVersion in CurFile^.Options) then begin
  820. if foReplaceSameVersionIfContentsDiffer in CurFile^.Options then begin
  821. { Get the two files' SHA-256 hashes and compare them }
  822. var ExistingFileHash: TSHA256Digest;
  823. if TryToGetSHA256OfFile(DisableFsRedir, DestFile, ExistingFileHash) then begin
  824. var CurFileHash: TSHA256Digest;
  825. if Assigned(CurFileLocation) then
  826. CurFileHash := CurFileLocation^.SHA256Sum
  827. else begin
  828. LastOperation := SetupMessages[msgErrorReadingSource];
  829. { This GetSHA256OfFile call could raise an exception, but
  830. it's very unlikely since we were already able to
  831. successfully read the file's version info. }
  832. CurFileHash := GetSHA256OfFile(DisableFsRedir, AExternalSourceFile);
  833. LastOperation := SetupMessages[msgErrorReadingExistingDest];
  834. end;
  835. { If the two files' SHA-256 hashes are equal, skip the file }
  836. if SHA256DigestsEqual(ExistingFileHash, CurFileHash) then begin
  837. Log('Existing file''s SHA-256 hash matches our file. Skipping.');
  838. goto Skip;
  839. end;
  840. Log('Existing file''s SHA-256 hash is different from our file. Proceeding.');
  841. end
  842. else
  843. Log('Failed to read existing file''s SHA-256 hash. Proceeding.');
  844. end
  845. else begin
  846. { Skip the file or fall back to time stamp comparison }
  847. if not(foCompareTimeStamp in CurFile^.Options) then begin
  848. Log('Same version. Skipping.');
  849. goto Skip;
  850. end;
  851. AllowTimeStampComparison := True;
  852. end;
  853. end;
  854. end;
  855. end
  856. else begin
  857. Log('Version of existing file: (none)');
  858. { If neither the existing file nor our file have version info,
  859. allow time stamp comparison }
  860. if not CurFileVersionInfoValid then
  861. AllowTimeStampComparison := True;
  862. end;
  863. end
  864. else begin
  865. { When foIgnoreVersion is in Options, always allow time stamp
  866. comparison }
  867. AllowTimeStampComparison := True;
  868. end;
  869. { Fall back to comparing time stamps if needed }
  870. if AllowTimeStampComparison and
  871. (foCompareTimeStamp in CurFile^.Options) then begin
  872. if foDownload in CurFile^.Options then
  873. InternalError('Unexpected Download flag');
  874. if not CurFileDateValid or not ExistingFileDateValid then begin
  875. { If we failed to read one of the time stamps, do the safe thing
  876. and just skip the file }
  877. Log('Couldn''t read time stamp. Skipping.');
  878. goto Skip;
  879. end;
  880. if CompareFileTime(ExistingFileDate, CurFileDate) = 0 then begin
  881. { Same time stamp }
  882. Log('Same time stamp. Skipping.');
  883. goto Skip;
  884. end;
  885. if CompareFileTime(ExistingFileDate, CurFileDate) > 0 then begin
  886. { Existing file has a later time stamp, ask user what to do unless we shouldn't }
  887. if (foPromptIfOlder in CurFile^.Options) and not IsProtectedFile then begin
  888. if PromptIfOlderOverwriteAll <> oaOverwrite then begin
  889. Overwrite := AskOverwrite(DestFile, SetupMessages[msgExistingFileNewerSelectAction],
  890. SetupMessages[msgExistingFileNewer2],
  891. [SetupMessages[msgExistingFileNewerKeepExisting], SetupMessages[msgExistingFileNewerOverwriteExisting]],
  892. SetupMessages[msgExistingFileNewerOverwriteOrKeepAll],
  893. mbError, IDYES, IDNO, PromptIfOlderOverwriteAll);
  894. if not Overwrite then begin
  895. Log('User opted not to overwrite the existing file. Skipping.');
  896. goto Skip;
  897. end;
  898. end;
  899. end else begin
  900. Log('Existing file has a later time stamp. Skipping.');
  901. goto Skip;
  902. end;
  903. end;
  904. end;
  905. LastOperation := '';
  906. { Don't attempt to replace an existing protected system file.
  907. (Do this *after* the version numbers of the new & existing files
  908. have been logged.) }
  909. if IsProtectedFile then begin
  910. Log('Existing file is protected by Windows File Protection. Skipping.');
  911. goto Skip;
  912. end;
  913. { If file already exists and foConfirmOverwrite is in Options, ask the user what to do }
  914. if foConfirmOverwrite in CurFile^.Options then begin
  915. if ConfirmOverwriteOverwriteAll <> oaOverwrite then begin
  916. Overwrite := AskOverwrite(DestFile, SetupMessages[msgFileExistsSelectAction],
  917. SetupMessages[msgFileExists2],
  918. [SetupMessages[msgFileExistsOverwriteExisting], SetupMessages[msgFileExistsKeepExisting]],
  919. SetupMessages[msgFileExistsOverwriteOrKeepAll],
  920. mbConfirmation, IDNO, IDYES, ConfirmOverwriteOverwriteAll);
  921. if not Overwrite then begin
  922. Log('User opted not to overwrite the existing file. Skipping.');
  923. goto Skip;
  924. end;
  925. end;
  926. end;
  927. { Check if existing file is read-only }
  928. while True do begin
  929. var ExistingFileAttr := GetFileAttributesRedir(DisableFsRedir, DestFile);
  930. if (ExistingFileAttr <> INVALID_FILE_ATTRIBUTES) and
  931. (ExistingFileAttr and FILE_ATTRIBUTE_READONLY <> 0) then begin
  932. if not(foOverwriteReadOnly in CurFile^.Options) and
  933. AbortRetryIgnoreTaskDialogMsgBox(
  934. DestFile + SNewLine2 + SetupMessages[msgExistingFileReadOnly2],
  935. [SetupMessages[msgExistingFileReadOnlyRetry], SetupMessages[msgExistingFileReadOnlyKeepExisting], SetupMessages[msgAbortRetryIgnoreCancel]]) then begin
  936. Log('User opted not to strip the existing file''s read-only attribute. Skipping.');
  937. goto Skip;
  938. end;
  939. LastOperation := SetupMessages[msgErrorChangingAttr];
  940. if SetFileAttributesRedir(DisableFsRedir, DestFile,
  941. ExistingFileAttr and not FILE_ATTRIBUTE_READONLY) then
  942. Log('Stripped read-only attribute.')
  943. else
  944. Log('Failed to strip read-only attribute.');
  945. if foOverwriteReadOnly in CurFile^.Options then
  946. Break; { don't retry }
  947. end
  948. else
  949. Break;
  950. end;
  951. end
  952. else begin
  953. if (foOnlyIfDestFileExists in CurFile^.Options) and not DestFileExistedBefore then begin
  954. Log('Skipping due to "onlyifdestfileexists" flag.');
  955. goto Skip;
  956. end;
  957. end;
  958. Log('Installing the file.');
  959. { Locate source file }
  960. SourceFile := AExternalSourceFile; { Empty string if not external }
  961. if DisableFsRedir = InstallDefaultDisableFsRedir then begin
  962. { If the file is compressed in the setup package, has the same file
  963. already been copied somewhere else? If so, just make a duplicate of
  964. that file instead of extracting it over again. }
  965. if (SourceFile = '') and (FileLocationFilenames <> nil) and
  966. (FileLocationFilenames[CurFile^.LocationEntry] <> '') and
  967. NewFileExistsRedir(DisableFsRedir, FileLocationFilenames[CurFile^.LocationEntry]) then
  968. SourceFile := FileLocationFilenames[CurFile^.LocationEntry];
  969. AllowFileToBeDuplicated := (SourceFile = '');
  970. end
  971. else begin
  972. { This file uses a non-default FS redirection setting. Files in
  973. FileLocationFilenames are assumed to have been installed with the
  974. default FS redirection setting, so we can't use a file in
  975. FileLocationFilenames as the source, or put this file there. }
  976. AllowFileToBeDuplicated := False;
  977. end;
  978. { Download or extract or copy the file to a temporary file. Create the destination
  979. file's directory if it didn't already exist. }
  980. LastOperation := SetupMessages[msgErrorCreatingTemp];
  981. TempFile := GenerateUniqueName(DisableFsRedir, PathExtractPath(DestFile), '.tmp');
  982. Flags := [];
  983. if foUninsNeverUninstall in CurFile^.Options then Include(Flags, mdNoUninstall);
  984. if foDeleteAfterInstall in CurFile^.Options then Include(Flags, mdDeleteAfterInstall);
  985. MakeDir(UninstLog, DisableFsRedir, PathExtractDir(TempFile), Flags);
  986. DestF := TFileRedir.Create(DisableFsRedir, TempFile, fdCreateAlways, faReadWrite, fsNone);
  987. try
  988. TempFileLeftOver := True;
  989. try
  990. ProgressUpdated := True;
  991. LastOperation := SetupMessages[msgErrorReadingSource];
  992. if SourceFile = '' then begin
  993. { Decompress a file }
  994. FileExtractor.SeekTo(CurFileLocation^, InternalProgressProc);
  995. LastOperation := SetupMessages[msgErrorCopying];
  996. FileExtractor.DecompressFile(CurFileLocation^, DestF, InternalProgressProc,
  997. not (foDontVerifyChecksum in CurFile^.Options));
  998. end
  999. else if foExtractArchive in CurFile^.Options then begin
  1000. { Extract a file from archive. Note: ISSigVerify for archive has
  1001. already been handled by RecurseExternalArchiveCopyFiles. }
  1002. LastOperation := SetupMessages[msgErrorExtracting];
  1003. var MaxProgress := CurProgress;
  1004. Inc(MaxProgress, AExternalSize);
  1005. ArchiveFindExtract(StrToInt(SourceFile), DestF, ExternalProgressProc64, MaxProgress);
  1006. end
  1007. else if foDownload in CurFile^.Options then begin
  1008. { Download a file with or without ISSigVerify. Note: estimate of
  1009. extra .issig size has already been added to CurFile's ExternalSize. }
  1010. LastOperation := SetupMessages[msgErrorDownloading];
  1011. const DownloadUserName = ExpandConst(CurFile^.DownloadUserName);
  1012. const DownloadPassword = ExpandConst(CurFile^.DownloadPassword);
  1013. var MaxProgress := CurProgress;
  1014. Inc(MaxProgress, AExternalSize);
  1015. if CurFile^.Verification.Typ = fvISSig then begin
  1016. const ISSigTempFile = TempFile + ISSigExt;
  1017. const ISSigDestF = TFileRedir.Create(DisableFsRedir, ISSigTempFile, fdCreateAlways, faReadWrite, fsNone);
  1018. try
  1019. { Download the .issig file }
  1020. const ISSigUrl = GetISSigUrl(SourceFile, ExpandConst(CurFile^.DownloadISSigSource));
  1021. DownloadFile(ISSigUrl, DownloadUserName, DownloadPassword,
  1022. ISSigDestF, NoVerification, '', JustProcessEventsProc64, 0, ProcessEvents);
  1023. FreeAndNil(ISSigDestF);
  1024. { Download and verify the actual file }
  1025. DownloadFile(SourceFile, DownloadUserName, DownloadPassword,
  1026. DestF, CurFile^.Verification, TempFile, ExternalProgressProc64, MaxProgress, ProcessEvents);
  1027. finally
  1028. ISSigDestF.Free;
  1029. { Delete the .issig file }
  1030. DeleteFileRedir(DisableFsRedir, ISSigTempFile);
  1031. end;
  1032. end else
  1033. DownloadFile(SourceFile, DownloadUserName, DownloadPassword,
  1034. DestF, CurFile^.Verification, '', ExternalProgressProc64, MaxProgress, ProcessEvents);
  1035. end
  1036. else begin
  1037. { Copy a duplicated non-external file, or an external file }
  1038. SourceF := TFileRedir.Create(DisableFsRedir, SourceFile, fdOpenExisting, faRead, fsRead);
  1039. try
  1040. LastOperation := SetupMessages[msgErrorCopying];
  1041. if Assigned(CurFileLocation) then
  1042. CopySourceFileToDestFile(SourceF, DestF, NoVerification,
  1043. '', CurFileLocation^.OriginalSize)
  1044. else
  1045. CopySourceFileToDestFile(SourceF, DestF, CurFile^.Verification,
  1046. SourceFile, AExternalSize);
  1047. finally
  1048. SourceF.Free;
  1049. end;
  1050. end;
  1051. except
  1052. { If an exception occurred, put progress meter back to where it was }
  1053. ProgressUpdated := False;
  1054. SetProgress(PreviousProgress);
  1055. raise;
  1056. end;
  1057. { Set time/date stamp }
  1058. if CurFileDateValid then
  1059. SetFileTime(DestF.Handle, nil, nil, @CurFileDate);
  1060. { If it's the uninstall program, bind the messages }
  1061. if CurFile^.FileType = ftUninstExe then begin
  1062. AllowFileToBeDuplicated := False;
  1063. MarkExeHeader(DestF, SetupExeModeUninstaller);
  1064. if not(shSignedUninstaller in SetupHeader.Options) and
  1065. not DetachedUninstMsgFile then
  1066. BindUninstallMsgDataToExe(ExpandedAppId, DestF);
  1067. end;
  1068. finally
  1069. DestF.Free;
  1070. end;
  1071. { If it's a font, unregister the existing one to ensure that Windows
  1072. 'notices' the file is being replaced, and to increase the chances
  1073. of the file being unlocked/closed before we replace it. }
  1074. if CurFile^.InstallFontName <> '' then begin
  1075. LastOperation := '';
  1076. FontFilename := ShortenOrExpandFontFilename(DestFile);
  1077. if DestFileExistedBefore then
  1078. RemoveFontResource(PChar(FontFilename));
  1079. end;
  1080. { Delete existing version of file, if any. If it can't be deleted
  1081. because it's in use and the "restartreplace" flag was specified
  1082. on the entry, register it to be replaced when the system is
  1083. restarted. Do retry deletion before doing this. }
  1084. if DestFileExists and (CurFile^.FileType <> ftUninstExe) then begin
  1085. LastOperation := SetupMessages[msgErrorReplacingExistingFile];
  1086. RetriesLeft := 4;
  1087. while not DeleteFileRedir(DisableFsRedir, DestFile) do begin
  1088. { Couldn't delete the existing file... }
  1089. LastError := GetLastError;
  1090. { If the file inexplicably vanished, it's not a problem }
  1091. if LastError = ERROR_FILE_NOT_FOUND then
  1092. Break;
  1093. { Does the error code indicate that it is possibly in use? }
  1094. if LastErrorIndicatesPossiblyInUse(LastError, False) then begin
  1095. DoHandleFailedDeleteOrMoveFileTry('DeleteFile', TempFile, DestFile,
  1096. LastError, RetriesLeft, LastOperation, NeedsRestart, ReplaceOnRestart,
  1097. DoBreak, DoContinue);
  1098. if DoBreak then
  1099. Break
  1100. else if DoContinue then
  1101. Continue;
  1102. end;
  1103. { Some other error occurred, or we ran out of tries }
  1104. SetLastError(LastError);
  1105. Win32ErrorMsg('DeleteFile');
  1106. end;
  1107. end;
  1108. { Rename the temporary file to the new name now, unless the file is
  1109. to be replaced when the system is restarted, or if the file is the
  1110. uninstall program and an existing uninstall program already exists.
  1111. If it can't be renamed and the "restartreplace" flag was specified
  1112. on the entry, register it to be replaced when the system is
  1113. restarted. Do retry renaming before doing this. }
  1114. if not (ReplaceOnRestart or
  1115. ((CurFile^.FileType = ftUninstExe) and DestFileExistedBefore)) then begin
  1116. LastOperation := SetupMessages[msgErrorRenamingTemp];
  1117. { Since the DeleteFile above succeeded you would expect the rename to
  1118. also always succeed, but if it doesn't retry anyway. }
  1119. RetriesLeft := 4;
  1120. while not MoveFileRedir(DisableFsRedir, TempFile, DestFile) do begin
  1121. { Couldn't rename the temporary file... }
  1122. LastError := GetLastError;
  1123. { Does the error code indicate that it is possibly in use? }
  1124. if LastErrorIndicatesPossiblyInUse(LastError, True) then begin
  1125. DoHandleFailedDeleteOrMoveFileTry('MoveFile', TempFile, DestFile,
  1126. LastError, RetriesLeft, LastOperation, NeedsRestart, ReplaceOnRestart,
  1127. DoBreak, DoContinue);
  1128. if DoBreak then
  1129. Break
  1130. else if DoContinue then
  1131. Continue;
  1132. end;
  1133. { Some other error occurred, or we ran out of tries }
  1134. SetLastError(LastError);
  1135. Win32ErrorMsg('MoveFile'); { Throws an exception }
  1136. end;
  1137. { If ReplaceOnRestart is still False the rename succeeded so handle this.
  1138. Then set any file attributes. }
  1139. if not ReplaceOnRestart then begin
  1140. TempFileLeftOver := False;
  1141. TempFile := '';
  1142. LastOperation := '';
  1143. Log('Successfully installed the file.');
  1144. if AllowFileToBeDuplicated then
  1145. SetFileLocationFilename(CurFile^.LocationEntry, DestFile);
  1146. if foDeleteAfterInstall in CurFile^.Options then
  1147. DeleteFilesAfterInstallList.AddObject(DestFile, Pointer(Ord(DisableFsRedir)));
  1148. { Set file attributes *after* renaming the file since Novell
  1149. reportedly can't rename read-only files. }
  1150. AddAttributesToFile(DisableFsRedir, DestFile, CurFile^.Attribs);
  1151. end;
  1152. end;
  1153. { Leave the temporary file in place for now if the file is to be
  1154. replaced when the system is restarted, or if the file is the uninstall
  1155. program and an existing uninstall program already exists. }
  1156. if ReplaceOnRestart or
  1157. ((CurFile^.FileType = ftUninstExe) and DestFileExistedBefore) then begin
  1158. if CurFile^.FileType = ftUninstExe then
  1159. UninstallTempExeFilename := TempFile;
  1160. TempFileLeftOver := False;
  1161. LastOperation := '';
  1162. Log('Leaving temporary file in place for now.');
  1163. if AllowFileToBeDuplicated then
  1164. SetFileLocationFilename(CurFile^.LocationEntry, TempFile);
  1165. AddAttributesToFile(DisableFsRedir, TempFile, CurFile^.Attribs);
  1166. end;
  1167. { If it's a font, register it }
  1168. if CurFile^.InstallFontName <> '' then begin
  1169. LastOperation := '';
  1170. LogFmt('Registering file as a font ("%s")', [CurFile^.InstallFontName]);
  1171. PerUserFont := not IsAdminInstallMode;
  1172. InstallFont(FontFilename, CurFile^.InstallFontName, PerUserFont, not ReplaceOnRestart, WarnedPerUserFonts);
  1173. DeleteFlags := DeleteFlags or utDeleteFile_IsFont;
  1174. if PerUserFont then
  1175. DeleteFlags := DeleteFlags or utDeleteFile_PerUserFont;
  1176. end;
  1177. { There were no errors so add the uninstall log entry, unless the file
  1178. is the uninstall program, or if it has the foSharedFile flag; shared
  1179. files are handled below. }
  1180. LastOperation := '';
  1181. if CurFile^.FileType <> ftUninstExe then begin
  1182. if not(foUninsNeverUninstall in CurFile^.Options) and
  1183. not(foSharedFile in CurFile^.Options) then begin
  1184. UninstLog.Add(utDeleteFile, [DestFile, TempFile,
  1185. CurFile^.InstallFontName, FontFilename,
  1186. CurFile^.StrongAssemblyName], DeleteFlags);
  1187. end;
  1188. end
  1189. else begin
  1190. if UninstallTempExeFilename = '' then
  1191. UninstallExeCreated := ueNew
  1192. else
  1193. UninstallExeCreated := ueReplaced;
  1194. end;
  1195. Skip:
  1196. { If foRegisterServer or foRegisterTypeLib is in Options, add the
  1197. file to RegisterFilesList for registering later.
  1198. Don't attempt to register if the file doesn't exist (which can
  1199. happen if the foOnlyIfDestFileExists flag is used). }
  1200. if ((foRegisterServer in CurFile^.Options) or
  1201. (foRegisterTypeLib in CurFile^.Options)) and
  1202. NewFileExistsRedir(DisableFsRedir, DestFile) then begin
  1203. LastOperation := '';
  1204. if foRegisterTypeLib in CurFile^.Options then
  1205. Log('Will register the file (a type library) later.')
  1206. else
  1207. Log('Will register the file (a DLL/OCX) later.');
  1208. New(RegisterRec);
  1209. RegisterRec^.Filename := DestFile;
  1210. RegisterRec^.Is64Bit := DisableFsRedir;
  1211. RegisterRec^.TypeLib := foRegisterTypeLib in CurFile^.Options;
  1212. RegisterRec^.NoErrorMessages := foNoRegError in CurFile^.Options;
  1213. RegisterFilesList.Add(RegisterRec);
  1214. end;
  1215. { If foSharedFile is in Options, increment the reference count in the
  1216. registry for the file, then add the uninstall log entry (which,
  1217. unlike non-shared files, must be done on skipped files as well;
  1218. that's why there are two places where utDeleteFile entries are
  1219. added). }
  1220. if foSharedFile in CurFile^.Options then begin
  1221. LastOperation := '';
  1222. if DisableFsRedir then begin
  1223. Log('Incrementing shared file count (64-bit).');
  1224. IncrementSharedCount(rv64Bit, DestFile, DestFileExistedBefore);
  1225. end
  1226. else begin
  1227. Log('Incrementing shared file count (32-bit).');
  1228. IncrementSharedCount(rv32Bit, DestFile, DestFileExistedBefore);
  1229. end;
  1230. if not(foUninsNeverUninstall in CurFile^.Options) then begin
  1231. DeleteFlags := DeleteFlags or utDeleteFile_SharedFile;
  1232. if DisableFsRedir then
  1233. DeleteFlags := DeleteFlags or utDeleteFile_SharedFileIn64BitKey;
  1234. if foUninsNoSharedFilePrompt in CurFile^.Options then
  1235. DeleteFlags := DeleteFlags or utDeleteFile_NoSharedFilePrompt;
  1236. UninstLog.Add(utDeleteFile, [DestFile, TempFile,
  1237. CurFile^.InstallFontName, FontFilename,
  1238. CurFile^.StrongAssemblyName], DeleteFlags);
  1239. end
  1240. else begin
  1241. if DisableFsRedir then
  1242. UninstLog.Add(utDecrementSharedCount, [DestFile],
  1243. utDecrementSharedCount_64BitKey)
  1244. else
  1245. UninstLog.Add(utDecrementSharedCount, [DestFile], 0);
  1246. end;
  1247. end;
  1248. { Apply permissions (even if the file wasn't replaced) }
  1249. LastOperation := '';
  1250. if TempFile <> '' then
  1251. ApplyPermissions(DisableFsRedir, TempFile, CurFile^.PermissionsEntry)
  1252. else
  1253. ApplyPermissions(DisableFsRedir, DestFile, CurFile^.PermissionsEntry);
  1254. { Set NTFS compression (even if the file wasn't replaced) }
  1255. if (foSetNTFSCompression in CurFile^.Options) or (foUnsetNTFSCompression in CurFile^.Options) then begin
  1256. LastOperation := '';
  1257. if TempFile <> '' then
  1258. ApplyNTFSCompression(DisableFsRedir, TempFile, foSetNTFSCompression in CurFile^.Options)
  1259. else
  1260. ApplyNTFSCompression(DisableFsRedir, DestFile, foSetNTFSCompression in CurFile^.Options);
  1261. end;
  1262. { Install into GAC (even if the file wasn't replaced) }
  1263. if foGacInstall in CurFile^.Options then begin
  1264. Log('Installing into GAC');
  1265. with TAssemblyCacheInfo.Create(rvDefault) do try
  1266. if TempFile <> '' then
  1267. InstallAssembly(TempFile)
  1268. else
  1269. InstallAssembly(DestFile);
  1270. finally
  1271. Free;
  1272. end;
  1273. end;
  1274. except
  1275. if ExceptObject is EAbort then
  1276. raise;
  1277. Failed := GetExceptMessage;
  1278. end;
  1279. finally
  1280. { If an exception occurred before TempFile was cleaned up, delete it now }
  1281. if TempFileLeftOver then
  1282. DeleteFileRedir(DisableFsRedir, TempFile);
  1283. end;
  1284. { Was there an exception? Display error message and offer to retry }
  1285. if Failed <> '' then begin
  1286. if (CurFile^.FileType = ftUninstExe) and (UninstallTempExeFilename <> '') then begin
  1287. DeleteFile(UninstallTempExeFilename);
  1288. UninstallTempExeFilename := '';
  1289. UninstallExeCreated := ueNone;
  1290. end;
  1291. if LastOperation <> '' then
  1292. LastOperation := LastOperation + SNewLine;
  1293. if not AbortRetryIgnoreTaskDialogMsgBox(
  1294. DestFile + SNewLine2 + LastOperation + Failed,
  1295. [SetupMessages[msgAbortRetryIgnoreRetry], SetupMessages[msgFileAbortRetryIgnoreSkipNotRecommended], SetupMessages[msgAbortRetryIgnoreCancel]]) then begin
  1296. if ProgressUpdated then
  1297. SetProgress(PreviousProgress);
  1298. goto Retry;
  1299. end;
  1300. end;
  1301. { Increment progress meter, if not already done so }
  1302. if not ProgressUpdated then begin
  1303. if Assigned(CurFileLocation) then { not an "external" file }
  1304. IncProgress(CurFileLocation^.OriginalSize)
  1305. else
  1306. IncProgress(AExternalSize);
  1307. end;
  1308. { Process any events between copying files }
  1309. ProcessEvents;
  1310. { Clear previous filename label in case an exception or debugger break
  1311. occurs between now and when the label for the next entry is set }
  1312. SetFilenameLabelText('', False);
  1313. end;
  1314. procedure CopyFiles(const UninstLog: TUninstallLog; const ExpandedAppId: String;
  1315. const RegisterFilesList: TList; Uninstallable: Boolean);
  1316. { Copies all the application's files }
  1317. function RecurseExternalCopyFiles(const DisableFsRedir: Boolean;
  1318. const SearchBaseDir, SearchSubDir, SearchWildcard: String; const SourceIsWildcard: Boolean;
  1319. const Excludes: TStrings; const CurFile: PSetupFileEntry; var ExpectedBytesLeft: Int64;
  1320. var ConfirmOverwriteOverwriteAll, PromptIfOlderOverwriteAll: TOverwriteAll;
  1321. var WarnedPerUserFonts: Boolean): Boolean;
  1322. begin
  1323. { Also see RecurseExternalFiles and RecurseExternalGetSizeOfFiles in Setup.MainFunc
  1324. Also see RecurseExternalArchiveCopyFiles directly below }
  1325. Result := False;
  1326. var FindData: TWin32FindData;
  1327. var H := FindFirstFileRedir(DisableFsRedir, SearchBaseDir + SearchSubDir + SearchWildcard, FindData);
  1328. if H <> INVALID_HANDLE_VALUE then begin
  1329. try
  1330. repeat
  1331. if FindData.dwFileAttributes and FILE_ATTRIBUTE_DIRECTORY = 0 then begin
  1332. var FileName: String;
  1333. if SourceIsWildcard then begin
  1334. if FindData.dwFileAttributes and FILE_ATTRIBUTE_HIDDEN <> 0 then
  1335. Continue;
  1336. FileName := FindData.cFileName;
  1337. end
  1338. else
  1339. FileName := SearchWildcard; { use the case specified in the script }
  1340. if IsExcluded(SearchSubDir + FileName, Excludes) then
  1341. Continue;
  1342. Result := True;
  1343. var SourceFile := SearchBaseDir + SearchSubDir + FileName;
  1344. { Note: CurFile^.DestName only includes a a filename if foCustomDestName is set,
  1345. see TSetupCompiler.EnumFilesProc.ProcessFileList }
  1346. var DestFile := ExpandConst(CurFile^.DestName);
  1347. if not(foCustomDestName in CurFile^.Options) then
  1348. DestFile := DestFile + SearchSubDir + FileName
  1349. else if SearchSubDir <> '' then
  1350. DestFile := PathExtractPath(DestFile) + SearchSubDir + PathExtractName(DestFile);
  1351. var Size := FindDataFileSizeToInt64(FindData);
  1352. if Size > ExpectedBytesLeft then begin
  1353. { Don't allow the progress bar to overflow if the size of the
  1354. files is greater than when we last checked }
  1355. Size := ExpectedBytesLeft;
  1356. end;
  1357. ProcessFileEntry(UninstLog, ExpandedAppId, RegisterFilesList,
  1358. CurFile, DisableFsRedir, SourceFile, DestFile, nil,
  1359. Size, ConfirmOverwriteOverwriteAll, PromptIfOlderOverwriteAll,
  1360. WarnedPerUserFonts, nil);
  1361. Dec(ExpectedBytesLeft, Size);
  1362. end;
  1363. until not FindNextFile(H, FindData);
  1364. finally
  1365. Windows.FindClose(H);
  1366. end;
  1367. end;
  1368. if foRecurseSubDirsExternal in CurFile^.Options then begin
  1369. H := FindFirstFileRedir(DisableFsRedir, SearchBaseDir + SearchSubDir + '*', FindData);
  1370. if H <> INVALID_HANDLE_VALUE then begin
  1371. try
  1372. repeat
  1373. if IsRecurseableDirectory(FindData) then
  1374. Result := RecurseExternalCopyFiles(DisableFsRedir, SearchBaseDir,
  1375. SearchSubDir + FindData.cFileName + '\', SearchWildcard,
  1376. SourceIsWildcard, Excludes, CurFile, ExpectedBytesLeft,
  1377. ConfirmOverwriteOverwriteAll, PromptIfOlderOverwriteAll,
  1378. WarnedPerUserFonts) or Result;
  1379. until not FindNextFile(H, FindData);
  1380. finally
  1381. Windows.FindClose(H);
  1382. end;
  1383. end;
  1384. end;
  1385. if SearchSubDir <> '' then begin
  1386. { If Result is False this subdir won't be created, so create it now if
  1387. CreateAllSubDirs was set }
  1388. if not Result and (foCreateAllSubDirs in CurFile.Options) then begin
  1389. var DestName := ExpandConst(CurFile^.DestName); { See above }
  1390. if not(foCustomDestName in CurFile^.Options) then
  1391. DestName := DestName + SearchSubDir
  1392. else
  1393. DestName := PathExtractPath(DestName) + SearchSubDir;
  1394. var Flags: TMakeDirFlags := [];
  1395. if foUninsNeverUninstall in CurFile^.Options then Include(Flags, mdNoUninstall);
  1396. if foDeleteAfterInstall in CurFile^.Options then Include(Flags, mdDeleteAfterInstall);
  1397. MakeDir(UninstLog, DisableFsRedir, DestName, Flags);
  1398. Result := True;
  1399. end;
  1400. end;
  1401. { When recursively searching but not picking up every file, we could
  1402. be frozen for a long time when installing from a network. Calling
  1403. ProcessEvents after every directory helps. }
  1404. ProcessEvents;
  1405. end;
  1406. function RecurseExternalArchiveCopyFiles(const DisableFsRedir: Boolean;
  1407. const ArchiveFilename: String; const Excludes: TStrings;
  1408. const CurFile: PSetupFileEntry; var ExpectedBytesLeft: Int64;
  1409. var ConfirmOverwriteOverwriteAll, PromptIfOlderOverwriteAll: TOverwriteAll;
  1410. var WarnedPerUserFonts: Boolean): Boolean;
  1411. begin
  1412. { See above }
  1413. { If the archive doesn't exist then the caller should handle this with
  1414. a msgSourceDoesntExist message. All other errors we handle ourselves
  1415. with a msgErrorExtracting message, without informing the caller, unless
  1416. you count EAbort. }
  1417. Result := NewFileExistsRedir(DisableFsRedir, ArchiveFilename);
  1418. if not Result then
  1419. Exit;
  1420. if foCustomDestName in CurFile^.Options then
  1421. InternalError('Unexpected custom DestName');
  1422. const DestDir = ExpandConst(CurFile^.DestName);
  1423. Log('-- Archive entry --');
  1424. var VerifySourceF: TFile := nil;
  1425. try
  1426. var FindData: TWin32FindData;
  1427. var H: TArchiveFindHandle := INVALID_HANDLE_VALUE;
  1428. var Failed: String;
  1429. repeat
  1430. try
  1431. if CurFile^.Verification.Typ <> fvNone then begin
  1432. if VerifySourceF = nil then
  1433. VerifySourceF := TFileRedir.Create(DisableFsRedir, ArchiveFilename, fdOpenExisting, faRead, fsRead);
  1434. var ExpectedFileHash: TSHA256Digest;
  1435. if CurFile^.Verification.Typ = fvHash then
  1436. ExpectedFileHash := CurFile^.Verification.Hash
  1437. else begin
  1438. DoISSigVerify(VerifySourceF, nil, ArchiveFilename, True, CurFile^.Verification.ISSigAllowedKeys,
  1439. ExpectedFileHash);
  1440. end;
  1441. { Can't get the SHA-256 while extracting so need to get and check it now }
  1442. const ActualFileHash = GetSHA256OfFile(VerifySourceF);
  1443. if not SHA256DigestsEqual(ActualFileHash, ExpectedFileHash) then
  1444. VerificationError(veFileHashIncorrect);
  1445. Log(VerificationSuccessfulLogMessage);
  1446. { Keep VerifySourceF open until extraction has completed to prevent TOCTOU problem }
  1447. end;
  1448. H := ArchiveFindFirstFileRedir(DisableFsRedir, ArchiveFilename, DestDir,
  1449. ExpandConst(CurFile^.ExtractArchivePassword), foRecurseSubDirsExternal in CurFile^.Options,
  1450. True, FindData);
  1451. Failed := '';
  1452. except
  1453. if ExceptObject is EAbort then
  1454. raise;
  1455. Failed := GetExceptMessage;
  1456. end;
  1457. until (Failed = '') or
  1458. AbortRetryIgnoreTaskDialogMsgBox(
  1459. ArchiveFilename + SNewLine2 + SetupMessages[msgErrorExtracting] + SNewLine + Failed,
  1460. [SetupMessages[msgAbortRetryIgnoreRetry], SetupMessages[msgFileAbortRetryIgnoreSkipNotRecommended], SetupMessages[msgAbortRetryIgnoreCancel]]);
  1461. if H <> INVALID_HANDLE_VALUE then begin
  1462. try
  1463. repeat
  1464. if FindData.dwFileAttributes and FILE_ATTRIBUTE_DIRECTORY = 0 then begin
  1465. if IsExcluded(FindData.cFileName, Excludes) then
  1466. Continue;
  1467. var SourceFile := IntToStr(H);
  1468. const DestFile = DestDir + FindData.cFileName;
  1469. var Size := FindDataFileSizeToInt64(FindData);
  1470. if Size > ExpectedBytesLeft then begin
  1471. { Don't allow the progress bar to overflow if the size of the
  1472. files is greater than when we last checked }
  1473. Size := ExpectedBytesLeft;
  1474. end;
  1475. ProcessFileEntry(UninstLog, ExpandedAppId, RegisterFilesList,
  1476. CurFile, DisableFsRedir, SourceFile, DestFile,
  1477. nil, Size, ConfirmOverwriteOverwriteAll, PromptIfOlderOverwriteAll,
  1478. WarnedPerUserFonts, @FindData.ftLastWriteTime);
  1479. Dec(ExpectedBytesLeft, Size);
  1480. end else if foCreateAllSubDirs in CurFile.Options then begin
  1481. var Flags: TMakeDirFlags := [];
  1482. if foUninsNeverUninstall in CurFile^.Options then Include(Flags, mdNoUninstall);
  1483. if foDeleteAfterInstall in CurFile^.Options then Include(Flags, mdDeleteAfterInstall);
  1484. MakeDir(UninstLog, DisableFsRedir, DestDir + FindData.cFileName, Flags);
  1485. Result := True;
  1486. end;
  1487. until not ArchiveFindNextFile(H, FindData);
  1488. finally
  1489. ArchiveFindClose(H);
  1490. end;
  1491. Log('Successfully extracted the archive.');
  1492. end else
  1493. Log('Found no files to extract.');
  1494. finally
  1495. VerifySourceF.Free;
  1496. end;
  1497. end;
  1498. var
  1499. I: Integer;
  1500. CurFileNumber: Integer;
  1501. CurFile: PSetupFileEntry;
  1502. SourceWildcard: String;
  1503. DisableFsRedir, FoundFiles: Boolean;
  1504. ConfirmOverwriteOverwriteAll, PromptIfOlderOverwriteAll: TOverwriteAll;
  1505. WarnedPerUserFonts: Boolean;
  1506. begin
  1507. ConfirmOverwriteOverwriteAll := oaUnknown;
  1508. PromptIfOlderOverwriteAll := oaUnknown;
  1509. WarnedPerUserFonts := False;
  1510. var FileLocationFilenames: TStringList := nil;
  1511. var Excludes: TStringList := nil;
  1512. try
  1513. FileLocationFilenames := TStringList.Create;
  1514. for I := 0 to Entries[seFileLocation].Count-1 do
  1515. FileLocationFilenames.Add('');
  1516. Excludes := TStringList.Create;
  1517. Excludes.StrictDelimiter := True;
  1518. Excludes.Delimiter := ',';
  1519. for CurFileNumber := 0 to Entries[seFile].Count-1 do begin
  1520. CurFile := PSetupFileEntry(Entries[seFile][CurFileNumber]);
  1521. if ((CurFile^.FileType <> ftUninstExe) or Uninstallable) and
  1522. ShouldProcessFileEntry(WizardComponents, WizardTasks, CurFile, False) then begin
  1523. DebugNotifyEntry(seFile, CurFileNumber);
  1524. NotifyBeforeInstallFileEntry(CurFile);
  1525. DisableFsRedir := InstallDefaultDisableFsRedir;
  1526. if fo32Bit in CurFile^.Options then
  1527. DisableFsRedir := False;
  1528. if fo64Bit in CurFile^.Options then begin
  1529. if not IsWin64 then
  1530. InternalError('Cannot install files to 64-bit locations on this version of Windows');
  1531. DisableFsRedir := True;
  1532. end;
  1533. if CurFile^.LocationEntry <> -1 then begin
  1534. ProcessFileEntry(UninstLog, ExpandedAppId, RegisterFilesList,
  1535. CurFile, DisableFsRedir, '', '', FileLocationFilenames, 0,
  1536. ConfirmOverwriteOverwriteAll, PromptIfOlderOverwriteAll, WarnedPerUserFonts, nil);
  1537. end
  1538. else begin
  1539. { File is an 'external' file }
  1540. if CurFile^.FileType = ftUninstExe then begin
  1541. { This is the file entry for the uninstaller program }
  1542. SourceWildcard := NewParamStr(0);
  1543. DisableFsRedir := False;
  1544. end
  1545. else
  1546. SourceWildcard := ExpandConst(CurFile^.SourceFilename);
  1547. Excludes.DelimitedText := CurFile^.Excludes;
  1548. var ProgressBefore := CurProgress;
  1549. repeat
  1550. SetProgress(ProgressBefore);
  1551. var ExpectedBytesLeft := CurFile^.ExternalSize;
  1552. if foDownload in CurFile^.Options then begin
  1553. { Archive download should have been done already by Setup.WizardForm's DownloadArchivesToExtract }
  1554. if foExtractArchive in CurFile^.Options then
  1555. InternalError('Unexpected Download flag');
  1556. if foSkipIfSourceDoesntExist in CurFile^.Options then
  1557. InternalError('Unexpected SkipIfSourceDoesntExist flag');
  1558. if not(foCustomDestName in CurFile^.Options) then
  1559. InternalError('Expected CustomDestName flag');
  1560. { CurFile^.DestName now includes a filename, see TSetupCompiler.EnumFilesProc.ProcessFileList }
  1561. ProcessFileEntry(UninstLog, ExpandedAppId, RegisterFilesList,
  1562. CurFile, DisableFsRedir, SourceWildcard, ExpandConst(CurFile^.DestName),
  1563. nil, ExpectedBytesLeft, ConfirmOverwriteOverwriteAll, PromptIfOlderOverwriteAll,
  1564. WarnedPerUserFonts, nil);
  1565. FoundFiles := True;
  1566. end else if foExtractArchive in CurFile^.Options then
  1567. FoundFiles := RecurseExternalArchiveCopyFiles(DisableFsRedir,
  1568. SourceWildcard, Excludes, CurFile,
  1569. ExpectedBytesLeft, ConfirmOverwriteOverwriteAll, PromptIfOlderOverwriteAll,
  1570. WarnedPerUserFonts)
  1571. else
  1572. FoundFiles := RecurseExternalCopyFiles(DisableFsRedir,
  1573. PathExtractPath(SourceWildcard), '', PathExtractName(SourceWildcard),
  1574. IsWildcard(SourceWildcard), Excludes, CurFile,
  1575. ExpectedBytesLeft, ConfirmOverwriteOverwriteAll, PromptIfOlderOverwriteAll,
  1576. WarnedPerUserFonts);
  1577. until FoundFiles or
  1578. (foSkipIfSourceDoesntExist in CurFile^.Options) or
  1579. AbortRetryIgnoreTaskDialogMsgBox(
  1580. SetupMessages[msgErrorReadingSource] + SNewLine + AddPeriod(FmtSetupMessage(msgSourceDoesntExist, [SourceWildcard])),
  1581. [SetupMessages[msgAbortRetryIgnoreRetry], SetupMessages[msgFileAbortRetryIgnoreSkipNotRecommended], SetupMessages[msgAbortRetryIgnoreCancel]]);
  1582. { In case we didn't end up copying all the expected bytes, bump
  1583. the progress bar up to the expected amount }
  1584. Inc(ProgressBefore, CurFile^.ExternalSize);
  1585. SetProgress(ProgressBefore);
  1586. end;
  1587. NotifyAfterInstallFileEntry(CurFile);
  1588. end;
  1589. end;
  1590. finally
  1591. Excludes.Free;
  1592. FileLocationFilenames.Free;
  1593. end;
  1594. end;
  1595. procedure CreateIcons(const UninstLog: TUninstallLog);
  1596. function IsPathURL(const S: String): Boolean;
  1597. { Returns True if S begins with a scheme name and colon. Should be
  1598. compliant with RFC 2396 section 3.1. }
  1599. const
  1600. SchemeAlphaChars = ['A'..'Z', 'a'..'z'];
  1601. SchemeAllChars = SchemeAlphaChars + ['0'..'9', '+', '-', '.'];
  1602. var
  1603. P, I: Integer;
  1604. begin
  1605. Result := False;
  1606. P := PathPos(':', S);
  1607. if (P > 2) and CharInSet(S[1], SchemeAlphaChars) then begin
  1608. for I := 2 to P-1 do
  1609. if not CharInSet(S[I], SchemeAllChars) then
  1610. Exit;
  1611. Result := True;
  1612. end;
  1613. end;
  1614. procedure CreateURLFile(const Filename, URL, IconFilename: String;
  1615. const IconIndex: Integer);
  1616. var
  1617. S: String;
  1618. F: TTextFileWriter;
  1619. begin
  1620. S := '[InternetShortcut]' + SNewLine + 'URL=' + URL + SNewLine;
  1621. if IconFilename <> '' then
  1622. S := S + 'IconFile=' + IconFilename + SNewLine +
  1623. 'IconIndex=' + IntToStr(IconIndex) + SNewLine;
  1624. F := TTextFileWriter.Create(Filename, fdCreateAlways, faWrite, fsNone);
  1625. try
  1626. if SameText(S, String(AnsiString(S))) then
  1627. F.WriteAnsi(AnsiString(S))
  1628. else
  1629. F.Write(S);
  1630. finally
  1631. F.Free;
  1632. end;
  1633. end;
  1634. procedure DeleteFolderShortcut(const Dir: String);
  1635. var
  1636. Attr: DWORD;
  1637. DesktopIniFilename, S: String;
  1638. begin
  1639. Attr := GetFileAttributes(PChar(Dir));
  1640. if (Attr <> INVALID_FILE_ATTRIBUTES) and (Attr and FILE_ATTRIBUTE_DIRECTORY <> 0) then begin
  1641. { To be sure this is really a folder shortcut and not a regular folder,
  1642. look for a desktop.ini file specifying CLSID_FolderShortcut }
  1643. DesktopIniFilename := PathCombine(Dir, 'desktop.ini');
  1644. S := GetIniString('.ShellClassInfo', 'CLSID2', '', DesktopIniFilename);
  1645. if CompareText(S, '{0AFACED1-E828-11D1-9187-B532F1E9575D}') = 0 then begin
  1646. DeleteFile(DesktopIniFilename);
  1647. DeleteFile(PathCombine(Dir, 'target.lnk'));
  1648. SetFileAttributes(PChar(Dir), Attr and not FILE_ATTRIBUTE_READONLY);
  1649. RemoveDirectory(PChar(Dir));
  1650. end;
  1651. end;
  1652. end;
  1653. procedure CreateAnIcon(Name: String; const Description, Path, Parameters,
  1654. WorkingDir, IconFilename: String; const IconIndex, ShowCmd: Integer;
  1655. const NeverUninstall: Boolean; const CloseOnExit: TSetupIconCloseOnExit;
  1656. const HotKey: Word; const AppUserModelID: String;
  1657. const AppUserModelToastActivatorCLSID: PGUID;
  1658. const ExcludeFromShowInNewInstall, PreventPinning: Boolean);
  1659. var
  1660. BeginsWithGroup: Boolean;
  1661. LinkFilename, PifFilename, UrlFilename, DirFilename, ProbableFilename,
  1662. ResultingFilename: String;
  1663. Flags: TMakeDirFlags;
  1664. URLShortcut: Boolean;
  1665. begin
  1666. BeginsWithGroup := Copy(Name, 1, 8) = '{group}\';
  1667. { Note: PathExpand removes trailing spaces, so it can't be called on
  1668. Name before the extensions are appended }
  1669. Name := ExpandConst(Name);
  1670. LinkFilename := PathExpand(Name + '.lnk');
  1671. PifFilename := PathExpand(Name + '.pif');
  1672. UrlFilename := PathExpand(Name + '.url');
  1673. DirFilename := PathExpand(Name);
  1674. Flags := [mdNotifyChange];
  1675. if NeverUninstall then
  1676. Include(Flags, mdNoUninstall)
  1677. else if BeginsWithGroup then
  1678. Include(Flags, mdAlwaysUninstall);
  1679. URLShortcut := IsPathURL(Path);
  1680. if URLShortcut then
  1681. ProbableFilename := UrlFilename
  1682. else
  1683. ProbableFilename := LinkFilename;
  1684. LogFmt('Dest filename: %s', [ProbableFilename]);
  1685. SetFilenameLabelText(ProbableFilename, True);
  1686. MakeDir(UninstLog, False, PathExtractDir(ProbableFilename), Flags);
  1687. { Delete any old files first }
  1688. DeleteFile(LinkFilename);
  1689. DeleteFile(PifFilename);
  1690. if NewFileExists(UrlFilename) then begin
  1691. { Flush out any pending writes by other apps before deleting }
  1692. WritePrivateProfileString(nil, nil, nil, PChar(UrlFilename));
  1693. end;
  1694. DeleteFile(UrlFilename);
  1695. DeleteFolderShortcut(DirFilename);
  1696. Log('Creating the icon.');
  1697. if not URLShortcut then begin
  1698. { Create the shortcut.
  1699. Note: Don't call PathExpand on any of the paths since they may contain
  1700. environment-variable strings (e.g. %SystemRoot%\...) }
  1701. ResultingFilename := CreateShellLink(LinkFilename, Description, Path,
  1702. Parameters, WorkingDir, IconFilename, IconIndex, ShowCmd, HotKey,
  1703. AppUserModelID, AppUserModelToastActivatorCLSID,
  1704. ExcludeFromShowInNewInstall, PreventPinning);
  1705. { If a .pif file was created, apply the "Close on exit" setting }
  1706. if (CloseOnExit <> icNoSetting) and
  1707. SameText(PathExtractExt(ResultingFilename), '.pif') then begin
  1708. try
  1709. ModifyPifFile(ResultingFilename, CloseOnExit = icYes);
  1710. except
  1711. { Failure isn't important here. Ignore exceptions }
  1712. end;
  1713. end;
  1714. end
  1715. else begin
  1716. { Create an Internet Shortcut (.url) file }
  1717. CreateURLFile(UrlFilename, Path, IconFilename, IconIndex);
  1718. ResultingFilename := UrlFilename;
  1719. end;
  1720. Log('Successfully created the icon.');
  1721. { Set the global flag that is checked by the Finished wizard page }
  1722. CreatedIcon := True;
  1723. { Notify shell of the change }
  1724. SHChangeNotify(SHCNE_CREATE, SHCNF_PATH, PChar(ResultingFilename), nil);
  1725. SHChangeNotify(SHCNE_UPDATEDIR, SHCNF_PATH or SHCNF_FLUSH,
  1726. PChar(PathExtractDir(ResultingFilename)), nil);
  1727. { Add uninstall log entries }
  1728. if not NeverUninstall then begin
  1729. if URLShortcut then
  1730. UninstLog.Add(utDeleteFile, [ResultingFilename], utDeleteFile_CallChangeNotify)
  1731. else begin
  1732. { Even though we only created one file, go ahead and try deleting
  1733. both a .lnk and .pif file at uninstall time, in case the user
  1734. alters the shortcut after installation }
  1735. UninstLog.Add(utDeleteFile, [LinkFilename], utDeleteFile_CallChangeNotify);
  1736. UninstLog.Add(utDeleteFile, [PifFilename], utDeleteFile_CallChangeNotify);
  1737. end;
  1738. end;
  1739. end;
  1740. function ExpandAppPath(const Filename: String): String;
  1741. var
  1742. K: HKEY;
  1743. Found: Boolean;
  1744. begin
  1745. if RegOpenKeyExView(InstallDefaultRegView, HKEY_LOCAL_MACHINE,
  1746. PChar(REGSTR_PATH_APPPATHS + '\' + Filename), 0, KEY_QUERY_VALUE, K) = ERROR_SUCCESS then begin
  1747. Found := RegQueryStringValue(K, '', Result);
  1748. RegCloseKey(K);
  1749. if Found then
  1750. Exit;
  1751. end;
  1752. Result := Filename;
  1753. end;
  1754. var
  1755. CurIconNumber: Integer;
  1756. CurIcon: PSetupIconEntry;
  1757. FN: String;
  1758. TACLSID: PGUID;
  1759. begin
  1760. for CurIconNumber := 0 to Entries[seIcon].Count-1 do begin
  1761. try
  1762. CurIcon := PSetupIconEntry(Entries[seIcon][CurIconNumber]);
  1763. with CurIcon^ do begin
  1764. if ShouldProcessIconEntry(WizardComponents, WizardTasks, WizardNoIcons, CurIcon) then begin
  1765. DebugNotifyEntry(seIcon, CurIconNumber);
  1766. NotifyBeforeInstallEntry(BeforeInstall);
  1767. Log('-- Icon entry --');
  1768. FN := ExpandConst(Filename);
  1769. if ioUseAppPaths in Options then
  1770. FN := ExpandAppPath(FN);
  1771. if not(ioCreateOnlyIfFileExists in Options) or NewFileExistsRedir(IsWin64, FN) then begin
  1772. if ioHasAppUserModelToastActivatorCLSID in Options then
  1773. TACLSID := @AppUserModelToastActivatorCLSID
  1774. else
  1775. TACLSID := nil;
  1776. CreateAnIcon(IconName, ExpandConst(Comment), FN,
  1777. ExpandConst(Parameters), ExpandConst(WorkingDir),
  1778. ExpandConst(IconFilename), IconIndex, ShowCmd,
  1779. ioUninsNeverUninstall in Options, CloseOnExit, HotKey,
  1780. ExpandConst(AppUserModelID), TACLSID,
  1781. ioExcludeFromShowInNewInstall in Options,
  1782. ioPreventPinning in Options)
  1783. end else
  1784. Log('Skipping due to "createonlyiffileexists" flag.');
  1785. { Increment progress meter }
  1786. IncProgress(1000);
  1787. NotifyAfterInstallEntry(AfterInstall);
  1788. end;
  1789. end;
  1790. except
  1791. if not(ExceptObject is EAbort) then
  1792. Application.HandleException(nil)
  1793. else
  1794. raise;
  1795. end;
  1796. ProcessEvents;
  1797. { Clear previous filename label in case an exception or debugger break
  1798. occurs between now and when the label for the next entry is set }
  1799. SetFilenameLabelText('', False);
  1800. end;
  1801. end;
  1802. procedure CreateIniEntries(const UninstLog: TUninstallLog);
  1803. var
  1804. CurIniNumber: Integer;
  1805. CurIni: PSetupIniEntry;
  1806. IniSection, IniEntry, IniValue, IniFilename, IniDir: String;
  1807. Skip: Boolean;
  1808. begin
  1809. for CurIniNumber := 0 to Entries[seIni].Count-1 do begin
  1810. CurIni := PSetupIniEntry(Entries[seIni][CurIniNumber]);
  1811. with CurIni^ do begin
  1812. if ShouldProcessEntry(WizardComponents, WizardTasks, Components, Tasks, Languages, Check) then begin
  1813. DebugNotifyEntry(seIni, CurIniNumber);
  1814. NotifyBeforeInstallEntry(BeforeInstall);
  1815. Log('-- INI entry --');
  1816. IniSection := ExpandConst(Section);
  1817. IniEntry := ExpandConst(Entry);
  1818. IniValue := ExpandConst(Value);
  1819. IniFilename := ExpandConst(Filename);
  1820. LogFmt('Dest filename: %s', [IniFilename]);
  1821. LogFmt('Section: %s', [IniSection]);
  1822. if IniEntry <> '' then
  1823. LogFmt('Entry: %s', [IniEntry]);
  1824. if ioHasValue in Options then
  1825. LogFmt('Value: %s', [IniValue]);
  1826. if (IniEntry <> '') and (ioHasValue in Options) and
  1827. (not(ioCreateKeyIfDoesntExist in Options) or
  1828. not IniKeyExists(IniSection, IniEntry, IniFilename)) then begin
  1829. Skip := False;
  1830. IniDir := PathExtractDir(IniFilename);
  1831. if IniDir <> '' then begin
  1832. while True do begin
  1833. try
  1834. MakeDir(UninstLog, False, IniDir, []);
  1835. Break;
  1836. except
  1837. if AbortRetryIgnoreTaskDialogMsgBox(
  1838. GetExceptMessage,
  1839. [SetupMessages[msgAbortRetryIgnoreRetry], SetupMessages[msgAbortRetryIgnoreIgnore], SetupMessages[msgAbortRetryIgnoreCancel]]) then begin
  1840. Skip := True;
  1841. Break;
  1842. end;
  1843. end;
  1844. end;
  1845. end;
  1846. if not Skip then
  1847. Log('Updating the .INI file.');
  1848. repeat
  1849. if SetIniString(IniSection, IniEntry, IniValue, IniFilename) then begin
  1850. Log('Successfully updated the .INI file.');
  1851. Break;
  1852. end;
  1853. until AbortRetryIgnoreTaskDialogMsgBox(
  1854. FmtSetupMessage1(msgErrorIniEntry, IniFilename),
  1855. [SetupMessages[msgAbortRetryIgnoreRetry], SetupMessages[msgAbortRetryIgnoreIgnore], SetupMessages[msgAbortRetryIgnoreCancel]]);
  1856. end else
  1857. Log('Skipping updating the .INI file, only updating uninstall log.');
  1858. if ioUninsDeleteEntireSection in Options then
  1859. UninstLog.Add(utIniDeleteSection, [IniFilename, IniSection], 0);
  1860. if ioUninsDeleteSectionIfEmpty in Options then
  1861. UninstLog.Add(utIniDeleteSection, [IniFilename, IniSection],
  1862. utIniDeleteSection_OnlyIfEmpty);
  1863. if (ioUninsDeleteEntry in Options) and (IniEntry <> '') then
  1864. UninstLog.Add(utIniDeleteEntry, [IniFilename, IniSection, IniEntry], 0);
  1865. { ^ add utIniDeleteEntry last since we want it done first by the
  1866. uninstaller (in case the entry's also got the
  1867. "uninsdeletesectionifempty" flag) }
  1868. NotifyAfterInstallEntry(AfterInstall);
  1869. end;
  1870. end;
  1871. end;
  1872. { Increment progress meter }
  1873. IncProgress(1000);
  1874. end;
  1875. procedure CreateRegistryEntries(const UninstLog: TUninstallLog);
  1876. function IsDeletableSubkey(const S: String): Boolean;
  1877. { A sanity check to prevent people from shooting themselves in the foot by
  1878. using
  1879. Root: HKLM; Subkey: ""; Flags: [unins]deletekey
  1880. or a 'code' constant in Subkey that returns a blank string or only
  1881. backslashes. }
  1882. var
  1883. P: PChar;
  1884. begin
  1885. Result := False;
  1886. P := PChar(S);
  1887. while P^ <> #0 do begin
  1888. if P^ <> '\' then begin
  1889. Result := True;
  1890. Break;
  1891. end;
  1892. Inc(P);
  1893. end;
  1894. end;
  1895. procedure ApplyPermissions(const RegView: TRegView; const RootKey: HKEY;
  1896. const Subkey: String; const PermsEntry: Integer);
  1897. var
  1898. P: PSetupPermissionEntry;
  1899. begin
  1900. LogFmt('Setting permissions on key: %s\%s',
  1901. [GetRegRootKeyName(RootKey), Subkey]);
  1902. P := Entries[sePermission][PermsEntry];
  1903. if not GrantPermissionOnKey(RegView, RootKey, Subkey,
  1904. TGrantPermissionEntry(Pointer(P.Permissions)^),
  1905. Length(P.Permissions) div SizeOf(TGrantPermissionEntry)) then begin
  1906. if GetLastError = ERROR_FILE_NOT_FOUND then
  1907. Log('Could not set permissions on the key because it currently does not exist.')
  1908. else
  1909. LogFmt('Failed to set permissions on the key (%d).', [GetLastError]);
  1910. end;
  1911. end;
  1912. const
  1913. REG_QWORD = 11;
  1914. var
  1915. RK, K: HKEY;
  1916. Disp: DWORD;
  1917. N, V, ExistingData: String;
  1918. ExistingType, NewType, DV: DWORD;
  1919. S: String;
  1920. RV: TRegView;
  1921. CurRegNumber: Integer;
  1922. NeedToRetry, DidDeleteKey: Boolean;
  1923. ErrorCode: Longint;
  1924. I: Integer;
  1925. AnsiS: AnsiString;
  1926. begin
  1927. for CurRegNumber := 0 to Entries[seRegistry].Count-1 do begin
  1928. with PSetupRegistryEntry(Entries[seRegistry][CurRegNumber])^ do begin
  1929. if ShouldProcessEntry(WizardComponents, WizardTasks, Components, Tasks, Languages, Check) then begin
  1930. DebugNotifyEntry(seRegistry, CurRegNumber);
  1931. NotifyBeforeInstallEntry(BeforeInstall);
  1932. Log('-- Registry entry --');
  1933. RK := RootKey;
  1934. if RK = HKEY_AUTO then
  1935. RK := InstallModeRootKey;
  1936. S := ExpandConst(Subkey);
  1937. LogFmt('Key: %s\%s', [GetRegRootKeyName(RK), Subkey]);
  1938. N := ExpandConst(ValueName);
  1939. if N <> '' then
  1940. LogFmt('Value name: %s', [N]);
  1941. RV := InstallDefaultRegView;
  1942. if (ro32Bit in Options) and (RV <> rv32Bit) then begin
  1943. Log('Non-default bitness: 32-bit');
  1944. RV := rv32Bit;
  1945. end;
  1946. if ro64Bit in Options then begin
  1947. if not IsWin64 then
  1948. InternalError('Cannot access 64-bit registry keys on this version of Windows');
  1949. if RV <> rv64Bit then begin
  1950. Log('Non-default bitness: 64-bit');
  1951. RV := rv64Bit;
  1952. end;
  1953. end;
  1954. repeat
  1955. NeedToRetry := False;
  1956. try
  1957. DidDeleteKey := False;
  1958. if roDeleteKey in Options then begin
  1959. if IsDeletableSubkey(S) then begin
  1960. Log('Deleting the key.');
  1961. RegDeleteKeyIncludingSubkeys(RV, RK, PChar(S));
  1962. DidDeleteKey := True;
  1963. end else
  1964. Log('Key to delete is not deletable.');
  1965. end;
  1966. if (roDeleteKey in Options) and (Typ = rtNone) then begin
  1967. { We've deleted the key, and no value is to be created.
  1968. Our work is done. }
  1969. if DidDeleteKey then
  1970. Log('Successfully deleted the key.');
  1971. end else if (roDeleteValue in Options) and (Typ = rtNone) then begin
  1972. { We're going to delete a value with no intention of creating
  1973. another, so don't create the key if it didn't exist. }
  1974. if RegOpenKeyExView(RV, RK, PChar(S), 0, KEY_SET_VALUE, K) = ERROR_SUCCESS then begin
  1975. Log('Deleting the value.');
  1976. RegDeleteValue(K, PChar(N));
  1977. RegCloseKey(K);
  1978. Log('Successfully deleted the value.');
  1979. { Our work is done. }
  1980. end else
  1981. Log('Key of value to delete does not exist.');
  1982. end
  1983. else begin
  1984. { Apply any permissions *before* calling RegCreateKeyExView or
  1985. RegOpenKeyExView, since we may (in a rather unlikely scenario)
  1986. need those permissions in order for those calls to succeed }
  1987. if PermissionsEntry <> -1 then
  1988. ApplyPermissions(RV, RK, S, PermissionsEntry);
  1989. { Create or open the key }
  1990. if not(roDontCreateKey in Options) then begin
  1991. Log('Creating or opening the key.');
  1992. ErrorCode := RegCreateKeyExView(RV, RK, PChar(S), 0, nil,
  1993. REG_OPTION_NON_VOLATILE, KEY_QUERY_VALUE or KEY_SET_VALUE,
  1994. nil, K, @Disp);
  1995. if ErrorCode = ERROR_SUCCESS then begin
  1996. { Apply permissions again if a new key was created }
  1997. if (Disp = REG_CREATED_NEW_KEY) and (PermissionsEntry <> -1) then begin
  1998. Log('New key created, need to set permissions again.');
  1999. ApplyPermissions(RV, RK, S, PermissionsEntry);
  2000. end;
  2001. end
  2002. else begin
  2003. if not(roNoError in Options) then
  2004. RegError(reRegCreateKeyEx, RK, S, ErrorCode);
  2005. end;
  2006. end
  2007. else begin
  2008. if Typ <> rtNone then begin
  2009. Log('Opening the key.');
  2010. ErrorCode := RegOpenKeyExView(RV, RK, PChar(S), 0,
  2011. KEY_QUERY_VALUE or KEY_SET_VALUE, K);
  2012. if (ErrorCode <> ERROR_SUCCESS) and (ErrorCode <> ERROR_FILE_NOT_FOUND) then
  2013. if not(roNoError in Options) then
  2014. RegError(reRegOpenKeyEx, RK, S, ErrorCode);
  2015. end
  2016. else begin
  2017. { We're not creating a value, and we're not just deleting a
  2018. value (that was checked above), so there is no reason to
  2019. even open the key }
  2020. Log('Not creating the key or a value, skipping the key and only updating uninstall log.');
  2021. ErrorCode := ERROR_FILE_NOT_FOUND;
  2022. end;
  2023. end;
  2024. { If there was no error opening the key, proceed with deleting
  2025. and/or creating the value }
  2026. if ErrorCode = ERROR_SUCCESS then
  2027. try
  2028. if roDeleteValue in Options then begin
  2029. Log('Deleting the value.');
  2030. RegDeleteValue(K, PChar(N));
  2031. end;
  2032. if (Typ <> rtNone) and
  2033. (not(roCreateValueIfDoesntExist in Options) or
  2034. not RegValueExists(K, PChar(N))) then begin
  2035. Log('Creating or setting the value.');
  2036. case Typ of
  2037. rtString, rtExpandString, rtMultiString: begin
  2038. NewType := REG_SZ;
  2039. case Typ of
  2040. rtExpandString: NewType := REG_EXPAND_SZ;
  2041. rtMultiString: NewType := REG_MULTI_SZ;
  2042. end;
  2043. if Typ <> rtMultiString then begin
  2044. if (Pos('{olddata}', ValueData) <> 0) and
  2045. RegQueryStringValue(K, PChar(N), ExistingData) then
  2046. { successful }
  2047. else
  2048. ExistingData := '';
  2049. if roPreserveStringType in Options then begin
  2050. if (RegQueryValueEx(K, PChar(N), nil, @ExistingType, nil, nil) = ERROR_SUCCESS) and
  2051. ((ExistingType = REG_SZ) or (ExistingType = REG_EXPAND_SZ)) then
  2052. NewType := ExistingType;
  2053. end;
  2054. V := ExpandConstEx(ValueData, ['olddata', ExistingData])
  2055. end
  2056. else begin
  2057. if (Pos('{olddata}', ValueData) <> 0) and
  2058. RegQueryMultiStringValue(K, PChar(N), ExistingData) then
  2059. { successful }
  2060. else
  2061. ExistingData := '';
  2062. V := ExpandConstEx(ValueData, ['olddata', ExistingData,
  2063. 'break', #0]);
  2064. { Multi-string data requires two null terminators:
  2065. one after the last string, and one to mark the end.
  2066. Delphi's String type is implicitly null-terminated,
  2067. so only one null needs to be added to the end. }
  2068. if (V <> '') and (V[Length(V)] <> #0) then
  2069. V := V + #0;
  2070. end;
  2071. ErrorCode := RegSetValueEx(K, PChar(N), 0, NewType,
  2072. PChar(V), (Length(V)+1)*SizeOf(V[1]));
  2073. if (ErrorCode <> ERROR_SUCCESS) and
  2074. not(roNoError in Options) then
  2075. RegError(reRegSetValueEx, RK, S, ErrorCode);
  2076. end;
  2077. rtDWord: begin
  2078. DV := StrToInt(ExpandConst(ValueData));
  2079. ErrorCode := RegSetValueEx(K, PChar(N), 0, REG_DWORD,
  2080. @DV, SizeOf(DV));
  2081. if (ErrorCode <> ERROR_SUCCESS) and
  2082. not(roNoError in Options) then
  2083. RegError(reRegSetValueEx, RK, S, ErrorCode);
  2084. end;
  2085. rtQWord: begin
  2086. const QV: UInt64 = StrToUInt64(ExpandConst(ValueData));
  2087. ErrorCode := RegSetValueEx(K, PChar(N), 0, REG_QWORD,
  2088. @QV, SizeOf(QV));
  2089. if (ErrorCode <> ERROR_SUCCESS) and
  2090. not(roNoError in Options) then
  2091. RegError(reRegSetValueEx, RK, S, ErrorCode);
  2092. end;
  2093. rtBinary: begin
  2094. AnsiS := '';
  2095. for I := 1 to Length(ValueData) do
  2096. AnsiS := AnsiS + AnsiChar(Ord(ValueData[I]));
  2097. ErrorCode := RegSetValueEx(K, PChar(N), 0, REG_BINARY,
  2098. PAnsiChar(AnsiS), Length(AnsiS));
  2099. if (ErrorCode <> ERROR_SUCCESS) and
  2100. not(roNoError in Options) then
  2101. RegError(reRegSetValueEx, RK, S, ErrorCode);
  2102. end;
  2103. end;
  2104. Log('Successfully created or set the value.');
  2105. end else if roDeleteValue in Options then
  2106. Log('Successfully deleted the value.')
  2107. else
  2108. Log('Successfully created the key.')
  2109. { Our work is done. }
  2110. finally
  2111. RegCloseKey(K);
  2112. end;
  2113. end;
  2114. except
  2115. if not AbortRetryIgnoreTaskDialogMsgBox(
  2116. GetExceptMessage,
  2117. [SetupMessages[msgAbortRetryIgnoreRetry], SetupMessages[msgAbortRetryIgnoreIgnore], SetupMessages[msgAbortRetryIgnoreCancel]]) then begin
  2118. Log('Retrying.');
  2119. NeedToRetry := True;
  2120. end;
  2121. end;
  2122. until not NeedToRetry;
  2123. if roUninsDeleteEntireKey in Options then
  2124. if IsDeletableSubkey(S) then
  2125. UninstLog.AddReg(utRegDeleteEntireKey, RV, RK, [S]);
  2126. if roUninsDeleteEntireKeyIfEmpty in Options then
  2127. if IsDeletableSubkey(S) then
  2128. UninstLog.AddReg(utRegDeleteKeyIfEmpty, RV, RK, [S]);
  2129. if roUninsDeleteValue in Options then
  2130. UninstLog.AddReg(utRegDeleteValue, RV, RK, [S, N]);
  2131. { ^ must add roUninsDeleteValue after roUninstDeleteEntireKey*
  2132. since the entry may have both the roUninsDeleteValue and
  2133. roUninsDeleteEntireKeyIfEmpty options }
  2134. if roUninsClearValue in Options then
  2135. UninstLog.AddReg(utRegClearValue, RV, RK, [S, N]);
  2136. NotifyAfterInstallEntry(AfterInstall);
  2137. end;
  2138. end;
  2139. end;
  2140. { Increment progress meter }
  2141. IncProgress(1000);
  2142. end;
  2143. procedure RegisterFiles(const RegisterFilesList: TList);
  2144. procedure RegisterServersOnRestart;
  2145. function CreateRegSvrExe(const Dir: String): String;
  2146. var
  2147. ExeFilename: String;
  2148. SourceF, DestF: TFile;
  2149. NumRead: Cardinal;
  2150. Buf: array[0..16383] of Byte;
  2151. begin
  2152. ExeFilename := GenerateUniqueName(False, Dir, '.exe');
  2153. DestF := nil;
  2154. SourceF := TFile.Create(NewParamStr(0), fdOpenExisting, faRead, fsRead);
  2155. try
  2156. DestF := TFile.Create(ExeFilename, fdCreateAlways, faWrite, fsNone);
  2157. try
  2158. DestF.Seek(SourceF.Size);
  2159. DestF.Truncate;
  2160. DestF.Seek(0);
  2161. while True do begin
  2162. NumRead := SourceF.Read(Buf, SizeOf(Buf));
  2163. if NumRead = 0 then
  2164. Break;
  2165. DestF.WriteBuffer(Buf, NumRead);
  2166. end;
  2167. if not(shSignedUninstaller in SetupHeader.Options) then
  2168. MarkExeHeader(DestF, SetupExeModeRegSvr);
  2169. except
  2170. FreeAndNil(DestF);
  2171. DeleteFile(ExeFilename);
  2172. raise;
  2173. end;
  2174. finally
  2175. DestF.Free;
  2176. SourceF.Free;
  2177. end;
  2178. Result := ExeFilename;
  2179. end;
  2180. procedure CreateRegSvrMsg(const Filename: String);
  2181. var
  2182. F: TFile;
  2183. begin
  2184. F := TFile.Create(Filename, fdCreateAlways, faWrite, fsNone);
  2185. try
  2186. WriteMsgData(F);
  2187. finally
  2188. F.Free;
  2189. end;
  2190. end;
  2191. const
  2192. Chars: array[Boolean, Boolean] of Char = (('s', 't'), ('S', 'T'));
  2193. var
  2194. RegSvrExeFilename: String;
  2195. F: TTextFileWriter;
  2196. Rec: PRegisterFilesListRec;
  2197. RootKey, H: HKEY;
  2198. I, J: Integer;
  2199. Disp: DWORD;
  2200. ValueName, Data: String;
  2201. ErrorCode: Longint;
  2202. begin
  2203. { Create RegSvr program used to register OLE servers & type libraries on
  2204. the next reboot }
  2205. if IsAdmin then begin
  2206. try
  2207. RegSvrExeFilename := CreateRegSvrExe(WinDir);
  2208. except
  2209. { In case Windows directory is write protected, try the Temp directory.
  2210. Windows directory is our first choice since some people (ignorantly)
  2211. put things like "DELTREE C:\WINDOWS\TEMP\*.*" in their AUTOEXEC.BAT.
  2212. Also, each user has his own personal Temp directory which may not
  2213. be accessible by other users. }
  2214. RegSvrExeFilename := CreateRegSvrExe(GetTempDir);
  2215. end;
  2216. end
  2217. else begin
  2218. { Always use Temp directory when user doesn't have admin privileges }
  2219. RegSvrExeFilename := CreateRegSvrExe(GetTempDir);
  2220. end;
  2221. LogFmt('Registration executable created: %s', [RegSvrExeFilename]);
  2222. try
  2223. CreateRegSvrMsg(PathChangeExt(RegSvrExeFilename, '.msg'));
  2224. F := TTextFileWriter.Create(PathChangeExt(RegSvrExeFilename, '.lst'),
  2225. fdCreateAlways, faWrite, fsNone);
  2226. try
  2227. F.WriteLine('; This file was created by the installer for:');
  2228. F.WriteLine('; ' + ExpandedAppVerName);
  2229. F.WriteLine('; Location: ' + SetupLdrOriginalFilename);
  2230. F.WriteLine('');
  2231. F.WriteLine('; List of files to be registered on the next reboot. DO NOT EDIT!');
  2232. F.WriteLine('');
  2233. for I := 0 to RegisterFilesList.Count-1 do begin
  2234. Rec := RegisterFilesList[I];
  2235. Data := '[..]' + Rec.Filename;
  2236. Data[2] := Chars[Rec.Is64Bit, Rec.TypeLib];
  2237. if Rec.NoErrorMessages then
  2238. Data[3] := 'q';
  2239. F.WriteLine(Data);
  2240. end;
  2241. finally
  2242. F.Free;
  2243. end;
  2244. if IsAdmin then
  2245. RootKey := HKEY_LOCAL_MACHINE
  2246. else
  2247. RootKey := HKEY_CURRENT_USER;
  2248. ErrorCode := RegCreateKeyExView(rvDefault, RootKey, REGSTR_PATH_RUNONCE, 0, nil,
  2249. REG_OPTION_NON_VOLATILE, KEY_SET_VALUE or KEY_QUERY_VALUE,
  2250. nil, H, @Disp);
  2251. if ErrorCode <> ERROR_SUCCESS then
  2252. RegError(reRegCreateKeyEx, RootKey, REGSTR_PATH_RUNONCE, ErrorCode);
  2253. try
  2254. J := 0;
  2255. while True do begin
  2256. Inc(J);
  2257. ValueName := Format('InnoSetupRegFile.%.10d', [J]); { don't localize }
  2258. { ^ Note: Names of values written to the "RunOnce" key cannot
  2259. exceed 31 characters! Otherwise the original Windows
  2260. Explorer 4.0 will not process them. }
  2261. if not RegValueExists(H, PChar(ValueName)) then begin
  2262. Data := '"' + RegSvrExeFilename + '" /REG';
  2263. if not IsAdmin then
  2264. Data := Data + 'U'; { /REG -> /REGU when not running as admin }
  2265. { Note: RegSvr expects /REG(U) to be the first parameter }
  2266. Data := Data + ' /REGSVRMODE';
  2267. ErrorCode := RegSetValueEx(H, PChar(ValueName), 0, REG_SZ, PChar(Data),
  2268. (Length(Data)+1)*SizeOf(Data[1]));
  2269. if ErrorCode <> ERROR_SUCCESS then
  2270. RegError(reRegSetValueEx, RootKey, REGSTR_PATH_RUNONCE, ErrorCode);
  2271. Break;
  2272. end;
  2273. end;
  2274. finally
  2275. RegCloseKey(H);
  2276. end;
  2277. except
  2278. DeleteFile(PathChangeExt(RegSvrExeFilename, '.lst'));
  2279. DeleteFile(PathChangeExt(RegSvrExeFilename, '.msg'));
  2280. DeleteFile(RegSvrExeFilename);
  2281. raise;
  2282. end;
  2283. end;
  2284. procedure RegisterSvr(const Is64Bit: Boolean; const Filename: String;
  2285. const NoErrorMessages: Boolean);
  2286. var
  2287. NeedToRetry: Boolean;
  2288. begin
  2289. repeat
  2290. if Is64Bit then
  2291. LogFmt('Registering 64-bit DLL/OCX: %s', [Filename])
  2292. else
  2293. LogFmt('Registering 32-bit DLL/OCX: %s', [Filename]);
  2294. NeedToRetry := False;
  2295. try
  2296. RegisterServer(False, Is64Bit, Filename, NoErrorMessages);
  2297. Log('Registration successful.');
  2298. except
  2299. Log('Registration failed:' + SNewLine + GetExceptMessage);
  2300. if not NoErrorMessages then
  2301. if not AbortRetryIgnoreTaskDialogMsgBox(
  2302. Filename + SNewLine2 + FmtSetupMessage1(msgErrorRegisterServer, GetExceptMessage),
  2303. [SetupMessages[msgAbortRetryIgnoreRetry], SetupMessages[msgFileAbortRetryIgnoreIgnoreNotRecommended], SetupMessages[msgAbortRetryIgnoreCancel]]) then
  2304. NeedToRetry := True;
  2305. end;
  2306. until not NeedToRetry;
  2307. end;
  2308. procedure RegisterTLib(const Is64Bit: Boolean; const Filename: String;
  2309. const NoErrorMessages: Boolean);
  2310. var
  2311. NeedToRetry: Boolean;
  2312. begin
  2313. repeat
  2314. if Is64Bit then
  2315. LogFmt('Registering 64-bit type library: %s', [Filename])
  2316. else
  2317. LogFmt('Registering 32-bit type library: %s', [Filename]);
  2318. NeedToRetry := False;
  2319. try
  2320. if Is64Bit then
  2321. HelperRegisterTypeLibrary(False, Filename)
  2322. else
  2323. RegisterTypeLibrary(Filename);
  2324. Log('Registration successful.');
  2325. except
  2326. Log('Registration failed:' + SNewLine + GetExceptMessage);
  2327. if not NoErrorMessages then
  2328. if not AbortRetryIgnoreTaskDialogMsgBox(
  2329. Filename + SNewLine2 + FmtSetupMessage1(msgErrorRegisterTypeLib, GetExceptMessage),
  2330. [SetupMessages[msgAbortRetryIgnoreRetry], SetupMessages[msgFileAbortRetryIgnoreIgnoreNotRecommended], SetupMessages[msgAbortRetryIgnoreCancel]]) then
  2331. NeedToRetry := True;
  2332. end;
  2333. until not NeedToRetry;
  2334. end;
  2335. var
  2336. I: Integer;
  2337. begin
  2338. if not NeedsRestart then
  2339. for I := 0 to RegisterFilesList.Count-1 do begin
  2340. with PRegisterFilesListRec(RegisterFilesList[I])^ do
  2341. if not TypeLib then
  2342. RegisterSvr(Is64Bit, Filename, NoErrorMessages)
  2343. else
  2344. RegisterTLib(Is64Bit, Filename, NoErrorMessages);
  2345. end
  2346. else begin
  2347. { When a restart is needed, all "regserver" & "regtypelib" files will get
  2348. registered on the next logon }
  2349. Log('Delaying registration of all files until the next logon since a restart is needed.');
  2350. try
  2351. RegisterServersOnRestart;
  2352. except
  2353. Application.HandleException(nil);
  2354. end;
  2355. end;
  2356. end;
  2357. procedure RecordUninstallDeleteEntries(const UninstLog: TUninstallLog);
  2358. const
  2359. DefFlags: array[TSetupDeleteType] of Longint = (
  2360. utDeleteDirOrFiles_Extra or utDeleteDirOrFiles_DeleteFiles,
  2361. utDeleteDirOrFiles_Extra or utDeleteDirOrFiles_DeleteFiles or
  2362. utDeleteDirOrFiles_DeleteSubdirsAlso,
  2363. utDeleteDirOrFiles_Extra or utDeleteDirOrFiles_IsDir);
  2364. var
  2365. I: Integer;
  2366. Flags: Longint;
  2367. begin
  2368. for I := Entries[seUninstallDelete].Count-1 downto 0 do
  2369. { ^ process backwards so the uninstaller will process them in the order
  2370. they appear in the script }
  2371. with PSetupDeleteEntry(Entries[seUninstallDelete][I])^ do
  2372. if ShouldProcessEntry(WizardComponents, WizardTasks, Components, Tasks, Languages, Check) then begin
  2373. DebugNotifyEntry(seUninstallDelete, I);
  2374. NotifyBeforeInstallEntry(BeforeInstall);
  2375. Flags := DefFlags[DeleteType];
  2376. if InstallDefaultDisableFsRedir then
  2377. Flags := Flags or utDeleteDirOrFiles_DisableFsRedir;
  2378. UninstLog.Add(utDeleteDirOrFiles, [ExpandConst(Name)], Flags);
  2379. NotifyAfterInstallEntry(AfterInstall);
  2380. end;
  2381. end;
  2382. procedure RecordUninstallRunEntries(const UninstLog: TUninstallLog);
  2383. var
  2384. I: Integer;
  2385. RunEntry: PSetupRunEntry;
  2386. Flags: Longint;
  2387. begin
  2388. for I := Entries[seUninstallRun].Count-1 downto 0 do begin
  2389. { ^ process backwards so the uninstaller will process them in the order
  2390. they appear in the script }
  2391. RunEntry := PSetupRunEntry(Entries[seUninstallRun][I]);
  2392. if ShouldProcessEntry(WizardComponents, WizardTasks, RunEntry.Components,
  2393. RunEntry.Tasks, RunEntry.Languages, RunEntry.Check) then begin
  2394. DebugNotifyEntry(seUninstallRun, I);
  2395. NotifyBeforeInstallEntry(RunEntry.BeforeInstall);
  2396. Flags := 0;
  2397. case RunEntry.Wait of
  2398. rwNoWait: Flags := Flags or utRun_NoWait;
  2399. rwWaitUntilIdle: Flags := Flags or utRun_WaitUntilIdle;
  2400. end;
  2401. if roShellExec in RunEntry.Options then
  2402. Flags := Flags or (utRun_ShellExec or utRun_ShellExecRespectWaitFlags)
  2403. else begin
  2404. if ShouldDisableFsRedirForRunEntry(RunEntry) then
  2405. Flags := Flags or utRun_DisableFsRedir;
  2406. end;
  2407. if roSkipIfDoesntExist in RunEntry.Options then
  2408. Flags := Flags or utRun_SkipIfDoesntExist;
  2409. case RunEntry.ShowCmd of
  2410. SW_SHOWMINNOACTIVE: Flags := Flags or utRun_RunMinimized;
  2411. SW_SHOWMAXIMIZED: Flags := Flags or utRun_RunMaximized;
  2412. SW_HIDE: Flags := Flags or utRun_RunHidden;
  2413. end;
  2414. if roDontLogParameters in RunEntry.Options then
  2415. Flags := Flags or utRun_DontLogParameters;
  2416. if roLogOutput in RunEntry.Options then
  2417. Flags := Flags or utRun_LogOutput;
  2418. UninstLog.Add(utRun, [ExpandConst(RunEntry.Name),
  2419. ExpandConst(RunEntry.Parameters), ExpandConst(RunEntry.WorkingDir),
  2420. ExpandConst(RunEntry.RunOnceId), ExpandConst(RunEntry.Verb)],
  2421. Flags);
  2422. NotifyAfterInstallEntry(RunEntry.AfterInstall);
  2423. end;
  2424. end;
  2425. end;
  2426. procedure GenerateUninstallInfoFilename(const UninstLog: TUninstallLog);
  2427. var
  2428. ExistingFiles: array[0..999] of Boolean;
  2429. BaseDir: String;
  2430. procedure FindFiles;
  2431. var
  2432. H: THandle;
  2433. FindData: TWin32FindData;
  2434. S: String;
  2435. begin
  2436. H := FindFirstFile(PChar(AddBackslash(BaseDir) + 'unins???.*'),
  2437. FindData);
  2438. if H <> INVALID_HANDLE_VALUE then begin
  2439. repeat
  2440. S := FindData.cFilename;
  2441. if (Length(S) >= 9) and (CompareText(Copy(S, 1, 5), 'unins') = 0) and
  2442. CharInSet(S[6], ['0'..'9']) and CharInSet(S[7], ['0'..'9']) and CharInSet(S[8], ['0'..'9']) and
  2443. (S[9] = '.') then
  2444. ExistingFiles[StrToInt(Copy(S, 6, 3))] := True;
  2445. until not FindNextFile(H, FindData);
  2446. Windows.FindClose(H);
  2447. end;
  2448. end;
  2449. procedure GenerateFilenames(const I: Integer);
  2450. var
  2451. BaseFilename: String;
  2452. begin
  2453. BaseFilename := AddBackslash(BaseDir) + Format('unins%.3d', [I]);
  2454. UninstallExeFilename := BaseFilename + '.exe';
  2455. UninstallDataFilename := BaseFilename + '.dat';
  2456. UninstallMsgFilename := BaseFilename + '.msg';
  2457. end;
  2458. procedure ReserveDataFile;
  2459. var
  2460. H: THandle;
  2461. begin
  2462. { Create an empty .dat file to reserve the filename. }
  2463. H := CreateFile(PChar(UninstallDataFilename), GENERIC_READ or GENERIC_WRITE,
  2464. 0, nil, CREATE_NEW, FILE_ATTRIBUTE_NORMAL, 0);
  2465. if H = INVALID_HANDLE_VALUE then
  2466. Win32ErrorMsg('CreateFile');
  2467. CloseHandle(H);
  2468. UninstallDataCreated := True;
  2469. end;
  2470. var
  2471. I: Integer;
  2472. ExistingFlags: TUninstallLogFlags;
  2473. begin
  2474. { Note: We never disable FS redirection when writing to UninstallFilesDir.
  2475. If someone sets UninstallFilesDir to "sys", we can't place a 32-bit
  2476. uninstaller in the 64-bit system directory, because it wouldn't see its
  2477. .dat file -- it would try to open 'windows\system32\unins???.dat' but
  2478. fail because system32 maps to syswow64 by default.
  2479. Not to mention, 32-bit EXEs really have no business being in the 64-bit
  2480. system directory, and vice versa. Might result in undefined behavior? }
  2481. { Because we don't disable FS redirection, we have to change any system32
  2482. to syswow64, otherwise Add/Remove Programs would look for the
  2483. UninstallString executable in the 64-bit system directory (at least
  2484. when using a 64-bit Uninstall key) }
  2485. BaseDir := ReplaceSystemDirWithSysWow64(PathExpand(ExpandConst(SetupHeader.UninstallFilesDir)));
  2486. LogFmt('Directory for uninstall files: %s', [BaseDir]);
  2487. MakeDir(UninstLog, False, BaseDir, []);
  2488. FillChar(ExistingFiles, SizeOf(ExistingFiles), 0); { set all to False }
  2489. FindFiles;
  2490. { Look for an existing .dat file to append to or overwrite }
  2491. if SetupHeader.UninstallLogMode <> lmNew then
  2492. for I := 0 to 999 do
  2493. if ExistingFiles[I] then begin
  2494. GenerateFilenames(I);
  2495. if NewFileExists(UninstallDataFilename) and
  2496. UninstLog.CanAppend(UninstallDataFilename, ExistingFlags) then begin
  2497. if SetupHeader.UninstallLogMode = lmAppend then begin
  2498. LogFmt('Will append to existing uninstall log: %s', [UninstallDataFilename]);
  2499. AppendUninstallData := True;
  2500. end
  2501. else
  2502. LogFmt('Will overwrite existing uninstall log: %s', [UninstallDataFilename]);
  2503. Exit;
  2504. end;
  2505. end;
  2506. { None found; use a new .dat file }
  2507. for I := 0 to 999 do
  2508. if not ExistingFiles[I] then begin
  2509. GenerateFilenames(I);
  2510. LogFmt('Creating new uninstall log: %s', [UninstallDataFilename]);
  2511. ReserveDataFile;
  2512. Exit;
  2513. end;
  2514. raise Exception.Create(FmtSetupMessage1(msgErrorTooManyFilesInDir,
  2515. BaseDir));
  2516. end;
  2517. procedure RenameUninstallExe;
  2518. begin
  2519. { If the uninstall EXE wasn't extracted to a .tmp file because it isn't
  2520. replacing an existing uninstall EXE, exit. }
  2521. if UninstallTempExeFilename = '' then
  2522. Exit;
  2523. Log('Renaming uninstaller.');
  2524. var Timer: TOneShotTimer;
  2525. var RetriesLeft := 4;
  2526. while True do begin
  2527. Timer.Start(1000);
  2528. if MoveFileReplace(UninstallTempExeFilename, UninstallExeFilename) then
  2529. Break;
  2530. var LastError := GetLastError;
  2531. { Does the error code indicate that the file is possibly in use? }
  2532. if LastErrorIndicatesPossiblyInUse(LastError, False) then begin
  2533. if RetriesLeft > 0 then begin
  2534. LogFmt('The existing file appears to be in use (%d). ' +
  2535. 'Retrying.', [LastError]);
  2536. Dec(RetriesLeft);
  2537. Timer.SleepUntilExpired;
  2538. ProcessEvents;
  2539. Continue;
  2540. end;
  2541. end;
  2542. const LastOperation = SetupMessages[msgErrorReplacingExistingFile];
  2543. const Failed = AddPeriod(FmtSetupMessage(msgErrorFunctionFailedWithMessage,
  2544. ['MoveFileEx', IntToStr(LastError), Win32ErrorString(LastError)]));
  2545. const Text = UninstallExeFilename + SNewLine2 + LastOperation + SNewLine + Failed;
  2546. case LoggedTaskDialogMsgBox('', SetupMessages[msgRetryCancelSelectAction], Text, '',
  2547. mbError, MB_RETRYCANCEL, [SetupMessages[msgRetryCancelRetry], SetupMessages[msgRetryCancelCancel]],
  2548. 0, True, IDCANCEL) of
  2549. IDRETRY: ;
  2550. IDCANCEL: Abort;
  2551. else
  2552. Log('LoggedTaskDialogMsgBox returned an unexpected value. Assuming Cancel.');
  2553. Abort;
  2554. end;
  2555. end;
  2556. UninstallTempExeFilename := '';
  2557. end;
  2558. function CreateUninstallMsgFile: Boolean;
  2559. { If the uninstaller EXE has a digital signature, or if Setup was started
  2560. with /DETACHEDMSG, create the unins???.msg file }
  2561. var
  2562. F: TFile;
  2563. begin
  2564. { If this installation didn't create or replace an unins???.exe file,
  2565. do nothing }
  2566. Result := False;
  2567. if (UninstallExeCreated <> ueNone) and
  2568. ((shSignedUninstaller in SetupHeader.Options) or DetachedUninstMsgFile) then begin
  2569. LogFmt('Writing uninstaller messages: %s', [UninstallMsgFilename]);
  2570. F := TFile.Create(UninstallMsgFilename, fdCreateAlways, faWrite, fsNone);
  2571. try
  2572. if UninstallExeCreated = ueNew then
  2573. Result := True;
  2574. WriteMsgData(F);
  2575. finally
  2576. F.Free;
  2577. end;
  2578. end;
  2579. end;
  2580. procedure PerformInstall(var Succeeded: Boolean; const ChangesEnvironment,
  2581. ChangesAssociations: Boolean);
  2582. var
  2583. Uninstallable, UninstLogCleared: Boolean;
  2584. I: Integer;
  2585. UninstallRegKeyBaseName: String;
  2586. begin
  2587. Succeeded := False;
  2588. Log('Starting the installation process.');
  2589. SetCurrentDir(WinSystemDir);
  2590. var InstallFilesSize, AfterInstallFilesSize: Int64;
  2591. CalcFilesSize(InstallFilesSize, AfterInstallFilesSize);
  2592. InitProgressGauge(InstallFilesSize);
  2593. UninstallExeCreated := ueNone;
  2594. UninstallDataCreated := False;
  2595. var UninstallMsgCreated := False;
  2596. AppendUninstallData := False;
  2597. UninstLogCleared := False;
  2598. var RegisterFilesList: TList := nil;
  2599. const UninstLog = TSetupUninstallLog.Create;
  2600. try
  2601. try
  2602. { Get AppId, UninstallRegKeyBaseName, and Uninstallable now so the user
  2603. can't change them while we're installing }
  2604. const ExpandedAppId = ExpandConst(SetupHeader.AppId);
  2605. if ExpandedAppId = '' then
  2606. InternalError('Failed to get a non empty installation "AppId"');
  2607. if TUninstallLog.WriteSafeHeaderString(nil, ExpandedAppId, 0) > 128 then
  2608. InternalError('"AppId" cannot exceed 128 bytes (encoded)');
  2609. UninstallRegKeyBaseName := GetUninstallRegKeyBaseName(ExpandedAppId);
  2610. Uninstallable := EvalDirectiveCheck(SetupHeader.Uninstallable);
  2611. { Init }
  2612. UninstLog.InstallMode64Bit := Is64BitInstallMode;
  2613. UninstLog.AppName := ExpandedAppName;
  2614. UninstLog.AppId := ExpandedAppId;
  2615. if IsAdminInstallMode then
  2616. Include(UninstLog.Flags, ufAdminInstallMode);
  2617. if IsWin64 then
  2618. Include(UninstLog.Flags, ufWin64);
  2619. if IsAdmin then { Setup or [Code] might have done administrative actions, even if IsAdminInstallMode is False }
  2620. Include(UninstLog.Flags, ufAdminInstalled)
  2621. else if IsPowerUserOrAdmin then
  2622. { Note: This flag is only set in 5.1.9 and later }
  2623. Include(UninstLog.Flags, ufPowerUserInstalled);
  2624. if shWizardModern in SetupHeader.Options then
  2625. Include(UninstLog.Flags, ufWizardModern);
  2626. if shWizardBorderStyled in SetupHeader.Options then
  2627. Include(UninstLog.Flags, ufWizardBorderStyled);
  2628. if shWizardLightButtonsUnstyled in SetupHeader.Options then
  2629. Include(UninstLog.Flags, ufWizardLightButtonsUnstyled);
  2630. if shWizardKeepAspectRatio in SetupHeader.Options then
  2631. Include(UninstLog.Flags, ufWizardKeepAspectRatio);
  2632. if SetupHeader.WizardDarkStyle = wdsDark then
  2633. Include(UninstLog.Flags, ufWizardDarkStyleDark)
  2634. else if SetupHeader.WizardDarkStyle = wdsDynamic then
  2635. Include(UninstLog.Flags, ufWizardDarkStyleDynamic);
  2636. if shUninstallRestartComputer in SetupHeader.Options then
  2637. Include(UninstLog.Flags, ufAlwaysRestart);
  2638. if ChangesEnvironment then
  2639. Include(UninstLog.Flags, ufChangesEnvironment);
  2640. UninstLog.WizardSizePercentX := SetupHeader.WizardSizePercentX;
  2641. UninstLog.WizardSizePercentY := SetupHeader.WizardSizePercentY;
  2642. RecordStartInstall(UninstLog);
  2643. RecordCompiledCode(UninstLog);
  2644. RegisterFilesList := TList.Create;
  2645. { Process Component entries, if any }
  2646. ProcessComponentEntries;
  2647. ProcessEvents;
  2648. { Process Tasks entries, if any }
  2649. ProcessTasksEntries;
  2650. ProcessEvents;
  2651. { Shutdown applications, if any }
  2652. if RmSessionStarted and RmFoundApplications then begin
  2653. if WizardPreparingYesRadio then begin
  2654. SetStatusLabelText(SetupMessages[msgStatusClosingApplications]);
  2655. ShutdownApplications;
  2656. ProcessEvents;
  2657. end else
  2658. Log('User chose not to shutdown applications using our files.');
  2659. end;
  2660. { Process InstallDelete entries, if any }
  2661. ProcessInstallDeleteEntries;
  2662. ProcessEvents;
  2663. if ExpandedAppMutex <> '' then
  2664. UninstLog.Add(utMutexCheck, [ExpandedAppMutex], 0);
  2665. if ChangesAssociations then
  2666. UninstLog.Add(utRefreshFileAssoc, [''], 0);
  2667. { Record UninstallDelete entries, if any }
  2668. RecordUninstallDeleteEntries(UninstLog);
  2669. ProcessEvents;
  2670. { Create the application directory and extra dirs }
  2671. SetStatusLabelText(SetupMessages[msgStatusCreateDirs]);
  2672. CreateDirs(UninstLog);
  2673. ProcessEvents;
  2674. if Uninstallable then begin
  2675. { Generate the filenam(UninstLog)es for the uninstall info in the application
  2676. directory }
  2677. SetStatusLabelText(SetupMessages[msgStatusSavingUninstall]);
  2678. GenerateUninstallInfoFilename(UninstLog);
  2679. end;
  2680. { Copy the files }
  2681. SetStatusLabelText(SetupMessages[msgStatusExtractFiles]);
  2682. CopyFiles(UninstLog, ExpandedAppId, RegisterFilesList, Uninstallable);
  2683. ProcessEvents;
  2684. { Create program icons, if any }
  2685. if HasIcons then begin
  2686. SetStatusLabelText(SetupMessages[msgStatusCreateIcons]);
  2687. CreateIcons(UninstLog);
  2688. ProcessEvents;
  2689. end;
  2690. { Create INI entries, if any }
  2691. if Entries[seIni].Count <> 0 then begin
  2692. SetStatusLabelText(SetupMessages[msgStatusCreateIniEntries]);
  2693. CreateIniEntries(UninstLog);
  2694. ProcessEvents;
  2695. end;
  2696. { Create registry entries, if any }
  2697. if Entries[seRegistry].Count <> 0 then begin
  2698. SetStatusLabelText(SetupMessages[msgStatusCreateRegistryEntries]);
  2699. CreateRegistryEntries(UninstLog);
  2700. ProcessEvents;
  2701. end;
  2702. { Call the NeedRestart event function now.
  2703. Note: This can't be done after RegisterFiles, since RegisterFiles
  2704. relies on the setting of the NeedsRestart variable. }
  2705. SetStatusLabelText('');
  2706. ProcessNeedRestartEvent;
  2707. ProcessEvents;
  2708. { Register files, if any }
  2709. if RegisterFilesList.Count <> 0 then begin
  2710. SetStatusLabelText(SetupMessages[msgStatusRegisterFiles]);
  2711. RegisterFiles(RegisterFilesList);
  2712. ProcessEvents;
  2713. end;
  2714. { Save uninstall information. After uninstall info is saved, you cannot
  2715. make any more modifications to the user's system. Any additional
  2716. modifications you want to add must be done before this is called. }
  2717. if Uninstallable then begin
  2718. SetStatusLabelText(SetupMessages[msgStatusSavingUninstall]);
  2719. Log('Saving uninstall information.');
  2720. RenameUninstallExe;
  2721. UninstallMsgCreated := CreateUninstallMsgFile;
  2722. { Register uninstall information so the program can be uninstalled
  2723. through the Add/Remove Programs Control Panel applet. This is done
  2724. on NT 3.51 too, so that the uninstall entry for the app will appear
  2725. if the user later upgrades to NT 4.0+. }
  2726. if EvalDirectiveCheck(SetupHeader.CreateUninstallRegKey) then
  2727. RegisterUninstallInfo(UninstLog, UninstallRegKeyBaseName, AfterInstallFilesSize);
  2728. RecordUninstallRunEntries(UninstLog);
  2729. UninstLog.Add(utEndInstall, [GetLocalTimeAsStr], 0);
  2730. UninstLog.Save(UninstallDataFilename, AppendUninstallData,
  2731. shUpdateUninstallLogAppName in SetupHeader.Options);
  2732. if Debugging then
  2733. DebugNotifyUninstExe(UninstallExeFileName);
  2734. end;
  2735. SetStatusLabelText('');
  2736. UninstLogCleared := True;
  2737. UninstLog.Clear;
  2738. except
  2739. try
  2740. { Show error message, if any, and set the exit code we'll be returning }
  2741. if not(ExceptObject is EAbort) then begin
  2742. Log(Format('Fatal exception during installation process (%s):' + SNewLine,
  2743. [ExceptObject.ClassName]) + GetExceptMessage);
  2744. SetupExitCode := ecInstallationError;
  2745. Application.HandleException(nil);
  2746. LoggedMsgBox(SetupMessages[msgSetupAborted], '', mbCriticalError, MB_OK, True, IDOK);
  2747. end
  2748. else begin
  2749. Log('User canceled the installation process.');
  2750. SetupExitCode := ecInstallationCancelled;
  2751. end;
  2752. { Undo any changes it's made so far }
  2753. if not UninstLogCleared then begin
  2754. Log('Rolling back changes.');
  2755. try
  2756. SetStatusLabelText(SetupMessages[msgStatusRollback]);
  2757. WizardForm.ProgressGauge.Visible := False;
  2758. FinishProgressGauge(True);
  2759. WizardForm.CancelButton.Enabled := False;
  2760. WizardForm.Update;
  2761. except
  2762. { ignore any exceptions, just in case... }
  2763. end;
  2764. if UninstallTempExeFilename <> '' then
  2765. DeleteFile(UninstallTempExeFilename);
  2766. if UninstallExeCreated = ueNew then
  2767. DeleteFile(UninstallExeFilename);
  2768. if UninstallDataCreated then
  2769. DeleteFile(UninstallDataFilename);
  2770. if UninstallMsgCreated then
  2771. DeleteFile(UninstallMsgFilename);
  2772. UninstLog.PerformUninstall(False, nil);
  2773. { Sleep for a bit so that the user has time to read the "Rolling
  2774. back changes" message }
  2775. if WizardForm.Visible then
  2776. Sleep(1500);
  2777. end;
  2778. except
  2779. { No exception should be generated by the above code, but just in
  2780. case, handle any exception now so that Application.Terminate is
  2781. always called below.
  2782. Note that we can't just put Application.Terminate in a finally
  2783. section, because it would prevent the display of an exception
  2784. message box later (MessageBox() dislikes WM_QUIT). }
  2785. Application.HandleException(nil);
  2786. end;
  2787. Exit;
  2788. end;
  2789. finally
  2790. if Assigned(RegisterFilesList) then begin
  2791. for I := RegisterFilesList.Count-1 downto 0 do
  2792. Dispose(PRegisterFilesListRec(RegisterFilesList[I]));
  2793. RegisterFilesList.Free;
  2794. end;
  2795. UninstLog.Free;
  2796. FinishProgressGauge(False);
  2797. end;
  2798. Log('Installation process succeeded.');
  2799. Succeeded := True;
  2800. end;
  2801. end.