Setup.Install.pas 171 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107110811091110111111121113111411151116111711181119112011211122112311241125112611271128112911301131113211331134113511361137113811391140114111421143114411451146114711481149115011511152115311541155115611571158115911601161116211631164116511661167116811691170117111721173117411751176117711781179118011811182118311841185118611871188118911901191119211931194119511961197119811991200120112021203120412051206120712081209121012111212121312141215121612171218121912201221122212231224122512261227122812291230123112321233123412351236123712381239124012411242124312441245124612471248124912501251125212531254125512561257125812591260126112621263126412651266126712681269127012711272127312741275127612771278127912801281128212831284128512861287128812891290129112921293129412951296129712981299130013011302130313041305130613071308130913101311131213131314131513161317131813191320132113221323132413251326132713281329133013311332133313341335133613371338133913401341134213431344134513461347134813491350135113521353135413551356135713581359136013611362136313641365136613671368136913701371137213731374137513761377137813791380138113821383138413851386138713881389139013911392139313941395139613971398139914001401140214031404140514061407140814091410141114121413141414151416141714181419142014211422142314241425142614271428142914301431143214331434143514361437143814391440144114421443144414451446144714481449145014511452145314541455145614571458145914601461146214631464146514661467146814691470147114721473147414751476147714781479148014811482148314841485148614871488148914901491149214931494149514961497149814991500150115021503150415051506150715081509151015111512151315141515151615171518151915201521152215231524152515261527152815291530153115321533153415351536153715381539154015411542154315441545154615471548154915501551155215531554155515561557155815591560156115621563156415651566156715681569157015711572157315741575157615771578157915801581158215831584158515861587158815891590159115921593159415951596159715981599160016011602160316041605160616071608160916101611161216131614161516161617161816191620162116221623162416251626162716281629163016311632163316341635163616371638163916401641164216431644164516461647164816491650165116521653165416551656165716581659166016611662166316641665166616671668166916701671167216731674167516761677167816791680168116821683168416851686168716881689169016911692169316941695169616971698169917001701170217031704170517061707170817091710171117121713171417151716171717181719172017211722172317241725172617271728172917301731173217331734173517361737173817391740174117421743174417451746174717481749175017511752175317541755175617571758175917601761176217631764176517661767176817691770177117721773177417751776177717781779178017811782178317841785178617871788178917901791179217931794179517961797179817991800180118021803180418051806180718081809181018111812181318141815181618171818181918201821182218231824182518261827182818291830183118321833183418351836183718381839184018411842184318441845184618471848184918501851185218531854185518561857185818591860186118621863186418651866186718681869187018711872187318741875187618771878187918801881188218831884188518861887188818891890189118921893189418951896189718981899190019011902190319041905190619071908190919101911191219131914191519161917191819191920192119221923192419251926192719281929193019311932193319341935193619371938193919401941194219431944194519461947194819491950195119521953195419551956195719581959196019611962196319641965196619671968196919701971197219731974197519761977197819791980198119821983198419851986198719881989199019911992199319941995199619971998199920002001200220032004200520062007200820092010201120122013201420152016201720182019202020212022202320242025202620272028202920302031203220332034203520362037203820392040204120422043204420452046204720482049205020512052205320542055205620572058205920602061206220632064206520662067206820692070207120722073207420752076207720782079208020812082208320842085208620872088208920902091209220932094209520962097209820992100210121022103210421052106210721082109211021112112211321142115211621172118211921202121212221232124212521262127212821292130213121322133213421352136213721382139214021412142214321442145214621472148214921502151215221532154215521562157215821592160216121622163216421652166216721682169217021712172217321742175217621772178217921802181218221832184218521862187218821892190219121922193219421952196219721982199220022012202220322042205220622072208220922102211221222132214221522162217221822192220222122222223222422252226222722282229223022312232223322342235223622372238223922402241224222432244224522462247224822492250225122522253225422552256225722582259226022612262226322642265226622672268226922702271227222732274227522762277227822792280228122822283228422852286228722882289229022912292229322942295229622972298229923002301230223032304230523062307230823092310231123122313231423152316231723182319232023212322232323242325232623272328232923302331233223332334233523362337233823392340234123422343234423452346234723482349235023512352235323542355235623572358235923602361236223632364236523662367236823692370237123722373237423752376237723782379238023812382238323842385238623872388238923902391239223932394239523962397239823992400240124022403240424052406240724082409241024112412241324142415241624172418241924202421242224232424242524262427242824292430243124322433243424352436243724382439244024412442244324442445244624472448244924502451245224532454245524562457245824592460246124622463246424652466246724682469247024712472247324742475247624772478247924802481248224832484248524862487248824892490249124922493249424952496249724982499250025012502250325042505250625072508250925102511251225132514251525162517251825192520252125222523252425252526252725282529253025312532253325342535253625372538253925402541254225432544254525462547254825492550255125522553255425552556255725582559256025612562256325642565256625672568256925702571257225732574257525762577257825792580258125822583258425852586258725882589259025912592259325942595259625972598259926002601260226032604260526062607260826092610261126122613261426152616261726182619262026212622262326242625262626272628262926302631263226332634263526362637263826392640264126422643264426452646264726482649265026512652265326542655265626572658265926602661266226632664266526662667266826692670267126722673267426752676267726782679268026812682268326842685268626872688268926902691269226932694269526962697269826992700270127022703270427052706270727082709271027112712271327142715271627172718271927202721272227232724272527262727272827292730273127322733273427352736273727382739274027412742274327442745274627472748274927502751275227532754275527562757275827592760276127622763276427652766276727682769277027712772277327742775277627772778277927802781278227832784278527862787278827892790279127922793279427952796279727982799280028012802280328042805280628072808280928102811281228132814281528162817281828192820282128222823282428252826282728282829283028312832283328342835283628372838283928402841284228432844284528462847284828492850285128522853285428552856285728582859286028612862286328642865286628672868286928702871287228732874287528762877287828792880288128822883288428852886288728882889289028912892289328942895289628972898289929002901290229032904290529062907290829092910291129122913291429152916291729182919292029212922292329242925292629272928292929302931293229332934293529362937293829392940294129422943294429452946294729482949295029512952295329542955295629572958295929602961296229632964296529662967296829692970297129722973297429752976297729782979298029812982298329842985298629872988298929902991299229932994299529962997299829993000300130023003300430053006300730083009301030113012301330143015301630173018301930203021302230233024302530263027302830293030303130323033303430353036303730383039304030413042304330443045304630473048304930503051305230533054305530563057305830593060306130623063306430653066306730683069307030713072307330743075307630773078307930803081308230833084308530863087308830893090309130923093309430953096309730983099310031013102310331043105310631073108310931103111311231133114311531163117311831193120312131223123312431253126312731283129313031313132313331343135313631373138313931403141314231433144314531463147314831493150315131523153315431553156315731583159316031613162316331643165316631673168316931703171317231733174317531763177317831793180318131823183318431853186318731883189319031913192319331943195319631973198319932003201320232033204320532063207320832093210321132123213321432153216321732183219322032213222322332243225322632273228322932303231323232333234323532363237323832393240324132423243324432453246324732483249325032513252325332543255325632573258325932603261326232633264326532663267326832693270327132723273327432753276327732783279328032813282328332843285328632873288328932903291329232933294329532963297329832993300330133023303330433053306330733083309331033113312331333143315331633173318331933203321332233233324332533263327332833293330333133323333333433353336333733383339334033413342334333443345334633473348334933503351335233533354335533563357335833593360336133623363336433653366336733683369337033713372337333743375337633773378337933803381338233833384338533863387338833893390339133923393339433953396339733983399340034013402340334043405340634073408340934103411341234133414341534163417341834193420342134223423342434253426342734283429343034313432343334343435343634373438343934403441344234433444344534463447344834493450345134523453345434553456345734583459346034613462346334643465346634673468346934703471347234733474347534763477347834793480348134823483348434853486348734883489349034913492349334943495349634973498349935003501350235033504350535063507350835093510351135123513351435153516351735183519352035213522352335243525352635273528352935303531353235333534353535363537353835393540354135423543354435453546354735483549355035513552355335543555355635573558355935603561356235633564356535663567356835693570357135723573357435753576357735783579358035813582358335843585358635873588358935903591359235933594359535963597359835993600360136023603360436053606360736083609361036113612361336143615361636173618361936203621362236233624362536263627362836293630363136323633363436353636363736383639364036413642364336443645364636473648364936503651365236533654365536563657365836593660366136623663366436653666366736683669367036713672367336743675367636773678367936803681368236833684368536863687368836893690369136923693369436953696369736983699370037013702370337043705370637073708370937103711371237133714371537163717371837193720372137223723372437253726372737283729373037313732373337343735373637373738373937403741374237433744374537463747374837493750375137523753375437553756375737583759376037613762376337643765376637673768376937703771377237733774377537763777377837793780378137823783378437853786378737883789379037913792379337943795379637973798379938003801380238033804380538063807380838093810381138123813381438153816381738183819382038213822382338243825382638273828382938303831383238333834383538363837383838393840384138423843384438453846384738483849385038513852385338543855385638573858385938603861386238633864386538663867386838693870387138723873387438753876387738783879388038813882388338843885388638873888388938903891389238933894389538963897389838993900390139023903390439053906390739083909391039113912391339143915391639173918391939203921392239233924392539263927392839293930393139323933393439353936393739383939394039413942394339443945394639473948394939503951395239533954395539563957395839593960396139623963396439653966396739683969397039713972397339743975397639773978397939803981398239833984398539863987398839893990399139923993399439953996399739983999400040014002400340044005400640074008400940104011401240134014401540164017401840194020402140224023402440254026402740284029403040314032403340344035403640374038403940404041404240434044404540464047404840494050405140524053405440554056405740584059406040614062406340644065406640674068406940704071407240734074407540764077407840794080408140824083408440854086408740884089409040914092409340944095409640974098409941004101410241034104410541064107410841094110411141124113411441154116411741184119412041214122412341244125412641274128
  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. uses
  11. Classes, SHA256, Shared.FileClass, Shared.SetupTypes, Shared.Int64Em, Shared.Struct;
  12. function NoVerification: TSetupFileVerification;
  13. procedure VerificationError(const AError: TVerificationError;
  14. const ASigFilename: String = '');
  15. procedure DoISSigVerify(const SourceF: TFile; const SourceFS: TFileStream;
  16. const SourceFilename: String; const VerifySourceFilename: Boolean; const ISSigAllowedKeys: AnsiString;
  17. out ExpectedFileHash: TSHA256Digest);
  18. procedure PerformInstall(var Succeeded: Boolean; const ChangesEnvironment,
  19. ChangesAssociations: Boolean);
  20. type
  21. TOnDownloadProgress = function(const Url, BaseName: string; const Progress, ProgressMax: Int64): Boolean of object;
  22. TOnSimpleDownloadProgress = procedure(const Bytes, Param: Integer64);
  23. procedure ExtractTemporaryFile(const BaseName: String);
  24. function ExtractTemporaryFiles(const Pattern: String): Integer;
  25. function DownloadFile(const Url, CustomUserName, CustomPassword: String;
  26. const DestF: TFile; [ref] const Verification: TSetupFileVerification; const ISSigSourceFilename: String;
  27. const OnSimpleDownloadProgress: TOnSimpleDownloadProgress;
  28. const OnSimpleDownloadProgressParam: Integer64): Int64;
  29. function DownloadTemporaryFile(const Url, BaseName: String;
  30. [ref] const Verification: TSetupFileVerification; const OnDownloadProgress: TOnDownloadProgress): Int64; overload;
  31. function DownloadTemporaryFile(const Url, BaseName: String;
  32. [ref] const Verification: TSetupFileVerification; const OnDownloadProgress: TOnDownloadProgress;
  33. out DestFile: String): Int64; overload;
  34. function DownloadTemporaryFileSize(const Url: String): Int64;
  35. function DownloadTemporaryFileDate(const Url: String): String;
  36. procedure SetDownloadTemporaryFileCredentials(const User, Pass: String);
  37. function GetISSigUrl(const Url, ISSigUrl: String): String;
  38. implementation
  39. uses
  40. Windows, SysUtils, Messages, Forms, ShlObj, Setup.UninstallLog,
  41. SetupLdrAndSetup.InstFunc, Setup.InstFunc, Setup.InstFunc.Ole, Setup.SecurityFunc, SetupLdrAndSetup.Messages,
  42. Setup.MainFunc, Setup.LoggingFunc, Setup.FileExtractor,
  43. Compression.Base, PathFunc, ISSigFunc, Shared.CommonFunc.Vcl, Compression.SevenZipDLLDecoder,
  44. Shared.CommonFunc, SetupLdrAndSetup.RedirFunc, Shared.SetupMessageIDs,
  45. Setup.WizardForm, Shared.DebugStruct, Setup.DebugClient, Shared.VerInfoFunc, Setup.ScriptRunner, Setup.RegDLL, Setup.Helper,
  46. Shared.ResUpdateFunc, Setup.DotNetFunc, TaskbarProgressFunc, NewProgressBar, RestartManager,
  47. Net.HTTPClient, Net.URLClient, NetEncoding, RegStr;
  48. type
  49. TSetupUninstallLog = class(TUninstallLog)
  50. protected
  51. procedure HandleException; override;
  52. end;
  53. var
  54. CurProgress: Integer64;
  55. ProgressShiftCount: Cardinal;
  56. { TSetupUninstallLog }
  57. procedure TSetupUninstallLog.HandleException;
  58. begin
  59. Application.HandleException(Self);
  60. end;
  61. procedure SetFilenameLabelText(const S: String; const CallUpdate: Boolean);
  62. begin
  63. WizardForm.FilenameLabel.Caption := MinimizePathName(S, WizardForm.FilenameLabel.Font, WizardForm.FileNameLabel.Width);
  64. if CallUpdate then
  65. WizardForm.FilenameLabel.Update;
  66. end;
  67. procedure SetStatusLabelText(const S: String;
  68. const ClearFilenameLabelText: Boolean = True);
  69. begin
  70. if WizardForm.StatusLabel.Caption <> S then begin
  71. WizardForm.StatusLabel.Caption := S;
  72. WizardForm.StatusLabel.Update;
  73. end;
  74. if ClearFilenameLabelText then
  75. SetFilenameLabelText('', True);
  76. end;
  77. procedure InstallMessageBoxCallback(const Flags: LongInt; const After: Boolean;
  78. const Param: LongInt);
  79. const
  80. States: array [TNewProgressBarState] of TTaskbarProgressState =
  81. (tpsNormal, tpsError, tpsPaused);
  82. var
  83. NewState: TNewProgressBarState;
  84. begin
  85. if After then
  86. NewState := npbsNormal
  87. else if (Flags and MB_ICONSTOP) <> 0 then
  88. NewState := npbsError
  89. else
  90. NewState := npbsPaused;
  91. with WizardForm.ProgressGauge do begin
  92. State := NewState;
  93. Invalidate;
  94. end;
  95. SetAppTaskbarProgressState(States[NewState]);
  96. end;
  97. procedure CalcFilesSize(var InstallFilesSize, AfterInstallFilesSize: Integer64);
  98. var
  99. N: Integer;
  100. CurFile: PSetupFileEntry;
  101. FileSize: Integer64;
  102. begin
  103. InstallFilesSize := To64(0);
  104. AfterInstallFilesSize := InstallFilesSize;
  105. for N := 0 to Entries[seFile].Count-1 do begin
  106. CurFile := PSetupFileEntry(Entries[seFile][N]);
  107. if ShouldProcessFileEntry(WizardComponents, WizardTasks, CurFile, False) then begin
  108. with CurFile^ do begin
  109. if LocationEntry <> -1 then { not an "external" file }
  110. FileSize := PSetupFileLocationEntry(Entries[seFileLocation][
  111. LocationEntry])^.OriginalSize
  112. else
  113. FileSize := ExternalSize;
  114. Inc6464(InstallFilesSize, FileSize);
  115. if not (foDeleteAfterInstall in Options) then
  116. Inc6464(AfterInstallFilesSize, FileSize);
  117. end;
  118. end;
  119. end;
  120. end;
  121. procedure InitProgressGauge(const InstallFilesSize: Integer64);
  122. var
  123. NewMaxValue: Integer64;
  124. begin
  125. { Calculate the MaxValue for the progress meter }
  126. NewMaxValue := To64(1000 * Entries[seIcon].Count);
  127. if Entries[seIni].Count <> 0 then Inc(NewMaxValue.Lo, 1000);
  128. if Entries[seRegistry].Count <> 0 then Inc(NewMaxValue.Lo, 1000);
  129. Inc6464(NewMaxValue, InstallFilesSize);
  130. { To avoid progress updates that are too small to result in any visible
  131. change, divide the Max value by 2 until it's under 1500 }
  132. ProgressShiftCount := 0;
  133. while (NewMaxValue.Hi <> 0) or (NewMaxValue.Lo >= Cardinal(1500)) do begin
  134. Shr64(NewMaxValue, 1);
  135. Inc(ProgressShiftCount);
  136. end;
  137. WizardForm.ProgressGauge.Max := NewMaxValue.Lo;
  138. SetMessageBoxCallbackFunc(InstallMessageBoxCallback, 0);
  139. end;
  140. procedure UpdateProgressGauge;
  141. var
  142. NewPosition: Integer64;
  143. begin
  144. NewPosition := CurProgress;
  145. Shr64(NewPosition, ProgressShiftCount);
  146. if WizardForm.ProgressGauge.Position <> Longint(NewPosition.Lo) then begin
  147. WizardForm.ProgressGauge.Position := NewPosition.Lo;
  148. WizardForm.ProgressGauge.Update;
  149. end;
  150. SetAppTaskbarProgressValue(NewPosition.Lo, WizardForm.ProgressGauge.Max);
  151. if (CodeRunner <> nil) and CodeRunner.FunctionExists('CurInstallProgressChanged', True) then begin
  152. try
  153. CodeRunner.RunProcedures('CurInstallProgressChanged', [NewPosition.Lo,
  154. WizardForm.ProgressGauge.Max], False);
  155. except
  156. Log('CurInstallProgressChanged raised an exception.');
  157. Application.HandleException(nil);
  158. end;
  159. end;
  160. end;
  161. procedure FinishProgressGauge(const HideGauge: Boolean);
  162. begin
  163. SetMessageBoxCallbackFunc(nil, 0);
  164. if HideGauge then
  165. WizardForm.ProgressGauge.Visible := False;
  166. SetAppTaskbarProgressState(tpsNoProgress);
  167. end;
  168. procedure SetProgress(const AProgress: Integer64);
  169. begin
  170. CurProgress := AProgress;
  171. UpdateProgressGauge;
  172. end;
  173. procedure IncProgress(const N: Cardinal);
  174. begin
  175. Inc64(CurProgress, N);
  176. UpdateProgressGauge;
  177. end;
  178. procedure IncProgress64(const N: Integer64);
  179. begin
  180. Inc6464(CurProgress, N);
  181. UpdateProgressGauge;
  182. end;
  183. procedure ProcessEvents;
  184. { Processes any waiting events. Must call this this periodically or else
  185. events like clicking the Cancel button won't be processed.
  186. Calls Abort if NeedToAbortInstall is True, which is usually the result of
  187. the user clicking Cancel and the form closing. }
  188. begin
  189. if NeedToAbortInstall then Abort;
  190. Application.ProcessMessages;
  191. if NeedToAbortInstall then Abort;
  192. end;
  193. procedure InternalProgressProc(const Bytes: Cardinal);
  194. begin
  195. IncProgress(Bytes);
  196. ProcessEvents;
  197. end;
  198. procedure ExternalProgressProc64(const Bytes, MaxProgress: Integer64);
  199. begin
  200. var NewProgress := CurProgress;
  201. Inc6464(NewProgress, Bytes);
  202. { In case the source file was larger than we thought it was, stop the
  203. progress bar at the maximum amount. Also see CopySourceFileToDestFile. }
  204. if Compare64(NewProgress, MaxProgress) > 0 then
  205. NewProgress := MaxProgress;
  206. SetProgress(NewProgress);
  207. ProcessEvents;
  208. end;
  209. procedure JustProcessEventsProc64(const Bytes, Param: Integer64);
  210. begin
  211. ProcessEvents;
  212. end;
  213. function AbortRetryIgnoreTaskDialogMsgBox(const Text: String;
  214. const RetryIgnoreAbortButtonLabels: array of String): Boolean;
  215. { Returns True if Ignore was selected, False if Retry was selected, or
  216. calls Abort if Abort was selected. }
  217. begin
  218. Result := False;
  219. case LoggedTaskDialogMsgBox('', SetupMessages[msgAbortRetryIgnoreSelectAction], Text, '',
  220. mbError, MB_ABORTRETRYIGNORE, RetryIgnoreAbortButtonLabels, 0, True, IDABORT) of
  221. IDABORT: Abort;
  222. IDRETRY: ;
  223. IDIGNORE: Result := True;
  224. else
  225. Log('LoggedTaskDialogMsgBox returned an unexpected value. Assuming Abort.');
  226. Abort;
  227. end;
  228. end;
  229. function FileTimeToStr(const AFileTime: TFileTime): String;
  230. { Converts a TFileTime into a string for log purposes. }
  231. var
  232. FT: TFileTime;
  233. ST: TSystemTime;
  234. begin
  235. FileTimeToLocalFileTime(AFileTime, FT);
  236. if FileTimeToSystemTime(FT, ST) then
  237. Result := Format('%.4u-%.2u-%.2u %.2u:%.2u:%.2u.%.3u',
  238. [ST.wYear, ST.wMonth, ST.wDay, ST.wHour, ST.wMinute, ST.wSecond,
  239. ST.wMilliseconds])
  240. else
  241. Result := '(invalid)';
  242. end;
  243. function TryToGetSHA256OfFile(const DisableFsRedir: Boolean; const Filename: String;
  244. var Sum: TSHA256Digest): Boolean;
  245. { Like GetSHA256OfFile but traps exceptions locally. Returns True if successful. }
  246. begin
  247. try
  248. Sum := GetSHA256OfFile(DisableFsRedir, Filename);
  249. Result := True;
  250. except
  251. Result := False;
  252. end;
  253. end;
  254. function NoVerification: TSetupFileVerification;
  255. begin
  256. Result := Default(TSetupFileVerification);
  257. Result.Typ := fvNone;
  258. end;
  259. procedure VerificationError(const AError: TVerificationError;
  260. const ASigFilename: String);
  261. const
  262. LogMessages: array[TVerificationError] of String =
  263. ('Signature file does not exist', 'Signature is malformed', 'No matching key found',
  264. 'Signature is bad', 'File name is incorrect', 'File size is incorrect', 'File hash is incorrect');
  265. SetupMessageIDs: array[TVerificationError] of TSetupMessageID =
  266. (msgVerificationSignatureDoesntExist, msgVerificationSignatureInvalid, msgVerificationKeyNotFound,
  267. msgVerificationSignatureInvalid, msgVerificationFileNameIncorrect, msgVerificationFileSizeIncorrect,
  268. msgVerificationFileHashIncorrect);
  269. begin
  270. { Also see Compiler.SetupCompiler for a similar function }
  271. Log('Verification error: ' + AddPeriod(LogMessages[AError]));
  272. raise Exception.Create(FmtSetupMessage1(msgSourceVerificationFailed,
  273. FmtSetupMessage1(SetupMessageIDs[AError], PathExtractName(ASigFilename)))); { Not all messages actually have a %1 parameter but that's OK }
  274. end;
  275. procedure DoISSigVerify(const SourceF: TFile; const SourceFS: TFileStream;
  276. const SourceFilename: String; const VerifySourceFilename: Boolean; const ISSigAllowedKeys: AnsiString;
  277. out ExpectedFileHash: TSHA256Digest);
  278. { Does not disable FS redirection. Either SourceF or SourceFS must be set, which
  279. may be opened for writing instead of reading. }
  280. begin
  281. if ((SourceF = nil) and (SourceFS = nil)) or ((SourceF <> nil) and (SourceFS <> nil)) then
  282. InternalError('DoISSigVerify: Invalid SourceF / SourceFS combination');
  283. var ExpectedFileName: String;
  284. var ExpectedFileSize: Int64;
  285. if not ISSigVerifySignature(SourceFilename,
  286. GetISSigAllowedKeys(ISSigAvailableKeys, ISSigAllowedKeys),
  287. ExpectedFileName, ExpectedFileSize, ExpectedFileHash,
  288. nil,
  289. procedure(const Filename, SigFilename: String)
  290. begin
  291. VerificationError(veSignatureMissing, SigFilename);
  292. end,
  293. procedure(const Filename, SigFilename: String; const VerifyResult: TISSigVerifySignatureResult)
  294. begin
  295. case VerifyResult of
  296. vsrMalformed: VerificationError(veSignatureMalformed, SigFilename);
  297. vsrBad: VerificationError(veSignatureBad, SigFilename);
  298. vsrKeyNotFound: VerificationError(veKeyNotFound, SigFilename);
  299. else
  300. InternalError('Unknown ISSigVerifySignature result');
  301. end;
  302. end
  303. ) then
  304. InternalError('Unexpected ISSigVerifySignature result');
  305. if VerifySourceFilename and (ExpectedFileName <> '') and not PathSame(PathExtractName(SourceFilename), ExpectedFileName) then
  306. VerificationError(veFileNameIncorrect);
  307. var FileSize: Int64;
  308. if SourceF <> nil then
  309. FileSize := SourceF.Size
  310. else
  311. FileSize := SourceFS.Size;
  312. if FileSize <> ExpectedFileSize then
  313. VerificationError(veFileSizeIncorrect);
  314. { Caller must check ExpectedFileHash }
  315. end;
  316. const
  317. VerificationSuccessfulLogMessage = 'Verification successful.';
  318. procedure CopySourceFileToDestFile(const SourceF, DestF: TFile;
  319. [ref] const Verification: TSetupFileVerification; const ISSigSourceFilename: String;
  320. const AExpectedSize: Integer64);
  321. { Copies all bytes from SourceF to DestF, incrementing process meter as it
  322. goes. Assumes file pointers of both are 0. }
  323. var
  324. BytesLeft: Integer64;
  325. BufSize: Cardinal;
  326. Buf: array[0..16383] of Byte;
  327. Context: TSHA256Context;
  328. begin
  329. var ExpectedFileHash: TSHA256Digest;
  330. if Verification.Typ <> fvNone then begin
  331. if Verification.Typ = fvHash then
  332. ExpectedFileHash := Verification.Hash
  333. else
  334. DoISSigVerify(SourceF, nil, ISSigSourceFilename, True, Verification.ISSigAllowedKeys, ExpectedFileHash);
  335. { ExpectedFileHash checked below after copy }
  336. SHA256Init(Context);
  337. end;
  338. var MaxProgress := CurProgress;
  339. Inc6464(MaxProgress, AExpectedSize);
  340. BytesLeft := SourceF.Size;
  341. { To avoid file system fragmentation, preallocate all of the bytes in the
  342. destination file }
  343. DestF.Seek64(BytesLeft);
  344. DestF.Truncate;
  345. DestF.Seek(0);
  346. while True do begin
  347. BufSize := SizeOf(Buf);
  348. if (BytesLeft.Hi = 0) and (BytesLeft.Lo < BufSize) then
  349. BufSize := BytesLeft.Lo;
  350. if BufSize = 0 then
  351. Break;
  352. SourceF.ReadBuffer(Buf, BufSize);
  353. DestF.WriteBuffer(Buf, BufSize);
  354. Dec64(BytesLeft, BufSize);
  355. if Verification.Typ <> fvNone then
  356. SHA256Update(Context, Buf, BufSize);
  357. ExternalProgressProc64(To64(BufSize), MaxProgress);
  358. end;
  359. if Verification.Typ <> fvNone then begin
  360. if not SHA256DigestsEqual(SHA256Final(Context), ExpectedFileHash) then
  361. VerificationError(veFileHashIncorrect);
  362. Log(VerificationSuccessfulLogMessage);
  363. end;
  364. { In case the source file was shorter than we thought it was, bump the
  365. progress bar to the maximum amount }
  366. SetProgress(MaxProgress);
  367. end;
  368. procedure AddAttributesToFile(const DisableFsRedir: Boolean;
  369. const Filename: String; Attribs: Integer);
  370. var
  371. ExistingAttr: DWORD;
  372. begin
  373. if Attribs <> 0 then begin
  374. ExistingAttr := GetFileAttributesRedir(DisableFsRedir, Filename);
  375. if ExistingAttr <> INVALID_FILE_ATTRIBUTES then
  376. SetFileAttributesRedir(DisableFsRedir, Filename,
  377. (ExistingAttr and not FILE_ATTRIBUTE_NORMAL) or DWORD(Attribs));
  378. end;
  379. end;
  380. function ShortenOrExpandFontFilename(const Filename: String): String;
  381. { Expands Filename, except if it's in the Fonts directory, in which case it
  382. removes the path }
  383. var
  384. FontDir: String;
  385. begin
  386. Result := PathExpand(Filename);
  387. FontDir := GetShellFolder(False, sfFonts);
  388. if FontDir <> '' then
  389. if PathCompare(PathExtractDir(Result), FontDir) = 0 then
  390. Result := PathExtractName(Result);
  391. end;
  392. function LastErrorIndicatesPossiblyInUse(const LastError: DWORD; const CheckAlreadyExists: Boolean): Boolean;
  393. begin
  394. Result := (LastError = ERROR_ACCESS_DENIED) or
  395. (LastError = ERROR_SHARING_VIOLATION) or
  396. (CheckAlreadyExists and (LastError = ERROR_ALREADY_EXISTS));
  397. end;
  398. procedure PerformInstall(var Succeeded: Boolean; const ChangesEnvironment,
  399. ChangesAssociations: Boolean);
  400. type
  401. PRegisterFilesListRec = ^TRegisterFilesListRec;
  402. TRegisterFilesListRec = record
  403. Filename: String;
  404. Is64Bit, TypeLib, NoErrorMessages: Boolean;
  405. end;
  406. var
  407. UninstLog: TSetupUninstallLog;
  408. UninstallTempExeFilename, UninstallDataFilename, UninstallMsgFilename: String;
  409. UninstallExeCreated: (ueNone, ueNew, ueReplaced);
  410. UninstallDataCreated, UninstallMsgCreated, AppendUninstallData: Boolean;
  411. RegisterFilesList: TList;
  412. ExpandedAppId: String;
  413. function GetLocalTimeAsStr: String;
  414. var
  415. SysTime: TSystemTime;
  416. begin
  417. GetLocalTime(SysTime);
  418. SetString(Result, PChar(@SysTime), SizeOf(SysTime) div SizeOf(Char));
  419. end;
  420. procedure RecordStartInstall;
  421. var
  422. AppDir: String;
  423. begin
  424. if shCreateAppDir in SetupHeader.Options then
  425. AppDir := WizardDirValue
  426. else
  427. AppDir := '';
  428. UninstLog.Add(utStartInstall, [GetComputerNameString, GetUserNameString,
  429. AppDir, GetLocalTimeAsStr], 0);
  430. end;
  431. procedure PackCustomMessagesIntoString(var S: String);
  432. var
  433. M: TMemoryStream;
  434. Count, I, N: Integer;
  435. begin
  436. M := TMemoryStream.Create;
  437. try
  438. Count := 0;
  439. M.WriteBuffer(Count, SizeOf(Count)); { overwritten later }
  440. for I := 0 to Entries[seCustomMessage].Count-1 do begin
  441. with PSetupCustomMessageEntry(Entries[seCustomMessage][I])^ do begin
  442. if (LangIndex = -1) or (LangIndex = ActiveLanguage) then begin
  443. N := Length(Name);
  444. M.WriteBuffer(N, SizeOf(N));
  445. M.WriteBuffer(Name[1], N*SizeOf(Name[1]));
  446. N := Length(Value);
  447. M.WriteBuffer(N, SizeOf(N));
  448. M.WriteBuffer(Value[1], N*SizeOf(Value[1]));
  449. Inc(Count);
  450. end;
  451. end;
  452. end;
  453. M.Seek(0, soFromBeginning);
  454. M.WriteBuffer(Count, SizeOf(Count));
  455. SetString(S, PChar(M.Memory), M.Size div SizeOf(Char));
  456. finally
  457. M.Free;
  458. end;
  459. end;
  460. function PackCompiledCodeTextIntoString(const CompiledCodeText: AnsiString): String;
  461. var
  462. N: Integer;
  463. begin
  464. N := Length(CompiledCodeText);
  465. if N mod 2 = 1 then
  466. Inc(N); { This will lead to 1 extra byte being moved but that's ok since it is the #0 }
  467. N := N div 2;
  468. SetString(Result, PChar(Pointer(CompiledCodeText)), N);
  469. end;
  470. procedure RecordCompiledCode;
  471. var
  472. LeadBytesStr, ExpandedApp, ExpandedGroup, CustomMessagesStr: String;
  473. begin
  474. { Only use app if Setup creates one }
  475. if shCreateAppDir in SetupHeader.Options then
  476. ExpandedApp := ExpandConst('{app}')
  477. else
  478. ExpandedApp := '';
  479. try
  480. ExpandedGroup := ExpandConst('{group}');
  481. except
  482. { Yep, expanding "group" might fail with an exception }
  483. ExpandedGroup := '';
  484. end;
  485. if SetupHeader.CompiledCodeText <> '' then
  486. PackCustomMessagesIntoString(CustomMessagesStr);
  487. { Record [Code] even if empty to 'overwrite' old versions }
  488. UninstLog.Add(utCompiledCode, [PackCompiledCodeTextIntoString(SetupHeader.CompiledCodeText),
  489. LeadBytesStr, ExpandedApp, ExpandedGroup, WizardGroupValue,
  490. ExpandConst('{language}'), CustomMessagesStr], SetupBinVersion or Longint($80000000));
  491. end;
  492. type
  493. TRegErrorFunc = (reRegSetValueEx, reRegCreateKeyEx, reRegOpenKeyEx);
  494. procedure RegError(const Func: TRegErrorFunc; const RootKey: HKEY;
  495. const KeyName: String; const ErrorCode: Longint);
  496. const
  497. ErrorMsgs: array[TRegErrorFunc] of TSetupMessageID =
  498. (msgErrorRegWriteKey, msgErrorRegCreateKey, msgErrorRegOpenKey);
  499. FuncNames: array[TRegErrorFunc] of String =
  500. ('RegSetValueEx', 'RegCreateKeyEx', 'RegOpenKeyEx');
  501. begin
  502. raise Exception.Create(FmtSetupMessage(ErrorMsgs[Func],
  503. [GetRegRootKeyName(RootKey), KeyName]) + SNewLine2 +
  504. FmtSetupMessage(msgErrorFunctionFailedWithMessage,
  505. [FuncNames[Func], IntToStr(ErrorCode), Win32ErrorString(ErrorCode)]));
  506. end;
  507. procedure RegisterUninstallInfo(const UninstallRegKeyBaseName: String; const AfterInstallFilesSize: Integer64);
  508. { Stores uninstall information in the Registry so that the program can be
  509. uninstalled through the Control Panel Add/Remove Programs applet. }
  510. const
  511. AdminInstallModeNames: array [Boolean] of String =
  512. ('non administrative', 'administrative');
  513. BitInstallModeNames: array [Boolean] of String =
  514. ('32-bit', '64-bit');
  515. var
  516. RegView, OppositeRegView: TRegView;
  517. RegViewIs64Bit, OppositeRegViewIs64Bit: Boolean;
  518. RootKey, OppositeRootKey: HKEY;
  519. RootKeyIsHKLM, OppositeRootKeyIsHKLM: Boolean;
  520. SubkeyName: String;
  521. procedure SetStringValue(const K: HKEY; const ValueName: PChar;
  522. const Data: String);
  523. var
  524. ErrorCode: Longint;
  525. begin
  526. ErrorCode := RegSetValueEx(K, ValueName, 0, REG_SZ, PChar(Data),
  527. (Length(Data)+1)*SizeOf(Data[1]));
  528. if ErrorCode <> ERROR_SUCCESS then
  529. RegError(reRegSetValueEx, RootKey, SubkeyName, ErrorCode);
  530. end;
  531. procedure SetStringValueUnlessEmpty(const K: HKEY; const ValueName: PChar;
  532. const Data: String);
  533. begin
  534. if Data <> '' then
  535. SetStringValue(K, ValueName, Data);
  536. end;
  537. procedure SetDWordValue(const K: HKEY; const ValueName: PChar;
  538. const Data: DWord);
  539. var
  540. ErrorCode: Longint;
  541. begin
  542. ErrorCode := RegSetValueEx(K, ValueName, 0, REG_DWORD, @Data,
  543. SizeOf(Data));
  544. if ErrorCode <> ERROR_SUCCESS then
  545. RegError(reRegSetValueEx, RootKey, SubkeyName, ErrorCode);
  546. end;
  547. function GetInstallDateString: String;
  548. var
  549. ST: TSystemTime;
  550. begin
  551. GetLocalTime(ST);
  552. Result := Format('%.4u%.2u%.2u', [ST.wYear, ST.wMonth, ST.wDay]);
  553. end;
  554. function ExtractMajorMinorVersion(Version: String; var Major, Minor: Integer): Boolean;
  555. var
  556. P, I: Integer;
  557. begin
  558. P := Pos('.', Version);
  559. if P <> 0 then begin
  560. Val(Copy(Version, 1, P-1), Major, I);
  561. if I = 0 then begin
  562. Delete(Version, 1, P);
  563. P := Pos('.', Version);
  564. if P <> 0 then
  565. Val(Copy(Version, 1, P-1), Minor, I)
  566. else
  567. Val(Version, Minor, I);
  568. end;
  569. end else begin
  570. Val(Version, Major, I);
  571. Minor := 0;
  572. end;
  573. Result := I = 0;
  574. end;
  575. { Also see Main.pas }
  576. function ExistingInstallationAt(const RegView: TRegView; const RootKey: HKEY): Boolean;
  577. var
  578. K: HKEY;
  579. begin
  580. if RegOpenKeyExView(RegView, RootKey, PChar(SubkeyName), 0, KEY_QUERY_VALUE, K) = ERROR_SUCCESS then begin
  581. Result := True;
  582. RegCloseKey(K);
  583. end else
  584. Result := False;
  585. end;
  586. procedure HandleDuplicateDisplayNames(var DisplayName: String);
  587. const
  588. UninstallDisplayNameMarksUser: array [Boolean] of TSetupMessageId =
  589. (msgUninstallDisplayNameMarkCurrentUser, msgUninstallDisplayNameMarkAllUsers);
  590. UninstallDisplayNameMarksBits: array [Boolean] of TSetupMessageId =
  591. (msgUninstallDisplayNameMark32Bit, msgUninstallDisplayNameMark64Bit);
  592. var
  593. ExistingAtOppositeAdminInstallMode, ExistingAtOpposite64BitInstallMode: Boolean;
  594. begin
  595. { Check opposite administrative install mode. }
  596. ExistingAtOppositeAdminInstallMode := ExistingInstallationAt(RegView, OppositeRootKey);
  597. if RootKeyIsHKLM or not IsWin64 then begin
  598. { 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. }
  599. LogFmt('Detected previous %s install? %s',
  600. [AdminInstallModeNames[OppositeRootKeyIsHKLM {always False}], SYesNo[ExistingAtOppositeAdminInstallMode]])
  601. end else begin
  602. { Opposite (HKLM) is not shared for 32-bit and 64-bit so log bitness. }
  603. LogFmt('Detected previous %s %s install? %s',
  604. [AdminInstallModeNames[OppositeRootKeyIsHKLM {always True}], BitInstallModeNames[RegViewIs64Bit], SYesNo[ExistingAtOppositeAdminInstallMode]]);
  605. end;
  606. if IsWin64 then begin
  607. { Check opposite 32-bit or 64-bit install mode. }
  608. if RootKeyIsHKLM then begin
  609. { 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
  610. since HKCU is shared for 32-bit and 64-bit mode and we already checked HKCU above. }
  611. ExistingAtOpposite64BitInstallMode := ExistingInstallationAt(OppositeRegView, RootKey {always HKLM});
  612. LogFmt('Detected previous %s %s install? %s',
  613. [AdminInstallModeNames[RootKeyIsHKLM {always True}], BitInstallModeNames[OppositeRegViewIs64Bit], SYesNo[ExistingAtOpposite64BitInstallMode]]);
  614. end else begin
  615. { 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
  616. 64-bit install mode since we haven't already done that. }
  617. ExistingAtOpposite64BitInstallMode := ExistingInstallationAt(OppositeRegView, OppositeRootKey {always HKLM});
  618. if ExistingAtOpposite64BitInstallMode then
  619. ExistingAtOppositeAdminInstallMode := True;
  620. LogFmt('Detected previous %s %s install? %s',
  621. [AdminInstallModeNames[OppositeRootKeyIsHKLM {always True}], BitInstallModeNames[OppositeRegViewIs64Bit], SYesNo[ExistingAtOpposite64BitInstallMode]]);
  622. end;
  623. end else
  624. ExistingAtOpposite64BitInstallMode := False;
  625. { Mark new display name if needed. Note: currently we don't attempt to mark existing display names as well. }
  626. if ExistingAtOppositeAdminInstallMode or ExistingAtOpposite64BitInstallMode then begin
  627. if ExistingAtOppositeAdminInstallMode and ExistingAtOpposite64BitInstallMode then
  628. DisplayName := FmtSetupMessage(msgUninstallDisplayNameMarks,
  629. [DisplayName, SetupMessages[UninstallDisplayNameMarksUser[RootKeyIsHKLM]],
  630. SetupMessages[UninstallDisplayNameMarksBits[RegViewIs64Bit]]])
  631. else if ExistingAtOppositeAdminInstallMode then
  632. DisplayName := FmtSetupMessage(msgUninstallDisplayNameMark,
  633. [DisplayName, SetupMessages[UninstallDisplayNameMarksUser[RootKeyIsHKLM]]])
  634. else
  635. DisplayName := FmtSetupMessage(msgUninstallDisplayNameMark,
  636. [DisplayName, SetupMessages[UninstallDisplayNameMarksBits[RegViewIs64Bit]]]);
  637. LogFmt('Marked uninstall display name to avoid duplicate entries. New display name: %s', [DisplayName]);
  638. end;
  639. end;
  640. var
  641. H2: HKEY;
  642. ErrorCode: Longint;
  643. Z: String;
  644. MajorVersion, MinorVersion, I: Integer;
  645. EstimatedSize: Integer64;
  646. begin
  647. RegView := InstallDefaultRegView;
  648. RegViewIs64Bit := RegView = rv64Bit;
  649. if RegViewIs64Bit then
  650. OppositeRegView := rv32Bit
  651. else
  652. OppositeRegView := rv64Bit;
  653. OppositeRegViewIs64Bit := not RegViewIs64Bit;
  654. RootKey := InstallModeRootKey;
  655. RootKeyIsHKLM := RootKey = HKEY_LOCAL_MACHINE;
  656. if RootKeyIsHKLM then
  657. OppositeRootKey := HKEY_CURRENT_USER
  658. else
  659. OppositeRootKey := HKEY_LOCAL_MACHINE;
  660. OppositeRootKeyIsHKLM := not RootKeyIsHKLM;
  661. SubkeyName := GetUninstallRegSubkeyName(UninstallRegKeyBaseName);
  662. if ExistingInstallationAt(RegView, RootKey) then begin
  663. if RootKeyIsHKLM then begin
  664. { HKLM is not shared for 32-bit and 64-bit so log bitness. }
  665. LogFmt('Deleting uninstall key left over from previous %s %s install.',
  666. [AdminInstallModeNames[RootKeyIsHKLM {always True}], BitInstallModeNames[RegViewIs64Bit]]);
  667. end else begin
  668. { HKCU is shared for 32-bit and 64-bit so don't log bitness. }
  669. LogFmt('Deleting uninstall key left over from previous %s install.',
  670. [AdminInstallModeNames[RootKeyIsHKLM {always False}]])
  671. end;
  672. RegDeleteKeyIncludingSubkeys(RegView, RootKey, PChar(SubkeyName));
  673. end;
  674. LogFmt('Creating new uninstall key: %s\%s', [GetRegRootKeyName(RootKey), SubkeyName]);
  675. { Create uninstall key }
  676. ErrorCode := RegCreateKeyExView(RegView, RootKey, PChar(SubkeyName),
  677. 0, nil, REG_OPTION_NON_VOLATILE, KEY_SET_VALUE, nil, H2, nil);
  678. if ErrorCode <> ERROR_SUCCESS then
  679. RegError(reRegCreateKeyEx, RootKey, SubkeyName, ErrorCode);
  680. try
  681. Log('Writing uninstall key values.');
  682. { do not localize or change any of the following strings }
  683. SetStringValue(H2, 'Inno Setup: Setup Version', SetupVersion);
  684. if shCreateAppDir in SetupHeader.Options then
  685. Z := WizardDirValue
  686. else
  687. Z := '';
  688. SetStringValue(H2, 'Inno Setup: App Path', Z);
  689. SetStringValueUnlessEmpty(H2, 'InstallLocation', AddBackslash(Z));
  690. SetStringValue(H2, 'Inno Setup: Icon Group', WizardGroupValue);
  691. if WizardNoIcons then
  692. SetDWordValue(H2, 'Inno Setup: No Icons', 1);
  693. SetStringValue(H2, 'Inno Setup: User', GetUserNameString);
  694. if WizardSetupType <> nil then begin
  695. SetStringValue(H2, 'Inno Setup: Setup Type', WizardSetupType.Name);
  696. SetStringValue(H2, 'Inno Setup: Selected Components', StringsToCommaString(WizardComponents));
  697. SetStringValue(H2, 'Inno Setup: Deselected Components', StringsToCommaString(WizardDeselectedComponents));
  698. end;
  699. if HasTasks then begin
  700. SetStringValue(H2, 'Inno Setup: Selected Tasks', StringsToCommaString(WizardTasks));
  701. SetStringValue(H2, 'Inno Setup: Deselected Tasks', StringsToCommaString(WizardDeselectedTasks));
  702. end;
  703. if shUserInfoPage in SetupHeader.Options then begin
  704. SetStringValue(H2, 'Inno Setup: User Info: Name', WizardUserInfoName);
  705. SetStringValue(H2, 'Inno Setup: User Info: Organization', WizardUserInfoOrg);
  706. SetStringValue(H2, 'Inno Setup: User Info: Serial', WizardUserInfoSerial);
  707. end;
  708. SetStringValue(H2, 'Inno Setup: Language', PSetupLanguageEntry(Entries[seLanguage][ActiveLanguage]).Name);
  709. if SetupHeader.UninstallDisplayName <> '' then
  710. Z := ExpandConst(SetupHeader.UninstallDisplayName)
  711. else
  712. Z := ExpandedAppVerName;
  713. HandleDuplicateDisplayNames(Z);
  714. { For the entry to appear in ARP, DisplayName cannot exceed 259 characters
  715. on Windows 2000 and later. }
  716. SetStringValue(H2, 'DisplayName', Copy(Z, 1, 259));
  717. SetStringValueUnlessEmpty(H2, 'DisplayIcon', ExpandConst(SetupHeader.UninstallDisplayIcon));
  718. var ExtraUninstallString: String;
  719. if shUninstallLogging in SetupHeader.Options then
  720. ExtraUninstallString := ' /LOG'
  721. else
  722. ExtraUninstallString := '';
  723. SetStringValue(H2, 'UninstallString', '"' + UninstallExeFilename + '"' + ExtraUninstallString);
  724. SetStringValue(H2, 'QuietUninstallString', '"' + UninstallExeFilename + '" /SILENT' + ExtraUninstallString);
  725. SetStringValueUnlessEmpty(H2, 'DisplayVersion', ExpandConst(SetupHeader.AppVersion));
  726. SetStringValueUnlessEmpty(H2, 'Publisher', ExpandConst(SetupHeader.AppPublisher));
  727. SetStringValueUnlessEmpty(H2, 'URLInfoAbout', ExpandConst(SetupHeader.AppPublisherURL));
  728. SetStringValueUnlessEmpty(H2, 'HelpTelephone', ExpandConst(SetupHeader.AppSupportPhone));
  729. SetStringValueUnlessEmpty(H2, 'HelpLink', ExpandConst(SetupHeader.AppSupportURL));
  730. SetStringValueUnlessEmpty(H2, 'URLUpdateInfo', ExpandConst(SetupHeader.AppUpdatesURL));
  731. SetStringValueUnlessEmpty(H2, 'Readme', ExpandConst(SetupHeader.AppReadmeFile));
  732. SetStringValueUnlessEmpty(H2, 'Contact', ExpandConst(SetupHeader.AppContact));
  733. SetStringValueUnlessEmpty(H2, 'Comments', ExpandConst(SetupHeader.AppComments));
  734. Z := ExpandConst(SetupHeader.AppModifyPath);
  735. if Z <> '' then
  736. SetStringValue(H2, 'ModifyPath', Z)
  737. else
  738. SetDWordValue(H2, 'NoModify', 1);
  739. SetDWordValue(H2, 'NoRepair', 1);
  740. SetStringValue(H2, 'InstallDate', GetInstallDateString);
  741. if ExtractMajorMinorVersion(ExpandConst(SetupHeader.AppVersion), MajorVersion, MinorVersion) then begin
  742. { Originally MSDN said to write to Major/MinorVersion, now it says to write to VersionMajor/Minor. So write to both. }
  743. SetDWordValue(H2, 'MajorVersion', MajorVersion);
  744. SetDWordValue(H2, 'MinorVersion', MinorVersion);
  745. SetDWordValue(H2, 'VersionMajor', MajorVersion);
  746. SetDWordValue(H2, 'VersionMinor', MinorVersion);
  747. end;
  748. { Note: Windows 7 (and later?) doesn't automatically calculate sizes so set EstimatedSize ourselves. }
  749. if (SetupHeader.UninstallDisplaySize.Hi = 0) and (SetupHeader.UninstallDisplaySize.Lo = 0) then begin
  750. { Estimate the size by taking the size of all files and adding any ExtraDiskSpaceRequired. }
  751. EstimatedSize := AfterInstallFilesSize;
  752. Inc6464(EstimatedSize, SetupHeader.ExtraDiskSpaceRequired);
  753. for I := 0 to Entries[seComponent].Count-1 do begin
  754. with PSetupComponentEntry(Entries[seComponent][I])^ do begin
  755. if ShouldProcessEntry(WizardComponents, nil, Name, '', Languages, '') then
  756. Inc6464(EstimatedSize, ExtraDiskSpaceRequired);
  757. end;
  758. end;
  759. end else
  760. EstimatedSize := SetupHeader.UninstallDisplaySize;
  761. { ARP on Windows 7 without SP1 only pays attention to the lower 6 bytes of EstimatedSize and
  762. throws away the rest. For example putting in $4000001 (=4GB + 1KB) displays as 1 KB.
  763. So we need to check for this. }
  764. if (Hi(NTServicePackLevel) > 0) or IsWindows8 or (EstimatedSize.Hi = 0) then begin
  765. Div64(EstimatedSize, 1024);
  766. SetDWordValue(H2, 'EstimatedSize', EstimatedSize.Lo)
  767. end;
  768. { Also see SetPreviousData in ScriptFunc.pas }
  769. if CodeRunner <> nil then begin
  770. try
  771. CodeRunner.RunProcedures('RegisterPreviousData', [Integer(H2)], False);
  772. except
  773. Log('RegisterPreviousData raised an exception.');
  774. Application.HandleException(nil);
  775. end;
  776. end;
  777. finally
  778. RegCloseKey(H2);
  779. end;
  780. UninstLog.AddReg(utRegDeleteEntireKey, RegView, RootKey,
  781. [SubkeyName]);
  782. end;
  783. type
  784. TMakeDirFlags = set of (mdNoUninstall, mdAlwaysUninstall, mdDeleteAfterInstall,
  785. mdNotifyChange);
  786. function MakeDir(const DisableFsRedir: Boolean; Dir: String;
  787. const Flags: TMakeDirFlags): Boolean;
  788. { Returns True if a new directory was created.
  789. Note: If DisableFsRedir is True, the mdNotifyChange flag should not be
  790. specified; it won't work properly. }
  791. var
  792. ErrorCode: DWORD;
  793. UninstFlags: Longint;
  794. begin
  795. Result := False;
  796. Dir := RemoveBackslashUnlessRoot(PathExpand(Dir));
  797. if PathExtractName(Dir) = '' then { reached root? }
  798. Exit;
  799. if DirExistsRedir(DisableFsRedir, Dir) then begin
  800. if not(mdAlwaysUninstall in Flags) then
  801. Exit;
  802. end
  803. else begin
  804. MakeDir(DisableFsRedir, PathExtractDir(Dir), Flags - [mdAlwaysUninstall]);
  805. LogFmt('Creating directory: %s', [Dir]);
  806. if not CreateDirectoryRedir(DisableFsRedir, Dir) then begin
  807. ErrorCode := GetLastError;
  808. raise Exception.Create(FmtSetupMessage(msgLastErrorMessage,
  809. [FmtSetupMessage1(msgErrorCreatingDir, Dir), IntToStr(ErrorCode),
  810. Win32ErrorString(ErrorCode)]));
  811. end;
  812. Result := True;
  813. if mdNotifyChange in Flags then begin
  814. SHChangeNotify(SHCNE_MKDIR, SHCNF_PATH, PChar(Dir), nil);
  815. SHChangeNotify(SHCNE_UPDATEDIR, SHCNF_PATH or SHCNF_FLUSH,
  816. PChar(PathExtractDir(Dir)), nil);
  817. end;
  818. end;
  819. if mdDeleteAfterInstall in Flags then
  820. DeleteDirsAfterInstallList.AddObject(Dir, Pointer(Ord(DisableFsRedir)))
  821. else begin
  822. if not(mdNoUninstall in Flags) then begin
  823. UninstFlags := utDeleteDirOrFiles_IsDir;
  824. if DisableFsRedir then
  825. UninstFlags := UninstFlags or utDeleteDirOrFiles_DisableFsRedir;
  826. if mdNotifyChange in Flags then
  827. UninstFlags := UninstFlags or utDeleteDirOrFiles_CallChangeNotify;
  828. UninstLog.Add(utDeleteDirOrFiles, [Dir], UninstFlags);
  829. end;
  830. end;
  831. end;
  832. procedure CreateDirs;
  833. { Creates the application's directories }
  834. procedure ApplyPermissions(const DisableFsRedir: Boolean;
  835. const Filename: String; const PermsEntry: Integer);
  836. var
  837. P: PSetupPermissionEntry;
  838. begin
  839. if PermsEntry <> -1 then begin
  840. LogFmt('Setting permissions on directory: %s', [Filename]);
  841. P := Entries[sePermission][PermsEntry];
  842. if not GrantPermissionOnFile(DisableFsRedir, Filename,
  843. TGrantPermissionEntry(Pointer(P.Permissions)^),
  844. Length(P.Permissions) div SizeOf(TGrantPermissionEntry)) then
  845. LogFmt('Failed to set permissions on directory (%d).', [GetLastError]);
  846. end;
  847. end;
  848. procedure ApplyNTFSCompression(const DisableFsRedir: Boolean;
  849. const Filename: String; const Compress: Boolean);
  850. begin
  851. if Compress then
  852. LogFmt('Setting NTFS compression on directory: %s', [Filename])
  853. else
  854. LogFmt('Unsetting NTFS compression on directory: %s', [Filename]);
  855. if not SetNTFSCompressionRedir(DisableFsRedir, Filename, Compress) then
  856. LogFmt('Failed to set NTFS compression state (%d).', [GetLastError]);
  857. end;
  858. var
  859. CurDirNumber: Integer;
  860. Flags: TMakeDirFlags;
  861. N: String;
  862. begin
  863. { Create main application directory }
  864. MakeDir(InstallDefaultDisableFsRedir, WizardDirValue, []);
  865. { Create the rest of the directories, if any }
  866. for CurDirNumber := 0 to Entries[seDir].Count-1 do
  867. with PSetupDirEntry(Entries[seDir][CurDirNumber])^ do begin
  868. if ShouldProcessEntry(WizardComponents, WizardTasks, Components, Tasks, Languages, Check) then begin
  869. DebugNotifyEntry(seDir, CurDirNumber);
  870. NotifyBeforeInstallEntry(BeforeInstall);
  871. Flags := [];
  872. if doUninsNeverUninstall in Options then Include(Flags, mdNoUninstall);
  873. if doDeleteAfterInstall in Options then Include(Flags, mdDeleteAfterInstall);
  874. if doUninsAlwaysUninstall in Options then Include(Flags, mdAlwaysUninstall);
  875. N := RemoveBackslashUnlessRoot(PathExpand(ExpandConst(DirName)));
  876. MakeDir(InstallDefaultDisableFsRedir, N, Flags);
  877. AddAttributesToFile(InstallDefaultDisableFsRedir, N, Attribs);
  878. ApplyPermissions(InstallDefaultDisableFsRedir, N, PermissionsEntry);
  879. if (doSetNTFSCompression in Options) or (doUnsetNTFSCompression in Options) then
  880. ApplyNTFSCompression(InstallDefaultDisableFsRedir, N, doSetNTFSCompression in Options);
  881. NotifyAfterInstallEntry(AfterInstall);
  882. end;
  883. end;
  884. end;
  885. procedure WriteMsgData(const F: TFile);
  886. var
  887. MsgLangOpts: TMessagesLangOptions;
  888. LangEntry: PSetupLanguageEntry;
  889. begin
  890. FillChar(MsgLangOpts, SizeOf(MsgLangOpts), 0);
  891. MsgLangOpts.ID := MessagesLangOptionsID;
  892. StrPLCopy(MsgLangOpts.DialogFontName, LangOptions.DialogFontName,
  893. (SizeOf(MsgLangOpts.DialogFontName) div SizeOf(MsgLangOpts.DialogFontName[0])) - 1);
  894. MsgLangOpts.DialogFontSize := LangOptions.DialogFontSize;
  895. if LangOptions.RightToLeft then
  896. Include(MsgLangOpts.Flags, lfRightToLeft);
  897. LangEntry := Entries[seLanguage][ActiveLanguage];
  898. F.WriteBuffer(LangEntry.Data[1], Length(LangEntry.Data));
  899. F.WriteBuffer(MsgLangOpts, SizeOf(MsgLangOpts));
  900. end;
  901. procedure MarkExeHeader(const F: TFile; const ModeID: Longint);
  902. begin
  903. F.Seek(SetupExeModeOffset);
  904. F.WriteBuffer(ModeID, SizeOf(ModeID));
  905. end;
  906. procedure BindUninstallMsgDataToExe(const F: TFile);
  907. var
  908. UniqueValue: TSHA256Digest;
  909. UninstallerMsgTail: TUninstallerMsgTail;
  910. begin
  911. F.SeekToEnd;
  912. { First append the hash of AppId so that unins*.exe files from different
  913. applications won't have the same file hash. This is done to combat broken
  914. anti-spyware programs that catch all unins*.exe files with certain hash
  915. sums just because some piece of spyware was deployed with Inno Setup and
  916. had the unins*.exe file in its directory. }
  917. UniqueValue := GetSHA256OfUnicodeString(ExpandedAppId);
  918. F.WriteBuffer(UniqueValue, SizeOf(UniqueValue));
  919. UninstallerMsgTail.ID := UninstallerMsgTailID;
  920. UninstallerMsgTail.Offset := F.Position;
  921. WriteMsgData(F);
  922. F.WriteBuffer(UninstallerMsgTail, SizeOf(UninstallerMsgTail));
  923. end;
  924. type
  925. TOverwriteAll = (oaUnknown, oaOverwrite, oaKeep);
  926. procedure ProcessFileEntry(const CurFile: PSetupFileEntry;
  927. const DisableFsRedir: Boolean; AExternalSourceFile, ADestFile: String;
  928. const FileLocationFilenames: TStringList; const AExternalSize: Integer64;
  929. var ConfirmOverwriteOverwriteAll, PromptIfOlderOverwriteAll: TOverwriteAll;
  930. var WarnedPerUserFonts: Boolean; const AExternalFileDate: PFileTime);
  931. { Not external: AExternalSourceFile and ADestFile should be empty strings,
  932. FileLocationFilenames should be set, AExternalSize is unused,
  933. AExternalFileDate should not be set
  934. External : Opposite except AExternalFileDate still not set
  935. Ext. Archive: Same as external except AExternalFileDate set and
  936. AExternalSourceFile should be set to ArchiveFindHandle as a string
  937. Ext. Downl. : Same as external except
  938. AExternalSourceFile should be set to an URL }
  939. procedure InstallFont(const Filename, FontName: String;
  940. const PerUserFont, AddToFontTableNow: Boolean; var WarnedPerUserFonts: Boolean);
  941. var
  942. RootKey, K: HKEY;
  943. begin
  944. if PerUserFont and not WindowsVersionAtLeast(10, 0, 17134) then begin
  945. { Per-user fonts require Windows 10 Version 1803 (10.0.17134) or newer. }
  946. if not WarnedPerUserFonts then begin
  947. Log('Failed to set value in Fonts registry key: per-user fonts are not supported by this version of Windows.');
  948. WarnedPerUserFonts := True;
  949. end;
  950. end else begin
  951. { 64-bit Windows note: The Fonts key is evidently exempt from registry
  952. redirection. When a 32-bit app writes to the Fonts key, it's the main
  953. 64-bit key that is modified. (There is actually a Fonts key under
  954. Wow6432Node but it appears it's never used or updated.)
  955. Also: We don't bother with any FS redirection stuff here. I'm not sure
  956. it's safe to disable FS redirection when calling AddFontResource, or
  957. if it would even work. Users should be installing their fonts to the
  958. Fonts directory instead of the System directory anyway. }
  959. if PerUserFont then
  960. RootKey := HKEY_CURRENT_USER
  961. else
  962. RootKey := HKEY_LOCAL_MACHINE;
  963. if RegOpenKeyExView(rvDefault, RootKey, 'Software\Microsoft\Windows NT\CurrentVersion\Fonts', 0,
  964. KEY_SET_VALUE, K) = ERROR_SUCCESS then begin
  965. if RegSetValueEx(K, PChar(FontName), 0, REG_SZ, PChar(Filename),
  966. (Length(Filename)+1)*SizeOf(Filename[1])) <> ERROR_SUCCESS then
  967. Log('Failed to set value in Fonts registry key.');
  968. RegCloseKey(K);
  969. end
  970. else
  971. Log('Failed to open Fonts registry key.');
  972. end;
  973. if AddToFontTableNow then begin
  974. repeat
  975. { Note: AddFontResource doesn't set the thread's last error code }
  976. if AddFontResource(PChar(Filename)) <> 0 then begin
  977. SendNotifyMessage(HWND_BROADCAST, WM_FONTCHANGE, 0, 0);
  978. Break;
  979. end;
  980. until AbortRetryIgnoreTaskDialogMsgBox(
  981. AddPeriod(FmtSetupMessage1(msgErrorFunctionFailedNoCode, 'AddFontResource')),
  982. [SetupMessages[msgAbortRetryIgnoreRetry], SetupMessages[msgAbortRetryIgnoreIgnore], SetupMessages[msgAbortRetryIgnoreCancel]]);
  983. end;
  984. end;
  985. procedure SetFileLocationFilename(const LocationEntry: Integer;
  986. Filename: String);
  987. var
  988. LowercaseFilename: String;
  989. Hash: Longint;
  990. I: Integer;
  991. begin
  992. Filename := PathExpand(Filename);
  993. LowercaseFilename := PathLowercase(Filename);
  994. Hash := GetCRC32(LowercaseFilename[1], Length(LowercaseFilename)*SizeOf(LowercaseFilename[1]));
  995. { If Filename was already associated with another LocationEntry,
  996. disassociate it. If we *don't* do this, then this script won't
  997. produce the expected result:
  998. [Files]
  999. Source: "fileA"; DestName: "file2"
  1000. Source: "fileB"; DestName: "file2"
  1001. Source: "fileA"; DestName: "file1"
  1002. 1. It extracts fileA under the name "file2"
  1003. 2. It extracts fileB under the name "file2"
  1004. 3. It copies file2 to file1, thinking a copy of fileA was still
  1005. stored in file2.
  1006. }
  1007. for I := 0 to FileLocationFilenames.Count-1 do
  1008. if (Longint(FileLocationFilenames.Objects[I]) = Hash) and
  1009. (PathLowercase(FileLocationFilenames[I]) = LowercaseFilename) then begin
  1010. FileLocationFilenames[I] := '';
  1011. FileLocationFilenames.Objects[I] := nil;
  1012. Break;
  1013. end;
  1014. FileLocationFilenames[LocationEntry] := Filename;
  1015. FileLocationFilenames.Objects[LocationEntry] := Pointer(Hash);
  1016. end;
  1017. procedure ApplyPermissions(const DisableFsRedir: Boolean;
  1018. const Filename: String; const PermsEntry: Integer);
  1019. var
  1020. Attr: DWORD;
  1021. P: PSetupPermissionEntry;
  1022. begin
  1023. if PermsEntry <> -1 then begin
  1024. Attr := GetFileAttributesRedir(DisableFsRedir, Filename);
  1025. if (Attr <> INVALID_FILE_ATTRIBUTES) and (Attr and FILE_ATTRIBUTE_DIRECTORY = 0) then begin
  1026. LogFmt('Setting permissions on file: %s', [Filename]);
  1027. P := Entries[sePermission][PermsEntry];
  1028. if not GrantPermissionOnFile(DisableFsRedir, Filename,
  1029. TGrantPermissionEntry(Pointer(P.Permissions)^),
  1030. Length(P.Permissions) div SizeOf(TGrantPermissionEntry)) then
  1031. LogFmt('Failed to set permissions on file (%d).', [GetLastError]);
  1032. end;
  1033. end;
  1034. end;
  1035. procedure ApplyNTFSCompression(const DisableFsRedir: Boolean;
  1036. const Filename: String; const Compress: Boolean);
  1037. begin
  1038. if Compress then
  1039. LogFmt('Setting NTFS compression on file: %s', [Filename])
  1040. else
  1041. LogFmt('Unsetting NTFS compression on file: %s', [Filename]);
  1042. if not SetNTFSCompressionRedir(DisableFsRedir, Filename, Compress) then
  1043. LogFmt('Failed to set NTFS compression state (%d).', [GetLastError]);
  1044. end;
  1045. procedure DoHandleFailedDeleteOrMoveFileTry(const Func, TempFile, DestFile: String;
  1046. const LastError: DWORD; var RetriesLeft: Integer; var LastOperation: String;
  1047. var NeedsRestart, ReplaceOnRestart, DoBreak, DoContinue: Boolean);
  1048. begin
  1049. { Automatically retry. Wait with replace on restart until no
  1050. retries left, unless we already know we're going to restart. }
  1051. if ((RetriesLeft = 0) or NeedsRestart) and
  1052. (foRestartReplace in CurFile^.Options) and IsAdmin then begin
  1053. LogFmt('%s: The existing file appears to be in use (%d). ' +
  1054. 'Will replace on restart.', [Func, LastError]);
  1055. LastOperation := SetupMessages[msgErrorRestartReplace];
  1056. NeedsRestart := True;
  1057. RestartReplace(DisableFsRedir, TempFile, DestFile);
  1058. ReplaceOnRestart := True;
  1059. DoBreak := True;
  1060. DoContinue := False;
  1061. end else if RetriesLeft > 0 then begin
  1062. LogFmt('%s: The existing file appears to be in use (%d). ' +
  1063. 'Retrying.', [Func, LastError]);
  1064. Dec(RetriesLeft);
  1065. Sleep(1000);
  1066. ProcessEvents;
  1067. DoBreak := False;
  1068. DoContinue := True;
  1069. end else begin
  1070. DoBreak := False;
  1071. DoContinue := False;
  1072. end;
  1073. end;
  1074. function AskOverwrite(const DestFile, Instruction, Caption: string; const ButtonLabels: array of String;
  1075. const VerificationText: String; const Typ: TMsgBoxType; const Default, Overwrite: Integer;
  1076. var OverwriteAll: TOverwriteAll): Boolean;
  1077. var
  1078. VerificationFlagChecked: BOOL;
  1079. begin
  1080. if OverwriteAll = oaKeep then
  1081. Result := False { The user already said to keep (=not overwrite) all }
  1082. else begin
  1083. Result := LoggedTaskDialogMsgBox('', Instruction, DestFile + SNewLine2 + Caption, '',
  1084. Typ, MB_YESNO, ButtonLabels, 0, True, Default, VerificationText, @VerificationFlagChecked) = Overwrite;
  1085. if VerificationFlagChecked then begin
  1086. if Result then
  1087. OverwriteAll := oaOverwrite
  1088. else
  1089. OverwriteAll := oaKeep;
  1090. end;
  1091. end;
  1092. end;
  1093. var
  1094. ProgressUpdated: Boolean;
  1095. PreviousProgress: Integer64;
  1096. LastOperation: String;
  1097. CurFileLocation: PSetupFileLocationEntry;
  1098. SourceFile, DestFile, TempFile, FontFilename: String;
  1099. DestFileExists, DestFileExistedBefore, CheckedDestFileExistedBefore,
  1100. TempFileLeftOver, AllowFileToBeDuplicated, ReplaceOnRestart, DoBreak,
  1101. DoContinue: Boolean;
  1102. Failed: String;
  1103. CurFileVersionInfoValid: Boolean;
  1104. CurFileVersionInfo, ExistingVersionInfo: TFileVersionNumbers;
  1105. CurFileDateValid, ExistingFileDateValid: Boolean;
  1106. IsProtectedFile, AllowTimeStampComparison: Boolean;
  1107. DeleteFlags: Longint;
  1108. CurFileDate, ExistingFileDate: TFileTime;
  1109. RegisterRec: PRegisterFilesListRec;
  1110. RetriesLeft: Integer;
  1111. LastError: DWORD;
  1112. DestF, SourceF: TFile;
  1113. Flags: TMakeDirFlags;
  1114. Overwrite, PerUserFont: Boolean;
  1115. label Retry, Skip;
  1116. begin
  1117. Log('-- File entry --');
  1118. CheckedDestFileExistedBefore := False;
  1119. DestFileExistedBefore := False; { prevent warning }
  1120. if CurFile^.LocationEntry <> -1 then
  1121. CurFileLocation := PSetupFileLocationEntry(Entries[seFileLocation][CurFile^.LocationEntry])
  1122. else
  1123. CurFileLocation := nil;
  1124. Retry:
  1125. DestFile := '';
  1126. TempFile := '';
  1127. TempFileLeftOver := False;
  1128. ProgressUpdated := False;
  1129. PreviousProgress := CurProgress;
  1130. LastOperation := '';
  1131. Failed := '';
  1132. try
  1133. try
  1134. ReplaceOnRestart := False;
  1135. DeleteFlags := 0;
  1136. if DisableFsRedir then
  1137. DeleteFlags := DeleteFlags or utDeleteFile_DisableFsRedir;
  1138. if foRegisterServer in CurFile^.Options then
  1139. DeleteFlags := DeleteFlags or utDeleteFile_RegisteredServer;
  1140. if foRegisterTypeLib in CurFile^.Options then
  1141. DeleteFlags := DeleteFlags or utDeleteFile_RegisteredTypeLib;
  1142. if foUninsRestartDelete in CurFile^.Options then
  1143. DeleteFlags := DeleteFlags or utDeleteFile_RestartDelete;
  1144. if foUninsRemoveReadOnly in CurFile^.Options then
  1145. DeleteFlags := DeleteFlags or utDeleteFile_RemoveReadOnly;
  1146. if foGacInstall in CurFile^.Options then
  1147. DeleteFlags := DeleteFlags or utDeleteFile_GacInstalled;
  1148. FontFilename := '';
  1149. { Determine the destination filename }
  1150. try
  1151. case CurFile^.FileType of
  1152. ftUninstExe: DestFile := UninstallExeFilename;
  1153. else
  1154. if ADestFile = '' then
  1155. DestFile := ExpandConst(CurFile^.DestName)
  1156. else
  1157. DestFile := ADestFile;
  1158. end;
  1159. DestFile := PathExpand(DestFile);
  1160. except
  1161. { If an exception occurred, reset DestFile back to an empty string
  1162. so the error message doesn't show an unexpanded name }
  1163. DestFile := '';
  1164. raise;
  1165. end;
  1166. { Update the status and filename labels }
  1167. if foDownload in CurFile^.Options then
  1168. SetStatusLabelText(SetupMessages[msgStatusDownloadFiles], False)
  1169. else
  1170. SetStatusLabelText(SetupMessages[msgStatusExtractFiles], False);
  1171. SetFilenameLabelText(DestFile, True);
  1172. LogFmt('Dest filename: %s', [DestFile]);
  1173. if DisableFsRedir <> InstallDefaultDisableFsRedir then begin
  1174. if DisableFsRedir then
  1175. Log('Non-default bitness: 64-bit')
  1176. else
  1177. Log('Non-default bitness: 32-bit');
  1178. end;
  1179. { See if it's a protected system file. }
  1180. if IsProtectedSystemFile(DisableFsRedir, DestFile) then begin
  1181. Log('Dest file is protected by Windows File Protection.');
  1182. IsProtectedFile := (CurFile^.FileType = ftUserFile);
  1183. end else
  1184. IsProtectedFile := False;
  1185. DestFileExists := NewFileExistsRedir(DisableFsRedir, DestFile);
  1186. if not CheckedDestFileExistedBefore then begin
  1187. DestFileExistedBefore := DestFileExists;
  1188. CheckedDestFileExistedBefore := True;
  1189. end;
  1190. if DestFileExistedBefore then
  1191. DeleteFlags := DeleteFlags or utDeleteFile_ExistedBeforeInstall;
  1192. var CurFileDateDidRead := True; { Set to False later if needed }
  1193. if Assigned(CurFileLocation) then begin
  1194. if floTimeStampInUTC in CurFileLocation^.Flags then
  1195. CurFileDate := CurFileLocation^.SourceTimeStamp
  1196. else
  1197. LocalFileTimeToFileTime(CurFileLocation^.SourceTimeStamp, CurFileDate);
  1198. CurFileDateValid := True;
  1199. end else if Assigned(AExternalFileDate) then begin
  1200. CurFileDate := AExternalFileDate^;
  1201. CurFileDateValid := CurFileDate.HasTime;
  1202. end else if not(foDownload in CurFile^.Options) then
  1203. CurFileDateValid := GetFileDateTime(DisableFsRedir, AExternalSourceFile, CurFileDate)
  1204. else begin
  1205. CurFileDateValid := False;
  1206. CurFileDateDidRead := False;
  1207. end;
  1208. if CurFileDateValid then
  1209. LogFmt('Time stamp of our file: %s', [FileTimeToStr(CurFileDate)])
  1210. else if CurFileDateDidRead then
  1211. Log('Time stamp of our file: (failed to read)');
  1212. if DestFileExists then begin
  1213. Log('Dest file exists.');
  1214. if foOnlyIfDoesntExist in CurFile^.Options then begin
  1215. Log('Skipping due to "onlyifdoesntexist" flag.');
  1216. goto Skip;
  1217. end;
  1218. LastOperation := SetupMessages[msgErrorReadingExistingDest];
  1219. ExistingFileDateValid := GetFileDateTime(DisableFsRedir, DestFile, ExistingFileDate);
  1220. if ExistingFileDateValid then
  1221. LogFmt('Time stamp of existing file: %s', [FileTimeToStr(ExistingFileDate)])
  1222. else
  1223. Log('Time stamp of existing file: (failed to read)');
  1224. { Compare version info }
  1225. if not(foIgnoreVersion in CurFile^.Options) then begin
  1226. AllowTimeStampComparison := False;
  1227. { Read version info of file being installed }
  1228. if foDownload in CurFile^.Options then
  1229. InternalError('Unexpected Download flag');
  1230. if foExtractArchive in CurFile^.Options then
  1231. InternalError('Unexpected ExtractArchive flag');
  1232. if Assigned(CurFileLocation) then begin
  1233. CurFileVersionInfoValid := floVersionInfoValid in CurFileLocation^.Flags;
  1234. CurFileVersionInfo.MS := CurFileLocation^.FileVersionMS;
  1235. CurFileVersionInfo.LS := CurFileLocation^.FileVersionLS;
  1236. end
  1237. else
  1238. CurFileVersionInfoValid := GetVersionNumbersRedir(DisableFsRedir,
  1239. PathExpand(AExternalSourceFile), CurFileVersionInfo);
  1240. if CurFileVersionInfoValid then
  1241. LogFmt('Version of our file: %u.%u.%u.%u',
  1242. [LongRec(CurFileVersionInfo.MS).Hi, LongRec(CurFileVersionInfo.MS).Lo,
  1243. LongRec(CurFileVersionInfo.LS).Hi, LongRec(CurFileVersionInfo.LS).Lo])
  1244. else
  1245. Log('Version of our file: (none)');
  1246. { Does the existing file have version info? }
  1247. if GetVersionNumbersRedir(DisableFsRedir, PathExpand(DestFile), ExistingVersionInfo) then begin
  1248. { If the file being installed has no version info, or the existing
  1249. file is a newer version... }
  1250. LogFmt('Version of existing file: %u.%u.%u.%u',
  1251. [LongRec(ExistingVersionInfo.MS).Hi, LongRec(ExistingVersionInfo.MS).Lo,
  1252. LongRec(ExistingVersionInfo.LS).Hi, LongRec(ExistingVersionInfo.LS).Lo]);
  1253. if not CurFileVersionInfoValid or
  1254. ((ExistingVersionInfo.MS > CurFileVersionInfo.MS) or
  1255. ((ExistingVersionInfo.MS = CurFileVersionInfo.MS) and
  1256. (ExistingVersionInfo.LS > CurFileVersionInfo.LS))) then begin
  1257. { No version info, or existing file is newer, ask user what to do unless we shouldn't }
  1258. if (foPromptIfOlder in CurFile^.Options) and not IsProtectedFile then begin
  1259. if PromptIfOlderOverwriteAll <> oaOverwrite then begin
  1260. Overwrite := AskOverwrite(DestFile, SetupMessages[msgExistingFileNewerSelectAction],
  1261. SetupMessages[msgExistingFileNewer2],
  1262. [SetupMessages[msgExistingFileNewerKeepExisting], SetupMessages[msgExistingFileNewerOverwriteExisting]],
  1263. SetupMessages[msgExistingFileNewerOverwriteOrKeepAll],
  1264. mbError, IDYES, IDNO, PromptIfOlderOverwriteAll);
  1265. if not Overwrite then begin
  1266. Log('User opted not to overwrite the existing file. Skipping.');
  1267. goto Skip;
  1268. end;
  1269. end;
  1270. end else begin
  1271. Log('Existing file is a newer version. Skipping.');
  1272. goto Skip;
  1273. end;
  1274. end
  1275. else begin
  1276. { If the existing file and the file being installed are the same
  1277. version... }
  1278. if (ExistingVersionInfo.MS = CurFileVersionInfo.MS) and
  1279. (ExistingVersionInfo.LS = CurFileVersionInfo.LS) and
  1280. not(foOverwriteSameVersion in CurFile^.Options) then begin
  1281. if foReplaceSameVersionIfContentsDiffer in CurFile^.Options then begin
  1282. { Get the two files' SHA-256 hashes and compare them }
  1283. var ExistingFileHash: TSHA256Digest;
  1284. if TryToGetSHA256OfFile(DisableFsRedir, DestFile, ExistingFileHash) then begin
  1285. var CurFileHash: TSHA256Digest;
  1286. if Assigned(CurFileLocation) then
  1287. CurFileHash := CurFileLocation^.SHA256Sum
  1288. else begin
  1289. LastOperation := SetupMessages[msgErrorReadingSource];
  1290. { This GetSHA256OfFile call could raise an exception, but
  1291. it's very unlikely since we were already able to
  1292. successfully read the file's version info. }
  1293. CurFileHash := GetSHA256OfFile(DisableFsRedir, AExternalSourceFile);
  1294. LastOperation := SetupMessages[msgErrorReadingExistingDest];
  1295. end;
  1296. { If the two files' SHA-256 hashes are equal, skip the file }
  1297. if SHA256DigestsEqual(ExistingFileHash, CurFileHash) then begin
  1298. Log('Existing file''s SHA-256 hash matches our file. Skipping.');
  1299. goto Skip;
  1300. end;
  1301. Log('Existing file''s SHA-256 hash is different from our file. Proceeding.');
  1302. end
  1303. else
  1304. Log('Failed to read existing file''s SHA-256 hash. Proceeding.');
  1305. end
  1306. else begin
  1307. { Skip the file or fall back to time stamp comparison }
  1308. if not(foCompareTimeStamp in CurFile^.Options) then begin
  1309. Log('Same version. Skipping.');
  1310. goto Skip;
  1311. end;
  1312. AllowTimeStampComparison := True;
  1313. end;
  1314. end;
  1315. end;
  1316. end
  1317. else begin
  1318. Log('Version of existing file: (none)');
  1319. { If neither the existing file nor our file have version info,
  1320. allow time stamp comparison }
  1321. if not CurFileVersionInfoValid then
  1322. AllowTimeStampComparison := True;
  1323. end;
  1324. end
  1325. else begin
  1326. { When foIgnoreVersion is in Options, always allow time stamp
  1327. comparison }
  1328. AllowTimeStampComparison := True;
  1329. end;
  1330. { Fall back to comparing time stamps if needed }
  1331. if AllowTimeStampComparison and
  1332. (foCompareTimeStamp in CurFile^.Options) then begin
  1333. if foDownload in CurFile^.Options then
  1334. InternalError('Unexpected Download flag');
  1335. if not CurFileDateValid or not ExistingFileDateValid then begin
  1336. { If we failed to read one of the time stamps, do the safe thing
  1337. and just skip the file }
  1338. Log('Couldn''t read time stamp. Skipping.');
  1339. goto Skip;
  1340. end;
  1341. if CompareFileTime(ExistingFileDate, CurFileDate) = 0 then begin
  1342. { Same time stamp }
  1343. Log('Same time stamp. Skipping.');
  1344. goto Skip;
  1345. end;
  1346. if CompareFileTime(ExistingFileDate, CurFileDate) > 0 then begin
  1347. { Existing file has a later time stamp, ask user what to do unless we shouldn't }
  1348. if (foPromptIfOlder in CurFile^.Options) and not IsProtectedFile then begin
  1349. if PromptIfOlderOverwriteAll <> oaOverwrite then begin
  1350. Overwrite := AskOverwrite(DestFile, SetupMessages[msgExistingFileNewerSelectAction],
  1351. SetupMessages[msgExistingFileNewer2],
  1352. [SetupMessages[msgExistingFileNewerKeepExisting], SetupMessages[msgExistingFileNewerOverwriteExisting]],
  1353. SetupMessages[msgExistingFileNewerOverwriteOrKeepAll],
  1354. mbError, IDYES, IDNO, PromptIfOlderOverwriteAll);
  1355. if not Overwrite then begin
  1356. Log('User opted not to overwrite the existing file. Skipping.');
  1357. goto Skip;
  1358. end;
  1359. end;
  1360. end else begin
  1361. Log('Existing file has a later time stamp. Skipping.');
  1362. goto Skip;
  1363. end;
  1364. end;
  1365. end;
  1366. LastOperation := '';
  1367. { Don't attempt to replace an existing protected system file.
  1368. (Do this *after* the version numbers of the new & existing files
  1369. have been logged.) }
  1370. if IsProtectedFile then begin
  1371. Log('Existing file is protected by Windows File Protection. Skipping.');
  1372. goto Skip;
  1373. end;
  1374. { If file already exists and foConfirmOverwrite is in Options, ask the user what to do }
  1375. if foConfirmOverwrite in CurFile^.Options then begin
  1376. if ConfirmOverwriteOverwriteAll <> oaOverwrite then begin
  1377. Overwrite := AskOverwrite(DestFile, SetupMessages[msgFileExistsSelectAction],
  1378. SetupMessages[msgFileExists2],
  1379. [SetupMessages[msgFileExistsOverwriteExisting], SetupMessages[msgFileExistsKeepExisting]],
  1380. SetupMessages[msgFileExistsOverwriteOrKeepAll],
  1381. mbConfirmation, IDNO, IDYES, ConfirmOverwriteOverwriteAll);
  1382. if not Overwrite then begin
  1383. Log('User opted not to overwrite the existing file. Skipping.');
  1384. goto Skip;
  1385. end;
  1386. end;
  1387. end;
  1388. { Check if existing file is read-only }
  1389. while True do begin
  1390. var ExistingFileAttr := GetFileAttributesRedir(DisableFsRedir, DestFile);
  1391. if (ExistingFileAttr <> INVALID_FILE_ATTRIBUTES) and
  1392. (ExistingFileAttr and FILE_ATTRIBUTE_READONLY <> 0) then begin
  1393. if not(foOverwriteReadOnly in CurFile^.Options) and
  1394. AbortRetryIgnoreTaskDialogMsgBox(
  1395. DestFile + SNewLine2 + SetupMessages[msgExistingFileReadOnly2],
  1396. [SetupMessages[msgExistingFileReadOnlyRetry], SetupMessages[msgExistingFileReadOnlyKeepExisting], SetupMessages[msgAbortRetryIgnoreCancel]]) then begin
  1397. Log('User opted not to strip the existing file''s read-only attribute. Skipping.');
  1398. goto Skip;
  1399. end;
  1400. LastOperation := SetupMessages[msgErrorChangingAttr];
  1401. if SetFileAttributesRedir(DisableFsRedir, DestFile,
  1402. ExistingFileAttr and not FILE_ATTRIBUTE_READONLY) then
  1403. Log('Stripped read-only attribute.')
  1404. else
  1405. Log('Failed to strip read-only attribute.');
  1406. if foOverwriteReadOnly in CurFile^.Options then
  1407. Break; { don't retry }
  1408. end
  1409. else
  1410. Break;
  1411. end;
  1412. end
  1413. else begin
  1414. if (foOnlyIfDestFileExists in CurFile^.Options) and not DestFileExistedBefore then begin
  1415. Log('Skipping due to "onlyifdestfileexists" flag.');
  1416. goto Skip;
  1417. end;
  1418. end;
  1419. Log('Installing the file.');
  1420. { Locate source file }
  1421. SourceFile := AExternalSourceFile; { Empty string if not external }
  1422. if DisableFsRedir = InstallDefaultDisableFsRedir then begin
  1423. { If the file is compressed in the setup package, has the same file
  1424. already been copied somewhere else? If so, just make a duplicate of
  1425. that file instead of extracting it over again. }
  1426. if (SourceFile = '') and (FileLocationFilenames <> nil) and
  1427. (FileLocationFilenames[CurFile^.LocationEntry] <> '') and
  1428. NewFileExistsRedir(DisableFsRedir, FileLocationFilenames[CurFile^.LocationEntry]) then
  1429. SourceFile := FileLocationFilenames[CurFile^.LocationEntry];
  1430. AllowFileToBeDuplicated := (SourceFile = '');
  1431. end
  1432. else begin
  1433. { This file uses a non-default FS redirection setting. Files in
  1434. FileLocationFilenames are assumed to have been installed with the
  1435. default FS redirection setting, so we can't use a file in
  1436. FileLocationFilenames as the source, or put this file there. }
  1437. AllowFileToBeDuplicated := False;
  1438. end;
  1439. { Download or extract or copy the file to a temporary file. Create the destination
  1440. file's directory if it didn't already exist. }
  1441. LastOperation := SetupMessages[msgErrorCreatingTemp];
  1442. TempFile := GenerateUniqueName(DisableFsRedir, PathExtractPath(DestFile), '.tmp');
  1443. Flags := [];
  1444. if foUninsNeverUninstall in CurFile^.Options then Include(Flags, mdNoUninstall);
  1445. if foDeleteAfterInstall in CurFile^.Options then Include(Flags, mdDeleteAfterInstall);
  1446. MakeDir(DisableFsRedir, PathExtractDir(TempFile), Flags);
  1447. DestF := TFileRedir.Create(DisableFsRedir, TempFile, fdCreateAlways, faReadWrite, fsNone);
  1448. try
  1449. TempFileLeftOver := True;
  1450. try
  1451. ProgressUpdated := True;
  1452. LastOperation := SetupMessages[msgErrorReadingSource];
  1453. if SourceFile = '' then begin
  1454. { Decompress a file }
  1455. FileExtractor.SeekTo(CurFileLocation^, InternalProgressProc);
  1456. LastOperation := SetupMessages[msgErrorCopying];
  1457. FileExtractor.DecompressFile(CurFileLocation^, DestF, InternalProgressProc,
  1458. not (foDontVerifyChecksum in CurFile^.Options));
  1459. end
  1460. else if foExtractArchive in CurFile^.Options then begin
  1461. { Extract a file from archive. Note: ISSigVerify for archive has
  1462. already been handled by RecurseExternalArchiveCopyFiles. }
  1463. LastOperation := SetupMessages[msgErrorExtracting];
  1464. var MaxProgress := CurProgress;
  1465. Inc6464(MaxProgress, AExternalSize);
  1466. ArchiveFindExtract(StrToInt(SourceFile), DestF, ExternalProgressProc64, MaxProgress);
  1467. end
  1468. else if foDownload in CurFile^.Options then begin
  1469. { Download a file with or without ISSigVerify. Note: estimate of
  1470. extra .issig size has already been added to CurFile's ExternalSize. }
  1471. LastOperation := SetupMessages[msgErrorDownloading];
  1472. const DownloadUserName = ExpandConst(CurFile^.DownloadUserName);
  1473. const DownloadPassword = ExpandConst(CurFile^.DownloadPassword);
  1474. var MaxProgress := CurProgress;
  1475. Inc6464(MaxProgress, AExternalSize);
  1476. if CurFile^.Verification.Typ = fvISSig then begin
  1477. const ISSigTempFile = TempFile + ISSigExt;
  1478. const ISSigDestF = TFileRedir.Create(DisableFsRedir, ISSigTempFile, fdCreateAlways, faReadWrite, fsNone);
  1479. try
  1480. { Download the .issig file }
  1481. const ISSigUrl = GetISSigUrl(SourceFile, ExpandConst(CurFile^.DownloadISSigSource));
  1482. DownloadFile(ISSigUrl, DownloadUserName, DownloadPassword,
  1483. ISSigDestF, NoVerification, '', JustProcessEventsProc64, To64(0));
  1484. FreeAndNil(ISSigDestF);
  1485. { Download and verify the actual file }
  1486. DownloadFile(SourceFile, DownloadUserName, DownloadPassword,
  1487. DestF, CurFile^.Verification, TempFile, ExternalProgressProc64, MaxProgress);
  1488. finally
  1489. ISSigDestF.Free;
  1490. { Delete the .issig file }
  1491. DeleteFileRedir(DisableFsRedir, ISSigTempFile);
  1492. end;
  1493. end else
  1494. DownloadFile(SourceFile, DownloadUserName, DownloadPassword,
  1495. DestF, CurFile^.Verification, '', ExternalProgressProc64, MaxProgress);
  1496. end
  1497. else begin
  1498. { Copy a duplicated non-external file, or an external file }
  1499. SourceF := TFileRedir.Create(DisableFsRedir, SourceFile, fdOpenExisting, faRead, fsRead);
  1500. try
  1501. LastOperation := SetupMessages[msgErrorCopying];
  1502. if Assigned(CurFileLocation) then
  1503. CopySourceFileToDestFile(SourceF, DestF, NoVerification,
  1504. '', CurFileLocation^.OriginalSize)
  1505. else
  1506. CopySourceFileToDestFile(SourceF, DestF, CurFile^.Verification,
  1507. SourceFile, AExternalSize);
  1508. finally
  1509. SourceF.Free;
  1510. end;
  1511. end;
  1512. except
  1513. { If an exception occurred, put progress meter back to where it was }
  1514. ProgressUpdated := False;
  1515. SetProgress(PreviousProgress);
  1516. raise;
  1517. end;
  1518. { Set time/date stamp }
  1519. if CurFileDateValid then
  1520. SetFileTime(DestF.Handle, nil, nil, @CurFileDate);
  1521. { If it's the uninstall program, bind the messages }
  1522. if CurFile^.FileType = ftUninstExe then begin
  1523. AllowFileToBeDuplicated := False;
  1524. MarkExeHeader(DestF, SetupExeModeUninstaller);
  1525. if not(shSignedUninstaller in SetupHeader.Options) and
  1526. not DetachedUninstMsgFile then
  1527. BindUninstallMsgDataToExe(DestF);
  1528. end;
  1529. finally
  1530. DestF.Free;
  1531. end;
  1532. { If it's a font, unregister the existing one to ensure that Windows
  1533. 'notices' the file is being replaced, and to increase the chances
  1534. of the file being unlocked/closed before we replace it. }
  1535. if CurFile^.InstallFontName <> '' then begin
  1536. LastOperation := '';
  1537. FontFilename := ShortenOrExpandFontFilename(DestFile);
  1538. if DestFileExistedBefore then
  1539. RemoveFontResource(PChar(FontFilename));
  1540. end;
  1541. { Delete existing version of file, if any. If it can't be deleted
  1542. because it's in use and the "restartreplace" flag was specified
  1543. on the entry, register it to be replaced when the system is
  1544. restarted. Do retry deletion before doing this. }
  1545. if DestFileExists and (CurFile^.FileType <> ftUninstExe) then begin
  1546. LastOperation := SetupMessages[msgErrorReplacingExistingFile];
  1547. RetriesLeft := 4;
  1548. while not DeleteFileRedir(DisableFsRedir, DestFile) do begin
  1549. { Couldn't delete the existing file... }
  1550. LastError := GetLastError;
  1551. { If the file inexplicably vanished, it's not a problem }
  1552. if LastError = ERROR_FILE_NOT_FOUND then
  1553. Break;
  1554. { Does the error code indicate that it is possibly in use? }
  1555. if LastErrorIndicatesPossiblyInUse(LastError, False) then begin
  1556. DoHandleFailedDeleteOrMoveFileTry('DeleteFile', TempFile, DestFile,
  1557. LastError, RetriesLeft, LastOperation, NeedsRestart, ReplaceOnRestart,
  1558. DoBreak, DoContinue);
  1559. if DoBreak then
  1560. Break
  1561. else if DoContinue then
  1562. Continue;
  1563. end;
  1564. { Some other error occurred, or we ran out of tries }
  1565. SetLastError(LastError);
  1566. Win32ErrorMsg('DeleteFile');
  1567. end;
  1568. end;
  1569. { Rename the temporary file to the new name now, unless the file is
  1570. to be replaced when the system is restarted, or if the file is the
  1571. uninstall program and an existing uninstall program already exists.
  1572. If it can't be renamed and the "restartreplace" flag was specified
  1573. on the entry, register it to be replaced when the system is
  1574. restarted. Do retry renaming before doing this. }
  1575. if not (ReplaceOnRestart or
  1576. ((CurFile^.FileType = ftUninstExe) and DestFileExistedBefore)) then begin
  1577. LastOperation := SetupMessages[msgErrorRenamingTemp];
  1578. { Since the DeleteFile above succeeded you would expect the rename to
  1579. also always succeed, but if it doesn't retry anyway. }
  1580. RetriesLeft := 4;
  1581. while not MoveFileRedir(DisableFsRedir, TempFile, DestFile) do begin
  1582. { Couldn't rename the temporary file... }
  1583. LastError := GetLastError;
  1584. { Does the error code indicate that it is possibly in use? }
  1585. if LastErrorIndicatesPossiblyInUse(LastError, True) then begin
  1586. DoHandleFailedDeleteOrMoveFileTry('MoveFile', TempFile, DestFile,
  1587. LastError, RetriesLeft, LastOperation, NeedsRestart, ReplaceOnRestart,
  1588. DoBreak, DoContinue);
  1589. if DoBreak then
  1590. Break
  1591. else if DoContinue then
  1592. Continue;
  1593. end;
  1594. { Some other error occurred, or we ran out of tries }
  1595. SetLastError(LastError);
  1596. Win32ErrorMsg('MoveFile'); { Throws an exception }
  1597. end;
  1598. { If ReplaceOnRestart is still False the rename succeeded so handle this.
  1599. Then set any file attributes. }
  1600. if not ReplaceOnRestart then begin
  1601. TempFileLeftOver := False;
  1602. TempFile := '';
  1603. LastOperation := '';
  1604. Log('Successfully installed the file.');
  1605. if AllowFileToBeDuplicated then
  1606. SetFileLocationFilename(CurFile^.LocationEntry, DestFile);
  1607. if foDeleteAfterInstall in CurFile^.Options then
  1608. DeleteFilesAfterInstallList.AddObject(DestFile, Pointer(Ord(DisableFsRedir)));
  1609. { Set file attributes *after* renaming the file since Novell
  1610. reportedly can't rename read-only files. }
  1611. AddAttributesToFile(DisableFsRedir, DestFile, CurFile^.Attribs);
  1612. end;
  1613. end;
  1614. { Leave the temporary file in place for now if the file is to be
  1615. replaced when the system is restarted, or if the file is the uninstall
  1616. program and an existing uninstall program already exists. }
  1617. if ReplaceOnRestart or
  1618. ((CurFile^.FileType = ftUninstExe) and DestFileExistedBefore) then begin
  1619. if CurFile^.FileType = ftUninstExe then
  1620. UninstallTempExeFilename := TempFile;
  1621. TempFileLeftOver := False;
  1622. LastOperation := '';
  1623. Log('Leaving temporary file in place for now.');
  1624. if AllowFileToBeDuplicated then
  1625. SetFileLocationFilename(CurFile^.LocationEntry, TempFile);
  1626. AddAttributesToFile(DisableFsRedir, TempFile, CurFile^.Attribs);
  1627. end;
  1628. { If it's a font, register it }
  1629. if CurFile^.InstallFontName <> '' then begin
  1630. LastOperation := '';
  1631. LogFmt('Registering file as a font ("%s")', [CurFile^.InstallFontName]);
  1632. PerUserFont := not IsAdminInstallMode;
  1633. InstallFont(FontFilename, CurFile^.InstallFontName, PerUserFont, not ReplaceOnRestart, WarnedPerUserFonts);
  1634. DeleteFlags := DeleteFlags or utDeleteFile_IsFont;
  1635. if PerUserFont then
  1636. DeleteFlags := DeleteFlags or utDeleteFile_PerUserFont;
  1637. end;
  1638. { There were no errors so add the uninstall log entry, unless the file
  1639. is the uninstall program, or if it has the foSharedFile flag; shared
  1640. files are handled below. }
  1641. LastOperation := '';
  1642. if CurFile^.FileType <> ftUninstExe then begin
  1643. if not(foUninsNeverUninstall in CurFile^.Options) and
  1644. not(foSharedFile in CurFile^.Options) then begin
  1645. UninstLog.Add(utDeleteFile, [DestFile, TempFile,
  1646. CurFile^.InstallFontName, FontFilename,
  1647. CurFile^.StrongAssemblyName], DeleteFlags);
  1648. end;
  1649. end
  1650. else begin
  1651. if UninstallTempExeFilename = '' then
  1652. UninstallExeCreated := ueNew
  1653. else
  1654. UninstallExeCreated := ueReplaced;
  1655. end;
  1656. Skip:
  1657. { If foRegisterServer or foRegisterTypeLib is in Options, add the
  1658. file to RegisterFilesList for registering later.
  1659. Don't attempt to register if the file doesn't exist (which can
  1660. happen if the foOnlyIfDestFileExists flag is used). }
  1661. if ((foRegisterServer in CurFile^.Options) or
  1662. (foRegisterTypeLib in CurFile^.Options)) and
  1663. NewFileExistsRedir(DisableFsRedir, DestFile) then begin
  1664. LastOperation := '';
  1665. if foRegisterTypeLib in CurFile^.Options then
  1666. Log('Will register the file (a type library) later.')
  1667. else
  1668. Log('Will register the file (a DLL/OCX) later.');
  1669. New(RegisterRec);
  1670. RegisterRec^.Filename := DestFile;
  1671. RegisterRec^.Is64Bit := DisableFsRedir;
  1672. RegisterRec^.TypeLib := foRegisterTypeLib in CurFile^.Options;
  1673. RegisterRec^.NoErrorMessages := foNoRegError in CurFile^.Options;
  1674. RegisterFilesList.Add(RegisterRec);
  1675. end;
  1676. { If foSharedFile is in Options, increment the reference count in the
  1677. registry for the file, then add the uninstall log entry (which,
  1678. unlike non-shared files, must be done on skipped files as well;
  1679. that's why there are two places where utDeleteFile entries are
  1680. added). }
  1681. if foSharedFile in CurFile^.Options then begin
  1682. LastOperation := '';
  1683. if DisableFsRedir then begin
  1684. Log('Incrementing shared file count (64-bit).');
  1685. IncrementSharedCount(rv64Bit, DestFile, DestFileExistedBefore);
  1686. end
  1687. else begin
  1688. Log('Incrementing shared file count (32-bit).');
  1689. IncrementSharedCount(rv32Bit, DestFile, DestFileExistedBefore);
  1690. end;
  1691. if not(foUninsNeverUninstall in CurFile^.Options) then begin
  1692. DeleteFlags := DeleteFlags or utDeleteFile_SharedFile;
  1693. if DisableFsRedir then
  1694. DeleteFlags := DeleteFlags or utDeleteFile_SharedFileIn64BitKey;
  1695. if foUninsNoSharedFilePrompt in CurFile^.Options then
  1696. DeleteFlags := DeleteFlags or utDeleteFile_NoSharedFilePrompt;
  1697. UninstLog.Add(utDeleteFile, [DestFile, TempFile,
  1698. CurFile^.InstallFontName, FontFilename,
  1699. CurFile^.StrongAssemblyName], DeleteFlags);
  1700. end
  1701. else begin
  1702. if DisableFsRedir then
  1703. UninstLog.Add(utDecrementSharedCount, [DestFile],
  1704. utDecrementSharedCount_64BitKey)
  1705. else
  1706. UninstLog.Add(utDecrementSharedCount, [DestFile], 0);
  1707. end;
  1708. end;
  1709. { Apply permissions (even if the file wasn't replaced) }
  1710. LastOperation := '';
  1711. if TempFile <> '' then
  1712. ApplyPermissions(DisableFsRedir, TempFile, CurFile^.PermissionsEntry)
  1713. else
  1714. ApplyPermissions(DisableFsRedir, DestFile, CurFile^.PermissionsEntry);
  1715. { Set NTFS compression (even if the file wasn't replaced) }
  1716. if (foSetNTFSCompression in CurFile^.Options) or (foUnsetNTFSCompression in CurFile^.Options) then begin
  1717. LastOperation := '';
  1718. if TempFile <> '' then
  1719. ApplyNTFSCompression(DisableFsRedir, TempFile, foSetNTFSCompression in CurFile^.Options)
  1720. else
  1721. ApplyNTFSCompression(DisableFsRedir, DestFile, foSetNTFSCompression in CurFile^.Options);
  1722. end;
  1723. { Install into GAC (even if the file wasn't replaced) }
  1724. if foGacInstall in CurFile^.Options then begin
  1725. Log('Installing into GAC');
  1726. with TAssemblyCacheInfo.Create(rvDefault) do try
  1727. if TempFile <> '' then
  1728. InstallAssembly(TempFile)
  1729. else
  1730. InstallAssembly(DestFile);
  1731. finally
  1732. Free;
  1733. end;
  1734. end;
  1735. except
  1736. if ExceptObject is EAbort then
  1737. raise;
  1738. Failed := GetExceptMessage;
  1739. end;
  1740. finally
  1741. { If an exception occurred before TempFile was cleaned up, delete it now }
  1742. if TempFileLeftOver then
  1743. DeleteFileRedir(DisableFsRedir, TempFile);
  1744. end;
  1745. { Was there an exception? Display error message and offer to retry }
  1746. if Failed <> '' then begin
  1747. if (CurFile^.FileType = ftUninstExe) and (UninstallTempExeFilename <> '') then begin
  1748. DeleteFile(UninstallTempExeFilename);
  1749. UninstallTempExeFilename := '';
  1750. UninstallExeCreated := ueNone;
  1751. end;
  1752. if LastOperation <> '' then
  1753. LastOperation := LastOperation + SNewLine;
  1754. if not AbortRetryIgnoreTaskDialogMsgBox(
  1755. DestFile + SNewLine2 + LastOperation + Failed,
  1756. [SetupMessages[msgAbortRetryIgnoreRetry], SetupMessages[msgFileAbortRetryIgnoreSkipNotRecommended], SetupMessages[msgAbortRetryIgnoreCancel]]) then begin
  1757. if ProgressUpdated then
  1758. SetProgress(PreviousProgress);
  1759. goto Retry;
  1760. end;
  1761. end;
  1762. { Increment progress meter, if not already done so }
  1763. if not ProgressUpdated then begin
  1764. if Assigned(CurFileLocation) then { not an "external" file }
  1765. IncProgress64(CurFileLocation^.OriginalSize)
  1766. else
  1767. IncProgress64(AExternalSize);
  1768. end;
  1769. { Process any events between copying files }
  1770. ProcessEvents;
  1771. { Clear previous filename label in case an exception or debugger break
  1772. occurs between now and when the label for the next entry is set }
  1773. SetFilenameLabelText('', False);
  1774. end;
  1775. procedure CopyFiles(const Uninstallable: Boolean);
  1776. { Copies all the application's files }
  1777. function RecurseExternalCopyFiles(const DisableFsRedir: Boolean;
  1778. const SearchBaseDir, SearchSubDir, SearchWildcard: String; const SourceIsWildcard: Boolean;
  1779. const Excludes: TStrings; const CurFile: PSetupFileEntry; var ExpectedBytesLeft: Integer64;
  1780. var ConfirmOverwriteOverwriteAll, PromptIfOlderOverwriteAll: TOverwriteAll;
  1781. var WarnedPerUserFonts: Boolean): Boolean;
  1782. begin
  1783. { Also see RecurseExternalFiles and RecurseExternalGetSizeOfFiles in Setup.MainFunc
  1784. Also see RecurseExternalArchiveCopyFiles directly below }
  1785. Result := False;
  1786. var FindData: TWin32FindData;
  1787. var H := FindFirstFileRedir(DisableFsRedir, SearchBaseDir + SearchSubDir + SearchWildcard, FindData);
  1788. if H <> INVALID_HANDLE_VALUE then begin
  1789. try
  1790. repeat
  1791. if FindData.dwFileAttributes and FILE_ATTRIBUTE_DIRECTORY = 0 then begin
  1792. var FileName: String;
  1793. if SourceIsWildcard then begin
  1794. if FindData.dwFileAttributes and FILE_ATTRIBUTE_HIDDEN <> 0 then
  1795. Continue;
  1796. FileName := FindData.cFileName;
  1797. end
  1798. else
  1799. FileName := SearchWildcard; { use the case specified in the script }
  1800. if IsExcluded(SearchSubDir + FileName, Excludes) then
  1801. Continue;
  1802. Result := True;
  1803. var SourceFile := SearchBaseDir + SearchSubDir + FileName;
  1804. { Note: CurFile^.DestName only includes a a filename if foCustomDestName is set,
  1805. see TSetupCompiler.EnumFilesProc.ProcessFileList }
  1806. var DestFile := ExpandConst(CurFile^.DestName);
  1807. if not(foCustomDestName in CurFile^.Options) then
  1808. DestFile := DestFile + SearchSubDir + FileName
  1809. else if SearchSubDir <> '' then
  1810. DestFile := PathExtractPath(DestFile) + SearchSubDir + PathExtractName(DestFile);
  1811. var Size: Integer64;
  1812. Size.Hi := FindData.nFileSizeHigh;
  1813. Size.Lo := FindData.nFileSizeLow;
  1814. if Compare64(Size, ExpectedBytesLeft) > 0 then begin
  1815. { Don't allow the progress bar to overflow if the size of the
  1816. files is greater than when we last checked }
  1817. Size := ExpectedBytesLeft;
  1818. end;
  1819. ProcessFileEntry(CurFile, DisableFsRedir, SourceFile, DestFile, nil,
  1820. Size, ConfirmOverwriteOverwriteAll, PromptIfOlderOverwriteAll,
  1821. WarnedPerUserFonts, nil);
  1822. Dec6464(ExpectedBytesLeft, Size);
  1823. end;
  1824. until not FindNextFile(H, FindData);
  1825. finally
  1826. Windows.FindClose(H);
  1827. end;
  1828. end;
  1829. if foRecurseSubDirsExternal in CurFile^.Options then begin
  1830. H := FindFirstFileRedir(DisableFsRedir, SearchBaseDir + SearchSubDir + '*', FindData);
  1831. if H <> INVALID_HANDLE_VALUE then begin
  1832. try
  1833. repeat
  1834. if IsRecurseableDirectory(FindData) then
  1835. Result := RecurseExternalCopyFiles(DisableFsRedir, SearchBaseDir,
  1836. SearchSubDir + FindData.cFileName + '\', SearchWildcard,
  1837. SourceIsWildcard, Excludes, CurFile, ExpectedBytesLeft,
  1838. ConfirmOverwriteOverwriteAll, PromptIfOlderOverwriteAll,
  1839. WarnedPerUserFonts) or Result;
  1840. until not FindNextFile(H, FindData);
  1841. finally
  1842. Windows.FindClose(H);
  1843. end;
  1844. end;
  1845. end;
  1846. if SearchSubDir <> '' then begin
  1847. { If Result is False this subdir won't be created, so create it now if
  1848. CreateAllSubDirs was set }
  1849. if not Result and (foCreateAllSubDirs in CurFile.Options) then begin
  1850. var DestName := ExpandConst(CurFile^.DestName); { See above }
  1851. if not(foCustomDestName in CurFile^.Options) then
  1852. DestName := DestName + SearchSubDir
  1853. else
  1854. DestName := PathExtractPath(DestName) + SearchSubDir;
  1855. var Flags: TMakeDirFlags := [];
  1856. if foUninsNeverUninstall in CurFile^.Options then Include(Flags, mdNoUninstall);
  1857. if foDeleteAfterInstall in CurFile^.Options then Include(Flags, mdDeleteAfterInstall);
  1858. MakeDir(DisableFsRedir, DestName, Flags);
  1859. Result := True;
  1860. end;
  1861. end;
  1862. { When recursively searching but not picking up every file, we could
  1863. be frozen for a long time when installing from a network. Calling
  1864. ProcessEvents after every directory helps. }
  1865. ProcessEvents;
  1866. end;
  1867. function RecurseExternalArchiveCopyFiles(const DisableFsRedir: Boolean;
  1868. const ArchiveFilename: String; const Excludes: TStrings;
  1869. const CurFile: PSetupFileEntry; var ExpectedBytesLeft: Integer64;
  1870. var ConfirmOverwriteOverwriteAll, PromptIfOlderOverwriteAll: TOverwriteAll;
  1871. var WarnedPerUserFonts: Boolean): Boolean;
  1872. begin
  1873. { See above }
  1874. { If the archive doesn't exist then the caller should handle this with
  1875. a msgSourceDoesntExist message. All other errors we handle ourselves
  1876. with a msgErrorExtracting message, without informing the caller, unless
  1877. you count EAbort. }
  1878. Result := NewFileExistsRedir(DisableFsRedir, ArchiveFilename);
  1879. if not Result then
  1880. Exit;
  1881. if foCustomDestName in CurFile^.Options then
  1882. InternalError('Unexpected custom DestName');
  1883. const DestDir = ExpandConst(CurFile^.DestName);
  1884. Log('-- Archive entry --');
  1885. var VerifySourceF: TFile := nil;
  1886. try
  1887. var FindData: TWin32FindData;
  1888. var H: TArchiveFindHandle := INVALID_HANDLE_VALUE;
  1889. var Failed: String;
  1890. repeat
  1891. try
  1892. if CurFile^.Verification.Typ <> fvNone then begin
  1893. if VerifySourceF = nil then
  1894. VerifySourceF := TFileRedir.Create(DisableFsRedir, ArchiveFilename, fdOpenExisting, faRead, fsRead);
  1895. var ExpectedFileHash: TSHA256Digest;
  1896. if CurFile^.Verification.Typ = fvHash then
  1897. ExpectedFileHash := CurFile^.Verification.Hash
  1898. else begin
  1899. DoISSigVerify(VerifySourceF, nil, ArchiveFilename, True, CurFile^.Verification.ISSigAllowedKeys,
  1900. ExpectedFileHash);
  1901. end;
  1902. { Can't get the SHA-256 while extracting so need to get and check it now }
  1903. const ActualFileHash = GetSHA256OfFile(VerifySourceF);
  1904. if not SHA256DigestsEqual(ActualFileHash, ExpectedFileHash) then
  1905. VerificationError(veFileHashIncorrect);
  1906. Log(VerificationSuccessfulLogMessage);
  1907. { Keep VerifySourceF open until extraction has completed to prevent TOCTOU problem }
  1908. end;
  1909. H := ArchiveFindFirstFileRedir(DisableFsRedir, ArchiveFilename, DestDir,
  1910. ExpandConst(CurFile^.ExtractArchivePassword), foRecurseSubDirsExternal in CurFile^.Options,
  1911. True, FindData);
  1912. Failed := '';
  1913. except
  1914. if ExceptObject is EAbort then
  1915. raise;
  1916. Failed := GetExceptMessage;
  1917. end;
  1918. until (Failed = '') or
  1919. AbortRetryIgnoreTaskDialogMsgBox(
  1920. ArchiveFilename + SNewLine2 + SetupMessages[msgErrorExtracting] + SNewLine + Failed,
  1921. [SetupMessages[msgAbortRetryIgnoreRetry], SetupMessages[msgFileAbortRetryIgnoreSkipNotRecommended], SetupMessages[msgAbortRetryIgnoreCancel]]);
  1922. if H <> INVALID_HANDLE_VALUE then begin
  1923. try
  1924. repeat
  1925. if FindData.dwFileAttributes and FILE_ATTRIBUTE_DIRECTORY = 0 then begin
  1926. if IsExcluded(FindData.cFileName, Excludes) then
  1927. Continue;
  1928. var SourceFile := IntToStr(H);
  1929. const DestFile = DestDir + FindData.cFileName;
  1930. var Size: Integer64;
  1931. Size.Hi := FindData.nFileSizeHigh;
  1932. Size.Lo := FindData.nFileSizeLow;
  1933. if Compare64(Size, ExpectedBytesLeft) > 0 then begin
  1934. { Don't allow the progress bar to overflow if the size of the
  1935. files is greater than when we last checked }
  1936. Size := ExpectedBytesLeft;
  1937. end;
  1938. ProcessFileEntry(CurFile, DisableFsRedir, SourceFile, DestFile,
  1939. nil, Size, ConfirmOverwriteOverwriteAll, PromptIfOlderOverwriteAll,
  1940. WarnedPerUserFonts, @FindData.ftLastWriteTime);
  1941. Dec6464(ExpectedBytesLeft, Size);
  1942. end else if foCreateAllSubDirs in CurFile.Options then begin
  1943. var Flags: TMakeDirFlags := [];
  1944. if foUninsNeverUninstall in CurFile^.Options then Include(Flags, mdNoUninstall);
  1945. if foDeleteAfterInstall in CurFile^.Options then Include(Flags, mdDeleteAfterInstall);
  1946. MakeDir(DisableFsRedir, DestDir + FindData.cFileName, Flags);
  1947. Result := True;
  1948. end;
  1949. until not ArchiveFindNextFile(H, FindData);
  1950. finally
  1951. ArchiveFindClose(H);
  1952. end;
  1953. Log('Successfully extracted the archive.');
  1954. end else
  1955. Log('Found no files to extract.');
  1956. finally
  1957. VerifySourceF.Free;
  1958. end;
  1959. end;
  1960. var
  1961. I: Integer;
  1962. CurFileNumber: Integer;
  1963. CurFile: PSetupFileEntry;
  1964. SourceWildcard: String;
  1965. ProgressBefore, ExpectedBytesLeft: Integer64;
  1966. DisableFsRedir, FoundFiles: Boolean;
  1967. ConfirmOverwriteOverwriteAll, PromptIfOlderOverwriteAll: TOverwriteAll;
  1968. WarnedPerUserFonts: Boolean;
  1969. begin
  1970. ConfirmOverwriteOverwriteAll := oaUnknown;
  1971. PromptIfOlderOverwriteAll := oaUnknown;
  1972. WarnedPerUserFonts := False;
  1973. var FileLocationFilenames: TStringList := nil;
  1974. var Excludes: TStringList := nil;
  1975. try
  1976. FileLocationFilenames := TStringList.Create;
  1977. for I := 0 to Entries[seFileLocation].Count-1 do
  1978. FileLocationFilenames.Add('');
  1979. Excludes := TStringList.Create;
  1980. Excludes.StrictDelimiter := True;
  1981. Excludes.Delimiter := ',';
  1982. for CurFileNumber := 0 to Entries[seFile].Count-1 do begin
  1983. CurFile := PSetupFileEntry(Entries[seFile][CurFileNumber]);
  1984. if ((CurFile^.FileType <> ftUninstExe) or Uninstallable) and
  1985. ShouldProcessFileEntry(WizardComponents, WizardTasks, CurFile, False) then begin
  1986. DebugNotifyEntry(seFile, CurFileNumber);
  1987. NotifyBeforeInstallFileEntry(CurFile);
  1988. DisableFsRedir := InstallDefaultDisableFsRedir;
  1989. if fo32Bit in CurFile^.Options then
  1990. DisableFsRedir := False;
  1991. if fo64Bit in CurFile^.Options then begin
  1992. if not IsWin64 then
  1993. InternalError('Cannot install files to 64-bit locations on this version of Windows');
  1994. DisableFsRedir := True;
  1995. end;
  1996. if CurFile^.LocationEntry <> -1 then begin
  1997. ProcessFileEntry(CurFile, DisableFsRedir, '', '', FileLocationFilenames, To64(0),
  1998. ConfirmOverwriteOverwriteAll, PromptIfOlderOverwriteAll, WarnedPerUserFonts, nil);
  1999. end
  2000. else begin
  2001. { File is an 'external' file }
  2002. if CurFile^.FileType = ftUninstExe then begin
  2003. { This is the file entry for the uninstaller program }
  2004. SourceWildcard := NewParamStr(0);
  2005. DisableFsRedir := False;
  2006. end
  2007. else
  2008. SourceWildcard := ExpandConst(CurFile^.SourceFilename);
  2009. Excludes.DelimitedText := CurFile^.Excludes;
  2010. ProgressBefore := CurProgress;
  2011. repeat
  2012. SetProgress(ProgressBefore);
  2013. ExpectedBytesLeft := CurFile^.ExternalSize;
  2014. if foDownload in CurFile^.Options then begin
  2015. { Archive download should have been done already by Setup.WizardForm's DownloadArchivesToExtract }
  2016. if foExtractArchive in CurFile^.Options then
  2017. InternalError('Unexpected Download flag');
  2018. if foSkipIfSourceDoesntExist in CurFile^.Options then
  2019. InternalError('Unexpected SkipIfSourceDoesntExist flag');
  2020. if not(foCustomDestName in CurFile^.Options) then
  2021. InternalError('Expected CustomDestName flag');
  2022. { CurFile^.DestName now includes a filename, see TSetupCompiler.EnumFilesProc.ProcessFileList }
  2023. ProcessFileEntry(CurFile, DisableFsRedir, SourceWildcard, ExpandConst(CurFile^.DestName),
  2024. nil, ExpectedBytesLeft, ConfirmOverwriteOverwriteAll, PromptIfOlderOverwriteAll,
  2025. WarnedPerUserFonts, nil);
  2026. FoundFiles := True;
  2027. end else if foExtractArchive in CurFile^.Options then
  2028. FoundFiles := RecurseExternalArchiveCopyFiles(DisableFsRedir,
  2029. SourceWildcard, Excludes, CurFile,
  2030. ExpectedBytesLeft, ConfirmOverwriteOverwriteAll, PromptIfOlderOverwriteAll,
  2031. WarnedPerUserFonts)
  2032. else
  2033. FoundFiles := RecurseExternalCopyFiles(DisableFsRedir,
  2034. PathExtractPath(SourceWildcard), '', PathExtractName(SourceWildcard),
  2035. IsWildcard(SourceWildcard), Excludes, CurFile,
  2036. ExpectedBytesLeft, ConfirmOverwriteOverwriteAll, PromptIfOlderOverwriteAll,
  2037. WarnedPerUserFonts);
  2038. until FoundFiles or
  2039. (foSkipIfSourceDoesntExist in CurFile^.Options) or
  2040. AbortRetryIgnoreTaskDialogMsgBox(
  2041. SetupMessages[msgErrorReadingSource] + SNewLine + AddPeriod(FmtSetupMessage(msgSourceDoesntExist, [SourceWildcard])),
  2042. [SetupMessages[msgAbortRetryIgnoreRetry], SetupMessages[msgFileAbortRetryIgnoreSkipNotRecommended], SetupMessages[msgAbortRetryIgnoreCancel]]);
  2043. { In case we didn't end up copying all the expected bytes, bump
  2044. the progress bar up to the expected amount }
  2045. Inc6464(ProgressBefore, CurFile^.ExternalSize);
  2046. SetProgress(ProgressBefore);
  2047. end;
  2048. NotifyAfterInstallFileEntry(CurFile);
  2049. end;
  2050. end;
  2051. finally
  2052. Excludes.Free;
  2053. FileLocationFilenames.Free;
  2054. end;
  2055. end;
  2056. procedure CreateIcons;
  2057. function IsPathURL(const S: String): Boolean;
  2058. { Returns True if S begins with a scheme name and colon. Should be
  2059. compliant with RFC 2396 section 3.1. }
  2060. const
  2061. SchemeAlphaChars = ['A'..'Z', 'a'..'z'];
  2062. SchemeAllChars = SchemeAlphaChars + ['0'..'9', '+', '-', '.'];
  2063. var
  2064. P, I: Integer;
  2065. begin
  2066. Result := False;
  2067. P := PathPos(':', S);
  2068. if (P > 2) and CharInSet(S[1], SchemeAlphaChars) then begin
  2069. for I := 2 to P-1 do
  2070. if not CharInSet(S[I], SchemeAllChars) then
  2071. Exit;
  2072. Result := True;
  2073. end;
  2074. end;
  2075. procedure CreateURLFile(const Filename, URL, IconFilename: String;
  2076. const IconIndex: Integer);
  2077. var
  2078. S: String;
  2079. F: TTextFileWriter;
  2080. begin
  2081. S := '[InternetShortcut]' + SNewLine + 'URL=' + URL + SNewLine;
  2082. if IconFilename <> '' then
  2083. S := S + 'IconFile=' + IconFilename + SNewLine +
  2084. 'IconIndex=' + IntToStr(IconIndex) + SNewLine;
  2085. F := TTextFileWriter.Create(Filename, fdCreateAlways, faWrite, fsNone);
  2086. try
  2087. if SameText(S, String(AnsiString(S))) then
  2088. F.WriteAnsi(AnsiString(S))
  2089. else
  2090. F.Write(S);
  2091. finally
  2092. F.Free;
  2093. end;
  2094. end;
  2095. procedure DeleteFolderShortcut(const Dir: String);
  2096. var
  2097. Attr: DWORD;
  2098. DesktopIniFilename, S: String;
  2099. begin
  2100. Attr := GetFileAttributes(PChar(Dir));
  2101. if (Attr <> INVALID_FILE_ATTRIBUTES) and (Attr and FILE_ATTRIBUTE_DIRECTORY <> 0) then begin
  2102. { To be sure this is really a folder shortcut and not a regular folder,
  2103. look for a desktop.ini file specifying CLSID_FolderShortcut }
  2104. DesktopIniFilename := PathCombine(Dir, 'desktop.ini');
  2105. S := GetIniString('.ShellClassInfo', 'CLSID2', '', DesktopIniFilename);
  2106. if CompareText(S, '{0AFACED1-E828-11D1-9187-B532F1E9575D}') = 0 then begin
  2107. DeleteFile(DesktopIniFilename);
  2108. DeleteFile(PathCombine(Dir, 'target.lnk'));
  2109. SetFileAttributes(PChar(Dir), Attr and not FILE_ATTRIBUTE_READONLY);
  2110. RemoveDirectory(PChar(Dir));
  2111. end;
  2112. end;
  2113. end;
  2114. procedure CreateAnIcon(Name: String; const Description, Path, Parameters,
  2115. WorkingDir, IconFilename: String; const IconIndex, ShowCmd: Integer;
  2116. const NeverUninstall: Boolean; const CloseOnExit: TSetupIconCloseOnExit;
  2117. const HotKey: Word; const AppUserModelID: String;
  2118. const AppUserModelToastActivatorCLSID: PGUID;
  2119. const ExcludeFromShowInNewInstall, PreventPinning: Boolean);
  2120. var
  2121. BeginsWithGroup: Boolean;
  2122. LinkFilename, PifFilename, UrlFilename, DirFilename, ProbableFilename,
  2123. ResultingFilename: String;
  2124. Flags: TMakeDirFlags;
  2125. URLShortcut: Boolean;
  2126. begin
  2127. BeginsWithGroup := Copy(Name, 1, 8) = '{group}\';
  2128. { Note: PathExpand removes trailing spaces, so it can't be called on
  2129. Name before the extensions are appended }
  2130. Name := ExpandConst(Name);
  2131. LinkFilename := PathExpand(Name + '.lnk');
  2132. PifFilename := PathExpand(Name + '.pif');
  2133. UrlFilename := PathExpand(Name + '.url');
  2134. DirFilename := PathExpand(Name);
  2135. Flags := [mdNotifyChange];
  2136. if NeverUninstall then
  2137. Include(Flags, mdNoUninstall)
  2138. else if BeginsWithGroup then
  2139. Include(Flags, mdAlwaysUninstall);
  2140. URLShortcut := IsPathURL(Path);
  2141. if URLShortcut then
  2142. ProbableFilename := UrlFilename
  2143. else
  2144. ProbableFilename := LinkFilename;
  2145. LogFmt('Dest filename: %s', [ProbableFilename]);
  2146. SetFilenameLabelText(ProbableFilename, True);
  2147. MakeDir(False, PathExtractDir(ProbableFilename), Flags);
  2148. { Delete any old files first }
  2149. DeleteFile(LinkFilename);
  2150. DeleteFile(PifFilename);
  2151. if NewFileExists(UrlFilename) then begin
  2152. { Flush out any pending writes by other apps before deleting }
  2153. WritePrivateProfileString(nil, nil, nil, PChar(UrlFilename));
  2154. end;
  2155. DeleteFile(UrlFilename);
  2156. DeleteFolderShortcut(DirFilename);
  2157. Log('Creating the icon.');
  2158. if not URLShortcut then begin
  2159. { Create the shortcut.
  2160. Note: Don't call PathExpand on any of the paths since they may contain
  2161. environment-variable strings (e.g. %SystemRoot%\...) }
  2162. ResultingFilename := CreateShellLink(LinkFilename, Description, Path,
  2163. Parameters, WorkingDir, IconFilename, IconIndex, ShowCmd, HotKey,
  2164. AppUserModelID, AppUserModelToastActivatorCLSID,
  2165. ExcludeFromShowInNewInstall, PreventPinning);
  2166. { If a .pif file was created, apply the "Close on exit" setting }
  2167. if (CloseOnExit <> icNoSetting) and
  2168. SameText(PathExtractExt(ResultingFilename), '.pif') then begin
  2169. try
  2170. ModifyPifFile(ResultingFilename, CloseOnExit = icYes);
  2171. except
  2172. { Failure isn't important here. Ignore exceptions }
  2173. end;
  2174. end;
  2175. end
  2176. else begin
  2177. { Create an Internet Shortcut (.url) file }
  2178. CreateURLFile(UrlFilename, Path, IconFilename, IconIndex);
  2179. ResultingFilename := UrlFilename;
  2180. end;
  2181. Log('Successfully created the icon.');
  2182. { Set the global flag that is checked by the Finished wizard page }
  2183. CreatedIcon := True;
  2184. { Notify shell of the change }
  2185. SHChangeNotify(SHCNE_CREATE, SHCNF_PATH, PChar(ResultingFilename), nil);
  2186. SHChangeNotify(SHCNE_UPDATEDIR, SHCNF_PATH or SHCNF_FLUSH,
  2187. PChar(PathExtractDir(ResultingFilename)), nil);
  2188. { Add uninstall log entries }
  2189. if not NeverUninstall then begin
  2190. if URLShortcut then
  2191. UninstLog.Add(utDeleteFile, [ResultingFilename], utDeleteFile_CallChangeNotify)
  2192. else begin
  2193. { Even though we only created one file, go ahead and try deleting
  2194. both a .lnk and .pif file at uninstall time, in case the user
  2195. alters the shortcut after installation }
  2196. UninstLog.Add(utDeleteFile, [LinkFilename], utDeleteFile_CallChangeNotify);
  2197. UninstLog.Add(utDeleteFile, [PifFilename], utDeleteFile_CallChangeNotify);
  2198. end;
  2199. end;
  2200. end;
  2201. function ExpandAppPath(const Filename: String): String;
  2202. var
  2203. K: HKEY;
  2204. Found: Boolean;
  2205. begin
  2206. if RegOpenKeyExView(InstallDefaultRegView, HKEY_LOCAL_MACHINE,
  2207. PChar(REGSTR_PATH_APPPATHS + '\' + Filename), 0, KEY_QUERY_VALUE, K) = ERROR_SUCCESS then begin
  2208. Found := RegQueryStringValue(K, '', Result);
  2209. RegCloseKey(K);
  2210. if Found then
  2211. Exit;
  2212. end;
  2213. Result := Filename;
  2214. end;
  2215. var
  2216. CurIconNumber: Integer;
  2217. CurIcon: PSetupIconEntry;
  2218. FN: String;
  2219. TACLSID: PGUID;
  2220. begin
  2221. for CurIconNumber := 0 to Entries[seIcon].Count-1 do begin
  2222. try
  2223. CurIcon := PSetupIconEntry(Entries[seIcon][CurIconNumber]);
  2224. with CurIcon^ do begin
  2225. if ShouldProcessIconEntry(WizardComponents, WizardTasks, WizardNoIcons, CurIcon) then begin
  2226. DebugNotifyEntry(seIcon, CurIconNumber);
  2227. NotifyBeforeInstallEntry(BeforeInstall);
  2228. Log('-- Icon entry --');
  2229. FN := ExpandConst(Filename);
  2230. if ioUseAppPaths in Options then
  2231. FN := ExpandAppPath(FN);
  2232. if not(ioCreateOnlyIfFileExists in Options) or NewFileExistsRedir(IsWin64, FN) then begin
  2233. if ioHasAppUserModelToastActivatorCLSID in Options then
  2234. TACLSID := @AppUserModelToastActivatorCLSID
  2235. else
  2236. TACLSID := nil;
  2237. CreateAnIcon(IconName, ExpandConst(Comment), FN,
  2238. ExpandConst(Parameters), ExpandConst(WorkingDir),
  2239. ExpandConst(IconFilename), IconIndex, ShowCmd,
  2240. ioUninsNeverUninstall in Options, CloseOnExit, HotKey,
  2241. ExpandConst(AppUserModelID), TACLSID,
  2242. ioExcludeFromShowInNewInstall in Options,
  2243. ioPreventPinning in Options)
  2244. end else
  2245. Log('Skipping due to "createonlyiffileexists" flag.');
  2246. { Increment progress meter }
  2247. IncProgress(1000);
  2248. NotifyAfterInstallEntry(AfterInstall);
  2249. end;
  2250. end;
  2251. except
  2252. if not(ExceptObject is EAbort) then
  2253. Application.HandleException(nil)
  2254. else
  2255. raise;
  2256. end;
  2257. ProcessEvents;
  2258. { Clear previous filename label in case an exception or debugger break
  2259. occurs between now and when the label for the next entry is set }
  2260. SetFilenameLabelText('', False);
  2261. end;
  2262. end;
  2263. procedure CreateIniEntries;
  2264. var
  2265. CurIniNumber: Integer;
  2266. CurIni: PSetupIniEntry;
  2267. IniSection, IniEntry, IniValue, IniFilename, IniDir: String;
  2268. Skip: Boolean;
  2269. begin
  2270. for CurIniNumber := 0 to Entries[seIni].Count-1 do begin
  2271. CurIni := PSetupIniEntry(Entries[seIni][CurIniNumber]);
  2272. with CurIni^ do begin
  2273. if ShouldProcessEntry(WizardComponents, WizardTasks, Components, Tasks, Languages, Check) then begin
  2274. DebugNotifyEntry(seIni, CurIniNumber);
  2275. NotifyBeforeInstallEntry(BeforeInstall);
  2276. Log('-- INI entry --');
  2277. IniSection := ExpandConst(Section);
  2278. IniEntry := ExpandConst(Entry);
  2279. IniValue := ExpandConst(Value);
  2280. IniFilename := ExpandConst(Filename);
  2281. LogFmt('Dest filename: %s', [IniFilename]);
  2282. LogFmt('Section: %s', [IniSection]);
  2283. if IniEntry <> '' then
  2284. LogFmt('Entry: %s', [IniEntry]);
  2285. if ioHasValue in Options then
  2286. LogFmt('Value: %s', [IniValue]);
  2287. if (IniEntry <> '') and (ioHasValue in Options) and
  2288. (not(ioCreateKeyIfDoesntExist in Options) or
  2289. not IniKeyExists(IniSection, IniEntry, IniFilename)) then begin
  2290. Skip := False;
  2291. IniDir := PathExtractDir(IniFilename);
  2292. if IniDir <> '' then begin
  2293. while True do begin
  2294. try
  2295. MakeDir(False, IniDir, []);
  2296. Break;
  2297. except
  2298. if AbortRetryIgnoreTaskDialogMsgBox(
  2299. GetExceptMessage,
  2300. [SetupMessages[msgAbortRetryIgnoreRetry], SetupMessages[msgAbortRetryIgnoreIgnore], SetupMessages[msgAbortRetryIgnoreCancel]]) then begin
  2301. Skip := True;
  2302. Break;
  2303. end;
  2304. end;
  2305. end;
  2306. end;
  2307. if not Skip then
  2308. Log('Updating the .INI file.');
  2309. repeat
  2310. if SetIniString(IniSection, IniEntry, IniValue, IniFilename) then begin
  2311. Log('Successfully updated the .INI file.');
  2312. Break;
  2313. end;
  2314. until AbortRetryIgnoreTaskDialogMsgBox(
  2315. FmtSetupMessage1(msgErrorIniEntry, IniFilename),
  2316. [SetupMessages[msgAbortRetryIgnoreRetry], SetupMessages[msgAbortRetryIgnoreIgnore], SetupMessages[msgAbortRetryIgnoreCancel]]);
  2317. end else
  2318. Log('Skipping updating the .INI file, only updating uninstall log.');
  2319. if ioUninsDeleteEntireSection in Options then
  2320. UninstLog.Add(utIniDeleteSection, [IniFilename, IniSection], 0);
  2321. if ioUninsDeleteSectionIfEmpty in Options then
  2322. UninstLog.Add(utIniDeleteSection, [IniFilename, IniSection],
  2323. utIniDeleteSection_OnlyIfEmpty);
  2324. if (ioUninsDeleteEntry in Options) and (IniEntry <> '') then
  2325. UninstLog.Add(utIniDeleteEntry, [IniFilename, IniSection, IniEntry], 0);
  2326. { ^ add utIniDeleteEntry last since we want it done first by the
  2327. uninstaller (in case the entry's also got the
  2328. "uninsdeletesectionifempty" flag) }
  2329. NotifyAfterInstallEntry(AfterInstall);
  2330. end;
  2331. end;
  2332. end;
  2333. { Increment progress meter }
  2334. IncProgress(1000);
  2335. end;
  2336. procedure CreateRegistryEntries;
  2337. function IsDeletableSubkey(const S: String): Boolean;
  2338. { A sanity check to prevent people from shooting themselves in the foot by
  2339. using
  2340. Root: HKLM; Subkey: ""; Flags: [unins]deletekey
  2341. or a 'code' constant in Subkey that returns a blank string or only
  2342. backslashes. }
  2343. var
  2344. P: PChar;
  2345. begin
  2346. Result := False;
  2347. P := PChar(S);
  2348. while P^ <> #0 do begin
  2349. if P^ <> '\' then begin
  2350. Result := True;
  2351. Break;
  2352. end;
  2353. Inc(P);
  2354. end;
  2355. end;
  2356. procedure ApplyPermissions(const RegView: TRegView; const RootKey: HKEY;
  2357. const Subkey: String; const PermsEntry: Integer);
  2358. var
  2359. P: PSetupPermissionEntry;
  2360. begin
  2361. LogFmt('Setting permissions on key: %s\%s',
  2362. [GetRegRootKeyName(RootKey), Subkey]);
  2363. P := Entries[sePermission][PermsEntry];
  2364. if not GrantPermissionOnKey(RegView, RootKey, Subkey,
  2365. TGrantPermissionEntry(Pointer(P.Permissions)^),
  2366. Length(P.Permissions) div SizeOf(TGrantPermissionEntry)) then begin
  2367. if GetLastError = ERROR_FILE_NOT_FOUND then
  2368. Log('Could not set permissions on the key because it currently does not exist.')
  2369. else
  2370. LogFmt('Failed to set permissions on the key (%d).', [GetLastError]);
  2371. end;
  2372. end;
  2373. const
  2374. REG_QWORD = 11;
  2375. var
  2376. RK, K: HKEY;
  2377. Disp: DWORD;
  2378. N, V, ExistingData: String;
  2379. ExistingType, NewType, DV: DWORD;
  2380. S: String;
  2381. RV: TRegView;
  2382. CurRegNumber: Integer;
  2383. NeedToRetry, DidDeleteKey: Boolean;
  2384. ErrorCode: Longint;
  2385. I: Integer;
  2386. AnsiS: AnsiString;
  2387. begin
  2388. for CurRegNumber := 0 to Entries[seRegistry].Count-1 do begin
  2389. with PSetupRegistryEntry(Entries[seRegistry][CurRegNumber])^ do begin
  2390. if ShouldProcessEntry(WizardComponents, WizardTasks, Components, Tasks, Languages, Check) then begin
  2391. DebugNotifyEntry(seRegistry, CurRegNumber);
  2392. NotifyBeforeInstallEntry(BeforeInstall);
  2393. Log('-- Registry entry --');
  2394. RK := RootKey;
  2395. if RK = HKEY_AUTO then
  2396. RK := InstallModeRootKey;
  2397. S := ExpandConst(Subkey);
  2398. LogFmt('Key: %s\%s', [GetRegRootKeyName(RK), Subkey]);
  2399. N := ExpandConst(ValueName);
  2400. if N <> '' then
  2401. LogFmt('Value name: %s', [N]);
  2402. RV := InstallDefaultRegView;
  2403. if (ro32Bit in Options) and (RV <> rv32Bit) then begin
  2404. Log('Non-default bitness: 32-bit');
  2405. RV := rv32Bit;
  2406. end;
  2407. if ro64Bit in Options then begin
  2408. if not IsWin64 then
  2409. InternalError('Cannot access 64-bit registry keys on this version of Windows');
  2410. if RV <> rv64Bit then begin
  2411. Log('Non-default bitness: 64-bit');
  2412. RV := rv64Bit;
  2413. end;
  2414. end;
  2415. repeat
  2416. NeedToRetry := False;
  2417. try
  2418. DidDeleteKey := False;
  2419. if roDeleteKey in Options then begin
  2420. if IsDeletableSubkey(S) then begin
  2421. Log('Deleting the key.');
  2422. RegDeleteKeyIncludingSubkeys(RV, RK, PChar(S));
  2423. DidDeleteKey := True;
  2424. end else
  2425. Log('Key to delete is not deletable.');
  2426. end;
  2427. if (roDeleteKey in Options) and (Typ = rtNone) then begin
  2428. { We've deleted the key, and no value is to be created.
  2429. Our work is done. }
  2430. if DidDeleteKey then
  2431. Log('Successfully deleted the key.');
  2432. end else if (roDeleteValue in Options) and (Typ = rtNone) then begin
  2433. { We're going to delete a value with no intention of creating
  2434. another, so don't create the key if it didn't exist. }
  2435. if RegOpenKeyExView(RV, RK, PChar(S), 0, KEY_SET_VALUE, K) = ERROR_SUCCESS then begin
  2436. Log('Deleting the value.');
  2437. RegDeleteValue(K, PChar(N));
  2438. RegCloseKey(K);
  2439. Log('Successfully deleted the value.');
  2440. { Our work is done. }
  2441. end else
  2442. Log('Key of value to delete does not exist.');
  2443. end
  2444. else begin
  2445. { Apply any permissions *before* calling RegCreateKeyExView or
  2446. RegOpenKeyExView, since we may (in a rather unlikely scenario)
  2447. need those permissions in order for those calls to succeed }
  2448. if PermissionsEntry <> -1 then
  2449. ApplyPermissions(RV, RK, S, PermissionsEntry);
  2450. { Create or open the key }
  2451. if not(roDontCreateKey in Options) then begin
  2452. Log('Creating or opening the key.');
  2453. ErrorCode := RegCreateKeyExView(RV, RK, PChar(S), 0, nil,
  2454. REG_OPTION_NON_VOLATILE, KEY_QUERY_VALUE or KEY_SET_VALUE,
  2455. nil, K, @Disp);
  2456. if ErrorCode = ERROR_SUCCESS then begin
  2457. { Apply permissions again if a new key was created }
  2458. if (Disp = REG_CREATED_NEW_KEY) and (PermissionsEntry <> -1) then begin
  2459. Log('New key created, need to set permissions again.');
  2460. ApplyPermissions(RV, RK, S, PermissionsEntry);
  2461. end;
  2462. end
  2463. else begin
  2464. if not(roNoError in Options) then
  2465. RegError(reRegCreateKeyEx, RK, S, ErrorCode);
  2466. end;
  2467. end
  2468. else begin
  2469. if Typ <> rtNone then begin
  2470. Log('Opening the key.');
  2471. ErrorCode := RegOpenKeyExView(RV, RK, PChar(S), 0,
  2472. KEY_QUERY_VALUE or KEY_SET_VALUE, K);
  2473. if (ErrorCode <> ERROR_SUCCESS) and (ErrorCode <> ERROR_FILE_NOT_FOUND) then
  2474. if not(roNoError in Options) then
  2475. RegError(reRegOpenKeyEx, RK, S, ErrorCode);
  2476. end
  2477. else begin
  2478. { We're not creating a value, and we're not just deleting a
  2479. value (that was checked above), so there is no reason to
  2480. even open the key }
  2481. Log('Not creating the key or a value, skipping the key and only updating uninstall log.');
  2482. ErrorCode := ERROR_FILE_NOT_FOUND;
  2483. end;
  2484. end;
  2485. { If there was no error opening the key, proceed with deleting
  2486. and/or creating the value }
  2487. if ErrorCode = ERROR_SUCCESS then
  2488. try
  2489. if roDeleteValue in Options then begin
  2490. Log('Deleting the value.');
  2491. RegDeleteValue(K, PChar(N));
  2492. end;
  2493. if (Typ <> rtNone) and
  2494. (not(roCreateValueIfDoesntExist in Options) or
  2495. not RegValueExists(K, PChar(N))) then begin
  2496. Log('Creating or setting the value.');
  2497. case Typ of
  2498. rtString, rtExpandString, rtMultiString: begin
  2499. NewType := REG_SZ;
  2500. case Typ of
  2501. rtExpandString: NewType := REG_EXPAND_SZ;
  2502. rtMultiString: NewType := REG_MULTI_SZ;
  2503. end;
  2504. if Typ <> rtMultiString then begin
  2505. if (Pos('{olddata}', ValueData) <> 0) and
  2506. RegQueryStringValue(K, PChar(N), ExistingData) then
  2507. { successful }
  2508. else
  2509. ExistingData := '';
  2510. if roPreserveStringType in Options then begin
  2511. if (RegQueryValueEx(K, PChar(N), nil, @ExistingType, nil, nil) = ERROR_SUCCESS) and
  2512. ((ExistingType = REG_SZ) or (ExistingType = REG_EXPAND_SZ)) then
  2513. NewType := ExistingType;
  2514. end;
  2515. V := ExpandConstEx(ValueData, ['olddata', ExistingData])
  2516. end
  2517. else begin
  2518. if (Pos('{olddata}', ValueData) <> 0) and
  2519. RegQueryMultiStringValue(K, PChar(N), ExistingData) then
  2520. { successful }
  2521. else
  2522. ExistingData := '';
  2523. V := ExpandConstEx(ValueData, ['olddata', ExistingData,
  2524. 'break', #0]);
  2525. { Multi-string data requires two null terminators:
  2526. one after the last string, and one to mark the end.
  2527. Delphi's String type is implicitly null-terminated,
  2528. so only one null needs to be added to the end. }
  2529. if (V <> '') and (V[Length(V)] <> #0) then
  2530. V := V + #0;
  2531. end;
  2532. ErrorCode := RegSetValueEx(K, PChar(N), 0, NewType,
  2533. PChar(V), (Length(V)+1)*SizeOf(V[1]));
  2534. if (ErrorCode <> ERROR_SUCCESS) and
  2535. not(roNoError in Options) then
  2536. RegError(reRegSetValueEx, RK, S, ErrorCode);
  2537. end;
  2538. rtDWord: begin
  2539. DV := StrToInt(ExpandConst(ValueData));
  2540. ErrorCode := RegSetValueEx(K, PChar(N), 0, REG_DWORD,
  2541. @DV, SizeOf(DV));
  2542. if (ErrorCode <> ERROR_SUCCESS) and
  2543. not(roNoError in Options) then
  2544. RegError(reRegSetValueEx, RK, S, ErrorCode);
  2545. end;
  2546. rtQWord: begin
  2547. const QV: UInt64 = StrToUInt64(ExpandConst(ValueData));
  2548. ErrorCode := RegSetValueEx(K, PChar(N), 0, REG_QWORD,
  2549. @QV, SizeOf(QV));
  2550. if (ErrorCode <> ERROR_SUCCESS) and
  2551. not(roNoError in Options) then
  2552. RegError(reRegSetValueEx, RK, S, ErrorCode);
  2553. end;
  2554. rtBinary: begin
  2555. AnsiS := '';
  2556. for I := 1 to Length(ValueData) do
  2557. AnsiS := AnsiS + AnsiChar(Ord(ValueData[I]));
  2558. ErrorCode := RegSetValueEx(K, PChar(N), 0, REG_BINARY,
  2559. PAnsiChar(AnsiS), Length(AnsiS));
  2560. if (ErrorCode <> ERROR_SUCCESS) and
  2561. not(roNoError in Options) then
  2562. RegError(reRegSetValueEx, RK, S, ErrorCode);
  2563. end;
  2564. end;
  2565. Log('Successfully created or set the value.');
  2566. end else if roDeleteValue in Options then
  2567. Log('Successfully deleted the value.')
  2568. else
  2569. Log('Successfully created the key.')
  2570. { Our work is done. }
  2571. finally
  2572. RegCloseKey(K);
  2573. end;
  2574. end;
  2575. except
  2576. if not AbortRetryIgnoreTaskDialogMsgBox(
  2577. GetExceptMessage,
  2578. [SetupMessages[msgAbortRetryIgnoreRetry], SetupMessages[msgAbortRetryIgnoreIgnore], SetupMessages[msgAbortRetryIgnoreCancel]]) then begin
  2579. Log('Retrying.');
  2580. NeedToRetry := True;
  2581. end;
  2582. end;
  2583. until not NeedToRetry;
  2584. if roUninsDeleteEntireKey in Options then
  2585. if IsDeletableSubkey(S) then
  2586. UninstLog.AddReg(utRegDeleteEntireKey, RV, RK, [S]);
  2587. if roUninsDeleteEntireKeyIfEmpty in Options then
  2588. if IsDeletableSubkey(S) then
  2589. UninstLog.AddReg(utRegDeleteKeyIfEmpty, RV, RK, [S]);
  2590. if roUninsDeleteValue in Options then
  2591. UninstLog.AddReg(utRegDeleteValue, RV, RK, [S, N]);
  2592. { ^ must add roUninsDeleteValue after roUninstDeleteEntireKey*
  2593. since the entry may have both the roUninsDeleteValue and
  2594. roUninsDeleteEntireKeyIfEmpty options }
  2595. if roUninsClearValue in Options then
  2596. UninstLog.AddReg(utRegClearValue, RV, RK, [S, N]);
  2597. NotifyAfterInstallEntry(AfterInstall);
  2598. end;
  2599. end;
  2600. end;
  2601. { Increment progress meter }
  2602. IncProgress(1000);
  2603. end;
  2604. procedure RegisterFiles;
  2605. procedure RegisterServersOnRestart;
  2606. function CreateRegSvrExe(const Dir: String): String;
  2607. var
  2608. ExeFilename: String;
  2609. SourceF, DestF: TFile;
  2610. NumRead: Cardinal;
  2611. Buf: array[0..16383] of Byte;
  2612. begin
  2613. ExeFilename := GenerateUniqueName(False, Dir, '.exe');
  2614. DestF := nil;
  2615. SourceF := TFile.Create(NewParamStr(0), fdOpenExisting, faRead, fsRead);
  2616. try
  2617. DestF := TFile.Create(ExeFilename, fdCreateAlways, faWrite, fsNone);
  2618. try
  2619. DestF.Seek64(SourceF.Size);
  2620. DestF.Truncate;
  2621. DestF.Seek(0);
  2622. while True do begin
  2623. NumRead := SourceF.Read(Buf, SizeOf(Buf));
  2624. if NumRead = 0 then
  2625. Break;
  2626. DestF.WriteBuffer(Buf, NumRead);
  2627. end;
  2628. if not(shSignedUninstaller in SetupHeader.Options) then
  2629. MarkExeHeader(DestF, SetupExeModeRegSvr);
  2630. except
  2631. FreeAndNil(DestF);
  2632. DeleteFile(ExeFilename);
  2633. raise;
  2634. end;
  2635. finally
  2636. DestF.Free;
  2637. SourceF.Free;
  2638. end;
  2639. Result := ExeFilename;
  2640. end;
  2641. procedure CreateRegSvrMsg(const Filename: String);
  2642. var
  2643. F: TFile;
  2644. begin
  2645. F := TFile.Create(Filename, fdCreateAlways, faWrite, fsNone);
  2646. try
  2647. WriteMsgData(F);
  2648. finally
  2649. F.Free;
  2650. end;
  2651. end;
  2652. const
  2653. Chars: array[Boolean, Boolean] of Char = (('s', 't'), ('S', 'T'));
  2654. var
  2655. RegSvrExeFilename: String;
  2656. F: TTextFileWriter;
  2657. Rec: PRegisterFilesListRec;
  2658. RootKey, H: HKEY;
  2659. I, J: Integer;
  2660. Disp: DWORD;
  2661. ValueName, Data: String;
  2662. ErrorCode: Longint;
  2663. begin
  2664. { Create RegSvr program used to register OLE servers & type libraries on
  2665. the next reboot }
  2666. if IsAdmin then begin
  2667. try
  2668. RegSvrExeFilename := CreateRegSvrExe(WinDir);
  2669. except
  2670. { In case Windows directory is write protected, try the Temp directory.
  2671. Windows directory is our first choice since some people (ignorantly)
  2672. put things like "DELTREE C:\WINDOWS\TEMP\*.*" in their AUTOEXEC.BAT.
  2673. Also, each user has his own personal Temp directory which may not
  2674. be accessible by other users. }
  2675. RegSvrExeFilename := CreateRegSvrExe(GetTempDir);
  2676. end;
  2677. end
  2678. else begin
  2679. { Always use Temp directory when user doesn't have admin privileges }
  2680. RegSvrExeFilename := CreateRegSvrExe(GetTempDir);
  2681. end;
  2682. LogFmt('Registration executable created: %s', [RegSvrExeFilename]);
  2683. try
  2684. CreateRegSvrMsg(PathChangeExt(RegSvrExeFilename, '.msg'));
  2685. F := TTextFileWriter.Create(PathChangeExt(RegSvrExeFilename, '.lst'),
  2686. fdCreateAlways, faWrite, fsNone);
  2687. try
  2688. F.WriteLine('; This file was created by the installer for:');
  2689. F.WriteLine('; ' + ExpandedAppVerName);
  2690. F.WriteLine('; Location: ' + SetupLdrOriginalFilename);
  2691. F.WriteLine('');
  2692. F.WriteLine('; List of files to be registered on the next reboot. DO NOT EDIT!');
  2693. F.WriteLine('');
  2694. for I := 0 to RegisterFilesList.Count-1 do begin
  2695. Rec := RegisterFilesList[I];
  2696. Data := '[..]' + Rec.Filename;
  2697. Data[2] := Chars[Rec.Is64Bit, Rec.TypeLib];
  2698. if Rec.NoErrorMessages then
  2699. Data[3] := 'q';
  2700. F.WriteLine(Data);
  2701. end;
  2702. finally
  2703. F.Free;
  2704. end;
  2705. if IsAdmin then
  2706. RootKey := HKEY_LOCAL_MACHINE
  2707. else
  2708. RootKey := HKEY_CURRENT_USER;
  2709. ErrorCode := RegCreateKeyExView(rvDefault, RootKey, REGSTR_PATH_RUNONCE, 0, nil,
  2710. REG_OPTION_NON_VOLATILE, KEY_SET_VALUE or KEY_QUERY_VALUE,
  2711. nil, H, @Disp);
  2712. if ErrorCode <> ERROR_SUCCESS then
  2713. RegError(reRegCreateKeyEx, RootKey, REGSTR_PATH_RUNONCE, ErrorCode);
  2714. try
  2715. J := 0;
  2716. while True do begin
  2717. Inc(J);
  2718. ValueName := Format('InnoSetupRegFile.%.10d', [J]); { don't localize }
  2719. { ^ Note: Names of values written to the "RunOnce" key cannot
  2720. exceed 31 characters! Otherwise the original Windows
  2721. Explorer 4.0 will not process them. }
  2722. if not RegValueExists(H, PChar(ValueName)) then begin
  2723. Data := '"' + RegSvrExeFilename + '" /REG';
  2724. if not IsAdmin then
  2725. Data := Data + 'U'; { /REG -> /REGU when not running as admin }
  2726. { Note: RegSvr expects /REG(U) to be the first parameter }
  2727. Data := Data + ' /REGSVRMODE';
  2728. ErrorCode := RegSetValueEx(H, PChar(ValueName), 0, REG_SZ, PChar(Data),
  2729. (Length(Data)+1)*SizeOf(Data[1]));
  2730. if ErrorCode <> ERROR_SUCCESS then
  2731. RegError(reRegSetValueEx, RootKey, REGSTR_PATH_RUNONCE, ErrorCode);
  2732. Break;
  2733. end;
  2734. end;
  2735. finally
  2736. RegCloseKey(H);
  2737. end;
  2738. except
  2739. DeleteFile(PathChangeExt(RegSvrExeFilename, '.lst'));
  2740. DeleteFile(PathChangeExt(RegSvrExeFilename, '.msg'));
  2741. DeleteFile(RegSvrExeFilename);
  2742. raise;
  2743. end;
  2744. end;
  2745. procedure RegisterSvr(const Is64Bit: Boolean; const Filename: String;
  2746. const NoErrorMessages: Boolean);
  2747. var
  2748. NeedToRetry: Boolean;
  2749. begin
  2750. repeat
  2751. if Is64Bit then
  2752. LogFmt('Registering 64-bit DLL/OCX: %s', [Filename])
  2753. else
  2754. LogFmt('Registering 32-bit DLL/OCX: %s', [Filename]);
  2755. NeedToRetry := False;
  2756. try
  2757. RegisterServer(False, Is64Bit, Filename, NoErrorMessages);
  2758. Log('Registration successful.');
  2759. except
  2760. Log('Registration failed:' + SNewLine + GetExceptMessage);
  2761. if not NoErrorMessages then
  2762. if not AbortRetryIgnoreTaskDialogMsgBox(
  2763. Filename + SNewLine2 + FmtSetupMessage1(msgErrorRegisterServer, GetExceptMessage),
  2764. [SetupMessages[msgAbortRetryIgnoreRetry], SetupMessages[msgFileAbortRetryIgnoreIgnoreNotRecommended], SetupMessages[msgAbortRetryIgnoreCancel]]) then
  2765. NeedToRetry := True;
  2766. end;
  2767. until not NeedToRetry;
  2768. end;
  2769. procedure RegisterTLib(const Is64Bit: Boolean; const Filename: String;
  2770. const NoErrorMessages: Boolean);
  2771. var
  2772. NeedToRetry: Boolean;
  2773. begin
  2774. repeat
  2775. if Is64Bit then
  2776. LogFmt('Registering 64-bit type library: %s', [Filename])
  2777. else
  2778. LogFmt('Registering 32-bit type library: %s', [Filename]);
  2779. NeedToRetry := False;
  2780. try
  2781. if Is64Bit then
  2782. HelperRegisterTypeLibrary(False, Filename)
  2783. else
  2784. RegisterTypeLibrary(Filename);
  2785. Log('Registration successful.');
  2786. except
  2787. Log('Registration failed:' + SNewLine + GetExceptMessage);
  2788. if not NoErrorMessages then
  2789. if not AbortRetryIgnoreTaskDialogMsgBox(
  2790. Filename + SNewLine2 + FmtSetupMessage1(msgErrorRegisterTypeLib, GetExceptMessage),
  2791. [SetupMessages[msgAbortRetryIgnoreRetry], SetupMessages[msgFileAbortRetryIgnoreIgnoreNotRecommended], SetupMessages[msgAbortRetryIgnoreCancel]]) then
  2792. NeedToRetry := True;
  2793. end;
  2794. until not NeedToRetry;
  2795. end;
  2796. var
  2797. I: Integer;
  2798. begin
  2799. if not NeedsRestart then
  2800. for I := 0 to RegisterFilesList.Count-1 do begin
  2801. with PRegisterFilesListRec(RegisterFilesList[I])^ do
  2802. if not TypeLib then
  2803. RegisterSvr(Is64Bit, Filename, NoErrorMessages)
  2804. else
  2805. RegisterTLib(Is64Bit, Filename, NoErrorMessages);
  2806. end
  2807. else begin
  2808. { When a restart is needed, all "regserver" & "regtypelib" files will get
  2809. registered on the next logon }
  2810. Log('Delaying registration of all files until the next logon since a restart is needed.');
  2811. try
  2812. RegisterServersOnRestart;
  2813. except
  2814. Application.HandleException(nil);
  2815. end;
  2816. end;
  2817. end;
  2818. procedure ProcessInstallDeleteEntries;
  2819. var
  2820. I: Integer;
  2821. begin
  2822. for I := 0 to Entries[seInstallDelete].Count-1 do
  2823. with PSetupDeleteEntry(Entries[seInstallDelete][I])^ do
  2824. if ShouldProcessEntry(WizardComponents, WizardTasks, Components, Tasks, Languages, Check) then begin
  2825. DebugNotifyEntry(seInstallDelete, I);
  2826. NotifyBeforeInstallEntry(BeforeInstall);
  2827. case DeleteType of
  2828. dfFiles, dfFilesAndOrSubdirs:
  2829. DelTree(InstallDefaultDisableFsRedir, ExpandConst(Name), False, True, DeleteType = dfFilesAndOrSubdirs, False,
  2830. nil, nil, nil);
  2831. dfDirIfEmpty:
  2832. DelTree(InstallDefaultDisableFsRedir, ExpandConst(Name), True, False, False, False, nil, nil, nil);
  2833. end;
  2834. NotifyAfterInstallEntry(AfterInstall);
  2835. end;
  2836. end;
  2837. procedure RecordUninstallDeleteEntries;
  2838. const
  2839. DefFlags: array[TSetupDeleteType] of Longint = (
  2840. utDeleteDirOrFiles_Extra or utDeleteDirOrFiles_DeleteFiles,
  2841. utDeleteDirOrFiles_Extra or utDeleteDirOrFiles_DeleteFiles or
  2842. utDeleteDirOrFiles_DeleteSubdirsAlso,
  2843. utDeleteDirOrFiles_Extra or utDeleteDirOrFiles_IsDir);
  2844. var
  2845. I: Integer;
  2846. Flags: Longint;
  2847. begin
  2848. for I := Entries[seUninstallDelete].Count-1 downto 0 do
  2849. { ^ process backwards so the uninstaller will process them in the order
  2850. they appear in the script }
  2851. with PSetupDeleteEntry(Entries[seUninstallDelete][I])^ do
  2852. if ShouldProcessEntry(WizardComponents, WizardTasks, Components, Tasks, Languages, Check) then begin
  2853. DebugNotifyEntry(seUninstallDelete, I);
  2854. NotifyBeforeInstallEntry(BeforeInstall);
  2855. Flags := DefFlags[DeleteType];
  2856. if InstallDefaultDisableFsRedir then
  2857. Flags := Flags or utDeleteDirOrFiles_DisableFsRedir;
  2858. UninstLog.Add(utDeleteDirOrFiles, [ExpandConst(Name)], Flags);
  2859. NotifyAfterInstallEntry(AfterInstall);
  2860. end;
  2861. end;
  2862. procedure RecordUninstallRunEntries;
  2863. var
  2864. I: Integer;
  2865. RunEntry: PSetupRunEntry;
  2866. Flags: Longint;
  2867. begin
  2868. for I := Entries[seUninstallRun].Count-1 downto 0 do begin
  2869. { ^ process backwards so the uninstaller will process them in the order
  2870. they appear in the script }
  2871. RunEntry := PSetupRunEntry(Entries[seUninstallRun][I]);
  2872. if ShouldProcessEntry(WizardComponents, WizardTasks, RunEntry.Components,
  2873. RunEntry.Tasks, RunEntry.Languages, RunEntry.Check) then begin
  2874. DebugNotifyEntry(seUninstallRun, I);
  2875. NotifyBeforeInstallEntry(RunEntry.BeforeInstall);
  2876. Flags := 0;
  2877. case RunEntry.Wait of
  2878. rwNoWait: Flags := Flags or utRun_NoWait;
  2879. rwWaitUntilIdle: Flags := Flags or utRun_WaitUntilIdle;
  2880. end;
  2881. if roShellExec in RunEntry.Options then
  2882. Flags := Flags or (utRun_ShellExec or utRun_ShellExecRespectWaitFlags)
  2883. else begin
  2884. if ShouldDisableFsRedirForRunEntry(RunEntry) then
  2885. Flags := Flags or utRun_DisableFsRedir;
  2886. end;
  2887. if roSkipIfDoesntExist in RunEntry.Options then
  2888. Flags := Flags or utRun_SkipIfDoesntExist;
  2889. case RunEntry.ShowCmd of
  2890. SW_SHOWMINNOACTIVE: Flags := Flags or utRun_RunMinimized;
  2891. SW_SHOWMAXIMIZED: Flags := Flags or utRun_RunMaximized;
  2892. SW_HIDE: Flags := Flags or utRun_RunHidden;
  2893. end;
  2894. if roDontLogParameters in RunEntry.Options then
  2895. Flags := Flags or utRun_DontLogParameters;
  2896. if roLogOutput in RunEntry.Options then
  2897. Flags := Flags or utRun_LogOutput;
  2898. UninstLog.Add(utRun, [ExpandConst(RunEntry.Name),
  2899. ExpandConst(RunEntry.Parameters), ExpandConst(RunEntry.WorkingDir),
  2900. ExpandConst(RunEntry.RunOnceId), ExpandConst(RunEntry.Verb)],
  2901. Flags);
  2902. NotifyAfterInstallEntry(RunEntry.AfterInstall);
  2903. end;
  2904. end;
  2905. end;
  2906. procedure GenerateUninstallInfoFilename;
  2907. var
  2908. ExistingFiles: array[0..999] of Boolean;
  2909. BaseDir: String;
  2910. procedure FindFiles;
  2911. var
  2912. H: THandle;
  2913. FindData: TWin32FindData;
  2914. S: String;
  2915. begin
  2916. H := FindFirstFile(PChar(AddBackslash(BaseDir) + 'unins???.*'),
  2917. FindData);
  2918. if H <> INVALID_HANDLE_VALUE then begin
  2919. repeat
  2920. S := FindData.cFilename;
  2921. if (Length(S) >= 9) and (CompareText(Copy(S, 1, 5), 'unins') = 0) and
  2922. CharInSet(S[6], ['0'..'9']) and CharInSet(S[7], ['0'..'9']) and CharInSet(S[8], ['0'..'9']) and
  2923. (S[9] = '.') then
  2924. ExistingFiles[StrToInt(Copy(S, 6, 3))] := True;
  2925. until not FindNextFile(H, FindData);
  2926. Windows.FindClose(H);
  2927. end;
  2928. end;
  2929. procedure GenerateFilenames(const I: Integer);
  2930. var
  2931. BaseFilename: String;
  2932. begin
  2933. BaseFilename := AddBackslash(BaseDir) + Format('unins%.3d', [I]);
  2934. UninstallExeFilename := BaseFilename + '.exe';
  2935. UninstallDataFilename := BaseFilename + '.dat';
  2936. UninstallMsgFilename := BaseFilename + '.msg';
  2937. end;
  2938. procedure ReserveDataFile;
  2939. var
  2940. H: THandle;
  2941. begin
  2942. { Create an empty .dat file to reserve the filename. }
  2943. H := CreateFile(PChar(UninstallDataFilename), GENERIC_READ or GENERIC_WRITE,
  2944. 0, nil, CREATE_NEW, FILE_ATTRIBUTE_NORMAL, 0);
  2945. if H = INVALID_HANDLE_VALUE then
  2946. Win32ErrorMsg('CreateFile');
  2947. CloseHandle(H);
  2948. UninstallDataCreated := True;
  2949. end;
  2950. var
  2951. I: Integer;
  2952. ExistingFlags: TUninstallLogFlags;
  2953. begin
  2954. { Note: We never disable FS redirection when writing to UninstallFilesDir.
  2955. If someone sets UninstallFilesDir to "sys", we can't place a 32-bit
  2956. uninstaller in the 64-bit system directory, because it wouldn't see its
  2957. .dat file -- it would try to open 'windows\system32\unins???.dat' but
  2958. fail because system32 maps to syswow64 by default.
  2959. Not to mention, 32-bit EXEs really have no business being in the 64-bit
  2960. system directory, and vice versa. Might result in undefined behavior? }
  2961. { Because we don't disable FS redirection, we have to change any system32
  2962. to syswow64, otherwise Add/Remove Programs would look for the
  2963. UninstallString executable in the 64-bit system directory (at least
  2964. when using a 64-bit Uninstall key) }
  2965. BaseDir := ReplaceSystemDirWithSysWow64(PathExpand(ExpandConst(SetupHeader.UninstallFilesDir)));
  2966. LogFmt('Directory for uninstall files: %s', [BaseDir]);
  2967. MakeDir(False, BaseDir, []);
  2968. FillChar(ExistingFiles, SizeOf(ExistingFiles), 0); { set all to False }
  2969. FindFiles;
  2970. { Look for an existing .dat file to append to or overwrite }
  2971. if SetupHeader.UninstallLogMode <> lmNew then
  2972. for I := 0 to 999 do
  2973. if ExistingFiles[I] then begin
  2974. GenerateFilenames(I);
  2975. if NewFileExists(UninstallDataFilename) and
  2976. UninstLog.CanAppend(UninstallDataFilename, ExistingFlags) then begin
  2977. if SetupHeader.UninstallLogMode = lmAppend then begin
  2978. LogFmt('Will append to existing uninstall log: %s', [UninstallDataFilename]);
  2979. AppendUninstallData := True;
  2980. end
  2981. else
  2982. LogFmt('Will overwrite existing uninstall log: %s', [UninstallDataFilename]);
  2983. Exit;
  2984. end;
  2985. end;
  2986. { None found; use a new .dat file }
  2987. for I := 0 to 999 do
  2988. if not ExistingFiles[I] then begin
  2989. GenerateFilenames(I);
  2990. LogFmt('Creating new uninstall log: %s', [UninstallDataFilename]);
  2991. ReserveDataFile;
  2992. Exit;
  2993. end;
  2994. raise Exception.Create(FmtSetupMessage1(msgErrorTooManyFilesInDir,
  2995. BaseDir));
  2996. end;
  2997. procedure RenameUninstallExe;
  2998. begin
  2999. { If the uninstall EXE wasn't extracted to a .tmp file because it isn't
  3000. replacing an existing uninstall EXE, exit. }
  3001. if UninstallTempExeFilename = '' then
  3002. Exit;
  3003. Log('Renaming uninstaller.');
  3004. var Timer: TOneShotTimer;
  3005. var RetriesLeft := 4;
  3006. while True do begin
  3007. Timer.Start(1000);
  3008. if MoveFileReplace(UninstallTempExeFilename, UninstallExeFilename) then
  3009. Break;
  3010. var LastError := GetLastError;
  3011. { Does the error code indicate that the file is possibly in use? }
  3012. if LastErrorIndicatesPossiblyInUse(LastError, False) then begin
  3013. if RetriesLeft > 0 then begin
  3014. LogFmt('The existing file appears to be in use (%d). ' +
  3015. 'Retrying.', [LastError]);
  3016. Dec(RetriesLeft);
  3017. Timer.SleepUntilExpired;
  3018. ProcessEvents;
  3019. Continue;
  3020. end;
  3021. end;
  3022. const LastOperation = SetupMessages[msgErrorReplacingExistingFile];
  3023. const Failed = AddPeriod(FmtSetupMessage(msgErrorFunctionFailedWithMessage,
  3024. ['MoveFileEx', IntToStr(LastError), Win32ErrorString(LastError)]));
  3025. const Text = UninstallExeFilename + SNewLine2 + LastOperation + SNewLine + Failed;
  3026. case LoggedTaskDialogMsgBox('', SetupMessages[msgRetryCancelSelectAction], Text, '',
  3027. mbError, MB_RETRYCANCEL, [SetupMessages[msgRetryCancelRetry], SetupMessages[msgRetryCancelCancel]],
  3028. 0, True, IDCANCEL) of
  3029. IDRETRY: ;
  3030. IDCANCEL: Abort;
  3031. else
  3032. Log('LoggedTaskDialogMsgBox returned an unexpected value. Assuming Cancel.');
  3033. Abort;
  3034. end;
  3035. end;
  3036. UninstallTempExeFilename := '';
  3037. end;
  3038. procedure CreateUninstallMsgFile;
  3039. { If the uninstaller EXE has a digital signature, or if Setup was started
  3040. with /DETACHEDMSG, create the unins???.msg file }
  3041. var
  3042. F: TFile;
  3043. begin
  3044. { If this installation didn't create or replace an unins???.exe file,
  3045. do nothing }
  3046. if (UninstallExeCreated <> ueNone) and
  3047. ((shSignedUninstaller in SetupHeader.Options) or DetachedUninstMsgFile) then begin
  3048. LogFmt('Writing uninstaller messages: %s', [UninstallMsgFilename]);
  3049. F := TFile.Create(UninstallMsgFilename, fdCreateAlways, faWrite, fsNone);
  3050. try
  3051. if UninstallExeCreated = ueNew then
  3052. UninstallMsgCreated := True;
  3053. WriteMsgData(F);
  3054. finally
  3055. F.Free;
  3056. end;
  3057. end;
  3058. end;
  3059. procedure ProcessNeedRestartEvent;
  3060. begin
  3061. if (CodeRunner <> nil) and CodeRunner.FunctionExists('NeedRestart', True) then begin
  3062. if not NeedsRestart then begin
  3063. try
  3064. if CodeRunner.RunBooleanFunctions('NeedRestart', [''], bcTrue, False, False) then begin
  3065. NeedsRestart := True;
  3066. Log('Will restart because NeedRestart returned True.');
  3067. end;
  3068. except
  3069. Log('NeedRestart raised an exception.');
  3070. Application.HandleException(nil);
  3071. end;
  3072. end
  3073. else
  3074. Log('Not calling NeedRestart because a restart has already been deemed necessary.');
  3075. end;
  3076. end;
  3077. procedure ProcessComponentEntries;
  3078. var
  3079. I: Integer;
  3080. begin
  3081. for I := 0 to Entries[seComponent].Count-1 do begin
  3082. with PSetupComponentEntry(Entries[seComponent][I])^ do begin
  3083. if ShouldProcessEntry(WizardComponents, nil, Name, '', Languages, '') and (coRestart in Options) then begin
  3084. NeedsRestart := True;
  3085. Break;
  3086. end;
  3087. end;
  3088. end;
  3089. end;
  3090. procedure ProcessTasksEntries;
  3091. var
  3092. I: Integer;
  3093. begin
  3094. for I := 0 to Entries[seTask].Count-1 do begin
  3095. with PSetupTaskEntry(Entries[seTask][I])^ do begin
  3096. if ShouldProcessEntry(nil, WizardTasks, '', Name, Languages, '') and (toRestart in Options) then begin
  3097. NeedsRestart := True;
  3098. Break;
  3099. end;
  3100. end;
  3101. end;
  3102. end;
  3103. procedure ShutdownApplications;
  3104. const
  3105. ERROR_FAIL_SHUTDOWN = 351;
  3106. ForcedStrings: array [Boolean] of String = ('', ' (forced)');
  3107. ForcedActionFlag: array [Boolean] of ULONG = (0, RmForceShutdown);
  3108. var
  3109. Forced: Boolean;
  3110. Error: DWORD;
  3111. begin
  3112. Forced := InitForceCloseApplications or
  3113. ((shForceCloseApplications in SetupHeader.Options) and not InitNoForceCloseApplications);
  3114. Log('Shutting down applications using our files.' + ForcedStrings[Forced]);
  3115. RmDoRestart := True;
  3116. Error := RmShutdown(RmSessionHandle, ForcedActionFlag[Forced], nil);
  3117. while Error = ERROR_FAIL_SHUTDOWN do begin
  3118. Log('Some applications could not be shut down.');
  3119. if AbortRetryIgnoreTaskDialogMsgBox(
  3120. SetupMessages[msgErrorCloseApplications],
  3121. [SetupMessages[msgAbortRetryIgnoreRetry], SetupMessages[msgAbortRetryIgnoreIgnore], SetupMessages[msgAbortRetryIgnoreCancel]]) then
  3122. Break;
  3123. Log('Retrying to shut down applications using our files.' + ForcedStrings[Forced]);
  3124. Error := RmShutdown(RmSessionHandle, ForcedActionFlag[Forced], nil);
  3125. end;
  3126. { Close session on all errors except for ERROR_FAIL_SHUTDOWN, should still call RmRestart in that case. }
  3127. if (Error <> ERROR_SUCCESS) and (Error <> ERROR_FAIL_SHUTDOWN) then begin
  3128. RmEndSession(RmSessionHandle);
  3129. LogFmt('RmShutdown returned an error: %d', [Error]);
  3130. RmDoRestart := False;
  3131. end;
  3132. end;
  3133. var
  3134. Uninstallable, UninstLogCleared: Boolean;
  3135. I: Integer;
  3136. UninstallRegKeyBaseName: String;
  3137. InstallFilesSize, AfterInstallFilesSize: Integer64;
  3138. begin
  3139. Succeeded := False;
  3140. Log('Starting the installation process.');
  3141. SetCurrentDir(WinSystemDir);
  3142. CalcFilesSize(InstallFilesSize, AfterInstallFilesSize);
  3143. InitProgressGauge(InstallFilesSize);
  3144. UninstallExeCreated := ueNone;
  3145. UninstallDataCreated := False;
  3146. UninstallMsgCreated := False;
  3147. AppendUninstallData := False;
  3148. UninstLogCleared := False;
  3149. RegisterFilesList := nil;
  3150. UninstLog := TSetupUninstallLog.Create;
  3151. try
  3152. try
  3153. { Get AppId, UninstallRegKeyBaseName, and Uninstallable now so the user
  3154. can't change them while we're installing }
  3155. ExpandedAppId := ExpandConst(SetupHeader.AppId);
  3156. if ExpandedAppId = '' then
  3157. InternalError('Failed to get a non empty installation "AppId"');
  3158. if TUninstallLog.WriteSafeHeaderString(nil, ExpandedAppId, 0) > 128 then
  3159. InternalError('"AppId" cannot exceed 128 bytes (encoded)');
  3160. UninstallRegKeyBaseName := GetUninstallRegKeyBaseName(ExpandedAppId);
  3161. Uninstallable := EvalDirectiveCheck(SetupHeader.Uninstallable);
  3162. { Init }
  3163. UninstLog.InstallMode64Bit := Is64BitInstallMode;
  3164. UninstLog.AppName := ExpandedAppName;
  3165. UninstLog.AppId := ExpandedAppId;
  3166. if IsAdminInstallMode then
  3167. Include(UninstLog.Flags, ufAdminInstallMode);
  3168. if IsWin64 then
  3169. Include(UninstLog.Flags, ufWin64);
  3170. if IsAdmin then { Setup or [Code] might have done administrative actions, even if IsAdminInstallMode is False }
  3171. Include(UninstLog.Flags, ufAdminInstalled)
  3172. else if IsPowerUserOrAdmin then
  3173. { Note: This flag is only set in 5.1.9 and later }
  3174. Include(UninstLog.Flags, ufPowerUserInstalled);
  3175. if SetupHeader.WizardStyle = wsModern then
  3176. Include(UninstLog.Flags, ufModernStyle);
  3177. if shUninstallRestartComputer in SetupHeader.Options then
  3178. Include(UninstLog.Flags, ufAlwaysRestart);
  3179. if ChangesEnvironment then
  3180. Include(UninstLog.Flags, ufChangesEnvironment);
  3181. RecordStartInstall;
  3182. RecordCompiledCode;
  3183. RegisterFilesList := TList.Create;
  3184. { Process Component entries, if any }
  3185. ProcessComponentEntries;
  3186. ProcessEvents;
  3187. { Process Tasks entries, if any }
  3188. ProcessTasksEntries;
  3189. ProcessEvents;
  3190. { Shutdown applications, if any }
  3191. if RmSessionStarted and RmFoundApplications then begin
  3192. if WizardPreparingYesRadio then begin
  3193. SetStatusLabelText(SetupMessages[msgStatusClosingApplications]);
  3194. ShutdownApplications;
  3195. ProcessEvents;
  3196. end else
  3197. Log('User chose not to shutdown applications using our files.');
  3198. end;
  3199. { Process InstallDelete entries, if any }
  3200. ProcessInstallDeleteEntries;
  3201. ProcessEvents;
  3202. if ExpandedAppMutex <> '' then
  3203. UninstLog.Add(utMutexCheck, [ExpandedAppMutex], 0);
  3204. if ChangesAssociations then
  3205. UninstLog.Add(utRefreshFileAssoc, [''], 0);
  3206. { Record UninstallDelete entries, if any }
  3207. RecordUninstallDeleteEntries;
  3208. ProcessEvents;
  3209. { Create the application directory and extra dirs }
  3210. SetStatusLabelText(SetupMessages[msgStatusCreateDirs]);
  3211. CreateDirs;
  3212. ProcessEvents;
  3213. if Uninstallable then begin
  3214. { Generate the filenames for the uninstall info in the application
  3215. directory }
  3216. SetStatusLabelText(SetupMessages[msgStatusSavingUninstall]);
  3217. GenerateUninstallInfoFilename;
  3218. end;
  3219. { Copy the files }
  3220. SetStatusLabelText(SetupMessages[msgStatusExtractFiles]);
  3221. CopyFiles(Uninstallable);
  3222. ProcessEvents;
  3223. { Create program icons, if any }
  3224. if HasIcons then begin
  3225. SetStatusLabelText(SetupMessages[msgStatusCreateIcons]);
  3226. CreateIcons;
  3227. ProcessEvents;
  3228. end;
  3229. { Create INI entries, if any }
  3230. if Entries[seIni].Count <> 0 then begin
  3231. SetStatusLabelText(SetupMessages[msgStatusCreateIniEntries]);
  3232. CreateIniEntries;
  3233. ProcessEvents;
  3234. end;
  3235. { Create registry entries, if any }
  3236. if Entries[seRegistry].Count <> 0 then begin
  3237. SetStatusLabelText(SetupMessages[msgStatusCreateRegistryEntries]);
  3238. CreateRegistryEntries;
  3239. ProcessEvents;
  3240. end;
  3241. { Call the NeedRestart event function now.
  3242. Note: This can't be done after RegisterFiles, since RegisterFiles
  3243. relies on the setting of the NeedsRestart variable. }
  3244. SetStatusLabelText('');
  3245. ProcessNeedRestartEvent;
  3246. ProcessEvents;
  3247. { Register files, if any }
  3248. if RegisterFilesList.Count <> 0 then begin
  3249. SetStatusLabelText(SetupMessages[msgStatusRegisterFiles]);
  3250. RegisterFiles;
  3251. ProcessEvents;
  3252. end;
  3253. { Save uninstall information. After uninstall info is saved, you cannot
  3254. make any more modifications to the user's system. Any additional
  3255. modifications you want to add must be done before this is called. }
  3256. if Uninstallable then begin
  3257. SetStatusLabelText(SetupMessages[msgStatusSavingUninstall]);
  3258. Log('Saving uninstall information.');
  3259. RenameUninstallExe;
  3260. CreateUninstallMsgFile;
  3261. { Register uninstall information so the program can be uninstalled
  3262. through the Add/Remove Programs Control Panel applet. This is done
  3263. on NT 3.51 too, so that the uninstall entry for the app will appear
  3264. if the user later upgrades to NT 4.0+. }
  3265. if EvalDirectiveCheck(SetupHeader.CreateUninstallRegKey) then
  3266. RegisterUninstallInfo(UninstallRegKeyBaseName, AfterInstallFilesSize);
  3267. RecordUninstallRunEntries;
  3268. UninstLog.Add(utEndInstall, [GetLocalTimeAsStr], 0);
  3269. UninstLog.Save(UninstallDataFilename, AppendUninstallData,
  3270. shUpdateUninstallLogAppName in SetupHeader.Options);
  3271. if Debugging then
  3272. DebugNotifyUninstExe(UninstallExeFileName);
  3273. end;
  3274. SetStatusLabelText('');
  3275. UninstLogCleared := True;
  3276. UninstLog.Clear;
  3277. except
  3278. try
  3279. { Show error message, if any, and set the exit code we'll be returning }
  3280. if not(ExceptObject is EAbort) then begin
  3281. Log(Format('Fatal exception during installation process (%s):' + SNewLine,
  3282. [ExceptObject.ClassName]) + GetExceptMessage);
  3283. SetupExitCode := ecInstallationError;
  3284. Application.HandleException(nil);
  3285. LoggedMsgBox(SetupMessages[msgSetupAborted], '', mbCriticalError, MB_OK, True, IDOK);
  3286. end
  3287. else begin
  3288. Log('User canceled the installation process.');
  3289. SetupExitCode := ecInstallationCancelled;
  3290. end;
  3291. { Undo any changes it's made so far }
  3292. if not UninstLogCleared then begin
  3293. Log('Rolling back changes.');
  3294. try
  3295. SetStatusLabelText(SetupMessages[msgStatusRollback]);
  3296. WizardForm.ProgressGauge.Visible := False;
  3297. FinishProgressGauge(True);
  3298. WizardForm.CancelButton.Enabled := False;
  3299. WizardForm.Update;
  3300. except
  3301. { ignore any exceptions, just in case... }
  3302. end;
  3303. if UninstallTempExeFilename <> '' then
  3304. DeleteFile(UninstallTempExeFilename);
  3305. if UninstallExeCreated = ueNew then
  3306. DeleteFile(UninstallExeFilename);
  3307. if UninstallDataCreated then
  3308. DeleteFile(UninstallDataFilename);
  3309. if UninstallMsgCreated then
  3310. DeleteFile(UninstallMsgFilename);
  3311. UninstLog.PerformUninstall(False, nil);
  3312. { Sleep for a bit so that the user has time to read the "Rolling
  3313. back changes" message }
  3314. if WizardForm.Visible then
  3315. Sleep(1500);
  3316. end;
  3317. except
  3318. { No exception should be generated by the above code, but just in
  3319. case, handle any exception now so that Application.Terminate is
  3320. always called below.
  3321. Note that we can't just put Application.Terminate in a finally
  3322. section, because it would prevent the display of an exception
  3323. message box later (MessageBox() dislikes WM_QUIT). }
  3324. Application.HandleException(nil);
  3325. end;
  3326. Exit;
  3327. end;
  3328. finally
  3329. if Assigned(RegisterFilesList) then begin
  3330. for I := RegisterFilesList.Count-1 downto 0 do
  3331. Dispose(PRegisterFilesListRec(RegisterFilesList[I]));
  3332. RegisterFilesList.Free;
  3333. end;
  3334. UninstLog.Free;
  3335. FinishProgressGauge(False);
  3336. end;
  3337. Log('Installation process succeeded.');
  3338. Succeeded := True;
  3339. end;
  3340. procedure InternalExtractTemporaryFile(const DestName: String;
  3341. const CurFile: PSetupFileEntry; const CurFileLocation: PSetupFileLocationEntry;
  3342. const CreateDirs: Boolean);
  3343. var
  3344. DestFile: String;
  3345. DestF: TFile;
  3346. CurFileDate: TFileTime;
  3347. begin
  3348. DestFile := AddBackslash(TempInstallDir) + DestName;
  3349. Log('Extracting temporary file: ' + DestFile);
  3350. { Does not disable FS redirection, like everything else working on the temp dir }
  3351. if CreateDirs then
  3352. ForceDirectories(False, PathExtractPath(DestFile));
  3353. DestF := TFile.Create(DestFile, fdCreateAlways, faWrite, fsNone);
  3354. try
  3355. try
  3356. FileExtractor.SeekTo(CurFileLocation^, nil);
  3357. FileExtractor.DecompressFile(CurFileLocation^, DestF, nil,
  3358. not (foDontVerifyChecksum in CurFile^.Options));
  3359. if floTimeStampInUTC in CurFileLocation^.Flags then
  3360. CurFileDate := CurFileLocation^.SourceTimeStamp
  3361. else
  3362. LocalFileTimeToFileTime(CurFileLocation^.SourceTimeStamp, CurFileDate);
  3363. SetFileTime(DestF.Handle, nil, nil, @CurFileDate);
  3364. finally
  3365. DestF.Free;
  3366. end;
  3367. except
  3368. DeleteFile(DestFile);
  3369. raise;
  3370. end;
  3371. AddAttributesToFile(False, DestFile, CurFile^.Attribs);
  3372. end;
  3373. procedure ExtractTemporaryFile(const BaseName: String);
  3374. function EscapeBraces(const S: String): String;
  3375. { Changes all '{' to '{{'. Uses ConstLeadBytes^ for the lead byte table. }
  3376. var
  3377. I: Integer;
  3378. begin
  3379. Result := S;
  3380. I := 1;
  3381. while I <= Length(Result) do begin
  3382. if Result[I] = '{' then begin
  3383. Insert('{', Result, I);
  3384. Inc(I);
  3385. end;
  3386. Inc(I);
  3387. end;
  3388. end;
  3389. var
  3390. EscapedBaseName: String;
  3391. CurFileNumber: Integer;
  3392. CurFile: PSetupFileEntry;
  3393. begin
  3394. { We compare BaseName to the filename portion of TSetupFileEntry.DestName
  3395. which has braces escaped, but BaseName does not; escape it to match }
  3396. EscapedBaseName := EscapeBraces(BaseName);
  3397. for CurFileNumber := 0 to Entries[seFile].Count-1 do begin
  3398. CurFile := PSetupFileEntry(Entries[seFile][CurFileNumber]);
  3399. if (CurFile^.LocationEntry <> -1) and (CompareText(PathExtractName(CurFile^.DestName), EscapedBaseName) = 0) then begin
  3400. InternalExtractTemporaryFile(BaseName, CurFile, Entries[seFileLocation][CurFile^.LocationEntry], False);
  3401. Exit;
  3402. end;
  3403. end;
  3404. InternalErrorFmt('ExtractTemporaryFile: The file "%s" was not found', [BaseName]);
  3405. end;
  3406. function ExtractTemporaryFiles(const Pattern: String): Integer;
  3407. var
  3408. LowerPattern, DestName: String;
  3409. CurFileNumber: Integer;
  3410. CurFile: PSetupFileEntry;
  3411. begin
  3412. if Length(Pattern) >= MAX_PATH then
  3413. InternalError('ExtractTemporaryFiles: Pattern too long');
  3414. LowerPattern := PathLowercase(Pattern);
  3415. Result := 0;
  3416. for CurFileNumber := 0 to Entries[seFile].Count-1 do begin
  3417. CurFile := PSetupFileEntry(Entries[seFile][CurFileNumber]);
  3418. if CurFile^.LocationEntry <> -1 then begin
  3419. { Use ExpandConstEx2 to unescape any braces not in an embedded constant,
  3420. while leaving constants unexpanded }
  3421. DestName := ExpandConstEx2(CurFile^.DestName, [''], False);
  3422. if WildcardMatch(PChar(PathLowercase(DestName)), PChar(LowerPattern)) then begin
  3423. Delete(DestName, 1, PathDrivePartLengthEx(DestName, True)); { Remove any drive part }
  3424. if Pos('{tmp}\', DestName) = 1 then
  3425. Delete(DestName, 1, Length('{tmp}\'));
  3426. if Pos(':', DestName) <> 0 then
  3427. InternalError('ExtractTemporaryFiles: Invalid character in matched file name');
  3428. InternalExtractTemporaryFile(DestName, CurFile, Entries[seFileLocation][CurFile^.LocationEntry], True);
  3429. Inc(Result);
  3430. end;
  3431. end;
  3432. end;
  3433. if Result = 0 then
  3434. InternalErrorFmt('ExtractTemporaryFiles: No files matching "%s" found', [Pattern]);
  3435. end;
  3436. type
  3437. THTTPDataReceiver = class
  3438. private
  3439. FBaseName, FUrl: String;
  3440. FOnDownloadProgress: TOnDownloadProgress;
  3441. FOnSimpleDownloadProgress: TOnSimpleDownloadProgress;
  3442. FOnSimpleDownloadProgressParam: Integer64;
  3443. FAborted: Boolean;
  3444. FProgress, FProgressMax: Int64;
  3445. FLastReportedProgress: Int64;
  3446. public
  3447. property BaseName: String write FBaseName;
  3448. property Url: String write FUrl;
  3449. property OnDownloadProgress: TOnDownloadProgress write FOnDownloadProgress;
  3450. property OnSimpleDownloadProgress: TOnSimpleDownloadProgress write FOnSimpleDownloadProgress;
  3451. property OnSimpleDownloadProgressParam: Integer64 write FOnSimpleDownloadProgressParam;
  3452. property Aborted: Boolean read FAborted;
  3453. property Progress: Int64 read FProgress;
  3454. property ProgressMax: Int64 read FProgressMax;
  3455. procedure OnReceiveData(const Sender: TObject; AContentLength: Int64; AReadCount: Int64; var Abort: Boolean);
  3456. end;
  3457. procedure THTTPDataReceiver.OnReceiveData(const Sender: TObject; AContentLength: Int64; AReadCount: Int64; var Abort: Boolean);
  3458. begin
  3459. FProgress := AReadCount;
  3460. FProgressMax := AContentLength;
  3461. try
  3462. if Assigned(FOnDownloadProgress) then begin
  3463. if not FOnDownloadProgress(FUrl, FBaseName, FProgress, FProgressMax) then
  3464. Abort := True;
  3465. end else if Assigned(FOnSimpleDownloadProgress) then begin
  3466. try
  3467. FOnSimpleDownloadProgress(Integer64(Progress-FLastReportedProgress), FOnSimpleDownloadProgressParam);
  3468. finally
  3469. FLastReportedProgress := Progress;
  3470. end;
  3471. end;
  3472. except
  3473. if ExceptObject is EAbort then { FOnSimpleDownloadProgress always uses Abort to abort }
  3474. Abort := True
  3475. else
  3476. raise;
  3477. end;
  3478. if not Abort and DownloadTemporaryFileOrExtractArchiveProcessMessages then
  3479. Application.ProcessMessages;
  3480. if Abort then
  3481. FAborted := True
  3482. end;
  3483. procedure SetUserAgentAndSecureProtocols(const AHTTPClient: THTTPClient);
  3484. begin
  3485. AHTTPClient.UserAgent := SetupTitle + ' ' + SetupVersion;
  3486. { TLS 1.2 isn't enabled by default on older versions of Windows }
  3487. AHTTPClient.SecureProtocols := [THTTPSecureProtocol.TLS1, THTTPSecureProtocol.TLS11, THTTPSecureProtocol.TLS12];
  3488. end;
  3489. function MaskPasswordInUrl(const Url: String): String;
  3490. var
  3491. Uri: TUri;
  3492. begin
  3493. Uri := TUri.Create(Url);
  3494. if Uri.Password <> '' then begin
  3495. Uri.Password := '***';
  3496. Result := Uri.ToString;
  3497. end else
  3498. Result := URL;
  3499. end;
  3500. var
  3501. DownloadTemporaryFileUser, DownloadTemporaryFilePass: String;
  3502. procedure SetDownloadTemporaryFileCredentials(const User, Pass: String);
  3503. begin
  3504. DownloadTemporaryFileUser := User;
  3505. DownloadTemporaryFilePass := Pass;
  3506. end;
  3507. function GetCredentialsAndCleanUrl(const Url, CustomUser, CustomPass: String; var User, Pass, CleanUrl: String) : Boolean;
  3508. begin
  3509. const Uri = TUri.Create(Url); { This is a record so no need to free }
  3510. if CustomUser = '' then
  3511. User := TNetEncoding.URL.Decode(Uri.Username)
  3512. else
  3513. User := CustomUser;
  3514. if CustomPass = '' then
  3515. Pass := TNetEncoding.URL.Decode(Uri.Password, [TURLEncoding.TDecodeOption.PlusAsSpaces])
  3516. else
  3517. Pass := CustomPass;
  3518. Uri.Username := '';
  3519. Uri.Password := '';
  3520. CleanUrl := Uri.ToString;
  3521. Result := (User <> '') or (Pass <> '');
  3522. if Result then
  3523. LogFmt('Download is using basic authentication: %s, ***', [User])
  3524. else
  3525. Log('Download is not using basic authentication');
  3526. end;
  3527. function GetISSigUrl(const Url, ISSigUrl: String): String;
  3528. begin
  3529. if ISSigUrl <> '' then
  3530. Result := ISSigUrl
  3531. else begin
  3532. const Uri = TUri.Create(Url); { This is a record so no need to free }
  3533. Uri.Path := Uri.Path + ISSigExt;
  3534. Result := Uri.ToString;
  3535. end;
  3536. end;
  3537. function DownloadFile(const Url, CustomUserName, CustomPassword: String;
  3538. const DestF: TFile; [ref] const Verification: TSetupFileVerification; const ISSigSourceFilename: String;
  3539. const OnSimpleDownloadProgress: TOnSimpleDownloadProgress;
  3540. const OnSimpleDownloadProgressParam: Integer64): Int64;
  3541. var
  3542. HandleStream: THandleStream;
  3543. HTTPDataReceiver: THTTPDataReceiver;
  3544. HTTPClient: THTTPClient;
  3545. HTTPResponse: IHTTPResponse;
  3546. User, Pass, CleanUrl: String;
  3547. HasCredentials : Boolean;
  3548. begin
  3549. if Url = '' then
  3550. InternalError('DownloadFile: Invalid Url value');
  3551. LogFmt('Downloading file from %s', [MaskPasswordInURL(Url)]);
  3552. HTTPDataReceiver := nil;
  3553. HTTPClient := nil;
  3554. HandleStream := nil;
  3555. try
  3556. HasCredentials := GetCredentialsAndCleanUrl(URL,
  3557. CustomUserName, CustomPassword, User, Pass, CleanUrl);
  3558. { Setup downloader }
  3559. HTTPDataReceiver := THTTPDataReceiver.Create;
  3560. HTTPDataReceiver.Url := CleanUrl;
  3561. HTTPDataReceiver.OnSimpleDownloadProgress := OnSimpleDownloadProgress;
  3562. HTTPDataReceiver.OnSimpleDownloadProgressParam := OnSimpleDownloadProgressParam;
  3563. HTTPClient := THTTPClient.Create; { http://docwiki.embarcadero.com/RADStudio/Rio/en/Using_an_HTTP_Client }
  3564. SetUserAgentAndSecureProtocols(HTTPClient);
  3565. HTTPClient.OnReceiveData := HTTPDataReceiver.OnReceiveData;
  3566. { Download to specified handle }
  3567. HandleStream := THandleStream.Create(DestF.Handle);
  3568. if HasCredentials then begin
  3569. const Base64 = TBase64Encoding.Create(0);
  3570. try
  3571. HTTPClient.CustomHeaders['Authorization'] := 'Basic ' + Base64.Encode(User + ':' + Pass);
  3572. finally
  3573. Base64.Free;
  3574. end;
  3575. end;
  3576. HTTPResponse := HTTPClient.Get(CleanUrl, HandleStream);
  3577. Result := 0; { silence compiler }
  3578. if HTTPDataReceiver.Aborted then
  3579. Abort
  3580. else if (HTTPResponse.StatusCode < 200) or (HTTPResponse.StatusCode > 299) then
  3581. raise Exception.Create(Format('%d %s', [HTTPResponse.StatusCode, HTTPResponse.StatusText]))
  3582. else begin
  3583. { Download completed, get size and close it }
  3584. Result := HandleStream.Size;
  3585. FreeAndNil(HandleStream);
  3586. { Check verification if specified, otherwise check everything else we can check }
  3587. if Verification.Typ <> fvNone then begin
  3588. var ExpectedFileHash: TSHA256Digest;
  3589. if Verification.Typ = fvHash then
  3590. ExpectedFileHash := Verification.Hash
  3591. else
  3592. DoISSigVerify(DestF, nil, ISSigSourceFilename, False, Verification.ISSigAllowedKeys, ExpectedFileHash);
  3593. const FileHash = GetSHA256OfFile(DestF);
  3594. if not SHA256DigestsEqual(FileHash, ExpectedFileHash) then
  3595. VerificationError(veFileHashIncorrect);
  3596. Log(VerificationSuccessfulLogMessage);
  3597. end else begin
  3598. if HTTPDataReceiver.ProgressMax > 0 then begin
  3599. if HTTPDataReceiver.Progress <> HTTPDataReceiver.ProgressMax then
  3600. raise Exception.Create(FmtSetupMessage(msgErrorProgress, [IntToStr(HTTPDataReceiver.Progress), IntToStr(HTTPDataReceiver.ProgressMax)]))
  3601. else if HTTPDataReceiver.ProgressMax <> Result then
  3602. raise Exception.Create(FmtSetupMessage(msgErrorFileSize, [IntToStr(HTTPDataReceiver.ProgressMax), IntToStr(Result)]));
  3603. end;
  3604. end;
  3605. end;
  3606. finally
  3607. HandleStream.Free;
  3608. HTTPClient.Free;
  3609. HTTPDataReceiver.Free;
  3610. end;
  3611. end;
  3612. function DownloadTemporaryFile(const Url, BaseName: String;
  3613. [ref] const Verification: TSetupFileVerification; const OnDownloadProgress: TOnDownloadProgress;
  3614. out DestFile: String): Int64;
  3615. var
  3616. TempFile: String;
  3617. TempF: TFile;
  3618. HandleStream: THandleStream;
  3619. TempFileLeftOver: Boolean;
  3620. HTTPDataReceiver: THTTPDataReceiver;
  3621. HTTPClient: THTTPClient;
  3622. HTTPResponse: IHTTPResponse;
  3623. RetriesLeft: Integer;
  3624. LastError: DWORD;
  3625. User, Pass, CleanUrl: String;
  3626. HasCredentials : Boolean;
  3627. begin
  3628. if Url = '' then
  3629. InternalError('DownloadTemporaryFile: Invalid Url value');
  3630. if BaseName = '' then
  3631. InternalError('DownloadTemporaryFile: Invalid BaseName value');
  3632. DestFile := AddBackslash(TempInstallDir) + BaseName;
  3633. LogFmt('Downloading temporary file from %s: %s', [MaskPasswordInURL(Url), DestFile]);
  3634. { Does not disable FS redirection, like everything else working on the temp dir }
  3635. { Prepare directory }
  3636. if NewFileExists(DestFile) then begin
  3637. if Verification.Typ = fvHash then begin
  3638. if SHA256DigestsEqual(GetSHA256OfFile(False, DestFile), Verification.Hash) then begin
  3639. Log(' File already downloaded.');
  3640. Result := 0;
  3641. Exit;
  3642. end;
  3643. end else if Verification.Typ = fvISSig then begin
  3644. var ExistingFileName: String;
  3645. var ExistingFileSize: Int64;
  3646. var ExistingFileHash: TSHA256Digest;
  3647. if ISSigVerifySignature(DestFile, GetISSigAllowedKeys(ISSigAvailableKeys, Verification.ISSigAllowedKeys),
  3648. ExistingFileName, ExistingFileSize, ExistingFileHash, nil, nil, nil) then begin
  3649. const DestF = TFile.Create(DestFile, fdOpenExisting, faRead, fsReadWrite);
  3650. try
  3651. { Not checking ExistingFileName because we can't be sure what the original filename was }
  3652. if (DestF.Size = ExistingFileSize) and
  3653. (SHA256DigestsEqual(GetSHA256OfFile(DestF), ExistingFileHash)) then begin
  3654. Log(' File already downloaded.');
  3655. Result := 0;
  3656. Exit;
  3657. end;
  3658. finally
  3659. DestF.Free;
  3660. end;
  3661. end;
  3662. end;
  3663. SetFileAttributes(PChar(DestFile), GetFileAttributes(PChar(DestFile)) and not FILE_ATTRIBUTE_READONLY);
  3664. DelayDeleteFile(False, DestFile, 13, 50, 250);
  3665. end else
  3666. ForceDirectories(False, PathExtractPath(DestFile));
  3667. HTTPDataReceiver := nil;
  3668. HTTPClient := nil;
  3669. TempF := nil;
  3670. TempFileLeftOver := False;
  3671. HandleStream := nil;
  3672. try
  3673. HasCredentials := GetCredentialsAndCleanUrl(URL,
  3674. DownloadTemporaryFileUser, DownloadTemporaryFilePass, User, Pass, CleanUrl);
  3675. { Setup downloader }
  3676. HTTPDataReceiver := THTTPDataReceiver.Create;
  3677. HTTPDataReceiver.BaseName := BaseName;
  3678. HTTPDataReceiver.Url := CleanUrl;
  3679. HTTPDataReceiver.OnDownloadProgress := OnDownloadProgress;
  3680. HTTPClient := THTTPClient.Create; { http://docwiki.embarcadero.com/RADStudio/Rio/en/Using_an_HTTP_Client }
  3681. SetUserAgentAndSecureProtocols(HTTPClient);
  3682. HTTPClient.OnReceiveData := HTTPDataReceiver.OnReceiveData;
  3683. { Create temporary file }
  3684. TempFile := GenerateUniqueName(False, PathExtractPath(DestFile), '.tmp');
  3685. TempF := TFile.Create(TempFile, fdCreateAlways, faWrite, fsNone);
  3686. TempFileLeftOver := True;
  3687. { To test redirects: https://jrsoftware.org/download.php/is.exe
  3688. To test expired certificates: https://expired.badssl.com/
  3689. To test self-signed certificates: https://self-signed.badssl.com/
  3690. To test basic authentication: https://guest:[email protected]/HTTP/Basic/
  3691. To test 100 MB file: https://speed.hetzner.de/100MB.bin
  3692. To test 1 GB file: https://speed.hetzner.de/1GB.bin
  3693. To test file without a content length: https://github.com/jrsoftware/issrc/archive/main.zip }
  3694. { Download to temporary file}
  3695. HandleStream := THandleStream.Create(TempF.Handle);
  3696. if HasCredentials then begin
  3697. const Base64 = TBase64Encoding.Create(0);
  3698. try
  3699. HTTPClient.CustomHeaders['Authorization'] := 'Basic ' + Base64.Encode(User + ':' + Pass);
  3700. finally
  3701. Base64.Free;
  3702. end;
  3703. end;
  3704. HTTPResponse := HTTPClient.Get(CleanUrl, HandleStream);
  3705. if HTTPDataReceiver.Aborted then
  3706. raise Exception.Create(SetupMessages[msgErrorDownloadAborted])
  3707. else if (HTTPResponse.StatusCode < 200) or (HTTPResponse.StatusCode > 299) then
  3708. raise Exception.Create(FmtSetupMessage(msgErrorDownloadFailed, [IntToStr(HTTPResponse.StatusCode), HTTPResponse.StatusText]))
  3709. else begin
  3710. { Download completed, get size and close it }
  3711. Result := HandleStream.Size;
  3712. FreeAndNil(HandleStream);
  3713. { Check verification if specified, otherwise check everything else we can check }
  3714. if Verification.Typ <> fvNone then begin
  3715. var ExpectedFileHash: TSHA256Digest;
  3716. if Verification.Typ = fvHash then
  3717. ExpectedFileHash := Verification.Hash
  3718. else
  3719. DoISSigVerify(TempF, nil, DestFile, False, Verification.ISSigAllowedKeys, ExpectedFileHash);
  3720. FreeAndNil(TempF);
  3721. const FileHash = GetSHA256OfFile(False, TempFile);
  3722. if not SHA256DigestsEqual(FileHash, ExpectedFileHash) then
  3723. VerificationError(veFileHashIncorrect);
  3724. Log(VerificationSuccessfulLogMessage);
  3725. end else begin
  3726. FreeAndNil(TempF);
  3727. if HTTPDataReceiver.ProgressMax > 0 then begin
  3728. if HTTPDataReceiver.Progress <> HTTPDataReceiver.ProgressMax then
  3729. raise Exception.Create(FmtSetupMessage(msgErrorProgress, [IntToStr(HTTPDataReceiver.Progress), IntToStr(HTTPDataReceiver.ProgressMax)]))
  3730. else if HTTPDataReceiver.ProgressMax <> Result then
  3731. raise Exception.Create(FmtSetupMessage(msgErrorFileSize, [IntToStr(HTTPDataReceiver.ProgressMax), IntToStr(Result)]));
  3732. end;
  3733. end;
  3734. { Rename the temporary file to the new name now, with retries if needed }
  3735. RetriesLeft := 4;
  3736. while not MoveFile(PChar(TempFile), PChar(DestFile)) do begin
  3737. { Couldn't rename the temporary file... }
  3738. LastError := GetLastError;
  3739. { Does the error code indicate that it is possibly in use? }
  3740. if LastErrorIndicatesPossiblyInUse(LastError, True) then begin
  3741. LogFmt(' The existing file appears to be in use (%d). ' +
  3742. 'Retrying.', [LastError]);
  3743. Dec(RetriesLeft);
  3744. Sleep(1000);
  3745. if RetriesLeft > 0 then
  3746. Continue;
  3747. end;
  3748. { Some other error occurred, or we ran out of tries }
  3749. SetLastError(LastError);
  3750. Win32ErrorMsg('MoveFile'); { Throws an exception }
  3751. end;
  3752. TempFileLeftOver := False;
  3753. end;
  3754. finally
  3755. HandleStream.Free;
  3756. TempF.Free;
  3757. HTTPClient.Free;
  3758. HTTPDataReceiver.Free;
  3759. if TempFileLeftOver then
  3760. DeleteFile(TempFile);
  3761. end;
  3762. end;
  3763. function DownloadTemporaryFile(const Url, BaseName: String;
  3764. [ref] const Verification: TSetupFileVerification; const OnDownloadProgress: TOnDownloadProgress): Int64;
  3765. begin
  3766. var DestFile: String;
  3767. Result := DownloadTemporaryFile(Url, BaseName, Verification, OnDownloadProgress, DestFile);
  3768. end;
  3769. procedure DownloadTemporaryFileSizeAndDate(const Url: String; var FileSize: Int64; var FileDate: String);
  3770. var
  3771. HTTPClient: THTTPClient;
  3772. HTTPResponse: IHTTPResponse;
  3773. User, Pass, CleanUrl: string;
  3774. HasCredentials : Boolean;
  3775. Base64: TBase64Encoding;
  3776. begin
  3777. HTTPClient := THTTPClient.Create;
  3778. Base64 := nil;
  3779. try
  3780. HasCredentials := GetCredentialsAndCleanUrl(Url,
  3781. DownloadTemporaryFileUser, DownloadTemporaryFilePass, User, Pass, CleanUrl);
  3782. if HasCredentials then begin
  3783. Base64 := TBase64Encoding.Create(0);
  3784. HTTPClient.CustomHeaders['Authorization'] := 'Basic ' + Base64.Encode(User + ':' + Pass);
  3785. end;
  3786. SetUserAgentAndSecureProtocols(HTTPClient);
  3787. HTTPResponse := HTTPClient.Head(CleanUrl);
  3788. if (HTTPResponse.StatusCode < 200) or (HTTPResponse.StatusCode > 299) then
  3789. raise Exception.Create(FmtSetupMessage(msgErrorDownloadSizeFailed, [IntToStr(HTTPResponse.StatusCode), HTTPResponse.StatusText]))
  3790. else begin
  3791. FileSize := HTTPResponse.ContentLength;
  3792. FileDate := HTTPResponse.LastModified;
  3793. end;
  3794. finally
  3795. Base64.Free;
  3796. HTTPClient.Free;
  3797. end;
  3798. end;
  3799. function DownloadTemporaryFileSize(const Url: String): Int64;
  3800. var
  3801. FileSize: Int64;
  3802. FileDate: String;
  3803. begin
  3804. if Url = '' then
  3805. InternalError('DownloadTemporaryFileSize: Invalid Url value');
  3806. LogFmt('Getting size of %s.', [MaskPasswordInUrl(Url)]);
  3807. DownloadTemporaryFileSizeAndDate(Url, FileSize, FileDate);
  3808. Result := FileSize;
  3809. end;
  3810. function DownloadTemporaryFileDate(const Url: String): String;
  3811. var
  3812. FileSize: Int64;
  3813. FileDate: String;
  3814. begin
  3815. if Url = '' then
  3816. InternalError('DownloadTemporaryFileDate: Invalid Url value');
  3817. LogFmt('Getting last modified date of %s.', [MaskPasswordInUrl(Url)]);
  3818. DownloadTemporaryFileSizeAndDate(Url, FileSize, FileDate);
  3819. Result := FileDate;
  3820. end;
  3821. end.