Setup.Install.pas 126 KB

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