Compiler.SetupCompiler.pas 297 KB

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