Setup.Install.pas 150 KB

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