Compiler.SetupCompiler.pas 307 KB

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