2
0

Compiler.SetupCompiler.pas 337 KB

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