Compiler.SetupCompiler.pas 315 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107110811091110111111121113111411151116111711181119112011211122112311241125112611271128112911301131113211331134113511361137113811391140114111421143114411451146114711481149115011511152115311541155115611571158115911601161116211631164116511661167116811691170117111721173117411751176117711781179118011811182118311841185118611871188118911901191119211931194119511961197119811991200120112021203120412051206120712081209121012111212121312141215121612171218121912201221122212231224122512261227122812291230123112321233123412351236123712381239124012411242124312441245124612471248124912501251125212531254125512561257125812591260126112621263126412651266126712681269127012711272127312741275127612771278127912801281128212831284128512861287128812891290129112921293129412951296129712981299130013011302130313041305130613071308130913101311131213131314131513161317131813191320132113221323132413251326132713281329133013311332133313341335133613371338133913401341134213431344134513461347134813491350135113521353135413551356135713581359136013611362136313641365136613671368136913701371137213731374137513761377137813791380138113821383138413851386138713881389139013911392139313941395139613971398139914001401140214031404140514061407140814091410141114121413141414151416141714181419142014211422142314241425142614271428142914301431143214331434143514361437143814391440144114421443144414451446144714481449145014511452145314541455145614571458145914601461146214631464146514661467146814691470147114721473147414751476147714781479148014811482148314841485148614871488148914901491149214931494149514961497149814991500150115021503150415051506150715081509151015111512151315141515151615171518151915201521152215231524152515261527152815291530153115321533153415351536153715381539154015411542154315441545154615471548154915501551155215531554155515561557155815591560156115621563156415651566156715681569157015711572157315741575157615771578157915801581158215831584158515861587158815891590159115921593159415951596159715981599160016011602160316041605160616071608160916101611161216131614161516161617161816191620162116221623162416251626162716281629163016311632163316341635163616371638163916401641164216431644164516461647164816491650165116521653165416551656165716581659166016611662166316641665166616671668166916701671167216731674167516761677167816791680168116821683168416851686168716881689169016911692169316941695169616971698169917001701170217031704170517061707170817091710171117121713171417151716171717181719172017211722172317241725172617271728172917301731173217331734173517361737173817391740174117421743174417451746174717481749175017511752175317541755175617571758175917601761176217631764176517661767176817691770177117721773177417751776177717781779178017811782178317841785178617871788178917901791179217931794179517961797179817991800180118021803180418051806180718081809181018111812181318141815181618171818181918201821182218231824182518261827182818291830183118321833183418351836183718381839184018411842184318441845184618471848184918501851185218531854185518561857185818591860186118621863186418651866186718681869187018711872187318741875187618771878187918801881188218831884188518861887188818891890189118921893189418951896189718981899190019011902190319041905190619071908190919101911191219131914191519161917191819191920192119221923192419251926192719281929193019311932193319341935193619371938193919401941194219431944194519461947194819491950195119521953195419551956195719581959196019611962196319641965196619671968196919701971197219731974197519761977197819791980198119821983198419851986198719881989199019911992199319941995199619971998199920002001200220032004200520062007200820092010201120122013201420152016201720182019202020212022202320242025202620272028202920302031203220332034203520362037203820392040204120422043204420452046204720482049205020512052205320542055205620572058205920602061206220632064206520662067206820692070207120722073207420752076207720782079208020812082208320842085208620872088208920902091209220932094209520962097209820992100210121022103210421052106210721082109211021112112211321142115211621172118211921202121212221232124212521262127212821292130213121322133213421352136213721382139214021412142214321442145214621472148214921502151215221532154215521562157215821592160216121622163216421652166216721682169217021712172217321742175217621772178217921802181218221832184218521862187218821892190219121922193219421952196219721982199220022012202220322042205220622072208220922102211221222132214221522162217221822192220222122222223222422252226222722282229223022312232223322342235223622372238223922402241224222432244224522462247224822492250225122522253225422552256225722582259226022612262226322642265226622672268226922702271227222732274227522762277227822792280228122822283228422852286228722882289229022912292229322942295229622972298229923002301230223032304230523062307230823092310231123122313231423152316231723182319232023212322232323242325232623272328232923302331233223332334233523362337233823392340234123422343234423452346234723482349235023512352235323542355235623572358235923602361236223632364236523662367236823692370237123722373237423752376237723782379238023812382238323842385238623872388238923902391239223932394239523962397239823992400240124022403240424052406240724082409241024112412241324142415241624172418241924202421242224232424242524262427242824292430243124322433243424352436243724382439244024412442244324442445244624472448244924502451245224532454245524562457245824592460246124622463246424652466246724682469247024712472247324742475247624772478247924802481248224832484248524862487248824892490249124922493249424952496249724982499250025012502250325042505250625072508250925102511251225132514251525162517251825192520252125222523252425252526252725282529253025312532253325342535253625372538253925402541254225432544254525462547254825492550255125522553255425552556255725582559256025612562256325642565256625672568256925702571257225732574257525762577257825792580258125822583258425852586258725882589259025912592259325942595259625972598259926002601260226032604260526062607260826092610261126122613261426152616261726182619262026212622262326242625262626272628262926302631263226332634263526362637263826392640264126422643264426452646264726482649265026512652265326542655265626572658265926602661266226632664266526662667266826692670267126722673267426752676267726782679268026812682268326842685268626872688268926902691269226932694269526962697269826992700270127022703270427052706270727082709271027112712271327142715271627172718271927202721272227232724272527262727272827292730273127322733273427352736273727382739274027412742274327442745274627472748274927502751275227532754275527562757275827592760276127622763276427652766276727682769277027712772277327742775277627772778277927802781278227832784278527862787278827892790279127922793279427952796279727982799280028012802280328042805280628072808280928102811281228132814281528162817281828192820282128222823282428252826282728282829283028312832283328342835283628372838283928402841284228432844284528462847284828492850285128522853285428552856285728582859286028612862286328642865286628672868286928702871287228732874287528762877287828792880288128822883288428852886288728882889289028912892289328942895289628972898289929002901290229032904290529062907290829092910291129122913291429152916291729182919292029212922292329242925292629272928292929302931293229332934293529362937293829392940294129422943294429452946294729482949295029512952295329542955295629572958295929602961296229632964296529662967296829692970297129722973297429752976297729782979298029812982298329842985298629872988298929902991299229932994299529962997299829993000300130023003300430053006300730083009301030113012301330143015301630173018301930203021302230233024302530263027302830293030303130323033303430353036303730383039304030413042304330443045304630473048304930503051305230533054305530563057305830593060306130623063306430653066306730683069307030713072307330743075307630773078307930803081308230833084308530863087308830893090309130923093309430953096309730983099310031013102310331043105310631073108310931103111311231133114311531163117311831193120312131223123312431253126312731283129313031313132313331343135313631373138313931403141314231433144314531463147314831493150315131523153315431553156315731583159316031613162316331643165316631673168316931703171317231733174317531763177317831793180318131823183318431853186318731883189319031913192319331943195319631973198319932003201320232033204320532063207320832093210321132123213321432153216321732183219322032213222322332243225322632273228322932303231323232333234323532363237323832393240324132423243324432453246324732483249325032513252325332543255325632573258325932603261326232633264326532663267326832693270327132723273327432753276327732783279328032813282328332843285328632873288328932903291329232933294329532963297329832993300330133023303330433053306330733083309331033113312331333143315331633173318331933203321332233233324332533263327332833293330333133323333333433353336333733383339334033413342334333443345334633473348334933503351335233533354335533563357335833593360336133623363336433653366336733683369337033713372337333743375337633773378337933803381338233833384338533863387338833893390339133923393339433953396339733983399340034013402340334043405340634073408340934103411341234133414341534163417341834193420342134223423342434253426342734283429343034313432343334343435343634373438343934403441344234433444344534463447344834493450345134523453345434553456345734583459346034613462346334643465346634673468346934703471347234733474347534763477347834793480348134823483348434853486348734883489349034913492349334943495349634973498349935003501350235033504350535063507350835093510351135123513351435153516351735183519352035213522352335243525352635273528352935303531353235333534353535363537353835393540354135423543354435453546354735483549355035513552355335543555355635573558355935603561356235633564356535663567356835693570357135723573357435753576357735783579358035813582358335843585358635873588358935903591359235933594359535963597359835993600360136023603360436053606360736083609361036113612361336143615361636173618361936203621362236233624362536263627362836293630363136323633363436353636363736383639364036413642364336443645364636473648364936503651365236533654365536563657365836593660366136623663366436653666366736683669367036713672367336743675367636773678367936803681368236833684368536863687368836893690369136923693369436953696369736983699370037013702370337043705370637073708370937103711371237133714371537163717371837193720372137223723372437253726372737283729373037313732373337343735373637373738373937403741374237433744374537463747374837493750375137523753375437553756375737583759376037613762376337643765376637673768376937703771377237733774377537763777377837793780378137823783378437853786378737883789379037913792379337943795379637973798379938003801380238033804380538063807380838093810381138123813381438153816381738183819382038213822382338243825382638273828382938303831383238333834383538363837383838393840384138423843384438453846384738483849385038513852385338543855385638573858385938603861386238633864386538663867386838693870387138723873387438753876387738783879388038813882388338843885388638873888388938903891389238933894389538963897389838993900390139023903390439053906390739083909391039113912391339143915391639173918391939203921392239233924392539263927392839293930393139323933393439353936393739383939394039413942394339443945394639473948394939503951395239533954395539563957395839593960396139623963396439653966396739683969397039713972397339743975397639773978397939803981398239833984398539863987398839893990399139923993399439953996399739983999400040014002400340044005400640074008400940104011401240134014401540164017401840194020402140224023402440254026402740284029403040314032403340344035403640374038403940404041404240434044404540464047404840494050405140524053405440554056405740584059406040614062406340644065406640674068406940704071407240734074407540764077407840794080408140824083408440854086408740884089409040914092409340944095409640974098409941004101410241034104410541064107410841094110411141124113411441154116411741184119412041214122412341244125412641274128412941304131413241334134413541364137413841394140414141424143414441454146414741484149415041514152415341544155415641574158415941604161416241634164416541664167416841694170417141724173417441754176417741784179418041814182418341844185418641874188418941904191419241934194419541964197419841994200420142024203420442054206420742084209421042114212421342144215421642174218421942204221422242234224422542264227422842294230423142324233423442354236423742384239424042414242424342444245424642474248424942504251425242534254425542564257425842594260426142624263426442654266426742684269427042714272427342744275427642774278427942804281428242834284428542864287428842894290429142924293429442954296429742984299430043014302430343044305430643074308430943104311431243134314431543164317431843194320432143224323432443254326432743284329433043314332433343344335433643374338433943404341434243434344434543464347434843494350435143524353435443554356435743584359436043614362436343644365436643674368436943704371437243734374437543764377437843794380438143824383438443854386438743884389439043914392439343944395439643974398439944004401440244034404440544064407440844094410441144124413441444154416441744184419442044214422442344244425442644274428442944304431443244334434443544364437443844394440444144424443444444454446444744484449445044514452445344544455445644574458445944604461446244634464446544664467446844694470447144724473447444754476447744784479448044814482448344844485448644874488448944904491449244934494449544964497449844994500450145024503450445054506450745084509451045114512451345144515451645174518451945204521452245234524452545264527452845294530453145324533453445354536453745384539454045414542454345444545454645474548454945504551455245534554455545564557455845594560456145624563456445654566456745684569457045714572457345744575457645774578457945804581458245834584458545864587458845894590459145924593459445954596459745984599460046014602460346044605460646074608460946104611461246134614461546164617461846194620462146224623462446254626462746284629463046314632463346344635463646374638463946404641464246434644464546464647464846494650465146524653465446554656465746584659466046614662466346644665466646674668466946704671467246734674467546764677467846794680468146824683468446854686468746884689469046914692469346944695469646974698469947004701470247034704470547064707470847094710471147124713471447154716471747184719472047214722472347244725472647274728472947304731473247334734473547364737473847394740474147424743474447454746474747484749475047514752475347544755475647574758475947604761476247634764476547664767476847694770477147724773477447754776477747784779478047814782478347844785478647874788478947904791479247934794479547964797479847994800480148024803480448054806480748084809481048114812481348144815481648174818481948204821482248234824482548264827482848294830483148324833483448354836483748384839484048414842484348444845484648474848484948504851485248534854485548564857485848594860486148624863486448654866486748684869487048714872487348744875487648774878487948804881488248834884488548864887488848894890489148924893489448954896489748984899490049014902490349044905490649074908490949104911491249134914491549164917491849194920492149224923492449254926492749284929493049314932493349344935493649374938493949404941494249434944494549464947494849494950495149524953495449554956495749584959496049614962496349644965496649674968496949704971497249734974497549764977497849794980498149824983498449854986498749884989499049914992499349944995499649974998499950005001500250035004500550065007500850095010501150125013501450155016501750185019502050215022502350245025502650275028502950305031503250335034503550365037503850395040504150425043504450455046504750485049505050515052505350545055505650575058505950605061506250635064506550665067506850695070507150725073507450755076507750785079508050815082508350845085508650875088508950905091509250935094509550965097509850995100510151025103510451055106510751085109511051115112511351145115511651175118511951205121512251235124512551265127512851295130513151325133513451355136513751385139514051415142514351445145514651475148514951505151515251535154515551565157515851595160516151625163516451655166516751685169517051715172517351745175517651775178517951805181518251835184518551865187518851895190519151925193519451955196519751985199520052015202520352045205520652075208520952105211521252135214521552165217521852195220522152225223522452255226522752285229523052315232523352345235523652375238523952405241524252435244524552465247524852495250525152525253525452555256525752585259526052615262526352645265526652675268526952705271527252735274527552765277527852795280528152825283528452855286528752885289529052915292529352945295529652975298529953005301530253035304530553065307530853095310531153125313531453155316531753185319532053215322532353245325532653275328532953305331533253335334533553365337533853395340534153425343534453455346534753485349535053515352535353545355535653575358535953605361536253635364536553665367536853695370537153725373537453755376537753785379538053815382538353845385538653875388538953905391539253935394539553965397539853995400540154025403540454055406540754085409541054115412541354145415541654175418541954205421542254235424542554265427542854295430543154325433543454355436543754385439544054415442544354445445544654475448544954505451545254535454545554565457545854595460546154625463546454655466546754685469547054715472547354745475547654775478547954805481548254835484548554865487548854895490549154925493549454955496549754985499550055015502550355045505550655075508550955105511551255135514551555165517551855195520552155225523552455255526552755285529553055315532553355345535553655375538553955405541554255435544554555465547554855495550555155525553555455555556555755585559556055615562556355645565556655675568556955705571557255735574557555765577557855795580558155825583558455855586558755885589559055915592559355945595559655975598559956005601560256035604560556065607560856095610561156125613561456155616561756185619562056215622562356245625562656275628562956305631563256335634563556365637563856395640564156425643564456455646564756485649565056515652565356545655565656575658565956605661566256635664566556665667566856695670567156725673567456755676567756785679568056815682568356845685568656875688568956905691569256935694569556965697569856995700570157025703570457055706570757085709571057115712571357145715571657175718571957205721572257235724572557265727572857295730573157325733573457355736573757385739574057415742574357445745574657475748574957505751575257535754575557565757575857595760576157625763576457655766576757685769577057715772577357745775577657775778577957805781578257835784578557865787578857895790579157925793579457955796579757985799580058015802580358045805580658075808580958105811581258135814581558165817581858195820582158225823582458255826582758285829583058315832583358345835583658375838583958405841584258435844584558465847584858495850585158525853585458555856585758585859586058615862586358645865586658675868586958705871587258735874587558765877587858795880588158825883588458855886588758885889589058915892589358945895589658975898589959005901590259035904590559065907590859095910591159125913591459155916591759185919592059215922592359245925592659275928592959305931593259335934593559365937593859395940594159425943594459455946594759485949595059515952595359545955595659575958595959605961596259635964596559665967596859695970597159725973597459755976597759785979598059815982598359845985598659875988598959905991599259935994599559965997599859996000600160026003600460056006600760086009601060116012601360146015601660176018601960206021602260236024602560266027602860296030603160326033603460356036603760386039604060416042604360446045604660476048604960506051605260536054605560566057605860596060606160626063606460656066606760686069607060716072607360746075607660776078607960806081608260836084608560866087608860896090609160926093609460956096609760986099610061016102610361046105610661076108610961106111611261136114611561166117611861196120612161226123612461256126612761286129613061316132613361346135613661376138613961406141614261436144614561466147614861496150615161526153615461556156615761586159616061616162616361646165616661676168616961706171617261736174617561766177617861796180618161826183618461856186618761886189619061916192619361946195619661976198619962006201620262036204620562066207620862096210621162126213621462156216621762186219622062216222622362246225622662276228622962306231623262336234623562366237623862396240624162426243624462456246624762486249625062516252625362546255625662576258625962606261626262636264626562666267626862696270627162726273627462756276627762786279628062816282628362846285628662876288628962906291629262936294629562966297629862996300630163026303630463056306630763086309631063116312631363146315631663176318631963206321632263236324632563266327632863296330633163326333633463356336633763386339634063416342634363446345634663476348634963506351635263536354635563566357635863596360636163626363636463656366636763686369637063716372637363746375637663776378637963806381638263836384638563866387638863896390639163926393639463956396639763986399640064016402640364046405640664076408640964106411641264136414641564166417641864196420642164226423642464256426642764286429643064316432643364346435643664376438643964406441644264436444644564466447644864496450645164526453645464556456645764586459646064616462646364646465646664676468646964706471647264736474647564766477647864796480648164826483648464856486648764886489649064916492649364946495649664976498649965006501650265036504650565066507650865096510651165126513651465156516651765186519652065216522652365246525652665276528652965306531653265336534653565366537653865396540654165426543654465456546654765486549655065516552655365546555655665576558655965606561656265636564656565666567656865696570657165726573657465756576657765786579658065816582658365846585658665876588658965906591659265936594659565966597659865996600660166026603660466056606660766086609661066116612661366146615661666176618661966206621662266236624662566266627662866296630663166326633663466356636663766386639664066416642664366446645664666476648664966506651665266536654665566566657665866596660666166626663666466656666666766686669667066716672667366746675667666776678667966806681668266836684668566866687668866896690669166926693669466956696669766986699670067016702670367046705670667076708670967106711671267136714671567166717671867196720672167226723672467256726672767286729673067316732673367346735673667376738673967406741674267436744674567466747674867496750675167526753675467556756675767586759676067616762676367646765676667676768676967706771677267736774677567766777677867796780678167826783678467856786678767886789679067916792679367946795679667976798679968006801680268036804680568066807680868096810681168126813681468156816681768186819682068216822682368246825682668276828682968306831683268336834683568366837683868396840684168426843684468456846684768486849685068516852685368546855685668576858685968606861686268636864686568666867686868696870687168726873687468756876687768786879688068816882688368846885688668876888688968906891689268936894689568966897689868996900690169026903690469056906690769086909691069116912691369146915691669176918691969206921692269236924692569266927692869296930693169326933693469356936693769386939694069416942694369446945694669476948694969506951695269536954695569566957695869596960696169626963696469656966696769686969697069716972697369746975697669776978697969806981698269836984698569866987698869896990699169926993699469956996699769986999700070017002700370047005700670077008700970107011701270137014701570167017701870197020702170227023702470257026702770287029703070317032703370347035703670377038703970407041704270437044704570467047704870497050705170527053705470557056705770587059706070617062706370647065706670677068706970707071707270737074707570767077707870797080708170827083708470857086708770887089709070917092709370947095709670977098709971007101710271037104710571067107710871097110711171127113711471157116711771187119712071217122712371247125712671277128712971307131713271337134713571367137713871397140714171427143714471457146714771487149715071517152715371547155715671577158715971607161716271637164716571667167716871697170717171727173717471757176717771787179718071817182718371847185718671877188718971907191719271937194719571967197719871997200720172027203720472057206720772087209721072117212721372147215721672177218721972207221722272237224722572267227722872297230723172327233723472357236723772387239724072417242724372447245724672477248724972507251725272537254725572567257725872597260726172627263726472657266726772687269727072717272727372747275727672777278727972807281728272837284728572867287728872897290729172927293729472957296729772987299730073017302730373047305730673077308730973107311731273137314731573167317731873197320732173227323732473257326732773287329733073317332733373347335733673377338733973407341734273437344734573467347734873497350735173527353735473557356735773587359736073617362736373647365736673677368736973707371737273737374737573767377737873797380738173827383738473857386738773887389739073917392739373947395739673977398739974007401740274037404740574067407740874097410741174127413741474157416741774187419742074217422742374247425742674277428742974307431743274337434743574367437743874397440744174427443744474457446744774487449745074517452745374547455745674577458745974607461746274637464746574667467746874697470747174727473747474757476747774787479748074817482748374847485748674877488748974907491749274937494749574967497749874997500750175027503750475057506750775087509751075117512751375147515751675177518751975207521752275237524752575267527752875297530753175327533753475357536753775387539754075417542754375447545754675477548754975507551755275537554755575567557755875597560756175627563756475657566756775687569757075717572757375747575757675777578757975807581758275837584758575867587758875897590759175927593759475957596759775987599760076017602760376047605760676077608760976107611761276137614761576167617761876197620762176227623762476257626762776287629763076317632763376347635763676377638763976407641764276437644764576467647764876497650765176527653765476557656765776587659766076617662766376647665766676677668766976707671767276737674767576767677767876797680768176827683768476857686768776887689769076917692769376947695769676977698769977007701770277037704770577067707770877097710771177127713771477157716771777187719772077217722772377247725772677277728772977307731773277337734773577367737773877397740774177427743774477457746774777487749775077517752775377547755775677577758775977607761776277637764776577667767776877697770777177727773777477757776777777787779778077817782778377847785778677877788778977907791779277937794779577967797779877997800780178027803780478057806780778087809781078117812781378147815781678177818781978207821782278237824782578267827782878297830783178327833783478357836783778387839784078417842784378447845784678477848784978507851785278537854785578567857785878597860786178627863786478657866786778687869787078717872787378747875787678777878787978807881788278837884788578867887788878897890789178927893789478957896789778987899790079017902790379047905790679077908790979107911791279137914791579167917791879197920792179227923792479257926792779287929793079317932793379347935793679377938793979407941794279437944794579467947794879497950795179527953795479557956795779587959796079617962796379647965796679677968796979707971797279737974797579767977797879797980798179827983798479857986798779887989799079917992799379947995799679977998799980008001800280038004800580068007800880098010801180128013801480158016801780188019802080218022802380248025802680278028802980308031803280338034803580368037803880398040804180428043804480458046804780488049805080518052805380548055805680578058805980608061806280638064806580668067806880698070807180728073807480758076807780788079808080818082808380848085808680878088808980908091809280938094809580968097809880998100810181028103810481058106810781088109811081118112811381148115811681178118811981208121812281238124812581268127812881298130813181328133813481358136813781388139814081418142814381448145814681478148814981508151815281538154815581568157815881598160816181628163816481658166816781688169817081718172817381748175817681778178817981808181818281838184818581868187818881898190819181928193819481958196819781988199820082018202820382048205820682078208820982108211821282138214821582168217821882198220822182228223822482258226822782288229823082318232823382348235823682378238823982408241824282438244824582468247824882498250825182528253825482558256825782588259826082618262826382648265826682678268826982708271827282738274827582768277827882798280828182828283828482858286828782888289829082918292829382948295829682978298829983008301830283038304830583068307830883098310831183128313831483158316831783188319832083218322832383248325832683278328832983308331833283338334833583368337833883398340834183428343834483458346834783488349835083518352835383548355835683578358835983608361836283638364836583668367836883698370837183728373837483758376837783788379838083818382838383848385838683878388838983908391839283938394839583968397839883998400840184028403840484058406840784088409841084118412841384148415841684178418841984208421842284238424842584268427842884298430843184328433843484358436843784388439844084418442844384448445
  1. unit Compiler.SetupCompiler;
  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. Compiler
  8. }
  9. {x$DEFINE STATICPREPROC}
  10. { For debugging purposes, remove the 'x' to have it link the ISPP code into this
  11. program and not depend on ISPP.dll. You will also need to add the Src
  12. folder to the Delphi Compiler Search path in the project options. Most useful
  13. when combined with IDE.MainForm's or ISCC's STATICCOMPILER. }
  14. interface
  15. uses
  16. Windows, SysUtils, Classes, Generics.Collections,
  17. SimpleExpression, SHA256, ChaCha20, Shared.SetupTypes,
  18. Shared.Struct, Shared.CompilerInt.Struct, Shared.PreprocInt, Shared.SetupMessageIDs,
  19. Shared.SetupSectionDirectives, Shared.VerInfoFunc, Shared.Int64Em, Shared.DebugStruct,
  20. Compiler.ScriptCompiler, Compiler.StringLists, Compression.LZMACompressor;
  21. type
  22. EISCompileError = class(Exception);
  23. TParamFlags = set of (piRequired, piNoEmpty, piNoQuotes);
  24. TParamInfo = record
  25. Name: String;
  26. Flags: TParamFlags;
  27. end;
  28. TParamValue = record
  29. Found: Boolean;
  30. Data: String;
  31. end;
  32. TEnumIniSectionProc = procedure(const Line: PChar; const Ext: Integer) of object;
  33. TAllowedConst = (acOldData, acBreak);
  34. TAllowedConsts = set of TAllowedConst;
  35. TPreLangData = class
  36. public
  37. Name: String;
  38. LanguageCodePage: Integer;
  39. end;
  40. TLangData = class
  41. public
  42. MessagesDefined: array[TSetupMessageID] of Boolean;
  43. Messages: array[TSetupMessageID] of String;
  44. end;
  45. TNameAndAccessMask = record
  46. Name: String;
  47. Mask: DWORD;
  48. end;
  49. TCheckOrInstallKind = (cikCheck, cikDirectiveCheck, cikInstall);
  50. TPrecompiledFile = (pfSetupE32, pfSetupLdrE32, pfIs7zDll, pfIsbunzipDll, pfIsunzlibDll, pfIslzmaExe);
  51. TPrecompiledFiles = set of TPrecompiledFile;
  52. TSetupCompiler = class
  53. private
  54. ScriptFiles: TStringList;
  55. PreprocOptionsString: String;
  56. PreprocCleanupProc: TPreprocCleanupProc;
  57. PreprocCleanupProcData: Pointer;
  58. LanguageEntries,
  59. CustomMessageEntries,
  60. PermissionEntries,
  61. TypeEntries,
  62. ComponentEntries,
  63. TaskEntries,
  64. DirEntries,
  65. ISSigKeyEntries,
  66. FileEntries,
  67. FileLocationEntries,
  68. IconEntries,
  69. IniEntries,
  70. RegistryEntries,
  71. InstallDeleteEntries,
  72. UninstallDeleteEntries,
  73. RunEntries,
  74. UninstallRunEntries: TList;
  75. FileLocationEntryFilenames: THashStringList;
  76. FileLocationEntryExtraInfos: TList;
  77. ISSigKeyEntryExtraInfos: TList;
  78. WarningsList: THashStringList;
  79. ExpectedCustomMessageNames: TStringList;
  80. MissingMessagesWarning, MissingRunOnceIdsWarning, MissingRunOnceIds, NotRecognizedMessagesWarning, UsedUserAreasWarning: Boolean;
  81. UsedUserAreas: TStringList;
  82. PreprocIncludedFilenames: TStringList;
  83. PreprocOutput: String;
  84. DefaultLangData: TLangData;
  85. PreLangDataList, LangDataList: TList;
  86. SignToolList: TList;
  87. SignTools, SignToolsParams: TStringList;
  88. SignToolRetryCount, SignToolRetryDelay, SignToolMinimumTimeBetween: Integer;
  89. SignToolRunMinimized: Boolean;
  90. LastSignCommandStartTick: DWORD;
  91. OutputDir, OutputBaseFilename, OutputManifestFile, SignedUninstallerDir,
  92. ExeFilename: String;
  93. Output, FixedOutput, FixedOutputDir, FixedOutputBaseFilename: Boolean;
  94. CompressMethod: TSetupCompressMethod;
  95. InternalCompressLevel, CompressLevel: Integer;
  96. InternalCompressProps, CompressProps: TLZMACompressorProps;
  97. UseSolidCompression: Boolean;
  98. DontMergeDuplicateFiles: Boolean;
  99. DisablePrecompiledFileVerifications: TPrecompiledFiles;
  100. Password: String;
  101. CryptKey: TSetupEncryptionKey;
  102. TimeStampsInUTC: Boolean;
  103. TimeStampRounding: Integer;
  104. TouchDateOption: (tdCurrent, tdNone, tdExplicit);
  105. TouchDateYear, TouchDateMonth, TouchDateDay: Integer;
  106. TouchTimeOption: (ttCurrent, ttNone, ttExplicit);
  107. TouchTimeHour, TouchTimeMinute, TouchTimeSecond: Integer;
  108. SetupEncryptionHeader: TSetupEncryptionHeader;
  109. SetupHeader: TSetupHeader;
  110. SetupDirectiveLines: array[TSetupSectionDirective] of Integer;
  111. UseSetupLdr, DiskSpanning, TerminalServicesAware, DEPCompatible, ASLRCompatible: Boolean;
  112. DiskSliceSize, DiskClusterSize, SlicesPerDisk, ReserveBytes: Longint;
  113. LicenseFile, InfoBeforeFile, InfoAfterFile, WizardImageFile: String;
  114. WizardSmallImageFile: String;
  115. DefaultDialogFontName: String;
  116. VersionInfoVersion, VersionInfoProductVersion: TFileVersionNumbers;
  117. VersionInfoVersionOriginalValue, VersionInfoCompany, VersionInfoCopyright,
  118. VersionInfoDescription, VersionInfoTextVersion, VersionInfoProductName, VersionInfoOriginalFileName,
  119. VersionInfoProductTextVersion, VersionInfoProductVersionOriginalValue: String;
  120. SetupIconFilename: String;
  121. CodeText: TStringList;
  122. CodeCompiler: TScriptCompiler;
  123. CompiledCodeText: AnsiString;
  124. CompileWasAlreadyCalled: Boolean;
  125. LineFilename: String;
  126. LineNumber: Integer;
  127. DebugInfo, CodeDebugInfo: TMemoryStream;
  128. DebugEntryCount, VariableDebugEntryCount: Integer;
  129. CompiledCodeTextLength, CompiledCodeDebugInfoLength: Integer;
  130. GotPrevFilename: Boolean;
  131. PrevFilename: String;
  132. PrevFileIndex: Integer;
  133. TotalBytesToCompress, BytesCompressedSoFar: Integer64;
  134. CompressionInProgress: Boolean;
  135. CompressionStartTick: DWORD;
  136. CachedUserDocsDir: String;
  137. procedure AddStatus(const S: String; const Warning: Boolean = False);
  138. procedure AddStatusFmt(const Msg: String; const Args: array of const;
  139. const Warning: Boolean);
  140. procedure OnCheckedTrust(CheckedTrust: Boolean);
  141. class procedure AbortCompile(const Msg: String);
  142. class procedure AbortCompileParamError(const Msg, ParamName: String);
  143. function PrependDirName(const Filename, Dir: String): String;
  144. function PrependSourceDirName(const Filename: String): String;
  145. procedure DoCallback(const Code: Integer; var Data: TCompilerCallbackData;
  146. const IgnoreCallbackResult: Boolean = False);
  147. procedure EnumIniSection(const EnumProc: TEnumIniSectionProc;
  148. const SectionName: String; const Ext: Integer; const Verbose, SkipBlankLines: Boolean;
  149. const Filename: String; const LangSection: Boolean = False; const LangSectionPre: Boolean = False);
  150. function EvalCheckOrInstallIdentifier(Sender: TSimpleExpression; const Name: String;
  151. const Parameters: array of const): Boolean;
  152. procedure CheckCheckOrInstall(const ParamName, ParamData: String;
  153. const Kind: TCheckOrInstallKind);
  154. function CheckConst(const S: String; const MinVersion: TSetupVersionData;
  155. const AllowedConsts: TAllowedConsts): Boolean;
  156. procedure CheckCustomMessageDefinitions;
  157. procedure CheckCustomMessageReferences;
  158. procedure EnumTypesProc(const Line: PChar; const Ext: Integer);
  159. procedure EnumComponentsProc(const Line: PChar; const Ext: Integer);
  160. procedure EnumTasksProc(const Line: PChar; const Ext: Integer);
  161. procedure EnumDirsProc(const Line: PChar; const Ext: Integer);
  162. procedure EnumIconsProc(const Line: PChar; const Ext: Integer);
  163. procedure EnumINIProc(const Line: PChar; const Ext: Integer);
  164. procedure EnumLangOptionsPreProc(const Line: PChar; const Ext: Integer);
  165. procedure EnumLangOptionsProc(const Line: PChar; const Ext: Integer);
  166. procedure EnumLanguagesPreProc(const Line: PChar; const Ext: Integer);
  167. procedure EnumLanguagesProc(const Line: PChar; const Ext: Integer);
  168. procedure EnumRegistryProc(const Line: PChar; const Ext: Integer);
  169. procedure EnumDeleteProc(const Line: PChar; const Ext: Integer);
  170. procedure EnumISSigKeysProc(const Line: PChar; const Ext: Integer);
  171. procedure EnumFilesProc(const Line: PChar; const Ext: Integer);
  172. procedure EnumRunProc(const Line: PChar; const Ext: Integer);
  173. procedure EnumSetupProc(const Line: PChar; const Ext: Integer);
  174. procedure EnumMessagesProc(const Line: PChar; const Ext: Integer);
  175. procedure EnumCustomMessagesProc(const Line: PChar; const Ext: Integer);
  176. procedure ExtractParameters(S: PChar; const ParamInfo: array of TParamInfo;
  177. var ParamValues: array of TParamValue);
  178. function FindLangEntryIndexByName(const AName: String; const Pre: Boolean): Integer;
  179. function FindSignToolIndexByName(const AName: String): Integer;
  180. function GetLZMAExeFilename(const Allow64Bit: Boolean): String;
  181. procedure InitBzipDLL;
  182. procedure InitPreLangData(const APreLangData: TPreLangData);
  183. procedure InitLanguageEntry(var ALanguageEntry: TSetupLanguageEntry);
  184. procedure InitLZMADLL;
  185. procedure InitPreprocessor;
  186. procedure InitZipDLL;
  187. procedure PopulateLanguageEntryData;
  188. procedure ProcessMinVersionParameter(const ParamValue: TParamValue;
  189. var AMinVersion: TSetupVersionData);
  190. procedure ProcessOnlyBelowVersionParameter(const ParamValue: TParamValue;
  191. var AOnlyBelowVersion: TSetupVersionData);
  192. procedure ProcessPermissionsParameter(ParamData: String;
  193. const AccessMasks: array of TNameAndAccessMask; var PermissionsEntry: Smallint);
  194. function EvalArchitectureIdentifier(Sender: TSimpleExpression; const Name: String;
  195. const Parameters: array of const): Boolean;
  196. function EvalComponentIdentifier(Sender: TSimpleExpression; const Name: String;
  197. const Parameters: array of const): Boolean;
  198. function EvalTaskIdentifier(Sender: TSimpleExpression; const Name: String;
  199. const Parameters: array of const): Boolean;
  200. function EvalLanguageIdentifier(Sender: TSimpleExpression; const Name: String;
  201. const Parameters: array of const): Boolean;
  202. procedure ProcessExpressionParameter(const ParamName,
  203. ParamData: String; OnEvalIdentifier: TSimpleExpressionOnEvalIdentifier;
  204. SlashConvert: Boolean; var ProcessedParamData: String);
  205. procedure ProcessWildcardsParameter(const ParamData: String;
  206. const AWildcards: TStringList; const TooLongMsg: String);
  207. procedure ReadDefaultMessages;
  208. procedure ReadMessagesFromFilesPre(const AFiles: String; const ALangIndex: Integer);
  209. procedure ReadMessagesFromFiles(const AFiles: String; const ALangIndex: Integer);
  210. procedure ReadMessagesFromScriptPre;
  211. procedure ReadMessagesFromScript;
  212. function ReadScriptFile(const Filename: String; const UseCache: Boolean;
  213. const AnsiConvertCodePage: Cardinal): TScriptFileLines;
  214. procedure RenamedConstantCallback(const Cnst, CnstRenamed: String);
  215. procedure EnumCodeProc(const Line: PChar; const Ext: Integer);
  216. procedure ReadCode;
  217. procedure CodeCompilerOnLineToLineInfo(const Line: LongInt; var Filename: String; var FileLine: LongInt);
  218. procedure CodeCompilerOnUsedLine(const Filename: String; const Line, Position: LongInt; const IsProcExit: Boolean);
  219. procedure CodeCompilerOnUsedVariable(const Filename: String; const Line, Col, Param1, Param2, Param3: LongInt; const Param4: AnsiString);
  220. procedure CodeCompilerOnError(const Msg: String; const ErrorFilename: String; const ErrorLine: LongInt);
  221. procedure CodeCompilerOnWarning(const Msg: String);
  222. procedure CompileCode;
  223. function FilenameToFileIndex(const AFileName: String): Integer;
  224. procedure ReadTextFile(const Filename: String; const LangIndex: Integer; var Text: AnsiString);
  225. procedure SeparateDirective(const Line: PChar; var Key, Value: String);
  226. procedure ShiftDebugEntryIndexes(AKind: TDebugEntryKind);
  227. procedure Sign(AExeFilename: String);
  228. procedure SignCommand(const AName, ACommand, AParams, AExeFilename: String; const RetryCount, RetryDelay, MinimumTimeBetween: Integer; const RunMinimized: Boolean);
  229. procedure WriteDebugEntry(Kind: TDebugEntryKind; Index: Integer; StepOutMarker: Boolean = False);
  230. procedure WriteCompiledCodeText(const CompiledCodeText: Ansistring);
  231. procedure WriteCompiledCodeDebugInfo(const CompiledCodeDebugInfo: AnsiString);
  232. function CreateMemoryStreamsFromFiles(const ADirectiveName, AFiles: String): TObjectList<TCustomMemoryStream>;
  233. function CreateMemoryStreamsFromResources(const AResourceNamesPrefixes, AResourceNamesPostfixes: array of String): TObjectList<TCustomMemoryStream>;
  234. procedure VerificationError(const AError: TVerificationError;
  235. const AFilename: String; const ASigFilename: String = '');
  236. public
  237. AppData: Longint;
  238. CallbackProc: TCompilerCallbackProc;
  239. CompilerDir, SourceDir, OriginalSourceDir: String;
  240. constructor Create(AOwner: TComponent);
  241. destructor Destroy; override;
  242. class procedure AbortCompileFmt(const Msg: String; const Args: array of const);
  243. procedure AddBytesCompressedSoFar(const Value: Cardinal); overload;
  244. procedure AddBytesCompressedSoFar(const Value: Integer64); overload;
  245. procedure AddPreprocOption(const Value: String);
  246. procedure AddSignTool(const Name, Command: String);
  247. procedure CallIdleProc(const IgnoreCallbackResult: Boolean = False);
  248. procedure Compile;
  249. function GetBytesCompressedSoFar: Integer64;
  250. function GetDebugInfo: TMemoryStream;
  251. function GetDiskSliceSize:Longint;
  252. function GetDiskSpanning: Boolean;
  253. function GetEncryptionBaseNonce: TSetupEncryptionNonce;
  254. function GetExeFilename: String;
  255. function GetLineFilename: String;
  256. function GetLineNumber: Integer;
  257. function GetOutputBaseFileName: String;
  258. function GetOutputDir: String;
  259. function GetPreprocIncludedFilenames: TStringList;
  260. function GetPreprocOutput: String;
  261. function GetSlicesPerDisk: Longint;
  262. procedure SetBytesCompressedSoFar(const Value: Integer64);
  263. procedure SetOutput(Value: Boolean);
  264. procedure SetOutputBaseFilename(const Value: String);
  265. procedure SetOutputDir(const Value: String);
  266. end;
  267. implementation
  268. uses
  269. Commctrl, TypInfo, AnsiStrings, Math, WideStrUtils,
  270. PathFunc, TrustFunc, ISSigFunc, ECDSA, Shared.CommonFunc, Compiler.Messages, Shared.SetupEntFunc,
  271. Shared.FileClass, Shared.EncryptionFunc, Compression.Base, Compression.Zlib, Compression.bzlib,
  272. Shared.LangOptionsSectionDirectives, Shared.ResUpdateFunc, Compiler.ExeUpdateFunc,
  273. {$IFDEF STATICPREPROC}
  274. ISPP.Preprocess,
  275. {$ENDIF}
  276. Compiler.CompressionHandler, Compiler.HelperFunc, Compiler.BuiltinPreproc;
  277. type
  278. TLineInfo = class
  279. public
  280. FileName: String;
  281. FileLineNumber: Integer;
  282. end;
  283. TSignTool = class
  284. Name, Command: String;
  285. end;
  286. PISSigKeyEntryExtraInfo = ^TISSigKeyEntryExtraInfo;
  287. TISSigKeyEntryExtraInfo = record
  288. Name: String;
  289. GroupNames: array of String;
  290. function HasGroupName(const GroupName: String): Boolean;
  291. end;
  292. TFileLocationSign = (fsNoSetting, fsYes, fsOnce, fsCheck);
  293. PFileLocationEntryExtraInfo = ^TFileLocationEntryExtraInfo;
  294. TFileLocationEntryExtraInfo = record
  295. Flags: set of (floVersionInfoNotValid, floIsUninstExe, floApplyTouchDateTime,
  296. floSolidBreak);
  297. Sign: TFileLocationSign;
  298. Verification: TSetupFileVerification;
  299. ISSigKeyUsedID: String;
  300. end;
  301. var
  302. ZipInitialized, BzipInitialized, LZMAInitialized: Boolean;
  303. PreprocessorInitialized: Boolean;
  304. PreprocessScriptProc: TPreprocessScriptProc;
  305. const
  306. ParamCommonFlags = 'Flags';
  307. ParamCommonComponents = 'Components';
  308. ParamCommonTasks = 'Tasks';
  309. ParamCommonLanguages = 'Languages';
  310. ParamCommonCheck = 'Check';
  311. ParamCommonBeforeInstall = 'BeforeInstall';
  312. ParamCommonAfterInstall = 'AfterInstall';
  313. ParamCommonMinVersion = 'MinVersion';
  314. ParamCommonOnlyBelowVersion = 'OnlyBelowVersion';
  315. DefaultTypeEntryNames: array[0..2] of PChar = ('full', 'compact', 'custom');
  316. MaxDiskSliceSize = 2100000000;
  317. DefaultKDFIterations = 220000;
  318. function ExtractStr(var S: String; const Separator: Char): String;
  319. var
  320. I: Integer;
  321. begin
  322. repeat
  323. I := PathPos(Separator, S);
  324. if I = 0 then I := Length(S)+1;
  325. Result := Trim(Copy(S, 1, I-1));
  326. S := Trim(Copy(S, I+1, Maxint));
  327. until (Result <> '') or (S = '');
  328. end;
  329. { TISSigKeyEntryExtraInfo }
  330. function TISSigKeyEntryExtraInfo.HasGroupName(const GroupName: String): Boolean;
  331. begin
  332. for var I := 0 to Length(GroupNames)-1 do
  333. if SameText(GroupNames[I], GroupName) then
  334. Exit(True);
  335. Result := False;
  336. end;
  337. { TSetupCompiler }
  338. constructor TSetupCompiler.Create(AOwner: TComponent);
  339. begin
  340. inherited Create;
  341. ScriptFiles := TStringList.Create;
  342. LanguageEntries := TList.Create;
  343. CustomMessageEntries := TList.Create;
  344. PermissionEntries := TList.Create;
  345. TypeEntries := TList.Create;
  346. ComponentEntries := TList.Create;
  347. TaskEntries := TList.Create;
  348. DirEntries := TList.Create;
  349. ISSigKeyEntries := TList.Create;
  350. FileEntries := TList.Create;
  351. FileLocationEntries := TList.Create;
  352. IconEntries := TList.Create;
  353. IniEntries := TList.Create;
  354. RegistryEntries := TList.Create;
  355. InstallDeleteEntries := TList.Create;
  356. UninstallDeleteEntries := TList.Create;
  357. RunEntries := TList.Create;
  358. UninstallRunEntries := TList.Create;
  359. FileLocationEntryFilenames := THashStringList.Create;
  360. FileLocationEntryExtraInfos := TList.Create;
  361. ISSIgKeyEntryExtraInfos := TList.Create;
  362. WarningsList := THashStringList.Create;
  363. WarningsList.IgnoreDuplicates := True;
  364. ExpectedCustomMessageNames := TStringList.Create;
  365. UsedUserAreas := TStringList.Create;
  366. UsedUserAreas.Sorted := True;
  367. UsedUserAreas.Duplicates := dupIgnore;
  368. PreprocIncludedFilenames := TStringList.Create;
  369. DefaultLangData := TLangData.Create;
  370. PreLangDataList := TList.Create;
  371. LangDataList := TList.Create;
  372. SignToolList := TList.Create;
  373. SignTools := TStringList.Create;
  374. SignToolsParams := TStringList.Create;
  375. DebugInfo := TMemoryStream.Create;
  376. CodeDebugInfo := TMemoryStream.Create;
  377. CodeText := TStringList.Create;
  378. CodeCompiler := TScriptCompiler.Create;
  379. CodeCompiler.NamingAttribute := 'Event';
  380. CodeCompiler.OnLineToLineInfo := CodeCompilerOnLineToLineInfo;
  381. CodeCompiler.OnUsedLine := CodeCompilerOnUsedLine;
  382. CodeCompiler.OnUsedVariable := CodeCompilerOnUsedVariable;
  383. CodeCompiler.OnError := CodeCompilerOnError;
  384. CodeCompiler.OnWarning := CodeCompilerOnWarning;
  385. end;
  386. destructor TSetupCompiler.Destroy;
  387. var
  388. I: Integer;
  389. begin
  390. CodeCompiler.Free;
  391. CodeText.Free;
  392. CodeDebugInfo.Free;
  393. DebugInfo.Free;
  394. SignToolsParams.Free;
  395. SignTools.Free;
  396. if Assigned(SignToolList) then begin
  397. for I := 0 to SignToolList.Count-1 do
  398. TSignTool(SignToolList[I]).Free;
  399. SignToolList.Free;
  400. end;
  401. LangDataList.Free;
  402. PreLangDataList.Free;
  403. DefaultLangData.Free;
  404. PreprocIncludedFilenames.Free;
  405. UsedUserAreas.Free;
  406. ExpectedCustomMessageNames.Free;
  407. WarningsList.Free;
  408. ISSigKeyEntryExtraInfos.Free;
  409. FileLocationEntryExtraInfos.Free;
  410. FileLocationEntryFilenames.Free;
  411. UninstallRunEntries.Free;
  412. RunEntries.Free;
  413. UninstallDeleteEntries.Free;
  414. InstallDeleteEntries.Free;
  415. RegistryEntries.Free;
  416. IniEntries.Free;
  417. IconEntries.Free;
  418. FileLocationEntries.Free;
  419. FileEntries.Free;
  420. ISSigKeyEntries.Free;
  421. DirEntries.Free;
  422. TaskEntries.Free;
  423. ComponentEntries.Free;
  424. TypeEntries.Free;
  425. PermissionEntries.Free;
  426. CustomMessageEntries.Free;
  427. LanguageEntries.Free;
  428. ScriptFiles.Free;
  429. inherited Destroy;
  430. end;
  431. function TSetupCompiler.CreateMemoryStreamsFromFiles(const ADirectiveName, AFiles: String): TObjectList<TCustomMemoryStream>;
  432. procedure AddFile(const Filename: String);
  433. begin
  434. AddStatus(Format(SCompilerStatusReadingInFile, [FileName]));
  435. Result.Add(CreateMemoryStreamFromFile(FileName));
  436. end;
  437. var
  438. Filename, SearchSubDir: String;
  439. AFilesList: TStringList;
  440. I: Integer;
  441. H: THandle;
  442. FindData: TWin32FindData;
  443. begin
  444. Result := TObjectList<TCustomMemoryStream>.Create;
  445. try
  446. { In older versions only one file could be listed and comma's could be used so
  447. before treating AFiles as a list, first check if it's actually a single file
  448. with a comma in its name. }
  449. Filename := PrependSourceDirName(AFiles);
  450. if NewFileExists(Filename) then
  451. AddFile(Filename)
  452. else begin
  453. AFilesList := TStringList.Create;
  454. try
  455. ProcessWildcardsParameter(AFiles, AFilesList,
  456. Format(SCompilerDirectivePatternTooLong, [ADirectiveName]));
  457. for I := 0 to AFilesList.Count-1 do begin
  458. Filename := PrependSourceDirName(AFilesList[I]);
  459. if IsWildcard(FileName) then begin
  460. H := FindFirstFile(PChar(Filename), FindData);
  461. if H <> INVALID_HANDLE_VALUE then begin
  462. try
  463. SearchSubDir := PathExtractPath(Filename);
  464. repeat
  465. if FindData.dwFileAttributes and (FILE_ATTRIBUTE_DIRECTORY or FILE_ATTRIBUTE_HIDDEN) <> 0 then
  466. Continue;
  467. AddFile(SearchSubDir + FindData.cFilename);
  468. until not FindNextFile(H, FindData);
  469. finally
  470. Windows.FindClose(H);
  471. end;
  472. end;
  473. end else
  474. AddFile(Filename); { use the case specified in the script }
  475. end;
  476. finally
  477. AFilesList.Free;
  478. end;
  479. end;
  480. except
  481. Result.Free;
  482. raise;
  483. end;
  484. end;
  485. function TSetupCompiler.CreateMemoryStreamsFromResources(const AResourceNamesPrefixes, AResourceNamesPostfixes: array of String): TObjectList<TCustomMemoryStream>;
  486. var
  487. I, J: Integer;
  488. begin
  489. Result := TObjectList<TCustomMemoryStream>.Create;
  490. try
  491. for I := 0 to Length(AResourceNamesPrefixes)-1 do
  492. for J := 0 to Length(AResourceNamesPostfixes)-1 do
  493. Result.Add(TResourceStream.Create(HInstance, AResourceNamesPrefixes[I]+AResourceNamesPostfixes[J], RT_RCDATA));
  494. except
  495. Result.Free;
  496. raise;
  497. end;
  498. end;
  499. function LoadCompilerDLL(const Filename: String; const Options: TLoadTrustedLibraryOptions): HMODULE;
  500. begin
  501. try
  502. Result := LoadTrustedLibrary(FileName, Options);
  503. except
  504. begin
  505. TSetupCompiler.AbortCompileFmt('Failed to load %s: %s', [PathExtractName(Filename), GetExceptMessage]);
  506. Result := 0; //silence compiler
  507. end;
  508. end;
  509. end;
  510. procedure TSetupCompiler.InitPreprocessor;
  511. begin
  512. if PreprocessorInitialized then
  513. Exit;
  514. {$IFNDEF STATICPREPROC}
  515. var Filename := CompilerDir + 'ISPP.dll';
  516. if NewFileExists(Filename) then begin
  517. var M := LoadCompilerDLL(Filename, [ltloTrustAllOnDebug]);
  518. PreprocessScriptProc := GetProcAddress(M, 'ISPreprocessScriptW');
  519. if not Assigned(PreprocessScriptProc) then
  520. AbortCompile('Failed to get address of functions in ISPP.dll');
  521. end; { else ISPP unavailable; fall back to built-in preprocessor }
  522. {$ELSE}
  523. PreprocessScriptProc := ISPreprocessScript;
  524. {$ENDIF}
  525. PreprocessorInitialized := True;
  526. end;
  527. procedure TSetupCompiler.InitZipDLL;
  528. begin
  529. if ZipInitialized then
  530. Exit;
  531. var Filename := CompilerDir + 'iszlib.dll';
  532. var M := LoadCompilerDLL(Filename, []);
  533. if not ZlibInitCompressFunctions(M) then
  534. AbortCompile('Failed to get address of functions in iszlib.dll');
  535. ZipInitialized := True;
  536. end;
  537. procedure TSetupCompiler.InitBzipDLL;
  538. begin
  539. if BzipInitialized then
  540. Exit;
  541. var Filename := CompilerDir + 'isbzip.dll';
  542. var M := LoadCompilerDLL(Filename, []);
  543. if not BZInitCompressFunctions(M) then
  544. AbortCompile('Failed to get address of functions in isbzip.dll');
  545. BzipInitialized := True;
  546. end;
  547. procedure TSetupCompiler.InitLZMADLL;
  548. begin
  549. if LZMAInitialized then
  550. Exit;
  551. var Filename := CompilerDir + 'islzma.dll';
  552. var M := LoadCompilerDLL(Filename, [ltloTrustAllOnDebug]);
  553. if not LZMAInitCompressFunctions(M) then
  554. AbortCompile('Failed to get address of functions in islzma.dll');
  555. LZMAInitialized := True;
  556. end;
  557. function TSetupCompiler.GetBytesCompressedSoFar: Integer64;
  558. begin
  559. Result := BytesCompressedSoFar;
  560. end;
  561. function TSetupCompiler.GetDebugInfo: TMemoryStream;
  562. begin
  563. Result := DebugInfo;
  564. end;
  565. function TSetupCompiler.GetDiskSliceSize: Longint;
  566. begin
  567. Result := DiskSliceSize;
  568. end;
  569. function TSetupCompiler.GetDiskSpanning: Boolean;
  570. begin
  571. Result := DiskSpanning;
  572. end;
  573. function TSetupCompiler.GetEncryptionBaseNonce: TSetupEncryptionNonce;
  574. begin
  575. Result := SetupEncryptionHeader.BaseNonce;
  576. end;
  577. function TSetupCompiler.GetExeFilename: String;
  578. begin
  579. Result := ExeFilename;
  580. end;
  581. function TSetupCompiler.GetLineFilename: String;
  582. begin
  583. Result := LineFilename;
  584. end;
  585. function TSetupCompiler.GetLineNumber: Integer;
  586. begin
  587. Result := LineNumber;
  588. end;
  589. function TSetupCompiler.GetLZMAExeFilename(const Allow64Bit: Boolean): String;
  590. const
  591. PROCESSOR_ARCHITECTURE_AMD64 = 9;
  592. ExeFilenames: array[Boolean] of String = ('islzma32.exe', 'islzma64.exe');
  593. var
  594. UseX64Exe: Boolean;
  595. GetNativeSystemInfoFunc: procedure(var lpSystemInfo: TSystemInfo); stdcall;
  596. SysInfo: TSystemInfo;
  597. begin
  598. UseX64Exe := False;
  599. if Allow64Bit then begin
  600. GetNativeSystemInfoFunc := GetProcAddress(GetModuleHandle(kernel32),
  601. 'GetNativeSystemInfo');
  602. if Assigned(GetNativeSystemInfoFunc) then begin
  603. GetNativeSystemInfoFunc(SysInfo);
  604. if SysInfo.wProcessorArchitecture = PROCESSOR_ARCHITECTURE_AMD64 then
  605. UseX64Exe := True;
  606. end;
  607. end;
  608. Result := CompilerDir + ExeFilenames[UseX64Exe];
  609. end;
  610. function TSetupCompiler.GetOutputBaseFileName: String;
  611. begin
  612. Result := OutputBaseFileName;
  613. end;
  614. function TSetupCompiler.GetOutputDir: String;
  615. begin
  616. Result := OutputDir;
  617. end;
  618. function TSetupCompiler.GetPreprocIncludedFilenames: TStringList;
  619. begin
  620. Result := PreprocIncludedFilenames;
  621. end;
  622. function TSetupCompiler.GetPreprocOutput: String;
  623. begin
  624. Result := PreprocOutput;
  625. end;
  626. function TSetupCompiler.GetSlicesPerDisk: Longint;
  627. begin
  628. Result := SlicesPerDisk;
  629. end;
  630. function TSetupCompiler.FilenameToFileIndex(const AFilename: String): Integer;
  631. begin
  632. if not GotPrevFilename or (PathCompare(AFilename, PrevFilename) <> 0) then begin
  633. { AFilename is non-empty when an include file is being read or when the compiler is reading
  634. CustomMessages/LangOptions/Messages sections from a messages file. Since these sections don't
  635. generate debug entries we can treat an empty AFileName as the main script and a non-empty
  636. AFilename as an include file. This works even when command-line compilation is used. }
  637. if AFilename = '' then
  638. PrevFileIndex := -1
  639. else begin
  640. PrevFileIndex := PreprocIncludedFilenames.IndexOf(AFilename);
  641. if PrevFileIndex = -1 then
  642. AbortCompileFmt('Failed to find index of file (%s)', [AFilename]);
  643. end;
  644. PrevFilename := AFilename;
  645. GotPrevFilename := True;
  646. end;
  647. Result := PrevFileIndex;
  648. end;
  649. procedure TSetupCompiler.WriteDebugEntry(Kind: TDebugEntryKind; Index: Integer; StepOutMarker: Boolean = False);
  650. var
  651. Rec: TDebugEntry;
  652. begin
  653. Rec.FileIndex := FilenameToFileIndex(LineFilename);
  654. Rec.LineNumber := LineNumber;
  655. Rec.Kind := Ord(Kind);
  656. Rec.Index := Index;
  657. Rec.StepOutMarker := StepOutMarker;
  658. DebugInfo.WriteBuffer(Rec, SizeOf(Rec));
  659. Inc(DebugEntryCount);
  660. end;
  661. procedure TSetupCompiler.WriteCompiledCodeText(const CompiledCodeText: AnsiString);
  662. begin
  663. CompiledCodeTextLength := Length(CompiledCodeText);
  664. CodeDebugInfo.WriteBuffer(CompiledCodeText[1], CompiledCodeTextLength);
  665. end;
  666. procedure TSetupCompiler.WriteCompiledCodeDebugInfo(const CompiledCodeDebugInfo: AnsiString);
  667. begin
  668. CompiledCodeDebugInfoLength := Length(CompiledCodeDebugInfo);
  669. CodeDebugInfo.WriteBuffer(CompiledCodeDebugInfo[1], CompiledCodeDebugInfoLength);
  670. end;
  671. procedure TSetupCompiler.ShiftDebugEntryIndexes(AKind: TDebugEntryKind);
  672. { Increments the Index field of each debug entry of the specified kind by 1.
  673. This has to be called when a new entry is inserted at the *front* of an
  674. *Entries array, since doing that causes the indexes of existing entries to
  675. shift. }
  676. var
  677. Rec: PDebugEntry;
  678. I: Integer;
  679. begin
  680. Cardinal(Rec) := Cardinal(DebugInfo.Memory) + SizeOf(TDebugInfoHeader);
  681. for I := 0 to DebugEntryCount-1 do begin
  682. if Rec.Kind = Ord(AKind) then
  683. Inc(Rec.Index);
  684. Inc(Rec);
  685. end;
  686. end;
  687. procedure TSetupCompiler.DoCallback(const Code: Integer;
  688. var Data: TCompilerCallbackData; const IgnoreCallbackResult: Boolean);
  689. begin
  690. case CallbackProc(Code, Data, AppData) of
  691. iscrSuccess: ;
  692. iscrRequestAbort: if not IgnoreCallbackResult then Abort;
  693. else
  694. AbortCompile('CallbackProc return code invalid');
  695. end;
  696. end;
  697. procedure TSetupCompiler.CallIdleProc(const IgnoreCallbackResult: Boolean);
  698. const
  699. ProgressMax = 1024;
  700. var
  701. Data: TCompilerCallbackData;
  702. MillisecondsElapsed: Cardinal;
  703. X: Integer64;
  704. begin
  705. Data.SecondsRemaining := -1;
  706. Data.BytesCompressedPerSecond := 0;
  707. if ((BytesCompressedSoFar.Lo = 0) and (BytesCompressedSoFar.Hi = 0)) or
  708. ((TotalBytesToCompress.Lo = 0) and (TotalBytesToCompress.Hi = 0)) then begin
  709. { Optimization(?) and avoid division by zero when TotalBytesToCompress=0 }
  710. Data.CompressProgress := 0;
  711. end
  712. else begin
  713. Data.CompressProgress := Trunc((Comp(BytesCompressedSoFar) * ProgressMax) /
  714. Comp(TotalBytesToCompress));
  715. { In case one of the files got bigger since we checked the sizes... }
  716. if Data.CompressProgress > ProgressMax then
  717. Data.CompressProgress := ProgressMax;
  718. if CompressionInProgress then begin
  719. MillisecondsElapsed := GetTickCount - CompressionStartTick;
  720. if MillisecondsElapsed >= Cardinal(1000) then begin
  721. X := BytesCompressedSoFar;
  722. Mul64(X, 1000);
  723. Div64(X, MillisecondsElapsed);
  724. if (X.Hi = 0) and (Longint(X.Lo) >= 0) then
  725. Data.BytesCompressedPerSecond := X.Lo
  726. else
  727. Data.BytesCompressedPerSecond := Maxint;
  728. if Compare64(BytesCompressedSoFar, TotalBytesToCompress) < 0 then begin
  729. { Protect against division by zero }
  730. if Data.BytesCompressedPerSecond <> 0 then begin
  731. X := TotalBytesToCompress;
  732. Dec6464(X, BytesCompressedSoFar);
  733. Inc64(X, Data.BytesCompressedPerSecond-1); { round up }
  734. Div64(X, Data.BytesCompressedPerSecond);
  735. if (X.Hi = 0) and (Longint(X.Lo) >= 0) then
  736. Data.SecondsRemaining := X.Lo
  737. else
  738. Data.SecondsRemaining := Maxint;
  739. end;
  740. end
  741. else begin
  742. { In case one of the files got bigger since we checked the sizes... }
  743. Data.SecondsRemaining := 0;
  744. end;
  745. end;
  746. end;
  747. end;
  748. Data.CompressProgressMax := ProgressMax;
  749. DoCallback(iscbNotifyIdle, Data, IgnoreCallbackResult);
  750. end;
  751. type
  752. PPreCompilerData = ^TPreCompilerData;
  753. TPreCompilerData = record
  754. Compiler: TSetupCompiler;
  755. MainScript: Boolean;
  756. InFiles: TStringList;
  757. OutLines: TScriptFileLines;
  758. AnsiConvertCodePage: Cardinal;
  759. CurInLine: String;
  760. ErrorSet: Boolean;
  761. ErrorMsg, ErrorFilename: String;
  762. ErrorLine, ErrorColumn: Integer;
  763. LastPrependDirNameResult: String;
  764. end;
  765. procedure PreErrorProc(CompilerData: TPreprocCompilerData; ErrorMsg: PChar;
  766. ErrorFilename: PChar; ErrorLine: Integer; ErrorColumn: Integer); stdcall; forward;
  767. function LoadFile(CompilerData: TPreprocCompilerData; AFilename: PChar;
  768. ErrorFilename: PChar; ErrorLine: Integer; ErrorColumn: Integer; FromPreProcessor: Boolean): TPreprocFileHandle;
  769. var
  770. Data: PPreCompilerData;
  771. Filename: String;
  772. I: Integer;
  773. Lines: TStringList;
  774. F: TTextFileReader;
  775. L: String;
  776. begin
  777. Data := CompilerData;
  778. Filename := AFilename;
  779. if Filename = '' then begin
  780. { Reject any attempt by the preprocessor to load the main script }
  781. PreErrorProc(CompilerData, 'Invalid parameter passed to PreLoadFileProc',
  782. ErrorFilename, ErrorLine, ErrorColumn);
  783. Result := -1;
  784. Exit;
  785. end;
  786. Filename := PathExpand(Filename);
  787. for I := 0 to Data.InFiles.Count-1 do
  788. if PathCompare(Data.InFiles[I], Filename) = 0 then begin
  789. Result := I;
  790. Exit;
  791. end;
  792. Lines := TStringList.Create;
  793. try
  794. if FromPreProcessor then begin
  795. Data.Compiler.AddStatus(Format(SCompilerStatusReadingInFile, [Filename]));
  796. if Data.MainScript then
  797. Data.Compiler.PreprocIncludedFilenames.Add(Filename);
  798. end;
  799. F := TTextFileReader.Create(Filename, fdOpenExisting, faRead, fsRead);
  800. try
  801. F.CodePage := Data.AnsiConvertCodePage;
  802. while not F.Eof do begin
  803. L := F.ReadLine;
  804. for I := 1 to Length(L) do
  805. if L[I] = #0 then
  806. raise Exception.CreateFmt(SCompilerIllegalNullChar, [Lines.Count + 1]);
  807. Lines.Add(L);
  808. end;
  809. finally
  810. F.Free;
  811. end;
  812. except
  813. Lines.Free;
  814. PreErrorProc(CompilerData, PChar(Format(SCompilerErrorOpeningIncludeFile,
  815. [Filename, GetExceptMessage])), ErrorFilename, ErrorLine, ErrorColumn);
  816. Result := -1;
  817. Exit;
  818. end;
  819. Result := Data.InFiles.AddObject(Filename, Lines);
  820. end;
  821. function PreLoadFileProc(CompilerData: TPreprocCompilerData; AFilename: PChar;
  822. ErrorFilename: PChar; ErrorLine: Integer; ErrorColumn: Integer): TPreprocFileHandle;
  823. stdcall;
  824. begin
  825. Result := LoadFile(CompilerData, AFilename, ErrorFilename, ErrorLine, ErrorColumn, True);
  826. end;
  827. function PreLineInProc(CompilerData: TPreprocCompilerData;
  828. FileHandle: TPreprocFileHandle; LineIndex: Integer): PChar; stdcall;
  829. var
  830. Data: PPreCompilerData;
  831. Lines: TStringList;
  832. begin
  833. Data := CompilerData;
  834. if (FileHandle >= 0) and (FileHandle < Data.InFiles.Count) and
  835. (LineIndex >= 0) then begin
  836. Lines := TStringList(Data.InFiles.Objects[FileHandle]);
  837. if LineIndex < Lines.Count then begin
  838. Data.CurInLine := Lines[LineIndex];
  839. Result := PChar(Data.CurInLine);
  840. end
  841. else
  842. Result := nil;
  843. end
  844. else begin
  845. PreErrorProc(CompilerData, 'Invalid parameter passed to LineInProc',
  846. nil, 0, 0);
  847. Result := nil;
  848. end;
  849. end;
  850. procedure PreLineOutProc(CompilerData: TPreprocCompilerData;
  851. Filename: PChar; LineNumber: Integer; Text: PChar); stdcall;
  852. var
  853. Data: PPreCompilerData;
  854. begin
  855. Data := CompilerData;
  856. Data.OutLines.Add(Filename, LineNumber, Text);
  857. end;
  858. procedure PreStatusProc(CompilerData: TPreprocCompilerData;
  859. StatusMsg: PChar; Warning: BOOL); stdcall;
  860. var
  861. Data: PPreCompilerData;
  862. begin
  863. Data := CompilerData;
  864. Data.Compiler.AddStatus(Format(SCompilerStatusPreprocessorStatus, [StatusMsg]), Warning);
  865. end;
  866. procedure PreErrorProc(CompilerData: TPreprocCompilerData; ErrorMsg: PChar;
  867. ErrorFilename: PChar; ErrorLine: Integer; ErrorColumn: Integer); stdcall;
  868. var
  869. Data: PPreCompilerData;
  870. begin
  871. Data := CompilerData;
  872. if not Data.ErrorSet then begin
  873. Data.ErrorMsg := ErrorMsg;
  874. Data.ErrorFilename := ErrorFilename;
  875. Data.ErrorLine := ErrorLine;
  876. Data.ErrorColumn := ErrorColumn;
  877. Data.ErrorSet := True;
  878. end;
  879. end;
  880. function PrePrependDirNameProc(CompilerData: TPreprocCompilerData;
  881. Filename: PChar; Dir: PChar; ErrorFilename: PChar; ErrorLine: Integer;
  882. ErrorColumn: Integer): PChar; stdcall;
  883. var
  884. Data: PPreCompilerData;
  885. begin
  886. Data := CompilerData;
  887. try
  888. Data.LastPrependDirNameResult := Data.Compiler.PrependDirName(
  889. PChar(Filename), PChar(Dir));
  890. Result := PChar(Data.LastPrependDirNameResult);
  891. except
  892. PreErrorProc(CompilerData, PChar(GetExceptMessage), ErrorFilename,
  893. ErrorLine, ErrorColumn);
  894. Result := nil;
  895. end;
  896. end;
  897. procedure PreIdleProc(CompilerData: TPreprocCompilerData); stdcall;
  898. var
  899. Data: PPreCompilerData;
  900. begin
  901. Data := CompilerData;
  902. Data.Compiler.CallIdleProc(True); { Doesn't allow an Abort }
  903. end;
  904. function TSetupCompiler.ReadScriptFile(const Filename: String;
  905. const UseCache: Boolean; const AnsiConvertCodePage: Cardinal): TScriptFileLines;
  906. function ReadMainScriptLines: TStringList;
  907. var
  908. Reset: Boolean;
  909. Data: TCompilerCallbackData;
  910. begin
  911. Result := TStringList.Create;
  912. try
  913. Reset := True;
  914. while True do begin
  915. Data.Reset := Reset;
  916. Data.LineRead := nil;
  917. DoCallback(iscbReadScript, Data);
  918. if Data.LineRead = nil then
  919. Break;
  920. Result.Add(Data.LineRead);
  921. Reset := False;
  922. end;
  923. except
  924. Result.Free;
  925. raise;
  926. end;
  927. end;
  928. function SelectPreprocessor(const Lines: TStringList): TPreprocessScriptProc;
  929. var
  930. S: String;
  931. begin
  932. { Don't allow ISPPCC to be used if ISPP.dll is missing }
  933. if (PreprocOptionsString <> '') and not Assigned(PreprocessScriptProc) then
  934. raise Exception.Create(SCompilerISPPMissing);
  935. { By default, only pass the main script through ISPP }
  936. if (Filename = '') and Assigned(PreprocessScriptProc) then
  937. Result := PreprocessScriptProc
  938. else
  939. Result := BuiltinPreprocessScript;
  940. { Check for (and remove) #preproc override directive on the first line }
  941. if Lines.Count > 0 then begin
  942. S := Trim(Lines[0]);
  943. if S = '#preproc builtin' then begin
  944. Lines[0] := '';
  945. Result := BuiltinPreprocessScript;
  946. end
  947. else if S = '#preproc ispp' then begin
  948. Lines[0] := '';
  949. Result := PreprocessScriptProc;
  950. if not Assigned(Result) then
  951. raise Exception.Create(SCompilerISPPMissing);
  952. end;
  953. end;
  954. end;
  955. procedure PreprocessLines(const OutLines: TScriptFileLines);
  956. var
  957. LSourcePath, LCompilerPath: String;
  958. Params: TPreprocessScriptParams;
  959. Data: TPreCompilerData;
  960. FileLoaded: Boolean;
  961. ResultCode, CleanupResultCode, I: Integer;
  962. PreProc: TPreprocessScriptProc;
  963. begin
  964. LSourcePath := OriginalSourceDir;
  965. LCompilerPath := CompilerDir;
  966. FillChar(Params, SizeOf(Params), 0);
  967. Params.Size := SizeOf(Params);
  968. Params.InterfaceVersion := 3;
  969. Params.CompilerBinVersion := SetupBinVersion;
  970. Params.Filename := PChar(Filename);
  971. Params.SourcePath := PChar(LSourcePath);
  972. Params.CompilerPath := PChar(LCompilerPath);
  973. Params.Options := PChar(PreprocOptionsString);
  974. Params.CompilerData := @Data;
  975. Params.LoadFileProc := PreLoadFileProc;
  976. Params.LineInProc := PreLineInProc;
  977. Params.LineOutProc := PreLineOutProc;
  978. Params.StatusProc := PreStatusProc;
  979. Params.ErrorProc := PreErrorProc;
  980. Params.PrependDirNameProc := PrePrependDirNameProc;
  981. Params.IdleProc := PreIdleProc;
  982. FillChar(Data, SizeOf(Data), 0);
  983. Data.Compiler := Self;
  984. Data.OutLines := OutLines;
  985. Data.AnsiConvertCodePage := AnsiConvertCodePage;
  986. Data.InFiles := TStringList.Create;
  987. try
  988. if Filename = '' then begin
  989. Data.MainScript := True;
  990. Data.InFiles.AddObject('', ReadMainScriptLines);
  991. FileLoaded := True;
  992. end
  993. else
  994. FileLoaded := (LoadFile(Params.CompilerData, PChar(Filename),
  995. PChar(LineFilename), LineNumber, 0, False) = 0);
  996. ResultCode := ispePreprocessError;
  997. if FileLoaded then begin
  998. PreProc := SelectPreprocessor(TStringList(Data.InFiles.Objects[0]));
  999. if Filename = '' then
  1000. AddStatus(SCompilerStatusPreprocessing);
  1001. ResultCode := PreProc(Params);
  1002. if Filename = '' then begin
  1003. PreprocOutput := Data.Outlines.Text;
  1004. { Defer cleanup of main script until after compilation }
  1005. PreprocCleanupProcData := Params.PreprocCleanupProcData;
  1006. PreprocCleanupProc := Params.PreprocCleanupProc;
  1007. end
  1008. else if Assigned(Params.PreprocCleanupProc) then begin
  1009. CleanupResultCode := Params.PreprocCleanupProc(Params.PreprocCleanupProcData);
  1010. if CleanupResultCode <> 0 then
  1011. AbortCompileFmt('Preprocessor cleanup function for "%s" failed with code %d',
  1012. [Filename, CleanupResultCode]);
  1013. end;
  1014. end;
  1015. if Data.ErrorSet then begin
  1016. LineFilename := Data.ErrorFilename;
  1017. LineNumber := Data.ErrorLine;
  1018. if Data.ErrorColumn > 0 then { hack for now... }
  1019. Insert(Format('Column %d:' + SNewLine, [Data.ErrorColumn]),
  1020. Data.ErrorMsg, 1);
  1021. AbortCompile(Data.ErrorMsg);
  1022. end;
  1023. case ResultCode of
  1024. ispeSuccess: ;
  1025. ispeSilentAbort: Abort;
  1026. else
  1027. AbortCompileFmt('Preprocess function failed with code %d', [ResultCode]);
  1028. end;
  1029. finally
  1030. for I := Data.InFiles.Count-1 downto 0 do
  1031. Data.InFiles.Objects[I].Free;
  1032. Data.InFiles.Free;
  1033. end;
  1034. end;
  1035. var
  1036. I: Integer;
  1037. Lines: TScriptFileLines;
  1038. begin
  1039. if UseCache then
  1040. for I := 0 to ScriptFiles.Count-1 do
  1041. if PathCompare(ScriptFiles[I], Filename) = 0 then begin
  1042. Result := TScriptFileLines(ScriptFiles.Objects[I]);
  1043. Exit;
  1044. end;
  1045. Lines := TScriptFileLines.Create;
  1046. try
  1047. PreprocessLines(Lines);
  1048. except
  1049. Lines.Free;
  1050. raise;
  1051. end;
  1052. if UseCache then
  1053. ScriptFiles.AddObject(Filename, Lines);
  1054. Result := Lines;
  1055. end;
  1056. procedure TSetupCompiler.EnumIniSection(const EnumProc: TEnumIniSectionProc;
  1057. const SectionName: String; const Ext: Integer; const Verbose, SkipBlankLines: Boolean;
  1058. const Filename: String; const LangSection, LangSectionPre: Boolean);
  1059. var
  1060. FoundSection: Boolean;
  1061. LastSection: String;
  1062. procedure DoFile(Filename: String);
  1063. const
  1064. PreCodePage = 1252;
  1065. var
  1066. UseCache: Boolean;
  1067. AnsiConvertCodePage: Cardinal;
  1068. Lines: TScriptFileLines;
  1069. SaveLineFilename, L: String;
  1070. SaveLineNumber, LineIndex, I: Integer;
  1071. Line: PScriptFileLine;
  1072. begin
  1073. if Filename <> '' then
  1074. Filename := PathExpand(PrependSourceDirName(Filename));
  1075. UseCache := not (LangSection and LangSectionPre);
  1076. AnsiConvertCodePage := 0;
  1077. if LangSection then begin
  1078. { During a Pre pass on an .isl file, use code page 1252 for translation.
  1079. Previously, the system code page was used, but on DBCS that resulted in
  1080. "Illegal null character" errors on files containing byte sequences that
  1081. do not form valid lead/trail byte combinations (i.e. most languages). }
  1082. if LangSectionPre then begin
  1083. if not IsValidCodePage(PreCodePage) then { just in case }
  1084. AbortCompileFmt('Code page %u unsupported', [PreCodePage]);
  1085. AnsiConvertCodePage := PreCodePage;
  1086. end else if Ext >= 0 then begin
  1087. { Ext = LangIndex, except for Default.isl for which its -2 when default
  1088. messages are read but no special conversion is needed for those. }
  1089. AnsiConvertCodePage := TPreLangData(PreLangDataList[Ext]).LanguageCodePage;
  1090. end;
  1091. end;
  1092. Lines := ReadScriptFile(Filename, UseCache, AnsiConvertCodePage);
  1093. try
  1094. SaveLineFilename := LineFilename;
  1095. SaveLineNumber := LineNumber;
  1096. for LineIndex := 0 to Lines.Count-1 do begin
  1097. Line := Lines[LineIndex];
  1098. LineFilename := Line.LineFilename;
  1099. LineNumber := Line.LineNumber;
  1100. L := Trim(Line.LineText);
  1101. { Check for blank lines or comments }
  1102. if (not FoundSection or SkipBlankLines) and ((L = '') or (L[1] = ';')) then Continue;
  1103. if (L <> '') and (L[1] = '[') then begin
  1104. { Section tag }
  1105. I := Pos(']', L);
  1106. if (I < 3) or (I <> Length(L)) then
  1107. AbortCompile(SCompilerSectionTagInvalid);
  1108. L := Copy(L, 2, I-2);
  1109. if L[1] = '/' then begin
  1110. L := Copy(L, 2, Maxint);
  1111. if (LastSection = '') or (CompareText(L, LastSection) <> 0) then
  1112. AbortCompileFmt(SCompilerSectionBadEndTag, [L]);
  1113. FoundSection := False;
  1114. LastSection := '';
  1115. end
  1116. else begin
  1117. FoundSection := (CompareText(L, SectionName) = 0);
  1118. LastSection := L;
  1119. end;
  1120. end
  1121. else begin
  1122. if not FoundSection then begin
  1123. if LastSection = '' then
  1124. AbortCompile(SCompilerTextNotInSection);
  1125. Continue; { not on the right section }
  1126. end;
  1127. if Verbose then begin
  1128. if LineFilename = '' then
  1129. AddStatus(Format(SCompilerStatusParsingSectionLine,
  1130. [SectionName, LineNumber]))
  1131. else
  1132. AddStatus(Format(SCompilerStatusParsingSectionLineFile,
  1133. [SectionName, LineNumber, LineFilename]));
  1134. end;
  1135. EnumProc(PChar(Line.LineText), Ext);
  1136. end;
  1137. end;
  1138. LineFilename := SaveLineFilename;
  1139. LineNumber := SaveLineNumber;
  1140. finally
  1141. if not UseCache then
  1142. Lines.Free;
  1143. end;
  1144. end;
  1145. begin
  1146. FoundSection := False;
  1147. LastSection := '';
  1148. DoFile(Filename);
  1149. end;
  1150. procedure TSetupCompiler.ExtractParameters(S: PChar;
  1151. const ParamInfo: array of TParamInfo; var ParamValues: array of TParamValue);
  1152. function GetParamIndex(const AName: String): Integer;
  1153. var
  1154. I: Integer;
  1155. begin
  1156. for I := 0 to High(ParamInfo) do
  1157. if CompareText(ParamInfo[I].Name, AName) = 0 then begin
  1158. Result := I;
  1159. if ParamValues[I].Found then
  1160. AbortCompileParamError(SCompilerParamDuplicated, ParamInfo[I].Name);
  1161. ParamValues[I].Found := True;
  1162. Exit;
  1163. end;
  1164. { Unknown parameter }
  1165. AbortCompileFmt(SCompilerParamUnknownParam, [AName]);
  1166. Result := -1;
  1167. end;
  1168. var
  1169. I, ParamIndex: Integer;
  1170. ParamName, Data: String;
  1171. begin
  1172. for I := 0 to High(ParamValues) do begin
  1173. ParamValues[I].Found := False;
  1174. ParamValues[I].Data := '';
  1175. end;
  1176. while True do begin
  1177. { Parameter name }
  1178. SkipWhitespace(S);
  1179. if S^ = #0 then
  1180. Break;
  1181. ParamName := ExtractWords(S, ':');
  1182. ParamIndex := GetParamIndex(ParamName);
  1183. if S^ <> ':' then
  1184. AbortCompileFmt(SCompilerParamHasNoValue, [ParamName]);
  1185. Inc(S);
  1186. { Parameter value }
  1187. SkipWhitespace(S);
  1188. if S^ <> '"' then begin
  1189. Data := ExtractWords(S, ';');
  1190. if Pos('"', Data) <> 0 then
  1191. AbortCompileFmt(SCompilerParamQuoteError, [ParamName]);
  1192. if S^ = ';' then
  1193. Inc(S);
  1194. end
  1195. else begin
  1196. Inc(S);
  1197. Data := '';
  1198. while True do begin
  1199. if S^ = #0 then
  1200. AbortCompileFmt(SCompilerParamMissingClosingQuote, [ParamName]);
  1201. if S^ = '"' then begin
  1202. Inc(S);
  1203. if S^ <> '"' then
  1204. Break;
  1205. end;
  1206. Data := Data + S^;
  1207. Inc(S);
  1208. end;
  1209. SkipWhitespace(S);
  1210. case S^ of
  1211. #0 : ;
  1212. ';': Inc(S);
  1213. else
  1214. AbortCompileFmt(SCompilerParamQuoteError, [ParamName]);
  1215. end;
  1216. end;
  1217. { Assign the data }
  1218. if (piNoEmpty in ParamInfo[ParamIndex].Flags) and (Data = '') then
  1219. AbortCompileParamError(SCompilerParamEmpty2, ParamInfo[ParamIndex].Name);
  1220. if (piNoQuotes in ParamInfo[ParamIndex].Flags) and (Pos('"', Data) <> 0) then
  1221. AbortCompileParamError(SCompilerParamNoQuotes2, ParamInfo[ParamIndex].Name);
  1222. ParamValues[ParamIndex].Data := Data;
  1223. end;
  1224. { Check for missing required parameters }
  1225. for I := 0 to High(ParamInfo) do begin
  1226. if (piRequired in ParamInfo[I].Flags) and
  1227. not ParamValues[I].Found then
  1228. AbortCompileParamError(SCompilerParamNotSpecified, ParamInfo[I].Name);
  1229. end;
  1230. end;
  1231. procedure TSetupCompiler.AddStatus(const S: String; const Warning: Boolean);
  1232. var
  1233. Data: TCompilerCallbackData;
  1234. begin
  1235. Data.StatusMsg := PChar(S);
  1236. Data.Warning := Warning;
  1237. DoCallback(iscbNotifyStatus, Data);
  1238. end;
  1239. procedure TSetupCompiler.AddStatusFmt(const Msg: String; const Args: array of const;
  1240. const Warning: Boolean);
  1241. begin
  1242. AddStatus(Format(Msg, Args), Warning);
  1243. end;
  1244. procedure TSetupCompiler.OnCheckedTrust(CheckedTrust: Boolean);
  1245. begin
  1246. if CheckedTrust then
  1247. AddStatus(SCompilerStatusVerified)
  1248. else
  1249. AddStatus(SCompilerStatusVerificationDisabled);
  1250. end;
  1251. class procedure TSetupCompiler.AbortCompile(const Msg: String);
  1252. begin
  1253. raise EISCompileError.Create(Msg);
  1254. end;
  1255. class procedure TSetupCompiler.AbortCompileFmt(const Msg: String; const Args: array of const);
  1256. begin
  1257. AbortCompile(Format(Msg, Args));
  1258. end;
  1259. class procedure TSetupCompiler.AbortCompileParamError(const Msg, ParamName: String);
  1260. begin
  1261. AbortCompileFmt(Msg, [ParamName]);
  1262. end;
  1263. function TSetupCompiler.PrependDirName(const Filename, Dir: String): String;
  1264. function GetShellFolderPathCached(const FolderID: Integer;
  1265. var CachedDir: String): String;
  1266. var
  1267. S: String;
  1268. begin
  1269. if CachedDir = '' then begin
  1270. S := GetShellFolderPath(FolderID);
  1271. if S = '' then
  1272. AbortCompileFmt('Failed to get shell folder path (0x%.4x)', [FolderID]);
  1273. S := AddBackslash(PathExpand(S));
  1274. CachedDir := S;
  1275. end;
  1276. Result := CachedDir;
  1277. end;
  1278. const
  1279. CSIDL_PERSONAL = $0005;
  1280. var
  1281. P: Integer;
  1282. Prefix: String;
  1283. begin
  1284. P := PathPos(':', Filename);
  1285. if (P = 0) or
  1286. ((P = 2) and CharInSet(UpCase(Filename[1]), ['A'..'Z'])) then begin
  1287. if (Filename = '') or not IsRelativePath(Filename) then
  1288. Result := Filename
  1289. else
  1290. Result := Dir + Filename;
  1291. end
  1292. else begin
  1293. Prefix := Copy(Filename, 1, P-1);
  1294. if Prefix = 'compiler' then
  1295. Result := CompilerDir + Copy(Filename, P+1, Maxint)
  1296. else if Prefix = 'userdocs' then
  1297. Result := GetShellFolderPathCached(CSIDL_PERSONAL, CachedUserDocsDir) +
  1298. Copy(Filename, P+1, Maxint)
  1299. else begin
  1300. AbortCompileFmt(SCompilerUnknownFilenamePrefix, [Copy(Filename, 1, P)]);
  1301. Result := Filename; { avoid warning }
  1302. end;
  1303. end;
  1304. end;
  1305. function TSetupCompiler.PrependSourceDirName(const Filename: String): String;
  1306. begin
  1307. Result := PrependDirName(Filename, SourceDir);
  1308. end;
  1309. procedure TSetupCompiler.RenamedConstantCallback(const Cnst, CnstRenamed: String);
  1310. begin
  1311. if Pos('common', LowerCase(CnstRenamed)) <> 0 then
  1312. WarningsList.Add(Format(SCompilerCommonConstantRenamed, [Cnst, CnstRenamed]))
  1313. else
  1314. WarningsList.Add(Format(SCompilerConstantRenamed, [Cnst, CnstRenamed]));
  1315. end;
  1316. function TSetupCompiler.CheckConst(const S: String; const MinVersion: TSetupVersionData;
  1317. const AllowedConsts: TAllowedConsts): Boolean;
  1318. { Returns True if S contains constants. Aborts compile if they are invalid. }
  1319. function CheckEnvConst(C: String): Boolean;
  1320. { based on ExpandEnvConst in Main.pas }
  1321. var
  1322. I: Integer;
  1323. VarName, Default: String;
  1324. begin
  1325. Delete(C, 1, 1);
  1326. I := ConstPos('|', C); { check for 'default' value }
  1327. if I = 0 then
  1328. I := Length(C)+1;
  1329. VarName := Copy(C, 1, I-1);
  1330. Default := Copy(C, I+1, Maxint);
  1331. if ConvertConstPercentStr(VarName) and ConvertConstPercentStr(Default) then begin
  1332. CheckConst(VarName, MinVersion, AllowedConsts);
  1333. CheckConst(Default, MinVersion, AllowedConsts);
  1334. Result := True;
  1335. Exit;
  1336. end;
  1337. { it will only reach here if there was a parsing error }
  1338. Result := False;
  1339. end;
  1340. function CheckRegConst(C: String): Boolean;
  1341. { based on ExpandRegConst in Main.pas }
  1342. type
  1343. TKeyNameConst = packed record
  1344. KeyName: String;
  1345. KeyConst: HKEY;
  1346. end;
  1347. const
  1348. KeyNameConsts: array[0..5] of TKeyNameConst = (
  1349. (KeyName: 'HKA'; KeyConst: HKEY_AUTO),
  1350. (KeyName: 'HKCR'; KeyConst: HKEY_CLASSES_ROOT),
  1351. (KeyName: 'HKCU'; KeyConst: HKEY_CURRENT_USER),
  1352. (KeyName: 'HKLM'; KeyConst: HKEY_LOCAL_MACHINE),
  1353. (KeyName: 'HKU'; KeyConst: HKEY_USERS),
  1354. (KeyName: 'HKCC'; KeyConst: HKEY_CURRENT_CONFIG));
  1355. var
  1356. Z, Subkey, Value, Default: String;
  1357. I, J, L: Integer;
  1358. RootKey: HKEY;
  1359. begin
  1360. Delete(C, 1, 4); { skip past 'reg:' }
  1361. I := ConstPos('\', C);
  1362. if I <> 0 then begin
  1363. Z := Copy(C, 1, I-1);
  1364. if Z <> '' then begin
  1365. L := Length(Z);
  1366. if L >= 2 then begin
  1367. { Check for '32' or '64' suffix }
  1368. if ((Z[L-1] = '3') and (Z[L] = '2')) or
  1369. ((Z[L-1] = '6') and (Z[L] = '4')) then
  1370. SetLength(Z, L-2);
  1371. end;
  1372. RootKey := 0;
  1373. for J := Low(KeyNameConsts) to High(KeyNameConsts) do
  1374. if CompareText(KeyNameConsts[J].KeyName, Z) = 0 then begin
  1375. RootKey := KeyNameConsts[J].KeyConst;
  1376. Break;
  1377. end;
  1378. if RootKey <> 0 then begin
  1379. Z := Copy(C, I+1, Maxint);
  1380. I := ConstPos('|', Z); { check for a 'default' data }
  1381. if I = 0 then
  1382. I := Length(Z)+1;
  1383. Default := Copy(Z, I+1, Maxint);
  1384. SetLength(Z, I-1);
  1385. I := ConstPos(',', Z); { comma separates subkey and value }
  1386. if I <> 0 then begin
  1387. Subkey := Copy(Z, 1, I-1);
  1388. Value := Copy(Z, I+1, Maxint);
  1389. if ConvertConstPercentStr(Subkey) and ConvertConstPercentStr(Value) and
  1390. ConvertConstPercentStr(Default) then begin
  1391. CheckConst(Subkey, MinVersion, AllowedConsts);
  1392. CheckConst(Value, MinVersion, AllowedConsts);
  1393. CheckConst(Default, MinVersion, AllowedConsts);
  1394. Result := True;
  1395. Exit;
  1396. end;
  1397. end;
  1398. end;
  1399. end;
  1400. end;
  1401. { it will only reach here if there was a parsing error }
  1402. Result := False;
  1403. end;
  1404. function CheckIniConst(C: String): Boolean;
  1405. { based on ExpandIniConst in Main.pas }
  1406. var
  1407. Z, Filename, Section, Key, Default: String;
  1408. I: Integer;
  1409. begin
  1410. Delete(C, 1, 4); { skip past 'ini:' }
  1411. I := ConstPos(',', C);
  1412. if I <> 0 then begin
  1413. Z := Copy(C, 1, I-1);
  1414. if Z <> '' then begin
  1415. Filename := Z;
  1416. Z := Copy(C, I+1, Maxint);
  1417. I := ConstPos('|', Z); { check for a 'default' data }
  1418. if I = 0 then
  1419. I := Length(Z)+1;
  1420. Default := Copy(Z, I+1, Maxint);
  1421. SetLength(Z, I-1);
  1422. I := ConstPos(',', Z); { comma separates section and key }
  1423. if I <> 0 then begin
  1424. Section := Copy(Z, 1, I-1);
  1425. Key := Copy(Z, I+1, Maxint);
  1426. if ConvertConstPercentStr(Filename) and ConvertConstPercentStr(Section) and
  1427. ConvertConstPercentStr(Key) and ConvertConstPercentStr(Default) then begin
  1428. CheckConst(Filename, MinVersion, AllowedConsts);
  1429. CheckConst(Section, MinVersion, AllowedConsts);
  1430. CheckConst(Key, MinVersion, AllowedConsts);
  1431. CheckConst(Default, MinVersion, AllowedConsts);
  1432. Result := True;
  1433. Exit;
  1434. end;
  1435. end;
  1436. end;
  1437. end;
  1438. { it will only reach here if there was a parsing error }
  1439. Result := False;
  1440. end;
  1441. function CheckParamConst(C: String): Boolean;
  1442. var
  1443. Z, Param, Default: String;
  1444. I: Integer;
  1445. begin
  1446. Delete(C, 1, 6); { skip past 'param:' }
  1447. Z := C;
  1448. I := ConstPos('|', Z); { check for a 'default' data }
  1449. if I = 0 then
  1450. I := Length(Z)+1;
  1451. Default := Copy(Z, I+1, Maxint);
  1452. SetLength(Z, I-1);
  1453. Param := Z;
  1454. if ConvertConstPercentStr(Param) and ConvertConstPercentStr(Default) then begin
  1455. CheckConst(Param, MinVersion, AllowedConsts);
  1456. CheckConst(Default, MinVersion, AllowedConsts);
  1457. Result := True;
  1458. Exit;
  1459. end;
  1460. { it will only reach here if there was a parsing error }
  1461. Result := False;
  1462. end;
  1463. function CheckCodeConst(C: String): Boolean;
  1464. var
  1465. Z, ScriptFunc, Param: String;
  1466. I: Integer;
  1467. begin
  1468. Delete(C, 1, 5); { skip past 'code:' }
  1469. Z := C;
  1470. I := ConstPos('|', Z); { check for optional parameter }
  1471. if I = 0 then
  1472. I := Length(Z)+1;
  1473. Param := Copy(Z, I+1, Maxint);
  1474. SetLength(Z, I-1);
  1475. ScriptFunc := Z;
  1476. if ConvertConstPercentStr(ScriptFunc) and ConvertConstPercentStr(Param) then begin
  1477. CheckConst(Param, MinVersion, AllowedConsts);
  1478. CodeCompiler.AddExport(ScriptFunc, 'String @String', False, True, LineFileName, LineNumber);
  1479. Result := True;
  1480. Exit;
  1481. end;
  1482. { it will only reach here if there was a parsing error }
  1483. Result := False;
  1484. end;
  1485. function CheckDriveConst(C: String): Boolean;
  1486. begin
  1487. Delete(C, 1, 6); { skip past 'drive:' }
  1488. if ConvertConstPercentStr(C) then begin
  1489. CheckConst(C, MinVersion, AllowedConsts);
  1490. Result := True;
  1491. Exit;
  1492. end;
  1493. { it will only reach here if there was a parsing error }
  1494. Result := False;
  1495. end;
  1496. function CheckCustomMessageConst(C: String): Boolean;
  1497. var
  1498. MsgName, Arg: String;
  1499. I, ArgCount: Integer;
  1500. Found: Boolean;
  1501. LineInfo: TLineInfo;
  1502. begin
  1503. Delete(C, 1, 3); { skip past 'cm:' }
  1504. I := ConstPos(',', C);
  1505. if I = 0 then
  1506. MsgName := C
  1507. else
  1508. MsgName := Copy(C, 1, I-1);
  1509. { Check each argument }
  1510. ArgCount := 0;
  1511. while I > 0 do begin
  1512. if ArgCount >= 9 then begin
  1513. { Can't have more than 9 arguments (%1 through %9) }
  1514. Result := False;
  1515. Exit;
  1516. end;
  1517. Delete(C, 1, I);
  1518. I := ConstPos(',', C);
  1519. if I = 0 then
  1520. Arg := C
  1521. else
  1522. Arg := Copy(C, 1, I-1);
  1523. if not ConvertConstPercentStr(Arg) then begin
  1524. Result := False;
  1525. Exit;
  1526. end;
  1527. CheckConst(Arg, MinVersion, AllowedConsts);
  1528. Inc(ArgCount);
  1529. end;
  1530. Found := False;
  1531. for I := 0 to ExpectedCustomMessageNames.Count-1 do begin
  1532. if CompareText(ExpectedCustomMessageNames[I], MsgName) = 0 then begin
  1533. Found := True;
  1534. Break;
  1535. end;
  1536. end;
  1537. if not Found then begin
  1538. LineInfo := TLineInfo.Create;
  1539. LineInfo.FileName := LineFileName;
  1540. LineInfo.FileLineNumber := LineNumber;
  1541. ExpectedCustomMessageNames.AddObject(MsgName, LineInfo);
  1542. end;
  1543. Result := True;
  1544. end;
  1545. const
  1546. UserConsts: array[0..0] of String = (
  1547. 'username');
  1548. Consts: array[0..41] of String = (
  1549. 'src', 'srcexe', 'tmp', 'app', 'win', 'sys', 'sd', 'groupname', 'commonfonts',
  1550. 'commonpf', 'commonpf32', 'commonpf64', 'commoncf', 'commoncf32', 'commoncf64',
  1551. 'autopf', 'autopf32', 'autopf64', 'autocf', 'autocf32', 'autocf64',
  1552. 'computername', 'dao', 'cmd', 'wizardhwnd', 'sysuserinfoname', 'sysuserinfoorg',
  1553. 'userinfoname', 'userinfoorg', 'userinfoserial', 'uninstallexe',
  1554. 'language', 'syswow64', 'sysnative', 'log', 'dotnet11', 'dotnet20', 'dotnet2032',
  1555. 'dotnet2064', 'dotnet40', 'dotnet4032', 'dotnet4064');
  1556. UserShellFolderConsts: array[0..13] of String = (
  1557. 'userdesktop', 'userstartmenu', 'userprograms', 'userstartup',
  1558. 'userappdata', 'userdocs', 'usertemplates', 'userfavorites', 'usersendto', 'userfonts',
  1559. 'localappdata', 'userpf', 'usercf', 'usersavedgames');
  1560. ShellFolderConsts: array[0..16] of String = (
  1561. 'group', 'commondesktop', 'commonstartmenu', 'commonprograms', 'commonstartup',
  1562. 'commonappdata', 'commondocs', 'commontemplates',
  1563. 'autodesktop', 'autostartmenu', 'autoprograms', 'autostartup',
  1564. 'autoappdata', 'autodocs', 'autotemplates', 'autofavorites', 'autofonts');
  1565. AllowedConstsNames: array[TAllowedConst] of String = (
  1566. 'olddata', 'break');
  1567. var
  1568. I, Start, K: Integer;
  1569. C: TAllowedConst;
  1570. Cnst: String;
  1571. label 1;
  1572. begin
  1573. Result := False;
  1574. I := 1;
  1575. while I <= Length(S) do begin
  1576. if S[I] = '{' then begin
  1577. if (I < Length(S)) and (S[I+1] = '{') then
  1578. Inc(I)
  1579. else begin
  1580. Result := True;
  1581. Start := I;
  1582. { Find the closing brace, skipping over any embedded constants }
  1583. I := SkipPastConst(S, I);
  1584. if I = 0 then { unclosed constant? }
  1585. AbortCompileFmt(SCompilerUnterminatedConst, [Copy(S, Start+1, Maxint)]);
  1586. Dec(I); { 'I' now points to the closing brace }
  1587. { Now check the constant }
  1588. Cnst := Copy(S, Start+1, I-(Start+1));
  1589. if Cnst <> '' then begin
  1590. HandleRenamedConstants(Cnst, RenamedConstantCallback);
  1591. if Cnst = '\' then
  1592. goto 1;
  1593. if Cnst[1] = '%' then begin
  1594. if not CheckEnvConst(Cnst) then
  1595. AbortCompileFmt(SCompilerBadEnvConst, [Cnst]);
  1596. goto 1;
  1597. end;
  1598. if Copy(Cnst, 1, 4) = 'reg:' then begin
  1599. if not CheckRegConst(Cnst) then
  1600. AbortCompileFmt(SCompilerBadRegConst, [Cnst]);
  1601. goto 1;
  1602. end;
  1603. if Copy(Cnst, 1, 4) = 'ini:' then begin
  1604. if not CheckIniConst(Cnst) then
  1605. AbortCompileFmt(SCompilerBadIniConst, [Cnst]);
  1606. goto 1;
  1607. end;
  1608. if Copy(Cnst, 1, 6) = 'param:' then begin
  1609. if not CheckParamConst(Cnst) then
  1610. AbortCompileFmt(SCompilerBadParamConst, [Cnst]);
  1611. goto 1;
  1612. end;
  1613. if Copy(Cnst, 1, 5) = 'code:' then begin
  1614. if not CheckCodeConst(Cnst) then
  1615. AbortCompileFmt(SCompilerBadCodeConst, [Cnst]);
  1616. goto 1;
  1617. end;
  1618. if Copy(Cnst, 1, 6) = 'drive:' then begin
  1619. if not CheckDriveConst(Cnst) then
  1620. AbortCompileFmt(SCompilerBadDriveConst, [Cnst]);
  1621. goto 1;
  1622. end;
  1623. if Copy(Cnst, 1, 3) = 'cm:' then begin
  1624. if not CheckCustomMessageConst(Cnst) then
  1625. AbortCompileFmt(SCompilerBadCustomMessageConst, [Cnst]);
  1626. goto 1;
  1627. end;
  1628. for K := Low(UserConsts) to High(UserConsts) do
  1629. if Cnst = UserConsts[K] then begin
  1630. UsedUserAreas.Add(Cnst);
  1631. goto 1;
  1632. end;
  1633. for K := Low(Consts) to High(Consts) do
  1634. if Cnst = Consts[K] then
  1635. goto 1;
  1636. for K := Low(UserShellFolderConsts) to High(UserShellFolderConsts) do
  1637. if Cnst = UserShellFolderConsts[K] then begin
  1638. UsedUserAreas.Add(Cnst);
  1639. goto 1;
  1640. end;
  1641. for K := Low(ShellFolderConsts) to High(ShellFolderConsts) do
  1642. if Cnst = ShellFolderConsts[K] then
  1643. goto 1;
  1644. for C := Low(C) to High(C) do
  1645. if Cnst = AllowedConstsNames[C] then begin
  1646. if not(C in AllowedConsts) then
  1647. AbortCompileFmt(SCompilerConstCannotUse, [Cnst]);
  1648. goto 1;
  1649. end;
  1650. end;
  1651. AbortCompileFmt(SCompilerUnknownConst, [Cnst]);
  1652. 1:{ Constant is OK }
  1653. end;
  1654. end;
  1655. Inc(I);
  1656. end;
  1657. end;
  1658. function TSetupCompiler.EvalCheckOrInstallIdentifier(Sender: TSimpleExpression;
  1659. const Name: String; const Parameters: array of const): Boolean;
  1660. var
  1661. IsCheck: Boolean;
  1662. Decl: String;
  1663. I: Integer;
  1664. begin
  1665. IsCheck := Boolean(Sender.Tag);
  1666. if IsCheck then
  1667. Decl := 'Boolean'
  1668. else
  1669. Decl := '0';
  1670. for I := Low(Parameters) to High(Parameters) do begin
  1671. if Parameters[I].VType = vtUnicodeString then
  1672. Decl := Decl + ' @String'
  1673. else if Parameters[I].VType = vtInteger then
  1674. Decl := Decl + ' @LongInt'
  1675. else if Parameters[I].VType = vtBoolean then
  1676. Decl := Decl + ' @Boolean'
  1677. else
  1678. raise Exception.Create('Internal Error: unknown parameter type');
  1679. end;
  1680. CodeCompiler.AddExport(Name, Decl, False, True, LineFileName, LineNumber);
  1681. Result := True; { Result doesn't matter }
  1682. end;
  1683. procedure TSetupCompiler.CheckCheckOrInstall(const ParamName, ParamData: String;
  1684. const Kind: TCheckOrInstallKind);
  1685. var
  1686. SimpleExpression: TSimpleExpression;
  1687. IsCheck, BoolResult: Boolean;
  1688. begin
  1689. if ParamData <> '' then begin
  1690. if (Kind <> cikDirectiveCheck) or not TryStrToBoolean(ParamData, BoolResult) then begin
  1691. IsCheck := Kind in [cikCheck, cikDirectiveCheck];
  1692. { Check the expression in ParamData and add exports while
  1693. evaluating. Use non-Lazy checking to make sure everything is evaluated. }
  1694. try
  1695. SimpleExpression := TSimpleExpression.Create;
  1696. try
  1697. SimpleExpression.Lazy := False;
  1698. SimpleExpression.Expression := ParamData;
  1699. SimpleExpression.OnEvalIdentifier := EvalCheckOrInstallIdentifier;
  1700. SimpleExpression.SilentOrAllowed := False;
  1701. SimpleExpression.SingleIdentifierMode := not IsCheck;
  1702. SimpleExpression.ParametersAllowed := True;
  1703. SimpleExpression.Tag := Integer(IsCheck);
  1704. SimpleExpression.Eval;
  1705. finally
  1706. SimpleExpression.Free;
  1707. end;
  1708. except
  1709. AbortCompileFmt(SCompilerExpressionError, [ParamName,
  1710. GetExceptMessage]);
  1711. end;
  1712. end;
  1713. end
  1714. else begin
  1715. if Kind = cikDirectiveCheck then
  1716. AbortCompileFmt(SCompilerEntryInvalid2, ['Setup', ParamName]);
  1717. end;
  1718. end;
  1719. function ExtractFlag(var S: String; const FlagStrs: array of PChar): Integer;
  1720. var
  1721. I: Integer;
  1722. F: String;
  1723. begin
  1724. F := ExtractStr(S, ' ');
  1725. if F = '' then begin
  1726. Result := -2;
  1727. Exit;
  1728. end;
  1729. Result := -1;
  1730. for I := 0 to High(FlagStrs) do
  1731. if StrIComp(FlagStrs[I], PChar(F)) = 0 then begin
  1732. Result := I;
  1733. Break;
  1734. end;
  1735. end;
  1736. function ExtractType(var S: String; const TypeEntries: TList): Integer;
  1737. var
  1738. I: Integer;
  1739. F: String;
  1740. begin
  1741. F := ExtractStr(S, ' ');
  1742. if F = '' then begin
  1743. Result := -2;
  1744. Exit;
  1745. end;
  1746. Result := -1;
  1747. if TypeEntries.Count <> 0 then begin
  1748. for I := 0 to TypeEntries.Count-1 do
  1749. if CompareText(PSetupTypeEntry(TypeEntries[I]).Name, F) = 0 then begin
  1750. Result := I;
  1751. Break;
  1752. end;
  1753. end else begin
  1754. for I := 0 to High(DefaultTypeEntryNames) do
  1755. if StrIComp(DefaultTypeEntryNames[I], PChar(F)) = 0 then begin
  1756. Result := I;
  1757. Break;
  1758. end;
  1759. end;
  1760. end;
  1761. function ExtractLangIndex(SetupCompiler: TSetupCompiler; var S: String;
  1762. const LanguageEntryIndex: Integer; const Pre: Boolean): Integer;
  1763. var
  1764. I: Integer;
  1765. begin
  1766. if LanguageEntryIndex = -1 then begin
  1767. { Message in the main script }
  1768. I := Pos('.', S);
  1769. if I = 0 then begin
  1770. { No '.'; apply to all languages }
  1771. Result := -1;
  1772. end
  1773. else begin
  1774. { Apply to specified language }
  1775. Result := SetupCompiler.FindLangEntryIndexByName(Copy(S, 1, I-1), Pre);
  1776. S := Copy(S, I+1, Maxint);
  1777. end;
  1778. end
  1779. else begin
  1780. { Inside a language file }
  1781. if Pos('.', S) <> 0 then
  1782. SetupCompiler.AbortCompile(SCompilerCantSpecifyLanguage);
  1783. Result := LanguageEntryIndex;
  1784. end;
  1785. end;
  1786. function TSetupCompiler.EvalArchitectureIdentifier(Sender: TSimpleExpression;
  1787. const Name: String; const Parameters: array of const): Boolean;
  1788. const
  1789. ArchIdentifiers: array[0..8] of String = (
  1790. 'arm32compatible', 'arm64', 'win64',
  1791. 'x64', 'x64os', 'x64compatible',
  1792. 'x86', 'x86os', 'x86compatible');
  1793. begin
  1794. for var ArchIdentifier in ArchIdentifiers do begin
  1795. if Name = ArchIdentifier then begin
  1796. if ArchIdentifier = 'x64' then
  1797. WarningsList.Add(Format(SCompilerArchitectureIdentifierDeprecatedWarning, ['x64', 'x64os', 'x64compatible']));
  1798. Exit(True); { Result doesn't matter }
  1799. end;
  1800. end;
  1801. raise Exception.CreateFmt(SCompilerArchitectureIdentifierInvalid, [Name]);
  1802. end;
  1803. { Sets the Used properties while evaluating }
  1804. function TSetupCompiler.EvalComponentIdentifier(Sender: TSimpleExpression; const Name: String;
  1805. const Parameters: array of const): Boolean;
  1806. var
  1807. Found: Boolean;
  1808. ComponentEntry: PSetupComponentEntry;
  1809. I: Integer;
  1810. begin
  1811. Found := False;
  1812. for I := 0 to ComponentEntries.Count-1 do begin
  1813. ComponentEntry := PSetupComponentEntry(ComponentEntries[I]);
  1814. if CompareText(ComponentEntry.Name, Name) = 0 then begin
  1815. ComponentEntry.Used := True;
  1816. Found := True;
  1817. { Don't Break; there may be multiple components with the same name }
  1818. end;
  1819. end;
  1820. if not Found then
  1821. raise Exception.CreateFmt(SCompilerParamUnknownComponent, [ParamCommonComponents]);
  1822. Result := True; { Result doesn't matter }
  1823. end;
  1824. { Sets the Used properties while evaluating }
  1825. function TSetupCompiler.EvalTaskIdentifier(Sender: TSimpleExpression; const Name: String;
  1826. const Parameters: array of const): Boolean;
  1827. var
  1828. Found: Boolean;
  1829. TaskEntry: PSetupTaskEntry;
  1830. I: Integer;
  1831. begin
  1832. Found := False;
  1833. for I := 0 to TaskEntries.Count-1 do begin
  1834. TaskEntry := PSetupTaskEntry(TaskEntries[I]);
  1835. if CompareText(TaskEntry.Name, Name) = 0 then begin
  1836. TaskEntry.Used := True;
  1837. Found := True;
  1838. { Don't Break; there may be multiple tasks with the same name }
  1839. end;
  1840. end;
  1841. if not Found then
  1842. raise Exception.CreateFmt(SCompilerParamUnknownTask, [ParamCommonTasks]);
  1843. Result := True; { Result doesn't matter }
  1844. end;
  1845. function TSetupCompiler.EvalLanguageIdentifier(Sender: TSimpleExpression; const Name: String;
  1846. const Parameters: array of const): Boolean;
  1847. var
  1848. LanguageEntry: PSetupLanguageEntry;
  1849. I: Integer;
  1850. begin
  1851. for I := 0 to LanguageEntries.Count-1 do begin
  1852. LanguageEntry := PSetupLanguageEntry(LanguageEntries[I]);
  1853. if CompareText(LanguageEntry.Name, Name) = 0 then begin
  1854. Result := True; { Result doesn't matter }
  1855. Exit;
  1856. end;
  1857. end;
  1858. raise Exception.CreateFmt(SCompilerParamUnknownLanguage, [ParamCommonLanguages]);
  1859. end;
  1860. procedure TSetupCompiler.ProcessExpressionParameter(const ParamName,
  1861. ParamData: String; OnEvalIdentifier: TSimpleExpressionOnEvalIdentifier;
  1862. SlashConvert: Boolean; var ProcessedParamData: String);
  1863. var
  1864. SimpleExpression: TSimpleExpression;
  1865. begin
  1866. ProcessedParamData := Trim(ParamData);
  1867. if ProcessedParamData <> '' then begin
  1868. if SlashConvert then
  1869. StringChange(ProcessedParamData, '/', '\');
  1870. { Check the expression in ParamData. Use non-Lazy checking to make sure
  1871. everything is evaluated. }
  1872. try
  1873. SimpleExpression := TSimpleExpression.Create;
  1874. try
  1875. SimpleExpression.Lazy := False;
  1876. SimpleExpression.Expression := ProcessedParamData;
  1877. SimpleExpression.OnEvalIdentifier := OnEvalIdentifier;
  1878. SimpleExpression.SilentOrAllowed := True;
  1879. SimpleExpression.SingleIdentifierMode := False;
  1880. SimpleExpression.ParametersAllowed := False;
  1881. SimpleExpression.Eval;
  1882. finally
  1883. SimpleExpression.Free;
  1884. end;
  1885. except
  1886. AbortCompileFmt(SCompilerExpressionError, [ParamName,
  1887. GetExceptMessage]);
  1888. end;
  1889. end;
  1890. end;
  1891. procedure TSetupCompiler.ProcessWildcardsParameter(const ParamData: String;
  1892. const AWildcards: TStringList; const TooLongMsg: String);
  1893. var
  1894. S, AWildcard: String;
  1895. begin
  1896. S := PathLowercase(ParamData);
  1897. while True do begin
  1898. AWildcard := ExtractStr(S, ',');
  1899. if AWildcard = '' then
  1900. Break;
  1901. { Impose a reasonable limit on the length of the string so
  1902. that WildcardMatch can't overflow the stack }
  1903. if Length(AWildcard) >= MAX_PATH then
  1904. AbortCompile(TooLongMsg);
  1905. AWildcards.Add(AWildcard);
  1906. end;
  1907. end;
  1908. procedure TSetupCompiler.ProcessMinVersionParameter(const ParamValue: TParamValue;
  1909. var AMinVersion: TSetupVersionData);
  1910. begin
  1911. if ParamValue.Found then
  1912. if not StrToSetupVersionData(ParamValue.Data, AMinVersion) then
  1913. AbortCompileParamError(SCompilerParamInvalid2, ParamCommonMinVersion);
  1914. end;
  1915. procedure TSetupCompiler.ProcessOnlyBelowVersionParameter(const ParamValue: TParamValue;
  1916. var AOnlyBelowVersion: TSetupVersionData);
  1917. begin
  1918. if ParamValue.Found then begin
  1919. if not StrToSetupVersionData(ParamValue.Data, AOnlyBelowVersion) then
  1920. AbortCompileParamError(SCompilerParamInvalid2, ParamCommonOnlyBelowVersion);
  1921. if (AOnlyBelowVersion.NTVersion <> 0) and
  1922. (AOnlyBelowVersion.NTVersion <= $06010000) then
  1923. WarningsList.Add(Format(SCompilerOnlyBelowVersionParameterNTTooLowWarning, ['6.1']));
  1924. end;
  1925. end;
  1926. procedure TSetupCompiler.ProcessPermissionsParameter(ParamData: String;
  1927. const AccessMasks: array of TNameAndAccessMask; var PermissionsEntry: Smallint);
  1928. procedure GetSidFromName(const AName: String; var ASid: TGrantPermissionSid);
  1929. type
  1930. TKnownSid = record
  1931. Name: String;
  1932. Sid: TGrantPermissionSid;
  1933. end;
  1934. const
  1935. SECURITY_WORLD_SID_AUTHORITY = 1;
  1936. SECURITY_WORLD_RID = $00000000;
  1937. SECURITY_CREATOR_SID_AUTHORITY = 3;
  1938. SECURITY_CREATOR_OWNER_RID = $00000000;
  1939. SECURITY_NT_AUTHORITY = 5;
  1940. SECURITY_AUTHENTICATED_USER_RID = $0000000B;
  1941. SECURITY_LOCAL_SYSTEM_RID = $00000012;
  1942. SECURITY_LOCAL_SERVICE_RID = $00000013;
  1943. SECURITY_NETWORK_SERVICE_RID = $00000014;
  1944. SECURITY_BUILTIN_DOMAIN_RID = $00000020;
  1945. DOMAIN_ALIAS_RID_ADMINS = $00000220;
  1946. DOMAIN_ALIAS_RID_USERS = $00000221;
  1947. DOMAIN_ALIAS_RID_GUESTS = $00000222;
  1948. DOMAIN_ALIAS_RID_POWER_USERS = $00000223;
  1949. DOMAIN_ALIAS_RID_IIS_IUSRS = $00000238;
  1950. KnownSids: array[0..10] of TKnownSid = (
  1951. (Name: 'admins';
  1952. Sid: (Authority: (Value: (0, 0, 0, 0, 0, SECURITY_NT_AUTHORITY));
  1953. SubAuthCount: 2;
  1954. SubAuth: (SECURITY_BUILTIN_DOMAIN_RID, DOMAIN_ALIAS_RID_ADMINS))),
  1955. (Name: 'authusers';
  1956. Sid: (Authority: (Value: (0, 0, 0, 0, 0, SECURITY_NT_AUTHORITY));
  1957. SubAuthCount: 1;
  1958. SubAuth: (SECURITY_AUTHENTICATED_USER_RID, 0))),
  1959. (Name: 'creatorowner';
  1960. Sid: (Authority: (Value: (0, 0, 0, 0, 0, SECURITY_CREATOR_SID_AUTHORITY));
  1961. SubAuthCount: 1;
  1962. SubAuth: (SECURITY_CREATOR_OWNER_RID, 0))),
  1963. (Name: 'everyone';
  1964. Sid: (Authority: (Value: (0, 0, 0, 0, 0, SECURITY_WORLD_SID_AUTHORITY));
  1965. SubAuthCount: 1;
  1966. SubAuth: (SECURITY_WORLD_RID, 0))),
  1967. (Name: 'guests';
  1968. Sid: (Authority: (Value: (0, 0, 0, 0, 0, SECURITY_NT_AUTHORITY));
  1969. SubAuthCount: 2;
  1970. SubAuth: (SECURITY_BUILTIN_DOMAIN_RID, DOMAIN_ALIAS_RID_GUESTS))),
  1971. (Name: 'iisiusrs';
  1972. Sid: (Authority: (Value: (0, 0, 0, 0, 0, SECURITY_NT_AUTHORITY));
  1973. SubAuthCount: 2;
  1974. SubAuth: (SECURITY_BUILTIN_DOMAIN_RID, DOMAIN_ALIAS_RID_IIS_IUSRS))),
  1975. (Name: 'networkservice';
  1976. Sid: (Authority: (Value: (0, 0, 0, 0, 0, SECURITY_NT_AUTHORITY));
  1977. SubAuthCount: 1;
  1978. SubAuth: (SECURITY_NETWORK_SERVICE_RID, 0))),
  1979. (Name: 'powerusers';
  1980. Sid: (Authority: (Value: (0, 0, 0, 0, 0, SECURITY_NT_AUTHORITY));
  1981. SubAuthCount: 2;
  1982. SubAuth: (SECURITY_BUILTIN_DOMAIN_RID, DOMAIN_ALIAS_RID_POWER_USERS))),
  1983. (Name: 'service';
  1984. Sid: (Authority: (Value: (0, 0, 0, 0, 0, SECURITY_NT_AUTHORITY));
  1985. SubAuthCount: 1;
  1986. SubAuth: (SECURITY_LOCAL_SERVICE_RID, 0))),
  1987. (Name: 'system';
  1988. Sid: (Authority: (Value: (0, 0, 0, 0, 0, SECURITY_NT_AUTHORITY));
  1989. SubAuthCount: 1;
  1990. SubAuth: (SECURITY_LOCAL_SYSTEM_RID, 0))),
  1991. (Name: 'users';
  1992. Sid: (Authority: (Value: (0, 0, 0, 0, 0, SECURITY_NT_AUTHORITY));
  1993. SubAuthCount: 2;
  1994. SubAuth: (SECURITY_BUILTIN_DOMAIN_RID, DOMAIN_ALIAS_RID_USERS)))
  1995. );
  1996. var
  1997. I: Integer;
  1998. begin
  1999. for I := Low(KnownSids) to High(KnownSids) do
  2000. if CompareText(AName, KnownSids[I].Name) = 0 then begin
  2001. ASid := KnownSids[I].Sid;
  2002. Exit;
  2003. end;
  2004. AbortCompileFmt(SCompilerPermissionsUnknownSid, [AName]);
  2005. end;
  2006. procedure GetAccessMaskFromName(const AName: String; var AAccessMask: DWORD);
  2007. var
  2008. I: Integer;
  2009. begin
  2010. for I := Low(AccessMasks) to High(AccessMasks) do
  2011. if CompareText(AName, AccessMasks[I].Name) = 0 then begin
  2012. AAccessMask := AccessMasks[I].Mask;
  2013. Exit;
  2014. end;
  2015. AbortCompileFmt(SCompilerPermissionsUnknownMask, [AName]);
  2016. end;
  2017. var
  2018. Perms, E: AnsiString;
  2019. S: String;
  2020. PermsCount, P, I: Integer;
  2021. Entry: TGrantPermissionEntry;
  2022. NewPermissionEntry: PSetupPermissionEntry;
  2023. begin
  2024. { Parse }
  2025. PermsCount := 0;
  2026. while True do begin
  2027. S := ExtractStr(ParamData, ' ');
  2028. if S = '' then
  2029. Break;
  2030. P := Pos('-', S);
  2031. if P = 0 then
  2032. AbortCompileFmt(SCompilerPermissionsInvalidValue, [S]);
  2033. FillChar(Entry, SizeOf(Entry), 0);
  2034. GetSidFromName(Copy(S, 1, P-1), Entry.Sid);
  2035. GetAccessMaskFromName(Copy(S, P+1, Maxint), Entry.AccessMask);
  2036. SetString(E, PAnsiChar(@Entry), SizeOf(Entry));
  2037. Perms := Perms + E;
  2038. Inc(PermsCount);
  2039. if PermsCount > MaxGrantPermissionEntries then
  2040. AbortCompileFmt(SCompilerPermissionsValueLimitExceeded, [MaxGrantPermissionEntries]);
  2041. end;
  2042. if Perms = '' then begin
  2043. { No permissions }
  2044. PermissionsEntry := -1;
  2045. end
  2046. else begin
  2047. { See if there's already an identical permissions entry }
  2048. for I := 0 to PermissionEntries.Count-1 do
  2049. if PSetupPermissionEntry(PermissionEntries[I]).Permissions = Perms then begin
  2050. PermissionsEntry := I;
  2051. Exit;
  2052. end;
  2053. { If not, create a new one }
  2054. PermissionEntries.Expand;
  2055. NewPermissionEntry := AllocMem(SizeOf(NewPermissionEntry^));
  2056. NewPermissionEntry.Permissions := Perms;
  2057. I := PermissionEntries.Add(NewPermissionEntry);
  2058. if I > High(PermissionsEntry) then
  2059. AbortCompile(SCompilerPermissionsTooMany);
  2060. PermissionsEntry := I;
  2061. end;
  2062. end;
  2063. procedure TSetupCompiler.ReadTextFile(const Filename: String; const LangIndex: Integer;
  2064. var Text: AnsiString);
  2065. var
  2066. F: TFile;
  2067. Size: Cardinal;
  2068. UnicodeFile, RTFFile: Boolean;
  2069. AnsiConvertCodePage: Integer;
  2070. S: RawByteString;
  2071. U: String;
  2072. begin
  2073. try
  2074. F := TFile.Create(Filename, fdOpenExisting, faRead, fsRead);
  2075. try
  2076. Size := F.CappedSize;
  2077. SetLength(S, Size);
  2078. F.ReadBuffer(S[1], Size);
  2079. UnicodeFile := ((Size >= 2) and (PWord(Pointer(S))^ = $FEFF)) or
  2080. ((Size >= 3) and (S[1] = #$EF) and (S[2] = #$BB) and (S[3] = #$BF));
  2081. RTFFile := Copy(S, 1, 6) = '{\rtf1';
  2082. if not UnicodeFile and not RTFFile and IsUTF8String(S) then begin
  2083. S := #$EF + #$BB + #$BF + S;
  2084. UnicodeFile := True;
  2085. end;
  2086. if not UnicodeFile and not RTFFile and (LangIndex >= 0) then begin
  2087. AnsiConvertCodePage := TPreLangData(PreLangDataList[LangIndex]).LanguageCodePage;
  2088. if AnsiConvertCodePage <> 0 then begin
  2089. AddStatus(Format(SCompilerStatusConvertCodePage , [AnsiConvertCodePage]));
  2090. { Convert the ANSI text to Unicode. }
  2091. SetCodePage(S, AnsiConvertCodePage, False);
  2092. U := String(S);
  2093. { Store the Unicode text in Text with a UTF16 BOM. }
  2094. Size := Length(U)*SizeOf(U[1]);
  2095. SetLength(Text, Size+2);
  2096. PWord(Pointer(Text))^ := $FEFF;
  2097. Move(U[1], Text[3], Size);
  2098. end else
  2099. Text := S;
  2100. end else
  2101. Text := S;
  2102. finally
  2103. F.Free;
  2104. end;
  2105. except
  2106. raise Exception.CreateFmt(SCompilerReadError, [Filename, GetExceptMessage]);
  2107. end;
  2108. end;
  2109. { Note: result Value may include leading/trailing whitespaces if it was quoted! }
  2110. procedure TSetupCompiler.SeparateDirective(const Line: PChar;
  2111. var Key, Value: String);
  2112. var
  2113. P: PChar;
  2114. begin
  2115. Key := '';
  2116. Value := '';
  2117. P := Line;
  2118. SkipWhitespace(P);
  2119. if P^ <> #0 then begin
  2120. Key := ExtractWords(P, '=');
  2121. if Key = '' then
  2122. AbortCompile(SCompilerDirectiveNameMissing);
  2123. if P^ <> '=' then
  2124. AbortCompileFmt(SCompilerDirectiveHasNoValue, [Key]);
  2125. Inc(P);
  2126. SkipWhitespace(P);
  2127. Value := ExtractWords(P, #0);
  2128. { If Value is surrounded in quotes, remove them. Note that unlike parameter
  2129. values, for backward compatibility we don't require embedded quotes to be
  2130. doubled, nor do we require surrounding quotes when there's a quote in
  2131. the middle of the value. Does *not* remove whitespace after removing quotes! }
  2132. if (Length(Value) >= 2) and
  2133. (Value[1] = '"') and (Value[Length(Value)] = '"') then
  2134. Value := Copy(Value, 2, Length(Value)-2);
  2135. end;
  2136. end;
  2137. procedure TSetupCompiler.SetBytesCompressedSoFar(const Value: Integer64);
  2138. begin
  2139. BytesCompressedSoFar := Value;
  2140. end;
  2141. procedure TSetupCompiler.SetOutput(Value: Boolean);
  2142. begin
  2143. Output := Value;
  2144. FixedOutput := True;
  2145. end;
  2146. procedure TSetupCompiler.SetOutputBaseFilename(const Value: String);
  2147. begin
  2148. OutputBaseFilename := Value;
  2149. FixedOutputBaseFilename := True;
  2150. end;
  2151. procedure TSetupCompiler.SetOutputDir(const Value: String);
  2152. begin
  2153. OutputDir := Value;
  2154. FixedOutputDir := True;
  2155. end;
  2156. procedure TSetupCompiler.EnumSetupProc(const Line: PChar; const Ext: Integer);
  2157. var
  2158. KeyName, Value: String;
  2159. I: Integer;
  2160. Directive: TSetupSectionDirective;
  2161. procedure Invalid;
  2162. begin
  2163. AbortCompileFmt(SCompilerEntryInvalid2, ['Setup', KeyName]);
  2164. end;
  2165. function StrToBool(const S: String): Boolean;
  2166. begin
  2167. Result := False;
  2168. if not TryStrToBoolean(S, Result) then
  2169. Invalid;
  2170. end;
  2171. function StrToIntRange(const S: String; const AMin, AMax: Integer): Integer;
  2172. var
  2173. E: Integer;
  2174. begin
  2175. Val(S, Result, E);
  2176. if (E <> 0) or (Result < AMin) or (Result > AMax) then
  2177. Invalid;
  2178. end;
  2179. procedure SetSetupHeaderOption(const Option: TSetupHeaderOption);
  2180. begin
  2181. if not StrToBool(Value) then
  2182. Exclude(SetupHeader.Options, Option)
  2183. else
  2184. Include(SetupHeader.Options, Option);
  2185. end;
  2186. function ExtractNumber(var P: PChar): Integer;
  2187. var
  2188. I: Integer;
  2189. begin
  2190. Result := 0;
  2191. for I := 0 to 3 do begin { maximum of 4 digits }
  2192. if not CharInSet(P^, ['0'..'9']) then begin
  2193. if I = 0 then
  2194. Invalid;
  2195. Break;
  2196. end;
  2197. Result := (Result * 10) + (Ord(P^) - Ord('0'));
  2198. Inc(P);
  2199. end;
  2200. end;
  2201. procedure StrToTouchDate(const S: String);
  2202. var
  2203. P: PChar;
  2204. Year, Month, Day: Integer;
  2205. ST: TSystemTime;
  2206. FT: TFileTime;
  2207. begin
  2208. if CompareText(S, 'current') = 0 then begin
  2209. TouchDateOption := tdCurrent;
  2210. Exit;
  2211. end;
  2212. if CompareText(S, 'none') = 0 then begin
  2213. TouchDateOption := tdNone;
  2214. Exit;
  2215. end;
  2216. P := PChar(S);
  2217. Year := ExtractNumber(P);
  2218. if (Year < 1980) or (Year > 2107) or (P^ <> '-') then
  2219. Invalid;
  2220. Inc(P);
  2221. Month := ExtractNumber(P);
  2222. if (Month < 1) or (Month > 12) or (P^ <> '-') then
  2223. Invalid;
  2224. Inc(P);
  2225. Day := ExtractNumber(P);
  2226. if (Day < 1) or (Day > 31) or (P^ <> #0) then
  2227. Invalid;
  2228. { Verify that the day is valid for the specified month & year }
  2229. FillChar(ST, SizeOf(ST), 0);
  2230. ST.wYear := Year;
  2231. ST.wMonth := Month;
  2232. ST.wDay := Day;
  2233. if not SystemTimeToFileTime(ST, FT) then
  2234. Invalid;
  2235. TouchDateOption := tdExplicit;
  2236. TouchDateYear := Year;
  2237. TouchDateMonth := Month;
  2238. TouchDateDay := Day;
  2239. end;
  2240. procedure StrToTouchTime(const S: String);
  2241. var
  2242. P: PChar;
  2243. Hour, Minute, Second: Integer;
  2244. begin
  2245. if CompareText(S, 'current') = 0 then begin
  2246. TouchTimeOption := ttCurrent;
  2247. Exit;
  2248. end;
  2249. if CompareText(S, 'none') = 0 then begin
  2250. TouchTimeOption := ttNone;
  2251. Exit;
  2252. end;
  2253. P := PChar(S);
  2254. Hour := ExtractNumber(P);
  2255. if (Hour > 23) or (P^ <> ':') then
  2256. Invalid;
  2257. Inc(P);
  2258. Minute := ExtractNumber(P);
  2259. if Minute > 59 then
  2260. Invalid;
  2261. if P^ = #0 then
  2262. Second := 0
  2263. else begin
  2264. if P^ <> ':' then
  2265. Invalid;
  2266. Inc(P);
  2267. Second := ExtractNumber(P);
  2268. if (Second > 59) or (P^ <> #0) then
  2269. Invalid;
  2270. end;
  2271. TouchTimeOption := ttExplicit;
  2272. TouchTimeHour := Hour;
  2273. TouchTimeMinute := Minute;
  2274. TouchTimeSecond := Second;
  2275. end;
  2276. function StrToPrivilegesRequiredOverrides(S: String): TSetupPrivilegesRequiredOverrides;
  2277. const
  2278. Overrides: array of PChar = ['commandline', 'dialog'];
  2279. begin
  2280. Result := [];
  2281. while True do
  2282. case ExtractFlag(S, Overrides) of
  2283. -2: Break;
  2284. -1: Invalid;
  2285. 0: Include(Result, proCommandLine);
  2286. 1: Result := Result + [proCommandLine, proDialog];
  2287. end;
  2288. end;
  2289. function StrToPrecompiledFiles(S: String): TPrecompiledFiles;
  2290. const
  2291. PrecompiledFiles: array of PChar = ['setupe32', 'setupldre32', 'is7zdll', 'isbunzipdll', 'isunzlibdll', 'islzmaexe'];
  2292. begin
  2293. Result := [];
  2294. while True do
  2295. case ExtractFlag(S, PrecompiledFiles) of
  2296. -2: Break;
  2297. -1: Invalid;
  2298. 0: Include(Result, pfSetupE32);
  2299. 1: Include(Result, pfSetupLdrE32);
  2300. 2: Include(Result, pfIs7zDll);
  2301. 3: Include(Result, pfIsbunzipDll);
  2302. 4: Include(Result, pfIsunzlibDll);
  2303. 5: Include(Result, pfIslzmaExe);
  2304. end;
  2305. end;
  2306. procedure StrToPercentages(const S: String; var X, Y: Integer; const Min, Max: Integer);
  2307. var
  2308. I: Integer;
  2309. begin
  2310. I := Pos(',', S);
  2311. if I = Length(S) then Invalid;
  2312. if I <> 0 then begin
  2313. X := StrToIntDef(Copy(S, 1, I-1), -1);
  2314. Y := StrToIntDef(Copy(S, I+1, Maxint), -1);
  2315. end else begin
  2316. X := StrToIntDef(S, -1);
  2317. Y := X;
  2318. end;
  2319. if (X < Min) or (X > Max) or (Y < Min) or (Y > Max) then
  2320. Invalid;
  2321. end;
  2322. var
  2323. P: Integer;
  2324. AIncludes: TStringList;
  2325. SignTool, SignToolParams: String;
  2326. begin
  2327. SeparateDirective(Line, KeyName, Value);
  2328. if KeyName = '' then
  2329. Exit;
  2330. I := GetEnumValue(TypeInfo(TSetupSectionDirective), 'ss' + KeyName);
  2331. if I = -1 then
  2332. AbortCompileFmt(SCompilerUnknownDirective, ['Setup', KeyName]);
  2333. Directive := TSetupSectionDirective(I);
  2334. if (Directive <> ssSignTool) and (SetupDirectiveLines[Directive] <> 0) then
  2335. AbortCompileFmt(SCompilerEntryAlreadySpecified, ['Setup', KeyName]);
  2336. SetupDirectiveLines[Directive] := LineNumber;
  2337. case Directive of
  2338. ssAllowCancelDuringInstall: begin
  2339. SetSetupHeaderOption(shAllowCancelDuringInstall);
  2340. end;
  2341. ssAllowNetworkDrive: begin
  2342. SetSetupHeaderOption(shAllowNetworkDrive);
  2343. end;
  2344. ssAllowNoIcons: begin
  2345. SetSetupHeaderOption(shAllowNoIcons);
  2346. end;
  2347. ssAllowRootDirectory: begin
  2348. SetSetupHeaderOption(shAllowRootDirectory);
  2349. end;
  2350. ssAllowUNCPath: begin
  2351. SetSetupHeaderOption(shAllowUNCPath);
  2352. end;
  2353. ssAlwaysRestart: begin
  2354. SetSetupHeaderOption(shAlwaysRestart);
  2355. end;
  2356. ssAlwaysUsePersonalGroup: begin
  2357. SetSetupHeaderOption(shAlwaysUsePersonalGroup);
  2358. end;
  2359. ssAlwaysShowComponentsList: begin
  2360. SetSetupHeaderOption(shAlwaysShowComponentsList);
  2361. end;
  2362. ssAlwaysShowDirOnReadyPage: begin
  2363. SetSetupHeaderOption(shAlwaysShowDirOnReadyPage);
  2364. end;
  2365. ssAlwaysShowGroupOnReadyPage: begin
  2366. SetSetupHeaderOption(shAlwaysShowGroupOnReadyPage);
  2367. end;
  2368. ssAppCopyright: begin
  2369. SetupHeader.AppCopyright := Value;
  2370. end;
  2371. ssAppComments: begin
  2372. SetupHeader.AppComments := Value;
  2373. end;
  2374. ssAppContact: begin
  2375. SetupHeader.AppContact := Value;
  2376. end;
  2377. ssAppendDefaultDirName: begin
  2378. SetSetupHeaderOption(shAppendDefaultDirName);
  2379. end;
  2380. ssAppendDefaultGroupName: begin
  2381. SetSetupHeaderOption(shAppendDefaultGroupName);
  2382. end;
  2383. ssAppId: begin
  2384. if Value = '' then
  2385. Invalid;
  2386. SetupHeader.AppId := Value;
  2387. end;
  2388. ssAppModifyPath: begin
  2389. SetupHeader.AppModifyPath := Value;
  2390. end;
  2391. ssAppMutex: begin
  2392. SetupHeader.AppMutex := Trim(Value);
  2393. end;
  2394. ssAppName: begin
  2395. if Value = '' then
  2396. Invalid;
  2397. SetupHeader.AppName := Value;
  2398. end;
  2399. ssAppPublisher: begin
  2400. SetupHeader.AppPublisher := Value;
  2401. end;
  2402. ssAppPublisherURL: begin
  2403. SetupHeader.AppPublisherURL := Value;
  2404. end;
  2405. ssAppReadmeFile: begin
  2406. SetupHeader.AppReadmeFile := Value;
  2407. end;
  2408. ssAppSupportPhone: begin
  2409. SetupHeader.AppSupportPhone := Value;
  2410. end;
  2411. ssAppSupportURL: begin
  2412. SetupHeader.AppSupportURL := Value;
  2413. end;
  2414. ssAppUpdatesURL: begin
  2415. SetupHeader.AppUpdatesURL := Value;
  2416. end;
  2417. ssAppVerName: begin
  2418. if Value = '' then
  2419. Invalid;
  2420. SetupHeader.AppVerName := Value;
  2421. end;
  2422. ssAppVersion: begin
  2423. SetupHeader.AppVersion := Value;
  2424. end;
  2425. ssArchitecturesAllowed: begin
  2426. ProcessExpressionParameter(KeyName, LowerCase(Value),
  2427. EvalArchitectureIdentifier, False, SetupHeader.ArchitecturesAllowed);
  2428. end;
  2429. ssArchitecturesInstallIn64BitMode: begin
  2430. ProcessExpressionParameter(KeyName, LowerCase(Value),
  2431. EvalArchitectureIdentifier, False, SetupHeader.ArchitecturesInstallIn64BitMode);
  2432. end;
  2433. ssArchiveExtraction: begin
  2434. Value := LowerCase(Trim(Value));
  2435. if Value = 'enhanced/nopassword' then begin
  2436. SetupHeader.SevenZipLibraryName := 'is7zxr.dll'
  2437. end else if Value = 'enhanced' then begin
  2438. SetupHeader.SevenZipLibraryName := 'is7zxa.dll'
  2439. end else if Value = 'full' then
  2440. SetupHeader.SevenZipLibraryName := 'is7z.dll'
  2441. else if Value <> 'basic' then
  2442. Invalid;
  2443. end;
  2444. ssASLRCompatible: begin
  2445. ASLRCompatible := StrToBool(Value);
  2446. end;
  2447. ssBackColor,
  2448. ssBackColor2,
  2449. ssBackColorDirection,
  2450. ssBackSolid: begin
  2451. WarningsList.Add(Format(SCompilerEntryObsolete, ['Setup', KeyName]));
  2452. end;
  2453. ssChangesAssociations: begin
  2454. SetupHeader.ChangesAssociations := Value;
  2455. end;
  2456. ssChangesEnvironment: begin
  2457. SetupHeader.ChangesEnvironment := Value;
  2458. end;
  2459. ssCloseApplications: begin
  2460. if CompareText(Value, 'force') = 0 then begin
  2461. Include(SetupHeader.Options, shCloseApplications);
  2462. Include(SetupHeader.Options, shForceCloseApplications);
  2463. end else begin
  2464. SetSetupHeaderOption(shCloseApplications);
  2465. Exclude(SetupHeader.Options, shForceCloseApplications);
  2466. end;
  2467. end;
  2468. ssCloseApplicationsFilter, ssCloseApplicationsFilterExcludes: begin
  2469. if Value = '' then
  2470. Invalid;
  2471. AIncludes := TStringList.Create;
  2472. try
  2473. ProcessWildcardsParameter(Value, AIncludes,
  2474. Format(SCompilerDirectivePatternTooLong, [KeyName]));
  2475. if Directive = ssCloseApplicationsFilter then
  2476. SetupHeader.CloseApplicationsFilter := StringsToCommaString(AIncludes)
  2477. else
  2478. SetupHeader.CloseApplicationsFilterExcludes := StringsToCommaString(AIncludes);
  2479. finally
  2480. AIncludes.Free;
  2481. end;
  2482. end;
  2483. ssCompression: begin
  2484. Value := LowerCase(Trim(Value));
  2485. if Value = 'none' then begin
  2486. CompressMethod := cmStored;
  2487. CompressLevel := 0;
  2488. end
  2489. else if Value = 'zip' then begin
  2490. CompressMethod := cmZip;
  2491. CompressLevel := 7;
  2492. end
  2493. else if Value = 'bzip' then begin
  2494. CompressMethod := cmBzip;
  2495. CompressLevel := 9;
  2496. end
  2497. else if Value = 'lzma' then begin
  2498. CompressMethod := cmLZMA;
  2499. CompressLevel := clLZMAMax;
  2500. end
  2501. else if Value = 'lzma2' then begin
  2502. CompressMethod := cmLZMA2;
  2503. CompressLevel := clLZMAMax;
  2504. end
  2505. else if Copy(Value, 1, 4) = 'zip/' then begin
  2506. I := StrToIntDef(Copy(Value, 5, Maxint), -1);
  2507. if (I < 1) or (I > 9) then
  2508. Invalid;
  2509. CompressMethod := cmZip;
  2510. CompressLevel := I;
  2511. end
  2512. else if Copy(Value, 1, 5) = 'bzip/' then begin
  2513. I := StrToIntDef(Copy(Value, 6, Maxint), -1);
  2514. if (I < 1) or (I > 9) then
  2515. Invalid;
  2516. CompressMethod := cmBzip;
  2517. CompressLevel := I;
  2518. end
  2519. else if Copy(Value, 1, 5) = 'lzma/' then begin
  2520. if not LZMAGetLevel(Copy(Value, 6, Maxint), I) then
  2521. Invalid;
  2522. CompressMethod := cmLZMA;
  2523. CompressLevel := I;
  2524. end
  2525. else if Copy(Value, 1, 6) = 'lzma2/' then begin
  2526. if not LZMAGetLevel(Copy(Value, 7, Maxint), I) then
  2527. Invalid;
  2528. CompressMethod := cmLZMA2;
  2529. CompressLevel := I;
  2530. end
  2531. else
  2532. Invalid;
  2533. end;
  2534. ssCompressionThreads: begin
  2535. if CompareText(Value, 'auto') = 0 then
  2536. { do nothing; it's the default }
  2537. else begin
  2538. if StrToIntRange(Value, 1, 64) = 1 then begin
  2539. InternalCompressProps.NumThreads := 1;
  2540. CompressProps.NumThreads := 1;
  2541. end;
  2542. end;
  2543. end;
  2544. ssCreateAppDir: begin
  2545. SetSetupHeaderOption(shCreateAppDir);
  2546. end;
  2547. ssCreateUninstallRegKey: begin
  2548. SetupHeader.CreateUninstallRegKey := Value;
  2549. end;
  2550. ssDefaultDialogFontName: begin
  2551. DefaultDialogFontName := Trim(Value);
  2552. end;
  2553. ssDefaultDirName: begin
  2554. SetupHeader.DefaultDirName := Value;
  2555. end;
  2556. ssDefaultGroupName: begin
  2557. SetupHeader.DefaultGroupName := Value;
  2558. end;
  2559. ssDefaultUserInfoName: begin
  2560. SetupHeader.DefaultUserInfoName := Value;
  2561. end;
  2562. ssDefaultUserInfoOrg: begin
  2563. SetupHeader.DefaultUserInfoOrg := Value;
  2564. end;
  2565. ssDefaultUserInfoSerial: begin
  2566. SetupHeader.DefaultUserInfoSerial := Value;
  2567. end;
  2568. ssDEPCompatible: begin
  2569. DEPCompatible := StrToBool(Value);
  2570. end;
  2571. ssDirExistsWarning: begin
  2572. if CompareText(Value, 'auto') = 0 then
  2573. SetupHeader.DirExistsWarning := ddAuto
  2574. else if StrToBool(Value) then
  2575. { ^ exception will be raised if Value is invalid }
  2576. SetupHeader.DirExistsWarning := ddYes
  2577. else
  2578. SetupHeader.DirExistsWarning := ddNo;
  2579. end;
  2580. ssDisableDirPage: begin
  2581. if CompareText(Value, 'auto') = 0 then
  2582. SetupHeader.DisableDirPage := dpAuto
  2583. else if StrToBool(Value) then
  2584. { ^ exception will be raised if Value is invalid }
  2585. SetupHeader.DisableDirPage := dpYes
  2586. else
  2587. SetupHeader.DisableDirPage := dpNo;
  2588. end;
  2589. ssDisableFinishedPage: begin
  2590. SetSetupHeaderOption(shDisableFinishedPage);
  2591. end;
  2592. ssDisablePrecompiledFileVerifications: begin
  2593. DisablePrecompiledFileVerifications := StrToPrecompiledFiles(Value);
  2594. CompressProps.WorkerProcessCheckTrust := not (pfIslzmaExe in DisablePrecompiledFileVerifications);
  2595. end;
  2596. ssDisableProgramGroupPage: begin
  2597. if CompareText(Value, 'auto') = 0 then
  2598. SetupHeader.DisableProgramGroupPage := dpAuto
  2599. else if StrToBool(Value) then
  2600. { ^ exception will be raised if Value is invalid }
  2601. SetupHeader.DisableProgramGroupPage := dpYes
  2602. else
  2603. SetupHeader.DisableProgramGroupPage := dpNo;
  2604. end;
  2605. ssDisableReadyMemo: begin
  2606. SetSetupHeaderOption(shDisableReadyMemo);
  2607. end;
  2608. ssDisableReadyPage: begin
  2609. SetSetupHeaderOption(shDisableReadyPage);
  2610. end;
  2611. ssDisableStartupPrompt: begin
  2612. SetSetupHeaderOption(shDisableStartupPrompt);
  2613. end;
  2614. ssDisableWelcomePage: begin
  2615. SetSetupHeaderOption(shDisableWelcomePage);
  2616. end;
  2617. ssDiskClusterSize: begin
  2618. Val(Value, DiskClusterSize, I);
  2619. if I <> 0 then
  2620. Invalid;
  2621. if (DiskClusterSize < 1) or (DiskClusterSize > 32768) then
  2622. AbortCompile(SCompilerDiskClusterSizeInvalid);
  2623. end;
  2624. ssDiskSliceSize: begin
  2625. if CompareText(Value, 'max') = 0 then
  2626. DiskSliceSize := MaxDiskSliceSize
  2627. else begin
  2628. Val(Value, DiskSliceSize, I);
  2629. if I <> 0 then
  2630. Invalid;
  2631. if (DiskSliceSize < 262144) or (DiskSliceSize > MaxDiskSliceSize) then
  2632. AbortCompileFmt(SCompilerDiskSliceSizeInvalid, [262144, MaxDiskSliceSize]);
  2633. end;
  2634. end;
  2635. ssDiskSpanning: begin
  2636. DiskSpanning := StrToBool(Value);
  2637. end;
  2638. ssDontMergeDuplicateFiles: begin { obsolete; superseded by "MergeDuplicateFiles" }
  2639. if SetupDirectiveLines[ssMergeDuplicateFiles] = 0 then
  2640. DontMergeDuplicateFiles := StrToBool(Value);
  2641. WarningsList.Add(Format(SCompilerEntrySuperseded2, ['Setup', KeyName,
  2642. 'MergeDuplicateFiles']));
  2643. end;
  2644. ssEnableDirDoesntExistWarning: begin
  2645. SetSetupHeaderOption(shEnableDirDoesntExistWarning);
  2646. end;
  2647. ssEncryption: begin
  2648. if CompareText(Value, 'full') = 0 then
  2649. SetupEncryptionHeader.EncryptionUse := euFull
  2650. else if StrToBool(Value) then
  2651. SetupEncryptionHeader.EncryptionUse := euFiles
  2652. else
  2653. SetupEncryptionHeader.EncryptionUse := euNone;
  2654. end;
  2655. ssEncryptionKeyDerivation: begin
  2656. if Value = 'pbkdf2' then
  2657. SetupEncryptionHeader.KDFIterations := DefaultKDFIterations
  2658. else if Copy(Value, 1, 7) = 'pbkdf2/' then begin
  2659. I := StrToIntDef(Copy(Value, 8, Maxint), -1);
  2660. if I < 1 then
  2661. Invalid;
  2662. SetupEncryptionHeader.KDFIterations := I;
  2663. end else
  2664. Invalid;
  2665. end;
  2666. ssExtraDiskSpaceRequired: begin
  2667. if not StrToInteger64(Value, SetupHeader.ExtraDiskSpaceRequired) then
  2668. Invalid;
  2669. end;
  2670. ssFlatComponentsList: begin
  2671. SetSetupHeaderOption(shFlatComponentsList);
  2672. end;
  2673. ssInfoBeforeFile: begin
  2674. InfoBeforeFile := Value;
  2675. end;
  2676. ssInfoAfterFile: begin
  2677. InfoAfterFile := Value;
  2678. end;
  2679. ssInternalCompressLevel: begin
  2680. Value := Trim(Value);
  2681. if (Value = '0') or (CompareText(Value, 'none') = 0) then
  2682. InternalCompressLevel := 0
  2683. else if not LZMAGetLevel(Value, InternalCompressLevel) then
  2684. Invalid;
  2685. end;
  2686. ssLanguageDetectionMethod: begin
  2687. if CompareText(Value, 'uilanguage') = 0 then
  2688. SetupHeader.LanguageDetectionMethod := ldUILanguage
  2689. else if CompareText(Value, 'locale') = 0 then
  2690. SetupHeader.LanguageDetectionMethod := ldLocale
  2691. else if CompareText(Value, 'none') = 0 then
  2692. SetupHeader.LanguageDetectionMethod := ldNone
  2693. else
  2694. Invalid;
  2695. end;
  2696. ssLicenseFile: begin
  2697. LicenseFile := Value;
  2698. end;
  2699. ssLZMAAlgorithm: begin
  2700. CompressProps.Algorithm := StrToIntRange(Value, 0, 1);
  2701. end;
  2702. ssLZMABlockSize: begin
  2703. CompressProps.BlockSize := StrToIntRange(Value, 1024, 262144) * 1024; //search Lzma2Enc.c for kMaxSize to see this limit: 262144*1024==1<<28
  2704. end;
  2705. ssLZMADictionarySize: begin
  2706. var MaxDictionarySize := 1024 shl 20; //1 GB - same as MaxDictionarySize in LZMADecomp.pas - lower than the LZMA SDK allows (search Lzma2Enc.c for kLzmaMaxHistorySize to see this limit: Cardinal(15 shl 28) = 3.8 GB) because Setup can't allocate that much memory
  2707. CompressProps.DictionarySize := StrToIntRange(Value, 4, MaxDictionarySize div 1024) * 1024;
  2708. end;
  2709. ssLZMAMatchFinder: begin
  2710. if CompareText(Value, 'BT') = 0 then
  2711. I := 1
  2712. else if CompareText(Value, 'HC') = 0 then
  2713. I := 0
  2714. else
  2715. Invalid;
  2716. CompressProps.BTMode := I;
  2717. end;
  2718. ssLZMANumBlockThreads: begin
  2719. CompressProps.NumBlockThreads := StrToIntRange(Value, 1, 256);
  2720. end;
  2721. ssLZMANumFastBytes: begin
  2722. CompressProps.NumFastBytes := StrToIntRange(Value, 5, 273);
  2723. end;
  2724. ssLZMAUseSeparateProcess: begin
  2725. if CompareText(Value, 'x86') = 0 then
  2726. CompressProps.WorkerProcessFilename := GetLZMAExeFilename(False)
  2727. else if StrToBool(Value) then
  2728. CompressProps.WorkerProcessFilename := GetLZMAExeFilename(True)
  2729. else
  2730. CompressProps.WorkerProcessFilename := '';
  2731. end;
  2732. ssMergeDuplicateFiles: begin
  2733. DontMergeDuplicateFiles := not StrToBool(Value);
  2734. end;
  2735. ssMessagesFile: begin
  2736. AbortCompile(SCompilerMessagesFileObsolete);
  2737. end;
  2738. ssMinVersion: begin
  2739. if not StrToSetupVersionData(Value, SetupHeader.MinVersion) then
  2740. Invalid;
  2741. if SetupHeader.MinVersion.WinVersion <> 0 then
  2742. AbortCompile(SCompilerMinVersionWinMustBeZero);
  2743. if SetupHeader.MinVersion.NTVersion < $06010000 then
  2744. AbortCompileFmt(SCompilerMinVersionNTTooLow, ['6.1']);
  2745. end;
  2746. ssMissingMessagesWarning: begin
  2747. MissingMessagesWarning := StrToBool(Value);
  2748. end;
  2749. ssMissingRunOnceIdsWarning: begin
  2750. MissingRunOnceIdsWarning := StrToBool(Value);
  2751. end;
  2752. ssOnlyBelowVersion: begin
  2753. if not StrToSetupVersionData(Value, SetupHeader.OnlyBelowVersion) then
  2754. Invalid;
  2755. if (SetupHeader.OnlyBelowVersion.NTVersion <> 0) and
  2756. (SetupHeader.OnlyBelowVersion.NTVersion <= $06010000) then
  2757. AbortCompileFmt(SCompilerOnlyBelowVersionNTTooLow, ['6.1']);
  2758. end;
  2759. ssOutput: begin
  2760. if not FixedOutput then
  2761. Output := StrToBool(Value);
  2762. end;
  2763. ssOutputBaseFilename: begin
  2764. if not FixedOutputBaseFilename then
  2765. OutputBaseFilename := Value;
  2766. end;
  2767. ssOutputDir: begin
  2768. if not FixedOutputDir then
  2769. OutputDir := Value;
  2770. end;
  2771. ssOutputManifestFile: begin
  2772. OutputManifestFile := Value;
  2773. end;
  2774. ssPassword: begin
  2775. Password := Value;
  2776. end;
  2777. ssPrivilegesRequired: begin
  2778. if CompareText(Value, 'none') = 0 then
  2779. SetupHeader.PrivilegesRequired := prNone
  2780. else if CompareText(Value, 'poweruser') = 0 then
  2781. SetupHeader.PrivilegesRequired := prPowerUser
  2782. else if CompareText(Value, 'admin') = 0 then
  2783. SetupHeader.PrivilegesRequired := prAdmin
  2784. else if CompareText(Value, 'lowest') = 0 then
  2785. SetupHeader.PrivilegesRequired := prLowest
  2786. else
  2787. Invalid;
  2788. end;
  2789. ssPrivilegesRequiredOverridesAllowed: begin
  2790. SetupHeader.PrivilegesRequiredOverridesAllowed := StrToPrivilegesRequiredOverrides(Value);
  2791. end;
  2792. ssReserveBytes: begin
  2793. Val(Value, ReserveBytes, I);
  2794. if (I <> 0) or (ReserveBytes < 0) then
  2795. Invalid;
  2796. end;
  2797. ssRestartApplications: begin
  2798. SetSetupHeaderOption(shRestartApplications);
  2799. end;
  2800. ssRestartIfNeededByRun: begin
  2801. SetSetupHeaderOption(shRestartIfNeededByRun);
  2802. end;
  2803. ssSetupIconFile: begin
  2804. SetupIconFilename := Value;
  2805. end;
  2806. ssSetupLogging: begin
  2807. SetSetupHeaderOption(shSetupLogging);
  2808. end;
  2809. ssSetupMutex: begin
  2810. SetupHeader.SetupMutex := Trim(Value);
  2811. end;
  2812. ssShowComponentSizes: begin
  2813. SetSetupHeaderOption(shShowComponentSizes);
  2814. end;
  2815. ssShowLanguageDialog: begin
  2816. if CompareText(Value, 'auto') = 0 then
  2817. SetupHeader.ShowLanguageDialog := slAuto
  2818. else if StrToBool(Value) then
  2819. SetupHeader.ShowLanguageDialog := slYes
  2820. else
  2821. SetupHeader.ShowLanguageDialog := slNo;
  2822. end;
  2823. ssShowTasksTreeLines: begin
  2824. SetSetupHeaderOption(shShowTasksTreeLines);
  2825. end;
  2826. ssShowUndisplayableLanguages: begin
  2827. WarningsList.Add(Format(SCompilerEntryObsolete, ['Setup', KeyName]));
  2828. end;
  2829. ssSignedUninstaller: begin
  2830. SetSetupHeaderOption(shSignedUninstaller);
  2831. end;
  2832. ssSignedUninstallerDir: begin
  2833. if Value = '' then
  2834. Invalid;
  2835. SignedUninstallerDir := Value;
  2836. end;
  2837. ssSignTool: begin
  2838. P := Pos(' ', Value);
  2839. if (P <> 0) then begin
  2840. SignTool := Copy(Value, 1, P-1);
  2841. SignToolParams := Copy(Value, P+1, MaxInt);
  2842. end else begin
  2843. SignTool := Value;
  2844. SignToolParams := '';
  2845. end;
  2846. if FindSignToolIndexByName(SignTool) = -1 then
  2847. Invalid;
  2848. SignTools.Add(SignTool);
  2849. SignToolsParams.Add(SignToolParams);
  2850. end;
  2851. ssSignToolMinimumTimeBetween: begin
  2852. I := StrToIntDef(Value, -1);
  2853. if I < 0 then
  2854. Invalid;
  2855. SignToolMinimumTimeBetween := I;
  2856. end;
  2857. ssSignToolRetryCount: begin
  2858. I := StrToIntDef(Value, -1);
  2859. if I < 0 then
  2860. Invalid;
  2861. SignToolRetryCount := I;
  2862. end;
  2863. ssSignToolRetryDelay: begin
  2864. I := StrToIntDef(Value, -1);
  2865. if I < 0 then
  2866. Invalid;
  2867. SignToolRetryDelay := I;
  2868. end;
  2869. ssSignToolRunMinimized: begin
  2870. SignToolRunMinimized := StrToBool(Value);
  2871. end;
  2872. ssSlicesPerDisk: begin
  2873. I := StrToIntDef(Value, -1);
  2874. if (I < 1) or (I > 26) then
  2875. Invalid;
  2876. SlicesPerDisk := I;
  2877. end;
  2878. ssSolidCompression: begin
  2879. UseSolidCompression := StrToBool(Value);
  2880. end;
  2881. ssSourceDir: begin
  2882. if Value = '' then
  2883. Invalid;
  2884. SourceDir := PrependDirName(Value, OriginalSourceDir);
  2885. end;
  2886. ssTerminalServicesAware: begin
  2887. TerminalServicesAware := StrToBool(Value);
  2888. end;
  2889. ssTimeStampRounding: begin
  2890. I := StrToIntDef(Value, -1);
  2891. { Note: We can't allow really high numbers here because it gets
  2892. multiplied by 10000000 }
  2893. if (I < 0) or (I > 60) then
  2894. Invalid;
  2895. TimeStampRounding := I;
  2896. end;
  2897. ssTimeStampsInUTC: begin
  2898. TimeStampsInUTC := StrToBool(Value);
  2899. end;
  2900. ssTouchDate: begin
  2901. StrToTouchDate(Value);
  2902. end;
  2903. ssTouchTime: begin
  2904. StrToTouchTime(Value);
  2905. end;
  2906. ssUpdateUninstallLogAppName: begin
  2907. SetSetupHeaderOption(shUpdateUninstallLogAppName);
  2908. end;
  2909. ssUninstallable: begin
  2910. SetupHeader.Uninstallable := Value;
  2911. end;
  2912. ssUninstallDisplayIcon: begin
  2913. SetupHeader.UninstallDisplayIcon := Value;
  2914. end;
  2915. ssUninstallDisplayName: begin
  2916. SetupHeader.UninstallDisplayName := Value;
  2917. end;
  2918. ssUninstallDisplaySize: begin
  2919. if not StrToInteger64(Value, SetupHeader.UninstallDisplaySize) or
  2920. ((SetupHeader.UninstallDisplaySize.Lo = 0) and (SetupHeader.UninstallDisplaySize.Hi = 0)) then
  2921. Invalid;
  2922. end;
  2923. ssUninstallFilesDir: begin
  2924. if Value = '' then
  2925. Invalid;
  2926. SetupHeader.UninstallFilesDir := Value;
  2927. end;
  2928. ssUninstallIconFile: begin
  2929. WarningsList.Add(Format(SCompilerEntryObsolete, ['Setup', KeyName]));
  2930. end;
  2931. ssUninstallLogging: begin
  2932. SetSetupHeaderOption(shUninstallLogging);
  2933. end;
  2934. ssUninstallLogMode: begin
  2935. if CompareText(Value, 'append') = 0 then
  2936. SetupHeader.UninstallLogMode := lmAppend
  2937. else if CompareText(Value, 'new') = 0 then
  2938. SetupHeader.UninstallLogMode := lmNew
  2939. else if CompareText(Value, 'overwrite') = 0 then
  2940. SetupHeader.UninstallLogMode := lmOverwrite
  2941. else
  2942. Invalid;
  2943. end;
  2944. ssUninstallRestartComputer: begin
  2945. SetSetupHeaderOption(shUninstallRestartComputer);
  2946. end;
  2947. ssUninstallStyle: begin
  2948. WarningsList.Add(Format(SCompilerEntryObsolete, ['Setup', KeyName]));
  2949. end;
  2950. ssUsePreviousAppDir: begin
  2951. SetSetupHeaderOption(shUsePreviousAppDir);
  2952. end;
  2953. ssNotRecognizedMessagesWarning: begin
  2954. NotRecognizedMessagesWarning := StrToBool(Value);
  2955. end;
  2956. ssUsedUserAreasWarning: begin
  2957. UsedUserAreasWarning := StrToBool(Value);
  2958. end;
  2959. ssUsePreviousGroup: begin
  2960. SetSetupHeaderOption(shUsePreviousGroup);
  2961. end;
  2962. ssUsePreviousLanguage: begin
  2963. SetSetupHeaderOption(shUsePreviousLanguage);
  2964. end;
  2965. ssUsePreviousPrivileges: begin
  2966. SetSetupHeaderOption(shUsePreviousPrivileges);
  2967. end;
  2968. ssUsePreviousSetupType: begin
  2969. SetSetupHeaderOption(shUsePreviousSetupType);
  2970. end;
  2971. ssUsePreviousTasks: begin
  2972. SetSetupHeaderOption(shUsePreviousTasks);
  2973. end;
  2974. ssUsePreviousUserInfo: begin
  2975. SetSetupHeaderOption(shUsePreviousUserInfo);
  2976. end;
  2977. ssUseSetupLdr: begin
  2978. UseSetupLdr := StrToBool(Value);
  2979. end;
  2980. ssUserInfoPage: begin
  2981. SetSetupHeaderOption(shUserInfoPage);
  2982. end;
  2983. ssVersionInfoCompany: begin
  2984. VersionInfoCompany := Value;
  2985. end;
  2986. ssVersionInfoCopyright: begin
  2987. VersionInfoCopyright := Value;
  2988. end;
  2989. ssVersionInfoDescription: begin
  2990. VersionInfoDescription := Value;
  2991. end;
  2992. ssVersionInfoOriginalFileName: begin
  2993. VersionInfoOriginalFileName := Value;
  2994. end;
  2995. ssVersionInfoProductName: begin
  2996. VersionInfoProductName := Value;
  2997. end;
  2998. ssVersionInfoProductVersion: begin
  2999. VersionInfoProductVersionOriginalValue := Value;
  3000. if not StrToVersionNumbers(Value, VersionInfoProductVersion) then
  3001. Invalid;
  3002. end;
  3003. ssVersionInfoProductTextVersion: begin
  3004. VersionInfoProductTextVersion := Value;
  3005. end;
  3006. ssVersionInfoTextVersion: begin
  3007. VersionInfoTextVersion := Value;
  3008. end;
  3009. ssVersionInfoVersion: begin
  3010. VersionInfoVersionOriginalValue := Value;
  3011. if not StrToVersionNumbers(Value, VersionInfoVersion) then
  3012. Invalid;
  3013. end;
  3014. ssWindowResizable,
  3015. ssWindowShowCaption,
  3016. ssWindowStartMaximized,
  3017. ssWindowVisible: begin
  3018. WarningsList.Add(Format(SCompilerEntryObsolete, ['Setup', KeyName]));
  3019. end;
  3020. ssWizardImageAlphaFormat: begin
  3021. if CompareText(Value, 'none') = 0 then
  3022. SetupHeader.WizardImageAlphaFormat := afIgnored
  3023. else if CompareText(Value, 'defined') = 0 then
  3024. SetupHeader.WizardImageAlphaFormat := afDefined
  3025. else if CompareText(Value, 'premultiplied') = 0 then
  3026. SetupHeader.WizardImageAlphaFormat := afPremultiplied
  3027. else
  3028. Invalid;
  3029. end;
  3030. ssWizardImageBackColor, ssWizardSmallImageBackColor: begin
  3031. WarningsList.Add(Format(SCompilerEntryObsolete, ['Setup', KeyName]));
  3032. end;
  3033. ssWizardImageStretch: begin
  3034. SetSetupHeaderOption(shWizardImageStretch);
  3035. end;
  3036. ssWizardImageFile: begin
  3037. WizardImageFile := Value;
  3038. end;
  3039. ssWizardResizable: begin
  3040. SetSetupHeaderOption(shWizardResizable);
  3041. end;
  3042. ssWizardSmallImageFile: begin
  3043. WizardSmallImageFile := Value;
  3044. end;
  3045. ssWizardSizePercent: begin
  3046. StrToPercentages(Value, SetupHeader.WizardSizePercentX,
  3047. SetupHeader.WizardSizePercentY, 100, 150)
  3048. end;
  3049. ssWizardStyle: begin
  3050. if CompareText(Value, 'classic') = 0 then
  3051. SetupHeader.WizardStyle := wsClassic
  3052. else if CompareText(Value, 'modern') = 0 then
  3053. SetupHeader.WizardStyle := wsModern
  3054. else
  3055. Invalid;
  3056. end;
  3057. end;
  3058. end;
  3059. function TSetupCompiler.FindLangEntryIndexByName(const AName: String;
  3060. const Pre: Boolean): Integer;
  3061. var
  3062. I: Integer;
  3063. begin
  3064. if Pre then begin
  3065. for I := 0 to PreLangDataList.Count-1 do begin
  3066. if TPreLangData(PreLangDataList[I]).Name = AName then begin
  3067. Result := I;
  3068. Exit;
  3069. end;
  3070. end;
  3071. AbortCompileFmt(SCompilerUnknownLanguage, [AName]);
  3072. end;
  3073. for I := 0 to LanguageEntries.Count-1 do begin
  3074. if PSetupLanguageEntry(LanguageEntries[I]).Name = AName then begin
  3075. Result := I;
  3076. Exit;
  3077. end;
  3078. end;
  3079. Result := -1;
  3080. AbortCompileFmt(SCompilerUnknownLanguage, [AName]);
  3081. end;
  3082. function TSetupCompiler.FindSignToolIndexByName(const AName: String): Integer;
  3083. var
  3084. I: Integer;
  3085. begin
  3086. for I := 0 to SignToolList.Count-1 do begin
  3087. if TSignTool(SignToolList[I]).Name = AName then begin
  3088. Result := I;
  3089. Exit;
  3090. end;
  3091. end;
  3092. Result := -1;
  3093. end;
  3094. procedure TSetupCompiler.EnumLangOptionsPreProc(const Line: PChar; const Ext: Integer);
  3095. procedure ApplyToLangEntryPre(const KeyName, Value: String;
  3096. const PreLangData: TPreLangData; const AffectsMultipleLangs: Boolean);
  3097. var
  3098. I: Integer;
  3099. Directive: TLangOptionsSectionDirective;
  3100. procedure Invalid;
  3101. begin
  3102. AbortCompileFmt(SCompilerEntryInvalid2, ['LangOptions', KeyName]);
  3103. end;
  3104. function StrToIntCheck(const S: String): Integer;
  3105. var
  3106. E: Integer;
  3107. begin
  3108. Val(S, Result, E);
  3109. if E <> 0 then
  3110. Invalid;
  3111. end;
  3112. begin
  3113. I := GetEnumValue(TypeInfo(TLangOptionsSectionDirective), 'ls' + KeyName);
  3114. if I = -1 then
  3115. AbortCompileFmt(SCompilerUnknownDirective, ['LangOptions', KeyName]);
  3116. Directive := TLangOptionsSectionDirective(I);
  3117. case Directive of
  3118. lsLanguageCodePage: begin
  3119. if AffectsMultipleLangs then
  3120. AbortCompileFmt(SCompilerCantSpecifyLangOption, [KeyName]);
  3121. PreLangData.LanguageCodePage := StrToIntCheck(Value);
  3122. if (PreLangData.LanguageCodePage <> 0) and
  3123. not IsValidCodePage(PreLangData.LanguageCodePage) then
  3124. Invalid;
  3125. end;
  3126. end;
  3127. end;
  3128. var
  3129. KeyName, Value: String;
  3130. I, LangIndex: Integer;
  3131. begin
  3132. SeparateDirective(Line, KeyName, Value);
  3133. LangIndex := ExtractLangIndex(Self, KeyName, Ext, True);
  3134. if LangIndex = -1 then begin
  3135. for I := 0 to PreLangDataList.Count-1 do
  3136. ApplyToLangEntryPre(KeyName, Value, TPreLangData(PreLangDataList[I]),
  3137. PreLangDataList.Count > 1);
  3138. end else
  3139. ApplyToLangEntryPre(KeyName, Value, TPreLangData(PreLangDataList[LangIndex]), False);
  3140. end;
  3141. procedure TSetupCompiler.EnumLangOptionsProc(const Line: PChar; const Ext: Integer);
  3142. procedure ApplyToLangEntry(const KeyName, Value: String;
  3143. var LangOptions: TSetupLanguageEntry; const AffectsMultipleLangs: Boolean);
  3144. var
  3145. I: Integer;
  3146. Directive: TLangOptionsSectionDirective;
  3147. procedure Invalid;
  3148. begin
  3149. AbortCompileFmt(SCompilerEntryInvalid2, ['LangOptions', KeyName]);
  3150. end;
  3151. function StrToIntCheck(const S: String): Integer;
  3152. var
  3153. E: Integer;
  3154. begin
  3155. Val(S, Result, E);
  3156. if E <> 0 then
  3157. Invalid;
  3158. end;
  3159. function ConvertLanguageName(N: String): String;
  3160. var
  3161. I, J, L: Integer;
  3162. W: Word;
  3163. begin
  3164. N := Trim(N);
  3165. if N = '' then
  3166. Invalid;
  3167. Result := '';
  3168. I := 1;
  3169. while I <= Length(N) do begin
  3170. if N[I] = '<' then begin
  3171. { Handle embedded Unicode characters ('<nnnn>') }
  3172. if (I+5 > Length(N)) or (N[I+5] <> '>') then
  3173. Invalid;
  3174. for J := I+1 to I+4 do
  3175. if not CharInSet(UpCase(N[J]), ['0'..'9', 'A'..'F']) then
  3176. Invalid;
  3177. W := StrToIntCheck('$' + Copy(N, I+1, 4));
  3178. Inc(I, 6);
  3179. end
  3180. else begin
  3181. W := Ord(N[I]);
  3182. Inc(I);
  3183. end;
  3184. L := Length(Result);
  3185. SetLength(Result, L + (SizeOf(Word) div SizeOf(Char)));
  3186. Word((@Result[L+1])^) := W;
  3187. end;
  3188. end;
  3189. begin
  3190. I := GetEnumValue(TypeInfo(TLangOptionsSectionDirective), 'ls' + KeyName);
  3191. if I = -1 then
  3192. AbortCompileFmt(SCompilerUnknownDirective, ['LangOptions', KeyName]);
  3193. Directive := TLangOptionsSectionDirective(I);
  3194. case Directive of
  3195. lsCopyrightFontName: begin
  3196. LangOptions.CopyrightFontName := Trim(Value);
  3197. end;
  3198. lsCopyrightFontSize: begin
  3199. LangOptions.CopyrightFontSize := StrToIntCheck(Value);
  3200. end;
  3201. lsDialogFontName: begin
  3202. LangOptions.DialogFontName := Trim(Value);
  3203. end;
  3204. lsDialogFontSize: begin
  3205. LangOptions.DialogFontSize := StrToIntCheck(Value);
  3206. end;
  3207. lsDialogFontStandardHeight: begin
  3208. WarningsList.Add(Format(SCompilerEntryObsolete, ['LangOptions', KeyName]));
  3209. end;
  3210. lsLanguageCodePage: begin
  3211. if AffectsMultipleLangs then
  3212. AbortCompileFmt(SCompilerCantSpecifyLangOption, [KeyName]);
  3213. StrToIntCheck(Value);
  3214. end;
  3215. lsLanguageID: begin
  3216. if AffectsMultipleLangs then
  3217. AbortCompileFmt(SCompilerCantSpecifyLangOption, [KeyName]);
  3218. LangOptions.LanguageID := StrToIntCheck(Value);
  3219. end;
  3220. lsLanguageName: begin
  3221. if AffectsMultipleLangs then
  3222. AbortCompileFmt(SCompilerCantSpecifyLangOption, [KeyName]);
  3223. LangOptions.LanguageName := ConvertLanguageName(Value);
  3224. end;
  3225. lsRightToLeft: begin
  3226. if not TryStrToBoolean(Value, LangOptions.RightToLeft) then
  3227. Invalid;
  3228. end;
  3229. lsTitleFontName: begin
  3230. LangOptions.TitleFontName := Trim(Value);
  3231. end;
  3232. lsTitleFontSize: begin
  3233. LangOptions.TitleFontSize := StrToIntCheck(Value);
  3234. end;
  3235. lsWelcomeFontName: begin
  3236. LangOptions.WelcomeFontName := Trim(Value);
  3237. end;
  3238. lsWelcomeFontSize: begin
  3239. LangOptions.WelcomeFontSize := StrToIntCheck(Value);
  3240. end;
  3241. end;
  3242. end;
  3243. var
  3244. KeyName, Value: String;
  3245. I, LangIndex: Integer;
  3246. begin
  3247. SeparateDirective(Line, KeyName, Value);
  3248. LangIndex := ExtractLangIndex(Self, KeyName, Ext, False);
  3249. if LangIndex = -1 then begin
  3250. for I := 0 to LanguageEntries.Count-1 do
  3251. ApplyToLangEntry(KeyName, Value, PSetupLanguageEntry(LanguageEntries[I])^,
  3252. LanguageEntries.Count > 1);
  3253. end else
  3254. ApplyToLangEntry(KeyName, Value, PSetupLanguageEntry(LanguageEntries[LangIndex])^, False);
  3255. end;
  3256. procedure TSetupCompiler.EnumTypesProc(const Line: PChar; const Ext: Integer);
  3257. function IsCustomTypeAlreadyDefined: Boolean;
  3258. var
  3259. I: Integer;
  3260. begin
  3261. for I := 0 to TypeEntries.Count-1 do
  3262. if toIsCustom in PSetupTypeEntry(TypeEntries[I]).Options then begin
  3263. Result := True;
  3264. Exit;
  3265. end;
  3266. Result := False;
  3267. end;
  3268. type
  3269. TParam = (paFlags, paName, paDescription, paLanguages, paCheck, paMinVersion,
  3270. paOnlyBelowVersion);
  3271. const
  3272. ParamTypesName = 'Name';
  3273. ParamTypesDescription = 'Description';
  3274. ParamInfo: array[TParam] of TParamInfo = (
  3275. (Name: ParamCommonFlags; Flags: []),
  3276. (Name: ParamTypesName; Flags: [piRequired, piNoEmpty]),
  3277. (Name: ParamTypesDescription; Flags: [piRequired, piNoEmpty]),
  3278. (Name: ParamCommonLanguages; Flags: []),
  3279. (Name: ParamCommonCheck; Flags: []),
  3280. (Name: ParamCommonMinVersion; Flags: []),
  3281. (Name: ParamCommonOnlyBelowVersion; Flags: []));
  3282. Flags: array[0..0] of PChar = (
  3283. 'iscustom');
  3284. var
  3285. Values: array[TParam] of TParamValue;
  3286. NewTypeEntry: PSetupTypeEntry;
  3287. begin
  3288. ExtractParameters(Line, ParamInfo, Values);
  3289. NewTypeEntry := AllocMem(SizeOf(TSetupTypeEntry));
  3290. try
  3291. with NewTypeEntry^ do begin
  3292. MinVersion := SetupHeader.MinVersion;
  3293. Typ := ttUser;
  3294. { Flags }
  3295. while True do
  3296. case ExtractFlag(Values[paFlags].Data, Flags) of
  3297. -2: Break;
  3298. -1: AbortCompileParamError(SCompilerParamUnknownFlag2, ParamCommonFlags);
  3299. 0: Include(Options, toIsCustom);
  3300. end;
  3301. { Name }
  3302. Name := LowerCase(Values[paName].Data);
  3303. { Description }
  3304. Description := Values[paDescription].Data;
  3305. { Common parameters }
  3306. ProcessExpressionParameter(ParamCommonLanguages, Values[paLanguages].Data, EvalLanguageIdentifier, False, Languages);
  3307. CheckOnce := Values[paCheck].Data;
  3308. ProcessMinVersionParameter(Values[paMinVersion], MinVersion);
  3309. ProcessOnlyBelowVersionParameter(Values[paOnlyBelowVersion], OnlyBelowVersion);
  3310. if (toIsCustom in Options) and IsCustomTypeAlreadyDefined then
  3311. AbortCompile(SCompilerTypesCustomTypeAlreadyDefined);
  3312. CheckConst(Description, MinVersion, []);
  3313. CheckCheckOrInstall(ParamCommonCheck, CheckOnce, cikCheck);
  3314. end;
  3315. except
  3316. SEFreeRec(NewTypeEntry, SetupTypeEntryStrings, SetupTypeEntryAnsiStrings);
  3317. raise;
  3318. end;
  3319. TypeEntries.Add(NewTypeEntry);
  3320. end;
  3321. procedure TSetupCompiler.EnumComponentsProc(const Line: PChar; const Ext: Integer);
  3322. procedure AddToCommaText(var CommaText: String; const S: String);
  3323. begin
  3324. if CommaText <> '' then
  3325. CommaText := CommaText + ',';
  3326. CommaText := CommaText + S;
  3327. end;
  3328. type
  3329. TParam = (paFlags, paName, paDescription, paExtraDiskSpaceRequired, paTypes,
  3330. paLanguages, paCheck, paMinVersion, paOnlyBelowVersion);
  3331. const
  3332. ParamComponentsName = 'Name';
  3333. ParamComponentsDescription = 'Description';
  3334. ParamComponentsExtraDiskSpaceRequired = 'ExtraDiskSpaceRequired';
  3335. ParamComponentsTypes = 'Types';
  3336. ParamInfo: array[TParam] of TParamInfo = (
  3337. (Name: ParamCommonFlags; Flags: []),
  3338. (Name: ParamComponentsName; Flags: [piRequired, piNoEmpty]),
  3339. (Name: ParamComponentsDescription; Flags: [piRequired, piNoEmpty]),
  3340. (Name: ParamComponentsExtraDiskSpaceRequired; Flags: []),
  3341. (Name: ParamComponentsTypes; Flags: []),
  3342. (Name: ParamCommonLanguages; Flags: []),
  3343. (Name: ParamCommonCheck; Flags: []),
  3344. (Name: ParamCommonMinVersion; Flags: []),
  3345. (Name: ParamCommonOnlyBelowVersion; Flags: []));
  3346. Flags: array[0..5] of PChar = (
  3347. 'fixed', 'restart', 'disablenouninstallwarning', 'exclusive',
  3348. 'dontinheritcheck', 'checkablealone');
  3349. var
  3350. Values: array[TParam] of TParamValue;
  3351. NewComponentEntry: PSetupComponentEntry;
  3352. PrevLevel, I: Integer;
  3353. begin
  3354. ExtractParameters(Line, ParamInfo, Values);
  3355. NewComponentEntry := AllocMem(SizeOf(TSetupComponentEntry));
  3356. try
  3357. with NewComponentEntry^ do begin
  3358. MinVersion := SetupHeader.MinVersion;
  3359. { Flags }
  3360. while True do
  3361. case ExtractFlag(Values[paFlags].Data, Flags) of
  3362. -2: Break;
  3363. -1: AbortCompileParamError(SCompilerParamUnknownFlag2, ParamCommonFlags);
  3364. 0: Include(Options, coFixed);
  3365. 1: Include(Options, coRestart);
  3366. 2: Include(Options, coDisableNoUninstallWarning);
  3367. 3: Include(Options, coExclusive);
  3368. 4: Include(Options, coDontInheritCheck);
  3369. 5: Used := True;
  3370. end;
  3371. { Name }
  3372. Name := LowerCase(Values[paName].Data);
  3373. StringChange(Name, '/', '\');
  3374. if not IsValidIdentString(Name, True, False) then
  3375. AbortCompile(SCompilerComponentsOrTasksBadName);
  3376. Level := CountChars(Name, '\');
  3377. if ComponentEntries.Count > 0 then
  3378. PrevLevel := PSetupComponentEntry(ComponentEntries[ComponentEntries.Count-1]).Level
  3379. else
  3380. PrevLevel := -1;
  3381. if Level > PrevLevel + 1 then
  3382. AbortCompile(SCompilerComponentsInvalidLevel);
  3383. { Description }
  3384. Description := Values[paDescription].Data;
  3385. { ExtraDiskSpaceRequired }
  3386. if Values[paExtraDiskSpaceRequired].Found then begin
  3387. if not StrToInteger64(Values[paExtraDiskSpaceRequired].Data, ExtraDiskSpaceRequired) then
  3388. AbortCompileParamError(SCompilerParamInvalid2, ParamComponentsExtraDiskSpaceRequired);
  3389. end;
  3390. { Types }
  3391. while True do begin
  3392. I := ExtractType(Values[paTypes].Data, TypeEntries);
  3393. case I of
  3394. -2: Break;
  3395. -1: AbortCompileParamError(SCompilerParamUnknownType, ParamComponentsTypes);
  3396. else begin
  3397. if TypeEntries.Count <> 0 then
  3398. AddToCommaText(Types, PSetupTypeEntry(TypeEntries[I]).Name)
  3399. else
  3400. AddToCommaText(Types, DefaultTypeEntryNames[I]);
  3401. end;
  3402. end;
  3403. end;
  3404. { Common parameters }
  3405. ProcessExpressionParameter(ParamCommonLanguages, Values[paLanguages].Data, EvalLanguageIdentifier, False, Languages);
  3406. CheckOnce := Values[paCheck].Data;
  3407. ProcessMinVersionParameter(Values[paMinVersion], MinVersion);
  3408. ProcessOnlyBelowVersionParameter(Values[paOnlyBelowVersion], OnlyBelowVersion);
  3409. if (coDontInheritCheck in Options) and (coExclusive in Options) then
  3410. AbortCompileFmt(SCompilerParamErrorBadCombo2,
  3411. [ParamCommonFlags, 'dontinheritcheck', 'exclusive']);
  3412. CheckConst(Description, MinVersion, []);
  3413. CheckCheckOrInstall(ParamCommonCheck, CheckOnce, cikCheck);
  3414. end;
  3415. except
  3416. SEFreeRec(NewComponentEntry, SetupComponentEntryStrings, SetupComponentEntryAnsiStrings);
  3417. raise;
  3418. end;
  3419. ComponentEntries.Add(NewComponentEntry);
  3420. end;
  3421. procedure TSetupCompiler.EnumTasksProc(const Line: PChar; const Ext: Integer);
  3422. type
  3423. TParam = (paFlags, paName, paDescription, paGroupDescription, paComponents,
  3424. paLanguages, paCheck, paMinVersion, paOnlyBelowVersion);
  3425. const
  3426. ParamTasksName = 'Name';
  3427. ParamTasksDescription = 'Description';
  3428. ParamTasksGroupDescription = 'GroupDescription';
  3429. ParamInfo: array[TParam] of TParamInfo = (
  3430. (Name: ParamCommonFlags; Flags: []),
  3431. (Name: ParamTasksName; Flags: [piRequired, piNoEmpty, piNoQuotes]),
  3432. (Name: ParamTasksDescription; Flags: [piRequired, piNoEmpty]),
  3433. (Name: ParamTasksGroupDescription; Flags: [piNoEmpty]),
  3434. (Name: ParamCommonComponents; Flags: []),
  3435. (Name: ParamCommonLanguages; Flags: []),
  3436. (Name: ParamCommonCheck; Flags: []),
  3437. (Name: ParamCommonMinVersion; Flags: []),
  3438. (Name: ParamCommonOnlyBelowVersion; Flags: []));
  3439. Flags: array[0..5] of PChar = (
  3440. 'exclusive', 'unchecked', 'restart', 'checkedonce', 'dontinheritcheck',
  3441. 'checkablealone');
  3442. var
  3443. Values: array[TParam] of TParamValue;
  3444. NewTaskEntry: PSetupTaskEntry;
  3445. PrevLevel: Integer;
  3446. begin
  3447. ExtractParameters(Line, ParamInfo, Values);
  3448. NewTaskEntry := AllocMem(SizeOf(TSetupTaskEntry));
  3449. try
  3450. with NewTaskEntry^ do begin
  3451. MinVersion := SetupHeader.MinVersion;
  3452. { Flags }
  3453. while True do
  3454. case ExtractFlag(Values[paFlags].Data, Flags) of
  3455. -2: Break;
  3456. -1: AbortCompileParamError(SCompilerParamUnknownFlag2, ParamCommonFlags);
  3457. 0: Include(Options, toExclusive);
  3458. 1: Include(Options, toUnchecked);
  3459. 2: Include(Options, toRestart);
  3460. 3: Include(Options, toCheckedOnce);
  3461. 4: Include(Options, toDontInheritCheck);
  3462. 5: Used := True;
  3463. end;
  3464. { Name }
  3465. Name := LowerCase(Values[paName].Data);
  3466. StringChange(Name, '/', '\');
  3467. if not IsValidIdentString(Name, True, False) then
  3468. AbortCompile(SCompilerComponentsOrTasksBadName);
  3469. Level := CountChars(Name, '\');
  3470. if TaskEntries.Count > 0 then
  3471. PrevLevel := PSetupTaskEntry(TaskEntries[TaskEntries.Count-1]).Level
  3472. else
  3473. PrevLevel := -1;
  3474. if Level > PrevLevel + 1 then
  3475. AbortCompile(SCompilerTasksInvalidLevel);
  3476. { Description }
  3477. Description := Values[paDescription].Data;
  3478. { GroupDescription }
  3479. GroupDescription := Values[paGroupDescription].Data;
  3480. { Common parameters }
  3481. ProcessExpressionParameter(ParamCommonComponents, Values[paComponents].Data, EvalComponentIdentifier, True, Components);
  3482. ProcessExpressionParameter(ParamCommonLanguages, Values[paLanguages].Data, EvalLanguageIdentifier, False, Languages);
  3483. Check := Values[paCheck].Data;
  3484. ProcessMinVersionParameter(Values[paMinVersion], MinVersion);
  3485. ProcessOnlyBelowVersionParameter(Values[paOnlyBelowVersion], OnlyBelowVersion);
  3486. if (toDontInheritCheck in Options) and (toExclusive in Options) then
  3487. AbortCompileFmt(SCompilerParamErrorBadCombo2,
  3488. [ParamCommonFlags, 'dontinheritcheck', 'exclusive']);
  3489. CheckConst(Description, MinVersion, []);
  3490. CheckConst(GroupDescription, MinVersion, []);
  3491. CheckCheckOrInstall(ParamCommonCheck, Check, cikCheck);
  3492. end;
  3493. except
  3494. SEFreeRec(NewTaskEntry, SetupTaskEntryStrings, SetupTaskEntryAnsiStrings);
  3495. raise;
  3496. end;
  3497. TaskEntries.Add(NewTaskEntry);
  3498. end;
  3499. const
  3500. FILE_ATTRIBUTE_NOT_CONTENT_INDEXED = $00002000;
  3501. procedure TSetupCompiler.EnumDirsProc(const Line: PChar; const Ext: Integer);
  3502. type
  3503. TParam = (paFlags, paName, paAttribs, paPermissions, paComponents, paTasks,
  3504. paLanguages, paCheck, paBeforeInstall, paAfterInstall, paMinVersion,
  3505. paOnlyBelowVersion);
  3506. const
  3507. ParamDirsName = 'Name';
  3508. ParamDirsAttribs = 'Attribs';
  3509. ParamDirsPermissions = 'Permissions';
  3510. ParamInfo: array[TParam] of TParamInfo = (
  3511. (Name: ParamCommonFlags; Flags: []),
  3512. (Name: ParamDirsName; Flags: [piRequired, piNoEmpty, piNoQuotes]),
  3513. (Name: ParamDirsAttribs; Flags: []),
  3514. (Name: ParamDirsPermissions; Flags: []),
  3515. (Name: ParamCommonComponents; Flags: []),
  3516. (Name: ParamCommonTasks; Flags: []),
  3517. (Name: ParamCommonLanguages; Flags: []),
  3518. (Name: ParamCommonCheck; Flags: []),
  3519. (Name: ParamCommonBeforeInstall; Flags: []),
  3520. (Name: ParamCommonAfterInstall; Flags: []),
  3521. (Name: ParamCommonMinVersion; Flags: []),
  3522. (Name: ParamCommonOnlyBelowVersion; Flags: []));
  3523. Flags: array[0..4] of PChar = (
  3524. 'uninsneveruninstall', 'deleteafterinstall', 'uninsalwaysuninstall',
  3525. 'setntfscompression', 'unsetntfscompression');
  3526. AttribsFlags: array[0..3] of PChar = (
  3527. 'readonly', 'hidden', 'system', 'notcontentindexed');
  3528. AccessMasks: array[0..2] of TNameAndAccessMask = (
  3529. (Name: 'full'; Mask: $1F01FF),
  3530. (Name: 'modify'; Mask: $1301BF),
  3531. (Name: 'readexec'; Mask: $1200A9));
  3532. var
  3533. Values: array[TParam] of TParamValue;
  3534. NewDirEntry: PSetupDirEntry;
  3535. begin
  3536. ExtractParameters(Line, ParamInfo, Values);
  3537. NewDirEntry := AllocMem(SizeOf(TSetupDirEntry));
  3538. try
  3539. with NewDirEntry^ do begin
  3540. MinVersion := SetupHeader.MinVersion;
  3541. { Flags }
  3542. while True do
  3543. case ExtractFlag(Values[paFlags].Data, Flags) of
  3544. -2: Break;
  3545. -1: AbortCompileParamError(SCompilerParamUnknownFlag2, ParamCommonFlags);
  3546. 0: Include(Options, doUninsNeverUninstall);
  3547. 1: Include(Options, doDeleteAfterInstall);
  3548. 2: Include(Options, doUninsAlwaysUninstall);
  3549. 3: Include(Options, doSetNTFSCompression);
  3550. 4: Include(Options, doUnsetNTFSCompression);
  3551. end;
  3552. { Name }
  3553. DirName := Values[paName].Data;
  3554. { Attribs }
  3555. while True do
  3556. case ExtractFlag(Values[paAttribs].Data, AttribsFlags) of
  3557. -2: Break;
  3558. -1: AbortCompileParamError(SCompilerParamUnknownFlag2, ParamDirsAttribs);
  3559. 0: Attribs := Attribs or FILE_ATTRIBUTE_READONLY;
  3560. 1: Attribs := Attribs or FILE_ATTRIBUTE_HIDDEN;
  3561. 2: Attribs := Attribs or FILE_ATTRIBUTE_SYSTEM;
  3562. 3: Attribs := Attribs or FILE_ATTRIBUTE_NOT_CONTENT_INDEXED;
  3563. end;
  3564. { Permissions }
  3565. ProcessPermissionsParameter(Values[paPermissions].Data, AccessMasks,
  3566. PermissionsEntry);
  3567. { Common parameters }
  3568. ProcessExpressionParameter(ParamCommonComponents, Values[paComponents].Data, EvalComponentIdentifier, True, Components);
  3569. ProcessExpressionParameter(ParamCommonTasks, Values[paTasks].Data, EvalTaskIdentifier, True, Tasks);
  3570. ProcessExpressionParameter(ParamCommonLanguages, Values[paLanguages].Data, EvalLanguageIdentifier, False, Languages);
  3571. Check := Values[paCheck].Data;
  3572. BeforeInstall := Values[paBeforeInstall].Data;
  3573. AfterInstall := Values[paAfterInstall].Data;
  3574. ProcessMinVersionParameter(Values[paMinVersion], MinVersion);
  3575. ProcessOnlyBelowVersionParameter(Values[paOnlyBelowVersion], OnlyBelowVersion);
  3576. if (doUninsNeverUninstall in Options) and
  3577. (doUninsAlwaysUninstall in Options) then
  3578. AbortCompileFmt(SCompilerParamErrorBadCombo2,
  3579. [ParamCommonFlags, 'uninsneveruninstall', 'uninsalwaysuninstall']);
  3580. if (doSetNTFSCompression in Options) and
  3581. (doUnsetNTFSCompression in Options) then
  3582. AbortCompileFmt(SCompilerParamErrorBadCombo2,
  3583. [ParamCommonFlags, 'setntfscompression', 'unsetntfscompression']);
  3584. CheckCheckOrInstall(ParamCommonCheck, Check, cikCheck);
  3585. CheckCheckOrInstall(ParamCommonBeforeInstall, BeforeInstall, cikInstall);
  3586. CheckCheckOrInstall(ParamCommonAfterInstall, AfterInstall, cikInstall);
  3587. CheckConst(DirName, MinVersion, []);
  3588. end;
  3589. except
  3590. SEFreeRec(NewDirEntry, SetupDirEntryStrings, SetupDirEntryAnsiStrings);
  3591. raise;
  3592. end;
  3593. WriteDebugEntry(deDir, DirEntries.Count);
  3594. DirEntries.Add(NewDirEntry);
  3595. end;
  3596. type
  3597. TMenuKeyCap = (mkcBkSp, mkcTab, mkcEsc, mkcEnter, mkcSpace, mkcPgUp,
  3598. mkcPgDn, mkcEnd, mkcHome, mkcLeft, mkcUp, mkcRight, mkcDown, mkcIns,
  3599. mkcDel, mkcShift, mkcCtrl, mkcAlt);
  3600. var
  3601. MenuKeyCaps: array[TMenuKeyCap] of string = (
  3602. 'BkSp', 'Tab', 'Esc', 'Enter', 'Space', 'PgUp',
  3603. 'PgDn', 'End', 'Home', 'Left', 'Up', 'Right',
  3604. 'Down', 'Ins', 'Del', 'Shift+', 'Ctrl+', 'Alt+');
  3605. procedure TSetupCompiler.EnumIconsProc(const Line: PChar; const Ext: Integer);
  3606. function HotKeyToText(HotKey: Word): string;
  3607. function GetSpecialName(HotKey: Word): string;
  3608. var
  3609. ScanCode: Integer;
  3610. KeyName: array[0..255] of Char;
  3611. begin
  3612. Result := '';
  3613. ScanCode := MapVirtualKey(WordRec(HotKey).Lo, 0) shl 16;
  3614. if ScanCode <> 0 then
  3615. begin
  3616. GetKeyNameText(ScanCode, KeyName, SizeOf(KeyName));
  3617. if (KeyName[1] = #0) and (KeyName[0] <> #0) then
  3618. GetSpecialName := KeyName;
  3619. end;
  3620. end;
  3621. var
  3622. Name: string;
  3623. begin
  3624. case WordRec(HotKey).Lo of
  3625. $08, $09:
  3626. Name := MenuKeyCaps[TMenuKeyCap(Ord(mkcBkSp) + WordRec(HotKey).Lo - $08)];
  3627. $0D: Name := MenuKeyCaps[mkcEnter];
  3628. $1B: Name := MenuKeyCaps[mkcEsc];
  3629. $20..$28:
  3630. Name := MenuKeyCaps[TMenuKeyCap(Ord(mkcSpace) + WordRec(HotKey).Lo - $20)];
  3631. $2D..$2E:
  3632. Name := MenuKeyCaps[TMenuKeyCap(Ord(mkcIns) + WordRec(HotKey).Lo - $2D)];
  3633. $30..$39: Name := Chr(WordRec(HotKey).Lo - $30 + Ord('0'));
  3634. $41..$5A: Name := Chr(WordRec(HotKey).Lo - $41 + Ord('A'));
  3635. $60..$69: Name := Chr(WordRec(HotKey).Lo - $60 + Ord('0'));
  3636. $70..$87: Name := 'F' + IntToStr(WordRec(HotKey).Lo - $6F);
  3637. else
  3638. Name := GetSpecialName(HotKey);
  3639. end;
  3640. if Name <> '' then
  3641. begin
  3642. Result := '';
  3643. if HotKey and (HOTKEYF_SHIFT shl 8) <> 0 then Result := Result + MenuKeyCaps[mkcShift];
  3644. if HotKey and (HOTKEYF_CONTROL shl 8) <> 0 then Result := Result + MenuKeyCaps[mkcCtrl];
  3645. if HotKey and (HOTKEYF_ALT shl 8) <> 0 then Result := Result + MenuKeyCaps[mkcAlt];
  3646. Result := Result + Name;
  3647. end
  3648. else Result := '';
  3649. end;
  3650. function TextToHotKey(Text: string): Word;
  3651. function CompareFront(var Text: string; const Front: string): Boolean;
  3652. begin
  3653. Result := False;
  3654. if CompareText(Copy(Text, 1, Length(Front)), Front) = 0 then
  3655. begin
  3656. Result := True;
  3657. Delete(Text, 1, Length(Front));
  3658. end;
  3659. end;
  3660. var
  3661. Key: Word;
  3662. Shift: Word;
  3663. begin
  3664. Result := 0;
  3665. Shift := 0;
  3666. while True do
  3667. begin
  3668. if CompareFront(Text, MenuKeyCaps[mkcShift]) then Shift := Shift or HOTKEYF_SHIFT
  3669. else if CompareFront(Text, '^') then Shift := Shift or HOTKEYF_CONTROL
  3670. else if CompareFront(Text, MenuKeyCaps[mkcCtrl]) then Shift := Shift or HOTKEYF_CONTROL
  3671. else if CompareFront(Text, MenuKeyCaps[mkcAlt]) then Shift := Shift or HOTKEYF_ALT
  3672. else Break;
  3673. end;
  3674. if Text = '' then Exit;
  3675. for Key := $08 to $255 do { Copy range from table in HotKeyToText }
  3676. if AnsiCompareText(Text, HotKeyToText(Key)) = 0 then
  3677. begin
  3678. Result := Key or (Shift shl 8);
  3679. Exit;
  3680. end;
  3681. end;
  3682. type
  3683. TParam = (paFlags, paName, paFilename, paParameters, paWorkingDir, paHotKey,
  3684. paIconFilename, paIconIndex, paComment, paAppUserModelID, paAppUserModelToastActivatorCLSID,
  3685. paComponents, paTasks, paLanguages, paCheck, paBeforeInstall, paAfterInstall, paMinVersion,
  3686. paOnlyBelowVersion);
  3687. const
  3688. ParamIconsName = 'Name';
  3689. ParamIconsFilename = 'Filename';
  3690. ParamIconsParameters = 'Parameters';
  3691. ParamIconsWorkingDir = 'WorkingDir';
  3692. ParamIconsHotKey = 'HotKey';
  3693. ParamIconsIconFilename = 'IconFilename';
  3694. ParamIconsIconIndex = 'IconIndex';
  3695. ParamIconsComment = 'Comment';
  3696. ParamIconsAppUserModelID = 'AppUserModelID';
  3697. ParamIconsAppUserModelToastActivatorCLSID = 'AppUserModelToastActivatorCLSID';
  3698. ParamInfo: array[TParam] of TParamInfo = (
  3699. (Name: ParamCommonFlags; Flags: []),
  3700. (Name: ParamIconsName; Flags: [piRequired, piNoEmpty, piNoQuotes]),
  3701. (Name: ParamIconsFilename; Flags: [piRequired, piNoEmpty, piNoQuotes]),
  3702. (Name: ParamIconsParameters; Flags: []),
  3703. (Name: ParamIconsWorkingDir; Flags: [piNoQuotes]),
  3704. (Name: ParamIconsHotKey; Flags: []),
  3705. (Name: ParamIconsIconFilename; Flags: [piNoQuotes]),
  3706. (Name: ParamIconsIconIndex; Flags: []),
  3707. (Name: ParamIconsComment; Flags: []),
  3708. (Name: ParamIconsAppUserModelID; Flags: []),
  3709. (Name: ParamIconsAppUserModelToastActivatorCLSID; Flags: []),
  3710. (Name: ParamCommonComponents; Flags: []),
  3711. (Name: ParamCommonTasks; Flags: []),
  3712. (Name: ParamCommonLanguages; Flags: []),
  3713. (Name: ParamCommonCheck; Flags: []),
  3714. (Name: ParamCommonBeforeInstall; Flags: []),
  3715. (Name: ParamCommonAfterInstall; Flags: []),
  3716. (Name: ParamCommonMinVersion; Flags: []),
  3717. (Name: ParamCommonOnlyBelowVersion; Flags: []));
  3718. Flags: array[0..8] of PChar = (
  3719. 'uninsneveruninstall', 'runminimized', 'createonlyiffileexists',
  3720. 'useapppaths', 'closeonexit', 'dontcloseonexit', 'runmaximized',
  3721. 'excludefromshowinnewinstall', 'preventpinning');
  3722. var
  3723. Values: array[TParam] of TParamValue;
  3724. NewIconEntry: PSetupIconEntry;
  3725. S: String;
  3726. begin
  3727. ExtractParameters(Line, ParamInfo, Values);
  3728. NewIconEntry := AllocMem(SizeOf(TSetupIconEntry));
  3729. try
  3730. with NewIconEntry^ do begin
  3731. MinVersion := SetupHeader.MinVersion;
  3732. ShowCmd := SW_SHOWNORMAL;
  3733. { Flags }
  3734. while True do
  3735. case ExtractFlag(Values[paFlags].Data, Flags) of
  3736. -2: Break;
  3737. -1: AbortCompileParamError(SCompilerParamUnknownFlag2, ParamCommonFlags);
  3738. 0: Include(Options, ioUninsNeverUninstall);
  3739. 1: ShowCmd := SW_SHOWMINNOACTIVE;
  3740. 2: Include(Options, ioCreateOnlyIfFileExists);
  3741. 3: Include(Options, ioUseAppPaths);
  3742. 4: CloseOnExit := icYes;
  3743. 5: CloseOnExit := icNo;
  3744. 6: ShowCmd := SW_SHOWMAXIMIZED;
  3745. 7: Include(Options, ioExcludeFromShowInNewInstall);
  3746. 8: Include(Options, ioPreventPinning);
  3747. end;
  3748. { Name }
  3749. IconName := Values[paName].Data;
  3750. { Filename }
  3751. Filename := Values[paFilename].Data;
  3752. { Parameters }
  3753. Parameters := Values[paParameters].Data;
  3754. { WorkingDir }
  3755. WorkingDir := Values[paWorkingDir].Data;
  3756. { HotKey }
  3757. if Values[paHotKey].Found then begin
  3758. HotKey := TextToHotKey(Values[paHotKey].Data);
  3759. if HotKey = 0 then
  3760. AbortCompileParamError(SCompilerParamInvalid2, ParamIconsHotKey);
  3761. end;
  3762. { IconFilename }
  3763. IconFilename := Values[paIconFilename].Data;
  3764. { IconIndex }
  3765. if Values[paIconIndex].Found then begin
  3766. try
  3767. IconIndex := StrToInt(Values[paIconIndex].Data);
  3768. except
  3769. AbortCompile(SCompilerIconsIconIndexInvalid);
  3770. end;
  3771. end;
  3772. { Comment }
  3773. Comment := Values[paComment].Data;
  3774. { AppUserModel }
  3775. AppUserModelID := Values[paAppUserModelID].Data;
  3776. S := Values[paAppUserModelToastActivatorCLSID].Data;
  3777. if S <> '' then begin
  3778. AppUserModelToastActivatorCLSID := StringToGUID('{' + S + '}');
  3779. Include(Options, ioHasAppUserModelToastActivatorCLSID);
  3780. end;
  3781. { Common parameters }
  3782. ProcessExpressionParameter(ParamCommonComponents, Values[paComponents].Data, EvalComponentIdentifier, True, Components);
  3783. ProcessExpressionParameter(ParamCommonTasks, Values[paTasks].Data, EvalTaskIdentifier, True, Tasks);
  3784. ProcessExpressionParameter(ParamCommonLanguages, Values[paLanguages].Data, EvalLanguageIdentifier, False, Languages);
  3785. Check := Values[paCheck].Data;
  3786. BeforeInstall := Values[paBeforeInstall].Data;
  3787. AfterInstall := Values[paAfterInstall].Data;
  3788. ProcessMinVersionParameter(Values[paMinVersion], MinVersion);
  3789. ProcessOnlyBelowVersionParameter(Values[paOnlyBelowVersion], OnlyBelowVersion);
  3790. if Pos('"', IconName) <> 0 then
  3791. AbortCompileParamError(SCompilerParamNoQuotes2, ParamIconsName);
  3792. if PathPos('\', IconName) = 0 then
  3793. AbortCompile(SCompilerIconsNamePathNotSpecified);
  3794. if (IconIndex <> 0) and (IconFilename = '') then
  3795. IconFilename := Filename;
  3796. CheckCheckOrInstall(ParamCommonCheck, Check, cikCheck);
  3797. CheckCheckOrInstall(ParamCommonBeforeInstall, BeforeInstall, cikInstall);
  3798. CheckCheckOrInstall(ParamCommonAfterInstall, AfterInstall, cikInstall);
  3799. S := IconName;
  3800. if Copy(S, 1, 8) = '{group}\' then
  3801. Delete(S, 1, 8);
  3802. CheckConst(S, MinVersion, []);
  3803. CheckConst(Filename, MinVersion, []);
  3804. CheckConst(Parameters, MinVersion, []);
  3805. CheckConst(WorkingDir, MinVersion, []);
  3806. CheckConst(IconFilename, MinVersion, []);
  3807. CheckConst(Comment, MinVersion, []);
  3808. CheckConst(AppUserModelID, MinVersion, []);
  3809. end;
  3810. except
  3811. SEFreeRec(NewIconEntry, SetupIconEntryStrings, SetupIconEntryAnsiStrings);
  3812. raise;
  3813. end;
  3814. WriteDebugEntry(deIcon, IconEntries.Count);
  3815. IconEntries.Add(NewIconEntry);
  3816. end;
  3817. procedure TSetupCompiler.EnumINIProc(const Line: PChar; const Ext: Integer);
  3818. type
  3819. TParam = (paFlags, paFilename, paSection, paKey, paString, paComponents,
  3820. paTasks, paLanguages, paCheck, paBeforeInstall, paAfterInstall,
  3821. paMinVersion, paOnlyBelowVersion);
  3822. const
  3823. ParamIniFilename = 'Filename';
  3824. ParamIniSection = 'Section';
  3825. ParamIniKey = 'Key';
  3826. ParamIniString = 'String';
  3827. ParamInfo: array[TParam] of TParamInfo = (
  3828. (Name: ParamCommonFlags; Flags: []),
  3829. (Name: ParamIniFilename; Flags: [piRequired, piNoQuotes]),
  3830. (Name: ParamIniSection; Flags: [piRequired, piNoEmpty]),
  3831. (Name: ParamIniKey; Flags: [piNoEmpty]),
  3832. (Name: ParamIniString; Flags: []),
  3833. (Name: ParamCommonComponents; Flags: []),
  3834. (Name: ParamCommonTasks; Flags: []),
  3835. (Name: ParamCommonLanguages; Flags: []),
  3836. (Name: ParamCommonCheck; Flags: []),
  3837. (Name: ParamCommonBeforeInstall; Flags: []),
  3838. (Name: ParamCommonAfterInstall; Flags: []),
  3839. (Name: ParamCommonMinVersion; Flags: []),
  3840. (Name: ParamCommonOnlyBelowVersion; Flags: []));
  3841. Flags: array[0..3] of PChar = (
  3842. 'uninsdeleteentry', 'uninsdeletesection', 'createkeyifdoesntexist',
  3843. 'uninsdeletesectionifempty');
  3844. var
  3845. Values: array[TParam] of TParamValue;
  3846. NewIniEntry: PSetupIniEntry;
  3847. begin
  3848. ExtractParameters(Line, ParamInfo, Values);
  3849. NewIniEntry := AllocMem(SizeOf(TSetupIniEntry));
  3850. try
  3851. with NewIniEntry^ do begin
  3852. MinVersion := SetupHeader.MinVersion;
  3853. { Flags }
  3854. while True do
  3855. case ExtractFlag(Values[paFlags].Data, Flags) of
  3856. -2: Break;
  3857. -1: AbortCompileParamError(SCompilerParamUnknownFlag2, ParamCommonFlags);
  3858. 0: Include(Options, ioUninsDeleteEntry);
  3859. 1: Include(Options, ioUninsDeleteEntireSection);
  3860. 2: Include(Options, ioCreateKeyIfDoesntExist);
  3861. 3: Include(Options, ioUninsDeleteSectionIfEmpty);
  3862. end;
  3863. { Filename }
  3864. Filename := Values[paFilename].Data;
  3865. { Section }
  3866. Section := Values[paSection].Data;
  3867. { Key }
  3868. Entry := Values[paKey].Data;
  3869. { String }
  3870. if Values[paString].Found then begin
  3871. Value := Values[paString].Data;
  3872. Include(Options, ioHasValue);
  3873. end;
  3874. { Common parameters }
  3875. ProcessExpressionParameter(ParamCommonComponents, Values[paComponents].Data, EvalComponentIdentifier, True, Components);
  3876. ProcessExpressionParameter(ParamCommonTasks, Values[paTasks].Data, EvalTaskIdentifier, True, Tasks);
  3877. ProcessExpressionParameter(ParamCommonLanguages, Values[paLanguages].Data, EvalLanguageIdentifier, False, Languages);
  3878. Check := Values[paCheck].Data;
  3879. BeforeInstall := Values[paBeforeInstall].Data;
  3880. AfterInstall := Values[paAfterInstall].Data;
  3881. ProcessMinVersionParameter(Values[paMinVersion], MinVersion);
  3882. ProcessOnlyBelowVersionParameter(Values[paOnlyBelowVersion], OnlyBelowVersion);
  3883. if (ioUninsDeleteEntry in Options) and
  3884. (ioUninsDeleteEntireSection in Options) then
  3885. AbortCompileFmt(SCompilerParamErrorBadCombo2,
  3886. [ParamCommonFlags, 'uninsdeleteentry', 'uninsdeletesection']);
  3887. if (ioUninsDeleteEntireSection in Options) and
  3888. (ioUninsDeleteSectionIfEmpty in Options) then
  3889. AbortCompileFmt(SCompilerParamErrorBadCombo2,
  3890. [ParamCommonFlags, 'uninsdeletesection', 'uninsdeletesectionifempty']);
  3891. CheckCheckOrInstall(ParamCommonCheck, Check, cikCheck);
  3892. CheckCheckOrInstall(ParamCommonBeforeInstall, BeforeInstall, cikInstall);
  3893. CheckCheckOrInstall(ParamCommonAfterInstall, AfterInstall, cikInstall);
  3894. CheckConst(Filename, MinVersion, []);
  3895. CheckConst(Section, MinVersion, []);
  3896. CheckConst(Entry, MinVersion, []);
  3897. CheckConst(Value, MinVersion, []);
  3898. end;
  3899. except
  3900. SEFreeRec(NewIniEntry, SetupIniEntryStrings, SetupIniEntryAnsiStrings);
  3901. raise;
  3902. end;
  3903. WriteDebugEntry(deIni, IniEntries.Count);
  3904. IniEntries.Add(NewIniEntry);
  3905. end;
  3906. procedure TSetupCompiler.EnumRegistryProc(const Line: PChar; const Ext: Integer);
  3907. type
  3908. TParam = (paFlags, paRoot, paSubkey, paValueType, paValueName, paValueData,
  3909. paPermissions, paComponents, paTasks, paLanguages, paCheck, paBeforeInstall,
  3910. paAfterInstall, paMinVersion, paOnlyBelowVersion);
  3911. const
  3912. ParamRegistryRoot = 'Root';
  3913. ParamRegistrySubkey = 'Subkey';
  3914. ParamRegistryValueType = 'ValueType';
  3915. ParamRegistryValueName = 'ValueName';
  3916. ParamRegistryValueData = 'ValueData';
  3917. ParamRegistryPermissions = 'Permissions';
  3918. ParamInfo: array[TParam] of TParamInfo = (
  3919. (Name: ParamCommonFlags; Flags: []),
  3920. (Name: ParamRegistryRoot; Flags: [piRequired]),
  3921. (Name: ParamRegistrySubkey; Flags: [piRequired, piNoEmpty]),
  3922. (Name: ParamRegistryValueType; Flags: []),
  3923. (Name: ParamRegistryValueName; Flags: []),
  3924. (Name: ParamRegistryValueData; Flags: []),
  3925. (Name: ParamRegistryPermissions; Flags: []),
  3926. (Name: ParamCommonComponents; Flags: []),
  3927. (Name: ParamCommonTasks; Flags: []),
  3928. (Name: ParamCommonLanguages; Flags: []),
  3929. (Name: ParamCommonCheck; Flags: []),
  3930. (Name: ParamCommonBeforeInstall; Flags: []),
  3931. (Name: ParamCommonAfterInstall; Flags: []),
  3932. (Name: ParamCommonMinVersion; Flags: []),
  3933. (Name: ParamCommonOnlyBelowVersion; Flags: []));
  3934. Flags: array[0..9] of PChar = (
  3935. 'createvalueifdoesntexist', 'uninsdeletevalue', 'uninsdeletekey',
  3936. 'uninsdeletekeyifempty', 'uninsclearvalue', 'preservestringtype',
  3937. 'deletekey', 'deletevalue', 'noerror', 'dontcreatekey');
  3938. AccessMasks: array[0..2] of TNameAndAccessMask = (
  3939. (Name: 'full'; Mask: $F003F),
  3940. (Name: 'modify'; Mask: $3001F), { <- same access that Power Users get by default on HKLM\SOFTWARE }
  3941. (Name: 'read'; Mask: $20019));
  3942. function ConvertBinaryString(const S: String): String;
  3943. procedure Invalid;
  3944. begin
  3945. AbortCompileParamError(SCompilerParamInvalid2, ParamRegistryValueData);
  3946. end;
  3947. var
  3948. I: Integer;
  3949. C: Char;
  3950. B: Byte;
  3951. N: Integer;
  3952. procedure EndByte;
  3953. begin
  3954. case N of
  3955. 0: ;
  3956. 2: begin
  3957. Result := Result + Chr(B);
  3958. N := 0;
  3959. B := 0;
  3960. end;
  3961. else
  3962. Invalid;
  3963. end;
  3964. end;
  3965. begin
  3966. Result := '';
  3967. N := 0;
  3968. B := 0;
  3969. for I := 1 to Length(S) do begin
  3970. C := UpCase(S[I]);
  3971. case C of
  3972. ' ': EndByte;
  3973. '0'..'9': begin
  3974. Inc(N);
  3975. if N > 2 then
  3976. Invalid;
  3977. B := (B shl 4) or (Ord(C) - Ord('0'));
  3978. end;
  3979. 'A'..'F': begin
  3980. Inc(N);
  3981. if N > 2 then
  3982. Invalid;
  3983. B := (B shl 4) or (10 + Ord(C) - Ord('A'));
  3984. end;
  3985. else
  3986. Invalid;
  3987. end;
  3988. end;
  3989. EndByte;
  3990. end;
  3991. function ConvertDWordString(const S: String): String;
  3992. var
  3993. DW: DWORD;
  3994. E: Integer;
  3995. begin
  3996. Result := Trim(S);
  3997. { Only check if it doesn't start with a constant }
  3998. if (Result = '') or (Result[1] <> '{') then begin
  3999. Val(Result, DW, E);
  4000. if E <> 0 then
  4001. AbortCompileParamError(SCompilerParamInvalid2, ParamRegistryValueData);
  4002. { Not really necessary, but sanitize the value }
  4003. Result := Format('$%x', [DW]);
  4004. end;
  4005. end;
  4006. function ConvertQWordString(const S: String): String;
  4007. begin
  4008. Result := Trim(S);
  4009. { Only check if it doesn't start with a constant }
  4010. if (Result = '') or (Result[1] <> '{') then begin
  4011. var QW: UInt64;
  4012. if not TryStrToUInt64(Result, QW) then
  4013. AbortCompileParamError(SCompilerParamInvalid2, ParamRegistryValueData);
  4014. { Not really necessary, but sanitize the value }
  4015. Result := Format('$%x', [QW]);
  4016. end;
  4017. end;
  4018. var
  4019. Values: array[TParam] of TParamValue;
  4020. NewRegistryEntry: PSetupRegistryEntry;
  4021. S, AData: String;
  4022. begin
  4023. ExtractParameters(Line, ParamInfo, Values);
  4024. NewRegistryEntry := AllocMem(SizeOf(TSetupRegistryEntry));
  4025. try
  4026. with NewRegistryEntry^ do begin
  4027. MinVersion := SetupHeader.MinVersion;
  4028. { Flags }
  4029. while True do
  4030. case ExtractFlag(Values[paFlags].Data, Flags) of
  4031. -2: Break;
  4032. -1: AbortCompileParamError(SCompilerParamUnknownFlag2, ParamCommonFlags);
  4033. 0: Include(Options, roCreateValueIfDoesntExist);
  4034. 1: Include(Options, roUninsDeleteValue);
  4035. 2: Include(Options, roUninsDeleteEntireKey);
  4036. 3: Include(Options, roUninsDeleteEntireKeyIfEmpty);
  4037. 4: Include(Options, roUninsClearValue);
  4038. 5: Include(Options, roPreserveStringType);
  4039. 6: Include(Options, roDeleteKey);
  4040. 7: Include(Options, roDeleteValue);
  4041. 8: Include(Options, roNoError);
  4042. 9: Include(Options, roDontCreateKey);
  4043. end;
  4044. { Root }
  4045. S := Uppercase(Trim(Values[paRoot].Data));
  4046. if Length(S) >= 2 then begin
  4047. { Check for '32' or '64' suffix }
  4048. if (S[Length(S)-1] = '3') and (S[Length(S)] = '2') then begin
  4049. Include(Options, ro32Bit);
  4050. SetLength(S, Length(S)-2);
  4051. end
  4052. else if (S[Length(S)-1] = '6') and (S[Length(S)] = '4') then begin
  4053. Include(Options, ro64Bit);
  4054. SetLength(S, Length(S)-2);
  4055. end;
  4056. end;
  4057. if S = 'HKA' then
  4058. RootKey := HKEY_AUTO
  4059. else if S = 'HKCR' then
  4060. RootKey := HKEY_CLASSES_ROOT
  4061. else if S = 'HKCU' then begin
  4062. UsedUserAreas.Add(S);
  4063. RootKey := HKEY_CURRENT_USER;
  4064. end else if S = 'HKLM' then
  4065. RootKey := HKEY_LOCAL_MACHINE
  4066. else if S = 'HKU' then
  4067. RootKey := HKEY_USERS
  4068. else if S = 'HKCC' then
  4069. RootKey := HKEY_CURRENT_CONFIG
  4070. else
  4071. AbortCompileParamError(SCompilerParamInvalid2, ParamRegistryRoot);
  4072. { Subkey }
  4073. if (Values[paSubkey].Data <> '') and (Values[paSubkey].Data[1] = '\') then
  4074. AbortCompileParamError(SCompilerParamNoPrecedingBackslash, ParamRegistrySubkey);
  4075. Subkey := Values[paSubkey].Data;
  4076. { ValueType }
  4077. if Values[paValueType].Found then begin
  4078. Values[paValueType].Data := Uppercase(Trim(Values[paValueType].Data));
  4079. if Values[paValueType].Data = 'NONE' then
  4080. Typ := rtNone
  4081. else if Values[paValueType].Data = 'STRING' then
  4082. Typ := rtString
  4083. else if Values[paValueType].Data = 'EXPANDSZ' then
  4084. Typ := rtExpandString
  4085. else if Values[paValueType].Data = 'MULTISZ' then
  4086. Typ := rtMultiString
  4087. else if Values[paValueType].Data = 'DWORD' then
  4088. Typ := rtDWord
  4089. else if Values[paValueType].Data = 'QWORD' then
  4090. Typ := rtQWord
  4091. else if Values[paValueType].Data = 'BINARY' then
  4092. Typ := rtBinary
  4093. else
  4094. AbortCompileParamError(SCompilerParamInvalid2, ParamRegistryValueType);
  4095. end;
  4096. { ValueName }
  4097. ValueName := Values[paValueName].Data;
  4098. { ValueData }
  4099. AData := Values[paValueData].Data;
  4100. { Permissions }
  4101. ProcessPermissionsParameter(Values[paPermissions].Data, AccessMasks,
  4102. PermissionsEntry);
  4103. { Common parameters }
  4104. ProcessExpressionParameter(ParamCommonComponents, Values[paComponents].Data, EvalComponentIdentifier, True, Components);
  4105. ProcessExpressionParameter(ParamCommonTasks, Values[paTasks].Data, EvalTaskIdentifier, True, Tasks);
  4106. ProcessExpressionParameter(ParamCommonLanguages, Values[paLanguages].Data, EvalLanguageIdentifier, False, Languages);
  4107. Check := Values[paCheck].Data;
  4108. BeforeInstall := Values[paBeforeInstall].Data;
  4109. AfterInstall := Values[paAfterInstall].Data;
  4110. ProcessMinVersionParameter(Values[paMinVersion], MinVersion);
  4111. ProcessOnlyBelowVersionParameter(Values[paOnlyBelowVersion], OnlyBelowVersion);
  4112. if (roUninsDeleteEntireKey in Options) and
  4113. (roUninsDeleteEntireKeyIfEmpty in Options) then
  4114. AbortCompileFmt(SCompilerParamErrorBadCombo2,
  4115. [ParamCommonFlags, 'uninsdeletekey', 'uninsdeletekeyifempty']);
  4116. if (roUninsDeleteEntireKey in Options) and
  4117. (roUninsClearValue in Options) then
  4118. AbortCompileFmt(SCompilerParamErrorBadCombo2,
  4119. [ParamCommonFlags, 'uninsclearvalue', 'uninsdeletekey']);
  4120. if (roUninsDeleteValue in Options) and
  4121. (roUninsDeleteEntireKey in Options) then
  4122. AbortCompileFmt(SCompilerParamErrorBadCombo2,
  4123. [ParamCommonFlags, 'uninsdeletevalue', 'uninsdeletekey']);
  4124. if (roUninsDeleteValue in Options) and
  4125. (roUninsClearValue in Options) then
  4126. AbortCompileFmt(SCompilerParamErrorBadCombo2,
  4127. [ParamCommonFlags, 'uninsdeletevalue', 'uninsclearvalue']);
  4128. { Safety checks }
  4129. if ((roUninsDeleteEntireKey in Options) or (roDeleteKey in Options)) and
  4130. (CompareText(Subkey, 'SYSTEM\CurrentControlSet\Control\Session Manager\Environment') = 0) then
  4131. AbortCompile(SCompilerRegistryDeleteKeyProhibited);
  4132. case Typ of
  4133. rtString, rtExpandString, rtMultiString:
  4134. ValueData := AData;
  4135. rtDWord:
  4136. ValueData := ConvertDWordString(AData);
  4137. rtQWord:
  4138. ValueData := ConvertQWordString(AData);
  4139. rtBinary:
  4140. ValueData := ConvertBinaryString(AData);
  4141. end;
  4142. CheckCheckOrInstall(ParamCommonCheck, Check, cikCheck);
  4143. CheckCheckOrInstall(ParamCommonBeforeInstall, BeforeInstall, cikInstall);
  4144. CheckCheckOrInstall(ParamCommonAfterInstall, AfterInstall, cikInstall);
  4145. CheckConst(Subkey, MinVersion, []);
  4146. CheckConst(ValueName, MinVersion, []);
  4147. case Typ of
  4148. rtString, rtExpandString:
  4149. CheckConst(ValueData, MinVersion, [acOldData]);
  4150. rtMultiString:
  4151. CheckConst(ValueData, MinVersion, [acOldData, acBreak]);
  4152. rtDWord:
  4153. CheckConst(ValueData, MinVersion, []);
  4154. end;
  4155. end;
  4156. except
  4157. SEFreeRec(NewRegistryEntry, SetupRegistryEntryStrings, SetupRegistryEntryAnsiStrings);
  4158. raise;
  4159. end;
  4160. WriteDebugEntry(deRegistry, RegistryEntries.Count);
  4161. RegistryEntries.Add(NewRegistryEntry);
  4162. end;
  4163. procedure TSetupCompiler.EnumDeleteProc(const Line: PChar; const Ext: Integer);
  4164. type
  4165. TParam = (paType, paName, paComponents, paTasks, paLanguages, paCheck,
  4166. paBeforeInstall, paAfterInstall, paMinVersion, paOnlyBelowVersion);
  4167. const
  4168. ParamDeleteType = 'Type';
  4169. ParamDeleteName = 'Name';
  4170. ParamInfo: array[TParam] of TParamInfo = (
  4171. (Name: ParamDeleteType; Flags: [piRequired]),
  4172. (Name: ParamDeleteName; Flags: [piRequired, piNoEmpty]),
  4173. (Name: ParamCommonComponents; Flags: []),
  4174. (Name: ParamCommonTasks; Flags: []),
  4175. (Name: ParamCommonLanguages; Flags: []),
  4176. (Name: ParamCommonCheck; Flags: []),
  4177. (Name: ParamCommonBeforeInstall; Flags: []),
  4178. (Name: ParamCommonAfterInstall; Flags: []),
  4179. (Name: ParamCommonMinVersion; Flags: []),
  4180. (Name: ParamCommonOnlyBelowVersion; Flags: []));
  4181. Types: array[TSetupDeleteType] of PChar = (
  4182. 'files', 'filesandordirs', 'dirifempty');
  4183. var
  4184. Values: array[TParam] of TParamValue;
  4185. NewDeleteEntry: PSetupDeleteEntry;
  4186. Valid: Boolean;
  4187. J: TSetupDeleteType;
  4188. begin
  4189. ExtractParameters(Line, ParamInfo, Values);
  4190. NewDeleteEntry := AllocMem(SizeOf(TSetupDeleteEntry));
  4191. try
  4192. with NewDeleteEntry^ do begin
  4193. MinVersion := SetupHeader.MinVersion;
  4194. { Type }
  4195. Values[paType].Data := Trim(Values[paType].Data);
  4196. Valid := False;
  4197. for J := Low(J) to High(J) do
  4198. if StrIComp(Types[J], PChar(Values[paType].Data)) = 0 then begin
  4199. DeleteType := J;
  4200. Valid := True;
  4201. Break;
  4202. end;
  4203. if not Valid then
  4204. AbortCompileParamError(SCompilerParamInvalid2, ParamDeleteType);
  4205. { Name }
  4206. Name := Values[paName].Data;
  4207. { Common parameters }
  4208. ProcessExpressionParameter(ParamCommonComponents, Values[paComponents].Data, EvalComponentIdentifier, True, Components);
  4209. ProcessExpressionParameter(ParamCommonTasks, Values[paTasks].Data, EvalTaskIdentifier, True, Tasks);
  4210. ProcessExpressionParameter(ParamCommonLanguages, Values[paLanguages].Data, EvalLanguageIdentifier, False, Languages);
  4211. Check := Values[paCheck].Data;
  4212. BeforeInstall := Values[paBeforeInstall].Data;
  4213. AfterInstall := Values[paAfterInstall].Data;
  4214. ProcessMinVersionParameter(Values[paMinVersion], MinVersion);
  4215. ProcessOnlyBelowVersionParameter(Values[paOnlyBelowVersion], OnlyBelowVersion);
  4216. CheckCheckOrInstall(ParamCommonCheck, Check, cikCheck);
  4217. CheckCheckOrInstall(ParamCommonBeforeInstall, BeforeInstall, cikInstall);
  4218. CheckCheckOrInstall(ParamCommonAfterInstall, AfterInstall, cikInstall);
  4219. CheckConst(Name, MinVersion, []);
  4220. end;
  4221. except
  4222. SEFreeRec(NewDeleteEntry, SetupDeleteEntryStrings, SetupDeleteEntryAnsiStrings);
  4223. raise;
  4224. end;
  4225. if Ext = 0 then begin
  4226. WriteDebugEntry(deInstallDelete, InstallDeleteEntries.Count);
  4227. InstallDeleteEntries.Add(NewDeleteEntry);
  4228. end
  4229. else begin
  4230. WriteDebugEntry(deUninstallDelete, UninstallDeleteEntries.Count);
  4231. UninstallDeleteEntries.Add(NewDeleteEntry);
  4232. end;
  4233. end;
  4234. procedure TSetupCompiler.EnumISSigKeysProc(const Line: PChar; const Ext: Integer);
  4235. function ISSigKeysNameExists(const Name: String; const CheckGroupNames: Boolean): Boolean;
  4236. begin
  4237. for var I := 0 to ISSigKeyEntryExtraInfos.Count-1 do begin
  4238. var ISSigKeyEntryExtraInfo := PISSigKeyEntryExtraInfo(ISSigKeyEntryExtraInfos[I]);
  4239. if SameText(ISSigKeyEntryExtraInfo.Name, Name) or
  4240. (CheckGroupNames and ISSigKeyEntryExtraInfo.HasGroupName(Name)) then
  4241. Exit(True)
  4242. end;
  4243. Result := False;
  4244. end;
  4245. function ISSigKeysRuntimeIDExists(const RuntimeID: String): Boolean;
  4246. begin
  4247. for var I := 0 to ISSigKeyEntries.Count-1 do begin
  4248. var ISSigKeyEntry := PSetupISSigKeyEntry(ISSigKeyEntries[I]);
  4249. if SameText(ISSigKeyEntry.RuntimeID, RuntimeID) then
  4250. Exit(True)
  4251. end;
  4252. Result := False;
  4253. end;
  4254. type
  4255. TParam = (paName, paGroup, paKeyFile, paKeyID, paPublicX, paPublicY, paRuntimeID);
  4256. const
  4257. ParamISSigKeysName = 'Name';
  4258. ParamISSigKeysGroup = 'Group';
  4259. ParamISSigKeysKeyFile = 'KeyFile';
  4260. ParamISSigKeysKeyID = 'KeyID';
  4261. ParamISSigKeysPublicX = 'PublicX';
  4262. ParamISSigKeysPublicY = 'PublicY';
  4263. ParamISSigKeysRuntimeID = 'RuntimeID';
  4264. ParamInfo: array[TParam] of TParamInfo = (
  4265. (Name: ParamISSigKeysName; Flags: [piRequired, piNoEmpty]),
  4266. (Name: ParamISSigKeysGroup; Flags: []),
  4267. (Name: ParamISSigKeysKeyFile; Flags: [piNoEmpty]),
  4268. (Name: ParamISSigKeysKeyID; Flags: [piNoEmpty]),
  4269. (Name: ParamISSigKeysPublicX; Flags: [piNoEmpty]),
  4270. (Name: ParamISSigKeysPublicY; Flags: [piNoEmpty]),
  4271. (Name: ParamISSigKeysRuntimeID; Flags: [piNoEmpty]));
  4272. var
  4273. Values: array[TParam] of TParamValue;
  4274. NewISSigKeyEntry: PSetupISSigKeyEntry;
  4275. NewISSigKeyEntryExtraInfo: PISSigKeyEntryExtraInfo;
  4276. begin
  4277. ExtractParameters(Line, ParamInfo, Values);
  4278. NewISSigKeyEntry := nil;
  4279. NewISSigKeyEntryExtraInfo := nil;
  4280. try
  4281. NewISSigKeyEntryExtraInfo := AllocMem(SizeOf(TISSigKeyEntryExtraInfo));
  4282. with NewISSigKeyEntryExtraInfo^ do begin
  4283. { Name }
  4284. Name := Values[paName].Data;
  4285. if not IsValidIdentString(Name, False, False) then
  4286. AbortCompileFmt(SCompilerLanguagesOrISSigKeysBadName, [ParamISSigKeysName])
  4287. else if ISSigKeysNameExists(Name, True) then
  4288. AbortCompileFmt(SCompilerISSigKeysNameOrRuntimeIDExists, [ParamISSigKeysName, Name]);
  4289. { Group }
  4290. var S := Values[paGroup].Data;
  4291. while True do begin
  4292. const GroupName = ExtractStr(S, ' ');
  4293. if GroupName = '' then
  4294. Break;
  4295. if not IsValidIdentString(GroupName, False, False) then
  4296. AbortCompileFmt(SCompilerLanguagesOrISSigKeysBadGroupName, [ParamISSigKeysGroup])
  4297. else if SameText(Name, GroupName) or ISSigKeysNameExists(GroupName, False) then
  4298. AbortCompileFmt(SCompilerISSigKeysNameOrRuntimeIDExists, [ParamISSigKeysName, GroupName]);
  4299. if not HasGroupName(GroupName) then begin
  4300. const N = Length(GroupNames);
  4301. SetLength(GroupNames, N+1);
  4302. GroupNames[N] := GroupName;
  4303. end;
  4304. end;
  4305. end;
  4306. NewISSigKeyEntry := AllocMem(SizeOf(TSetupISSigKeyEntry));
  4307. with NewISSigKeyEntry^ do begin
  4308. { KeyFile & PublicX & PublicY }
  4309. var KeyFile := PrependSourceDirName(Values[paKeyFile].Data);
  4310. PublicX := Values[paPublicX].Data;
  4311. PublicY := Values[paPublicY].Data;
  4312. if (KeyFile = '') and (PublicX = '') and (PublicY = '') then
  4313. AbortCompile(SCompilerISSigKeysKeyNotSpecified)
  4314. else if KeyFile <> '' then begin
  4315. if PublicX <> '' then
  4316. AbortCompileFmt(SCompilerParamConflict, [ParamISSigKeysKeyFile, ParamISSigKeysPublicX])
  4317. else if PublicY <> '' then
  4318. AbortCompileFmt(SCompilerParamConflict, [ParamISSigKeysKeyFile, ParamISSigKeysPublicY]);
  4319. var KeyText := ISSigLoadTextFromFile(KeyFile);
  4320. var PublicKey: TECDSAPublicKey;
  4321. const ParseResult = ISSigParsePublicKeyText(KeyText, PublicKey);
  4322. if ParseResult = ikrMalformed then
  4323. AbortCompile(SCompilerISSigKeysBadKeyFile)
  4324. else if ParseResult <> ikrSuccess then
  4325. AbortCompile(SCompilerISSigKeysUnknownKeyImportResult);
  4326. ISSigConvertPublicKeyToStrings(PublicKey, PublicX, PublicY);
  4327. end else begin
  4328. if PublicX = '' then
  4329. AbortCompileParamError(SCompilerParamNotSpecified, ParamISSigKeysPublicX)
  4330. else if PublicY = '' then
  4331. AbortCompileParamError(SCompilerParamNotSpecified, ParamISSigKeysPublicY);
  4332. try
  4333. ISSigCheckValidPublicXOrY(PublicX);
  4334. except
  4335. AbortCompileFmt(SCompilerParamInvalidWithError, [ParamISSigKeysPublicX, GetExceptMessage]);
  4336. end;
  4337. try
  4338. ISSigCheckValidPublicXOrY(PublicY);
  4339. except
  4340. AbortCompileFmt(SCompilerParamInvalidWithError, [ParamISSigKeysPublicY, GetExceptMessage]);
  4341. end;
  4342. end;
  4343. { KeyID }
  4344. var KeyID := Values[paKeyID].Data;
  4345. if KeyID <> '' then begin
  4346. try
  4347. ISSigCheckValidKeyID(KeyID);
  4348. except
  4349. AbortCompileFmt(SCompilerParamInvalidWithError, [ParamISSigKeysKeyID, GetExceptMessage]);
  4350. end;
  4351. if not ISSigIsValidKeyIDForPublicXY(KeyID, PublicX, PublicY) then
  4352. AbortCompile(SCompilerISSigKeysBadKeyID);
  4353. end;
  4354. RuntimeID := Values[paRuntimeID].Data;
  4355. if (RuntimeID <> '') and ISSigKeysRuntimeIDExists(RuntimeID) then
  4356. AbortCompileFmt(SCompilerISSigKeysNameOrRuntimeIDExists, [ParamISSigKeysRuntimeID, RuntimeID]);
  4357. end;
  4358. except
  4359. SEFreeRec(NewISSigKeyEntry, SetupISSigKeyEntryStrings, SetupISSigKeyEntryAnsiStrings);
  4360. Dispose(NewISSigKeyEntryExtraInfo);
  4361. raise;
  4362. end;
  4363. ISSigKeyEntries.Add(NewISSigKeyEntry);
  4364. ISSigKeyEntryExtraInfos.Add(NewISSigKeyEntryExtraInfo);
  4365. end;
  4366. procedure TSetupCompiler.EnumFilesProc(const Line: PChar; const Ext: Integer);
  4367. function EscapeBraces(const S: String): String;
  4368. { Changes all '{' to '{{' }
  4369. var
  4370. I: Integer;
  4371. begin
  4372. Result := S;
  4373. I := 1;
  4374. while I <= Length(Result) do begin
  4375. if Result[I] = '{' then begin
  4376. Insert('{', Result, I);
  4377. Inc(I);
  4378. end;
  4379. Inc(I);
  4380. end;
  4381. end;
  4382. type
  4383. TParam = (paFlags, paSource, paDestDir, paDestName, paCopyMode, paAttribs,
  4384. paPermissions, paFontInstall, paExcludes, paExternalSize, paExtractArchivePassword,
  4385. paStrongAssemblyName, paHash, paISSigAllowedKeys, paDownloadISSigSource, paDownloadUserName,
  4386. paDownloadPassword, paComponents, paTasks, paLanguages, paCheck, paBeforeInstall,
  4387. paAfterInstall, paMinVersion, paOnlyBelowVersion);
  4388. const
  4389. ParamFilesSource = 'Source';
  4390. ParamFilesDestDir = 'DestDir';
  4391. ParamFilesDestName = 'DestName';
  4392. ParamFilesCopyMode = 'CopyMode';
  4393. ParamFilesAttribs = 'Attribs';
  4394. ParamFilesPermissions = 'Permissions';
  4395. ParamFilesFontInstall = 'FontInstall';
  4396. ParamFilesExcludes = 'Excludes';
  4397. ParamFilesExternalSize = 'ExternalSize';
  4398. ParamFilesExtractArchivePassword = 'ExtractArchivePassword';
  4399. ParamFilesStrongAssemblyName = 'StrongAssemblyName';
  4400. ParamFilesHash = 'Hash';
  4401. ParamFilesISSigAllowedKeys = 'ISSigAllowedKeys';
  4402. ParamFilesDownloadISSigSource = 'DownloadISSigSource';
  4403. ParamFilesDownloadUserName = 'DownloadUserName';
  4404. ParamFilesDownloadPassword = 'DownloadPassword';
  4405. ParamInfo: array[TParam] of TParamInfo = (
  4406. (Name: ParamCommonFlags; Flags: []),
  4407. (Name: ParamFilesSource; Flags: [piRequired, piNoEmpty, piNoQuotes]),
  4408. (Name: ParamFilesDestDir; Flags: [piNoEmpty, piNoQuotes]),
  4409. (Name: ParamFilesDestName; Flags: [piNoEmpty, piNoQuotes]),
  4410. (Name: ParamFilesCopyMode; Flags: []),
  4411. (Name: ParamFilesAttribs; Flags: []),
  4412. (Name: ParamFilesPermissions; Flags: []),
  4413. (Name: ParamFilesFontInstall; Flags: [piNoEmpty]),
  4414. (Name: ParamFilesExcludes; Flags: []),
  4415. (Name: ParamFilesExternalSize; Flags: []),
  4416. (Name: ParamFilesExtractArchivePassword; Flags: []),
  4417. (Name: ParamFilesStrongAssemblyName; Flags: [piNoEmpty]),
  4418. (Name: ParamFilesHash; Flags: [piNoEmpty]),
  4419. (Name: ParamFilesISSigAllowedKeys; Flags: [piNoEmpty]),
  4420. (Name: ParamFilesDownloadISSigSource; Flags: []),
  4421. (Name: ParamFilesDownloadUserName; Flags: [piNoEmpty]),
  4422. (Name: ParamFilesDownloadPassword; Flags: [piNoEmpty]),
  4423. (Name: ParamCommonComponents; Flags: []),
  4424. (Name: ParamCommonTasks; Flags: []),
  4425. (Name: ParamCommonLanguages; Flags: []),
  4426. (Name: ParamCommonCheck; Flags: []),
  4427. (Name: ParamCommonBeforeInstall; Flags: []),
  4428. (Name: ParamCommonAfterInstall; Flags: []),
  4429. (Name: ParamCommonMinVersion; Flags: []),
  4430. (Name: ParamCommonOnlyBelowVersion; Flags: []));
  4431. Flags: array[0..43] of PChar = (
  4432. 'confirmoverwrite', 'uninsneveruninstall', 'isreadme', 'regserver',
  4433. 'sharedfile', 'restartreplace', 'deleteafterinstall',
  4434. 'comparetimestamp', 'fontisnttruetype', 'regtypelib', 'external',
  4435. 'skipifsourcedoesntexist', 'overwritereadonly', 'onlyifdestfileexists',
  4436. 'recursesubdirs', 'noregerror', 'allowunsafefiles', 'uninsrestartdelete',
  4437. 'onlyifdoesntexist', 'ignoreversion', 'promptifolder', 'dontcopy',
  4438. 'uninsremovereadonly', 'sortfilesbyextension', 'touch', 'replacesameversion',
  4439. 'noencryption', 'nocompression', 'dontverifychecksum',
  4440. 'uninsnosharedfileprompt', 'createallsubdirs', '32bit', '64bit',
  4441. 'solidbreak', 'setntfscompression', 'unsetntfscompression',
  4442. 'sortfilesbyname', 'gacinstall', 'sign', 'signonce', 'signcheck',
  4443. 'issigverify', 'download', 'extractarchive');
  4444. SignFlags: array[TFileLocationSign] of String = (
  4445. '', 'sign', 'signonce', 'signcheck');
  4446. AttribsFlags: array[0..3] of PChar = (
  4447. 'readonly', 'hidden', 'system', 'notcontentindexed');
  4448. AccessMasks: array[0..2] of TNameAndAccessMask = (
  4449. (Name: 'full'; Mask: $1F01FF),
  4450. (Name: 'modify'; Mask: $1301BF),
  4451. (Name: 'readexec'; Mask: $1200A9));
  4452. var
  4453. Values: array[TParam] of TParamValue;
  4454. NewFileEntry, PrevFileEntry: PSetupFileEntry;
  4455. NewFileLocationEntry: PSetupFileLocationEntry;
  4456. NewFileLocationEntryExtraInfo: PFileLocationEntryExtraInfo;
  4457. VersionNumbers: TFileVersionNumbers;
  4458. SourceWildcard, ADestDir, ADestName, AInstallFontName, AStrongAssemblyName: String;
  4459. AExcludes: TStringList;
  4460. ReadmeFile, ExternalFile, SourceIsWildcard, RecurseSubdirs,
  4461. AllowUnsafeFiles, Touch, NoCompression, NoEncryption, SolidBreak: Boolean;
  4462. Sign: TFileLocationSign;
  4463. type
  4464. PFileListRec = ^TFileListRec;
  4465. TFileListRec = record
  4466. Name: String;
  4467. Size: Integer64;
  4468. end;
  4469. PDirListRec = ^TDirListRec;
  4470. TDirListRec = record
  4471. Name: String;
  4472. end;
  4473. procedure CheckForUnsafeFile(const Filename, SourceFile: String;
  4474. const IsRegistered: Boolean);
  4475. { This generates errors on "unsafe files" }
  4476. const
  4477. UnsafeSysFiles: array[0..13] of String = (
  4478. 'ADVAPI32.DLL', 'COMCTL32.DLL', 'COMDLG32.DLL', 'GDI32.DLL',
  4479. 'KERNEL32.DLL', 'MSCOREE.DLL', 'RICHED32.DLL', 'SHDOCVW.DLL',
  4480. 'SHELL32.DLL', 'SHLWAPI.DLL', 'URLMON.DLL', 'USER32.DLL', 'UXTHEME.DLL',
  4481. 'WININET.DLL');
  4482. UnsafeNonSysRegFiles: array[0..5] of String = (
  4483. 'COMCAT.DLL', 'MSVBVM50.DLL', 'MSVBVM60.DLL', 'OLEAUT32.DLL',
  4484. 'OLEPRO32.DLL', 'STDOLE2.TLB');
  4485. var
  4486. SourceFileDir, SysWow64Dir: String;
  4487. I: Integer;
  4488. begin
  4489. if AllowUnsafeFiles then
  4490. Exit;
  4491. if ADestDir = '{sys}\' then begin
  4492. { Files that must NOT be deployed to the user's System directory }
  4493. { Any DLL deployed from system's own System directory }
  4494. if not ExternalFile and
  4495. SameText(PathExtractExt(Filename), '.DLL') then begin
  4496. SourceFileDir := PathExpand(PathExtractDir(SourceFile));
  4497. SysWow64Dir := GetSysWow64Dir;
  4498. if (PathCompare(SourceFileDir, GetSystemDir) = 0) or
  4499. ((SysWow64Dir <> '') and ((PathCompare(SourceFileDir, SysWow64Dir) = 0))) then
  4500. AbortCompile(SCompilerFilesSystemDirUsed);
  4501. end;
  4502. { CTL3D32.DLL }
  4503. if not ExternalFile and
  4504. (CompareText(Filename, 'CTL3D32.DLL') = 0) and
  4505. (NewFileEntry^.MinVersion.WinVersion <> 0) and
  4506. FileSizeAndCRCIs(SourceFile, 27136, $28A66C20) then
  4507. AbortCompileFmt(SCompilerFilesUnsafeFile, ['CTL3D32.DLL, Windows NT-specific version']);
  4508. { Remaining files }
  4509. for I := Low(UnsafeSysFiles) to High(UnsafeSysFiles) do
  4510. if CompareText(Filename, UnsafeSysFiles[I]) = 0 then
  4511. AbortCompileFmt(SCompilerFilesUnsafeFile, [UnsafeSysFiles[I]]);
  4512. end
  4513. else begin
  4514. { Files that MUST be deployed to the user's System directory }
  4515. if IsRegistered then
  4516. for I := Low(UnsafeNonSysRegFiles) to High(UnsafeNonSysRegFiles) do
  4517. if CompareText(Filename, UnsafeNonSysRegFiles[I]) = 0 then
  4518. AbortCompileFmt(SCompilerFilesSystemDirNotUsed, [UnsafeNonSysRegFiles[I]]);
  4519. end;
  4520. end;
  4521. procedure AddToFileList(const FileList: TList; const Filename: String;
  4522. const SizeLo, SizeHi: LongWord);
  4523. var
  4524. Rec: PFileListRec;
  4525. begin
  4526. FileList.Expand;
  4527. New(Rec);
  4528. Rec.Name := Filename;
  4529. Rec.Size.Lo := SizeLo;
  4530. Rec.Size.Hi := SizeHi;
  4531. FileList.Add(Rec);
  4532. end;
  4533. procedure AddToDirList(const DirList: TList; const Dirname: String);
  4534. var
  4535. Rec: PDirListRec;
  4536. begin
  4537. DirList.Expand;
  4538. New(Rec);
  4539. Rec.Name := Dirname;
  4540. DirList.Add(Rec);
  4541. end;
  4542. procedure BuildFileList(const SearchBaseDir, SearchSubDir, SearchWildcard: String;
  4543. FileList, DirList: TList; CreateAllSubDirs: Boolean);
  4544. { Searches for any non excluded files matching "SearchBaseDir + SearchSubDir + SearchWildcard"
  4545. and adds them to FileList. }
  4546. var
  4547. SearchFullPath, FileName: String;
  4548. H: THandle;
  4549. FindData: TWin32FindData;
  4550. OldFileListCount, OldDirListCount: Integer;
  4551. begin
  4552. SearchFullPath := SearchBaseDir + SearchSubDir + SearchWildcard;
  4553. OldFileListCount := FileList.Count;
  4554. OldDirListCount := DirList.Count;
  4555. H := FindFirstFile(PChar(SearchFullPath), FindData);
  4556. if H <> INVALID_HANDLE_VALUE then begin
  4557. try
  4558. repeat
  4559. if FindData.dwFileAttributes and FILE_ATTRIBUTE_DIRECTORY <> 0 then
  4560. Continue;
  4561. if SourceIsWildcard then begin
  4562. if FindData.dwFileAttributes and FILE_ATTRIBUTE_HIDDEN <> 0 then
  4563. Continue;
  4564. FileName := FindData.cFileName;
  4565. end
  4566. else
  4567. FileName := SearchWildcard; { use the case specified in the script }
  4568. if IsExcluded(SearchSubDir + FileName, AExcludes) then
  4569. Continue;
  4570. AddToFileList(FileList, SearchSubDir + FileName, FindData.nFileSizeLow,
  4571. FindData.nFileSizeHigh);
  4572. CallIdleProc;
  4573. until not SourceIsWildcard or not FindNextFile(H, FindData);
  4574. finally
  4575. Windows.FindClose(H);
  4576. end;
  4577. end else
  4578. CallIdleProc;
  4579. if RecurseSubdirs then begin
  4580. H := FindFirstFile(PChar(SearchBaseDir + SearchSubDir + '*'), FindData);
  4581. if H <> INVALID_HANDLE_VALUE then begin
  4582. try
  4583. repeat
  4584. if (FindData.dwFileAttributes and FILE_ATTRIBUTE_DIRECTORY <> 0) and
  4585. (FindData.dwFileAttributes and FILE_ATTRIBUTE_HIDDEN = 0) and
  4586. (StrComp(FindData.cFileName, '.') <> 0) and
  4587. (StrComp(FindData.cFileName, '..') <> 0) and
  4588. not IsExcluded(SearchSubDir + FindData.cFileName, AExcludes) then
  4589. BuildFileList(SearchBaseDir, SearchSubDir + FindData.cFileName + '\',
  4590. SearchWildcard, FileList, DirList, CreateAllSubDirs);
  4591. until not FindNextFile(H, FindData);
  4592. finally
  4593. Windows.FindClose(H);
  4594. end;
  4595. end;
  4596. end;
  4597. if SearchSubDir <> '' then begin
  4598. { If both FileList and DirList didn't change size, this subdir won't be
  4599. created during install, so add it to DirList now if CreateAllSubDirs is set }
  4600. if CreateAllSubDirs and (FileList.Count = OldFileListCount) and
  4601. (DirList.Count = OldDirListCount) then
  4602. AddToDirList(DirList, SearchSubDir);
  4603. end;
  4604. end;
  4605. procedure ApplyNewSign(var Sign: TFileLocationSign;
  4606. const NewSign: TFileLocationSign; const ErrorMessage: String);
  4607. begin
  4608. if not (Sign in [fsNoSetting, NewSign]) then
  4609. AbortCompileFmt(ErrorMessage,
  4610. [ParamCommonFlags, SignFlags[Sign], SignFlags[NewSign]])
  4611. else
  4612. Sign := NewSign;
  4613. end;
  4614. procedure ApplyNewVerificationType(var VerificationType: TSetupFileVerificationType;
  4615. const NewVerificationType: TSetupFileVerificationType; const ErrorMessage: String);
  4616. begin
  4617. if not (VerificationType in [fvNone, NewVerificationType]) then
  4618. AbortCompileFmt(ErrorMessage, ['Hash', 'issigverify'])
  4619. else
  4620. VerificationType := NewVerificationType;
  4621. end;
  4622. procedure ProcessFileList(const FileListBaseDir: String; FileList: TList);
  4623. var
  4624. FileListRec: PFileListRec;
  4625. CheckName: String;
  4626. SourceFile: String;
  4627. I, J: Integer;
  4628. NewRunEntry: PSetupRunEntry;
  4629. begin
  4630. for I := 0 to FileList.Count-1 do begin
  4631. FileListRec := FileList[I];
  4632. if NewFileEntry = nil then begin
  4633. NewFileEntry := AllocMem(SizeOf(TSetupFileEntry));
  4634. SEDuplicateRec(PrevFileEntry, NewFileEntry,
  4635. SizeOf(TSetupFileEntry), SetupFileEntryStrings, SetupFileEntryAnsiStrings);
  4636. end;
  4637. if Ext = 0 then begin
  4638. if ADestName = '' then begin
  4639. if not ExternalFile then
  4640. NewFileEntry^.DestName := ADestDir + EscapeBraces(FileListRec.Name)
  4641. else
  4642. { Don't append the filename to DestName on 'external' files;
  4643. it will be determined during installation }
  4644. NewFileEntry^.DestName := ADestDir;
  4645. end
  4646. else begin
  4647. if not ExternalFile then
  4648. NewFileEntry^.DestName := ADestDir + EscapeBraces(PathExtractPath(FileListRec.Name)) +
  4649. ADestName
  4650. else
  4651. NewFileEntry^.DestName := ADestDir + ADestName;
  4652. { ^ user is already required to escape '{' in DestName }
  4653. Include(NewFileEntry^.Options, foCustomDestName);
  4654. end;
  4655. end
  4656. else
  4657. NewFileEntry^.DestName := '';
  4658. SourceFile := FileListBaseDir + FileListRec.Name;
  4659. NewFileLocationEntry := nil;
  4660. if not ExternalFile then begin
  4661. if not DontMergeDuplicateFiles then begin
  4662. { See if the source filename is already in the list of files to
  4663. be compressed. If so, merge it. }
  4664. J := FileLocationEntryFilenames.CaseInsensitiveIndexOf(SourceFile);
  4665. if J <> -1 then begin
  4666. NewFileLocationEntry := FileLocationEntries[J];
  4667. NewFileLocationEntryExtraInfo := FileLocationEntryExtraInfos[J];
  4668. NewFileEntry^.LocationEntry := J;
  4669. end;
  4670. end;
  4671. if NewFileLocationEntry = nil then begin
  4672. NewFileLocationEntry := AllocMem(SizeOf(TSetupFileLocationEntry));
  4673. NewFileLocationEntryExtraInfo := AllocMem(SizeOf(TFileLocationEntryExtraInfo));
  4674. SetupHeader.CompressMethod := CompressMethod;
  4675. FileLocationEntries.Add(NewFileLocationEntry);
  4676. FileLocationEntryExtraInfos.Add(NewFileLocationEntryExtraInfo);
  4677. FileLocationEntryFilenames.Add(SourceFile);
  4678. NewFileEntry^.LocationEntry := FileLocationEntries.Count-1;
  4679. if NewFileEntry^.FileType = ftUninstExe then
  4680. Include(NewFileLocationEntryExtraInfo^.Flags, floIsUninstExe);
  4681. Inc6464(TotalBytesToCompress, FileListRec.Size);
  4682. if SetupHeader.CompressMethod <> cmStored then
  4683. Include(NewFileLocationEntry^.Flags, floChunkCompressed);
  4684. if SetupEncryptionHeader.EncryptionUse <> euNone then
  4685. Include(NewFileLocationEntry^.Flags, floChunkEncrypted);
  4686. if SolidBreak and UseSolidCompression then begin
  4687. Include(NewFileLocationEntryExtraInfo^.Flags, floSolidBreak);
  4688. { If the entry matches multiple files, it should only break prior
  4689. to compressing the first one }
  4690. SolidBreak := False;
  4691. end;
  4692. NewFileLocationEntryExtraInfo^.Verification.Typ := fvNone; { Correct value set below }
  4693. NewFileLocationEntryExtraInfo^.Verification.Hash := NewFileEntry^.Verification.Hash;
  4694. NewFileLocationEntryExtraInfo^.Verification.ISSigAllowedKeys := NewFileEntry^.Verification.ISSigAllowedKeys;
  4695. end else begin
  4696. { Verification.Typ changes checked below }
  4697. if (NewFileLocationEntryExtraInfo^.Verification.Typ = fvHash) and
  4698. (NewFileEntry^.Verification.Typ = fvHash) and
  4699. not CompareMem(@NewFileLocationEntryExtraInfo^.Verification.Hash[0],
  4700. @NewFileEntry^.Verification.Hash[0], SizeOf(TSHA256Digest)) then
  4701. AbortCompileFmt(SCompilerFilesValueConflict, ['Hash']);
  4702. if (NewFileLocationEntryExtraInfo^.Verification.Typ = fvISSig) and
  4703. (NewFileEntry^.Verification.Typ = fvISSig) and
  4704. (NewFileLocationEntryExtraInfo^.Verification.ISSigAllowedKeys <> NewFileEntry^.Verification.ISSigAllowedKeys) then
  4705. AbortCompileFmt(SCompilerFilesValueConflict, ['ISSigAllowedKeys']);
  4706. end;
  4707. if Touch then
  4708. Include(NewFileLocationEntryExtraInfo^.Flags, floApplyTouchDateTime);
  4709. { Note: "nocompression"/"noencryption" on one file makes all merged
  4710. copies uncompressed/unencrypted too }
  4711. if NoCompression then
  4712. Exclude(NewFileLocationEntry^.Flags, floChunkCompressed);
  4713. if NoEncryption then
  4714. Exclude(NewFileLocationEntry^.Flags, floChunkEncrypted);
  4715. if Sign <> fsNoSetting then
  4716. ApplyNewSign(NewFileLocationEntryExtraInfo.Sign, Sign, SCompilerParamErrorBadCombo2SameSource);
  4717. if NewFileEntry^.Verification.Typ <> fvNone then
  4718. ApplyNewVerificationType(NewFileLocationEntryExtraInfo.Verification.Typ, NewFileEntry^.Verification.Typ,
  4719. SCompilerFilesParamFlagConflictSameSource);
  4720. end
  4721. else begin
  4722. NewFileEntry^.SourceFilename := SourceFile;
  4723. NewFileEntry^.LocationEntry := -1;
  4724. end;
  4725. { Read version info }
  4726. if not ExternalFile and not(foIgnoreVersion in NewFileEntry^.Options) and
  4727. (NewFileLocationEntry^.Flags * [floVersionInfoValid] = []) and
  4728. (NewFileLocationEntryExtraInfo^.Flags * [floVersionInfoNotValid] = []) then begin
  4729. AddStatus(Format(SCompilerStatusFilesVerInfo, [SourceFile]));
  4730. if GetVersionNumbers(SourceFile, VersionNumbers) then begin
  4731. NewFileLocationEntry^.FileVersionMS := VersionNumbers.MS;
  4732. NewFileLocationEntry^.FileVersionLS := VersionNumbers.LS;
  4733. Include(NewFileLocationEntry^.Flags, floVersionInfoValid);
  4734. end
  4735. else
  4736. Include(NewFileLocationEntryExtraInfo^.Flags, floVersionInfoNotValid);
  4737. end;
  4738. { Safety checks }
  4739. if Ext = 0 then begin
  4740. if ADestName <> '' then
  4741. CheckName := ADestName
  4742. else
  4743. CheckName := PathExtractName(FileListRec.Name);
  4744. CheckForUnsafeFile(CheckName, SourceFile,
  4745. (foRegisterServer in NewFileEntry^.Options) or
  4746. (foRegisterTypeLib in NewFileEntry^.Options));
  4747. if (ADestDir = '{sys}\') and (foIgnoreVersion in NewFileEntry^.Options) and
  4748. not SameText(PathExtractExt(CheckName), '.scr') then
  4749. WarningsList.Add(Format(SCompilerFilesIgnoreVersionUsedUnsafely, [CheckName]));
  4750. end;
  4751. if ReadmeFile then begin
  4752. NewRunEntry := AllocMem(Sizeof(TSetupRunEntry));
  4753. NewRunEntry.Name := NewFileEntry.DestName;
  4754. NewRunEntry.Components := NewFileEntry.Components;
  4755. NewRunEntry.Tasks := NewFileEntry.Tasks;
  4756. NewRunEntry.Languages := NewFileEntry.Languages;
  4757. NewRunEntry.Check := NewFileEntry.Check;
  4758. NewRunEntry.BeforeInstall := '';
  4759. NewRunEntry.AfterInstall := '';
  4760. NewRunEntry.MinVersion := NewFileEntry.MinVersion;
  4761. NewRunEntry.OnlyBelowVersion := NewFileEntry.OnlyBelowVersion;
  4762. NewRunEntry.Options := [roShellExec, roSkipIfDoesntExist, roPostInstall,
  4763. roSkipIfSilent, roRunAsOriginalUser];
  4764. NewRunEntry.ShowCmd := SW_SHOWNORMAL;
  4765. NewRunEntry.Wait := rwNoWait;
  4766. NewRunEntry.Verb := '';
  4767. RunEntries.Insert(0, NewRunEntry);
  4768. ShiftDebugEntryIndexes(deRun); { because we inserted at the front }
  4769. end;
  4770. WriteDebugEntry(deFile, FileEntries.Count);
  4771. FileEntries.Expand;
  4772. PrevFileEntry := NewFileEntry;
  4773. { nil before adding so there's no chance it could ever be double-freed }
  4774. NewFileEntry := nil;
  4775. FileEntries.Add(PrevFileEntry);
  4776. CallIdleProc;
  4777. end;
  4778. end;
  4779. procedure SortFileList(FileList: TList; L: Integer; const R: Integer;
  4780. const ByExtension, ByName: Boolean);
  4781. function Compare(const F1, F2: PFileListRec): Integer;
  4782. function ComparePathStr(P1, P2: PChar): Integer;
  4783. { Like CompareStr, but sorts backslashes correctly ('A\B' < 'AB\B') }
  4784. var
  4785. C1, C2: Char;
  4786. begin
  4787. repeat
  4788. C1 := P1^;
  4789. if C1 = '\' then
  4790. C1 := #1;
  4791. C2 := P2^;
  4792. if C2 = '\' then
  4793. C2 := #1;
  4794. Result := Ord(C1) - Ord(C2);
  4795. if Result <> 0 then
  4796. Break;
  4797. if C1 = #0 then
  4798. Break;
  4799. Inc(P1);
  4800. Inc(P2);
  4801. until False;
  4802. end;
  4803. var
  4804. S1, S2: String;
  4805. begin
  4806. { Optimization: First check if we were passed the same string }
  4807. if Pointer(F1.Name) = Pointer(F2.Name) then begin
  4808. Result := 0;
  4809. Exit;
  4810. end;
  4811. S1 := AnsiUppercase(F1.Name); { uppercase to mimic NTFS's sort order }
  4812. S2 := AnsiUppercase(F2.Name);
  4813. if ByExtension then
  4814. Result := CompareStr(PathExtractExt(S1), PathExtractExt(S2))
  4815. else
  4816. Result := 0;
  4817. if ByName and (Result = 0) then
  4818. Result := CompareStr(PathExtractName(S1), PathExtractName(S2));
  4819. if Result = 0 then begin
  4820. { To avoid randomness in the sorting, sort by path and then name }
  4821. Result := ComparePathStr(PChar(PathExtractPath(S1)),
  4822. PChar(PathExtractPath(S2)));
  4823. if Result = 0 then
  4824. Result := CompareStr(S1, S2);
  4825. end;
  4826. end;
  4827. var
  4828. I, J: Integer;
  4829. P: PFileListRec;
  4830. begin
  4831. repeat
  4832. I := L;
  4833. J := R;
  4834. P := FileList[(L + R) shr 1];
  4835. repeat
  4836. while Compare(FileList[I], P) < 0 do
  4837. Inc(I);
  4838. while Compare(FileList[J], P) > 0 do
  4839. Dec(J);
  4840. if I <= J then begin
  4841. FileList.Exchange(I, J);
  4842. Inc(I);
  4843. Dec(J);
  4844. end;
  4845. until I > J;
  4846. if L < J then
  4847. SortFileList(FileList, L, J, ByExtension, ByName);
  4848. L := I;
  4849. until I >= R;
  4850. end;
  4851. procedure ProcessDirList(DirList: TList);
  4852. var
  4853. DirListRec: PDirListRec;
  4854. NewDirEntry: PSetupDirEntry;
  4855. BaseFileEntry: PSetupFileEntry;
  4856. I: Integer;
  4857. begin
  4858. if NewFileEntry <> nil then
  4859. { If NewFileEntry is still assigned it means ProcessFileList didn't
  4860. process any files (i.e. only directories were matched) }
  4861. BaseFileEntry := NewFileEntry
  4862. else
  4863. BaseFileEntry := PrevFileEntry;
  4864. if not(foDontCopy in BaseFileEntry.Options) then begin
  4865. for I := 0 to DirList.Count-1 do begin
  4866. DirListRec := DirList[I];
  4867. NewDirEntry := AllocMem(Sizeof(TSetupDirEntry));
  4868. NewDirEntry.DirName := ADestDir + EscapeBraces(DirListRec.Name);
  4869. NewDirEntry.Components := BaseFileEntry.Components;
  4870. NewDirEntry.Tasks := BaseFileEntry.Tasks;
  4871. NewDirEntry.Languages := BaseFileEntry.Languages;
  4872. NewDirEntry.Check := BaseFileEntry.Check;
  4873. NewDirEntry.BeforeInstall := '';
  4874. NewDirEntry.AfterInstall := '';
  4875. NewDirEntry.MinVersion := BaseFileEntry.MinVersion;
  4876. NewDirEntry.OnlyBelowVersion := BaseFileEntry.OnlyBelowVersion;
  4877. NewDirEntry.Attribs := 0;
  4878. NewDirEntry.PermissionsEntry := -1;
  4879. NewDirEntry.Options := [];
  4880. DirEntries.Add(NewDirEntry);
  4881. end;
  4882. end;
  4883. end;
  4884. var
  4885. FileList, DirList: TList;
  4886. SortFilesByExtension, SortFilesByName: Boolean;
  4887. I: Integer;
  4888. begin
  4889. CallIdleProc;
  4890. if Ext = 0 then
  4891. ExtractParameters(Line, ParamInfo, Values);
  4892. AExcludes := TStringList.Create();
  4893. try
  4894. AExcludes.StrictDelimiter := True;
  4895. AExcludes.Delimiter := ',';
  4896. PrevFileEntry := nil;
  4897. NewFileEntry := AllocMem(SizeOf(TSetupFileEntry));
  4898. try
  4899. with NewFileEntry^ do begin
  4900. MinVersion := SetupHeader.MinVersion;
  4901. PermissionsEntry := -1;
  4902. ADestName := '';
  4903. ADestDir := '';
  4904. AInstallFontName := '';
  4905. AStrongAssemblyName := '';
  4906. ReadmeFile := False;
  4907. ExternalFile := False;
  4908. RecurseSubdirs := False;
  4909. AllowUnsafeFiles := False;
  4910. Touch := False;
  4911. SortFilesByExtension := False;
  4912. NoCompression := False;
  4913. NoEncryption := False;
  4914. SolidBreak := False;
  4915. ExternalSize := To64(0);
  4916. SortFilesByName := False;
  4917. Sign := fsNoSetting;
  4918. case Ext of
  4919. 0: begin
  4920. { Flags }
  4921. while True do
  4922. case ExtractFlag(Values[paFlags].Data, Flags) of
  4923. -2: Break;
  4924. -1: AbortCompileParamError(SCompilerParamUnknownFlag2, ParamCommonFlags);
  4925. 0: Include(Options, foConfirmOverwrite);
  4926. 1: Include(Options, foUninsNeverUninstall);
  4927. 2: ReadmeFile := True;
  4928. 3: Include(Options, foRegisterServer);
  4929. 4: Include(Options, foSharedFile);
  4930. 5: Include(Options, foRestartReplace);
  4931. 6: Include(Options, foDeleteAfterInstall);
  4932. 7: Include(Options, foCompareTimeStamp);
  4933. 8: Include(Options, foFontIsntTrueType);
  4934. 9: Include(Options, foRegisterTypeLib);
  4935. 10: ExternalFile := True;
  4936. 11: Include(Options, foSkipIfSourceDoesntExist);
  4937. 12: Include(Options, foOverwriteReadOnly);
  4938. 13: Include(Options, foOnlyIfDestFileExists);
  4939. 14: RecurseSubdirs := True;
  4940. 15: Include(Options, foNoRegError);
  4941. 16: AllowUnsafeFiles := True;
  4942. 17: Include(Options, foUninsRestartDelete);
  4943. 18: Include(Options, foOnlyIfDoesntExist);
  4944. 19: Include(Options, foIgnoreVersion);
  4945. 20: Include(Options, foPromptIfOlder);
  4946. 21: Include(Options, foDontCopy);
  4947. 22: Include(Options, foUninsRemoveReadOnly);
  4948. 23: SortFilesByExtension := True;
  4949. 24: Touch := True;
  4950. 25: Include(Options, foReplaceSameVersionIfContentsDiffer);
  4951. 26: NoEncryption := True;
  4952. 27: NoCompression := True;
  4953. 28: Include(Options, foDontVerifyChecksum);
  4954. 29: Include(Options, foUninsNoSharedFilePrompt);
  4955. 30: Include(Options, foCreateAllSubDirs);
  4956. 31: Include(Options, fo32Bit);
  4957. 32: Include(Options, fo64Bit);
  4958. 33: SolidBreak := True;
  4959. 34: Include(Options, foSetNTFSCompression);
  4960. 35: Include(Options, foUnsetNTFSCompression);
  4961. 36: SortFilesByName := True;
  4962. 37: Include(Options, foGacInstall);
  4963. 38: ApplyNewSign(Sign, fsYes, SCompilerParamErrorBadCombo2);
  4964. 39: ApplyNewSign(Sign, fsOnce, SCompilerParamErrorBadCombo2);
  4965. 40: ApplyNewSign(Sign, fsCheck, SCompilerParamErrorBadCombo2);
  4966. 41: ApplyNewVerificationType(Verification.Typ, fvISSig, SCompilerFilesParamFlagConflict);
  4967. 42: Include(Options, foDownload);
  4968. 43: Include(Options, foExtractArchive);
  4969. end;
  4970. { Source }
  4971. SourceWildcard := Values[paSource].Data;
  4972. { DestDir }
  4973. if Values[paDestDir].Found then
  4974. ADestDir := Values[paDestDir].Data
  4975. else begin
  4976. if foDontCopy in Options then
  4977. { DestDir is optional when the 'dontcopy' flag is used }
  4978. ADestDir := '{tmp}'
  4979. else
  4980. AbortCompileParamError(SCompilerParamNotSpecified, ParamFilesDestDir);
  4981. end;
  4982. { DestName }
  4983. if ConstPos('\', Values[paDestName].Data) <> 0 then
  4984. AbortCompileParamError(SCompilerParamNoBackslash, ParamFilesDestName);
  4985. ADestName := Values[paDestName].Data;
  4986. { CopyMode }
  4987. if Values[paCopyMode].Found then begin
  4988. Values[paCopyMode].Data := Trim(Values[paCopyMode].Data);
  4989. if CompareText(Values[paCopyMode].Data, 'normal') = 0 then begin
  4990. Include(Options, foPromptIfOlder);
  4991. WarningsList.Add(Format(SCompilerFilesWarningCopyMode,
  4992. ['normal', 'promptifolder', 'promptifolder']));
  4993. end
  4994. else if CompareText(Values[paCopyMode].Data, 'onlyifdoesntexist') = 0 then begin
  4995. Include(Options, foOnlyIfDoesntExist);
  4996. WarningsList.Add(Format(SCompilerFilesWarningCopyMode,
  4997. ['onlyifdoesntexist', 'onlyifdoesntexist',
  4998. 'onlyifdoesntexist']));
  4999. end
  5000. else if CompareText(Values[paCopyMode].Data, 'alwaysoverwrite') = 0 then begin
  5001. Include(Options, foIgnoreVersion);
  5002. WarningsList.Add(Format(SCompilerFilesWarningCopyMode,
  5003. ['alwaysoverwrite', 'ignoreversion', 'ignoreversion']));
  5004. end
  5005. else if CompareText(Values[paCopyMode].Data, 'alwaysskipifsameorolder') = 0 then begin
  5006. WarningsList.Add(SCompilerFilesWarningASISOO);
  5007. end
  5008. else if CompareText(Values[paCopyMode].Data, 'dontcopy') = 0 then begin
  5009. Include(Options, foDontCopy);
  5010. WarningsList.Add(Format(SCompilerFilesWarningCopyMode,
  5011. ['dontcopy', 'dontcopy', 'dontcopy']));
  5012. end
  5013. else
  5014. AbortCompileParamError(SCompilerParamInvalid2, ParamFilesCopyMode);
  5015. end;
  5016. { Attribs }
  5017. while True do
  5018. case ExtractFlag(Values[paAttribs].Data, AttribsFlags) of
  5019. -2: Break;
  5020. -1: AbortCompileParamError(SCompilerParamUnknownFlag2, ParamFilesAttribs);
  5021. 0: Attribs := Attribs or FILE_ATTRIBUTE_READONLY;
  5022. 1: Attribs := Attribs or FILE_ATTRIBUTE_HIDDEN;
  5023. 2: Attribs := Attribs or FILE_ATTRIBUTE_SYSTEM;
  5024. 3: Attribs := Attribs or FILE_ATTRIBUTE_NOT_CONTENT_INDEXED;
  5025. end;
  5026. { Permissions }
  5027. ProcessPermissionsParameter(Values[paPermissions].Data, AccessMasks,
  5028. PermissionsEntry);
  5029. { FontInstall }
  5030. AInstallFontName := Values[paFontInstall].Data;
  5031. { StrongAssemblyName }
  5032. AStrongAssemblyName := Values[paStrongAssemblyName].Data;
  5033. { Excludes }
  5034. ProcessWildcardsParameter(Values[paExcludes].Data, AExcludes, SCompilerFilesExcludeTooLong); { for an external file the Excludes field is set below }
  5035. { ExternalSize }
  5036. if Values[paExternalSize].Found then begin
  5037. if not ExternalFile then
  5038. AbortCompileFmt(SCompilerFilesParamRequiresFlag, ['ExternalSize', 'external']);
  5039. if not StrToInteger64(Values[paExternalSize].Data, ExternalSize) then
  5040. AbortCompileParamError(SCompilerParamInvalid2, ParamFilesExternalSize);
  5041. Include(Options, foExternalSizePreset);
  5042. end;
  5043. { DownloadISSigSource }
  5044. DownloadISSigSource := Values[paDownloadISSigSource].Data;
  5045. { DownloadUserName }
  5046. DownloadUserName := Values[paDownloadUserName].Data;
  5047. { DownloadPassword }
  5048. DownloadPassword := Values[paDownloadPassword].Data;
  5049. { ExtractArchivePassword }
  5050. ExtractArchivePassword := Values[paExtractArchivePassword].Data;
  5051. { Hash }
  5052. if Values[paHash].Found then begin
  5053. ApplyNewVerificationType(Verification.Typ, fvHash, SCompilerFilesParamFlagConflict);
  5054. Verification.Hash := SHA256DigestFromString(Values[paHash].Data);
  5055. end;
  5056. { ISSigAllowedKeys }
  5057. var S := Values[paISSigAllowedKeys].Data;
  5058. while True do begin
  5059. const KeyNameOrGroupName = ExtractStr(S, ' ');
  5060. if KeyNameOrGroupName = '' then
  5061. Break;
  5062. var FoundKey := False;
  5063. for var KeyIndex := 0 to ISSigKeyEntryExtraInfos.Count-1 do begin
  5064. var ISSigKeyEntryExtraInfo := PISSigKeyEntryExtraInfo(ISSigKeyEntryExtraInfos[KeyIndex]);
  5065. if SameText(ISSigKeyEntryExtraInfo.Name, KeyNameOrGroupName) or
  5066. ISSigKeyEntryExtraInfo.HasGroupName(KeyNameOrGroupName) then begin
  5067. SetISSigAllowedKey(Verification.ISSigAllowedKeys, KeyIndex);
  5068. FoundKey := True;
  5069. end;
  5070. end;
  5071. if not FoundKey then
  5072. AbortCompileFmt(SCompilerFilesUnkownISSigKeyNameOrGroupName, [ParamFilesISSigAllowedKeys]);
  5073. end;
  5074. { Common parameters }
  5075. ProcessExpressionParameter(ParamCommonComponents, Values[paComponents].Data, EvalComponentIdentifier, True, Components);
  5076. ProcessExpressionParameter(ParamCommonTasks, Values[paTasks].Data, EvalTaskIdentifier, True, Tasks);
  5077. ProcessExpressionParameter(ParamCommonLanguages, Values[paLanguages].Data, EvalLanguageIdentifier, False, Languages);
  5078. Check := Values[paCheck].Data;
  5079. BeforeInstall := Values[paBeforeInstall].Data;
  5080. AfterInstall := Values[paAfterInstall].Data;
  5081. ProcessMinVersionParameter(Values[paMinVersion], MinVersion);
  5082. ProcessOnlyBelowVersionParameter(Values[paOnlyBelowVersion], OnlyBelowVersion);
  5083. end;
  5084. 1: begin
  5085. SourceWildcard := '';
  5086. FileType := ftUninstExe;
  5087. { Ordinary hash comparison on unins*.exe won't really work since
  5088. Setup modifies the file after extracting it. Force same
  5089. version to always be overwritten by including the special
  5090. foOverwriteSameVersion option. }
  5091. Options := [foOverwriteSameVersion];
  5092. ExternalFile := True;
  5093. end;
  5094. end;
  5095. if (ADestDir = '{tmp}') or (Copy(ADestDir, 1, 4) = '{tmp}\') then
  5096. Include(Options, foDeleteAfterInstall);
  5097. if foDeleteAfterInstall in Options then begin
  5098. if foRestartReplace in Options then
  5099. AbortCompileFmt(SCompilerFilesTmpBadFlag, ['restartreplace']);
  5100. if foUninsNeverUninstall in Options then
  5101. AbortCompileFmt(SCompilerFilesTmpBadFlag, ['uninsneveruninstall']);
  5102. if foRegisterServer in Options then
  5103. AbortCompileFmt(SCompilerFilesTmpBadFlag, ['regserver']);
  5104. if foRegisterTypeLib in Options then
  5105. AbortCompileFmt(SCompilerFilesTmpBadFlag, ['regtypelib']);
  5106. if foSharedFile in Options then
  5107. AbortCompileFmt(SCompilerFilesTmpBadFlag, ['sharedfile']);
  5108. if foGacInstall in Options then
  5109. AbortCompileFmt(SCompilerFilesTmpBadFlag, ['gacinstall']);
  5110. Include(Options, foUninsNeverUninstall);
  5111. end;
  5112. if (fo32Bit in Options) and (fo64Bit in Options) then
  5113. AbortCompileFmt(SCompilerParamErrorBadCombo2,
  5114. [ParamCommonFlags, '32bit', '64bit']);
  5115. if AInstallFontName <> '' then begin
  5116. if not(foFontIsntTrueType in Options) then
  5117. AInstallFontName := AInstallFontName + ' (TrueType)';
  5118. InstallFontName := AInstallFontName;
  5119. end;
  5120. if (foGacInstall in Options) and (AStrongAssemblyName = '') then
  5121. AbortCompileFmt(SCompilerParamFlagMissingParam, ['StrongAssemblyName', 'gacinstall']);
  5122. if AStrongAssemblyName <> '' then
  5123. StrongAssemblyName := AStrongAssemblyName;
  5124. if not NoCompression and (foDontVerifyChecksum in Options) then
  5125. AbortCompileFmt(SCompilerParamFlagMissing, ['nocompression', 'dontverifychecksum']);
  5126. if ExternalFile then begin
  5127. if Sign <> fsNoSetting then
  5128. AbortCompileFmt(SCompilerParamErrorBadCombo2,
  5129. [ParamCommonFlags, 'external', SignFlags[Sign]]);
  5130. Excludes := AExcludes.DelimitedText;
  5131. end;
  5132. if foDownload in Options then begin
  5133. if not ExternalFile then
  5134. AbortCompileFmt(SCompilerParamFlagMissing, ['external', 'download']);
  5135. if not(foIgnoreVersion in Options) then
  5136. AbortCompileFmt(SCompilerParamFlagMissing, ['ignoreversion', 'download']);
  5137. if foCompareTimeStamp in Options then
  5138. AbortCompileFmt(SCompilerParamErrorBadCombo2, [ParamCommonFlags, 'download', 'comparetimestamp']);
  5139. if foSkipIfSourceDoesntExist in Options then
  5140. AbortCompileFmt(SCompilerParamErrorBadCombo2, [ParamCommonFlags, 'download', 'skipifsourcedoesntexist']);
  5141. if not(foExtractArchive in Options) and RecurseSubdirs then
  5142. AbortCompileFmt(SCompilerParamErrorBadCombo2, [ParamCommonFlags, 'recursesubdirs', 'download']);
  5143. if ADestName = '' then
  5144. AbortCompileFmt(SCompilerParamFlagMissingParam, ['DestName', 'download']);
  5145. if not(foExternalSizePreset in Options) then
  5146. AbortCompileFmt(SCompilerParamFlagMissingParam, ['ExternalSize', 'download']);
  5147. end;
  5148. if foExtractArchive in Options then begin
  5149. if not ExternalFile then
  5150. AbortCompileFmt(SCompilerParamFlagMissing, ['external', 'extractarchive']);
  5151. if not(foIgnoreVersion in Options) then
  5152. AbortCompileFmt(SCompilerParamFlagMissing, ['ignoreversion', 'extractarchive']);
  5153. if SetupHeader.SevenZipLibraryName = '' then
  5154. AbortCompileFmt(SCompilerEntryValueUnsupported, ['Setup', 'ArchiveExtraction', 'basic', 'extractarchive']);
  5155. end;
  5156. if (foIgnoreVersion in Options) and (foReplaceSameVersionIfContentsDiffer in Options) then
  5157. AbortCompileFmt(SCompilerParamErrorBadCombo2, ['Flags', 'ignoreversion', 'replacesameversion']);
  5158. if (ISSigKeyEntries.Count = 0) and (Verification.Typ = fvISSig) then
  5159. AbortCompile(SCompilerFilesISSigVerifyMissingISSigKeys);
  5160. if (Verification.ISSigAllowedKeys <> '') and (Verification.Typ <> fvISSig) then
  5161. AbortCompile(SCompilerFilesISSigAllowedKeysMissingISSigVerify);
  5162. if Sign in [fsYes, fsOnce] then begin
  5163. if Verification.Typ = fvHash then
  5164. AbortCompileFmt(SCompilerFilesParamFlagConflict,
  5165. [ParamCommonFlags, 'Hash', SignFlags[Sign]]);
  5166. if Verification.Typ = fvISSig then
  5167. AbortCompileFmt(SCompilerParamErrorBadCombo2,
  5168. [ParamCommonFlags, SignFlags[Sign], 'issigverify']);
  5169. if SignTools.Count = 0 then
  5170. Sign := fsNoSetting
  5171. end;
  5172. if not RecurseSubdirs and (foCreateAllSubDirs in Options) then
  5173. AbortCompileFmt(SCompilerParamFlagMissing, ['recursesubdirs', 'createallsubdirs']);
  5174. if (foSetNTFSCompression in Options) and
  5175. (foUnsetNTFSCompression in Options) then
  5176. AbortCompileFmt(SCompilerParamErrorBadCombo2,
  5177. [ParamCommonFlags, 'setntfscompression', 'unsetntfscompression']);
  5178. if (foSharedFile in Options) and
  5179. (Copy(ADestDir, 1, Length('{syswow64}')) = '{syswow64}') then
  5180. WarningsList.Add(SCompilerFilesWarningSharedFileSysWow64);
  5181. SourceIsWildcard := not(foDownload in Options) and IsWildcard(SourceWildcard);
  5182. if ExternalFile then begin
  5183. if RecurseSubdirs then
  5184. Include(Options, foRecurseSubDirsExternal);
  5185. CheckConst(SourceWildcard, MinVersion, []);
  5186. end;
  5187. if (ADestName <> '') and (SourceIsWildcard or (not (foDownload in Options) and (foExtractArchive in Options))) then
  5188. AbortCompile(SCompilerFilesDestNameCantBeSpecified);
  5189. CheckConst(ADestDir, MinVersion, []);
  5190. ADestDir := AddBackslash(ADestDir);
  5191. CheckConst(ADestName, MinVersion, []);
  5192. if not ExternalFile then
  5193. SourceWildcard := PrependSourceDirName(SourceWildcard);
  5194. CheckCheckOrInstall(ParamCommonCheck, Check, cikCheck);
  5195. CheckCheckOrInstall(ParamCommonBeforeInstall, BeforeInstall, cikInstall);
  5196. CheckCheckOrInstall(ParamCommonAfterInstall, AfterInstall, cikInstall);
  5197. CheckConst(DownloadISSigSource, MinVersion, []);
  5198. CheckConst(DownloadUserName, MinVersion, []);
  5199. CheckConst(DownloadPassword, MinVersion, []);
  5200. CheckConst(ExtractArchivePassword, MinVersion, []);
  5201. end;
  5202. FileList := TList.Create();
  5203. DirList := TList.Create();
  5204. try
  5205. if not ExternalFile then begin
  5206. BuildFileList(PathExtractPath(SourceWildcard), '', PathExtractName(SourceWildcard), FileList, DirList, foCreateAllSubDirs in NewFileEntry.Options);
  5207. if FileList.Count > 1 then
  5208. SortFileList(FileList, 0, FileList.Count-1, SortFilesByExtension, SortFilesByName);
  5209. end else
  5210. AddToFileList(FileList, SourceWildcard, 0, 0);
  5211. if FileList.Count > 0 then begin
  5212. if not ExternalFile then
  5213. ProcessFileList(PathExtractPath(SourceWildcard), FileList)
  5214. else
  5215. ProcessFileList('', FileList);
  5216. end;
  5217. if DirList.Count > 0 then begin
  5218. { Dirs found that need to be created. Can only happen if not external. }
  5219. ProcessDirList(DirList);
  5220. end;
  5221. if (FileList.Count = 0) and (DirList.Count = 0) then begin
  5222. { Nothing found. Can only happen if not external. }
  5223. if not(foSkipIfSourceDoesntExist in NewFileEntry^.Options) then begin
  5224. if SourceIsWildcard then
  5225. AbortCompileFmt(SCompilerFilesWildcardNotMatched, [SourceWildcard])
  5226. else
  5227. AbortCompileFmt(SCompilerSourceFileDoesntExist, [SourceWildcard]);
  5228. end;
  5229. end;
  5230. finally
  5231. for I := DirList.Count-1 downto 0 do
  5232. Dispose(PDirListRec(DirList[I]));
  5233. DirList.Free();
  5234. for I := FileList.Count-1 downto 0 do
  5235. Dispose(PFileListRec(FileList[I]));
  5236. FileList.Free();
  5237. end;
  5238. finally
  5239. { If NewFileEntry is still assigned at this point, either an exception
  5240. occurred or no files were matched }
  5241. SEFreeRec(NewFileEntry, SetupFileEntryStrings, SetupFileEntryAnsiStrings);
  5242. end;
  5243. finally
  5244. AExcludes.Free();
  5245. end;
  5246. end;
  5247. procedure TSetupCompiler.EnumRunProc(const Line: PChar; const Ext: Integer);
  5248. type
  5249. TParam = (paFlags, paFilename, paParameters, paWorkingDir, paRunOnceId,
  5250. paDescription, paStatusMsg, paVerb, paComponents, paTasks, paLanguages,
  5251. paCheck, paBeforeInstall, paAfterInstall, paMinVersion, paOnlyBelowVersion);
  5252. const
  5253. ParamRunFilename = 'Filename';
  5254. ParamRunParameters = 'Parameters';
  5255. ParamRunWorkingDir = 'WorkingDir';
  5256. ParamRunRunOnceId = 'RunOnceId';
  5257. ParamRunDescription = 'Description';
  5258. ParamRunStatusMsg = 'StatusMsg';
  5259. ParamRunVerb = 'Verb';
  5260. ParamInfo: array[TParam] of TParamInfo = (
  5261. (Name: ParamCommonFlags; Flags: []),
  5262. (Name: ParamRunFilename; Flags: [piRequired, piNoEmpty, piNoQuotes]),
  5263. (Name: ParamRunParameters; Flags: []),
  5264. (Name: ParamRunWorkingDir; Flags: []),
  5265. (Name: ParamRunRunOnceId; Flags: []),
  5266. (Name: ParamRunDescription; Flags: []),
  5267. (Name: ParamRunStatusMsg; Flags: []),
  5268. (Name: ParamRunVerb; Flags: []),
  5269. (Name: ParamCommonComponents; Flags: []),
  5270. (Name: ParamCommonTasks; Flags: []),
  5271. (Name: ParamCommonLanguages; Flags: []),
  5272. (Name: ParamCommonCheck; Flags: []),
  5273. (Name: ParamCommonBeforeInstall; Flags: []),
  5274. (Name: ParamCommonAfterInstall; Flags: []),
  5275. (Name: ParamCommonMinVersion; Flags: []),
  5276. (Name: ParamCommonOnlyBelowVersion; Flags: []));
  5277. Flags: array[0..19] of PChar = (
  5278. 'nowait', 'waituntilidle', 'shellexec', 'skipifdoesntexist',
  5279. 'runminimized', 'runmaximized', 'showcheckbox', 'postinstall',
  5280. 'unchecked', 'skipifsilent', 'skipifnotsilent', 'hidewizard',
  5281. 'runhidden', 'waituntilterminated', '32bit', '64bit', 'runasoriginaluser',
  5282. 'runascurrentuser', 'dontlogparameters', 'logoutput');
  5283. var
  5284. Values: array[TParam] of TParamValue;
  5285. NewRunEntry: PSetupRunEntry;
  5286. WaitFlagSpecified, RunAsOriginalUser, RunAsCurrentUser: Boolean;
  5287. begin
  5288. ExtractParameters(Line, ParamInfo, Values);
  5289. NewRunEntry := AllocMem(SizeOf(TSetupRunEntry));
  5290. try
  5291. with NewRunEntry^ do begin
  5292. MinVersion := SetupHeader.MinVersion;
  5293. ShowCmd := SW_SHOWNORMAL;
  5294. WaitFlagSpecified := False;
  5295. RunAsOriginalUser := False;
  5296. RunAsCurrentUser := False;
  5297. { Flags }
  5298. while True do
  5299. case ExtractFlag(Values[paFlags].Data, Flags) of
  5300. -2: Break;
  5301. -1: AbortCompileParamError(SCompilerParamUnknownFlag2, ParamCommonFlags);
  5302. 0: begin
  5303. if WaitFlagSpecified then
  5304. AbortCompile(SCompilerRunMultipleWaitFlags);
  5305. Wait := rwNoWait;
  5306. WaitFlagSpecified := True;
  5307. end;
  5308. 1: begin
  5309. if WaitFlagSpecified then
  5310. AbortCompile(SCompilerRunMultipleWaitFlags);
  5311. Wait := rwWaitUntilIdle;
  5312. WaitFlagSpecified := True;
  5313. end;
  5314. 2: Include(Options, roShellExec);
  5315. 3: Include(Options, roSkipIfDoesntExist);
  5316. 4: ShowCmd := SW_SHOWMINNOACTIVE;
  5317. 5: ShowCmd := SW_SHOWMAXIMIZED;
  5318. 6: begin
  5319. if (Ext = 1) then
  5320. AbortCompileParamError(SCompilerParamUnsupportedFlag, ParamCommonFlags);
  5321. WarningsList.Add(Format(SCompilerRunFlagObsolete, ['showcheckbox', 'postinstall']));
  5322. Include(Options, roPostInstall);
  5323. end;
  5324. 7: begin
  5325. if (Ext = 1) then
  5326. AbortCompileParamError(SCompilerParamUnsupportedFlag, ParamCommonFlags);
  5327. Include(Options, roPostInstall);
  5328. end;
  5329. 8: begin
  5330. if (Ext = 1) then
  5331. AbortCompileParamError(SCompilerParamUnsupportedFlag, ParamCommonFlags);
  5332. Include(Options, roUnchecked);
  5333. end;
  5334. 9: begin
  5335. if (Ext = 1) then
  5336. AbortCompileParamError(SCompilerParamUnsupportedFlag, ParamCommonFlags);
  5337. Include(Options, roSkipIfSilent);
  5338. end;
  5339. 10: begin
  5340. if (Ext = 1) then
  5341. AbortCompileParamError(SCompilerParamUnsupportedFlag, ParamCommonFlags);
  5342. Include(Options, roSkipIfNotSilent);
  5343. end;
  5344. 11: Include(Options, roHideWizard);
  5345. 12: ShowCmd := SW_HIDE;
  5346. 13: begin
  5347. if WaitFlagSpecified then
  5348. AbortCompile(SCompilerRunMultipleWaitFlags);
  5349. Wait := rwWaitUntilTerminated;
  5350. WaitFlagSpecified := True;
  5351. end;
  5352. 14: Include(Options, roRun32Bit);
  5353. 15: Include(Options, roRun64Bit);
  5354. 16: begin
  5355. if (Ext = 1) then
  5356. AbortCompileParamError(SCompilerParamUnsupportedFlag, ParamCommonFlags);
  5357. RunAsOriginalUser := True;
  5358. end;
  5359. 17: RunAsCurrentUser := True;
  5360. 18: Include(Options, roDontLogParameters);
  5361. 19: Include(Options, roLogOutput);
  5362. end;
  5363. if not WaitFlagSpecified then begin
  5364. if roShellExec in Options then
  5365. Wait := rwNoWait
  5366. else
  5367. Wait := rwWaitUntilTerminated;
  5368. end;
  5369. if RunAsOriginalUser and RunAsCurrentUser then
  5370. AbortCompileFmt(SCompilerParamErrorBadCombo2,
  5371. [ParamCommonFlags, 'runasoriginaluser', 'runascurrentuser']);
  5372. if RunAsOriginalUser or
  5373. (not RunAsCurrentUser and (roPostInstall in Options)) then
  5374. Include(Options, roRunAsOriginalUser);
  5375. if roLogOutput in Options then begin
  5376. if roShellExec in Options then
  5377. AbortCompileFmt(SCompilerParamErrorBadCombo2,
  5378. [ParamCommonFlags, 'logoutput', 'shellexec']);
  5379. if (Wait <> rwWaitUntilTerminated) then
  5380. AbortCompileFmt(SCompilerParamFlagMissing,
  5381. ['waituntilterminated', 'logoutput']);
  5382. if RunAsOriginalUser then
  5383. AbortCompileFmt(SCompilerParamErrorBadCombo2,
  5384. [ParamCommonFlags, 'logoutput', 'runasoriginaluser']);
  5385. if roRunAsOriginalUser in Options then
  5386. AbortCompileFmt(SCompilerParamFlagMissing3,
  5387. ['runascurrentuser', 'logoutput', 'postinstall']);
  5388. end;
  5389. { Filename }
  5390. Name := Values[paFilename].Data;
  5391. { Parameters }
  5392. Parameters := Values[paParameters].Data;
  5393. { WorkingDir }
  5394. WorkingDir := Values[paWorkingDir].Data;
  5395. { RunOnceId }
  5396. if Values[paRunOnceId].Data <> '' then begin
  5397. if Ext = 0 then
  5398. AbortCompile(SCompilerRunCantUseRunOnceId);
  5399. end else if Ext = 1 then
  5400. MissingRunOnceIds := True;
  5401. RunOnceId := Values[paRunOnceId].Data;
  5402. { Description }
  5403. if (Ext = 1) and (Values[paDescription].Data <> '') then
  5404. AbortCompile(SCompilerUninstallRunCantUseDescription);
  5405. Description := Values[paDescription].Data;
  5406. { StatusMsg }
  5407. StatusMsg := Values[paStatusMsg].Data;
  5408. { Verb }
  5409. if not (roShellExec in Options) and Values[paVerb].Found then
  5410. AbortCompileFmt(SCompilerParamFlagMissing2,
  5411. ['shellexec', 'Verb']);
  5412. Verb := Values[paVerb].Data;
  5413. { Common parameters }
  5414. ProcessExpressionParameter(ParamCommonComponents, Values[paComponents].Data, EvalComponentIdentifier, True, Components);
  5415. ProcessExpressionParameter(ParamCommonTasks, Values[paTasks].Data, EvalTaskIdentifier, True, Tasks);
  5416. ProcessExpressionParameter(ParamCommonLanguages, Values[paLanguages].Data, EvalLanguageIdentifier, False, Languages);
  5417. Check := Values[paCheck].Data;
  5418. BeforeInstall := Values[paBeforeInstall].Data;
  5419. AfterInstall := Values[paAfterInstall].Data;
  5420. ProcessMinVersionParameter(Values[paMinVersion], MinVersion);
  5421. ProcessOnlyBelowVersionParameter(Values[paOnlyBelowVersion], OnlyBelowVersion);
  5422. if (roRun32Bit in Options) and (roRun64Bit in Options) then
  5423. AbortCompileFmt(SCompilerParamErrorBadCombo2,
  5424. [ParamCommonFlags, '32bit', '64bit']);
  5425. if (roRun32Bit in Options) and (roShellExec in Options) then
  5426. AbortCompileFmt(SCompilerParamErrorBadCombo2,
  5427. [ParamCommonFlags, '32bit', 'shellexec']);
  5428. if (roRun64Bit in Options) and (roShellExec in Options) then
  5429. AbortCompileFmt(SCompilerParamErrorBadCombo2,
  5430. [ParamCommonFlags, '64bit', 'shellexec']);
  5431. CheckCheckOrInstall(ParamCommonCheck, Check, cikCheck);
  5432. CheckCheckOrInstall(ParamCommonBeforeInstall, BeforeInstall, cikInstall);
  5433. CheckCheckOrInstall(ParamCommonAfterInstall, AfterInstall, cikInstall);
  5434. CheckConst(Name, MinVersion, []);
  5435. CheckConst(Parameters, MinVersion, []);
  5436. CheckConst(WorkingDir, MinVersion, []);
  5437. CheckConst(RunOnceId, MinVersion, []);
  5438. CheckConst(Description, MinVersion, []);
  5439. CheckConst(StatusMsg, MinVersion, []);
  5440. CheckConst(Verb, MinVersion, []);
  5441. end;
  5442. except
  5443. SEFreeRec(NewRunEntry, SetupRunEntryStrings, SetupRunEntryAnsiStrings);
  5444. raise;
  5445. end;
  5446. if Ext = 0 then begin
  5447. WriteDebugEntry(deRun, RunEntries.Count);
  5448. RunEntries.Add(NewRunEntry)
  5449. end
  5450. else begin
  5451. WriteDebugEntry(deUninstallRun, UninstallRunEntries.Count);
  5452. UninstallRunEntries.Add(NewRunEntry);
  5453. end;
  5454. end;
  5455. type
  5456. TLanguagesParam = (paName, paMessagesFile, paLicenseFile, paInfoBeforeFile, paInfoAfterFile);
  5457. const
  5458. ParamLanguagesName = 'Name';
  5459. ParamLanguagesMessagesFile = 'MessagesFile';
  5460. ParamLanguagesLicenseFile = 'LicenseFile';
  5461. ParamLanguagesInfoBeforeFile = 'InfoBeforeFile';
  5462. ParamLanguagesInfoAfterFile = 'InfoAfterFile';
  5463. LanguagesParamInfo: array[TLanguagesParam] of TParamInfo = (
  5464. (Name: ParamLanguagesName; Flags: [piRequired, piNoEmpty]),
  5465. (Name: ParamLanguagesMessagesFile; Flags: [piRequired, piNoEmpty]),
  5466. (Name: ParamLanguagesLicenseFile; Flags: [piNoEmpty]),
  5467. (Name: ParamLanguagesInfoBeforeFile; Flags: [piNoEmpty]),
  5468. (Name: ParamLanguagesInfoAfterFile; Flags: [piNoEmpty]));
  5469. procedure TSetupCompiler.EnumLanguagesPreProc(const Line: PChar; const Ext: Integer);
  5470. var
  5471. Values: array[TLanguagesParam] of TParamValue;
  5472. NewPreLangData: TPreLangData;
  5473. Filename: String;
  5474. begin
  5475. ExtractParameters(Line, LanguagesParamInfo, Values);
  5476. PreLangDataList.Expand;
  5477. NewPreLangData := nil;
  5478. try
  5479. NewPreLangData := TPreLangData.Create;
  5480. Filename := '';
  5481. InitPreLangData(NewPreLangData);
  5482. { Name }
  5483. if not IsValidIdentString(Values[paName].Data, False, False) then
  5484. AbortCompile(SCompilerLanguagesOrISSigKeysBadName);
  5485. NewPreLangData.Name := Values[paName].Data;
  5486. { MessagesFile }
  5487. Filename := Values[paMessagesFile].Data;
  5488. except
  5489. NewPreLangData.Free;
  5490. raise;
  5491. end;
  5492. PreLangDataList.Add(NewPreLangData);
  5493. ReadMessagesFromFilesPre(Filename, PreLangDataList.Count-1);
  5494. end;
  5495. procedure TSetupCompiler.EnumLanguagesProc(const Line: PChar; const Ext: Integer);
  5496. var
  5497. Values: array[TLanguagesParam] of TParamValue;
  5498. NewLanguageEntry: PSetupLanguageEntry;
  5499. NewLangData: TLangData;
  5500. Filename: String;
  5501. begin
  5502. ExtractParameters(Line, LanguagesParamInfo, Values);
  5503. LanguageEntries.Expand;
  5504. LangDataList.Expand;
  5505. NewLangData := nil;
  5506. NewLanguageEntry := AllocMem(SizeOf(TSetupLanguageEntry));
  5507. try
  5508. NewLangData := TLangData.Create;
  5509. Filename := '';
  5510. InitLanguageEntry(NewLanguageEntry^);
  5511. { Name }
  5512. if not IsValidIdentString(Values[paName].Data, False, False) then
  5513. AbortCompile(SCompilerLanguagesOrISSigKeysBadName);
  5514. NewLanguageEntry.Name := Values[paName].Data;
  5515. { MessagesFile }
  5516. Filename := Values[paMessagesFile].Data;
  5517. { LicenseFile }
  5518. if (Values[paLicenseFile].Data <> '') then begin
  5519. AddStatus(Format(SCompilerStatusReadingInFile, [Values[paLicenseFile].Data]));
  5520. ReadTextFile(PrependSourceDirName(Values[paLicenseFile].Data), LanguageEntries.Count,
  5521. NewLanguageEntry.LicenseText);
  5522. end;
  5523. { InfoBeforeFile }
  5524. if (Values[paInfoBeforeFile].Data <> '') then begin
  5525. AddStatus(Format(SCompilerStatusReadingInFile, [Values[paInfoBeforeFile].Data]));
  5526. ReadTextFile(PrependSourceDirName(Values[paInfoBeforeFile].Data), LanguageEntries.Count,
  5527. NewLanguageEntry.InfoBeforeText);
  5528. end;
  5529. { InfoAfterFile }
  5530. if (Values[paInfoAfterFile].Data <> '') then begin
  5531. AddStatus(Format(SCompilerStatusReadingInFile, [Values[paInfoAfterFile].Data]));
  5532. ReadTextFile(PrependSourceDirName(Values[paInfoAfterFile].Data), LanguageEntries.Count,
  5533. NewLanguageEntry.InfoAfterText);
  5534. end;
  5535. except
  5536. NewLangData.Free;
  5537. SEFreeRec(NewLanguageEntry, SetupLanguageEntryStrings, SetupLanguageEntryAnsiStrings);
  5538. raise;
  5539. end;
  5540. LanguageEntries.Add(NewLanguageEntry);
  5541. LangDataList.Add(NewLangData);
  5542. ReadMessagesFromFiles(Filename, LanguageEntries.Count-1);
  5543. end;
  5544. procedure TSetupCompiler.EnumMessagesProc(const Line: PChar; const Ext: Integer);
  5545. var
  5546. P, P2: PChar;
  5547. I, ID, LangIndex: Integer;
  5548. N, M: String;
  5549. begin
  5550. P := StrScan(Line, '=');
  5551. if P = nil then
  5552. AbortCompile(SCompilerMessagesMissingEquals);
  5553. SetString(N, Line, P - Line);
  5554. N := Trim(N);
  5555. LangIndex := ExtractLangIndex(Self, N, Ext, False);
  5556. ID := GetEnumValue(TypeInfo(TSetupMessageID), 'msg' + N);
  5557. if ID = -1 then begin
  5558. if LangIndex = -2 then
  5559. AbortCompileFmt(SCompilerMessagesNotRecognizedDefault, [N])
  5560. else begin
  5561. if NotRecognizedMessagesWarning then begin
  5562. if LineFilename = '' then
  5563. WarningsList.Add(Format(SCompilerMessagesNotRecognizedWarning, [N]))
  5564. else
  5565. WarningsList.Add(Format(SCompilerMessagesNotRecognizedInFileWarning,
  5566. [N, LineFilename]));
  5567. end;
  5568. Exit;
  5569. end;
  5570. end;
  5571. Inc(P);
  5572. M := P;
  5573. { Replace %n with actual CR/LF characters }
  5574. P2 := PChar(M);
  5575. while True do begin
  5576. P2 := StrPos(P2, '%n');
  5577. if P2 = nil then Break;
  5578. P2[0] := #13;
  5579. P2[1] := #10;
  5580. Inc(P2, 2);
  5581. end;
  5582. if LangIndex = -2 then begin
  5583. { Special -2 value means store in DefaultLangData }
  5584. DefaultLangData.Messages[TSetupMessageID(ID)] := M;
  5585. DefaultLangData.MessagesDefined[TSetupMessageID(ID)] := True;
  5586. end
  5587. else begin
  5588. for I := 0 to LangDataList.Count-1 do begin
  5589. if (LangIndex <> -1) and (I <> LangIndex) then
  5590. Continue;
  5591. TLangData(LangDataList[I]).Messages[TSetupMessageID(ID)] := M;
  5592. TLangData(LangDataList[I]).MessagesDefined[TSetupMessageID(ID)] := True;
  5593. end;
  5594. end;
  5595. end;
  5596. procedure TSetupCompiler.EnumCustomMessagesProc(const Line: PChar; const Ext: Integer);
  5597. function ExpandNewlines(const S: String): String;
  5598. { Replaces '%n' with #13#10 }
  5599. var
  5600. L, I: Integer;
  5601. begin
  5602. Result := S;
  5603. L := Length(Result);
  5604. I := 1;
  5605. while I < L do begin
  5606. if Result[I] = '%' then begin
  5607. if Result[I+1] = 'n' then begin
  5608. Result[I] := #13;
  5609. Result[I+1] := #10;
  5610. end;
  5611. Inc(I);
  5612. end;
  5613. Inc(I);
  5614. end;
  5615. end;
  5616. var
  5617. P: PChar;
  5618. LangIndex: Integer;
  5619. N: String;
  5620. I: Integer;
  5621. ExistingCustomMessageEntry, NewCustomMessageEntry: PSetupCustomMessageEntry;
  5622. begin
  5623. P := StrScan(Line, '=');
  5624. if P = nil then
  5625. AbortCompile(SCompilerMessagesMissingEquals);
  5626. SetString(N, Line, P - Line);
  5627. N := Trim(N);
  5628. LangIndex := ExtractLangIndex(Self, N, Ext, False);
  5629. Inc(P);
  5630. CustomMessageEntries.Expand;
  5631. NewCustomMessageEntry := AllocMem(SizeOf(TSetupCustomMessageEntry));
  5632. try
  5633. if not IsValidIdentString(N, False, True) then
  5634. AbortCompile(SCompilerCustomMessageBadName);
  5635. { Delete existing entries}
  5636. for I := CustomMessageEntries.Count-1 downto 0 do begin
  5637. ExistingCustomMessageEntry := CustomMessageEntries[I];
  5638. if (CompareText(ExistingCustomMessageEntry.Name, N) = 0) and
  5639. ((LangIndex = -1) or (ExistingCustomMessageEntry.LangIndex = LangIndex)) then begin
  5640. SEFreeRec(ExistingCustomMessageEntry, SetupCustomMessageEntryStrings,
  5641. SetupCustomMessageEntryAnsiStrings);
  5642. CustomMessageEntries.Delete(I);
  5643. end;
  5644. end;
  5645. { Setup the new one }
  5646. NewCustomMessageEntry.Name := N;
  5647. NewCustomMessageEntry.Value := ExpandNewlines(P);
  5648. NewCustomMessageEntry.LangIndex := LangIndex;
  5649. except
  5650. SEFreeRec(NewCustomMessageEntry, SetupCustomMessageEntryStrings, SetupCustomMessageEntryAnsiStrings);
  5651. raise;
  5652. end;
  5653. CustomMessageEntries.Add(NewCustomMessageEntry);
  5654. end;
  5655. procedure TSetupCompiler.CheckCustomMessageDefinitions;
  5656. { Checks 'language completeness' of custom message constants }
  5657. var
  5658. MissingLang, Found: Boolean;
  5659. I, J, K: Integer;
  5660. CustomMessage1, CustomMessage2: PSetupCustomMessageEntry;
  5661. begin
  5662. for I := 0 to CustomMessageEntries.Count-1 do begin
  5663. CustomMessage1 := PSetupCustomMessageEntry(CustomMessageEntries[I]);
  5664. if CustomMessage1.LangIndex <> -1 then begin
  5665. MissingLang := False;
  5666. for J := 0 to LanguageEntries.Count-1 do begin
  5667. { Check whether the outer custom message name exists for this language }
  5668. Found := False;
  5669. for K := 0 to CustomMessageEntries.Count-1 do begin
  5670. CustomMessage2 := PSetupCustomMessageEntry(CustomMessageEntries[K]);
  5671. if CompareText(CustomMessage1.Name, CustomMessage2.Name) = 0 then begin
  5672. if (CustomMessage2.LangIndex = -1) or (CustomMessage2.LangIndex = J) then begin
  5673. Found := True;
  5674. Break;
  5675. end;
  5676. end;
  5677. end;
  5678. if not Found then begin
  5679. WarningsList.Add(Format(SCompilerCustomMessagesMissingLangWarning,
  5680. [CustomMessage1.Name, PSetupLanguageEntry(LanguageEntries[J]).Name,
  5681. PSetupLanguageEntry(LanguageEntries[CustomMessage1.LangIndex]).Name]));
  5682. MissingLang := True;
  5683. end;
  5684. end;
  5685. if MissingLang then begin
  5686. { The custom message CustomMessage1.Name is not 'language complete'.
  5687. Force it to be by setting CustomMessage1.LangIndex to -1. This will
  5688. cause languages that do not define the custom message to use this
  5689. one (i.e. the first definition of it). Note: Languages that do define
  5690. the custom message in subsequent entries will override this entry,
  5691. since Setup looks for the *last* matching entry. }
  5692. CustomMessage1.LangIndex := -1;
  5693. end;
  5694. end;
  5695. end;
  5696. end;
  5697. procedure TSetupCompiler.CheckCustomMessageReferences;
  5698. { Checks existence of expected custom message constants }
  5699. var
  5700. LineInfo: TLineInfo;
  5701. Found: Boolean;
  5702. S: String;
  5703. I, J: Integer;
  5704. begin
  5705. for I := 0 to ExpectedCustomMessageNames.Count-1 do begin
  5706. Found := False;
  5707. S := ExpectedCustomMessageNames[I];
  5708. for J := 0 to CustomMessageEntries.Count-1 do begin
  5709. if CompareText(PSetupCustomMessageEntry(CustomMessageEntries[J]).Name, S) = 0 then begin
  5710. Found := True;
  5711. Break;
  5712. end;
  5713. end;
  5714. if not Found then begin
  5715. LineInfo := TLineInfo(ExpectedCustomMessageNames.Objects[I]);
  5716. LineFilename := LineInfo.Filename;
  5717. LineNumber := LineInfo.FileLineNumber;
  5718. AbortCompileFmt(SCompilerCustomMessagesMissingName, [S]);
  5719. end;
  5720. end;
  5721. end;
  5722. procedure TSetupCompiler.InitPreLangData(const APreLangData: TPreLangData);
  5723. { Initializes a TPreLangData object with the default settings }
  5724. begin
  5725. with APreLangData do begin
  5726. Name := 'default';
  5727. LanguageCodePage := 0;
  5728. end;
  5729. end;
  5730. procedure TSetupCompiler.InitLanguageEntry(var ALanguageEntry: TSetupLanguageEntry);
  5731. { Initializes a TSetupLanguageEntry record with the default settings }
  5732. begin
  5733. with ALanguageEntry do begin
  5734. Name := 'default';
  5735. LanguageName := 'English';
  5736. LanguageID := $0409; { U.S. English }
  5737. DialogFontName := DefaultDialogFontName;
  5738. DialogFontSize := 8;
  5739. TitleFontName := 'Arial';
  5740. TitleFontSize := 29;
  5741. WelcomeFontName := 'Verdana';
  5742. WelcomeFontSize := 12;
  5743. CopyrightFontName := 'Arial';
  5744. CopyrightFontSize := 8;
  5745. LicenseText := '';
  5746. InfoBeforeText := '';
  5747. InfoAfterText := '';
  5748. end;
  5749. end;
  5750. procedure TSetupCompiler.ReadMessagesFromFilesPre(const AFiles: String;
  5751. const ALangIndex: Integer);
  5752. var
  5753. S, Filename: String;
  5754. begin
  5755. S := AFiles;
  5756. while True do begin
  5757. Filename := ExtractStr(S, ',');
  5758. if Filename = '' then
  5759. Break;
  5760. Filename := PathExpand(PrependSourceDirName(Filename));
  5761. AddStatus(Format(SCompilerStatusReadingInFile, [Filename]));
  5762. EnumIniSection(EnumLangOptionsPreProc, 'LangOptions', ALangIndex, False, True, Filename, True, True);
  5763. CallIdleProc;
  5764. end;
  5765. end;
  5766. procedure TSetupCompiler.ReadMessagesFromFiles(const AFiles: String;
  5767. const ALangIndex: Integer);
  5768. var
  5769. S, Filename: String;
  5770. begin
  5771. S := AFiles;
  5772. while True do begin
  5773. Filename := ExtractStr(S, ',');
  5774. if Filename = '' then
  5775. Break;
  5776. Filename := PathExpand(PrependSourceDirName(Filename));
  5777. AddStatus(Format(SCompilerStatusReadingInFile, [Filename]));
  5778. EnumIniSection(EnumLangOptionsProc, 'LangOptions', ALangIndex, False, True, Filename, True, False);
  5779. CallIdleProc;
  5780. EnumIniSection(EnumMessagesProc, 'Messages', ALangIndex, False, True, Filename, True, False);
  5781. CallIdleProc;
  5782. EnumIniSection(EnumCustomMessagesProc, 'CustomMessages', ALangIndex, False, True, Filename, True, False);
  5783. CallIdleProc;
  5784. end;
  5785. end;
  5786. const
  5787. DefaultIsl = {$IFDEF DEBUG} 'compiler:..\..\Files\Default.isl' {$ELSE} 'compiler:Default.isl' {$ENDIF};
  5788. procedure TSetupCompiler.ReadDefaultMessages;
  5789. var
  5790. J: TSetupMessageID;
  5791. begin
  5792. { Read messages from Default.isl into DefaultLangData }
  5793. EnumIniSection(EnumMessagesProc, 'Messages', -2, False, True, DefaultIsl, True, False);
  5794. CallIdleProc;
  5795. { Check for missing messages in Default.isl }
  5796. for J := Low(DefaultLangData.Messages) to High(DefaultLangData.Messages) do
  5797. if not DefaultLangData.MessagesDefined[J] then
  5798. AbortCompileFmt(SCompilerMessagesMissingDefaultMessage,
  5799. [Copy(GetEnumName(TypeInfo(TSetupMessageID), Ord(J)), 4, Maxint)]);
  5800. { ^ Copy(..., 4, Maxint) is to skip past "msg" }
  5801. end;
  5802. procedure TSetupCompiler.ReadMessagesFromScriptPre;
  5803. procedure CreateDefaultLanguageEntryPre;
  5804. var
  5805. NewPreLangData: TPreLangData;
  5806. begin
  5807. PreLangDataList.Expand;
  5808. NewPreLangData := nil;
  5809. try
  5810. NewPreLangData := TPreLangData.Create;
  5811. InitPreLangData(NewPreLangData);
  5812. except
  5813. NewPreLangData.Free;
  5814. raise;
  5815. end;
  5816. PreLangDataList.Add(NewPreLangData);
  5817. ReadMessagesFromFilesPre(DefaultIsl, PreLangDataList.Count-1);
  5818. end;
  5819. begin
  5820. { If there were no [Languages] entries, take this opportunity to create a
  5821. default language }
  5822. if PreLangDataList.Count = 0 then begin
  5823. CreateDefaultLanguageEntryPre;
  5824. CallIdleProc;
  5825. end;
  5826. { Then read the [LangOptions] section in the script }
  5827. AddStatus(SCompilerStatusReadingInScriptMsgs);
  5828. EnumIniSection(EnumLangOptionsPreProc, 'LangOptions', -1, False, True, '', True, False);
  5829. CallIdleProc;
  5830. end;
  5831. procedure TSetupCompiler.ReadMessagesFromScript;
  5832. procedure CreateDefaultLanguageEntry;
  5833. var
  5834. NewLanguageEntry: PSetupLanguageEntry;
  5835. NewLangData: TLangData;
  5836. begin
  5837. LanguageEntries.Expand;
  5838. LangDataList.Expand;
  5839. NewLangData := nil;
  5840. NewLanguageEntry := AllocMem(SizeOf(TSetupLanguageEntry));
  5841. try
  5842. NewLangData := TLangData.Create;
  5843. InitLanguageEntry(NewLanguageEntry^);
  5844. except
  5845. NewLangData.Free;
  5846. SEFreeRec(NewLanguageEntry, SetupLanguageEntryStrings, SetupLanguageEntryAnsiStrings);
  5847. raise;
  5848. end;
  5849. LanguageEntries.Add(NewLanguageEntry);
  5850. LangDataList.Add(NewLangData);
  5851. ReadMessagesFromFiles(DefaultIsl, LanguageEntries.Count-1);
  5852. end;
  5853. function IsOptional(const MessageID: TSetupMessageID): Boolean;
  5854. begin
  5855. Result := False; { Currently there are no optional messages }
  5856. end;
  5857. var
  5858. I: Integer;
  5859. LangData: TLangData;
  5860. J: TSetupMessageID;
  5861. begin
  5862. { If there were no [Languages] entries, take this opportunity to create a
  5863. default language }
  5864. if LanguageEntries.Count = 0 then begin
  5865. CreateDefaultLanguageEntry;
  5866. CallIdleProc;
  5867. end;
  5868. { Then read the [LangOptions] & [Messages] & [CustomMessages] sections in the script }
  5869. AddStatus(SCompilerStatusReadingInScriptMsgs);
  5870. EnumIniSection(EnumLangOptionsProc, 'LangOptions', -1, False, True, '', True, False);
  5871. CallIdleProc;
  5872. EnumIniSection(EnumMessagesProc, 'Messages', -1, False, True, '', True, False);
  5873. CallIdleProc;
  5874. EnumIniSection(EnumCustomMessagesProc, 'CustomMessages', -1, False, True, '', True, False);
  5875. CallIdleProc;
  5876. { Check for missing messages }
  5877. for I := 0 to LanguageEntries.Count-1 do begin
  5878. LangData := LangDataList[I];
  5879. for J := Low(LangData.Messages) to High(LangData.Messages) do
  5880. if not LangData.MessagesDefined[J] and not IsOptional(J) then begin
  5881. { Use the message from Default.isl }
  5882. if MissingMessagesWarning and not (J in [msgHelpTextNote, msgTranslatorNote]) then
  5883. WarningsList.Add(Format(SCompilerMessagesMissingMessageWarning,
  5884. [Copy(GetEnumName(TypeInfo(TSetupMessageID), Ord(J)), 4, Maxint),
  5885. PSetupLanguageEntry(LanguageEntries[I]).Name]));
  5886. { ^ Copy(..., 4, Maxint) is to skip past "msg" }
  5887. LangData.Messages[J] := DefaultLangData.Messages[J];
  5888. end;
  5889. end;
  5890. CallIdleProc;
  5891. end;
  5892. procedure TSetupCompiler.PopulateLanguageEntryData;
  5893. { Fills in each language entry's Data field, based on the messages in
  5894. LangDataList }
  5895. type
  5896. PMessagesDataStructure = ^TMessagesDataStructure;
  5897. TMessagesDataStructure = packed record
  5898. ID: TMessagesHdrID;
  5899. Header: TMessagesHeader;
  5900. MsgData: array[0..0] of Byte;
  5901. end;
  5902. var
  5903. L: Integer;
  5904. LangData: TLangData;
  5905. M: TMemoryStream;
  5906. I: TSetupMessageID;
  5907. Header: TMessagesHeader;
  5908. begin
  5909. for L := 0 to LanguageEntries.Count-1 do begin
  5910. LangData := LangDataList[L];
  5911. M := TMemoryStream.Create;
  5912. try
  5913. M.WriteBuffer(MessagesHdrID, SizeOf(MessagesHdrID));
  5914. FillChar(Header, SizeOf(Header), 0);
  5915. M.WriteBuffer(Header, SizeOf(Header)); { overwritten later }
  5916. for I := Low(LangData.Messages) to High(LangData.Messages) do
  5917. M.WriteBuffer(PChar(LangData.Messages[I])^, (Length(LangData.Messages[I]) + 1) * SizeOf(LangData.Messages[I][1]));
  5918. Header.NumMessages := Ord(High(LangData.Messages)) - Ord(Low(LangData.Messages)) + 1;
  5919. Header.TotalSize := M.Size;
  5920. Header.NotTotalSize := not Header.TotalSize;
  5921. Header.CRCMessages := GetCRC32(PMessagesDataStructure(M.Memory).MsgData,
  5922. M.Size - (SizeOf(MessagesHdrID) + SizeOf(Header)));
  5923. PMessagesDataStructure(M.Memory).Header := Header;
  5924. SetString(PSetupLanguageEntry(LanguageEntries[L]).Data, PAnsiChar(M.Memory),
  5925. M.Size);
  5926. finally
  5927. M.Free;
  5928. end;
  5929. end;
  5930. end;
  5931. procedure TSetupCompiler.EnumCodeProc(const Line: PChar; const Ext: Integer);
  5932. var
  5933. CodeTextLineInfo: TLineInfo;
  5934. begin
  5935. CodeTextLineInfo := TLineInfo.Create;
  5936. CodeTextLineInfo.Filename := LineFilename;
  5937. CodeTextLineInfo.FileLineNumber := LineNumber;
  5938. CodeText.AddObject(Line, CodeTextLineInfo);
  5939. end;
  5940. procedure TSetupCompiler.ReadCode;
  5941. begin
  5942. { Read [Code] section }
  5943. AddStatus(SCompilerStatusReadingCode);
  5944. EnumIniSection(EnumCodeProc, 'Code', 0, False, False, '', False, False);
  5945. CallIdleProc;
  5946. end;
  5947. procedure TSetupCompiler.CodeCompilerOnLineToLineInfo(const Line: LongInt; var Filename: String; var FileLine: LongInt);
  5948. var
  5949. CodeTextLineInfo: TLineInfo;
  5950. begin
  5951. if (Line > 0) and (Line <= CodeText.Count) then begin
  5952. CodeTextLineInfo := TLineInfo(CodeText.Objects[Line-1]);
  5953. Filename := CodeTextLineInfo.Filename;
  5954. FileLine := CodeTextLineInfo.FileLineNumber;
  5955. end;
  5956. end;
  5957. procedure TSetupCompiler.CodeCompilerOnUsedLine(const Filename: String; const Line, Position: LongInt; const IsProcExit: Boolean);
  5958. var
  5959. OldLineFilename: String;
  5960. OldLineNumber: Integer;
  5961. begin
  5962. OldLineFilename := LineFilename;
  5963. OldLineNumber := LineNumber;
  5964. try
  5965. LineFilename := Filename;
  5966. LineNumber := Line;
  5967. WriteDebugEntry(deCodeLine, Position, IsProcExit);
  5968. finally
  5969. LineFilename := OldLineFilename;
  5970. LineNumber := OldLineNumber;
  5971. end;
  5972. end;
  5973. procedure TSetupCompiler.CodeCompilerOnUsedVariable(const Filename: String; const Line, Col, Param1, Param2, Param3: LongInt; const Param4: AnsiString);
  5974. var
  5975. Rec: TVariableDebugEntry;
  5976. begin
  5977. if Length(Param4)+1 <= SizeOf(Rec.Param4) then begin
  5978. Rec.FileIndex := FilenameToFileIndex(Filename);
  5979. Rec.LineNumber := Line;
  5980. Rec.Col := Col;
  5981. Rec.Param1 := Param1;
  5982. Rec.Param2 := Param2;
  5983. Rec.Param3 := Param3;
  5984. FillChar(Rec.Param4, SizeOf(Rec.Param4), 0);
  5985. AnsiStrings.StrPCopy(Rec.Param4, Param4);
  5986. CodeDebugInfo.WriteBuffer(Rec, SizeOf(Rec));
  5987. Inc(VariableDebugEntryCount);
  5988. end;
  5989. end;
  5990. procedure TSetupCompiler.CodeCompilerOnError(const Msg: String; const ErrorFilename: String; const ErrorLine: LongInt);
  5991. begin
  5992. LineFilename := ErrorFilename;
  5993. LineNumber := ErrorLine;
  5994. AbortCompile(Msg);
  5995. end;
  5996. procedure TSetupCompiler.CodeCompilerOnWarning(const Msg: String);
  5997. begin
  5998. WarningsList.Add(Msg);
  5999. end;
  6000. procedure TSetupCompiler.CompileCode;
  6001. var
  6002. CodeStr: String;
  6003. CompiledCodeDebugInfo: AnsiString;
  6004. begin
  6005. { Compile CodeText }
  6006. if (CodeText.Count > 0) or (CodeCompiler.ExportCount > 0) then begin
  6007. if CodeText.Count > 0 then
  6008. AddStatus(SCompilerStatusCompilingCode);
  6009. //don't forget highlighter!
  6010. //setup
  6011. CodeCompiler.AddExport('InitializeSetup', 'Boolean', True, False, '', 0);
  6012. CodeCompiler.AddExport('DeinitializeSetup', '0', True, False, '', 0);
  6013. CodeCompiler.AddExport('CurStepChanged', '0 @TSetupStep', True, False, '', 0);
  6014. CodeCompiler.AddExport('NextButtonClick', 'Boolean @LongInt', True, False, '', 0);
  6015. CodeCompiler.AddExport('BackButtonClick', 'Boolean @LongInt', True, False, '', 0);
  6016. CodeCompiler.AddExport('CancelButtonClick', '0 @LongInt !Boolean !Boolean', True, False, '', 0);
  6017. CodeCompiler.AddExport('ShouldSkipPage', 'Boolean @LongInt', True, False, '', 0);
  6018. CodeCompiler.AddExport('CurPageChanged', '0 @LongInt', True, False, '', 0);
  6019. CodeCompiler.AddExport('CheckPassword', 'Boolean @String', True, False, '', 0);
  6020. CodeCompiler.AddExport('NeedRestart', 'Boolean', True, False, '', 0);
  6021. CodeCompiler.AddExport('RegisterPreviousData', '0 @LongInt', True, False, '', 0);
  6022. CodeCompiler.AddExport('CheckSerial', 'Boolean @String', True, False, '', 0);
  6023. CodeCompiler.AddExport('InitializeWizard', '0', True, False, '', 0);
  6024. CodeCompiler.AddExport('RegisterExtraCloseApplicationsResources', '0', True, False, '', 0);
  6025. CodeCompiler.AddExport('CurInstallProgressChanged', '0 @LongInt @LongInt', True, False, '', 0);
  6026. CodeCompiler.AddExport('UpdateReadyMemo', 'String @String @String @String @String @String @String @String @String', True, False, '', 0);
  6027. CodeCompiler.AddExport('GetCustomSetupExitCode', 'LongInt', True, False, '', 0);
  6028. CodeCompiler.AddExport('PrepareToInstall', 'String !Boolean', True, False, '', 0);
  6029. //uninstall
  6030. CodeCompiler.AddExport('InitializeUninstall', 'Boolean', True, False, '', 0);
  6031. CodeCompiler.AddExport('DeinitializeUninstall', '0', True, False, '', 0);
  6032. CodeCompiler.AddExport('CurUninstallStepChanged', '0 @TUninstallStep', True, False, '', 0);
  6033. CodeCompiler.AddExport('UninstallNeedRestart', 'Boolean', True, False, '', 0);
  6034. CodeCompiler.AddExport('InitializeUninstallProgressForm', '0', True, False, '', 0);
  6035. CodeStr := CodeText.Text;
  6036. { Remove trailing CR-LF so that ROPS will never report an error on
  6037. line CodeText.Count, one past the last actual line }
  6038. if Length(CodeStr) >= Length(#13#10) then
  6039. SetLength(CodeStr, Length(CodeStr) - Length(#13#10));
  6040. CodeCompiler.Compile(CodeStr, CompiledCodeText, CompiledCodeDebugInfo);
  6041. if CodeCompiler.FunctionFound('SkipCurPage') then
  6042. AbortCompileFmt(SCompilerCodeUnsupportedEventFunction, ['SkipCurPage',
  6043. 'ShouldSkipPage']);
  6044. WriteCompiledCodeText(CompiledCodeText);
  6045. WriteCompiledCodeDebugInfo(CompiledCodeDebugInfo);
  6046. end else begin
  6047. CompiledCodeText := '';
  6048. { Check if there were references to [Code] functions despite there being
  6049. no [Code] section }
  6050. CodeCompiler.CheckExports();
  6051. end;
  6052. end;
  6053. procedure TSetupCompiler.AddBytesCompressedSoFar(const Value: Cardinal);
  6054. begin
  6055. Inc64(BytesCompressedSoFar, Value);
  6056. end;
  6057. procedure TSetupCompiler.AddBytesCompressedSoFar(const Value: Integer64);
  6058. begin
  6059. Inc6464(BytesCompressedSoFar, Value);
  6060. end;
  6061. procedure TSetupCompiler.AddPreprocOption(const Value: String);
  6062. begin
  6063. PreprocOptionsString := PreprocOptionsString + Value + #0;
  6064. end;
  6065. procedure TSetupCompiler.AddSignTool(const Name, Command: String);
  6066. var
  6067. SignTool: TSignTool;
  6068. begin
  6069. SignToolList.Expand;
  6070. SignTool := TSignTool.Create();
  6071. SignTool.Name := Name;
  6072. SignTool.Command := Command;
  6073. SignToolList.Add(SignTool);
  6074. end;
  6075. procedure TSetupCompiler.Sign(AExeFilename: String);
  6076. var
  6077. I, SignToolIndex: Integer;
  6078. SignTool: TSignTool;
  6079. begin
  6080. for I := 0 to SignTools.Count - 1 do begin
  6081. SignToolIndex := FindSignToolIndexByName(SignTools[I]); //can't fail, already checked
  6082. SignTool := TSignTool(SignToolList[SignToolIndex]);
  6083. SignCommand(SignTool.Name, SignTool.Command, SignToolsParams[I], AExeFilename, SignToolRetryCount, SignToolRetryDelay, SignToolMinimumTimeBetween, SignToolRunMinimized);
  6084. end;
  6085. end;
  6086. procedure SignCommandLog(const S: String; const Error, FirstLine: Boolean; const Data: NativeInt);
  6087. begin
  6088. if S <> '' then begin
  6089. var SetupCompiler := TSetupCompiler(Data);
  6090. SetupCompiler.AddStatus(' ' + S, Error);
  6091. end;
  6092. end;
  6093. procedure TSetupCompiler.SignCommand(const AName, ACommand, AParams, AExeFilename: String; const RetryCount, RetryDelay, MinimumTimeBetween: Integer; const RunMinimized: Boolean);
  6094. function FmtCommand(S: PChar; const AParams, AFileName: String; var AFileNameSequenceFound: Boolean): String;
  6095. var
  6096. P: PChar;
  6097. Z: String;
  6098. begin
  6099. Result := '';
  6100. AFileNameSequenceFound := False;
  6101. if S = nil then Exit;
  6102. while True do begin
  6103. P := StrScan(S, '$');
  6104. if P = nil then begin
  6105. Result := Result + S;
  6106. Break;
  6107. end;
  6108. if P <> S then begin
  6109. SetString(Z, S, P - S);
  6110. Result := Result + Z;
  6111. S := P;
  6112. end;
  6113. Inc(P);
  6114. if (P^ = 'p') then begin
  6115. Result := Result + AParams;
  6116. Inc(S, 2);
  6117. end
  6118. else if (P^ = 'f') then begin
  6119. Result := Result + '"' + AFileName + '"';
  6120. AFileNameSequenceFound := True;
  6121. Inc(S, 2);
  6122. end
  6123. else if (P^ = 'q') then begin
  6124. Result := Result + '"';
  6125. Inc(S, 2);
  6126. end
  6127. else begin
  6128. Result := Result + '$';
  6129. Inc(S);
  6130. if P^ = '$' then
  6131. Inc(S);
  6132. end;
  6133. end;
  6134. end;
  6135. procedure InternalSignCommand(const AFormattedCommand: String;
  6136. const Delay: Cardinal);
  6137. begin
  6138. {Also see IsppFuncs' Exec }
  6139. if Delay <> 0 then begin
  6140. AddStatus(Format(SCompilerStatusSigningWithDelay, [AName, Delay, AFormattedCommand]));
  6141. Sleep(Delay);
  6142. end else
  6143. AddStatus(Format(SCompilerStatusSigning, [AName, AFormattedCommand]));
  6144. LastSignCommandStartTick := GetTickCount;
  6145. var StartupInfo: TStartupInfo;
  6146. FillChar(StartupInfo, SizeOf(StartupInfo), 0);
  6147. StartupInfo.cb := SizeOf(StartupInfo);
  6148. StartupInfo.dwFlags := STARTF_USESHOWWINDOW;
  6149. StartupInfo.wShowWindow := IfThen(RunMinimized, SW_SHOWMINNOACTIVE, SW_SHOWNORMAL);
  6150. var OutputReader := TCreateProcessOutputReader.Create(SignCommandLog, NativeInt(Self));
  6151. try
  6152. var InheritHandles := True;
  6153. var dwCreationFlags: DWORD := CREATE_DEFAULT_ERROR_MODE or CREATE_NO_WINDOW;
  6154. OutputReader.UpdateStartupInfo(StartupInfo);
  6155. var ProcessInfo: TProcessInformation;
  6156. if not CreateProcess(nil, PChar(AFormattedCommand), nil, nil, InheritHandles,
  6157. dwCreationFlags, nil, PChar(CompilerDir), StartupInfo, ProcessInfo) then begin
  6158. var LastError := GetLastError;
  6159. AbortCompileFmt(SCompilerSignToolCreateProcessFailed, [LastError,
  6160. Win32ErrorString(LastError)]);
  6161. end;
  6162. { Don't need the thread handle, so close it now }
  6163. CloseHandle(ProcessInfo.hThread);
  6164. OutputReader.NotifyCreateProcessDone;
  6165. try
  6166. while True do begin
  6167. case WaitForSingleObject(ProcessInfo.hProcess, 50) of
  6168. WAIT_OBJECT_0: Break;
  6169. WAIT_TIMEOUT:
  6170. begin
  6171. OutputReader.Read(False);
  6172. CallIdleProc(True); { Doesn't allow an Abort }
  6173. end;
  6174. else
  6175. AbortCompile('Sign: WaitForSingleObject failed');
  6176. end;
  6177. end;
  6178. OutputReader.Read(True);
  6179. var ExitCode: DWORD;
  6180. if not GetExitCodeProcess(ProcessInfo.hProcess, ExitCode) then
  6181. AbortCompile('Sign: GetExitCodeProcess failed');
  6182. if ExitCode <> 0 then
  6183. AbortCompileFmt(SCompilerSignToolNonZeroExitCode, [ExitCode]);
  6184. finally
  6185. CloseHandle(ProcessInfo.hProcess);
  6186. end;
  6187. finally
  6188. OutputReader.Free;
  6189. end;
  6190. end;
  6191. var
  6192. Params, Command: String;
  6193. MinimumTimeBetweenDelay: Integer;
  6194. I: Integer;
  6195. FileNameSequenceFound1, FileNameSequenceFound2: Boolean;
  6196. begin
  6197. Params := FmtCommand(PChar(AParams), '', AExeFileName, FileNameSequenceFound1);
  6198. Command := FmtCommand(PChar(ACommand), Params, AExeFileName, FileNameSequenceFound2);
  6199. if not FileNameSequenceFound1 and not FileNameSequenceFound2 then
  6200. AbortCompileFmt(SCompilerSignToolFileNameSequenceNotFound, [AName]);
  6201. for I := 0 to RetryCount do begin
  6202. try
  6203. if (MinimumTimeBetween <> 0) and (LastSignCommandStartTick <> 0) then begin
  6204. MinimumTimeBetweenDelay := MinimumTimeBetween - Integer(GetTickCount - LastSignCommandStartTick);
  6205. if MinimumTimeBetweenDelay < 0 then
  6206. MinimumTimeBetweenDelay := 0;
  6207. end else
  6208. MinimumTimeBetweenDelay := 0;
  6209. InternalSignCommand(Command, MinimumTimeBetweenDelay);
  6210. Break;
  6211. except on E: Exception do
  6212. if I < RetryCount then begin
  6213. AddStatus(Format(SCompilerStatusWillRetrySigning, [E.Message, RetryCount-I]));
  6214. Sleep(RetryDelay);
  6215. end else
  6216. raise;
  6217. end;
  6218. end;
  6219. end;
  6220. procedure TSetupCompiler.VerificationError(const AError: TVerificationError;
  6221. const AFilename, ASigFilename: String);
  6222. const
  6223. Messages: array[TVerificationError] of String =
  6224. (SCompilerVerificationSignatureDoesntExist, SCompilerVerificationSignatureMalformed,
  6225. SCompilerVerificationKeyNotFound, SCompilerVerificationSignatureBad,
  6226. SCompilerVerificationFileNameIncorrect, SCompilerVerificationFileSizeIncorrect,
  6227. SCompilerVerificationFileHashIncorrect);
  6228. begin
  6229. { Also see Setup.Install for a similar function }
  6230. AbortCompileFmt(SCompilerSourceFileVerificationFailed,
  6231. [AFilename, Format(Messages[AError], [PathExtractName(ASigFilename)])]); { Not all messages actually have a %s parameter but that's OK }
  6232. end;
  6233. procedure TSetupCompiler.Compile;
  6234. procedure InitDebugInfo;
  6235. var
  6236. Header: TDebugInfoHeader;
  6237. begin
  6238. DebugEntryCount := 0;
  6239. VariableDebugEntryCount := 0;
  6240. DebugInfo.Clear;
  6241. CodeDebugInfo.Clear;
  6242. Header.ID := DebugInfoHeaderID;
  6243. Header.Version := DebugInfoHeaderVersion;
  6244. Header.DebugEntryCount := 0;
  6245. Header.CompiledCodeTextLength := 0;
  6246. Header.CompiledCodeDebugInfoLength := 0;
  6247. DebugInfo.WriteBuffer(Header, SizeOf(Header));
  6248. end;
  6249. procedure FinalizeDebugInfo;
  6250. var
  6251. Header: TDebugInfoHeader;
  6252. begin
  6253. DebugInfo.CopyFrom(CodeDebugInfo, 0);
  6254. { Update the header }
  6255. DebugInfo.Seek(0, soFromBeginning);
  6256. DebugInfo.ReadBuffer(Header, SizeOf(Header));
  6257. Header.DebugEntryCount := DebugEntryCount;
  6258. Header.VariableDebugEntryCount := VariableDebugEntryCount;
  6259. Header.CompiledCodeTextLength := CompiledCodeTextLength;
  6260. Header.CompiledCodeDebugInfoLength := CompiledCodeDebugInfoLength;
  6261. DebugInfo.Seek(0, soFromBeginning);
  6262. DebugInfo.WriteBuffer(Header, SizeOf(Header));
  6263. end;
  6264. procedure EmptyOutputDir(const Log: Boolean);
  6265. procedure DelFile(const Filename: String);
  6266. begin
  6267. if DeleteFile(OutputDir + Filename) and Log then
  6268. AddStatus(Format(SCompilerStatusDeletingPrevious, [Filename]));
  6269. end;
  6270. var
  6271. H: THandle;
  6272. FindData: TWin32FindData;
  6273. N: String;
  6274. I: Integer;
  6275. HasNumbers: Boolean;
  6276. begin
  6277. { Delete Setup.* and Setup-*.bin if they existed in the output directory }
  6278. if OutputBaseFilename <> '' then begin
  6279. DelFile(OutputBaseFilename + '.exe');
  6280. if OutputDir <> '' then begin
  6281. H := FindFirstFile(PChar(OutputDir + OutputBaseFilename + '-*.bin'), FindData);
  6282. if H <> INVALID_HANDLE_VALUE then begin
  6283. try
  6284. repeat
  6285. if FindData.dwFileAttributes and FILE_ATTRIBUTE_DIRECTORY = 0 then begin
  6286. N := FindData.cFileName;
  6287. if PathStartsWith(N, OutputBaseFilename) then begin
  6288. I := Length(OutputBaseFilename) + 1;
  6289. if (I <= Length(N)) and (N[I] = '-') then begin
  6290. Inc(I);
  6291. HasNumbers := False;
  6292. while (I <= Length(N)) and CharInSet(N[I], ['0'..'9']) do begin
  6293. HasNumbers := True;
  6294. Inc(I);
  6295. end;
  6296. if HasNumbers then begin
  6297. if (I <= Length(N)) and CharInSet(UpCase(N[I]), ['A'..'Z']) then
  6298. Inc(I);
  6299. if CompareText(Copy(N, I, Maxint), '.bin') = 0 then
  6300. DelFile(N);
  6301. end;
  6302. end;
  6303. end;
  6304. end;
  6305. until not FindNextFile(H, FindData);
  6306. finally
  6307. Windows.FindClose(H);
  6308. end;
  6309. end;
  6310. end;
  6311. end;
  6312. end;
  6313. procedure ClearSEList(const List: TList; const NumStrings, NumAnsiStrings: Integer);
  6314. begin
  6315. for var I := List.Count-1 downto 0 do begin
  6316. SEFreeRec(List[I], NumStrings, NumAnsiStrings);
  6317. List.Delete(I);
  6318. end;
  6319. end;
  6320. procedure ClearPreLangDataList;
  6321. var
  6322. I: Integer;
  6323. begin
  6324. for I := PreLangDataList.Count-1 downto 0 do begin
  6325. TPreLangData(PreLangDataList[I]).Free;
  6326. PreLangDataList.Delete(I);
  6327. end;
  6328. end;
  6329. procedure ClearLangDataList;
  6330. var
  6331. I: Integer;
  6332. begin
  6333. for I := LangDataList.Count-1 downto 0 do begin
  6334. TLangData(LangDataList[I]).Free;
  6335. LangDataList.Delete(I);
  6336. end;
  6337. end;
  6338. procedure ClearScriptFiles;
  6339. var
  6340. I: Integer;
  6341. SL: TObject;
  6342. begin
  6343. for I := ScriptFiles.Count-1 downto 0 do begin
  6344. SL := ScriptFiles.Objects[I];
  6345. ScriptFiles.Delete(I);
  6346. SL.Free;
  6347. end;
  6348. end;
  6349. procedure ClearLineInfoList(L: TStringList);
  6350. var
  6351. I: Integer;
  6352. LineInfo: TLineInfo;
  6353. begin
  6354. for I := L.Count-1 downto 0 do begin
  6355. LineInfo := TLineInfo(L.Objects[I]);
  6356. L.Delete(I);
  6357. LineInfo.Free;
  6358. end;
  6359. end;
  6360. type
  6361. PCopyBuffer = ^TCopyBuffer;
  6362. TCopyBuffer = array[0..32767] of Char;
  6363. var
  6364. SetupFile: TFile;
  6365. ExeFile: TFile;
  6366. LicenseText, InfoBeforeText, InfoAfterText: AnsiString;
  6367. WizardImages, WizardSmallImages: TObjectList<TCustomMemoryStream>;
  6368. DecompressorDLL, SevenZipDLL: TMemoryStream;
  6369. SizeOfExe, SizeOfHeaders: Int64;
  6370. function WriteSetup0(const F: TFile): Int64;
  6371. procedure WriteStream(Stream: TCustomMemoryStream; W: TCompressedBlockWriter);
  6372. var
  6373. Size: Longint;
  6374. begin
  6375. Size := Stream.Size;
  6376. W.Write(Size, SizeOf(Size));
  6377. W.Write(Stream.Memory^, Size);
  6378. end;
  6379. var
  6380. J: Integer;
  6381. W: TCompressedBlockWriter;
  6382. begin
  6383. const StartPosition = F.Position;
  6384. F.WriteBuffer(SetupID, SizeOf(SetupID));
  6385. const SetupEncryptionHeaderCRC = GetCRC32(SetupEncryptionHeader, SizeOf(SetupEncryptionHeader));
  6386. F.WriteBuffer(SetupEncryptionHeaderCRC, SizeOf(SetupEncryptionHeaderCRC));
  6387. F.WriteBuffer(SetupEncryptionHeader, SizeOf(SetupEncryptionHeader));
  6388. SetupHeader.NumLanguageEntries := LanguageEntries.Count;
  6389. SetupHeader.NumCustomMessageEntries := CustomMessageEntries.Count;
  6390. SetupHeader.NumPermissionEntries := PermissionEntries.Count;
  6391. SetupHeader.NumTypeEntries := TypeEntries.Count;
  6392. SetupHeader.NumComponentEntries := ComponentEntries.Count;
  6393. SetupHeader.NumTaskEntries := TaskEntries.Count;
  6394. SetupHeader.NumDirEntries := DirEntries.Count;
  6395. SetupHeader.NumISSigKeyEntries := ISSigKeyEntries.Count;
  6396. SetupHeader.NumFileEntries := FileEntries.Count;
  6397. SetupHeader.NumFileLocationEntries := FileLocationEntries.Count;
  6398. SetupHeader.NumIconEntries := IconEntries.Count;
  6399. SetupHeader.NumIniEntries := IniEntries.Count;
  6400. SetupHeader.NumRegistryEntries := RegistryEntries.Count;
  6401. SetupHeader.NumInstallDeleteEntries := InstallDeleteEntries.Count;
  6402. SetupHeader.NumUninstallDeleteEntries := UninstallDeleteEntries.Count;
  6403. SetupHeader.NumRunEntries := RunEntries.Count;
  6404. SetupHeader.NumUninstallRunEntries := UninstallRunEntries.Count;
  6405. SetupHeader.LicenseText := LicenseText;
  6406. SetupHeader.InfoBeforeText := InfoBeforeText;
  6407. SetupHeader.InfoAfterText := InfoAfterText;
  6408. SetupHeader.CompiledCodeText := CompiledCodeText;
  6409. W := TCompressedBlockWriter.Create(F, TLZMACompressor, InternalCompressLevel,
  6410. InternalCompressProps);
  6411. try
  6412. if SetupEncryptionHeader.EncryptionUse = euFull then
  6413. W.InitEncryption(CryptKey, SetupEncryptionHeader.BaseNonce, sccCompressedBlocks1);
  6414. SECompressedBlockWrite(W, SetupHeader, SizeOf(SetupHeader),
  6415. SetupHeaderStrings, SetupHeaderAnsiStrings);
  6416. for J := 0 to LanguageEntries.Count-1 do
  6417. SECompressedBlockWrite(W, LanguageEntries[J]^, SizeOf(TSetupLanguageEntry),
  6418. SetupLanguageEntryStrings, SetupLanguageEntryAnsiStrings);
  6419. for J := 0 to CustomMessageEntries.Count-1 do
  6420. SECompressedBlockWrite(W, CustomMessageEntries[J]^, SizeOf(TSetupCustomMessageEntry),
  6421. SetupCustomMessageEntryStrings, SetupCustomMessageEntryAnsiStrings);
  6422. for J := 0 to PermissionEntries.Count-1 do
  6423. SECompressedBlockWrite(W, PermissionEntries[J]^, SizeOf(TSetupPermissionEntry),
  6424. SetupPermissionEntryStrings, SetupPermissionEntryAnsiStrings);
  6425. for J := 0 to TypeEntries.Count-1 do
  6426. SECompressedBlockWrite(W, TypeEntries[J]^, SizeOf(TSetupTypeEntry),
  6427. SetupTypeEntryStrings, SetupTypeEntryAnsiStrings);
  6428. for J := 0 to ComponentEntries.Count-1 do
  6429. SECompressedBlockWrite(W, ComponentEntries[J]^, SizeOf(TSetupComponentEntry),
  6430. SetupComponentEntryStrings, SetupComponentEntryAnsiStrings);
  6431. for J := 0 to TaskEntries.Count-1 do
  6432. SECompressedBlockWrite(W, TaskEntries[J]^, SizeOf(TSetupTaskEntry),
  6433. SetupTaskEntryStrings, SetupTaskEntryAnsiStrings);
  6434. for J := 0 to DirEntries.Count-1 do
  6435. SECompressedBlockWrite(W, DirEntries[J]^, SizeOf(TSetupDirEntry),
  6436. SetupDirEntryStrings, SetupDirEntryAnsiStrings);
  6437. for J := 0 to ISSigKeyEntries.Count-1 do
  6438. SECompressedBlockWrite(W, ISSigKeyEntries[J]^, SizeOf(TSetupISSigKeyEntry),
  6439. SetupISSigKeyEntryStrings, SetupISSigKeyEntryAnsiStrings);
  6440. for J := 0 to FileEntries.Count-1 do
  6441. SECompressedBlockWrite(W, FileEntries[J]^, SizeOf(TSetupFileEntry),
  6442. SetupFileEntryStrings, SetupFileEntryAnsiStrings);
  6443. for J := 0 to IconEntries.Count-1 do
  6444. SECompressedBlockWrite(W, IconEntries[J]^, SizeOf(TSetupIconEntry),
  6445. SetupIconEntryStrings, SetupIconEntryAnsiStrings);
  6446. for J := 0 to IniEntries.Count-1 do
  6447. SECompressedBlockWrite(W, IniEntries[J]^, SizeOf(TSetupIniEntry),
  6448. SetupIniEntryStrings, SetupIniEntryAnsiStrings);
  6449. for J := 0 to RegistryEntries.Count-1 do
  6450. SECompressedBlockWrite(W, RegistryEntries[J]^, SizeOf(TSetupRegistryEntry),
  6451. SetupRegistryEntryStrings, SetupRegistryEntryAnsiStrings);
  6452. for J := 0 to InstallDeleteEntries.Count-1 do
  6453. SECompressedBlockWrite(W, InstallDeleteEntries[J]^, SizeOf(TSetupDeleteEntry),
  6454. SetupDeleteEntryStrings, SetupDeleteEntryAnsiStrings);
  6455. for J := 0 to UninstallDeleteEntries.Count-1 do
  6456. SECompressedBlockWrite(W, UninstallDeleteEntries[J]^, SizeOf(TSetupDeleteEntry),
  6457. SetupDeleteEntryStrings, SetupDeleteEntryAnsiStrings);
  6458. for J := 0 to RunEntries.Count-1 do
  6459. SECompressedBlockWrite(W, RunEntries[J]^, SizeOf(TSetupRunEntry),
  6460. SetupRunEntryStrings, SetupRunEntryAnsiStrings);
  6461. for J := 0 to UninstallRunEntries.Count-1 do
  6462. SECompressedBlockWrite(W, UninstallRunEntries[J]^, SizeOf(TSetupRunEntry),
  6463. SetupRunEntryStrings, SetupRunEntryAnsiStrings);
  6464. W.Write(WizardImages.Count, SizeOf(Integer));
  6465. for J := 0 to WizardImages.Count-1 do
  6466. WriteStream(WizardImages[J], W);
  6467. W.Write(WizardSmallImages.Count, SizeOf(Integer));
  6468. for J := 0 to WizardSmallImages.Count-1 do
  6469. WriteStream(WizardSmallImages[J], W);
  6470. if SetupHeader.CompressMethod in [cmZip, cmBzip] then
  6471. WriteStream(DecompressorDLL, W);
  6472. if SetupHeader.SevenZipLibraryName <> '' then
  6473. WriteStream(SevenZipDLL, W);
  6474. W.Finish;
  6475. finally
  6476. W.Free;
  6477. end;
  6478. if not DiskSpanning then
  6479. W := TCompressedBlockWriter.Create(F, TLZMACompressor, InternalCompressLevel,
  6480. InternalCompressProps)
  6481. else
  6482. W := TCompressedBlockWriter.Create(F, nil, 0, nil);
  6483. { ^ When disk spanning is enabled, the Setup Compiler requires that
  6484. FileLocationEntries be a fixed size, so don't compress them }
  6485. try
  6486. if SetupEncryptionHeader.EncryptionUse = euFull then
  6487. W.InitEncryption(CryptKey, SetupEncryptionHeader.BaseNonce, sccCompressedBlocks2);
  6488. for J := 0 to FileLocationEntries.Count-1 do
  6489. W.Write(FileLocationEntries[J]^, SizeOf(TSetupFileLocationEntry));
  6490. W.Finish;
  6491. finally
  6492. W.Free;
  6493. end;
  6494. Result := F.Position - StartPosition;
  6495. end;
  6496. function CreateSetup0File: Int64;
  6497. var
  6498. F: TFile;
  6499. begin
  6500. F := TFile.Create(OutputDir + OutputBaseFilename + '-0.bin',
  6501. fdCreateAlways, faWrite, fsNone);
  6502. try
  6503. Result := WriteSetup0(F);
  6504. finally
  6505. F.Free;
  6506. end;
  6507. end;
  6508. function RoundToNearestClusterSize(const L: Int64): Int64;
  6509. begin
  6510. Result := (L div DiskClusterSize) * DiskClusterSize;
  6511. if L mod DiskClusterSize <> 0 then
  6512. Inc(Result, DiskClusterSize);
  6513. end;
  6514. procedure CompressFiles(const FirstDestFile: String;
  6515. const BytesToReserveOnFirstDisk: Int64);
  6516. var
  6517. CurrentTime: TSystemTime;
  6518. procedure ApplyTouchDateTime(var FT: TFileTime);
  6519. var
  6520. ST: TSystemTime;
  6521. begin
  6522. if (TouchDateOption = tdNone) and (TouchTimeOption = ttNone) then
  6523. Exit; { nothing to do }
  6524. if not FileTimeToSystemTime(FT, ST) then
  6525. AbortCompile('ApplyTouch: FileTimeToSystemTime call failed');
  6526. case TouchDateOption of
  6527. tdCurrent: begin
  6528. ST.wYear := CurrentTime.wYear;
  6529. ST.wMonth := CurrentTime.wMonth;
  6530. ST.wDay := CurrentTime.wDay;
  6531. end;
  6532. tdExplicit: begin
  6533. ST.wYear := TouchDateYear;
  6534. ST.wMonth := TouchDateMonth;
  6535. ST.wDay := TouchDateDay;
  6536. end;
  6537. end;
  6538. case TouchTimeOption of
  6539. ttCurrent: begin
  6540. ST.wHour := CurrentTime.wHour;
  6541. ST.wMinute := CurrentTime.wMinute;
  6542. ST.wSecond := CurrentTime.wSecond;
  6543. ST.wMilliseconds := CurrentTime.wMilliseconds;
  6544. end;
  6545. ttExplicit: begin
  6546. ST.wHour := TouchTimeHour;
  6547. ST.wMinute := TouchTimeMinute;
  6548. ST.wSecond := TouchTimeSecond;
  6549. ST.wMilliseconds := 0;
  6550. end;
  6551. end;
  6552. if not SystemTimeToFileTime(ST, FT) then
  6553. AbortCompile('ApplyTouch: SystemTimeToFileTime call failed');
  6554. end;
  6555. function GetCompressorClass(const UseCompression: Boolean): TCustomCompressorClass;
  6556. begin
  6557. if not UseCompression then
  6558. Result := TStoredCompressor
  6559. else begin
  6560. case SetupHeader.CompressMethod of
  6561. cmStored: begin
  6562. Result := TStoredCompressor;
  6563. end;
  6564. cmZip: begin
  6565. InitZipDLL;
  6566. Result := TZCompressor;
  6567. end;
  6568. cmBzip: begin
  6569. InitBzipDLL;
  6570. Result := TBZCompressor;
  6571. end;
  6572. cmLZMA: begin
  6573. Result := TLZMACompressor;
  6574. end;
  6575. cmLZMA2: begin
  6576. Result := TLZMA2Compressor;
  6577. end;
  6578. else
  6579. AbortCompile('GetCompressorClass: Unknown CompressMethod');
  6580. Result := nil;
  6581. end;
  6582. end;
  6583. end;
  6584. procedure FinalizeChunk(const CH: TCompressionHandler;
  6585. const LastFileLocationEntry: Integer);
  6586. var
  6587. I: Integer;
  6588. FL: PSetupFileLocationEntry;
  6589. begin
  6590. if CH.ChunkStarted then begin
  6591. CH.EndChunk;
  6592. { Set LastSlice and ChunkCompressedSize on all file location
  6593. entries that are part of the chunk }
  6594. for I := 0 to LastFileLocationEntry do begin
  6595. FL := FileLocationEntries[I];
  6596. if (FL.StartOffset = CH.ChunkStartOffset) and (FL.FirstSlice = CH.ChunkFirstSlice) then begin
  6597. FL.LastSlice := CH.CurSlice;
  6598. FL.ChunkCompressedSize := CH.ChunkBytesWritten;
  6599. end;
  6600. end;
  6601. end;
  6602. end;
  6603. const
  6604. StatusFilesStoringOrCompressingVersionStrings: array [Boolean] of String = (
  6605. SCompilerStatusFilesStoringVersion,
  6606. SCompilerStatusFilesCompressingVersion);
  6607. StatusFilesStoringOrCompressingStrings: array [Boolean] of String = (
  6608. SCompilerStatusFilesStoring,
  6609. SCompilerStatusFilesCompressing);
  6610. var
  6611. CH: TCompressionHandler;
  6612. ChunkCompressed: Boolean;
  6613. I: Integer;
  6614. FL: PSetupFileLocationEntry;
  6615. FLExtraInfo: PFileLocationEntryExtraInfo;
  6616. FT: TFileTime;
  6617. SourceFile: TFile;
  6618. SignatureAddress, SignatureSize: Cardinal;
  6619. HdrChecksum, ErrorCode: DWORD;
  6620. ISSigAvailableKeys: TArrayOfECDSAKey;
  6621. begin
  6622. if (SetupHeader.CompressMethod in [cmLZMA, cmLZMA2]) and
  6623. (CompressProps.WorkerProcessFilename <> '') then
  6624. AddStatus(Format(' Using separate process for LZMA compression (%s)',
  6625. [PathExtractName(CompressProps.WorkerProcessFilename)]));
  6626. if TimeStampsInUTC then
  6627. GetSystemTime(CurrentTime)
  6628. else
  6629. GetLocalTime(CurrentTime);
  6630. ChunkCompressed := False; { avoid warning }
  6631. CH := TCompressionHandler.Create(Self, FirstDestFile);
  6632. SetLength(ISSigAvailableKeys, ISSigKeyEntries.Count);
  6633. for I := 0 to ISSigKeyEntries.Count-1 do
  6634. ISSigAvailableKeys[I] := nil;
  6635. try
  6636. for I := 0 to ISSigKeyEntries.Count-1 do begin
  6637. const ISSigKeyEntry = PSetupISSigKeyEntry(ISSigKeyEntries[I]);
  6638. ISSigAvailableKeys[I] := TECDSAKey.Create;
  6639. try
  6640. ISSigImportPublicKey(ISSigAvailableKeys[I], '', ISSigKeyEntry.PublicX, ISSigKeyEntry.PublicY); { shouldn't fail: values checked already }
  6641. except
  6642. AbortCompileFmt(SCompilerCompressInternalError, ['ISSigImportPublicKey failed: ' + GetExceptMessage]);
  6643. end;
  6644. end;
  6645. if DiskSpanning then begin
  6646. if not CH.ReserveBytesOnSlice(BytesToReserveOnFirstDisk) then
  6647. AbortCompile(SCompilerNotEnoughSpaceOnFirstDisk);
  6648. end;
  6649. CompressionStartTick := GetTickCount;
  6650. CompressionInProgress := True;
  6651. for I := 0 to FileLocationEntries.Count-1 do begin
  6652. FL := FileLocationEntries[I];
  6653. FLExtraInfo := FileLocationEntryExtraInfos[I];
  6654. if FLExtraInfo.Sign <> fsNoSetting then begin
  6655. var SignatureFound := False;
  6656. if FLExtraInfo.Sign in [fsOnce, fsCheck] then begin
  6657. { Check the file for a signature }
  6658. SourceFile := TFile.Create(FileLocationEntryFilenames[I],
  6659. fdOpenExisting, faRead, fsRead);
  6660. try
  6661. if ReadSignatureAndChecksumFields(SourceFile, DWORD(SignatureAddress),
  6662. DWORD(SignatureSize), HdrChecksum) or
  6663. ReadSignatureAndChecksumFields64(SourceFile, DWORD(SignatureAddress),
  6664. DWORD(SignatureSize), HdrChecksum) then
  6665. SignatureFound := SignatureSize <> 0;
  6666. finally
  6667. SourceFile.Free;
  6668. end;
  6669. end;
  6670. if (FLExtraInfo.Sign = fsYes) or ((FLExtraInfo.Sign = fsOnce) and not SignatureFound) then begin
  6671. AddStatus(Format(SCompilerStatusSigningSourceFile, [FileLocationEntryFilenames[I]]));
  6672. Sign(FileLocationEntryFilenames[I]);
  6673. CallIdleProc;
  6674. end else if FLExtraInfo.Sign = fsOnce then
  6675. AddStatus(Format(SCompilerStatusSourceFileAlreadySigned, [FileLocationEntryFilenames[I]]))
  6676. else if (FLExtraInfo.Sign = fsCheck) and not SignatureFound then
  6677. AbortCompileFmt(SCompilerSourceFileNotSigned, [FileLocationEntryFilenames[I]]);
  6678. end;
  6679. if floVersionInfoValid in FL.Flags then
  6680. AddStatus(Format(StatusFilesStoringOrCompressingVersionStrings[floChunkCompressed in FL.Flags],
  6681. [FileLocationEntryFilenames[I],
  6682. LongRec(FL.FileVersionMS).Hi, LongRec(FL.FileVersionMS).Lo,
  6683. LongRec(FL.FileVersionLS).Hi, LongRec(FL.FileVersionLS).Lo]))
  6684. else
  6685. AddStatus(Format(StatusFilesStoringOrCompressingStrings[floChunkCompressed in FL.Flags],
  6686. [FileLocationEntryFilenames[I]]));
  6687. CallIdleProc;
  6688. SourceFile := TFile.Create(FileLocationEntryFilenames[I],
  6689. fdOpenExisting, faRead, fsRead);
  6690. try
  6691. var ExpectedFileHash: TSHA256Digest;
  6692. if FLExtraInfo.Verification.Typ = fvHash then
  6693. ExpectedFileHash := FLExtraInfo.Verification.Hash
  6694. else if FLExtraInfo.Verification.Typ = fvISSig then begin
  6695. { See Setup.Install's CopySourceFileToDestFile for similar code }
  6696. if Length(ISSigAvailableKeys) = 0 then { shouldn't fail: flag stripped already }
  6697. AbortCompileFmt(SCompilerCompressInternalError, ['Length(ISSigAvailableKeys) = 0']);
  6698. var ExpectedFileName: String;
  6699. var ExpectedFileSize: Int64;
  6700. if not ISSigVerifySignature(FileLocationEntryFilenames[I],
  6701. GetISSigAllowedKeys(ISSigAvailableKeys, FLExtraInfo.Verification.ISSigAllowedKeys),
  6702. ExpectedFileName, ExpectedFileSize, ExpectedFileHash, FLExtraInfo.ISSigKeyUsedID,
  6703. nil,
  6704. procedure(const Filename, SigFilename: String)
  6705. begin
  6706. VerificationError(veSignatureMissing, Filename, SigFilename);
  6707. end,
  6708. procedure(const Filename, SigFilename: String; const VerifyResult: TISSigVerifySignatureResult)
  6709. begin
  6710. var VerifyResultAsString: String;
  6711. case VerifyResult of
  6712. vsrMalformed: VerificationError(veSignatureMalformed, Filename, SigFilename);
  6713. vsrBad: VerificationError(veSignatureBad, Filename, SigFilename);
  6714. vsrKeyNotFound: VerificationError(veKeyNotFound, Filename, SigFilename);
  6715. else
  6716. AbortCompileFmt(SCompilerCompressInternalError, ['Unknown ISSigVerifySignature result'])
  6717. end;
  6718. end
  6719. ) then
  6720. AbortCompileFmt(SCompilerCompressInternalError, ['Unexpected ISSigVerifySignature result']);
  6721. if (ExpectedFileName <> '') and not PathSame(PathExtractName(FileLocationEntryFilenames[I]), ExpectedFileName) then
  6722. VerificationError(veFileNameIncorrect, FileLocationEntryFilenames[I]);
  6723. if SourceFile.Size <> ExpectedFileSize then
  6724. VerificationError(veFileSizeIncorrect, FileLocationEntryFilenames[I]);
  6725. { ExpectedFileHash checked below after compression }
  6726. end;
  6727. if CH.ChunkStarted then begin
  6728. { End the current chunk if one of the following conditions is true:
  6729. - we're not using solid compression
  6730. - the "solidbreak" flag was specified on this file
  6731. - the compression or encryption status of this file is
  6732. different from the previous file(s) in the chunk }
  6733. if not UseSolidCompression or
  6734. (floSolidBreak in FLExtraInfo.Flags) or
  6735. (ChunkCompressed <> (floChunkCompressed in FL.Flags)) or
  6736. (CH.ChunkEncrypted <> (floChunkEncrypted in FL.Flags)) then
  6737. FinalizeChunk(CH, I-1);
  6738. end;
  6739. { Start a new chunk if needed }
  6740. if not CH.ChunkStarted then begin
  6741. ChunkCompressed := (floChunkCompressed in FL.Flags);
  6742. CH.NewChunk(GetCompressorClass(ChunkCompressed), CompressLevel,
  6743. CompressProps, floChunkEncrypted in FL.Flags, CryptKey);
  6744. end;
  6745. FL.FirstSlice := CH.ChunkFirstSlice;
  6746. FL.StartOffset := CH.ChunkStartOffset;
  6747. FL.ChunkSuboffset := CH.ChunkBytesRead;
  6748. FL.OriginalSize := SourceFile.Size;
  6749. if not GetFileTime(SourceFile.Handle, nil, nil, @FT) then begin
  6750. ErrorCode := GetLastError;
  6751. AbortCompileFmt(SCompilerFunctionFailedWithCode,
  6752. ['CompressFiles: GetFileTime', ErrorCode, Win32ErrorString(ErrorCode)]);
  6753. end;
  6754. if TimeStampsInUTC then begin
  6755. FL.SourceTimeStamp := FT;
  6756. Include(FL.Flags, floTimeStampInUTC);
  6757. end
  6758. else
  6759. FileTimeToLocalFileTime(FT, FL.SourceTimeStamp);
  6760. if floApplyTouchDateTime in FLExtraInfo.Flags then
  6761. ApplyTouchDateTime(FL.SourceTimeStamp);
  6762. if TimeStampRounding > 0 then
  6763. Dec64(Integer64(FL.SourceTimeStamp), Mod64(Integer64(FL.SourceTimeStamp), TimeStampRounding * 10000000));
  6764. if ChunkCompressed and IsX86OrX64Executable(SourceFile) then
  6765. Include(FL.Flags, floCallInstructionOptimized);
  6766. CH.CompressFile(SourceFile, FL.OriginalSize,
  6767. floCallInstructionOptimized in FL.Flags, FL.SHA256Sum);
  6768. if FLExtraInfo.Verification.Typ <> fvNone then begin
  6769. if not SHA256DigestsEqual(FL.SHA256Sum, ExpectedFileHash) then
  6770. VerificationError(veFileHashIncorrect, FileLocationEntryFilenames[I]);
  6771. AddStatus(SCompilerStatusVerified);
  6772. end;
  6773. finally
  6774. SourceFile.Free;
  6775. end;
  6776. end;
  6777. { Finalize the last chunk }
  6778. FinalizeChunk(CH, FileLocationEntries.Count-1);
  6779. CH.Finish;
  6780. finally
  6781. CompressionInProgress := False;
  6782. for I := 0 to Length(ISSigAvailableKeys)-1 do
  6783. ISSigAvailableKeys[I].Free;
  6784. CH.Free;
  6785. end;
  6786. { Ensure progress bar is full, in case a file shrunk in size }
  6787. BytesCompressedSoFar := TotalBytesToCompress;
  6788. CallIdleProc;
  6789. end;
  6790. procedure CopyFileOrAbort(const SourceFile, DestFile: String;
  6791. const CheckTrust: Boolean; const CheckFileTrustOptions: TCheckFileTrustOptions;
  6792. const OnCheckedTrust: TProc<Boolean>);
  6793. var
  6794. ErrorCode: DWORD;
  6795. begin
  6796. if CheckTrust then begin
  6797. try
  6798. CheckFileTrust(SourceFile, CheckFileTrustOptions);
  6799. except
  6800. const Msg = Format(SCompilerCopyError3a, [SourceFile, DestFile,
  6801. GetExceptMessage]);
  6802. AbortCompileFmt(SCompilerCheckPrecompiledFileTrustError, [Msg]);
  6803. end;
  6804. end;
  6805. if Assigned(OnCheckedTrust) then
  6806. OnCheckedTrust(CheckTrust);
  6807. if not CopyFile(PChar(SourceFile), PChar(DestFile), False) then begin
  6808. ErrorCode := GetLastError;
  6809. AbortCompileFmt(SCompilerCopyError3b, [SourceFile, DestFile,
  6810. ErrorCode, Win32ErrorString(ErrorCode)]);
  6811. end;
  6812. end;
  6813. function InternalSignSetupE32(const Filename: String;
  6814. var UnsignedFile: TMemoryFile; const UnsignedFileSize: Cardinal;
  6815. const MismatchMessage: String): Boolean;
  6816. var
  6817. SignedFile, TestFile, OldFile: TMemoryFile;
  6818. SignedFileSize: Cardinal;
  6819. SignatureAddress, SignatureSize: Cardinal;
  6820. HdrChecksum: DWORD;
  6821. begin
  6822. SignedFile := TMemoryFile.Create(Filename);
  6823. try
  6824. SignedFileSize := SignedFile.CappedSize;
  6825. { Check the file for a signature }
  6826. if not ReadSignatureAndChecksumFields(SignedFile, DWORD(SignatureAddress),
  6827. DWORD(SignatureSize), HdrChecksum) then
  6828. AbortCompile('ReadSignatureAndChecksumFields failed');
  6829. if SignatureAddress = 0 then begin
  6830. { No signature found. Return False to inform the caller that the file
  6831. needs to be signed, but first make sure it isn't somehow corrupted. }
  6832. if (SignedFileSize = UnsignedFileSize) and
  6833. CompareMem(UnsignedFile.Memory, SignedFile.Memory, UnsignedFileSize) then begin
  6834. Result := False;
  6835. Exit;
  6836. end;
  6837. AbortCompileFmt(MismatchMessage, [Filename]);
  6838. end;
  6839. if (SignedFileSize <= UnsignedFileSize) or
  6840. (SignatureAddress <> UnsignedFileSize) or
  6841. (SignatureSize <> SignedFileSize - UnsignedFileSize) or
  6842. (SignatureSize >= Cardinal($100000)) then
  6843. AbortCompile(SCompilerSignatureInvalid);
  6844. { Sanity check: Remove the signature (in memory) and verify that
  6845. the signed file is identical byte-for-byte to the original }
  6846. TestFile := TMemoryFile.CreateFromMemory(SignedFile.Memory^, SignedFileSize);
  6847. try
  6848. { Carry checksum over from UnsignedFile to TestFile. We used to just
  6849. zero it in TestFile, but that didn't work if the user modified
  6850. Setup.e32 with a res-editing tool that sets a non-zero checksum. }
  6851. if not ReadSignatureAndChecksumFields(UnsignedFile, DWORD(SignatureAddress),
  6852. DWORD(SignatureSize), HdrChecksum) then
  6853. AbortCompile('ReadSignatureAndChecksumFields failed (2)');
  6854. if not UpdateSignatureAndChecksumFields(TestFile, 0, 0, HdrChecksum) then
  6855. AbortCompile('UpdateSignatureAndChecksumFields failed');
  6856. if not CompareMem(UnsignedFile.Memory, TestFile.Memory, UnsignedFileSize) then
  6857. AbortCompileFmt(MismatchMessage, [Filename]);
  6858. finally
  6859. TestFile.Free;
  6860. end;
  6861. except
  6862. SignedFile.Free;
  6863. raise;
  6864. end;
  6865. { Replace UnsignedFile with the signed file }
  6866. OldFile := UnsignedFile;
  6867. UnsignedFile := SignedFile;
  6868. OldFile.Free;
  6869. Result := True;
  6870. end;
  6871. procedure SignSetupE32(var UnsignedFile: TMemoryFile);
  6872. var
  6873. UnsignedFileSize: Cardinal;
  6874. ModeID: Longint;
  6875. Filename, TempFilename: String;
  6876. F: TFile;
  6877. LastError: DWORD;
  6878. begin
  6879. UnsignedFileSize := UnsignedFile.CappedSize;
  6880. UnsignedFile.Seek(SetupExeModeOffset);
  6881. ModeID := SetupExeModeUninstaller;
  6882. UnsignedFile.WriteBuffer(ModeID, SizeOf(ModeID));
  6883. if SignTools.Count > 0 then begin
  6884. Filename := SignedUninstallerDir + 'uninst.e32.tmp';
  6885. F := TFile.Create(Filename, fdCreateAlways, faWrite, fsNone);
  6886. try
  6887. F.WriteBuffer(UnsignedFile.Memory^, UnsignedFileSize);
  6888. finally
  6889. F.Free;
  6890. end;
  6891. try
  6892. Sign(Filename);
  6893. if not InternalSignSetupE32(Filename, UnsignedFile, UnsignedFileSize,
  6894. SCompilerSignedFileContentsMismatch) then
  6895. AbortCompile(SCompilerSignToolSucceededButNoSignature);
  6896. finally
  6897. DeleteFile(Filename);
  6898. end;
  6899. end else begin
  6900. Filename := SignedUninstallerDir + Format('uninst-%s-%s.e32', [SetupVersion,
  6901. Copy(SHA256DigestToString(SHA256Buf(UnsignedFile.Memory^, UnsignedFileSize)), 1, 10)]);
  6902. if not NewFileExists(Filename) then begin
  6903. { Create new signed uninstaller file }
  6904. AddStatus(Format(SCompilerStatusSignedUninstallerNew, [Filename]));
  6905. TempFilename := Filename + '.tmp';
  6906. F := TFile.Create(TempFilename, fdCreateAlways, faWrite, fsNone);
  6907. try
  6908. F.WriteBuffer(UnsignedFile.Memory^, UnsignedFileSize);
  6909. finally
  6910. F.Free;
  6911. end;
  6912. if not MoveFile(PChar(TempFilename), PChar(Filename)) then begin
  6913. LastError := GetLastError;
  6914. DeleteFile(TempFilename);
  6915. TFile.RaiseError(LastError);
  6916. end;
  6917. end
  6918. else begin
  6919. { Use existing signed uninstaller file }
  6920. AddStatus(Format(SCompilerStatusSignedUninstallerExisting, [Filename]));
  6921. end;
  6922. if not InternalSignSetupE32(Filename, UnsignedFile, UnsignedFileSize,
  6923. SCompilerSignedFileContentsMismatchRetry) then
  6924. AbortCompileFmt(SCompilerSignatureNeeded, [Filename]);
  6925. end;
  6926. end;
  6927. procedure PrepareSetupE32(var M: TMemoryFile);
  6928. var
  6929. TempFilename, E32Filename, ConvertFilename: String;
  6930. ConvertFile: TFile;
  6931. begin
  6932. TempFilename := '';
  6933. try
  6934. E32Filename := CompilerDir + 'Setup.e32';
  6935. { make a copy and update icons, version info and if needed manifest }
  6936. ConvertFilename := OutputDir + OutputBaseFilename + '.e32.tmp';
  6937. CopyFileOrAbort(E32Filename, ConvertFilename, not(pfSetupE32 in DisablePrecompiledFileVerifications),
  6938. [cftoTrustAllOnDebug], OnCheckedTrust);
  6939. SetFileAttributes(PChar(ConvertFilename), FILE_ATTRIBUTE_ARCHIVE);
  6940. TempFilename := ConvertFilename;
  6941. if SetupIconFilename <> '' then begin
  6942. AddStatus(Format(SCompilerStatusUpdatingIcons, ['Setup.e32']));
  6943. LineNumber := SetupDirectiveLines[ssSetupIconFile];
  6944. { This also deletes the UninstallImage resource. Removing it makes UninstallProgressForm use the custom icon instead. }
  6945. UpdateIcons(ConvertFileName, PrependSourceDirName(SetupIconFilename), True);
  6946. LineNumber := 0;
  6947. end;
  6948. AddStatus(Format(SCompilerStatusUpdatingVersionInfo, ['Setup.e32']));
  6949. ConvertFile := TFile.Create(ConvertFilename, fdOpenExisting, faReadWrite, fsNone);
  6950. try
  6951. UpdateVersionInfo(ConvertFile, TFileVersionNumbers(nil^), VersionInfoProductVersion, VersionInfoCompany,
  6952. '', '', VersionInfoCopyright, VersionInfoProductName, VersionInfoProductTextVersion, VersionInfoOriginalFileName,
  6953. False);
  6954. finally
  6955. ConvertFile.Free;
  6956. end;
  6957. M := TMemoryFile.Create(ConvertFilename);
  6958. UpdateSetupPEHeaderFields(M, TerminalServicesAware, DEPCompatible, ASLRCompatible);
  6959. if shSignedUninstaller in SetupHeader.Options then
  6960. SignSetupE32(M);
  6961. finally
  6962. if TempFilename <> '' then
  6963. DeleteFile(TempFilename);
  6964. end;
  6965. end;
  6966. procedure CompressSetupE32(const M: TMemoryFile; const DestF: TFile;
  6967. var UncompressedSize: LongWord; var CRC: Longint);
  6968. { Note: This modifies the contents of M. }
  6969. var
  6970. Writer: TCompressedBlockWriter;
  6971. begin
  6972. AddStatus(SCompilerStatusCompressingSetupExe);
  6973. UncompressedSize := M.CappedSize;
  6974. CRC := GetCRC32(M.Memory^, UncompressedSize);
  6975. TransformCallInstructions(M.Memory^, UncompressedSize, True, 0);
  6976. Writer := TCompressedBlockWriter.Create(DestF, TLZMACompressor, InternalCompressLevel,
  6977. InternalCompressProps);
  6978. try
  6979. Writer.Write(M.Memory^, UncompressedSize);
  6980. Writer.Finish;
  6981. finally
  6982. Writer.Free;
  6983. end;
  6984. end;
  6985. procedure AddDefaultSetupType(Name: String; Options: TSetupTypeOptions; Typ: TSetupTypeType);
  6986. var
  6987. NewTypeEntry: PSetupTypeEntry;
  6988. begin
  6989. NewTypeEntry := AllocMem(SizeOf(TSetupTypeEntry));
  6990. NewTypeEntry.Name := Name;
  6991. NewTypeEntry.Description := ''; //set at runtime
  6992. NewTypeEntry.CheckOnce := '';
  6993. NewTypeEntry.MinVersion := SetupHeader.MinVersion;
  6994. NewTypeEntry.OnlyBelowVersion := SetupHeader.OnlyBelowVersion;
  6995. NewTypeEntry.Options := Options;
  6996. NewTypeEntry.Typ := Typ;
  6997. TypeEntries.Add(NewTypeEntry);
  6998. end;
  6999. procedure MkDirs(Dir: string);
  7000. begin
  7001. Dir := RemoveBackslashUnlessRoot(Dir);
  7002. if (PathExtractPath(Dir) = Dir) or DirExists(Dir) then
  7003. Exit;
  7004. MkDirs(PathExtractPath(Dir));
  7005. MkDir(Dir);
  7006. end;
  7007. procedure CreateManifestFile;
  7008. function FileTimeToString(const FileTime: TFileTime; const UTC: Boolean): String;
  7009. var
  7010. ST: TSystemTime;
  7011. begin
  7012. if FileTimeToSystemTime(FileTime, ST) then
  7013. Result := Format('%.4u-%.2u-%.2u %.2u:%.2u:%.2u.%.3u',
  7014. [ST.wYear, ST.wMonth, ST.wDay, ST.wHour, ST.wMinute, ST.wSecond,
  7015. ST.wMilliseconds])
  7016. else
  7017. Result := '(invalid)';
  7018. if UTC then
  7019. Result := Result + ' UTC';
  7020. end;
  7021. function SliceToString(const ASlice: Integer): String;
  7022. begin
  7023. Result := IntToStr(ASlice div SlicesPerDisk + 1);
  7024. if SlicesPerDisk <> 1 then
  7025. Result := Result + Chr(Ord('a') + ASlice mod SlicesPerDisk);
  7026. end;
  7027. const
  7028. EncryptedStrings: array [Boolean] of String = ('no', 'yes');
  7029. var
  7030. F: TTextFileWriter;
  7031. FL: PSetupFileLocationEntry;
  7032. FLExtraInfo: PFileLocationEntryExtraInfo;
  7033. S: String;
  7034. I: Integer;
  7035. begin
  7036. F := TTextFileWriter.Create(PrependDirName(OutputManifestFile, OutputDir),
  7037. fdCreateAlways, faWrite, fsRead);
  7038. try
  7039. S := 'Index' + #9 + 'SourceFilename' + #9 + 'TimeStamp' + #9 +
  7040. 'Version' + #9 + 'SHA256Sum' + #9 + 'OriginalSize' + #9 +
  7041. 'FirstSlice' + #9 + 'LastSlice' + #9 + 'StartOffset' + #9 +
  7042. 'ChunkSuboffset' + #9 + 'ChunkCompressedSize' + #9 + 'Encrypted' + #9 +
  7043. 'ISSigKeyID';
  7044. F.WriteLine(S);
  7045. for I := 0 to FileLocationEntries.Count-1 do begin
  7046. FL := FileLocationEntries[I];
  7047. FLExtraInfo := FileLocationEntryExtraInfos[I];
  7048. S := IntToStr(I) + #9 + FileLocationEntryFilenames[I] + #9 +
  7049. FileTimeToString(FL.SourceTimeStamp, floTimeStampInUTC in FL.Flags) + #9;
  7050. if floVersionInfoValid in FL.Flags then
  7051. S := S + Format('%u.%u.%u.%u', [FL.FileVersionMS shr 16,
  7052. FL.FileVersionMS and $FFFF, FL.FileVersionLS shr 16,
  7053. FL.FileVersionLS and $FFFF]);
  7054. S := S + #9 + SHA256DigestToString(FL.SHA256Sum) + #9 +
  7055. Integer64ToStr(FL.OriginalSize) + #9 +
  7056. SliceToString(FL.FirstSlice) + #9 +
  7057. SliceToString(FL.LastSlice) + #9 +
  7058. IntToStr(FL.StartOffset) + #9 +
  7059. Integer64ToStr(FL.ChunkSuboffset) + #9 +
  7060. Integer64ToStr(FL.ChunkCompressedSize) + #9 +
  7061. EncryptedStrings[floChunkEncrypted in FL.Flags] + #9 +
  7062. FLExtraInfo.ISSigKeyUsedID;
  7063. F.WriteLine(S);
  7064. end;
  7065. finally
  7066. F.Free;
  7067. end;
  7068. end;
  7069. procedure CallPreprocessorCleanupProc;
  7070. var
  7071. ResultCode: Integer;
  7072. begin
  7073. if Assigned(PreprocCleanupProc) then begin
  7074. ResultCode := PreprocCleanupProc(PreprocCleanupProcData);
  7075. if ResultCode <> 0 then
  7076. AddStatusFmt(SCompilerStatusWarning +
  7077. 'Preprocessor cleanup function failed with code %d.', [ResultCode], True);
  7078. end;
  7079. end;
  7080. procedure UpdateTimeStamp(H: THandle);
  7081. var
  7082. FT: TFileTime;
  7083. begin
  7084. GetSystemTimeAsFileTime(FT);
  7085. SetFileTime(H, nil, nil, @FT);
  7086. end;
  7087. const
  7088. BadFilePathChars = '/*?"<>|';
  7089. BadFileNameChars = BadFilePathChars + ':';
  7090. var
  7091. SetupE32: TMemoryFile;
  7092. I: Integer;
  7093. AppNameHasConsts, AppVersionHasConsts, AppPublisherHasConsts,
  7094. AppCopyrightHasConsts, AppIdHasConsts, Uninstallable: Boolean;
  7095. PrivilegesRequiredValue: String;
  7096. GetActiveProcessorGroupCountFunc: function: WORD; stdcall;
  7097. begin
  7098. { Sanity check: A single TSetupCompiler instance cannot be used to do
  7099. multiple compiles. A separate instance must be used for each compile,
  7100. otherwise some settings (e.g. DefaultLangData, VersionInfo*) would be
  7101. carried over from one compile to another. }
  7102. if CompileWasAlreadyCalled then
  7103. AbortCompile('Compile was already called');
  7104. CompileWasAlreadyCalled := True;
  7105. CompilerDir := AddBackslash(PathExpand(CompilerDir));
  7106. InitPreprocessor;
  7107. InitLZMADLL;
  7108. WizardImages := nil;
  7109. WizardSmallImages := nil;
  7110. SetupE32 := nil;
  7111. DecompressorDLL := nil;
  7112. SevenZipDLL := nil;
  7113. try
  7114. FillChar(SetupEncryptionHeader, SizeOf(SetupEncryptionHeader), 0);
  7115. Finalize(SetupHeader);
  7116. FillChar(SetupHeader, SizeOf(SetupHeader), 0);
  7117. InitDebugInfo;
  7118. PreprocIncludedFilenames.Clear;
  7119. { Initialize defaults }
  7120. OriginalSourceDir := AddBackslash(PathExpand(SourceDir));
  7121. if not FixedOutput then
  7122. Output := True;
  7123. if not FixedOutputDir then
  7124. OutputDir := 'Output';
  7125. if not FixedOutputBaseFilename then
  7126. OutputBaseFilename := 'mysetup';
  7127. InternalCompressLevel := clLZMANormal;
  7128. InternalCompressProps := TLZMACompressorProps.Create;
  7129. CompressMethod := cmLZMA2;
  7130. CompressLevel := clLZMAMax;
  7131. CompressProps := TLZMACompressorProps.Create;
  7132. GetActiveProcessorGroupCountFunc := GetProcAddress(GetModuleHandle(kernel32),
  7133. 'GetActiveProcessorGroupCount');
  7134. if Assigned(GetActiveProcessorGroupCountFunc) then begin
  7135. const ActiveProcessorGroupCount = GetActiveProcessorGroupCountFunc;
  7136. if ActiveProcessorGroupCount > 1 then
  7137. CompressProps.NumThreadGroups := ActiveProcessorGroupCount;
  7138. end;
  7139. CompressProps.WorkerProcessCheckTrust := True;
  7140. CompressProps.WorkerProcessOnCheckedTrust := OnCheckedTrust;
  7141. UseSetupLdr := True;
  7142. TerminalServicesAware := True;
  7143. DEPCompatible := True;
  7144. ASLRCompatible := True;
  7145. DiskSliceSize := MaxDiskSliceSize;
  7146. DiskClusterSize := 512;
  7147. SlicesPerDisk := 1;
  7148. ReserveBytes := 0;
  7149. TimeStampRounding := 2;
  7150. SetupEncryptionHeader.EncryptionUse := euNone;
  7151. SetupEncryptionHeader.KDFIterations := DefaultKDFIterations;
  7152. SetupHeader.MinVersion.WinVersion := 0;
  7153. SetupHeader.MinVersion.NTVersion := $06010000;
  7154. SetupHeader.MinVersion.NTServicePack := $100;
  7155. SetupHeader.Options := [shDisableStartupPrompt, shCreateAppDir,
  7156. shUsePreviousAppDir, shUsePreviousGroup,
  7157. shUsePreviousSetupType, shAlwaysShowComponentsList, shFlatComponentsList,
  7158. shShowComponentSizes, shUsePreviousTasks, shUpdateUninstallLogAppName,
  7159. shAllowUNCPath, shUsePreviousUserInfo, shRestartIfNeededByRun,
  7160. shAllowCancelDuringInstall, shWizardImageStretch, shAppendDefaultDirName,
  7161. shAppendDefaultGroupName, shUsePreviousLanguage, shCloseApplications,
  7162. shRestartApplications, shAllowNetworkDrive, shDisableWelcomePage,
  7163. shUsePreviousPrivileges];
  7164. SetupHeader.PrivilegesRequired := prAdmin;
  7165. SetupHeader.UninstallFilesDir := '{app}';
  7166. SetupHeader.DefaultUserInfoName := '{sysuserinfoname}';
  7167. SetupHeader.DefaultUserInfoOrg := '{sysuserinfoorg}';
  7168. SetupHeader.DisableDirPage := dpAuto;
  7169. SetupHeader.DisableProgramGroupPage := dpAuto;
  7170. SetupHeader.CreateUninstallRegKey := 'yes';
  7171. SetupHeader.Uninstallable := 'yes';
  7172. SetupHeader.ChangesEnvironment := 'no';
  7173. SetupHeader.ChangesAssociations := 'no';
  7174. DefaultDialogFontName := 'Tahoma';
  7175. SignToolRetryCount := 2;
  7176. SignToolRetryDelay := 500;
  7177. SetupHeader.CloseApplicationsFilter := '*.exe,*.dll,*.chm';
  7178. SetupHeader.WizardImageAlphaFormat := afIgnored;
  7179. MissingRunOnceIdsWarning := True;
  7180. MissingMessagesWarning := True;
  7181. NotRecognizedMessagesWarning := True;
  7182. UsedUserAreasWarning := True;
  7183. SetupHeader.WizardStyle := wsClassic;
  7184. { Read [Setup] section }
  7185. EnumIniSection(EnumSetupProc, 'Setup', 0, True, True, '', False, False);
  7186. CallIdleProc;
  7187. { Verify settings set in [Setup] section }
  7188. if SetupDirectiveLines[ssAppName] = 0 then
  7189. AbortCompileFmt(SCompilerEntryMissing2, ['Setup', 'AppName']);
  7190. if (SetupHeader.AppVerName = '') and (SetupHeader.AppVersion = '') then
  7191. AbortCompile(SCompilerAppVersionOrAppVerNameRequired);
  7192. LineNumber := SetupDirectiveLines[ssAppName];
  7193. AppNameHasConsts := CheckConst(SetupHeader.AppName, SetupHeader.MinVersion, []);
  7194. if AppNameHasConsts then begin
  7195. Include(SetupHeader.Options, shAppNameHasConsts);
  7196. if not(shDisableStartupPrompt in SetupHeader.Options) then begin
  7197. { AppName has constants so DisableStartupPrompt must be used }
  7198. LineNumber := SetupDirectiveLines[ssDisableStartupPrompt];
  7199. AbortCompile(SCompilerMustUseDisableStartupPrompt);
  7200. end;
  7201. end;
  7202. if SetupHeader.AppId = '' then
  7203. SetupHeader.AppId := SetupHeader.AppName
  7204. else
  7205. LineNumber := SetupDirectiveLines[ssAppId];
  7206. AppIdHasConsts := CheckConst(SetupHeader.AppId, SetupHeader.MinVersion, []);
  7207. if AppIdHasConsts and (shUsePreviousLanguage in SetupHeader.Options) then begin
  7208. { AppId has constants so UsePreviousLanguage must not be used }
  7209. LineNumber := SetupDirectiveLines[ssUsePreviousLanguage];
  7210. AbortCompile(SCompilerMustNotUsePreviousLanguage);
  7211. end;
  7212. if AppIdHasConsts and (proDialog in SetupHeader.PrivilegesRequiredOverridesAllowed) and (shUsePreviousPrivileges in SetupHeader.Options) then begin
  7213. { AppId has constants so UsePreviousPrivileges must not be used }
  7214. LineNumber := SetupDirectiveLines[ssUsePreviousPrivileges];
  7215. AbortCompile(SCompilerMustNotUsePreviousPrivileges);
  7216. end;
  7217. LineNumber := SetupDirectiveLines[ssAppVerName];
  7218. CheckConst(SetupHeader.AppVerName, SetupHeader.MinVersion, []);
  7219. LineNumber := SetupDirectiveLines[ssAppComments];
  7220. CheckConst(SetupHeader.AppComments, SetupHeader.MinVersion, []);
  7221. LineNumber := SetupDirectiveLines[ssAppContact];
  7222. CheckConst(SetupHeader.AppContact, SetupHeader.MinVersion, []);
  7223. LineNumber := SetupDirectiveLines[ssAppCopyright];
  7224. AppCopyrightHasConsts := CheckConst(SetupHeader.AppCopyright, SetupHeader.MinVersion, []);
  7225. LineNumber := SetupDirectiveLines[ssAppModifyPath];
  7226. CheckConst(SetupHeader.AppModifyPath, SetupHeader.MinVersion, []);
  7227. LineNumber := SetupDirectiveLines[ssAppPublisher];
  7228. AppPublisherHasConsts := CheckConst(SetupHeader.AppPublisher, SetupHeader.MinVersion, []);
  7229. LineNumber := SetupDirectiveLines[ssAppPublisherURL];
  7230. CheckConst(SetupHeader.AppPublisherURL, SetupHeader.MinVersion, []);
  7231. LineNumber := SetupDirectiveLines[ssAppReadmeFile];
  7232. CheckConst(SetupHeader.AppReadmeFile, SetupHeader.MinVersion, []);
  7233. LineNumber := SetupDirectiveLines[ssAppSupportPhone];
  7234. CheckConst(SetupHeader.AppSupportPhone, SetupHeader.MinVersion, []);
  7235. LineNumber := SetupDirectiveLines[ssAppSupportURL];
  7236. CheckConst(SetupHeader.AppSupportURL, SetupHeader.MinVersion, []);
  7237. LineNumber := SetupDirectiveLines[ssAppUpdatesURL];
  7238. CheckConst(SetupHeader.AppUpdatesURL, SetupHeader.MinVersion, []);
  7239. LineNumber := SetupDirectiveLines[ssAppVersion];
  7240. AppVersionHasConsts := CheckConst(SetupHeader.AppVersion, SetupHeader.MinVersion, []);
  7241. LineNumber := SetupDirectiveLines[ssAppMutex];
  7242. CheckConst(SetupHeader.AppMutex, SetupHeader.MinVersion, []);
  7243. LineNumber := SetupDirectiveLines[ssSetupMutex];
  7244. CheckConst(SetupHeader.SetupMutex, SetupHeader.MinVersion, []);
  7245. LineNumber := SetupDirectiveLines[ssDefaultDirName];
  7246. CheckConst(SetupHeader.DefaultDirName, SetupHeader.MinVersion, []);
  7247. if SetupHeader.DefaultDirName = '' then begin
  7248. if shCreateAppDir in SetupHeader.Options then
  7249. AbortCompileFmt(SCompilerEntryMissing2, ['Setup', 'DefaultDirName'])
  7250. else
  7251. SetupHeader.DefaultDirName := '?ERROR?';
  7252. end;
  7253. LineNumber := SetupDirectiveLines[ssDefaultGroupName];
  7254. CheckConst(SetupHeader.DefaultGroupName, SetupHeader.MinVersion, []);
  7255. if SetupHeader.DefaultGroupName = '' then
  7256. SetupHeader.DefaultGroupName := '(Default)';
  7257. LineNumber := SetupDirectiveLines[ssUninstallDisplayName];
  7258. CheckConst(SetupHeader.UninstallDisplayName, SetupHeader.MinVersion, []);
  7259. LineNumber := SetupDirectiveLines[ssUninstallDisplayIcon];
  7260. CheckConst(SetupHeader.UninstallDisplayIcon, SetupHeader.MinVersion, []);
  7261. LineNumber := SetupDirectiveLines[ssUninstallFilesDir];
  7262. CheckConst(SetupHeader.UninstallFilesDir, SetupHeader.MinVersion, []);
  7263. LineNumber := SetupDirectiveLines[ssDefaultUserInfoName];
  7264. CheckConst(SetupHeader.DefaultUserInfoName, SetupHeader.MinVersion, []);
  7265. LineNumber := SetupDirectiveLines[ssDefaultUserInfoOrg];
  7266. CheckConst(SetupHeader.DefaultUserInfoOrg, SetupHeader.MinVersion, []);
  7267. LineNumber := SetupDirectiveLines[ssDefaultUserInfoSerial];
  7268. CheckConst(SetupHeader.DefaultUserInfoSerial, SetupHeader.MinVersion, []);
  7269. if not DiskSpanning then begin
  7270. DiskSliceSize := MaxDiskSliceSize;
  7271. DiskClusterSize := 1;
  7272. SlicesPerDisk := 1;
  7273. ReserveBytes := 0;
  7274. end;
  7275. SetupHeader.SlicesPerDisk := SlicesPerDisk;
  7276. if SetupDirectiveLines[ssVersionInfoDescription] = 0 then begin
  7277. { Use AppName as VersionInfoDescription if possible. If not possible,
  7278. warn about this since AppName is a required directive }
  7279. if not AppNameHasConsts then
  7280. VersionInfoDescription := UnescapeBraces(SetupHeader.AppName) + ' Setup'
  7281. else
  7282. WarningsList.Add(Format(SCompilerDirectiveNotUsingDefault,
  7283. ['VersionInfoDescription', 'AppName']));
  7284. end;
  7285. if SetupDirectiveLines[ssVersionInfoCompany] = 0 then begin
  7286. { Use AppPublisher as VersionInfoCompany if possible, otherwise warn }
  7287. if not AppPublisherHasConsts then
  7288. VersionInfoCompany := UnescapeBraces(SetupHeader.AppPublisher)
  7289. else
  7290. WarningsList.Add(Format(SCompilerDirectiveNotUsingDefault,
  7291. ['VersionInfoCompany', 'AppPublisher']));
  7292. end;
  7293. if SetupDirectiveLines[ssVersionInfoCopyright] = 0 then begin
  7294. { Use AppCopyright as VersionInfoCopyright if possible, otherwise warn }
  7295. if not AppCopyrightHasConsts then
  7296. VersionInfoCopyright := UnescapeBraces(SetupHeader.AppCopyright)
  7297. else
  7298. WarningsList.Add(Format(SCompilerDirectiveNotUsingDefault,
  7299. ['VersionInfoCopyright', 'AppCopyright']));
  7300. end;
  7301. if SetupDirectiveLines[ssVersionInfoTextVersion] = 0 then
  7302. VersionInfoTextVersion := VersionInfoVersionOriginalValue;
  7303. if SetupDirectiveLines[ssVersionInfoProductName] = 0 then begin
  7304. { Use AppName as VersionInfoProductName if possible, otherwise warn }
  7305. if not AppNameHasConsts then
  7306. VersionInfoProductName := UnescapeBraces(SetupHeader.AppName)
  7307. else
  7308. WarningsList.Add(Format(SCompilerDirectiveNotUsingDefault,
  7309. ['VersionInfoProductName', 'AppName']));
  7310. end;
  7311. if VersionInfoProductVersionOriginalValue = '' then
  7312. VersionInfoProductVersion := VersionInfoVersion;
  7313. if SetupDirectiveLines[ssVersionInfoProductTextVersion] = 0 then begin
  7314. { Note: This depends on the initialization of VersionInfoTextVersion above }
  7315. if VersionInfoProductVersionOriginalValue = '' then begin
  7316. VersionInfoProductTextVersion := VersionInfoTextVersion;
  7317. if SetupHeader.AppVersion <> '' then begin
  7318. if not AppVersionHasConsts then
  7319. VersionInfoProductTextVersion := UnescapeBraces(SetupHeader.AppVersion)
  7320. else
  7321. WarningsList.Add(Format(SCompilerDirectiveNotUsingPreferredDefault,
  7322. ['VersionInfoProductTextVersion', 'VersionInfoTextVersion', 'AppVersion']));
  7323. end;
  7324. end
  7325. else
  7326. VersionInfoProductTextVersion := VersionInfoProductVersionOriginalValue;
  7327. end;
  7328. if (SetupEncryptionHeader.EncryptionUse <> euNone) and (Password = '') then begin
  7329. LineNumber := SetupDirectiveLines[ssEncryption];
  7330. AbortCompileFmt(SCompilerEntryMissing2, ['Setup', 'Password']);
  7331. end;
  7332. if (SetupDirectiveLines[ssSignedUninstaller] = 0) and (SignTools.Count > 0) then
  7333. Include(SetupHeader.Options, shSignedUninstaller);
  7334. if not UseSetupLdr and
  7335. ((SignTools.Count > 0) or (shSignedUninstaller in SetupHeader.Options)) then
  7336. AbortCompile(SCompilerNoSetupLdrSignError);
  7337. LineNumber := SetupDirectiveLines[ssCreateUninstallRegKey];
  7338. CheckCheckOrInstall('CreateUninstallRegKey', SetupHeader.CreateUninstallRegKey, cikDirectiveCheck);
  7339. LineNumber := SetupDirectiveLines[ssUninstallable];
  7340. CheckCheckOrInstall('Uninstallable', SetupHeader.Uninstallable, cikDirectiveCheck);
  7341. LineNumber := SetupDirectiveLines[ssChangesEnvironment];
  7342. CheckCheckOrInstall('ChangesEnvironment', SetupHeader.ChangesEnvironment, cikDirectiveCheck);
  7343. LineNumber := SetupDirectiveLines[ssChangesAssociations];
  7344. CheckCheckOrInstall('ChangesAssociations', SetupHeader.ChangesAssociations, cikDirectiveCheck);
  7345. if Output and (OutputDir = '') then begin
  7346. LineNumber := SetupDirectiveLines[ssOutput];
  7347. AbortCompileFmt(SCompilerEntryInvalid2, ['Setup', 'OutputDir']);
  7348. end;
  7349. if (Output and (OutputBaseFileName = '')) or (PathLastDelimiter(BadFileNameChars + '\', OutputBaseFileName) <> 0) then begin
  7350. LineNumber := SetupDirectiveLines[ssOutputBaseFileName];
  7351. AbortCompileFmt(SCompilerEntryInvalid2, ['Setup', 'OutputBaseFileName']);
  7352. end else if OutputBaseFileName = 'setup' then { Warn even if Output is False }
  7353. WarningsList.Add(SCompilerOutputBaseFileNameSetup);
  7354. if (SetupDirectiveLines[ssOutputManifestFile] <> 0) and
  7355. ((Output and (OutputManifestFile = '')) or (PathLastDelimiter(BadFilePathChars, OutputManifestFile) <> 0)) then begin
  7356. LineNumber := SetupDirectiveLines[ssOutputManifestFile];
  7357. AbortCompileFmt(SCompilerEntryInvalid2, ['Setup', 'OutputManifestFile']);
  7358. end;
  7359. if shAlwaysUsePersonalGroup in SetupHeader.Options then
  7360. UsedUserAreas.Add('AlwaysUsePersonalGroup');
  7361. if SetupDirectiveLines[ssWizardSizePercent] = 0 then begin
  7362. if SetupHeader.WizardStyle = wsModern then
  7363. SetupHeader.WizardSizePercentX := 120
  7364. else
  7365. SetupHeader.WizardSizePercentX := 100;
  7366. SetupHeader.WizardSizePercentY := SetupHeader.WizardSizePercentX;
  7367. end;
  7368. if (SetupDirectiveLines[ssWizardResizable] = 0) and (SetupHeader.WizardStyle = wsModern) then
  7369. Include(SetupHeader.Options, shWizardResizable);
  7370. if (SetupHeader.MinVersion.NTVersion shr 16 = $0601) and (SetupHeader.MinVersion.NTServicePack < $100) then
  7371. WarningsList.Add(Format(SCompilerMinVersionRecommendation, ['6.1', '6.1sp1']));
  7372. LineNumber := 0;
  7373. SourceDir := AddBackslash(PathExpand(SourceDir));
  7374. if not FixedOutputDir then
  7375. OutputDir := PrependSourceDirName(OutputDir);
  7376. OutputDir := RemoveBackslashUnlessRoot(PathExpand(OutputDir));
  7377. LineNumber := SetupDirectiveLines[ssOutputDir];
  7378. if not DirExists(OutputDir) then begin
  7379. AddStatus(Format(SCompilerStatusCreatingOutputDir, [OutputDir]));
  7380. MkDirs(OutputDir);
  7381. end;
  7382. LineNumber := 0;
  7383. OutputDir := AddBackslash(OutputDir);
  7384. if SignedUninstallerDir = '' then
  7385. SignedUninstallerDir := OutputDir
  7386. else begin
  7387. SignedUninstallerDir := RemoveBackslashUnlessRoot(PathExpand(PrependSourceDirName(SignedUninstallerDir)));
  7388. if not DirExists(SignedUninstallerDir) then begin
  7389. AddStatus(Format(SCompilerStatusCreatingSignedUninstallerDir, [SignedUninstallerDir]));
  7390. MkDirs(SignedUninstallerDir);
  7391. end;
  7392. SignedUninstallerDir := AddBackslash(SignedUninstallerDir);
  7393. end;
  7394. if Password <> '' then begin
  7395. GenerateRandomBytes(SetupEncryptionHeader.KDFSalt, SizeOf(SetupEncryptionHeader.KDFSalt));
  7396. GenerateRandomBytes(SetupEncryptionHeader.BaseNonce, SizeOf(SetupEncryptionHeader.BaseNonce));
  7397. GenerateEncryptionKey(Password, SetupEncryptionHeader.KDFSalt, SetupEncryptionHeader.KDFIterations, CryptKey);
  7398. GeneratePasswordTest(CryptKey, SetupEncryptionHeader.BaseNonce, SetupEncryptionHeader.PasswordTest);
  7399. Include(SetupHeader.Options, shPassword);
  7400. end;
  7401. { Read text files }
  7402. if LicenseFile <> '' then begin
  7403. LineNumber := SetupDirectiveLines[ssLicenseFile];
  7404. AddStatus(Format(SCompilerStatusReadingFile, ['LicenseFile']));
  7405. ReadTextFile(PrependSourceDirName(LicenseFile), -1, LicenseText);
  7406. end;
  7407. if InfoBeforeFile <> '' then begin
  7408. LineNumber := SetupDirectiveLines[ssInfoBeforeFile];
  7409. AddStatus(Format(SCompilerStatusReadingFile, ['InfoBeforeFile']));
  7410. ReadTextFile(PrependSourceDirName(InfoBeforeFile), -1, InfoBeforeText);
  7411. end;
  7412. if InfoAfterFile <> '' then begin
  7413. LineNumber := SetupDirectiveLines[ssInfoAfterFile];
  7414. AddStatus(Format(SCompilerStatusReadingFile, ['InfoAfterFile']));
  7415. ReadTextFile(PrependSourceDirName(InfoAfterFile), -1, InfoAfterText);
  7416. end;
  7417. LineNumber := 0;
  7418. CallIdleProc;
  7419. { Read wizard image }
  7420. LineNumber := SetupDirectiveLines[ssWizardImageFile];
  7421. AddStatus(Format(SCompilerStatusReadingFile, ['WizardImageFile']));
  7422. if WizardImageFile <> '' then begin
  7423. if SameText(WizardImageFile, 'compiler:WizModernImage.bmp') then begin
  7424. WarningsList.Add(Format(SCompilerWizImageRenamed, [WizardImageFile, 'compiler:WizClassicImage.bmp']));
  7425. WizardImageFile := 'compiler:WizClassicImage.bmp';
  7426. end;
  7427. WizardImages := CreateMemoryStreamsFromFiles('WizardImageFile', WizardImageFile)
  7428. end else
  7429. WizardImages := CreateMemoryStreamsFromResources(['WizardImage'], ['150']);
  7430. LineNumber := SetupDirectiveLines[ssWizardSmallImageFile];
  7431. AddStatus(Format(SCompilerStatusReadingFile, ['WizardSmallImageFile']));
  7432. if WizardSmallImageFile <> '' then begin
  7433. if SameText(WizardSmallImageFile, 'compiler:WizModernSmallImage.bmp') then begin
  7434. WarningsList.Add(Format(SCompilerWizImageRenamed, [WizardSmallImageFile, 'compiler:WizClassicSmallImage.bmp']));
  7435. WizardSmallImageFile := 'compiler:WizClassicSmallImage.bmp';
  7436. end;
  7437. WizardSmallImages := CreateMemoryStreamsFromFiles('WizardSmallImage', WizardSmallImageFile)
  7438. end else
  7439. WizardSmallImages := CreateMemoryStreamsFromResources(['WizardSmallImage'], ['250']);
  7440. LineNumber := 0;
  7441. { Prepare Setup executable & signed uninstaller data }
  7442. if Output then begin
  7443. AddStatus(SCompilerStatusPreparingSetupExe);
  7444. PrepareSetupE32(SetupE32);
  7445. end else
  7446. AddStatus(SCompilerStatusSkippingPreparingSetupExe);
  7447. { Read languages:
  7448. 0. Determine final code pages:
  7449. Unicode Setup uses Unicode text and does not depend on the system code page. To
  7450. provide Setup with Unicode text without requiring Unicode .isl files (but still
  7451. supporting Unicode .iss, license and info files), the compiler converts the .isl
  7452. files to Unicode during compilation. It also does this if it finds ANSI plain text
  7453. license and info files. To be able to do this it needs to know the language's code
  7454. page but as seen above it can't simply take this from the current .isl. And license
  7455. and info files do not even have a language code page setting.
  7456. This means the Unicode compiler has to do an extra phase: following the logic above
  7457. it first determines the final language code page for each language, storing these
  7458. into an extra list called PreDataList, and then it continues as normal while using
  7459. the final language code page for any conversions needed.
  7460. Note: it must avoid caching the .isl files while determining the code pages, since
  7461. the conversion is done *before* the caching.
  7462. 1. Read Default.isl messages:
  7463. ReadDefaultMessages calls EnumMessages for Default.isl's [Messages], with Ext set to -2.
  7464. These messages are stored in DefaultLangData to be used as defaults for missing messages
  7465. later on. EnumLangOptions isn't called, the defaults will (at run-time) be displayed
  7466. using the code page of the language with the missing messages. EnumMessages for
  7467. Default.isl's [CustomMessages] also isn't called at this point, missing custom messages
  7468. are handled differently.
  7469. 2. Read [Languages] section and the .isl files the entries reference:
  7470. EnumLanguages is called for the script. For each [Languages] entry its parameters
  7471. are read and for the MessagesFiles parameter ReadMessagesFromFiles is called. For
  7472. each file ReadMessagesFromFiles first calls EnumLangOptions, then EnumMessages for
  7473. [Messages], and finally another EnumMessages for [CustomMessages], all with Ext set
  7474. to the index of the language.
  7475. All the [LangOptions] and [Messages] data is stored in single structures per language,
  7476. namely LanguageEntries[Ext] (langoptions) and LangDataList[Ext] (messages), any 'double'
  7477. directives or messages overwrite each other. This means if that for example the first
  7478. messages file does not specify a code page, but the second does, the language will
  7479. automatically use the code page of the second file. And vice versa.
  7480. The [CustomMessages] data is stored in a single list for all languages, with each
  7481. entry having a LangIndex property saying to which language it belongs. If a 'double'
  7482. custom message is found, the existing one is removed from the list.
  7483. 3. Read [LangOptions] & [Messages] & [CustomMessages] in the script:
  7484. ReadMessagesFromScript is called and this will first call CreateDefaultLanguageEntry
  7485. if no languages have been defined. CreateDefaultLanguageEntry first creates a language
  7486. with all settings set to the default, and then it calles ReadMessagesFromFiles for
  7487. Default.isl for this language. ReadMessagesFromFiles works as described above.
  7488. Note this is just like the script creator creating an entry for Default.isl.
  7489. ReadMessagesFromScript then first calls EnumLangOptions, then EnumMessages for
  7490. [Messages], and finally another EnumMessages for [CustomMessages] for the script.
  7491. Note this is just like ReadMessagesFromFiles does for files, except that Ext is set
  7492. to -1. This causes it to accept language identifiers ('en.LanguageCodePage=...'):
  7493. if the identifier is set the read data is stored only for that language in the
  7494. structures described above. If the identifier is not set, the read data is stored
  7495. for all languages either by writing to all structures (langoptions/messages) or by
  7496. adding an entry with LangIndex set to -1 (custommessages). This for example means
  7497. all language code pages read so far could be overwritten from the script.
  7498. ReadMessagesFromScript then checks for any missing messages and uses the messages
  7499. read in the very beginning to provide defaults.
  7500. After ReadMessagesFromScript returns, the read messages stored in the LangDataList
  7501. entries are streamed into the LanguageEntry.Data fields by PopulateLanguageEntryData.
  7502. 4. Check 'language completeness' of custom message constants:
  7503. CheckCustomMessageDefinitions is used to check for missing custom messages and
  7504. where necessary it 'promotes' a custom message by resetting its LangIndex property
  7505. to -1. }
  7506. { 0. Determine final language code pages }
  7507. AddStatus(SCompilerStatusDeterminingCodePages);
  7508. { 0.1. Read [Languages] section and [LangOptions] in the .isl files the
  7509. entries reference }
  7510. EnumIniSection(EnumLanguagesPreProc, 'Languages', 0, True, True, '', False, True);
  7511. CallIdleProc;
  7512. { 0.2. Read [LangOptions] in the script }
  7513. ReadMessagesFromScriptPre;
  7514. { 1. Read Default.isl messages }
  7515. AddStatus(SCompilerStatusReadingDefaultMessages);
  7516. ReadDefaultMessages;
  7517. { 2. Read [Languages] section and the .isl files the entries reference }
  7518. EnumIniSection(EnumLanguagesProc, 'Languages', 0, True, True, '', False, False);
  7519. CallIdleProc;
  7520. { 3. Read [LangOptions] & [Messages] & [CustomMessages] in the script }
  7521. AddStatus(SCompilerStatusParsingMessages);
  7522. ReadMessagesFromScript;
  7523. PopulateLanguageEntryData;
  7524. { 4. Check 'language completeness' of custom message constants }
  7525. CheckCustomMessageDefinitions;
  7526. { Read (but not compile) [Code] section }
  7527. ReadCode;
  7528. { Read [Types] section }
  7529. EnumIniSection(EnumTypesProc, 'Types', 0, True, True, '', False, False);
  7530. CallIdleProc;
  7531. { Read [Components] section }
  7532. EnumIniSection(EnumComponentsProc, 'Components', 0, True, True, '', False, False);
  7533. CallIdleProc;
  7534. { Read [Tasks] section }
  7535. EnumIniSection(EnumTasksProc, 'Tasks', 0, True, True, '', False, False);
  7536. CallIdleProc;
  7537. { Read [Dirs] section }
  7538. EnumIniSection(EnumDirsProc, 'Dirs', 0, True, True, '', False, False);
  7539. CallIdleProc;
  7540. { Read [Icons] section }
  7541. EnumIniSection(EnumIconsProc, 'Icons', 0, True, True, '', False, False);
  7542. CallIdleProc;
  7543. { Read [INI] section }
  7544. EnumIniSection(EnumINIProc, 'INI', 0, True, True, '', False, False);
  7545. CallIdleProc;
  7546. { Read [Registry] section }
  7547. EnumIniSection(EnumRegistryProc, 'Registry', 0, True, True, '', False, False);
  7548. CallIdleProc;
  7549. { Read [InstallDelete] section }
  7550. EnumIniSection(EnumDeleteProc, 'InstallDelete', 0, True, True, '', False, False);
  7551. CallIdleProc;
  7552. { Read [UninstallDelete] section }
  7553. EnumIniSection(EnumDeleteProc, 'UninstallDelete', 1, True, True, '', False, False);
  7554. CallIdleProc;
  7555. { Read [Run] section }
  7556. EnumIniSection(EnumRunProc, 'Run', 0, True, True, '', False, False);
  7557. CallIdleProc;
  7558. { Read [UninstallRun] section }
  7559. EnumIniSection(EnumRunProc, 'UninstallRun', 1, True, True, '', False, False);
  7560. CallIdleProc;
  7561. if MissingRunOnceIdsWarning and MissingRunOnceIds then
  7562. WarningsList.Add(Format(SCompilerMissingRunOnceIdsWarning, ['UninstallRun', 'RunOnceId']));
  7563. { Read [ISSigKeys] section - must be done before reading [Files] section }
  7564. EnumIniSection(EnumISSigKeysProc, 'ISSigKeys', 0, True, True, '', False, False);
  7565. CallIdleProc;
  7566. { Read [Files] section }
  7567. if not TryStrToBoolean(SetupHeader.Uninstallable, Uninstallable) or Uninstallable then
  7568. EnumFilesProc('', 1);
  7569. EnumIniSection(EnumFilesProc, 'Files', 0, True, True, '', False, False);
  7570. CallIdleProc;
  7571. if UsedUserAreasWarning and (UsedUserAreas.Count > 0) and
  7572. (SetupHeader.PrivilegesRequired in [prPowerUser, prAdmin]) then begin
  7573. if SetupHeader.PrivilegesRequired = prPowerUser then
  7574. PrivilegesRequiredValue := 'poweruser'
  7575. else
  7576. PrivilegesRequiredValue := 'admin';
  7577. WarningsList.Add(Format(SCompilerUsedUserAreasWarning, ['Setup',
  7578. 'PrivilegesRequired', PrivilegesRequiredValue, UsedUserAreas.CommaText]));
  7579. end;
  7580. { Read decompressor DLL. Must be done after [Files] is parsed, since
  7581. SetupHeader.CompressMethod isn't set until then }
  7582. case SetupHeader.CompressMethod of
  7583. cmZip: begin
  7584. AddStatus(Format(SCompilerStatusReadingFile, ['isunzlib.dll']));
  7585. DecompressorDLL := CreateMemoryStreamFromFile(CompilerDir + 'isunzlib.dll',
  7586. not(pfIsunzlibDll in DisablePrecompiledFileVerifications), OnCheckedTrust);
  7587. end;
  7588. cmBzip: begin
  7589. AddStatus(Format(SCompilerStatusReadingFile, ['isbunzip.dll']));
  7590. DecompressorDLL := CreateMemoryStreamFromFile(CompilerDir + 'isbunzip.dll',
  7591. not(pfIsbunzipDll in DisablePrecompiledFileVerifications), OnCheckedTrust);
  7592. end;
  7593. end;
  7594. { Read 7-Zip DLL }
  7595. if SetupHeader.SevenZipLibraryName <> '' then begin
  7596. AddStatus(Format(SCompilerStatusReadingFile, [SetupHeader.SevenZipLibraryName]));
  7597. SevenZipDLL := CreateMemoryStreamFromFile(CompilerDir + SetupHeader.SevenZipLibraryName,
  7598. not(pfIs7zDll in DisablePrecompiledFileVerifications), OnCheckedTrust);
  7599. end;
  7600. { Add default types if necessary }
  7601. if (ComponentEntries.Count > 0) and (TypeEntries.Count = 0) then begin
  7602. AddDefaultSetupType(DefaultTypeEntryNames[0], [], ttDefaultFull);
  7603. AddDefaultSetupType(DefaultTypeEntryNames[1], [], ttDefaultCompact);
  7604. AddDefaultSetupType(DefaultTypeEntryNames[2], [toIsCustom], ttDefaultCustom);
  7605. end;
  7606. { Check existence of expected custom message constants }
  7607. CheckCustomMessageReferences;
  7608. { Compile CodeText }
  7609. CompileCode;
  7610. CallIdleProc;
  7611. { Clear any existing setup* files out of the output directory first (even
  7612. if output is disabled. }
  7613. EmptyOutputDir(True);
  7614. if OutputManifestFile <> '' then
  7615. DeleteFile(PrependDirName(OutputManifestFile, OutputDir));
  7616. { Create setup files }
  7617. if Output then begin
  7618. AddStatus(SCompilerStatusCreateSetupFiles);
  7619. ExeFilename := OutputDir + OutputBaseFilename + '.exe';
  7620. try
  7621. if not UseSetupLdr then begin
  7622. SetupFile := TFile.Create(ExeFilename, fdCreateAlways, faWrite, fsNone);
  7623. try
  7624. SetupFile.WriteBuffer(SetupE32.Memory^, SetupE32.CappedSize);
  7625. SizeOfExe := SetupFile.Size;
  7626. finally
  7627. SetupFile.Free;
  7628. end;
  7629. CallIdleProc;
  7630. if not DiskSpanning then begin
  7631. { Create Setup-0.bin and Setup-1.bin }
  7632. CompressFiles('', 0);
  7633. CreateSetup0File;
  7634. end
  7635. else begin
  7636. { Create Setup-0.bin and Setup-*.bin }
  7637. SizeOfHeaders := CreateSetup0File;
  7638. CompressFiles('', RoundToNearestClusterSize(SizeOfExe) +
  7639. RoundToNearestClusterSize(SizeOfHeaders) +
  7640. RoundToNearestClusterSize(ReserveBytes));
  7641. { CompressFiles modifies setup header data, so go back and
  7642. rewrite it }
  7643. if CreateSetup0File <> SizeOfHeaders then
  7644. { Make sure new and old size match. No reason why they
  7645. shouldn't but check just in case }
  7646. AbortCompile(SCompilerSetup0Mismatch);
  7647. end;
  7648. end
  7649. else begin
  7650. CopyFileOrAbort(CompilerDir + 'SetupLdr.e32', ExeFilename, not(pfSetupLdrE32 in DisablePrecompiledFileVerifications),
  7651. [cftoTrustAllOnDebug], OnCheckedTrust);
  7652. { if there was a read-only attribute, remove it }
  7653. SetFileAttributes(PChar(ExeFilename), FILE_ATTRIBUTE_ARCHIVE);
  7654. if SetupIconFilename <> '' then begin
  7655. { update icons }
  7656. AddStatus(Format(SCompilerStatusUpdatingIcons, ['Setup.exe']));
  7657. LineNumber := SetupDirectiveLines[ssSetupIconFile];
  7658. UpdateIcons(ExeFilename, PrependSourceDirName(SetupIconFilename), False);
  7659. LineNumber := 0;
  7660. end;
  7661. SetupFile := TFile.Create(ExeFilename, fdOpenExisting, faReadWrite, fsNone);
  7662. try
  7663. UpdateSetupPEHeaderFields(SetupFile, TerminalServicesAware, DEPCompatible, ASLRCompatible);
  7664. SizeOfExe := SetupFile.Size;
  7665. finally
  7666. SetupFile.Free;
  7667. end;
  7668. CallIdleProc;
  7669. { When disk spanning isn't used, place the compressed files inside
  7670. Setup.exe }
  7671. if not DiskSpanning then
  7672. CompressFiles(ExeFilename, 0);
  7673. ExeFile := TFile.Create(ExeFilename, fdOpenExisting, faReadWrite, fsNone);
  7674. try
  7675. ExeFile.SeekToEnd;
  7676. { Move the data from Setup.e?? into the Setup.exe, and write
  7677. header data }
  7678. var SetupLdrOffsetTable := Default(TSetupLdrOffsetTable);
  7679. SetupLdrOffsetTable.ID := SetupLdrOffsetTableID;
  7680. SetupLdrOffsetTable.Version := SetupLdrOffsetTableVersion;
  7681. SetupLdrOffsetTable.Offset0 := ExeFile.Position;
  7682. SizeOfHeaders := WriteSetup0(ExeFile);
  7683. SetupLdrOffsetTable.OffsetEXE := ExeFile.Position;
  7684. CompressSetupE32(SetupE32, ExeFile, SetupLdrOffsetTable.UncompressedSizeEXE,
  7685. SetupLdrOffsetTable.CRCEXE);
  7686. SetupLdrOffsetTable.TotalSize := ExeFile.Size;
  7687. if DiskSpanning then begin
  7688. SetupLdrOffsetTable.Offset1 := 0;
  7689. { Compress the files in Setup-*.bin after we know the size of
  7690. Setup.exe }
  7691. CompressFiles('',
  7692. RoundToNearestClusterSize(SetupLdrOffsetTable.TotalSize) +
  7693. RoundToNearestClusterSize(ReserveBytes));
  7694. { CompressFiles modifies setup header data, so go back and
  7695. rewrite it }
  7696. ExeFile.Seek(SetupLdrOffsetTable.Offset0);
  7697. if WriteSetup0(ExeFile) <> SizeOfHeaders then
  7698. { Make sure new and old size match. No reason why they
  7699. shouldn't but check just in case }
  7700. AbortCompile(SCompilerSetup0Mismatch);
  7701. end
  7702. else
  7703. SetupLdrOffsetTable.Offset1 := SizeOfExe;
  7704. SetupLdrOffsetTable.TableCRC := GetCRC32(SetupLdrOffsetTable,
  7705. SizeOf(SetupLdrOffsetTable) - SizeOf(SetupLdrOffsetTable.TableCRC));
  7706. { Write SetupLdrOffsetTable to Setup.exe }
  7707. if SeekToResourceData(ExeFile, Cardinal(RT_RCDATA), SetupLdrOffsetTableResID) <> SizeOf(SetupLdrOffsetTable) then
  7708. AbortCompile('Wrong offset table resource size');
  7709. ExeFile.WriteBuffer(SetupLdrOffsetTable, SizeOf(SetupLdrOffsetTable));
  7710. { Update version info }
  7711. AddStatus(Format(SCompilerStatusUpdatingVersionInfo, ['Setup.exe']));
  7712. UpdateVersionInfo(ExeFile, VersionInfoVersion, VersionInfoProductVersion, VersionInfoCompany,
  7713. VersionInfoDescription, VersionInfoTextVersion,
  7714. VersionInfoCopyright, VersionInfoProductName, VersionInfoProductTextVersion, VersionInfoOriginalFileName,
  7715. True);
  7716. { Update manifest if needed }
  7717. if UseSetupLdr then begin
  7718. AddStatus(Format(SCompilerStatusUpdatingManifest, ['Setup.exe']));
  7719. PreventCOMCTL32Sideloading(ExeFile);
  7720. end;
  7721. { For some reason, on Win95 the date/time of the EXE sometimes
  7722. doesn't get updated after it's been written to so it has to
  7723. manually set it. (I don't get it!!) }
  7724. UpdateTimeStamp(ExeFile.Handle);
  7725. finally
  7726. ExeFile.Free;
  7727. end;
  7728. end;
  7729. { Sign }
  7730. if SignTools.Count > 0 then begin
  7731. AddStatus(SCompilerStatusSigningSetup);
  7732. Sign(ExeFileName);
  7733. end;
  7734. except
  7735. EmptyOutputDir(False);
  7736. raise;
  7737. end;
  7738. CallIdleProc;
  7739. { Create manifest file }
  7740. if OutputManifestFile <> '' then begin
  7741. AddStatus(SCompilerStatusCreateManifestFile);
  7742. CreateManifestFile;
  7743. CallIdleProc;
  7744. end;
  7745. end else begin
  7746. AddStatus(SCompilerStatusSkippingCreateSetupFiles);
  7747. ExeFilename := '';
  7748. end;
  7749. { Finalize debug info }
  7750. FinalizeDebugInfo;
  7751. { Done }
  7752. AddStatus('');
  7753. for I := 0 to WarningsList.Count-1 do
  7754. AddStatus(SCompilerStatusWarning + WarningsList[I], True);
  7755. asm jmp @1; db 0,'Inno Setup Compiler, Copyright (C) 1997-2025 Jordan Russell, '
  7756. db 'Portions Copyright (C) 2000-2025 Martijn Laan',0; @1: end;
  7757. { Note: Removing or modifying the copyright text is a violation of the
  7758. Inno Setup license agreement; see LICENSE.TXT. }
  7759. finally
  7760. { Free / clear all the data }
  7761. CallPreprocessorCleanupProc;
  7762. UsedUserAreas.Clear;
  7763. WarningsList.Clear;
  7764. SevenZipDLL.Free;
  7765. DecompressorDLL.Free;
  7766. SetupE32.Free;
  7767. WizardSmallImages.Free;
  7768. WizardImages.Free;
  7769. ClearSEList(LanguageEntries, SetupLanguageEntryStrings, SetupLanguageEntryAnsiStrings);
  7770. ClearSEList(CustomMessageEntries, SetupCustomMessageEntryStrings, SetupCustomMessageEntryAnsiStrings);
  7771. ClearSEList(PermissionEntries, SetupPermissionEntryStrings, SetupPermissionEntryAnsiStrings);
  7772. ClearSEList(TypeEntries, SetupTypeEntryStrings, SetupTypeEntryAnsiStrings);
  7773. ClearSEList(ComponentEntries, SetupComponentEntryStrings, SetupComponentEntryAnsiStrings);
  7774. ClearSEList(TaskEntries, SetupTaskEntryStrings, SetupTaskEntryAnsiStrings);
  7775. ClearSEList(DirEntries, SetupDirEntryStrings, SetupDirEntryAnsiStrings);
  7776. ClearSEList(FileEntries, SetupFileEntryStrings, SetupFileEntryAnsiStrings);
  7777. ClearSEList(FileLocationEntries, SetupFileLocationEntryStrings, SetupFileLocationEntryAnsiStrings);
  7778. ClearSEList(ISSigKeyEntries, SetupISSigKeyEntryStrings, SetupISSigKeyEntryAnsiStrings);
  7779. ClearSEList(IconEntries, SetupIconEntryStrings, SetupIconEntryAnsiStrings);
  7780. ClearSEList(IniEntries, SetupIniEntryStrings, SetupIniEntryAnsiStrings);
  7781. ClearSEList(RegistryEntries, SetupRegistryEntryStrings, SetupRegistryEntryAnsiStrings);
  7782. ClearSEList(InstallDeleteEntries, SetupDeleteEntryStrings, SetupDeleteEntryAnsiStrings);
  7783. ClearSEList(UninstallDeleteEntries, SetupDeleteEntryStrings, SetupDeleteEntryAnsiStrings);
  7784. ClearSEList(RunEntries, SetupRunEntryStrings, SetupRunEntryAnsiStrings);
  7785. ClearSEList(UninstallRunEntries, SetupRunEntryStrings, SetupRunEntryAnsiStrings);
  7786. FileLocationEntryFilenames.Clear;
  7787. for I := FileLocationEntryExtraInfos.Count-1 downto 0 do begin
  7788. Dispose(PFileLocationEntryExtraInfo(FileLocationEntryExtraInfos[I]));
  7789. FileLocationEntryExtraInfos.Delete(I);
  7790. end;
  7791. for I := ISSigKeyEntryExtraInfos.Count-1 downto 0 do begin
  7792. Dispose(PISSigKeyEntryExtraInfo(ISSigKeyEntryExtraInfos[I]));
  7793. ISSigKeyEntryExtraInfos.Delete(I);
  7794. end;
  7795. ClearLineInfoList(ExpectedCustomMessageNames);
  7796. ClearLangDataList;
  7797. ClearPreLangDataList;
  7798. ClearScriptFiles;
  7799. ClearLineInfoList(CodeText);
  7800. FreeAndNil(CompressProps);
  7801. FreeAndNil(InternalCompressProps);
  7802. end;
  7803. end;
  7804. end.