Compiler.SetupCompiler.pas 315 KB

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