Setup.MainFunc.pas 154 KB

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