Compiler.SetupCompiler.pas 324 KB

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