Compiler.SetupCompiler.pas 309 KB

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