Setup.MainFunc.pas 174 KB

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