Install.pas 150 KB

12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697989910010110210310410510610710810911011111211311411511611711811912012112212312412512612712812913013113213313413513613713813914014114214314414514614714814915015115215315415515615715815916016116216316416516616716816917017117217317417517617717817918018118218318418518618718818919019119219319419519619719819920020120220320420520620720820921021121221321421521621721821922022122222322422522622722822923023123223323423523623723823924024124224324424524624724824925025125225325425525625725825926026126226326426526626726826927027127227327427527627727827928028128228328428528628728828929029129229329429529629729829930030130230330430530630730830931031131231331431531631731831932032132232332432532632732832933033133233333433533633733833934034134234334434534634734834935035135235335435535635735835936036136236336436536636736836937037137237337437537637737837938038138238338438538638738838939039139239339439539639739839940040140240340440540640740840941041141241341441541641741841942042142242342442542642742842943043143243343443543643743843944044144244344444544644744844945045145245345445545645745845946046146246346446546646746846947047147247347447547647747847948048148248348448548648748848949049149249349449549649749849950050150250350450550650750850951051151251351451551651751851952052152252352452552652752852953053153253353453553653753853954054154254354454554654754854955055155255355455555655755855956056156256356456556656756856957057157257357457557657757857958058158258358458558658758858959059159259359459559659759859960060160260360460560660760860961061161261361461561661761861962062162262362462562662762862963063163263363463563663763863964064164264364464564664764864965065165265365465565665765865966066166266366466566666766866967067167267367467567667767867968068168268368468568668768868969069169269369469569669769869970070170270370470570670770870971071171271371471571671771871972072172272372472572672772872973073173273373473573673773873974074174274374474574674774874975075175275375475575675775875976076176276376476576676776876977077177277377477577677777877978078178278378478578678778878979079179279379479579679779879980080180280380480580680780880981081181281381481581681781881982082182282382482582682782882983083183283383483583683783883984084184284384484584684784884985085185285385485585685785885986086186286386486586686786886987087187287387487587687787887988088188288388488588688788888989089189289389489589689789889990090190290390490590690790890991091191291391491591691791891992092192292392492592692792892993093193293393493593693793893994094194294394494594694794894995095195295395495595695795895996096196296396496596696796896997097197297397497597697797897998098198298398498598698798898999099199299399499599699799899910001001100210031004100510061007100810091010101110121013101410151016101710181019102010211022102310241025102610271028102910301031103210331034103510361037103810391040104110421043104410451046104710481049105010511052105310541055105610571058105910601061106210631064106510661067106810691070107110721073107410751076107710781079108010811082108310841085108610871088108910901091109210931094109510961097109810991100110111021103110411051106110711081109111011111112111311141115111611171118111911201121112211231124112511261127112811291130113111321133113411351136113711381139114011411142114311441145114611471148114911501151115211531154115511561157115811591160116111621163116411651166116711681169117011711172117311741175117611771178117911801181118211831184118511861187118811891190119111921193119411951196119711981199120012011202120312041205120612071208120912101211121212131214121512161217121812191220122112221223122412251226122712281229123012311232123312341235123612371238123912401241124212431244124512461247124812491250125112521253125412551256125712581259126012611262126312641265126612671268126912701271127212731274127512761277127812791280128112821283128412851286128712881289129012911292129312941295129612971298129913001301130213031304130513061307130813091310131113121313131413151316131713181319132013211322132313241325132613271328132913301331133213331334133513361337133813391340134113421343134413451346134713481349135013511352135313541355135613571358135913601361136213631364136513661367136813691370137113721373137413751376137713781379138013811382138313841385138613871388138913901391139213931394139513961397139813991400140114021403140414051406140714081409141014111412141314141415141614171418141914201421142214231424142514261427142814291430143114321433143414351436143714381439144014411442144314441445144614471448144914501451145214531454145514561457145814591460146114621463146414651466146714681469147014711472147314741475147614771478147914801481148214831484148514861487148814891490149114921493149414951496149714981499150015011502150315041505150615071508150915101511151215131514151515161517151815191520152115221523152415251526152715281529153015311532153315341535153615371538153915401541154215431544154515461547154815491550155115521553155415551556155715581559156015611562156315641565156615671568156915701571157215731574157515761577157815791580158115821583158415851586158715881589159015911592159315941595159615971598159916001601160216031604160516061607160816091610161116121613161416151616161716181619162016211622162316241625162616271628162916301631163216331634163516361637163816391640164116421643164416451646164716481649165016511652165316541655165616571658165916601661166216631664166516661667166816691670167116721673167416751676167716781679168016811682168316841685168616871688168916901691169216931694169516961697169816991700170117021703170417051706170717081709171017111712171317141715171617171718171917201721172217231724172517261727172817291730173117321733173417351736173717381739174017411742174317441745174617471748174917501751175217531754175517561757175817591760176117621763176417651766176717681769177017711772177317741775177617771778177917801781178217831784178517861787178817891790179117921793179417951796179717981799180018011802180318041805180618071808180918101811181218131814181518161817181818191820182118221823182418251826182718281829183018311832183318341835183618371838183918401841184218431844184518461847184818491850185118521853185418551856185718581859186018611862186318641865186618671868186918701871187218731874187518761877187818791880188118821883188418851886188718881889189018911892189318941895189618971898189919001901190219031904190519061907190819091910191119121913191419151916191719181919192019211922192319241925192619271928192919301931193219331934193519361937193819391940194119421943194419451946194719481949195019511952195319541955195619571958195919601961196219631964196519661967196819691970197119721973197419751976197719781979198019811982198319841985198619871988198919901991199219931994199519961997199819992000200120022003200420052006200720082009201020112012201320142015201620172018201920202021202220232024202520262027202820292030203120322033203420352036203720382039204020412042204320442045204620472048204920502051205220532054205520562057205820592060206120622063206420652066206720682069207020712072207320742075207620772078207920802081208220832084208520862087208820892090209120922093209420952096209720982099210021012102210321042105210621072108210921102111211221132114211521162117211821192120212121222123212421252126212721282129213021312132213321342135213621372138213921402141214221432144214521462147214821492150215121522153215421552156215721582159216021612162216321642165216621672168216921702171217221732174217521762177217821792180218121822183218421852186218721882189219021912192219321942195219621972198219922002201220222032204220522062207220822092210221122122213221422152216221722182219222022212222222322242225222622272228222922302231223222332234223522362237223822392240224122422243224422452246224722482249225022512252225322542255225622572258225922602261226222632264226522662267226822692270227122722273227422752276227722782279228022812282228322842285228622872288228922902291229222932294229522962297229822992300230123022303230423052306230723082309231023112312231323142315231623172318231923202321232223232324232523262327232823292330233123322333233423352336233723382339234023412342234323442345234623472348234923502351235223532354235523562357235823592360236123622363236423652366236723682369237023712372237323742375237623772378237923802381238223832384238523862387238823892390239123922393239423952396239723982399240024012402240324042405240624072408240924102411241224132414241524162417241824192420242124222423242424252426242724282429243024312432243324342435243624372438243924402441244224432444244524462447244824492450245124522453245424552456245724582459246024612462246324642465246624672468246924702471247224732474247524762477247824792480248124822483248424852486248724882489249024912492249324942495249624972498249925002501250225032504250525062507250825092510251125122513251425152516251725182519252025212522252325242525252625272528252925302531253225332534253525362537253825392540254125422543254425452546254725482549255025512552255325542555255625572558255925602561256225632564256525662567256825692570257125722573257425752576257725782579258025812582258325842585258625872588258925902591259225932594259525962597259825992600260126022603260426052606260726082609261026112612261326142615261626172618261926202621262226232624262526262627262826292630263126322633263426352636263726382639264026412642264326442645264626472648264926502651265226532654265526562657265826592660266126622663266426652666266726682669267026712672267326742675267626772678267926802681268226832684268526862687268826892690269126922693269426952696269726982699270027012702270327042705270627072708270927102711271227132714271527162717271827192720272127222723272427252726272727282729273027312732273327342735273627372738273927402741274227432744274527462747274827492750275127522753275427552756275727582759276027612762276327642765276627672768276927702771277227732774277527762777277827792780278127822783278427852786278727882789279027912792279327942795279627972798279928002801280228032804280528062807280828092810281128122813281428152816281728182819282028212822282328242825282628272828282928302831283228332834283528362837283828392840284128422843284428452846284728482849285028512852285328542855285628572858285928602861286228632864286528662867286828692870287128722873287428752876287728782879288028812882288328842885288628872888288928902891289228932894289528962897289828992900290129022903290429052906290729082909291029112912291329142915291629172918291929202921292229232924292529262927292829292930293129322933293429352936293729382939294029412942294329442945294629472948294929502951295229532954295529562957295829592960296129622963296429652966296729682969297029712972297329742975297629772978297929802981298229832984298529862987298829892990299129922993299429952996299729982999300030013002300330043005300630073008300930103011301230133014301530163017301830193020302130223023302430253026302730283029303030313032303330343035303630373038303930403041304230433044304530463047304830493050305130523053305430553056305730583059306030613062306330643065306630673068306930703071307230733074307530763077307830793080308130823083308430853086308730883089309030913092309330943095309630973098309931003101310231033104310531063107310831093110311131123113311431153116311731183119312031213122312331243125312631273128312931303131313231333134313531363137313831393140314131423143314431453146314731483149315031513152315331543155315631573158315931603161316231633164316531663167316831693170317131723173317431753176317731783179318031813182318331843185318631873188318931903191319231933194319531963197319831993200320132023203320432053206320732083209321032113212321332143215321632173218321932203221322232233224322532263227322832293230323132323233323432353236323732383239324032413242324332443245324632473248324932503251325232533254325532563257325832593260326132623263326432653266326732683269327032713272327332743275327632773278327932803281328232833284328532863287328832893290329132923293329432953296329732983299330033013302330333043305330633073308330933103311331233133314331533163317331833193320332133223323332433253326332733283329333033313332333333343335333633373338333933403341334233433344334533463347334833493350335133523353335433553356335733583359336033613362336333643365336633673368336933703371337233733374337533763377337833793380338133823383338433853386338733883389339033913392339333943395339633973398339934003401340234033404340534063407340834093410341134123413341434153416341734183419342034213422342334243425342634273428342934303431343234333434343534363437343834393440344134423443344434453446344734483449345034513452345334543455345634573458345934603461346234633464346534663467346834693470347134723473347434753476347734783479348034813482348334843485348634873488348934903491349234933494349534963497349834993500350135023503350435053506350735083509351035113512351335143515351635173518351935203521352235233524352535263527352835293530353135323533353435353536353735383539354035413542354335443545354635473548354935503551355235533554355535563557355835593560356135623563356435653566356735683569357035713572357335743575357635773578357935803581358235833584358535863587358835893590359135923593359435953596359735983599360036013602360336043605360636073608360936103611361236133614361536163617361836193620362136223623362436253626362736283629363036313632363336343635363636373638363936403641364236433644364536463647364836493650365136523653365436553656365736583659366036613662366336643665366636673668366936703671367236733674
  1. unit 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. {$I VERSION.INC}
  11. procedure PerformInstall(var Succeeded: Boolean; const ChangesEnvironment,
  12. ChangesAssociations: Boolean);
  13. type
  14. TOnDownloadProgress = function(const Url, BaseName: string; const Progress, ProgressMax: Int64): Boolean of object;
  15. procedure ExtractTemporaryFile(const BaseName: String);
  16. function ExtractTemporaryFiles(const Pattern: String): Integer;
  17. function DownloadTemporaryFile(const Url, BaseName, RequiredSHA256OfFile: String; const OnDownloadProgress: TOnDownloadProgress): Int64;
  18. function DownloadTemporaryFileSize(const Url: String): Int64;
  19. function DownloadTemporaryFileDate(const Url: String): String;
  20. procedure SetDownloadCredentials(const User, Pass: String);
  21. implementation
  22. uses
  23. Windows, SysUtils, Messages, Classes, Forms, ShlObj, Struct, Undo, SetupTypes,
  24. InstFunc, InstFnc2, SecurityFunc, Msgs, Main, Logging, Extract, FileClass,
  25. Compress, SHA1, PathFunc, CmnFunc, CmnFunc2, RedirFunc, Int64Em, MsgIDs,
  26. Wizard, DebugStruct, DebugClient, VerInfo, ScriptRunner, RegDLL, Helper,
  27. ResUpdate, DotNet, 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 TryToGetSHA1OfFile(const DisableFsRedir: Boolean; const Filename: String;
  209. var Sum: TSHA1Digest): Boolean;
  210. { Like GetSHA1OfFile but traps exceptions locally. Returns True if successful. }
  211. begin
  212. try
  213. Sum := GetSHA1OfFile(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 <> $FFFFFFFF 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 (WindowsVersion shr 16 > $0601) 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: TSHA1Digest;
  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 MD5 sum. This is done to combat broken
  802. anti-spyware programs that catch all unins*.exe files with certain MD5
  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 := GetSHA1OfUnicodeString(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 (WindowsVersion < Cardinal($0A0042EE)) 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 <> $FFFFFFFF) 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. ExistingFileAttr: Integer;
  983. Failed: String;
  984. CurFileVersionInfoValid: Boolean;
  985. CurFileVersionInfo, ExistingVersionInfo: TFileVersionNumbers;
  986. CurFileDateValid, ExistingFileDateValid: Boolean;
  987. CurFileHash, ExistingFileHash: TSHA1Digest;
  988. IsProtectedFile, AllowTimeStampComparison: Boolean;
  989. DeleteFlags: Longint;
  990. CurFileDate, ExistingFileDate: TFileTime;
  991. RegisterRec: PRegisterFilesListRec;
  992. RetriesLeft: Integer;
  993. LastError: DWORD;
  994. DestF, SourceF: TFile;
  995. Flags: TMakeDirFlags;
  996. Overwrite, PerUserFont: Boolean;
  997. label Retry, Skip;
  998. begin
  999. Log('-- File entry --');
  1000. CheckedDestFileExistedBefore := False;
  1001. DestFileExistedBefore := False; { prevent warning }
  1002. if CurFile^.LocationEntry <> -1 then
  1003. CurFileLocation := PSetupFileLocationEntry(Entries[seFileLocation][CurFile^.LocationEntry])
  1004. else
  1005. CurFileLocation := nil;
  1006. Retry:
  1007. DestFile := '';
  1008. TempFile := '';
  1009. TempFileLeftOver := False;
  1010. ProgressUpdated := False;
  1011. PreviousProgress := CurProgress;
  1012. LastOperation := '';
  1013. Failed := '';
  1014. try
  1015. try
  1016. ReplaceOnRestart := False;
  1017. DeleteFlags := 0;
  1018. if DisableFsRedir then
  1019. DeleteFlags := DeleteFlags or utDeleteFile_DisableFsRedir;
  1020. if foRegisterServer in CurFile^.Options then
  1021. DeleteFlags := DeleteFlags or utDeleteFile_RegisteredServer;
  1022. if foRegisterTypeLib in CurFile^.Options then
  1023. DeleteFlags := DeleteFlags or utDeleteFile_RegisteredTypeLib;
  1024. if foUninsRestartDelete in CurFile^.Options then
  1025. DeleteFlags := DeleteFlags or utDeleteFile_RestartDelete;
  1026. if foUninsRemoveReadOnly in CurFile^.Options then
  1027. DeleteFlags := DeleteFlags or utDeleteFile_RemoveReadOnly;
  1028. if foGacInstall in CurFile^.Options then
  1029. DeleteFlags := DeleteFlags or utDeleteFile_GacInstalled;
  1030. FontFilename := '';
  1031. { Determine the destination filename }
  1032. try
  1033. case CurFile^.FileType of
  1034. ftUninstExe: DestFile := UninstallExeFilename;
  1035. else
  1036. if ADestName = '' then
  1037. DestFile := ExpandConst(CurFile^.DestName)
  1038. else
  1039. DestFile := ADestName;
  1040. end;
  1041. DestFile := PathExpand(DestFile);
  1042. except
  1043. { If an exception occurred, reset DestFile back to an empty string
  1044. so the error message doesn't show an unexpanded name }
  1045. DestFile := '';
  1046. raise;
  1047. end;
  1048. { Update the filename label }
  1049. SetFilenameLabelText(DestFile, True);
  1050. LogFmt('Dest filename: %s', [DestFile]);
  1051. if DisableFsRedir <> InstallDefaultDisableFsRedir then begin
  1052. if DisableFsRedir then
  1053. Log('Non-default bitness: 64-bit')
  1054. else
  1055. Log('Non-default bitness: 32-bit');
  1056. end;
  1057. { See if it's a protected system file. }
  1058. if IsProtectedSystemFile(DisableFsRedir, DestFile) then begin
  1059. Log('Dest file is protected by Windows File Protection.');
  1060. IsProtectedFile := (CurFile^.FileType = ftUserFile);
  1061. end else
  1062. IsProtectedFile := False;
  1063. DestFileExists := NewFileExistsRedir(DisableFsRedir, DestFile);
  1064. if not CheckedDestFileExistedBefore then begin
  1065. DestFileExistedBefore := DestFileExists;
  1066. CheckedDestFileExistedBefore := True;
  1067. end;
  1068. if DestFileExistedBefore then
  1069. DeleteFlags := DeleteFlags or utDeleteFile_ExistedBeforeInstall;
  1070. if Assigned(CurFileLocation) then begin
  1071. if foTimeStampInUTC in CurFileLocation^.Flags then
  1072. CurFileDate := CurFileLocation^.SourceTimeStamp
  1073. else
  1074. LocalFileTimeToFileTime(CurFileLocation^.SourceTimeStamp, CurFileDate);
  1075. CurFileDateValid := True;
  1076. end
  1077. else
  1078. CurFileDateValid := GetFileDateTime(DisableFsRedir, ASourceFile, CurFileDate);
  1079. if CurFileDateValid then
  1080. LogFmt('Time stamp of our file: %s', [FileTimeToStr(CurFileDate)])
  1081. else
  1082. Log('Time stamp of our file: (failed to read)');
  1083. if DestFileExists then begin
  1084. Log('Dest file exists.');
  1085. if foOnlyIfDoesntExist in CurFile^.Options then begin
  1086. Log('Skipping due to "onlyifdoesntexist" flag.');
  1087. goto Skip;
  1088. end;
  1089. LastOperation := SetupMessages[msgErrorReadingExistingDest];
  1090. ExistingFileDateValid := GetFileDateTime(DisableFsRedir, DestFile, ExistingFileDate);
  1091. if ExistingFileDateValid then
  1092. LogFmt('Time stamp of existing file: %s', [FileTimeToStr(ExistingFileDate)])
  1093. else
  1094. Log('Time stamp of existing file: (failed to read)');
  1095. { Compare version info }
  1096. if not(foIgnoreVersion in CurFile^.Options) then begin
  1097. AllowTimeStampComparison := False;
  1098. { Read version info of file being installed }
  1099. if Assigned(CurFileLocation) then begin
  1100. CurFileVersionInfoValid := foVersionInfoValid in CurFileLocation^.Flags;
  1101. CurFileVersionInfo.MS := CurFileLocation^.FileVersionMS;
  1102. CurFileVersionInfo.LS := CurFileLocation^.FileVersionLS;
  1103. end
  1104. else
  1105. CurFileVersionInfoValid := GetVersionNumbersRedir(DisableFsRedir,
  1106. PathExpand(ASourceFile), CurFileVersionInfo);
  1107. if CurFileVersionInfoValid then
  1108. LogFmt('Version of our file: %u.%u.%u.%u',
  1109. [LongRec(CurFileVersionInfo.MS).Hi, LongRec(CurFileVersionInfo.MS).Lo,
  1110. LongRec(CurFileVersionInfo.LS).Hi, LongRec(CurFileVersionInfo.LS).Lo])
  1111. else
  1112. Log('Version of our file: (none)');
  1113. { Does the existing file have version info? }
  1114. if GetVersionNumbersRedir(DisableFsRedir, PathExpand(DestFile), ExistingVersionInfo) then begin
  1115. { If the file being installed has no version info, or the existing
  1116. file is a newer version... }
  1117. LogFmt('Version of existing file: %u.%u.%u.%u',
  1118. [LongRec(ExistingVersionInfo.MS).Hi, LongRec(ExistingVersionInfo.MS).Lo,
  1119. LongRec(ExistingVersionInfo.LS).Hi, LongRec(ExistingVersionInfo.LS).Lo]);
  1120. if not CurFileVersionInfoValid or
  1121. ((ExistingVersionInfo.MS > CurFileVersionInfo.MS) or
  1122. ((ExistingVersionInfo.MS = CurFileVersionInfo.MS) and
  1123. (ExistingVersionInfo.LS > CurFileVersionInfo.LS))) then begin
  1124. { Existing file is newer, ask user what to do unless we shouldn't }
  1125. if (foPromptIfOlder in CurFile^.Options) and not IsProtectedFile then begin
  1126. if PromptIfOlderOverwriteAll <> oaOverwrite then begin
  1127. Overwrite := AskOverwrite(DestFile, SetupMessages[msgExistingFileNewerSelectAction],
  1128. SetupMessages[msgExistingFileNewer2],
  1129. [SetupMessages[msgExistingFileNewerKeepExisting], SetupMessages[msgExistingFileNewerOverwriteExisting]],
  1130. SetupMessages[msgExistingFileNewerOverwriteOrKeepAll],
  1131. mbError, IDYES, IDNO, PromptIfOlderOverwriteAll);
  1132. if not Overwrite then begin
  1133. Log('User opted not to overwrite the existing file. Skipping.');
  1134. goto Skip;
  1135. end;
  1136. end;
  1137. end else begin
  1138. Log('Existing file is a newer version. Skipping.');
  1139. goto Skip;
  1140. end;
  1141. end
  1142. else begin
  1143. { If the existing file and the file being installed are the same
  1144. version... }
  1145. if (ExistingVersionInfo.MS = CurFileVersionInfo.MS) and
  1146. (ExistingVersionInfo.LS = CurFileVersionInfo.LS) and
  1147. not(foOverwriteSameVersion in CurFile^.Options) then begin
  1148. if foReplaceSameVersionIfContentsDiffer in CurFile^.Options then begin
  1149. { Get the two files' SHA-1 hashes and compare them }
  1150. if TryToGetSHA1OfFile(DisableFsRedir, DestFile, ExistingFileHash) then begin
  1151. if Assigned(CurFileLocation) then
  1152. CurFileHash := CurFileLocation^.SHA1Sum
  1153. else begin
  1154. LastOperation := SetupMessages[msgErrorReadingSource];
  1155. { This GetSHA1OfFile call could raise an exception, but
  1156. it's very unlikely since we were already able to
  1157. successfully read the file's version info. }
  1158. CurFileHash := GetSHA1OfFile(DisableFsRedir, ASourceFile);
  1159. LastOperation := SetupMessages[msgErrorReadingExistingDest];
  1160. end;
  1161. { If the two files' SHA-1 hashes are equal, skip the file }
  1162. if SHA1DigestsEqual(ExistingFileHash, CurFileHash) then begin
  1163. Log('Existing file''s SHA-1 hash matches our file. Skipping.');
  1164. goto Skip;
  1165. end;
  1166. Log('Existing file''s SHA-1 hash is different from our file. Proceeding.');
  1167. end
  1168. else
  1169. Log('Failed to read existing file''s SHA-1 hash. Proceeding.');
  1170. end
  1171. else begin
  1172. { Skip the file or fall back to time stamp comparison }
  1173. if not(foCompareTimeStamp in CurFile^.Options) then begin
  1174. Log('Same version. Skipping.');
  1175. goto Skip;
  1176. end;
  1177. AllowTimeStampComparison := True;
  1178. end;
  1179. end;
  1180. end;
  1181. end
  1182. else begin
  1183. Log('Version of existing file: (none)');
  1184. { If neither the existing file nor our file have version info,
  1185. allow time stamp comparison }
  1186. if not CurFileVersionInfoValid then
  1187. AllowTimeStampComparison := True;
  1188. end;
  1189. end
  1190. else begin
  1191. { When foIgnoreVersion is in Options, always allow time stamp
  1192. comparison }
  1193. AllowTimeStampComparison := True;
  1194. end;
  1195. { Fall back to comparing time stamps if needed }
  1196. if AllowTimeStampComparison and
  1197. (foCompareTimeStamp in CurFile^.Options) then begin
  1198. if not CurFileDateValid or not ExistingFileDateValid then begin
  1199. { If we failed to read one of the time stamps, do the safe thing
  1200. and just skip the file }
  1201. Log('Couldn''t read time stamp. Skipping.');
  1202. goto Skip;
  1203. end;
  1204. if CompareFileTime(ExistingFileDate, CurFileDate) = 0 then begin
  1205. { Same time stamp }
  1206. Log('Same time stamp. Skipping.');
  1207. goto Skip;
  1208. end;
  1209. if CompareFileTime(ExistingFileDate, CurFileDate) > 0 then begin
  1210. { Existing file has a later time stamp, ask user what to do unless we shouldn't }
  1211. if (foPromptIfOlder in CurFile^.Options) and not IsProtectedFile then begin
  1212. if PromptIfOlderOverwriteAll <> oaOverwrite then begin
  1213. Overwrite := AskOverwrite(DestFile, SetupMessages[msgExistingFileNewerSelectAction],
  1214. SetupMessages[msgExistingFileNewer2],
  1215. [SetupMessages[msgExistingFileNewerKeepExisting], SetupMessages[msgExistingFileNewerOverwriteExisting]],
  1216. SetupMessages[msgExistingFileNewerOverwriteOrKeepAll],
  1217. mbError, IDYES, IDNO, PromptIfOlderOverwriteAll);
  1218. if not Overwrite then begin
  1219. Log('User opted not to overwrite the existing file. Skipping.');
  1220. goto Skip;
  1221. end;
  1222. end;
  1223. end else begin
  1224. Log('Existing file has a later time stamp. Skipping.');
  1225. goto Skip;
  1226. end;
  1227. end;
  1228. end;
  1229. LastOperation := '';
  1230. { Don't attempt to replace an existing protected system file.
  1231. (Do this *after* the version numbers of the new & existing files
  1232. have been logged.) }
  1233. if IsProtectedFile then begin
  1234. Log('Existing file is protected by Windows File Protection. Skipping.');
  1235. goto Skip;
  1236. end;
  1237. { If file already exists and foConfirmOverwrite is in Options, ask the user what to do }
  1238. if foConfirmOverwrite in CurFile^.Options then begin
  1239. if ConfirmOverwriteOverwriteAll <> oaOverwrite then begin
  1240. Overwrite := AskOverwrite(DestFile, SetupMessages[msgFileExistsSelectAction],
  1241. SetupMessages[msgFileExists2],
  1242. [SetupMessages[msgFileExistsOverwriteExisting], SetupMessages[msgFileExistsKeepExisting]],
  1243. SetupMessages[msgFileExistsOverwriteOrKeepAll],
  1244. mbConfirmation, IDNO, IDYES, ConfirmOverwriteOverwriteAll);
  1245. if not Overwrite then begin
  1246. Log('User opted not to overwrite the existing file. Skipping.');
  1247. goto Skip;
  1248. end;
  1249. end;
  1250. end;
  1251. { Check if existing file is read-only }
  1252. while True do begin
  1253. ExistingFileAttr := GetFileAttributesRedir(DisableFsRedir, DestFile);
  1254. if (ExistingFileAttr <> -1) and
  1255. (ExistingFileAttr and FILE_ATTRIBUTE_READONLY <> 0) then begin
  1256. if not(foOverwriteReadOnly in CurFile^.Options) and
  1257. AbortRetryIgnoreTaskDialogMsgBox(
  1258. DestFile + SNewLine2 + SetupMessages[msgExistingFileReadOnly2],
  1259. [SetupMessages[msgExistingFileReadOnlyRetry], SetupMessages[msgExistingFileReadOnlyKeepExisting], SetupMessages[msgAbortRetryIgnoreCancel]]) then begin
  1260. Log('User opted not to strip the existing file''s read-only attribute. Skipping.');
  1261. goto Skip;
  1262. end;
  1263. LastOperation := SetupMessages[msgErrorChangingAttr];
  1264. if SetFileAttributesRedir(DisableFsRedir, DestFile,
  1265. ExistingFileAttr and not FILE_ATTRIBUTE_READONLY) then
  1266. Log('Stripped read-only attribute.')
  1267. else
  1268. Log('Failed to strip read-only attribute.');
  1269. if foOverwriteReadOnly in CurFile^.Options then
  1270. Break; { don't retry }
  1271. end
  1272. else
  1273. Break;
  1274. end;
  1275. end
  1276. else begin
  1277. if (foOnlyIfDestFileExists in CurFile^.Options) and not DestFileExistedBefore then begin
  1278. Log('Skipping due to "onlyifdestfileexists" flag.');
  1279. goto Skip;
  1280. end;
  1281. end;
  1282. Log('Installing the file.');
  1283. { Locate source file }
  1284. SourceFile := ASourceFile;
  1285. if DisableFsRedir = InstallDefaultDisableFsRedir then begin
  1286. { If the file is compressed in the setup package, has the same file
  1287. already been copied somewhere else? If so, just make a duplicate of
  1288. that file instead of extracting it over again. }
  1289. if (SourceFile = '') and
  1290. (FileLocationFilenames[CurFile^.LocationEntry] <> '') and
  1291. NewFileExistsRedir(DisableFsRedir, FileLocationFilenames[CurFile^.LocationEntry]) then
  1292. SourceFile := FileLocationFilenames[CurFile^.LocationEntry];
  1293. AllowFileToBeDuplicated := (SourceFile = '');
  1294. end
  1295. else begin
  1296. { This file uses a non-default FS redirection setting. Files in
  1297. FileLocationFilenames are assumed to have been installed with the
  1298. default FS redirection setting, so we can't use a file in
  1299. FileLocationFilenames as the source, or put this file there. }
  1300. AllowFileToBeDuplicated := False;
  1301. end;
  1302. { Extract or copy the file to a temporary file. Create the destination
  1303. file's directory if it didn't already exist. }
  1304. LastOperation := SetupMessages[msgErrorCreatingTemp];
  1305. TempFile := GenerateUniqueName(DisableFsRedir, PathExtractPath(DestFile), '.tmp');
  1306. Flags := [];
  1307. if foUninsNeverUninstall in CurFile^.Options then Include(Flags, mdNoUninstall);
  1308. if foDeleteAfterInstall in CurFile^.Options then Include(Flags, mdDeleteAfterInstall);
  1309. MakeDir(DisableFsRedir, PathExtractDir(TempFile), Flags);
  1310. DestF := TFileRedir.Create(DisableFsRedir, TempFile, fdCreateAlways, faReadWrite, fsNone);
  1311. try
  1312. TempFileLeftOver := True;
  1313. try
  1314. ProgressUpdated := True;
  1315. LastOperation := SetupMessages[msgErrorReadingSource];
  1316. if SourceFile = '' then begin
  1317. { Decompress a file }
  1318. FileExtractor.SeekTo(CurFileLocation^, ExtractorProgressProc);
  1319. LastOperation := SetupMessages[msgErrorCopying];
  1320. FileExtractor.DecompressFile(CurFileLocation^, DestF, ExtractorProgressProc,
  1321. not (foDontVerifyChecksum in CurFile^.Options));
  1322. end
  1323. else begin
  1324. { Copy an external file, or a duplicated non-external file }
  1325. SourceF := TFileRedir.Create(DisableFsRedir, SourceFile, fdOpenExisting, faRead, fsRead);
  1326. try
  1327. LastOperation := SetupMessages[msgErrorCopying];
  1328. if Assigned(CurFileLocation) then
  1329. CopySourceFileToDestFile(SourceF, DestF, CurFileLocation^.OriginalSize)
  1330. else
  1331. CopySourceFileToDestFile(SourceF, DestF, AExternalSize);
  1332. finally
  1333. SourceF.Free;
  1334. end;
  1335. end;
  1336. except
  1337. { If an exception occurred, put progress meter back to where it was }
  1338. ProgressUpdated := False;
  1339. SetProgress(PreviousProgress);
  1340. raise;
  1341. end;
  1342. { Set time/date stamp }
  1343. SetFileTime(DestF.Handle, nil, nil, @CurFileDate);
  1344. { If it's the uninstall program, bind the messages }
  1345. if CurFile^.FileType = ftUninstExe then begin
  1346. AllowFileToBeDuplicated := False;
  1347. MarkExeHeader(DestF, SetupExeModeUninstaller);
  1348. if not(shSignedUninstaller in SetupHeader.Options) and
  1349. not DetachedUninstMsgFile then
  1350. BindUninstallMsgDataToExe(DestF);
  1351. end;
  1352. finally
  1353. DestF.Free;
  1354. end;
  1355. { If it's a font, unregister the existing one to ensure that Windows
  1356. 'notices' the file is being replaced, and to increase the chances
  1357. of the file being unlocked/closed before we replace it. }
  1358. if CurFile^.InstallFontName <> '' then begin
  1359. LastOperation := '';
  1360. FontFilename := ShortenOrExpandFontFilename(DestFile);
  1361. if DestFileExistedBefore then
  1362. RemoveFontResource(PChar(FontFilename));
  1363. end;
  1364. { Delete existing version of file, if any. If it can't be deleted
  1365. because it's in use and the "restartreplace" flag was specified
  1366. on the entry, register it to be replaced when the system is
  1367. restarted. Do retry deletion before doing this. }
  1368. if DestFileExists and (CurFile^.FileType <> ftUninstExe) then begin
  1369. LastOperation := SetupMessages[msgErrorReplacingExistingFile];
  1370. RetriesLeft := 4;
  1371. while not DeleteFileRedir(DisableFsRedir, DestFile) do begin
  1372. { Couldn't delete the existing file... }
  1373. LastError := GetLastError;
  1374. { If the file inexplicably vanished, it's not a problem }
  1375. if LastError = ERROR_FILE_NOT_FOUND then
  1376. Break;
  1377. { Does the error code indicate that it is possibly in use? }
  1378. if LastErrorIndicatesPossiblyInUse(LastError, False) then begin
  1379. DoHandleFailedDeleteOrMoveFileTry('DeleteFile', TempFile, DestFile,
  1380. LastError, RetriesLeft, LastOperation, NeedsRestart, ReplaceOnRestart,
  1381. DoBreak, DoContinue);
  1382. if DoBreak then
  1383. Break
  1384. else if DoContinue then
  1385. Continue;
  1386. end;
  1387. { Some other error occurred, or we ran out of tries }
  1388. SetLastError(LastError);
  1389. Win32ErrorMsg('DeleteFile');
  1390. end;
  1391. end;
  1392. { Rename the temporary file to the new name now, unless the file is
  1393. to be replaced when the system is restarted, or if the file is the
  1394. uninstall program and an existing uninstall program already exists.
  1395. If it can't be renamed and the "restartreplace" flag was specified
  1396. on the entry, register it to be replaced when the system is
  1397. restarted. Do retry renaming before doing this. }
  1398. if not (ReplaceOnRestart or
  1399. ((CurFile^.FileType = ftUninstExe) and DestFileExistedBefore)) then begin
  1400. LastOperation := SetupMessages[msgErrorRenamingTemp];
  1401. { Since the DeleteFile above succeeded you would expect the rename to
  1402. also always succeed, but if it doesn't retry anyway. }
  1403. RetriesLeft := 4;
  1404. while not MoveFileRedir(DisableFsRedir, TempFile, DestFile) do begin
  1405. { Couldn't rename the temporary file... }
  1406. LastError := GetLastError;
  1407. { Does the error code indicate that it is possibly in use? }
  1408. if LastErrorIndicatesPossiblyInUse(LastError, True) then begin
  1409. DoHandleFailedDeleteOrMoveFileTry('MoveFile', TempFile, DestFile,
  1410. LastError, RetriesLeft, LastOperation, NeedsRestart, ReplaceOnRestart,
  1411. DoBreak, DoContinue);
  1412. if DoBreak then
  1413. Break
  1414. else if DoContinue then
  1415. Continue;
  1416. end;
  1417. { Some other error occurred, or we ran out of tries }
  1418. SetLastError(LastError);
  1419. Win32ErrorMsg('MoveFile'); { Throws an exception }
  1420. end;
  1421. { If ReplaceOnRestart is still False the rename succeeded so handle this.
  1422. Then set any file attributes. }
  1423. if not ReplaceOnRestart then begin
  1424. TempFileLeftOver := False;
  1425. TempFile := '';
  1426. LastOperation := '';
  1427. Log('Successfully installed the file.');
  1428. if AllowFileToBeDuplicated then
  1429. SetFileLocationFilename(CurFile^.LocationEntry, DestFile);
  1430. if foDeleteAfterInstall in CurFile^.Options then
  1431. DeleteFilesAfterInstallList.AddObject(DestFile, Pointer(Ord(DisableFsRedir)));
  1432. { Set file attributes *after* renaming the file since Novell
  1433. reportedly can't rename read-only files. }
  1434. AddAttributesToFile(DisableFsRedir, DestFile, CurFile^.Attribs);
  1435. end;
  1436. end;
  1437. { Leave the temporary file in place for now if the file is to be
  1438. replaced when the system is restarted, or if the file is the uninstall
  1439. program and an existing uninstall program already exists. }
  1440. if ReplaceOnRestart or
  1441. ((CurFile^.FileType = ftUninstExe) and DestFileExistedBefore) then begin
  1442. if CurFile^.FileType = ftUninstExe then
  1443. UninstallTempExeFilename := TempFile;
  1444. TempFileLeftOver := False;
  1445. LastOperation := '';
  1446. Log('Leaving temporary file in place for now.');
  1447. if AllowFileToBeDuplicated then
  1448. SetFileLocationFilename(CurFile^.LocationEntry, TempFile);
  1449. AddAttributesToFile(DisableFsRedir, TempFile, CurFile^.Attribs);
  1450. end;
  1451. { If it's a font, register it }
  1452. if CurFile^.InstallFontName <> '' then begin
  1453. LastOperation := '';
  1454. LogFmt('Registering file as a font ("%s")', [CurFile^.InstallFontName]);
  1455. PerUserFont := not IsAdminInstallMode;
  1456. InstallFont(FontFilename, CurFile^.InstallFontName, PerUserFont, not ReplaceOnRestart, WarnedPerUserFonts);
  1457. DeleteFlags := DeleteFlags or utDeleteFile_IsFont;
  1458. if PerUserFont then
  1459. DeleteFlags := DeleteFlags or utDeleteFile_PerUserFont;
  1460. end;
  1461. { There were no errors so add the uninstall log entry, unless the file
  1462. is the uninstall program, or if it has the foSharedFile flag; shared
  1463. files are handled below. }
  1464. LastOperation := '';
  1465. if CurFile^.FileType <> ftUninstExe then begin
  1466. if not(foUninsNeverUninstall in CurFile^.Options) and
  1467. not(foSharedFile in CurFile^.Options) then begin
  1468. UninstLog.Add(utDeleteFile, [DestFile, TempFile,
  1469. CurFile^.InstallFontName, FontFilename,
  1470. CurFile^.StrongAssemblyName], DeleteFlags);
  1471. end;
  1472. end
  1473. else begin
  1474. if UninstallTempExeFilename = '' then
  1475. UninstallExeCreated := ueNew
  1476. else
  1477. UninstallExeCreated := ueReplaced;
  1478. end;
  1479. Skip:
  1480. { If foRegisterServer or foRegisterTypeLib is in Options, add the
  1481. file to RegisterFilesList for registering later.
  1482. Don't attempt to register if the file doesn't exist (which can
  1483. happen if the foOnlyIfDestFileExists flag is used). }
  1484. if ((foRegisterServer in CurFile^.Options) or
  1485. (foRegisterTypeLib in CurFile^.Options)) and
  1486. NewFileExistsRedir(DisableFsRedir, DestFile) then begin
  1487. LastOperation := '';
  1488. if foRegisterTypeLib in CurFile^.Options then
  1489. Log('Will register the file (a type library) later.')
  1490. else
  1491. Log('Will register the file (a DLL/OCX) later.');
  1492. New(RegisterRec);
  1493. RegisterRec^.Filename := DestFile;
  1494. RegisterRec^.Is64Bit := DisableFsRedir;
  1495. RegisterRec^.TypeLib := foRegisterTypeLib in CurFile^.Options;
  1496. RegisterRec^.NoErrorMessages := foNoRegError in CurFile^.Options;
  1497. RegisterFilesList.Add(RegisterRec);
  1498. end;
  1499. { If foSharedFile is in Options, increment the reference count in the
  1500. registry for the file, then add the uninstall log entry (which,
  1501. unlike non-shared files, must be done on skipped files as well;
  1502. that's why there are two places where utDeleteFile entries are
  1503. added). }
  1504. if foSharedFile in CurFile^.Options then begin
  1505. LastOperation := '';
  1506. if DisableFsRedir then begin
  1507. Log('Incrementing shared file count (64-bit).');
  1508. IncrementSharedCount(rv64Bit, DestFile, DestFileExistedBefore);
  1509. end
  1510. else begin
  1511. Log('Incrementing shared file count (32-bit).');
  1512. IncrementSharedCount(rv32Bit, DestFile, DestFileExistedBefore);
  1513. end;
  1514. if not(foUninsNeverUninstall in CurFile^.Options) then begin
  1515. DeleteFlags := DeleteFlags or utDeleteFile_SharedFile;
  1516. if DisableFsRedir then
  1517. DeleteFlags := DeleteFlags or utDeleteFile_SharedFileIn64BitKey;
  1518. if foUninsNoSharedFilePrompt in CurFile^.Options then
  1519. DeleteFlags := DeleteFlags or utDeleteFile_NoSharedFilePrompt;
  1520. UninstLog.Add(utDeleteFile, [DestFile, TempFile,
  1521. CurFile^.InstallFontName, FontFilename,
  1522. CurFile^.StrongAssemblyName], DeleteFlags);
  1523. end
  1524. else begin
  1525. if DisableFsRedir then
  1526. UninstLog.Add(utDecrementSharedCount, [DestFile],
  1527. utDecrementSharedCount_64BitKey)
  1528. else
  1529. UninstLog.Add(utDecrementSharedCount, [DestFile], 0);
  1530. end;
  1531. end;
  1532. { Apply permissions (even if the file wasn't replaced) }
  1533. LastOperation := '';
  1534. if TempFile <> '' then
  1535. ApplyPermissions(DisableFsRedir, TempFile, CurFile^.PermissionsEntry)
  1536. else
  1537. ApplyPermissions(DisableFsRedir, DestFile, CurFile^.PermissionsEntry);
  1538. { Set NTFS compression (even if the file wasn't replaced) }
  1539. if (foSetNTFSCompression in CurFile^.Options) or (foUnsetNTFSCompression in CurFile^.Options) then begin
  1540. LastOperation := '';
  1541. if TempFile <> '' then
  1542. ApplyNTFSCompression(DisableFsRedir, TempFile, foSetNTFSCompression in CurFile^.Options)
  1543. else
  1544. ApplyNTFSCompression(DisableFsRedir, DestFile, foSetNTFSCompression in CurFile^.Options);
  1545. end;
  1546. { Install into GAC (even if the file wasn't replaced) }
  1547. if foGacInstall in CurFile^.Options then begin
  1548. Log('Installing into GAC');
  1549. with TAssemblyCacheInfo.Create(rvDefault) do try
  1550. if TempFile <> '' then
  1551. InstallAssembly(TempFile)
  1552. else
  1553. InstallAssembly(DestFile);
  1554. finally
  1555. Free;
  1556. end;
  1557. end;
  1558. except
  1559. if ExceptObject is EAbort then
  1560. raise;
  1561. Failed := GetExceptMessage;
  1562. end;
  1563. finally
  1564. { If an exception occurred before TempFile was cleaned up, delete it now }
  1565. if TempFileLeftOver then
  1566. DeleteFileRedir(DisableFsRedir, TempFile);
  1567. end;
  1568. { Was there an exception? Display error message and offer to retry }
  1569. if Failed <> '' then begin
  1570. if (CurFile^.FileType = ftUninstExe) and (UninstallTempExeFilename <> '') then begin
  1571. DeleteFile(UninstallTempExeFilename);
  1572. UninstallTempExeFilename := '';
  1573. UninstallExeCreated := ueNone;
  1574. end;
  1575. if LastOperation <> '' then
  1576. LastOperation := LastOperation + SNewLine;
  1577. if not AbortRetryIgnoreTaskDialogMsgBox(
  1578. DestFile + SNewLine2 + LastOperation + Failed,
  1579. [SetupMessages[msgAbortRetryIgnoreRetry], SetupMessages[msgFileAbortRetryIgnoreSkipNotRecommended], SetupMessages[msgAbortRetryIgnoreCancel]]) then begin
  1580. if ProgressUpdated then
  1581. SetProgress(PreviousProgress);
  1582. goto Retry;
  1583. end;
  1584. end;
  1585. { Increment progress meter, if not already done so }
  1586. if not ProgressUpdated then begin
  1587. if Assigned(CurFileLocation) then { not an "external" file }
  1588. IncProgress64(CurFileLocation^.OriginalSize)
  1589. else
  1590. IncProgress64(AExternalSize);
  1591. end;
  1592. { Process any events between copying files }
  1593. ProcessEvents;
  1594. { Clear previous filename label in case an exception or debugger break
  1595. occurs between now and when the label for the next entry is set }
  1596. SetFilenameLabelText('', False);
  1597. end;
  1598. procedure CopyFiles(const Uninstallable: Boolean);
  1599. { Copies all the application's files }
  1600. function RecurseExternalCopyFiles(const DisableFsRedir: Boolean;
  1601. const SearchBaseDir, SearchSubDir, SearchWildcard: String; const SourceIsWildcard: Boolean;
  1602. const CurFile: PSetupFileEntry; const FileLocationFilenames: TStringList;
  1603. var ExpectedBytesLeft: Integer64; var ConfirmOverwriteOverwriteAll, PromptIfOlderOverwriteAll: TOverwriteAll;
  1604. var WarnedPerUserFonts: Boolean): Boolean;
  1605. var
  1606. SearchFullPath, FileName, SourceFile, DestName: String;
  1607. H: THandle;
  1608. FindData: TWin32FindData;
  1609. Size: Integer64;
  1610. Flags: TMakeDirFlags;
  1611. begin
  1612. SearchFullPath := SearchBaseDir + SearchSubDir + SearchWildcard;
  1613. Result := False;
  1614. H := FindFirstFileRedir(DisableFsRedir, SearchFullPath, FindData);
  1615. if H <> INVALID_HANDLE_VALUE then begin
  1616. try
  1617. repeat
  1618. if FindData.dwFileAttributes and FILE_ATTRIBUTE_DIRECTORY = 0 then begin
  1619. if SourceIsWildcard then begin
  1620. if FindData.dwFileAttributes and FILE_ATTRIBUTE_HIDDEN <> 0 then
  1621. Continue;
  1622. FileName := FindData.cFileName;
  1623. end
  1624. else
  1625. FileName := SearchWildcard; { use the case specified in the script }
  1626. Result := True;
  1627. SourceFile := SearchBaseDir + SearchSubDir + FileName;
  1628. DestName := ExpandConst(CurFile^.DestName);
  1629. if not(foCustomDestName in CurFile^.Options) then
  1630. DestName := DestName + SearchSubDir + FileName
  1631. else if SearchSubDir <> '' then
  1632. DestName := PathExtractPath(DestName) + SearchSubDir + PathExtractName(DestName);
  1633. Size.Hi := FindData.nFileSizeHigh;
  1634. Size.Lo := FindData.nFileSizeLow;
  1635. if Compare64(Size, ExpectedBytesLeft) > 0 then begin
  1636. { Don't allow the progress bar to overflow if the size of the
  1637. files is greater than when we last checked }
  1638. Size := ExpectedBytesLeft;
  1639. end;
  1640. ProcessFileEntry(CurFile, DisableFsRedir, SourceFile, DestName,
  1641. FileLocationFilenames, Size, ConfirmOverwriteOverwriteAll, PromptIfOlderOverwriteAll,
  1642. WarnedPerUserFonts);
  1643. Dec6464(ExpectedBytesLeft, Size);
  1644. end;
  1645. until not FindNextFile(H, FindData);
  1646. finally
  1647. Windows.FindClose(H);
  1648. end;
  1649. end;
  1650. if foRecurseSubDirsExternal in CurFile^.Options then begin
  1651. H := FindFirstFileRedir(DisableFsRedir, SearchBaseDir + SearchSubDir + '*', FindData);
  1652. if H <> INVALID_HANDLE_VALUE then begin
  1653. try
  1654. repeat
  1655. if IsRecurseableDirectory(FindData) then
  1656. Result := RecurseExternalCopyFiles(DisableFsRedir, SearchBaseDir,
  1657. SearchSubDir + FindData.cFileName + '\', SearchWildcard,
  1658. SourceIsWildcard, CurFile, FileLocationFileNames,
  1659. ExpectedBytesLeft, ConfirmOverwriteOverwriteAll, PromptIfOlderOverwriteAll,
  1660. WarnedPerUserFonts) or Result;
  1661. until not FindNextFile(H, FindData);
  1662. finally
  1663. Windows.FindClose(H);
  1664. end;
  1665. end;
  1666. end;
  1667. if SearchSubDir <> '' then begin
  1668. { If Result is False this subdir won't be created, so create it now if
  1669. CreateAllSubDirs was set }
  1670. if (foCreateAllSubDirs in CurFile.Options) and not Result then begin
  1671. DestName := ExpandConst(CurFile^.DestName);
  1672. if not(foCustomDestName in CurFile^.Options) then
  1673. DestName := DestName + SearchSubDir
  1674. else
  1675. DestName := PathExtractPath(DestName) + SearchSubDir;
  1676. Flags := [];
  1677. if foUninsNeverUninstall in CurFile^.Options then Include(Flags, mdNoUninstall);
  1678. if foDeleteAfterInstall in CurFile^.Options then Include(Flags, mdDeleteAfterInstall);
  1679. MakeDir(DisableFsRedir, DestName, Flags);
  1680. Result := True;
  1681. end;
  1682. end;
  1683. { When recursively searching but not picking up every file, we could
  1684. be frozen for a long time when installing from a network. Calling
  1685. ProcessEvents after every directory helps. }
  1686. ProcessEvents;
  1687. end;
  1688. var
  1689. FileLocationFilenames: TStringList;
  1690. I: Integer;
  1691. CurFileNumber: Integer;
  1692. CurFile: PSetupFileEntry;
  1693. ExternalSize: Integer64;
  1694. SourceWildcard: String;
  1695. ProgressBefore, ExpectedBytesLeft: Integer64;
  1696. DisableFsRedir, FoundFiles: Boolean;
  1697. ConfirmOverwriteOverwriteAll, PromptIfOlderOverwriteAll: TOverwriteAll;
  1698. WarnedPerUserFonts: Boolean;
  1699. begin
  1700. ConfirmOverwriteOverwriteAll := oaUnknown;
  1701. PromptIfOlderOverwriteAll := oaUnknown;
  1702. WarnedPerUserFonts := False;
  1703. FileLocationFilenames := TStringList.Create;
  1704. try
  1705. for I := 0 to Entries[seFileLocation].Count-1 do
  1706. FileLocationFilenames.Add('');
  1707. for CurFileNumber := 0 to Entries[seFile].Count-1 do begin
  1708. CurFile := PSetupFileEntry(Entries[seFile][CurFileNumber]);
  1709. if ((CurFile^.FileType <> ftUninstExe) or Uninstallable) and
  1710. ShouldProcessFileEntry(WizardComponents, WizardTasks, CurFile, False) then begin
  1711. DebugNotifyEntry(seFile, CurFileNumber);
  1712. NotifyBeforeInstallFileEntry(CurFile);
  1713. DisableFsRedir := InstallDefaultDisableFsRedir;
  1714. if fo32Bit in CurFile^.Options then
  1715. DisableFsRedir := False;
  1716. if fo64Bit in CurFile^.Options then begin
  1717. if not IsWin64 then
  1718. InternalError('Cannot install files to 64-bit locations on this version of Windows');
  1719. DisableFsRedir := True;
  1720. end;
  1721. if CurFile^.LocationEntry <> -1 then begin
  1722. ExternalSize.Hi := 0; { not used... }
  1723. ExternalSize.Lo := 0;
  1724. ProcessFileEntry(CurFile, DisableFsRedir, '', '', FileLocationFilenames, ExternalSize,
  1725. ConfirmOverwriteOverwriteAll, PromptIfOlderOverwriteAll, WarnedPerUserFonts);
  1726. end
  1727. else begin
  1728. { File is an 'external' file }
  1729. if CurFile^.FileType = ftUninstExe then begin
  1730. { This is the file entry for the uninstaller program }
  1731. SourceWildcard := NewParamStr(0);
  1732. DisableFsRedir := False;
  1733. end
  1734. else
  1735. SourceWildcard := ExpandConst(CurFile^.SourceFilename);
  1736. ProgressBefore := CurProgress;
  1737. repeat
  1738. SetProgress(ProgressBefore);
  1739. ExpectedBytesLeft := CurFile^.ExternalSize;
  1740. FoundFiles := RecurseExternalCopyFiles(DisableFsRedir,
  1741. PathExtractPath(SourceWildcard), '', PathExtractName(SourceWildcard),
  1742. IsWildcard(SourceWildcard), CurFile, FileLocationFileNames,
  1743. ExpectedBytesLeft, ConfirmOverwriteOverwriteAll, PromptIfOlderOverwriteAll,
  1744. WarnedPerUserFonts);
  1745. until FoundFiles or
  1746. (foSkipIfSourceDoesntExist in CurFile^.Options) or
  1747. AbortRetryIgnoreTaskDialogMsgBox(
  1748. SetupMessages[msgErrorReadingSource] + SNewLine + AddPeriod(FmtSetupMessage(msgSourceDoesntExist, [SourceWildcard])),
  1749. [SetupMessages[msgAbortRetryIgnoreRetry], SetupMessages[msgFileAbortRetryIgnoreSkipNotRecommended], SetupMessages[msgAbortRetryIgnoreCancel]]);
  1750. { In case we didn't end up copying all the expected bytes, bump
  1751. the progress bar up to the expected amount }
  1752. Inc6464(ProgressBefore, CurFile^.ExternalSize);
  1753. SetProgress(ProgressBefore);
  1754. end;
  1755. NotifyAfterInstallFileEntry(CurFile);
  1756. end;
  1757. end;
  1758. finally
  1759. FileLocationFilenames.Free;
  1760. end;
  1761. end;
  1762. procedure CreateIcons;
  1763. function IsPathURL(const S: String): Boolean;
  1764. { Returns True if S begins with a scheme name and colon. Should be
  1765. compliant with RFC 2396 section 3.1. }
  1766. const
  1767. SchemeAlphaChars = ['A'..'Z', 'a'..'z'];
  1768. SchemeAllChars = SchemeAlphaChars + ['0'..'9', '+', '-', '.'];
  1769. var
  1770. P, I: Integer;
  1771. begin
  1772. Result := False;
  1773. P := PathPos(':', S);
  1774. if (P > 2) and CharInSet(S[1], SchemeAlphaChars) then begin
  1775. for I := 2 to P-1 do
  1776. if not CharInSet(S[I], SchemeAllChars) then
  1777. Exit;
  1778. Result := True;
  1779. end;
  1780. end;
  1781. procedure CreateURLFile(const Filename, URL, IconFilename: String;
  1782. const IconIndex: Integer);
  1783. var
  1784. S: String;
  1785. F: TTextFileWriter;
  1786. begin
  1787. S := '[InternetShortcut]' + SNewLine + 'URL=' + URL + SNewLine;
  1788. if IconFilename <> '' then
  1789. S := S + 'IconFile=' + IconFilename + SNewLine +
  1790. 'IconIndex=' + IntToStr(IconIndex) + SNewLine;
  1791. F := TTextFileWriter.Create(Filename, fdCreateAlways, faWrite, fsNone);
  1792. try
  1793. if SameText(S, String(AnsiString(S))) then
  1794. F.WriteAnsi(AnsiString(S))
  1795. else
  1796. F.Write(S);
  1797. finally
  1798. F.Free;
  1799. end;
  1800. end;
  1801. procedure DeleteFolderShortcut(const Dir: String);
  1802. var
  1803. Attr: DWORD;
  1804. DesktopIniFilename, S: String;
  1805. begin
  1806. Attr := GetFileAttributes(PChar(Dir));
  1807. if (Attr <> $FFFFFFFF) and (Attr and FILE_ATTRIBUTE_DIRECTORY <> 0) then begin
  1808. { To be sure this is really a folder shortcut and not a regular folder,
  1809. look for a desktop.ini file specifying CLSID_FolderShortcut }
  1810. DesktopIniFilename := PathCombine(Dir, 'desktop.ini');
  1811. S := GetIniString('.ShellClassInfo', 'CLSID2', '', DesktopIniFilename);
  1812. if CompareText(S, '{0AFACED1-E828-11D1-9187-B532F1E9575D}') = 0 then begin
  1813. DeleteFile(DesktopIniFilename);
  1814. DeleteFile(PathCombine(Dir, 'target.lnk'));
  1815. SetFileAttributes(PChar(Dir), Attr and not FILE_ATTRIBUTE_READONLY);
  1816. RemoveDirectory(PChar(Dir));
  1817. end;
  1818. end;
  1819. end;
  1820. procedure CreateAnIcon(Name: String; const Description, Path, Parameters,
  1821. WorkingDir, IconFilename: String; const IconIndex, ShowCmd: Integer;
  1822. const NeverUninstall: Boolean; const CloseOnExit: TSetupIconCloseOnExit;
  1823. const HotKey: Word; const AppUserModelID: String;
  1824. const AppUserModelToastActivatorCLSID: PGUID;
  1825. const ExcludeFromShowInNewInstall, PreventPinning: Boolean);
  1826. var
  1827. BeginsWithGroup: Boolean;
  1828. LinkFilename, PifFilename, UrlFilename, DirFilename, ProbableFilename,
  1829. ResultingFilename: String;
  1830. Flags: TMakeDirFlags;
  1831. URLShortcut: Boolean;
  1832. begin
  1833. BeginsWithGroup := Copy(Name, 1, 8) = '{group}\';
  1834. { Note: PathExpand removes trailing spaces, so it can't be called on
  1835. Name before the extensions are appended }
  1836. Name := ExpandConst(Name);
  1837. LinkFilename := PathExpand(Name + '.lnk');
  1838. PifFilename := PathExpand(Name + '.pif');
  1839. UrlFilename := PathExpand(Name + '.url');
  1840. DirFilename := PathExpand(Name);
  1841. Flags := [mdNotifyChange];
  1842. if NeverUninstall then
  1843. Include(Flags, mdNoUninstall)
  1844. else if BeginsWithGroup then
  1845. Include(Flags, mdAlwaysUninstall);
  1846. URLShortcut := IsPathURL(Path);
  1847. if URLShortcut then
  1848. ProbableFilename := UrlFilename
  1849. else
  1850. ProbableFilename := LinkFilename;
  1851. LogFmt('Dest filename: %s', [ProbableFilename]);
  1852. SetFilenameLabelText(ProbableFilename, True);
  1853. MakeDir(False, PathExtractDir(ProbableFilename), Flags);
  1854. { Delete any old files first }
  1855. DeleteFile(LinkFilename);
  1856. DeleteFile(PifFilename);
  1857. if NewFileExists(UrlFilename) then begin
  1858. { Flush out any pending writes by other apps before deleting }
  1859. WritePrivateProfileString(nil, nil, nil, PChar(UrlFilename));
  1860. end;
  1861. DeleteFile(UrlFilename);
  1862. DeleteFolderShortcut(DirFilename);
  1863. Log('Creating the icon.');
  1864. if not URLShortcut then begin
  1865. { Create the shortcut.
  1866. Note: Don't call PathExpand on any of the paths since they may contain
  1867. environment-variable strings (e.g. %SystemRoot%\...) }
  1868. ResultingFilename := CreateShellLink(LinkFilename, Description, Path,
  1869. Parameters, WorkingDir, IconFilename, IconIndex, ShowCmd, HotKey,
  1870. AppUserModelID, AppUserModelToastActivatorCLSID,
  1871. ExcludeFromShowInNewInstall, PreventPinning);
  1872. { If a .pif file was created, apply the "Close on exit" setting }
  1873. if (CloseOnExit <> icNoSetting) and
  1874. (CompareText(PathExtractExt(ResultingFilename), '.pif') = 0) then begin
  1875. try
  1876. ModifyPifFile(ResultingFilename, CloseOnExit = icYes);
  1877. except
  1878. { Failure isn't important here. Ignore exceptions }
  1879. end;
  1880. end;
  1881. end
  1882. else begin
  1883. { Create an Internet Shortcut (.url) file }
  1884. CreateURLFile(UrlFilename, Path, IconFilename, IconIndex);
  1885. ResultingFilename := UrlFilename;
  1886. end;
  1887. Log('Successfully created the icon.');
  1888. { Set the global flag that is checked by the Finished wizard page }
  1889. CreatedIcon := True;
  1890. { Notify shell of the change }
  1891. SHChangeNotify(SHCNE_CREATE, SHCNF_PATH, PChar(ResultingFilename), nil);
  1892. SHChangeNotify(SHCNE_UPDATEDIR, SHCNF_PATH or SHCNF_FLUSH,
  1893. PChar(PathExtractDir(ResultingFilename)), nil);
  1894. { Add uninstall log entries }
  1895. if not NeverUninstall then begin
  1896. if URLShortcut then
  1897. UninstLog.Add(utDeleteFile, [ResultingFilename], utDeleteFile_CallChangeNotify)
  1898. else begin
  1899. { Even though we only created one file, go ahead and try deleting
  1900. both a .lnk and .pif file at uninstall time, in case the user
  1901. alters the shortcut after installation }
  1902. UninstLog.Add(utDeleteFile, [LinkFilename], utDeleteFile_CallChangeNotify);
  1903. UninstLog.Add(utDeleteFile, [PifFilename], utDeleteFile_CallChangeNotify);
  1904. end;
  1905. end;
  1906. end;
  1907. function ExpandAppPath(const Filename: String): String;
  1908. var
  1909. K: HKEY;
  1910. Found: Boolean;
  1911. begin
  1912. if RegOpenKeyExView(InstallDefaultRegView, HKEY_LOCAL_MACHINE,
  1913. PChar(REGSTR_PATH_APPPATHS + '\' + Filename), 0, KEY_QUERY_VALUE, K) = ERROR_SUCCESS then begin
  1914. Found := RegQueryStringValue(K, '', Result);
  1915. RegCloseKey(K);
  1916. if Found then
  1917. Exit;
  1918. end;
  1919. Result := Filename;
  1920. end;
  1921. var
  1922. CurIconNumber: Integer;
  1923. CurIcon: PSetupIconEntry;
  1924. FN: String;
  1925. TACLSID: PGUID;
  1926. begin
  1927. for CurIconNumber := 0 to Entries[seIcon].Count-1 do begin
  1928. try
  1929. CurIcon := PSetupIconEntry(Entries[seIcon][CurIconNumber]);
  1930. with CurIcon^ do begin
  1931. if ShouldProcessIconEntry(WizardComponents, WizardTasks, WizardNoIcons, CurIcon) then begin
  1932. DebugNotifyEntry(seIcon, CurIconNumber);
  1933. NotifyBeforeInstallEntry(BeforeInstall);
  1934. Log('-- Icon entry --');
  1935. FN := ExpandConst(Filename);
  1936. if ioUseAppPaths in Options then
  1937. FN := ExpandAppPath(FN);
  1938. if not(ioCreateOnlyIfFileExists in Options) or NewFileExistsRedir(IsWin64, FN) then begin
  1939. if ioHasAppUserModelToastActivatorCLSID in Options then
  1940. TACLSID := @AppUserModelToastActivatorCLSID
  1941. else
  1942. TACLSID := nil;
  1943. CreateAnIcon(IconName, ExpandConst(Comment), FN,
  1944. ExpandConst(Parameters), ExpandConst(WorkingDir),
  1945. ExpandConst(IconFilename), IconIndex, ShowCmd,
  1946. ioUninsNeverUninstall in Options, CloseOnExit, HotKey,
  1947. ExpandConst(AppUserModelID), TACLSID,
  1948. ioExcludeFromShowInNewInstall in Options,
  1949. ioPreventPinning in Options)
  1950. end else
  1951. Log('Skipping due to "createonlyiffileexists" flag.');
  1952. { Increment progress meter }
  1953. IncProgress(1000);
  1954. NotifyAfterInstallEntry(AfterInstall);
  1955. end;
  1956. end;
  1957. except
  1958. if not(ExceptObject is EAbort) then
  1959. Application.HandleException(nil)
  1960. else
  1961. raise;
  1962. end;
  1963. ProcessEvents;
  1964. { Clear previous filename label in case an exception or debugger break
  1965. occurs between now and when the label for the next entry is set }
  1966. SetFilenameLabelText('', False);
  1967. end;
  1968. end;
  1969. procedure CreateIniEntries;
  1970. var
  1971. CurIniNumber: Integer;
  1972. CurIni: PSetupIniEntry;
  1973. IniSection, IniEntry, IniValue, IniFilename, IniDir: String;
  1974. Skip: Boolean;
  1975. begin
  1976. for CurIniNumber := 0 to Entries[seIni].Count-1 do begin
  1977. CurIni := PSetupIniEntry(Entries[seIni][CurIniNumber]);
  1978. with CurIni^ do begin
  1979. if ShouldProcessEntry(WizardComponents, WizardTasks, Components, Tasks, Languages, Check) then begin
  1980. DebugNotifyEntry(seIni, CurIniNumber);
  1981. NotifyBeforeInstallEntry(BeforeInstall);
  1982. Log('-- INI entry --');
  1983. IniSection := ExpandConst(Section);
  1984. IniEntry := ExpandConst(Entry);
  1985. IniValue := ExpandConst(Value);
  1986. IniFilename := ExpandConst(Filename);
  1987. LogFmt('Dest filename: %s', [IniFilename]);
  1988. LogFmt('Section: %s', [IniSection]);
  1989. if IniEntry <> '' then
  1990. LogFmt('Entry: %s', [IniEntry]);
  1991. if ioHasValue in Options then
  1992. LogFmt('Value: %s', [IniValue]);
  1993. if (IniEntry <> '') and (ioHasValue in Options) and
  1994. (not(ioCreateKeyIfDoesntExist in Options) or
  1995. not IniKeyExists(IniSection, IniEntry, IniFilename)) then begin
  1996. Skip := False;
  1997. IniDir := PathExtractDir(IniFilename);
  1998. if IniDir <> '' then begin
  1999. while True do begin
  2000. try
  2001. MakeDir(False, IniDir, []);
  2002. Break;
  2003. except
  2004. if AbortRetryIgnoreTaskDialogMsgBox(
  2005. GetExceptMessage,
  2006. [SetupMessages[msgAbortRetryIgnoreRetry], SetupMessages[msgAbortRetryIgnoreIgnore], SetupMessages[msgAbortRetryIgnoreCancel]]) then begin
  2007. Skip := True;
  2008. Break;
  2009. end;
  2010. end;
  2011. end;
  2012. end;
  2013. if not Skip then
  2014. Log('Updating the .INI file.');
  2015. repeat
  2016. if SetIniString(IniSection, IniEntry, IniValue, IniFilename) then begin
  2017. Log('Successfully updated the .INI file.');
  2018. Break;
  2019. end;
  2020. until AbortRetryIgnoreTaskDialogMsgBox(
  2021. FmtSetupMessage1(msgErrorIniEntry, IniFilename),
  2022. [SetupMessages[msgAbortRetryIgnoreRetry], SetupMessages[msgAbortRetryIgnoreIgnore], SetupMessages[msgAbortRetryIgnoreCancel]]);
  2023. end else
  2024. Log('Skipping updating the .INI file, only updating uninstall log.');
  2025. if ioUninsDeleteEntireSection in Options then
  2026. UninstLog.Add(utIniDeleteSection, [IniFilename, IniSection], 0);
  2027. if ioUninsDeleteSectionIfEmpty in Options then
  2028. UninstLog.Add(utIniDeleteSection, [IniFilename, IniSection],
  2029. utIniDeleteSection_OnlyIfEmpty);
  2030. if (ioUninsDeleteEntry in Options) and (IniEntry <> '') then
  2031. UninstLog.Add(utIniDeleteEntry, [IniFilename, IniSection, IniEntry], 0);
  2032. { ^ add utIniDeleteEntry last since we want it done first by the
  2033. uninstaller (in case the entry's also got the
  2034. "uninsdeletesectionifempty" flag) }
  2035. NotifyAfterInstallEntry(AfterInstall);
  2036. end;
  2037. end;
  2038. end;
  2039. { Increment progress meter }
  2040. IncProgress(1000);
  2041. end;
  2042. procedure CreateRegistryEntries;
  2043. function IsDeletableSubkey(const S: String): Boolean;
  2044. { A sanity check to prevent people from shooting themselves in the foot by
  2045. using
  2046. Root: HKLM; Subkey: ""; Flags: [unins]deletekey
  2047. or a 'code' constant in Subkey that returns a blank string or only
  2048. backslashes. }
  2049. var
  2050. P: PChar;
  2051. begin
  2052. Result := False;
  2053. P := PChar(S);
  2054. while P^ <> #0 do begin
  2055. if P^ <> '\' then begin
  2056. Result := True;
  2057. Break;
  2058. end;
  2059. Inc(P);
  2060. end;
  2061. end;
  2062. procedure ApplyPermissions(const RegView: TRegView; const RootKey: HKEY;
  2063. const Subkey: String; const PermsEntry: Integer);
  2064. var
  2065. P: PSetupPermissionEntry;
  2066. begin
  2067. LogFmt('Setting permissions on key: %s\%s',
  2068. [GetRegRootKeyName(RootKey), Subkey]);
  2069. P := Entries[sePermission][PermsEntry];
  2070. if not GrantPermissionOnKey(RegView, RootKey, Subkey,
  2071. TGrantPermissionEntry(Pointer(P.Permissions)^),
  2072. Length(P.Permissions) div SizeOf(TGrantPermissionEntry)) then begin
  2073. if GetLastError = ERROR_FILE_NOT_FOUND then
  2074. Log('Could not set permissions on the key because it currently does not exist.')
  2075. else
  2076. LogFmt('Failed to set permissions on the key (%d).', [GetLastError]);
  2077. end;
  2078. end;
  2079. const
  2080. REG_QWORD = 11;
  2081. var
  2082. RK, K: HKEY;
  2083. Disp: DWORD;
  2084. N, V, ExistingData: String;
  2085. ExistingType, NewType, DV: DWORD;
  2086. S: String;
  2087. RV: TRegView;
  2088. CurRegNumber: Integer;
  2089. NeedToRetry, DidDeleteKey: Boolean;
  2090. ErrorCode: Longint;
  2091. QV: Integer64;
  2092. I: Integer;
  2093. AnsiS: AnsiString;
  2094. begin
  2095. for CurRegNumber := 0 to Entries[seRegistry].Count-1 do begin
  2096. with PSetupRegistryEntry(Entries[seRegistry][CurRegNumber])^ do begin
  2097. if ShouldProcessEntry(WizardComponents, WizardTasks, Components, Tasks, Languages, Check) then begin
  2098. DebugNotifyEntry(seRegistry, CurRegNumber);
  2099. NotifyBeforeInstallEntry(BeforeInstall);
  2100. Log('-- Registry entry --');
  2101. RK := RootKey;
  2102. if RK = HKEY_AUTO then
  2103. RK := InstallModeRootKey;
  2104. S := ExpandConst(Subkey);
  2105. LogFmt('Key: %s\%s', [GetRegRootKeyName(RK), Subkey]);
  2106. N := ExpandConst(ValueName);
  2107. if N <> '' then
  2108. LogFmt('Value name: %s', [N]);
  2109. RV := InstallDefaultRegView;
  2110. if (ro32Bit in Options) and (RV <> rv32Bit) then begin
  2111. Log('Non-default bitness: 32-bit');
  2112. RV := rv32Bit;
  2113. end;
  2114. if ro64Bit in Options then begin
  2115. if not IsWin64 then
  2116. InternalError('Cannot access 64-bit registry keys on this version of Windows');
  2117. if RV <> rv64Bit then begin
  2118. Log('Non-default bitness: 64-bit');
  2119. RV := rv64Bit;
  2120. end;
  2121. end;
  2122. repeat
  2123. NeedToRetry := False;
  2124. try
  2125. DidDeleteKey := False;
  2126. if roDeleteKey in Options then begin
  2127. if IsDeletableSubkey(S) then begin
  2128. Log('Deleting the key.');
  2129. RegDeleteKeyIncludingSubkeys(RV, RK, PChar(S));
  2130. DidDeleteKey := True;
  2131. end else
  2132. Log('Key to delete is not deletable.');
  2133. end;
  2134. if (roDeleteKey in Options) and (Typ = rtNone) then begin
  2135. { We've deleted the key, and no value is to be created.
  2136. Our work is done. }
  2137. if DidDeleteKey then
  2138. Log('Successfully deleted the key.');
  2139. end else if (roDeleteValue in Options) and (Typ = rtNone) then begin
  2140. { We're going to delete a value with no intention of creating
  2141. another, so don't create the key if it didn't exist. }
  2142. if RegOpenKeyExView(RV, RK, PChar(S), 0, KEY_SET_VALUE, K) = ERROR_SUCCESS then begin
  2143. Log('Deleting the value.');
  2144. RegDeleteValue(K, PChar(N));
  2145. RegCloseKey(K);
  2146. Log('Successfully deleted the value.');
  2147. { Our work is done. }
  2148. end else
  2149. Log('Key of value to delete does not exist.');
  2150. end
  2151. else begin
  2152. { Apply any permissions *before* calling RegCreateKeyExView or
  2153. RegOpenKeyExView, since we may (in a rather unlikely scenario)
  2154. need those permissions in order for those calls to succeed }
  2155. if PermissionsEntry <> -1 then
  2156. ApplyPermissions(RV, RK, S, PermissionsEntry);
  2157. { Create or open the key }
  2158. if not(roDontCreateKey in Options) then begin
  2159. Log('Creating or opening the key.');
  2160. ErrorCode := RegCreateKeyExView(RV, RK, PChar(S), 0, nil,
  2161. REG_OPTION_NON_VOLATILE, KEY_QUERY_VALUE or KEY_SET_VALUE,
  2162. nil, K, @Disp);
  2163. if ErrorCode = ERROR_SUCCESS then begin
  2164. { Apply permissions again if a new key was created }
  2165. if (Disp = REG_CREATED_NEW_KEY) and (PermissionsEntry <> -1) then begin
  2166. Log('New key created, need to set permissions again.');
  2167. ApplyPermissions(RV, RK, S, PermissionsEntry);
  2168. end;
  2169. end
  2170. else begin
  2171. if not(roNoError in Options) then
  2172. RegError(reRegCreateKeyEx, RK, S, ErrorCode);
  2173. end;
  2174. end
  2175. else begin
  2176. if Typ <> rtNone then begin
  2177. Log('Opening the key.');
  2178. ErrorCode := RegOpenKeyExView(RV, RK, PChar(S), 0,
  2179. KEY_QUERY_VALUE or KEY_SET_VALUE, K);
  2180. if (ErrorCode <> ERROR_SUCCESS) and (ErrorCode <> ERROR_FILE_NOT_FOUND) then
  2181. if not(roNoError in Options) then
  2182. RegError(reRegOpenKeyEx, RK, S, ErrorCode);
  2183. end
  2184. else begin
  2185. { We're not creating a value, and we're not just deleting a
  2186. value (that was checked above), so there is no reason to
  2187. even open the key }
  2188. Log('Not creating the key or a value, skipping the key and only updating uninstall log.');
  2189. ErrorCode := ERROR_FILE_NOT_FOUND;
  2190. end;
  2191. end;
  2192. { If there was no error opening the key, proceed with deleting
  2193. and/or creating the value }
  2194. if ErrorCode = ERROR_SUCCESS then
  2195. try
  2196. if roDeleteValue in Options then begin
  2197. Log('Deleting the value.');
  2198. RegDeleteValue(K, PChar(N));
  2199. end;
  2200. if (Typ <> rtNone) and
  2201. (not(roCreateValueIfDoesntExist in Options) or
  2202. not RegValueExists(K, PChar(N))) then begin
  2203. Log('Creating or setting the value.');
  2204. case Typ of
  2205. rtString, rtExpandString, rtMultiString: begin
  2206. NewType := REG_SZ;
  2207. case Typ of
  2208. rtExpandString: NewType := REG_EXPAND_SZ;
  2209. rtMultiString: NewType := REG_MULTI_SZ;
  2210. end;
  2211. if Typ <> rtMultiString then begin
  2212. if (Pos('{olddata}', ValueData) <> 0) and
  2213. RegQueryStringValue(K, PChar(N), ExistingData) then
  2214. { successful }
  2215. else
  2216. ExistingData := '';
  2217. if roPreserveStringType in Options then begin
  2218. if (RegQueryValueEx(K, PChar(N), nil, @ExistingType, nil, nil) = ERROR_SUCCESS) and
  2219. ((ExistingType = REG_SZ) or (ExistingType = REG_EXPAND_SZ)) then
  2220. NewType := ExistingType;
  2221. end;
  2222. V := ExpandConstEx(ValueData, ['olddata', ExistingData])
  2223. end
  2224. else begin
  2225. if (Pos('{olddata}', ValueData) <> 0) and
  2226. RegQueryMultiStringValue(K, PChar(N), ExistingData) then
  2227. { successful }
  2228. else
  2229. ExistingData := '';
  2230. V := ExpandConstEx(ValueData, ['olddata', ExistingData,
  2231. 'break', #0]);
  2232. { Multi-string data requires two null terminators:
  2233. one after the last string, and one to mark the end.
  2234. Delphi's String type is implicitly null-terminated,
  2235. so only one null needs to be added to the end. }
  2236. if (V <> '') and (V[Length(V)] <> #0) then
  2237. V := V + #0;
  2238. end;
  2239. ErrorCode := RegSetValueEx(K, PChar(N), 0, NewType,
  2240. PChar(V), (Length(V)+1)*SizeOf(V[1]));
  2241. if (ErrorCode <> ERROR_SUCCESS) and
  2242. not(roNoError in Options) then
  2243. RegError(reRegSetValueEx, RK, S, ErrorCode);
  2244. end;
  2245. rtDWord: begin
  2246. DV := StrToInt(ExpandConst(ValueData));
  2247. ErrorCode := RegSetValueEx(K, PChar(N), 0, REG_DWORD,
  2248. @DV, SizeOf(DV));
  2249. if (ErrorCode <> ERROR_SUCCESS) and
  2250. not(roNoError in Options) then
  2251. RegError(reRegSetValueEx, RK, S, ErrorCode);
  2252. end;
  2253. rtQWord: begin
  2254. if not StrToInteger64(ExpandConst(ValueData), QV) then
  2255. InternalError('Failed to parse "qword" value');
  2256. ErrorCode := RegSetValueEx(K, PChar(N), 0, REG_QWORD,
  2257. @TLargeInteger(QV), SizeOf(TLargeInteger(QV)));
  2258. if (ErrorCode <> ERROR_SUCCESS) and
  2259. not(roNoError in Options) then
  2260. RegError(reRegSetValueEx, RK, S, ErrorCode);
  2261. end;
  2262. rtBinary: begin
  2263. AnsiS := '';
  2264. for I := 1 to Length(ValueData) do
  2265. AnsiS := AnsiS + AnsiChar(Ord(ValueData[I]));
  2266. ErrorCode := RegSetValueEx(K, PChar(N), 0, REG_BINARY,
  2267. PAnsiChar(AnsiS), Length(AnsiS));
  2268. if (ErrorCode <> ERROR_SUCCESS) and
  2269. not(roNoError in Options) then
  2270. RegError(reRegSetValueEx, RK, S, ErrorCode);
  2271. end;
  2272. end;
  2273. Log('Successfully created or set the value.');
  2274. end else if roDeleteValue in Options then
  2275. Log('Successfully deleted the value.')
  2276. else
  2277. Log('Successfully created the key.')
  2278. { Our work is done. }
  2279. finally
  2280. RegCloseKey(K);
  2281. end;
  2282. end;
  2283. except
  2284. if not AbortRetryIgnoreTaskDialogMsgBox(
  2285. GetExceptMessage,
  2286. [SetupMessages[msgAbortRetryIgnoreRetry], SetupMessages[msgAbortRetryIgnoreIgnore], SetupMessages[msgAbortRetryIgnoreCancel]]) then begin
  2287. Log('Retrying.');
  2288. NeedToRetry := True;
  2289. end;
  2290. end;
  2291. until not NeedToRetry;
  2292. if roUninsDeleteEntireKey in Options then
  2293. if IsDeletableSubkey(S) then
  2294. UninstLog.AddReg(utRegDeleteEntireKey, RV, RK, [S]);
  2295. if roUninsDeleteEntireKeyIfEmpty in Options then
  2296. if IsDeletableSubkey(S) then
  2297. UninstLog.AddReg(utRegDeleteKeyIfEmpty, RV, RK, [S]);
  2298. if roUninsDeleteValue in Options then
  2299. UninstLog.AddReg(utRegDeleteValue, RV, RK, [S, N]);
  2300. { ^ must add roUninsDeleteValue after roUninstDeleteEntireKey*
  2301. since the entry may have both the roUninsDeleteValue and
  2302. roUninsDeleteEntireKeyIfEmpty options }
  2303. if roUninsClearValue in Options then
  2304. UninstLog.AddReg(utRegClearValue, RV, RK, [S, N]);
  2305. NotifyAfterInstallEntry(AfterInstall);
  2306. end;
  2307. end;
  2308. end;
  2309. { Increment progress meter }
  2310. IncProgress(1000);
  2311. end;
  2312. procedure RegisterFiles;
  2313. procedure RegisterServersOnRestart;
  2314. function CreateRegSvrExe(const Dir: String): String;
  2315. var
  2316. ExeFilename: String;
  2317. SourceF, DestF: TFile;
  2318. NumRead: Cardinal;
  2319. Buf: array[0..16383] of Byte;
  2320. begin
  2321. ExeFilename := GenerateUniqueName(False, Dir, '.exe');
  2322. DestF := nil;
  2323. SourceF := TFile.Create(NewParamStr(0), fdOpenExisting, faRead, fsRead);
  2324. try
  2325. DestF := TFile.Create(ExeFilename, fdCreateAlways, faWrite, fsNone);
  2326. try
  2327. DestF.Seek64(SourceF.Size);
  2328. DestF.Truncate;
  2329. DestF.Seek(0);
  2330. while True do begin
  2331. NumRead := SourceF.Read(Buf, SizeOf(Buf));
  2332. if NumRead = 0 then
  2333. Break;
  2334. DestF.WriteBuffer(Buf, NumRead);
  2335. end;
  2336. if not(shSignedUninstaller in SetupHeader.Options) then
  2337. MarkExeHeader(DestF, SetupExeModeRegSvr);
  2338. except
  2339. FreeAndNil(DestF);
  2340. DeleteFile(ExeFilename);
  2341. raise;
  2342. end;
  2343. finally
  2344. DestF.Free;
  2345. SourceF.Free;
  2346. end;
  2347. Result := ExeFilename;
  2348. end;
  2349. procedure CreateRegSvrMsg(const Filename: String);
  2350. var
  2351. F: TFile;
  2352. begin
  2353. F := TFile.Create(Filename, fdCreateAlways, faWrite, fsNone);
  2354. try
  2355. WriteMsgData(F);
  2356. finally
  2357. F.Free;
  2358. end;
  2359. end;
  2360. const
  2361. Chars: array[Boolean, Boolean] of Char = (('s', 't'), ('S', 'T'));
  2362. var
  2363. RegSvrExeFilename: String;
  2364. F: TTextFileWriter;
  2365. Rec: PRegisterFilesListRec;
  2366. RootKey, H: HKEY;
  2367. I, J: Integer;
  2368. Disp: DWORD;
  2369. ValueName, Data: String;
  2370. ErrorCode: Longint;
  2371. begin
  2372. { Create RegSvr program used to register OLE servers & type libraries on
  2373. the next reboot }
  2374. if IsAdmin then begin
  2375. try
  2376. RegSvrExeFilename := CreateRegSvrExe(WinDir);
  2377. except
  2378. { In case Windows directory is write protected, try the Temp directory.
  2379. Windows directory is our first choice since some people (ignorantly)
  2380. put things like "DELTREE C:\WINDOWS\TEMP\*.*" in their AUTOEXEC.BAT.
  2381. Also, each user has his own personal Temp directory which may not
  2382. be accessible by other users. }
  2383. RegSvrExeFilename := CreateRegSvrExe(GetTempDir);
  2384. end;
  2385. end
  2386. else begin
  2387. { Always use Temp directory when user doesn't have admin privileges }
  2388. RegSvrExeFilename := CreateRegSvrExe(GetTempDir);
  2389. end;
  2390. LogFmt('Registration executable created: %s', [RegSvrExeFilename]);
  2391. try
  2392. CreateRegSvrMsg(PathChangeExt(RegSvrExeFilename, '.msg'));
  2393. F := TTextFileWriter.Create(PathChangeExt(RegSvrExeFilename, '.lst'),
  2394. fdCreateAlways, faWrite, fsNone);
  2395. try
  2396. F.WriteLine('; This file was created by the installer for:');
  2397. F.WriteLine('; ' + ExpandedAppVerName);
  2398. F.WriteLine('; Location: ' + SetupLdrOriginalFilename);
  2399. F.WriteLine('');
  2400. F.WriteLine('; List of files to be registered on the next reboot. DO NOT EDIT!');
  2401. F.WriteLine('');
  2402. for I := 0 to RegisterFilesList.Count-1 do begin
  2403. Rec := RegisterFilesList[I];
  2404. Data := '[..]' + Rec.Filename;
  2405. Data[2] := Chars[Rec.Is64Bit, Rec.TypeLib];
  2406. if Rec.NoErrorMessages then
  2407. Data[3] := 'q';
  2408. F.WriteLine(Data);
  2409. end;
  2410. finally
  2411. F.Free;
  2412. end;
  2413. if IsAdmin then
  2414. RootKey := HKEY_LOCAL_MACHINE
  2415. else
  2416. RootKey := HKEY_CURRENT_USER;
  2417. ErrorCode := RegCreateKeyExView(rvDefault, RootKey, REGSTR_PATH_RUNONCE, 0, nil,
  2418. REG_OPTION_NON_VOLATILE, KEY_SET_VALUE or KEY_QUERY_VALUE,
  2419. nil, H, @Disp);
  2420. if ErrorCode <> ERROR_SUCCESS then
  2421. RegError(reRegCreateKeyEx, RootKey, REGSTR_PATH_RUNONCE, ErrorCode);
  2422. try
  2423. J := 0;
  2424. while True do begin
  2425. Inc(J);
  2426. ValueName := Format('InnoSetupRegFile.%.10d', [J]); { don't localize }
  2427. { ^ Note: Names of values written to the "RunOnce" key cannot
  2428. exceed 31 characters! Otherwise the original Windows
  2429. Explorer 4.0 will not process them. }
  2430. if not RegValueExists(H, PChar(ValueName)) then begin
  2431. Data := '"' + RegSvrExeFilename + '" /REG';
  2432. if not IsAdmin then
  2433. Data := Data + 'U'; { /REG -> /REGU when not running as admin }
  2434. { Note: RegSvr expects /REG(U) to be the first parameter }
  2435. Data := Data + ' /REGSVRMODE';
  2436. ErrorCode := RegSetValueEx(H, PChar(ValueName), 0, REG_SZ, PChar(Data),
  2437. (Length(Data)+1)*SizeOf(Data[1]));
  2438. if ErrorCode <> ERROR_SUCCESS then
  2439. RegError(reRegSetValueEx, RootKey, REGSTR_PATH_RUNONCE, ErrorCode);
  2440. Break;
  2441. end;
  2442. end;
  2443. finally
  2444. RegCloseKey(H);
  2445. end;
  2446. except
  2447. DeleteFile(PathChangeExt(RegSvrExeFilename, '.lst'));
  2448. DeleteFile(PathChangeExt(RegSvrExeFilename, '.msg'));
  2449. DeleteFile(RegSvrExeFilename);
  2450. raise;
  2451. end;
  2452. end;
  2453. procedure RegisterSvr(const Is64Bit: Boolean; const Filename: String;
  2454. const NoErrorMessages: Boolean);
  2455. var
  2456. NeedToRetry: Boolean;
  2457. begin
  2458. repeat
  2459. if Is64Bit then
  2460. LogFmt('Registering 64-bit DLL/OCX: %s', [Filename])
  2461. else
  2462. LogFmt('Registering 32-bit DLL/OCX: %s', [Filename]);
  2463. NeedToRetry := False;
  2464. try
  2465. RegisterServer(False, Is64Bit, Filename, NoErrorMessages);
  2466. Log('Registration successful.');
  2467. except
  2468. Log('Registration failed:' + SNewLine + GetExceptMessage);
  2469. if not NoErrorMessages then
  2470. if not AbortRetryIgnoreTaskDialogMsgBox(
  2471. Filename + SNewLine2 + FmtSetupMessage1(msgErrorRegisterServer, GetExceptMessage),
  2472. [SetupMessages[msgAbortRetryIgnoreRetry], SetupMessages[msgFileAbortRetryIgnoreIgnoreNotRecommended], SetupMessages[msgAbortRetryIgnoreCancel]]) then
  2473. NeedToRetry := True;
  2474. end;
  2475. until not NeedToRetry;
  2476. end;
  2477. procedure RegisterTLib(const Is64Bit: Boolean; const Filename: String;
  2478. const NoErrorMessages: Boolean);
  2479. var
  2480. NeedToRetry: Boolean;
  2481. begin
  2482. repeat
  2483. if Is64Bit then
  2484. LogFmt('Registering 64-bit type library: %s', [Filename])
  2485. else
  2486. LogFmt('Registering 32-bit type library: %s', [Filename]);
  2487. NeedToRetry := False;
  2488. try
  2489. if Is64Bit then
  2490. HelperRegisterTypeLibrary(False, Filename)
  2491. else
  2492. RegisterTypeLibrary(Filename);
  2493. Log('Registration successful.');
  2494. except
  2495. Log('Registration failed:' + SNewLine + GetExceptMessage);
  2496. if not NoErrorMessages then
  2497. if not AbortRetryIgnoreTaskDialogMsgBox(
  2498. Filename + SNewLine2 + FmtSetupMessage1(msgErrorRegisterTypeLib, GetExceptMessage),
  2499. [SetupMessages[msgAbortRetryIgnoreRetry], SetupMessages[msgFileAbortRetryIgnoreIgnoreNotRecommended], SetupMessages[msgAbortRetryIgnoreCancel]]) then
  2500. NeedToRetry := True;
  2501. end;
  2502. until not NeedToRetry;
  2503. end;
  2504. var
  2505. I: Integer;
  2506. begin
  2507. if not NeedsRestart then
  2508. for I := 0 to RegisterFilesList.Count-1 do begin
  2509. with PRegisterFilesListRec(RegisterFilesList[I])^ do
  2510. if not TypeLib then
  2511. RegisterSvr(Is64Bit, Filename, NoErrorMessages)
  2512. else
  2513. RegisterTLib(Is64Bit, Filename, NoErrorMessages);
  2514. end
  2515. else begin
  2516. { When a restart is needed, all "regserver" & "regtypelib" files will get
  2517. registered on the next logon }
  2518. Log('Delaying registration of all files until the next logon since a restart is needed.');
  2519. try
  2520. RegisterServersOnRestart;
  2521. except
  2522. Application.HandleException(nil);
  2523. end;
  2524. end;
  2525. end;
  2526. procedure ProcessInstallDeleteEntries;
  2527. var
  2528. I: Integer;
  2529. begin
  2530. for I := 0 to Entries[seInstallDelete].Count-1 do
  2531. with PSetupDeleteEntry(Entries[seInstallDelete][I])^ do
  2532. if ShouldProcessEntry(WizardComponents, WizardTasks, Components, Tasks, Languages, Check) then begin
  2533. DebugNotifyEntry(seInstallDelete, I);
  2534. NotifyBeforeInstallEntry(BeforeInstall);
  2535. case DeleteType of
  2536. dfFiles, dfFilesAndOrSubdirs:
  2537. DelTree(InstallDefaultDisableFsRedir, ExpandConst(Name), False, True, DeleteType = dfFilesAndOrSubdirs, False,
  2538. nil, nil, nil);
  2539. dfDirIfEmpty:
  2540. DelTree(InstallDefaultDisableFsRedir, ExpandConst(Name), True, False, False, False, nil, nil, nil);
  2541. end;
  2542. NotifyAfterInstallEntry(AfterInstall);
  2543. end;
  2544. end;
  2545. procedure RecordUninstallDeleteEntries;
  2546. const
  2547. DefFlags: array[TSetupDeleteType] of Longint = (
  2548. utDeleteDirOrFiles_Extra or utDeleteDirOrFiles_DeleteFiles,
  2549. utDeleteDirOrFiles_Extra or utDeleteDirOrFiles_DeleteFiles or
  2550. utDeleteDirOrFiles_DeleteSubdirsAlso,
  2551. utDeleteDirOrFiles_Extra or utDeleteDirOrFiles_IsDir);
  2552. var
  2553. I: Integer;
  2554. Flags: Longint;
  2555. begin
  2556. for I := Entries[seUninstallDelete].Count-1 downto 0 do
  2557. { ^ process backwards so the uninstaller will process them in the order
  2558. they appear in the script }
  2559. with PSetupDeleteEntry(Entries[seUninstallDelete][I])^ do
  2560. if ShouldProcessEntry(WizardComponents, WizardTasks, Components, Tasks, Languages, Check) then begin
  2561. DebugNotifyEntry(seUninstallDelete, I);
  2562. NotifyBeforeInstallEntry(BeforeInstall);
  2563. Flags := DefFlags[DeleteType];
  2564. if InstallDefaultDisableFsRedir then
  2565. Flags := Flags or utDeleteDirOrFiles_DisableFsRedir;
  2566. UninstLog.Add(utDeleteDirOrFiles, [ExpandConst(Name)], Flags);
  2567. NotifyAfterInstallEntry(AfterInstall);
  2568. end;
  2569. end;
  2570. procedure RecordUninstallRunEntries;
  2571. var
  2572. I: Integer;
  2573. RunEntry: PSetupRunEntry;
  2574. Flags: Longint;
  2575. begin
  2576. for I := Entries[seUninstallRun].Count-1 downto 0 do begin
  2577. { ^ process backwards so the uninstaller will process them in the order
  2578. they appear in the script }
  2579. RunEntry := PSetupRunEntry(Entries[seUninstallRun][I]);
  2580. if ShouldProcessEntry(WizardComponents, WizardTasks, RunEntry.Components,
  2581. RunEntry.Tasks, RunEntry.Languages, RunEntry.Check) then begin
  2582. DebugNotifyEntry(seUninstallRun, I);
  2583. NotifyBeforeInstallEntry(RunEntry.BeforeInstall);
  2584. Flags := 0;
  2585. case RunEntry.Wait of
  2586. rwNoWait: Flags := Flags or utRun_NoWait;
  2587. rwWaitUntilIdle: Flags := Flags or utRun_WaitUntilIdle;
  2588. end;
  2589. if roShellExec in RunEntry.Options then
  2590. Flags := Flags or (utRun_ShellExec or utRun_ShellExecRespectWaitFlags)
  2591. else begin
  2592. if ShouldDisableFsRedirForRunEntry(RunEntry) then
  2593. Flags := Flags or utRun_DisableFsRedir;
  2594. end;
  2595. if roSkipIfDoesntExist in RunEntry.Options then
  2596. Flags := Flags or utRun_SkipIfDoesntExist;
  2597. case RunEntry.ShowCmd of
  2598. SW_SHOWMINNOACTIVE: Flags := Flags or utRun_RunMinimized;
  2599. SW_SHOWMAXIMIZED: Flags := Flags or utRun_RunMaximized;
  2600. SW_HIDE: Flags := Flags or utRun_RunHidden;
  2601. end;
  2602. if roDontLogParameters in RunEntry.Options then
  2603. Flags := Flags or utRun_DontLogParameters;
  2604. UninstLog.Add(utRun, [ExpandConst(RunEntry.Name),
  2605. ExpandConst(RunEntry.Parameters), ExpandConst(RunEntry.WorkingDir),
  2606. ExpandConst(RunEntry.RunOnceId), ExpandConst(RunEntry.Verb)],
  2607. Flags);
  2608. NotifyAfterInstallEntry(RunEntry.AfterInstall);
  2609. end;
  2610. end;
  2611. end;
  2612. procedure GenerateUninstallInfoFilename;
  2613. var
  2614. ExistingFiles: array[0..999] of Boolean;
  2615. BaseDir: String;
  2616. procedure FindFiles;
  2617. var
  2618. H: THandle;
  2619. FindData: TWin32FindData;
  2620. S: String;
  2621. begin
  2622. H := FindFirstFile(PChar(AddBackslash(BaseDir) + 'unins???.*'),
  2623. FindData);
  2624. if H <> INVALID_HANDLE_VALUE then begin
  2625. repeat
  2626. S := FindData.cFilename;
  2627. if (Length(S) >= 9) and (CompareText(Copy(S, 1, 5), 'unins') = 0) and
  2628. CharInSet(S[6], ['0'..'9']) and CharInSet(S[7], ['0'..'9']) and CharInSet(S[8], ['0'..'9']) and
  2629. (S[9] = '.') then
  2630. ExistingFiles[StrToInt(Copy(S, 6, 3))] := True;
  2631. until not FindNextFile(H, FindData);
  2632. Windows.FindClose(H);
  2633. end;
  2634. end;
  2635. procedure GenerateFilenames(const I: Integer);
  2636. var
  2637. BaseFilename: String;
  2638. begin
  2639. BaseFilename := AddBackslash(BaseDir) + Format('unins%.3d', [I]);
  2640. UninstallExeFilename := BaseFilename + '.exe';
  2641. UninstallDataFilename := BaseFilename + '.dat';
  2642. UninstallMsgFilename := BaseFilename + '.msg';
  2643. end;
  2644. procedure ReserveDataFile;
  2645. var
  2646. H: THandle;
  2647. begin
  2648. { Create an empty .dat file to reserve the filename. }
  2649. H := CreateFile(PChar(UninstallDataFilename), GENERIC_READ or GENERIC_WRITE,
  2650. 0, nil, CREATE_NEW, FILE_ATTRIBUTE_NORMAL, 0);
  2651. if H = INVALID_HANDLE_VALUE then
  2652. Win32ErrorMsg('CreateFile');
  2653. CloseHandle(H);
  2654. UninstallDataCreated := True;
  2655. end;
  2656. var
  2657. I: Integer;
  2658. ExistingFlags: TUninstallLogFlags;
  2659. begin
  2660. { Note: We never disable FS redirection when writing to UninstallFilesDir.
  2661. If someone sets UninstallFilesDir to "sys", we can't place a 32-bit
  2662. uninstaller in the 64-bit system directory, because it wouldn't see its
  2663. .dat file -- it would try to open 'windows\system32\unins???.dat' but
  2664. fail because system32 maps to syswow64 by default.
  2665. Not to mention, 32-bit EXEs really have no business being in the 64-bit
  2666. system directory, and vice versa. Might result in undefined behavior? }
  2667. { Because we don't disable FS redirection, we have to change any system32
  2668. to syswow64, otherwise Add/Remove Programs would look for the
  2669. UninstallString executable in the 64-bit system directory (at least
  2670. when using a 64-bit Uninstall key) }
  2671. BaseDir := ReplaceSystemDirWithSysWow64(PathExpand(ExpandConst(SetupHeader.UninstallFilesDir)));
  2672. LogFmt('Directory for uninstall files: %s', [BaseDir]);
  2673. MakeDir(False, BaseDir, []);
  2674. FillChar(ExistingFiles, SizeOf(ExistingFiles), 0); { set all to False }
  2675. FindFiles;
  2676. { Look for an existing .dat file to append to or overwrite }
  2677. if SetupHeader.UninstallLogMode <> lmNew then
  2678. for I := 0 to 999 do
  2679. if ExistingFiles[I] then begin
  2680. GenerateFilenames(I);
  2681. if NewFileExists(UninstallDataFilename) and
  2682. UninstLog.CanAppend(UninstallDataFilename, ExistingFlags) then begin
  2683. if SetupHeader.UninstallLogMode = lmAppend then begin
  2684. LogFmt('Will append to existing uninstall log: %s', [UninstallDataFilename]);
  2685. AppendUninstallData := True;
  2686. end
  2687. else
  2688. LogFmt('Will overwrite existing uninstall log: %s', [UninstallDataFilename]);
  2689. Exit;
  2690. end;
  2691. end;
  2692. { None found; use a new .dat file }
  2693. for I := 0 to 999 do
  2694. if not ExistingFiles[I] then begin
  2695. GenerateFilenames(I);
  2696. LogFmt('Creating new uninstall log: %s', [UninstallDataFilename]);
  2697. ReserveDataFile;
  2698. Exit;
  2699. end;
  2700. raise Exception.Create(FmtSetupMessage1(msgErrorTooManyFilesInDir,
  2701. BaseDir));
  2702. end;
  2703. procedure RenameUninstallExe;
  2704. var
  2705. RetriesLeft: Integer;
  2706. Timer: TOneShotTimer;
  2707. LastError: DWORD;
  2708. begin
  2709. { If the uninstall EXE wasn't extracted to a .tmp file because it isn't
  2710. replacing an existing uninstall EXE, exit. }
  2711. if UninstallTempExeFilename = '' then
  2712. Exit;
  2713. Log('Renaming uninstaller.');
  2714. RetriesLeft := 4;
  2715. while True do begin
  2716. Timer.Start(1000);
  2717. if MoveFileReplace(UninstallTempExeFilename, UninstallExeFilename) then
  2718. Break;
  2719. LastError := GetLastError;
  2720. { Does the error code indicate that the file is possibly in use? }
  2721. if LastErrorIndicatesPossiblyInUse(LastError, False) then begin
  2722. if RetriesLeft > 0 then begin
  2723. LogFmt('The existing file appears to be in use (%d). ' +
  2724. 'Retrying.', [LastError]);
  2725. Dec(RetriesLeft);
  2726. Timer.SleepUntilExpired;
  2727. ProcessEvents;
  2728. Continue;
  2729. end;
  2730. end;
  2731. case LoggedMsgBox(UninstallExeFilename + SNewLine2 +
  2732. SetupMessages[msgErrorReplacingExistingFile] + SNewLine2 +
  2733. AddPeriod(FmtSetupMessage(msgErrorFunctionFailedWithMessage,
  2734. ['MoveFileEx', IntToStr(LastError), Win32ErrorString(LastError)])),
  2735. '', mbError, MB_RETRYCANCEL, True, IDCANCEL) of
  2736. IDRETRY: ;
  2737. IDCANCEL: Abort;
  2738. else
  2739. Log('LoggedMsgBox returned an unexpected value. Assuming Cancel.');
  2740. Abort;
  2741. end;
  2742. end;
  2743. UninstallTempExeFilename := '';
  2744. end;
  2745. procedure CreateUninstallMsgFile;
  2746. { If the uninstaller EXE has a digital signature, or if Setup was started
  2747. with /DETACHEDMSG, create the unins???.msg file }
  2748. var
  2749. F: TFile;
  2750. begin
  2751. { If this installation didn't create or replace an unins???.exe file,
  2752. do nothing }
  2753. if (UninstallExeCreated <> ueNone) and
  2754. ((shSignedUninstaller in SetupHeader.Options) or DetachedUninstMsgFile) then begin
  2755. LogFmt('Writing uninstaller messages: %s', [UninstallMsgFilename]);
  2756. F := TFile.Create(UninstallMsgFilename, fdCreateAlways, faWrite, fsNone);
  2757. try
  2758. if UninstallExeCreated = ueNew then
  2759. UninstallMsgCreated := True;
  2760. WriteMsgData(F);
  2761. finally
  2762. F.Free;
  2763. end;
  2764. end;
  2765. end;
  2766. procedure ProcessNeedRestartEvent;
  2767. begin
  2768. if (CodeRunner <> nil) and CodeRunner.FunctionExists('NeedRestart', True) then begin
  2769. if not NeedsRestart then begin
  2770. try
  2771. if CodeRunner.RunBooleanFunctions('NeedRestart', [''], bcTrue, False, False) then begin
  2772. NeedsRestart := True;
  2773. Log('Will restart because NeedRestart returned True.');
  2774. end;
  2775. except
  2776. Log('NeedRestart raised an exception.');
  2777. Application.HandleException(nil);
  2778. end;
  2779. end
  2780. else
  2781. Log('Not calling NeedRestart because a restart has already been deemed necessary.');
  2782. end;
  2783. end;
  2784. procedure ProcessComponentEntries;
  2785. var
  2786. I: Integer;
  2787. begin
  2788. for I := 0 to Entries[seComponent].Count-1 do begin
  2789. with PSetupComponentEntry(Entries[seComponent][I])^ do begin
  2790. if ShouldProcessEntry(WizardComponents, nil, Name, '', Languages, '') and (coRestart in Options) then begin
  2791. NeedsRestart := True;
  2792. Break;
  2793. end;
  2794. end;
  2795. end;
  2796. end;
  2797. procedure ProcessTasksEntries;
  2798. var
  2799. I: Integer;
  2800. begin
  2801. for I := 0 to Entries[seTask].Count-1 do begin
  2802. with PSetupTaskEntry(Entries[seTask][I])^ do begin
  2803. if ShouldProcessEntry(nil, WizardTasks, '', Name, Languages, '') and (toRestart in Options) then begin
  2804. NeedsRestart := True;
  2805. Break;
  2806. end;
  2807. end;
  2808. end;
  2809. end;
  2810. procedure ShutdownApplications;
  2811. const
  2812. ERROR_FAIL_SHUTDOWN = 351;
  2813. ForcedStrings: array [Boolean] of String = ('', ' (forced)');
  2814. ForcedActionFlag: array [Boolean] of ULONG = (0, RmForceShutdown);
  2815. var
  2816. Forced: Boolean;
  2817. Error: DWORD;
  2818. begin
  2819. Forced := InitForceCloseApplications or
  2820. ((shForceCloseApplications in SetupHeader.Options) and not InitNoForceCloseApplications);
  2821. Log('Shutting down applications using our files.' + ForcedStrings[Forced]);
  2822. RmDoRestart := True;
  2823. Error := RmShutdown(RmSessionHandle, ForcedActionFlag[Forced], nil);
  2824. while Error = ERROR_FAIL_SHUTDOWN do begin
  2825. Log('Some applications could not be shut down.');
  2826. if AbortRetryIgnoreTaskDialogMsgBox(
  2827. SetupMessages[msgErrorCloseApplications],
  2828. [SetupMessages[msgAbortRetryIgnoreRetry], SetupMessages[msgAbortRetryIgnoreIgnore], SetupMessages[msgAbortRetryIgnoreCancel]]) then
  2829. Break;
  2830. Log('Retrying to shut down applications using our files.' + ForcedStrings[Forced]);
  2831. Error := RmShutdown(RmSessionHandle, ForcedActionFlag[Forced], nil);
  2832. end;
  2833. { Close session on all errors except for ERROR_FAIL_SHUTDOWN, should still call RmRestart in that case. }
  2834. if (Error <> ERROR_SUCCESS) and (Error <> ERROR_FAIL_SHUTDOWN) then begin
  2835. RmEndSession(RmSessionHandle);
  2836. LogFmt('RmShutdown returned an error: %d', [Error]);
  2837. RmDoRestart := False;
  2838. end;
  2839. end;
  2840. var
  2841. Uninstallable, UninstLogCleared: Boolean;
  2842. I: Integer;
  2843. UninstallRegKeyBaseName: String;
  2844. InstallFilesSize, AfterInstallFilesSize: Integer64;
  2845. begin
  2846. Succeeded := False;
  2847. Log('Starting the installation process.');
  2848. SetCurrentDir(WinSystemDir);
  2849. CalcFilesSize(InstallFilesSize, AfterInstallFilesSize);
  2850. InitProgressGauge(InstallFilesSize);
  2851. UninstallExeCreated := ueNone;
  2852. UninstallDataCreated := False;
  2853. UninstallMsgCreated := False;
  2854. AppendUninstallData := False;
  2855. UninstLogCleared := False;
  2856. RegisterFilesList := nil;
  2857. UninstLog := TSetupUninstallLog.Create;
  2858. try
  2859. try
  2860. { Get AppId, UninstallRegKeyBaseName, and Uninstallable now so the user
  2861. can't change them while we're installing }
  2862. ExpandedAppId := ExpandConst(SetupHeader.AppId);
  2863. if ExpandedAppId = '' then
  2864. InternalError('Failed to get a non empty installation "AppId"');
  2865. if TUninstallLog.WriteSafeHeaderString(nil, ExpandedAppId, 0) > 128 then
  2866. InternalError('"AppId" cannot exceed 128 bytes (encoded)');
  2867. UninstallRegKeyBaseName := GetUninstallRegKeyBaseName(ExpandedAppId);
  2868. Uninstallable := EvalDirectiveCheck(SetupHeader.Uninstallable);
  2869. { Init }
  2870. UninstLog.InstallMode64Bit := Is64BitInstallMode;
  2871. UninstLog.AppName := ExpandedAppName;
  2872. UninstLog.AppId := ExpandedAppId;
  2873. if IsAdminInstallMode then
  2874. Include(UninstLog.Flags, ufAdminInstallMode);
  2875. if IsWin64 then
  2876. Include(UninstLog.Flags, ufWin64);
  2877. if IsAdmin then { Setup or [Code] might have done administrative actions, even if IsAdminInstallMode is False }
  2878. Include(UninstLog.Flags, ufAdminInstalled)
  2879. else if IsPowerUserOrAdmin then
  2880. { Note: This flag is only set in 5.1.9 and later }
  2881. Include(UninstLog.Flags, ufPowerUserInstalled);
  2882. if SetupHeader.WizardStyle = wsModern then
  2883. Include(UninstLog.Flags, ufModernStyle);
  2884. if shUninstallRestartComputer in SetupHeader.Options then
  2885. Include(UninstLog.Flags, ufAlwaysRestart);
  2886. if ChangesEnvironment then
  2887. Include(UninstLog.Flags, ufChangesEnvironment);
  2888. RecordStartInstall;
  2889. RecordCompiledCode;
  2890. RegisterFilesList := TList.Create;
  2891. { Process Component entries, if any }
  2892. ProcessComponentEntries;
  2893. ProcessEvents;
  2894. { Process Tasks entries, if any }
  2895. ProcessTasksEntries;
  2896. ProcessEvents;
  2897. { Shutdown applications, if any }
  2898. if RmSessionStarted and RmFoundApplications then begin
  2899. if WizardPreparingYesRadio then begin
  2900. SetStatusLabelText(SetupMessages[msgStatusClosingApplications]);
  2901. ShutdownApplications;
  2902. ProcessEvents;
  2903. end else
  2904. Log('User chose not to shutdown applications using our files.');
  2905. end;
  2906. { Process InstallDelete entries, if any }
  2907. ProcessInstallDeleteEntries;
  2908. ProcessEvents;
  2909. if ExpandedAppMutex <> '' then
  2910. UninstLog.Add(utMutexCheck, [ExpandedAppMutex], 0);
  2911. if ChangesAssociations then
  2912. UninstLog.Add(utRefreshFileAssoc, [''], 0);
  2913. { Record UninstallDelete entries, if any }
  2914. RecordUninstallDeleteEntries;
  2915. ProcessEvents;
  2916. { Create the application directory and extra dirs }
  2917. SetStatusLabelText(SetupMessages[msgStatusCreateDirs]);
  2918. CreateDirs;
  2919. ProcessEvents;
  2920. if Uninstallable then begin
  2921. { Generate the filenames for the uninstall info in the application
  2922. directory }
  2923. SetStatusLabelText(SetupMessages[msgStatusSavingUninstall]);
  2924. GenerateUninstallInfoFilename;
  2925. end;
  2926. { Copy the files }
  2927. SetStatusLabelText(SetupMessages[msgStatusExtractFiles]);
  2928. CopyFiles(Uninstallable);
  2929. ProcessEvents;
  2930. { Create program icons, if any }
  2931. if HasIcons then begin
  2932. SetStatusLabelText(SetupMessages[msgStatusCreateIcons]);
  2933. CreateIcons;
  2934. ProcessEvents;
  2935. end;
  2936. { Create INI entries, if any }
  2937. if Entries[seIni].Count <> 0 then begin
  2938. SetStatusLabelText(SetupMessages[msgStatusCreateIniEntries]);
  2939. CreateIniEntries;
  2940. ProcessEvents;
  2941. end;
  2942. { Create registry entries, if any }
  2943. if Entries[seRegistry].Count <> 0 then begin
  2944. SetStatusLabelText(SetupMessages[msgStatusCreateRegistryEntries]);
  2945. CreateRegistryEntries;
  2946. ProcessEvents;
  2947. end;
  2948. { Call the NeedRestart event function now.
  2949. Note: This can't be done after RegisterFiles, since RegisterFiles
  2950. relies on the setting of the NeedsRestart variable. }
  2951. SetStatusLabelText('');
  2952. ProcessNeedRestartEvent;
  2953. ProcessEvents;
  2954. { Register files, if any }
  2955. if RegisterFilesList.Count <> 0 then begin
  2956. SetStatusLabelText(SetupMessages[msgStatusRegisterFiles]);
  2957. RegisterFiles;
  2958. ProcessEvents;
  2959. end;
  2960. { Save uninstall information. After uninstall info is saved, you cannot
  2961. make any more modifications to the user's system. Any additional
  2962. modifications you want to add must be done before this is called. }
  2963. if Uninstallable then begin
  2964. SetStatusLabelText(SetupMessages[msgStatusSavingUninstall]);
  2965. Log('Saving uninstall information.');
  2966. RenameUninstallExe;
  2967. CreateUninstallMsgFile;
  2968. { Register uninstall information so the program can be uninstalled
  2969. through the Add/Remove Programs Control Panel applet. This is done
  2970. on NT 3.51 too, so that the uninstall entry for the app will appear
  2971. if the user later upgrades to NT 4.0+. }
  2972. if EvalDirectiveCheck(SetupHeader.CreateUninstallRegKey) then
  2973. RegisterUninstallInfo(UninstallRegKeyBaseName, AfterInstallFilesSize);
  2974. RecordUninstallRunEntries;
  2975. UninstLog.Add(utEndInstall, [GetLocalTimeAsStr], 0);
  2976. UninstLog.Save(UninstallDataFilename, AppendUninstallData,
  2977. shUpdateUninstallLogAppName in SetupHeader.Options);
  2978. if Debugging then
  2979. DebugNotifyUninstExe(UninstallExeFileName);
  2980. end;
  2981. SetStatusLabelText('');
  2982. UninstLogCleared := True;
  2983. UninstLog.Clear;
  2984. except
  2985. try
  2986. { Show error message, if any, and set the exit code we'll be returning }
  2987. if not(ExceptObject is EAbort) then begin
  2988. Log(Format('Fatal exception during installation process (%s):' + SNewLine,
  2989. [ExceptObject.ClassName]) + GetExceptMessage);
  2990. SetupExitCode := ecInstallationError;
  2991. Application.HandleException(nil);
  2992. LoggedMsgBox(SetupMessages[msgSetupAborted], '', mbCriticalError, MB_OK, True, IDOK);
  2993. end
  2994. else begin
  2995. Log('User canceled the installation process.');
  2996. SetupExitCode := ecInstallationCancelled;
  2997. end;
  2998. { Undo any changes it's made so far }
  2999. if not UninstLogCleared then begin
  3000. Log('Rolling back changes.');
  3001. try
  3002. SetStatusLabelText(SetupMessages[msgStatusRollback]);
  3003. WizardForm.ProgressGauge.Visible := False;
  3004. FinishProgressGauge(True);
  3005. WizardForm.CancelButton.Enabled := False;
  3006. WizardForm.Update;
  3007. except
  3008. { ignore any exceptions, just in case... }
  3009. end;
  3010. if UninstallTempExeFilename <> '' then
  3011. DeleteFile(UninstallTempExeFilename);
  3012. if UninstallExeCreated = ueNew then
  3013. DeleteFile(UninstallExeFilename);
  3014. if UninstallDataCreated then
  3015. DeleteFile(UninstallDataFilename);
  3016. if UninstallMsgCreated then
  3017. DeleteFile(UninstallMsgFilename);
  3018. UninstLog.PerformUninstall(False, nil);
  3019. { Sleep for a bit so that the user has time to read the "Rolling
  3020. back changes" message }
  3021. if WizardForm.Visible then
  3022. Sleep(1500);
  3023. end;
  3024. except
  3025. { No exception should be generated by the above code, but just in
  3026. case, handle any exception now so that Application.Terminate is
  3027. always called below.
  3028. Note that we can't just put Application.Terminate in a finally
  3029. section, because it would prevent the display of an exception
  3030. message box later (MessageBox() dislikes WM_QUIT). }
  3031. Application.HandleException(nil);
  3032. end;
  3033. Exit;
  3034. end;
  3035. finally
  3036. if Assigned(RegisterFilesList) then begin
  3037. for I := RegisterFilesList.Count-1 downto 0 do
  3038. Dispose(PRegisterFilesListRec(RegisterFilesList[I]));
  3039. RegisterFilesList.Free;
  3040. end;
  3041. UninstLog.Free;
  3042. FinishProgressGauge(False);
  3043. end;
  3044. Log('Installation process succeeded.');
  3045. Succeeded := True;
  3046. end;
  3047. procedure InternalExtractTemporaryFile(const DestName: String;
  3048. const CurFile: PSetupFileEntry; const CurFileLocation: PSetupFileLocationEntry;
  3049. const CreateDirs: Boolean);
  3050. var
  3051. DisableFsRedir: Boolean;
  3052. DestFile: String;
  3053. DestF: TFile;
  3054. CurFileDate: TFileTime;
  3055. begin
  3056. DestFile := AddBackslash(TempInstallDir) + DestName;
  3057. Log('Extracting temporary file: ' + DestFile);
  3058. DisableFsRedir := InstallDefaultDisableFsRedir;
  3059. if CreateDirs then
  3060. ForceDirectories(DisableFsRedir, PathExtractPath(DestFile));
  3061. DestF := TFileRedir.Create(DisableFsRedir, DestFile, fdCreateAlways, faWrite, fsNone);
  3062. try
  3063. try
  3064. FileExtractor.SeekTo(CurFileLocation^, nil);
  3065. FileExtractor.DecompressFile(CurFileLocation^, DestF, nil,
  3066. not (foDontVerifyChecksum in CurFile^.Options));
  3067. if foTimeStampInUTC in CurFileLocation^.Flags then
  3068. CurFileDate := CurFileLocation^.SourceTimeStamp
  3069. else
  3070. LocalFileTimeToFileTime(CurFileLocation^.SourceTimeStamp, CurFileDate);
  3071. SetFileTime(DestF.Handle, nil, nil, @CurFileDate);
  3072. finally
  3073. DestF.Free;
  3074. end;
  3075. except
  3076. DeleteFileRedir(DisableFsRedir, DestFile);
  3077. raise;
  3078. end;
  3079. AddAttributesToFile(DisableFsRedir, DestFile, CurFile^.Attribs);
  3080. end;
  3081. procedure ExtractTemporaryFile(const BaseName: String);
  3082. function EscapeBraces(const S: String): String;
  3083. { Changes all '{' to '{{'. Uses ConstLeadBytes^ for the lead byte table. }
  3084. var
  3085. I: Integer;
  3086. begin
  3087. Result := S;
  3088. I := 1;
  3089. while I <= Length(Result) do begin
  3090. if Result[I] = '{' then begin
  3091. Insert('{', Result, I);
  3092. Inc(I);
  3093. end;
  3094. Inc(I);
  3095. end;
  3096. end;
  3097. var
  3098. EscapedBaseName: String;
  3099. CurFileNumber: Integer;
  3100. CurFile: PSetupFileEntry;
  3101. begin
  3102. { We compare BaseName to the filename portion of TSetupFileEntry.DestName
  3103. which has braces escaped, but BaseName does not; escape it to match }
  3104. EscapedBaseName := EscapeBraces(BaseName);
  3105. for CurFileNumber := 0 to Entries[seFile].Count-1 do begin
  3106. CurFile := PSetupFileEntry(Entries[seFile][CurFileNumber]);
  3107. if (CurFile^.LocationEntry <> -1) and (CompareText(PathExtractName(CurFile^.DestName), EscapedBaseName) = 0) then begin
  3108. InternalExtractTemporaryFile(BaseName, CurFile, Entries[seFileLocation][CurFile^.LocationEntry], False);
  3109. Exit;
  3110. end;
  3111. end;
  3112. InternalErrorFmt('ExtractTemporaryFile: The file "%s" was not found', [BaseName]);
  3113. end;
  3114. function ExtractTemporaryFiles(const Pattern: String): Integer;
  3115. var
  3116. LowerPattern, DestName: String;
  3117. CurFileNumber: Integer;
  3118. CurFile: PSetupFileEntry;
  3119. begin
  3120. if Length(Pattern) >= MAX_PATH then
  3121. InternalError('ExtractTemporaryFiles: Pattern too long');
  3122. LowerPattern := PathLowercase(Pattern);
  3123. Result := 0;
  3124. for CurFileNumber := 0 to Entries[seFile].Count-1 do begin
  3125. CurFile := PSetupFileEntry(Entries[seFile][CurFileNumber]);
  3126. if CurFile^.LocationEntry <> -1 then begin
  3127. { Use ExpandConstEx2 to unescape any braces not in an embedded constant,
  3128. while leaving constants unexpanded }
  3129. DestName := ExpandConstEx2(CurFile^.DestName, [''], False);
  3130. if WildcardMatch(PChar(PathLowercase(DestName)), PChar(LowerPattern)) then begin
  3131. Delete(DestName, 1, PathDrivePartLengthEx(DestName, True)); { Remove any drive part }
  3132. if Pos('{tmp}\', DestName) = 1 then
  3133. Delete(DestName, 1, Length('{tmp}\'));
  3134. if Pos(':', DestName) <> 0 then
  3135. InternalError('ExtractTemporaryFiles: Invalid character in matched file name');
  3136. InternalExtractTemporaryFile(DestName, CurFile, Entries[seFileLocation][CurFile^.LocationEntry], True);
  3137. Inc(Result);
  3138. end;
  3139. end;
  3140. end;
  3141. if Result = 0 then
  3142. InternalErrorFmt('ExtractTemporaryFiles: No files matching "%s" found', [Pattern]);
  3143. end;
  3144. type
  3145. THTTPDataReceiver = class
  3146. private
  3147. FBaseName, FUrl: String;
  3148. FOnDownloadProgress: TOnDownloadProgress;
  3149. FAborted: Boolean;
  3150. FProgress, FProgressMax: Int64;
  3151. FLastReportedProgress, FLastReportedProgressMax: Int64;
  3152. public
  3153. property BaseName: String write FBaseName;
  3154. property Url: String write FUrl;
  3155. property OnDownloadProgress: TOnDownloadProgress write FOnDownloadProgress;
  3156. property Aborted: Boolean read FAborted;
  3157. property Progress: Int64 read FProgress;
  3158. property ProgressMax: Int64 read FProgressMax;
  3159. procedure OnReceiveData(const Sender: TObject; AContentLength: Int64; AReadCount: Int64; var Abort: Boolean);
  3160. end;
  3161. procedure THTTPDataReceiver.OnReceiveData(const Sender: TObject; AContentLength: Int64; AReadCount: Int64; var Abort: Boolean);
  3162. begin
  3163. FProgress := AReadCount;
  3164. FProgressMax := AContentLength;
  3165. if Assigned(FOnDownloadProgress) then begin
  3166. { Make sure script isn't called crazy often because that would slow the download significantly. Only report:
  3167. -At start or finish
  3168. -Or if somehow Progress decreased or Max changed
  3169. -Or if at least 512 KB progress was made since last report
  3170. }
  3171. if (FProgress = 0) or (FProgress = FProgressMax) or
  3172. (FProgress < FLastReportedProgress) or (FProgressMax <> FLastReportedProgressMax) or
  3173. ((FProgress - FLastReportedProgress) > 524288) then begin
  3174. try
  3175. if not FOnDownloadProgress(FUrl, FBaseName, FProgress, FProgressMax) then
  3176. Abort := True;
  3177. finally
  3178. FLastReportedProgress := FProgress;
  3179. FLastReportedProgressMax := FProgressMax;
  3180. end;
  3181. end;
  3182. end;
  3183. if not Abort and DownloadTemporaryFileProcessMessages then
  3184. Application.ProcessMessages;
  3185. if Abort then
  3186. FAborted := True
  3187. end;
  3188. procedure SetUserAgentAndSecureProtocols(const AHTTPClient: THTTPClient);
  3189. begin
  3190. AHTTPClient.UserAgent := SetupTitle + ' ' + SetupVersion;
  3191. { TLS 1.2 isn't enabled by default on older versions of Windows }
  3192. AHTTPClient.SecureProtocols := [THTTPSecureProtocol.TLS1, THTTPSecureProtocol.TLS11, THTTPSecureProtocol.TLS12];
  3193. end;
  3194. function MaskPasswordInUrl(const Url: String): String;
  3195. var
  3196. Uri: TUri;
  3197. begin
  3198. Uri := TUri.Create(Url);
  3199. if Uri.Password <> '' then begin
  3200. Uri.Password := '***';
  3201. Result := Uri.ToString;
  3202. end else
  3203. Result := URL;
  3204. end;
  3205. procedure SetDownloadCredentials(const User, Pass: String);
  3206. begin
  3207. DownloadUser := User;
  3208. DownloadPass := Pass;
  3209. end;
  3210. function GetCredentialsAndCleanUrl(const Url: String; var User, Pass, CleanUrl: String) : Boolean;
  3211. var
  3212. Uri: TUri;
  3213. begin
  3214. Uri := TUri.Create(Url);
  3215. if DownloadUser = '' then
  3216. User := TNetEncoding.URL.Decode(Uri.Username)
  3217. else
  3218. User := DownloadUser;
  3219. if DownloadPass = '' then
  3220. Pass := TNetEncoding.URL.Decode(Uri.Password, [TURLEncoding.TDecodeOption.PlusAsSpaces])
  3221. else
  3222. Pass := DownloadPass;
  3223. Uri.Username := '';
  3224. Uri.Password := '';
  3225. CleanUrl := Uri.ToString;
  3226. Result := (User <> '') or (Pass <> '');
  3227. if Result then
  3228. LogFmt('Download is using basic authentication: %s, ***', [User])
  3229. else
  3230. Log('Download is not using basic authentication');
  3231. end;
  3232. function DownloadTemporaryFile(const Url, BaseName, RequiredSHA256OfFile: String; const OnDownloadProgress: TOnDownloadProgress): Int64;
  3233. var
  3234. DisableFsRedir: Boolean;
  3235. DestFile, TempFile: String;
  3236. TempF: TFileRedir;
  3237. HandleStream: THandleStream;
  3238. TempFileLeftOver: Boolean;
  3239. HTTPDataReceiver: THTTPDataReceiver;
  3240. HTTPClient: THTTPClient;
  3241. HTTPResponse: IHTTPResponse;
  3242. SHA256OfFile: String;
  3243. RetriesLeft: Integer;
  3244. LastError: DWORD;
  3245. User, Pass, CleanUrl: String;
  3246. HasCredentials : Boolean;
  3247. Base64: TBase64Encoding;
  3248. begin
  3249. if Url = '' then
  3250. InternalError('DownloadTemporaryFile: Invalid Url value');
  3251. if BaseName = '' then
  3252. InternalError('DownloadTemporaryFile: Invalid BaseName value');
  3253. DestFile := AddBackslash(TempInstallDir) + BaseName;
  3254. LogFmt('Downloading temporary file from %s: %s', [MaskPasswordInURL(Url), DestFile]);
  3255. DisableFsRedir := InstallDefaultDisableFsRedir;
  3256. { Prepare directory }
  3257. if FileExists(DestFile) then begin
  3258. if (RequiredSHA256OfFile <> '') and (RequiredSHA256OfFile = GetSHA256OfFile(DisableFsRedir, DestFile)) then begin
  3259. Log(' File already downloaded.');
  3260. Result := 0;
  3261. Exit;
  3262. end;
  3263. SetFileAttributesRedir(DisableFsRedir, DestFile, GetFileAttributesRedir(DisableFsRedir, DestFile) and not FILE_ATTRIBUTE_READONLY);
  3264. DelayDeleteFile(DisableFsRedir, DestFile, 13, 50, 250);
  3265. end else
  3266. ForceDirectories(DisableFsRedir, PathExtractPath(DestFile));
  3267. HTTPDataReceiver := nil;
  3268. HTTPClient := nil;
  3269. TempF := nil;
  3270. TempFileLeftOver := False;
  3271. HandleStream := nil;
  3272. Base64 := nil;
  3273. try
  3274. HasCredentials := GetCredentialsAndCleanUrl(URL, User, Pass, CleanUrl);
  3275. { Setup downloader }
  3276. HTTPDataReceiver := THTTPDataReceiver.Create;
  3277. HTTPDataReceiver.BaseName := BaseName;
  3278. HTTPDataReceiver.Url := CleanUrl;
  3279. HTTPDataReceiver.OnDownloadProgress := OnDownloadProgress;
  3280. HTTPClient := THTTPClient.Create; { http://docwiki.embarcadero.com/RADStudio/Rio/en/Using_an_HTTP_Client }
  3281. SetUserAgentAndSecureProtocols(HTTPClient);
  3282. HTTPClient.OnReceiveData := HTTPDataReceiver.OnReceiveData;
  3283. { Create temporary file }
  3284. TempFile := GenerateUniqueName(DisableFsRedir, PathExtractPath(DestFile), '.tmp');
  3285. TempF := TFileRedir.Create(DisableFsRedir, TempFile, fdCreateAlways, faWrite, fsNone);
  3286. TempFileLeftOver := True;
  3287. { To test redirects: https://jrsoftware.org/download.php/is.exe
  3288. To test expired certificates: https://expired.badssl.com/
  3289. To test self-signed certificates: https://self-signed.badssl.com/
  3290. To test basic authentication: https://guest:[email protected]/HTTP/Basic/
  3291. To test 100 MB file: https://speed.hetzner.de/100MB.bin
  3292. To test 1 GB file: https://speed.hetzner.de/1GB.bin
  3293. To test file without a content length: https://github.com/jrsoftware/issrc/archive/main.zip }
  3294. { Download to temporary file}
  3295. HandleStream := THandleStream.Create(TempF.Handle);
  3296. if HasCredentials then begin
  3297. Base64 := TBase64Encoding.Create(0);
  3298. HTTPClient.CustomHeaders['Authorization'] := 'Basic ' + Base64.Encode(User + ':' + Pass);
  3299. end;
  3300. HTTPResponse := HTTPClient.Get(CleanUrl, HandleStream);
  3301. if HTTPDataReceiver.Aborted then
  3302. raise Exception.Create(SetupMessages[msgErrorDownloadAborted])
  3303. else if (HTTPResponse.StatusCode < 200) or (HTTPResponse.StatusCode > 299) then
  3304. raise Exception.Create(FmtSetupMessage(msgErrorDownloadFailed, [IntToStr(HTTPResponse.StatusCode), HTTPResponse.StatusText]))
  3305. else begin
  3306. { Download completed, get temporary file size and close it }
  3307. Result := HandleStream.Size;
  3308. FreeAndNil(HandleStream);
  3309. FreeAndNil(TempF);
  3310. { Check hash if specified, otherwise check everything else we can check }
  3311. if RequiredSHA256OfFile <> '' then begin
  3312. try
  3313. SHA256OfFile := GetSHA256OfFile(DisableFsRedir, TempFile);
  3314. except on E: Exception do
  3315. raise Exception.Create(FmtSetupMessage(msgErrorFileHash1, [E.Message]));
  3316. end;
  3317. if not SameText(RequiredSHA256OfFile, SHA256OfFile) then
  3318. raise Exception.Create(FmtSetupMessage(msgErrorFileHash2, [RequiredSHA256OfFile, SHA256OfFile]));
  3319. end else if HTTPDataReceiver.ProgressMax > 0 then begin
  3320. if HTTPDataReceiver.Progress <> HTTPDataReceiver.ProgressMax then
  3321. raise Exception.Create(FmtSetupMessage(msgErrorProgress, [IntToStr(HTTPDataReceiver.Progress), IntToStr(HTTPDataReceiver.ProgressMax)]))
  3322. else if HTTPDataReceiver.ProgressMax <> Result then
  3323. raise Exception.Create(FmtSetupMessage(msgErrorFileSize, [IntToStr(HTTPDataReceiver.ProgressMax), IntToStr(Result)]));
  3324. end;
  3325. { Rename the temporary file to the new name now, with retries if needed }
  3326. RetriesLeft := 4;
  3327. while not MoveFileRedir(DisableFsRedir, TempFile, DestFile) do begin
  3328. { Couldn't rename the temporary file... }
  3329. LastError := GetLastError;
  3330. { Does the error code indicate that it is possibly in use? }
  3331. if LastErrorIndicatesPossiblyInUse(LastError, True) then begin
  3332. LogFmt(' The existing file appears to be in use (%d). ' +
  3333. 'Retrying.', [LastError]);
  3334. Dec(RetriesLeft);
  3335. Sleep(1000);
  3336. if RetriesLeft > 0 then
  3337. Continue;
  3338. end;
  3339. { Some other error occurred, or we ran out of tries }
  3340. SetLastError(LastError);
  3341. Win32ErrorMsg('MoveFile'); { Throws an exception }
  3342. end;
  3343. TempFileLeftOver := False;
  3344. end;
  3345. finally
  3346. Base64.Free;
  3347. HandleStream.Free;
  3348. TempF.Free;
  3349. HTTPClient.Free;
  3350. HTTPDataReceiver.Free;
  3351. if TempFileLeftOver then
  3352. DeleteFileRedir(DisableFsRedir, TempFile);
  3353. end;
  3354. end;
  3355. procedure DownloadTemporaryFileSizeAndDate(const Url: String; var FileSize: Int64; var FileDate: String);
  3356. var
  3357. HTTPClient: THTTPClient;
  3358. HTTPResponse: IHTTPResponse;
  3359. User, Pass, CleanUrl: string;
  3360. HasCredentials : Boolean;
  3361. Base64: TBase64Encoding;
  3362. begin
  3363. HTTPClient := THTTPClient.Create;
  3364. Base64 := nil;
  3365. HasCredentials := GetCredentialsAndCleanUrl(Url, User, Pass, CleanUrl);
  3366. try
  3367. if HasCredentials then begin
  3368. Base64 := TBase64Encoding.Create(0);
  3369. HTTPClient.CustomHeaders['Authorization'] := 'Basic ' + Base64.Encode(User + ':' + Pass);
  3370. end;
  3371. SetUserAgentAndSecureProtocols(HTTPClient);
  3372. HTTPResponse := HTTPClient.Head(CleanUrl);
  3373. if (HTTPResponse.StatusCode < 200) or (HTTPResponse.StatusCode > 299) then
  3374. raise Exception.Create(FmtSetupMessage(msgErrorDownloadSizeFailed, [IntToStr(HTTPResponse.StatusCode), HTTPResponse.StatusText]))
  3375. else begin
  3376. FileSize := HTTPResponse.ContentLength;
  3377. FileDate := HTTPResponse.LastModified;
  3378. end;
  3379. finally
  3380. Base64.Free;
  3381. HTTPClient.Free;
  3382. end;
  3383. end;
  3384. function DownloadTemporaryFileSize(const Url: String): Int64;
  3385. var
  3386. FileSize: Int64;
  3387. FileDate: String;
  3388. begin
  3389. if Url = '' then
  3390. InternalError('DownloadTemporaryFileSize: Invalid Url value');
  3391. LogFmt('Getting size of %s.', [MaskPasswordInUrl(Url)]);
  3392. DownloadTemporaryFileSizeAndDate(Url, FileSize, FileDate);
  3393. Result := FileSize;
  3394. end;
  3395. function DownloadTemporaryFileDate(const Url: String): String;
  3396. var
  3397. FileSize: Int64;
  3398. FileDate: String;
  3399. begin
  3400. if Url = '' then
  3401. InternalError('DownloadTemporaryFileDate: Invalid Url value');
  3402. LogFmt('Getting last modified date of %s.', [MaskPasswordInUrl(Url)]);
  3403. DownloadTemporaryFileSizeAndDate(Url, FileSize, FileDate);
  3404. Result := FileDate;
  3405. end;
  3406. end.