| 12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697989910010110210310410510610710810911011111211311411511611711811912012112212312412512612712812913013113213313413513613713813914014114214314414514614714814915015115215315415515615715815916016116216316416516616716816917017117217317417517617717817918018118218318418518618718818919019119219319419519619719819920020120220320420520620720820921021121221321421521621721821922022122222322422522622722822923023123223323423523623723823924024124224324424524624724824925025125225325425525625725825926026126226326426526626726826927027127227327427527627727827928028128228328428528628728828929029129229329429529629729829930030130230330430530630730830931031131231331431531631731831932032132232332432532632732832933033133233333433533633733833934034134234334434534634734834935035135235335435535635735835936036136236336436536636736836937037137237337437537637737837938038138238338438538638738838939039139239339439539639739839940040140240340440540640740840941041141241341441541641741841942042142242342442542642742842943043143243343443543643743843944044144244344444544644744844945045145245345445545645745845946046146246346446546646746846947047147247347447547647747847948048148248348448548648748848949049149249349449549649749849950050150250350450550650750850951051151251351451551651751851952052152252352452552652752852953053153253353453553653753853954054154254354454554654754854955055155255355455555655755855956056156256356456556656756856957057157257357457557657757857958058158258358458558658758858959059159259359459559659759859960060160260360460560660760860961061161261361461561661761861962062162262362462562662762862963063163263363463563663763863964064164264364464564664764864965065165265365465565665765865966066166266366466566666766866967067167267367467567667767867968068168268368468568668768868969069169269369469569669769869970070170270370470570670770870971071171271371471571671771871972072172272372472572672772872973073173273373473573673773873974074174274374474574674774874975075175275375475575675775875976076176276376476576676776876977077177277377477577677777877978078178278378478578678778878979079179279379479579679779879980080180280380480580680780880981081181281381481581681781881982082182282382482582682782882983083183283383483583683783883984084184284384484584684784884985085185285385485585685785885986086186286386486586686786886987087187287387487587687787887988088188288388488588688788888989089189289389489589689789889990090190290390490590690790890991091191291391491591691791891992092192292392492592692792892993093193293393493593693793893994094194294394494594694794894995095195295395495595695795895996096196296396496596696796896997097197297397497597697797897998098198298398498598698798898999099199299399499599699799899910001001100210031004100510061007100810091010101110121013101410151016101710181019102010211022102310241025102610271028102910301031103210331034103510361037103810391040104110421043104410451046104710481049105010511052105310541055105610571058105910601061106210631064106510661067106810691070107110721073107410751076107710781079108010811082108310841085108610871088108910901091109210931094109510961097109810991100110111021103110411051106110711081109111011111112111311141115111611171118111911201121112211231124112511261127112811291130113111321133113411351136113711381139114011411142114311441145114611471148114911501151115211531154115511561157115811591160116111621163116411651166116711681169117011711172117311741175117611771178117911801181118211831184118511861187118811891190119111921193119411951196119711981199120012011202120312041205120612071208120912101211121212131214121512161217121812191220122112221223122412251226122712281229123012311232123312341235123612371238123912401241124212431244124512461247124812491250125112521253125412551256125712581259126012611262126312641265126612671268126912701271127212731274127512761277127812791280128112821283128412851286128712881289129012911292129312941295129612971298129913001301130213031304130513061307130813091310131113121313131413151316131713181319132013211322132313241325132613271328132913301331133213331334133513361337133813391340134113421343134413451346134713481349135013511352135313541355135613571358135913601361136213631364136513661367136813691370137113721373137413751376137713781379138013811382138313841385138613871388138913901391139213931394139513961397139813991400140114021403140414051406140714081409141014111412141314141415141614171418141914201421142214231424142514261427142814291430143114321433143414351436143714381439144014411442144314441445144614471448144914501451145214531454145514561457145814591460146114621463146414651466146714681469147014711472147314741475147614771478147914801481148214831484148514861487148814891490149114921493149414951496149714981499150015011502150315041505150615071508150915101511151215131514151515161517151815191520152115221523152415251526152715281529153015311532153315341535153615371538153915401541154215431544154515461547154815491550155115521553155415551556155715581559156015611562156315641565156615671568156915701571157215731574157515761577157815791580158115821583158415851586158715881589159015911592159315941595159615971598159916001601160216031604160516061607160816091610161116121613161416151616161716181619162016211622162316241625162616271628162916301631163216331634163516361637163816391640164116421643164416451646164716481649165016511652165316541655165616571658165916601661166216631664166516661667166816691670167116721673167416751676167716781679168016811682168316841685168616871688168916901691169216931694169516961697169816991700170117021703170417051706170717081709171017111712171317141715171617171718171917201721172217231724172517261727172817291730173117321733173417351736173717381739174017411742174317441745174617471748174917501751175217531754175517561757175817591760176117621763176417651766176717681769177017711772177317741775177617771778177917801781178217831784178517861787178817891790179117921793179417951796179717981799180018011802180318041805180618071808180918101811181218131814181518161817181818191820182118221823182418251826182718281829183018311832183318341835183618371838183918401841184218431844184518461847184818491850185118521853185418551856185718581859186018611862186318641865186618671868186918701871187218731874187518761877187818791880188118821883188418851886188718881889189018911892189318941895189618971898189919001901190219031904190519061907190819091910191119121913191419151916191719181919192019211922192319241925192619271928192919301931193219331934193519361937193819391940194119421943194419451946194719481949195019511952195319541955195619571958195919601961196219631964196519661967196819691970197119721973197419751976197719781979198019811982198319841985198619871988198919901991199219931994199519961997199819992000200120022003200420052006200720082009201020112012201320142015201620172018201920202021202220232024202520262027202820292030203120322033203420352036203720382039204020412042204320442045204620472048204920502051205220532054205520562057205820592060206120622063206420652066206720682069207020712072207320742075207620772078207920802081208220832084208520862087208820892090209120922093209420952096209720982099210021012102210321042105210621072108210921102111211221132114211521162117211821192120212121222123212421252126212721282129213021312132213321342135213621372138213921402141214221432144214521462147214821492150215121522153215421552156215721582159216021612162216321642165216621672168216921702171217221732174217521762177217821792180218121822183218421852186218721882189219021912192219321942195219621972198219922002201220222032204220522062207220822092210221122122213221422152216221722182219222022212222222322242225222622272228222922302231223222332234223522362237223822392240224122422243224422452246224722482249225022512252225322542255225622572258225922602261226222632264226522662267226822692270227122722273227422752276227722782279228022812282228322842285228622872288228922902291229222932294229522962297229822992300230123022303230423052306230723082309231023112312231323142315231623172318231923202321232223232324232523262327232823292330233123322333233423352336233723382339234023412342234323442345234623472348234923502351235223532354235523562357235823592360236123622363236423652366236723682369237023712372237323742375237623772378237923802381238223832384238523862387238823892390239123922393239423952396239723982399240024012402240324042405240624072408240924102411241224132414241524162417241824192420242124222423242424252426242724282429243024312432243324342435243624372438243924402441244224432444244524462447244824492450245124522453245424552456245724582459246024612462246324642465246624672468246924702471247224732474247524762477247824792480248124822483248424852486248724882489249024912492249324942495249624972498249925002501250225032504250525062507250825092510251125122513251425152516251725182519252025212522252325242525252625272528252925302531253225332534253525362537253825392540254125422543254425452546254725482549255025512552255325542555255625572558255925602561256225632564256525662567256825692570257125722573257425752576257725782579258025812582258325842585258625872588258925902591259225932594259525962597259825992600260126022603260426052606260726082609261026112612261326142615261626172618261926202621262226232624262526262627262826292630263126322633263426352636263726382639264026412642264326442645264626472648264926502651265226532654265526562657265826592660266126622663266426652666266726682669267026712672267326742675267626772678267926802681268226832684268526862687268826892690269126922693269426952696269726982699270027012702270327042705270627072708270927102711271227132714271527162717271827192720272127222723272427252726272727282729273027312732273327342735273627372738273927402741274227432744274527462747274827492750275127522753275427552756275727582759276027612762276327642765276627672768276927702771277227732774277527762777277827792780278127822783278427852786278727882789279027912792279327942795279627972798279928002801280228032804280528062807280828092810281128122813281428152816281728182819282028212822282328242825282628272828282928302831283228332834283528362837283828392840284128422843284428452846284728482849285028512852285328542855285628572858285928602861286228632864286528662867286828692870287128722873287428752876287728782879288028812882288328842885288628872888288928902891289228932894289528962897289828992900290129022903290429052906290729082909291029112912291329142915291629172918291929202921292229232924292529262927292829292930293129322933293429352936293729382939294029412942294329442945294629472948294929502951295229532954295529562957295829592960296129622963296429652966296729682969297029712972297329742975297629772978297929802981298229832984298529862987298829892990299129922993299429952996299729982999300030013002300330043005300630073008300930103011301230133014301530163017301830193020302130223023302430253026302730283029303030313032303330343035303630373038303930403041304230433044304530463047304830493050305130523053305430553056305730583059306030613062306330643065306630673068306930703071307230733074307530763077307830793080308130823083308430853086308730883089309030913092309330943095309630973098309931003101310231033104310531063107310831093110311131123113311431153116311731183119312031213122312331243125312631273128312931303131313231333134313531363137313831393140314131423143314431453146314731483149315031513152315331543155315631573158315931603161316231633164316531663167316831693170317131723173317431753176317731783179318031813182318331843185318631873188318931903191319231933194319531963197319831993200320132023203320432053206320732083209321032113212321332143215321632173218321932203221322232233224322532263227322832293230323132323233323432353236323732383239324032413242324332443245324632473248324932503251325232533254325532563257325832593260326132623263326432653266326732683269327032713272327332743275327632773278327932803281328232833284328532863287328832893290329132923293329432953296329732983299330033013302330333043305330633073308330933103311331233133314331533163317331833193320332133223323332433253326332733283329333033313332333333343335333633373338333933403341334233433344334533463347334833493350335133523353335433553356335733583359336033613362336333643365336633673368336933703371337233733374337533763377337833793380338133823383338433853386338733883389339033913392339333943395339633973398339934003401340234033404340534063407340834093410341134123413341434153416341734183419342034213422342334243425342634273428342934303431343234333434343534363437343834393440344134423443344434453446344734483449345034513452345334543455345634573458345934603461346234633464346534663467346834693470347134723473347434753476347734783479348034813482348334843485348634873488348934903491349234933494349534963497349834993500350135023503350435053506350735083509351035113512351335143515351635173518351935203521352235233524352535263527352835293530353135323533353435353536353735383539354035413542354335443545354635473548354935503551355235533554355535563557355835593560356135623563356435653566356735683569357035713572357335743575357635773578357935803581358235833584358535863587358835893590359135923593359435953596359735983599360036013602360336043605360636073608360936103611361236133614361536163617361836193620362136223623362436253626362736283629363036313632363336343635363636373638363936403641364236433644364536463647364836493650365136523653365436553656365736583659366036613662366336643665366636673668366936703671367236733674367536763677367836793680368136823683368436853686368736883689369036913692369336943695369636973698369937003701370237033704370537063707370837093710371137123713371437153716371737183719372037213722372337243725372637273728372937303731373237333734373537363737373837393740374137423743374437453746374737483749375037513752375337543755375637573758375937603761376237633764376537663767376837693770377137723773377437753776377737783779378037813782378337843785378637873788378937903791379237933794379537963797379837993800380138023803380438053806380738083809381038113812381338143815381638173818381938203821382238233824382538263827382838293830383138323833383438353836383738383839384038413842384338443845384638473848384938503851385238533854385538563857385838593860386138623863386438653866386738683869387038713872387338743875387638773878387938803881388238833884388538863887388838893890389138923893389438953896389738983899390039013902390339043905390639073908390939103911391239133914391539163917391839193920392139223923392439253926392739283929393039313932393339343935393639373938393939403941394239433944394539463947394839493950395139523953395439553956395739583959396039613962396339643965396639673968396939703971397239733974397539763977397839793980398139823983398439853986398739883989399039913992399339943995399639973998399940004001400240034004400540064007400840094010401140124013401440154016401740184019402040214022402340244025402640274028402940304031403240334034403540364037403840394040404140424043404440454046404740484049405040514052405340544055405640574058405940604061406240634064406540664067406840694070407140724073407440754076407740784079408040814082408340844085408640874088408940904091409240934094409540964097409840994100410141024103410441054106410741084109411041114112411341144115411641174118411941204121412241234124412541264127412841294130413141324133413441354136413741384139414041414142414341444145414641474148414941504151415241534154415541564157415841594160416141624163416441654166416741684169417041714172417341744175417641774178417941804181418241834184418541864187418841894190419141924193419441954196419741984199420042014202420342044205420642074208420942104211421242134214421542164217421842194220422142224223422442254226422742284229423042314232423342344235423642374238423942404241424242434244424542464247424842494250425142524253425442554256425742584259426042614262426342644265426642674268426942704271427242734274427542764277427842794280428142824283428442854286428742884289429042914292429342944295429642974298429943004301430243034304430543064307430843094310431143124313431443154316431743184319432043214322432343244325432643274328432943304331433243334334433543364337433843394340434143424343434443454346434743484349435043514352435343544355435643574358435943604361436243634364436543664367436843694370437143724373437443754376437743784379438043814382 |
- 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, Generics.Collections,
- StdCtrls, Shared.Struct, Shared.DebugStruct, 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
- TWizardImages = TObjectList<TGraphic>;
- 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, InitNoStyle, InitRedirectionGuard, InitNoRedirectionGuard: 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;
- OrigSetupHeaderWizardBackColor: Integer;
- LangOptions: TSetupLanguageEntry;
- Entries: array[TEntryType] of TList;
- WizardImages, WizardSmallImages, WizardBackImages: TWizardImages;
- MainIconPostfix, WizardIconsPostfix: String;
- 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, IsWinDark, IsDarkInstallMode,
- IsUninstaller, AllowUninstallerShutdown, AcceptedQueryEndSessionInProgress,
- CustomWizardBackground: 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: Int64;
- DeleteFilesAfterInstallList, DeleteDirsAfterInstallList: TStringList;
- ExpandedAppName, ExpandedAppVerName, ExpandedAppCopyright, ExpandedAppMutex: String;
- DisableCodeConsts: Integer;
- SetupExitCode: Integer;
- CreatedIcon: Boolean;
- RestartInitiatedByThisProcess, DownloadTemporaryFileOrExtractArchiveProcessMessages: Boolean;
- InstallModeRootKey: HKEY;
- CodeRunner: TScriptRunner;
- function ApplyPathRedirRules(const A64Bit: Boolean; const APath: String): String;
- 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);
- procedure DeleteResidualTempUninstallDirs;
- 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 LoggedMsgBox(const Text, Caption: PChar; const Flags: Integer;
- const Suppressible: Boolean; const Default: Integer): Integer; overload;
- function LoggedMsgBox(const Text, Caption: String; const Typ: TMsgBoxType;
- const Buttons: Cardinal; const Suppressible: Boolean; const Default: Integer): Integer; overload;
- 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);
- procedure RedirectionGuardConfigure(const AEnable: Boolean);
- function RedirectionGuardEnabled: Boolean;
- 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;
- function SelectBestImage(WizardImages: TWizardImages; TargetWidth, TargetHeight: Integer): TGraphic;
- implementation
- uses
- ShellAPI, ShlObj, StrUtils, ActiveX, RegStr, Imaging.pngimage, Themes,
- ChaCha20, ECDSA, ISSigFunc, NewCtrls, PathFunc, UnsignedFunc, FormBackgroundStyleHook, RichEditViewer,
- SetupLdrAndSetup.Messages, Shared.SetupMessageIDs, Setup.DownloadFileFunc, Setup.ExtractFileFunc,
- SetupLdrAndSetup.InstFunc, Setup.InstFunc, Setup.RedirFunc,
- 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, StringScanner,
- SimpleExpression, Setup.Helper, Setup.SpawnClient, Setup.SpawnServer,
- Setup.DotNetFunc, Shared.TaskDialogFunc, Setup.MainForm, Compression.SevenZipDecoder,
- Compression.SevenZipDLLDecoder, Setup.SetupForm;
- 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 SelectBestImage(WizardImages: TWizardImages; TargetWidth, TargetHeight: Integer): TGraphic;
- var
- TargetArea, Difference, SmallestDifference, I: Integer;
- begin
- if WizardImages.Count <> 1 then begin
- { Find the image with the smallest area difference compared to the target area. }
- TargetArea := TargetWidth*TargetHeight;
- SmallestDifference := -1;
- Result := nil;
- for I := 0 to WizardImages.Count-1 do begin
- Difference := Abs(TargetArea-WizardImages[I].Width*WizardImages[I].Height);
- if (SmallestDifference = -1) or (Difference < SmallestDifference) then begin
- Result := WizardImages[I];
- SmallestDifference := Difference;
- end;
- end;
- end else
- Result := WizardImages[0];
- end;
- 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 ApplyPathRedirRules(const A64Bit: Boolean; const APath: String): String;
- begin
- var NewPath := PathExpand(APath);
- if A64Bit then begin
- { system32 -> sysnative }
- if not IsWin64 then
- InternalError('ApplyPathRedirRules: A64Bit=True but IsWin64=False');
- NewPath := ReplaceSystemDirWithSysNative(NewPath, IsWin64);
- end else begin
- { system32 -> syswow64 rule currently disabled; it's only really needed
- when the target process is 64-bit. }
- //NewPath := ReplaceSystemDirWithSysWow64(NewPath);
- end;
- Result := NewPath;
- 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], ULength(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);
- InitNoStyle := GetIniBool(Section, 'NoStyle', InitNoStyle, FileName);
- InitRedirectionGuard := GetIniBool(Section, 'RedirectionGuard', InitRedirectionGuard, FileName);
- InitNoRedirectionGuard := GetIniBool(Section, 'NoRedirectionGuard', InitNoRedirectionGuard, 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+'='), ULength(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 := Format('%d', [UInt32(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 DeleteResidualTempUninstallDirs;
- var
- SelfExeFilename: String;
- function IsAttrDirectoryAndNotReparsePoint(const Attr: DWORD): Boolean;
- begin
- Result := (Attr and (FILE_ATTRIBUTE_DIRECTORY or FILE_ATTRIBUTE_REPARSE_POINT)) =
- FILE_ATTRIBUTE_DIRECTORY;
- end;
- function IsRecentFileTime(const AFileTime: TFileTime): Boolean;
- const
- ThresholdSecs = 5 * 60; { 5 minutes }
- begin
- var NowTime: TFileTime;
- GetSystemTimeAsFileTime(NowTime);
- const A = FileTimeToUInt64(AFileTime);
- const B = FileTimeToUInt64(NowTime);
- { Past and future times are both considered recent }
- var Diff: UInt64;
- if A > B then
- Diff := A - B
- else
- Diff := B - A;
- Result := Diff < ThresholdSecs * UInt64(10000000);
- end;
- function TryDeleteUninstallDir(const ADir: String): Boolean;
- begin
- Result := False;
- const UninsExeFilename = ADir + '\_unins.tmp';
- { Quick out if it's our own process's directory }
- if PathSame(UninsExeFilename, SelfExeFilename) then
- Exit;
- { Open handle to the directory. This serves two purposes:
- - Avoid TOCTOU race in the reparse point check: We checked the
- attributes returned by FindFirstFile/FindNextFile, but it's *possible*
- that the directory was replaced with a reparse point (or a file)
- between then and now. By passing only FILE_SHARE_READ for the sharing
- mode, we block other processes from deleting the directory or changing
- it into a reparse point in-place. We can then re-check the attributes
- with no worries of them changing afterward, as long as the handle
- remains open.
- - It functions like a mutex: If two processes enter this function
- concurrently for the same directory, this CreateFile call will only
- succeed in one of them. The other will fail with
- ERROR_SHARING_VIOLATION, because FILE_SHARE_READ doesn't allow another
- handle to be opened for DELETE access.
- The docs for GetFileInformationByHandle (called below) don't specify
- what access rights, if any, are required. Even though the function
- succeeds with only DELETE access on Windows 11, we also include
- FILE_READ_ATTRIBUTES to be sure we aren't depending on undocumented
- implementation details. }
- const DirHandle = CreateFile(PChar(ADir),
- Windows._DELETE or FILE_READ_ATTRIBUTES, FILE_SHARE_READ, nil,
- OPEN_EXISTING, FILE_FLAG_OPEN_REPARSE_POINT or FILE_FLAG_BACKUP_SEMANTICS,
- 0);
- if DirHandle <> INVALID_HANDLE_VALUE then begin
- try
- var Info: TByHandleFileInformation;
- if GetFileInformationByHandle(DirHandle, Info) and
- IsAttrDirectoryAndNotReparsePoint(Info.dwFileAttributes) then begin
- { Try to open _unins-done.tmp, which is an empty file created by
- Uninstall to signal to us that the directory needs deleting.
- It also serves as a lock: if the file exists, but opening it fails
- with ERROR_SHARING_VIOLATION, that means the Uninstall process is
- still running, so we shouldn't try to delete the directory at this
- time. (Uninstall holds the file open until it terminates, allowing
- only FILE_SHARE_READ sharing, which conflicts with the request
- for DELETE access here.) }
- const DoneFileHandle = CreateFile(PChar(ADir + '\_unins-done.tmp'),
- Windows._DELETE, FILE_SHARE_READ, nil, OPEN_EXISTING,
- FILE_FLAG_OPEN_REPARSE_POINT, 0);
- if DoneFileHandle <> INVALID_HANDLE_VALUE then begin
- try
- Result := Windows.DeleteFile(PChar(UninsExeFilename));
- if Result then begin
- LogFmt('Deleted file: %s', [UninsExeFilename]);
- if not DeleteFileOrDirByHandle(DoneFileHandle) then
- LogWithLastError('Failed to delete "_unins-done.tmp".');
- end;
- finally
- CloseHandle(DoneFileHandle);
- end;
- end;
- { Try to remove the directory (if empty) in two cases:
- - If we just deleted files from it. (Any failure is logged.)
- - If it wasn't modified recently. It could be an empty directory
- that this function couldn't remove before because an AV or other
- process was holding handles to the directory or now-deleted
- files inside. Or, it could be an empty directory that
- Uninstall's RunFirstPhase couldn't remove because this function
- was running concurrently in another process and had it open (an
- unlikely race).
- The time check prevents removal of a directory that a
- concurrently-running Uninstall process just created (also an
- unlikely race).
- The time check is intentionally done first (often unnecessarily)
- just to ensure that code path gets regularly exercised. }
- if not IsRecentFileTime(Info.ftLastWriteTime) or Result then
- if not DeleteFileOrDirByHandle(DirHandle) then
- if Result then
- LogWithLastError('Failed to remove directory.');
- end;
- finally
- CloseHandle(DirHandle);
- end;
- end;
- end;
- begin
- Log('Cleaning up any residual temporary files from previous Uninstall runs.');
- SelfExeFilename := NewParamStr(0);
- var NumDirsFound: Cardinal := 0;
- var NumDirsChecked: Cardinal := 0;
- var NumFilesDeleted: Cardinal := 0;
- const ParentDir = AddBackslash(GetTempDir);
- var FindData: TWin32FindData;
- const H = FindFirstFile(PChar(ParentDir + 'is-*-uninstall.tmp'), FindData);
- if H = INVALID_HANDLE_VALUE then begin
- if GetLastError <> ERROR_FILE_NOT_FOUND then
- LogWithLastError('Failed to list directory.');
- end else begin
- try
- var TimeLimitReached := False;
- var TimeLimitTimer: TOneShotTimer;
- TimeLimitTimer.Start(3000);
- repeat
- if IsAttrDirectoryAndNotReparsePoint(FindData.dwFileAttributes) then begin
- const BaseName: String = FindData.cFileName;
- { Scrutinize the name further }
- const SS = TStringScanner.Create(PathLowercase(BaseName));
- const MatchingName = SS.Consume('is-') and
- (SS.ConsumeMulti(['0'..'9', 'a'..'z'], False, 10, 20) > 0) and
- SS.Consume('-uninstall.tmp') and SS.ReachedEnd;
- if MatchingName then begin
- Inc(NumDirsFound);
- if not TimeLimitReached then begin
- if (NumDirsChecked >= 10) and TimeLimitTimer.Expired then begin
- TimeLimitReached := True;
- Log('Stopping cleanup because it''s taking too long (>3s).');
- end else begin
- Inc(NumDirsChecked);
- if TryDeleteUninstallDir(ParentDir + BaseName) then
- Inc(NumFilesDeleted);
- end;
- end;
- end;
- end;
- until not FindNextFile(H, FindData);
- finally
- Windows.FindClose(H);
- end;
- end;
- LogFmt('Cleanup finished (%u directories found, %u directories checked, %u files deleted).',
- [NumDirsFound, NumDirsChecked, NumFilesDeleted]);
- 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('.tmp', 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 begin
- ShellFolder := GetShellFolderByGUID(FOLDERID_UserProgramFiles, True);
- if ShellFolder = '' then { should happen on Wine only }
- ShellFolder := ExpandConst('{localappdata}\Programs'); { supply default, same as Windows }
- end else if ID = sfUserCommonFiles then begin
- ShellFolder := GetShellFolderByGUID(FOLDERID_UserProgramFilesCommon, True);
- if ShellFolder = '' then { should happen on Wine only }
- ShellFolder := ExpandConst('{localappdata}\Programs\Common'); { supply default, same as Windows }
- end 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: Int64): Int64;
- 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
- Inc(Result, PSetupFileLocationEntry(Entries[seFileLocation][LocationEntry])^.OriginalSize)
- else
- Inc(Result, ExternalSize);
- end;
- end;
- end;
- end;
- finally
- ComponentNameAsList.Free();
- end;
- end;
- function GetSizeOfType(const TypeName: String; const IsCustom: Boolean): Int64;
- var
- ComponentTypes: TStringList;
- I: Integer;
- begin
- Result := 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
- Inc(Result, Size);
- end else begin
- if ListContains(ComponentTypes, TypeName) then
- Inc(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, UINT(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], ULength(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;
- var
- IsRedirectionGuardEnabled: Boolean;
- procedure RedirectionGuardConfigure(const AEnable: Boolean);
- const
- ProcessRedirectionTrustPolicy = TProcessMitigationPolicy(16);
- var
- SetProcessMitigationPolicyFunc: function(MitigationPolicy: TProcessMitigationPolicy;
- lpBuffer: PVOID; dwLength: SIZE_T): BOOL; stdcall;
- begin
- var Status: String;
- if AEnable then begin
- SetProcessMitigationPolicyFunc := GetProcAddress(GetModuleHandle(kernel32),
- PAnsiChar('SetProcessMitigationPolicy'));
- if Assigned(SetProcessMitigationPolicyFunc) then begin
- const Flags: DWORD = 1; { = EnforceRedirectionTrust bit set }
- if SetProcessMitigationPolicyFunc(ProcessRedirectionTrustPolicy, @Flags, SizeOf(Flags)) then begin
- IsRedirectionGuardEnabled := True;
- Status := 'Enabled in enforcing mode'
- end else begin
- const ErrorCode = GetLastError;
- Status := Format('Could not enable (SetProcessMitigationPolicy failed with error code %u)',
- [ErrorCode]);
- end;
- end else
- Status := 'Could not enable (SetProcessMitigationPolicy unavailable)';
- end else
- Status := 'Not enabling';
- LogFmt('RedirectionGuard status for current process: %s', [Status]);
- end;
- function RedirectionGuardEnabled: Boolean;
- begin
- Result := IsRedirectionGuardEnabled;
- 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].
- Same applies to MB_ABORTRETRYIGNORE. }
- 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 LogSuppressedMsgBox(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 LogMsgBox(const Text: PChar; const Buttons: Cardinal);
- begin
- Log(Format('Message box (%s):' + SNewLine,
- [GetButtonsText(Buttons)]) + Text);
- end;
- function LoggedMsgBox(const Text, Caption: PChar; const Flags: Integer;
- const Suppressible: Boolean; const Default: Integer): Integer;
- begin
- if InitSuppressMsgBoxes and Suppressible then begin
- LogSuppressedMsgBox(Text, Flags, Default);
- Result := Default;
- end else begin
- LogMsgBox(Text, Flags);
- Result := MsgBox(Text, Caption, Flags);
- if Result <> 0 then
- LogFmt('User chose %s.', [GetMessageBoxResultText(Result)])
- else
- Log('MsgBox 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
- LogSuppressedMsgBox(PChar(Text), Buttons, Default);
- Result := Default;
- end else begin
- LogMsgBox(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
- LogSuppressedMsgBox(PChar(Text), Buttons, Default);
- Result := Default;
- end else begin
- LogMsgBox(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: Integer;
- NotifyRestartRequested: Boolean;
- NotifyNewLanguage: Integer;
- end;
- begin
- Cancelled := False;
- try
- Server := TSpawnServer.Create;
- try
- if SetupNotifyWndPresent then
- ParamNotifyWnd := SetupNotifyWnd
- else
- ParamNotifyWnd := Server.Wnd;
- { The UInt32 casts prevent sign extension }
- RespawnSelfElevated(SetupLdrOriginalFilename,
- Format('/SPAWNWND=$%x /NOTIFYWND=$%x ', [UInt32(Server.Wnd), UInt32(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;
- System.ExitCode := RespawnResults.ExitCode;
- Halt;
- end;
- procedure InitializeCommonVars;
- { Initializes variables shared between Setup and Uninstall }
- begin
- IsAdmin := IsAdminLoggedOn;
- IsPowerUserOrAdmin := IsAdmin or IsPowerUserLoggedOn;
- 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^, Cardinal(Bytes));
- if Stream <> nil then
- Stream.WriteBuffer(Buf^, Bytes);
- Dec(BytesLeft, Bytes);
- end;
- finally
- Dispose(Buf);
- end;
- end;
- function ReadWizardImage(const Reader: TCompressedBlockReader): TGraphic;
- begin
- const MemStream = TMemoryStream.Create;
- try
- ReadFileIntoStream(Reader, MemStream);
- MemStream.Seek(0, soFromBeginning);
- if TPngImage.CanLoadFromStream(MemStream) then
- Result := TPngImage.Create
- else begin
- Result := TBitmap.Create;
- TBitmap(Result).AlphaFormat := TAlphaFormat(SetupHeader.WizardImageAlphaFormat);
- end;
- Result.LoadFromStream(MemStream);
- finally
- MemStream.Free;
- end;
- end;
- procedure ReadWizardImages(const Reader: TCompressedBlockReader; const WizardImages: TWizardImages;
- const WantImages: Boolean);
- begin
- var Count: Integer;
- Reader.Read(Count, SizeOf(Integer));
- if Count = -1 then { True if DynamicDark images were same as 'regular' images }
- Exit;
- if WantImages then
- WizardImages.Clear; { This is to clear 'regular' images which have been read already }
- for var I := 0 to Count-1 do begin
- if WantImages then
- WizardImages.Add(ReadWizardImage(Reader))
- else
- ReadFileIntoStream(Reader, nil);
- 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(PSetupVersionData(PByte(P) + MinVersionOfs)^,
- PSetupVersionData(PByte(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 ShouldEnableRedirectionGuard: Boolean;
- begin
- Result := InitRedirectionGuard or
- ((shRedirectionGuard in SetupHeader.Options) and not InitNoRedirectionGuard);
- 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): Int64;
- begin
- { Also see RecurseExternalFiles above and RecurseExternalCopyFiles in Setup.Install
- Also see RecurseExternalArchiveGetSizeOfFiles directly below }
- Result := 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;
- Inc(Result, FindDataFileSizeToInt64(FindData));
- 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);
- Inc(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): Int64;
- begin
- { See above }
- Result := 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;
- Inc(Result, FindDataFileSizeToInt64(FindData));
- 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' + MainIconPostfix, 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' + MainIconPostfix, 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;
- SetupFile: TFile;
- TestID: TSetupID;
- NameAndVersionMsg: String;
- NextAllowedLevel: Integer;
- LastShownComponentEntry, ComponentEntry: PSetupComponentEntry;
- 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 SameText(ParamName, '/SL5=') then begin
- StartParam := 2;
- SetupLdrMode := True;
- SetupNotifyWnd := HWND(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 SameText(ParamName, '/Log') then begin
- EnableLogging := True;
- LogFilename := '';
- end else if SameText(ParamName, '/Log=') then begin
- EnableLogging := True;
- LogFilename := ParamValue;
- end else if SameText(ParamName, '/Silent') then
- InitSilent := True
- else if SameText(ParamName, '/VerySilent') then
- InitVerySilent := True
- else if SameText(ParamName, '/NoRestart') then
- InitNoRestart := True
- else if SameText(ParamName, '/CloseApplications') then
- InitCloseApplications := True
- else if SameText(ParamName, '/NoCloseApplications') then
- InitNoCloseApplications := True
- else if SameText(ParamName, '/ForceCloseApplications') then
- InitForceCloseApplications := True
- else if SameText(ParamName, '/NoForceCloseApplications') then
- InitNoForceCloseApplications := True
- else if SameText(ParamName, '/LogCloseApplications') then
- InitLogCloseApplications := True
- else if SameText(ParamName, '/RestartApplications') then
- InitRestartApplications := True
- else if SameText(ParamName, '/NoRestartApplications') then
- InitNoRestartApplications := True
- else if SameText(ParamName, '/RedirectionGuard') then
- InitRedirectionGuard := True
- else if SameText(ParamName, '/NoRedirectionGuard') then
- InitNoRedirectionGuard := True
- else if SameText(ParamName, '/NoIcons') then
- InitNoIcons := True
- else if SameText(ParamName, '/NoCancel') then
- InitNoCancel := True
- else if SameText(ParamName, '/NoStyle') then
- InitNoStyle := True
- else if SameText(ParamName, '/Lang=') then
- InitLang := ParamValue
- else if SameText(ParamName, '/Type=') then
- InitSetupType := ParamValue
- else if SameText(ParamName, '/Components=') then begin
- InitComponentsSpecified := True;
- SetStringsFromCommaString(InitComponents, SlashesToBackslashes(ParamValue));
- end else if SameText(ParamName, '/Tasks=') then begin
- InitDeselectAllTasks := True;
- SetStringsFromCommaString(InitTasks, SlashesToBackslashes(ParamValue));
- end else if SameText(ParamName, '/MergeTasks=') then begin
- InitDeselectAllTasks := False;
- SetStringsFromCommaString(InitTasks, SlashesToBackslashes(ParamValue));
- end else if SameText(ParamName, '/LoadInf=') then
- InitLoadInf := PathExpand(ParamValue)
- else if SameText(ParamName, '/SaveInf=') then
- InitSaveInf := PathExpand(ParamValue)
- else if SameText(ParamName, '/DIR=') then
- InitDir := ParamValue
- else if SameText(ParamName, '/GROUP=') then
- InitProgramGroup := ParamValue
- else if SameText(ParamName, '/Password=') then
- InitPassword := ParamValue
- else if SameText(ParamName, '/RestartExitCode=') then
- InitRestartExitCode := StrToIntDef(ParamValue, 0)
- else if SameText(ParamName, '/SuppressMsgBoxes') then
- WantToSuppressMsgBoxes := True
- else if SameText(ParamName, '/DETACHEDMSG') then { for debugging }
- DetachedUninstMsgFile := True
- else if SameText(ParamName, '/SPAWNWND=') then begin
- ParamIsAutomaticInternal := True; { sent by RespawnSetupElevated }
- IsRespawnedProcess := True;
- InitializeSpawnClient(StrToWnd(ParamValue));
- end else if SameText(ParamName, '/NOTIFYWND=') then begin
- ParamIsAutomaticInternal := True; { sent by RespawnSetupElevated }
- { /NOTIFYWND= takes precedence over any previously set SetupNotifyWnd }
- SetupNotifyWnd := StrToWnd(ParamValue);
- SetupNotifyWndPresent := True;
- end else if SameText(ParamName, '/DebugSpawnServer') then { for debugging }
- EnterSpawnServerDebugMode { does not return }
- else if SameText(ParamName, '/DEBUGWND=') then begin
- ParamIsAutomaticInternal := True; { sent by IDE.MainForm's StartProcess }
- DebugServerWnd := StrToWnd(ParamValue);
- end else if SameText(ParamName, '/ALLUSERS') then begin
- InitPrivilegesRequired := prAdmin;
- HasInitPrivilegesRequired := True;
- end else if SameText(ParamName, '/CURRENTUSER') 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 }
- var SetupFilename: String;
- if not SetupLdrMode then begin
- SetupFilename := PathChangeExt(SetupLdrOriginalFilename, '') + '-0.bin';
- {$IFDEF DEBUG}
- { Also see TFileExtractor.FindSliceFilename }
- SetupFileName := SetupFileName.Replace('SetupCustomStyle', 'Setup');
- {$ENDIF}
- 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;
- if (SetupFile.Read(SetupEncryptionHeaderCRC, SizeOf(SetupEncryptionHeaderCRC)) <> SizeOf(SetupEncryptionHeaderCRC)) or
- (SetupFile.Read(SetupEncryptionHeader, SizeOf(SetupEncryptionHeader)) <> SizeOf(SetupEncryptionHeader)) then
- AbortInit(msgSetupFileCorrupt);
- if SetupEncryptionHeaderCRC <> GetCRC32(SetupEncryptionHeader, SizeOf(SetupEncryptionHeader)) then
- AbortInit(msgSetupFileCorrupt);
- 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 }
- { SetupHeader.WizardBackColor may be overwritten below, and we need to keep the original
- value for Uninstall }
- OrigSetupHeaderWizardBackColor := SetupHeader.WizardBackColor;
- { 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;
- { Apply style - also see Setup.Uninstall's RunSecondPhase
- Must be ordered after ActivateDefaultLanguage since TTaskDialogForm
- and its parent TSetupForm use LangOptions and SetupMessages.
- Note: when debugging Setup.e32 or SetupCustomStyle.e32 it will see the default resources,
- instead of the ones prepared by the compiler. This is because the .e32 is started, and
- not the .exe prepared by the compiler. This is not noticable except for the VCL style
- resources: the MYSTYLE1 and MYSTYLE1_DARK styles will always be missing. In this case
- it will use the ZIRCON style, see below. This does *not* mean Uninstall will then
- also use ZIRCON. To test Uninstall styling use a real Setup compiled by the
- compiler. }
- var WantWizardImagesDynamicDark := False;
- IsWinDark := DarkModeActive;
- if not HighContrastActive and not InitNoStyle then begin
- const IsDynamicDark = (SetupHeader.WizardDarkStyle = wdsDynamic) and IsWinDark;
- const IsForcedDark = SetupHeader.WizardDarkStyle = wdsDark;
- if IsDynamicDark then begin
- SetupHeader.WizardImageBackColor := SetupHeader.WizardImageBackColorDynamicDark;
- SetupHeader.WizardSmallImageBackColor := SetupHeader.WizardSmallImageBackColorDynamicDark;
- SetupHeader.WizardBackColor := SetupHeader.WizardBackColorDynamicDark;
- MainIconPostfix := '_DARK';
- { If the main icon is custom, a dark version will not be available, so check for this }
- if FindResource(HInstance, PChar('MAINICON' + MainIconPostfix), RT_GROUP_ICON) = 0 then
- MainIconPostfix := '';
- WantWizardImagesDynamicDark := True; { Handled below }
- end;
- if IsDynamicDark or IsForcedDark then begin
- IsDarkInstallMode := True;
- WizardIconsPostfix := '_DARK';
- end;
- TStyleManager.AutoDiscoverStyleResources := False;
- { Also see comment above }
- var StyleName := 'MYSTYLE1';
- if IsDynamicDark then
- StyleName := StyleName + '_DARK';
- var Handle: TStyleManager.TStyleServicesHandle;
- if TStyleManager.TryLoadFromResource(HInstance, StyleName, 'VCLSTYLE', Handle)
- {$IFDEF DEBUG}
- or TStyleManager.TryLoadFromResource(HInstance, 'ZIRCON', 'VCLSTYLE', Handle)
- { Comment the line above to activate WINDOWSPOLARDARK instead of ZIRCON }
- or TStyleManager.TryLoadFromResource(HInstance, 'WINDOWSPOLARDARK', 'VCLSTYLE', Handle)
- {$ENDIF}
- then begin
- TStyleManager.SetStyle(Handle);
- if not (shWizardBorderStyled in SetupHeader.Options) then
- TStyleManager.FormBorderStyle := fbsSystemStyle;
- CustomWizardBackground := SetupHeader.WizardBackColor <> clNone;
- if CustomWizardBackground then begin
- TCustomStyleEngine.RegisterStyleHook(TSetupForm, TFormBackgroundStyleHook);
- TFormBackgroundStyleHook.BackColor := SetupHeader.WizardBackColor;
- end;
- end;
- end;
- { 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);
- RedirectionGuardConfigure(ShouldEnableRedirectionGuard);
- 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 }
- ReadWizardImages(Reader, WizardImages, True); { If WantWizardImagesDynamicDark is True, then these might be overwritten below }
- ReadWizardImages(Reader, WizardSmallImages, True); { Same }
- ReadWizardImages(Reader, WizardBackImages, True); { Same }
- ReadWizardImages(Reader, WizardImages, WantWizardImagesDynamicDark);
- ReadWizardImages(Reader, WizardSmallImages, WantWizardImagesDynamicDark);
- ReadWizardImages(Reader, WizardBackImages, WantWizardImagesDynamicDark);
- { 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;
- RedirectionGuardConfigure(ShouldEnableRedirectionGuard);
- { Test code. Originally planned to call DeleteResidualTempUninstallDirs
- during Setup's startup too, but decided against it; it's not really
- necessary and could slow down the startup (slightly). }
- (*
- for var Z := 1 to 5 do begin
- const TD = CreateTempDir('-uninstall.tmp', IsAdmin);
- TFile.Create(TD + '\_unins.tmp', fdCreateNew, faWrite, fsNone).Free;
- TFile.Create(TD + '\_unins-done.tmp', fdCreateNew, faWrite, fsNone).Free;
- end;
- DeleteResidualTempUninstallDirs;
- *)
- { 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}
- Inc(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}
- Inc(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
- var MinimumTypeSpace: Int64 := 0;
- 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 (Size < MinimumTypeSpace) then
- MinimumTypeSpace := Size;
- end;
- end;
- Inc(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.FlipAndCenterIfNeeded(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 := Word((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;
- begin
- FreeAndNil(WizardBackImages);
- FreeAndNil(WizardSmallImages);
- FreeAndNil(WizardImages);
- 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 := TWizardImages.Create;
- WizardSmallImages := TWizardImages.Create;
- WizardBackImages := TWizardImages.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.
|