Setup.MainFunc.pas 165 KB

12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697989910010110210310410510610710810911011111211311411511611711811912012112212312412512612712812913013113213313413513613713813914014114214314414514614714814915015115215315415515615715815916016116216316416516616716816917017117217317417517617717817918018118218318418518618718818919019119219319419519619719819920020120220320420520620720820921021121221321421521621721821922022122222322422522622722822923023123223323423523623723823924024124224324424524624724824925025125225325425525625725825926026126226326426526626726826927027127227327427527627727827928028128228328428528628728828929029129229329429529629729829930030130230330430530630730830931031131231331431531631731831932032132232332432532632732832933033133233333433533633733833934034134234334434534634734834935035135235335435535635735835936036136236336436536636736836937037137237337437537637737837938038138238338438538638738838939039139239339439539639739839940040140240340440540640740840941041141241341441541641741841942042142242342442542642742842943043143243343443543643743843944044144244344444544644744844945045145245345445545645745845946046146246346446546646746846947047147247347447547647747847948048148248348448548648748848949049149249349449549649749849950050150250350450550650750850951051151251351451551651751851952052152252352452552652752852953053153253353453553653753853954054154254354454554654754854955055155255355455555655755855956056156256356456556656756856957057157257357457557657757857958058158258358458558658758858959059159259359459559659759859960060160260360460560660760860961061161261361461561661761861962062162262362462562662762862963063163263363463563663763863964064164264364464564664764864965065165265365465565665765865966066166266366466566666766866967067167267367467567667767867968068168268368468568668768868969069169269369469569669769869970070170270370470570670770870971071171271371471571671771871972072172272372472572672772872973073173273373473573673773873974074174274374474574674774874975075175275375475575675775875976076176276376476576676776876977077177277377477577677777877978078178278378478578678778878979079179279379479579679779879980080180280380480580680780880981081181281381481581681781881982082182282382482582682782882983083183283383483583683783883984084184284384484584684784884985085185285385485585685785885986086186286386486586686786886987087187287387487587687787887988088188288388488588688788888989089189289389489589689789889990090190290390490590690790890991091191291391491591691791891992092192292392492592692792892993093193293393493593693793893994094194294394494594694794894995095195295395495595695795895996096196296396496596696796896997097197297397497597697797897998098198298398498598698798898999099199299399499599699799899910001001100210031004100510061007100810091010101110121013101410151016101710181019102010211022102310241025102610271028102910301031103210331034103510361037103810391040104110421043104410451046104710481049105010511052105310541055105610571058105910601061106210631064106510661067106810691070107110721073107410751076107710781079108010811082108310841085108610871088108910901091109210931094109510961097109810991100110111021103110411051106110711081109111011111112111311141115111611171118111911201121112211231124112511261127112811291130113111321133113411351136113711381139114011411142114311441145114611471148114911501151115211531154115511561157115811591160116111621163116411651166116711681169117011711172117311741175117611771178117911801181118211831184118511861187118811891190119111921193119411951196119711981199120012011202120312041205120612071208120912101211121212131214121512161217121812191220122112221223122412251226122712281229123012311232123312341235123612371238123912401241124212431244124512461247124812491250125112521253125412551256125712581259126012611262126312641265126612671268126912701271127212731274127512761277127812791280128112821283128412851286128712881289129012911292129312941295129612971298129913001301130213031304130513061307130813091310131113121313131413151316131713181319132013211322132313241325132613271328132913301331133213331334133513361337133813391340134113421343134413451346134713481349135013511352135313541355135613571358135913601361136213631364136513661367136813691370137113721373137413751376137713781379138013811382138313841385138613871388138913901391139213931394139513961397139813991400140114021403140414051406140714081409141014111412141314141415141614171418141914201421142214231424142514261427142814291430143114321433143414351436143714381439144014411442144314441445144614471448144914501451145214531454145514561457145814591460146114621463146414651466146714681469147014711472147314741475147614771478147914801481148214831484148514861487148814891490149114921493149414951496149714981499150015011502150315041505150615071508150915101511151215131514151515161517151815191520152115221523152415251526152715281529153015311532153315341535153615371538153915401541154215431544154515461547154815491550155115521553155415551556155715581559156015611562156315641565156615671568156915701571157215731574157515761577157815791580158115821583158415851586158715881589159015911592159315941595159615971598159916001601160216031604160516061607160816091610161116121613161416151616161716181619162016211622162316241625162616271628162916301631163216331634163516361637163816391640164116421643164416451646164716481649165016511652165316541655165616571658165916601661166216631664166516661667166816691670167116721673167416751676167716781679168016811682168316841685168616871688168916901691169216931694169516961697169816991700170117021703170417051706170717081709171017111712171317141715171617171718171917201721172217231724172517261727172817291730173117321733173417351736173717381739174017411742174317441745174617471748174917501751175217531754175517561757175817591760176117621763176417651766176717681769177017711772177317741775177617771778177917801781178217831784178517861787178817891790179117921793179417951796179717981799180018011802180318041805180618071808180918101811181218131814181518161817181818191820182118221823182418251826182718281829183018311832183318341835183618371838183918401841184218431844184518461847184818491850185118521853185418551856185718581859186018611862186318641865186618671868186918701871187218731874187518761877187818791880188118821883188418851886188718881889189018911892189318941895189618971898189919001901190219031904190519061907190819091910191119121913191419151916191719181919192019211922192319241925192619271928192919301931193219331934193519361937193819391940194119421943194419451946194719481949195019511952195319541955195619571958195919601961196219631964196519661967196819691970197119721973197419751976197719781979198019811982198319841985198619871988198919901991199219931994199519961997199819992000200120022003200420052006200720082009201020112012201320142015201620172018201920202021202220232024202520262027202820292030203120322033203420352036203720382039204020412042204320442045204620472048204920502051205220532054205520562057205820592060206120622063206420652066206720682069207020712072207320742075207620772078207920802081208220832084208520862087208820892090209120922093209420952096209720982099210021012102210321042105210621072108210921102111211221132114211521162117211821192120212121222123212421252126212721282129213021312132213321342135213621372138213921402141214221432144214521462147214821492150215121522153215421552156215721582159216021612162216321642165216621672168216921702171217221732174217521762177217821792180218121822183218421852186218721882189219021912192219321942195219621972198219922002201220222032204220522062207220822092210221122122213221422152216221722182219222022212222222322242225222622272228222922302231223222332234223522362237223822392240224122422243224422452246224722482249225022512252225322542255225622572258225922602261226222632264226522662267226822692270227122722273227422752276227722782279228022812282228322842285228622872288228922902291229222932294229522962297229822992300230123022303230423052306230723082309231023112312231323142315231623172318231923202321232223232324232523262327232823292330233123322333233423352336233723382339234023412342234323442345234623472348234923502351235223532354235523562357235823592360236123622363236423652366236723682369237023712372237323742375237623772378237923802381238223832384238523862387238823892390239123922393239423952396239723982399240024012402240324042405240624072408240924102411241224132414241524162417241824192420242124222423242424252426242724282429243024312432243324342435243624372438243924402441244224432444244524462447244824492450245124522453245424552456245724582459246024612462246324642465246624672468246924702471247224732474247524762477247824792480248124822483248424852486248724882489249024912492249324942495249624972498249925002501250225032504250525062507250825092510251125122513251425152516251725182519252025212522252325242525252625272528252925302531253225332534253525362537253825392540254125422543254425452546254725482549255025512552255325542555255625572558255925602561256225632564256525662567256825692570257125722573257425752576257725782579258025812582258325842585258625872588258925902591259225932594259525962597259825992600260126022603260426052606260726082609261026112612261326142615261626172618261926202621262226232624262526262627262826292630263126322633263426352636263726382639264026412642264326442645264626472648264926502651265226532654265526562657265826592660266126622663266426652666266726682669267026712672267326742675267626772678267926802681268226832684268526862687268826892690269126922693269426952696269726982699270027012702270327042705270627072708270927102711271227132714271527162717271827192720272127222723272427252726272727282729273027312732273327342735273627372738273927402741274227432744274527462747274827492750275127522753275427552756275727582759276027612762276327642765276627672768276927702771277227732774277527762777277827792780278127822783278427852786278727882789279027912792279327942795279627972798279928002801280228032804280528062807280828092810281128122813281428152816281728182819282028212822282328242825282628272828282928302831283228332834283528362837283828392840284128422843284428452846284728482849285028512852285328542855285628572858285928602861286228632864286528662867286828692870287128722873287428752876287728782879288028812882288328842885288628872888288928902891289228932894289528962897289828992900290129022903290429052906290729082909291029112912291329142915291629172918291929202921292229232924292529262927292829292930293129322933293429352936293729382939294029412942294329442945294629472948294929502951295229532954295529562957295829592960296129622963296429652966296729682969297029712972297329742975297629772978297929802981298229832984298529862987298829892990299129922993299429952996299729982999300030013002300330043005300630073008300930103011301230133014301530163017301830193020302130223023302430253026302730283029303030313032303330343035303630373038303930403041304230433044304530463047304830493050305130523053305430553056305730583059306030613062306330643065306630673068306930703071307230733074307530763077307830793080308130823083308430853086308730883089309030913092309330943095309630973098309931003101310231033104310531063107310831093110311131123113311431153116311731183119312031213122312331243125312631273128312931303131313231333134313531363137313831393140314131423143314431453146314731483149315031513152315331543155315631573158315931603161316231633164316531663167316831693170317131723173317431753176317731783179318031813182318331843185318631873188318931903191319231933194319531963197319831993200320132023203320432053206320732083209321032113212321332143215321632173218321932203221322232233224322532263227322832293230323132323233323432353236323732383239324032413242324332443245324632473248324932503251325232533254325532563257325832593260326132623263326432653266326732683269327032713272327332743275327632773278327932803281328232833284328532863287328832893290329132923293329432953296329732983299330033013302330333043305330633073308330933103311331233133314331533163317331833193320332133223323332433253326332733283329333033313332333333343335333633373338333933403341334233433344334533463347334833493350335133523353335433553356335733583359336033613362336333643365336633673368336933703371337233733374337533763377337833793380338133823383338433853386338733883389339033913392339333943395339633973398339934003401340234033404340534063407340834093410341134123413341434153416341734183419342034213422342334243425342634273428342934303431343234333434343534363437343834393440344134423443344434453446344734483449345034513452345334543455345634573458345934603461346234633464346534663467346834693470347134723473347434753476347734783479348034813482348334843485348634873488348934903491349234933494349534963497349834993500350135023503350435053506350735083509351035113512351335143515351635173518351935203521352235233524352535263527352835293530353135323533353435353536353735383539354035413542354335443545354635473548354935503551355235533554355535563557355835593560356135623563356435653566356735683569357035713572357335743575357635773578357935803581358235833584358535863587358835893590359135923593359435953596359735983599360036013602360336043605360636073608360936103611361236133614361536163617361836193620362136223623362436253626362736283629363036313632363336343635363636373638363936403641364236433644364536463647364836493650365136523653365436553656365736583659366036613662366336643665366636673668366936703671367236733674367536763677367836793680368136823683368436853686368736883689369036913692369336943695369636973698369937003701370237033704370537063707370837093710371137123713371437153716371737183719372037213722372337243725372637273728372937303731373237333734373537363737373837393740374137423743374437453746374737483749375037513752375337543755375637573758375937603761376237633764376537663767376837693770377137723773377437753776377737783779378037813782378337843785378637873788378937903791379237933794379537963797379837993800380138023803380438053806380738083809381038113812381338143815381638173818381938203821382238233824382538263827382838293830383138323833383438353836383738383839384038413842384338443845384638473848384938503851385238533854385538563857385838593860386138623863386438653866386738683869387038713872387338743875387638773878387938803881388238833884388538863887388838893890389138923893389438953896389738983899390039013902390339043905390639073908390939103911391239133914391539163917391839193920392139223923392439253926392739283929393039313932393339343935393639373938393939403941394239433944394539463947394839493950395139523953395439553956395739583959396039613962396339643965396639673968396939703971397239733974397539763977397839793980398139823983398439853986398739883989399039913992399339943995399639973998399940004001400240034004400540064007400840094010401140124013401440154016401740184019402040214022402340244025402640274028402940304031403240334034403540364037403840394040404140424043404440454046404740484049405040514052405340544055405640574058405940604061406240634064406540664067406840694070407140724073407440754076407740784079408040814082408340844085408640874088408940904091409240934094409540964097409840994100410141024103410441054106410741084109411041114112411341144115411641174118411941204121412241234124412541264127412841294130413141324133413441354136413741384139414041414142414341444145414641474148414941504151415241534154415541564157415841594160416141624163416441654166416741684169417041714172417341744175417641774178417941804181418241834184418541864187418841894190419141924193419441954196419741984199420042014202420342044205420642074208420942104211421242134214421542164217421842194220422142224223422442254226422742284229423042314232423342344235423642374238423942404241424242434244424542464247424842494250425142524253425442554256425742584259
  1. unit Setup.MainFunc;
  2. {
  3. Inno Setup
  4. Copyright (C) 1997-2025 Jordan Russell
  5. Portions by Martijn Laan
  6. For conditions of distribution and use, see LICENSE.TXT.
  7. Setup main functions and global variables
  8. }
  9. interface
  10. uses
  11. Windows, SysUtils, Messages, Classes, Graphics, Controls, Forms, Dialogs, Generics.Collections,
  12. StdCtrls, Shared.Struct, Shared.DebugStruct, Shared.CommonFunc.Vcl, Shared.CommonFunc,
  13. Shared.SetupTypes, Setup.ScriptRunner, RestartManager;
  14. type
  15. TEntryType = (seLanguage, seCustomMessage, sePermission, seType, seComponent,
  16. seTask, seDir, seISSigKey, seFile, seFileLocation, seIcon, seIni, seRegistry,
  17. seInstallDelete, seUninstallDelete, seRun, seUninstallRun);
  18. TShellFolderID = (sfDesktop, sfStartMenu, sfPrograms, sfStartup, sfSendTo, //these have common and user versions
  19. sfFonts, sfAppData, sfDocs, sfTemplates, //
  20. sfFavorites, sfLocalAppData, sfUserProgramFiles, sfUserCommonFiles, sfUserSavedGames); //these only have user versions
  21. TWizardImages = TObjectList<TGraphic>;
  22. const
  23. EntryStrings: array[TEntryType] of Integer = (SetupLanguageEntryStrings,
  24. SetupCustomMessageEntryStrings, SetupPermissionEntryStrings,
  25. SetupTypeEntryStrings, SetupComponentEntryStrings, SetupTaskEntryStrings,
  26. SetupDirEntryStrings, SetupISSigKeyEntryStrings, SetupFileEntryStrings,
  27. SetupFileLocationEntryStrings, SetupIconEntryStrings, SetupIniEntryStrings,
  28. SetupRegistryEntryStrings, SetupDeleteEntryStrings, SetupDeleteEntryStrings,
  29. SetupRunEntryStrings, SetupRunEntryStrings);
  30. EntryAnsiStrings: array[TEntryType] of Integer = (SetupLanguageEntryAnsiStrings,
  31. SetupCustomMessageEntryAnsiStrings, SetupPermissionEntryAnsiStrings,
  32. SetupTypeEntryAnsiStrings, SetupComponentEntryAnsiStrings, SetupTaskEntryAnsiStrings,
  33. SetupDirEntryAnsiStrings, SetupISSigKeyEntryAnsiStrings, SetupFileEntryAnsiStrings,
  34. SetupFileLocationEntryAnsiStrings, SetupIconEntryAnsiStrings, SetupIniEntryAnsiStrings,
  35. SetupRegistryEntryAnsiStrings, SetupDeleteEntryAnsiStrings, SetupDeleteEntryAnsiStrings,
  36. SetupRunEntryAnsiStrings, SetupRunEntryAnsiStrings);
  37. { Exit codes that are assigned to the SetupExitCode variable.
  38. Note: SetupLdr also returns exit codes with the same numbers. }
  39. ecInitializationError = 1; { Setup failed to initialize. }
  40. ecCancelledBeforeInstall = 2; { User clicked Cancel before the actual
  41. installation started. }
  42. ecNextStepError = 3; { A fatal exception occurred while moving to
  43. the next step. }
  44. ecInstallationError = 4; { A fatal exception occurred during
  45. installation. }
  46. ecInstallationCancelled = 5; { User clicked Cancel during installation,
  47. or clicked Abort at an Abort-Retry-Ignore
  48. dialog. }
  49. ecKilledByDebugger = 6; { User killed the Setup process from within
  50. the debugger. }
  51. ecPrepareToInstallFailed = 7; { Stopped on Preparing to Install page;
  52. restart not needed. }
  53. ecPrepareToInstallFailedRestartNeeded = 8;
  54. { Stopped on Preparing to Install page;
  55. restart needed. }
  56. CodeRunnerNamingAttribute = 'Event';
  57. var
  58. { Variables for command line parameters }
  59. SetupLdrMode: Boolean;
  60. SetupLdrOriginalFilename: String;
  61. SetupLdrOffset0, SetupLdrOffset1: Int64;
  62. SetupNotifyWndPresent: Boolean;
  63. SetupNotifyWnd: HWND;
  64. InitLang: String;
  65. InitDir, InitProgramGroup: String;
  66. InitLoadInf, InitSaveInf: String;
  67. InitNoIcons, InitSilent, InitVerySilent, InitNoRestart, InitCloseApplications,
  68. InitNoCloseApplications, InitForceCloseApplications, InitNoForceCloseApplications,
  69. InitLogCloseApplications, InitRestartApplications, InitNoRestartApplications,
  70. InitNoCancel, InitNoStyle: Boolean;
  71. InitSetupType: String;
  72. InitComponents, InitTasks: TStringList;
  73. InitComponentsSpecified: Boolean;
  74. InitDeselectAllTasks: Boolean;
  75. InitPassword: String;
  76. InitRestartExitCode: Integer;
  77. InitPrivilegesRequired: TSetupPrivilegesRequired;
  78. HasInitPrivilegesRequired: Boolean;
  79. InitSuppressMsgBoxes: Boolean;
  80. DetachedUninstMsgFile: Boolean;
  81. NewParamsForCode: TStringList;
  82. { Debugger }
  83. OriginalEntryIndexes: array[TEntryType] of TList;
  84. { 'Constants' }
  85. SourceDir, TempInstallDir, WinDir, WinSystemDir, WinSysWow64Dir, WinSysNativeDir, SystemDrive,
  86. ProgramFiles32Dir, CommonFiles32Dir, ProgramFiles64Dir, CommonFiles64Dir,
  87. CmdFilename, SysUserInfoName,
  88. SysUserInfoOrg, UninstallExeFilename: String;
  89. { Uninstall 'constants' }
  90. UninstallExpandedAppId, UninstallExpandedApp, UninstallExpandedGroup,
  91. UninstallExpandedGroupName, UninstallExpandedLanguage: String;
  92. UninstallSilent: Boolean;
  93. { Variables read in from the Setup.0 file }
  94. SetupEncryptionHeader: TSetupEncryptionHeader;
  95. SetupHeader: TSetupHeader;
  96. LangOptions: TSetupLanguageEntry;
  97. Entries: array[TEntryType] of TList;
  98. WizardImages: TWizardImages;
  99. WizardSmallImages: TWizardImages;
  100. MainIconPostfix, WizardIconsPostfix: String;
  101. CloseApplicationsFilterList, CloseApplicationsFilterExcludesList: TStringList;
  102. ISSigAvailableKeys: TArrayOfECDSAKey;
  103. { User options }
  104. ActiveLanguage: Integer = -1;
  105. ActiveLicenseText, ActiveInfoBeforeText, ActiveInfoAfterText: AnsiString;
  106. WizardUserInfoName, WizardUserInfoOrg, WizardUserInfoSerial, WizardDirValue, WizardGroupValue: String;
  107. WizardNoIcons, WizardPreparingYesRadio: Boolean;
  108. WizardSetupType: PSetupTypeEntry;
  109. WizardComponents, WizardDeselectedComponents, WizardTasks, WizardDeselectedTasks: TStringList;
  110. NeedToAbortInstall: Boolean;
  111. { Check/BeforeInstall/AfterInstall 'constants' }
  112. CheckOrInstallCurrentFilename, CheckOrInstallCurrentSourceFilename: String;
  113. { RestartManager API state.
  114. Note: the handle and key might change while running, see TWizardForm.QueryRestartManager. }
  115. RmSessionStarted, RmFoundApplications, RmDoRestart: Boolean;
  116. RmSessionHandle: DWORD;
  117. RmSessionKey: array[0..CCH_RM_SESSION_KEY] of WideChar;
  118. RmRegisteredFilesCount: Integer;
  119. { Other }
  120. ShowLanguageDialog, MatchedLangParameter: Boolean;
  121. InstallMode: (imNormal, imSilent, imVerySilent);
  122. HasIcons, IsWin64, Is64BitInstallMode, IsAdmin, IsPowerUserOrAdmin, IsAdminInstallMode,
  123. NeedPassword, NeedSerial, NeedsRestart, RestartSystem, IsWinDark, IsDarkInstallMode,
  124. IsUninstaller, AllowUninstallerShutdown, AcceptedQueryEndSessionInProgress: Boolean;
  125. InstallDefaultDisableFsRedir, ScriptFuncDisableFsRedir: Boolean;
  126. InstallDefaultRegView: TRegView = rvDefault;
  127. HasCustomType, HasComponents, HasTasks: Boolean;
  128. ProcessorArchitecture: TSetupProcessorArchitecture = paUnknown;
  129. MachineTypesSupportedBySystem: TSetupProcessorArchitectures;
  130. WindowsVersion: Cardinal;
  131. NTServicePackLevel: Word;
  132. WindowsProductType: Byte;
  133. WindowsSuiteMask: Word;
  134. MinimumSpace: Int64;
  135. DeleteFilesAfterInstallList, DeleteDirsAfterInstallList: TStringList;
  136. ExpandedAppName, ExpandedAppVerName, ExpandedAppCopyright, ExpandedAppMutex: String;
  137. DisableCodeConsts: Integer;
  138. SetupExitCode: Integer;
  139. CreatedIcon: Boolean;
  140. RestartInitiatedByThisProcess, DownloadTemporaryFileOrExtractArchiveProcessMessages: Boolean;
  141. InstallModeRootKey: HKEY;
  142. CodeRunner: TScriptRunner;
  143. procedure CodeRunnerOnLog(const S: String);
  144. procedure CodeRunnerOnLogFmt(const S: String; const Args: array of const);
  145. function CodeRunnerOnDebug(const Position: LongInt;
  146. var ContinueStepOver: Boolean): Boolean;
  147. function CodeRunnerOnDebugIntermediate(const Position: LongInt;
  148. var ContinueStepOver: Boolean): Boolean;
  149. procedure CodeRunnerOnDllImport(var DllName: String; var ForceDelayLoad: Boolean);
  150. procedure CodeRunnerOnException(const Exception: AnsiString; const Position: LongInt);
  151. procedure CreateTempInstallDirAndExtract64BitHelper;
  152. procedure DebugNotifyEntry(EntryType: TEntryType; Number: Integer);
  153. procedure DeinitSetup(const AllowCustomSetupExitCode: Boolean);
  154. procedure DeleteResidualTempUninstallDirs;
  155. function ExitSetupMsgBox: Boolean;
  156. function ExpandConst(const S: String): String;
  157. function ExpandConstEx(const S: String; const CustomConsts: array of String): String;
  158. function ExpandConstEx2(const S: String; const CustomConsts: array of String;
  159. const DoExpandIndividualConst: Boolean): String;
  160. function ExpandConstIfPrefixed(const S: String): String;
  161. function GetCustomMessageValue(const AName: String; var AValue: String): Boolean;
  162. function GetShellFolder(const Common: Boolean; const ID: TShellFolderID): String;
  163. function GetShellFolderByCSIDL(Folder: Integer; const Create: Boolean): String;
  164. function GetUninstallRegKeyBaseName(const ExpandedAppId: String): String;
  165. function GetUninstallRegSubkeyName(const UninstallRegKeyBaseName: String): String;
  166. function GetPreviousData(const ExpandedAppID, ValueName, DefaultValueData: String): String;
  167. function GetPreviousLanguage(const ExpandedAppID: String): Integer;
  168. procedure InitializeAdminInstallMode(const AAdminInstallMode: Boolean);
  169. procedure Initialize64BitInstallMode(const A64BitInstallMode: Boolean);
  170. procedure Log64BitInstallMode;
  171. procedure LogArchiveExtractionModeOnce;
  172. procedure InitializeCommonVars;
  173. procedure InitializeSetup;
  174. procedure InitializeWizard;
  175. procedure InitMainNonSHFolderConsts;
  176. function InstallOnThisVersion(const MinVersion: TSetupVersionData;
  177. const OnlyBelowVersion: TSetupVersionData): TInstallOnThisVersionResult;
  178. function IsRecurseableDirectory(const FindData: TWin32FindData): Boolean;
  179. procedure LoadSHFolderDLL;
  180. function LoggedMsgBox(const Text, Caption: PChar; const Flags: Longint;
  181. const Suppressible: Boolean; const Default: Integer): Integer; overload;
  182. function LoggedMsgBox(const Text, Caption: String; const Typ: TMsgBoxType;
  183. const Buttons: Cardinal; const Suppressible: Boolean; const Default: Integer): Integer; overload;
  184. function LoggedTaskDialogMsgBox(const Icon, Instruction, Text, Caption: String;
  185. const Typ: TMsgBoxType; const Buttons: Cardinal; const ButtonLabels: array of String;
  186. const ShieldButton: Integer; const Suppressible: Boolean; const Default: Integer;
  187. const VerificationText: String = ''; const pfVerificationFlagChecked: PBOOL = nil): Integer;
  188. procedure LogWindowsVersion;
  189. procedure NotifyAfterInstallEntry(const AfterInstall: String);
  190. procedure NotifyAfterInstallFileEntry(const FileEntry: PSetupFileEntry);
  191. procedure NotifyBeforeInstallEntry(const BeforeInstall: String);
  192. procedure NotifyBeforeInstallFileEntry(const FileEntry: PSetupFileEntry);
  193. function PreviousInstallCompleted(const WizardComponents, WizardTasks: TStringList): Boolean;
  194. function CodeRegisterExtraCloseApplicationsResource(const DisableFsRedir: Boolean; const AFilename: String): Boolean;
  195. procedure RegisterResourcesWithRestartManager(const WizardComponents, WizardTasks: TStringList);
  196. procedure RemoveTempInstallDir;
  197. procedure SaveInf(const FileName: String);
  198. procedure SaveResourceToTempFile(const ResName, Filename: String);
  199. procedure SetActiveLanguage(const I: Integer);
  200. procedure ShellExecuteAsOriginalUser(hWnd: HWND; Operation, FileName, Parameters, Directory: LPWSTR; ShowCmd: Integer); stdcall;
  201. function ShouldDisableFsRedirForFileEntry(const FileEntry: PSetupFileEntry): Boolean;
  202. function ShouldDisableFsRedirForRunEntry(const RunEntry: PSetupRunEntry): Boolean;
  203. procedure ProcessRunEntry(const RunEntry: PSetupRunEntry);
  204. function EvalArchitectureIdentifier(const Name: String): Boolean;
  205. function EvalDirectiveCheck(const Expression: String): Boolean;
  206. function ShouldProcessEntry(const WizardComponents, WizardTasks: TStringList;
  207. const Components, Tasks, Languages, Check: String): Boolean;
  208. function ShouldProcessFileEntry(const WizardComponents, WizardTasks: TStringList;
  209. const FileEntry: PSetupFileEntry; const IgnoreCheck: Boolean): Boolean;
  210. function ShouldProcessIconEntry(const WizardComponents, WizardTasks: TStringList;
  211. const WizardNoIcons: Boolean; const IconEntry: PSetupIconEntry): Boolean;
  212. function ShouldProcessRunEntry(const WizardComponents, WizardTasks: TStringList;
  213. const RunEntry: PSetupRunEntry): Boolean;
  214. procedure UnloadSHFolderDLL;
  215. function WindowsVersionAtLeast(const AMajor, AMinor: Byte; const ABuild: Word = 0): Boolean;
  216. function IsWindows8: Boolean;
  217. function IsWindows10: Boolean;
  218. function IsWindows11: Boolean;
  219. implementation
  220. uses
  221. ShellAPI, ShlObj, StrUtils, ActiveX, RegStr, Imaging.pngimage, Themes,
  222. ChaCha20, ECDSA, ISSigFunc, BidiCtrls,
  223. SetupLdrAndSetup.Messages, Shared.SetupMessageIDs, Setup.DownloadFileFunc, Setup.ExtractFileFunc,
  224. SetupLdrAndSetup.InstFunc, Setup.InstFunc, Setup.RedirFunc, PathFunc,
  225. Compression.Base, Compression.Zlib, Compression.bzlib, Compression.LZMADecompressor,
  226. Shared.SetupEntFunc, Shared.EncryptionFunc, Setup.SelectLanguageForm,
  227. Setup.WizardForm, Setup.DebugClient, Shared.VerInfoFunc, Setup.FileExtractor,
  228. Shared.FileClass, Setup.LoggingFunc, StringScanner,
  229. SimpleExpression, Setup.Helper, Setup.SpawnClient, Setup.SpawnServer,
  230. Setup.DotNetFunc, Shared.TaskDialogFunc, Setup.MainForm, Compression.SevenZipDecoder,
  231. Compression.SevenZipDLLDecoder;
  232. var
  233. ShellFolders: array[Boolean, TShellFolderID] of String;
  234. ShellFoldersRead: array[Boolean, TShellFolderID] of Boolean;
  235. SHFolderDLLHandle: HMODULE;
  236. SHGetFolderPathFunc: function(hwndOwner: HWND; nFolder: Integer;
  237. hToken: THandle; dwFlags: DWORD; pszPath: PChar): HRESULT; stdcall;
  238. SHGetKnownFolderPathFunc: function(const rfid: TGUID; dwFlags: DWORD; hToken: THandle;
  239. var ppszPath: PWideChar): HRESULT; stdcall;
  240. DecompressorDLLHandle, SevenZipDLLHandle: HMODULE;
  241. type
  242. TDummyClass = class
  243. public
  244. class function ExpandCheckOrInstallConstant(Sender: TSimpleExpression;
  245. const Constant: String): String;
  246. class function EvalInstallIdentifier(Sender: TSimpleExpression;
  247. const Name: String; const Parameters: array of const): Boolean;
  248. class function EvalArchitectureIdentifier(Sender: TSimpleExpression;
  249. const Name: String; const Parameters: array of const): Boolean;
  250. class function EvalComponentOrTaskIdentifier(Sender: TSimpleExpression;
  251. const Name: String; const Parameters: array of const): Boolean;
  252. class function EvalLanguageIdentifier(Sender: TSimpleExpression;
  253. const Name: String; const Parameters: array of const): Boolean;
  254. class function EvalCheckIdentifier(Sender: TSimpleExpression;
  255. const Name: String; const Parameters: array of const): Boolean;
  256. end;
  257. { Misc. functions }
  258. function WindowsVersionAtLeast(const AMajor, AMinor: Byte; const ABuild: Word): Boolean;
  259. begin
  260. Result := WindowsVersion >= Cardinal((AMajor shl 24) or (AMinor shl 16) or ABuild);
  261. end;
  262. function IsWindows8: Boolean;
  263. begin
  264. Result := WindowsVersionAtLeast(6, 2);
  265. end;
  266. function IsWindows10: Boolean;
  267. begin
  268. Result := WindowsVersionAtLeast(10, 0);
  269. end;
  270. function IsWindows11: Boolean;
  271. begin
  272. Result := WindowsVersionAtLeast(10, 0, 22000);
  273. end;
  274. function GetUninstallRegKeyBaseName(const ExpandedAppId: String): String;
  275. var
  276. UseAnsiCRC32: Boolean;
  277. S: AnsiString;
  278. I: Integer;
  279. begin
  280. { Set uninstall registry key base name }
  281. Result := ExpandedAppId;
  282. { Uninstall registry keys can only be up to 63 characters, otherwise Win95
  283. ignores them. Limit to 57 since Setup will add _isXXX to the end later. }
  284. if Length(Result) > 57 then begin
  285. { Only keep the first 48 characters, then add an tilde and the CRC
  286. of the original string (to make the trimmed string unique). The
  287. resulting string is 57 characters long. On Unicode, only do this if we
  288. can get a CRC32 compatible with ANSI versions, else there's no point
  289. in shortening since Unicode doesn't run on Win95. }
  290. UseAnsiCRC32 := True;
  291. for I := 1 to Length(Result) do begin
  292. if Ord(Result[I]) > 126 then begin
  293. UseAnsiCRC32 := False;
  294. Break;
  295. end;
  296. end;
  297. if UseAnsiCRC32 then begin
  298. S := AnsiString(Result);
  299. FmtStr(Result, '%.48s~%.8x', [Result, GetCRC32(S[1], Length(S)*SizeOf(S[1]))]);
  300. end;
  301. end;
  302. end;
  303. function GetUninstallRegSubkeyName(const UninstallRegKeyBaseName: String): String;
  304. begin
  305. Result := Format('%s\%s_is1', [REGSTR_PATH_UNINSTALL, UninstallRegKeyBaseName]);
  306. end;
  307. { Based on FindPreviousData in Wizard.pas }
  308. function GetPreviousData(const ExpandedAppID, ValueName, DefaultValueData: String): String;
  309. var
  310. H: HKEY;
  311. begin
  312. Result := DefaultValueData;
  313. if ExpandedAppId <> '' then begin
  314. if RegOpenKeyExView(InstallDefaultRegView, InstallModeRootKey,
  315. PChar(GetUninstallRegSubkeyName(GetUninstallRegKeyBaseName(ExpandedAppId))),
  316. 0, KEY_QUERY_VALUE, H) = ERROR_SUCCESS then begin
  317. try
  318. RegQueryStringValue (H, PChar(ValueName), Result);
  319. finally
  320. RegCloseKey (H);
  321. end;
  322. end;
  323. end;
  324. end;
  325. function GetPreviousLanguage(const ExpandedAppID: String): Integer;
  326. var
  327. PrevLang: String;
  328. I: Integer;
  329. begin
  330. { do not localize or change the following string }
  331. PrevLang := GetPreviousData(ExpandConst(SetupHeader.AppId), 'Inno Setup: Language', '');
  332. if PrevLang <> '' then begin
  333. for I := 0 to Entries[seLanguage].Count-1 do begin
  334. if CompareText(PrevLang, PSetupLanguageEntry(Entries[seLanguage][I]).Name) = 0 then begin
  335. Result := I;
  336. Exit;
  337. end;
  338. end;
  339. end;
  340. Result := -1;
  341. end;
  342. class function TDummyClass.ExpandCheckOrInstallConstant(Sender: TSimpleExpression;
  343. const Constant: String): String;
  344. begin
  345. Result := ExpandConst(Constant);
  346. end;
  347. class function TDummyClass.EvalInstallIdentifier(Sender: TSimpleExpression;
  348. const Name: String; const Parameters: array of const): Boolean;
  349. begin
  350. CodeRunner.RunProcedure(AnsiString(Name), Parameters, True);
  351. Result := True; { Result doesn't matter }
  352. end;
  353. procedure NotifyInstallEntry(const Install: String);
  354. procedure EvalInstall(const Expression: String);
  355. var
  356. SimpleExpression: TSimpleExpression;
  357. begin
  358. try
  359. SimpleExpression := TSimpleExpression.Create;
  360. try
  361. SimpleExpression.Expression := Expression;
  362. SimpleExpression.OnEvalIdentifier := TDummyClass.EvalInstallIdentifier;
  363. SimpleExpression.OnExpandConstant := TDummyClass.ExpandCheckOrInstallConstant;
  364. SimpleExpression.ParametersAllowed := True;
  365. SimpleExpression.SingleIdentifierMode := True;
  366. SimpleExpression.Eval;
  367. finally
  368. SimpleExpression.Free;
  369. end;
  370. except
  371. InternalError(Format('Expression error ''%s''', [GetExceptMessage]));
  372. end;
  373. end;
  374. begin
  375. if Install <> '' then begin
  376. try
  377. if CodeRunner = nil then
  378. InternalError('"BeforeInstall" or "AfterInstall" parameter with no CodeRunner');
  379. EvalInstall(Install);
  380. except
  381. { Don't allow exceptions raised by Before/AfterInstall functions to be propagated out }
  382. Application.HandleException(nil);
  383. end;
  384. end;
  385. end;
  386. procedure NotifyBeforeInstallEntry(const BeforeInstall: String);
  387. begin
  388. NotifyInstallEntry(BeforeInstall);
  389. end;
  390. procedure NotifyBeforeInstallFileEntry(const FileEntry: PSetupFileEntry);
  391. begin
  392. CheckOrInstallCurrentFilename := FileEntry.DestName;
  393. CheckOrInstallCurrentSourceFilename := FileEntry.SourceFilename;
  394. NotifyInstallEntry(FileEntry.BeforeInstall);
  395. CheckOrInstallCurrentFilename := '';
  396. CheckOrInstallCurrentSourceFilename := '';
  397. end;
  398. procedure NotifyAfterInstallEntry(const AfterInstall: String);
  399. begin
  400. NotifyInstallEntry(AfterInstall);
  401. end;
  402. procedure NotifyAfterInstallFileEntry(const FileEntry: PSetupFileEntry);
  403. begin
  404. CheckOrInstallCurrentFilename := FileEntry.DestName;
  405. CheckOrInstallCurrentSourceFilename := FileEntry.SourceFilename;
  406. NotifyInstallEntry(FileEntry.AfterInstall);
  407. CheckOrInstallCurrentFilename := '';
  408. CheckOrInstallCurrentSourceFilename := '';
  409. end;
  410. function EvalArchitectureIdentifier(const Name: String): Boolean;
  411. type
  412. TArchIdentifierRec = record
  413. Name: String;
  414. Arch: TSetupProcessorArchitecture;
  415. Compatible: Boolean;
  416. end;
  417. const
  418. { Valid identifier 'win64' is not in this list but treated specially below }
  419. ArchIdentifiers: array[0..7] of TArchIdentifierRec = (
  420. (Name: 'arm32compatible'; Arch: paArm32; Compatible: True),
  421. (Name: 'arm64'; Arch: paArm64; Compatible: False),
  422. (Name: 'x64'; Arch: paX64; Compatible: False),
  423. (Name: 'x64os'; Arch: paX64; Compatible: False),
  424. (Name: 'x64compatible'; Arch: paX64; Compatible: True),
  425. (Name: 'x86'; Arch: paX86; Compatible: False),
  426. (Name: 'x86os'; Arch: paX86; Compatible: False),
  427. (Name: 'x86compatible'; Arch: paX86; Compatible: True));
  428. begin
  429. if Name = 'win64' then
  430. Exit(IsWin64);
  431. for var ArchIdentifier in ArchIdentifiers do
  432. if ArchIdentifier.Name = Name then begin
  433. if ArchIdentifier.Compatible then
  434. Exit(ArchIdentifier.Arch in MachineTypesSupportedBySystem)
  435. else { An exact match is requested instead of anything compatible, perhaps
  436. for a driver install or something similar }
  437. Exit(ProcessorArchitecture = ArchIdentifier.Arch);
  438. end;
  439. raise Exception.CreateFmt('Unknown architecture ''%s''', [Name]);
  440. end;
  441. class function TDummyClass.EvalArchitectureIdentifier(Sender: TSimpleExpression;
  442. const Name: String; const Parameters: array of const): Boolean;
  443. begin
  444. Result := Setup.MainFunc.EvalArchitectureIdentifier(Name);
  445. end;
  446. class function TDummyClass.EvalComponentOrTaskIdentifier(Sender: TSimpleExpression;
  447. const Name: String; const Parameters: array of const): Boolean;
  448. var
  449. WizardItems: TStringList;
  450. begin
  451. WizardItems := TStringList(Sender.Tag);
  452. Result := ListContains(WizardItems, Name);
  453. end;
  454. class function TDummyClass.EvalLanguageIdentifier(Sender: TSimpleExpression;
  455. const Name: String; const Parameters: array of const): Boolean;
  456. begin
  457. Result := CompareText(PSetupLanguageEntry(Entries[seLanguage][ActiveLanguage]).Name, Name) = 0;
  458. end;
  459. class function TDummyClass.EvalCheckIdentifier(Sender: TSimpleExpression;
  460. const Name: String; const Parameters: array of const): Boolean;
  461. begin
  462. Result := CodeRunner.RunBooleanFunction(AnsiString(Name), Parameters, True, False);
  463. end;
  464. function EvalCheck(const Expression: String): Boolean;
  465. var
  466. SimpleExpression: TSimpleExpression;
  467. begin
  468. try
  469. SimpleExpression := TSimpleExpression.Create;
  470. try
  471. SimpleExpression.Lazy := True;
  472. SimpleExpression.Expression := Expression;
  473. SimpleExpression.OnEvalIdentifier := TDummyClass.EvalCheckIdentifier;
  474. SimpleExpression.OnExpandConstant := TDummyClass.ExpandCheckOrInstallConstant;
  475. SimpleExpression.ParametersAllowed := True;
  476. SimpleExpression.SilentOrAllowed := False;
  477. SimpleExpression.SingleIdentifierMode := False;
  478. Result := SimpleExpression.Eval;
  479. finally
  480. SimpleExpression.Free;
  481. end;
  482. except
  483. InternalError(Format('Expression error ''%s''', [GetExceptMessage]));
  484. Result := False;
  485. end;
  486. end;
  487. function EvalDirectiveCheck(const Expression: String): Boolean;
  488. begin
  489. if not TryStrToBoolean(Expression, Result) then
  490. Result := EvalCheck(Expression);
  491. end;
  492. function EvalExpression(const Expression: String;
  493. OnEvalIdentifier: TSimpleExpressionOnEvalIdentifier; Tag: LongInt = 0): Boolean;
  494. var
  495. SimpleExpression: TSimpleExpression;
  496. begin
  497. try
  498. SimpleExpression := TSimpleExpression.Create;
  499. try
  500. SimpleExpression.Lazy := True;
  501. SimpleExpression.Expression := Expression;
  502. SimpleExpression.OnEvalIdentifier := OnEvalIdentifier;
  503. SimpleExpression.ParametersAllowed := False;
  504. SimpleExpression.SilentOrAllowed := True;
  505. SimpleExpression.SingleIdentifierMode := False;
  506. SimpleExpression.Tag := Tag;
  507. Result := SimpleExpression.Eval;
  508. finally
  509. SimpleExpression.Free;
  510. end;
  511. except
  512. InternalError(Format('Expression error ''%s''', [GetExceptMessage]));
  513. Result := False;
  514. end;
  515. end;
  516. function ShouldProcessEntry(const WizardComponents, WizardTasks: TStringList;
  517. const Components, Tasks, Languages, Check: String): Boolean;
  518. var
  519. ProcessComponent, ProcessTask, ProcessLanguage: Boolean;
  520. begin
  521. if (Components <> '') or (Tasks <> '') or (Languages <> '') or (Check <> '') then begin
  522. if (Components <> '') and (WizardComponents <> nil) then
  523. ProcessComponent := EvalExpression(Components, TDummyClass.EvalComponentOrTaskIdentifier, LongInt(WizardComponents))
  524. else
  525. ProcessComponent := True;
  526. if (Tasks <> '') and (WizardTasks <> nil) then
  527. ProcessTask := EvalExpression(Tasks, TDummyClass.EvalComponentOrTaskIdentifier, LongInt(WizardTasks))
  528. else
  529. ProcessTask := True;
  530. if Languages <> '' then
  531. ProcessLanguage := EvalExpression(Languages, TDummyClass.EvalLanguageIdentifier)
  532. else
  533. ProcessLanguage := True;
  534. Result := ProcessComponent and ProcessTask and ProcessLanguage;
  535. if Result and (Check <> '') then begin
  536. try
  537. if CodeRunner = nil then
  538. InternalError('"Check" parameter with no CodeRunner');
  539. Result := EvalCheck(Check);
  540. except
  541. { Don't allow exceptions raised by Check functions to be propagated out }
  542. Application.HandleException(nil);
  543. Result := False;
  544. end;
  545. end;
  546. end else
  547. Result := True;
  548. end;
  549. function ShouldProcessFileEntry(const WizardComponents, WizardTasks: TStringList;
  550. const FileEntry: PSetupFileEntry; const IgnoreCheck: Boolean): Boolean;
  551. begin
  552. if foDontCopy in FileEntry.Options then begin
  553. Result := False;
  554. Exit;
  555. end;
  556. CheckOrInstallCurrentFilename := FileEntry.DestName;
  557. CheckOrInstallCurrentSourceFilename := FileEntry.SourceFilename;
  558. if IgnoreCheck then
  559. Result := ShouldProcessEntry(WizardComponents, WizardTasks, FileEntry.Components, FileEntry.Tasks, FileEntry.Languages, '')
  560. else
  561. Result := ShouldProcessEntry(WizardComponents, WizardTasks, FileEntry.Components, FileEntry.Tasks, FileEntry.Languages, FileEntry.Check);
  562. CheckOrInstallCurrentFilename := '';
  563. CheckOrInstallCurrentSourceFilename := '';
  564. end;
  565. function ShouldProcessRunEntry(const WizardComponents, WizardTasks: TStringList;
  566. const RunEntry: PSetupRunEntry): Boolean;
  567. begin
  568. if (InstallMode <> imNormal) and (roSkipIfSilent in RunEntry.Options) then
  569. Result := False
  570. else if (InstallMode = imNormal) and (roSkipIfNotSilent in RunEntry.Options) then
  571. Result := False
  572. else
  573. Result := ShouldProcessEntry(WizardComponents, WizardTasks, RunEntry.Components, RunEntry.Tasks, RunEntry.Languages, RunEntry.Check);
  574. end;
  575. function ShouldProcessIconEntry(const WizardComponents, WizardTasks: TStringList;
  576. const WizardNoIcons: Boolean; const IconEntry: PSetupIconEntry): Boolean;
  577. begin
  578. if WizardNoIcons and (IconEntry.Tasks = '') and
  579. (Copy(IconEntry.IconName, 1, 8) = '{group}\') then
  580. Result := False
  581. else
  582. Result := ShouldProcessEntry(WizardComponents, WizardTasks, IconEntry.Components, IconEntry.Tasks, IconEntry.Languages, IconEntry.Check);
  583. end;
  584. function ShouldDisableFsRedirForFileEntry(const FileEntry: PSetupFileEntry): Boolean;
  585. begin
  586. Result := InstallDefaultDisableFsRedir;
  587. if fo32Bit in FileEntry.Options then
  588. Result := False;
  589. if fo64Bit in FileEntry.Options then begin
  590. if not IsWin64 then
  591. InternalError('Cannot install files to 64-bit locations on this version of Windows');
  592. Result := True;
  593. end;
  594. end;
  595. function SlashesToBackslashes(const S: String): String;
  596. var
  597. I: Integer;
  598. begin
  599. Result := S;
  600. for I := 1 to Length(Result) do
  601. if Result[I] = '/' then
  602. Result[I] := '\';
  603. end;
  604. procedure LoadInf(const FileName: String; var WantToSuppressMsgBoxes: Boolean);
  605. const
  606. Section = 'Setup';
  607. var
  608. S: String;
  609. begin
  610. //saved infs
  611. InitLang := GetIniString(Section, 'Lang', InitLang, FileName);
  612. InitDir := GetIniString(Section, 'Dir', InitDir, FileName);
  613. InitProgramGroup := GetIniString(Section, 'Group', InitProgramGroup, FileName);
  614. InitNoIcons := GetIniBool(Section, 'NoIcons', InitNoIcons, FileName);
  615. InitSetupType := GetIniString(Section, 'SetupType', InitSetupType, FileName);
  616. S := GetIniString(Section, 'Components', '$', FileName);
  617. if S <> '$' then begin
  618. InitComponentsSpecified := True;
  619. SetStringsFromCommaString(InitComponents, SlashesToBackslashes(S));
  620. end;
  621. S := GetIniString(Section, 'Tasks', '$', FileName);
  622. if S <> '$' then begin
  623. InitDeselectAllTasks := True;
  624. SetStringsFromCommaString(InitTasks, SlashesToBackslashes(S));
  625. end;
  626. //non saved infs (=non user settable)
  627. InitSilent := GetIniBool(Section, 'Silent', InitSilent, FileName);
  628. InitVerySilent := GetIniBool(Section, 'VerySilent', InitVerySilent, FileName);
  629. InitNoRestart := GetIniBool(Section, 'NoRestart', InitNoRestart, FileName);
  630. InitCloseApplications := GetIniBool(Section, 'CloseApplications', InitCloseApplications, FileName);
  631. InitNoCloseApplications := GetIniBool(Section, 'NoCloseApplications', InitNoCloseApplications, FileName);
  632. InitForceCloseApplications := GetIniBool(Section, 'ForceCloseApplications', InitForceCloseApplications, FileName);
  633. InitNoForceCloseApplications := GetIniBool(Section, 'NoForceCloseApplications', InitNoForceCloseApplications, FileName);
  634. InitLogCloseApplications := GetIniBool(Section, 'LogCloseApplications', InitLogCloseApplications, FileName);
  635. InitRestartApplications := GetIniBool(Section, 'RestartApplications', InitRestartApplications, FileName);
  636. InitNoRestartApplications := GetIniBool(Section, 'NoRestartApplications', InitNoRestartApplications, FileName);
  637. InitNoCancel := GetIniBool(Section, 'NoCancel', InitNoCancel, FileName);
  638. InitNoStyle := GetIniBool(Section, 'NoStyle', InitNoStyle, FileName);
  639. InitPassword := GetIniString(Section, 'Password', InitPassword, FileName);
  640. InitRestartExitCode := GetIniInt(Section, 'RestartExitCode', InitRestartExitCode, 0, 0, FileName);
  641. WantToSuppressMsgBoxes := GetIniBool(Section, 'SuppressMsgBoxes', WantToSuppressMsgBoxes, FileName);
  642. InitSaveInf := GetIniString(Section, 'SaveInf', InitSaveInf, FileName);
  643. end;
  644. procedure SaveInf(const FileName: String);
  645. const
  646. Section = 'Setup';
  647. begin
  648. SetIniString(Section, 'Lang',
  649. PSetupLanguageEntry(Entries[seLanguage][ActiveLanguage]).Name, FileName);
  650. SetIniString(Section, 'Dir', WizardDirValue, FileName);
  651. SetIniString(Section, 'Group', WizardGroupValue, FileName);
  652. SetIniBool(Section, 'NoIcons', WizardNoIcons, FileName);
  653. if WizardSetupType <> nil then begin
  654. SetIniString(Section, 'SetupType', WizardSetupType.Name, FileName);
  655. SetIniString(Section, 'Components', StringsToCommaString(WizardComponents), FileName);
  656. end
  657. else begin
  658. DeleteIniEntry(Section, 'SetupType', FileName);
  659. DeleteIniEntry(Section, 'Components', FileName);
  660. end;
  661. SetIniString(Section, 'Tasks', StringsToCommaString(WizardTasks), FileName);
  662. end;
  663. function GetCustomMessageValue(const AName: String; var AValue: String): Boolean;
  664. var
  665. I: Integer;
  666. begin
  667. Result := False;
  668. for I := 0 to Entries[seCustomMessage].Count-1 do begin
  669. with PSetupCustomMessageEntry(Entries[seCustomMessage][I])^ do begin
  670. if (CompareText(Name, AName) = 0) and
  671. ((LangIndex = -1) or (LangIndex = ActiveLanguage)) then begin
  672. Result := True;
  673. AValue := Value;
  674. { don't stop looping, last item counts }
  675. end;
  676. end;
  677. end;
  678. end;
  679. function ExpandIndividualConst(Cnst: String;
  680. const CustomConsts: array of String): String;
  681. { Cnst must be the name of a single constant, without the braces.
  682. For example: app
  683. IsPath is set to True if the result is a path which needs special trailing-
  684. backslash handling. }
  685. procedure HandleAutoConstants(var Cnst: String);
  686. const
  687. Actual: array [Boolean] of String = ('user', 'common');
  688. begin
  689. if Copy(Cnst, 1, 4) = 'auto' then begin
  690. StringChange(Cnst, 'auto', Actual[IsAdminInstallMode]);
  691. if (Cnst = 'userpf32') or (Cnst = 'userpf64') or
  692. (Cnst = 'usercf32') or (Cnst = 'usercf64') then
  693. Delete(Cnst, Length(Cnst)-1, 2);
  694. end;
  695. end;
  696. procedure NoUninstallConstError(const C: String);
  697. begin
  698. InternalError(Format('Cannot evaluate "%s" constant during Uninstall', [C]));
  699. end;
  700. function ExpandEnvConst(C: String): String;
  701. var
  702. I: Integer;
  703. VarName, Default: String;
  704. begin
  705. Delete(C, 1, 1);
  706. I := ConstPos('|', C); { check for 'default' value }
  707. if I = 0 then
  708. I := Length(C)+1;
  709. VarName := Copy(C, 1, I-1);
  710. Default := Copy(C, I+1, Maxint);
  711. Result := '';
  712. if ConvertConstPercentStr(VarName) and ConvertConstPercentStr(Default) then begin
  713. Result := GetEnv(ExpandConstEx(VarName, CustomConsts));
  714. if Result = '' then
  715. Result := ExpandConstEx(Default, CustomConsts);
  716. end;
  717. end;
  718. function ExpandRegConst(C: String): String;
  719. { Expands a registry-value constant in the form:
  720. reg:HKxx\SubkeyName,ValueName|DefaultValue }
  721. type
  722. TKeyNameConst = packed record
  723. KeyName: String;
  724. KeyConst: HKEY;
  725. end;
  726. const
  727. KeyNameConsts: array[0..5] of TKeyNameConst = (
  728. (KeyName: 'HKA'; KeyConst: HKEY_AUTO),
  729. (KeyName: 'HKCR'; KeyConst: HKEY_CLASSES_ROOT),
  730. (KeyName: 'HKCU'; KeyConst: HKEY_CURRENT_USER),
  731. (KeyName: 'HKLM'; KeyConst: HKEY_LOCAL_MACHINE),
  732. (KeyName: 'HKU'; KeyConst: HKEY_USERS),
  733. (KeyName: 'HKCC'; KeyConst: HKEY_CURRENT_CONFIG));
  734. var
  735. Z, Subkey, Value, Default: String;
  736. I, J, L: Integer;
  737. RegView: TRegView;
  738. RootKey: HKEY;
  739. K: HKEY;
  740. begin
  741. Delete(C, 1, 4); { skip past 'reg:' }
  742. I := ConstPos('\', C);
  743. if I <> 0 then begin
  744. Z := Copy(C, 1, I-1);
  745. if Z <> '' then begin
  746. RegView := InstallDefaultRegView;
  747. L := Length(Z);
  748. if L >= 2 then begin
  749. { Check for '32' or '64' suffix }
  750. if (Z[L-1] = '3') and (Z[L] = '2') then begin
  751. RegView := rv32Bit;
  752. SetLength(Z, L-2);
  753. end
  754. else if (Z[L-1] = '6') and (Z[L] = '4') then begin
  755. if not IsWin64 then
  756. InternalError('Cannot access a 64-bit key in a "reg" constant on this version of Windows');
  757. RegView := rv64Bit;
  758. SetLength(Z, L-2);
  759. end;
  760. end;
  761. RootKey := 0;
  762. for J := Low(KeyNameConsts) to High(KeyNameConsts) do
  763. if CompareText(KeyNameConsts[J].KeyName, Z) = 0 then begin
  764. RootKey := KeyNameConsts[J].KeyConst;
  765. if RootKey = HKEY_AUTO then
  766. RootKey := InstallModeRootKey;
  767. Break;
  768. end;
  769. if RootKey <> 0 then begin
  770. Z := Copy(C, I+1, Maxint);
  771. I := ConstPos('|', Z); { check for a 'default' data }
  772. if I = 0 then
  773. I := Length(Z)+1;
  774. Default := Copy(Z, I+1, Maxint);
  775. SetLength(Z, I-1);
  776. I := ConstPos(',', Z); { comma separates subkey and value }
  777. if I <> 0 then begin
  778. Subkey := Copy(Z, 1, I-1);
  779. Value := Copy(Z, I+1, Maxint);
  780. if ConvertConstPercentStr(Subkey) and ConvertConstPercentStr(Value) and
  781. ConvertConstPercentStr(Default) then begin
  782. Result := ExpandConstEx(Default, CustomConsts);
  783. if RegOpenKeyExView(RegView, RootKey,
  784. PChar(ExpandConstEx(Subkey, CustomConsts)),
  785. 0, KEY_QUERY_VALUE, K) = ERROR_SUCCESS then begin
  786. RegQueryStringValue(K, PChar(ExpandConstEx(Value, CustomConsts)),
  787. Result, True); { also allows REG_DWORD }
  788. RegCloseKey(K);
  789. end;
  790. Exit;
  791. end;
  792. end;
  793. end;
  794. end;
  795. end;
  796. { it will only reach here if there was a parsing error }
  797. InternalError('Failed to parse "reg" constant');
  798. end;
  799. function ExpandIniConst(C: String): String;
  800. { Expands an INI-value constant in the form:
  801. filename,section,key|defaultvalue }
  802. var
  803. Z, Filename, Section, Key, Default: String;
  804. I: Integer;
  805. begin
  806. Delete(C, 1, 4); { skip past 'ini:' }
  807. I := ConstPos(',', C);
  808. if I <> 0 then begin
  809. Z := Copy(C, 1, I-1);
  810. if Z <> '' then begin
  811. Filename := Z;
  812. Z := Copy(C, I+1, Maxint);
  813. I := ConstPos('|', Z); { check for a 'default' data }
  814. if I = 0 then
  815. I := Length(Z)+1;
  816. Default := Copy(Z, I+1, Maxint);
  817. SetLength(Z, I-1);
  818. I := ConstPos(',', Z); { comma separates section and key }
  819. if I <> 0 then begin
  820. Section := Copy(Z, 1, I-1);
  821. Key := Copy(Z, I+1, Maxint);
  822. if ConvertConstPercentStr(Filename) and ConvertConstPercentStr(Section) and ConvertConstPercentStr(Key) and
  823. ConvertConstPercentStr(Default) then begin
  824. Filename := ExpandConstEx(Filename, CustomConsts);
  825. Section := ExpandConstEx(Section, CustomConsts);
  826. Key := ExpandConstEx(Key, CustomConsts);
  827. Default := ExpandConstEx(Default, CustomConsts);
  828. Result := GetIniString(Section, Key, Default, Filename);
  829. Exit;
  830. end;
  831. end;
  832. end;
  833. end;
  834. { it will only reach here if there was a parsing error }
  835. InternalError('Failed to parse "ini" constant');
  836. end;
  837. function ExpandParamConst(C: String): String;
  838. { Expands an commandline-parameter-value constant in the form:
  839. parametername|defaultvalue }
  840. function GetParamString(const Param, Default: String): String;
  841. var
  842. I, PCount: Integer;
  843. Z: String;
  844. begin
  845. PCount := NewParamCount();
  846. for I := 1 to PCount do begin
  847. Z := NewParamStr(I);
  848. if StrLIComp(PChar(Z), PChar('/'+Param+'='), Length(Param)+2) = 0 then begin
  849. Delete(Z, 1, Length(Param)+2);
  850. Result := Z;
  851. Exit;
  852. end;
  853. end;
  854. Result := Default;
  855. end;
  856. var
  857. Z, Param, Default: String;
  858. I: Integer;
  859. begin
  860. Delete(C, 1, 6); { skip past 'param:' }
  861. Z := C;
  862. I := ConstPos('|', Z); { check for a 'default' data }
  863. if I = 0 then
  864. I := Length(Z)+1;
  865. Default := Copy(Z, I+1, Maxint);
  866. SetLength(Z, I-1);
  867. Param := Z;
  868. if ConvertConstPercentStr(Param) and ConvertConstPercentStr(Default) then begin
  869. Param := ExpandConstEx(Param, CustomConsts);
  870. Default := ExpandConstEx(Default, CustomConsts);
  871. Result := GetParamString(Param, Default);
  872. Exit;
  873. end;
  874. { it will only reach here if there was a parsing error }
  875. InternalError('Failed to parse "param" constant');
  876. end;
  877. function ExpandCodeConst(C: String): String;
  878. { Expands an Pascal-script-value constant in the form:
  879. parametername|defaultvalue }
  880. function GetCodeString(const ScriptFunc, Default: String): String;
  881. begin
  882. if (CodeRunner <> nil) then
  883. Result := CodeRunner.RunStringFunction(AnsiString(ScriptFunc), [Default], True, Default)
  884. else begin
  885. InternalError('"code" constant with no CodeRunner');
  886. Result := '';
  887. end;
  888. end;
  889. var
  890. Z, ScriptFunc, Default: String;
  891. I: Integer;
  892. begin
  893. if DisableCodeConsts <> 0 then
  894. raise Exception.Create('Cannot evaluate "code" constant because of possible side effects');
  895. Delete(C, 1, 5); { skip past 'code:' }
  896. Z := C;
  897. I := ConstPos('|', Z); { check for a 'default' data }
  898. if I = 0 then
  899. I := Length(Z)+1;
  900. Default := Copy(Z, I+1, Maxint);
  901. SetLength(Z, I-1);
  902. ScriptFunc := Z;
  903. if ConvertConstPercentStr(ScriptFunc) and ConvertConstPercentStr(Default) then begin
  904. Default := ExpandConstEx(Default, CustomConsts);
  905. Result := GetCodeString(ScriptFunc, Default);
  906. Exit;
  907. end;
  908. { it will only reach here if there was a parsing error }
  909. InternalError('Failed to parse "code" constant');
  910. end;
  911. function ExpandDriveConst(C: String): String;
  912. begin
  913. Delete(C, 1, 6); { skip past 'drive:' }
  914. if ConvertConstPercentStr(C) then begin
  915. Result := PathExtractDrive(ExpandConstEx(C, CustomConsts));
  916. Exit;
  917. end;
  918. { it will only reach here if there was a parsing error }
  919. InternalError('Failed to parse "drive" constant');
  920. end;
  921. function ExpandCustomMessageConst(C: String): String;
  922. var
  923. I, ArgCount: Integer;
  924. MsgName: String;
  925. ArgValues: array[0..8] of String; { %1 through %9 }
  926. begin
  927. Delete(C, 1, 3); { skip past 'cm:' }
  928. I := ConstPos(',', C);
  929. if I = 0 then
  930. MsgName := C
  931. else
  932. MsgName := Copy(C, 1, I-1);
  933. { Prepare arguments. Excess arguments are ignored. }
  934. ArgCount := 0;
  935. while (I > 0) and (ArgCount <= High(ArgValues)) do begin
  936. Delete(C, 1, I);
  937. I := ConstPos(',', C);
  938. if I = 0 then
  939. ArgValues[ArgCount] := C
  940. else
  941. ArgValues[ArgCount] := Copy(C, 1, I-1);
  942. if not ConvertConstPercentStr(ArgValues[ArgCount]) then
  943. InternalError('Failed to parse "cm" constant');
  944. ArgValues[ArgCount] := ExpandConstEx(ArgValues[ArgCount], CustomConsts);
  945. Inc(ArgCount);
  946. end;
  947. { Look up the message value }
  948. if not GetCustomMessageValue(MsgName, Result) then
  949. InternalError(Format('Unknown custom message name "%s" in "cm" constant', [MsgName]));
  950. { Expand the message }
  951. Result := FmtMessage(PChar(Result), Slice(ArgValues, ArgCount));
  952. end;
  953. const
  954. FolderConsts: array[Boolean, TShellFolderID] of String = (
  955. { Also see FolderIDs }
  956. { User }
  957. ('userdesktop', 'userstartmenu', 'userprograms', 'userstartup',
  958. 'usersendto', 'commonfonts', 'userappdata', 'userdocs', 'usertemplates',
  959. 'userfavorites', 'localappdata', 'userpf', 'usercf', 'usersavedgames'),
  960. { Common }
  961. ('commondesktop', 'commonstartmenu', 'commonprograms', 'commonstartup',
  962. 'usersendto', 'commonfonts', 'commonappdata', 'commondocs', 'commontemplates',
  963. 'commonfavorites' { not accepted anymore by the compiler }, '', '', '', ''));
  964. NoUninstallConsts: array[0..6] of String =
  965. ('src', 'srcexe', 'userinfoname', 'userinfoorg', 'userinfoserial', 'hwnd',
  966. 'wizardhwnd');
  967. var
  968. OriginalCnst, ShellFolder: String;
  969. Common: Boolean;
  970. ShellFolderID: TShellFolderID;
  971. I: Integer;
  972. begin
  973. OriginalCnst := Cnst;
  974. HandleRenamedConstants(Cnst, nil);
  975. HandleAutoConstants(Cnst);
  976. if IsUninstaller then
  977. for I := Low(NoUninstallConsts) to High(NoUninstallConsts) do
  978. if NoUninstallConsts[I] = Cnst then
  979. NoUninstallConstError(NoUninstallConsts[I]);
  980. if Cnst = '\' then Result := '\'
  981. else if Cnst = 'app' then begin
  982. if IsUninstaller then begin
  983. if UninstallExpandedApp = '' then
  984. InternalError('An attempt was made to expand the "' + OriginalCnst + '" constant but Setup didn''t create the "app" dir');
  985. Result := UninstallExpandedApp;
  986. end else begin
  987. if WizardDirValue = '' then
  988. InternalError('An attempt was made to expand the "' + OriginalCnst + '" constant before it was initialized');
  989. Result := WizardDirValue;
  990. end;
  991. end
  992. else if Cnst = 'win' then Result := WinDir
  993. else if Cnst = 'sys' then Result := WinSystemDir
  994. else if Cnst = 'syswow64' then begin
  995. if WinSysWow64Dir <> '' then
  996. Result := WinSysWow64Dir
  997. else begin
  998. if IsWin64 then { sanity check }
  999. InternalError('Cannot expand "' + OriginalCnst + '" constant because there is no SysWOW64 directory');
  1000. Result := WinSystemDir;
  1001. end;
  1002. end
  1003. else if Cnst = 'sysnative' then begin
  1004. if WinSysNativeDir <> '' then
  1005. Result := WinSysNativeDir
  1006. else
  1007. Result := WinSystemDir;
  1008. end
  1009. else if Cnst = 'src' then Result := SourceDir
  1010. else if Cnst = 'srcexe' then Result := SetupLdrOriginalFilename
  1011. else if Cnst = 'tmp' then Result := TempInstallDir
  1012. else if Cnst = 'sd' then Result := SystemDrive
  1013. else if Cnst = 'commonpf' then begin
  1014. if Is64BitInstallMode then
  1015. Result := ProgramFiles64Dir
  1016. else
  1017. Result := ProgramFiles32Dir;
  1018. end
  1019. else if Cnst = 'commoncf' then begin
  1020. if Is64BitInstallMode then
  1021. Result := CommonFiles64Dir
  1022. else
  1023. Result := CommonFiles32Dir;
  1024. end
  1025. else if Cnst = 'commonpf32' then Result := ProgramFiles32Dir
  1026. else if Cnst = 'commoncf32' then Result := CommonFiles32Dir
  1027. else if Cnst = 'commonpf64' then begin
  1028. if IsWin64 then
  1029. Result := ProgramFiles64Dir
  1030. else
  1031. InternalError('Cannot expand "' + OriginalCnst + '" constant on this version of Windows');
  1032. end
  1033. else if Cnst = 'commoncf64' then begin
  1034. if IsWin64 then
  1035. Result := CommonFiles64Dir
  1036. else
  1037. InternalError('Cannot expand "' + OriginalCnst + '" constant on this version of Windows');
  1038. end
  1039. else if Cnst = 'userfonts' then Result := ExpandConst('{localappdata}\Microsoft\Windows\Fonts') { supported by Windows 10 Version 1803 and newer. doesn't have a KNOWNFOLDERID. }
  1040. else if Cnst = 'dao' then Result := ExpandConst('{cf}\Microsoft Shared\DAO')
  1041. else if Cnst = 'cmd' then Result := CmdFilename
  1042. else if Cnst = 'computername' then Result := GetComputerNameString
  1043. else if Cnst = 'username' then Result := GetUserNameString
  1044. else if Cnst = 'groupname' then begin
  1045. if IsUninstaller then begin
  1046. if UninstallExpandedGroupName = '' then
  1047. InternalError('Cannot expand "' + OriginalCnst + '" constant because it was not available at install time');
  1048. Result := UninstallExpandedGroupName;
  1049. end
  1050. else begin
  1051. if WizardGroupValue = '' then
  1052. InternalError('An attempt was made to expand the "' + OriginalCnst + '" constant before it was initialized');
  1053. Result := WizardGroupValue;
  1054. end;
  1055. end
  1056. else if Cnst = 'sysuserinfoname' then Result := SysUserInfoName
  1057. else if Cnst = 'sysuserinfoorg' then Result := SysUserInfoOrg
  1058. else if Cnst = 'userinfoname' then Result := WizardUserInfoName
  1059. else if Cnst = 'userinfoorg' then Result := WizardUserInfoOrg
  1060. else if Cnst = 'userinfoserial' then Result := WizardUserInfoSerial
  1061. else if Cnst = 'uninstallexe' then Result := UninstallExeFilename
  1062. else if Cnst = 'group' then begin
  1063. if IsUninstaller then begin
  1064. if UninstallExpandedGroup = '' then
  1065. InternalError('Cannot expand "' + OriginalCnst + '" constant because it was not available at install time');
  1066. Result := UninstallExpandedGroup;
  1067. end
  1068. else begin
  1069. if WizardGroupValue = '' then
  1070. InternalError('An attempt was made to expand the "' + OriginalCnst + '" constant before it was initialized');
  1071. ShellFolder := GetShellFolder(not(shAlwaysUsePersonalGroup in SetupHeader.Options) and IsAdminInstallMode,
  1072. sfPrograms);
  1073. if ShellFolder = '' then
  1074. InternalError('Failed to expand "' + OriginalCnst + '" constant');
  1075. Result := AddBackslash(ShellFolder) + WizardGroupValue;
  1076. end;
  1077. end
  1078. else if Cnst = 'language' then begin
  1079. if IsUninstaller then
  1080. Result := UninstallExpandedLanguage
  1081. else
  1082. Result := PSetupLanguageEntry(Entries[seLanguage][ActiveLanguage]).Name
  1083. end
  1084. else if Cnst = 'wizardhwnd' then begin
  1085. if Assigned(WizardForm) then
  1086. Result := IntToStr(WizardForm.Handle)
  1087. else
  1088. Result := '0';
  1089. end
  1090. else if Cnst = 'log' then Result := GetLogFileName
  1091. else if Cnst = 'dotnet11' then Result := GetDotNetVersionInstallRoot(rv32Bit, netbase11)
  1092. else if Cnst = 'dotnet20' then Result := GetDotNetVersionInstallRoot(InstallDefaultRegView, netbase20)
  1093. else if Cnst = 'dotnet2032' then Result := GetDotNetVersionInstallRoot(rv32Bit, netbase20)
  1094. else if Cnst = 'dotnet2064' then begin
  1095. if IsWin64 then
  1096. Result := GetDotNetVersionInstallRoot(rv64Bit, netbase20)
  1097. else
  1098. InternalError('Cannot expand "' + OriginalCnst + '" constant on this version of Windows');
  1099. end
  1100. else if Cnst = 'dotnet40' then Result := GetDotNetVersionInstallRoot(InstallDefaultRegView, netbase40)
  1101. else if Cnst = 'dotnet4032' then Result := GetDotNetVersionInstallRoot(rv32Bit, netbase40)
  1102. else if Cnst = 'dotnet4064' then begin
  1103. if IsWin64 then
  1104. Result := GetDotNetVersionInstallRoot(rv64Bit, netbase40)
  1105. else
  1106. InternalError('Cannot expand "' + OriginalCnst + '" constant on this version of Windows');
  1107. end
  1108. else if (Cnst <> '') and (Cnst[1] = '%') then Result := ExpandEnvConst(Cnst)
  1109. else if StrLComp(PChar(Cnst), 'reg:', 4) = 0 then Result := ExpandRegConst(Cnst)
  1110. else if StrLComp(PChar(Cnst), 'ini:', 4) = 0 then Result := ExpandIniConst(Cnst)
  1111. else if StrLComp(PChar(Cnst), 'param:', 6) = 0 then Result := ExpandParamConst(Cnst)
  1112. else if StrLComp(PChar(Cnst), 'code:', 5) = 0 then Result := ExpandCodeConst(Cnst)
  1113. else if StrLComp(PChar(Cnst), 'drive:', 6) = 0 then Result := ExpandDriveConst(Cnst)
  1114. else if StrLComp(PChar(Cnst), 'cm:', 3) = 0 then Result := ExpandCustomMessageConst(Cnst)
  1115. else begin
  1116. { Shell folder constants }
  1117. if Cnst <> '' then
  1118. for Common := False to True do
  1119. for ShellFolderID := Low(ShellFolderID) to High(ShellFolderID) do
  1120. if Cnst = FolderConsts[Common, ShellFolderID] then begin
  1121. ShellFolder := GetShellFolder(Common, ShellFolderID);
  1122. if ShellFolder = '' then
  1123. InternalError(Format('Failed to expand shell folder constant "%s"', [OriginalCnst]));
  1124. Result := ShellFolder;
  1125. Exit;
  1126. end;
  1127. { Custom constants }
  1128. if Cnst <> '' then begin
  1129. I := 0;
  1130. while I < High(CustomConsts) do begin
  1131. if Cnst = CustomConsts[I] then begin
  1132. Result := CustomConsts[I+1];
  1133. Exit;
  1134. end;
  1135. Inc(I, 2);
  1136. end;
  1137. end;
  1138. { Unknown constant }
  1139. InternalError(Format('Unknown constant "%s"', [OriginalCnst]));
  1140. end;
  1141. end;
  1142. function ExpandConst(const S: String): String;
  1143. begin
  1144. Result := ExpandConstEx2(S, [''], True);
  1145. end;
  1146. function ExpandConstEx(const S: String; const CustomConsts: array of String): String;
  1147. begin
  1148. Result := ExpandConstEx2(S, CustomConsts, True);
  1149. end;
  1150. function ExpandConstEx2(const S: String; const CustomConsts: array of String;
  1151. const DoExpandIndividualConst: Boolean): String;
  1152. var
  1153. I, Start: Integer;
  1154. Cnst, ReplaceWith: String;
  1155. begin
  1156. Result := S;
  1157. I := 1;
  1158. while I <= Length(Result) do begin
  1159. if Result[I] = '{' then begin
  1160. if (I < Length(Result)) and (Result[I+1] = '{') then begin
  1161. { Change '{{' to '{' if not in an embedded constant }
  1162. Inc(I);
  1163. Delete(Result, I, 1);
  1164. end
  1165. else begin
  1166. Start := I;
  1167. { Find the closing brace, skipping over any embedded constants }
  1168. I := SkipPastConst(Result, I);
  1169. if I = 0 then { unclosed constant? }
  1170. InternalError('Unclosed constant');
  1171. Dec(I); { 'I' now points to the closing brace }
  1172. if DoExpandIndividualConst then begin
  1173. { Now translate the constant }
  1174. Cnst := Copy(Result, Start+1, I-(Start+1));
  1175. ReplaceWith := ExpandIndividualConst(Cnst, CustomConsts);
  1176. Delete(Result, Start, (I+1)-Start);
  1177. Insert(ReplaceWith, Result, Start);
  1178. I := Start + Length(ReplaceWith);
  1179. if (ReplaceWith <> '') and (PathLastChar(ReplaceWith)^ = '\') and
  1180. (I <= Length(Result)) and (Result[I] = '\') then
  1181. Delete(Result, I, 1);
  1182. end else
  1183. Inc(I); { Skip closing brace }
  1184. end;
  1185. end
  1186. else
  1187. Inc(I);
  1188. end;
  1189. end;
  1190. function ExpandConstIfPrefixed(const S: String): String;
  1191. const
  1192. ExpandPrefix = 'expand:';
  1193. begin
  1194. if Pos(ExpandPrefix, S) = 1 then begin
  1195. Inc(DisableCodeConsts);
  1196. try
  1197. Result := ExpandConst(Copy(S, Length(ExpandPrefix)+1, Maxint));
  1198. finally
  1199. Dec(DisableCodeConsts);
  1200. end;
  1201. end
  1202. else
  1203. Result := S;
  1204. end;
  1205. procedure InitMainNonSHFolderConsts;
  1206. function GetPath(const RegView: TRegView; const Name: PChar): String;
  1207. var
  1208. H: HKEY;
  1209. begin
  1210. if RegOpenKeyExView(RegView, HKEY_LOCAL_MACHINE, REGSTR_PATH_SETUP, 0,
  1211. KEY_QUERY_VALUE, H) = ERROR_SUCCESS then begin
  1212. if not RegQueryStringValue(H, Name, Result) then
  1213. Result := '';
  1214. RegCloseKey(H);
  1215. end
  1216. else
  1217. Result := '';
  1218. end;
  1219. procedure ReadSysUserInfo;
  1220. var
  1221. RegView: TRegView;
  1222. K: HKEY;
  1223. begin
  1224. { Windows 7 x64 (and later?) is bugged: the owner and organization
  1225. are set to "Microsoft" on the 32-bit key. So on 64-bit Windows, read
  1226. from the 64-bit key. (The bug doesn't exist on 64-bit XP or Server 2003,
  1227. but it's safe to read the 64-bit key on those versions too.) }
  1228. if IsWin64 then
  1229. RegView := rv64Bit
  1230. else
  1231. RegView := rvDefault;
  1232. if RegOpenKeyExView(RegView, HKEY_LOCAL_MACHINE, 'SOFTWARE\Microsoft\Windows NT\CurrentVersion',
  1233. 0, KEY_QUERY_VALUE, K) = ERROR_SUCCESS then begin
  1234. RegQueryStringValue(K, 'RegisteredOwner', SysUserInfoName);
  1235. RegQueryStringValue(K, 'RegisteredOrganization', SysUserInfoOrg);
  1236. RegCloseKey(K);
  1237. end;
  1238. end;
  1239. begin
  1240. { Read Windows and Windows System dirs }
  1241. WinDir := GetWinDir;
  1242. WinSystemDir := GetSystemDir;
  1243. WinSysWow64Dir := GetSysWow64Dir;
  1244. WinSysNativeDir := GetSysNativeDir(IsWin64);
  1245. { Get system drive }
  1246. SystemDrive := GetEnv('SystemDrive'); {don't localize}
  1247. if SystemDrive = '' then begin
  1248. SystemDrive := PathExtractDrive(WinDir);
  1249. if SystemDrive = '' then
  1250. { In some rare case that PathExtractDrive failed, just default to C }
  1251. SystemDrive := 'C:';
  1252. end;
  1253. { Get 32-bit Program Files and Common Files dirs }
  1254. ProgramFiles32Dir := GetPath(rv32Bit, 'ProgramFilesDir');
  1255. if ProgramFiles32Dir = '' then
  1256. ProgramFiles32Dir := SystemDrive + '\Program Files'; {don't localize}
  1257. CommonFiles32Dir := GetPath(rv32Bit, 'CommonFilesDir');
  1258. if CommonFiles32Dir = '' then
  1259. CommonFiles32Dir := AddBackslash(ProgramFiles32Dir) + 'Common Files'; {don't localize}
  1260. { Get 64-bit Program Files and Common Files dirs }
  1261. if IsWin64 then begin
  1262. ProgramFiles64Dir := GetPath(rv64Bit, 'ProgramFilesDir');
  1263. if ProgramFiles64Dir = '' then
  1264. InternalError('Failed to get path of 64-bit Program Files directory');
  1265. CommonFiles64Dir := GetPath(rv64Bit, 'CommonFilesDir');
  1266. if CommonFiles64Dir = '' then
  1267. InternalError('Failed to get path of 64-bit Common Files directory');
  1268. end;
  1269. { Get path of command interpreter }
  1270. CmdFilename := AddBackslash(WinSystemDir) + 'cmd.exe';
  1271. { Get user info from system }
  1272. ReadSysUserInfo;
  1273. end;
  1274. procedure SaveStreamToTempFile(const Strm: TCustomMemoryStream;
  1275. const Filename: String);
  1276. var
  1277. ErrorCode: DWORD;
  1278. begin
  1279. try
  1280. Strm.SaveToFile(Filename);
  1281. except
  1282. { Display more useful error message than 'Stream write error' etc. }
  1283. on EStreamError do begin
  1284. ErrorCode := GetLastError;
  1285. raise Exception.Create(FmtSetupMessage(msgLastErrorMessage,
  1286. [SetupMessages[msgLdrCannotCreateTemp], IntToStr(ErrorCode),
  1287. Win32ErrorString(ErrorCode)]));
  1288. end;
  1289. end;
  1290. end;
  1291. procedure SaveResourceToTempFile(const ResName, Filename: String);
  1292. var
  1293. ResStrm: TResourceStream;
  1294. begin
  1295. ResStrm := TResourceStream.Create(HInstance, ResName, RT_RCDATA);
  1296. try
  1297. SaveStreamToTempFile(ResStrm, Filename);
  1298. finally
  1299. ResStrm.Free;
  1300. end;
  1301. end;
  1302. procedure DeleteResidualTempUninstallDirs;
  1303. var
  1304. SelfExeFilename: String;
  1305. function IsAttrDirectoryAndNotReparsePoint(const Attr: DWORD): Boolean;
  1306. begin
  1307. Result := (Attr and (FILE_ATTRIBUTE_DIRECTORY or FILE_ATTRIBUTE_REPARSE_POINT)) =
  1308. FILE_ATTRIBUTE_DIRECTORY;
  1309. end;
  1310. function IsRecentFileTime(const AFileTime: TFileTime): Boolean;
  1311. const
  1312. ThresholdSecs = 5 * 60; { 5 minutes }
  1313. begin
  1314. var NowTime: TFileTime;
  1315. GetSystemTimeAsFileTime(NowTime);
  1316. const A = FileTimeToUInt64(AFileTime);
  1317. const B = FileTimeToUInt64(NowTime);
  1318. { Past and future times are both considered recent }
  1319. var Diff: UInt64;
  1320. if A > B then
  1321. Diff := A - B
  1322. else
  1323. Diff := B - A;
  1324. Result := Diff < ThresholdSecs * UInt64(10000000);
  1325. end;
  1326. function TryDeleteUninstallDir(const ADir: String): Boolean;
  1327. begin
  1328. Result := False;
  1329. const UninsExeFilename = ADir + '\_unins.tmp';
  1330. { Quick out if it's our own process's directory }
  1331. if PathSame(UninsExeFilename, SelfExeFilename) then
  1332. Exit;
  1333. { Open handle to the directory. This serves two purposes:
  1334. - Avoid TOCTOU race in the reparse point check: We checked the
  1335. attributes returned by FindFirstFile/FindNextFile, but it's *possible*
  1336. that the directory was replaced with a reparse point (or a file)
  1337. between then and now. By passing only FILE_SHARE_READ for the sharing
  1338. mode, we block other processes from deleting the directory or changing
  1339. it into a reparse point in-place. We can then re-check the attributes
  1340. with no worries of them changing afterward, as long as the handle
  1341. remains open.
  1342. - It functions like a mutex: If two processes enter this function
  1343. concurrently for the same directory, this CreateFile call will only
  1344. succeed in one of them. The other will fail with
  1345. ERROR_SHARING_VIOLATION, because FILE_SHARE_READ doesn't allow another
  1346. handle to be opened for DELETE access.
  1347. The docs for GetFileInformationByHandle (called below) don't specify
  1348. what access rights, if any, are required. Even though the function
  1349. succeeds with only DELETE access on Windows 11, we also include
  1350. FILE_READ_ATTRIBUTES to be sure we aren't depending on undocumented
  1351. implementation details. }
  1352. const DirHandle = CreateFile(PChar(ADir),
  1353. Windows._DELETE or FILE_READ_ATTRIBUTES, FILE_SHARE_READ, nil,
  1354. OPEN_EXISTING, FILE_FLAG_OPEN_REPARSE_POINT or FILE_FLAG_BACKUP_SEMANTICS,
  1355. 0);
  1356. if DirHandle <> INVALID_HANDLE_VALUE then begin
  1357. try
  1358. var Info: TByHandleFileInformation;
  1359. if GetFileInformationByHandle(DirHandle, Info) and
  1360. IsAttrDirectoryAndNotReparsePoint(Info.dwFileAttributes) then begin
  1361. { Try to open _unins-done.tmp, which is an empty file created by
  1362. Uninstall to signal to us that the directory needs deleting.
  1363. It also serves as a lock: if the file exists, but opening it fails
  1364. with ERROR_SHARING_VIOLATION, that means the Uninstall process is
  1365. still running, so we shouldn't try to delete the directory at this
  1366. time. (Uninstall holds the file open until it terminates, allowing
  1367. only FILE_SHARE_READ sharing, which conflicts with the request
  1368. for DELETE access here.) }
  1369. const DoneFileHandle = CreateFile(PChar(ADir + '\_unins-done.tmp'),
  1370. Windows._DELETE, FILE_SHARE_READ, nil, OPEN_EXISTING,
  1371. FILE_FLAG_OPEN_REPARSE_POINT, 0);
  1372. if DoneFileHandle <> INVALID_HANDLE_VALUE then begin
  1373. try
  1374. Result := Windows.DeleteFile(PChar(UninsExeFilename));
  1375. if Result then begin
  1376. LogFmt('Deleted file: %s', [UninsExeFilename]);
  1377. if not DeleteFileOrDirByHandle(DoneFileHandle) then
  1378. LogWithLastError('Failed to delete "_unins-done.tmp".');
  1379. end;
  1380. finally
  1381. CloseHandle(DoneFileHandle);
  1382. end;
  1383. end;
  1384. { Try to remove the directory (if empty) in two cases:
  1385. - If we just deleted files from it. (Any failure is logged.)
  1386. - If it wasn't modified recently. It could be an empty directory
  1387. that this function couldn't remove before because an AV or other
  1388. process was holding handles to the directory or now-deleted
  1389. files inside. Or, it could be an empty directory that
  1390. Uninstall's RunFirstPhase couldn't remove because this function
  1391. was running concurrently in another process and had it open (an
  1392. unlikely race).
  1393. The time check prevents removal of a directory that a
  1394. concurrently-running Uninstall process just created (also an
  1395. unlikely race).
  1396. The time check is intentionally done first (often unnecessarily)
  1397. just to ensure that code path gets regularly exercised. }
  1398. if not IsRecentFileTime(Info.ftLastWriteTime) or Result then
  1399. if not DeleteFileOrDirByHandle(DirHandle) then
  1400. if Result then
  1401. LogWithLastError('Failed to remove directory.');
  1402. end;
  1403. finally
  1404. CloseHandle(DirHandle);
  1405. end;
  1406. end;
  1407. end;
  1408. begin
  1409. Log('Cleaning up any residual temporary files from previous Uninstall runs.');
  1410. SelfExeFilename := NewParamStr(0);
  1411. var NumDirsFound: Cardinal := 0;
  1412. var NumDirsChecked: Cardinal := 0;
  1413. var NumFilesDeleted: Cardinal := 0;
  1414. const ParentDir = AddBackslash(GetTempDir);
  1415. var FindData: TWin32FindData;
  1416. const H = FindFirstFile(PChar(ParentDir + 'is-*-uninstall.tmp'), FindData);
  1417. if H = INVALID_HANDLE_VALUE then begin
  1418. if GetLastError <> ERROR_FILE_NOT_FOUND then
  1419. LogWithLastError('Failed to list directory.');
  1420. end else begin
  1421. try
  1422. var TimeLimitReached := False;
  1423. var TimeLimitTimer: TOneShotTimer;
  1424. TimeLimitTimer.Start(3000);
  1425. repeat
  1426. if IsAttrDirectoryAndNotReparsePoint(FindData.dwFileAttributes) then begin
  1427. const BaseName: String = FindData.cFileName;
  1428. { Scrutinize the name further }
  1429. const SS = TStringScanner.Create(PathLowercase(BaseName));
  1430. const MatchingName = SS.Consume('is-') and
  1431. (SS.ConsumeMulti(['0'..'9', 'a'..'z'], False, 10, 20) > 0) and
  1432. SS.Consume('-uninstall.tmp') and SS.ReachedEnd;
  1433. if MatchingName then begin
  1434. Inc(NumDirsFound);
  1435. if not TimeLimitReached then begin
  1436. if (NumDirsChecked >= 10) and TimeLimitTimer.Expired then begin
  1437. TimeLimitReached := True;
  1438. Log('Stopping cleanup because it''s taking too long (>3s).');
  1439. end else begin
  1440. Inc(NumDirsChecked);
  1441. if TryDeleteUninstallDir(ParentDir + BaseName) then
  1442. Inc(NumFilesDeleted);
  1443. end;
  1444. end;
  1445. end;
  1446. end;
  1447. until not FindNextFile(H, FindData);
  1448. finally
  1449. Windows.FindClose(H);
  1450. end;
  1451. end;
  1452. LogFmt('Cleanup finished (%u directories found, %u directories checked, %u files deleted).',
  1453. [NumDirsFound, NumDirsChecked, NumFilesDeleted]);
  1454. end;
  1455. procedure CreateTempInstallDirAndExtract64BitHelper;
  1456. { Initializes TempInstallDir and extracts the 64-bit helper into it if needed.
  1457. This is called by Setup, Uninstall, and RegSvr. }
  1458. begin
  1459. var Protected: Boolean;
  1460. TempInstallDir := CreateTempDir('.tmp', IsAdmin and not Debugging, Protected);
  1461. LogFmt('Created %stemporary directory: %s', [IfThen(Protected, 'protected ', ''), TempInstallDir]);
  1462. if Debugging then
  1463. DebugNotifyTempDir(TempInstallDir);
  1464. { Create _isetup subdirectory to hold our internally-used files to ensure
  1465. they won't use any DLLs the install creator might've dumped into
  1466. TempInstallDir }
  1467. var Subdir := AddBackslash(TempInstallDir) + '_isetup';
  1468. if not CreateDirectory(PChar(Subdir), nil) then begin
  1469. var ErrorCode := GetLastError;
  1470. raise Exception.Create(FmtSetupMessage(msgLastErrorMessage,
  1471. [FmtSetupMessage1(msgErrorCreatingDir, Subdir), IntToStr(ErrorCode),
  1472. Win32ErrorString(ErrorCode)]));
  1473. end;
  1474. { Extract 64-bit helper EXE, if one is available for the current processor
  1475. architecture }
  1476. var ResName := GetHelperResourceName;
  1477. if ResName <> '' then begin
  1478. var Filename := Subdir + '\_setup64.tmp';
  1479. SaveResourceToTempFile(ResName, Filename);
  1480. SetHelperExeFilename(Filename);
  1481. end;
  1482. end;
  1483. function TempDeleteFileProc(const DisableFsRedir: Boolean;
  1484. const FileName: String; const Param: Pointer): Boolean;
  1485. var
  1486. Elapsed: DWORD;
  1487. label Retry;
  1488. begin
  1489. Retry:
  1490. Result := DeleteFileRedir(DisableFsRedir, FileName);
  1491. if not Result and
  1492. (GetLastError <> ERROR_FILE_NOT_FOUND) and
  1493. (GetLastError <> ERROR_PATH_NOT_FOUND) then begin
  1494. { If we get here, the file is probably still in use. On an SMP machine,
  1495. it's possible for an EXE to remain locked by Windows for a short time
  1496. after it terminates, causing DeleteFile to fail with ERROR_ACCESS_DENIED.
  1497. (I'm not sure this issue can really be seen here in practice; I could
  1498. only reproduce it consistently by calling DeleteFile() *immediately*
  1499. after waiting on the process handle.)
  1500. Retry if fewer than 2 seconds have passed since DelTree started,
  1501. otherwise assume the error must be permanent and give up. 2 seconds
  1502. ought to be more than enough for the SMP case. }
  1503. Elapsed := GetTickCount - DWORD(Param);
  1504. if Cardinal(Elapsed) < Cardinal(2000) then begin
  1505. Sleep(50);
  1506. goto Retry;
  1507. end;
  1508. end;
  1509. end;
  1510. procedure RemoveTempInstallDir;
  1511. { Removes TempInstallDir and all its contents. Stops the 64-bit helper first
  1512. if necessary. }
  1513. begin
  1514. { Stop 64-bit helper if it's running }
  1515. StopHelper(False);
  1516. SetHelperExeFilename('');
  1517. if TempInstallDir <> '' then begin
  1518. if Debugging then
  1519. DebugNotifyTempDir('');
  1520. if not DelTree(False, TempInstallDir, True, True, True, False, nil,
  1521. TempDeleteFileProc, Pointer(GetTickCount())) then
  1522. Log('Failed to remove temporary directory: ' + TempInstallDir);
  1523. end;
  1524. end;
  1525. procedure LoadSHFolderDLL;
  1526. var
  1527. Filename: String;
  1528. const
  1529. shfolder = 'shfolder.dll';
  1530. begin
  1531. Filename := AddBackslash(GetSystemDir) + shfolder;
  1532. { Ensure shell32.dll is pre-loaded so it isn't loaded/freed for each
  1533. individual SHGetFolderPath call }
  1534. SafeLoadLibrary(AddBackslash(GetSystemDir) + shell32, SEM_NOOPENFILEERRORBOX);
  1535. SHFolderDLLHandle := SafeLoadLibrary(Filename, SEM_NOOPENFILEERRORBOX);
  1536. if SHFolderDLLHandle = 0 then
  1537. InternalError(Format('Failed to load DLL "%s"', [Filename]));
  1538. @SHGetFolderPathFunc := GetProcAddress(SHFolderDLLHandle, 'SHGetFolderPathW');
  1539. if @SHGetFolderPathFunc = nil then
  1540. InternalError('Failed to get address of SHGetFolderPath function');
  1541. end;
  1542. procedure UnloadSHFolderDLL;
  1543. begin
  1544. @SHGetFolderPathFunc := nil;
  1545. if SHFolderDLLHandle <> 0 then begin
  1546. FreeLibrary(SHFolderDLLHandle);
  1547. SHFolderDLLHandle := 0;
  1548. end;
  1549. end;
  1550. function GetShellFolderByCSIDL(Folder: Integer; const Create: Boolean): String;
  1551. const
  1552. CSIDL_FLAG_CREATE = $8000;
  1553. SHGFP_TYPE_CURRENT = 0;
  1554. var
  1555. Res: HRESULT;
  1556. Buf: array[0..MAX_PATH-1] of Char;
  1557. begin
  1558. { Note: Must pass Create=True or else SHGetFolderPath fails if the
  1559. specified CSIDL is valid but doesn't currently exist. }
  1560. if Create then
  1561. Folder := Folder or CSIDL_FLAG_CREATE;
  1562. { Work around a nasty bug in Windows Vista and Windows Server 2008 and maybe
  1563. later versions also: When a folder ID resolves to the root directory of a
  1564. drive ('X:\') and the CSIDL_FLAG_CREATE flag is passed, SHGetFolderPath
  1565. fails with code 0x80070005.
  1566. So, first try calling the function without CSIDL_FLAG_CREATE.
  1567. If and only if that fails, call it again with the flag.
  1568. Note: The calls *must* be issued in this order; if it's called with the
  1569. flag first, it seems to permanently cache the failure code, causing future
  1570. calls that don't include the flag to fail as well. }
  1571. if Folder and CSIDL_FLAG_CREATE <> 0 then
  1572. Res := SHGetFolderPathFunc(0, Folder and not CSIDL_FLAG_CREATE, 0,
  1573. SHGFP_TYPE_CURRENT, Buf)
  1574. else
  1575. Res := E_FAIL; { always issue the call below }
  1576. if Res <> S_OK then
  1577. Res := SHGetFolderPathFunc(0, Folder, 0, SHGFP_TYPE_CURRENT, Buf);
  1578. if Res = S_OK then
  1579. Result := RemoveBackslashUnlessRoot(PathExpand(Buf))
  1580. else begin
  1581. Result := '';
  1582. LogFmt('Warning: SHGetFolderPath failed with code 0x%.8x on folder 0x%.4x',
  1583. [Res, Folder]);
  1584. end;
  1585. end;
  1586. function GetShellFolderByGUID(Folder: TGUID; const Create: Boolean): String;
  1587. begin
  1588. if Assigned(SHGetKnownFolderPathFunc) then begin
  1589. var dwFlags: DWORD := 0;
  1590. if Create then
  1591. dwFlags := dwFlags or KF_FLAG_CREATE;
  1592. var Path: PWideChar;
  1593. { Note: Must pass Create=True or else SHGetKnownFolderPath fails if the
  1594. specified GUID is valid but doesn't currently exist. }
  1595. var Res := SHGetKnownFolderPathFunc(Folder, dwFlags, 0, Path);
  1596. if Res = S_OK then begin
  1597. Result := WideCharToString(Path);
  1598. CoTaskMemFree(Path);
  1599. end else begin
  1600. Result := '';
  1601. LogFmt('Warning: SHGetKnownFolderPath failed with code 0x%.8x', [Res]);
  1602. end;
  1603. end else
  1604. Result := '';
  1605. end;
  1606. function GetShellFolder(const Common: Boolean; const ID: TShellFolderID): String;
  1607. const
  1608. CSIDL_COMMON_STARTMENU = $0016;
  1609. CSIDL_COMMON_PROGRAMS = $0017;
  1610. CSIDL_COMMON_STARTUP = $0018;
  1611. CSIDL_COMMON_DESKTOPDIRECTORY = $0019;
  1612. CSIDL_APPDATA = $001A;
  1613. CSIDL_LOCAL_APPDATA = $001C;
  1614. CSIDL_COMMON_FAVORITES = $001F;
  1615. CSIDL_COMMON_APPDATA = $0023;
  1616. CSIDL_COMMON_TEMPLATES = $002D;
  1617. CSIDL_COMMON_DOCUMENTS = $002E;
  1618. FolderIDs: array[Boolean, TShellFolderID] of Integer = (
  1619. { Values must match FolderConsts }
  1620. { User }
  1621. (CSIDL_DESKTOPDIRECTORY, CSIDL_STARTMENU, CSIDL_PROGRAMS, CSIDL_STARTUP,
  1622. CSIDL_SENDTO, CSIDL_FONTS, CSIDL_APPDATA, CSIDL_PERSONAL,
  1623. CSIDL_TEMPLATES, CSIDL_FAVORITES, CSIDL_LOCAL_APPDATA, 0, 0, 0),
  1624. { Common }
  1625. (CSIDL_COMMON_DESKTOPDIRECTORY, CSIDL_COMMON_STARTMENU, CSIDL_COMMON_PROGRAMS, CSIDL_COMMON_STARTUP,
  1626. CSIDL_SENDTO, CSIDL_FONTS, CSIDL_COMMON_APPDATA, CSIDL_COMMON_DOCUMENTS,
  1627. CSIDL_COMMON_TEMPLATES, CSIDL_COMMON_FAVORITES, 0, 0, 0, 0));
  1628. FOLDERID_UserProgramFiles: TGUID = (D1:$5CD7AEE2; D2:$2219; D3:$4A67; D4:($B8,$5D,$6C,$9C,$E1,$56,$60,$CB));
  1629. FOLDERID_UserProgramFilesCommon: TGUID = (D1:$BCBD3057; D2:$CA5C; D3:$4622; D4:($B4,$2D,$BC,$56,$DB,$0A,$E5,$16));
  1630. FOLDERID_SavedGames: TGUID = (D1:$4C5C32FF; D2:$BB9D; D3:$43B0; D4:($B5,$B4,$2D,$72,$E5,$4E,$AA,$A4));
  1631. var
  1632. ShellFolder: String;
  1633. begin
  1634. if not ShellFoldersRead[Common, ID] then begin
  1635. if ID = sfUserProgramFiles then
  1636. ShellFolder := GetShellFolderByGUID(FOLDERID_UserProgramFiles, True)
  1637. else if ID = sfUserCommonFiles then
  1638. ShellFolder := GetShellFolderByGUID(FOLDERID_UserProgramFilesCommon, True)
  1639. else if ID = sfUserSavedGames then
  1640. ShellFolder := GetShellFolderByGUID(FOLDERID_SavedGames, True)
  1641. else
  1642. ShellFolder := GetShellFolderByCSIDL(FolderIDs[Common, ID], True);
  1643. ShellFolders[Common, ID] := ShellFolder;
  1644. ShellFoldersRead[Common, ID] := True;
  1645. end;
  1646. Result := ShellFolders[Common, ID];
  1647. end;
  1648. function InstallOnThisVersion(const MinVersion: TSetupVersionData;
  1649. const OnlyBelowVersion: TSetupVersionData): TInstallOnThisVersionResult;
  1650. var
  1651. Ver, Ver2, MinVer, OnlyBelowVer: Cardinal;
  1652. begin
  1653. Ver := WindowsVersion;
  1654. MinVer := MinVersion.NTVersion;
  1655. OnlyBelowVer := OnlyBelowVersion.NTVersion;
  1656. Result := irInstall;
  1657. if MinVer = 0 then
  1658. Result := irNotOnThisPlatform
  1659. else begin
  1660. if Ver < MinVer then
  1661. Result := irVersionTooLow
  1662. else if (LongRec(Ver).Hi = LongRec(MinVer).Hi) and
  1663. (NTServicePackLevel < MinVersion.NTServicePack) then
  1664. Result := irServicePackTooLow
  1665. else begin
  1666. if OnlyBelowVer <> 0 then begin
  1667. Ver2 := Ver;
  1668. { A build number of 0 on OnlyBelowVersion means 'match any build' }
  1669. if LongRec(OnlyBelowVer).Lo = 0 then
  1670. Ver2 := Ver2 and $FFFF0000; { set build number to zero on Ver2 also }
  1671. { Note: When OnlyBelowVersion includes a service pack level, the
  1672. version number test changes from a "<" to "<=" operation. Thus,
  1673. on Windows 2000 SP4, 5.0 and 5.0.2195 will fail, but 5.0sp5 and
  1674. 5.0.2195sp5 will pass. }
  1675. if (Ver2 > OnlyBelowVer) or
  1676. ((Ver2 = OnlyBelowVer) and
  1677. (OnlyBelowVersion.NTServicePack = 0)) or
  1678. ((LongRec(Ver).Hi = LongRec(OnlyBelowVer).Hi) and
  1679. (OnlyBelowVersion.NTServicePack <> 0) and
  1680. (NTServicePackLevel >= OnlyBelowVersion.NTServicePack)) then
  1681. Result := irVerTooHigh;
  1682. end;
  1683. end;
  1684. end;
  1685. end;
  1686. function GetSizeOfComponent(const ComponentName: String; const ExtraDiskSpaceRequired: Int64): Int64;
  1687. var
  1688. ComponentNameAsList: TStringList;
  1689. FileEntry: PSetupFileEntry;
  1690. I: Integer;
  1691. begin
  1692. Result := ExtraDiskSpaceRequired;
  1693. ComponentNameAsList := TStringList.Create();
  1694. try
  1695. ComponentNameAsList.Add(ComponentName);
  1696. for I := 0 to Entries[seFile].Count-1 do begin
  1697. FileEntry := PSetupFileEntry(Entries[seFile][I]);
  1698. with FileEntry^ do begin
  1699. if (Components <> '') and
  1700. ((Tasks = '') and (Check = '')) then begin {don't count tasks or scripted entries}
  1701. if ShouldProcessFileEntry(ComponentNameAsList, nil, FileEntry, True) then begin
  1702. if LocationEntry <> -1 then
  1703. Inc(Result, PSetupFileLocationEntry(Entries[seFileLocation][LocationEntry])^.OriginalSize)
  1704. else
  1705. Inc(Result, ExternalSize);
  1706. end;
  1707. end;
  1708. end;
  1709. end;
  1710. finally
  1711. ComponentNameAsList.Free();
  1712. end;
  1713. end;
  1714. function GetSizeOfType(const TypeName: String; const IsCustom: Boolean): Int64;
  1715. var
  1716. ComponentTypes: TStringList;
  1717. I: Integer;
  1718. begin
  1719. Result := 0;
  1720. ComponentTypes := TStringList.Create();
  1721. for I := 0 to Entries[seComponent].Count-1 do begin
  1722. with PSetupComponentEntry(Entries[seComponent][I])^ do begin
  1723. SetStringsFromCommaString(ComponentTypes, Types);
  1724. { For custom types, only count fixed components. Otherwise count all. }
  1725. if IsCustom then begin
  1726. if (coFixed in Options) and ListContains(ComponentTypes, TypeName) then
  1727. Inc(Result, Size);
  1728. end else begin
  1729. if ListContains(ComponentTypes, TypeName) then
  1730. Inc(Result, Size);
  1731. end;
  1732. end;
  1733. end;
  1734. ComponentTypes.Free();
  1735. end;
  1736. function IsRecurseableDirectory(const FindData: TWin32FindData): Boolean;
  1737. { Returns True if FindData is a directory that may be recursed into.
  1738. Intended only for use when processing external+recursesubdirs file entries. }
  1739. begin
  1740. Result :=
  1741. (FindData.dwFileAttributes and FILE_ATTRIBUTE_DIRECTORY <> 0) and
  1742. (FindData.dwFileAttributes and FILE_ATTRIBUTE_HIDDEN = 0) and
  1743. (StrComp(FindData.cFileName, '.') <> 0) and
  1744. (StrComp(FindData.cFileName, '..') <> 0);
  1745. end;
  1746. type
  1747. TEnumFilesProc = function(const DisableFsRedir: Boolean; const Filename: String;
  1748. const Param: Pointer): Boolean;
  1749. function DummyDeleteDirProc(const DisableFsRedir: Boolean; const Filename: String;
  1750. const Param: Pointer): Boolean;
  1751. begin
  1752. { We don't actually want to delete the dir, so just return success. }
  1753. Result := True;
  1754. end;
  1755. { Enumerates the files we're going to install and delete. Returns True on success.
  1756. Likewise EnumFilesProc should return True on success and return False
  1757. to break the enum and to cause EnumFiles to return False instead of True. }
  1758. function EnumFiles(const EnumFilesProc: TEnumFilesProc;
  1759. const WizardComponents, WizardTasks: TStringList; const Param: Pointer): Boolean;
  1760. function RecurseExternalFiles(const DisableFsRedir: Boolean;
  1761. const SearchBaseDir, SearchSubDir, SearchWildcard: String;
  1762. const SourceIsWildcard: Boolean; const Excludes: TStrings; const CurFile: PSetupFileEntry): Boolean;
  1763. begin
  1764. { Also see RecurseExternalGetSizeOfFiles below and RecurseExternalCopyFiles in Setup.Install
  1765. Also see RecurseExternalArchiveFiles directly below }
  1766. Result := True;
  1767. var FindData: TWin32FindData;
  1768. var H := FindFirstFileRedir(DisableFsRedir, SearchBaseDir + SearchSubDir + SearchWildcard, FindData);
  1769. if H <> INVALID_HANDLE_VALUE then begin
  1770. try
  1771. repeat
  1772. if FindData.dwFileAttributes and FILE_ATTRIBUTE_DIRECTORY = 0 then begin
  1773. if SourceIsWildcard then
  1774. if FindData.dwFileAttributes and FILE_ATTRIBUTE_HIDDEN <> 0 then
  1775. Continue;
  1776. if IsExcluded(SearchSubDir + FindData.cFileName, Excludes) then
  1777. Continue;
  1778. { Note: CurFile^.DestName only includes a a filename if foCustomDestName is set,
  1779. see TSetupCompiler.EnumFilesProc.ProcessFileList }
  1780. var DestFile := ExpandConst(CurFile^.DestName);
  1781. if not(foCustomDestName in CurFile^.Options) then
  1782. DestFile := DestFile + SearchSubDir + FindData.cFileName
  1783. else if SearchSubDir <> '' then
  1784. DestFile := PathExtractPath(DestFile) + SearchSubDir + PathExtractName(DestFile);
  1785. if not EnumFilesProc(DisableFsRedir, DestFile, Param) then begin
  1786. Result := False;
  1787. Exit;
  1788. end;
  1789. end;
  1790. until not FindNextFile(H, FindData);
  1791. finally
  1792. Windows.FindClose(H);
  1793. end;
  1794. end;
  1795. if foRecurseSubDirsExternal in CurFile^.Options then begin
  1796. H := FindFirstFileRedir(DisableFsRedir, SearchBaseDir + SearchSubDir + '*', FindData);
  1797. if H <> INVALID_HANDLE_VALUE then begin
  1798. try
  1799. repeat
  1800. if IsRecurseableDirectory(FindData) then
  1801. if not RecurseExternalFiles(DisableFsRedir, SearchBaseDir,
  1802. SearchSubDir + FindData.cFileName + '\', SearchWildcard,
  1803. SourceIsWildcard, Excludes, CurFile) then
  1804. Exit(False);
  1805. until not FindNextFile(H, FindData);
  1806. finally
  1807. Windows.FindClose(H);
  1808. end;
  1809. end;
  1810. end;
  1811. end;
  1812. function RecurseExternalArchiveFiles(const DisableFsRedir: Boolean;
  1813. const ArchiveFilename: String; const Excludes: TStrings;
  1814. const CurFile: PSetupFileEntry): Boolean;
  1815. begin
  1816. { See above }
  1817. Result := True;
  1818. if not NewFileExistsRedir(DisableFsRedir, ArchiveFilename) then
  1819. Exit;
  1820. if foCustomDestName in CurFile^.Options then
  1821. InternalError('Unexpected CustomDestName flag');
  1822. const DestDir = ExpandConst(CurFile^.DestName);
  1823. var FindData: TWin32FindData;
  1824. var H := ArchiveFindFirstFileRedir(DisableFsRedir, ArchiveFilename, DestDir,
  1825. ExpandConst(CurFile^.ExtractArchivePassword), foRecurseSubDirsExternal in CurFile^.Options,
  1826. False, FindData);
  1827. if H <> INVALID_HANDLE_VALUE then begin
  1828. try
  1829. repeat
  1830. if FindData.dwFileAttributes and FILE_ATTRIBUTE_DIRECTORY = 0 then begin
  1831. if IsExcluded(FindData.cFileName, Excludes) then
  1832. Continue;
  1833. const DestFile = DestDir + FindData.cFileName;
  1834. if not EnumFilesProc(DisableFsRedir, DestFile, Param) then
  1835. Exit(False);
  1836. end;
  1837. until not ArchiveFindNextFile(H, FindData);
  1838. finally
  1839. ArchiveFindClose(H);
  1840. end;
  1841. end;
  1842. end;
  1843. var
  1844. I: Integer;
  1845. CurFile: PSetupFileEntry;
  1846. DisableFsRedir: Boolean;
  1847. SourceWildcard: String;
  1848. begin
  1849. Result := True;
  1850. { [Files] }
  1851. const Excludes = TStringList.Create;
  1852. try
  1853. Excludes.StrictDelimiter := True;
  1854. Excludes.Delimiter := ',';
  1855. for I := 0 to Entries[seFile].Count-1 do begin
  1856. CurFile := PSetupFileEntry(Entries[seFile][I]);
  1857. if (CurFile^.FileType = ftUserFile) and
  1858. ShouldProcessFileEntry(WizardComponents, WizardTasks, CurFile, False) then begin
  1859. DisableFsRedir := ShouldDisableFsRedirForFileEntry(CurFile);
  1860. if CurFile^.LocationEntry <> -1 then begin
  1861. { Non-external file }
  1862. if not EnumFilesProc(DisableFsRedir, ExpandConst(CurFile^.DestName), Param) then begin
  1863. Result := False;
  1864. Exit;
  1865. end;
  1866. end
  1867. else begin
  1868. { External file }
  1869. if foDownload in CurFile^.Options then begin
  1870. { Archive download should have been done already by Setup.WizardForm's DownloadArchivesToExtract }
  1871. if foExtractArchive in CurFile^.Options then
  1872. InternalError('Unexpected Download flag');
  1873. if not(foCustomDestName in CurFile^.Options) then
  1874. InternalError('Expected CustomDestName flag');
  1875. { CurFile^.DestName now includes a filename, see TSetupCompiler.EnumFilesProc.ProcessFileList }
  1876. if not EnumFilesProc(DisableFsRedir, ExpandConst(CurFile^.DestName), Param) then
  1877. Exit(False);
  1878. end else begin
  1879. SourceWildcard := ExpandConst(CurFile^.SourceFilename);
  1880. Excludes.DelimitedText := CurFile^.Excludes;
  1881. if foExtractArchive in CurFile^.Options then begin
  1882. try
  1883. if not RecurseExternalArchiveFiles(DisableFsRedir, SourceWildcard,
  1884. Excludes, CurFile) then
  1885. Exit(False);
  1886. except on E: ESevenZipError do
  1887. { Ignore archive errors for now, will show up with proper UI during
  1888. installation }
  1889. end;
  1890. end else begin
  1891. if not RecurseExternalFiles(DisableFsRedir, PathExtractPath(SourceWildcard), '',
  1892. PathExtractName(SourceWildcard), IsWildcard(SourceWildcard), Excludes, CurFile) then
  1893. Exit(False);
  1894. end;
  1895. end;
  1896. end;
  1897. end;
  1898. end;
  1899. finally
  1900. Excludes.Free;
  1901. end;
  1902. { [InstallDelete] }
  1903. for I := 0 to Entries[seInstallDelete].Count-1 do
  1904. with PSetupDeleteEntry(Entries[seInstallDelete][I])^ do
  1905. if ShouldProcessEntry(WizardComponents, WizardTasks, Components, Tasks, Languages, Check) then begin
  1906. case DeleteType of
  1907. dfFiles, dfFilesAndOrSubdirs:
  1908. if not DelTree(InstallDefaultDisableFsRedir, ExpandConst(Name), False, True, DeleteType = dfFilesAndOrSubdirs, True,
  1909. DummyDeleteDirProc, EnumFilesProc, Param) then begin
  1910. Result := False;
  1911. Exit;
  1912. end;
  1913. dfDirIfEmpty:
  1914. if not DelTree(InstallDefaultDisableFsRedir, ExpandConst(Name), True, False, False, True,
  1915. DummyDeleteDirProc, EnumFilesProc, Param) then begin
  1916. Result := False;
  1917. Exit;
  1918. end;
  1919. end;
  1920. end;
  1921. end;
  1922. procedure EnumProc(const Filename: String; Param: Pointer);
  1923. begin
  1924. TStringList(Param).Add(PathLowercase(Filename));
  1925. end;
  1926. var
  1927. CheckForFileSL: TStringList;
  1928. function CheckForFile(const DisableFsRedir: Boolean; const AFilename: String;
  1929. const Param: Pointer): Boolean;
  1930. var
  1931. Filename: String;
  1932. J: Integer;
  1933. begin
  1934. Filename := AFilename;
  1935. if not DisableFsRedir then
  1936. Filename := ReplaceSystemDirWithSysWow64(Filename);
  1937. Filename := PathLowercase(Filename);
  1938. for J := 0 to CheckForFileSL.Count-1 do begin
  1939. if CheckForFileSL[J] = Filename then begin
  1940. LogFmt('Found pending rename or delete that matches one of our files: %s', [Filename]);
  1941. Result := False; { Break the enum, just need to know if any matches }
  1942. Exit;
  1943. end;
  1944. end;
  1945. Result := True; { Success! }
  1946. end;
  1947. { Checks if no file we're going to install or delete has a pending rename or delete. }
  1948. function PreviousInstallCompleted(const WizardComponents, WizardTasks: TStringList): Boolean;
  1949. begin
  1950. Result := True;
  1951. if Entries[seFile].Count = 0 then
  1952. Exit;
  1953. CheckForFileSL := TStringList.Create;
  1954. try
  1955. EnumFileReplaceOperationsFilenames(EnumProc, CheckForFileSL);
  1956. if CheckForFileSL.Count = 0 then
  1957. Exit;
  1958. Result := EnumFiles(CheckForFile, WizardComponents, WizardTasks, nil);
  1959. finally
  1960. CheckForFileSL.Free;
  1961. end;
  1962. end;
  1963. type
  1964. TArrayOfPWideChar = array[0..(MaxInt div SizeOf(PWideChar))-1] of PWideChar;
  1965. PArrayOfPWideChar = ^TArrayOfPWideChar;
  1966. var
  1967. RegisterFileBatchFilenames: PArrayOfPWideChar;
  1968. RegisterFileFilenamesBatchMax, RegisterFileFilenamesBatchCount: Integer;
  1969. function RegisterFile(const DisableFsRedir: Boolean; const AFilename: String;
  1970. const Param: Pointer): Boolean;
  1971. var
  1972. Filename, Text: String;
  1973. I, Len: Integer;
  1974. CheckFilter, Match: Boolean;
  1975. begin
  1976. Filename := AFilename;
  1977. { First: check filters and self. }
  1978. if Filename <> '' then begin
  1979. CheckFilter := Boolean(Param);
  1980. if CheckFilter then begin
  1981. Match := False;
  1982. Text := PathLowercase(PathExtractName(Filename));
  1983. for I := 0 to CloseApplicationsFilterList.Count-1 do begin
  1984. if WildcardMatch(PChar(Text), PChar(CloseApplicationsFilterList[I])) then begin
  1985. Match := True;
  1986. Break;
  1987. end;
  1988. end;
  1989. if Match then begin
  1990. for I := 0 to CloseApplicationsFilterExcludesList.Count-1 do begin
  1991. if WildcardMatch(PChar(Text), PChar(CloseApplicationsFilterExcludesList[I])) then begin
  1992. Match := False;
  1993. Break;
  1994. end;
  1995. end;
  1996. end;
  1997. if not Match then begin
  1998. { No match with filter so exit but don't return an error. }
  1999. Result := True;
  2000. Exit;
  2001. end;
  2002. end;
  2003. if PathCompare(Filename, SetupLdrOriginalFilename) = 0 then begin
  2004. { Don't allow self to be registered but don't return an error. }
  2005. Result := True;
  2006. Exit;
  2007. end;
  2008. end;
  2009. { Secondly: check if we need to register this batch, either because the batch is full
  2010. or because we're done scanning and have leftovers. }
  2011. if ((Filename <> '') and (RegisterFileFilenamesBatchCount = RegisterFileFilenamesBatchMax)) or
  2012. ((Filename = '') and (RegisterFileFilenamesBatchCount > 0)) then begin
  2013. if RmRegisterResources(RmSessionHandle, RegisterFileFilenamesBatchCount, RegisterFileBatchFilenames, 0, nil, 0, nil) = ERROR_SUCCESS then begin
  2014. for I := 0 to RegisterFileFilenamesBatchCount-1 do
  2015. FreeMem(RegisterFileBatchFilenames[I]);
  2016. RegisterFileFilenamesBatchCount := 0;
  2017. end else begin
  2018. RmEndSession(RmSessionHandle);
  2019. RmSessionStarted := False;
  2020. end;
  2021. end;
  2022. { Finally: add this file to the batch. }
  2023. if RmSessionStarted and (FileName <> '') then begin
  2024. { From MSDN: "Installers should not disable file system redirection before calling
  2025. the Restart Manager API. This means that a 32-bit installer run on 64-bit Windows
  2026. is unable register a file in the %windir%\system32 directory." This is incorrect,
  2027. we can register such files by using the Sysnative alias. }
  2028. if DisableFsRedir then
  2029. Filename := ReplaceSystemDirWithSysNative(Filename, IsWin64);
  2030. if InitLogCloseApplications then
  2031. LogFmt('Found a file to register with RestartManager: %s', [Filename]);
  2032. Len := Length(Filename);
  2033. GetMem(RegisterFileBatchFilenames[RegisterFileFilenamesBatchCount], (Len + 1) * SizeOf(RegisterFileBatchFilenames[RegisterFileFilenamesBatchCount][0]));
  2034. StrPCopy(RegisterFileBatchFilenames[RegisterFileFilenamesBatchCount], Filename);
  2035. Inc(RegisterFileFilenamesBatchCount);
  2036. Inc(RmRegisteredFilesCount);
  2037. end;
  2038. Result := RmSessionStarted; { Break the enum if there was an error, else continue. }
  2039. end;
  2040. { Helper function for [Code] to register extra files. }
  2041. var
  2042. AllowCodeRegisterExtraCloseApplicationsResource: Boolean;
  2043. function CodeRegisterExtraCloseApplicationsResource(const DisableFsRedir: Boolean; const AFilename: String): Boolean;
  2044. begin
  2045. if AllowCodeRegisterExtraCloseApplicationsResource then
  2046. Result := RegisterFile(DisableFsRedir, AFilename, Pointer(False))
  2047. else begin
  2048. InternalError('Cannot call "RegisterExtraCloseApplicationsResource" function at this time');
  2049. Result := False;
  2050. end;
  2051. end;
  2052. { Register all files we're going to install or delete. Ends RmSession on errors. }
  2053. procedure RegisterResourcesWithRestartManager(const WizardComponents, WizardTasks: TStringList);
  2054. var
  2055. I: Integer;
  2056. begin
  2057. { Note: MSDN says we shouldn't call RmRegisterResources for each file because of speed, but calling
  2058. it once for all files adds extra memory usage, so calling it in batches. }
  2059. RegisterFileFilenamesBatchMax := 1000;
  2060. GetMem(RegisterFileBatchFilenames, RegisterFileFilenamesBatchMax * SizeOf(RegisterFileBatchFilenames[0]));
  2061. try
  2062. { Register our files. }
  2063. RmRegisteredFilesCount := 0;
  2064. try
  2065. EnumFiles(RegisterFile, WizardComponents, WizardTasks, Pointer(True));
  2066. except
  2067. Log('EnumFiles(RegisterFile) raised an exception.');
  2068. Application.HandleException(nil);
  2069. end;
  2070. { Ask [Code] for more files. }
  2071. if CodeRunner <> nil then begin
  2072. AllowCodeRegisterExtraCloseApplicationsResource := True;
  2073. try
  2074. try
  2075. CodeRunner.RunProcedures('RegisterExtraCloseApplicationsResources', [''], False);
  2076. except
  2077. Log('RegisterExtraCloseApplicationsResources raised an exception.');
  2078. Application.HandleException(nil);
  2079. end;
  2080. finally
  2081. AllowCodeRegisterExtraCloseApplicationsResource := False;
  2082. end;
  2083. end;
  2084. { Don't forget to register leftovers. }
  2085. if RmSessionStarted then
  2086. RegisterFile(False, '', nil);
  2087. finally
  2088. for I := 0 to RegisterFileFilenamesBatchCount-1 do
  2089. FreeMem(RegisterFileBatchFilenames[I]);
  2090. FreeMem(RegisterFileBatchFilenames);
  2091. end;
  2092. end;
  2093. procedure DebugNotifyEntry(EntryType: TEntryType; Number: Integer);
  2094. var
  2095. Kind: TDebugEntryKind;
  2096. B: Boolean;
  2097. begin
  2098. if not Debugging then Exit;
  2099. case EntryType of
  2100. seDir: Kind := deDir;
  2101. seFile: Kind := deFile;
  2102. seIcon: Kind := deIcon;
  2103. seIni: Kind := deIni;
  2104. seRegistry: Kind := deRegistry;
  2105. seInstallDelete: Kind := deInstallDelete;
  2106. seUninstallDelete: Kind := deUninstallDelete;
  2107. seRun: Kind := deRun;
  2108. seUninstallRun: Kind := deUninstallRun;
  2109. else
  2110. Exit;
  2111. end;
  2112. DebugNotify(Kind, Integer(OriginalEntryIndexes[EntryType][Number]), B);
  2113. end;
  2114. procedure CodeRunnerOnLog(const S: String);
  2115. begin
  2116. Log(S);
  2117. end;
  2118. procedure CodeRunnerOnLogFmt(const S: String; const Args: array of const);
  2119. begin
  2120. LogFmt(S, Args);
  2121. end;
  2122. procedure CodeRunnerOnDllImport(var DllName: String; var ForceDelayLoad: Boolean);
  2123. var
  2124. S, BaseName, FullName: String;
  2125. FirstFile: Boolean;
  2126. P: Integer;
  2127. begin
  2128. while True do begin
  2129. if Pos('setup:', DllName) = 1 then begin
  2130. if IsUninstaller then begin
  2131. DllName := '';
  2132. ForceDelayLoad := True;
  2133. Exit;
  2134. end;
  2135. Delete(DllName, 1, Length('setup:'));
  2136. end
  2137. else if Pos('uninstall:', DllName) = 1 then begin
  2138. if not IsUninstaller then begin
  2139. DllName := '';
  2140. ForceDelayLoad := True;
  2141. Exit;
  2142. end;
  2143. Delete(DllName, 1, Length('uninstall:'));
  2144. end
  2145. else
  2146. Break;
  2147. end;
  2148. if Pos('files:', DllName) = 1 then begin
  2149. if IsUninstaller then begin
  2150. { Uninstall doesn't do 'files:' }
  2151. DllName := '';
  2152. ForceDelayLoad := True;
  2153. end
  2154. else begin
  2155. S := Copy(DllName, Length('files:')+1, Maxint);
  2156. FirstFile := True;
  2157. repeat
  2158. P := ConstPos(',', S);
  2159. if P = 0 then
  2160. BaseName := S
  2161. else begin
  2162. BaseName := Copy(S, 1, P-1);
  2163. Delete(S, 1, P);
  2164. end;
  2165. BaseName := ExpandConst((BaseName));
  2166. FullName := AddBackslash(TempInstallDir) + BaseName;
  2167. if not NewFileExists(FullName) then
  2168. ExtractTemporaryFile(BaseName);
  2169. if FirstFile then begin
  2170. DllName := FullName;
  2171. FirstFile := False;
  2172. end;
  2173. until P = 0;
  2174. end;
  2175. end
  2176. else
  2177. DllName := ExpandConst(DllName);
  2178. end;
  2179. function CodeRunnerOnDebug(const Position: LongInt;
  2180. var ContinueStepOver: Boolean): Boolean;
  2181. begin
  2182. Result := DebugNotify(deCodeLine, Position, ContinueStepOver, CodeRunner.GetCallStack);
  2183. end;
  2184. function CodeRunnerOnDebugIntermediate(const Position: LongInt;
  2185. var ContinueStepOver: Boolean): Boolean;
  2186. begin
  2187. Result := DebugNotifyIntermediate(deCodeLine, Position, ContinueStepOver);
  2188. end;
  2189. procedure CodeRunnerOnException(const Exception: AnsiString; const Position: LongInt);
  2190. begin
  2191. if Debugging then
  2192. DebugNotifyException(String(Exception), deCodeLine, Position);
  2193. end;
  2194. procedure SetActiveLanguage(const I: Integer);
  2195. { Activates the specified language }
  2196. var
  2197. LangEntry: PSetupLanguageEntry;
  2198. J: Integer;
  2199. begin
  2200. if ActiveLanguage = I then
  2201. Exit;
  2202. LangEntry := Entries[seLanguage][I];
  2203. AssignSetupMessages(LangEntry.Data[1], Length(LangEntry.Data));
  2204. { Remove outdated < and > markers from the Back and Next buttons. Done here for now to avoid a Default.isl change. }
  2205. StringChange(SetupMessages[msgButtonBack], '< ', '');
  2206. StringChange(SetupMessages[msgButtonNext], ' >', '');
  2207. ActiveLanguage := I;
  2208. Finalize(LangOptions); { prevent leak on D2 }
  2209. LangOptions := LangEntry^;
  2210. if LangEntry.LicenseText <> '' then
  2211. ActiveLicenseText := LangEntry.LicenseText
  2212. else
  2213. ActiveLicenseText := SetupHeader.LicenseText;
  2214. if LangEntry.InfoBeforeText <> '' then
  2215. ActiveInfoBeforeText := LangEntry.InfoBeforeText
  2216. else
  2217. ActiveInfoBeforeText := SetupHeader.InfoBeforeText;
  2218. if LangEntry.InfoAfterText <> '' then
  2219. ActiveInfoAfterText := LangEntry.InfoAfterText
  2220. else
  2221. ActiveInfoAfterText := SetupHeader.InfoAfterText;
  2222. SetMessageBoxRightToLeft(LangOptions.RightToLeft);
  2223. SetMessageBoxCaption(mbInformation, PChar(SetupMessages[msgInformationTitle]));
  2224. SetMessageBoxCaption(mbConfirmation, PChar(SetupMessages[msgConfirmTitle]));
  2225. SetMessageBoxCaption(mbError, PChar(SetupMessages[msgErrorTitle]));
  2226. SetMessageBoxCaption(mbCriticalError, PChar(SetupMessages[msgErrorTitle]));
  2227. Application.Title := SetupMessages[msgSetupAppTitle];
  2228. for J := 0 to Entries[seType].Count-1 do begin
  2229. with PSetupTypeEntry(Entries[seType][J])^ do begin
  2230. case Typ of
  2231. ttDefaultFull: Description := SetupMessages[msgFullInstallation];
  2232. ttDefaultCompact: Description := SetupMessages[msgCompactInstallation];
  2233. ttDefaultCustom: Description := SetupMessages[msgCustomInstallation];
  2234. end;
  2235. end;
  2236. end;
  2237. { Tell the first instance to change its language too. (It's possible for
  2238. the first instance to display messages after Setup terminates, e.g. if it
  2239. fails to restart the computer.) }
  2240. if SetupNotifyWndPresent then
  2241. SendNotifyMessage(SetupNotifyWnd, WM_USER + 150, 10001, I);
  2242. end;
  2243. function GetLanguageEntryProc(Index: Integer; var Entry: PSetupLanguageEntry): Boolean;
  2244. begin
  2245. Result := False;
  2246. if Index < Entries[seLanguage].Count then begin
  2247. Entry := Entries[seLanguage][Index];
  2248. Result := True;
  2249. end;
  2250. end;
  2251. procedure ActivateDefaultLanguage;
  2252. { Auto-detects the most appropriate language and activates it.
  2253. Also initializes the ShowLanguageDialog and MatchedLangParameter variables.
  2254. Note: A like-named version of this function is also present in SetupLdr.dpr. }
  2255. var
  2256. I: Integer;
  2257. begin
  2258. MatchedLangParameter := False;
  2259. case DetermineDefaultLanguage(GetLanguageEntryProc,
  2260. SetupHeader.LanguageDetectionMethod, InitLang, I) of
  2261. ddNoMatch: ShowLanguageDialog := (SetupHeader.ShowLanguageDialog <> slNo);
  2262. ddMatch: ShowLanguageDialog := (SetupHeader.ShowLanguageDialog = slYes);
  2263. else
  2264. begin
  2265. { ddMatchLangParameter }
  2266. ShowLanguageDialog := False;
  2267. MatchedLangParameter := True;
  2268. end;
  2269. end;
  2270. SetActiveLanguage(I);
  2271. end;
  2272. procedure LogCompatibilityMode;
  2273. var
  2274. S: String;
  2275. begin
  2276. S := GetEnv('__COMPAT_LAYER');
  2277. if S <> '' then
  2278. LogFmt('Compatibility mode: %s (%s)', [SYesNo[True], S]);
  2279. end;
  2280. procedure LogWindowsVersion;
  2281. function ArchitecturesToStr(const Architectures: TSetupProcessorArchitectures;
  2282. const Separator: String): String;
  2283. procedure AppendArchitecture(var S: String; const Separator, L: String);
  2284. begin
  2285. if S <> '' then
  2286. S := S + Separator + L
  2287. else
  2288. S := L;
  2289. end;
  2290. var
  2291. I: TSetupProcessorArchitecture;
  2292. begin
  2293. Result := '';
  2294. for I := Low(I) to High(I) do
  2295. if I in Architectures then
  2296. AppendArchitecture(Result, Separator, SetupProcessorArchitectureNames[I]);
  2297. end;
  2298. var
  2299. SP: String;
  2300. begin
  2301. if NTServicePackLevel <> 0 then begin
  2302. SP := ' SP' + IntToStr(Hi(NTServicePackLevel));
  2303. if Lo(NTServicePackLevel) <> 0 then
  2304. SP := SP + '.' + IntToStr(Lo(NTServicePackLevel));
  2305. end;
  2306. LogFmt('Windows version: %u.%u.%u%s', [WindowsVersion shr 24,
  2307. (WindowsVersion shr 16) and $FF, WindowsVersion and $FFFF, SP]);
  2308. var Bits := 32;
  2309. if IsWin64 then
  2310. Bits := 64;
  2311. LogFmt('Windows architecture: %s (%d-bit)', [SetupProcessorArchitectureNames[ProcessorArchitecture], Bits]);
  2312. LogFmt('Machine types supported by system: %s', [ArchitecturesToStr(MachineTypesSupportedBySystem, ' ')]);
  2313. if IsAdmin then
  2314. Log('User privileges: Administrative')
  2315. else if IsPowerUserOrAdmin then
  2316. Log('User privileges: Power User')
  2317. else
  2318. Log('User privileges: None');
  2319. end;
  2320. function GetMessageBoxResultText(const AResult: Integer): String;
  2321. begin
  2322. case AResult of
  2323. IDOK: Result := 'OK';
  2324. IDCANCEL: Result := 'Cancel';
  2325. IDABORT: Result := 'Abort';
  2326. IDRETRY: Result := 'Retry';
  2327. IDIGNORE: Result := 'Ignore';
  2328. IDYES: Result := 'Yes';
  2329. IDNO: Result := 'No';
  2330. IDTRYAGAIN: Result := 'Try Again';
  2331. IDCONTINUE: Result := 'Continue';
  2332. else
  2333. Result := IntToStr(AResult);
  2334. end;
  2335. end;
  2336. function GetButtonsText(const Buttons: Cardinal): String;
  2337. const
  2338. { We don't use this type, but end users are liable to in [Code].
  2339. Same applies to MB_ABORTRETRYIGNORE. }
  2340. MB_CANCELTRYCONTINUE = $00000006;
  2341. begin
  2342. case Buttons and MB_TYPEMASK of
  2343. MB_OK: Result := 'OK';
  2344. MB_OKCANCEL: Result := 'OK/Cancel';
  2345. MB_ABORTRETRYIGNORE: Result := 'Abort/Retry/Ignore';
  2346. MB_YESNOCANCEL: Result := 'Yes/No/Cancel';
  2347. MB_YESNO: Result := 'Yes/No';
  2348. MB_RETRYCANCEL: Result := 'Retry/Cancel';
  2349. MB_CANCELTRYCONTINUE: Result := 'Cancel/Try Again/Continue';
  2350. else
  2351. Result := IntToStr(Buttons and MB_TYPEMASK);
  2352. end;
  2353. end;
  2354. procedure LogSuppressedMsgBox(const Text: PChar; const Buttons: Cardinal;
  2355. const Default: Integer);
  2356. begin
  2357. Log(Format('Defaulting to %s for suppressed message box (%s):' + SNewLine,
  2358. [GetMessageBoxResultText(Default), GetButtonsText(Buttons)]) + Text);
  2359. end;
  2360. procedure LogMsgBox(const Text: PChar; const Buttons: Cardinal);
  2361. begin
  2362. Log(Format('Message box (%s):' + SNewLine,
  2363. [GetButtonsText(Buttons)]) + Text);
  2364. end;
  2365. function LoggedMsgBox(const Text, Caption: PChar; const Flags: Longint;
  2366. const Suppressible: Boolean; const Default: Integer): Integer;
  2367. begin
  2368. if InitSuppressMsgBoxes and Suppressible then begin
  2369. LogSuppressedMsgBox(Text, Flags, Default);
  2370. Result := Default;
  2371. end else begin
  2372. LogMsgBox(Text, Flags);
  2373. Result := MsgBox(Text, Caption, Flags);
  2374. if Result <> 0 then
  2375. LogFmt('User chose %s.', [GetMessageBoxResultText(Result)])
  2376. else
  2377. Log('MsgBox failed.');
  2378. end;
  2379. end;
  2380. function LoggedMsgBox(const Text, Caption: String; const Typ: TMsgBoxType;
  2381. const Buttons: Cardinal; const Suppressible: Boolean; const Default: Integer): Integer;
  2382. begin
  2383. if InitSuppressMsgBoxes and Suppressible then begin
  2384. LogSuppressedMsgBox(PChar(Text), Buttons, Default);
  2385. Result := Default;
  2386. end else begin
  2387. LogMsgBox(PChar(Text), Buttons);
  2388. Result := MsgBox(Text, Caption, Typ, Buttons);
  2389. if Result <> 0 then
  2390. LogFmt('User chose %s.', [GetMessageBoxResultText(Result)])
  2391. else
  2392. Log('MsgBox failed.');
  2393. end;
  2394. end;
  2395. function LoggedTaskDialogMsgBox(const Icon, Instruction, Text, Caption: String;
  2396. const Typ: TMsgBoxType; const Buttons: Cardinal; const ButtonLabels: array of String;
  2397. const ShieldButton: Integer; const Suppressible: Boolean; const Default: Integer;
  2398. const VerificationText: String = ''; const pfVerificationFlagChecked: PBOOL = nil): Integer;
  2399. begin
  2400. if InitSuppressMsgBoxes and Suppressible then begin
  2401. LogSuppressedMsgBox(PChar(Text), Buttons, Default);
  2402. Result := Default;
  2403. end else begin
  2404. LogMsgBox(PChar(Text), Buttons);
  2405. Result := TaskDialogMsgBox(Icon, Instruction, Text,
  2406. Caption, Typ, Buttons, ButtonLabels, ShieldButton, VerificationText, pfVerificationFlagChecked);
  2407. if Result <> 0 then begin
  2408. LogFmt('User chose %s.', [GetMessageBoxResultText(Result)]);
  2409. if pfVerificationFlagChecked <> nil then
  2410. LogFmt('User chose %s for the verification.', [SYesNo[pfVerificationFlagChecked^]]);
  2411. end else
  2412. Log('TaskDialogMsgBox failed.');
  2413. end;
  2414. end;
  2415. procedure RestartComputerFromThisProcess;
  2416. begin
  2417. RestartInitiatedByThisProcess := True;
  2418. { Note: Depending on the OS, RestartComputer may not return if successful }
  2419. if not RestartComputer then begin
  2420. LoggedMsgBox(SetupMessages[msgErrorRestartingComputer], '', mbError,
  2421. MB_OK, True, IDOK);
  2422. end;
  2423. end;
  2424. procedure RespawnSetupElevated(const AParams: String);
  2425. { Starts a new, elevated Setup(Ldr) process and waits until it terminates.
  2426. Does not return; either calls Halt or raises an exception. }
  2427. var
  2428. Cancelled: Boolean;
  2429. Server: TSpawnServer;
  2430. ParamNotifyWnd: HWND;
  2431. RespawnResults: record
  2432. ExitCode: DWORD;
  2433. NotifyRestartRequested: Boolean;
  2434. NotifyNewLanguage: Integer;
  2435. end;
  2436. begin
  2437. Cancelled := False;
  2438. try
  2439. Server := TSpawnServer.Create;
  2440. try
  2441. if SetupNotifyWndPresent then
  2442. ParamNotifyWnd := SetupNotifyWnd
  2443. else
  2444. ParamNotifyWnd := Server.Wnd;
  2445. RespawnSelfElevated(SetupLdrOriginalFilename,
  2446. Format('/SPAWNWND=$%x /NOTIFYWND=$%x ', [Server.Wnd, ParamNotifyWnd]) +
  2447. AParams, RespawnResults.ExitCode);
  2448. RespawnResults.NotifyRestartRequested := Server.NotifyRestartRequested;
  2449. RespawnResults.NotifyNewLanguage := Server.NotifyNewLanguage;
  2450. finally
  2451. Server.Free;
  2452. end;
  2453. except
  2454. { If the user clicked Cancel on the dialog, halt with special exit code }
  2455. if ExceptObject is EAbort then
  2456. Cancelled := True
  2457. else
  2458. raise;
  2459. end;
  2460. if Cancelled then
  2461. Halt(ecCancelledBeforeInstall);
  2462. if not SetupNotifyWndPresent then begin
  2463. { In the UseSetupLdr=no case, there is no notify window handle to pass to
  2464. RespawnSelfElevated, so it hosts one itself. Process the results. }
  2465. try
  2466. if (RespawnResults.NotifyNewLanguage >= 0) and
  2467. (RespawnResults.NotifyNewLanguage < Entries[seLanguage].Count) then
  2468. SetActiveLanguage(RespawnResults.NotifyNewLanguage);
  2469. if RespawnResults.NotifyRestartRequested then begin
  2470. { Note: Depending on the OS, this may not return if successful }
  2471. RestartComputerFromThisProcess;
  2472. end;
  2473. except
  2474. { In the unlikely event that something above raises an exception, handle
  2475. it here so the right exit code will still be returned below }
  2476. Application.HandleException(nil);
  2477. end;
  2478. end;
  2479. Halt(RespawnResults.ExitCode);
  2480. end;
  2481. procedure InitializeCommonVars;
  2482. { Initializes variables shared between Setup and Uninstall }
  2483. begin
  2484. IsAdmin := IsAdminLoggedOn;
  2485. IsPowerUserOrAdmin := IsAdmin or IsPowerUserLoggedOn;
  2486. end;
  2487. procedure InitializeAdminInstallMode(const AAdminInstallMode: Boolean);
  2488. { Initializes IsAdminInstallMode and other global variables that depend on it }
  2489. const
  2490. RootKeys: array[Boolean] of HKEY = (HKEY_CURRENT_USER, HKEY_LOCAL_MACHINE);
  2491. begin
  2492. LogFmt('Administrative install mode: %s', [SYesNo[AAdminInstallMode]]);
  2493. IsAdminInstallMode := AAdminInstallMode;
  2494. InstallModeRootKey := RootKeys[AAdminInstallMode];
  2495. LogFmt('Install mode root key: %s', [GetRegRootKeyName(InstallModeRootKey)]);
  2496. end;
  2497. procedure Initialize64BitInstallMode(const A64BitInstallMode: Boolean);
  2498. { Initializes Is64BitInstallMode and other global variables that depend on it }
  2499. begin
  2500. Is64BitInstallMode := A64BitInstallMode;
  2501. InstallDefaultDisableFsRedir := A64BitInstallMode;
  2502. ScriptFuncDisableFsRedir := A64BitInstallMode;
  2503. if A64BitInstallMode then
  2504. InstallDefaultRegView := rv64Bit
  2505. else
  2506. InstallDefaultRegView := rv32Bit;
  2507. end;
  2508. procedure Log64BitInstallMode;
  2509. begin
  2510. LogFmt('64-bit install mode: %s', [SYesNo[Is64BitInstallMode]]);
  2511. end;
  2512. var
  2513. LoggedArchiveExtractionMode: Boolean;
  2514. procedure LogArchiveExtractionModeOnce;
  2515. begin
  2516. if not LoggedArchiveExtractionMode then begin
  2517. LogFmt('Archive extraction mode: %s',
  2518. [IfThen(SetupHeader.SevenZipLibraryName <> '', Format('Using %s', [SetupHeader.SevenZipLibraryName]), 'Basic')]);
  2519. LoggedArchiveExtractionMode := True;
  2520. end;
  2521. end;
  2522. procedure InitializeSetup;
  2523. { Initializes various vars used by the setup. This is called in the project
  2524. source. }
  2525. var
  2526. DecompressorDLL, SevenZipDLL: TMemoryStream;
  2527. function ExtractInt64(var S: String): Int64;
  2528. begin
  2529. const P = Pos(',', S);
  2530. if P = 0 then
  2531. raise Exception.Create('Error parsing command line: Missing comma');
  2532. Result := StrToInt64Def(Copy(S, 1, P-1), -1);
  2533. if Result < 0 then
  2534. raise Exception.Create('Error parsing command line: Invalid value');
  2535. Delete(S, 1, P);
  2536. end;
  2537. procedure AbortInit(const Msg: TSetupMessageID); overload;
  2538. begin
  2539. LoggedMsgBox(SetupMessages[Msg], '', mbCriticalError, MB_OK, True, IDOK);
  2540. Abort;
  2541. end;
  2542. procedure AbortInit(const Msg: String); overload;
  2543. begin
  2544. LoggedMsgBox(Msg, '', mbCriticalError, MB_OK, True, IDOK);
  2545. Abort;
  2546. end;
  2547. procedure AbortInitFmt1(const Msg: TSetupMessageID; const Arg1: String);
  2548. begin
  2549. LoggedMsgBox(FmtSetupMessage(Msg, [Arg1]), '', mbCriticalError, MB_OK, True, IDOK);
  2550. Abort;
  2551. end;
  2552. procedure AbortInitServicePackRequired(const ServicePack: Word);
  2553. begin
  2554. LoggedMsgBox(FmtSetupMessage(msgWindowsServicePackRequired, ['Windows',
  2555. IntToStr(Hi(ServicePack))]), '', mbCriticalError, MB_OK, True, IDOK);
  2556. Abort;
  2557. end;
  2558. procedure ReadFileIntoStream(const Reader: TCompressedBlockReader; const Stream: TStream);
  2559. type
  2560. PBuffer = ^TBuffer;
  2561. TBuffer = array[0..8191] of Byte;
  2562. var
  2563. Buf: PBuffer;
  2564. BytesLeft, Bytes: Longint;
  2565. begin
  2566. New(Buf);
  2567. try
  2568. Reader.Read(BytesLeft, SizeOf(BytesLeft));
  2569. while BytesLeft > 0 do begin
  2570. Bytes := BytesLeft;
  2571. if Bytes > SizeOf(Buf^) then Bytes := SizeOf(Buf^);
  2572. Reader.Read(Buf^, Bytes);
  2573. if Stream <> nil then
  2574. Stream.WriteBuffer(Buf^, Bytes);
  2575. Dec(BytesLeft, Bytes);
  2576. end;
  2577. finally
  2578. Dispose(Buf);
  2579. end;
  2580. end;
  2581. function ReadWizardImage(const Reader: TCompressedBlockReader): TGraphic;
  2582. begin
  2583. const MemStream = TMemoryStream.Create;
  2584. try
  2585. ReadFileIntoStream(Reader, MemStream);
  2586. MemStream.Seek(0, soFromBeginning);
  2587. if TPngImage.CanLoadFromStream(MemStream) then
  2588. Result := TPngImage.Create
  2589. else begin
  2590. Result := TBitmap.Create;
  2591. TBitmap(Result).AlphaFormat := TAlphaFormat(SetupHeader.WizardImageAlphaFormat);
  2592. end;
  2593. Result.LoadFromStream(MemStream);
  2594. finally
  2595. MemStream.Free;
  2596. end;
  2597. end;
  2598. procedure ReadWizardImages(const Reader: TCompressedBlockReader; const WizardImages: TWizardImages;
  2599. const WantImages: Boolean);
  2600. begin
  2601. var N: LongInt;
  2602. Reader.Read(N, SizeOf(LongInt));
  2603. for var I := 0 to N-1 do begin
  2604. if WantImages then
  2605. WizardImages.Add(ReadWizardImage(Reader))
  2606. else
  2607. ReadFileIntoStream(Reader, nil);
  2608. end;
  2609. end;
  2610. procedure LoadDecompressorDLL;
  2611. var
  2612. Filename: String;
  2613. begin
  2614. Filename := AddBackslash(TempInstallDir) + '_isetup\_isdecmp.dll';
  2615. SaveStreamToTempFile(DecompressorDLL, Filename);
  2616. FreeAndNil(DecompressorDLL);
  2617. DecompressorDLLHandle := SafeLoadLibrary(Filename, SEM_NOOPENFILEERRORBOX);
  2618. if DecompressorDLLHandle = 0 then
  2619. InternalError(Format('Failed to load DLL "%s"', [Filename]));
  2620. case SetupHeader.CompressMethod of
  2621. cmZip:
  2622. if not ZlibInitDecompressFunctions(DecompressorDLLHandle) then
  2623. InternalError('ZlibInitDecompressFunctions failed');
  2624. cmBzip:
  2625. if not BZInitDecompressFunctions(DecompressorDLLHandle) then
  2626. InternalError('BZInitDecompressFunctions failed');
  2627. end;
  2628. end;
  2629. procedure LoadSevenZipDLL;
  2630. var
  2631. Filename: String;
  2632. begin
  2633. Filename := AddBackslash(TempInstallDir) + '_isetup\_is7z.dll';
  2634. SaveStreamToTempFile(SevenZipDLL, Filename);
  2635. FreeAndNil(SevenZipDLL);
  2636. SevenZipDLLHandle := SafeLoadLibrary(Filename, SEM_NOOPENFILEERRORBOX);
  2637. if SevenZipDLLHandle = 0 then
  2638. InternalError(Format('Failed to load DLL "%s"', [Filename]))
  2639. else begin
  2640. var VersionNumbers: TFileVersionNumbers;
  2641. if not GetVersionNumbers(Filename, VersionNumbers) then
  2642. FillChar(VersionNumbers, SizeOf(VersionNumbers), 0);
  2643. if not SevenZipDLLInit(SevenZipDLLHandle, VersionNumbers) then
  2644. InternalError('SevenZipDLLInit failed');
  2645. end;
  2646. end;
  2647. procedure ReadEntriesWithoutVersion(const Reader: TCompressedBlockReader;
  2648. const EntryType: TEntryType; const Count: Integer; const Size: Integer);
  2649. var
  2650. I: Integer;
  2651. P: Pointer;
  2652. begin
  2653. Entries[EntryType].Capacity := Count;
  2654. for I := 0 to Count-1 do begin
  2655. P := AllocMem(Size);
  2656. SECompressedBlockRead(Reader, P^, Size, EntryStrings[EntryType],
  2657. EntryAnsiStrings[EntryType]);
  2658. Entries[EntryType].Add(P);
  2659. end;
  2660. end;
  2661. procedure ReadEntries(Reader: TCompressedBlockReader; const EntryType: TEntryType;
  2662. const Count: Integer; const Size: Integer; const MinVersionOfs, OnlyBelowVersionOfs: Integer);
  2663. var
  2664. I: Integer;
  2665. P: Pointer;
  2666. begin
  2667. if Debugging then begin
  2668. OriginalEntryIndexes[EntryType] := TList.Create;
  2669. OriginalEntryIndexes[EntryType].Capacity := Count;
  2670. end;
  2671. Entries[EntryType].Capacity := Count;
  2672. for I := 0 to Count-1 do begin
  2673. P := AllocMem(Size);
  2674. SECompressedBlockRead(Reader, P^, Size, EntryStrings[EntryType],
  2675. EntryAnsiStrings[Entrytype]);
  2676. if (MinVersionOfs = -1) or
  2677. (InstallOnThisVersion(TSetupVersionData((@PByteArray(P)[MinVersionOfs])^),
  2678. TSetupVersionData((@PByteArray(P)[OnlyBelowVersionOfs])^)) = irInstall) then begin
  2679. Entries[EntryType].Add(P);
  2680. if Debugging then
  2681. OriginalEntryIndexes[EntryType].Add(Pointer(I));
  2682. end
  2683. else
  2684. SEFreeRec(P, EntryStrings[EntryType], EntryAnsiStrings[EntryType]);
  2685. end;
  2686. end;
  2687. function HandleInitPassword(const NeedPassword: Boolean): Boolean;
  2688. { Handles InitPassword and returns the updated value of NeedPassword }
  2689. { Also see WizardForm.CheckPassword }
  2690. begin
  2691. Result := NeedPassword;
  2692. if NeedPassword and (InitPassword <> '') then begin
  2693. var PasswordOk := False;
  2694. var S := InitPassword;
  2695. var CryptKey: TSetupEncryptionKey;
  2696. GenerateEncryptionKey(S, SetupEncryptionHeader.KDFSalt, SetupEncryptionHeader.KDFIterations, CryptKey);
  2697. if shPassword in SetupHeader.Options then
  2698. PasswordOk := TestPassword(CryptKey, SetupEncryptionHeader.BaseNonce, SetupEncryptionHeader.PasswordTest);
  2699. if not PasswordOk and (CodeRunner <> nil) then
  2700. PasswordOk := CodeRunner.RunBooleanFunctions('CheckPassword', [S], bcTrue, False, PasswordOk);
  2701. if PasswordOk then begin
  2702. Result := False;
  2703. if SetupEncryptionHeader.EncryptionUse = euFiles then
  2704. FileExtractor.CryptKey := CryptKey;
  2705. end;
  2706. end;
  2707. end;
  2708. procedure SetupInstallMode;
  2709. begin
  2710. if InitVerySilent then
  2711. InstallMode := imVerySilent
  2712. else if InitSilent then
  2713. InstallMode := imSilent;
  2714. end;
  2715. function RecurseExternalGetSizeOfFiles(const DisableFsRedir: Boolean;
  2716. const SearchBaseDir, SearchSubDir, SearchWildcard: String;
  2717. const SourceIsWildcard: Boolean; const Excludes: TStrings;
  2718. const RecurseSubDirs: Boolean): Int64;
  2719. begin
  2720. { Also see RecurseExternalFiles above and RecurseExternalCopyFiles in Setup.Install
  2721. Also see RecurseExternalArchiveGetSizeOfFiles directly below }
  2722. Result := 0;
  2723. var FindData: TWin32FindData;
  2724. var H := FindFirstFileRedir(DisableFsRedir, SearchBaseDir + SearchSubDir + SearchWildcard, FindData);
  2725. if H <> INVALID_HANDLE_VALUE then begin
  2726. repeat
  2727. if FindData.dwFileAttributes and FILE_ATTRIBUTE_DIRECTORY = 0 then begin
  2728. if SourceIsWildcard then
  2729. if FindData.dwFileAttributes and FILE_ATTRIBUTE_HIDDEN <> 0 then
  2730. Continue;
  2731. if IsExcluded(SearchSubDir + FindData.cFileName, Excludes) then
  2732. Continue;
  2733. Inc(Result, FindDataFileSizeToInt64(FindData));
  2734. end;
  2735. until not FindNextFile(H, FindData);
  2736. Windows.FindClose(H);
  2737. end;
  2738. if RecurseSubDirs then begin
  2739. H := FindFirstFileRedir(DisableFsRedir, SearchBaseDir + SearchSubDir + '*', FindData);
  2740. if H <> INVALID_HANDLE_VALUE then begin
  2741. try
  2742. repeat
  2743. if IsRecurseableDirectory(FindData) then begin
  2744. var I := RecurseExternalGetSizeOfFiles(DisableFsRedir, SearchBaseDir,
  2745. SearchSubDir + FindData.cFileName + '\', SearchWildcard,
  2746. SourceIsWildcard, Excludes, RecurseSubDirs);
  2747. Inc(Result, I);
  2748. end;
  2749. until not FindNextFile(H, FindData);
  2750. finally
  2751. Windows.FindClose(H);
  2752. end;
  2753. end;
  2754. end;
  2755. end;
  2756. function RecurseExternalArchiveGetSizeOfFiles(const DisableFsRedir: Boolean;
  2757. const ArchiveFilename, Password: String; const Excludes: TStrings;
  2758. const RecurseSubDirs: Boolean): Int64;
  2759. begin
  2760. { See above }
  2761. Result := 0;
  2762. if not NewFileExistsRedir(DisableFsRedir, ArchiveFilename) then
  2763. Exit;
  2764. var FindData: TWin32FindData;
  2765. var H := ArchiveFindFirstFileRedir(DisableFsRedir, ArchiveFilename,
  2766. AddBackslash(TempInstallDir), { DestDir isn't known yet, pass a placeholder }
  2767. Password, RecurseSubDirs, False, FindData);
  2768. if H <> INVALID_HANDLE_VALUE then begin
  2769. try
  2770. repeat
  2771. if FindData.dwFileAttributes and FILE_ATTRIBUTE_DIRECTORY = 0 then begin
  2772. if IsExcluded(FindData.cFileName, Excludes) then
  2773. Continue;
  2774. Inc(Result, FindDataFileSizeToInt64(FindData));
  2775. end;
  2776. until not ArchiveFindNextFile(H, FindData);
  2777. finally
  2778. ArchiveFindClose(H);
  2779. end;
  2780. end;
  2781. end;
  2782. { Also see Install.pas }
  2783. function ExistingInstallationAt(const RootKey: HKEY; const SubkeyName: String): Boolean;
  2784. var
  2785. K: HKEY;
  2786. begin
  2787. if RegOpenKeyExView(InstallDefaultRegView, RootKey, PChar(SubkeyName), 0, KEY_QUERY_VALUE, K) = ERROR_SUCCESS then begin
  2788. Result := True;
  2789. RegCloseKey(K);
  2790. end else
  2791. Result := False;
  2792. end;
  2793. procedure HandlePrivilegesRequiredOverrides(var ExtraRespawnParam: String);
  2794. var
  2795. ExistingAtAdminInstallMode, ExistingAtNonAdminInstallMode, DesireAnInstallMode, DesireAdminInstallMode: Boolean;
  2796. SubkeyName, AppName: String;
  2797. begin
  2798. if HasInitPrivilegesRequired and (proCommandLine in SetupHeader.PrivilegesRequiredOverridesAllowed) then begin
  2799. SetupHeader.PrivilegesRequired := InitPrivilegesRequired;
  2800. { We don't need to set ExtraRespawnParam since the existing command line
  2801. already contains the needed parameters and it will automatically be
  2802. passed on to any respawned Setup(Ldr). }
  2803. end else if proDialog in SetupHeader.PrivilegesRequiredOverridesAllowed then begin
  2804. if shUsePreviousPrivileges in SetupHeader.Options then begin
  2805. { Note: if proDialog is used and UsePreviousPrivileges is set to "yes"
  2806. then the compiler does not allow AppId to include constants but we
  2807. should still call ExpandConst to handle any '{{'. }
  2808. SubkeyName := GetUninstallRegSubkeyName(GetUninstallRegKeyBaseName(ExpandConst(SetupHeader.AppID)));
  2809. ExistingAtAdminInstallMode := ExistingInstallationAt(HKEY_LOCAL_MACHINE, SubkeyName);
  2810. ExistingAtNonAdminInstallMode := ExistingInstallationAt(HKEY_CURRENT_USER, SubkeyName);
  2811. end else begin
  2812. ExistingAtAdminInstallMode := False;
  2813. ExistingAtNonAdminInstallMode := False;
  2814. end;
  2815. DesireAnInstallMode := True;
  2816. DesireAdminInstallMode := False; { Silence compiler }
  2817. if ExistingAtAdminInstallMode and not ExistingAtNonAdminInstallMode then
  2818. DesireAdminInstallMode := True
  2819. else if not ExistingAtAdminInstallMode and ExistingAtNonAdminInstallMode then
  2820. DesireAdminInstallMode := False
  2821. else if not InitSuppressMsgBoxes then begin
  2822. { Ask user. Doesn't log since logging hasn't started yet. Also doesn't
  2823. use ExpandedAppName since it isn't set yet. Afterwards we need to tell
  2824. any respawned Setup(Ldr) about the user choice (and avoid asking again).
  2825. Will use the command line parameter for this. Allowing proDialog forces
  2826. allowing proCommandLine, so we can count on the parameter to work. }
  2827. if shAppNameHasConsts in SetupHeader.Options then
  2828. AppName := PathChangeExt(PathExtractName(SetupLdrOriginalFilename), '')
  2829. else
  2830. AppName := SetupHeader.AppName;
  2831. if SetupHeader.PrivilegesRequired = prLowest then begin
  2832. case TaskDialogMsgBox('MAINICON' + MainIconPostfix, SetupMessages[msgPrivilegesRequiredOverrideInstruction],
  2833. FmtSetupMessage(msgPrivilegesRequiredOverrideText2, [AppName]),
  2834. SetupMessages[msgPrivilegesRequiredOverrideTitle], mbInformation, MB_YESNOCANCEL,
  2835. [SetupMessages[msgPrivilegesRequiredOverrideCurrentUserRecommended], SetupMessages[msgPrivilegesRequiredOverrideAllUsers]], IDNO) of
  2836. IDYES: DesireAdminInstallMode := False;
  2837. IDNO: DesireAdminInstallMode := True;
  2838. IDCANCEL: Abort;
  2839. end;
  2840. end else begin
  2841. case TaskDialogMsgBox('MAINICON' + MainIconPostfix, SetupMessages[msgPrivilegesRequiredOverrideInstruction],
  2842. FmtSetupMessage(msgPrivilegesRequiredOverrideText1, [AppName]),
  2843. SetupMessages[msgPrivilegesRequiredOverrideTitle], mbInformation, MB_YESNOCANCEL,
  2844. [SetupMessages[msgPrivilegesRequiredOverrideAllUsersRecommended], SetupMessages[msgPrivilegesRequiredOverrideCurrentUser]], IDYES) of
  2845. IDYES: DesireAdminInstallMode := True;
  2846. IDNO: DesireAdminInstallMode := False;
  2847. IDCANCEL: Abort;
  2848. end;
  2849. end;
  2850. end else
  2851. DesireAnInstallMode := False; { No previous found and msgboxes are suppressed, just keep things as they are. }
  2852. if DesireAnInstallMode then begin
  2853. if DesireAdminInstallMode then begin
  2854. SetupHeader.PrivilegesRequired := prAdmin;
  2855. ExtraRespawnParam := '/ALLUSERS';
  2856. end else begin
  2857. SetupHeader.PrivilegesRequired := prLowest;
  2858. ExtraRespawnParam := '/CURRENTUSER';
  2859. end;
  2860. end;
  2861. end;
  2862. end;
  2863. var
  2864. ParamName, ParamValue: String;
  2865. ParamIsAutomaticInternal: Boolean;
  2866. StartParam: Integer;
  2867. I, N: Integer;
  2868. IsRespawnedProcess, EnableLogging, WantToSuppressMsgBoxes, Res: Boolean;
  2869. DebugServerWnd: HWND;
  2870. LogFilename: String;
  2871. SetupFile: TFile;
  2872. TestID: TSetupID;
  2873. NameAndVersionMsg: String;
  2874. NextAllowedLevel: Integer;
  2875. LastShownComponentEntry, ComponentEntry: PSetupComponentEntry;
  2876. SourceWildcard: String;
  2877. ExpandedSetupMutex, ExtraRespawnParam, RespawnParams: String;
  2878. begin
  2879. InitializeCommonVars;
  2880. { NewParamsForCode will hold all params except automatic internal ones like /SL5= and /DEBUGWND=
  2881. Also see Uninstall.ProcessCommandLine }
  2882. NewParamsForCode.Add(NewParamStr(0));
  2883. { Based on SetupLdr or not?
  2884. Parameters for launching SetupLdr-based installation are:
  2885. /SL5="<handle to SetupLdr's notify window>,<setup 0 data offset>,
  2886. <setup 1 data offset>,<original exe filename>"
  2887. }
  2888. SplitNewParamStr(1, ParamName, ParamValue);
  2889. if SameText(ParamName, '/SL5=') then begin
  2890. StartParam := 2;
  2891. SetupLdrMode := True;
  2892. SetupNotifyWnd := UInt32(ExtractInt64(ParamValue));
  2893. SetupNotifyWndPresent := True;
  2894. SetupLdrOffset0 := ExtractInt64(ParamValue);
  2895. SetupLdrOffset1 := ExtractInt64(ParamValue);
  2896. SetupLdrOriginalFilename := ParamValue;
  2897. end
  2898. else begin
  2899. StartParam := 1;
  2900. SetupLdrOriginalFilename := NewParamStr(0);
  2901. end;
  2902. SourceDir := PathExtractDir(SetupLdrOriginalFilename);
  2903. IsRespawnedProcess := False;
  2904. EnableLogging := False;
  2905. WantToSuppressMsgBoxes := False;
  2906. DebugServerWnd := 0;
  2907. for I := StartParam to NewParamCount do begin
  2908. SplitNewParamStr(I, ParamName, ParamValue);
  2909. ParamIsAutomaticInternal := False;
  2910. if SameText(ParamName, '/Log') then begin
  2911. EnableLogging := True;
  2912. LogFilename := '';
  2913. end else if SameText(ParamName, '/Log=') then begin
  2914. EnableLogging := True;
  2915. LogFilename := ParamValue;
  2916. end else if SameText(ParamName, '/Silent') then
  2917. InitSilent := True
  2918. else if SameText(ParamName, '/VerySilent') then
  2919. InitVerySilent := True
  2920. else if SameText(ParamName, '/NoRestart') then
  2921. InitNoRestart := True
  2922. else if SameText(ParamName, '/CloseApplications') then
  2923. InitCloseApplications := True
  2924. else if SameText(ParamName, '/NoCloseApplications') then
  2925. InitNoCloseApplications := True
  2926. else if SameText(ParamName, '/ForceCloseApplications') then
  2927. InitForceCloseApplications := True
  2928. else if SameText(ParamName, '/NoForceCloseApplications') then
  2929. InitNoForceCloseApplications := True
  2930. else if SameText(ParamName, '/LogCloseApplications') then
  2931. InitLogCloseApplications := True
  2932. else if SameText(ParamName, '/RestartApplications') then
  2933. InitRestartApplications := True
  2934. else if SameText(ParamName, '/NoRestartApplications') then
  2935. InitNoRestartApplications := True
  2936. else if SameText(ParamName, '/NoIcons') then
  2937. InitNoIcons := True
  2938. else if SameText(ParamName, '/NoCancel') then
  2939. InitNoCancel := True
  2940. else if SameText(ParamName, '/NoStyle') then
  2941. InitNoStyle := True
  2942. else if SameText(ParamName, '/Lang=') then
  2943. InitLang := ParamValue
  2944. else if SameText(ParamName, '/Type=') then
  2945. InitSetupType := ParamValue
  2946. else if SameText(ParamName, '/Components=') then begin
  2947. InitComponentsSpecified := True;
  2948. SetStringsFromCommaString(InitComponents, SlashesToBackslashes(ParamValue));
  2949. end else if SameText(ParamName, '/Tasks=') then begin
  2950. InitDeselectAllTasks := True;
  2951. SetStringsFromCommaString(InitTasks, SlashesToBackslashes(ParamValue));
  2952. end else if SameText(ParamName, '/MergeTasks=') then begin
  2953. InitDeselectAllTasks := False;
  2954. SetStringsFromCommaString(InitTasks, SlashesToBackslashes(ParamValue));
  2955. end else if SameText(ParamName, '/LoadInf=') then
  2956. InitLoadInf := PathExpand(ParamValue)
  2957. else if SameText(ParamName, '/SaveInf=') then
  2958. InitSaveInf := PathExpand(ParamValue)
  2959. else if SameText(ParamName, '/DIR=') then
  2960. InitDir := ParamValue
  2961. else if SameText(ParamName, '/GROUP=') then
  2962. InitProgramGroup := ParamValue
  2963. else if SameText(ParamName, '/Password=') then
  2964. InitPassword := ParamValue
  2965. else if SameText(ParamName, '/RestartExitCode=') then
  2966. InitRestartExitCode := StrToIntDef(ParamValue, 0)
  2967. else if SameText(ParamName, '/SuppressMsgBoxes') then
  2968. WantToSuppressMsgBoxes := True
  2969. else if SameText(ParamName, '/DETACHEDMSG') then { for debugging }
  2970. DetachedUninstMsgFile := True
  2971. else if SameText(ParamName, '/SPAWNWND=') then begin
  2972. ParamIsAutomaticInternal := True; { sent by RespawnSetupElevated }
  2973. IsRespawnedProcess := True;
  2974. InitializeSpawnClient(StrToInt(ParamValue));
  2975. end else if SameText(ParamName, '/NOTIFYWND=') then begin
  2976. ParamIsAutomaticInternal := True; { sent by RespawnSetupElevated }
  2977. { /NOTIFYWND= takes precedence over any previously set SetupNotifyWnd }
  2978. SetupNotifyWnd := StrToInt(ParamValue);
  2979. SetupNotifyWndPresent := True;
  2980. end else if SameText(ParamName, '/DebugSpawnServer') then { for debugging }
  2981. EnterSpawnServerDebugMode { does not return }
  2982. else if SameText(ParamName, '/DEBUGWND=') then begin
  2983. ParamIsAutomaticInternal := True; { sent by IDE.MainForm's StartProcess }
  2984. DebugServerWnd := StrToInt(ParamValue);
  2985. end else if SameText(ParamName, '/ALLUSERS') then begin
  2986. InitPrivilegesRequired := prAdmin;
  2987. HasInitPrivilegesRequired := True;
  2988. end else if SameText(ParamName, '/CURRENTUSER') then begin
  2989. InitPrivilegesRequired := prLowest;
  2990. HasInitPrivilegesRequired := True;
  2991. end;
  2992. if not ParamIsAutomaticInternal then
  2993. NewParamsForCode.Add(NewParamStr(I));
  2994. end;
  2995. if InitLoadInf <> '' then
  2996. LoadInf(InitLoadInf, WantToSuppressMsgBoxes);
  2997. if WantToSuppressMsgBoxes and (InitSilent or InitVerySilent) then
  2998. InitSuppressMsgBoxes := True;
  2999. { Assign some default messages that may be used before the messages are read }
  3000. SetupMessages[msgSetupFileMissing] := SSetupFileMissing;
  3001. SetupMessages[msgSetupFileCorrupt] := SSetupFileCorrupt;
  3002. SetupMessages[msgSetupFileCorruptOrWrongVer] := SSetupFileCorruptOrWrongVer;
  3003. { Read setup-0.bin, or from EXE }
  3004. var SetupFilename: String;
  3005. if not SetupLdrMode then begin
  3006. SetupFilename := PathChangeExt(SetupLdrOriginalFilename, '') + '-0.bin';
  3007. {$IFDEF DEBUG}
  3008. { Also see TFileExtractor.FindSliceFilename }
  3009. SetupFileName := SetupFileName.Replace('SetupCustomStyle', 'Setup');
  3010. {$ENDIF}
  3011. if not NewFileExists(SetupFilename) then
  3012. AbortInitFmt1(msgSetupFileMissing, PathExtractName(SetupFilename));
  3013. end
  3014. else
  3015. SetupFilename := SetupLdrOriginalFilename;
  3016. SetupFile := TFile.Create(SetupFilename, fdOpenExisting, faRead, fsRead);
  3017. try
  3018. SetupFile.Seek(SetupLdrOffset0);
  3019. if SetupFile.Read(TestID, SizeOf(TestID)) <> SizeOf(TestID) then
  3020. AbortInit(msgSetupFileCorruptOrWrongVer);
  3021. if TestID <> SetupID then
  3022. AbortInit(msgSetupFileCorruptOrWrongVer);
  3023. var SetupEncryptionHeaderCRC: Longint;
  3024. SetupFile.Read(SetupEncryptionHeaderCRC, SizeOf(SetupEncryptionHeaderCRC));
  3025. SetupFile.Read(SetupEncryptionHeader, SizeOf(SetupEncryptionHeader));
  3026. if SetupEncryptionHeaderCRC <> GetCRC32(SetupEncryptionHeader, SizeOf(SetupEncryptionHeader)) then
  3027. AbortInit(msgSetupFileCorruptOrWrongVer);
  3028. var CryptKey: TSetupEncryptionKey;
  3029. if SetupEncryptionHeader.EncryptionUse = euFull then begin
  3030. if InitPassword = '' then
  3031. AbortInit(SMissingPassword);
  3032. GenerateEncryptionKey(InitPassword, SetupEncryptionHeader.KDFSalt, SetupEncryptionHeader.KDFIterations, CryptKey);
  3033. if not TestPassword(CryptKey, SetupEncryptionHeader.BaseNonce, SetupEncryptionHeader.PasswordTest) then
  3034. AbortInit(SIncorrectPassword);
  3035. { FileExtractor (a function!) requires SetupHeader.CompressMethod to be set, so delaying setting
  3036. FileExtractor.CryptKey until SetupHeader is read below }
  3037. end;
  3038. try
  3039. var Reader := TCompressedBlockReader.Create(SetupFile, TLZMA1Decompressor);
  3040. try
  3041. if SetupEncryptionHeader.EncryptionUse = euFull then
  3042. Reader.InitDecryption(CryptKey, SetupEncryptionHeader.BaseNonce, sccCompressedBlocks1);
  3043. { Header }
  3044. SECompressedBlockRead(Reader, SetupHeader, SizeOf(SetupHeader),
  3045. SetupHeaderStrings, SetupHeaderAnsiStrings);
  3046. if SetupEncryptionHeader.EncryptionUse = euFull then
  3047. FileExtractor.CryptKey := CryptKey; { See above }
  3048. { Apply style - also see Setup.Uninstall's RunSecondPhase
  3049. Note: when debugging Setup.e32 or SetupCustomStyle.e32 it will see the default resources,
  3050. instead of the ones prepared by the compiler. This is because the .e32 is started, and
  3051. not the .exe prepared by the compiler. This is not noticable except for the VCL style
  3052. resources: the MYSTYLE1 and MYSTYLE1_DARK styles will always be missing. In this case
  3053. it will use the ZIRCON style, see below. This does *not* mean Uninstall will then
  3054. also use ZIRCON. To test Uninstall styling use a real Setup compiled by the
  3055. compiler. }
  3056. var WantWizardImagesDynamicDark := False;
  3057. IsWinDark := DarkModeActive;
  3058. if not HighContrastActive and not InitNoStyle then begin
  3059. const IsDynamicDark = (SetupHeader.WizardDarkStyle = wdsDynamic) and IsWinDark;
  3060. const IsForcedDark = SetupHeader.WizardDarkStyle = wdsDark;
  3061. if IsDynamicDark then begin
  3062. SetupHeader.WizardImageBackColor := SetupHeader.WizardImageBackColorDynamicDark;
  3063. SetupHeader.WizardSmallImageBackColor := SetupHeader.WizardSmallImageBackColorDynamicDark;
  3064. MainIconPostfix := '_DARK';
  3065. { If the main icon is custom, a dark version will not be available, so check for this }
  3066. if FindResource(HInstance, PChar('MAINICON' + MainIconPostfix), RT_GROUP_ICON) = 0 then
  3067. MainIconPostfix := '';
  3068. WantWizardImagesDynamicDark := True; { Handled below }
  3069. end;
  3070. if IsDynamicDark or IsForcedDark then begin
  3071. IsDarkInstallMode := True;
  3072. WizardIconsPostfix := '_DARK';
  3073. end;
  3074. TStyleManager.AutoDiscoverStyleResources := False;
  3075. { Also see comment above }
  3076. var StyleName := 'MYSTYLE1';
  3077. if IsDynamicDark then
  3078. StyleName := StyleName + '_DARK';
  3079. var Handle: TStyleManager.TStyleServicesHandle;
  3080. if TStyleManager.TryLoadFromResource(HInstance, StyleName, 'VCLSTYLE', Handle)
  3081. {$IFDEF DEBUG}
  3082. or TStyleManager.TryLoadFromResource(HInstance, 'ZIRCON', 'VCLSTYLE', Handle)
  3083. { Comment the line above to activate POLAR_DARK instead of ZIRCON }
  3084. or TStyleManager.TryLoadFromResource(HInstance, 'POLAR_DARK', 'VCLSTYLE', Handle)
  3085. {$ENDIF}
  3086. then begin
  3087. TStyleManager.SetStyle(Handle);
  3088. if not IsDarkInstallMode and (shWizardLightButtonsUnstyled in SetupHeader.Options) then
  3089. TNewButton.DontStyle := True;
  3090. end;
  3091. end;
  3092. { Language entries }
  3093. ReadEntriesWithoutVersion(Reader, seLanguage, SetupHeader.NumLanguageEntries,
  3094. SizeOf(TSetupLanguageEntry));
  3095. { CustomMessage entries }
  3096. ReadEntriesWithoutVersion(Reader, seCustomMessage, SetupHeader.NumCustomMessageEntries,
  3097. SizeOf(TSetupCustomMessageEntry));
  3098. { Permission entries }
  3099. ReadEntriesWithoutVersion(Reader, sePermission, SetupHeader.NumPermissionEntries,
  3100. SizeOf(TSetupPermissionEntry));
  3101. { Type entries }
  3102. ReadEntries(Reader, seType, SetupHeader.NumTypeEntries, SizeOf(TSetupTypeEntry),
  3103. Integer(@PSetupTypeEntry(nil).MinVersion),
  3104. Integer(@PSetupTypeEntry(nil).OnlyBelowVersion));
  3105. ActivateDefaultLanguage;
  3106. { Set Is64BitInstallMode if we're on Win64 and the processor architecture is
  3107. one on which a "64-bit mode" install should be performed. Doing this early
  3108. so that UsePreviousPrivileges knows where to look. Will log later. }
  3109. if (SetupHeader.ArchitecturesInstallIn64BitMode <> '') and
  3110. EvalExpression(SetupHeader.ArchitecturesInstallIn64BitMode, TDummyClass.EvalArchitectureIdentifier) then begin
  3111. if not IsWin64 then begin
  3112. { The script writer made a mistake: their expression matched a
  3113. 32-bit system. Obviously that can't be allowed.
  3114. With "not" there are lots of ways that could happen without
  3115. explicitly specifying a 32-bit architecture in the expression.
  3116. One example: "not win64" }
  3117. InternalError('ArchitecturesInstallIn64BitMode expression matched 32-bit system');
  3118. end;
  3119. Initialize64BitInstallMode(True);
  3120. end
  3121. else
  3122. Initialize64BitInstallMode(False);
  3123. HandlePrivilegesRequiredOverrides(ExtraRespawnParam);
  3124. { Start a new, elevated Setup(Ldr) process if needed }
  3125. if not IsRespawnedProcess and
  3126. NeedToRespawnSelfElevated(not (SetupHeader.PrivilegesRequired in [prNone, prLowest]),
  3127. SetupHeader.PrivilegesRequired <> prLowest) then begin
  3128. FreeAndNil(Reader);
  3129. FreeAndNil(SetupFile);
  3130. RespawnParams := GetCmdTailEx(StartParam);
  3131. if ExtraRespawnParam <> '' then
  3132. RespawnParams := RespawnParams + ' ' + ExtraRespawnParam;
  3133. RespawnSetupElevated(RespawnParams);
  3134. { Note: RespawnSetupElevated does not return; it either calls Halt
  3135. or raises an exception. }
  3136. end;
  3137. { Application.Handle is now known to be the main window. Set the shutdown block reason. }
  3138. ShutdownBlockReasonCreate(Application.Handle, SetupMessages[msgWizardInstalling]);
  3139. { Initialize debug client (client=Setup, server=debugger/IDE) }
  3140. if DebugServerWnd <> 0 then
  3141. SetDebugServerWnd(DebugServerWnd, False);
  3142. { Initialize logging }
  3143. if EnableLogging or (shSetupLogging in SetupHeader.Options) then begin
  3144. try
  3145. if LogFilename = '' then
  3146. StartLogging('Setup')
  3147. else
  3148. StartLoggingWithFixedFilename(LogFilename);
  3149. except
  3150. on E: Exception do begin
  3151. E.Message := 'Error creating log file:' + SNewLine2 + E.Message;
  3152. raise;
  3153. end;
  3154. end;
  3155. end;
  3156. Log('Setup version: ' + SetupTitle + ' version ' + SetupVersion);
  3157. Log('Original Setup EXE: ' + SetupLdrOriginalFilename);
  3158. Log('Setup command line: ' + GetCmdTail);
  3159. LogCompatibilityMode;
  3160. LogWindowsVersion;
  3161. NeedPassword := (SetupEncryptionHeader.EncryptionUse <> euFull) and (shPassword in SetupHeader.Options);
  3162. NeedSerial := False;
  3163. NeedsRestart := shAlwaysRestart in SetupHeader.Options;
  3164. { Component entries }
  3165. ReadEntries(Reader, seComponent, SetupHeader.NumComponentEntries, SizeOf(TSetupComponentEntry),
  3166. -1, -1);
  3167. { Task entries }
  3168. ReadEntries(Reader, seTask, SetupHeader.NumTaskEntries, SizeOf(TSetupTaskEntry),
  3169. -1, -1);
  3170. { Dir entries }
  3171. ReadEntries(Reader, seDir, SetupHeader.NumDirEntries, SizeOf(TSetupDirEntry),
  3172. Integer(@PSetupDirEntry(nil).MinVersion),
  3173. Integer(@PSetupDirEntry(nil).OnlyBelowVersion));
  3174. { ISSigKey entries }
  3175. ReadEntriesWithoutVersion(Reader, seISSigKey, SetupHeader.NumISSigKeyEntries, SizeOf(TSetupISSigKeyEntry));
  3176. { File entries }
  3177. ReadEntries(Reader, seFile, SetupHeader.NumFileEntries, SizeOf(TSetupFileEntry),
  3178. Integer(@PSetupFileEntry(nil).MinVersion),
  3179. Integer(@PSetupFileEntry(nil).OnlyBelowVersion));
  3180. { Icon entries }
  3181. ReadEntries(Reader, seIcon, SetupHeader.NumIconEntries, SizeOf(TSetupIconEntry),
  3182. Integer(@PSetupIconEntry(nil).MinVersion),
  3183. Integer(@PSetupIconEntry(nil).OnlyBelowVersion));
  3184. { INI entries }
  3185. ReadEntries(Reader, seIni, SetupHeader.NumIniEntries, SizeOf(TSetupIniEntry),
  3186. Integer(@PSetupIniEntry(nil).MinVersion),
  3187. Integer(@PSetupIniEntry(nil).OnlyBelowVersion));
  3188. { Registry entries }
  3189. ReadEntries(Reader, seRegistry, SetupHeader.NumRegistryEntries, SizeOf(TSetupRegistryEntry),
  3190. Integer(@PSetupRegistryEntry(nil).MinVersion),
  3191. Integer(@PSetupRegistryEntry(nil).OnlyBelowVersion));
  3192. { InstallDelete entries }
  3193. ReadEntries(Reader, seInstallDelete, SetupHeader.NumInstallDeleteEntries, SizeOf(TSetupDeleteEntry),
  3194. Integer(@PSetupDeleteEntry(nil).MinVersion),
  3195. Integer(@PSetupDeleteEntry(nil).OnlyBelowVersion));
  3196. { UninstallDelete entries }
  3197. ReadEntries(Reader, seUninstallDelete, SetupHeader.NumUninstallDeleteEntries, SizeOf(TSetupDeleteEntry),
  3198. Integer(@PSetupDeleteEntry(nil).MinVersion),
  3199. Integer(@PSetupDeleteEntry(nil).OnlyBelowVersion));
  3200. { Run entries }
  3201. ReadEntries(Reader, seRun, SetupHeader.NumRunEntries, SizeOf(TSetupRunEntry),
  3202. Integer(@PSetupRunEntry(nil).MinVersion),
  3203. Integer(@PSetupRunEntry(nil).OnlyBelowVersion));
  3204. { UninstallRun entries }
  3205. ReadEntries(Reader, seUninstallRun, SetupHeader.NumUninstallRunEntries, SizeOf(TSetupRunEntry),
  3206. Integer(@PSetupRunEntry(nil).MinVersion),
  3207. Integer(@PSetupRunEntry(nil).OnlyBelowVersion));
  3208. { Wizard images }
  3209. ReadWizardImages(Reader, WizardImages, not WantWizardImagesDynamicDark);
  3210. ReadWizardImages(Reader, WizardSmallImages, not WantWizardImagesDynamicDark);
  3211. ReadWizardImages(Reader, WizardImages, WantWizardImagesDynamicDark);
  3212. ReadWizardImages(Reader, WizardSmallImages, WantWizardImagesDynamicDark);
  3213. { Decompressor DLL }
  3214. DecompressorDLL := nil;
  3215. if SetupHeader.CompressMethod in [cmZip, cmBzip] then begin
  3216. DecompressorDLL := TMemoryStream.Create;
  3217. ReadFileIntoStream(Reader, DecompressorDLL);
  3218. end;
  3219. { SevenZip DLL }
  3220. SevenZipDLL := nil;
  3221. if SetupHeader.SevenZipLibraryName <> '' then begin
  3222. SevenZipDLL := TMemoryStream.Create;
  3223. ReadFileIntoStream(Reader, SevenZipDLL);
  3224. end;
  3225. finally
  3226. Reader.Free;
  3227. end;
  3228. Reader := TCompressedBlockReader.Create(SetupFile, TLZMA1Decompressor);
  3229. try
  3230. if SetupEncryptionHeader.EncryptionUse = euFull then
  3231. Reader.InitDecryption(CryptKey, SetupEncryptionHeader.BaseNonce, sccCompressedBlocks2);
  3232. { File location entries }
  3233. ReadEntriesWithoutVersion(Reader, seFileLocation, SetupHeader.NumFileLocationEntries,
  3234. SizeOf(TSetupFileLocationEntry));
  3235. finally
  3236. Reader.Free;
  3237. end;
  3238. except
  3239. on ECompressDataError do
  3240. AbortInit(msgSetupFileCorrupt);
  3241. end;
  3242. finally
  3243. SetupFile.Free;
  3244. end;
  3245. InitializeAdminInstallMode(IsAdmin and (SetupHeader.PrivilegesRequired <> prLowest));
  3246. Log64BitInstallMode;
  3247. { Test code. Originally planned to call DeleteResidualTempUninstallDirs
  3248. during Setup's startup too, but decided against it; it's not really
  3249. necessary and could slow down the startup (slightly). }
  3250. (*
  3251. for var Z := 1 to 5 do begin
  3252. const TD = CreateTempDir('-uninstall.tmp', IsAdmin);
  3253. TFile.Create(TD + '\_unins.tmp', fdCreateNew, faWrite, fsNone).Free;
  3254. TFile.Create(TD + '\_unins-done.tmp', fdCreateNew, faWrite, fsNone).Free;
  3255. end;
  3256. DeleteResidualTempUninstallDirs;
  3257. *)
  3258. { Show "Select Language" dialog if necessary - requires "64-bit mode" to be
  3259. initialized else it might query the previous language from the wrong registry
  3260. view }
  3261. if Entries[seLanguage].Count > 1 then begin
  3262. if ShowLanguageDialog and not InitSilent and not InitVerySilent then begin
  3263. if not AskForLanguage then
  3264. Abort;
  3265. end else if not MatchedLangParameter and (shUsePreviousLanguage in SetupHeader.Options) then begin
  3266. { Replicate the dialog's UsePreviousLanguage functionality. }
  3267. { Note: if UsePreviousLanguage is set to "yes" then the compiler does not
  3268. allow AppId to include constants but we should still call ExpandConst
  3269. to handle any '{{'. }
  3270. I := GetPreviousLanguage(ExpandConst(SetupHeader.AppId));
  3271. if I <> -1 then
  3272. SetActiveLanguage(I);
  3273. end;
  3274. end;
  3275. { Check unsupported Itanium - must be on Windows Server 2008 R2 so remove once
  3276. this becomes unsupported as well and Windows 8 (6.2+) becomes the new minimum }
  3277. var SysInfo: TSystemInfo;
  3278. GetNativeSystemInfo(SysInfo);
  3279. if SysInfo.wProcessorArchitecture = PROCESSOR_ARCHITECTURE_IA64 then
  3280. AbortInit(msgWindowsVersionNotSupported);
  3281. { Check allowed processor architectures }
  3282. if (SetupHeader.ArchitecturesAllowed <> '') and
  3283. not EvalExpression(SetupHeader.ArchitecturesAllowed, TDummyClass.EvalArchitectureIdentifier) then
  3284. AbortInit(msgWindowsVersionNotSupported);
  3285. { Check Windows version }
  3286. case InstallOnThisVersion(SetupHeader.MinVersion, SetupHeader.OnlyBelowVersion) of
  3287. irInstall: ;
  3288. irServicePackTooLow:
  3289. AbortInitServicePackRequired(SetupHeader.MinVersion.NTServicePack);
  3290. else
  3291. AbortInit(msgWindowsVersionNotSupported);
  3292. end;
  3293. { Check if the user lacks the required privileges }
  3294. case SetupHeader.PrivilegesRequired of
  3295. prPowerUser:
  3296. if not IsPowerUserOrAdmin then AbortInit(msgPowerUserPrivilegesRequired);
  3297. prAdmin:
  3298. if not IsAdmin then AbortInit(msgAdminPrivilegesRequired);
  3299. end;
  3300. { Init main constants, not depending on shfolder.dll/_shfoldr.dll }
  3301. InitMainNonSHFolderConsts;
  3302. { Create temporary directory and extract 64-bit helper EXE if necessary }
  3303. CreateTempInstallDirAndExtract64BitHelper;
  3304. { Load system's "shfolder.dll", and load it }
  3305. LoadSHFolderDLL;
  3306. { Save DecompressorDLL stream as "_isdecmp.dll" in TempInstallDir, and load it }
  3307. if SetupHeader.CompressMethod in [cmZip, cmBzip] then
  3308. LoadDecompressorDLL;
  3309. { Save SevenZipDll stream as "_is7z.dll" in TempInstallDir, and load it }
  3310. if SetupHeader.SevenZipLibraryName <> '' then
  3311. LoadSevenZipDLL;
  3312. { Start RestartManager session }
  3313. if InitCloseApplications or
  3314. ((shCloseApplications in SetupHeader.Options) and not InitNoCloseApplications) then begin
  3315. InitRestartManagerLibrary;
  3316. { Note from Old New Thing: "The RmStartSession function doesn't properly
  3317. null-terminate the session key <...>. To work around this bug, we pre-fill
  3318. the buffer with null characters <...>." Our key is pre-filled too since
  3319. it's global. }
  3320. if UseRestartManager and (RmStartSession(@RmSessionHandle, 0, RmSessionKey) = ERROR_SUCCESS) then begin
  3321. RmSessionStarted := True;
  3322. SetStringsFromCommaString(CloseApplicationsFilterList, SetupHeader.CloseApplicationsFilter);
  3323. SetStringsFromCommaString(CloseApplicationsFilterExcludesList, SetupHeader.CloseApplicationsFilterExcludes);
  3324. end;
  3325. end;
  3326. { Set install mode }
  3327. SetupInstallMode;
  3328. { Init ISSigAvailableKeys }
  3329. SetLength(ISSigAvailableKeys, Entries[seISSigKey].Count);
  3330. for I := 0 to Entries[seISSigKey].Count-1 do begin
  3331. var ISSigKeyEntry := PSetupISSigKeyEntry(Entries[seISSigKey][I]);
  3332. ISSigAvailableKeys[I] := TECDSAKey.Create;
  3333. if ISSigImportPublicKey(ISSigAvailableKeys[I], '', ISSigKeyEntry.PublicX, ISSigKeyEntry.PublicY) <> ikrSuccess then
  3334. InternalError('ISSigImportPublicKey failed')
  3335. end;
  3336. { Load and initialize code }
  3337. if SetupHeader.CompiledCodeText <> '' then begin
  3338. CodeRunner := TScriptRunner.Create();
  3339. try
  3340. CodeRunner.NamingAttribute := CodeRunnerNamingAttribute;
  3341. CodeRunner.OnLog := CodeRunnerOnLog;
  3342. CodeRunner.OnLogFmt := CodeRunnerOnLogFmt;
  3343. CodeRunner.OnDllImport := CodeRunnerOnDllImport;
  3344. CodeRunner.OnDebug := CodeRunnerOnDebug;
  3345. CodeRunner.OnDebugIntermediate := CodeRunnerOnDebugIntermediate;
  3346. CodeRunner.OnException := CodeRunnerOnException;
  3347. CodeRunner.LoadScript(SetupHeader.CompiledCodeText, DebugClientCompiledCodeDebugInfo);
  3348. if not NeedPassword then
  3349. NeedPassword := CodeRunner.FunctionExists('CheckPassword', True);
  3350. NeedPassword := HandleInitPassword(NeedPassword);
  3351. if not NeedSerial then
  3352. NeedSerial := CodeRunner.FunctionExists('CheckSerial', True);
  3353. except
  3354. { Don't let DeinitSetup see a partially-initialized CodeRunner }
  3355. FreeAndNil(CodeRunner);
  3356. raise;
  3357. end;
  3358. try
  3359. Res := CodeRunner.RunBooleanFunctions('InitializeSetup', [''], bcFalse, False, True);
  3360. except
  3361. Log('InitializeSetup raised an exception (fatal).');
  3362. raise;
  3363. end;
  3364. if not Res then begin
  3365. Log('InitializeSetup returned False; aborting.');
  3366. Abort;
  3367. end;
  3368. end
  3369. else
  3370. NeedPassword := HandleInitPassword(NeedPassword);
  3371. { Expand AppName, AppVerName, and AppCopyright now since they're used often,
  3372. especially by the background window painting. }
  3373. ExpandedAppName := ExpandConst(SetupHeader.AppName);
  3374. if SetupHeader.AppVerName <> '' then
  3375. ExpandedAppVerName := ExpandConst(SetupHeader.AppVerName)
  3376. else begin
  3377. if not GetCustomMessageValue('NameAndVersion', NameAndVersionMsg) then
  3378. NameAndVersionMsg := '%1 %2'; { just in case }
  3379. ExpandedAppVerName := FmtMessage(PChar(NameAndVersionMsg),
  3380. [ExpandedAppName, ExpandConst(SetupHeader.AppVersion)]);
  3381. end;
  3382. ExpandedAppCopyright := ExpandConst(SetupHeader.AppCopyright);
  3383. ExpandedAppMutex := ExpandConst(SetupHeader.AppMutex);
  3384. ExpandedSetupMutex := ExpandConst(SetupHeader.SetupMutex);
  3385. { Update the shutdown block reason now that we have ExpandedAppName. }
  3386. ShutdownBlockReasonCreate(Application.Handle,
  3387. FmtSetupMessage1(msgShutdownBlockReasonInstallingApp, ExpandedAppName));
  3388. { Check if app is running }
  3389. while CheckForMutexes(ExpandedAppMutex) do
  3390. if LoggedMsgBox(FmtSetupMessage1(msgSetupAppRunningError, ExpandedAppName),
  3391. SetupMessages[msgSetupAppTitle], mbError, MB_OKCANCEL, True, IDCANCEL) <> IDOK then
  3392. Abort;
  3393. { Check if Setup is running and if not create mutexes }
  3394. while CheckForMutexes(ExpandedSetupMutex) do
  3395. if LoggedMsgBox(FmtSetupMessage1(msgSetupAppRunningError, SetupMessages[msgSetupAppTitle]),
  3396. SetupMessages[msgSetupAppTitle], mbError, MB_OKCANCEL, True, IDCANCEL) <> IDOK then
  3397. Abort;
  3398. CreateMutexes(ExpandedSetupMutex);
  3399. { Remove types that fail their 'languages' or 'check'. Can't do this earlier
  3400. because the InitializeSetup call above can't be done earlier. }
  3401. for I := 0 to Entries[seType].Count-1 do begin
  3402. if not ShouldProcessEntry(nil, nil, '', '', PSetupTypeEntry(Entries[seType][I]).Languages, PSetupTypeEntry(Entries[seType][I]).CheckOnce) then begin
  3403. SEFreeRec(Entries[seType][I], EntryStrings[seType], EntryAnsiStrings[seType]);
  3404. { Don't delete it yet so that the entries can be processed sequentially }
  3405. Entries[seType][I] := nil;
  3406. end;
  3407. end;
  3408. { Delete the nil-ed items now }
  3409. Entries[seType].Pack();
  3410. { Remove components }
  3411. NextAllowedLevel := 0;
  3412. LastShownComponentEntry := nil;
  3413. for I := 0 to Entries[seComponent].Count-1 do begin
  3414. ComponentEntry := PSetupComponentEntry(Entries[seComponent][I]);
  3415. if (ComponentEntry.Level <= NextAllowedLevel) and
  3416. (InstallOnThisVersion(ComponentEntry.MinVersion, ComponentEntry.OnlyBelowVersion) = irInstall) and
  3417. ShouldProcessEntry(nil, nil, '', '', ComponentEntry.Languages, ComponentEntry.CheckOnce) then begin
  3418. NextAllowedLevel := ComponentEntry.Level + 1;
  3419. LastShownComponentEntry := ComponentEntry;
  3420. end
  3421. else begin
  3422. { Not showing }
  3423. if Assigned(LastShownComponentEntry) and
  3424. (ComponentEntry.Level = LastShownComponentEntry.Level) and
  3425. (CompareText(ComponentEntry.Name, LastShownComponentEntry.Name) = 0) then begin
  3426. { It's a duplicate of the last shown item. Leave NextAllowedLevel
  3427. alone, so that any child items that follow can attach to the last
  3428. shown item. }
  3429. end
  3430. else begin
  3431. { Not a duplicate of the last shown item, so the next item must be
  3432. at the same level or less }
  3433. if NextAllowedLevel > ComponentEntry.Level then
  3434. NextAllowedLevel := ComponentEntry.Level;
  3435. { Clear LastShownComponentEntry so that no subsequent item can be
  3436. considered a duplicate of it. Needed in this case:
  3437. foo (shown)
  3438. foo\childA (not shown)
  3439. foo (not shown)
  3440. foo\childB
  3441. "foo\childB" should be hidden, not made a child of "foo" #1. }
  3442. LastShownComponentEntry := nil;
  3443. end;
  3444. Entries[seComponent][I] := nil;
  3445. SEFreeRec(ComponentEntry, EntryStrings[seComponent], EntryAnsiStrings[seComponent]);
  3446. end;
  3447. end;
  3448. Entries[seComponent].Pack();
  3449. { Set misc. variables }
  3450. HasCustomType := False;
  3451. for I := 0 to Entries[seType].Count-1 do begin
  3452. if toIsCustom in PSetupTypeEntry(Entries[seType][I]).Options then begin
  3453. HasCustomType := True;
  3454. Break;
  3455. end;
  3456. end;
  3457. HasComponents := Entries[seComponent].Count <> 0;
  3458. HasIcons := Entries[seIcon].Count <> 0;
  3459. HasTasks := Entries[seTask].Count <> 0;
  3460. { Calculate minimum disk space. If there are setup types, find the smallest
  3461. type and add the size of all files that don't belong to any component. Otherwise
  3462. calculate minimum disk space by adding all of the file's sizes. Also for each
  3463. "external" file, check the file size now, and store it the ExternalSize field
  3464. of the TSetupFileEntry record, except if an ExternalSize was specified by the
  3465. script. }
  3466. MinimumSpace := SetupHeader.ExtraDiskSpaceRequired;
  3467. const LExcludes = TStringList.Create;
  3468. try
  3469. LExcludes.StrictDelimiter := True;
  3470. LExcludes.Delimiter := ',';
  3471. for I := 0 to Entries[seFile].Count-1 do begin
  3472. with PSetupFileEntry(Entries[seFile][I])^ do begin
  3473. if LocationEntry <> -1 then begin { not an "external" file }
  3474. if Components = '' then { no types or a file that doesn't belong to any component }
  3475. if (Tasks = '') and (Check = '') then {don't count tasks and scripted entries}
  3476. Inc(MinimumSpace, PSetupFileLocationEntry(Entries[seFileLocation][LocationEntry])^.OriginalSize)
  3477. end else begin
  3478. if not(foExternalSizePreset in Options) then begin
  3479. if foDownload in Options then
  3480. InternalError('Unexpected download flag');
  3481. try
  3482. LExcludes.DelimitedText := Excludes;
  3483. if foExtractArchive in Options then begin
  3484. ExternalSize := RecurseExternalArchiveGetSizeOfFiles(
  3485. ShouldDisableFsRedirForFileEntry(PSetupFileEntry(Entries[seFile][I])),
  3486. ExpandConst(SourceFilename), ExpandConst(ExtractArchivePassword), LExcludes,
  3487. foRecurseSubDirsExternal in Options);
  3488. end else begin
  3489. if FileType <> ftUserFile then
  3490. SourceWildcard := NewParamStr(0)
  3491. else
  3492. SourceWildcard := ExpandConst(SourceFilename);
  3493. ExternalSize := RecurseExternalGetSizeOfFiles(
  3494. ShouldDisableFsRedirForFileEntry(PSetupFileEntry(Entries[seFile][I])),
  3495. PathExtractPath(SourceWildcard),
  3496. '', PathExtractName(SourceWildcard), IsWildcard(SourceWildcard),
  3497. LExcludes, foRecurseSubDirsExternal in Options);
  3498. end;
  3499. except
  3500. { Ignore exceptions. Two notable exceptions we want to ignore are
  3501. the one about "app" not being initialized and also archive errors
  3502. (ESevenZipError). Also see EnumFiles. }
  3503. end;
  3504. end;
  3505. if Components = '' then { no types or a file that doesn't belong to any component }
  3506. if (Tasks = '') and (Check = '') then {don't count tasks or scripted entries}
  3507. Inc(MinimumSpace, ExternalSize);
  3508. end;
  3509. end;
  3510. end;
  3511. finally
  3512. LExcludes.Free;
  3513. end;
  3514. for I := 0 to Entries[seComponent].Count-1 do
  3515. with PSetupComponentEntry(Entries[seComponent][I])^ do
  3516. Size := GetSizeOfComponent(Name, ExtraDiskSpaceRequired);
  3517. if Entries[seType].Count > 0 then begin
  3518. var MinimumTypeSpace: Int64 := 0;
  3519. for I := 0 to Entries[seType].Count-1 do begin
  3520. with PSetupTypeEntry(Entries[seType][I])^ do begin
  3521. Size := GetSizeOfType(Name, toIsCustom in Options);
  3522. if (I = 0) or (Size < MinimumTypeSpace) then
  3523. MinimumTypeSpace := Size;
  3524. end;
  3525. end;
  3526. Inc(MinimumSpace, MinimumTypeSpace);
  3527. end;
  3528. end;
  3529. procedure InitializeWizard;
  3530. begin
  3531. WizardForm := AppCreateForm(TWizardForm) as TWizardForm;
  3532. if CodeRunner <> nil then begin
  3533. try
  3534. CodeRunner.RunProcedures('InitializeWizard', [''], False);
  3535. except
  3536. Log('InitializeWizard raised an exception (fatal).');
  3537. raise;
  3538. end;
  3539. end;
  3540. WizardForm.FlipAndCenterIfNeeded(False, nil, False);
  3541. WizardForm.SetCurPage(wpWelcome);
  3542. if InstallMode = imNormal then begin
  3543. WizardForm.ClickToStartPage; { this won't go past wpReady }
  3544. WizardForm.Visible := True;
  3545. end
  3546. else
  3547. WizardForm.ClickThroughPages;
  3548. end;
  3549. procedure DeinitSetup(const AllowCustomSetupExitCode: Boolean);
  3550. var
  3551. I: Integer;
  3552. begin
  3553. Log('Deinitializing Setup.');
  3554. if Assigned(CodeRunner) then begin
  3555. if AllowCustomSetupExitCode then begin
  3556. try
  3557. SetupExitCode := CodeRunner.RunIntegerFunctions('GetCustomSetupExitCode',
  3558. [''], bcNonZero, False, SetupExitCode);
  3559. except
  3560. Log('GetCustomSetupExitCode raised an exception.');
  3561. Application.HandleException(nil);
  3562. end;
  3563. end;
  3564. try
  3565. CodeRunner.RunProcedures('DeinitializeSetup', [''], False);
  3566. except
  3567. Log('DeinitializeSetup raised an exception.');
  3568. Application.HandleException(nil);
  3569. end;
  3570. FreeAndNil(CodeRunner);
  3571. end;
  3572. for I := 0 to DeleteFilesAfterInstallList.Count-1 do
  3573. DeleteFileRedir(DeleteFilesAfterInstallList.Objects[I] <> nil,
  3574. DeleteFilesAfterInstallList[I]);
  3575. DeleteFilesAfterInstallList.Clear;
  3576. for I := DeleteDirsAfterInstallList.Count-1 downto 0 do
  3577. RemoveDirectoryRedir(DeleteDirsAfterInstallList.Objects[I] <> nil,
  3578. DeleteDirsAfterInstallList[I]);
  3579. DeleteDirsAfterInstallList.Clear;
  3580. for I := 0 to Length(ISSigAvailableKeys)-1 do
  3581. ISSigAvailableKeys[I].Free;
  3582. FreeFileExtractor;
  3583. { End RestartManager session }
  3584. if RmSessionStarted then
  3585. RmEndSession(RmSessionHandle);
  3586. { Free the _isdecmp.dll and _is7z.dll handles }
  3587. if DecompressorDLLHandle <> 0 then
  3588. FreeLibrary(DecompressorDLLHandle);
  3589. if SevenZipDLLHandle <> 0 then begin
  3590. SevenZipDLLDeInit;
  3591. FreeLibrary(SevenZipDLLHandle);
  3592. end;
  3593. { Free the shfolder.dll handle }
  3594. UnloadSHFolderDLL;
  3595. { Remove TempInstallDir, stopping the 64-bit helper first if necessary }
  3596. RemoveTempInstallDir;
  3597. { An attempt to restart while debugging is most likely an accident;
  3598. don't allow it }
  3599. if RestartSystem and Debugging then begin
  3600. Log('Not restarting Windows because Setup is being run from the debugger.');
  3601. RestartSystem := False;
  3602. end;
  3603. EndDebug;
  3604. ShutdownBlockReasonDestroy(Application.Handle);
  3605. if RestartSystem then begin
  3606. Log('Restarting Windows.');
  3607. if SetupNotifyWndPresent then begin
  3608. { Send a special message back to the first instance telling it to
  3609. restart the system after Setup returns }
  3610. SendNotifyMessage(SetupNotifyWnd, WM_USER + 150, 10000, 0);
  3611. end
  3612. else begin
  3613. { There is no other instance, so initiate the restart ourself.
  3614. Note: Depending on the OS, this may not return if successful. }
  3615. RestartComputerFromThisProcess;
  3616. end;
  3617. end;
  3618. end;
  3619. function ExitSetupMsgBox: Boolean;
  3620. begin
  3621. Result := LoggedMsgBox(SetupMessages[msgExitSetupMessage], SetupMessages[msgExitSetupTitle],
  3622. mbConfirmation, MB_YESNO or MB_DEFBUTTON2, False, 0) = IDYES;
  3623. end;
  3624. procedure ProcessMessagesProc; far;
  3625. begin
  3626. Application.ProcessMessages;
  3627. end;
  3628. procedure RunExecLog(const S: String; const Error, FirstLine: Boolean; const Data: NativeInt);
  3629. begin
  3630. if not Error and FirstLine then
  3631. Log('Output:');
  3632. Log(S);
  3633. end;
  3634. function ShouldDisableFsRedirForRunEntry(const RunEntry: PSetupRunEntry): Boolean;
  3635. begin
  3636. Result := InstallDefaultDisableFsRedir;
  3637. if roRun32Bit in RunEntry.Options then
  3638. Result := False;
  3639. if roRun64Bit in RunEntry.Options then begin
  3640. if not IsWin64 then
  3641. InternalError('Cannot run files in 64-bit locations on this version of Windows');
  3642. Result := True;
  3643. end;
  3644. end;
  3645. procedure ProcessRunEntry(const RunEntry: PSetupRunEntry);
  3646. var
  3647. RunAsOriginalUser: Boolean;
  3648. ExpandedFilename, ExpandedParameters: String;
  3649. Wait: TExecWait;
  3650. DisableFsRedir: Boolean;
  3651. ErrorCode: Integer;
  3652. begin
  3653. try
  3654. Log('-- Run entry --');
  3655. RunAsOriginalUser := (roRunAsOriginalUser in RunEntry.Options);
  3656. if RunAsOriginalUser then
  3657. Log('Run as: Original user')
  3658. else
  3659. Log('Run as: Current user');
  3660. if not(roShellExec in RunEntry.Options) then
  3661. Log('Type: Exec')
  3662. else
  3663. Log('Type: ShellExec');
  3664. ExpandedFilename := ExpandConst(RunEntry.Name);
  3665. Log('Filename: ' + ExpandedFilename);
  3666. ExpandedParameters := ExpandConst(RunEntry.Parameters);
  3667. if not(roDontLogParameters in RunEntry.Options) and (ExpandedParameters <> '') then
  3668. Log('Parameters: ' + ExpandedParameters);
  3669. Wait := ewWaitUntilTerminated;
  3670. case RunEntry.Wait of
  3671. rwNoWait: Wait := ewNoWait;
  3672. rwWaitUntilIdle: Wait := ewWaitUntilIdle;
  3673. end;
  3674. if not(roShellExec in RunEntry.Options) then begin
  3675. DisableFsRedir := ShouldDisableFsRedirForRunEntry(RunEntry);
  3676. if not(roSkipIfDoesntExist in RunEntry.Options) or
  3677. NewFileExistsRedir(DisableFsRedir, ExpandedFilename) then begin
  3678. var OutputReader: TCreateProcessOutputReader := nil;
  3679. try
  3680. if GetLogActive and (roLogOutput in RunEntry.Options) then
  3681. OutputReader := TCreateProcessOutputReader.Create(RunExecLog, 0);
  3682. if not InstExecEx(RunAsOriginalUser, DisableFsRedir, ExpandedFilename,
  3683. ExpandedParameters, ExpandConst(RunEntry.WorkingDir),
  3684. Wait, RunEntry.ShowCmd, ProcessMessagesProc, OutputReader, ErrorCode) then
  3685. raise Exception.Create(FmtSetupMessage1(msgErrorExecutingProgram, ExpandedFilename) +
  3686. SNewLine2 + FmtSetupMessage(msgErrorFunctionFailedWithMessage,
  3687. ['CreateProcess', IntToStr(ErrorCode), Win32ErrorString(ErrorCode)]));
  3688. if Wait = ewWaitUntilTerminated then
  3689. Log(Format('Process exit code: %u', [ErrorCode]));
  3690. finally
  3691. OutputReader.Free;
  3692. end;
  3693. end
  3694. else
  3695. Log('File doesn''t exist. Skipping.');
  3696. end
  3697. else begin
  3698. if not(roSkipIfDoesntExist in RunEntry.Options) or FileOrDirExists(ExpandedFilename) then begin
  3699. if not InstShellExecEx(RunAsOriginalUser, ExpandConst(RunEntry.Verb),
  3700. ExpandedFilename, ExpandedParameters, ExpandConst(RunEntry.WorkingDir),
  3701. Wait, RunEntry.ShowCmd, ProcessMessagesProc, ErrorCode) then
  3702. raise Exception.Create(FmtSetupMessage1(msgErrorExecutingProgram, ExpandedFilename) +
  3703. SNewLine2 + FmtSetupMessage(msgErrorFunctionFailedWithMessage,
  3704. ['ShellExecuteEx', IntToStr(ErrorCode), Win32ErrorString(ErrorCode)]));
  3705. end
  3706. else
  3707. Log('File/directory doesn''t exist. Skipping.');
  3708. end;
  3709. except
  3710. Application.HandleException(nil);
  3711. end;
  3712. end;
  3713. procedure ShellExecuteAsOriginalUser(hWnd: HWND; Operation, FileName, Parameters, Directory: LPWSTR; ShowCmd: Integer); stdcall;
  3714. var
  3715. ErrorCode: Integer;
  3716. begin
  3717. InstShellExecEx(True, Operation, Filename, Parameters, Directory, ewNoWait, ShowCmd, ProcessMessagesProc, ErrorCode);
  3718. end;
  3719. procedure InitIsWin64AndProcessorArchitectureAndMachineTypesSupportedBySystem;
  3720. const
  3721. PROCESSOR_ARCHITECTURE_ARM64 = 12;
  3722. IMAGE_FILE_MACHINE_ARM64 = $AA64;
  3723. IMAGE_FILE_MACHINE_ARMNT = $01C4;
  3724. UserEnabled = $1;
  3725. var
  3726. KernelModule: HMODULE;
  3727. IsWow64ProcessFunc: function(hProcess: THandle; var Wow64Process: BOOL): BOOL; stdcall;
  3728. IsWow64Process2Func: function(hProcess: THandle; var pProcessMachine, pNativeMachine: USHORT): BOOL; stdcall;
  3729. GetMachineTypeAttributesFunc: function(Machine: USHORT; var MachineTypeAttributes: Integer): HRESULT; stdcall;
  3730. IsWow64GuestMachineSupportedFunc: function(WowGuestMachine: USHORT; var MachineIsSupported: BOOL): HRESULT; stdcall;
  3731. ProcessMachine, NativeMachine: USHORT;
  3732. Wow64Process: BOOL;
  3733. SysInfo: TSystemInfo;
  3734. begin
  3735. KernelModule := GetModuleHandle(kernel32);
  3736. { The system is considered a "Win64" system if all of the following
  3737. conditions are true:
  3738. 1. One of the following two is true:
  3739. a. IsWow64Process2 is available, and returns True for the current process.
  3740. b. IsWow64Process is available, and returns True for the current process.
  3741. 2. Wow64DisableWow64FsRedirection is available.
  3742. 3. Wow64RevertWow64FsRedirection is available.
  3743. 4. GetSystemWow64DirectoryA is available.
  3744. 5. RegDeleteKeyExA is available.
  3745. The system does not have to be one of the known 64-bit architectures
  3746. to be considered a "Win64" system. }
  3747. IsWin64 := False;
  3748. IsWow64Process2Func := GetProcAddress(KernelModule, 'IsWow64Process2');
  3749. if Assigned(IsWow64Process2Func) and
  3750. IsWow64Process2Func(GetCurrentProcess, ProcessMachine, NativeMachine) and
  3751. (ProcessMachine <> IMAGE_FILE_MACHINE_UNKNOWN) then begin
  3752. IsWin64 := True;
  3753. case NativeMachine of
  3754. IMAGE_FILE_MACHINE_I386: ProcessorArchitecture := paX86;
  3755. IMAGE_FILE_MACHINE_AMD64: ProcessorArchitecture := paX64;
  3756. IMAGE_FILE_MACHINE_ARM64: ProcessorArchitecture := paArm64;
  3757. else
  3758. ProcessorArchitecture := paUnknown;
  3759. end;
  3760. end else begin
  3761. IsWow64ProcessFunc := GetProcAddress(KernelModule, 'IsWow64Process');
  3762. if Assigned(IsWow64ProcessFunc) and
  3763. IsWow64ProcessFunc(GetCurrentProcess, Wow64Process) and
  3764. Wow64Process then
  3765. IsWin64 := True;
  3766. GetNativeSystemInfo(SysInfo);
  3767. case SysInfo.wProcessorArchitecture of
  3768. PROCESSOR_ARCHITECTURE_INTEL: ProcessorArchitecture := paX86;
  3769. PROCESSOR_ARCHITECTURE_AMD64: ProcessorArchitecture := paX64;
  3770. PROCESSOR_ARCHITECTURE_ARM64: ProcessorArchitecture := paArm64;
  3771. else
  3772. ProcessorArchitecture := paUnknown;
  3773. end;
  3774. end;
  3775. if IsWin64 and
  3776. not (AreFsRedirectionFunctionsAvailable and
  3777. (GetProcAddress(KernelModule, 'GetSystemWow64DirectoryA') <> nil) and
  3778. (GetProcAddress(GetModuleHandle(advapi32), 'RegDeleteKeyExA') <> nil)) then
  3779. IsWin64 := False;
  3780. { Setup MachineTypesSupportedBySystem. The result should end up being:
  3781. - 32-bit x86: [paX86]
  3782. - x64: [paX86, paX64]
  3783. (but not paX86 in a future x64 build of Inno Setup if Windows was installed
  3784. without support for x86 binaries (which is possible with Windows Server))
  3785. - Arm64 Windows 10: [paX86, paArm64, paArm32]
  3786. (Arm32 support detected, not just assumed)
  3787. - Arm64 Windows 11: [paX86, paX64, paArm64, paArm32]
  3788. (X64 and Arm32 support detected, not just assumed) }
  3789. {$IFDEF CPUX86}
  3790. MachineTypesSupportedBySystem := [paX86];
  3791. {$ELSE}
  3792. {$MESSAGE ERROR 'This needs updating for non-x86 builds'}
  3793. {$ENDIF}
  3794. if ProcessorArchitecture <> paUnknown then
  3795. Include(MachineTypesSupportedBySystem, ProcessorArchitecture);
  3796. { On Windows 11 we can use GetMachineTypeAttributes to check what is supported extra }
  3797. GetMachineTypeAttributesFunc := GetProcAddress(KernelModule, 'GetMachineTypeAttributes');
  3798. if Assigned(GetMachineTypeAttributesFunc) then begin
  3799. var MachineTypeAttributes: Integer;
  3800. if (GetMachineTypeAttributesFunc(IMAGE_FILE_MACHINE_ARMNT, MachineTypeAttributes) = S_OK) and
  3801. ((MachineTypeAttributes and UserEnabled) <> 0) then
  3802. Include(MachineTypesSupportedBySystem, paArm32);
  3803. if not (paX64 in MachineTypesSupportedBySystem) and
  3804. (GetMachineTypeAttributesFunc(IMAGE_FILE_MACHINE_AMD64, MachineTypeAttributes) = S_OK) and
  3805. ((MachineTypeAttributes and UserEnabled) <> 0) then
  3806. Include(MachineTypesSupportedBySystem, paX64);
  3807. end else begin
  3808. { Without GetMachineTypeAttributes we can only check if Arm32 is supported extra
  3809. using IsWow64GuestMachineSupported }
  3810. IsWow64GuestMachineSupportedFunc := GetProcAddress(KernelModule, 'IsWow64GuestMachineSupported');
  3811. if Assigned(IsWow64GuestMachineSupportedFunc) then begin
  3812. var MachineIsSupported: BOOL;
  3813. if (IsWow64GuestMachineSupportedFunc(IMAGE_FILE_MACHINE_ARMNT, MachineIsSupported) = S_OK) and
  3814. MachineIsSupported then
  3815. Include(MachineTypesSupportedBySystem, paArm32);
  3816. end;
  3817. end;
  3818. end;
  3819. procedure InitWindowsVersion;
  3820. var
  3821. OSVersionInfo: TOSVersionInfo;
  3822. OSVersionInfoEx: TOSVersionInfoEx;
  3823. begin
  3824. OSVersionInfo.dwOSVersionInfoSize := SizeOf(OSVersionInfo);
  3825. if GetVersionEx(OSVersionInfo) then begin
  3826. WindowsVersion := (Byte(OSVersionInfo.dwMajorVersion) shl 24) or
  3827. (Byte(OSVersionInfo.dwMinorVersion) shl 16) or
  3828. Word(OSVersionInfo.dwBuildNumber);
  3829. { ^ Note: We MUST clip dwBuildNumber to 16 bits for Win9x compatibility }
  3830. OSVersionInfoEx.dwOSVersionInfoSize := SizeOf(OSVersionInfoEx);
  3831. if GetVersionEx(POSVersionInfo(@OSVersionInfoEx)^) then begin
  3832. NTServicePackLevel := (Byte(OSVersionInfoEx.wServicePackMajor) shl 8) or
  3833. Byte(OSVersionInfoEx.wServicePackMinor);
  3834. WindowsProductType := OSVersionInfoEx.wProductType;
  3835. WindowsSuiteMask := OSVersionInfoEx.wSuiteMask;
  3836. end;
  3837. end;
  3838. end;
  3839. procedure CreateEntryLists;
  3840. var
  3841. I: TEntryType;
  3842. begin
  3843. for I := Low(I) to High(I) do
  3844. Entries[I] := TList.Create;
  3845. end;
  3846. procedure FreeEntryLists;
  3847. var
  3848. I: TEntryType;
  3849. List: TList;
  3850. J: Integer;
  3851. P: Pointer;
  3852. begin
  3853. for I := High(I) downto Low(I) do begin
  3854. List := Entries[I];
  3855. if Assigned(List) then begin
  3856. Entries[I] := nil;
  3857. for J := List.Count-1 downto 0 do begin
  3858. P := List[J];
  3859. if EntryStrings[I] <> 0 then
  3860. SEFreeRec(P, EntryStrings[I], EntryAnsiStrings[I])
  3861. else
  3862. FreeMem(P);
  3863. end;
  3864. List.Free;
  3865. end;
  3866. FreeAndNil(OriginalEntryIndexes[I]);
  3867. end;
  3868. end;
  3869. procedure FreeWizardImages;
  3870. begin
  3871. FreeAndNil(WizardImages);
  3872. FreeAndNil(WizardSmallImages);
  3873. end;
  3874. initialization
  3875. InitIsWin64AndProcessorArchitectureAndMachineTypesSupportedBySystem;
  3876. InitWindowsVersion;
  3877. InitComponents := TStringList.Create();
  3878. InitTasks := TStringList.Create();
  3879. NewParamsForCode := TStringList.Create();
  3880. WizardComponents := TStringList.Create();
  3881. WizardDeselectedComponents := TStringList.Create();
  3882. WizardTasks := TStringList.Create();
  3883. WizardDeselectedTasks := TStringList.Create();
  3884. CreateEntryLists;
  3885. DeleteFilesAfterInstallList := TStringList.Create;
  3886. DeleteDirsAfterInstallList := TStringList.Create;
  3887. CloseApplicationsFilterList := TStringList.Create;
  3888. CloseApplicationsFilterExcludesList := TStringList.Create;
  3889. WizardImages := TWizardImages.Create;
  3890. WizardSmallImages := TWizardImages.Create;
  3891. SHGetKnownFolderPathFunc := GetProcAddress(SafeLoadLibrary(AddBackslash(GetSystemDir) + shell32,
  3892. SEM_NOOPENFILEERRORBOX), 'SHGetKnownFolderPath');
  3893. finalization
  3894. FreeWizardImages;
  3895. FreeAndNil(CloseApplicationsFilterExcludesList);
  3896. FreeAndNil(CloseApplicationsFilterList);
  3897. FreeAndNil(DeleteDirsAfterInstallList);
  3898. FreeAndNil(DeleteFilesAfterInstallList);
  3899. FreeEntryLists;
  3900. FreeAndNil(WizardDeselectedTasks);
  3901. FreeAndNil(WizardTasks);
  3902. FreeAndNil(WizardDeselectedComponents);
  3903. FreeAndNil(WizardComponents);
  3904. FreeAndNil(NewParamsForCode);
  3905. FreeAndNil(InitTasks);
  3906. FreeAndNil(InitComponents);
  3907. end.