Compiler.SetupCompiler.pas 313 KB

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