123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107110811091110111111121113111411151116111711181119112011211122112311241125112611271128112911301131113211331134113511361137113811391140114111421143114411451146114711481149115011511152115311541155115611571158115911601161116211631164116511661167116811691170117111721173117411751176117711781179118011811182118311841185118611871188118911901191119211931194119511961197119811991200120112021203120412051206120712081209121012111212121312141215121612171218121912201221122212231224122512261227122812291230123112321233123412351236123712381239124012411242124312441245124612471248124912501251125212531254125512561257125812591260126112621263126412651266126712681269127012711272127312741275127612771278127912801281128212831284128512861287128812891290129112921293129412951296129712981299130013011302130313041305130613071308130913101311131213131314131513161317131813191320132113221323132413251326132713281329133013311332133313341335133613371338133913401341134213431344134513461347134813491350135113521353135413551356135713581359136013611362136313641365136613671368136913701371137213731374137513761377137813791380138113821383138413851386138713881389139013911392139313941395139613971398139914001401140214031404140514061407140814091410141114121413141414151416141714181419142014211422142314241425142614271428142914301431143214331434143514361437143814391440144114421443144414451446144714481449145014511452145314541455145614571458145914601461146214631464146514661467146814691470147114721473147414751476147714781479148014811482148314841485148614871488148914901491149214931494149514961497149814991500150115021503150415051506150715081509151015111512151315141515151615171518151915201521152215231524152515261527152815291530153115321533153415351536153715381539154015411542154315441545154615471548154915501551155215531554155515561557155815591560156115621563156415651566156715681569157015711572157315741575157615771578157915801581158215831584158515861587158815891590159115921593159415951596159715981599160016011602160316041605160616071608160916101611161216131614161516161617161816191620162116221623162416251626162716281629163016311632163316341635163616371638163916401641164216431644164516461647164816491650165116521653165416551656165716581659166016611662166316641665166616671668166916701671167216731674167516761677167816791680168116821683168416851686168716881689169016911692169316941695169616971698169917001701170217031704170517061707170817091710171117121713171417151716171717181719172017211722172317241725172617271728172917301731173217331734173517361737173817391740174117421743174417451746174717481749175017511752175317541755175617571758175917601761176217631764176517661767176817691770177117721773177417751776177717781779178017811782178317841785178617871788178917901791179217931794179517961797179817991800180118021803180418051806180718081809181018111812181318141815181618171818181918201821182218231824182518261827182818291830183118321833183418351836183718381839184018411842184318441845184618471848184918501851185218531854185518561857185818591860186118621863186418651866186718681869187018711872187318741875187618771878187918801881188218831884188518861887188818891890189118921893189418951896189718981899190019011902190319041905190619071908190919101911191219131914191519161917191819191920192119221923192419251926192719281929193019311932193319341935193619371938193919401941194219431944194519461947194819491950195119521953195419551956195719581959196019611962196319641965196619671968196919701971197219731974197519761977197819791980198119821983198419851986198719881989199019911992199319941995199619971998199920002001200220032004200520062007200820092010201120122013201420152016201720182019202020212022202320242025202620272028202920302031203220332034203520362037203820392040204120422043204420452046204720482049205020512052205320542055205620572058205920602061206220632064206520662067206820692070207120722073207420752076207720782079208020812082208320842085208620872088208920902091209220932094209520962097209820992100210121022103210421052106210721082109211021112112211321142115211621172118211921202121212221232124212521262127212821292130213121322133213421352136213721382139214021412142214321442145214621472148214921502151215221532154215521562157215821592160216121622163216421652166216721682169217021712172217321742175217621772178217921802181218221832184218521862187218821892190219121922193219421952196219721982199220022012202220322042205220622072208220922102211221222132214221522162217221822192220222122222223222422252226222722282229223022312232223322342235223622372238223922402241224222432244224522462247224822492250225122522253225422552256225722582259226022612262226322642265226622672268226922702271227222732274227522762277227822792280228122822283228422852286228722882289229022912292229322942295229622972298229923002301230223032304230523062307230823092310231123122313231423152316231723182319232023212322232323242325232623272328232923302331233223332334233523362337233823392340234123422343234423452346234723482349235023512352235323542355235623572358235923602361236223632364236523662367236823692370237123722373237423752376237723782379238023812382238323842385238623872388238923902391239223932394239523962397239823992400240124022403240424052406240724082409241024112412241324142415241624172418241924202421242224232424242524262427242824292430243124322433243424352436243724382439244024412442244324442445244624472448244924502451245224532454245524562457245824592460246124622463246424652466246724682469247024712472247324742475247624772478247924802481248224832484248524862487248824892490249124922493249424952496249724982499250025012502250325042505250625072508250925102511251225132514251525162517251825192520252125222523252425252526252725282529253025312532253325342535253625372538253925402541254225432544254525462547254825492550255125522553255425552556255725582559256025612562256325642565256625672568256925702571257225732574257525762577257825792580258125822583258425852586258725882589259025912592259325942595259625972598259926002601260226032604260526062607260826092610261126122613261426152616261726182619262026212622262326242625262626272628262926302631263226332634263526362637263826392640264126422643264426452646264726482649265026512652265326542655265626572658265926602661266226632664266526662667266826692670267126722673267426752676267726782679268026812682268326842685268626872688268926902691269226932694269526962697269826992700270127022703270427052706270727082709271027112712271327142715271627172718271927202721272227232724272527262727272827292730273127322733273427352736273727382739274027412742274327442745274627472748274927502751275227532754275527562757275827592760276127622763276427652766276727682769277027712772277327742775277627772778277927802781278227832784278527862787278827892790279127922793279427952796279727982799280028012802280328042805280628072808280928102811281228132814281528162817281828192820282128222823282428252826282728282829283028312832283328342835283628372838283928402841284228432844284528462847284828492850285128522853285428552856285728582859286028612862286328642865286628672868286928702871287228732874287528762877287828792880288128822883288428852886288728882889289028912892289328942895289628972898289929002901290229032904290529062907290829092910291129122913291429152916291729182919292029212922292329242925292629272928292929302931293229332934293529362937293829392940294129422943294429452946294729482949295029512952295329542955295629572958295929602961296229632964296529662967296829692970297129722973297429752976297729782979298029812982298329842985298629872988298929902991299229932994299529962997299829993000300130023003300430053006300730083009301030113012301330143015301630173018301930203021302230233024302530263027302830293030303130323033303430353036303730383039304030413042304330443045304630473048304930503051305230533054305530563057305830593060306130623063306430653066306730683069307030713072307330743075307630773078307930803081308230833084308530863087308830893090309130923093309430953096309730983099310031013102310331043105310631073108310931103111311231133114311531163117311831193120312131223123312431253126312731283129313031313132313331343135313631373138313931403141314231433144314531463147314831493150315131523153315431553156315731583159316031613162316331643165316631673168316931703171317231733174317531763177317831793180318131823183318431853186318731883189319031913192319331943195319631973198319932003201320232033204320532063207320832093210321132123213321432153216321732183219322032213222322332243225322632273228322932303231323232333234323532363237323832393240324132423243324432453246324732483249325032513252325332543255325632573258325932603261326232633264326532663267326832693270327132723273327432753276327732783279328032813282328332843285328632873288328932903291329232933294329532963297329832993300330133023303330433053306330733083309331033113312331333143315331633173318331933203321332233233324332533263327332833293330333133323333333433353336333733383339334033413342334333443345334633473348334933503351335233533354335533563357335833593360336133623363336433653366336733683369337033713372337333743375337633773378337933803381338233833384338533863387338833893390339133923393339433953396339733983399340034013402340334043405340634073408340934103411341234133414341534163417341834193420342134223423342434253426342734283429343034313432343334343435343634373438343934403441344234433444344534463447344834493450345134523453345434553456345734583459346034613462346334643465346634673468346934703471347234733474347534763477347834793480348134823483348434853486348734883489349034913492349334943495349634973498349935003501350235033504350535063507350835093510351135123513351435153516351735183519352035213522352335243525352635273528352935303531353235333534353535363537353835393540354135423543354435453546354735483549355035513552355335543555355635573558355935603561356235633564356535663567356835693570357135723573357435753576357735783579358035813582358335843585358635873588358935903591359235933594359535963597359835993600360136023603360436053606360736083609361036113612361336143615361636173618361936203621362236233624362536263627362836293630363136323633363436353636363736383639364036413642364336443645364636473648364936503651365236533654365536563657365836593660366136623663366436653666366736683669367036713672367336743675367636773678367936803681368236833684368536863687368836893690369136923693369436953696369736983699370037013702370337043705370637073708370937103711371237133714371537163717371837193720372137223723372437253726372737283729373037313732373337343735373637373738373937403741374237433744374537463747374837493750375137523753375437553756375737583759376037613762376337643765376637673768376937703771377237733774377537763777377837793780378137823783378437853786378737883789379037913792379337943795379637973798379938003801380238033804380538063807380838093810381138123813381438153816381738183819382038213822382338243825382638273828382938303831383238333834383538363837383838393840384138423843384438453846384738483849385038513852385338543855385638573858385938603861386238633864386538663867386838693870387138723873387438753876387738783879388038813882388338843885388638873888388938903891389238933894389538963897389838993900390139023903390439053906390739083909391039113912391339143915391639173918391939203921392239233924392539263927392839293930393139323933393439353936393739383939394039413942394339443945394639473948394939503951395239533954395539563957395839593960396139623963396439653966396739683969397039713972397339743975397639773978397939803981398239833984398539863987398839893990399139923993399439953996399739983999400040014002400340044005400640074008400940104011401240134014401540164017401840194020 |
- unit Setup.MainFunc;
- {
- Inno Setup
- Copyright (C) 1997-2025 Jordan Russell
- Portions by Martijn Laan
- For conditions of distribution and use, see LICENSE.TXT.
- Setup main functions and global variables
- }
- interface
- uses
- Windows, SysUtils, Messages, Classes, Graphics, Controls, Forms, Dialogs,
- StdCtrls, Shared.Struct, Shared.DebugStruct, Shared.Int64Em, Shared.CommonFunc.Vcl, Shared.CommonFunc,
- Shared.SetupTypes, Setup.ScriptRunner, RestartManager;
- type
- TEntryType = (seLanguage, seCustomMessage, sePermission, seType, seComponent,
- seTask, seDir, seISSigKey, seFile, seFileLocation, seIcon, seIni, seRegistry,
- seInstallDelete, seUninstallDelete, seRun, seUninstallRun);
- TShellFolderID = (sfDesktop, sfStartMenu, sfPrograms, sfStartup, sfSendTo, //these have common and user versions
- sfFonts, sfAppData, sfDocs, sfTemplates, //
- sfFavorites, sfLocalAppData, sfUserProgramFiles, sfUserCommonFiles, sfUserSavedGames); //these only have user versions
- const
- EntryStrings: array[TEntryType] of Integer = (SetupLanguageEntryStrings,
- SetupCustomMessageEntryStrings, SetupPermissionEntryStrings,
- SetupTypeEntryStrings, SetupComponentEntryStrings, SetupTaskEntryStrings,
- SetupDirEntryStrings, SetupISSigKeyEntryStrings, SetupFileEntryStrings,
- SetupFileLocationEntryStrings, SetupIconEntryStrings, SetupIniEntryStrings,
- SetupRegistryEntryStrings, SetupDeleteEntryStrings, SetupDeleteEntryStrings,
- SetupRunEntryStrings, SetupRunEntryStrings);
- EntryAnsiStrings: array[TEntryType] of Integer = (SetupLanguageEntryAnsiStrings,
- SetupCustomMessageEntryAnsiStrings, SetupPermissionEntryAnsiStrings,
- SetupTypeEntryAnsiStrings, SetupComponentEntryAnsiStrings, SetupTaskEntryAnsiStrings,
- SetupDirEntryAnsiStrings, SetupISSigKeyEntryAnsiStrings, SetupFileEntryAnsiStrings,
- SetupFileLocationEntryAnsiStrings, SetupIconEntryAnsiStrings, SetupIniEntryAnsiStrings,
- SetupRegistryEntryAnsiStrings, SetupDeleteEntryAnsiStrings, SetupDeleteEntryAnsiStrings,
- SetupRunEntryAnsiStrings, SetupRunEntryAnsiStrings);
- { Exit codes that are assigned to the SetupExitCode variable.
- Note: SetupLdr also returns exit codes with the same numbers. }
- ecInitializationError = 1; { Setup failed to initialize. }
- ecCancelledBeforeInstall = 2; { User clicked Cancel before the actual
- installation started. }
- ecNextStepError = 3; { A fatal exception occurred while moving to
- the next step. }
- ecInstallationError = 4; { A fatal exception occurred during
- installation. }
- ecInstallationCancelled = 5; { User clicked Cancel during installation,
- or clicked Abort at an Abort-Retry-Ignore
- dialog. }
- ecKilledByDebugger = 6; { User killed the Setup process from within
- the debugger. }
- ecPrepareToInstallFailed = 7; { Stopped on Preparing to Install page;
- restart not needed. }
- ecPrepareToInstallFailedRestartNeeded = 8;
- { Stopped on Preparing to Install page;
- restart needed. }
-
- CodeRunnerNamingAttribute = 'Event';
- var
- { Variables for command line parameters }
- SetupLdrMode: Boolean;
- SetupLdrOriginalFilename: String;
- SetupLdrOffset0, SetupLdrOffset1: Int64;
- SetupNotifyWndPresent: Boolean;
- SetupNotifyWnd: HWND;
- InitLang: String;
- InitDir, InitProgramGroup: String;
- InitLoadInf, InitSaveInf: String;
- InitNoIcons, InitSilent, InitVerySilent, InitNoRestart, InitCloseApplications,
- InitNoCloseApplications, InitForceCloseApplications, InitNoForceCloseApplications,
- InitLogCloseApplications, InitRestartApplications, InitNoRestartApplications,
- InitNoCancel: Boolean;
- InitSetupType: String;
- InitComponents, InitTasks: TStringList;
- InitComponentsSpecified: Boolean;
- InitDeselectAllTasks: Boolean;
- InitPassword: String;
- InitRestartExitCode: Integer;
- InitPrivilegesRequired: TSetupPrivilegesRequired;
- HasInitPrivilegesRequired: Boolean;
- InitSuppressMsgBoxes: Boolean;
- DetachedUninstMsgFile: Boolean;
- NewParamsForCode: TStringList;
- { Debugger }
- OriginalEntryIndexes: array[TEntryType] of TList;
- { 'Constants' }
- SourceDir, TempInstallDir, WinDir, WinSystemDir, WinSysWow64Dir, WinSysNativeDir, SystemDrive,
- ProgramFiles32Dir, CommonFiles32Dir, ProgramFiles64Dir, CommonFiles64Dir,
- CmdFilename, SysUserInfoName,
- SysUserInfoOrg, UninstallExeFilename: String;
- { Uninstall 'constants' }
- UninstallExpandedAppId, UninstallExpandedApp, UninstallExpandedGroup,
- UninstallExpandedGroupName, UninstallExpandedLanguage: String;
- UninstallSilent: Boolean;
- { Variables read in from the SETUP.0 file }
- SetupEncryptionHeader: TSetupEncryptionHeader;
- SetupHeader: TSetupHeader;
- LangOptions: TSetupLanguageEntry;
- Entries: array[TEntryType] of TList;
- WizardImages: TList;
- WizardSmallImages: TList;
- CloseApplicationsFilterList, CloseApplicationsFilterExcludesList: TStringList;
- ISSigAvailableKeys: TArrayOfECDSAKey;
- { User options }
- ActiveLanguage: Integer = -1;
- ActiveLicenseText, ActiveInfoBeforeText, ActiveInfoAfterText: AnsiString;
- WizardUserInfoName, WizardUserInfoOrg, WizardUserInfoSerial, WizardDirValue, WizardGroupValue: String;
- WizardNoIcons, WizardPreparingYesRadio: Boolean;
- WizardSetupType: PSetupTypeEntry;
- WizardComponents, WizardDeselectedComponents, WizardTasks, WizardDeselectedTasks: TStringList;
- NeedToAbortInstall: Boolean;
- { Check/BeforeInstall/AfterInstall 'constants' }
- CheckOrInstallCurrentFilename, CheckOrInstallCurrentSourceFilename: String;
- { RestartManager API state.
- Note: the handle and key might change while running, see TWizardForm.QueryRestartManager. }
- RmSessionStarted, RmFoundApplications, RmDoRestart: Boolean;
- RmSessionHandle: DWORD;
- RmSessionKey: array[0..CCH_RM_SESSION_KEY] of WideChar;
- RmRegisteredFilesCount: Integer;
- { Other }
- ShowLanguageDialog, MatchedLangParameter: Boolean;
- InstallMode: (imNormal, imSilent, imVerySilent);
- HasIcons, IsWin64, Is64BitInstallMode, IsAdmin, IsPowerUserOrAdmin, IsAdminInstallMode,
- NeedPassword, NeedSerial, NeedsRestart, RestartSystem,
- IsUninstaller, AllowUninstallerShutdown, AcceptedQueryEndSessionInProgress: Boolean;
- InstallDefaultDisableFsRedir, ScriptFuncDisableFsRedir: Boolean;
- InstallDefaultRegView: TRegView = rvDefault;
- HasCustomType, HasComponents, HasTasks: Boolean;
- ProcessorArchitecture: TSetupProcessorArchitecture = paUnknown;
- MachineTypesSupportedBySystem: TSetupProcessorArchitectures;
- WindowsVersion: Cardinal;
- NTServicePackLevel: Word;
- WindowsProductType: Byte;
- WindowsSuiteMask: Word;
- MinimumSpace: Integer64;
- DeleteFilesAfterInstallList, DeleteDirsAfterInstallList: TStringList;
- ExpandedAppName, ExpandedAppVerName, ExpandedAppCopyright, ExpandedAppMutex: String;
- DisableCodeConsts: Integer;
- SetupExitCode: Integer;
- CreatedIcon: Boolean;
- RestartInitiatedByThisProcess, DownloadTemporaryFileOrExtractArchiveProcessMessages: Boolean;
- InstallModeRootKey: HKEY;
- CodeRunner: TScriptRunner;
- procedure CodeRunnerOnLog(const S: String);
- procedure CodeRunnerOnLogFmt(const S: String; const Args: array of const);
- function CodeRunnerOnDebug(const Position: LongInt;
- var ContinueStepOver: Boolean): Boolean;
- function CodeRunnerOnDebugIntermediate(const Position: LongInt;
- var ContinueStepOver: Boolean): Boolean;
- procedure CodeRunnerOnDllImport(var DllName: String; var ForceDelayLoad: Boolean);
- procedure CodeRunnerOnException(const Exception: AnsiString; const Position: LongInt);
- procedure CreateTempInstallDirAndExtract64BitHelper;
- procedure DebugNotifyEntry(EntryType: TEntryType; Number: Integer);
- procedure DeinitSetup(const AllowCustomSetupExitCode: Boolean);
- function ExitSetupMsgBox: Boolean;
- function ExpandConst(const S: String): String;
- function ExpandConstEx(const S: String; const CustomConsts: array of String): String;
- function ExpandConstEx2(const S: String; const CustomConsts: array of String;
- const DoExpandIndividualConst: Boolean): String;
- function ExpandConstIfPrefixed(const S: String): String;
- function GetCustomMessageValue(const AName: String; var AValue: String): Boolean;
- function GetShellFolder(const Common: Boolean; const ID: TShellFolderID): String;
- function GetShellFolderByCSIDL(Folder: Integer; const Create: Boolean): String;
- function GetUninstallRegKeyBaseName(const ExpandedAppId: String): String;
- function GetUninstallRegSubkeyName(const UninstallRegKeyBaseName: String): String;
- function GetPreviousData(const ExpandedAppID, ValueName, DefaultValueData: String): String;
- function GetPreviousLanguage(const ExpandedAppID: String): Integer;
- procedure InitializeAdminInstallMode(const AAdminInstallMode: Boolean);
- procedure Initialize64BitInstallMode(const A64BitInstallMode: Boolean);
- procedure Log64BitInstallMode;
- procedure LogArchiveExtractionModeOnce;
- procedure InitializeCommonVars;
- procedure InitializeSetup;
- procedure InitializeWizard;
- procedure InitMainNonSHFolderConsts;
- function InstallOnThisVersion(const MinVersion: TSetupVersionData;
- const OnlyBelowVersion: TSetupVersionData): TInstallOnThisVersionResult;
- function IsRecurseableDirectory(const FindData: TWin32FindData): Boolean;
- procedure LoadSHFolderDLL;
- function LoggedAppMessageBox(const Text, Caption: PChar; const Flags: Longint;
- const Suppressible: Boolean; const Default: Integer): Integer;
- function LoggedMsgBox(const Text, Caption: String; const Typ: TMsgBoxType;
- const Buttons: Cardinal; const Suppressible: Boolean; const Default: Integer): Integer;
- function LoggedTaskDialogMsgBox(const Icon, Instruction, Text, Caption: String;
- const Typ: TMsgBoxType; const Buttons: Cardinal; const ButtonLabels: array of String;
- const ShieldButton: Integer; const Suppressible: Boolean; const Default: Integer;
- const VerificationText: String = ''; const pfVerificationFlagChecked: PBOOL = nil): Integer;
- procedure LogWindowsVersion;
- procedure NotifyAfterInstallEntry(const AfterInstall: String);
- procedure NotifyAfterInstallFileEntry(const FileEntry: PSetupFileEntry);
- procedure NotifyBeforeInstallEntry(const BeforeInstall: String);
- procedure NotifyBeforeInstallFileEntry(const FileEntry: PSetupFileEntry);
- function PreviousInstallCompleted(const WizardComponents, WizardTasks: TStringList): Boolean;
- function CodeRegisterExtraCloseApplicationsResource(const DisableFsRedir: Boolean; const AFilename: String): Boolean;
- procedure RegisterResourcesWithRestartManager(const WizardComponents, WizardTasks: TStringList);
- procedure RemoveTempInstallDir;
- procedure SaveInf(const FileName: String);
- procedure SaveResourceToTempFile(const ResName, Filename: String);
- procedure SetActiveLanguage(const I: Integer);
- procedure ShellExecuteAsOriginalUser(hWnd: HWND; Operation, FileName, Parameters, Directory: LPWSTR; ShowCmd: Integer); stdcall;
- function ShouldDisableFsRedirForFileEntry(const FileEntry: PSetupFileEntry): Boolean;
- function ShouldDisableFsRedirForRunEntry(const RunEntry: PSetupRunEntry): Boolean;
- procedure ProcessRunEntry(const RunEntry: PSetupRunEntry);
- function EvalArchitectureIdentifier(const Name: String): Boolean;
- function EvalDirectiveCheck(const Expression: String): Boolean;
- function ShouldProcessEntry(const WizardComponents, WizardTasks: TStringList;
- const Components, Tasks, Languages, Check: String): Boolean;
- function ShouldProcessFileEntry(const WizardComponents, WizardTasks: TStringList;
- const FileEntry: PSetupFileEntry; const IgnoreCheck: Boolean): Boolean;
- function ShouldProcessIconEntry(const WizardComponents, WizardTasks: TStringList;
- const WizardNoIcons: Boolean; const IconEntry: PSetupIconEntry): Boolean;
- function ShouldProcessRunEntry(const WizardComponents, WizardTasks: TStringList;
- const RunEntry: PSetupRunEntry): Boolean;
- procedure UnloadSHFolderDLL;
- function WindowsVersionAtLeast(const AMajor, AMinor: Byte; const ABuild: Word = 0): Boolean;
- function IsWindows8: Boolean;
- function IsWindows10: Boolean;
- function IsWindows11: Boolean;
- implementation
- uses
- ShellAPI, ShlObj, StrUtils, ActiveX, RegStr, ChaCha20, ECDSA, ISSigFunc,
- SetupLdrAndSetup.Messages, Shared.SetupMessageIDs, Setup.Install, SetupLdrAndSetup.InstFunc,
- Setup.InstFunc, SetupLdrAndSetup.RedirFunc, PathFunc,
- Compression.Base, Compression.Zlib, Compression.bzlib, Compression.LZMADecompressor,
- Shared.SetupEntFunc, Shared.EncryptionFunc, Setup.SelectLanguageForm,
- Setup.WizardForm, Setup.DebugClient, Shared.VerInfoFunc, Setup.FileExtractor,
- Shared.FileClass, Setup.LoggingFunc,
- SimpleExpression, Setup.Helper, Setup.SpawnClient, Setup.SpawnServer,
- Setup.DotNetFunc, Shared.TaskDialogFunc, Setup.MainForm, Compression.SevenZipDecoder,
- Compression.SevenZipDLLDecoder;
- var
- ShellFolders: array[Boolean, TShellFolderID] of String;
- ShellFoldersRead: array[Boolean, TShellFolderID] of Boolean;
- SHFolderDLLHandle: HMODULE;
- SHGetFolderPathFunc: function(hwndOwner: HWND; nFolder: Integer;
- hToken: THandle; dwFlags: DWORD; pszPath: PChar): HRESULT; stdcall;
- SHGetKnownFolderPathFunc: function(const rfid: TGUID; dwFlags: DWORD; hToken: THandle;
- var ppszPath: PWideChar): HRESULT; stdcall;
- DecompressorDLLHandle, SevenZipDLLHandle: HMODULE;
- type
- TDummyClass = class
- public
- class function ExpandCheckOrInstallConstant(Sender: TSimpleExpression;
- const Constant: String): String;
- class function EvalInstallIdentifier(Sender: TSimpleExpression;
- const Name: String; const Parameters: array of const): Boolean;
- class function EvalArchitectureIdentifier(Sender: TSimpleExpression;
- const Name: String; const Parameters: array of const): Boolean;
- class function EvalComponentOrTaskIdentifier(Sender: TSimpleExpression;
- const Name: String; const Parameters: array of const): Boolean;
- class function EvalLanguageIdentifier(Sender: TSimpleExpression;
- const Name: String; const Parameters: array of const): Boolean;
- class function EvalCheckIdentifier(Sender: TSimpleExpression;
- const Name: String; const Parameters: array of const): Boolean;
- end;
- { Misc. functions }
- function WindowsVersionAtLeast(const AMajor, AMinor: Byte; const ABuild: Word): Boolean;
- begin
- Result := WindowsVersion >= Cardinal((AMajor shl 24) or (AMinor shl 16) or ABuild);
- end;
- function IsWindows8: Boolean;
- begin
- Result := WindowsVersionAtLeast(6, 2);
- end;
- function IsWindows10: Boolean;
- begin
- Result := WindowsVersionAtLeast(10, 0);
- end;
- function IsWindows11: Boolean;
- begin
- Result := WindowsVersionAtLeast(10, 0, 22000);
- end;
- function GetUninstallRegKeyBaseName(const ExpandedAppId: String): String;
- var
- UseAnsiCRC32: Boolean;
- S: AnsiString;
- I: Integer;
- begin
- { Set uninstall registry key base name }
- Result := ExpandedAppId;
- { Uninstall registry keys can only be up to 63 characters, otherwise Win95
- ignores them. Limit to 57 since Setup will add _isXXX to the end later. }
- if Length(Result) > 57 then begin
- { Only keep the first 48 characters, then add an tilde and the CRC
- of the original string (to make the trimmed string unique). The
- resulting string is 57 characters long. On Unicode, only do this if we
- can get a CRC32 compatible with ANSI versions, else there's no point
- in shortening since Unicode doesn't run on Win95. }
- UseAnsiCRC32 := True;
- for I := 1 to Length(Result) do begin
- if Ord(Result[I]) > 126 then begin
- UseAnsiCRC32 := False;
- Break;
- end;
- end;
- if UseAnsiCRC32 then begin
- S := AnsiString(Result);
- FmtStr(Result, '%.48s~%.8x', [Result, GetCRC32(S[1], Length(S)*SizeOf(S[1]))]);
- end;
- end;
- end;
- function GetUninstallRegSubkeyName(const UninstallRegKeyBaseName: String): String;
- begin
- Result := Format('%s\%s_is1', [REGSTR_PATH_UNINSTALL, UninstallRegKeyBaseName]);
- end;
- { Based on FindPreviousData in Wizard.pas }
- function GetPreviousData(const ExpandedAppID, ValueName, DefaultValueData: String): String;
- var
- H: HKEY;
- begin
- Result := DefaultValueData;
- if ExpandedAppId <> '' then begin
- if RegOpenKeyExView(InstallDefaultRegView, InstallModeRootKey,
- PChar(GetUninstallRegSubkeyName(GetUninstallRegKeyBaseName(ExpandedAppId))),
- 0, KEY_QUERY_VALUE, H) = ERROR_SUCCESS then begin
- try
- RegQueryStringValue (H, PChar(ValueName), Result);
- finally
- RegCloseKey (H);
- end;
- end;
- end;
- end;
- function GetPreviousLanguage(const ExpandedAppID: String): Integer;
- var
- PrevLang: String;
- I: Integer;
- begin
- { do not localize or change the following string }
- PrevLang := GetPreviousData(ExpandConst(SetupHeader.AppId), 'Inno Setup: Language', '');
- if PrevLang <> '' then begin
- for I := 0 to Entries[seLanguage].Count-1 do begin
- if CompareText(PrevLang, PSetupLanguageEntry(Entries[seLanguage][I]).Name) = 0 then begin
- Result := I;
- Exit;
- end;
- end;
- end;
-
- Result := -1;
- end;
- class function TDummyClass.ExpandCheckOrInstallConstant(Sender: TSimpleExpression;
- const Constant: String): String;
- begin
- Result := ExpandConst(Constant);
- end;
- class function TDummyClass.EvalInstallIdentifier(Sender: TSimpleExpression;
- const Name: String; const Parameters: array of const): Boolean;
- begin
- CodeRunner.RunProcedure(AnsiString(Name), Parameters, True);
- Result := True; { Result doesn't matter }
- end;
- procedure NotifyInstallEntry(const Install: String);
- procedure EvalInstall(const Expression: String);
- var
- SimpleExpression: TSimpleExpression;
- begin
- try
- SimpleExpression := TSimpleExpression.Create;
- try
- SimpleExpression.Expression := Expression;
- SimpleExpression.OnEvalIdentifier := TDummyClass.EvalInstallIdentifier;
- SimpleExpression.OnExpandConstant := TDummyClass.ExpandCheckOrInstallConstant;
- SimpleExpression.ParametersAllowed := True;
- SimpleExpression.SingleIdentifierMode := True;
- SimpleExpression.Eval;
- finally
- SimpleExpression.Free;
- end;
- except
- InternalError(Format('Expression error ''%s''', [GetExceptMessage]));
- end;
- end;
- begin
- if Install <> '' then begin
- try
- if CodeRunner = nil then
- InternalError('"BeforeInstall" or "AfterInstall" parameter with no CodeRunner');
- EvalInstall(Install);
- except
- { Don't allow exceptions raised by Before/AfterInstall functions to be propagated out }
- Application.HandleException(nil);
- end;
- end;
- end;
- procedure NotifyBeforeInstallEntry(const BeforeInstall: String);
- begin
- NotifyInstallEntry(BeforeInstall);
- end;
- procedure NotifyBeforeInstallFileEntry(const FileEntry: PSetupFileEntry);
- begin
- CheckOrInstallCurrentFilename := FileEntry.DestName;
- CheckOrInstallCurrentSourceFilename := FileEntry.SourceFilename;
- NotifyInstallEntry(FileEntry.BeforeInstall);
- CheckOrInstallCurrentFilename := '';
- CheckOrInstallCurrentSourceFilename := '';
- end;
- procedure NotifyAfterInstallEntry(const AfterInstall: String);
- begin
- NotifyInstallEntry(AfterInstall);
- end;
- procedure NotifyAfterInstallFileEntry(const FileEntry: PSetupFileEntry);
- begin
- CheckOrInstallCurrentFilename := FileEntry.DestName;
- CheckOrInstallCurrentSourceFilename := FileEntry.SourceFilename;
- NotifyInstallEntry(FileEntry.AfterInstall);
- CheckOrInstallCurrentFilename := '';
- CheckOrInstallCurrentSourceFilename := '';
- end;
- function EvalArchitectureIdentifier(const Name: String): Boolean;
- type
- TArchIdentifierRec = record
- Name: String;
- Arch: TSetupProcessorArchitecture;
- Compatible: Boolean;
- end;
- const
- { Valid identifier 'win64' is not in this list but treated specially below }
- ArchIdentifiers: array[0..7] of TArchIdentifierRec = (
- (Name: 'arm32compatible'; Arch: paArm32; Compatible: True),
- (Name: 'arm64'; Arch: paArm64; Compatible: False),
- (Name: 'x64'; Arch: paX64; Compatible: False),
- (Name: 'x64os'; Arch: paX64; Compatible: False),
- (Name: 'x64compatible'; Arch: paX64; Compatible: True),
- (Name: 'x86'; Arch: paX86; Compatible: False),
- (Name: 'x86os'; Arch: paX86; Compatible: False),
- (Name: 'x86compatible'; Arch: paX86; Compatible: True));
- begin
- if Name = 'win64' then
- Exit(IsWin64);
- for var ArchIdentifier in ArchIdentifiers do
- if ArchIdentifier.Name = Name then begin
- if ArchIdentifier.Compatible then
- Exit(ArchIdentifier.Arch in MachineTypesSupportedBySystem)
- else { An exact match is requested instead of anything compatible, perhaps
- for a driver install or something similar }
- Exit(ProcessorArchitecture = ArchIdentifier.Arch);
- end;
- raise Exception.CreateFmt('Unknown architecture ''%s''', [Name]);
- end;
- class function TDummyClass.EvalArchitectureIdentifier(Sender: TSimpleExpression;
- const Name: String; const Parameters: array of const): Boolean;
- begin
- Result := Setup.MainFunc.EvalArchitectureIdentifier(Name);
- end;
- class function TDummyClass.EvalComponentOrTaskIdentifier(Sender: TSimpleExpression;
- const Name: String; const Parameters: array of const): Boolean;
- var
- WizardItems: TStringList;
- begin
- WizardItems := TStringList(Sender.Tag);
- Result := ListContains(WizardItems, Name);
- end;
- class function TDummyClass.EvalLanguageIdentifier(Sender: TSimpleExpression;
- const Name: String; const Parameters: array of const): Boolean;
- begin
- Result := CompareText(PSetupLanguageEntry(Entries[seLanguage][ActiveLanguage]).Name, Name) = 0;
- end;
- class function TDummyClass.EvalCheckIdentifier(Sender: TSimpleExpression;
- const Name: String; const Parameters: array of const): Boolean;
- begin
- Result := CodeRunner.RunBooleanFunction(AnsiString(Name), Parameters, True, False);
- end;
- function EvalCheck(const Expression: String): Boolean;
- var
- SimpleExpression: TSimpleExpression;
- begin
- try
- SimpleExpression := TSimpleExpression.Create;
- try
- SimpleExpression.Lazy := True;
- SimpleExpression.Expression := Expression;
- SimpleExpression.OnEvalIdentifier := TDummyClass.EvalCheckIdentifier;
- SimpleExpression.OnExpandConstant := TDummyClass.ExpandCheckOrInstallConstant;
- SimpleExpression.ParametersAllowed := True;
- SimpleExpression.SilentOrAllowed := False;
- SimpleExpression.SingleIdentifierMode := False;
- Result := SimpleExpression.Eval;
- finally
- SimpleExpression.Free;
- end;
- except
- InternalError(Format('Expression error ''%s''', [GetExceptMessage]));
- Result := False;
- end;
- end;
- function EvalDirectiveCheck(const Expression: String): Boolean;
- begin
- if not TryStrToBoolean(Expression, Result) then
- Result := EvalCheck(Expression);
- end;
- function EvalExpression(const Expression: String;
- OnEvalIdentifier: TSimpleExpressionOnEvalIdentifier; Tag: LongInt = 0): Boolean;
- var
- SimpleExpression: TSimpleExpression;
- begin
- try
- SimpleExpression := TSimpleExpression.Create;
- try
- SimpleExpression.Lazy := True;
- SimpleExpression.Expression := Expression;
- SimpleExpression.OnEvalIdentifier := OnEvalIdentifier;
- SimpleExpression.ParametersAllowed := False;
- SimpleExpression.SilentOrAllowed := True;
- SimpleExpression.SingleIdentifierMode := False;
- SimpleExpression.Tag := Tag;
- Result := SimpleExpression.Eval;
- finally
- SimpleExpression.Free;
- end;
- except
- InternalError(Format('Expression error ''%s''', [GetExceptMessage]));
- Result := False;
- end;
- end;
- function ShouldProcessEntry(const WizardComponents, WizardTasks: TStringList;
- const Components, Tasks, Languages, Check: String): Boolean;
- var
- ProcessComponent, ProcessTask, ProcessLanguage: Boolean;
- begin
- if (Components <> '') or (Tasks <> '') or (Languages <> '') or (Check <> '') then begin
- if (Components <> '') and (WizardComponents <> nil) then
- ProcessComponent := EvalExpression(Components, TDummyClass.EvalComponentOrTaskIdentifier, LongInt(WizardComponents))
- else
- ProcessComponent := True;
- if (Tasks <> '') and (WizardTasks <> nil) then
- ProcessTask := EvalExpression(Tasks, TDummyClass.EvalComponentOrTaskIdentifier, LongInt(WizardTasks))
- else
- ProcessTask := True;
- if Languages <> '' then
- ProcessLanguage := EvalExpression(Languages, TDummyClass.EvalLanguageIdentifier)
- else
- ProcessLanguage := True;
- Result := ProcessComponent and ProcessTask and ProcessLanguage;
- if Result and (Check <> '') then begin
- try
- if CodeRunner = nil then
- InternalError('"Check" parameter with no CodeRunner');
- Result := EvalCheck(Check);
- except
- { Don't allow exceptions raised by Check functions to be propagated out }
- Application.HandleException(nil);
- Result := False;
- end;
- end;
- end else
- Result := True;
- end;
- function ShouldProcessFileEntry(const WizardComponents, WizardTasks: TStringList;
- const FileEntry: PSetupFileEntry; const IgnoreCheck: Boolean): Boolean;
- begin
- if foDontCopy in FileEntry.Options then begin
- Result := False;
- Exit;
- end;
- CheckOrInstallCurrentFilename := FileEntry.DestName;
- CheckOrInstallCurrentSourceFilename := FileEntry.SourceFilename;
- if IgnoreCheck then
- Result := ShouldProcessEntry(WizardComponents, WizardTasks, FileEntry.Components, FileEntry.Tasks, FileEntry.Languages, '')
- else
- Result := ShouldProcessEntry(WizardComponents, WizardTasks, FileEntry.Components, FileEntry.Tasks, FileEntry.Languages, FileEntry.Check);
- CheckOrInstallCurrentFilename := '';
- CheckOrInstallCurrentSourceFilename := '';
- end;
- function ShouldProcessRunEntry(const WizardComponents, WizardTasks: TStringList;
- const RunEntry: PSetupRunEntry): Boolean;
- begin
- if (InstallMode <> imNormal) and (roSkipIfSilent in RunEntry.Options) then
- Result := False
- else if (InstallMode = imNormal) and (roSkipIfNotSilent in RunEntry.Options) then
- Result := False
- else
- Result := ShouldProcessEntry(WizardComponents, WizardTasks, RunEntry.Components, RunEntry.Tasks, RunEntry.Languages, RunEntry.Check);
- end;
- function ShouldProcessIconEntry(const WizardComponents, WizardTasks: TStringList;
- const WizardNoIcons: Boolean; const IconEntry: PSetupIconEntry): Boolean;
- begin
- if WizardNoIcons and (IconEntry.Tasks = '') and
- (Copy(IconEntry.IconName, 1, 8) = '{group}\') then
- Result := False
- else
- Result := ShouldProcessEntry(WizardComponents, WizardTasks, IconEntry.Components, IconEntry.Tasks, IconEntry.Languages, IconEntry.Check);
- end;
- function ShouldDisableFsRedirForFileEntry(const FileEntry: PSetupFileEntry): Boolean;
- begin
- Result := InstallDefaultDisableFsRedir;
- if fo32Bit in FileEntry.Options then
- Result := False;
- if fo64Bit in FileEntry.Options then begin
- if not IsWin64 then
- InternalError('Cannot install files to 64-bit locations on this version of Windows');
- Result := True;
- end;
- end;
- function SlashesToBackslashes(const S: String): String;
- var
- I: Integer;
- begin
- Result := S;
- for I := 1 to Length(Result) do
- if Result[I] = '/' then
- Result[I] := '\';
- end;
- procedure LoadInf(const FileName: String; var WantToSuppressMsgBoxes: Boolean);
- const
- Section = 'Setup';
- var
- S: String;
- begin
- //saved infs
- InitLang := GetIniString(Section, 'Lang', InitLang, FileName);
- InitDir := GetIniString(Section, 'Dir', InitDir, FileName);
- InitProgramGroup := GetIniString(Section, 'Group', InitProgramGroup, FileName);
- InitNoIcons := GetIniBool(Section, 'NoIcons', InitNoIcons, FileName);
- InitSetupType := GetIniString(Section, 'SetupType', InitSetupType, FileName);
- S := GetIniString(Section, 'Components', '$', FileName);
- if S <> '$' then begin
- InitComponentsSpecified := True;
- SetStringsFromCommaString(InitComponents, SlashesToBackslashes(S));
- end;
- S := GetIniString(Section, 'Tasks', '$', FileName);
- if S <> '$' then begin
- InitDeselectAllTasks := True;
- SetStringsFromCommaString(InitTasks, SlashesToBackslashes(S));
- end;
- //non saved infs (=non user settable)
- InitSilent := GetIniBool(Section, 'Silent', InitSilent, FileName);
- InitVerySilent := GetIniBool(Section, 'VerySilent', InitVerySilent, FileName);
- InitNoRestart := GetIniBool(Section, 'NoRestart', InitNoRestart, FileName);
- InitCloseApplications := GetIniBool(Section, 'CloseApplications', InitCloseApplications, FileName);
- InitNoCloseApplications := GetIniBool(Section, 'NoCloseApplications', InitNoCloseApplications, FileName);
- InitForceCloseApplications := GetIniBool(Section, 'ForceCloseApplications', InitForceCloseApplications, FileName);
- InitNoForceCloseApplications := GetIniBool(Section, 'NoForceCloseApplications', InitNoForceCloseApplications, FileName);
- InitLogCloseApplications := GetIniBool(Section, 'LogCloseApplications', InitLogCloseApplications, FileName);
- InitRestartApplications := GetIniBool(Section, 'RestartApplications', InitRestartApplications, FileName);
- InitNoRestartApplications := GetIniBool(Section, 'NoRestartApplications', InitNoRestartApplications, FileName);
- InitNoCancel := GetIniBool(Section, 'NoCancel', InitNoCancel, FileName);
- InitPassword := GetIniString(Section, 'Password', InitPassword, FileName);
- InitRestartExitCode := GetIniInt(Section, 'RestartExitCode', InitRestartExitCode, 0, 0, FileName);
- WantToSuppressMsgBoxes := GetIniBool(Section, 'SuppressMsgBoxes', WantToSuppressMsgBoxes, FileName);
- InitSaveInf := GetIniString(Section, 'SaveInf', InitSaveInf, FileName);
- end;
- procedure SaveInf(const FileName: String);
- const
- Section = 'Setup';
- begin
- SetIniString(Section, 'Lang',
- PSetupLanguageEntry(Entries[seLanguage][ActiveLanguage]).Name, FileName);
- SetIniString(Section, 'Dir', WizardDirValue, FileName);
- SetIniString(Section, 'Group', WizardGroupValue, FileName);
- SetIniBool(Section, 'NoIcons', WizardNoIcons, FileName);
- if WizardSetupType <> nil then begin
- SetIniString(Section, 'SetupType', WizardSetupType.Name, FileName);
- SetIniString(Section, 'Components', StringsToCommaString(WizardComponents), FileName);
- end
- else begin
- DeleteIniEntry(Section, 'SetupType', FileName);
- DeleteIniEntry(Section, 'Components', FileName);
- end;
- SetIniString(Section, 'Tasks', StringsToCommaString(WizardTasks), FileName);
- end;
- function GetCustomMessageValue(const AName: String; var AValue: String): Boolean;
- var
- I: Integer;
- begin
- Result := False;
- for I := 0 to Entries[seCustomMessage].Count-1 do begin
- with PSetupCustomMessageEntry(Entries[seCustomMessage][I])^ do begin
- if (CompareText(Name, AName) = 0) and
- ((LangIndex = -1) or (LangIndex = ActiveLanguage)) then begin
- Result := True;
- AValue := Value;
- { don't stop looping, last item counts }
- end;
- end;
- end;
- end;
- function ExpandIndividualConst(Cnst: String;
- const CustomConsts: array of String): String;
- { Cnst must be the name of a single constant, without the braces.
- For example: app
- IsPath is set to True if the result is a path which needs special trailing-
- backslash handling. }
-
- procedure HandleAutoConstants(var Cnst: String);
- const
- Actual: array [Boolean] of String = ('user', 'common');
- begin
- if Copy(Cnst, 1, 4) = 'auto' then begin
- StringChange(Cnst, 'auto', Actual[IsAdminInstallMode]);
- if (Cnst = 'userpf32') or (Cnst = 'userpf64') or
- (Cnst = 'usercf32') or (Cnst = 'usercf64') then
- Delete(Cnst, Length(Cnst)-1, 2);
- end;
- end;
-
- procedure NoUninstallConstError(const C: String);
- begin
- InternalError(Format('Cannot evaluate "%s" constant during Uninstall', [C]));
- end;
- function ExpandEnvConst(C: String): String;
- var
- I: Integer;
- VarName, Default: String;
- begin
- Delete(C, 1, 1);
- I := ConstPos('|', C); { check for 'default' value }
- if I = 0 then
- I := Length(C)+1;
- VarName := Copy(C, 1, I-1);
- Default := Copy(C, I+1, Maxint);
- Result := '';
- if ConvertConstPercentStr(VarName) and ConvertConstPercentStr(Default) then begin
- Result := GetEnv(ExpandConstEx(VarName, CustomConsts));
- if Result = '' then
- Result := ExpandConstEx(Default, CustomConsts);
- end;
- end;
- function ExpandRegConst(C: String): String;
- { Expands a registry-value constant in the form:
- reg:HKxx\SubkeyName,ValueName|DefaultValue }
- type
- TKeyNameConst = packed record
- KeyName: String;
- KeyConst: HKEY;
- end;
- const
- KeyNameConsts: array[0..5] of TKeyNameConst = (
- (KeyName: 'HKA'; KeyConst: HKEY_AUTO),
- (KeyName: 'HKCR'; KeyConst: HKEY_CLASSES_ROOT),
- (KeyName: 'HKCU'; KeyConst: HKEY_CURRENT_USER),
- (KeyName: 'HKLM'; KeyConst: HKEY_LOCAL_MACHINE),
- (KeyName: 'HKU'; KeyConst: HKEY_USERS),
- (KeyName: 'HKCC'; KeyConst: HKEY_CURRENT_CONFIG));
- var
- Z, Subkey, Value, Default: String;
- I, J, L: Integer;
- RegView: TRegView;
- RootKey: HKEY;
- K: HKEY;
- begin
- Delete(C, 1, 4); { skip past 'reg:' }
- I := ConstPos('\', C);
- if I <> 0 then begin
- Z := Copy(C, 1, I-1);
- if Z <> '' then begin
- RegView := InstallDefaultRegView;
- L := Length(Z);
- if L >= 2 then begin
- { Check for '32' or '64' suffix }
- if (Z[L-1] = '3') and (Z[L] = '2') then begin
- RegView := rv32Bit;
- SetLength(Z, L-2);
- end
- else if (Z[L-1] = '6') and (Z[L] = '4') then begin
- if not IsWin64 then
- InternalError('Cannot access a 64-bit key in a "reg" constant on this version of Windows');
- RegView := rv64Bit;
- SetLength(Z, L-2);
- end;
- end;
- RootKey := 0;
- for J := Low(KeyNameConsts) to High(KeyNameConsts) do
- if CompareText(KeyNameConsts[J].KeyName, Z) = 0 then begin
- RootKey := KeyNameConsts[J].KeyConst;
- if RootKey = HKEY_AUTO then
- RootKey := InstallModeRootKey;
- Break;
- end;
- if RootKey <> 0 then begin
- Z := Copy(C, I+1, Maxint);
- I := ConstPos('|', Z); { check for a 'default' data }
- if I = 0 then
- I := Length(Z)+1;
- Default := Copy(Z, I+1, Maxint);
- SetLength(Z, I-1);
- I := ConstPos(',', Z); { comma separates subkey and value }
- if I <> 0 then begin
- Subkey := Copy(Z, 1, I-1);
- Value := Copy(Z, I+1, Maxint);
- if ConvertConstPercentStr(Subkey) and ConvertConstPercentStr(Value) and
- ConvertConstPercentStr(Default) then begin
- Result := ExpandConstEx(Default, CustomConsts);
- if RegOpenKeyExView(RegView, RootKey,
- PChar(ExpandConstEx(Subkey, CustomConsts)),
- 0, KEY_QUERY_VALUE, K) = ERROR_SUCCESS then begin
- RegQueryStringValue(K, PChar(ExpandConstEx(Value, CustomConsts)),
- Result, True); { also allows REG_DWORD }
- RegCloseKey(K);
- end;
- Exit;
- end;
- end;
- end;
- end;
- end;
- { it will only reach here if there was a parsing error }
- InternalError('Failed to parse "reg" constant');
- end;
- function ExpandIniConst(C: String): String;
- { Expands an INI-value constant in the form:
- filename,section,key|defaultvalue }
- var
- Z, Filename, Section, Key, Default: String;
- I: Integer;
- begin
- Delete(C, 1, 4); { skip past 'ini:' }
- I := ConstPos(',', C);
- if I <> 0 then begin
- Z := Copy(C, 1, I-1);
- if Z <> '' then begin
- Filename := Z;
- Z := Copy(C, I+1, Maxint);
- I := ConstPos('|', Z); { check for a 'default' data }
- if I = 0 then
- I := Length(Z)+1;
- Default := Copy(Z, I+1, Maxint);
- SetLength(Z, I-1);
- I := ConstPos(',', Z); { comma separates section and key }
- if I <> 0 then begin
- Section := Copy(Z, 1, I-1);
- Key := Copy(Z, I+1, Maxint);
- if ConvertConstPercentStr(Filename) and ConvertConstPercentStr(Section) and ConvertConstPercentStr(Key) and
- ConvertConstPercentStr(Default) then begin
- Filename := ExpandConstEx(Filename, CustomConsts);
- Section := ExpandConstEx(Section, CustomConsts);
- Key := ExpandConstEx(Key, CustomConsts);
- Default := ExpandConstEx(Default, CustomConsts);
- Result := GetIniString(Section, Key, Default, Filename);
- Exit;
- end;
- end;
- end;
- end;
- { it will only reach here if there was a parsing error }
- InternalError('Failed to parse "ini" constant');
- end;
- function ExpandParamConst(C: String): String;
- { Expands an commandline-parameter-value constant in the form:
- parametername|defaultvalue }
- function GetParamString(const Param, Default: String): String;
- var
- I, PCount: Integer;
- Z: String;
- begin
- PCount := NewParamCount();
- for I := 1 to PCount do begin
- Z := NewParamStr(I);
- if StrLIComp(PChar(Z), PChar('/'+Param+'='), Length(Param)+2) = 0 then begin
- Delete(Z, 1, Length(Param)+2);
- Result := Z;
- Exit;
- end;
- end;
- Result := Default;
- end;
- var
- Z, Param, Default: String;
- I: Integer;
- begin
- Delete(C, 1, 6); { skip past 'param:' }
- Z := C;
- I := ConstPos('|', Z); { check for a 'default' data }
- if I = 0 then
- I := Length(Z)+1;
- Default := Copy(Z, I+1, Maxint);
- SetLength(Z, I-1);
- Param := Z;
- if ConvertConstPercentStr(Param) and ConvertConstPercentStr(Default) then begin
- Param := ExpandConstEx(Param, CustomConsts);
- Default := ExpandConstEx(Default, CustomConsts);
- Result := GetParamString(Param, Default);
- Exit;
- end;
- { it will only reach here if there was a parsing error }
- InternalError('Failed to parse "param" constant');
- end;
- function ExpandCodeConst(C: String): String;
- { Expands an Pascal-script-value constant in the form:
- parametername|defaultvalue }
- function GetCodeString(const ScriptFunc, Default: String): String;
- begin
- if (CodeRunner <> nil) then
- Result := CodeRunner.RunStringFunction(AnsiString(ScriptFunc), [Default], True, Default)
- else begin
- InternalError('"code" constant with no CodeRunner');
- Result := '';
- end;
- end;
- var
- Z, ScriptFunc, Default: String;
- I: Integer;
- begin
- if DisableCodeConsts <> 0 then
- raise Exception.Create('Cannot evaluate "code" constant because of possible side effects');
- Delete(C, 1, 5); { skip past 'code:' }
- Z := C;
- I := ConstPos('|', Z); { check for a 'default' data }
- if I = 0 then
- I := Length(Z)+1;
- Default := Copy(Z, I+1, Maxint);
- SetLength(Z, I-1);
- ScriptFunc := Z;
- if ConvertConstPercentStr(ScriptFunc) and ConvertConstPercentStr(Default) then begin
- Default := ExpandConstEx(Default, CustomConsts);
- Result := GetCodeString(ScriptFunc, Default);
- Exit;
- end;
- { it will only reach here if there was a parsing error }
- InternalError('Failed to parse "code" constant');
- end;
- function ExpandDriveConst(C: String): String;
- begin
- Delete(C, 1, 6); { skip past 'drive:' }
- if ConvertConstPercentStr(C) then begin
- Result := PathExtractDrive(ExpandConstEx(C, CustomConsts));
- Exit;
- end;
- { it will only reach here if there was a parsing error }
- InternalError('Failed to parse "drive" constant');
- end;
- function ExpandCustomMessageConst(C: String): String;
- var
- I, ArgCount: Integer;
- MsgName: String;
- ArgValues: array[0..8] of String; { %1 through %9 }
- begin
- Delete(C, 1, 3); { skip past 'cm:' }
- I := ConstPos(',', C);
- if I = 0 then
- MsgName := C
- else
- MsgName := Copy(C, 1, I-1);
- { Prepare arguments. Excess arguments are ignored. }
- ArgCount := 0;
- while (I > 0) and (ArgCount <= High(ArgValues)) do begin
- Delete(C, 1, I);
- I := ConstPos(',', C);
- if I = 0 then
- ArgValues[ArgCount] := C
- else
- ArgValues[ArgCount] := Copy(C, 1, I-1);
- if not ConvertConstPercentStr(ArgValues[ArgCount]) then
- InternalError('Failed to parse "cm" constant');
- ArgValues[ArgCount] := ExpandConstEx(ArgValues[ArgCount], CustomConsts);
- Inc(ArgCount);
- end;
- { Look up the message value }
- if not GetCustomMessageValue(MsgName, Result) then
- InternalError(Format('Unknown custom message name "%s" in "cm" constant', [MsgName]));
- { Expand the message }
- Result := FmtMessage(PChar(Result), Slice(ArgValues, ArgCount));
- end;
- const
- FolderConsts: array[Boolean, TShellFolderID] of String = (
- { Also see FolderIDs }
- { User }
- ('userdesktop', 'userstartmenu', 'userprograms', 'userstartup',
- 'usersendto', 'commonfonts', 'userappdata', 'userdocs', 'usertemplates',
- 'userfavorites', 'localappdata', 'userpf', 'usercf', 'usersavedgames'),
- { Common }
- ('commondesktop', 'commonstartmenu', 'commonprograms', 'commonstartup',
- 'usersendto', 'commonfonts', 'commonappdata', 'commondocs', 'commontemplates',
- 'commonfavorites' { not accepted anymore by the compiler }, '', '', '', ''));
- NoUninstallConsts: array[0..6] of String =
- ('src', 'srcexe', 'userinfoname', 'userinfoorg', 'userinfoserial', 'hwnd',
- 'wizardhwnd');
- var
- OriginalCnst, ShellFolder: String;
- Common: Boolean;
- ShellFolderID: TShellFolderID;
- I: Integer;
- begin
- OriginalCnst := Cnst;
- HandleRenamedConstants(Cnst, nil);
- HandleAutoConstants(Cnst);
- if IsUninstaller then
- for I := Low(NoUninstallConsts) to High(NoUninstallConsts) do
- if NoUninstallConsts[I] = Cnst then
- NoUninstallConstError(NoUninstallConsts[I]);
- if Cnst = '\' then Result := '\'
- else if Cnst = 'app' then begin
- if IsUninstaller then begin
- if UninstallExpandedApp = '' then
- InternalError('An attempt was made to expand the "' + OriginalCnst + '" constant but Setup didn''t create the "app" dir');
- Result := UninstallExpandedApp;
- end else begin
- if WizardDirValue = '' then
- InternalError('An attempt was made to expand the "' + OriginalCnst + '" constant before it was initialized');
- Result := WizardDirValue;
- end;
- end
- else if Cnst = 'win' then Result := WinDir
- else if Cnst = 'sys' then Result := WinSystemDir
- else if Cnst = 'syswow64' then begin
- if WinSysWow64Dir <> '' then
- Result := WinSysWow64Dir
- else begin
- if IsWin64 then { sanity check }
- InternalError('Cannot expand "' + OriginalCnst + '" constant because there is no SysWOW64 directory');
- Result := WinSystemDir;
- end;
- end
- else if Cnst = 'sysnative' then begin
- if WinSysNativeDir <> '' then
- Result := WinSysNativeDir
- else
- Result := WinSystemDir;
- end
- else if Cnst = 'src' then Result := SourceDir
- else if Cnst = 'srcexe' then Result := SetupLdrOriginalFilename
- else if Cnst = 'tmp' then Result := TempInstallDir
- else if Cnst = 'sd' then Result := SystemDrive
- else if Cnst = 'commonpf' then begin
- if Is64BitInstallMode then
- Result := ProgramFiles64Dir
- else
- Result := ProgramFiles32Dir;
- end
- else if Cnst = 'commoncf' then begin
- if Is64BitInstallMode then
- Result := CommonFiles64Dir
- else
- Result := CommonFiles32Dir;
- end
- else if Cnst = 'commonpf32' then Result := ProgramFiles32Dir
- else if Cnst = 'commoncf32' then Result := CommonFiles32Dir
- else if Cnst = 'commonpf64' then begin
- if IsWin64 then
- Result := ProgramFiles64Dir
- else
- InternalError('Cannot expand "' + OriginalCnst + '" constant on this version of Windows');
- end
- else if Cnst = 'commoncf64' then begin
- if IsWin64 then
- Result := CommonFiles64Dir
- else
- InternalError('Cannot expand "' + OriginalCnst + '" constant on this version of Windows');
- end
- else if Cnst = 'userfonts' then Result := ExpandConst('{localappdata}\Microsoft\Windows\Fonts') { supported by Windows 10 Version 1803 and newer. doesn't have a KNOWNFOLDERID. }
- else if Cnst = 'dao' then Result := ExpandConst('{cf}\Microsoft Shared\DAO')
- else if Cnst = 'cmd' then Result := CmdFilename
- else if Cnst = 'computername' then Result := GetComputerNameString
- else if Cnst = 'username' then Result := GetUserNameString
- else if Cnst = 'groupname' then begin
- if IsUninstaller then begin
- if UninstallExpandedGroupName = '' then
- InternalError('Cannot expand "' + OriginalCnst + '" constant because it was not available at install time');
- Result := UninstallExpandedGroupName;
- end
- else begin
- if WizardGroupValue = '' then
- InternalError('An attempt was made to expand the "' + OriginalCnst + '" constant before it was initialized');
- Result := WizardGroupValue;
- end;
- end
- else if Cnst = 'sysuserinfoname' then Result := SysUserInfoName
- else if Cnst = 'sysuserinfoorg' then Result := SysUserInfoOrg
- else if Cnst = 'userinfoname' then Result := WizardUserInfoName
- else if Cnst = 'userinfoorg' then Result := WizardUserInfoOrg
- else if Cnst = 'userinfoserial' then Result := WizardUserInfoSerial
- else if Cnst = 'uninstallexe' then Result := UninstallExeFilename
- else if Cnst = 'group' then begin
- if IsUninstaller then begin
- if UninstallExpandedGroup = '' then
- InternalError('Cannot expand "' + OriginalCnst + '" constant because it was not available at install time');
- Result := UninstallExpandedGroup;
- end
- else begin
- if WizardGroupValue = '' then
- InternalError('An attempt was made to expand the "' + OriginalCnst + '" constant before it was initialized');
- ShellFolder := GetShellFolder(not(shAlwaysUsePersonalGroup in SetupHeader.Options) and IsAdminInstallMode,
- sfPrograms);
- if ShellFolder = '' then
- InternalError('Failed to expand "' + OriginalCnst + '" constant');
- Result := AddBackslash(ShellFolder) + WizardGroupValue;
- end;
- end
- else if Cnst = 'language' then begin
- if IsUninstaller then
- Result := UninstallExpandedLanguage
- else
- Result := PSetupLanguageEntry(Entries[seLanguage][ActiveLanguage]).Name
- end
- else if Cnst = 'wizardhwnd' then begin
- if Assigned(WizardForm) then
- Result := IntToStr(WizardForm.Handle)
- else
- Result := '0';
- end
- else if Cnst = 'log' then Result := GetLogFileName
- else if Cnst = 'dotnet11' then Result := GetDotNetVersionInstallRoot(rv32Bit, netbase11)
- else if Cnst = 'dotnet20' then Result := GetDotNetVersionInstallRoot(InstallDefaultRegView, netbase20)
- else if Cnst = 'dotnet2032' then Result := GetDotNetVersionInstallRoot(rv32Bit, netbase20)
- else if Cnst = 'dotnet2064' then begin
- if IsWin64 then
- Result := GetDotNetVersionInstallRoot(rv64Bit, netbase20)
- else
- InternalError('Cannot expand "' + OriginalCnst + '" constant on this version of Windows');
- end
- else if Cnst = 'dotnet40' then Result := GetDotNetVersionInstallRoot(InstallDefaultRegView, netbase40)
- else if Cnst = 'dotnet4032' then Result := GetDotNetVersionInstallRoot(rv32Bit, netbase40)
- else if Cnst = 'dotnet4064' then begin
- if IsWin64 then
- Result := GetDotNetVersionInstallRoot(rv64Bit, netbase40)
- else
- InternalError('Cannot expand "' + OriginalCnst + '" constant on this version of Windows');
- end
- else if (Cnst <> '') and (Cnst[1] = '%') then Result := ExpandEnvConst(Cnst)
- else if StrLComp(PChar(Cnst), 'reg:', 4) = 0 then Result := ExpandRegConst(Cnst)
- else if StrLComp(PChar(Cnst), 'ini:', 4) = 0 then Result := ExpandIniConst(Cnst)
- else if StrLComp(PChar(Cnst), 'param:', 6) = 0 then Result := ExpandParamConst(Cnst)
- else if StrLComp(PChar(Cnst), 'code:', 5) = 0 then Result := ExpandCodeConst(Cnst)
- else if StrLComp(PChar(Cnst), 'drive:', 6) = 0 then Result := ExpandDriveConst(Cnst)
- else if StrLComp(PChar(Cnst), 'cm:', 3) = 0 then Result := ExpandCustomMessageConst(Cnst)
- else begin
- { Shell folder constants }
- if Cnst <> '' then
- for Common := False to True do
- for ShellFolderID := Low(ShellFolderID) to High(ShellFolderID) do
- if Cnst = FolderConsts[Common, ShellFolderID] then begin
- ShellFolder := GetShellFolder(Common, ShellFolderID);
- if ShellFolder = '' then
- InternalError(Format('Failed to expand shell folder constant "%s"', [OriginalCnst]));
- Result := ShellFolder;
- Exit;
- end;
- { Custom constants }
- if Cnst <> '' then begin
- I := 0;
- while I < High(CustomConsts) do begin
- if Cnst = CustomConsts[I] then begin
- Result := CustomConsts[I+1];
- Exit;
- end;
- Inc(I, 2);
- end;
- end;
- { Unknown constant }
- InternalError(Format('Unknown constant "%s"', [OriginalCnst]));
- end;
- end;
- function ExpandConst(const S: String): String;
- begin
- Result := ExpandConstEx2(S, [''], True);
- end;
- function ExpandConstEx(const S: String; const CustomConsts: array of String): String;
- begin
- Result := ExpandConstEx2(S, CustomConsts, True);
- end;
- function ExpandConstEx2(const S: String; const CustomConsts: array of String;
- const DoExpandIndividualConst: Boolean): String;
- var
- I, Start: Integer;
- Cnst, ReplaceWith: String;
- begin
- Result := S;
- I := 1;
- while I <= Length(Result) do begin
- if Result[I] = '{' then begin
- if (I < Length(Result)) and (Result[I+1] = '{') then begin
- { Change '{{' to '{' if not in an embedded constant }
- Inc(I);
- Delete(Result, I, 1);
- end
- else begin
- Start := I;
- { Find the closing brace, skipping over any embedded constants }
- I := SkipPastConst(Result, I);
- if I = 0 then { unclosed constant? }
- InternalError('Unclosed constant');
- Dec(I); { 'I' now points to the closing brace }
- if DoExpandIndividualConst then begin
- { Now translate the constant }
- Cnst := Copy(Result, Start+1, I-(Start+1));
- ReplaceWith := ExpandIndividualConst(Cnst, CustomConsts);
- Delete(Result, Start, (I+1)-Start);
- Insert(ReplaceWith, Result, Start);
- I := Start + Length(ReplaceWith);
- if (ReplaceWith <> '') and (PathLastChar(ReplaceWith)^ = '\') and
- (I <= Length(Result)) and (Result[I] = '\') then
- Delete(Result, I, 1);
- end else
- Inc(I); { Skip closing brace }
- end;
- end
- else
- Inc(I);
- end;
- end;
- function ExpandConstIfPrefixed(const S: String): String;
- const
- ExpandPrefix = 'expand:';
- begin
- if Pos(ExpandPrefix, S) = 1 then begin
- Inc(DisableCodeConsts);
- try
- Result := ExpandConst(Copy(S, Length(ExpandPrefix)+1, Maxint));
- finally
- Dec(DisableCodeConsts);
- end;
- end
- else
- Result := S;
- end;
- procedure InitMainNonSHFolderConsts;
- function GetPath(const RegView: TRegView; const Name: PChar): String;
- var
- H: HKEY;
- begin
- if RegOpenKeyExView(RegView, HKEY_LOCAL_MACHINE, REGSTR_PATH_SETUP, 0,
- KEY_QUERY_VALUE, H) = ERROR_SUCCESS then begin
- if not RegQueryStringValue(H, Name, Result) then
- Result := '';
- RegCloseKey(H);
- end
- else
- Result := '';
- end;
- procedure ReadSysUserInfo;
- var
- RegView: TRegView;
- K: HKEY;
- begin
- { Windows 7 x64 (and later?) is bugged: the owner and organization
- are set to "Microsoft" on the 32-bit key. So on 64-bit Windows, read
- from the 64-bit key. (The bug doesn't exist on 64-bit XP or Server 2003,
- but it's safe to read the 64-bit key on those versions too.) }
- if IsWin64 then
- RegView := rv64Bit
- else
- RegView := rvDefault;
- if RegOpenKeyExView(RegView, HKEY_LOCAL_MACHINE, 'SOFTWARE\Microsoft\Windows NT\CurrentVersion',
- 0, KEY_QUERY_VALUE, K) = ERROR_SUCCESS then begin
- RegQueryStringValue(K, 'RegisteredOwner', SysUserInfoName);
- RegQueryStringValue(K, 'RegisteredOrganization', SysUserInfoOrg);
- RegCloseKey(K);
- end;
- end;
- begin
- { Read Windows and Windows System dirs }
- WinDir := GetWinDir;
- WinSystemDir := GetSystemDir;
- WinSysWow64Dir := GetSysWow64Dir;
- WinSysNativeDir := GetSysNativeDir(IsWin64);
- { Get system drive }
- SystemDrive := GetEnv('SystemDrive'); {don't localize}
- if SystemDrive = '' then begin
- SystemDrive := PathExtractDrive(WinDir);
- if SystemDrive = '' then
- { In some rare case that PathExtractDrive failed, just default to C }
- SystemDrive := 'C:';
- end;
- { Get 32-bit Program Files and Common Files dirs }
- ProgramFiles32Dir := GetPath(rv32Bit, 'ProgramFilesDir');
- if ProgramFiles32Dir = '' then
- ProgramFiles32Dir := SystemDrive + '\Program Files'; {don't localize}
- CommonFiles32Dir := GetPath(rv32Bit, 'CommonFilesDir');
- if CommonFiles32Dir = '' then
- CommonFiles32Dir := AddBackslash(ProgramFiles32Dir) + 'Common Files'; {don't localize}
- { Get 64-bit Program Files and Common Files dirs }
- if IsWin64 then begin
- ProgramFiles64Dir := GetPath(rv64Bit, 'ProgramFilesDir');
- if ProgramFiles64Dir = '' then
- InternalError('Failed to get path of 64-bit Program Files directory');
- CommonFiles64Dir := GetPath(rv64Bit, 'CommonFilesDir');
- if CommonFiles64Dir = '' then
- InternalError('Failed to get path of 64-bit Common Files directory');
- end;
- { Get path of command interpreter }
- CmdFilename := AddBackslash(WinSystemDir) + 'cmd.exe';
- { Get user info from system }
- ReadSysUserInfo;
- end;
- procedure SaveStreamToTempFile(const Strm: TCustomMemoryStream;
- const Filename: String);
- var
- ErrorCode: DWORD;
- begin
- try
- Strm.SaveToFile(Filename);
- except
- { Display more useful error message than 'Stream write error' etc. }
- on EStreamError do begin
- ErrorCode := GetLastError;
- raise Exception.Create(FmtSetupMessage(msgLastErrorMessage,
- [SetupMessages[msgLdrCannotCreateTemp], IntToStr(ErrorCode),
- Win32ErrorString(ErrorCode)]));
- end;
- end;
- end;
- procedure SaveResourceToTempFile(const ResName, Filename: String);
- var
- ResStrm: TResourceStream;
- begin
- ResStrm := TResourceStream.Create(HInstance, ResName, RT_RCDATA);
- try
- SaveStreamToTempFile(ResStrm, Filename);
- finally
- ResStrm.Free;
- end;
- end;
- procedure CreateTempInstallDirAndExtract64BitHelper;
- { Initializes TempInstallDir and extracts the 64-bit helper into it if needed.
- This is called by Setup, Uninstall, and RegSvr. }
- begin
- var Protected: Boolean;
- TempInstallDir := CreateTempDir(IsAdmin and not Debugging, Protected);
- LogFmt('Created %stemporary directory: %s', [IfThen(Protected, 'protected ', ''), TempInstallDir]);
- if Debugging then
- DebugNotifyTempDir(TempInstallDir);
- { Create _isetup subdirectory to hold our internally-used files to ensure
- they won't use any DLLs the install creator might've dumped into
- TempInstallDir }
- var Subdir := AddBackslash(TempInstallDir) + '_isetup';
- if not CreateDirectory(PChar(Subdir), nil) then begin
- var ErrorCode := GetLastError;
- raise Exception.Create(FmtSetupMessage(msgLastErrorMessage,
- [FmtSetupMessage1(msgErrorCreatingDir, Subdir), IntToStr(ErrorCode),
- Win32ErrorString(ErrorCode)]));
- end;
- { Extract 64-bit helper EXE, if one is available for the current processor
- architecture }
- var ResName := GetHelperResourceName;
- if ResName <> '' then begin
- var Filename := Subdir + '\_setup64.tmp';
- SaveResourceToTempFile(ResName, Filename);
- SetHelperExeFilename(Filename);
- end;
- end;
- function TempDeleteFileProc(const DisableFsRedir: Boolean;
- const FileName: String; const Param: Pointer): Boolean;
- var
- Elapsed: DWORD;
- label Retry;
- begin
- Retry:
- Result := DeleteFileRedir(DisableFsRedir, FileName);
- if not Result and
- (GetLastError <> ERROR_FILE_NOT_FOUND) and
- (GetLastError <> ERROR_PATH_NOT_FOUND) then begin
- { If we get here, the file is probably still in use. On an SMP machine,
- it's possible for an EXE to remain locked by Windows for a short time
- after it terminates, causing DeleteFile to fail with ERROR_ACCESS_DENIED.
- (I'm not sure this issue can really be seen here in practice; I could
- only reproduce it consistently by calling DeleteFile() *immediately*
- after waiting on the process handle.)
- Retry if fewer than 2 seconds have passed since DelTree started,
- otherwise assume the error must be permanent and give up. 2 seconds
- ought to be more than enough for the SMP case. }
- Elapsed := GetTickCount - DWORD(Param);
- if Cardinal(Elapsed) < Cardinal(2000) then begin
- Sleep(50);
- goto Retry;
- end;
- end;
- end;
- procedure RemoveTempInstallDir;
- { Removes TempInstallDir and all its contents. Stops the 64-bit helper first
- if necessary. }
- begin
- { Stop 64-bit helper if it's running }
- StopHelper(False);
- SetHelperExeFilename('');
- if TempInstallDir <> '' then begin
- if Debugging then
- DebugNotifyTempDir('');
- if not DelTree(False, TempInstallDir, True, True, True, False, nil,
- TempDeleteFileProc, Pointer(GetTickCount())) then
- Log('Failed to remove temporary directory: ' + TempInstallDir);
- end;
- end;
- procedure LoadSHFolderDLL;
- var
- Filename: String;
- const
- shfolder = 'shfolder.dll';
- begin
- Filename := AddBackslash(GetSystemDir) + shfolder;
- { Ensure shell32.dll is pre-loaded so it isn't loaded/freed for each
- individual SHGetFolderPath call }
- SafeLoadLibrary(AddBackslash(GetSystemDir) + shell32, SEM_NOOPENFILEERRORBOX);
- SHFolderDLLHandle := SafeLoadLibrary(Filename, SEM_NOOPENFILEERRORBOX);
- if SHFolderDLLHandle = 0 then
- InternalError(Format('Failed to load DLL "%s"', [Filename]));
- @SHGetFolderPathFunc := GetProcAddress(SHFolderDLLHandle, 'SHGetFolderPathW');
- if @SHGetFolderPathFunc = nil then
- InternalError('Failed to get address of SHGetFolderPath function');
- end;
- procedure UnloadSHFolderDLL;
- begin
- @SHGetFolderPathFunc := nil;
- if SHFolderDLLHandle <> 0 then begin
- FreeLibrary(SHFolderDLLHandle);
- SHFolderDLLHandle := 0;
- end;
- end;
- function GetShellFolderByCSIDL(Folder: Integer; const Create: Boolean): String;
- const
- CSIDL_FLAG_CREATE = $8000;
- SHGFP_TYPE_CURRENT = 0;
- var
- Res: HRESULT;
- Buf: array[0..MAX_PATH-1] of Char;
- begin
- { Note: Must pass Create=True or else SHGetFolderPath fails if the
- specified CSIDL is valid but doesn't currently exist. }
- if Create then
- Folder := Folder or CSIDL_FLAG_CREATE;
- { Work around a nasty bug in Windows Vista and Windows Server 2008 and maybe
- later versions also: When a folder ID resolves to the root directory of a
- drive ('X:\') and the CSIDL_FLAG_CREATE flag is passed, SHGetFolderPath
- fails with code 0x80070005.
- So, first try calling the function without CSIDL_FLAG_CREATE.
- If and only if that fails, call it again with the flag.
- Note: The calls *must* be issued in this order; if it's called with the
- flag first, it seems to permanently cache the failure code, causing future
- calls that don't include the flag to fail as well. }
- if Folder and CSIDL_FLAG_CREATE <> 0 then
- Res := SHGetFolderPathFunc(0, Folder and not CSIDL_FLAG_CREATE, 0,
- SHGFP_TYPE_CURRENT, Buf)
- else
- Res := E_FAIL; { always issue the call below }
- if Res <> S_OK then
- Res := SHGetFolderPathFunc(0, Folder, 0, SHGFP_TYPE_CURRENT, Buf);
- if Res = S_OK then
- Result := RemoveBackslashUnlessRoot(PathExpand(Buf))
- else begin
- Result := '';
- LogFmt('Warning: SHGetFolderPath failed with code 0x%.8x on folder 0x%.4x',
- [Res, Folder]);
- end;
- end;
- function GetShellFolderByGUID(Folder: TGUID; const Create: Boolean): String;
- begin
- if Assigned(SHGetKnownFolderPathFunc) then begin
- var dwFlags: DWORD := 0;
- if Create then
- dwFlags := dwFlags or KF_FLAG_CREATE;
- var Path: PWideChar;
- { Note: Must pass Create=True or else SHGetKnownFolderPath fails if the
- specified GUID is valid but doesn't currently exist. }
- var Res := SHGetKnownFolderPathFunc(Folder, dwFlags, 0, Path);
- if Res = S_OK then begin
- Result := WideCharToString(Path);
- CoTaskMemFree(Path);
- end else begin
- Result := '';
- LogFmt('Warning: SHGetKnownFolderPath failed with code 0x%.8x', [Res]);
- end;
- end else
- Result := '';
- end;
- function GetShellFolder(const Common: Boolean; const ID: TShellFolderID): String;
- const
- CSIDL_COMMON_STARTMENU = $0016;
- CSIDL_COMMON_PROGRAMS = $0017;
- CSIDL_COMMON_STARTUP = $0018;
- CSIDL_COMMON_DESKTOPDIRECTORY = $0019;
- CSIDL_APPDATA = $001A;
- CSIDL_LOCAL_APPDATA = $001C;
- CSIDL_COMMON_FAVORITES = $001F;
- CSIDL_COMMON_APPDATA = $0023;
- CSIDL_COMMON_TEMPLATES = $002D;
- CSIDL_COMMON_DOCUMENTS = $002E;
- FolderIDs: array[Boolean, TShellFolderID] of Integer = (
- { Values must match FolderConsts }
- { User }
- (CSIDL_DESKTOPDIRECTORY, CSIDL_STARTMENU, CSIDL_PROGRAMS, CSIDL_STARTUP,
- CSIDL_SENDTO, CSIDL_FONTS, CSIDL_APPDATA, CSIDL_PERSONAL,
- CSIDL_TEMPLATES, CSIDL_FAVORITES, CSIDL_LOCAL_APPDATA, 0, 0, 0),
- { Common }
- (CSIDL_COMMON_DESKTOPDIRECTORY, CSIDL_COMMON_STARTMENU, CSIDL_COMMON_PROGRAMS, CSIDL_COMMON_STARTUP,
- CSIDL_SENDTO, CSIDL_FONTS, CSIDL_COMMON_APPDATA, CSIDL_COMMON_DOCUMENTS,
- CSIDL_COMMON_TEMPLATES, CSIDL_COMMON_FAVORITES, 0, 0, 0, 0));
- FOLDERID_UserProgramFiles: TGUID = (D1:$5CD7AEE2; D2:$2219; D3:$4A67; D4:($B8,$5D,$6C,$9C,$E1,$56,$60,$CB));
- FOLDERID_UserProgramFilesCommon: TGUID = (D1:$BCBD3057; D2:$CA5C; D3:$4622; D4:($B4,$2D,$BC,$56,$DB,$0A,$E5,$16));
- FOLDERID_SavedGames: TGUID = (D1:$4C5C32FF; D2:$BB9D; D3:$43B0; D4:($B5,$B4,$2D,$72,$E5,$4E,$AA,$A4));
- var
- ShellFolder: String;
- begin
- if not ShellFoldersRead[Common, ID] then begin
- if ID = sfUserProgramFiles then
- ShellFolder := GetShellFolderByGUID(FOLDERID_UserProgramFiles, True)
- else if ID = sfUserCommonFiles then
- ShellFolder := GetShellFolderByGUID(FOLDERID_UserProgramFilesCommon, True)
- else if ID = sfUserSavedGames then
- ShellFolder := GetShellFolderByGUID(FOLDERID_SavedGames, True)
- else
- ShellFolder := GetShellFolderByCSIDL(FolderIDs[Common, ID], True);
- ShellFolders[Common, ID] := ShellFolder;
- ShellFoldersRead[Common, ID] := True;
- end;
- Result := ShellFolders[Common, ID];
- end;
- function InstallOnThisVersion(const MinVersion: TSetupVersionData;
- const OnlyBelowVersion: TSetupVersionData): TInstallOnThisVersionResult;
- var
- Ver, Ver2, MinVer, OnlyBelowVer: Cardinal;
- begin
- Ver := WindowsVersion;
- MinVer := MinVersion.NTVersion;
- OnlyBelowVer := OnlyBelowVersion.NTVersion;
- Result := irInstall;
- if MinVer = 0 then
- Result := irNotOnThisPlatform
- else begin
- if Ver < MinVer then
- Result := irVersionTooLow
- else if (LongRec(Ver).Hi = LongRec(MinVer).Hi) and
- (NTServicePackLevel < MinVersion.NTServicePack) then
- Result := irServicePackTooLow
- else begin
- if OnlyBelowVer <> 0 then begin
- Ver2 := Ver;
- { A build number of 0 on OnlyBelowVersion means 'match any build' }
- if LongRec(OnlyBelowVer).Lo = 0 then
- Ver2 := Ver2 and $FFFF0000; { set build number to zero on Ver2 also }
- { Note: When OnlyBelowVersion includes a service pack level, the
- version number test changes from a "<" to "<=" operation. Thus,
- on Windows 2000 SP4, 5.0 and 5.0.2195 will fail, but 5.0sp5 and
- 5.0.2195sp5 will pass. }
- if (Ver2 > OnlyBelowVer) or
- ((Ver2 = OnlyBelowVer) and
- (OnlyBelowVersion.NTServicePack = 0)) or
- ((LongRec(Ver).Hi = LongRec(OnlyBelowVer).Hi) and
- (OnlyBelowVersion.NTServicePack <> 0) and
- (NTServicePackLevel >= OnlyBelowVersion.NTServicePack)) then
- Result := irVerTooHigh;
- end;
- end;
- end;
- end;
- function GetSizeOfComponent(const ComponentName: String; const ExtraDiskSpaceRequired: Integer64): Integer64;
- var
- ComponentNameAsList: TStringList;
- FileEntry: PSetupFileEntry;
- I: Integer;
- begin
- Result := ExtraDiskSpaceRequired;
- ComponentNameAsList := TStringList.Create();
- try
- ComponentNameAsList.Add(ComponentName);
- for I := 0 to Entries[seFile].Count-1 do begin
- FileEntry := PSetupFileEntry(Entries[seFile][I]);
- with FileEntry^ do begin
- if (Components <> '') and
- ((Tasks = '') and (Check = '')) then begin {don't count tasks or scripted entries}
- if ShouldProcessFileEntry(ComponentNameAsList, nil, FileEntry, True) then begin
- if LocationEntry <> -1 then
- Inc6464(Result, PSetupFileLocationEntry(Entries[seFileLocation][LocationEntry])^.OriginalSize)
- else
- Inc6464(Result, ExternalSize);
- end;
- end;
- end;
- end;
- finally
- ComponentNameAsList.Free();
- end;
- end;
- function GetSizeOfType(const TypeName: String; const IsCustom: Boolean): Integer64;
- var
- ComponentTypes: TStringList;
- I: Integer;
- begin
- Result := To64(0);
- ComponentTypes := TStringList.Create();
- for I := 0 to Entries[seComponent].Count-1 do begin
- with PSetupComponentEntry(Entries[seComponent][I])^ do begin
- SetStringsFromCommaString(ComponentTypes, Types);
- { For custom types, only count fixed components. Otherwise count all. }
- if IsCustom then begin
- if (coFixed in Options) and ListContains(ComponentTypes, TypeName) then
- Inc6464(Result, Size);
- end else begin
- if ListContains(ComponentTypes, TypeName) then
- Inc6464(Result, Size);
- end;
- end;
- end;
- ComponentTypes.Free();
- end;
- function IsRecurseableDirectory(const FindData: TWin32FindData): Boolean;
- { Returns True if FindData is a directory that may be recursed into.
- Intended only for use when processing external+recursesubdirs file entries. }
- begin
- Result :=
- (FindData.dwFileAttributes and FILE_ATTRIBUTE_DIRECTORY <> 0) and
- (FindData.dwFileAttributes and FILE_ATTRIBUTE_HIDDEN = 0) and
- (StrComp(FindData.cFileName, '.') <> 0) and
- (StrComp(FindData.cFileName, '..') <> 0);
- end;
- type
- TEnumFilesProc = function(const DisableFsRedir: Boolean; const Filename: String;
- const Param: Pointer): Boolean;
- function DummyDeleteDirProc(const DisableFsRedir: Boolean; const Filename: String;
- const Param: Pointer): Boolean;
- begin
- { We don't actually want to delete the dir, so just return success. }
- Result := True;
- end;
- { Enumerates the files we're going to install and delete. Returns True on success.
- Likewise EnumFilesProc should return True on success and return False
- to break the enum and to cause EnumFiles to return False instead of True. }
- function EnumFiles(const EnumFilesProc: TEnumFilesProc;
- const WizardComponents, WizardTasks: TStringList; const Param: Pointer): Boolean;
- function RecurseExternalFiles(const DisableFsRedir: Boolean;
- const SearchBaseDir, SearchSubDir, SearchWildcard: String;
- const SourceIsWildcard: Boolean; const Excludes: TStrings; const CurFile: PSetupFileEntry): Boolean;
- begin
- { Also see RecurseExternalGetSizeOfFiles below and RecurseExternalCopyFiles in Setup.Install
- Also see RecurseExternalArchiveFiles directly below }
- Result := True;
- var FindData: TWin32FindData;
- var H := FindFirstFileRedir(DisableFsRedir, SearchBaseDir + SearchSubDir + SearchWildcard, FindData);
- if H <> INVALID_HANDLE_VALUE then begin
- try
- repeat
- if FindData.dwFileAttributes and FILE_ATTRIBUTE_DIRECTORY = 0 then begin
- if SourceIsWildcard then
- if FindData.dwFileAttributes and FILE_ATTRIBUTE_HIDDEN <> 0 then
- Continue;
- if IsExcluded(SearchSubDir + FindData.cFileName, Excludes) then
- Continue;
- { Note: CurFile^.DestName only includes a a filename if foCustomDestName is set,
- see TSetupCompiler.EnumFilesProc.ProcessFileList }
- var DestFile := ExpandConst(CurFile^.DestName);
- if not(foCustomDestName in CurFile^.Options) then
- DestFile := DestFile + SearchSubDir + FindData.cFileName
- else if SearchSubDir <> '' then
- DestFile := PathExtractPath(DestFile) + SearchSubDir + PathExtractName(DestFile);
- if not EnumFilesProc(DisableFsRedir, DestFile, Param) then begin
- Result := False;
- Exit;
- end;
- end;
- until not FindNextFile(H, FindData);
- finally
- Windows.FindClose(H);
- end;
- end;
- if foRecurseSubDirsExternal in CurFile^.Options then begin
- H := FindFirstFileRedir(DisableFsRedir, SearchBaseDir + SearchSubDir + '*', FindData);
- if H <> INVALID_HANDLE_VALUE then begin
- try
- repeat
- if IsRecurseableDirectory(FindData) then
- if not RecurseExternalFiles(DisableFsRedir, SearchBaseDir,
- SearchSubDir + FindData.cFileName + '\', SearchWildcard,
- SourceIsWildcard, Excludes, CurFile) then
- Exit(False);
- until not FindNextFile(H, FindData);
- finally
- Windows.FindClose(H);
- end;
- end;
- end;
- end;
- function RecurseExternalArchiveFiles(const DisableFsRedir: Boolean;
- const ArchiveFilename: String; const Excludes: TStrings;
- const CurFile: PSetupFileEntry): Boolean;
- begin
- { See above }
- Result := True;
- if not NewFileExistsRedir(DisableFsRedir, ArchiveFilename) then
- Exit;
- if foCustomDestName in CurFile^.Options then
- InternalError('Unexpected CustomDestName flag');
- const DestDir = ExpandConst(CurFile^.DestName);
- var FindData: TWin32FindData;
- var H := ArchiveFindFirstFileRedir(DisableFsRedir, ArchiveFilename, DestDir,
- ExpandConst(CurFile^.ExtractArchivePassword), foRecurseSubDirsExternal in CurFile^.Options,
- False, FindData);
- if H <> INVALID_HANDLE_VALUE then begin
- try
- repeat
- if FindData.dwFileAttributes and FILE_ATTRIBUTE_DIRECTORY = 0 then begin
- if IsExcluded(FindData.cFileName, Excludes) then
- Continue;
- const DestFile = DestDir + FindData.cFileName;
- if not EnumFilesProc(DisableFsRedir, DestFile, Param) then
- Exit(False);
- end;
- until not ArchiveFindNextFile(H, FindData);
- finally
- ArchiveFindClose(H);
- end;
- end;
- end;
- var
- I: Integer;
- CurFile: PSetupFileEntry;
- DisableFsRedir: Boolean;
- SourceWildcard: String;
- begin
- Result := True;
- { [Files] }
- const Excludes = TStringList.Create;
- try
- Excludes.StrictDelimiter := True;
- Excludes.Delimiter := ',';
- for I := 0 to Entries[seFile].Count-1 do begin
- CurFile := PSetupFileEntry(Entries[seFile][I]);
- if (CurFile^.FileType = ftUserFile) and
- ShouldProcessFileEntry(WizardComponents, WizardTasks, CurFile, False) then begin
- DisableFsRedir := ShouldDisableFsRedirForFileEntry(CurFile);
- if CurFile^.LocationEntry <> -1 then begin
- { Non-external file }
- if not EnumFilesProc(DisableFsRedir, ExpandConst(CurFile^.DestName), Param) then begin
- Result := False;
- Exit;
- end;
- end
- else begin
- { External file }
- if foDownload in CurFile^.Options then begin
- { Archive download should have been done already by Setup.WizardForm's DownloadArchivesToExtract }
- if foExtractArchive in CurFile^.Options then
- InternalError('Unexpected Download flag');
- if not(foCustomDestName in CurFile^.Options) then
- InternalError('Expected CustomDestName flag');
- { CurFile^.DestName now includes a filename, see TSetupCompiler.EnumFilesProc.ProcessFileList }
- if not EnumFilesProc(DisableFsRedir, ExpandConst(CurFile^.DestName), Param) then
- Exit(False);
- end else begin
- SourceWildcard := ExpandConst(CurFile^.SourceFilename);
- Excludes.DelimitedText := CurFile^.Excludes;
- if foExtractArchive in CurFile^.Options then begin
- try
- if not RecurseExternalArchiveFiles(DisableFsRedir, SourceWildcard,
- Excludes, CurFile) then
- Exit(False);
- except on E: ESevenZipError do
- { Ignore archive errors for now, will show up with proper UI during
- installation }
- end;
- end else begin
- if not RecurseExternalFiles(DisableFsRedir, PathExtractPath(SourceWildcard), '',
- PathExtractName(SourceWildcard), IsWildcard(SourceWildcard), Excludes, CurFile) then
- Exit(False);
- end;
- end;
- end;
- end;
- end;
- finally
- Excludes.Free;
- end;
- { [InstallDelete] }
- for I := 0 to Entries[seInstallDelete].Count-1 do
- with PSetupDeleteEntry(Entries[seInstallDelete][I])^ do
- if ShouldProcessEntry(WizardComponents, WizardTasks, Components, Tasks, Languages, Check) then begin
- case DeleteType of
- dfFiles, dfFilesAndOrSubdirs:
- if not DelTree(InstallDefaultDisableFsRedir, ExpandConst(Name), False, True, DeleteType = dfFilesAndOrSubdirs, True,
- DummyDeleteDirProc, EnumFilesProc, Param) then begin
- Result := False;
- Exit;
- end;
- dfDirIfEmpty:
- if not DelTree(InstallDefaultDisableFsRedir, ExpandConst(Name), True, False, False, True,
- DummyDeleteDirProc, EnumFilesProc, Param) then begin
- Result := False;
- Exit;
- end;
- end;
- end;
- end;
- procedure EnumProc(const Filename: String; Param: Pointer);
- begin
- TStringList(Param).Add(PathLowercase(Filename));
- end;
- var
- CheckForFileSL: TStringList;
- function CheckForFile(const DisableFsRedir: Boolean; const AFilename: String;
- const Param: Pointer): Boolean;
- var
- Filename: String;
- J: Integer;
- begin
- Filename := AFilename;
- if not DisableFsRedir then
- Filename := ReplaceSystemDirWithSysWow64(Filename);
- Filename := PathLowercase(Filename);
- for J := 0 to CheckForFileSL.Count-1 do begin
- if CheckForFileSL[J] = Filename then begin
- LogFmt('Found pending rename or delete that matches one of our files: %s', [Filename]);
- Result := False; { Break the enum, just need to know if any matches }
- Exit;
- end;
- end;
- Result := True; { Success! }
- end;
- { Checks if no file we're going to install or delete has a pending rename or delete. }
- function PreviousInstallCompleted(const WizardComponents, WizardTasks: TStringList): Boolean;
- begin
- Result := True;
- if Entries[seFile].Count = 0 then
- Exit;
- CheckForFileSL := TStringList.Create;
- try
- EnumFileReplaceOperationsFilenames(EnumProc, CheckForFileSL);
- if CheckForFileSL.Count = 0 then
- Exit;
- Result := EnumFiles(CheckForFile, WizardComponents, WizardTasks, nil);
- finally
- CheckForFileSL.Free;
- end;
- end;
- type
- TArrayOfPWideChar = array[0..(MaxInt div SizeOf(PWideChar))-1] of PWideChar;
- PArrayOfPWideChar = ^TArrayOfPWideChar;
- var
- RegisterFileBatchFilenames: PArrayOfPWideChar;
- RegisterFileFilenamesBatchMax, RegisterFileFilenamesBatchCount: Integer;
- function RegisterFile(const DisableFsRedir: Boolean; const AFilename: String;
- const Param: Pointer): Boolean;
- var
- Filename, Text: String;
- I, Len: Integer;
- CheckFilter, Match: Boolean;
- begin
- Filename := AFilename;
- { First: check filters and self. }
- if Filename <> '' then begin
- CheckFilter := Boolean(Param);
- if CheckFilter then begin
- Match := False;
- Text := PathLowercase(PathExtractName(Filename));
- for I := 0 to CloseApplicationsFilterList.Count-1 do begin
- if WildcardMatch(PChar(Text), PChar(CloseApplicationsFilterList[I])) then begin
- Match := True;
- Break;
- end;
- end;
- if Match then begin
- for I := 0 to CloseApplicationsFilterExcludesList.Count-1 do begin
- if WildcardMatch(PChar(Text), PChar(CloseApplicationsFilterExcludesList[I])) then begin
- Match := False;
- Break;
- end;
- end;
- end;
- if not Match then begin
- { No match with filter so exit but don't return an error. }
- Result := True;
- Exit;
- end;
- end;
- if PathCompare(Filename, SetupLdrOriginalFilename) = 0 then begin
- { Don't allow self to be registered but don't return an error. }
- Result := True;
- Exit;
- end;
- end;
- { Secondly: check if we need to register this batch, either because the batch is full
- or because we're done scanning and have leftovers. }
- if ((Filename <> '') and (RegisterFileFilenamesBatchCount = RegisterFileFilenamesBatchMax)) or
- ((Filename = '') and (RegisterFileFilenamesBatchCount > 0)) then begin
- if RmRegisterResources(RmSessionHandle, RegisterFileFilenamesBatchCount, RegisterFileBatchFilenames, 0, nil, 0, nil) = ERROR_SUCCESS then begin
- for I := 0 to RegisterFileFilenamesBatchCount-1 do
- FreeMem(RegisterFileBatchFilenames[I]);
- RegisterFileFilenamesBatchCount := 0;
- end else begin
- RmEndSession(RmSessionHandle);
- RmSessionStarted := False;
- end;
- end;
- { Finally: add this file to the batch. }
- if RmSessionStarted and (FileName <> '') then begin
- { From MSDN: "Installers should not disable file system redirection before calling
- the Restart Manager API. This means that a 32-bit installer run on 64-bit Windows
- is unable register a file in the %windir%\system32 directory." This is incorrect,
- we can register such files by using the Sysnative alias. }
- if DisableFsRedir then
- Filename := ReplaceSystemDirWithSysNative(Filename, IsWin64);
- if InitLogCloseApplications then
- LogFmt('Found a file to register with RestartManager: %s', [Filename]);
- Len := Length(Filename);
- GetMem(RegisterFileBatchFilenames[RegisterFileFilenamesBatchCount], (Len + 1) * SizeOf(RegisterFileBatchFilenames[RegisterFileFilenamesBatchCount][0]));
- StrPCopy(RegisterFileBatchFilenames[RegisterFileFilenamesBatchCount], Filename);
- Inc(RegisterFileFilenamesBatchCount);
- Inc(RmRegisteredFilesCount);
- end;
- Result := RmSessionStarted; { Break the enum if there was an error, else continue. }
- end;
- { Helper function for [Code] to register extra files. }
- var
- AllowCodeRegisterExtraCloseApplicationsResource: Boolean;
- function CodeRegisterExtraCloseApplicationsResource(const DisableFsRedir: Boolean; const AFilename: String): Boolean;
- begin
- if AllowCodeRegisterExtraCloseApplicationsResource then
- Result := RegisterFile(DisableFsRedir, AFilename, Pointer(False))
- else begin
- InternalError('Cannot call "RegisterExtraCloseApplicationsResource" function at this time');
- Result := False;
- end;
- end;
- { Register all files we're going to install or delete. Ends RmSession on errors. }
- procedure RegisterResourcesWithRestartManager(const WizardComponents, WizardTasks: TStringList);
- var
- I: Integer;
- begin
- { Note: MSDN says we shouldn't call RmRegisterResources for each file because of speed, but calling
- it once for all files adds extra memory usage, so calling it in batches. }
- RegisterFileFilenamesBatchMax := 1000;
- GetMem(RegisterFileBatchFilenames, RegisterFileFilenamesBatchMax * SizeOf(RegisterFileBatchFilenames[0]));
- try
- { Register our files. }
- RmRegisteredFilesCount := 0;
- try
- EnumFiles(RegisterFile, WizardComponents, WizardTasks, Pointer(True));
- except
- Log('EnumFiles(RegisterFile) raised an exception.');
- Application.HandleException(nil);
- end;
- { Ask [Code] for more files. }
- if CodeRunner <> nil then begin
- AllowCodeRegisterExtraCloseApplicationsResource := True;
- try
- try
- CodeRunner.RunProcedures('RegisterExtraCloseApplicationsResources', [''], False);
- except
- Log('RegisterExtraCloseApplicationsResources raised an exception.');
- Application.HandleException(nil);
- end;
- finally
- AllowCodeRegisterExtraCloseApplicationsResource := False;
- end;
- end;
- { Don't forget to register leftovers. }
- if RmSessionStarted then
- RegisterFile(False, '', nil);
- finally
- for I := 0 to RegisterFileFilenamesBatchCount-1 do
- FreeMem(RegisterFileBatchFilenames[I]);
- FreeMem(RegisterFileBatchFilenames);
- end;
- end;
- procedure DebugNotifyEntry(EntryType: TEntryType; Number: Integer);
- var
- Kind: TDebugEntryKind;
- B: Boolean;
- begin
- if not Debugging then Exit;
- case EntryType of
- seDir: Kind := deDir;
- seFile: Kind := deFile;
- seIcon: Kind := deIcon;
- seIni: Kind := deIni;
- seRegistry: Kind := deRegistry;
- seInstallDelete: Kind := deInstallDelete;
- seUninstallDelete: Kind := deUninstallDelete;
- seRun: Kind := deRun;
- seUninstallRun: Kind := deUninstallRun;
- else
- Exit;
- end;
- DebugNotify(Kind, Integer(OriginalEntryIndexes[EntryType][Number]), B);
- end;
- procedure CodeRunnerOnLog(const S: String);
- begin
- Log(S);
- end;
- procedure CodeRunnerOnLogFmt(const S: String; const Args: array of const);
- begin
- LogFmt(S, Args);
- end;
- procedure CodeRunnerOnDllImport(var DllName: String; var ForceDelayLoad: Boolean);
- var
- S, BaseName, FullName: String;
- FirstFile: Boolean;
- P: Integer;
- begin
- while True do begin
- if Pos('setup:', DllName) = 1 then begin
- if IsUninstaller then begin
- DllName := '';
- ForceDelayLoad := True;
- Exit;
- end;
- Delete(DllName, 1, Length('setup:'));
- end
- else if Pos('uninstall:', DllName) = 1 then begin
- if not IsUninstaller then begin
- DllName := '';
- ForceDelayLoad := True;
- Exit;
- end;
- Delete(DllName, 1, Length('uninstall:'));
- end
- else
- Break;
- end;
- if Pos('files:', DllName) = 1 then begin
- if IsUninstaller then begin
- { Uninstall doesn't do 'files:' }
- DllName := '';
- ForceDelayLoad := True;
- end
- else begin
- S := Copy(DllName, Length('files:')+1, Maxint);
- FirstFile := True;
- repeat
- P := ConstPos(',', S);
- if P = 0 then
- BaseName := S
- else begin
- BaseName := Copy(S, 1, P-1);
- Delete(S, 1, P);
- end;
- BaseName := ExpandConst((BaseName));
- FullName := AddBackslash(TempInstallDir) + BaseName;
- if not NewFileExists(FullName) then
- ExtractTemporaryFile(BaseName);
- if FirstFile then begin
- DllName := FullName;
- FirstFile := False;
- end;
- until P = 0;
- end;
- end
- else
- DllName := ExpandConst(DllName);
- end;
- function CodeRunnerOnDebug(const Position: LongInt;
- var ContinueStepOver: Boolean): Boolean;
- begin
- Result := DebugNotify(deCodeLine, Position, ContinueStepOver, CodeRunner.GetCallStack);
- end;
- function CodeRunnerOnDebugIntermediate(const Position: LongInt;
- var ContinueStepOver: Boolean): Boolean;
- begin
- Result := DebugNotifyIntermediate(deCodeLine, Position, ContinueStepOver);
- end;
- procedure CodeRunnerOnException(const Exception: AnsiString; const Position: LongInt);
- begin
- if Debugging then
- DebugNotifyException(String(Exception), deCodeLine, Position);
- end;
- procedure SetActiveLanguage(const I: Integer);
- { Activates the specified language }
- var
- LangEntry: PSetupLanguageEntry;
- J: Integer;
- begin
- if ActiveLanguage = I then
- Exit;
- LangEntry := Entries[seLanguage][I];
- AssignSetupMessages(LangEntry.Data[1], Length(LangEntry.Data));
- { Remove outdated < and > markers from the Back and Next buttons. Done here for now to avoid a Default.isl change. }
- StringChange(SetupMessages[msgButtonBack], '< ', '');
- StringChange(SetupMessages[msgButtonNext], ' >', '');
- ActiveLanguage := I;
- Finalize(LangOptions); { prevent leak on D2 }
- LangOptions := LangEntry^;
- if LangEntry.LicenseText <> '' then
- ActiveLicenseText := LangEntry.LicenseText
- else
- ActiveLicenseText := SetupHeader.LicenseText;
- if LangEntry.InfoBeforeText <> '' then
- ActiveInfoBeforeText := LangEntry.InfoBeforeText
- else
- ActiveInfoBeforeText := SetupHeader.InfoBeforeText;
- if LangEntry.InfoAfterText <> '' then
- ActiveInfoAfterText := LangEntry.InfoAfterText
- else
- ActiveInfoAfterText := SetupHeader.InfoAfterText;
- SetMessageBoxRightToLeft(LangOptions.RightToLeft);
- SetMessageBoxCaption(mbInformation, PChar(SetupMessages[msgInformationTitle]));
- SetMessageBoxCaption(mbConfirmation, PChar(SetupMessages[msgConfirmTitle]));
- SetMessageBoxCaption(mbError, PChar(SetupMessages[msgErrorTitle]));
- SetMessageBoxCaption(mbCriticalError, PChar(SetupMessages[msgErrorTitle]));
- Application.Title := SetupMessages[msgSetupAppTitle];
- for J := 0 to Entries[seType].Count-1 do begin
- with PSetupTypeEntry(Entries[seType][J])^ do begin
- case Typ of
- ttDefaultFull: Description := SetupMessages[msgFullInstallation];
- ttDefaultCompact: Description := SetupMessages[msgCompactInstallation];
- ttDefaultCustom: Description := SetupMessages[msgCustomInstallation];
- end;
- end;
- end;
- { Tell the first instance to change its language too. (It's possible for
- the first instance to display messages after Setup terminates, e.g. if it
- fails to restart the computer.) }
- if SetupNotifyWndPresent then
- SendNotifyMessage(SetupNotifyWnd, WM_USER + 150, 10001, I);
- end;
- function GetLanguageEntryProc(Index: Integer; var Entry: PSetupLanguageEntry): Boolean;
- begin
- Result := False;
- if Index < Entries[seLanguage].Count then begin
- Entry := Entries[seLanguage][Index];
- Result := True;
- end;
- end;
- procedure ActivateDefaultLanguage;
- { Auto-detects the most appropriate language and activates it.
- Also initializes the ShowLanguageDialog and MatchedLangParameter variables.
- Note: A like-named version of this function is also present in SetupLdr.dpr. }
- var
- I: Integer;
- begin
- MatchedLangParameter := False;
- case DetermineDefaultLanguage(GetLanguageEntryProc,
- SetupHeader.LanguageDetectionMethod, InitLang, I) of
- ddNoMatch: ShowLanguageDialog := (SetupHeader.ShowLanguageDialog <> slNo);
- ddMatch: ShowLanguageDialog := (SetupHeader.ShowLanguageDialog = slYes);
- else
- begin
- { ddMatchLangParameter }
- ShowLanguageDialog := False;
- MatchedLangParameter := True;
- end;
- end;
- SetActiveLanguage(I);
- end;
- procedure LogCompatibilityMode;
- var
- S: String;
- begin
- S := GetEnv('__COMPAT_LAYER');
- if S <> '' then
- LogFmt('Compatibility mode: %s (%s)', [SYesNo[True], S]);
- end;
- procedure LogWindowsVersion;
- function ArchitecturesToStr(const Architectures: TSetupProcessorArchitectures;
- const Separator: String): String;
- procedure AppendArchitecture(var S: String; const Separator, L: String);
- begin
- if S <> '' then
- S := S + Separator + L
- else
- S := L;
- end;
- var
- I: TSetupProcessorArchitecture;
- begin
- Result := '';
- for I := Low(I) to High(I) do
- if I in Architectures then
- AppendArchitecture(Result, Separator, SetupProcessorArchitectureNames[I]);
- end;
- var
- SP: String;
- begin
- if NTServicePackLevel <> 0 then begin
- SP := ' SP' + IntToStr(Hi(NTServicePackLevel));
- if Lo(NTServicePackLevel) <> 0 then
- SP := SP + '.' + IntToStr(Lo(NTServicePackLevel));
- end;
- LogFmt('Windows version: %u.%u.%u%s', [WindowsVersion shr 24,
- (WindowsVersion shr 16) and $FF, WindowsVersion and $FFFF, SP]);
- var Bits := 32;
- if IsWin64 then
- Bits := 64;
- LogFmt('Windows architecture: %s (%d-bit)', [SetupProcessorArchitectureNames[ProcessorArchitecture], Bits]);
- LogFmt('Machine types supported by system: %s', [ArchitecturesToStr(MachineTypesSupportedBySystem, ' ')]);
- if IsAdmin then
- Log('User privileges: Administrative')
- else if IsPowerUserOrAdmin then
- Log('User privileges: Power User')
- else
- Log('User privileges: None');
- end;
- function GetMessageBoxResultText(const AResult: Integer): String;
- begin
- case AResult of
- IDOK: Result := 'OK';
- IDCANCEL: Result := 'Cancel';
- IDABORT: Result := 'Abort';
- IDRETRY: Result := 'Retry';
- IDIGNORE: Result := 'Ignore';
- IDYES: Result := 'Yes';
- IDNO: Result := 'No';
- IDTRYAGAIN: Result := 'Try Again';
- IDCONTINUE: Result := 'Continue';
- else
- Result := IntToStr(AResult);
- end;
- end;
- function GetButtonsText(const Buttons: Cardinal): String;
- const
- { We don't use this type, but end users are liable to in [Code] }
- MB_CANCELTRYCONTINUE = $00000006;
- begin
- case Buttons and MB_TYPEMASK of
- MB_OK: Result := 'OK';
- MB_OKCANCEL: Result := 'OK/Cancel';
- MB_ABORTRETRYIGNORE: Result := 'Abort/Retry/Ignore';
- MB_YESNOCANCEL: Result := 'Yes/No/Cancel';
- MB_YESNO: Result := 'Yes/No';
- MB_RETRYCANCEL: Result := 'Retry/Cancel';
- MB_CANCELTRYCONTINUE: Result := 'Cancel/Try Again/Continue';
- else
- Result := IntToStr(Buttons and MB_TYPEMASK);
- end;
- end;
- procedure LogSuppressedMessageBox(const Text: PChar; const Buttons: Cardinal;
- const Default: Integer);
- begin
- Log(Format('Defaulting to %s for suppressed message box (%s):' + SNewLine,
- [GetMessageBoxResultText(Default), GetButtonsText(Buttons)]) + Text);
- end;
- procedure LogMessageBox(const Text: PChar; const Buttons: Cardinal);
- begin
- Log(Format('Message box (%s):' + SNewLine,
- [GetButtonsText(Buttons)]) + Text);
- end;
- function LoggedAppMessageBox(const Text, Caption: PChar; const Flags: Longint;
- const Suppressible: Boolean; const Default: Integer): Integer;
- begin
- if InitSuppressMsgBoxes and Suppressible then begin
- LogSuppressedMessageBox(Text, Flags, Default);
- Result := Default;
- end else begin
- LogMessageBox(Text, Flags);
- Result := AppMessageBox(Text, Caption, Flags);
- if Result <> 0 then
- LogFmt('User chose %s.', [GetMessageBoxResultText(Result)])
- else
- Log('AppMessageBox failed.');
- end;
- end;
- function LoggedMsgBox(const Text, Caption: String; const Typ: TMsgBoxType;
- const Buttons: Cardinal; const Suppressible: Boolean; const Default: Integer): Integer;
- begin
- if InitSuppressMsgBoxes and Suppressible then begin
- LogSuppressedMessageBox(PChar(Text), Buttons, Default);
- Result := Default;
- end else begin
- LogMessageBox(PChar(Text), Buttons);
- Result := MsgBox(Text, Caption, Typ, Buttons);
- if Result <> 0 then
- LogFmt('User chose %s.', [GetMessageBoxResultText(Result)])
- else
- Log('MsgBox failed.');
- end;
- end;
- function LoggedTaskDialogMsgBox(const Icon, Instruction, Text, Caption: String;
- const Typ: TMsgBoxType; const Buttons: Cardinal; const ButtonLabels: array of String;
- const ShieldButton: Integer; const Suppressible: Boolean; const Default: Integer;
- const VerificationText: String = ''; const pfVerificationFlagChecked: PBOOL = nil): Integer;
- begin
- if InitSuppressMsgBoxes and Suppressible then begin
- LogSuppressedMessageBox(PChar(Text), Buttons, Default);
- Result := Default;
- end else begin
- LogMessageBox(PChar(Text), Buttons);
- Result := TaskDialogMsgBox(Icon, Instruction, Text,
- Caption, Typ, Buttons, ButtonLabels, ShieldButton, VerificationText, pfVerificationFlagChecked);
- if Result <> 0 then begin
- LogFmt('User chose %s.', [GetMessageBoxResultText(Result)]);
- if pfVerificationFlagChecked <> nil then
- LogFmt('User chose %s for the verification.', [SYesNo[pfVerificationFlagChecked^]]);
- end else
- Log('TaskDialogMsgBox failed.');
- end;
- end;
- procedure RestartComputerFromThisProcess;
- begin
- RestartInitiatedByThisProcess := True;
- { Note: Depending on the OS, RestartComputer may not return if successful }
- if not RestartComputer then begin
- LoggedMsgBox(SetupMessages[msgErrorRestartingComputer], '', mbError,
- MB_OK, True, IDOK);
- end;
- end;
- procedure RespawnSetupElevated(const AParams: String);
- { Starts a new, elevated Setup(Ldr) process and waits until it terminates.
- Does not return; either calls Halt or raises an exception. }
- var
- Cancelled: Boolean;
- Server: TSpawnServer;
- ParamNotifyWnd: HWND;
- RespawnResults: record
- ExitCode: DWORD;
- NotifyRestartRequested: Boolean;
- NotifyNewLanguage: Integer;
- end;
- begin
- Cancelled := False;
- try
- Server := TSpawnServer.Create;
- try
- if SetupNotifyWndPresent then
- ParamNotifyWnd := SetupNotifyWnd
- else
- ParamNotifyWnd := Server.Wnd;
- RespawnSelfElevated(SetupLdrOriginalFilename,
- Format('/SPAWNWND=$%x /NOTIFYWND=$%x ', [Server.Wnd, ParamNotifyWnd]) +
- AParams, RespawnResults.ExitCode);
- RespawnResults.NotifyRestartRequested := Server.NotifyRestartRequested;
- RespawnResults.NotifyNewLanguage := Server.NotifyNewLanguage;
- finally
- Server.Free;
- end;
- except
- { If the user clicked Cancel on the dialog, halt with special exit code }
- if ExceptObject is EAbort then
- Cancelled := True
- else
- raise;
- end;
- if Cancelled then
- Halt(ecCancelledBeforeInstall);
- if not SetupNotifyWndPresent then begin
- { In the UseSetupLdr=no case, there is no notify window handle to pass to
- RespawnSelfElevated, so it hosts one itself. Process the results. }
- try
- if (RespawnResults.NotifyNewLanguage >= 0) and
- (RespawnResults.NotifyNewLanguage < Entries[seLanguage].Count) then
- SetActiveLanguage(RespawnResults.NotifyNewLanguage);
- if RespawnResults.NotifyRestartRequested then begin
- { Note: Depending on the OS, this may not return if successful }
- RestartComputerFromThisProcess;
- end;
- except
- { In the unlikely event that something above raises an exception, handle
- it here so the right exit code will still be returned below }
- Application.HandleException(nil);
- end;
- end;
- Halt(RespawnResults.ExitCode);
- end;
- procedure InitializeCommonVars;
- { Initializes variables shared between Setup and Uninstall }
- begin
- IsAdmin := IsAdminLoggedOn;
- IsPowerUserOrAdmin := IsAdmin or IsPowerUserLoggedOn;
- Randomize;
- end;
- procedure InitializeAdminInstallMode(const AAdminInstallMode: Boolean);
- { Initializes IsAdminInstallMode and other global variables that depend on it }
- const
- RootKeys: array[Boolean] of HKEY = (HKEY_CURRENT_USER, HKEY_LOCAL_MACHINE);
- begin
- LogFmt('Administrative install mode: %s', [SYesNo[AAdminInstallMode]]);
- IsAdminInstallMode := AAdminInstallMode;
- InstallModeRootKey := RootKeys[AAdminInstallMode];
- LogFmt('Install mode root key: %s', [GetRegRootKeyName(InstallModeRootKey)]);
- end;
- procedure Initialize64BitInstallMode(const A64BitInstallMode: Boolean);
- { Initializes Is64BitInstallMode and other global variables that depend on it }
- begin
- Is64BitInstallMode := A64BitInstallMode;
- InstallDefaultDisableFsRedir := A64BitInstallMode;
- ScriptFuncDisableFsRedir := A64BitInstallMode;
- if A64BitInstallMode then
- InstallDefaultRegView := rv64Bit
- else
- InstallDefaultRegView := rv32Bit;
- end;
- procedure Log64BitInstallMode;
- begin
- LogFmt('64-bit install mode: %s', [SYesNo[Is64BitInstallMode]]);
- end;
- var
- LoggedArchiveExtractionMode: Boolean;
- procedure LogArchiveExtractionModeOnce;
- begin
- if not LoggedArchiveExtractionMode then begin
- LogFmt('Archive extraction mode: %s',
- [IfThen(SetupHeader.SevenZipLibraryName <> '', Format('Using %s', [SetupHeader.SevenZipLibraryName]), 'Basic')]);
- LoggedArchiveExtractionMode := True;
- end;
- end;
- procedure InitializeSetup;
- { Initializes various vars used by the setup. This is called in the project
- source. }
- var
- DecompressorDLL, SevenZipDLL: TMemoryStream;
- function ExtractInt64(var S: String): Int64;
- begin
- const P = Pos(',', S);
- if P = 0 then
- raise Exception.Create('Error parsing command line: Missing comma');
- Result := StrToInt64Def(Copy(S, 1, P-1), -1);
- if Result < 0 then
- raise Exception.Create('Error parsing command line: Invalid value');
- Delete(S, 1, P);
- end;
- procedure AbortInit(const Msg: TSetupMessageID); overload;
- begin
- LoggedMsgBox(SetupMessages[Msg], '', mbCriticalError, MB_OK, True, IDOK);
- Abort;
- end;
- procedure AbortInit(const Msg: String); overload;
- begin
- LoggedMsgBox(Msg, '', mbCriticalError, MB_OK, True, IDOK);
- Abort;
- end;
- procedure AbortInitFmt1(const Msg: TSetupMessageID; const Arg1: String);
- begin
- LoggedMsgBox(FmtSetupMessage(Msg, [Arg1]), '', mbCriticalError, MB_OK, True, IDOK);
- Abort;
- end;
- procedure AbortInitServicePackRequired(const ServicePack: Word);
- begin
- LoggedMsgBox(FmtSetupMessage(msgWindowsServicePackRequired, ['Windows',
- IntToStr(Hi(ServicePack))]), '', mbCriticalError, MB_OK, True, IDOK);
- Abort;
- end;
- procedure ReadFileIntoStream(const Reader: TCompressedBlockReader; const Stream: TStream);
- type
- PBuffer = ^TBuffer;
- TBuffer = array[0..8191] of Byte;
- var
- Buf: PBuffer;
- BytesLeft, Bytes: Longint;
- begin
- New(Buf);
- try
- Reader.Read(BytesLeft, SizeOf(BytesLeft));
- while BytesLeft > 0 do begin
- Bytes := BytesLeft;
- if Bytes > SizeOf(Buf^) then Bytes := SizeOf(Buf^);
- Reader.Read(Buf^, Bytes);
- Stream.WriteBuffer(Buf^, Bytes);
- Dec(BytesLeft, Bytes);
- end;
- finally
- Dispose(Buf);
- end;
- end;
- function ReadWizardImage(const Reader: TCompressedBlockReader): TBitmap;
- begin
- const MemStream = TMemoryStream.Create;
- try
- ReadFileIntoStream(Reader, MemStream);
- MemStream.Seek(0, soFromBeginning);
- Result := TBitmap.Create;
- Result.AlphaFormat := TAlphaFormat(SetupHeader.WizardImageAlphaFormat);
- Result.LoadFromStream(MemStream);
- finally
- MemStream.Free;
- end;
- end;
- procedure LoadDecompressorDLL;
- var
- Filename: String;
- begin
- Filename := AddBackslash(TempInstallDir) + '_isetup\_isdecmp.dll';
- SaveStreamToTempFile(DecompressorDLL, Filename);
- FreeAndNil(DecompressorDLL);
- DecompressorDLLHandle := SafeLoadLibrary(Filename, SEM_NOOPENFILEERRORBOX);
- if DecompressorDLLHandle = 0 then
- InternalError(Format('Failed to load DLL "%s"', [Filename]));
- case SetupHeader.CompressMethod of
- cmZip:
- if not ZlibInitDecompressFunctions(DecompressorDLLHandle) then
- InternalError('ZlibInitDecompressFunctions failed');
- cmBzip:
- if not BZInitDecompressFunctions(DecompressorDLLHandle) then
- InternalError('BZInitDecompressFunctions failed');
- end;
- end;
- procedure LoadSevenZipDLL;
- var
- Filename: String;
- begin
- Filename := AddBackslash(TempInstallDir) + '_isetup\_is7z.dll';
- SaveStreamToTempFile(SevenZipDLL, Filename);
- FreeAndNil(SevenZipDLL);
- SevenZipDLLHandle := SafeLoadLibrary(Filename, SEM_NOOPENFILEERRORBOX);
- if SevenZipDLLHandle = 0 then
- InternalError(Format('Failed to load DLL "%s"', [Filename]))
- else begin
- var VersionNumbers: TFileVersionNumbers;
- if not GetVersionNumbers(Filename, VersionNumbers) then
- FillChar(VersionNumbers, SizeOf(VersionNumbers), 0);
- if not SevenZipDLLInit(SevenZipDLLHandle, VersionNumbers) then
- InternalError('SevenZipDLLInit failed');
- end;
- end;
- procedure ReadEntriesWithoutVersion(const Reader: TCompressedBlockReader;
- const EntryType: TEntryType; const Count: Integer; const Size: Integer);
- var
- I: Integer;
- P: Pointer;
- begin
- Entries[EntryType].Capacity := Count;
- for I := 0 to Count-1 do begin
- P := AllocMem(Size);
- SECompressedBlockRead(Reader, P^, Size, EntryStrings[EntryType],
- EntryAnsiStrings[EntryType]);
- Entries[EntryType].Add(P);
- end;
- end;
- procedure ReadEntries(Reader: TCompressedBlockReader; const EntryType: TEntryType;
- const Count: Integer; const Size: Integer; const MinVersionOfs, OnlyBelowVersionOfs: Integer);
- var
- I: Integer;
- P: Pointer;
- begin
- if Debugging then begin
- OriginalEntryIndexes[EntryType] := TList.Create;
- OriginalEntryIndexes[EntryType].Capacity := Count;
- end;
- Entries[EntryType].Capacity := Count;
- for I := 0 to Count-1 do begin
- P := AllocMem(Size);
- SECompressedBlockRead(Reader, P^, Size, EntryStrings[EntryType],
- EntryAnsiStrings[Entrytype]);
- if (MinVersionOfs = -1) or
- (InstallOnThisVersion(TSetupVersionData((@PByteArray(P)[MinVersionOfs])^),
- TSetupVersionData((@PByteArray(P)[OnlyBelowVersionOfs])^)) = irInstall) then begin
- Entries[EntryType].Add(P);
- if Debugging then
- OriginalEntryIndexes[EntryType].Add(Pointer(I));
- end
- else
- SEFreeRec(P, EntryStrings[EntryType], EntryAnsiStrings[EntryType]);
- end;
- end;
- function HandleInitPassword(const NeedPassword: Boolean): Boolean;
- { Handles InitPassword and returns the updated value of NeedPassword }
- { Also see WizardForm.CheckPassword }
- begin
- Result := NeedPassword;
- if NeedPassword and (InitPassword <> '') then begin
- var PasswordOk := False;
- var S := InitPassword;
- var CryptKey: TSetupEncryptionKey;
- GenerateEncryptionKey(S, SetupEncryptionHeader.KDFSalt, SetupEncryptionHeader.KDFIterations, CryptKey);
- if shPassword in SetupHeader.Options then
- PasswordOk := TestPassword(CryptKey, SetupEncryptionHeader.BaseNonce, SetupEncryptionHeader.PasswordTest);
- if not PasswordOk and (CodeRunner <> nil) then
- PasswordOk := CodeRunner.RunBooleanFunctions('CheckPassword', [S], bcTrue, False, PasswordOk);
- if PasswordOk then begin
- Result := False;
- if SetupEncryptionHeader.EncryptionUse = euFiles then
- FileExtractor.CryptKey := CryptKey;
- end;
- end;
- end;
- procedure SetupInstallMode;
- begin
- if InitVerySilent then
- InstallMode := imVerySilent
- else if InitSilent then
- InstallMode := imSilent;
- end;
- function RecurseExternalGetSizeOfFiles(const DisableFsRedir: Boolean;
- const SearchBaseDir, SearchSubDir, SearchWildcard: String;
- const SourceIsWildcard: Boolean; const Excludes: TStrings;
- const RecurseSubDirs: Boolean): Integer64;
- begin
- { Also see RecurseExternalFiles above and RecurseExternalCopyFiles in Setup.Install
- Also see RecurseExternalArchiveGetSizeOfFiles directly below }
- Result := To64(0);
- var FindData: TWin32FindData;
- var H := FindFirstFileRedir(DisableFsRedir, SearchBaseDir + SearchSubDir + SearchWildcard, FindData);
- if H <> INVALID_HANDLE_VALUE then begin
- repeat
- if FindData.dwFileAttributes and FILE_ATTRIBUTE_DIRECTORY = 0 then begin
- if SourceIsWildcard then
- if FindData.dwFileAttributes and FILE_ATTRIBUTE_HIDDEN <> 0 then
- Continue;
- if IsExcluded(SearchSubDir + FindData.cFileName, Excludes) then
- Continue;
- var I: Integer64;
- I.Hi := FindData.nFileSizeHigh;
- I.Lo := FindData.nFileSizeLow;
- Inc6464(Result, I);
- end;
- until not FindNextFile(H, FindData);
- Windows.FindClose(H);
- end;
- if RecurseSubDirs then begin
- H := FindFirstFileRedir(DisableFsRedir, SearchBaseDir + SearchSubDir + '*', FindData);
- if H <> INVALID_HANDLE_VALUE then begin
- try
- repeat
- if IsRecurseableDirectory(FindData) then begin
- var I := RecurseExternalGetSizeOfFiles(DisableFsRedir, SearchBaseDir,
- SearchSubDir + FindData.cFileName + '\', SearchWildcard,
- SourceIsWildcard, Excludes, RecurseSubDirs);
- Inc6464(Result, I);
- end;
- until not FindNextFile(H, FindData);
- finally
- Windows.FindClose(H);
- end;
- end;
- end;
- end;
- function RecurseExternalArchiveGetSizeOfFiles(const DisableFsRedir: Boolean;
- const ArchiveFilename, Password: String; const Excludes: TStrings;
- const RecurseSubDirs: Boolean): Integer64;
- begin
- { See above }
- Result := To64(0);
- if not NewFileExistsRedir(DisableFsRedir, ArchiveFilename) then
- Exit;
- var FindData: TWin32FindData;
- var H := ArchiveFindFirstFileRedir(DisableFsRedir, ArchiveFilename,
- AddBackslash(TempInstallDir), { DestDir isn't known yet, pass a placeholder }
- Password, RecurseSubDirs, False, FindData);
- if H <> INVALID_HANDLE_VALUE then begin
- try
- repeat
- if FindData.dwFileAttributes and FILE_ATTRIBUTE_DIRECTORY = 0 then begin
- if IsExcluded(FindData.cFileName, Excludes) then
- Continue;
- var I: Integer64;
- I.Hi := FindData.nFileSizeHigh;
- I.Lo := FindData.nFileSizeLow;
- Inc6464(Result, I);
- end;
- until not ArchiveFindNextFile(H, FindData);
- finally
- ArchiveFindClose(H);
- end;
- end;
- end;
-
- { Also see Install.pas }
- function ExistingInstallationAt(const RootKey: HKEY; const SubkeyName: String): Boolean;
- var
- K: HKEY;
- begin
- if RegOpenKeyExView(InstallDefaultRegView, RootKey, PChar(SubkeyName), 0, KEY_QUERY_VALUE, K) = ERROR_SUCCESS then begin
- Result := True;
- RegCloseKey(K);
- end else
- Result := False;
- end;
- procedure HandlePrivilegesRequiredOverrides(var ExtraRespawnParam: String);
- var
- ExistingAtAdminInstallMode, ExistingAtNonAdminInstallMode, DesireAnInstallMode, DesireAdminInstallMode: Boolean;
- SubkeyName, AppName: String;
- begin
- if HasInitPrivilegesRequired and (proCommandLine in SetupHeader.PrivilegesRequiredOverridesAllowed) then begin
- SetupHeader.PrivilegesRequired := InitPrivilegesRequired;
- { We don't need to set ExtraRespawnParam since the existing command line
- already contains the needed parameters and it will automatically be
- passed on to any respawned Setup(Ldr). }
- end else if proDialog in SetupHeader.PrivilegesRequiredOverridesAllowed then begin
- if shUsePreviousPrivileges in SetupHeader.Options then begin
- { Note: if proDialog is used and UsePreviousPrivileges is set to "yes"
- then the compiler does not allow AppId to include constants but we
- should still call ExpandConst to handle any '{{'. }
- SubkeyName := GetUninstallRegSubkeyName(GetUninstallRegKeyBaseName(ExpandConst(SetupHeader.AppID)));
- ExistingAtAdminInstallMode := ExistingInstallationAt(HKEY_LOCAL_MACHINE, SubkeyName);
- ExistingAtNonAdminInstallMode := ExistingInstallationAt(HKEY_CURRENT_USER, SubkeyName);
- end else begin
- ExistingAtAdminInstallMode := False;
- ExistingAtNonAdminInstallMode := False;
- end;
- DesireAnInstallMode := True;
- DesireAdminInstallMode := False; { Silence compiler }
- if ExistingAtAdminInstallMode and not ExistingAtNonAdminInstallMode then
- DesireAdminInstallMode := True
- else if not ExistingAtAdminInstallMode and ExistingAtNonAdminInstallMode then
- DesireAdminInstallMode := False
- else if not InitSuppressMsgBoxes then begin
- { Ask user. Doesn't log since logging hasn't started yet. Also doesn't
- use ExpandedAppName since it isn't set yet. Afterwards we need to tell
- any respawned Setup(Ldr) about the user choice (and avoid asking again).
- Will use the command line parameter for this. Allowing proDialog forces
- allowing proCommandLine, so we can count on the parameter to work. }
- if shAppNameHasConsts in SetupHeader.Options then
- AppName := PathChangeExt(PathExtractName(SetupLdrOriginalFilename), '')
- else
- AppName := SetupHeader.AppName;
- if SetupHeader.PrivilegesRequired = prLowest then begin
- case TaskDialogMsgBox('MAINICON', SetupMessages[msgPrivilegesRequiredOverrideInstruction],
- FmtSetupMessage(msgPrivilegesRequiredOverrideText2, [AppName]),
- SetupMessages[msgPrivilegesRequiredOverrideTitle], mbInformation, MB_YESNOCANCEL,
- [SetupMessages[msgPrivilegesRequiredOverrideCurrentUserRecommended], SetupMessages[msgPrivilegesRequiredOverrideAllUsers]], IDNO) of
- IDYES: DesireAdminInstallMode := False;
- IDNO: DesireAdminInstallMode := True;
- IDCANCEL: Abort;
- end;
- end else begin
- case TaskDialogMsgBox('MAINICON', SetupMessages[msgPrivilegesRequiredOverrideInstruction],
- FmtSetupMessage(msgPrivilegesRequiredOverrideText1, [AppName]),
- SetupMessages[msgPrivilegesRequiredOverrideTitle], mbInformation, MB_YESNOCANCEL,
- [SetupMessages[msgPrivilegesRequiredOverrideAllUsersRecommended], SetupMessages[msgPrivilegesRequiredOverrideCurrentUser]], IDYES) of
- IDYES: DesireAdminInstallMode := True;
- IDNO: DesireAdminInstallMode := False;
- IDCANCEL: Abort;
- end;
- end;
- end else
- DesireAnInstallMode := False; { No previous found and msgboxes are suppressed, just keep things as they are. }
- if DesireAnInstallMode then begin
- if DesireAdminInstallMode then begin
- SetupHeader.PrivilegesRequired := prAdmin;
- ExtraRespawnParam := '/ALLUSERS';
- end else begin
- SetupHeader.PrivilegesRequired := prLowest;
- ExtraRespawnParam := '/CURRENTUSER';
- end;
- end;
- end;
- end;
- var
- ParamName, ParamValue: String;
- ParamIsAutomaticInternal: Boolean;
- StartParam: Integer;
- I, N: Integer;
- IsRespawnedProcess, EnableLogging, WantToSuppressMsgBoxes, Res: Boolean;
- DebugServerWnd: HWND;
- LogFilename: String;
- SetupFilename: String;
- SetupFile: TFile;
- TestID: TSetupID;
- NameAndVersionMsg: String;
- NextAllowedLevel: Integer;
- LastShownComponentEntry, ComponentEntry: PSetupComponentEntry;
- MinimumTypeSpace: Integer64;
- SourceWildcard: String;
- ExpandedSetupMutex, ExtraRespawnParam, RespawnParams: String;
- begin
- InitializeCommonVars;
- { NewParamsForCode will hold all params except automatic internal ones like /SL5= and /DEBUGWND=
- Also see Uninstall.ProcessCommandLine }
- NewParamsForCode.Add(NewParamStr(0));
- { Based on SetupLdr or not?
- Parameters for launching SetupLdr-based installation are:
- /SL5="<handle to SetupLdr's notify window>,<setup 0 data offset>,
- <setup 1 data offset>,<original exe filename>"
- }
- SplitNewParamStr(1, ParamName, ParamValue);
- if CompareText(ParamName, '/SL5=') = 0 then begin
- StartParam := 2;
- SetupLdrMode := True;
- SetupNotifyWnd := UInt32(ExtractInt64(ParamValue));
- SetupNotifyWndPresent := True;
- SetupLdrOffset0 := ExtractInt64(ParamValue);
- SetupLdrOffset1 := ExtractInt64(ParamValue);
- SetupLdrOriginalFilename := ParamValue;
- end
- else begin
- StartParam := 1;
- SetupLdrOriginalFilename := NewParamStr(0);
- end;
- SourceDir := PathExtractDir(SetupLdrOriginalFilename);
- IsRespawnedProcess := False;
- EnableLogging := False;
- WantToSuppressMsgBoxes := False;
- DebugServerWnd := 0;
- for I := StartParam to NewParamCount do begin
- SplitNewParamStr(I, ParamName, ParamValue);
- ParamIsAutomaticInternal := False;
- if CompareText(ParamName, '/Log') = 0 then begin
- EnableLogging := True;
- LogFilename := '';
- end else if CompareText(ParamName, '/Log=') = 0 then begin
- EnableLogging := True;
- LogFilename := ParamValue;
- end else if CompareText(ParamName, '/Silent') = 0 then
- InitSilent := True
- else if CompareText(ParamName, '/VerySilent') = 0 then
- InitVerySilent := True
- else if CompareText(ParamName, '/NoRestart') = 0 then
- InitNoRestart := True
- else if CompareText(ParamName, '/CloseApplications') = 0 then
- InitCloseApplications := True
- else if CompareText(ParamName, '/NoCloseApplications') = 0 then
- InitNoCloseApplications := True
- else if CompareText(ParamName, '/ForceCloseApplications') = 0 then
- InitForceCloseApplications := True
- else if CompareText(ParamName, '/NoForceCloseApplications') = 0 then
- InitNoForceCloseApplications := True
- else if CompareText(ParamName, '/LogCloseApplications') = 0 then
- InitLogCloseApplications := True
- else if CompareText(ParamName, '/RestartApplications') = 0 then
- InitRestartApplications := True
- else if CompareText(ParamName, '/NoRestartApplications') = 0 then
- InitNoRestartApplications := True
- else if CompareText(ParamName, '/NoIcons') = 0 then
- InitNoIcons := True
- else if CompareText(ParamName, '/NoCancel') = 0 then
- InitNoCancel := True
- else if CompareText(ParamName, '/Lang=') = 0 then
- InitLang := ParamValue
- else if CompareText(ParamName, '/Type=') = 0 then
- InitSetupType := ParamValue
- else if CompareText(ParamName, '/Components=') = 0 then begin
- InitComponentsSpecified := True;
- SetStringsFromCommaString(InitComponents, SlashesToBackslashes(ParamValue));
- end else if CompareText(ParamName, '/Tasks=') = 0 then begin
- InitDeselectAllTasks := True;
- SetStringsFromCommaString(InitTasks, SlashesToBackslashes(ParamValue));
- end else if CompareText(ParamName, '/MergeTasks=') = 0 then begin
- InitDeselectAllTasks := False;
- SetStringsFromCommaString(InitTasks, SlashesToBackslashes(ParamValue));
- end else if CompareText(ParamName, '/LoadInf=') = 0 then
- InitLoadInf := PathExpand(ParamValue)
- else if CompareText(ParamName, '/SaveInf=') = 0 then
- InitSaveInf := PathExpand(ParamValue)
- else if CompareText(ParamName, '/DIR=') = 0 then
- InitDir := ParamValue
- else if CompareText(ParamName, '/GROUP=') = 0 then
- InitProgramGroup := ParamValue
- else if CompareText(ParamName, '/Password=') = 0 then
- InitPassword := ParamValue
- else if CompareText(ParamName, '/RestartExitCode=') = 0 then
- InitRestartExitCode := StrToIntDef(ParamValue, 0)
- else if CompareText(ParamName, '/SuppressMsgBoxes') = 0 then
- WantToSuppressMsgBoxes := True
- else if CompareText(ParamName, '/DETACHEDMSG') = 0 then { for debugging }
- DetachedUninstMsgFile := True
- else if CompareText(ParamName, '/SPAWNWND=') = 0 then begin
- ParamIsAutomaticInternal := True; { sent by RespawnSetupElevated }
- IsRespawnedProcess := True;
- InitializeSpawnClient(StrToInt(ParamValue));
- end else if CompareText(ParamName, '/NOTIFYWND=') = 0 then begin
- ParamIsAutomaticInternal := True; { sent by RespawnSetupElevated }
- { /NOTIFYWND= takes precedence over any previously set SetupNotifyWnd }
- SetupNotifyWnd := StrToInt(ParamValue);
- SetupNotifyWndPresent := True;
- end else if CompareText(ParamName, '/DebugSpawnServer') = 0 then { for debugging }
- EnterSpawnServerDebugMode { does not return }
- else if CompareText(ParamName, '/DEBUGWND=') = 0 then begin
- ParamIsAutomaticInternal := True; { sent by IDE.MainForm's StartProcess }
- DebugServerWnd := StrToInt(ParamValue);
- end else if CompareText(ParamName, '/ALLUSERS') = 0 then begin
- InitPrivilegesRequired := prAdmin;
- HasInitPrivilegesRequired := True;
- end else if CompareText(ParamName, '/CURRENTUSER') = 0 then begin
- InitPrivilegesRequired := prLowest;
- HasInitPrivilegesRequired := True;
- end;
- if not ParamIsAutomaticInternal then
- NewParamsForCode.Add(NewParamStr(I));
- end;
- if InitLoadInf <> '' then
- LoadInf(InitLoadInf, WantToSuppressMsgBoxes);
- if WantToSuppressMsgBoxes and (InitSilent or InitVerySilent) then
- InitSuppressMsgBoxes := True;
- { Assign some default messages that may be used before the messages are read }
- SetupMessages[msgSetupFileMissing] := SSetupFileMissing;
- SetupMessages[msgSetupFileCorrupt] := SSetupFileCorrupt;
- SetupMessages[msgSetupFileCorruptOrWrongVer] := SSetupFileCorruptOrWrongVer;
- { Read setup-0.bin, or from EXE }
- if not SetupLdrMode then begin
- SetupFilename := PathChangeExt(SetupLdrOriginalFilename, '') + '-0.bin';
- if not NewFileExists(SetupFilename) then
- AbortInitFmt1(msgSetupFileMissing, PathExtractName(SetupFilename));
- end
- else
- SetupFilename := SetupLdrOriginalFilename;
- SetupFile := TFile.Create(SetupFilename, fdOpenExisting, faRead, fsRead);
- try
- SetupFile.Seek(SetupLdrOffset0);
- if SetupFile.Read(TestID, SizeOf(TestID)) <> SizeOf(TestID) then
- AbortInit(msgSetupFileCorruptOrWrongVer);
- if TestID <> SetupID then
- AbortInit(msgSetupFileCorruptOrWrongVer);
- var SetupEncryptionHeaderCRC: Longint;
- SetupFile.Read(SetupEncryptionHeaderCRC, SizeOf(SetupEncryptionHeaderCRC));
- SetupFile.Read(SetupEncryptionHeader, SizeOf(SetupEncryptionHeader));
- if SetupEncryptionHeaderCRC <> GetCRC32(SetupEncryptionHeader, SizeOf(SetupEncryptionHeader)) then
- AbortInit(msgSetupFileCorruptOrWrongVer);
- var CryptKey: TSetupEncryptionKey;
- if SetupEncryptionHeader.EncryptionUse = euFull then begin
- if InitPassword = '' then
- AbortInit(SMissingPassword);
- GenerateEncryptionKey(InitPassword, SetupEncryptionHeader.KDFSalt, SetupEncryptionHeader.KDFIterations, CryptKey);
- if not TestPassword(CryptKey, SetupEncryptionHeader.BaseNonce, SetupEncryptionHeader.PasswordTest) then
- AbortInit(SIncorrectPassword);
- { FileExtractor (a function!) requires SetupHeader.CompressMethod to be set, so delaying setting
- FileExtractor.CryptKey until SetupHeader is read below }
- end;
- try
- var Reader := TCompressedBlockReader.Create(SetupFile, TLZMA1Decompressor);
- try
- if SetupEncryptionHeader.EncryptionUse = euFull then
- Reader.InitDecryption(CryptKey, SetupEncryptionHeader.BaseNonce, sccCompressedBlocks1);
- { Header }
- SECompressedBlockRead(Reader, SetupHeader, SizeOf(SetupHeader),
- SetupHeaderStrings, SetupHeaderAnsiStrings);
- if SetupEncryptionHeader.EncryptionUse = euFull then
- FileExtractor.CryptKey := CryptKey; { See above }
- { Language entries }
- ReadEntriesWithoutVersion(Reader, seLanguage, SetupHeader.NumLanguageEntries,
- SizeOf(TSetupLanguageEntry));
- { CustomMessage entries }
- ReadEntriesWithoutVersion(Reader, seCustomMessage, SetupHeader.NumCustomMessageEntries,
- SizeOf(TSetupCustomMessageEntry));
- { Permission entries }
- ReadEntriesWithoutVersion(Reader, sePermission, SetupHeader.NumPermissionEntries,
- SizeOf(TSetupPermissionEntry));
- { Type entries }
- ReadEntries(Reader, seType, SetupHeader.NumTypeEntries, SizeOf(TSetupTypeEntry),
- Integer(@PSetupTypeEntry(nil).MinVersion),
- Integer(@PSetupTypeEntry(nil).OnlyBelowVersion));
- ActivateDefaultLanguage;
- { Set Is64BitInstallMode if we're on Win64 and the processor architecture is
- one on which a "64-bit mode" install should be performed. Doing this early
- so that UsePreviousPrivileges knows where to look. Will log later. }
- if (SetupHeader.ArchitecturesInstallIn64BitMode <> '') and
- EvalExpression(SetupHeader.ArchitecturesInstallIn64BitMode, TDummyClass.EvalArchitectureIdentifier) then begin
- if not IsWin64 then begin
- { The script writer made a mistake: their expression matched a
- 32-bit system. Obviously that can't be allowed.
- With "not" there are lots of ways that could happen without
- explicitly specifying a 32-bit architecture in the expression.
- One example: "not win64" }
- InternalError('ArchitecturesInstallIn64BitMode expression matched 32-bit system');
- end;
- Initialize64BitInstallMode(True);
- end
- else
- Initialize64BitInstallMode(False);
-
- HandlePrivilegesRequiredOverrides(ExtraRespawnParam);
- { Start a new, elevated Setup(Ldr) process if needed }
- if not IsRespawnedProcess and
- NeedToRespawnSelfElevated(not (SetupHeader.PrivilegesRequired in [prNone, prLowest]),
- SetupHeader.PrivilegesRequired <> prLowest) then begin
- FreeAndNil(Reader);
- FreeAndNil(SetupFile);
- RespawnParams := GetCmdTailEx(StartParam);
- if ExtraRespawnParam <> '' then
- RespawnParams := RespawnParams + ' ' + ExtraRespawnParam;
- RespawnSetupElevated(RespawnParams);
- { Note: RespawnSetupElevated does not return; it either calls Halt
- or raises an exception. }
- end;
- { Application.Handle is now known to be the main window. Set the shutdown block reason. }
- ShutdownBlockReasonCreate(Application.Handle, SetupMessages[msgWizardInstalling]);
- { Initialize debug client (client=Setup, server=debugger/IDE) }
- if DebugServerWnd <> 0 then
- SetDebugServerWnd(DebugServerWnd, False);
- { Initialize logging }
- if EnableLogging or (shSetupLogging in SetupHeader.Options) then begin
- try
- if LogFilename = '' then
- StartLogging('Setup')
- else
- StartLoggingWithFixedFilename(LogFilename);
- except
- on E: Exception do begin
- E.Message := 'Error creating log file:' + SNewLine2 + E.Message;
- raise;
- end;
- end;
- end;
- Log('Setup version: ' + SetupTitle + ' version ' + SetupVersion);
- Log('Original Setup EXE: ' + SetupLdrOriginalFilename);
- Log('Setup command line: ' + GetCmdTail);
- LogCompatibilityMode;
- LogWindowsVersion;
- NeedPassword := (SetupEncryptionHeader.EncryptionUse <> euFull) and (shPassword in SetupHeader.Options);
- NeedSerial := False;
- NeedsRestart := shAlwaysRestart in SetupHeader.Options;
- { Component entries }
- ReadEntries(Reader, seComponent, SetupHeader.NumComponentEntries, SizeOf(TSetupComponentEntry),
- -1, -1);
- { Task entries }
- ReadEntries(Reader, seTask, SetupHeader.NumTaskEntries, SizeOf(TSetupTaskEntry),
- -1, -1);
- { Dir entries }
- ReadEntries(Reader, seDir, SetupHeader.NumDirEntries, SizeOf(TSetupDirEntry),
- Integer(@PSetupDirEntry(nil).MinVersion),
- Integer(@PSetupDirEntry(nil).OnlyBelowVersion));
- { ISSigKey entries }
- ReadEntriesWithoutVersion(Reader, seISSigKey, SetupHeader.NumISSigKeyEntries, SizeOf(TSetupISSigKeyEntry));
- { File entries }
- ReadEntries(Reader, seFile, SetupHeader.NumFileEntries, SizeOf(TSetupFileEntry),
- Integer(@PSetupFileEntry(nil).MinVersion),
- Integer(@PSetupFileEntry(nil).OnlyBelowVersion));
- { Icon entries }
- ReadEntries(Reader, seIcon, SetupHeader.NumIconEntries, SizeOf(TSetupIconEntry),
- Integer(@PSetupIconEntry(nil).MinVersion),
- Integer(@PSetupIconEntry(nil).OnlyBelowVersion));
- { INI entries }
- ReadEntries(Reader, seIni, SetupHeader.NumIniEntries, SizeOf(TSetupIniEntry),
- Integer(@PSetupIniEntry(nil).MinVersion),
- Integer(@PSetupIniEntry(nil).OnlyBelowVersion));
- { Registry entries }
- ReadEntries(Reader, seRegistry, SetupHeader.NumRegistryEntries, SizeOf(TSetupRegistryEntry),
- Integer(@PSetupRegistryEntry(nil).MinVersion),
- Integer(@PSetupRegistryEntry(nil).OnlyBelowVersion));
- { InstallDelete entries }
- ReadEntries(Reader, seInstallDelete, SetupHeader.NumInstallDeleteEntries, SizeOf(TSetupDeleteEntry),
- Integer(@PSetupDeleteEntry(nil).MinVersion),
- Integer(@PSetupDeleteEntry(nil).OnlyBelowVersion));
- { UninstallDelete entries }
- ReadEntries(Reader, seUninstallDelete, SetupHeader.NumUninstallDeleteEntries, SizeOf(TSetupDeleteEntry),
- Integer(@PSetupDeleteEntry(nil).MinVersion),
- Integer(@PSetupDeleteEntry(nil).OnlyBelowVersion));
- { Run entries }
- ReadEntries(Reader, seRun, SetupHeader.NumRunEntries, SizeOf(TSetupRunEntry),
- Integer(@PSetupRunEntry(nil).MinVersion),
- Integer(@PSetupRunEntry(nil).OnlyBelowVersion));
- { UninstallRun entries }
- ReadEntries(Reader, seUninstallRun, SetupHeader.NumUninstallRunEntries, SizeOf(TSetupRunEntry),
- Integer(@PSetupRunEntry(nil).MinVersion),
- Integer(@PSetupRunEntry(nil).OnlyBelowVersion));
- { Wizard images }
- Reader.Read(N, SizeOf(LongInt));
- for I := 0 to N-1 do
- WizardImages.Add(ReadWizardImage(Reader));
- Reader.Read(N, SizeOf(LongInt));
- for I := 0 to N-1 do
- WizardSmallImages.Add(ReadWizardImage(Reader));
- { Decompressor DLL }
- DecompressorDLL := nil;
- if SetupHeader.CompressMethod in [cmZip, cmBzip] then begin
- DecompressorDLL := TMemoryStream.Create;
- ReadFileIntoStream(Reader, DecompressorDLL);
- end;
- { SevenZip DLL }
- SevenZipDLL := nil;
- if SetupHeader.SevenZipLibraryName <> '' then begin
- SevenZipDLL := TMemoryStream.Create;
- ReadFileIntoStream(Reader, SevenZipDLL);
- end;
- finally
- Reader.Free;
- end;
- Reader := TCompressedBlockReader.Create(SetupFile, TLZMA1Decompressor);
- try
- if SetupEncryptionHeader.EncryptionUse = euFull then
- Reader.InitDecryption(CryptKey, SetupEncryptionHeader.BaseNonce, sccCompressedBlocks2);
- { File location entries }
- ReadEntriesWithoutVersion(Reader, seFileLocation, SetupHeader.NumFileLocationEntries,
- SizeOf(TSetupFileLocationEntry));
- finally
- Reader.Free;
- end;
- except
- on ECompressDataError do
- AbortInit(msgSetupFileCorrupt);
- end;
- finally
- SetupFile.Free;
- end;
-
- InitializeAdminInstallMode(IsAdmin and (SetupHeader.PrivilegesRequired <> prLowest));
- Log64BitInstallMode;
- { Show "Select Language" dialog if necessary - requires "64-bit mode" to be
- initialized else it might query the previous language from the wrong registry
- view }
- if Entries[seLanguage].Count > 1 then begin
- if ShowLanguageDialog and not InitSilent and not InitVerySilent then begin
- if not AskForLanguage then
- Abort;
- end else if not MatchedLangParameter and (shUsePreviousLanguage in SetupHeader.Options) then begin
- { Replicate the dialog's UsePreviousLanguage functionality. }
- { Note: if UsePreviousLanguage is set to "yes" then the compiler does not
- allow AppId to include constants but we should still call ExpandConst
- to handle any '{{'. }
- I := GetPreviousLanguage(ExpandConst(SetupHeader.AppId));
- if I <> -1 then
- SetActiveLanguage(I);
- end;
- end;
- { Check unsupported Itanium - must be on Windows Server 2008 R2 so remove once
- this becomes unsupported as well and Windows 8 (6.2+) becomes the new minimum }
- var SysInfo: TSystemInfo;
- GetNativeSystemInfo(SysInfo);
- if SysInfo.wProcessorArchitecture = PROCESSOR_ARCHITECTURE_IA64 then
- AbortInit(msgWindowsVersionNotSupported);
-
- { Check allowed processor architectures }
- if (SetupHeader.ArchitecturesAllowed <> '') and
- not EvalExpression(SetupHeader.ArchitecturesAllowed, TDummyClass.EvalArchitectureIdentifier) then
- AbortInit(msgWindowsVersionNotSupported);
- { Check Windows version }
- case InstallOnThisVersion(SetupHeader.MinVersion, SetupHeader.OnlyBelowVersion) of
- irInstall: ;
- irServicePackTooLow:
- AbortInitServicePackRequired(SetupHeader.MinVersion.NTServicePack);
- else
- AbortInit(msgWindowsVersionNotSupported);
- end;
- { Check if the user lacks the required privileges }
- case SetupHeader.PrivilegesRequired of
- prPowerUser:
- if not IsPowerUserOrAdmin then AbortInit(msgPowerUserPrivilegesRequired);
- prAdmin:
- if not IsAdmin then AbortInit(msgAdminPrivilegesRequired);
- end;
- { Init main constants, not depending on shfolder.dll/_shfoldr.dll }
- InitMainNonSHFolderConsts;
- { Create temporary directory and extract 64-bit helper EXE if necessary }
- CreateTempInstallDirAndExtract64BitHelper;
- { Load system's "shfolder.dll", and load it }
- LoadSHFolderDLL;
- { Save DecompressorDLL stream as "_isdecmp.dll" in TempInstallDir, and load it }
- if SetupHeader.CompressMethod in [cmZip, cmBzip] then
- LoadDecompressorDLL;
- { Save SevenZipDll stream as "_is7z.dll" in TempInstallDir, and load it }
- if SetupHeader.SevenZipLibraryName <> '' then
- LoadSevenZipDLL;
- { Start RestartManager session }
- if InitCloseApplications or
- ((shCloseApplications in SetupHeader.Options) and not InitNoCloseApplications) then begin
- InitRestartManagerLibrary;
- { Note from Old New Thing: "The RmStartSession function doesn't properly
- null-terminate the session key <...>. To work around this bug, we pre-fill
- the buffer with null characters <...>." Our key is pre-filled too since
- it's global. }
- if UseRestartManager and (RmStartSession(@RmSessionHandle, 0, RmSessionKey) = ERROR_SUCCESS) then begin
- RmSessionStarted := True;
- SetStringsFromCommaString(CloseApplicationsFilterList, SetupHeader.CloseApplicationsFilter);
- SetStringsFromCommaString(CloseApplicationsFilterExcludesList, SetupHeader.CloseApplicationsFilterExcludes);
- end;
- end;
- { Set install mode }
- SetupInstallMode;
- { Init ISSigAvailableKeys }
- SetLength(ISSigAvailableKeys, Entries[seISSigKey].Count);
- for I := 0 to Entries[seISSigKey].Count-1 do begin
- var ISSigKeyEntry := PSetupISSigKeyEntry(Entries[seISSigKey][I]);
- ISSigAvailableKeys[I] := TECDSAKey.Create;
- if ISSigImportPublicKey(ISSigAvailableKeys[I], '', ISSigKeyEntry.PublicX, ISSigKeyEntry.PublicY) <> ikrSuccess then
- InternalError('ISSigImportPublicKey failed')
- end;
- { Load and initialize code }
- if SetupHeader.CompiledCodeText <> '' then begin
- CodeRunner := TScriptRunner.Create();
- try
- CodeRunner.NamingAttribute := CodeRunnerNamingAttribute;
- CodeRunner.OnLog := CodeRunnerOnLog;
- CodeRunner.OnLogFmt := CodeRunnerOnLogFmt;
- CodeRunner.OnDllImport := CodeRunnerOnDllImport;
- CodeRunner.OnDebug := CodeRunnerOnDebug;
- CodeRunner.OnDebugIntermediate := CodeRunnerOnDebugIntermediate;
- CodeRunner.OnException := CodeRunnerOnException;
- CodeRunner.LoadScript(SetupHeader.CompiledCodeText, DebugClientCompiledCodeDebugInfo);
- if not NeedPassword then
- NeedPassword := CodeRunner.FunctionExists('CheckPassword', True);
- NeedPassword := HandleInitPassword(NeedPassword);
- if not NeedSerial then
- NeedSerial := CodeRunner.FunctionExists('CheckSerial', True);
- except
- { Don't let DeinitSetup see a partially-initialized CodeRunner }
- FreeAndNil(CodeRunner);
- raise;
- end;
- try
- Res := CodeRunner.RunBooleanFunctions('InitializeSetup', [''], bcFalse, False, True);
- except
- Log('InitializeSetup raised an exception (fatal).');
- raise;
- end;
- if not Res then begin
- Log('InitializeSetup returned False; aborting.');
- Abort;
- end;
- end
- else
- NeedPassword := HandleInitPassword(NeedPassword);
- { Expand AppName, AppVerName, and AppCopyright now since they're used often,
- especially by the background window painting. }
- ExpandedAppName := ExpandConst(SetupHeader.AppName);
- if SetupHeader.AppVerName <> '' then
- ExpandedAppVerName := ExpandConst(SetupHeader.AppVerName)
- else begin
- if not GetCustomMessageValue('NameAndVersion', NameAndVersionMsg) then
- NameAndVersionMsg := '%1 %2'; { just in case }
- ExpandedAppVerName := FmtMessage(PChar(NameAndVersionMsg),
- [ExpandedAppName, ExpandConst(SetupHeader.AppVersion)]);
- end;
- ExpandedAppCopyright := ExpandConst(SetupHeader.AppCopyright);
- ExpandedAppMutex := ExpandConst(SetupHeader.AppMutex);
- ExpandedSetupMutex := ExpandConst(SetupHeader.SetupMutex);
- { Update the shutdown block reason now that we have ExpandedAppName. }
- ShutdownBlockReasonCreate(Application.Handle,
- FmtSetupMessage1(msgShutdownBlockReasonInstallingApp, ExpandedAppName));
- { Check if app is running }
- while CheckForMutexes(ExpandedAppMutex) do
- if LoggedMsgBox(FmtSetupMessage1(msgSetupAppRunningError, ExpandedAppName),
- SetupMessages[msgSetupAppTitle], mbError, MB_OKCANCEL, True, IDCANCEL) <> IDOK then
- Abort;
- { Check if Setup is running and if not create mutexes }
- while CheckForMutexes(ExpandedSetupMutex) do
- if LoggedMsgBox(FmtSetupMessage1(msgSetupAppRunningError, SetupMessages[msgSetupAppTitle]),
- SetupMessages[msgSetupAppTitle], mbError, MB_OKCANCEL, True, IDCANCEL) <> IDOK then
- Abort;
- CreateMutexes(ExpandedSetupMutex);
- { Remove types that fail their 'languages' or 'check'. Can't do this earlier
- because the InitializeSetup call above can't be done earlier. }
- for I := 0 to Entries[seType].Count-1 do begin
- if not ShouldProcessEntry(nil, nil, '', '', PSetupTypeEntry(Entries[seType][I]).Languages, PSetupTypeEntry(Entries[seType][I]).CheckOnce) then begin
- SEFreeRec(Entries[seType][I], EntryStrings[seType], EntryAnsiStrings[seType]);
- { Don't delete it yet so that the entries can be processed sequentially }
- Entries[seType][I] := nil;
- end;
- end;
- { Delete the nil-ed items now }
- Entries[seType].Pack();
- { Remove components }
- NextAllowedLevel := 0;
- LastShownComponentEntry := nil;
- for I := 0 to Entries[seComponent].Count-1 do begin
- ComponentEntry := PSetupComponentEntry(Entries[seComponent][I]);
- if (ComponentEntry.Level <= NextAllowedLevel) and
- (InstallOnThisVersion(ComponentEntry.MinVersion, ComponentEntry.OnlyBelowVersion) = irInstall) and
- ShouldProcessEntry(nil, nil, '', '', ComponentEntry.Languages, ComponentEntry.CheckOnce) then begin
- NextAllowedLevel := ComponentEntry.Level + 1;
- LastShownComponentEntry := ComponentEntry;
- end
- else begin
- { Not showing }
- if Assigned(LastShownComponentEntry) and
- (ComponentEntry.Level = LastShownComponentEntry.Level) and
- (CompareText(ComponentEntry.Name, LastShownComponentEntry.Name) = 0) then begin
- { It's a duplicate of the last shown item. Leave NextAllowedLevel
- alone, so that any child items that follow can attach to the last
- shown item. }
- end
- else begin
- { Not a duplicate of the last shown item, so the next item must be
- at the same level or less }
- if NextAllowedLevel > ComponentEntry.Level then
- NextAllowedLevel := ComponentEntry.Level;
- { Clear LastShownComponentEntry so that no subsequent item can be
- considered a duplicate of it. Needed in this case:
- foo (shown)
- foo\childA (not shown)
- foo (not shown)
- foo\childB
- "foo\childB" should be hidden, not made a child of "foo" #1. }
- LastShownComponentEntry := nil;
- end;
- Entries[seComponent][I] := nil;
- SEFreeRec(ComponentEntry, EntryStrings[seComponent], EntryAnsiStrings[seComponent]);
- end;
- end;
- Entries[seComponent].Pack();
- { Set misc. variables }
- HasCustomType := False;
- for I := 0 to Entries[seType].Count-1 do begin
- if toIsCustom in PSetupTypeEntry(Entries[seType][I]).Options then begin
- HasCustomType := True;
- Break;
- end;
- end;
- HasComponents := Entries[seComponent].Count <> 0;
- HasIcons := Entries[seIcon].Count <> 0;
- HasTasks := Entries[seTask].Count <> 0;
- { Calculate minimum disk space. If there are setup types, find the smallest
- type and add the size of all files that don't belong to any component. Otherwise
- calculate minimum disk space by adding all of the file's sizes. Also for each
- "external" file, check the file size now, and store it the ExternalSize field
- of the TSetupFileEntry record, except if an ExternalSize was specified by the
- script. }
- MinimumSpace := SetupHeader.ExtraDiskSpaceRequired;
- const LExcludes = TStringList.Create;
- try
- LExcludes.StrictDelimiter := True;
- LExcludes.Delimiter := ',';
- for I := 0 to Entries[seFile].Count-1 do begin
- with PSetupFileEntry(Entries[seFile][I])^ do begin
- if LocationEntry <> -1 then begin { not an "external" file }
- if Components = '' then { no types or a file that doesn't belong to any component }
- if (Tasks = '') and (Check = '') then {don't count tasks and scripted entries}
- Inc6464(MinimumSpace, PSetupFileLocationEntry(Entries[seFileLocation][LocationEntry])^.OriginalSize)
- end else begin
- if not(foExternalSizePreset in Options) then begin
- if foDownload in Options then
- InternalError('Unexpected download flag');
- try
- LExcludes.DelimitedText := Excludes;
- if foExtractArchive in Options then begin
- ExternalSize := RecurseExternalArchiveGetSizeOfFiles(
- ShouldDisableFsRedirForFileEntry(PSetupFileEntry(Entries[seFile][I])),
- ExpandConst(SourceFilename), ExpandConst(ExtractArchivePassword), LExcludes,
- foRecurseSubDirsExternal in Options);
- end else begin
- if FileType <> ftUserFile then
- SourceWildcard := NewParamStr(0)
- else
- SourceWildcard := ExpandConst(SourceFilename);
- ExternalSize := RecurseExternalGetSizeOfFiles(
- ShouldDisableFsRedirForFileEntry(PSetupFileEntry(Entries[seFile][I])),
- PathExtractPath(SourceWildcard),
- '', PathExtractName(SourceWildcard), IsWildcard(SourceWildcard),
- LExcludes, foRecurseSubDirsExternal in Options);
- end;
- except
- { Ignore exceptions. Two notable exceptions we want to ignore are
- the one about "app" not being initialized and also archive errors
- (ESevenZipError). Also see EnumFiles. }
- end;
- end;
- if Components = '' then { no types or a file that doesn't belong to any component }
- if (Tasks = '') and (Check = '') then {don't count tasks or scripted entries}
- Inc6464(MinimumSpace, ExternalSize);
- end;
- end;
- end;
- finally
- LExcludes.Free;
- end;
- for I := 0 to Entries[seComponent].Count-1 do
- with PSetupComponentEntry(Entries[seComponent][I])^ do
- Size := GetSizeOfComponent(Name, ExtraDiskSpaceRequired);
- if Entries[seType].Count > 0 then begin
- for I := 0 to Entries[seType].Count-1 do begin
- with PSetupTypeEntry(Entries[seType][I])^ do begin
- Size := GetSizeOfType(Name, toIsCustom in Options);
- if (I = 0) or (Compare64(Size, MinimumTypeSpace) < 0) then
- MinimumTypeSpace := Size;
- end;
- end;
- Inc6464(MinimumSpace, MinimumTypeSpace);
- end;
- end;
- procedure InitializeWizard;
- begin
- WizardForm := AppCreateForm(TWizardForm) as TWizardForm;
- if CodeRunner <> nil then begin
- try
- CodeRunner.RunProcedures('InitializeWizard', [''], False);
- except
- Log('InitializeWizard raised an exception (fatal).');
- raise;
- end;
- end;
- WizardForm.FlipSizeAndCenterIfNeeded(False, nil, False);
- WizardForm.SetCurPage(wpWelcome);
- if InstallMode = imNormal then begin
- WizardForm.ClickToStartPage; { this won't go past wpReady }
- WizardForm.Visible := True;
- end
- else
- WizardForm.ClickThroughPages;
- end;
- procedure DeinitSetup(const AllowCustomSetupExitCode: Boolean);
- var
- I: Integer;
- begin
- Log('Deinitializing Setup.');
- if Assigned(CodeRunner) then begin
- if AllowCustomSetupExitCode then begin
- try
- SetupExitCode := CodeRunner.RunIntegerFunctions('GetCustomSetupExitCode',
- [''], bcNonZero, False, SetupExitCode);
- except
- Log('GetCustomSetupExitCode raised an exception.');
- Application.HandleException(nil);
- end;
- end;
- try
- CodeRunner.RunProcedures('DeinitializeSetup', [''], False);
- except
- Log('DeinitializeSetup raised an exception.');
- Application.HandleException(nil);
- end;
- FreeAndNil(CodeRunner);
- end;
- for I := 0 to DeleteFilesAfterInstallList.Count-1 do
- DeleteFileRedir(DeleteFilesAfterInstallList.Objects[I] <> nil,
- DeleteFilesAfterInstallList[I]);
- DeleteFilesAfterInstallList.Clear;
- for I := DeleteDirsAfterInstallList.Count-1 downto 0 do
- RemoveDirectoryRedir(DeleteDirsAfterInstallList.Objects[I] <> nil,
- DeleteDirsAfterInstallList[I]);
- DeleteDirsAfterInstallList.Clear;
- for I := 0 to Length(ISSigAvailableKeys)-1 do
- ISSigAvailableKeys[I].Free;
- FreeFileExtractor;
- { End RestartManager session }
- if RmSessionStarted then
- RmEndSession(RmSessionHandle);
- { Free the _isdecmp.dll and _is7z.dll handles }
- if DecompressorDLLHandle <> 0 then
- FreeLibrary(DecompressorDLLHandle);
- if SevenZipDLLHandle <> 0 then begin
- SevenZipDLLDeInit;
- FreeLibrary(SevenZipDLLHandle);
- end;
- { Free the shfolder.dll handle }
- UnloadSHFolderDLL;
- { Remove TempInstallDir, stopping the 64-bit helper first if necessary }
- RemoveTempInstallDir;
- { An attempt to restart while debugging is most likely an accident;
- don't allow it }
- if RestartSystem and Debugging then begin
- Log('Not restarting Windows because Setup is being run from the debugger.');
- RestartSystem := False;
- end;
- EndDebug;
- ShutdownBlockReasonDestroy(Application.Handle);
- if RestartSystem then begin
- Log('Restarting Windows.');
- if SetupNotifyWndPresent then begin
- { Send a special message back to the first instance telling it to
- restart the system after Setup returns }
- SendNotifyMessage(SetupNotifyWnd, WM_USER + 150, 10000, 0);
- end
- else begin
- { There is no other instance, so initiate the restart ourself.
- Note: Depending on the OS, this may not return if successful. }
- RestartComputerFromThisProcess;
- end;
- end;
- end;
- function ExitSetupMsgBox: Boolean;
- begin
- Result := LoggedMsgBox(SetupMessages[msgExitSetupMessage], SetupMessages[msgExitSetupTitle],
- mbConfirmation, MB_YESNO or MB_DEFBUTTON2, False, 0) = IDYES;
- end;
- procedure ProcessMessagesProc; far;
- begin
- Application.ProcessMessages;
- end;
- procedure RunExecLog(const S: String; const Error, FirstLine: Boolean; const Data: NativeInt);
- begin
- if not Error and FirstLine then
- Log('Output:');
- Log(S);
- end;
- function ShouldDisableFsRedirForRunEntry(const RunEntry: PSetupRunEntry): Boolean;
- begin
- Result := InstallDefaultDisableFsRedir;
- if roRun32Bit in RunEntry.Options then
- Result := False;
- if roRun64Bit in RunEntry.Options then begin
- if not IsWin64 then
- InternalError('Cannot run files in 64-bit locations on this version of Windows');
- Result := True;
- end;
- end;
- procedure ProcessRunEntry(const RunEntry: PSetupRunEntry);
- var
- RunAsOriginalUser: Boolean;
- ExpandedFilename, ExpandedParameters: String;
- Wait: TExecWait;
- DisableFsRedir: Boolean;
- ErrorCode: Integer;
- begin
- try
- Log('-- Run entry --');
- RunAsOriginalUser := (roRunAsOriginalUser in RunEntry.Options);
- if RunAsOriginalUser then
- Log('Run as: Original user')
- else
- Log('Run as: Current user');
- if not(roShellExec in RunEntry.Options) then
- Log('Type: Exec')
- else
- Log('Type: ShellExec');
- ExpandedFilename := ExpandConst(RunEntry.Name);
- Log('Filename: ' + ExpandedFilename);
- ExpandedParameters := ExpandConst(RunEntry.Parameters);
- if not(roDontLogParameters in RunEntry.Options) and (ExpandedParameters <> '') then
- Log('Parameters: ' + ExpandedParameters);
- Wait := ewWaitUntilTerminated;
- case RunEntry.Wait of
- rwNoWait: Wait := ewNoWait;
- rwWaitUntilIdle: Wait := ewWaitUntilIdle;
- end;
- if not(roShellExec in RunEntry.Options) then begin
- DisableFsRedir := ShouldDisableFsRedirForRunEntry(RunEntry);
- if not(roSkipIfDoesntExist in RunEntry.Options) or
- NewFileExistsRedir(DisableFsRedir, ExpandedFilename) then begin
- var OutputReader: TCreateProcessOutputReader := nil;
- try
- if GetLogActive and (roLogOutput in RunEntry.Options) then
- OutputReader := TCreateProcessOutputReader.Create(RunExecLog, 0);
- if not InstExecEx(RunAsOriginalUser, DisableFsRedir, ExpandedFilename,
- ExpandedParameters, ExpandConst(RunEntry.WorkingDir),
- Wait, RunEntry.ShowCmd, ProcessMessagesProc, OutputReader, ErrorCode) then
- raise Exception.Create(FmtSetupMessage1(msgErrorExecutingProgram, ExpandedFilename) +
- SNewLine2 + FmtSetupMessage(msgErrorFunctionFailedWithMessage,
- ['CreateProcess', IntToStr(ErrorCode), Win32ErrorString(ErrorCode)]));
- if Wait = ewWaitUntilTerminated then
- Log(Format('Process exit code: %u', [ErrorCode]));
- finally
- OutputReader.Free;
- end;
- end
- else
- Log('File doesn''t exist. Skipping.');
- end
- else begin
- if not(roSkipIfDoesntExist in RunEntry.Options) or FileOrDirExists(ExpandedFilename) then begin
- if not InstShellExecEx(RunAsOriginalUser, ExpandConst(RunEntry.Verb),
- ExpandedFilename, ExpandedParameters, ExpandConst(RunEntry.WorkingDir),
- Wait, RunEntry.ShowCmd, ProcessMessagesProc, ErrorCode) then
- raise Exception.Create(FmtSetupMessage1(msgErrorExecutingProgram, ExpandedFilename) +
- SNewLine2 + FmtSetupMessage(msgErrorFunctionFailedWithMessage,
- ['ShellExecuteEx', IntToStr(ErrorCode), Win32ErrorString(ErrorCode)]));
- end
- else
- Log('File/directory doesn''t exist. Skipping.');
- end;
- except
- Application.HandleException(nil);
- end;
- end;
- procedure ShellExecuteAsOriginalUser(hWnd: HWND; Operation, FileName, Parameters, Directory: LPWSTR; ShowCmd: Integer); stdcall;
- var
- ErrorCode: Integer;
- begin
- InstShellExecEx(True, Operation, Filename, Parameters, Directory, ewNoWait, ShowCmd, ProcessMessagesProc, ErrorCode);
- end;
- procedure InitIsWin64AndProcessorArchitectureAndMachineTypesSupportedBySystem;
- const
- PROCESSOR_ARCHITECTURE_ARM64 = 12;
- IMAGE_FILE_MACHINE_ARM64 = $AA64;
- IMAGE_FILE_MACHINE_ARMNT = $01C4;
- UserEnabled = $1;
- var
- KernelModule: HMODULE;
- IsWow64ProcessFunc: function(hProcess: THandle; var Wow64Process: BOOL): BOOL; stdcall;
- IsWow64Process2Func: function(hProcess: THandle; var pProcessMachine, pNativeMachine: USHORT): BOOL; stdcall;
- GetMachineTypeAttributesFunc: function(Machine: USHORT; var MachineTypeAttributes: Integer): HRESULT; stdcall;
- IsWow64GuestMachineSupportedFunc: function(WowGuestMachine: USHORT; var MachineIsSupported: BOOL): HRESULT; stdcall;
- ProcessMachine, NativeMachine: USHORT;
- Wow64Process: BOOL;
- SysInfo: TSystemInfo;
- begin
- KernelModule := GetModuleHandle(kernel32);
- { The system is considered a "Win64" system if all of the following
- conditions are true:
- 1. One of the following two is true:
- a. IsWow64Process2 is available, and returns True for the current process.
- b. IsWow64Process is available, and returns True for the current process.
- 2. Wow64DisableWow64FsRedirection is available.
- 3. Wow64RevertWow64FsRedirection is available.
- 4. GetSystemWow64DirectoryA is available.
- 5. RegDeleteKeyExA is available.
- The system does not have to be one of the known 64-bit architectures
- to be considered a "Win64" system. }
- IsWin64 := False;
- IsWow64Process2Func := GetProcAddress(KernelModule, 'IsWow64Process2');
- if Assigned(IsWow64Process2Func) and
- IsWow64Process2Func(GetCurrentProcess, ProcessMachine, NativeMachine) and
- (ProcessMachine <> IMAGE_FILE_MACHINE_UNKNOWN) then begin
- IsWin64 := True;
- case NativeMachine of
- IMAGE_FILE_MACHINE_I386: ProcessorArchitecture := paX86;
- IMAGE_FILE_MACHINE_AMD64: ProcessorArchitecture := paX64;
- IMAGE_FILE_MACHINE_ARM64: ProcessorArchitecture := paArm64;
- else
- ProcessorArchitecture := paUnknown;
- end;
- end else begin
- IsWow64ProcessFunc := GetProcAddress(KernelModule, 'IsWow64Process');
- if Assigned(IsWow64ProcessFunc) and
- IsWow64ProcessFunc(GetCurrentProcess, Wow64Process) and
- Wow64Process then
- IsWin64 := True;
- GetNativeSystemInfo(SysInfo);
- case SysInfo.wProcessorArchitecture of
- PROCESSOR_ARCHITECTURE_INTEL: ProcessorArchitecture := paX86;
- PROCESSOR_ARCHITECTURE_AMD64: ProcessorArchitecture := paX64;
- PROCESSOR_ARCHITECTURE_ARM64: ProcessorArchitecture := paArm64;
- else
- ProcessorArchitecture := paUnknown;
- end;
- end;
- if IsWin64 and
- not (AreFsRedirectionFunctionsAvailable and
- (GetProcAddress(KernelModule, 'GetSystemWow64DirectoryA') <> nil) and
- (GetProcAddress(GetModuleHandle(advapi32), 'RegDeleteKeyExA') <> nil)) then
- IsWin64 := False;
- { Setup MachineTypesSupportedBySystem. The result should end up being:
- - 32-bit x86: [paX86]
- - x64: [paX86, paX64]
- (but not paX86 in a future x64 build of Inno Setup if Windows was installed
- without support for x86 binaries (which is possible with Windows Server))
- - Arm64 Windows 10: [paX86, paArm64, paArm32]
- (Arm32 support detected, not just assumed)
- - Arm64 Windows 11: [paX86, paX64, paArm64, paArm32]
- (X64 and Arm32 support detected, not just assumed) }
- {$IFDEF CPUX86}
- MachineTypesSupportedBySystem := [paX86];
- {$ELSE}
- {$MESSAGE ERROR 'This needs updating for non-x86 builds'}
- {$ENDIF}
- if ProcessorArchitecture <> paUnknown then
- Include(MachineTypesSupportedBySystem, ProcessorArchitecture);
- { On Windows 11 we can use GetMachineTypeAttributes to check what is supported extra }
- GetMachineTypeAttributesFunc := GetProcAddress(KernelModule, 'GetMachineTypeAttributes');
- if Assigned(GetMachineTypeAttributesFunc) then begin
- var MachineTypeAttributes: Integer;
- if (GetMachineTypeAttributesFunc(IMAGE_FILE_MACHINE_ARMNT, MachineTypeAttributes) = S_OK) and
- ((MachineTypeAttributes and UserEnabled) <> 0) then
- Include(MachineTypesSupportedBySystem, paArm32);
- if not (paX64 in MachineTypesSupportedBySystem) and
- (GetMachineTypeAttributesFunc(IMAGE_FILE_MACHINE_AMD64, MachineTypeAttributes) = S_OK) and
- ((MachineTypeAttributes and UserEnabled) <> 0) then
- Include(MachineTypesSupportedBySystem, paX64);
- end else begin
- { Without GetMachineTypeAttributes we can only check if Arm32 is supported extra
- using IsWow64GuestMachineSupported }
- IsWow64GuestMachineSupportedFunc := GetProcAddress(KernelModule, 'IsWow64GuestMachineSupported');
- if Assigned(IsWow64GuestMachineSupportedFunc) then begin
- var MachineIsSupported: BOOL;
- if (IsWow64GuestMachineSupportedFunc(IMAGE_FILE_MACHINE_ARMNT, MachineIsSupported) = S_OK) and
- MachineIsSupported then
- Include(MachineTypesSupportedBySystem, paArm32);
- end;
- end;
- end;
- procedure InitWindowsVersion;
- var
- OSVersionInfo: TOSVersionInfo;
- OSVersionInfoEx: TOSVersionInfoEx;
- begin
- OSVersionInfo.dwOSVersionInfoSize := SizeOf(OSVersionInfo);
- if GetVersionEx(OSVersionInfo) then begin
- WindowsVersion := (Byte(OSVersionInfo.dwMajorVersion) shl 24) or
- (Byte(OSVersionInfo.dwMinorVersion) shl 16) or
- Word(OSVersionInfo.dwBuildNumber);
- { ^ Note: We MUST clip dwBuildNumber to 16 bits for Win9x compatibility }
- OSVersionInfoEx.dwOSVersionInfoSize := SizeOf(OSVersionInfoEx);
- if GetVersionEx(POSVersionInfo(@OSVersionInfoEx)^) then begin
- NTServicePackLevel := (Byte(OSVersionInfoEx.wServicePackMajor) shl 8) or
- Byte(OSVersionInfoEx.wServicePackMinor);
- WindowsProductType := OSVersionInfoEx.wProductType;
- WindowsSuiteMask := OSVersionInfoEx.wSuiteMask;
- end;
- end;
- end;
- procedure CreateEntryLists;
- var
- I: TEntryType;
- begin
- for I := Low(I) to High(I) do
- Entries[I] := TList.Create;
- end;
- procedure FreeEntryLists;
- var
- I: TEntryType;
- List: TList;
- J: Integer;
- P: Pointer;
- begin
- for I := High(I) downto Low(I) do begin
- List := Entries[I];
- if Assigned(List) then begin
- Entries[I] := nil;
- for J := List.Count-1 downto 0 do begin
- P := List[J];
- if EntryStrings[I] <> 0 then
- SEFreeRec(P, EntryStrings[I], EntryAnsiStrings[I])
- else
- FreeMem(P);
- end;
- List.Free;
- end;
- FreeAndNil(OriginalEntryIndexes[I]);
- end;
- end;
- procedure FreeWizardImages;
- var
- I: Integer;
- begin
- for I := WizardImages.Count-1 downto 0 do
- TBitmap(WizardImages[I]).Free;
- FreeAndNil(WizardImages);
- for I := WizardSmallImages.Count-1 downto 0 do
- TBitmap(WizardSmallImages[I]).Free;
- FreeAndNil(WizardSmallImages);
- end;
- initialization
- InitIsWin64AndProcessorArchitectureAndMachineTypesSupportedBySystem;
- InitWindowsVersion;
- InitComponents := TStringList.Create();
- InitTasks := TStringList.Create();
- NewParamsForCode := TStringList.Create();
- WizardComponents := TStringList.Create();
- WizardDeselectedComponents := TStringList.Create();
- WizardTasks := TStringList.Create();
- WizardDeselectedTasks := TStringList.Create();
- CreateEntryLists;
- DeleteFilesAfterInstallList := TStringList.Create;
- DeleteDirsAfterInstallList := TStringList.Create;
- CloseApplicationsFilterList := TStringList.Create;
- CloseApplicationsFilterExcludesList := TStringList.Create;
- WizardImages := TList.Create;
- WizardSmallImages := TList.Create;
- SHGetKnownFolderPathFunc := GetProcAddress(SafeLoadLibrary(AddBackslash(GetSystemDir) + shell32,
- SEM_NOOPENFILEERRORBOX), 'SHGetKnownFolderPath');
- finalization
- FreeWizardImages;
- FreeAndNil(CloseApplicationsFilterExcludesList);
- FreeAndNil(CloseApplicationsFilterList);
- FreeAndNil(DeleteDirsAfterInstallList);
- FreeAndNil(DeleteFilesAfterInstallList);
- FreeEntryLists;
- FreeAndNil(WizardDeselectedTasks);
- FreeAndNil(WizardTasks);
- FreeAndNil(WizardDeselectedComponents);
- FreeAndNil(WizardComponents);
- FreeAndNil(NewParamsForCode);
- FreeAndNil(InitTasks);
- FreeAndNil(InitComponents);
- end.
|