Compiler.SetupCompiler.pas 343 KB

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