Compile.pas 332 KB

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