Setup.MainFunc.pas 171 KB

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