Setup.MainFunc.pas 154 KB

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