Compiler.SetupCompiler.pas 295 KB

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