| 12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697989910010110210310410510610710810911011111211311411511611711811912012112212312412512612712812913013113213313413513613713813914014114214314414514614714814915015115215315415515615715815916016116216316416516616716816917017117217317417517617717817918018118218318418518618718818919019119219319419519619719819920020120220320420520620720820921021121221321421521621721821922022122222322422522622722822923023123223323423523623723823924024124224324424524624724824925025125225325425525625725825926026126226326426526626726826927027127227327427527627727827928028128228328428528628728828929029129229329429529629729829930030130230330430530630730830931031131231331431531631731831932032132232332432532632732832933033133233333433533633733833934034134234334434534634734834935035135235335435535635735835936036136236336436536636736836937037137237337437537637737837938038138238338438538638738838939039139239339439539639739839940040140240340440540640740840941041141241341441541641741841942042142242342442542642742842943043143243343443543643743843944044144244344444544644744844945045145245345445545645745845946046146246346446546646746846947047147247347447547647747847948048148248348448548648748848949049149249349449549649749849950050150250350450550650750850951051151251351451551651751851952052152252352452552652752852953053153253353453553653753853954054154254354454554654754854955055155255355455555655755855956056156256356456556656756856957057157257357457557657757857958058158258358458558658758858959059159259359459559659759859960060160260360460560660760860961061161261361461561661761861962062162262362462562662762862963063163263363463563663763863964064164264364464564664764864965065165265365465565665765865966066166266366466566666766866967067167267367467567667767867968068168268368468568668768868969069169269369469569669769869970070170270370470570670770870971071171271371471571671771871972072172272372472572672772872973073173273373473573673773873974074174274374474574674774874975075175275375475575675775875976076176276376476576676776876977077177277377477577677777877978078178278378478578678778878979079179279379479579679779879980080180280380480580680780880981081181281381481581681781881982082182282382482582682782882983083183283383483583683783883984084184284384484584684784884985085185285385485585685785885986086186286386486586686786886987087187287387487587687787887988088188288388488588688788888989089189289389489589689789889990090190290390490590690790890991091191291391491591691791891992092192292392492592692792892993093193293393493593693793893994094194294394494594694794894995095195295395495595695795895996096196296396496596696796896997097197297397497597697797897998098198298398498598698798898999099199299399499599699799899910001001100210031004100510061007100810091010101110121013101410151016101710181019102010211022102310241025102610271028102910301031103210331034103510361037103810391040104110421043104410451046104710481049105010511052105310541055105610571058105910601061106210631064106510661067106810691070107110721073107410751076107710781079108010811082108310841085108610871088108910901091109210931094109510961097109810991100110111021103110411051106110711081109111011111112111311141115111611171118111911201121112211231124112511261127112811291130113111321133113411351136113711381139114011411142114311441145114611471148114911501151115211531154115511561157115811591160116111621163116411651166116711681169117011711172117311741175117611771178117911801181118211831184118511861187118811891190119111921193119411951196119711981199120012011202120312041205120612071208120912101211121212131214121512161217121812191220122112221223122412251226122712281229123012311232123312341235123612371238123912401241124212431244124512461247124812491250125112521253125412551256125712581259126012611262126312641265126612671268126912701271127212731274127512761277127812791280128112821283128412851286128712881289129012911292129312941295129612971298129913001301130213031304130513061307130813091310131113121313131413151316131713181319132013211322132313241325132613271328132913301331133213331334133513361337133813391340134113421343134413451346134713481349135013511352135313541355135613571358135913601361136213631364136513661367136813691370137113721373137413751376137713781379138013811382138313841385138613871388138913901391139213931394139513961397139813991400140114021403140414051406140714081409141014111412141314141415141614171418141914201421142214231424142514261427142814291430143114321433143414351436143714381439144014411442144314441445144614471448144914501451145214531454145514561457145814591460146114621463146414651466146714681469147014711472147314741475147614771478147914801481148214831484148514861487148814891490149114921493149414951496149714981499150015011502150315041505150615071508150915101511151215131514151515161517151815191520152115221523152415251526152715281529153015311532153315341535153615371538153915401541154215431544154515461547154815491550155115521553155415551556155715581559156015611562156315641565156615671568156915701571157215731574157515761577157815791580158115821583158415851586158715881589159015911592159315941595159615971598159916001601160216031604160516061607160816091610161116121613161416151616161716181619162016211622162316241625162616271628162916301631163216331634163516361637163816391640164116421643164416451646164716481649165016511652165316541655165616571658165916601661166216631664166516661667166816691670167116721673167416751676167716781679168016811682168316841685168616871688168916901691169216931694169516961697169816991700170117021703170417051706170717081709171017111712171317141715171617171718171917201721172217231724172517261727172817291730173117321733173417351736173717381739174017411742174317441745174617471748174917501751175217531754175517561757175817591760176117621763176417651766176717681769177017711772177317741775177617771778177917801781178217831784178517861787178817891790179117921793179417951796179717981799180018011802180318041805180618071808180918101811181218131814181518161817181818191820182118221823182418251826182718281829183018311832183318341835183618371838183918401841184218431844184518461847184818491850185118521853185418551856185718581859186018611862186318641865186618671868186918701871187218731874187518761877187818791880188118821883188418851886188718881889189018911892189318941895189618971898189919001901190219031904190519061907190819091910191119121913191419151916191719181919192019211922192319241925192619271928192919301931193219331934193519361937193819391940194119421943194419451946194719481949195019511952195319541955195619571958195919601961196219631964196519661967196819691970197119721973197419751976197719781979198019811982198319841985198619871988198919901991199219931994199519961997199819992000200120022003200420052006200720082009201020112012201320142015201620172018201920202021202220232024202520262027202820292030203120322033203420352036203720382039204020412042204320442045204620472048204920502051205220532054205520562057205820592060206120622063206420652066206720682069207020712072207320742075207620772078207920802081208220832084208520862087208820892090209120922093209420952096209720982099210021012102210321042105210621072108210921102111211221132114211521162117211821192120212121222123212421252126212721282129213021312132213321342135213621372138213921402141214221432144214521462147214821492150215121522153215421552156215721582159216021612162216321642165216621672168216921702171217221732174217521762177217821792180218121822183218421852186218721882189219021912192219321942195219621972198219922002201220222032204220522062207220822092210221122122213221422152216221722182219222022212222222322242225222622272228222922302231223222332234223522362237223822392240224122422243224422452246224722482249225022512252225322542255225622572258225922602261226222632264226522662267226822692270227122722273227422752276227722782279228022812282228322842285228622872288228922902291229222932294229522962297229822992300230123022303230423052306230723082309231023112312231323142315231623172318231923202321232223232324232523262327232823292330233123322333233423352336233723382339234023412342234323442345234623472348234923502351235223532354235523562357235823592360236123622363236423652366236723682369237023712372237323742375237623772378237923802381238223832384238523862387238823892390239123922393239423952396239723982399240024012402240324042405240624072408240924102411241224132414241524162417241824192420242124222423242424252426242724282429243024312432243324342435243624372438243924402441244224432444244524462447244824492450245124522453245424552456245724582459246024612462246324642465246624672468246924702471247224732474247524762477247824792480248124822483248424852486248724882489249024912492249324942495249624972498249925002501250225032504250525062507250825092510251125122513251425152516251725182519252025212522252325242525252625272528252925302531253225332534253525362537253825392540254125422543254425452546254725482549255025512552255325542555255625572558255925602561256225632564256525662567256825692570257125722573257425752576257725782579258025812582258325842585258625872588258925902591259225932594259525962597259825992600260126022603260426052606260726082609261026112612261326142615261626172618261926202621262226232624262526262627262826292630263126322633263426352636263726382639264026412642264326442645264626472648264926502651265226532654265526562657265826592660266126622663266426652666266726682669267026712672267326742675267626772678267926802681268226832684268526862687268826892690269126922693269426952696269726982699270027012702270327042705270627072708270927102711271227132714271527162717271827192720272127222723272427252726272727282729273027312732273327342735273627372738273927402741274227432744274527462747274827492750275127522753275427552756275727582759276027612762276327642765276627672768276927702771277227732774277527762777277827792780278127822783278427852786278727882789279027912792279327942795279627972798279928002801280228032804280528062807280828092810281128122813281428152816281728182819282028212822282328242825282628272828282928302831283228332834283528362837283828392840284128422843284428452846284728482849285028512852285328542855285628572858285928602861286228632864286528662867286828692870287128722873287428752876287728782879288028812882288328842885288628872888288928902891289228932894289528962897289828992900290129022903290429052906290729082909291029112912291329142915291629172918291929202921292229232924292529262927292829292930293129322933293429352936293729382939294029412942294329442945294629472948294929502951295229532954295529562957295829592960296129622963296429652966296729682969297029712972297329742975297629772978297929802981298229832984298529862987298829892990299129922993299429952996299729982999300030013002300330043005300630073008300930103011301230133014301530163017301830193020302130223023302430253026302730283029303030313032303330343035303630373038303930403041304230433044304530463047304830493050305130523053305430553056305730583059306030613062306330643065306630673068306930703071307230733074307530763077307830793080308130823083308430853086308730883089309030913092309330943095309630973098309931003101310231033104310531063107310831093110311131123113311431153116311731183119312031213122312331243125312631273128312931303131313231333134313531363137313831393140314131423143314431453146314731483149315031513152315331543155315631573158315931603161316231633164316531663167316831693170317131723173317431753176317731783179318031813182318331843185318631873188318931903191319231933194319531963197319831993200320132023203320432053206320732083209321032113212321332143215321632173218321932203221322232233224322532263227322832293230323132323233323432353236323732383239324032413242324332443245324632473248324932503251325232533254325532563257325832593260326132623263326432653266326732683269327032713272327332743275327632773278327932803281328232833284328532863287328832893290329132923293329432953296329732983299330033013302330333043305330633073308330933103311331233133314331533163317331833193320332133223323332433253326332733283329333033313332333333343335333633373338333933403341334233433344334533463347334833493350335133523353335433553356335733583359336033613362336333643365336633673368336933703371337233733374337533763377337833793380338133823383338433853386338733883389339033913392339333943395339633973398339934003401340234033404340534063407340834093410341134123413341434153416341734183419342034213422342334243425342634273428342934303431343234333434343534363437343834393440344134423443344434453446344734483449345034513452345334543455345634573458345934603461346234633464346534663467346834693470347134723473347434753476347734783479348034813482348334843485348634873488348934903491349234933494349534963497349834993500350135023503350435053506350735083509351035113512351335143515351635173518351935203521352235233524352535263527352835293530353135323533353435353536353735383539354035413542354335443545354635473548354935503551355235533554355535563557355835593560356135623563356435653566356735683569357035713572357335743575357635773578357935803581358235833584358535863587358835893590359135923593359435953596359735983599360036013602360336043605360636073608360936103611361236133614361536163617361836193620362136223623362436253626362736283629363036313632363336343635363636373638363936403641364236433644364536463647364836493650365136523653365436553656365736583659366036613662366336643665366636673668366936703671367236733674367536763677367836793680368136823683368436853686368736883689369036913692369336943695369636973698369937003701370237033704370537063707370837093710371137123713371437153716371737183719372037213722372337243725372637273728372937303731373237333734373537363737373837393740374137423743374437453746374737483749375037513752375337543755375637573758375937603761376237633764376537663767376837693770377137723773377437753776377737783779378037813782378337843785378637873788378937903791379237933794379537963797379837993800380138023803380438053806380738083809381038113812381338143815381638173818381938203821382238233824382538263827382838293830383138323833383438353836383738383839384038413842384338443845384638473848384938503851385238533854385538563857385838593860386138623863386438653866386738683869387038713872387338743875387638773878387938803881388238833884388538863887388838893890389138923893389438953896389738983899390039013902390339043905390639073908390939103911391239133914391539163917391839193920392139223923392439253926392739283929393039313932393339343935393639373938393939403941394239433944394539463947394839493950395139523953395439553956395739583959396039613962396339643965396639673968396939703971397239733974397539763977397839793980398139823983398439853986398739883989399039913992399339943995399639973998399940004001400240034004400540064007400840094010401140124013401440154016401740184019402040214022402340244025402640274028402940304031403240334034403540364037403840394040404140424043404440454046404740484049405040514052405340544055405640574058405940604061406240634064406540664067406840694070407140724073407440754076407740784079408040814082408340844085408640874088408940904091409240934094409540964097409840994100410141024103410441054106410741084109411041114112411341144115411641174118411941204121412241234124412541264127412841294130413141324133413441354136413741384139414041414142414341444145414641474148414941504151415241534154415541564157415841594160416141624163416441654166416741684169417041714172417341744175417641774178417941804181418241834184418541864187418841894190419141924193419441954196419741984199420042014202420342044205420642074208420942104211421242134214421542164217421842194220422142224223422442254226422742284229423042314232423342344235423642374238423942404241424242434244424542464247424842494250425142524253425442554256425742584259426042614262426342644265426642674268426942704271427242734274427542764277427842794280428142824283428442854286428742884289429042914292429342944295429642974298429943004301430243034304430543064307430843094310431143124313431443154316431743184319432043214322432343244325432643274328432943304331433243334334433543364337433843394340434143424343434443454346434743484349435043514352435343544355435643574358435943604361436243634364436543664367436843694370437143724373437443754376437743784379438043814382438343844385438643874388438943904391439243934394439543964397439843994400440144024403440444054406440744084409441044114412441344144415441644174418441944204421442244234424442544264427442844294430443144324433443444354436443744384439444044414442444344444445444644474448444944504451445244534454445544564457445844594460446144624463446444654466446744684469447044714472447344744475447644774478447944804481448244834484448544864487448844894490449144924493449444954496449744984499450045014502450345044505450645074508450945104511451245134514451545164517451845194520452145224523452445254526452745284529453045314532453345344535453645374538453945404541454245434544454545464547454845494550455145524553455445554556455745584559456045614562456345644565456645674568456945704571457245734574457545764577457845794580458145824583458445854586458745884589459045914592459345944595459645974598459946004601460246034604460546064607460846094610461146124613461446154616461746184619462046214622462346244625462646274628462946304631463246334634463546364637463846394640464146424643464446454646464746484649465046514652465346544655465646574658465946604661466246634664466546664667466846694670467146724673467446754676467746784679468046814682468346844685468646874688468946904691469246934694469546964697469846994700470147024703470447054706470747084709471047114712471347144715471647174718471947204721472247234724472547264727472847294730473147324733473447354736473747384739474047414742474347444745474647474748474947504751475247534754475547564757475847594760476147624763476447654766476747684769477047714772477347744775477647774778477947804781478247834784478547864787478847894790479147924793479447954796479747984799480048014802480348044805480648074808480948104811481248134814481548164817481848194820482148224823482448254826482748284829483048314832483348344835483648374838483948404841484248434844484548464847484848494850485148524853485448554856485748584859486048614862486348644865486648674868486948704871487248734874487548764877487848794880488148824883488448854886488748884889489048914892489348944895489648974898489949004901490249034904490549064907490849094910491149124913491449154916491749184919492049214922492349244925492649274928492949304931493249334934493549364937493849394940494149424943494449454946494749484949495049514952495349544955495649574958495949604961496249634964496549664967496849694970497149724973497449754976497749784979498049814982498349844985498649874988498949904991499249934994499549964997499849995000500150025003500450055006500750085009501050115012501350145015501650175018501950205021502250235024502550265027502850295030503150325033503450355036503750385039504050415042504350445045504650475048504950505051505250535054505550565057505850595060506150625063506450655066506750685069507050715072507350745075507650775078507950805081508250835084508550865087508850895090509150925093509450955096509750985099510051015102510351045105510651075108510951105111511251135114511551165117511851195120512151225123512451255126512751285129513051315132513351345135513651375138513951405141514251435144514551465147514851495150515151525153515451555156515751585159516051615162516351645165516651675168516951705171517251735174517551765177517851795180518151825183518451855186518751885189519051915192519351945195519651975198519952005201520252035204520552065207520852095210521152125213521452155216521752185219522052215222522352245225522652275228522952305231523252335234523552365237523852395240524152425243524452455246524752485249525052515252525352545255525652575258525952605261526252635264526552665267526852695270527152725273527452755276527752785279528052815282528352845285528652875288528952905291529252935294529552965297529852995300530153025303530453055306530753085309531053115312531353145315531653175318531953205321532253235324532553265327532853295330533153325333533453355336533753385339534053415342534353445345534653475348534953505351535253535354535553565357535853595360536153625363536453655366536753685369537053715372537353745375537653775378537953805381538253835384538553865387538853895390539153925393539453955396539753985399540054015402540354045405540654075408540954105411541254135414541554165417541854195420542154225423542454255426542754285429543054315432543354345435543654375438543954405441544254435444544554465447544854495450545154525453545454555456545754585459546054615462546354645465546654675468546954705471547254735474547554765477547854795480548154825483548454855486548754885489549054915492549354945495549654975498549955005501550255035504550555065507550855095510551155125513551455155516551755185519552055215522552355245525552655275528552955305531553255335534553555365537553855395540554155425543554455455546554755485549555055515552555355545555555655575558555955605561556255635564556555665567556855695570557155725573557455755576557755785579558055815582558355845585558655875588558955905591559255935594559555965597559855995600560156025603560456055606560756085609561056115612561356145615561656175618561956205621562256235624562556265627562856295630563156325633563456355636563756385639564056415642564356445645564656475648564956505651565256535654565556565657565856595660566156625663566456655666566756685669567056715672567356745675567656775678567956805681568256835684568556865687568856895690569156925693569456955696569756985699570057015702570357045705570657075708570957105711571257135714571557165717571857195720572157225723572457255726572757285729573057315732573357345735573657375738573957405741574257435744574557465747574857495750575157525753575457555756575757585759576057615762576357645765576657675768576957705771577257735774577557765777577857795780578157825783578457855786578757885789579057915792579357945795579657975798579958005801580258035804580558065807580858095810581158125813581458155816581758185819582058215822582358245825582658275828582958305831583258335834583558365837583858395840584158425843584458455846584758485849585058515852585358545855585658575858585958605861586258635864586558665867586858695870587158725873587458755876587758785879588058815882588358845885588658875888588958905891589258935894589558965897589858995900590159025903590459055906590759085909591059115912591359145915591659175918591959205921592259235924592559265927592859295930593159325933593459355936593759385939594059415942594359445945594659475948594959505951595259535954595559565957595859595960596159625963596459655966596759685969597059715972597359745975597659775978597959805981598259835984598559865987598859895990599159925993599459955996599759985999600060016002600360046005600660076008600960106011601260136014601560166017601860196020602160226023602460256026602760286029603060316032603360346035603660376038603960406041604260436044604560466047604860496050605160526053605460556056605760586059606060616062606360646065606660676068606960706071607260736074607560766077607860796080608160826083608460856086608760886089609060916092609360946095609660976098609961006101610261036104610561066107610861096110611161126113611461156116611761186119612061216122612361246125612661276128612961306131613261336134613561366137613861396140614161426143614461456146614761486149615061516152615361546155615661576158615961606161616261636164616561666167616861696170617161726173617461756176617761786179618061816182618361846185618661876188618961906191619261936194619561966197619861996200620162026203620462056206620762086209621062116212621362146215621662176218621962206221622262236224622562266227622862296230623162326233623462356236623762386239624062416242624362446245624662476248624962506251625262536254625562566257625862596260626162626263626462656266626762686269627062716272627362746275627662776278627962806281628262836284628562866287628862896290629162926293629462956296629762986299630063016302630363046305630663076308630963106311631263136314631563166317631863196320632163226323632463256326632763286329633063316332633363346335633663376338633963406341634263436344634563466347634863496350635163526353635463556356635763586359636063616362636363646365636663676368636963706371637263736374637563766377637863796380638163826383638463856386638763886389639063916392639363946395639663976398639964006401640264036404640564066407640864096410641164126413641464156416641764186419642064216422642364246425642664276428642964306431643264336434643564366437643864396440644164426443644464456446644764486449645064516452645364546455645664576458645964606461646264636464646564666467646864696470647164726473647464756476647764786479648064816482648364846485648664876488648964906491649264936494649564966497649864996500650165026503650465056506650765086509651065116512651365146515651665176518651965206521652265236524652565266527652865296530653165326533653465356536653765386539654065416542654365446545654665476548654965506551655265536554655565566557655865596560656165626563656465656566656765686569657065716572657365746575657665776578657965806581658265836584658565866587658865896590659165926593659465956596659765986599660066016602660366046605660666076608660966106611661266136614661566166617661866196620662166226623662466256626662766286629663066316632663366346635663666376638663966406641664266436644664566466647664866496650665166526653665466556656665766586659666066616662666366646665666666676668666966706671667266736674667566766677667866796680668166826683668466856686668766886689669066916692669366946695669666976698669967006701670267036704670567066707670867096710671167126713671467156716671767186719672067216722672367246725672667276728672967306731673267336734673567366737673867396740674167426743674467456746674767486749675067516752675367546755675667576758675967606761676267636764676567666767676867696770677167726773677467756776677767786779678067816782678367846785678667876788678967906791679267936794679567966797679867996800680168026803680468056806680768086809681068116812681368146815681668176818681968206821682268236824682568266827682868296830683168326833683468356836683768386839684068416842684368446845684668476848684968506851685268536854685568566857685868596860686168626863686468656866686768686869687068716872687368746875687668776878687968806881688268836884688568866887688868896890689168926893689468956896689768986899690069016902690369046905690669076908690969106911691269136914691569166917691869196920692169226923692469256926692769286929693069316932693369346935693669376938693969406941694269436944694569466947694869496950695169526953695469556956695769586959696069616962696369646965696669676968696969706971697269736974697569766977697869796980698169826983698469856986698769886989699069916992699369946995699669976998699970007001700270037004700570067007700870097010701170127013701470157016701770187019702070217022702370247025702670277028702970307031703270337034703570367037703870397040704170427043704470457046704770487049705070517052705370547055705670577058705970607061706270637064706570667067706870697070707170727073707470757076707770787079708070817082708370847085708670877088708970907091709270937094709570967097709870997100710171027103710471057106710771087109711071117112711371147115711671177118711971207121712271237124712571267127712871297130713171327133713471357136713771387139714071417142714371447145714671477148714971507151715271537154715571567157715871597160716171627163716471657166716771687169717071717172717371747175717671777178717971807181718271837184718571867187718871897190719171927193719471957196719771987199720072017202720372047205720672077208720972107211721272137214721572167217721872197220722172227223722472257226722772287229723072317232723372347235723672377238723972407241724272437244724572467247724872497250725172527253725472557256725772587259726072617262726372647265726672677268726972707271727272737274727572767277727872797280728172827283728472857286728772887289729072917292729372947295729672977298729973007301730273037304730573067307730873097310731173127313731473157316731773187319732073217322732373247325732673277328732973307331733273337334733573367337733873397340734173427343734473457346734773487349735073517352735373547355735673577358735973607361736273637364736573667367736873697370737173727373737473757376737773787379738073817382738373847385738673877388738973907391739273937394739573967397739873997400740174027403740474057406740774087409741074117412741374147415741674177418741974207421742274237424742574267427742874297430743174327433743474357436743774387439744074417442744374447445744674477448744974507451745274537454745574567457745874597460746174627463746474657466746774687469747074717472747374747475747674777478747974807481748274837484748574867487748874897490749174927493749474957496749774987499750075017502750375047505750675077508750975107511751275137514751575167517751875197520752175227523752475257526752775287529753075317532753375347535753675377538753975407541754275437544754575467547754875497550755175527553755475557556755775587559756075617562756375647565756675677568756975707571757275737574757575767577757875797580758175827583758475857586758775887589759075917592759375947595759675977598759976007601760276037604760576067607760876097610761176127613761476157616761776187619762076217622762376247625762676277628762976307631763276337634763576367637763876397640764176427643764476457646764776487649765076517652765376547655765676577658765976607661766276637664766576667667766876697670767176727673767476757676767776787679768076817682768376847685768676877688768976907691769276937694769576967697769876997700770177027703770477057706770777087709771077117712771377147715771677177718771977207721772277237724772577267727772877297730773177327733773477357736773777387739774077417742774377447745774677477748774977507751775277537754775577567757775877597760776177627763776477657766776777687769777077717772777377747775777677777778777977807781778277837784778577867787778877897790779177927793779477957796779777987799780078017802780378047805780678077808780978107811781278137814781578167817781878197820782178227823782478257826782778287829783078317832783378347835783678377838783978407841784278437844784578467847784878497850785178527853785478557856785778587859786078617862786378647865786678677868786978707871787278737874787578767877787878797880788178827883788478857886788778887889789078917892789378947895789678977898789979007901790279037904790579067907790879097910791179127913791479157916791779187919792079217922792379247925792679277928792979307931793279337934793579367937793879397940794179427943794479457946794779487949795079517952795379547955795679577958795979607961796279637964796579667967796879697970797179727973797479757976797779787979798079817982798379847985798679877988798979907991799279937994799579967997799879998000800180028003800480058006800780088009801080118012801380148015801680178018801980208021802280238024802580268027802880298030803180328033803480358036803780388039804080418042804380448045804680478048804980508051805280538054805580568057805880598060806180628063806480658066806780688069807080718072807380748075807680778078807980808081808280838084808580868087808880898090809180928093809480958096809780988099810081018102810381048105810681078108810981108111811281138114811581168117811881198120812181228123812481258126812781288129813081318132813381348135813681378138813981408141814281438144814581468147814881498150815181528153815481558156815781588159816081618162816381648165816681678168816981708171817281738174817581768177817881798180818181828183818481858186818781888189819081918192819381948195819681978198819982008201820282038204820582068207820882098210821182128213821482158216821782188219822082218222822382248225822682278228822982308231823282338234823582368237823882398240824182428243824482458246824782488249825082518252825382548255825682578258825982608261826282638264826582668267826882698270827182728273827482758276827782788279828082818282828382848285828682878288828982908291829282938294829582968297829882998300830183028303830483058306830783088309831083118312831383148315831683178318831983208321832283238324832583268327832883298330833183328333833483358336833783388339834083418342834383448345834683478348834983508351835283538354835583568357835883598360836183628363836483658366836783688369837083718372837383748375837683778378837983808381838283838384838583868387838883898390839183928393839483958396839783988399840084018402840384048405840684078408840984108411841284138414841584168417841884198420842184228423842484258426842784288429843084318432843384348435843684378438843984408441844284438444844584468447844884498450845184528453845484558456845784588459846084618462846384648465846684678468846984708471847284738474847584768477847884798480848184828483848484858486848784888489849084918492849384948495849684978498849985008501850285038504850585068507850885098510851185128513851485158516851785188519852085218522852385248525852685278528852985308531853285338534853585368537853885398540854185428543854485458546854785488549855085518552855385548555855685578558855985608561856285638564856585668567856885698570857185728573857485758576857785788579858085818582858385848585858685878588858985908591859285938594859585968597859885998600860186028603860486058606860786088609861086118612861386148615861686178618861986208621862286238624862586268627862886298630863186328633863486358636863786388639864086418642864386448645864686478648864986508651865286538654865586568657865886598660866186628663866486658666866786688669867086718672867386748675867686778678867986808681868286838684868586868687868886898690869186928693869486958696869786988699870087018702870387048705870687078708870987108711871287138714871587168717871887198720872187228723872487258726872787288729873087318732873387348735873687378738873987408741874287438744874587468747874887498750875187528753875487558756875787588759876087618762876387648765876687678768876987708771877287738774877587768777877887798780878187828783878487858786878787888789879087918792879387948795879687978798879988008801880288038804880588068807880888098810881188128813881488158816881788188819882088218822882388248825882688278828882988308831883288338834883588368837883888398840884188428843884488458846884788488849885088518852885388548855885688578858885988608861886288638864886588668867886888698870887188728873887488758876887788788879888088818882888388848885888688878888888988908891889288938894889588968897889888998900890189028903890489058906890789088909891089118912891389148915891689178918891989208921892289238924892589268927892889298930893189328933893489358936893789388939894089418942894389448945894689478948894989508951895289538954895589568957895889598960896189628963896489658966896789688969897089718972 |
- unit Compiler.SetupCompiler;
- {
- Inno Setup
- Copyright (C) 1997-2025 Jordan Russell
- Portions by Martijn Laan
- For conditions of distribution and use, see LICENSE.TXT.
- Compiler
- }
- {x$DEFINE STATICPREPROC}
- { For debugging purposes, remove the 'x' to have it link the ISPP code into this
- program and not depend on ISPP.dll. You will also need to add the Src
- folder to the Delphi Compiler Search path in the project options. Most useful
- when combined with IDE.MainForm's or ISCC's STATICCOMPILER. }
- {x$DEFINE TESTRETRIES}
- { For debugging purposes, remove the 'x' to have it simulate file-in-use errors
- while outputting Setup }
- interface
- uses
- Windows, SysUtils, Classes, Generics.Collections,
- SimpleExpression, SHA256, ChaCha20, Shared.SetupTypes, Shared.CommonFunc,
- Shared.Struct, Shared.CompilerInt.Struct, Shared.PreprocInt, Shared.SetupMessageIDs,
- Shared.SetupSectionDirectives, Shared.VerInfoFunc, Shared.DebugStruct,
- Compiler.ScriptCompiler, Compiler.StringLists, Compression.LZMACompressor,
- Compiler.ExeUpdateFunc;
- type
- EISCompileError = class(Exception);
- TParamFlags = set of (piRequired, piNoEmpty, piNoQuotes);
- TParamInfo = record
- Name: String;
- Flags: TParamFlags;
- end;
- TParamValue = record
- Found: Boolean;
- Data: String;
- end;
- TEnumIniSectionProc = procedure(const Line: PChar; const Ext: Integer) of object;
- TAllowedConst = (acOldData, acBreak);
- TAllowedConsts = set of TAllowedConst;
- TPreLangData = class
- public
- Name: String;
- LanguageCodePage: Word;
- end;
- TLangData = class
- public
- MessagesDefined: array[TSetupMessageID] of Boolean;
- Messages: array[TSetupMessageID] of String;
- end;
- TNameAndAccessMask = record
- Name: String;
- Mask: DWORD;
- end;
- TCheckOrInstallKind = (cikCheck, cikDirectiveCheck, cikInstall);
- TPrecompiledFile = (pfSetup, pfSetupCustomStyle, pfSetupLdr, pfIs7z, pfIsbunzip, pfIsunzlib, pfIslzma);
- TPrecompiledFiles = set of TPrecompiledFile;
- TWizardImages = TObjectList<TCustomMemoryStream>;
- TSetupLdr = (slNone, sl32bit, sl64bit);
- TSetupCompiler = class
- private
- ScriptFiles: TStringList;
- PreprocOptionsString: String;
- PreprocCleanupProc: TPreprocCleanupProc;
- PreprocCleanupProcData: Pointer;
- LanguageEntries,
- CustomMessageEntries,
- PermissionEntries,
- TypeEntries,
- ComponentEntries,
- TaskEntries,
- DirEntries,
- ISSigKeyEntries,
- FileEntries,
- FileLocationEntries,
- IconEntries,
- IniEntries,
- RegistryEntries,
- InstallDeleteEntries,
- UninstallDeleteEntries,
- RunEntries,
- UninstallRunEntries: TList;
- FileLocationEntryFilenames: THashStringList;
- FileLocationEntryExtraInfos: TList;
- ISSigKeyEntryExtraInfos: TList;
- WarningsList: THashStringList;
- ExpectedCustomMessageNames: TStringList;
- MissingMessagesWarning, MissingRunOnceIdsWarning, MissingRunOnceIds, NotRecognizedMessagesWarning, UsedUserAreasWarning: Boolean;
- UsedUserAreas: TStringList;
- PreprocIncludedFilenames: TStringList;
- PreprocOutput: String;
- DefaultLangData: TLangData;
- PreLangDataList, LangDataList: TList;
- SignToolList: TList;
- SignTools, SignToolsParams: TStringList;
- SignToolRetryCount, SignToolRetryDelay, SignToolMinimumTimeBetween: Integer;
- SignToolRunMinimized: Boolean;
- LastSignCommandStartTick: DWORD;
- OutputDir, OutputBaseFilename, OutputManifestFile, SignedUninstallerDir,
- ExeFilename: String;
- Output, FixedOutput, FixedOutputDir, FixedOutputBaseFilename: Boolean;
- CompressMethod: TSetupCompressMethod;
- InternalCompressLevel, CompressLevel: Integer;
- InternalCompressProps, CompressProps: TLZMACompressorProps;
- UseSolidCompression: Boolean;
- DontMergeDuplicateFiles: Boolean;
- DisablePrecompiledFileVerifications: TPrecompiledFiles;
- Password: String;
- CryptKey: TSetupEncryptionKey;
- TimeStampsInUTC: Boolean;
- TimeStampRounding: Integer;
- TouchDateOption: (tdCurrent, tdNone, tdExplicit);
- TouchDateYear, TouchDateMonth, TouchDateDay: Word;
- TouchTimeOption: (ttCurrent, ttNone, ttExplicit);
- TouchTimeHour, TouchTimeMinute, TouchTimeSecond: Word;
- SetupEncryptionHeader: TSetupEncryptionHeader;
- SetupHeader: TSetupHeader;
- SetupDirectiveLines: array[TSetupSectionDirective] of Integer;
- UseSetupLdr: TSetupLdr;
- DiskSpanning, TerminalServicesAware, DEPCompatible, ASLRCompatible: Boolean;
- DiskSliceSize: Int64;
- DiskClusterSize, SlicesPerDisk, ReserveBytes: Longint;
- LicenseFile, InfoBeforeFile, InfoAfterFile: String;
- WizardImageFile, WizardSmallImageFile, WizardBackImageFile: String;
- WizardImageFileDynamicDark, WizardSmallImageFileDynamicDark, WizardBackImageFileDynamicDark: String;
- WizardStyleFile, WizardStyleFileDynamicDark: String; { .vsf files }
- WizardStyleSpecial: String; { 'polar', etc. }
- DefaultDialogFontName: String;
- VersionInfoVersion, VersionInfoProductVersion: TFileVersionNumbers;
- VersionInfoVersionOriginalValue, VersionInfoCompany, VersionInfoCopyright,
- VersionInfoDescription, VersionInfoTextVersion, VersionInfoProductName, VersionInfoOriginalFileName,
- VersionInfoProductTextVersion, VersionInfoProductVersionOriginalValue: String;
- SetupIconFilename: String;
- CodeText: TStringList;
- CodeCompiler: TScriptCompiler;
- CompiledCodeText: AnsiString;
- CompileWasAlreadyCalled: Boolean;
- LineFilename: String;
- LineNumber: Integer;
- DebugInfo, CodeDebugInfo: TMemoryStream;
- DebugEntryCount, VariableDebugEntryCount: Integer;
- CompiledCodeTextLength, CompiledCodeDebugInfoLength: Integer;
- GotPrevFilename: Boolean;
- PrevFilename: String;
- PrevFileIndex: Integer;
- TotalBytesToCompress, BytesCompressedSoFar: Int64;
- CompressionInProgress: Boolean;
- CompressionStartTick: DWORD;
- CachedUserDocsDir: String;
- procedure AddStatus(const S: String; const Warning: Boolean = False);
- procedure AddStatusFmt(const Msg: String; const Args: array of const;
- const Warning: Boolean = False);
- procedure OnCheckedTrust(CheckedTrust: Boolean);
- class procedure AbortCompile(const Msg: String);
- class procedure AbortCompileParamError(const Msg, ParamName: String);
- function PrependDirName(const Filename, Dir: String): String;
- function PrependSourceDirName(const Filename: String): String;
- procedure DoCallback(const Code: Integer; var Data: TCompilerCallbackData;
- const IgnoreCallbackResult: Boolean = False);
- procedure EnumIniSection(const EnumProc: TEnumIniSectionProc;
- const SectionName: String; const Ext: Integer; const Verbose, SkipBlankLines: Boolean;
- const Filename: String; const LangSection: Boolean = False; const LangSectionPre: Boolean = False);
- function EvalCheckOrInstallIdentifier(Sender: TSimpleExpression; const Name: String;
- const Parameters: array of const): Boolean;
- procedure CheckCheckOrInstall(const ParamName, ParamData: String;
- const Kind: TCheckOrInstallKind);
- function CheckConst(const S: String; const MinVersion: TSetupVersionData;
- const AllowedConsts: TAllowedConsts): Boolean;
- procedure CheckCustomMessageDefinitions;
- procedure CheckCustomMessageReferences;
- procedure EnumTypesProc(const Line: PChar; const Ext: Integer);
- procedure EnumComponentsProc(const Line: PChar; const Ext: Integer);
- procedure EnumTasksProc(const Line: PChar; const Ext: Integer);
- procedure EnumDirsProc(const Line: PChar; const Ext: Integer);
- procedure EnumIconsProc(const Line: PChar; const Ext: Integer);
- procedure EnumINIProc(const Line: PChar; const Ext: Integer);
- procedure EnumLangOptionsPreProc(const Line: PChar; const Ext: Integer);
- procedure EnumLangOptionsProc(const Line: PChar; const Ext: Integer);
- procedure EnumLanguagesPreProc(const Line: PChar; const Ext: Integer);
- procedure EnumLanguagesProc(const Line: PChar; const Ext: Integer);
- procedure EnumRegistryProc(const Line: PChar; const Ext: Integer);
- procedure EnumDeleteProc(const Line: PChar; const Ext: Integer);
- procedure EnumISSigKeysProc(const Line: PChar; const Ext: Integer);
- procedure EnumFilesProc(const Line: PChar; const Ext: Integer);
- procedure EnumRunProc(const Line: PChar; const Ext: Integer);
- procedure EnumSetupProc(const Line: PChar; const Ext: Integer);
- procedure EnumMessagesProc(const Line: PChar; const Ext: Integer);
- procedure EnumCustomMessagesProc(const Line: PChar; const Ext: Integer);
- procedure ExtractParameters(S: PChar; const ParamInfo: array of TParamInfo;
- var ParamValues: array of TParamValue);
- function FindLangEntryIndexByName(const AName: String; const Pre: Boolean): Integer;
- function FindSignToolIndexByName(const AName: String): Integer;
- function GetLZMAExeFilename(const Allow64Bit: Boolean): String;
- procedure InitBzipDLL;
- procedure InitPreLangData(const APreLangData: TPreLangData);
- procedure InitLanguageEntry(var ALanguageEntry: TSetupLanguageEntry);
- procedure InitLZMADLL;
- procedure InitPreprocessor;
- procedure InitZipDLL;
- procedure PopulateLanguageEntryData;
- procedure ProcessMinVersionParameter(const ParamValue: TParamValue;
- var AMinVersion: TSetupVersionData);
- procedure ProcessOnlyBelowVersionParameter(const ParamValue: TParamValue;
- var AOnlyBelowVersion: TSetupVersionData);
- procedure ProcessPermissionsParameter(ParamData: String;
- const AccessMasks: array of TNameAndAccessMask; var PermissionsEntry: Smallint);
- function EvalArchitectureIdentifier(Sender: TSimpleExpression; const Name: String;
- const Parameters: array of const): Boolean;
- function EvalComponentIdentifier(Sender: TSimpleExpression; const Name: String;
- const Parameters: array of const): Boolean;
- function EvalTaskIdentifier(Sender: TSimpleExpression; const Name: String;
- const Parameters: array of const): Boolean;
- function EvalLanguageIdentifier(Sender: TSimpleExpression; const Name: String;
- const Parameters: array of const): Boolean;
- procedure ProcessExpressionParameter(const ParamName,
- ParamData: String; OnEvalIdentifier: TSimpleExpressionOnEvalIdentifier;
- SlashConvert: Boolean; var ProcessedParamData: String);
- procedure ProcessWildcardsParameter(const ParamData: String;
- const AWildcards: TStringList; const TooLongMsg: String);
- procedure ReadDefaultMessages;
- procedure ReadMessagesFromFilesPre(const AFiles: String; const ALangIndex: Integer);
- procedure ReadMessagesFromFiles(const AFiles: String; const ALangIndex: Integer);
- procedure ReadMessagesFromScriptPre;
- procedure ReadMessagesFromScript;
- function ReadScriptFile(const Filename: String; const UseCache: Boolean;
- const AnsiConvertCodePage: Word): TScriptFileLines;
- procedure RenamedConstantCallback(const Cnst, CnstRenamed: String);
- procedure EnumCodeProc(const Line: PChar; const Ext: Integer);
- procedure ReadCode;
- procedure CodeCompilerOnLineToLineInfo(const Line: LongInt; var Filename: String; var FileLine: LongInt);
- procedure CodeCompilerOnUsedLine(const Filename: String; const Line, Position: LongInt; const IsProcExit: Boolean);
- procedure CodeCompilerOnUsedVariable(const Filename: String; const Line, Col, Param1, Param2, Param3: LongInt; const Param4: AnsiString);
- procedure CodeCompilerOnError(const Msg: String; const ErrorFilename: String; const ErrorLine: LongInt);
- procedure CodeCompilerOnWarning(const Msg: String);
- procedure CompileCode;
- function FilenameToFileIndex(const AFileName: String): Integer;
- procedure ReadTextFile(const Filename: String; const LangIndex: Integer; var Text: AnsiString);
- procedure SeparateDirective(const Line: PChar; var Key, Value: String);
- procedure ShiftDebugEntryIndexes(AKind: TDebugEntryKind);
- procedure Sign(AExeFilename: String);
- procedure SignCommand(const AName, ACommand, AParams, AExeFilename: String; const RetryCount, RetryDelay, MinimumTimeBetween: Integer; const RunMinimized: Boolean);
- procedure WriteDebugEntry(Kind: TDebugEntryKind; Index: Integer; StepOutMarker: Boolean = False);
- procedure WriteCompiledCodeText(const CompiledCodeText: Ansistring);
- procedure WriteCompiledCodeDebugInfo(const CompiledCodeDebugInfo: AnsiString);
- function CreateWizardImagesFromFiles(const ADirectiveName, AFiles: String): TWizardImages;
- function CreateWizardImagesFromResources(const AResourceNamesPrefixes, AResourceNamesPostfixes: array of String; const ADark: Boolean): TWizardImages;
- procedure VerificationError(const AError: TVerificationError;
- const AFilename: String; const ASigFilename: String = '');
- procedure OnUpdateIconsAndStyle(const Operation: TUpdateIconsAndStyleOperation);
- public
- AppData: Longint;
- CallbackProc: TCompilerCallbackProc;
- CompilerDir, SourceDir, OriginalSourceDir: String;
- constructor Create(AOwner: TComponent);
- destructor Destroy; override;
- class procedure AbortCompileFmt(const Msg: String; const Args: array of const);
- procedure AddBytesCompressedSoFar(const Value: Int64);
- procedure AddPreprocOption(const Value: String);
- procedure AddSignTool(const Name, Command: String);
- procedure CallIdleProc(const IgnoreCallbackResult: Boolean = False);
- procedure Compile;
- function GetBytesCompressedSoFar: Int64;
- function GetDebugInfo: TMemoryStream;
- function GetDiskSliceSize: Int64;
- function GetDiskSpanning: Boolean;
- function GetEncryptionBaseNonce: TSetupEncryptionNonce;
- function GetExeFilename: String;
- function GetLineFilename: String;
- function GetLineNumber: Integer;
- function GetOutputBaseFileName: String;
- function GetOutputDir: String;
- function GetPreprocIncludedFilenames: TStringList;
- function GetPreprocOutput: String;
- function GetSlicesPerDisk: Longint;
- procedure SetBytesCompressedSoFar(const Value: Int64);
- procedure SetOutput(Value: Boolean);
- procedure SetOutputBaseFilename(const Value: String);
- procedure SetOutputDir(const Value: String);
- end;
- implementation
- uses
- Commctrl, TypInfo, AnsiStrings, Math, WideStrUtils,
- PathFunc, TrustFunc, ISSigFunc, ECDSA, UnsignedFunc,
- Compiler.Messages, Shared.SetupEntFunc,
- Shared.FileClass, Shared.EncryptionFunc, Compression.Base, Compression.Zlib, Compression.bzlib,
- Shared.LangOptionsSectionDirectives,
- {$IFDEF STATICPREPROC}
- ISPP.Preprocess,
- {$ENDIF}
- Compiler.CompressionHandler, Compiler.HelperFunc, Compiler.BuiltinPreproc;
- type
- TLineInfo = class
- public
- FileName: String;
- FileLineNumber: Integer;
- end;
- TSignTool = class
- Name, Command: String;
- end;
- PISSigKeyEntryExtraInfo = ^TISSigKeyEntryExtraInfo;
- TISSigKeyEntryExtraInfo = record
- Name: String;
- GroupNames: array of String;
- function HasGroupName(const GroupName: String): Boolean;
- end;
- TFileLocationSign = (fsNoSetting, fsYes, fsOnce, fsCheck);
- PFileLocationEntryExtraInfo = ^TFileLocationEntryExtraInfo;
- TFileLocationEntryExtraInfo = record
- Flags: set of (floVersionInfoNotValid, floIsUninstExe, floTouch,
- floSolidBreak, floNoTimeStamp);
- Sign: TFileLocationSign;
- Verification: TSetupFileVerification;
- ISSigKeyUsedID: String;
- end;
- var
- ZipInitialized, BzipInitialized, LZMAInitialized: Boolean;
- PreprocessorInitialized: Boolean;
- PreprocessScriptProc: TPreprocessScriptProc;
- const
- ParamCommonFlags = 'Flags';
- ParamCommonComponents = 'Components';
- ParamCommonTasks = 'Tasks';
- ParamCommonLanguages = 'Languages';
- ParamCommonCheck = 'Check';
- ParamCommonBeforeInstall = 'BeforeInstall';
- ParamCommonAfterInstall = 'AfterInstall';
- ParamCommonMinVersion = 'MinVersion';
- ParamCommonOnlyBelowVersion = 'OnlyBelowVersion';
- DefaultTypeEntryNames: array[0..2] of PChar = ('full', 'compact', 'custom');
- DefaultKDFIterations = 220000;
- function ExtractStr(var S: String; const Separator: Char): String;
- var
- I: Integer;
- begin
- repeat
- I := PathPos(Separator, S);
- if I = 0 then I := Length(S)+1;
- Result := Trim(Copy(S, 1, I-1));
- S := Trim(Copy(S, I+1, Maxint));
- until (Result <> '') or (S = '');
- end;
- { TISSigKeyEntryExtraInfo }
- function TISSigKeyEntryExtraInfo.HasGroupName(const GroupName: String): Boolean;
- begin
- for var I := 0 to Length(GroupNames)-1 do
- if SameText(GroupNames[I], GroupName) then
- Exit(True);
- Result := False;
- end;
- { TSetupCompiler }
- constructor TSetupCompiler.Create(AOwner: TComponent);
- begin
- inherited Create;
- ScriptFiles := TStringList.Create;
- LanguageEntries := TList.Create;
- CustomMessageEntries := TList.Create;
- PermissionEntries := TList.Create;
- TypeEntries := TList.Create;
- ComponentEntries := TList.Create;
- TaskEntries := TList.Create;
- DirEntries := TList.Create;
- ISSigKeyEntries := TList.Create;
- FileEntries := TList.Create;
- FileLocationEntries := TList.Create;
- IconEntries := TList.Create;
- IniEntries := TList.Create;
- RegistryEntries := TList.Create;
- InstallDeleteEntries := TList.Create;
- UninstallDeleteEntries := TList.Create;
- RunEntries := TList.Create;
- UninstallRunEntries := TList.Create;
- FileLocationEntryFilenames := THashStringList.Create;
- FileLocationEntryExtraInfos := TList.Create;
- ISSIgKeyEntryExtraInfos := TList.Create;
- WarningsList := THashStringList.Create;
- WarningsList.IgnoreDuplicates := True;
- ExpectedCustomMessageNames := TStringList.Create;
- UsedUserAreas := TStringList.Create;
- UsedUserAreas.Sorted := True;
- UsedUserAreas.Duplicates := dupIgnore;
- PreprocIncludedFilenames := TStringList.Create;
- DefaultLangData := TLangData.Create;
- PreLangDataList := TList.Create;
- LangDataList := TList.Create;
- SignToolList := TList.Create;
- SignTools := TStringList.Create;
- SignToolsParams := TStringList.Create;
- DebugInfo := TMemoryStream.Create;
- CodeDebugInfo := TMemoryStream.Create;
- CodeText := TStringList.Create;
- CodeCompiler := TScriptCompiler.Create;
- CodeCompiler.NamingAttribute := 'Event';
- CodeCompiler.OnLineToLineInfo := CodeCompilerOnLineToLineInfo;
- CodeCompiler.OnUsedLine := CodeCompilerOnUsedLine;
- CodeCompiler.OnUsedVariable := CodeCompilerOnUsedVariable;
- CodeCompiler.OnError := CodeCompilerOnError;
- CodeCompiler.OnWarning := CodeCompilerOnWarning;
- end;
- destructor TSetupCompiler.Destroy;
- var
- I: Integer;
- begin
- CodeCompiler.Free;
- CodeText.Free;
- CodeDebugInfo.Free;
- DebugInfo.Free;
- SignToolsParams.Free;
- SignTools.Free;
- if Assigned(SignToolList) then begin
- for I := 0 to SignToolList.Count-1 do
- TSignTool(SignToolList[I]).Free;
- SignToolList.Free;
- end;
- LangDataList.Free;
- PreLangDataList.Free;
- DefaultLangData.Free;
- PreprocIncludedFilenames.Free;
- UsedUserAreas.Free;
- ExpectedCustomMessageNames.Free;
- WarningsList.Free;
- ISSigKeyEntryExtraInfos.Free;
- FileLocationEntryExtraInfos.Free;
- FileLocationEntryFilenames.Free;
- UninstallRunEntries.Free;
- RunEntries.Free;
- UninstallDeleteEntries.Free;
- InstallDeleteEntries.Free;
- RegistryEntries.Free;
- IniEntries.Free;
- IconEntries.Free;
- FileLocationEntries.Free;
- FileEntries.Free;
- ISSigKeyEntries.Free;
- DirEntries.Free;
- TaskEntries.Free;
- ComponentEntries.Free;
- TypeEntries.Free;
- PermissionEntries.Free;
- CustomMessageEntries.Free;
- LanguageEntries.Free;
- ScriptFiles.Free;
- inherited Destroy;
- end;
- function TSetupCompiler.CreateWizardImagesFromFiles(const ADirectiveName, AFiles: String): TWizardImages;
- procedure AddFile(const Filename: String);
- begin
- AddStatus(Format(SCompilerStatusReadingInFile, [FileName]));
- Result.Add(CreateMemoryStreamFromFile(FileName));
- end;
- var
- Filename, SearchSubDir: String;
- AFilesList: TStringList;
- I: Integer;
- H: THandle;
- FindData: TWin32FindData;
- begin
- Result := TWizardImages.Create;
- try
- { In older versions only one file could be listed and comma's could be used so
- before treating AFiles as a list, first check if it's actually a single file
- with a comma in its name. }
- Filename := PrependSourceDirName(AFiles);
- if NewFileExists(Filename) then
- AddFile(Filename)
- else begin
- AFilesList := TStringList.Create;
- try
- ProcessWildcardsParameter(AFiles, AFilesList,
- Format(SCompilerDirectivePatternTooLong, [ADirectiveName]));
- for I := 0 to AFilesList.Count-1 do begin
- Filename := PrependSourceDirName(AFilesList[I]);
- if IsWildcard(FileName) then begin
- H := FindFirstFile(PChar(Filename), FindData);
- if H <> INVALID_HANDLE_VALUE then begin
- try
- SearchSubDir := PathExtractPath(Filename);
- repeat
- if FindData.dwFileAttributes and (FILE_ATTRIBUTE_DIRECTORY or FILE_ATTRIBUTE_HIDDEN) <> 0 then
- Continue;
- AddFile(SearchSubDir + FindData.cFilename);
- until not FindNextFile(H, FindData);
- finally
- Windows.FindClose(H);
- end;
- end;
- end else
- AddFile(Filename); { use the case specified in the script }
- end;
- finally
- AFilesList.Free;
- end;
- end;
- except
- Result.Free;
- raise;
- end;
- end;
- function TSetupCompiler.CreateWizardImagesFromResources(const AResourceNamesPrefixes, AResourceNamesPostfixes: array of String; const ADark: Boolean): TWizardImages;
- var
- I, J: Integer;
- begin
- var ADarkPostfix := '';
- if ADark then
- ADarkPostfix := '_Dark';
- Result := TWizardImages.Create;
- try
- for I := 0 to Length(AResourceNamesPrefixes)-1 do
- for J := 0 to Length(AResourceNamesPostfixes)-1 do
- Result.Add(TResourceStream.Create(HInstance, AResourceNamesPrefixes[I]+AResourceNamesPostfixes[J]+ADarkPostfix, RT_RCDATA));
- except
- Result.Free;
- raise;
- end;
- end;
- function LoadCompilerDLL(const Filename: String; const Options: TLoadTrustedLibraryOptions): HMODULE;
- begin
- try
- Result := LoadTrustedLibrary(FileName, Options);
- except
- begin
- TSetupCompiler.AbortCompileFmt('Failed to load %s: %s', [PathExtractName(Filename), GetExceptMessage]);
- Result := 0; //silence compiler
- end;
- end;
- end;
- procedure TSetupCompiler.InitPreprocessor;
- begin
- if PreprocessorInitialized then
- Exit;
- {$IFNDEF STATICPREPROC}
- var Filename := CompilerDir + 'ISPP.dll';
- if NewFileExists(Filename) then begin
- var M := LoadCompilerDLL(Filename, [ltloTrustAllOnDebug]);
- PreprocessScriptProc := GetProcAddress(M, 'ISPreprocessScriptW');
- if not Assigned(PreprocessScriptProc) then
- AbortCompile('Failed to get address of functions in ISPP.dll');
- end; { else ISPP unavailable; fall back to built-in preprocessor }
- {$ELSE}
- PreprocessScriptProc := ISPreprocessScript;
- {$ENDIF}
- PreprocessorInitialized := True;
- end;
- procedure TSetupCompiler.InitZipDLL;
- begin
- if ZipInitialized then
- Exit;
- var Filename := CompilerDir + 'iszlib.dll';
- var M := LoadCompilerDLL(Filename, []);
- if not ZlibInitCompressFunctions(M) then
- AbortCompile('Failed to get address of functions in iszlib.dll');
- ZipInitialized := True;
- end;
- procedure TSetupCompiler.InitBzipDLL;
- begin
- if BzipInitialized then
- Exit;
- var Filename := CompilerDir + 'isbzip.dll';
- var M := LoadCompilerDLL(Filename, []);
- if not BZInitCompressFunctions(M) then
- AbortCompile('Failed to get address of functions in isbzip.dll');
- BzipInitialized := True;
- end;
- procedure TSetupCompiler.InitLZMADLL;
- begin
- if LZMAInitialized then
- Exit;
- var Filename := CompilerDir + 'islzma.dll';
- var M := LoadCompilerDLL(Filename, [ltloTrustAllOnDebug]);
- if not LZMAInitCompressFunctions(M) then
- AbortCompile('Failed to get address of functions in islzma.dll');
- LZMAInitialized := True;
- end;
- function TSetupCompiler.GetBytesCompressedSoFar: Int64;
- begin
- Result := BytesCompressedSoFar;
- end;
- function TSetupCompiler.GetDebugInfo: TMemoryStream;
- begin
- Result := DebugInfo;
- end;
- function TSetupCompiler.GetDiskSliceSize: Int64;
- begin
- Result := DiskSliceSize;
- end;
- function TSetupCompiler.GetDiskSpanning: Boolean;
- begin
- Result := DiskSpanning;
- end;
- function TSetupCompiler.GetEncryptionBaseNonce: TSetupEncryptionNonce;
- begin
- Result := SetupEncryptionHeader.BaseNonce;
- end;
- function TSetupCompiler.GetExeFilename: String;
- begin
- Result := ExeFilename;
- end;
- function TSetupCompiler.GetLineFilename: String;
- begin
- Result := LineFilename;
- end;
- function TSetupCompiler.GetLineNumber: Integer;
- begin
- Result := LineNumber;
- end;
- function TSetupCompiler.GetLZMAExeFilename(const Allow64Bit: Boolean): String;
- const
- PROCESSOR_ARCHITECTURE_AMD64 = 9;
- ExeFilenames: array[Boolean] of String = ('islzma32.exe', 'islzma64.exe');
- var
- UseX64Exe: Boolean;
- GetNativeSystemInfoFunc: procedure(var lpSystemInfo: TSystemInfo); stdcall;
- SysInfo: TSystemInfo;
- begin
- UseX64Exe := False;
- if Allow64Bit then begin
- GetNativeSystemInfoFunc := GetProcAddress(GetModuleHandle(kernel32),
- 'GetNativeSystemInfo');
- if Assigned(GetNativeSystemInfoFunc) then begin
- GetNativeSystemInfoFunc(SysInfo);
- if SysInfo.wProcessorArchitecture = PROCESSOR_ARCHITECTURE_AMD64 then
- UseX64Exe := True;
- end;
- end;
- Result := CompilerDir + ExeFilenames[UseX64Exe];
- end;
- function TSetupCompiler.GetOutputBaseFileName: String;
- begin
- Result := OutputBaseFileName;
- end;
- function TSetupCompiler.GetOutputDir: String;
- begin
- Result := OutputDir;
- end;
- function TSetupCompiler.GetPreprocIncludedFilenames: TStringList;
- begin
- Result := PreprocIncludedFilenames;
- end;
- function TSetupCompiler.GetPreprocOutput: String;
- begin
- Result := PreprocOutput;
- end;
- function TSetupCompiler.GetSlicesPerDisk: Longint;
- begin
- Result := SlicesPerDisk;
- end;
- function TSetupCompiler.FilenameToFileIndex(const AFilename: String): Integer;
- begin
- if not GotPrevFilename or (PathCompare(AFilename, PrevFilename) <> 0) then begin
- { AFilename is non-empty when an include file is being read or when the compiler is reading
- CustomMessages/LangOptions/Messages sections from a messages file. Since these sections don't
- generate debug entries we can treat an empty AFileName as the main script and a non-empty
- AFilename as an include file. This works even when command-line compilation is used. }
- if AFilename = '' then
- PrevFileIndex := -1
- else begin
- PrevFileIndex := PreprocIncludedFilenames.IndexOf(AFilename);
- if PrevFileIndex = -1 then
- AbortCompileFmt('Failed to find index of file (%s)', [AFilename]);
- end;
- PrevFilename := AFilename;
- GotPrevFilename := True;
- end;
- Result := PrevFileIndex;
- end;
- procedure TSetupCompiler.WriteDebugEntry(Kind: TDebugEntryKind; Index: Integer; StepOutMarker: Boolean = False);
- var
- Rec: TDebugEntry;
- begin
- Rec.FileIndex := FilenameToFileIndex(LineFilename);
- Rec.LineNumber := LineNumber;
- Rec.Kind := Ord(Kind);
- Rec.Index := Index;
- Rec.StepOutMarker := StepOutMarker;
- DebugInfo.WriteBuffer(Rec, SizeOf(Rec));
- Inc(DebugEntryCount);
- end;
- procedure TSetupCompiler.WriteCompiledCodeText(const CompiledCodeText: AnsiString);
- begin
- CompiledCodeTextLength := Length(CompiledCodeText);
- CodeDebugInfo.WriteBuffer(CompiledCodeText[1], CompiledCodeTextLength);
- end;
- procedure TSetupCompiler.WriteCompiledCodeDebugInfo(const CompiledCodeDebugInfo: AnsiString);
- begin
- CompiledCodeDebugInfoLength := Length(CompiledCodeDebugInfo);
- CodeDebugInfo.WriteBuffer(CompiledCodeDebugInfo[1], CompiledCodeDebugInfoLength);
- end;
- procedure TSetupCompiler.ShiftDebugEntryIndexes(AKind: TDebugEntryKind);
- { Increments the Index field of each debug entry of the specified kind by 1.
- This has to be called when a new entry is inserted at the *front* of an
- *Entries array, since doing that causes the indexes of existing entries to
- shift. }
- var
- Rec: PDebugEntry;
- I: Integer;
- begin
- Cardinal(Rec) := Cardinal(DebugInfo.Memory) + SizeOf(TDebugInfoHeader);
- for I := 0 to DebugEntryCount-1 do begin
- if Rec.Kind = Ord(AKind) then
- Inc(Rec.Index);
- Inc(Rec);
- end;
- end;
- procedure TSetupCompiler.DoCallback(const Code: Integer;
- var Data: TCompilerCallbackData; const IgnoreCallbackResult: Boolean);
- begin
- case CallbackProc(Code, Data, AppData) of
- iscrSuccess: ;
- iscrRequestAbort: if not IgnoreCallbackResult then Abort;
- else
- AbortCompile('CallbackProc return code invalid');
- end;
- end;
- procedure TSetupCompiler.CallIdleProc(const IgnoreCallbackResult: Boolean);
- const
- ProgressMax = 1024;
- var
- Data: TCompilerCallbackData;
- MillisecondsElapsed: Cardinal;
- begin
- Data.SecondsRemaining := -1;
- Data.BytesCompressedPerSecond := 0;
- if (BytesCompressedSoFar = 0) or (TotalBytesToCompress = 0) then begin
- { Optimization(?) and avoid division by zero when TotalBytesToCompress=0 }
- Data.CompressProgress := 0;
- end
- else begin
- Data.CompressProgress := Trunc((Comp(BytesCompressedSoFar) * ProgressMax) /
- Comp(TotalBytesToCompress));
- { In case one of the files got bigger since we checked the sizes... }
- if Data.CompressProgress > ProgressMax then
- Data.CompressProgress := ProgressMax;
- if CompressionInProgress then begin
- MillisecondsElapsed := GetTickCount - CompressionStartTick;
- if MillisecondsElapsed >= Cardinal(1000) then begin
- var X := UInt64(BytesCompressedSoFar);
- X := X * 1000;
- X := X div MillisecondsElapsed;
- if X <= High(Cardinal) then
- Data.BytesCompressedPerSecond := Cardinal(X)
- else
- Data.BytesCompressedPerSecond := High(Cardinal);
- if BytesCompressedSoFar < TotalBytesToCompress then begin
- { Protect against division by zero }
- if Data.BytesCompressedPerSecond <> 0 then begin
- X := UInt64(TotalBytesToCompress);
- Dec(X, BytesCompressedSoFar);
- Inc(X, Data.BytesCompressedPerSecond-1); { round up }
- X := X div Data.BytesCompressedPerSecond;
- if X <= High(Integer) then
- Data.SecondsRemaining := Integer(X)
- else
- Data.SecondsRemaining := High(Integer);
- end;
- end
- else begin
- { In case one of the files got bigger since we checked the sizes... }
- Data.SecondsRemaining := 0;
- end;
- end;
- end;
- end;
- Data.CompressProgressMax := ProgressMax;
- DoCallback(iscbNotifyIdle, Data, IgnoreCallbackResult);
- end;
- type
- PPreCompilerData = ^TPreCompilerData;
- TPreCompilerData = record
- Compiler: TSetupCompiler;
- MainScript: Boolean;
- InFiles: TStringList;
- OutLines: TScriptFileLines;
- AnsiConvertCodePage: Word;
- CurInLine: String;
- ErrorSet: Boolean;
- ErrorMsg, ErrorFilename: String;
- ErrorLine, ErrorColumn: Integer;
- LastPrependDirNameResult: String;
- end;
- procedure PreErrorProc(CompilerData: TPreprocCompilerData; ErrorMsg: PChar;
- ErrorFilename: PChar; ErrorLine: Integer; ErrorColumn: Integer); stdcall; forward;
- function LoadFile(CompilerData: TPreprocCompilerData; AFilename: PChar;
- ErrorFilename: PChar; ErrorLine: Integer; ErrorColumn: Integer; FromPreProcessor: Boolean): TPreprocFileHandle;
- var
- Data: PPreCompilerData;
- Filename: String;
- I: Integer;
- Lines: TStringList;
- F: TTextFileReader;
- L: String;
- begin
- Data := CompilerData;
- Filename := AFilename;
- if Filename = '' then begin
- { Reject any attempt by the preprocessor to load the main script }
- PreErrorProc(CompilerData, 'Invalid parameter passed to PreLoadFileProc',
- ErrorFilename, ErrorLine, ErrorColumn);
- Result := -1;
- Exit;
- end;
- Filename := PathExpand(Filename);
- for I := 0 to Data.InFiles.Count-1 do
- if PathCompare(Data.InFiles[I], Filename) = 0 then begin
- Result := I;
- Exit;
- end;
- Lines := TStringList.Create;
- try
- if FromPreProcessor then begin
- Data.Compiler.AddStatus(Format(SCompilerStatusReadingInFile, [Filename]));
- if Data.MainScript then
- Data.Compiler.PreprocIncludedFilenames.Add(Filename);
- end;
- F := TTextFileReader.Create(Filename, fdOpenExisting, faRead, fsRead);
- try
- F.CodePage := Data.AnsiConvertCodePage;
- while not F.Eof do begin
- L := F.ReadLine;
- for I := 1 to Length(L) do
- if L[I] = #0 then
- raise Exception.CreateFmt(SCompilerIllegalNullChar, [Lines.Count + 1]);
- Lines.Add(L);
- end;
- finally
- F.Free;
- end;
- except
- Lines.Free;
- PreErrorProc(CompilerData, PChar(Format(SCompilerErrorOpeningIncludeFile,
- [Filename, GetExceptMessage])), ErrorFilename, ErrorLine, ErrorColumn);
- Result := -1;
- Exit;
- end;
- Result := Data.InFiles.AddObject(Filename, Lines);
- end;
- function PreLoadFileProc(CompilerData: TPreprocCompilerData; AFilename: PChar;
- ErrorFilename: PChar; ErrorLine: Integer; ErrorColumn: Integer): TPreprocFileHandle;
- stdcall;
- begin
- Result := LoadFile(CompilerData, AFilename, ErrorFilename, ErrorLine, ErrorColumn, True);
- end;
- function PreLineInProc(CompilerData: TPreprocCompilerData;
- FileHandle: TPreprocFileHandle; LineIndex: Integer): PChar; stdcall;
- var
- Data: PPreCompilerData;
- Lines: TStringList;
- begin
- Data := CompilerData;
- if (FileHandle >= 0) and (FileHandle < Data.InFiles.Count) and
- (LineIndex >= 0) then begin
- Lines := TStringList(Data.InFiles.Objects[FileHandle]);
- if LineIndex < Lines.Count then begin
- Data.CurInLine := Lines[LineIndex];
- Result := PChar(Data.CurInLine);
- end
- else
- Result := nil;
- end
- else begin
- PreErrorProc(CompilerData, 'Invalid parameter passed to LineInProc',
- nil, 0, 0);
- Result := nil;
- end;
- end;
- procedure PreLineOutProc(CompilerData: TPreprocCompilerData;
- Filename: PChar; LineNumber: Integer; Text: PChar); stdcall;
- var
- Data: PPreCompilerData;
- begin
- Data := CompilerData;
- Data.OutLines.Add(Filename, LineNumber, Text);
- end;
- procedure PreStatusProc(CompilerData: TPreprocCompilerData;
- StatusMsg: PChar; Warning: BOOL); stdcall;
- var
- Data: PPreCompilerData;
- begin
- Data := CompilerData;
- Data.Compiler.AddStatus(Format(SCompilerStatusPreprocessorStatus, [StatusMsg]), Warning);
- end;
- procedure PreErrorProc(CompilerData: TPreprocCompilerData; ErrorMsg: PChar;
- ErrorFilename: PChar; ErrorLine: Integer; ErrorColumn: Integer); stdcall;
- var
- Data: PPreCompilerData;
- begin
- Data := CompilerData;
- if not Data.ErrorSet then begin
- Data.ErrorMsg := ErrorMsg;
- Data.ErrorFilename := ErrorFilename;
- Data.ErrorLine := ErrorLine;
- Data.ErrorColumn := ErrorColumn;
- Data.ErrorSet := True;
- end;
- end;
- function PrePrependDirNameProc(CompilerData: TPreprocCompilerData;
- Filename: PChar; Dir: PChar; ErrorFilename: PChar; ErrorLine: Integer;
- ErrorColumn: Integer): PChar; stdcall;
- var
- Data: PPreCompilerData;
- begin
- Data := CompilerData;
- try
- Data.LastPrependDirNameResult := Data.Compiler.PrependDirName(
- PChar(Filename), PChar(Dir));
- Result := PChar(Data.LastPrependDirNameResult);
- except
- PreErrorProc(CompilerData, PChar(GetExceptMessage), ErrorFilename,
- ErrorLine, ErrorColumn);
- Result := nil;
- end;
- end;
- procedure PreIdleProc(CompilerData: TPreprocCompilerData); stdcall;
- var
- Data: PPreCompilerData;
- begin
- Data := CompilerData;
- Data.Compiler.CallIdleProc(True); { Doesn't allow an Abort }
- end;
- function TSetupCompiler.ReadScriptFile(const Filename: String;
- const UseCache: Boolean; const AnsiConvertCodePage: Word): TScriptFileLines;
- function ReadMainScriptLines: TStringList;
- var
- Reset: Boolean;
- Data: TCompilerCallbackData;
- begin
- Result := TStringList.Create;
- try
- Reset := True;
- while True do begin
- Data.Reset := Reset;
- Data.LineRead := nil;
- DoCallback(iscbReadScript, Data);
- if Data.LineRead = nil then
- Break;
- Result.Add(Data.LineRead);
- Reset := False;
- end;
- except
- Result.Free;
- raise;
- end;
- end;
- function SelectPreprocessor(const Lines: TStringList): TPreprocessScriptProc;
- var
- S: String;
- begin
- { Don't allow ISPPCC to be used if ISPP.dll is missing }
- if (PreprocOptionsString <> '') and not Assigned(PreprocessScriptProc) then
- raise Exception.Create(SCompilerISPPMissing);
- { By default, only pass the main script through ISPP }
- if (Filename = '') and Assigned(PreprocessScriptProc) then
- Result := PreprocessScriptProc
- else
- Result := BuiltinPreprocessScript;
- { Check for (and remove) #preproc override directive on the first line }
- if Lines.Count > 0 then begin
- S := Trim(Lines[0]);
- if S = '#preproc builtin' then begin
- Lines[0] := '';
- Result := BuiltinPreprocessScript;
- end
- else if S = '#preproc ispp' then begin
- Lines[0] := '';
- Result := PreprocessScriptProc;
- if not Assigned(Result) then
- raise Exception.Create(SCompilerISPPMissing);
- end;
- end;
- end;
- procedure PreprocessLines(const OutLines: TScriptFileLines);
- var
- LSourcePath, LCompilerPath: String;
- Params: TPreprocessScriptParams;
- Data: TPreCompilerData;
- FileLoaded: Boolean;
- ResultCode, CleanupResultCode, I: Integer;
- PreProc: TPreprocessScriptProc;
- begin
- LSourcePath := OriginalSourceDir;
- LCompilerPath := CompilerDir;
- FillChar(Params, SizeOf(Params), 0);
- Params.Size := SizeOf(Params);
- Params.InterfaceVersion := 3;
- Params.CompilerBinVersion := SetupBinVersion;
- Params.Filename := PChar(Filename);
- Params.SourcePath := PChar(LSourcePath);
- Params.CompilerPath := PChar(LCompilerPath);
- Params.Options := PChar(PreprocOptionsString);
- Params.CompilerData := @Data;
- Params.LoadFileProc := PreLoadFileProc;
- Params.LineInProc := PreLineInProc;
- Params.LineOutProc := PreLineOutProc;
- Params.StatusProc := PreStatusProc;
- Params.ErrorProc := PreErrorProc;
- Params.PrependDirNameProc := PrePrependDirNameProc;
- Params.IdleProc := PreIdleProc;
- FillChar(Data, SizeOf(Data), 0);
- Data.Compiler := Self;
- Data.OutLines := OutLines;
- Data.AnsiConvertCodePage := AnsiConvertCodePage;
- Data.InFiles := TStringList.Create;
- try
- if Filename = '' then begin
- Data.MainScript := True;
- Data.InFiles.AddObject('', ReadMainScriptLines);
- FileLoaded := True;
- end
- else
- FileLoaded := (LoadFile(Params.CompilerData, PChar(Filename),
- PChar(LineFilename), LineNumber, 0, False) = 0);
- ResultCode := ispePreprocessError;
- if FileLoaded then begin
- PreProc := SelectPreprocessor(TStringList(Data.InFiles.Objects[0]));
- if Filename = '' then
- AddStatus(SCompilerStatusPreprocessing);
- ResultCode := PreProc(Params);
- if Filename = '' then begin
- PreprocOutput := Data.Outlines.Text;
- { Defer cleanup of main script until after compilation }
- PreprocCleanupProcData := Params.PreprocCleanupProcData;
- PreprocCleanupProc := Params.PreprocCleanupProc;
- end
- else if Assigned(Params.PreprocCleanupProc) then begin
- CleanupResultCode := Params.PreprocCleanupProc(Params.PreprocCleanupProcData);
- if CleanupResultCode <> 0 then
- AbortCompileFmt('Preprocessor cleanup function for "%s" failed with code %d',
- [Filename, CleanupResultCode]);
- end;
- end;
- if Data.ErrorSet then begin
- LineFilename := Data.ErrorFilename;
- LineNumber := Data.ErrorLine;
- if Data.ErrorColumn > 0 then { hack for now... }
- Insert(Format('Column %d:' + SNewLine, [Data.ErrorColumn]),
- Data.ErrorMsg, 1);
- AbortCompile(Data.ErrorMsg);
- end;
- case ResultCode of
- ispeSuccess: ;
- ispeSilentAbort: Abort;
- else
- AbortCompileFmt('Preprocess function failed with code %d', [ResultCode]);
- end;
- finally
- for I := Data.InFiles.Count-1 downto 0 do
- Data.InFiles.Objects[I].Free;
- Data.InFiles.Free;
- end;
- end;
- var
- I: Integer;
- Lines: TScriptFileLines;
- begin
- if UseCache then
- for I := 0 to ScriptFiles.Count-1 do
- if PathCompare(ScriptFiles[I], Filename) = 0 then begin
- Result := TScriptFileLines(ScriptFiles.Objects[I]);
- Exit;
- end;
- Lines := TScriptFileLines.Create;
- try
- PreprocessLines(Lines);
- except
- Lines.Free;
- raise;
- end;
- if UseCache then
- ScriptFiles.AddObject(Filename, Lines);
- Result := Lines;
- end;
- procedure TSetupCompiler.EnumIniSection(const EnumProc: TEnumIniSectionProc;
- const SectionName: String; const Ext: Integer; const Verbose, SkipBlankLines: Boolean;
- const Filename: String; const LangSection, LangSectionPre: Boolean);
- var
- FoundSection: Boolean;
- LastSection: String;
- procedure DoFile(Filename: String);
- const
- PreCodePage = 1252;
- var
- UseCache: Boolean;
- Lines: TScriptFileLines;
- SaveLineFilename, L: String;
- SaveLineNumber, LineIndex, I: Integer;
- Line: PScriptFileLine;
- begin
- if Filename <> '' then
- Filename := PathExpand(PrependSourceDirName(Filename));
- UseCache := not (LangSection and LangSectionPre);
- var AnsiConvertCodePage: Word := 0;
- if LangSection then begin
- { During a Pre pass on an .isl file, use code page 1252 for translation.
- Previously, the system code page was used, but on DBCS that resulted in
- "Illegal null character" errors on files containing byte sequences that
- do not form valid lead/trail byte combinations (i.e. most languages). }
- if LangSectionPre then begin
- if not IsValidCodePage(PreCodePage) then { just in case }
- AbortCompileFmt('Code page %u unsupported', [PreCodePage]);
- AnsiConvertCodePage := PreCodePage;
- end else if Ext >= 0 then begin
- { Ext = LangIndex, except for Default.isl for which its -2 when default
- messages are read but no special conversion is needed for those. }
- AnsiConvertCodePage := TPreLangData(PreLangDataList[Ext]).LanguageCodePage;
- end;
- end;
- Lines := ReadScriptFile(Filename, UseCache, AnsiConvertCodePage);
- try
- SaveLineFilename := LineFilename;
- SaveLineNumber := LineNumber;
- for LineIndex := 0 to Lines.Count-1 do begin
- Line := Lines[LineIndex];
- LineFilename := Line.LineFilename;
- LineNumber := Line.LineNumber;
- L := Trim(Line.LineText);
- { Check for blank lines or comments }
- if (not FoundSection or SkipBlankLines) and ((L = '') or (L[1] = ';')) then Continue;
- if (L <> '') and (L[1] = '[') then begin
- { Section tag }
- I := Pos(']', L);
- if (I < 3) or (I <> Length(L)) then
- AbortCompile(SCompilerSectionTagInvalid);
- L := Copy(L, 2, I-2);
- if L[1] = '/' then begin
- L := Copy(L, 2, Maxint);
- if (LastSection = '') or (CompareText(L, LastSection) <> 0) then
- AbortCompileFmt(SCompilerSectionBadEndTag, [L]);
- FoundSection := False;
- LastSection := '';
- end
- else begin
- FoundSection := (CompareText(L, SectionName) = 0);
- LastSection := L;
- end;
- end
- else begin
- if not FoundSection then begin
- if LastSection = '' then
- AbortCompile(SCompilerTextNotInSection);
- Continue; { not on the right section }
- end;
- if Verbose then begin
- if LineFilename = '' then
- AddStatus(Format(SCompilerStatusParsingSectionLine,
- [SectionName, LineNumber]))
- else
- AddStatus(Format(SCompilerStatusParsingSectionLineFile,
- [SectionName, LineNumber, LineFilename]));
- end;
- EnumProc(PChar(Line.LineText), Ext);
- end;
- end;
- LineFilename := SaveLineFilename;
- LineNumber := SaveLineNumber;
- finally
- if not UseCache then
- Lines.Free;
- end;
- end;
- begin
- FoundSection := False;
- LastSection := '';
- DoFile(Filename);
- end;
- procedure TSetupCompiler.ExtractParameters(S: PChar;
- const ParamInfo: array of TParamInfo; var ParamValues: array of TParamValue);
- function GetParamIndex(const AName: String): Integer;
- var
- I: Integer;
- begin
- for I := 0 to High(ParamInfo) do
- if CompareText(ParamInfo[I].Name, AName) = 0 then begin
- Result := I;
- if ParamValues[I].Found then
- AbortCompileParamError(SCompilerParamDuplicated, ParamInfo[I].Name);
- ParamValues[I].Found := True;
- Exit;
- end;
- { Unknown parameter }
- AbortCompileFmt(SCompilerParamUnknownParam, [AName]);
- Result := -1;
- end;
- var
- I, ParamIndex: Integer;
- ParamName, Data: String;
- begin
- for I := 0 to High(ParamValues) do begin
- ParamValues[I].Found := False;
- ParamValues[I].Data := '';
- end;
- while True do begin
- { Parameter name }
- SkipWhitespace(S);
- if S^ = #0 then
- Break;
- ParamName := ExtractWords(S, ':');
- ParamIndex := GetParamIndex(ParamName);
- if S^ <> ':' then
- AbortCompileFmt(SCompilerParamHasNoValue, [ParamName]);
- Inc(S);
- { Parameter value }
- SkipWhitespace(S);
- if S^ <> '"' then begin
- Data := ExtractWords(S, ';');
- if Pos('"', Data) <> 0 then
- AbortCompileFmt(SCompilerParamQuoteError, [ParamName]);
- if S^ = ';' then
- Inc(S);
- end
- else begin
- Inc(S);
- Data := '';
- while True do begin
- if S^ = #0 then
- AbortCompileFmt(SCompilerParamMissingClosingQuote, [ParamName]);
- if S^ = '"' then begin
- Inc(S);
- if S^ <> '"' then
- Break;
- end;
- Data := Data + S^;
- Inc(S);
- end;
- SkipWhitespace(S);
- case S^ of
- #0 : ;
- ';': Inc(S);
- else
- AbortCompileFmt(SCompilerParamQuoteError, [ParamName]);
- end;
- end;
- { Assign the data }
- if (piNoEmpty in ParamInfo[ParamIndex].Flags) and (Data = '') then
- AbortCompileParamError(SCompilerParamEmpty2, ParamInfo[ParamIndex].Name);
- if (piNoQuotes in ParamInfo[ParamIndex].Flags) and (Pos('"', Data) <> 0) then
- AbortCompileParamError(SCompilerParamNoQuotes2, ParamInfo[ParamIndex].Name);
- ParamValues[ParamIndex].Data := Data;
- end;
- { Check for missing required parameters }
- for I := 0 to High(ParamInfo) do begin
- if (piRequired in ParamInfo[I].Flags) and
- not ParamValues[I].Found then
- AbortCompileParamError(SCompilerParamNotSpecified, ParamInfo[I].Name);
- end;
- end;
- procedure TSetupCompiler.AddStatus(const S: String; const Warning: Boolean);
- var
- Data: TCompilerCallbackData;
- begin
- Data.StatusMsg := PChar(S);
- Data.Warning := Warning;
- DoCallback(iscbNotifyStatus, Data);
- end;
- procedure TSetupCompiler.AddStatusFmt(const Msg: String; const Args: array of const;
- const Warning: Boolean);
- begin
- AddStatus(Format(Msg, Args), Warning);
- end;
- procedure TSetupCompiler.OnCheckedTrust(CheckedTrust: Boolean);
- begin
- if CheckedTrust then
- AddStatus(SCompilerStatusVerified)
- else
- AddStatus(SCompilerStatusVerificationDisabled);
- end;
- class procedure TSetupCompiler.AbortCompile(const Msg: String);
- begin
- raise EISCompileError.Create(Msg);
- end;
- class procedure TSetupCompiler.AbortCompileFmt(const Msg: String; const Args: array of const);
- begin
- AbortCompile(Format(Msg, Args));
- end;
- class procedure TSetupCompiler.AbortCompileParamError(const Msg, ParamName: String);
- begin
- AbortCompileFmt(Msg, [ParamName]);
- end;
- function TSetupCompiler.PrependDirName(const Filename, Dir: String): String;
- function GetShellFolderPathCached(const FolderID: Integer;
- var CachedDir: String): String;
- var
- S: String;
- begin
- if CachedDir = '' then begin
- S := GetShellFolderPath(FolderID);
- if S = '' then
- AbortCompileFmt('Failed to get shell folder path (0x%.4x)', [FolderID]);
- S := AddBackslash(PathExpand(S));
- CachedDir := S;
- end;
- Result := CachedDir;
- end;
- const
- CSIDL_PERSONAL = $0005;
- var
- P: Integer;
- Prefix: String;
- begin
- P := PathPos(':', Filename);
- if (P = 0) or
- ((P = 2) and CharInSet(UpCase(Filename[1]), ['A'..'Z'])) then begin
- if (Filename = '') or not IsRelativePath(Filename) then
- Result := Filename
- else
- Result := Dir + Filename;
- end
- else begin
- Prefix := Copy(Filename, 1, P-1);
- if Prefix = 'builtin' then
- Result := Filename
- else if Prefix = 'compiler' then
- Result := CompilerDir + Copy(Filename, P+1, Maxint)
- else if Prefix = 'userdocs' then
- Result := GetShellFolderPathCached(CSIDL_PERSONAL, CachedUserDocsDir) +
- Copy(Filename, P+1, Maxint)
- else begin
- AbortCompileFmt(SCompilerUnknownFilenamePrefix, [Copy(Filename, 1, P)]);
- Result := Filename; { avoid warning }
- end;
- end;
- end;
- function TSetupCompiler.PrependSourceDirName(const Filename: String): String;
- begin
- Result := PrependDirName(Filename, SourceDir);
- end;
- procedure TSetupCompiler.RenamedConstantCallback(const Cnst, CnstRenamed: String);
- begin
- if Pos('common', LowerCase(CnstRenamed)) <> 0 then
- WarningsList.Add(Format(SCompilerCommonConstantRenamed, [Cnst, CnstRenamed]))
- else
- WarningsList.Add(Format(SCompilerConstantRenamed, [Cnst, CnstRenamed]));
- end;
- function TSetupCompiler.CheckConst(const S: String; const MinVersion: TSetupVersionData;
- const AllowedConsts: TAllowedConsts): Boolean;
- { Returns True if S contains constants. Aborts compile if they are invalid. }
- function CheckEnvConst(C: String): Boolean;
- { based on ExpandEnvConst in Main.pas }
- var
- I: Integer;
- VarName, Default: String;
- begin
- Delete(C, 1, 1);
- I := ConstPos('|', C); { check for 'default' value }
- if I = 0 then
- I := Length(C)+1;
- VarName := Copy(C, 1, I-1);
- Default := Copy(C, I+1, Maxint);
- if ConvertConstPercentStr(VarName) and ConvertConstPercentStr(Default) then begin
- CheckConst(VarName, MinVersion, AllowedConsts);
- CheckConst(Default, MinVersion, AllowedConsts);
- Result := True;
- Exit;
- end;
- { it will only reach here if there was a parsing error }
- Result := False;
- end;
- function CheckRegConst(C: String): Boolean;
- { based on ExpandRegConst in Main.pas }
- type
- TKeyNameConst = packed record
- KeyName: String;
- KeyConst: HKEY;
- end;
- const
- KeyNameConsts: array[0..5] of TKeyNameConst = (
- (KeyName: 'HKA'; KeyConst: HKEY_AUTO),
- (KeyName: 'HKCR'; KeyConst: HKEY_CLASSES_ROOT),
- (KeyName: 'HKCU'; KeyConst: HKEY_CURRENT_USER),
- (KeyName: 'HKLM'; KeyConst: HKEY_LOCAL_MACHINE),
- (KeyName: 'HKU'; KeyConst: HKEY_USERS),
- (KeyName: 'HKCC'; KeyConst: HKEY_CURRENT_CONFIG));
- var
- Z, Subkey, Value, Default: String;
- I, J, L: Integer;
- RootKey: HKEY;
- begin
- Delete(C, 1, 4); { skip past 'reg:' }
- I := ConstPos('\', C);
- if I <> 0 then begin
- Z := Copy(C, 1, I-1);
- if Z <> '' then begin
- L := Length(Z);
- if L >= 2 then begin
- { Check for '32' or '64' suffix }
- if ((Z[L-1] = '3') and (Z[L] = '2')) or
- ((Z[L-1] = '6') and (Z[L] = '4')) then
- SetLength(Z, L-2);
- end;
- RootKey := 0;
- for J := Low(KeyNameConsts) to High(KeyNameConsts) do
- if CompareText(KeyNameConsts[J].KeyName, Z) = 0 then begin
- RootKey := KeyNameConsts[J].KeyConst;
- Break;
- end;
- if RootKey <> 0 then begin
- Z := Copy(C, I+1, Maxint);
- I := ConstPos('|', Z); { check for a 'default' data }
- if I = 0 then
- I := Length(Z)+1;
- Default := Copy(Z, I+1, Maxint);
- SetLength(Z, I-1);
- I := ConstPos(',', Z); { comma separates subkey and value }
- if I <> 0 then begin
- Subkey := Copy(Z, 1, I-1);
- Value := Copy(Z, I+1, Maxint);
- if ConvertConstPercentStr(Subkey) and ConvertConstPercentStr(Value) and
- ConvertConstPercentStr(Default) then begin
- CheckConst(Subkey, MinVersion, AllowedConsts);
- CheckConst(Value, MinVersion, AllowedConsts);
- CheckConst(Default, MinVersion, AllowedConsts);
- Result := True;
- Exit;
- end;
- end;
- end;
- end;
- end;
- { it will only reach here if there was a parsing error }
- Result := False;
- end;
- function CheckIniConst(C: String): Boolean;
- { based on ExpandIniConst in Main.pas }
- var
- Z, Filename, Section, Key, Default: String;
- I: Integer;
- begin
- Delete(C, 1, 4); { skip past 'ini:' }
- I := ConstPos(',', C);
- if I <> 0 then begin
- Z := Copy(C, 1, I-1);
- if Z <> '' then begin
- Filename := Z;
- Z := Copy(C, I+1, Maxint);
- I := ConstPos('|', Z); { check for a 'default' data }
- if I = 0 then
- I := Length(Z)+1;
- Default := Copy(Z, I+1, Maxint);
- SetLength(Z, I-1);
- I := ConstPos(',', Z); { comma separates section and key }
- if I <> 0 then begin
- Section := Copy(Z, 1, I-1);
- Key := Copy(Z, I+1, Maxint);
- if ConvertConstPercentStr(Filename) and ConvertConstPercentStr(Section) and
- ConvertConstPercentStr(Key) and ConvertConstPercentStr(Default) then begin
- CheckConst(Filename, MinVersion, AllowedConsts);
- CheckConst(Section, MinVersion, AllowedConsts);
- CheckConst(Key, MinVersion, AllowedConsts);
- CheckConst(Default, MinVersion, AllowedConsts);
- Result := True;
- Exit;
- end;
- end;
- end;
- end;
- { it will only reach here if there was a parsing error }
- Result := False;
- end;
- function CheckParamConst(C: String): Boolean;
- var
- Z, Param, Default: String;
- I: Integer;
- begin
- Delete(C, 1, 6); { skip past 'param:' }
- Z := C;
- I := ConstPos('|', Z); { check for a 'default' data }
- if I = 0 then
- I := Length(Z)+1;
- Default := Copy(Z, I+1, Maxint);
- SetLength(Z, I-1);
- Param := Z;
- if ConvertConstPercentStr(Param) and ConvertConstPercentStr(Default) then begin
- CheckConst(Param, MinVersion, AllowedConsts);
- CheckConst(Default, MinVersion, AllowedConsts);
- Result := True;
- Exit;
- end;
- { it will only reach here if there was a parsing error }
- Result := False;
- end;
- function CheckCodeConst(C: String): Boolean;
- var
- Z, ScriptFunc, Param: String;
- I: Integer;
- begin
- Delete(C, 1, 5); { skip past 'code:' }
- Z := C;
- I := ConstPos('|', Z); { check for optional parameter }
- if I = 0 then
- I := Length(Z)+1;
- Param := Copy(Z, I+1, Maxint);
- SetLength(Z, I-1);
- ScriptFunc := Z;
- if ConvertConstPercentStr(ScriptFunc) and ConvertConstPercentStr(Param) then begin
- CheckConst(Param, MinVersion, AllowedConsts);
- CodeCompiler.AddExport(ScriptFunc, 'String @String', False, True, LineFileName, LineNumber);
- Result := True;
- Exit;
- end;
- { it will only reach here if there was a parsing error }
- Result := False;
- end;
- function CheckDriveConst(C: String): Boolean;
- begin
- Delete(C, 1, 6); { skip past 'drive:' }
- if ConvertConstPercentStr(C) then begin
- CheckConst(C, MinVersion, AllowedConsts);
- Result := True;
- Exit;
- end;
- { it will only reach here if there was a parsing error }
- Result := False;
- end;
- function CheckCustomMessageConst(C: String): Boolean;
- var
- MsgName, Arg: String;
- I, ArgCount: Integer;
- Found: Boolean;
- LineInfo: TLineInfo;
- begin
- Delete(C, 1, 3); { skip past 'cm:' }
- I := ConstPos(',', C);
- if I = 0 then
- MsgName := C
- else
- MsgName := Copy(C, 1, I-1);
- { Check each argument }
- ArgCount := 0;
- while I > 0 do begin
- if ArgCount >= 9 then begin
- { Can't have more than 9 arguments (%1 through %9) }
- Result := False;
- Exit;
- end;
- Delete(C, 1, I);
- I := ConstPos(',', C);
- if I = 0 then
- Arg := C
- else
- Arg := Copy(C, 1, I-1);
- if not ConvertConstPercentStr(Arg) then begin
- Result := False;
- Exit;
- end;
- CheckConst(Arg, MinVersion, AllowedConsts);
- Inc(ArgCount);
- end;
- Found := False;
- for I := 0 to ExpectedCustomMessageNames.Count-1 do begin
- if CompareText(ExpectedCustomMessageNames[I], MsgName) = 0 then begin
- Found := True;
- Break;
- end;
- end;
- if not Found then begin
- LineInfo := TLineInfo.Create;
- LineInfo.FileName := LineFileName;
- LineInfo.FileLineNumber := LineNumber;
- ExpectedCustomMessageNames.AddObject(MsgName, LineInfo);
- end;
- Result := True;
- end;
- const
- UserConsts: array[0..0] of String = (
- 'username');
- Consts: array[0..41] of String = (
- 'src', 'srcexe', 'tmp', 'app', 'win', 'sys', 'sd', 'groupname', 'commonfonts',
- 'commonpf', 'commonpf32', 'commonpf64', 'commoncf', 'commoncf32', 'commoncf64',
- 'autopf', 'autopf32', 'autopf64', 'autocf', 'autocf32', 'autocf64',
- 'computername', 'dao', 'cmd', 'wizardhwnd', 'sysuserinfoname', 'sysuserinfoorg',
- 'userinfoname', 'userinfoorg', 'userinfoserial', 'uninstallexe',
- 'language', 'syswow64', 'sysnative', 'log', 'dotnet11', 'dotnet20', 'dotnet2032',
- 'dotnet2064', 'dotnet40', 'dotnet4032', 'dotnet4064');
- UserShellFolderConsts: array[0..13] of String = (
- 'userdesktop', 'userstartmenu', 'userprograms', 'userstartup',
- 'userappdata', 'userdocs', 'usertemplates', 'userfavorites', 'usersendto', 'userfonts',
- 'localappdata', 'userpf', 'usercf', 'usersavedgames');
- ShellFolderConsts: array[0..16] of String = (
- 'group', 'commondesktop', 'commonstartmenu', 'commonprograms', 'commonstartup',
- 'commonappdata', 'commondocs', 'commontemplates',
- 'autodesktop', 'autostartmenu', 'autoprograms', 'autostartup',
- 'autoappdata', 'autodocs', 'autotemplates', 'autofavorites', 'autofonts');
- AllowedConstsNames: array[TAllowedConst] of String = (
- 'olddata', 'break');
- var
- I, Start, K: Integer;
- C: TAllowedConst;
- Cnst: String;
- label 1;
- begin
- Result := False;
- I := 1;
- while I <= Length(S) do begin
- if S[I] = '{' then begin
- if (I < Length(S)) and (S[I+1] = '{') then
- Inc(I)
- else begin
- Result := True;
- Start := I;
- { Find the closing brace, skipping over any embedded constants }
- I := SkipPastConst(S, I);
- if I = 0 then { unclosed constant? }
- AbortCompileFmt(SCompilerUnterminatedConst, [Copy(S, Start+1, Maxint)]);
- Dec(I); { 'I' now points to the closing brace }
- { Now check the constant }
- Cnst := Copy(S, Start+1, I-(Start+1));
- if Cnst <> '' then begin
- HandleRenamedConstants(Cnst, RenamedConstantCallback);
- if Cnst = '\' then
- goto 1;
- if Cnst[1] = '%' then begin
- if not CheckEnvConst(Cnst) then
- AbortCompileFmt(SCompilerBadEnvConst, [Cnst]);
- goto 1;
- end;
- if Copy(Cnst, 1, 4) = 'reg:' then begin
- if not CheckRegConst(Cnst) then
- AbortCompileFmt(SCompilerBadRegConst, [Cnst]);
- goto 1;
- end;
- if Copy(Cnst, 1, 4) = 'ini:' then begin
- if not CheckIniConst(Cnst) then
- AbortCompileFmt(SCompilerBadIniConst, [Cnst]);
- goto 1;
- end;
- if Copy(Cnst, 1, 6) = 'param:' then begin
- if not CheckParamConst(Cnst) then
- AbortCompileFmt(SCompilerBadParamConst, [Cnst]);
- goto 1;
- end;
- if Copy(Cnst, 1, 5) = 'code:' then begin
- if not CheckCodeConst(Cnst) then
- AbortCompileFmt(SCompilerBadCodeConst, [Cnst]);
- goto 1;
- end;
- if Copy(Cnst, 1, 6) = 'drive:' then begin
- if not CheckDriveConst(Cnst) then
- AbortCompileFmt(SCompilerBadDriveConst, [Cnst]);
- goto 1;
- end;
- if Copy(Cnst, 1, 3) = 'cm:' then begin
- if not CheckCustomMessageConst(Cnst) then
- AbortCompileFmt(SCompilerBadCustomMessageConst, [Cnst]);
- goto 1;
- end;
- for K := Low(UserConsts) to High(UserConsts) do
- if Cnst = UserConsts[K] then begin
- UsedUserAreas.Add(Cnst);
- goto 1;
- end;
- for K := Low(Consts) to High(Consts) do
- if Cnst = Consts[K] then
- goto 1;
- for K := Low(UserShellFolderConsts) to High(UserShellFolderConsts) do
- if Cnst = UserShellFolderConsts[K] then begin
- UsedUserAreas.Add(Cnst);
- goto 1;
- end;
- for K := Low(ShellFolderConsts) to High(ShellFolderConsts) do
- if Cnst = ShellFolderConsts[K] then
- goto 1;
- for C := Low(C) to High(C) do
- if Cnst = AllowedConstsNames[C] then begin
- if not(C in AllowedConsts) then
- AbortCompileFmt(SCompilerConstCannotUse, [Cnst]);
- goto 1;
- end;
- end;
- AbortCompileFmt(SCompilerUnknownConst, [Cnst]);
- 1:{ Constant is OK }
- end;
- end;
- Inc(I);
- end;
- end;
- function TSetupCompiler.EvalCheckOrInstallIdentifier(Sender: TSimpleExpression;
- const Name: String; const Parameters: array of const): Boolean;
- var
- IsCheck: Boolean;
- Decl: String;
- I: Integer;
- begin
- IsCheck := Boolean(Sender.Tag);
- if IsCheck then
- Decl := 'Boolean'
- else
- Decl := '0';
- for I := Low(Parameters) to High(Parameters) do begin
- if Parameters[I].VType = vtUnicodeString then
- Decl := Decl + ' @String'
- else if Parameters[I].VType = vtInteger then
- Decl := Decl + ' @LongInt'
- else if Parameters[I].VType = vtBoolean then
- Decl := Decl + ' @Boolean'
- else
- raise Exception.Create('Internal Error: unknown parameter type');
- end;
- CodeCompiler.AddExport(Name, Decl, False, True, LineFileName, LineNumber);
- Result := True; { Result doesn't matter }
- end;
- procedure TSetupCompiler.CheckCheckOrInstall(const ParamName, ParamData: String;
- const Kind: TCheckOrInstallKind);
- var
- SimpleExpression: TSimpleExpression;
- IsCheck, BoolResult: Boolean;
- begin
- if ParamData <> '' then begin
- if (Kind <> cikDirectiveCheck) or not TryStrToBoolean(ParamData, BoolResult) then begin
- IsCheck := Kind in [cikCheck, cikDirectiveCheck];
- { Check the expression in ParamData and add exports while
- evaluating. Use non-Lazy checking to make sure everything is evaluated. }
- try
- SimpleExpression := TSimpleExpression.Create;
- try
- SimpleExpression.Lazy := False;
- SimpleExpression.Expression := ParamData;
- SimpleExpression.OnEvalIdentifier := EvalCheckOrInstallIdentifier;
- SimpleExpression.SilentOrAllowed := False;
- SimpleExpression.SingleIdentifierMode := not IsCheck;
- SimpleExpression.ParametersAllowed := True;
- SimpleExpression.Tag := Integer(IsCheck);
- SimpleExpression.Eval;
- finally
- SimpleExpression.Free;
- end;
- except
- AbortCompileFmt(SCompilerExpressionError, [ParamName,
- GetExceptMessage]);
- end;
- end;
- end
- else begin
- if Kind = cikDirectiveCheck then
- AbortCompileFmt(SCompilerEntryInvalid2, ['Setup', ParamName]);
- end;
- end;
- function ExtractFlag(var S: String; const FlagStrs: array of PChar): Integer;
- var
- I: Integer;
- F: String;
- begin
- F := ExtractStr(S, ' ');
- if F = '' then begin
- Result := -2;
- Exit;
- end;
- Result := -1;
- for I := 0 to High(FlagStrs) do
- if StrIComp(FlagStrs[I], PChar(F)) = 0 then begin
- Result := I;
- Break;
- end;
- end;
- function ExtractType(var S: String; const TypeEntries: TList): Integer;
- var
- I: Integer;
- F: String;
- begin
- F := ExtractStr(S, ' ');
- if F = '' then begin
- Result := -2;
- Exit;
- end;
- Result := -1;
- if TypeEntries.Count <> 0 then begin
- for I := 0 to TypeEntries.Count-1 do
- if CompareText(PSetupTypeEntry(TypeEntries[I]).Name, F) = 0 then begin
- Result := I;
- Break;
- end;
- end else begin
- for I := 0 to High(DefaultTypeEntryNames) do
- if StrIComp(DefaultTypeEntryNames[I], PChar(F)) = 0 then begin
- Result := I;
- Break;
- end;
- end;
- end;
- function ExtractLangIndex(SetupCompiler: TSetupCompiler; var S: String;
- const LanguageEntryIndex: Integer; const Pre: Boolean): Integer;
- var
- I: Integer;
- begin
- if LanguageEntryIndex = -1 then begin
- { Message in the main script }
- I := Pos('.', S);
- if I = 0 then begin
- { No '.'; apply to all languages }
- Result := -1;
- end
- else begin
- { Apply to specified language }
- Result := SetupCompiler.FindLangEntryIndexByName(Copy(S, 1, I-1), Pre);
- S := Copy(S, I+1, Maxint);
- end;
- end
- else begin
- { Inside a language file }
- if Pos('.', S) <> 0 then
- SetupCompiler.AbortCompile(SCompilerCantSpecifyLanguage);
- Result := LanguageEntryIndex;
- end;
- end;
- function StrToInteger64(const S: String; var X: Int64): Boolean;
- { Converts a string containing an unsigned decimal number, or hexadecimal
- number prefixed with '$', into an Integer64. Returns True if successful,
- or False if invalid characters were encountered or an overflow occurred.
- Supports digits separators. }
- var
- Len, Base, StartIndex, I: Integer;
- V: Int64;
- C: Char;
- begin
- Result := False;
- Len := Length(S);
- Base := 10;
- StartIndex := 1;
- if Len > 0 then begin
- if S[1] = '$' then begin
- Base := 16;
- Inc(StartIndex);
- end else if S[1] = '_' then
- Exit;
- end;
- if (StartIndex > Len) or (S[StartIndex] = '_') then
- Exit;
- V := 0;
- try
- for I := StartIndex to Len do begin
- C := UpCase(S[I]);
- case C of
- '0'..'9':
- begin
- V := V * Base;
- Inc(V, Ord(C) - Ord('0'));
- end;
- 'A'..'F':
- begin
- if Base <> 16 then
- Exit;
- V := V * Base;
- Inc(V, Ord(C) - (Ord('A') - 10));
- end;
- '_':
- { Ignore }
- else
- Exit;
- end;
- end;
- X := V;
- Result := True;
- except on E: EOverflow do
- ;
- end;
- end;
- function TSetupCompiler.EvalArchitectureIdentifier(Sender: TSimpleExpression;
- const Name: String; const Parameters: array of const): Boolean;
- const
- ArchIdentifiers: array[0..8] of String = (
- 'arm32compatible', 'arm64', 'win64',
- 'x64', 'x64os', 'x64compatible',
- 'x86', 'x86os', 'x86compatible');
- begin
- for var ArchIdentifier in ArchIdentifiers do begin
- if Name = ArchIdentifier then begin
- if ArchIdentifier = 'x64' then
- WarningsList.Add(Format(SCompilerArchitectureIdentifierDeprecatedWarning, ['x64', 'x64os', 'x64compatible']));
- Exit(True); { Result doesn't matter }
- end;
- end;
- raise Exception.CreateFmt(SCompilerArchitectureIdentifierInvalid, [Name]);
- end;
- { Sets the Used properties while evaluating }
- function TSetupCompiler.EvalComponentIdentifier(Sender: TSimpleExpression; const Name: String;
- const Parameters: array of const): Boolean;
- var
- Found: Boolean;
- ComponentEntry: PSetupComponentEntry;
- I: Integer;
- begin
- Found := False;
- for I := 0 to ComponentEntries.Count-1 do begin
- ComponentEntry := PSetupComponentEntry(ComponentEntries[I]);
- if CompareText(ComponentEntry.Name, Name) = 0 then begin
- ComponentEntry.Used := True;
- Found := True;
- { Don't Break; there may be multiple components with the same name }
- end;
- end;
- if not Found then
- raise Exception.CreateFmt(SCompilerParamUnknownComponent, [ParamCommonComponents]);
- Result := True; { Result doesn't matter }
- end;
- { Sets the Used properties while evaluating }
- function TSetupCompiler.EvalTaskIdentifier(Sender: TSimpleExpression; const Name: String;
- const Parameters: array of const): Boolean;
- var
- Found: Boolean;
- TaskEntry: PSetupTaskEntry;
- I: Integer;
- begin
- Found := False;
- for I := 0 to TaskEntries.Count-1 do begin
- TaskEntry := PSetupTaskEntry(TaskEntries[I]);
- if CompareText(TaskEntry.Name, Name) = 0 then begin
- TaskEntry.Used := True;
- Found := True;
- { Don't Break; there may be multiple tasks with the same name }
- end;
- end;
- if not Found then
- raise Exception.CreateFmt(SCompilerParamUnknownTask, [ParamCommonTasks]);
- Result := True; { Result doesn't matter }
- end;
- function TSetupCompiler.EvalLanguageIdentifier(Sender: TSimpleExpression; const Name: String;
- const Parameters: array of const): Boolean;
- var
- LanguageEntry: PSetupLanguageEntry;
- I: Integer;
- begin
- for I := 0 to LanguageEntries.Count-1 do begin
- LanguageEntry := PSetupLanguageEntry(LanguageEntries[I]);
- if CompareText(LanguageEntry.Name, Name) = 0 then begin
- Result := True; { Result doesn't matter }
- Exit;
- end;
- end;
- raise Exception.CreateFmt(SCompilerParamUnknownLanguage, [ParamCommonLanguages]);
- end;
- procedure TSetupCompiler.ProcessExpressionParameter(const ParamName,
- ParamData: String; OnEvalIdentifier: TSimpleExpressionOnEvalIdentifier;
- SlashConvert: Boolean; var ProcessedParamData: String);
- var
- SimpleExpression: TSimpleExpression;
- begin
- ProcessedParamData := Trim(ParamData);
- if ProcessedParamData <> '' then begin
- if SlashConvert then
- StringChange(ProcessedParamData, '/', '\');
- { Check the expression in ParamData. Use non-Lazy checking to make sure
- everything is evaluated. }
- try
- SimpleExpression := TSimpleExpression.Create;
- try
- SimpleExpression.Lazy := False;
- SimpleExpression.Expression := ProcessedParamData;
- SimpleExpression.OnEvalIdentifier := OnEvalIdentifier;
- SimpleExpression.SilentOrAllowed := True;
- SimpleExpression.SingleIdentifierMode := False;
- SimpleExpression.ParametersAllowed := False;
- SimpleExpression.Eval;
- finally
- SimpleExpression.Free;
- end;
- except
- AbortCompileFmt(SCompilerExpressionError, [ParamName,
- GetExceptMessage]);
- end;
- end;
- end;
- procedure TSetupCompiler.ProcessWildcardsParameter(const ParamData: String;
- const AWildcards: TStringList; const TooLongMsg: String);
- var
- S, AWildcard: String;
- begin
- S := PathLowercase(ParamData);
- while True do begin
- AWildcard := ExtractStr(S, ',');
- if AWildcard = '' then
- Break;
- { Impose a reasonable limit on the length of the string so
- that WildcardMatch can't overflow the stack }
- if Length(AWildcard) >= MAX_PATH then
- AbortCompile(TooLongMsg);
- AWildcards.Add(AWildcard);
- end;
- end;
- procedure TSetupCompiler.ProcessMinVersionParameter(const ParamValue: TParamValue;
- var AMinVersion: TSetupVersionData);
- begin
- if ParamValue.Found then
- if not StrToSetupVersionData(ParamValue.Data, AMinVersion) then
- AbortCompileParamError(SCompilerParamInvalid2, ParamCommonMinVersion);
- end;
- procedure TSetupCompiler.ProcessOnlyBelowVersionParameter(const ParamValue: TParamValue;
- var AOnlyBelowVersion: TSetupVersionData);
- begin
- if ParamValue.Found then begin
- if not StrToSetupVersionData(ParamValue.Data, AOnlyBelowVersion) then
- AbortCompileParamError(SCompilerParamInvalid2, ParamCommonOnlyBelowVersion);
- if (AOnlyBelowVersion.NTVersion <> 0) and
- (AOnlyBelowVersion.NTVersion <= $06010000) then
- WarningsList.Add(Format(SCompilerOnlyBelowVersionParameterNTTooLowWarning, ['6.1']));
- end;
- end;
- procedure TSetupCompiler.ProcessPermissionsParameter(ParamData: String;
- const AccessMasks: array of TNameAndAccessMask; var PermissionsEntry: Smallint);
- procedure GetSidFromName(const AName: String; var ASid: TGrantPermissionSid);
- type
- TKnownSid = record
- Name: String;
- Sid: TGrantPermissionSid;
- end;
- const
- SECURITY_WORLD_SID_AUTHORITY = 1;
- SECURITY_WORLD_RID = $00000000;
- SECURITY_CREATOR_SID_AUTHORITY = 3;
- SECURITY_CREATOR_OWNER_RID = $00000000;
- SECURITY_NT_AUTHORITY = 5;
- SECURITY_AUTHENTICATED_USER_RID = $0000000B;
- SECURITY_LOCAL_SYSTEM_RID = $00000012;
- SECURITY_LOCAL_SERVICE_RID = $00000013;
- SECURITY_NETWORK_SERVICE_RID = $00000014;
- SECURITY_BUILTIN_DOMAIN_RID = $00000020;
- DOMAIN_ALIAS_RID_ADMINS = $00000220;
- DOMAIN_ALIAS_RID_USERS = $00000221;
- DOMAIN_ALIAS_RID_GUESTS = $00000222;
- DOMAIN_ALIAS_RID_POWER_USERS = $00000223;
- DOMAIN_ALIAS_RID_IIS_IUSRS = $00000238;
- KnownSids: array[0..10] of TKnownSid = (
- (Name: 'admins';
- Sid: (Authority: (Value: (0, 0, 0, 0, 0, SECURITY_NT_AUTHORITY));
- SubAuthCount: 2;
- SubAuth: (SECURITY_BUILTIN_DOMAIN_RID, DOMAIN_ALIAS_RID_ADMINS))),
- (Name: 'authusers';
- Sid: (Authority: (Value: (0, 0, 0, 0, 0, SECURITY_NT_AUTHORITY));
- SubAuthCount: 1;
- SubAuth: (SECURITY_AUTHENTICATED_USER_RID, 0))),
- (Name: 'creatorowner';
- Sid: (Authority: (Value: (0, 0, 0, 0, 0, SECURITY_CREATOR_SID_AUTHORITY));
- SubAuthCount: 1;
- SubAuth: (SECURITY_CREATOR_OWNER_RID, 0))),
- (Name: 'everyone';
- Sid: (Authority: (Value: (0, 0, 0, 0, 0, SECURITY_WORLD_SID_AUTHORITY));
- SubAuthCount: 1;
- SubAuth: (SECURITY_WORLD_RID, 0))),
- (Name: 'guests';
- Sid: (Authority: (Value: (0, 0, 0, 0, 0, SECURITY_NT_AUTHORITY));
- SubAuthCount: 2;
- SubAuth: (SECURITY_BUILTIN_DOMAIN_RID, DOMAIN_ALIAS_RID_GUESTS))),
- (Name: 'iisiusrs';
- Sid: (Authority: (Value: (0, 0, 0, 0, 0, SECURITY_NT_AUTHORITY));
- SubAuthCount: 2;
- SubAuth: (SECURITY_BUILTIN_DOMAIN_RID, DOMAIN_ALIAS_RID_IIS_IUSRS))),
- (Name: 'networkservice';
- Sid: (Authority: (Value: (0, 0, 0, 0, 0, SECURITY_NT_AUTHORITY));
- SubAuthCount: 1;
- SubAuth: (SECURITY_NETWORK_SERVICE_RID, 0))),
- (Name: 'powerusers';
- Sid: (Authority: (Value: (0, 0, 0, 0, 0, SECURITY_NT_AUTHORITY));
- SubAuthCount: 2;
- SubAuth: (SECURITY_BUILTIN_DOMAIN_RID, DOMAIN_ALIAS_RID_POWER_USERS))),
- (Name: 'service';
- Sid: (Authority: (Value: (0, 0, 0, 0, 0, SECURITY_NT_AUTHORITY));
- SubAuthCount: 1;
- SubAuth: (SECURITY_LOCAL_SERVICE_RID, 0))),
- (Name: 'system';
- Sid: (Authority: (Value: (0, 0, 0, 0, 0, SECURITY_NT_AUTHORITY));
- SubAuthCount: 1;
- SubAuth: (SECURITY_LOCAL_SYSTEM_RID, 0))),
- (Name: 'users';
- Sid: (Authority: (Value: (0, 0, 0, 0, 0, SECURITY_NT_AUTHORITY));
- SubAuthCount: 2;
- SubAuth: (SECURITY_BUILTIN_DOMAIN_RID, DOMAIN_ALIAS_RID_USERS)))
- );
- var
- I: Integer;
- begin
- for I := Low(KnownSids) to High(KnownSids) do
- if CompareText(AName, KnownSids[I].Name) = 0 then begin
- ASid := KnownSids[I].Sid;
- Exit;
- end;
- AbortCompileFmt(SCompilerPermissionsUnknownSid, [AName]);
- end;
- procedure GetAccessMaskFromName(const AName: String; var AAccessMask: DWORD);
- var
- I: Integer;
- begin
- for I := Low(AccessMasks) to High(AccessMasks) do
- if CompareText(AName, AccessMasks[I].Name) = 0 then begin
- AAccessMask := AccessMasks[I].Mask;
- Exit;
- end;
- AbortCompileFmt(SCompilerPermissionsUnknownMask, [AName]);
- end;
- var
- Perms, E: AnsiString;
- S: String;
- PermsCount, P: Integer;
- Entry: TGrantPermissionEntry;
- NewPermissionEntry: PSetupPermissionEntry;
- begin
- { Parse }
- PermsCount := 0;
- while True do begin
- S := ExtractStr(ParamData, ' ');
- if S = '' then
- Break;
- P := Pos('-', S);
- if P = 0 then
- AbortCompileFmt(SCompilerPermissionsInvalidValue, [S]);
- FillChar(Entry, SizeOf(Entry), 0);
- GetSidFromName(Copy(S, 1, P-1), Entry.Sid);
- GetAccessMaskFromName(Copy(S, P+1, Maxint), Entry.AccessMask);
- SetString(E, PAnsiChar(@Entry), SizeOf(Entry));
- Perms := Perms + E;
- Inc(PermsCount);
- if PermsCount > MaxGrantPermissionEntries then
- AbortCompileFmt(SCompilerPermissionsValueLimitExceeded, [MaxGrantPermissionEntries]);
- end;
- if Perms = '' then begin
- { No permissions }
- PermissionsEntry := -1;
- end
- else begin
- { See if there's already an identical permissions entry }
- for var I := 0 to PermissionEntries.Count-1 do
- if PSetupPermissionEntry(PermissionEntries[I]).Permissions = Perms then begin
- PermissionsEntry := SmallInt(I);
- Exit;
- end;
- { If not, create a new one }
- PermissionEntries.Expand;
- NewPermissionEntry := AllocMem(SizeOf(NewPermissionEntry^));
- NewPermissionEntry.Permissions := Perms;
- const I = PermissionEntries.Add(NewPermissionEntry);
- if I > High(SmallInt) then
- AbortCompile(SCompilerPermissionsTooMany);
- PermissionsEntry := SmallInt(I);
- end;
- end;
- procedure TSetupCompiler.ReadTextFile(const Filename: String; const LangIndex: Integer;
- var Text: AnsiString);
- var
- F: TFile;
- Size: Cardinal;
- UnicodeFile, RTFFile: Boolean;
- S: RawByteString;
- U: String;
- begin
- try
- F := TFile.Create(Filename, fdOpenExisting, faRead, fsRead);
- try
- Size := F.CappedSize;
- SetLength(S, Size);
- F.ReadBuffer(S[1], Size);
- UnicodeFile := ((Size >= 2) and (PWord(Pointer(S))^ = $FEFF)) or
- ((Size >= 3) and (S[1] = #$EF) and (S[2] = #$BB) and (S[3] = #$BF));
- RTFFile := Copy(S, 1, 6) = '{\rtf1';
- if not UnicodeFile and not RTFFile and IsUTF8String(S) then begin
- S := #$EF + #$BB + #$BF + S;
- UnicodeFile := True;
- end;
- if not UnicodeFile and not RTFFile and (LangIndex >= 0) then begin
- const AnsiConvertCodePage = TPreLangData(PreLangDataList[LangIndex]).LanguageCodePage;
- if AnsiConvertCodePage <> 0 then begin
- AddStatus(Format(SCompilerStatusConvertCodePage , [AnsiConvertCodePage]));
- { Convert the ANSI text to Unicode. }
- SetCodePage(S, AnsiConvertCodePage, False);
- U := String(S);
- { Store the Unicode text in Text with a UTF16 BOM. }
- Size := ULength(U)*SizeOf(U[1]);
- SetLength(Text, Size+2);
- PWord(Pointer(Text))^ := $FEFF;
- UMove(U[1], Text[3], Size);
- end else
- Text := S;
- end else
- Text := S;
- finally
- F.Free;
- end;
- except
- raise Exception.CreateFmt(SCompilerReadError, [Filename, GetExceptMessage]);
- end;
- end;
- { Note: result Value may include leading/trailing whitespaces if it was quoted! }
- procedure TSetupCompiler.SeparateDirective(const Line: PChar;
- var Key, Value: String);
- var
- P: PChar;
- begin
- Key := '';
- Value := '';
- P := Line;
- SkipWhitespace(P);
- if P^ <> #0 then begin
- Key := ExtractWords(P, '=');
- if Key = '' then
- AbortCompile(SCompilerDirectiveNameMissing);
- if P^ <> '=' then
- AbortCompileFmt(SCompilerDirectiveHasNoValue, [Key]);
- Inc(P);
- SkipWhitespace(P);
- Value := ExtractWords(P, #0);
- { If Value is surrounded in quotes, remove them. Note that unlike parameter
- values, for backward compatibility we don't require embedded quotes to be
- doubled, nor do we require surrounding quotes when there's a quote in
- the middle of the value. Does *not* remove whitespace after removing quotes! }
- if (Length(Value) >= 2) and
- (Value[1] = '"') and (Value[Length(Value)] = '"') then
- Value := Copy(Value, 2, Length(Value)-2);
- end;
- end;
- procedure TSetupCompiler.SetBytesCompressedSoFar(const Value: Int64);
- begin
- BytesCompressedSoFar := Value;
- end;
- procedure TSetupCompiler.SetOutput(Value: Boolean);
- begin
- Output := Value;
- FixedOutput := True;
- end;
- procedure TSetupCompiler.SetOutputBaseFilename(const Value: String);
- begin
- OutputBaseFilename := Value;
- FixedOutputBaseFilename := True;
- end;
- procedure TSetupCompiler.SetOutputDir(const Value: String);
- begin
- OutputDir := Value;
- FixedOutputDir := True;
- end;
- procedure TSetupCompiler.EnumSetupProc(const Line: PChar; const Ext: Integer);
- var
- KeyName, Value: String;
- I: Integer;
- Directive: TSetupSectionDirective;
- procedure Invalid;
- begin
- AbortCompileFmt(SCompilerEntryInvalid2, ['Setup', KeyName]);
- end;
- function StrToBool(const S: String): Boolean;
- begin
- Result := False;
- if not TryStrToBoolean(S, Result) then
- Invalid;
- end;
- function StrToIntRange(const S: String; const AMin, AMax: Integer): Integer;
- var
- E: Integer;
- begin
- Val(S, Result, E);
- if (E <> 0) or (Result < AMin) or (Result > AMax) then
- Invalid;
- end;
- procedure SetSetupHeaderOption(const Option: TSetupHeaderOption);
- begin
- if not StrToBool(Value) then
- Exclude(SetupHeader.Options, Option)
- else
- Include(SetupHeader.Options, Option);
- end;
- function ExtractNumber(var P: PChar): Integer;
- var
- I: Integer;
- begin
- Result := 0;
- for I := 0 to 3 do begin { maximum of 4 digits }
- if not CharInSet(P^, ['0'..'9']) then begin
- if I = 0 then
- Invalid;
- Break;
- end;
- Result := (Result * 10) + (Ord(P^) - Ord('0'));
- Inc(P);
- end;
- end;
- procedure StrToTouchDate(const S: String);
- var
- P: PChar;
- Year, Month, Day: Integer;
- ST: TSystemTime;
- FT: TFileTime;
- begin
- if CompareText(S, 'current') = 0 then begin
- TouchDateOption := tdCurrent;
- Exit;
- end;
- if CompareText(S, 'none') = 0 then begin
- TouchDateOption := tdNone;
- Exit;
- end;
- P := PChar(S);
- Year := ExtractNumber(P);
- if (Year < 1980) or (Year > 2107) or (P^ <> '-') then
- Invalid;
- Inc(P);
- Month := ExtractNumber(P);
- if (Month < 1) or (Month > 12) or (P^ <> '-') then
- Invalid;
- Inc(P);
- Day := ExtractNumber(P);
- if (Day < 1) or (Day > 31) or (P^ <> #0) then
- Invalid;
- { Verify that the day is valid for the specified month & year }
- FillChar(ST, SizeOf(ST), 0);
- ST.wYear := Word(Year);
- ST.wMonth := Word(Month);
- ST.wDay := Word(Day);
- if not SystemTimeToFileTime(ST, FT) then
- Invalid;
- TouchDateOption := tdExplicit;
- TouchDateYear := Word(Year);
- TouchDateMonth := Word(Month);
- TouchDateDay := Word(Day);
- end;
- procedure StrToTouchTime(const S: String);
- var
- P: PChar;
- Hour, Minute, Second: Integer;
- begin
- if CompareText(S, 'current') = 0 then begin
- TouchTimeOption := ttCurrent;
- Exit;
- end;
- if CompareText(S, 'none') = 0 then begin
- TouchTimeOption := ttNone;
- Exit;
- end;
- P := PChar(S);
- Hour := ExtractNumber(P);
- if (Hour > 23) or (P^ <> ':') then
- Invalid;
- Inc(P);
- Minute := ExtractNumber(P);
- if Minute > 59 then
- Invalid;
- if P^ = #0 then
- Second := 0
- else begin
- if P^ <> ':' then
- Invalid;
- Inc(P);
- Second := ExtractNumber(P);
- if (Second > 59) or (P^ <> #0) then
- Invalid;
- end;
- TouchTimeOption := ttExplicit;
- TouchTimeHour := Word(Hour);
- TouchTimeMinute := Word(Minute);
- TouchTimeSecond := Word(Second);
- end;
- function StrToPrivilegesRequiredOverrides(S: String): TSetupPrivilegesRequiredOverrides;
- const
- Overrides: array of PChar = ['commandline', 'dialog'];
- begin
- Result := [];
- while True do
- case ExtractFlag(S, Overrides) of
- -2: Break;
- -1: Invalid;
- 0: Include(Result, proCommandLine);
- 1: Result := Result + [proCommandLine, proDialog];
- end;
- end;
- function StrToPrecompiledFiles(S: String): TPrecompiledFiles;
- const
- PrecompiledFiles: array of PChar = ['setup', 'setupcustomstyle', 'setupldr',
- 'is7z', 'isbunzip', 'isunzlib', 'islzma'];
- begin
- Result := [];
- while True do
- case ExtractFlag(S, PrecompiledFiles) of
- -2: Break;
- -1: Invalid;
- 0: Include(Result, pfSetup);
- 1: Include(Result, pfSetupCustomStyle);
- 2: Include(Result, pfSetupLdr);
- 3: Include(Result, pfIs7z);
- 4: Include(Result, pfIsbunzip);
- 5: Include(Result, pfIsunzlib);
- 6: Include(Result, pfIslzma);
- end;
- end;
- procedure StrToPercentages(const S: String; var X, Y: Integer; const Min, Max: Integer);
- var
- I: Integer;
- begin
- I := Pos(',', S);
- if I = Length(S) then Invalid;
- if I <> 0 then begin
- X := StrToIntDef(Copy(S, 1, I-1), -1);
- Y := StrToIntDef(Copy(S, I+1, Maxint), -1);
- end else begin
- X := StrToIntDef(S, -1);
- Y := X;
- end;
- if (X < Min) or (X > Max) or (Y < Min) or (Y > Max) then
- Invalid;
- end;
- procedure HandleWizardStyle(WizardStyle: String);
- const
- Styles: array of PChar = [
- 'classic', 'modern',
- 'light', 'dark', 'dynamic',
- 'excludelightbuttons', 'excludelightcontrols',
- 'hidebevels',
- 'includetitlebar',
- 'polar', 'slate', 'windows11', 'zircon'];
- StylesGroups: array of Integer = [0, 0, 1, 1, 1, 2, 2, 3, 4, 5, 5, 5, 5];
- var
- StylesGroupSeen: array [0..5] of Boolean;
- begin
- for var I := Low(StylesGroupSeen) to High(StylesGroupSeen) do
- StylesGroupSeen[I] := False;
- while True do begin
- const R = ExtractFlag(WizardStyle, Styles);
- case R of
- -2: Break;
- -1: Invalid;
- end;
- const StyleGroup = StylesGroups[R];
- if StylesGroupSeen[StyleGroup] then
- Invalid;
- StylesGroupSeen[StyleGroup] := True;
- case R of
- 0: Exclude(SetupHeader.Options, shWizardModern);
- 1: Include(SetupHeader.Options, shWizardModern);
- 2: SetupHeader.WizardDarkStyle := wdsLight;
- 3: SetupHeader.WizardDarkStyle := wdsDark;
- 4: SetupHeader.WizardDarkStyle := wdsDynamic;
- 5: SetupHeader.WizardLightControlStyling := wcsAllButButtons;
- 6: SetupHeader.WizardLightControlStyling := wcsOnlyRequired;
- 7: Include(SetupHeader.Options, shWizardBevelsHidden);
- 8: Include(SetupHeader.Options, shWizardBorderStyled);
- 9..12: WizardStyleSpecial := Styles[R];
- end;
- end;
- end;
- var
- P: Integer;
- AIncludes: TStringList;
- SignTool, SignToolParams: String;
- begin
- SeparateDirective(Line, KeyName, Value);
- if KeyName = '' then
- Exit;
- I := GetEnumValue(TypeInfo(TSetupSectionDirective), 'ss' + KeyName);
- if I = -1 then
- AbortCompileFmt(SCompilerUnknownDirective, ['Setup', KeyName]);
- Directive := TSetupSectionDirective(I);
- if (Directive <> ssSignTool) and (SetupDirectiveLines[Directive] <> 0) then
- AbortCompileFmt(SCompilerEntryAlreadySpecified, ['Setup', KeyName]);
- SetupDirectiveLines[Directive] := LineNumber;
- case Directive of
- ssAllowCancelDuringInstall: begin
- SetSetupHeaderOption(shAllowCancelDuringInstall);
- end;
- ssAllowNetworkDrive: begin
- SetSetupHeaderOption(shAllowNetworkDrive);
- end;
- ssAllowNoIcons: begin
- SetSetupHeaderOption(shAllowNoIcons);
- end;
- ssAllowRootDirectory: begin
- SetSetupHeaderOption(shAllowRootDirectory);
- end;
- ssAllowUNCPath: begin
- SetSetupHeaderOption(shAllowUNCPath);
- end;
- ssAlwaysRestart: begin
- SetSetupHeaderOption(shAlwaysRestart);
- end;
- ssAlwaysUsePersonalGroup: begin
- SetSetupHeaderOption(shAlwaysUsePersonalGroup);
- end;
- ssAlwaysShowComponentsList: begin
- SetSetupHeaderOption(shAlwaysShowComponentsList);
- end;
- ssAlwaysShowDirOnReadyPage: begin
- SetSetupHeaderOption(shAlwaysShowDirOnReadyPage);
- end;
- ssAlwaysShowGroupOnReadyPage: begin
- SetSetupHeaderOption(shAlwaysShowGroupOnReadyPage);
- end;
- ssAppCopyright: begin
- SetupHeader.AppCopyright := Value;
- end;
- ssAppComments: begin
- SetupHeader.AppComments := Value;
- end;
- ssAppContact: begin
- SetupHeader.AppContact := Value;
- end;
- ssAppendDefaultDirName: begin
- SetSetupHeaderOption(shAppendDefaultDirName);
- end;
- ssAppendDefaultGroupName: begin
- SetSetupHeaderOption(shAppendDefaultGroupName);
- end;
- ssAppId: begin
- if Value = '' then
- Invalid;
- SetupHeader.AppId := Value;
- end;
- ssAppModifyPath: begin
- SetupHeader.AppModifyPath := Value;
- end;
- ssAppMutex: begin
- SetupHeader.AppMutex := Trim(Value);
- end;
- ssAppName: begin
- if Value = '' then
- Invalid;
- SetupHeader.AppName := Value;
- end;
- ssAppPublisher: begin
- SetupHeader.AppPublisher := Value;
- end;
- ssAppPublisherURL: begin
- SetupHeader.AppPublisherURL := Value;
- end;
- ssAppReadmeFile: begin
- SetupHeader.AppReadmeFile := Value;
- end;
- ssAppSupportPhone: begin
- SetupHeader.AppSupportPhone := Value;
- end;
- ssAppSupportURL: begin
- SetupHeader.AppSupportURL := Value;
- end;
- ssAppUpdatesURL: begin
- SetupHeader.AppUpdatesURL := Value;
- end;
- ssAppVerName: begin
- if Value = '' then
- Invalid;
- SetupHeader.AppVerName := Value;
- end;
- ssAppVersion: begin
- SetupHeader.AppVersion := Value;
- end;
- ssArchitecturesAllowed: begin
- ProcessExpressionParameter(KeyName, LowerCase(Value),
- EvalArchitectureIdentifier, False, SetupHeader.ArchitecturesAllowed);
- end;
- ssArchitecturesInstallIn64BitMode: begin
- ProcessExpressionParameter(KeyName, LowerCase(Value),
- EvalArchitectureIdentifier, False, SetupHeader.ArchitecturesInstallIn64BitMode);
- end;
- ssArchiveExtraction: begin
- Value := LowerCase(Trim(Value));
- if Value = 'enhanced/nopassword' then begin
- SetupHeader.SevenZipLibraryName := 'is7zxr.dll'
- end else if Value = 'enhanced' then begin
- SetupHeader.SevenZipLibraryName := 'is7zxa.dll'
- end else if Value = 'full' then
- SetupHeader.SevenZipLibraryName := 'is7z.dll'
- else if Value <> 'basic' then
- Invalid;
- end;
- ssASLRCompatible: begin
- ASLRCompatible := StrToBool(Value);
- end;
- ssBackColor,
- ssBackColor2,
- ssBackColorDirection,
- ssBackSolid: begin
- WarningsList.Add(Format(SCompilerEntryObsolete, ['Setup', KeyName]));
- end;
- ssChangesAssociations: begin
- SetupHeader.ChangesAssociations := Value;
- end;
- ssChangesEnvironment: begin
- SetupHeader.ChangesEnvironment := Value;
- end;
- ssCloseApplications: begin
- if CompareText(Value, 'force') = 0 then begin
- Include(SetupHeader.Options, shCloseApplications);
- Include(SetupHeader.Options, shForceCloseApplications);
- end else begin
- SetSetupHeaderOption(shCloseApplications);
- Exclude(SetupHeader.Options, shForceCloseApplications);
- end;
- end;
- ssCloseApplicationsFilter, ssCloseApplicationsFilterExcludes: begin
- if Value = '' then
- Invalid;
- AIncludes := TStringList.Create;
- try
- ProcessWildcardsParameter(Value, AIncludes,
- Format(SCompilerDirectivePatternTooLong, [KeyName]));
- if Directive = ssCloseApplicationsFilter then
- SetupHeader.CloseApplicationsFilter := StringsToCommaString(AIncludes)
- else
- SetupHeader.CloseApplicationsFilterExcludes := StringsToCommaString(AIncludes);
- finally
- AIncludes.Free;
- end;
- end;
- ssCompression: begin
- Value := LowerCase(Trim(Value));
- if Value = 'none' then begin
- CompressMethod := cmStored;
- CompressLevel := 0;
- end
- else if Value = 'zip' then begin
- CompressMethod := cmZip;
- CompressLevel := 7;
- end
- else if Value = 'bzip' then begin
- CompressMethod := cmBzip;
- CompressLevel := 9;
- end
- else if Value = 'lzma' then begin
- CompressMethod := cmLZMA;
- CompressLevel := clLZMAMax;
- end
- else if Value = 'lzma2' then begin
- CompressMethod := cmLZMA2;
- CompressLevel := clLZMAMax;
- end
- else if Copy(Value, 1, 4) = 'zip/' then begin
- I := StrToIntDef(Copy(Value, 5, Maxint), -1);
- if (I < 1) or (I > 9) then
- Invalid;
- CompressMethod := cmZip;
- CompressLevel := I;
- end
- else if Copy(Value, 1, 5) = 'bzip/' then begin
- I := StrToIntDef(Copy(Value, 6, Maxint), -1);
- if (I < 1) or (I > 9) then
- Invalid;
- CompressMethod := cmBzip;
- CompressLevel := I;
- end
- else if Copy(Value, 1, 5) = 'lzma/' then begin
- if not LZMAGetLevel(Copy(Value, 6, Maxint), I) then
- Invalid;
- CompressMethod := cmLZMA;
- CompressLevel := I;
- end
- else if Copy(Value, 1, 6) = 'lzma2/' then begin
- if not LZMAGetLevel(Copy(Value, 7, Maxint), I) then
- Invalid;
- CompressMethod := cmLZMA2;
- CompressLevel := I;
- end
- else
- Invalid;
- end;
- ssCompressionThreads: begin
- if CompareText(Value, 'auto') = 0 then
- { do nothing; it's the default }
- else begin
- if StrToIntRange(Value, 1, 64) = 1 then begin
- InternalCompressProps.NumThreads := 1;
- CompressProps.NumThreads := 1;
- end;
- end;
- end;
- ssCreateAppDir: begin
- SetSetupHeaderOption(shCreateAppDir);
- end;
- ssCreateUninstallRegKey: begin
- SetupHeader.CreateUninstallRegKey := Value;
- end;
- ssDefaultDialogFontName: begin
- DefaultDialogFontName := Trim(Value);
- end;
- ssDefaultDirName: begin
- SetupHeader.DefaultDirName := Value;
- end;
- ssDefaultGroupName: begin
- SetupHeader.DefaultGroupName := Value;
- end;
- ssDefaultUserInfoName: begin
- SetupHeader.DefaultUserInfoName := Value;
- end;
- ssDefaultUserInfoOrg: begin
- SetupHeader.DefaultUserInfoOrg := Value;
- end;
- ssDefaultUserInfoSerial: begin
- SetupHeader.DefaultUserInfoSerial := Value;
- end;
- ssDEPCompatible: begin
- DEPCompatible := StrToBool(Value);
- end;
- ssDirExistsWarning: begin
- if CompareText(Value, 'auto') = 0 then
- SetupHeader.DirExistsWarning := ddAuto
- else if StrToBool(Value) then
- { ^ exception will be raised if Value is invalid }
- SetupHeader.DirExistsWarning := ddYes
- else
- SetupHeader.DirExistsWarning := ddNo;
- end;
- ssDisableDirPage: begin
- if CompareText(Value, 'auto') = 0 then
- SetupHeader.DisableDirPage := dpAuto
- else if StrToBool(Value) then
- { ^ exception will be raised if Value is invalid }
- SetupHeader.DisableDirPage := dpYes
- else
- SetupHeader.DisableDirPage := dpNo;
- end;
- ssDisableFinishedPage: begin
- SetSetupHeaderOption(shDisableFinishedPage);
- end;
- ssDisablePrecompiledFileVerifications: begin
- DisablePrecompiledFileVerifications := StrToPrecompiledFiles(Value);
- CompressProps.WorkerProcessCheckTrust := not (pfIslzma in DisablePrecompiledFileVerifications);
- end;
- ssDisableProgramGroupPage: begin
- if CompareText(Value, 'auto') = 0 then
- SetupHeader.DisableProgramGroupPage := dpAuto
- else if StrToBool(Value) then
- { ^ exception will be raised if Value is invalid }
- SetupHeader.DisableProgramGroupPage := dpYes
- else
- SetupHeader.DisableProgramGroupPage := dpNo;
- end;
- ssDisableReadyMemo: begin
- SetSetupHeaderOption(shDisableReadyMemo);
- end;
- ssDisableReadyPage: begin
- SetSetupHeaderOption(shDisableReadyPage);
- end;
- ssDisableStartupPrompt: begin
- SetSetupHeaderOption(shDisableStartupPrompt);
- end;
- ssDisableWelcomePage: begin
- SetSetupHeaderOption(shDisableWelcomePage);
- end;
- ssDiskClusterSize: begin
- Val(Value, DiskClusterSize, I);
- if I <> 0 then
- Invalid;
- if (DiskClusterSize < 1) or (DiskClusterSize > 32768) then
- AbortCompile(SCompilerDiskClusterSizeInvalid);
- end;
- ssDiskSliceSize: begin
- const MaxDiskSliceSize = 9223372036800000000;
- if CompareText(Value, 'max') = 0 then
- DiskSliceSize := MaxDiskSliceSize
- else begin
- Val(Value, DiskSliceSize, I);
- if I <> 0 then
- Invalid;
- if (DiskSliceSize < 262144) or (DiskSliceSize > MaxDiskSliceSize) then
- AbortCompileFmt(SCompilerDiskSliceSizeInvalid, [262144, MaxDiskSliceSize]);
- end;
- end;
- ssDiskSpanning: begin
- DiskSpanning := StrToBool(Value);
- end;
- ssDontMergeDuplicateFiles: begin { obsolete; superseded by "MergeDuplicateFiles" }
- if SetupDirectiveLines[ssMergeDuplicateFiles] = 0 then
- DontMergeDuplicateFiles := StrToBool(Value);
- WarningsList.Add(Format(SCompilerEntrySuperseded2, ['Setup', KeyName,
- 'MergeDuplicateFiles']));
- end;
- ssEnableDirDoesntExistWarning: begin
- SetSetupHeaderOption(shEnableDirDoesntExistWarning);
- end;
- ssEncryption: begin
- if CompareText(Value, 'full') = 0 then
- SetupEncryptionHeader.EncryptionUse := euFull
- else if StrToBool(Value) then
- SetupEncryptionHeader.EncryptionUse := euFiles
- else
- SetupEncryptionHeader.EncryptionUse := euNone;
- end;
- ssEncryptionKeyDerivation: begin
- if Value = 'pbkdf2' then
- SetupEncryptionHeader.KDFIterations := DefaultKDFIterations
- else if Copy(Value, 1, 7) = 'pbkdf2/' then begin
- I := StrToIntDef(Copy(Value, 8, Maxint), -1);
- if I < 1 then
- Invalid;
- SetupEncryptionHeader.KDFIterations := I;
- end else
- Invalid;
- end;
- ssExtraDiskSpaceRequired: begin
- if not StrToInteger64(Value, SetupHeader.ExtraDiskSpaceRequired) then
- Invalid;
- end;
- ssFlatComponentsList: begin
- SetSetupHeaderOption(shFlatComponentsList);
- end;
- ssInfoBeforeFile: begin
- InfoBeforeFile := Value;
- end;
- ssInfoAfterFile: begin
- InfoAfterFile := Value;
- end;
- ssInternalCompressLevel: begin
- Value := Trim(Value);
- if (Value = '0') or (CompareText(Value, 'none') = 0) then
- InternalCompressLevel := 0
- else if not LZMAGetLevel(Value, InternalCompressLevel) then
- Invalid;
- end;
- ssLanguageDetectionMethod: begin
- if CompareText(Value, 'uilanguage') = 0 then
- SetupHeader.LanguageDetectionMethod := ldUILanguage
- else if CompareText(Value, 'locale') = 0 then
- SetupHeader.LanguageDetectionMethod := ldLocale
- else if CompareText(Value, 'none') = 0 then
- SetupHeader.LanguageDetectionMethod := ldNone
- else
- Invalid;
- end;
- ssLicenseFile: begin
- LicenseFile := Value;
- end;
- ssLZMAAlgorithm: begin
- CompressProps.Algorithm := StrToIntRange(Value, 0, 1);
- end;
- ssLZMABlockSize: begin
- CompressProps.BlockSize := StrToIntRange(Value, 1024, 262144) * 1024; //search Lzma2Enc.c for kMaxSize to see this limit: 262144*1024==1<<28
- end;
- ssLZMADictionarySize: begin
- 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
- CompressProps.DictionarySize := Cardinal(StrToIntRange(Value, 4, MaxDictionarySize div 1024) * 1024);
- end;
- ssLZMAMatchFinder: begin
- if CompareText(Value, 'BT') = 0 then
- I := 1
- else if CompareText(Value, 'HC') = 0 then
- I := 0
- else
- Invalid;
- CompressProps.BTMode := I;
- end;
- ssLZMANumBlockThreads: begin
- CompressProps.NumBlockThreads := StrToIntRange(Value, 1, 256);
- end;
- ssLZMANumFastBytes: begin
- CompressProps.NumFastBytes := StrToIntRange(Value, 5, 273);
- end;
- ssLZMAUseSeparateProcess: begin
- if CompareText(Value, 'x86') = 0 then
- CompressProps.WorkerProcessFilename := GetLZMAExeFilename(False)
- else if StrToBool(Value) then
- CompressProps.WorkerProcessFilename := GetLZMAExeFilename(True)
- else
- CompressProps.WorkerProcessFilename := '';
- end;
- ssMergeDuplicateFiles: begin
- DontMergeDuplicateFiles := not StrToBool(Value);
- end;
- ssMessagesFile: begin
- AbortCompile(SCompilerMessagesFileObsolete);
- end;
- ssMinVersion: begin
- if not StrToSetupVersionData(Value, SetupHeader.MinVersion) then
- Invalid;
- if SetupHeader.MinVersion.WinVersion <> 0 then
- AbortCompile(SCompilerMinVersionWinMustBeZero);
- if SetupHeader.MinVersion.NTVersion < $06010000 then
- AbortCompileFmt(SCompilerMinVersionNTTooLow, ['6.1']);
- end;
- ssMissingMessagesWarning: begin
- MissingMessagesWarning := StrToBool(Value);
- end;
- ssMissingRunOnceIdsWarning: begin
- MissingRunOnceIdsWarning := StrToBool(Value);
- end;
- ssOnlyBelowVersion: begin
- if not StrToSetupVersionData(Value, SetupHeader.OnlyBelowVersion) then
- Invalid;
- if (SetupHeader.OnlyBelowVersion.NTVersion <> 0) and
- (SetupHeader.OnlyBelowVersion.NTVersion <= $06010000) then
- AbortCompileFmt(SCompilerOnlyBelowVersionNTTooLow, ['6.1']);
- end;
- ssOutput: begin
- if not FixedOutput then
- Output := StrToBool(Value);
- end;
- ssOutputBaseFilename: begin
- if not FixedOutputBaseFilename then
- OutputBaseFilename := Value;
- end;
- ssOutputDir: begin
- if not FixedOutputDir then
- OutputDir := Value;
- end;
- ssOutputManifestFile: begin
- OutputManifestFile := Value;
- end;
- ssPassword: begin
- Password := Value;
- end;
- ssPrivilegesRequired: begin
- if CompareText(Value, 'none') = 0 then
- SetupHeader.PrivilegesRequired := prNone
- else if CompareText(Value, 'poweruser') = 0 then
- SetupHeader.PrivilegesRequired := prPowerUser
- else if CompareText(Value, 'admin') = 0 then
- SetupHeader.PrivilegesRequired := prAdmin
- else if CompareText(Value, 'lowest') = 0 then
- SetupHeader.PrivilegesRequired := prLowest
- else
- Invalid;
- end;
- ssPrivilegesRequiredOverridesAllowed: begin
- SetupHeader.PrivilegesRequiredOverridesAllowed := StrToPrivilegesRequiredOverrides(Value);
- end;
- ssRedirectionGuard: begin
- SetSetupHeaderOption(shRedirectionGuard);
- end;
- ssReserveBytes: begin
- Val(Value, ReserveBytes, I);
- if (I <> 0) or (ReserveBytes < 0) then
- Invalid;
- end;
- ssRestartApplications: begin
- SetSetupHeaderOption(shRestartApplications);
- end;
- ssRestartIfNeededByRun: begin
- SetSetupHeaderOption(shRestartIfNeededByRun);
- end;
- ssSetupIconFile: begin
- SetupIconFilename := Value;
- end;
- ssSetupLogging: begin
- SetSetupHeaderOption(shSetupLogging);
- end;
- ssSetupMutex: begin
- SetupHeader.SetupMutex := Trim(Value);
- end;
- ssShowComponentSizes: begin
- SetSetupHeaderOption(shShowComponentSizes);
- end;
- ssShowLanguageDialog: begin
- if CompareText(Value, 'auto') = 0 then
- SetupHeader.ShowLanguageDialog := slAuto
- else if StrToBool(Value) then
- SetupHeader.ShowLanguageDialog := slYes
- else
- SetupHeader.ShowLanguageDialog := slNo;
- end;
- ssShowTasksTreeLines: begin
- SetSetupHeaderOption(shShowTasksTreeLines);
- end;
- ssShowUndisplayableLanguages: begin
- WarningsList.Add(Format(SCompilerEntryObsolete, ['Setup', KeyName]));
- end;
- ssSignedUninstaller: begin
- SetSetupHeaderOption(shSignedUninstaller);
- end;
- ssSignedUninstallerDir: begin
- if Value = '' then
- Invalid;
- SignedUninstallerDir := Value;
- end;
- ssSignTool: begin
- P := Pos(' ', Value);
- if (P <> 0) then begin
- SignTool := Copy(Value, 1, P-1);
- SignToolParams := Copy(Value, P+1, MaxInt);
- end else begin
- SignTool := Value;
- SignToolParams := '';
- end;
- if FindSignToolIndexByName(SignTool) = -1 then
- Invalid;
- SignTools.Add(SignTool);
- SignToolsParams.Add(SignToolParams);
- end;
- ssSignToolMinimumTimeBetween: begin
- I := StrToIntDef(Value, -1);
- if I < 0 then
- Invalid;
- SignToolMinimumTimeBetween := I;
- end;
- ssSignToolRetryCount: begin
- I := StrToIntDef(Value, -1);
- if I < 0 then
- Invalid;
- SignToolRetryCount := I;
- end;
- ssSignToolRetryDelay: begin
- I := StrToIntDef(Value, -1);
- if I < 0 then
- Invalid;
- SignToolRetryDelay := I;
- end;
- ssSignToolRunMinimized: begin
- SignToolRunMinimized := StrToBool(Value);
- end;
- ssSlicesPerDisk: begin
- I := StrToIntDef(Value, -1);
- if (I < 1) or (I > 26) then
- Invalid;
- SlicesPerDisk := I;
- end;
- ssSolidCompression: begin
- UseSolidCompression := StrToBool(Value);
- end;
- ssSourceDir: begin
- if Value = '' then
- Invalid;
- SourceDir := PrependDirName(Value, OriginalSourceDir);
- end;
- ssTerminalServicesAware: begin
- TerminalServicesAware := StrToBool(Value);
- end;
- ssTimeStampRounding: begin
- I := StrToIntDef(Value, -1);
- { Note: We can't allow really high numbers here because it gets
- multiplied by 10000000 }
- if (I < 0) or (I > 60) then
- Invalid;
- TimeStampRounding := I;
- end;
- ssTimeStampsInUTC: begin
- TimeStampsInUTC := StrToBool(Value);
- end;
- ssTouchDate: begin
- StrToTouchDate(Value);
- end;
- ssTouchTime: begin
- StrToTouchTime(Value);
- end;
- ssUpdateUninstallLogAppName: begin
- SetSetupHeaderOption(shUpdateUninstallLogAppName);
- end;
- ssUninstallable: begin
- SetupHeader.Uninstallable := Value;
- end;
- ssUninstallDisplayIcon: begin
- SetupHeader.UninstallDisplayIcon := Value;
- end;
- ssUninstallDisplayName: begin
- SetupHeader.UninstallDisplayName := Value;
- end;
- ssUninstallDisplaySize: begin
- if not StrToInteger64(Value, SetupHeader.UninstallDisplaySize) or
- (SetupHeader.UninstallDisplaySize = 0) then
- Invalid;
- end;
- ssUninstallFilesDir: begin
- if Value = '' then
- Invalid;
- SetupHeader.UninstallFilesDir := Value;
- end;
- ssUninstallIconFile: begin
- WarningsList.Add(Format(SCompilerEntryObsolete, ['Setup', KeyName]));
- end;
- ssUninstallLogging: begin
- SetSetupHeaderOption(shUninstallLogging);
- end;
- ssUninstallLogMode: begin
- if CompareText(Value, 'append') = 0 then
- SetupHeader.UninstallLogMode := lmAppend
- else if CompareText(Value, 'new') = 0 then
- SetupHeader.UninstallLogMode := lmNew
- else if CompareText(Value, 'overwrite') = 0 then
- SetupHeader.UninstallLogMode := lmOverwrite
- else
- Invalid;
- end;
- ssUninstallRestartComputer: begin
- SetSetupHeaderOption(shUninstallRestartComputer);
- end;
- ssUninstallStyle: begin
- WarningsList.Add(Format(SCompilerEntryObsolete, ['Setup', KeyName]));
- end;
- ssUsePreviousAppDir: begin
- SetupHeader.UsePreviousAppDir := Value;
- end;
- ssNotRecognizedMessagesWarning: begin
- NotRecognizedMessagesWarning := StrToBool(Value);
- end;
- ssUsedUserAreasWarning: begin
- UsedUserAreasWarning := StrToBool(Value);
- end;
- ssUsePreviousGroup: begin
- SetupHeader.UsePreviousGroup := Value;
- end;
- ssUsePreviousLanguage: begin
- SetSetupHeaderOption(shUsePreviousLanguage);
- end;
- ssUsePreviousPrivileges: begin
- SetSetupHeaderOption(shUsePreviousPrivileges);
- end;
- ssUsePreviousSetupType: begin
- SetupHeader.UsePreviousSetupType := Value;
- end;
- ssUsePreviousTasks: begin
- SetupHeader.UsePreviousTasks := Value;
- end;
- ssUsePreviousUserInfo: begin
- SetupHeader.UsePreviousUserInfo := Value;
- end;
- ssUseSetupLdr: begin
- if SameText(Value, 'x64') then
- UseSetupLdr := sl64bit
- else if SameText(Value, 'x86') or StrToBool(Value) then
- UseSetupLdr := sl32bit
- else
- UseSetupLdr := slNone;
- end;
- ssUserInfoPage: begin
- SetSetupHeaderOption(shUserInfoPage);
- end;
- ssVersionInfoCompany: begin
- VersionInfoCompany := Value;
- end;
- ssVersionInfoCopyright: begin
- VersionInfoCopyright := Value;
- end;
- ssVersionInfoDescription: begin
- VersionInfoDescription := Value;
- end;
- ssVersionInfoOriginalFileName: begin
- VersionInfoOriginalFileName := Value;
- end;
- ssVersionInfoProductName: begin
- VersionInfoProductName := Value;
- end;
- ssVersionInfoProductVersion: begin
- VersionInfoProductVersionOriginalValue := Value;
- if not StrToVersionNumbers(Value, VersionInfoProductVersion) then
- Invalid;
- end;
- ssVersionInfoProductTextVersion: begin
- VersionInfoProductTextVersion := Value;
- end;
- ssVersionInfoTextVersion: begin
- VersionInfoTextVersion := Value;
- end;
- ssVersionInfoVersion: begin
- VersionInfoVersionOriginalValue := Value;
- if not StrToVersionNumbers(Value, VersionInfoVersion) then
- Invalid;
- end;
- ssWindowResizable,
- ssWindowShowCaption,
- ssWindowStartMaximized,
- ssWindowVisible: begin
- WarningsList.Add(Format(SCompilerEntryObsolete, ['Setup', KeyName]));
- end;
- ssWizardBackColor: begin
- try
- SetupHeader.WizardBackColor := StringToColor(Value);
- except
- Invalid;
- end;
- end;
- ssWizardBackColorDynamicDark: begin
- try
- SetupHeader.WizardBackColorDynamicDark := StringToColor(Value);
- except
- Invalid;
- end;
- end;
- ssWizardBackImageFile: begin
- WizardBackImageFile := Value;
- end;
- ssWizardBackImageFileDynamicDark: begin
- WizardBackImageFileDynamicDark := Value;
- end;
- ssWizardBackImageOpacity: begin
- SetupHeader.WizardBackImageOpacity := Byte(StrToIntRange(Value, 0, 255));
- end;
- ssWizardImageAlphaFormat: begin
- if CompareText(Value, 'none') = 0 then
- SetupHeader.WizardImageAlphaFormat := afIgnored
- else if CompareText(Value, 'defined') = 0 then
- SetupHeader.WizardImageAlphaFormat := afDefined
- else if CompareText(Value, 'premultiplied') = 0 then
- SetupHeader.WizardImageAlphaFormat := afPremultiplied
- else
- Invalid;
- end;
- ssWizardImageBackColor: begin
- try
- SetupHeader.WizardImageBackColor := StringToColor(Value);
- except
- Invalid;
- end;
- end;
- ssWizardImageBackColorDynamicDark: begin
- try
- SetupHeader.WizardImageBackColorDynamicDark := StringToColor(Value);
- except
- Invalid;
- end;
- end;
- ssWizardSmallImageBackColor: begin
- try
- SetupHeader.WizardSmallImageBackColor := StringToColor(Value);
- except
- Invalid;
- end;
- end;
- ssWizardSmallImageBackColorDynamicDark: begin
- try
- SetupHeader.WizardSmallImageBackColorDynamicDark := StringToColor(Value);
- except
- Invalid;
- end;
- end;
- ssWizardImageFile: begin
- WizardImageFile := Value;
- end;
- ssWizardImageFileDynamicDark: begin
- WizardImageFileDynamicDark := Value;
- end;
- ssWizardImageOpacity: begin
- SetupHeader.WizardImageOpacity := Byte(StrToIntRange(Value, 0, 255));
- end;
- ssWizardImageStretch: begin
- SetSetupHeaderOption(shWizardImageStretch);
- end;
- ssWizardKeepAspectRatio: begin
- SetSetupHeaderOption(shWizardKeepAspectRatio);
- end;
- ssWizardResizable: begin
- WarningsList.Add(Format(SCompilerEntryObsolete, ['Setup', KeyName]));
- end;
- ssWizardSmallImageFile: begin
- WizardSmallImageFile := Value;
- end;
- ssWizardSmallImageFileDynamicDark: begin
- WizardSmallImageFileDynamicDark := Value;
- end;
- ssWizardSizePercent: begin
- StrToPercentages(Value, SetupHeader.WizardSizePercentX,
- SetupHeader.WizardSizePercentY, 100, 150)
- end;
- ssWizardStyle: begin
- HandleWizardStyle(Value);
- end;
- ssWizardStyleFile: begin
- WizardStyleFile := Value;
- end;
- ssWizardStyleFileDynamicDark: begin
- WizardStyleFileDynamicDark := Value;
- end;
- end;
- end;
- function TSetupCompiler.FindLangEntryIndexByName(const AName: String;
- const Pre: Boolean): Integer;
- var
- I: Integer;
- begin
- if Pre then begin
- for I := 0 to PreLangDataList.Count-1 do begin
- if TPreLangData(PreLangDataList[I]).Name = AName then begin
- Result := I;
- Exit;
- end;
- end;
- AbortCompileFmt(SCompilerUnknownLanguage, [AName]);
- end;
- for I := 0 to LanguageEntries.Count-1 do begin
- if PSetupLanguageEntry(LanguageEntries[I]).Name = AName then begin
- Result := I;
- Exit;
- end;
- end;
- Result := -1;
- AbortCompileFmt(SCompilerUnknownLanguage, [AName]);
- end;
- function TSetupCompiler.FindSignToolIndexByName(const AName: String): Integer;
- var
- I: Integer;
- begin
- for I := 0 to SignToolList.Count-1 do begin
- if TSignTool(SignToolList[I]).Name = AName then begin
- Result := I;
- Exit;
- end;
- end;
- Result := -1;
- end;
- procedure TSetupCompiler.EnumLangOptionsPreProc(const Line: PChar; const Ext: Integer);
- procedure ApplyToLangEntryPre(const KeyName, Value: String;
- const PreLangData: TPreLangData; const AffectsMultipleLangs: Boolean);
- var
- I: Integer;
- Directive: TLangOptionsSectionDirective;
- procedure Invalid;
- begin
- AbortCompileFmt(SCompilerEntryInvalid2, ['LangOptions', KeyName]);
- end;
- function StrToWordCheck(const S: String): Word;
- var
- E: Integer;
- begin
- Val(S, Result, E);
- if E <> 0 then
- Invalid;
- end;
- begin
- I := GetEnumValue(TypeInfo(TLangOptionsSectionDirective), 'ls' + KeyName);
- if I = -1 then
- AbortCompileFmt(SCompilerUnknownDirective, ['LangOptions', KeyName]);
- Directive := TLangOptionsSectionDirective(I);
- case Directive of
- lsLanguageCodePage: begin
- if AffectsMultipleLangs then
- AbortCompileFmt(SCompilerCantSpecifyLangOption, [KeyName]);
- PreLangData.LanguageCodePage := StrToWordCheck(Value);
- if (PreLangData.LanguageCodePage <> 0) and
- not IsValidCodePage(PreLangData.LanguageCodePage) then
- Invalid;
- end;
- end;
- end;
- var
- KeyName, Value: String;
- I, LangIndex: Integer;
- begin
- SeparateDirective(Line, KeyName, Value);
- LangIndex := ExtractLangIndex(Self, KeyName, Ext, True);
- if LangIndex = -1 then begin
- for I := 0 to PreLangDataList.Count-1 do
- ApplyToLangEntryPre(KeyName, Value, TPreLangData(PreLangDataList[I]),
- PreLangDataList.Count > 1);
- end else
- ApplyToLangEntryPre(KeyName, Value, TPreLangData(PreLangDataList[LangIndex]), False);
- end;
- procedure TSetupCompiler.EnumLangOptionsProc(const Line: PChar; const Ext: Integer);
- procedure ApplyToLangEntry(const KeyName, Value: String;
- var LangOptions: TSetupLanguageEntry; const AffectsMultipleLangs: Boolean);
- var
- I: Integer;
- Directive: TLangOptionsSectionDirective;
- procedure Invalid;
- begin
- AbortCompileFmt(SCompilerEntryInvalid2, ['LangOptions', KeyName]);
- end;
- function StrToIntCheck(const S: String): Integer;
- var
- E: Integer;
- begin
- Val(S, Result, E);
- if E <> 0 then
- Invalid;
- end;
- function ConvertLanguageName(N: String): String;
- var
- I, J, L: Integer;
- W: Word;
- begin
- N := Trim(N);
- if N = '' then
- Invalid;
- Result := '';
- I := 1;
- while I <= Length(N) do begin
- if N[I] = '<' then begin
- { Handle embedded Unicode characters ('<nnnn>') }
- if (I+5 > Length(N)) or (N[I+5] <> '>') then
- Invalid;
- for J := I+1 to I+4 do
- if not CharInSet(UpCase(N[J]), ['0'..'9', 'A'..'F']) then
- Invalid;
- W := Word(StrToIntCheck('$' + Copy(N, I+1, 4)));
- Inc(I, 6);
- end
- else begin
- W := Ord(N[I]);
- Inc(I);
- end;
- L := Length(Result);
- SetLength(Result, L + (SizeOf(Word) div SizeOf(Char)));
- Word((@Result[L+1])^) := W;
- end;
- end;
- begin
- I := GetEnumValue(TypeInfo(TLangOptionsSectionDirective), 'ls' + KeyName);
- if I = -1 then
- AbortCompileFmt(SCompilerUnknownDirective, ['LangOptions', KeyName]);
- Directive := TLangOptionsSectionDirective(I);
- case Directive of
- lsCopyrightFontName,
- lsCopyrightFontSize,
- lsTitleFontName,
- lsTitleFontSize: begin
- WarningsList.Add(Format(SCompilerEntryObsolete, ['LangOptions', KeyName]));
- end;
- lsDialogFontBaseScaleHeight: begin
- LangOptions.DialogFontBaseScaleHeight := StrToIntCheck(Value);
- end;
- lsDialogFontBaseScaleWidth: begin
- LangOptions.DialogFontBaseScaleWidth := StrToIntCheck(Value);
- end;
- lsDialogFontName: begin
- LangOptions.DialogFontName := Trim(Value);
- end;
- lsDialogFontSize: begin
- LangOptions.DialogFontSize := StrToIntCheck(Value);
- end;
- lsDialogFontStandardHeight: begin
- WarningsList.Add(Format(SCompilerEntryObsolete, ['LangOptions', KeyName]));
- end;
- lsLanguageCodePage: begin
- if AffectsMultipleLangs then
- AbortCompileFmt(SCompilerCantSpecifyLangOption, [KeyName]);
- StrToIntCheck(Value);
- end;
- lsLanguageID: begin
- if AffectsMultipleLangs then
- AbortCompileFmt(SCompilerCantSpecifyLangOption, [KeyName]);
- const LanguageID = StrToIntCheck(Value);
- if (LanguageID < Low(LangOptions.LanguageID)) or (LanguageID > High(LangOptions.LanguageID)) then
- Invalid;
- LangOptions.LanguageID := Word(LanguageID);
- end;
- lsLanguageName: begin
- if AffectsMultipleLangs then
- AbortCompileFmt(SCompilerCantSpecifyLangOption, [KeyName]);
- LangOptions.LanguageName := ConvertLanguageName(Value);
- end;
- lsRightToLeft: begin
- if not TryStrToBoolean(Value, LangOptions.RightToLeft) then
- Invalid;
- end;
- lsWelcomeFontName: begin
- LangOptions.WelcomeFontName := Trim(Value);
- end;
- lsWelcomeFontSize: begin
- LangOptions.WelcomeFontSize := StrToIntCheck(Value);
- end;
- end;
- end;
- var
- KeyName, Value: String;
- I, LangIndex: Integer;
- begin
- SeparateDirective(Line, KeyName, Value);
- LangIndex := ExtractLangIndex(Self, KeyName, Ext, False);
- if LangIndex = -1 then begin
- for I := 0 to LanguageEntries.Count-1 do
- ApplyToLangEntry(KeyName, Value, PSetupLanguageEntry(LanguageEntries[I])^,
- LanguageEntries.Count > 1);
- end else
- ApplyToLangEntry(KeyName, Value, PSetupLanguageEntry(LanguageEntries[LangIndex])^, False);
- end;
- procedure TSetupCompiler.EnumTypesProc(const Line: PChar; const Ext: Integer);
- function IsCustomTypeAlreadyDefined: Boolean;
- var
- I: Integer;
- begin
- for I := 0 to TypeEntries.Count-1 do
- if toIsCustom in PSetupTypeEntry(TypeEntries[I]).Options then begin
- Result := True;
- Exit;
- end;
- Result := False;
- end;
- type
- TParam = (paFlags, paName, paDescription, paLanguages, paCheck, paMinVersion,
- paOnlyBelowVersion);
- const
- ParamTypesName = 'Name';
- ParamTypesDescription = 'Description';
- ParamInfo: array[TParam] of TParamInfo = (
- (Name: ParamCommonFlags; Flags: []),
- (Name: ParamTypesName; Flags: [piRequired, piNoEmpty]),
- (Name: ParamTypesDescription; Flags: [piRequired, piNoEmpty]),
- (Name: ParamCommonLanguages; Flags: []),
- (Name: ParamCommonCheck; Flags: []),
- (Name: ParamCommonMinVersion; Flags: []),
- (Name: ParamCommonOnlyBelowVersion; Flags: []));
- Flags: array[0..0] of PChar = (
- 'iscustom');
- var
- Values: array[TParam] of TParamValue;
- NewTypeEntry: PSetupTypeEntry;
- begin
- ExtractParameters(Line, ParamInfo, Values);
- NewTypeEntry := AllocMem(SizeOf(TSetupTypeEntry));
- try
- with NewTypeEntry^ do begin
- MinVersion := SetupHeader.MinVersion;
- Typ := ttUser;
- { Flags }
- while True do
- case ExtractFlag(Values[paFlags].Data, Flags) of
- -2: Break;
- -1: AbortCompileParamError(SCompilerParamUnknownFlag2, ParamCommonFlags);
- 0: Include(Options, toIsCustom);
- end;
- { Name }
- Name := LowerCase(Values[paName].Data);
- { Description }
- Description := Values[paDescription].Data;
- { Common parameters }
- ProcessExpressionParameter(ParamCommonLanguages, Values[paLanguages].Data, EvalLanguageIdentifier, False, Languages);
- CheckOnce := Values[paCheck].Data;
- ProcessMinVersionParameter(Values[paMinVersion], MinVersion);
- ProcessOnlyBelowVersionParameter(Values[paOnlyBelowVersion], OnlyBelowVersion);
- if (toIsCustom in Options) and IsCustomTypeAlreadyDefined then
- AbortCompile(SCompilerTypesCustomTypeAlreadyDefined);
- CheckConst(Description, MinVersion, []);
- CheckCheckOrInstall(ParamCommonCheck, CheckOnce, cikCheck);
- end;
- except
- SEFreeRec(NewTypeEntry, SetupTypeEntryStrings, SetupTypeEntryAnsiStrings);
- raise;
- end;
- TypeEntries.Add(NewTypeEntry);
- end;
- procedure TSetupCompiler.EnumComponentsProc(const Line: PChar; const Ext: Integer);
- procedure AddToCommaText(var CommaText: String; const S: String);
- begin
- if CommaText <> '' then
- CommaText := CommaText + ',';
- CommaText := CommaText + S;
- end;
- type
- TParam = (paFlags, paName, paDescription, paExtraDiskSpaceRequired, paTypes,
- paLanguages, paCheck, paMinVersion, paOnlyBelowVersion);
- const
- ParamComponentsName = 'Name';
- ParamComponentsDescription = 'Description';
- ParamComponentsExtraDiskSpaceRequired = 'ExtraDiskSpaceRequired';
- ParamComponentsTypes = 'Types';
- ParamInfo: array[TParam] of TParamInfo = (
- (Name: ParamCommonFlags; Flags: []),
- (Name: ParamComponentsName; Flags: [piRequired, piNoEmpty]),
- (Name: ParamComponentsDescription; Flags: [piRequired, piNoEmpty]),
- (Name: ParamComponentsExtraDiskSpaceRequired; Flags: []),
- (Name: ParamComponentsTypes; Flags: []),
- (Name: ParamCommonLanguages; Flags: []),
- (Name: ParamCommonCheck; Flags: []),
- (Name: ParamCommonMinVersion; Flags: []),
- (Name: ParamCommonOnlyBelowVersion; Flags: []));
- Flags: array[0..5] of PChar = (
- 'fixed', 'restart', 'disablenouninstallwarning', 'exclusive',
- 'dontinheritcheck', 'checkablealone');
- var
- Values: array[TParam] of TParamValue;
- NewComponentEntry: PSetupComponentEntry;
- PrevLevel, I: Integer;
- begin
- ExtractParameters(Line, ParamInfo, Values);
- NewComponentEntry := AllocMem(SizeOf(TSetupComponentEntry));
- try
- with NewComponentEntry^ do begin
- MinVersion := SetupHeader.MinVersion;
- { Flags }
- while True do
- case ExtractFlag(Values[paFlags].Data, Flags) of
- -2: Break;
- -1: AbortCompileParamError(SCompilerParamUnknownFlag2, ParamCommonFlags);
- 0: Include(Options, coFixed);
- 1: Include(Options, coRestart);
- 2: Include(Options, coDisableNoUninstallWarning);
- 3: Include(Options, coExclusive);
- 4: Include(Options, coDontInheritCheck);
- 5: Used := True;
- end;
- { Name }
- Name := LowerCase(Values[paName].Data);
- StringChange(Name, '/', '\');
- if not IsValidIdentString(Name, True, False) then
- AbortCompile(SCompilerComponentsOrTasksBadName);
- const CountedChars = CountChars(Name, '\');
- if CountedChars > High(Byte) then
- AbortCompile(SCompilerComponentsInvalidLevel);
- Level := Byte(CountedChars);
- if ComponentEntries.Count > 0 then
- PrevLevel := PSetupComponentEntry(ComponentEntries[ComponentEntries.Count-1]).Level
- else
- PrevLevel := -1;
- if Level > PrevLevel + 1 then
- AbortCompile(SCompilerComponentsInvalidLevel);
- { Description }
- Description := Values[paDescription].Data;
- { ExtraDiskSpaceRequired }
- if Values[paExtraDiskSpaceRequired].Found then begin
- if not StrToInteger64(Values[paExtraDiskSpaceRequired].Data, ExtraDiskSpaceRequired) then
- AbortCompileParamError(SCompilerParamInvalid2, ParamComponentsExtraDiskSpaceRequired);
- end;
- { Types }
- while True do begin
- I := ExtractType(Values[paTypes].Data, TypeEntries);
- case I of
- -2: Break;
- -1: AbortCompileParamError(SCompilerParamUnknownType, ParamComponentsTypes);
- else begin
- if TypeEntries.Count <> 0 then
- AddToCommaText(Types, PSetupTypeEntry(TypeEntries[I]).Name)
- else
- AddToCommaText(Types, DefaultTypeEntryNames[I]);
- end;
- end;
- end;
- { Common parameters }
- ProcessExpressionParameter(ParamCommonLanguages, Values[paLanguages].Data, EvalLanguageIdentifier, False, Languages);
- CheckOnce := Values[paCheck].Data;
- ProcessMinVersionParameter(Values[paMinVersion], MinVersion);
- ProcessOnlyBelowVersionParameter(Values[paOnlyBelowVersion], OnlyBelowVersion);
- if (coDontInheritCheck in Options) and (coExclusive in Options) then
- AbortCompileFmt(SCompilerParamErrorBadCombo2,
- [ParamCommonFlags, 'dontinheritcheck', 'exclusive']);
- CheckConst(Description, MinVersion, []);
- CheckCheckOrInstall(ParamCommonCheck, CheckOnce, cikCheck);
- end;
- except
- SEFreeRec(NewComponentEntry, SetupComponentEntryStrings, SetupComponentEntryAnsiStrings);
- raise;
- end;
- ComponentEntries.Add(NewComponentEntry);
- end;
- procedure TSetupCompiler.EnumTasksProc(const Line: PChar; const Ext: Integer);
- type
- TParam = (paFlags, paName, paDescription, paGroupDescription, paComponents,
- paLanguages, paCheck, paMinVersion, paOnlyBelowVersion);
- const
- ParamTasksName = 'Name';
- ParamTasksDescription = 'Description';
- ParamTasksGroupDescription = 'GroupDescription';
- ParamInfo: array[TParam] of TParamInfo = (
- (Name: ParamCommonFlags; Flags: []),
- (Name: ParamTasksName; Flags: [piRequired, piNoEmpty, piNoQuotes]),
- (Name: ParamTasksDescription; Flags: [piRequired, piNoEmpty]),
- (Name: ParamTasksGroupDescription; Flags: [piNoEmpty]),
- (Name: ParamCommonComponents; Flags: []),
- (Name: ParamCommonLanguages; Flags: []),
- (Name: ParamCommonCheck; Flags: []),
- (Name: ParamCommonMinVersion; Flags: []),
- (Name: ParamCommonOnlyBelowVersion; Flags: []));
- Flags: array[0..5] of PChar = (
- 'exclusive', 'unchecked', 'restart', 'checkedonce', 'dontinheritcheck',
- 'checkablealone');
- var
- Values: array[TParam] of TParamValue;
- NewTaskEntry: PSetupTaskEntry;
- PrevLevel: Integer;
- begin
- ExtractParameters(Line, ParamInfo, Values);
- NewTaskEntry := AllocMem(SizeOf(TSetupTaskEntry));
- try
- with NewTaskEntry^ do begin
- MinVersion := SetupHeader.MinVersion;
- { Flags }
- while True do
- case ExtractFlag(Values[paFlags].Data, Flags) of
- -2: Break;
- -1: AbortCompileParamError(SCompilerParamUnknownFlag2, ParamCommonFlags);
- 0: Include(Options, toExclusive);
- 1: Include(Options, toUnchecked);
- 2: Include(Options, toRestart);
- 3: Include(Options, toCheckedOnce);
- 4: Include(Options, toDontInheritCheck);
- 5: Used := True;
- end;
- { Name }
- Name := LowerCase(Values[paName].Data);
- StringChange(Name, '/', '\');
- if not IsValidIdentString(Name, True, False) then
- AbortCompile(SCompilerComponentsOrTasksBadName);
- const CountedChars = CountChars(Name, '\');
- if CountedChars > High(Byte) then
- AbortCompile(SCompilerTasksInvalidLevel);
- Level := Byte(CountedChars);
- if TaskEntries.Count > 0 then
- PrevLevel := PSetupTaskEntry(TaskEntries[TaskEntries.Count-1]).Level
- else
- PrevLevel := -1;
- if Level > PrevLevel + 1 then
- AbortCompile(SCompilerTasksInvalidLevel);
- { Description }
- Description := Values[paDescription].Data;
- { GroupDescription }
- GroupDescription := Values[paGroupDescription].Data;
- { Common parameters }
- ProcessExpressionParameter(ParamCommonComponents, Values[paComponents].Data, EvalComponentIdentifier, True, Components);
- ProcessExpressionParameter(ParamCommonLanguages, Values[paLanguages].Data, EvalLanguageIdentifier, False, Languages);
- Check := Values[paCheck].Data;
- ProcessMinVersionParameter(Values[paMinVersion], MinVersion);
- ProcessOnlyBelowVersionParameter(Values[paOnlyBelowVersion], OnlyBelowVersion);
- if (toDontInheritCheck in Options) and (toExclusive in Options) then
- AbortCompileFmt(SCompilerParamErrorBadCombo2,
- [ParamCommonFlags, 'dontinheritcheck', 'exclusive']);
- CheckConst(Description, MinVersion, []);
- CheckConst(GroupDescription, MinVersion, []);
- CheckCheckOrInstall(ParamCommonCheck, Check, cikCheck);
- end;
- except
- SEFreeRec(NewTaskEntry, SetupTaskEntryStrings, SetupTaskEntryAnsiStrings);
- raise;
- end;
- TaskEntries.Add(NewTaskEntry);
- end;
- const
- FILE_ATTRIBUTE_NOT_CONTENT_INDEXED = $00002000;
- procedure TSetupCompiler.EnumDirsProc(const Line: PChar; const Ext: Integer);
- type
- TParam = (paFlags, paName, paAttribs, paPermissions, paComponents, paTasks,
- paLanguages, paCheck, paBeforeInstall, paAfterInstall, paMinVersion,
- paOnlyBelowVersion);
- const
- ParamDirsName = 'Name';
- ParamDirsAttribs = 'Attribs';
- ParamDirsPermissions = 'Permissions';
- ParamInfo: array[TParam] of TParamInfo = (
- (Name: ParamCommonFlags; Flags: []),
- (Name: ParamDirsName; Flags: [piRequired, piNoEmpty, piNoQuotes]),
- (Name: ParamDirsAttribs; Flags: []),
- (Name: ParamDirsPermissions; Flags: []),
- (Name: ParamCommonComponents; Flags: []),
- (Name: ParamCommonTasks; Flags: []),
- (Name: ParamCommonLanguages; Flags: []),
- (Name: ParamCommonCheck; Flags: []),
- (Name: ParamCommonBeforeInstall; Flags: []),
- (Name: ParamCommonAfterInstall; Flags: []),
- (Name: ParamCommonMinVersion; Flags: []),
- (Name: ParamCommonOnlyBelowVersion; Flags: []));
- Flags: array[0..4] of PChar = (
- 'uninsneveruninstall', 'deleteafterinstall', 'uninsalwaysuninstall',
- 'setntfscompression', 'unsetntfscompression');
- AttribsFlags: array[0..3] of PChar = (
- 'readonly', 'hidden', 'system', 'notcontentindexed');
- AccessMasks: array[0..2] of TNameAndAccessMask = (
- (Name: 'full'; Mask: $1F01FF),
- (Name: 'modify'; Mask: $1301BF),
- (Name: 'readexec'; Mask: $1200A9));
- var
- Values: array[TParam] of TParamValue;
- NewDirEntry: PSetupDirEntry;
- begin
- ExtractParameters(Line, ParamInfo, Values);
- NewDirEntry := AllocMem(SizeOf(TSetupDirEntry));
- try
- with NewDirEntry^ do begin
- MinVersion := SetupHeader.MinVersion;
- { Flags }
- while True do
- case ExtractFlag(Values[paFlags].Data, Flags) of
- -2: Break;
- -1: AbortCompileParamError(SCompilerParamUnknownFlag2, ParamCommonFlags);
- 0: Include(Options, doUninsNeverUninstall);
- 1: Include(Options, doDeleteAfterInstall);
- 2: Include(Options, doUninsAlwaysUninstall);
- 3: Include(Options, doSetNTFSCompression);
- 4: Include(Options, doUnsetNTFSCompression);
- end;
- { Name }
- DirName := Values[paName].Data;
- { Attribs }
- while True do
- case ExtractFlag(Values[paAttribs].Data, AttribsFlags) of
- -2: Break;
- -1: AbortCompileParamError(SCompilerParamUnknownFlag2, ParamDirsAttribs);
- 0: Attribs := Attribs or FILE_ATTRIBUTE_READONLY;
- 1: Attribs := Attribs or FILE_ATTRIBUTE_HIDDEN;
- 2: Attribs := Attribs or FILE_ATTRIBUTE_SYSTEM;
- 3: Attribs := Attribs or FILE_ATTRIBUTE_NOT_CONTENT_INDEXED;
- end;
- { Permissions }
- ProcessPermissionsParameter(Values[paPermissions].Data, AccessMasks,
- PermissionsEntry);
- { Common parameters }
- ProcessExpressionParameter(ParamCommonComponents, Values[paComponents].Data, EvalComponentIdentifier, True, Components);
- ProcessExpressionParameter(ParamCommonTasks, Values[paTasks].Data, EvalTaskIdentifier, True, Tasks);
- ProcessExpressionParameter(ParamCommonLanguages, Values[paLanguages].Data, EvalLanguageIdentifier, False, Languages);
- Check := Values[paCheck].Data;
- BeforeInstall := Values[paBeforeInstall].Data;
- AfterInstall := Values[paAfterInstall].Data;
- ProcessMinVersionParameter(Values[paMinVersion], MinVersion);
- ProcessOnlyBelowVersionParameter(Values[paOnlyBelowVersion], OnlyBelowVersion);
- if (doUninsNeverUninstall in Options) and
- (doUninsAlwaysUninstall in Options) then
- AbortCompileFmt(SCompilerParamErrorBadCombo2,
- [ParamCommonFlags, 'uninsneveruninstall', 'uninsalwaysuninstall']);
- if (doSetNTFSCompression in Options) and
- (doUnsetNTFSCompression in Options) then
- AbortCompileFmt(SCompilerParamErrorBadCombo2,
- [ParamCommonFlags, 'setntfscompression', 'unsetntfscompression']);
- CheckCheckOrInstall(ParamCommonCheck, Check, cikCheck);
- CheckCheckOrInstall(ParamCommonBeforeInstall, BeforeInstall, cikInstall);
- CheckCheckOrInstall(ParamCommonAfterInstall, AfterInstall, cikInstall);
- CheckConst(DirName, MinVersion, []);
- end;
- except
- SEFreeRec(NewDirEntry, SetupDirEntryStrings, SetupDirEntryAnsiStrings);
- raise;
- end;
- WriteDebugEntry(deDir, DirEntries.Count);
- DirEntries.Add(NewDirEntry);
- end;
- type
- TMenuKeyCap = (mkcBkSp, mkcTab, mkcEsc, mkcEnter, mkcSpace, mkcPgUp,
- mkcPgDn, mkcEnd, mkcHome, mkcLeft, mkcUp, mkcRight, mkcDown, mkcIns,
- mkcDel, mkcShift, mkcCtrl, mkcAlt);
- var
- MenuKeyCaps: array[TMenuKeyCap] of string = (
- 'BkSp', 'Tab', 'Esc', 'Enter', 'Space', 'PgUp',
- 'PgDn', 'End', 'Home', 'Left', 'Up', 'Right',
- 'Down', 'Ins', 'Del', 'Shift+', 'Ctrl+', 'Alt+');
- procedure TSetupCompiler.EnumIconsProc(const Line: PChar; const Ext: Integer);
- function HotKeyToText(HotKey: Word): string;
- function GetSpecialName(HotKey: Word): string;
- var
- KeyName: array[0..255] of Char;
- begin
- Result := '';
- const ScanCode = Integer(MapVirtualKey(WordRec(HotKey).Lo, 0) shl 16);
- if ScanCode <> 0 then begin
- GetKeyNameText(ScanCode, KeyName, SizeOf(KeyName));
- if (KeyName[1] = #0) and (KeyName[0] <> #0) then
- GetSpecialName := KeyName;
- end;
- end;
- var
- Name: string;
- begin
- case WordRec(HotKey).Lo of
- $08, $09:
- Name := MenuKeyCaps[TMenuKeyCap(Ord(mkcBkSp) + WordRec(HotKey).Lo - $08)];
- $0D: Name := MenuKeyCaps[mkcEnter];
- $1B: Name := MenuKeyCaps[mkcEsc];
- $20..$28:
- Name := MenuKeyCaps[TMenuKeyCap(Ord(mkcSpace) + WordRec(HotKey).Lo - $20)];
- $2D..$2E:
- Name := MenuKeyCaps[TMenuKeyCap(Ord(mkcIns) + WordRec(HotKey).Lo - $2D)];
- $30..$39: Name := Chr(WordRec(HotKey).Lo - $30 + Ord('0'));
- $41..$5A: Name := Chr(WordRec(HotKey).Lo - $41 + Ord('A'));
- $60..$69: Name := Chr(WordRec(HotKey).Lo - $60 + Ord('0'));
- $70..$87: Name := 'F' + IntToStr(WordRec(HotKey).Lo - $6F);
- else
- Name := GetSpecialName(HotKey);
- end;
- if Name <> '' then
- begin
- Result := '';
- if HotKey and (HOTKEYF_SHIFT shl 8) <> 0 then Result := Result + MenuKeyCaps[mkcShift];
- if HotKey and (HOTKEYF_CONTROL shl 8) <> 0 then Result := Result + MenuKeyCaps[mkcCtrl];
- if HotKey and (HOTKEYF_ALT shl 8) <> 0 then Result := Result + MenuKeyCaps[mkcAlt];
- Result := Result + Name;
- end
- else Result := '';
- end;
- function TextToHotKey(Text: string): Word;
- function CompareFront(var Text: string; const Front: string): Boolean;
- begin
- Result := False;
- if CompareText(Copy(Text, 1, Length(Front)), Front) = 0 then
- begin
- Result := True;
- Delete(Text, 1, Length(Front));
- end;
- end;
- var
- Key: Word;
- Shift: Word;
- begin
- Result := 0;
- Shift := 0;
- while True do
- begin
- if CompareFront(Text, MenuKeyCaps[mkcShift]) then Shift := Shift or HOTKEYF_SHIFT
- else if CompareFront(Text, '^') then Shift := Shift or HOTKEYF_CONTROL
- else if CompareFront(Text, MenuKeyCaps[mkcCtrl]) then Shift := Shift or HOTKEYF_CONTROL
- else if CompareFront(Text, MenuKeyCaps[mkcAlt]) then Shift := Shift or HOTKEYF_ALT
- else Break;
- end;
- if Text = '' then Exit;
- for Key := $08 to $255 do { Copy range from table in HotKeyToText }
- if AnsiCompareText(Text, HotKeyToText(Key)) = 0 then
- begin
- Result := Word(Key or (Shift shl 8));
- Exit;
- end;
- end;
- type
- TParam = (paFlags, paName, paFilename, paParameters, paWorkingDir, paHotKey,
- paIconFilename, paIconIndex, paComment, paAppUserModelID, paAppUserModelToastActivatorCLSID,
- paComponents, paTasks, paLanguages, paCheck, paBeforeInstall, paAfterInstall, paMinVersion,
- paOnlyBelowVersion);
- const
- ParamIconsName = 'Name';
- ParamIconsFilename = 'Filename';
- ParamIconsParameters = 'Parameters';
- ParamIconsWorkingDir = 'WorkingDir';
- ParamIconsHotKey = 'HotKey';
- ParamIconsIconFilename = 'IconFilename';
- ParamIconsIconIndex = 'IconIndex';
- ParamIconsComment = 'Comment';
- ParamIconsAppUserModelID = 'AppUserModelID';
- ParamIconsAppUserModelToastActivatorCLSID = 'AppUserModelToastActivatorCLSID';
- ParamInfo: array[TParam] of TParamInfo = (
- (Name: ParamCommonFlags; Flags: []),
- (Name: ParamIconsName; Flags: [piRequired, piNoEmpty, piNoQuotes]),
- (Name: ParamIconsFilename; Flags: [piRequired, piNoEmpty, piNoQuotes]),
- (Name: ParamIconsParameters; Flags: []),
- (Name: ParamIconsWorkingDir; Flags: [piNoQuotes]),
- (Name: ParamIconsHotKey; Flags: []),
- (Name: ParamIconsIconFilename; Flags: [piNoQuotes]),
- (Name: ParamIconsIconIndex; Flags: []),
- (Name: ParamIconsComment; Flags: []),
- (Name: ParamIconsAppUserModelID; Flags: []),
- (Name: ParamIconsAppUserModelToastActivatorCLSID; Flags: []),
- (Name: ParamCommonComponents; Flags: []),
- (Name: ParamCommonTasks; Flags: []),
- (Name: ParamCommonLanguages; Flags: []),
- (Name: ParamCommonCheck; Flags: []),
- (Name: ParamCommonBeforeInstall; Flags: []),
- (Name: ParamCommonAfterInstall; Flags: []),
- (Name: ParamCommonMinVersion; Flags: []),
- (Name: ParamCommonOnlyBelowVersion; Flags: []));
- Flags: array[0..8] of PChar = (
- 'uninsneveruninstall', 'runminimized', 'createonlyiffileexists',
- 'useapppaths', 'closeonexit', 'dontcloseonexit', 'runmaximized',
- 'excludefromshowinnewinstall', 'preventpinning');
- var
- Values: array[TParam] of TParamValue;
- NewIconEntry: PSetupIconEntry;
- S: String;
- begin
- ExtractParameters(Line, ParamInfo, Values);
- NewIconEntry := AllocMem(SizeOf(TSetupIconEntry));
- try
- with NewIconEntry^ do begin
- MinVersion := SetupHeader.MinVersion;
- ShowCmd := SW_SHOWNORMAL;
- { Flags }
- while True do
- case ExtractFlag(Values[paFlags].Data, Flags) of
- -2: Break;
- -1: AbortCompileParamError(SCompilerParamUnknownFlag2, ParamCommonFlags);
- 0: Include(Options, ioUninsNeverUninstall);
- 1: ShowCmd := SW_SHOWMINNOACTIVE;
- 2: Include(Options, ioCreateOnlyIfFileExists);
- 3: Include(Options, ioUseAppPaths);
- 4: CloseOnExit := icYes;
- 5: CloseOnExit := icNo;
- 6: ShowCmd := SW_SHOWMAXIMIZED;
- 7: Include(Options, ioExcludeFromShowInNewInstall);
- 8: Include(Options, ioPreventPinning);
- end;
- { Name }
- IconName := Values[paName].Data;
- { Filename }
- Filename := Values[paFilename].Data;
- { Parameters }
- Parameters := Values[paParameters].Data;
- { WorkingDir }
- WorkingDir := Values[paWorkingDir].Data;
- { HotKey }
- if Values[paHotKey].Found then begin
- HotKey := TextToHotKey(Values[paHotKey].Data);
- if HotKey = 0 then
- AbortCompileParamError(SCompilerParamInvalid2, ParamIconsHotKey);
- end;
- { IconFilename }
- IconFilename := Values[paIconFilename].Data;
- { IconIndex }
- if Values[paIconIndex].Found then begin
- try
- IconIndex := StrToInt(Values[paIconIndex].Data);
- except
- AbortCompile(SCompilerIconsIconIndexInvalid);
- end;
- end;
- { Comment }
- Comment := Values[paComment].Data;
- { AppUserModel }
- AppUserModelID := Values[paAppUserModelID].Data;
- S := Values[paAppUserModelToastActivatorCLSID].Data;
- if S <> '' then begin
- AppUserModelToastActivatorCLSID := StringToGUID('{' + S + '}');
- Include(Options, ioHasAppUserModelToastActivatorCLSID);
- end;
- { Common parameters }
- ProcessExpressionParameter(ParamCommonComponents, Values[paComponents].Data, EvalComponentIdentifier, True, Components);
- ProcessExpressionParameter(ParamCommonTasks, Values[paTasks].Data, EvalTaskIdentifier, True, Tasks);
- ProcessExpressionParameter(ParamCommonLanguages, Values[paLanguages].Data, EvalLanguageIdentifier, False, Languages);
- Check := Values[paCheck].Data;
- BeforeInstall := Values[paBeforeInstall].Data;
- AfterInstall := Values[paAfterInstall].Data;
- ProcessMinVersionParameter(Values[paMinVersion], MinVersion);
- ProcessOnlyBelowVersionParameter(Values[paOnlyBelowVersion], OnlyBelowVersion);
- if Pos('"', IconName) <> 0 then
- AbortCompileParamError(SCompilerParamNoQuotes2, ParamIconsName);
- if PathPos('\', IconName) = 0 then
- AbortCompile(SCompilerIconsNamePathNotSpecified);
- if (IconIndex <> 0) and (IconFilename = '') then
- IconFilename := Filename;
- CheckCheckOrInstall(ParamCommonCheck, Check, cikCheck);
- CheckCheckOrInstall(ParamCommonBeforeInstall, BeforeInstall, cikInstall);
- CheckCheckOrInstall(ParamCommonAfterInstall, AfterInstall, cikInstall);
- S := IconName;
- if Copy(S, 1, 8) = '{group}\' then
- Delete(S, 1, 8);
- CheckConst(S, MinVersion, []);
- CheckConst(Filename, MinVersion, []);
- CheckConst(Parameters, MinVersion, []);
- CheckConst(WorkingDir, MinVersion, []);
- CheckConst(IconFilename, MinVersion, []);
- CheckConst(Comment, MinVersion, []);
- CheckConst(AppUserModelID, MinVersion, []);
- end;
- except
- SEFreeRec(NewIconEntry, SetupIconEntryStrings, SetupIconEntryAnsiStrings);
- raise;
- end;
- WriteDebugEntry(deIcon, IconEntries.Count);
- IconEntries.Add(NewIconEntry);
- end;
- procedure TSetupCompiler.EnumINIProc(const Line: PChar; const Ext: Integer);
- type
- TParam = (paFlags, paFilename, paSection, paKey, paString, paComponents,
- paTasks, paLanguages, paCheck, paBeforeInstall, paAfterInstall,
- paMinVersion, paOnlyBelowVersion);
- const
- ParamIniFilename = 'Filename';
- ParamIniSection = 'Section';
- ParamIniKey = 'Key';
- ParamIniString = 'String';
- ParamInfo: array[TParam] of TParamInfo = (
- (Name: ParamCommonFlags; Flags: []),
- (Name: ParamIniFilename; Flags: [piRequired, piNoQuotes]),
- (Name: ParamIniSection; Flags: [piRequired, piNoEmpty]),
- (Name: ParamIniKey; Flags: [piNoEmpty]),
- (Name: ParamIniString; Flags: []),
- (Name: ParamCommonComponents; Flags: []),
- (Name: ParamCommonTasks; Flags: []),
- (Name: ParamCommonLanguages; Flags: []),
- (Name: ParamCommonCheck; Flags: []),
- (Name: ParamCommonBeforeInstall; Flags: []),
- (Name: ParamCommonAfterInstall; Flags: []),
- (Name: ParamCommonMinVersion; Flags: []),
- (Name: ParamCommonOnlyBelowVersion; Flags: []));
- Flags: array[0..3] of PChar = (
- 'uninsdeleteentry', 'uninsdeletesection', 'createkeyifdoesntexist',
- 'uninsdeletesectionifempty');
- var
- Values: array[TParam] of TParamValue;
- NewIniEntry: PSetupIniEntry;
- begin
- ExtractParameters(Line, ParamInfo, Values);
- NewIniEntry := AllocMem(SizeOf(TSetupIniEntry));
- try
- with NewIniEntry^ do begin
- MinVersion := SetupHeader.MinVersion;
- { Flags }
- while True do
- case ExtractFlag(Values[paFlags].Data, Flags) of
- -2: Break;
- -1: AbortCompileParamError(SCompilerParamUnknownFlag2, ParamCommonFlags);
- 0: Include(Options, ioUninsDeleteEntry);
- 1: Include(Options, ioUninsDeleteEntireSection);
- 2: Include(Options, ioCreateKeyIfDoesntExist);
- 3: Include(Options, ioUninsDeleteSectionIfEmpty);
- end;
- { Filename }
- Filename := Values[paFilename].Data;
- { Section }
- Section := Values[paSection].Data;
- { Key }
- Entry := Values[paKey].Data;
- { String }
- if Values[paString].Found then begin
- Value := Values[paString].Data;
- Include(Options, ioHasValue);
- end;
- { Common parameters }
- ProcessExpressionParameter(ParamCommonComponents, Values[paComponents].Data, EvalComponentIdentifier, True, Components);
- ProcessExpressionParameter(ParamCommonTasks, Values[paTasks].Data, EvalTaskIdentifier, True, Tasks);
- ProcessExpressionParameter(ParamCommonLanguages, Values[paLanguages].Data, EvalLanguageIdentifier, False, Languages);
- Check := Values[paCheck].Data;
- BeforeInstall := Values[paBeforeInstall].Data;
- AfterInstall := Values[paAfterInstall].Data;
- ProcessMinVersionParameter(Values[paMinVersion], MinVersion);
- ProcessOnlyBelowVersionParameter(Values[paOnlyBelowVersion], OnlyBelowVersion);
- if (ioUninsDeleteEntry in Options) and
- (ioUninsDeleteEntireSection in Options) then
- AbortCompileFmt(SCompilerParamErrorBadCombo2,
- [ParamCommonFlags, 'uninsdeleteentry', 'uninsdeletesection']);
- if (ioUninsDeleteEntireSection in Options) and
- (ioUninsDeleteSectionIfEmpty in Options) then
- AbortCompileFmt(SCompilerParamErrorBadCombo2,
- [ParamCommonFlags, 'uninsdeletesection', 'uninsdeletesectionifempty']);
- CheckCheckOrInstall(ParamCommonCheck, Check, cikCheck);
- CheckCheckOrInstall(ParamCommonBeforeInstall, BeforeInstall, cikInstall);
- CheckCheckOrInstall(ParamCommonAfterInstall, AfterInstall, cikInstall);
- CheckConst(Filename, MinVersion, []);
- CheckConst(Section, MinVersion, []);
- CheckConst(Entry, MinVersion, []);
- CheckConst(Value, MinVersion, []);
- end;
- except
- SEFreeRec(NewIniEntry, SetupIniEntryStrings, SetupIniEntryAnsiStrings);
- raise;
- end;
- WriteDebugEntry(deIni, IniEntries.Count);
- IniEntries.Add(NewIniEntry);
- end;
- procedure TSetupCompiler.EnumRegistryProc(const Line: PChar; const Ext: Integer);
- type
- TParam = (paFlags, paRoot, paSubkey, paValueType, paValueName, paValueData,
- paPermissions, paComponents, paTasks, paLanguages, paCheck, paBeforeInstall,
- paAfterInstall, paMinVersion, paOnlyBelowVersion);
- const
- ParamRegistryRoot = 'Root';
- ParamRegistrySubkey = 'Subkey';
- ParamRegistryValueType = 'ValueType';
- ParamRegistryValueName = 'ValueName';
- ParamRegistryValueData = 'ValueData';
- ParamRegistryPermissions = 'Permissions';
- ParamInfo: array[TParam] of TParamInfo = (
- (Name: ParamCommonFlags; Flags: []),
- (Name: ParamRegistryRoot; Flags: [piRequired]),
- (Name: ParamRegistrySubkey; Flags: [piRequired, piNoEmpty]),
- (Name: ParamRegistryValueType; Flags: []),
- (Name: ParamRegistryValueName; Flags: []),
- (Name: ParamRegistryValueData; Flags: []),
- (Name: ParamRegistryPermissions; Flags: []),
- (Name: ParamCommonComponents; Flags: []),
- (Name: ParamCommonTasks; Flags: []),
- (Name: ParamCommonLanguages; Flags: []),
- (Name: ParamCommonCheck; Flags: []),
- (Name: ParamCommonBeforeInstall; Flags: []),
- (Name: ParamCommonAfterInstall; Flags: []),
- (Name: ParamCommonMinVersion; Flags: []),
- (Name: ParamCommonOnlyBelowVersion; Flags: []));
- Flags: array[0..9] of PChar = (
- 'createvalueifdoesntexist', 'uninsdeletevalue', 'uninsdeletekey',
- 'uninsdeletekeyifempty', 'uninsclearvalue', 'preservestringtype',
- 'deletekey', 'deletevalue', 'noerror', 'dontcreatekey');
- AccessMasks: array[0..2] of TNameAndAccessMask = (
- (Name: 'full'; Mask: $F003F),
- (Name: 'modify'; Mask: $3001F), { <- same access that Power Users get by default on HKLM\SOFTWARE }
- (Name: 'read'; Mask: $20019));
- function ConvertBinaryString(const S: String): String;
- procedure Invalid;
- begin
- AbortCompileParamError(SCompilerParamInvalid2, ParamRegistryValueData);
- end;
- var
- I: Integer;
- C: Char;
- B: Byte;
- N: Integer;
- procedure EndByte;
- begin
- case N of
- 0: ;
- 2: begin
- Result := Result + Chr(B);
- N := 0;
- B := 0;
- end;
- else
- Invalid;
- end;
- end;
- begin
- Result := '';
- N := 0;
- B := 0;
- for I := 1 to Length(S) do begin
- C := UpCase(S[I]);
- case C of
- ' ': EndByte;
- '0'..'9': begin
- Inc(N);
- if N > 2 then
- Invalid;
- B := Byte((B shl 4) or (Ord(C) - Ord('0')));
- end;
- 'A'..'F': begin
- Inc(N);
- if N > 2 then
- Invalid;
- B := Byte((B shl 4) or (10 + Ord(C) - Ord('A')));
- end;
- else
- Invalid;
- end;
- end;
- EndByte;
- end;
- function ConvertDWordString(const S: String): String;
- var
- DW: DWORD;
- E: Integer;
- begin
- Result := Trim(S);
- { Only check if it doesn't start with a constant }
- if (Result = '') or (Result[1] <> '{') then begin
- Val(Result, DW, E);
- if E <> 0 then
- AbortCompileParamError(SCompilerParamInvalid2, ParamRegistryValueData);
- { Not really necessary, but sanitize the value }
- Result := Format('$%x', [DW]);
- end;
- end;
- function ConvertQWordString(const S: String): String;
- begin
- Result := Trim(S);
- { Only check if it doesn't start with a constant }
- if (Result = '') or (Result[1] <> '{') then begin
- var QW: UInt64;
- if not TryStrToUInt64(Result, QW) then
- AbortCompileParamError(SCompilerParamInvalid2, ParamRegistryValueData);
- { Not really necessary, but sanitize the value }
- Result := Format('$%x', [QW]);
- end;
- end;
- var
- Values: array[TParam] of TParamValue;
- NewRegistryEntry: PSetupRegistryEntry;
- S, AData: String;
- begin
- ExtractParameters(Line, ParamInfo, Values);
- NewRegistryEntry := AllocMem(SizeOf(TSetupRegistryEntry));
- try
- with NewRegistryEntry^ do begin
- MinVersion := SetupHeader.MinVersion;
- { Flags }
- while True do
- case ExtractFlag(Values[paFlags].Data, Flags) of
- -2: Break;
- -1: AbortCompileParamError(SCompilerParamUnknownFlag2, ParamCommonFlags);
- 0: Include(Options, roCreateValueIfDoesntExist);
- 1: Include(Options, roUninsDeleteValue);
- 2: Include(Options, roUninsDeleteEntireKey);
- 3: Include(Options, roUninsDeleteEntireKeyIfEmpty);
- 4: Include(Options, roUninsClearValue);
- 5: Include(Options, roPreserveStringType);
- 6: Include(Options, roDeleteKey);
- 7: Include(Options, roDeleteValue);
- 8: Include(Options, roNoError);
- 9: Include(Options, roDontCreateKey);
- end;
- { Root }
- S := Uppercase(Trim(Values[paRoot].Data));
- if Length(S) >= 2 then begin
- { Check for '32' or '64' suffix }
- if (S[Length(S)-1] = '3') and (S[Length(S)] = '2') then begin
- Include(Options, ro32Bit);
- SetLength(S, Length(S)-2);
- end
- else if (S[Length(S)-1] = '6') and (S[Length(S)] = '4') then begin
- Include(Options, ro64Bit);
- SetLength(S, Length(S)-2);
- end;
- end;
- if S = 'HKA' then
- RootKey := HKEY_AUTO
- else if S = 'HKCR' then
- RootKey := HKEY_CLASSES_ROOT
- else if S = 'HKCU' then begin
- UsedUserAreas.Add(S);
- RootKey := HKEY_CURRENT_USER;
- end else if S = 'HKLM' then
- RootKey := HKEY_LOCAL_MACHINE
- else if S = 'HKU' then
- RootKey := HKEY_USERS
- else if S = 'HKCC' then
- RootKey := HKEY_CURRENT_CONFIG
- else
- AbortCompileParamError(SCompilerParamInvalid2, ParamRegistryRoot);
- { Subkey }
- if (Values[paSubkey].Data <> '') and (Values[paSubkey].Data[1] = '\') then
- AbortCompileParamError(SCompilerParamNoPrecedingBackslash, ParamRegistrySubkey);
- Subkey := Values[paSubkey].Data;
- { ValueType }
- if Values[paValueType].Found then begin
- Values[paValueType].Data := Uppercase(Trim(Values[paValueType].Data));
- if Values[paValueType].Data = 'NONE' then
- Typ := rtNone
- else if Values[paValueType].Data = 'STRING' then
- Typ := rtString
- else if Values[paValueType].Data = 'EXPANDSZ' then
- Typ := rtExpandString
- else if Values[paValueType].Data = 'MULTISZ' then
- Typ := rtMultiString
- else if Values[paValueType].Data = 'DWORD' then
- Typ := rtDWord
- else if Values[paValueType].Data = 'QWORD' then
- Typ := rtQWord
- else if Values[paValueType].Data = 'BINARY' then
- Typ := rtBinary
- else
- AbortCompileParamError(SCompilerParamInvalid2, ParamRegistryValueType);
- end;
- { ValueName }
- ValueName := Values[paValueName].Data;
- { ValueData }
- AData := Values[paValueData].Data;
- { Permissions }
- ProcessPermissionsParameter(Values[paPermissions].Data, AccessMasks,
- PermissionsEntry);
- { Common parameters }
- ProcessExpressionParameter(ParamCommonComponents, Values[paComponents].Data, EvalComponentIdentifier, True, Components);
- ProcessExpressionParameter(ParamCommonTasks, Values[paTasks].Data, EvalTaskIdentifier, True, Tasks);
- ProcessExpressionParameter(ParamCommonLanguages, Values[paLanguages].Data, EvalLanguageIdentifier, False, Languages);
- Check := Values[paCheck].Data;
- BeforeInstall := Values[paBeforeInstall].Data;
- AfterInstall := Values[paAfterInstall].Data;
- ProcessMinVersionParameter(Values[paMinVersion], MinVersion);
- ProcessOnlyBelowVersionParameter(Values[paOnlyBelowVersion], OnlyBelowVersion);
- if (roUninsDeleteEntireKey in Options) and
- (roUninsDeleteEntireKeyIfEmpty in Options) then
- AbortCompileFmt(SCompilerParamErrorBadCombo2,
- [ParamCommonFlags, 'uninsdeletekey', 'uninsdeletekeyifempty']);
- if (roUninsDeleteEntireKey in Options) and
- (roUninsClearValue in Options) then
- AbortCompileFmt(SCompilerParamErrorBadCombo2,
- [ParamCommonFlags, 'uninsclearvalue', 'uninsdeletekey']);
- if (roUninsDeleteValue in Options) and
- (roUninsDeleteEntireKey in Options) then
- AbortCompileFmt(SCompilerParamErrorBadCombo2,
- [ParamCommonFlags, 'uninsdeletevalue', 'uninsdeletekey']);
- if (roUninsDeleteValue in Options) and
- (roUninsClearValue in Options) then
- AbortCompileFmt(SCompilerParamErrorBadCombo2,
- [ParamCommonFlags, 'uninsdeletevalue', 'uninsclearvalue']);
- { Safety checks }
- if ((roUninsDeleteEntireKey in Options) or (roDeleteKey in Options)) and
- (CompareText(Subkey, 'SYSTEM\CurrentControlSet\Control\Session Manager\Environment') = 0) then
- AbortCompile(SCompilerRegistryDeleteKeyProhibited);
- case Typ of
- rtString, rtExpandString, rtMultiString:
- ValueData := AData;
- rtDWord:
- ValueData := ConvertDWordString(AData);
- rtQWord:
- ValueData := ConvertQWordString(AData);
- rtBinary:
- ValueData := ConvertBinaryString(AData);
- end;
- CheckCheckOrInstall(ParamCommonCheck, Check, cikCheck);
- CheckCheckOrInstall(ParamCommonBeforeInstall, BeforeInstall, cikInstall);
- CheckCheckOrInstall(ParamCommonAfterInstall, AfterInstall, cikInstall);
- CheckConst(Subkey, MinVersion, []);
- CheckConst(ValueName, MinVersion, []);
- case Typ of
- rtString, rtExpandString:
- CheckConst(ValueData, MinVersion, [acOldData]);
- rtMultiString:
- CheckConst(ValueData, MinVersion, [acOldData, acBreak]);
- rtDWord:
- CheckConst(ValueData, MinVersion, []);
- end;
- end;
- except
- SEFreeRec(NewRegistryEntry, SetupRegistryEntryStrings, SetupRegistryEntryAnsiStrings);
- raise;
- end;
- WriteDebugEntry(deRegistry, RegistryEntries.Count);
- RegistryEntries.Add(NewRegistryEntry);
- end;
- procedure TSetupCompiler.EnumDeleteProc(const Line: PChar; const Ext: Integer);
- type
- TParam = (paType, paName, paComponents, paTasks, paLanguages, paCheck,
- paBeforeInstall, paAfterInstall, paMinVersion, paOnlyBelowVersion);
- const
- ParamDeleteType = 'Type';
- ParamDeleteName = 'Name';
- ParamInfo: array[TParam] of TParamInfo = (
- (Name: ParamDeleteType; Flags: [piRequired]),
- (Name: ParamDeleteName; Flags: [piRequired, piNoEmpty]),
- (Name: ParamCommonComponents; Flags: []),
- (Name: ParamCommonTasks; Flags: []),
- (Name: ParamCommonLanguages; Flags: []),
- (Name: ParamCommonCheck; Flags: []),
- (Name: ParamCommonBeforeInstall; Flags: []),
- (Name: ParamCommonAfterInstall; Flags: []),
- (Name: ParamCommonMinVersion; Flags: []),
- (Name: ParamCommonOnlyBelowVersion; Flags: []));
- Types: array[TSetupDeleteType] of PChar = (
- 'files', 'filesandordirs', 'dirifempty');
- var
- Values: array[TParam] of TParamValue;
- NewDeleteEntry: PSetupDeleteEntry;
- Valid: Boolean;
- J: TSetupDeleteType;
- begin
- ExtractParameters(Line, ParamInfo, Values);
- NewDeleteEntry := AllocMem(SizeOf(TSetupDeleteEntry));
- try
- with NewDeleteEntry^ do begin
- MinVersion := SetupHeader.MinVersion;
- { Type }
- Values[paType].Data := Trim(Values[paType].Data);
- Valid := False;
- for J := Low(J) to High(J) do
- if StrIComp(Types[J], PChar(Values[paType].Data)) = 0 then begin
- DeleteType := J;
- Valid := True;
- Break;
- end;
- if not Valid then
- AbortCompileParamError(SCompilerParamInvalid2, ParamDeleteType);
- { Name }
- Name := Values[paName].Data;
- { Common parameters }
- ProcessExpressionParameter(ParamCommonComponents, Values[paComponents].Data, EvalComponentIdentifier, True, Components);
- ProcessExpressionParameter(ParamCommonTasks, Values[paTasks].Data, EvalTaskIdentifier, True, Tasks);
- ProcessExpressionParameter(ParamCommonLanguages, Values[paLanguages].Data, EvalLanguageIdentifier, False, Languages);
- Check := Values[paCheck].Data;
- BeforeInstall := Values[paBeforeInstall].Data;
- AfterInstall := Values[paAfterInstall].Data;
- ProcessMinVersionParameter(Values[paMinVersion], MinVersion);
- ProcessOnlyBelowVersionParameter(Values[paOnlyBelowVersion], OnlyBelowVersion);
- CheckCheckOrInstall(ParamCommonCheck, Check, cikCheck);
- CheckCheckOrInstall(ParamCommonBeforeInstall, BeforeInstall, cikInstall);
- CheckCheckOrInstall(ParamCommonAfterInstall, AfterInstall, cikInstall);
- CheckConst(Name, MinVersion, []);
- end;
- except
- SEFreeRec(NewDeleteEntry, SetupDeleteEntryStrings, SetupDeleteEntryAnsiStrings);
- raise;
- end;
- if Ext = 0 then begin
- WriteDebugEntry(deInstallDelete, InstallDeleteEntries.Count);
- InstallDeleteEntries.Add(NewDeleteEntry);
- end
- else begin
- WriteDebugEntry(deUninstallDelete, UninstallDeleteEntries.Count);
- UninstallDeleteEntries.Add(NewDeleteEntry);
- end;
- end;
- procedure TSetupCompiler.EnumISSigKeysProc(const Line: PChar; const Ext: Integer);
- function ISSigKeysNameExists(const Name: String; const CheckGroupNames: Boolean): Boolean;
- begin
- for var I := 0 to ISSigKeyEntryExtraInfos.Count-1 do begin
- var ISSigKeyEntryExtraInfo := PISSigKeyEntryExtraInfo(ISSigKeyEntryExtraInfos[I]);
- if SameText(ISSigKeyEntryExtraInfo.Name, Name) or
- (CheckGroupNames and ISSigKeyEntryExtraInfo.HasGroupName(Name)) then
- Exit(True)
- end;
- Result := False;
- end;
- function ISSigKeysRuntimeIDExists(const RuntimeID: String): Boolean;
- begin
- for var I := 0 to ISSigKeyEntries.Count-1 do begin
- var ISSigKeyEntry := PSetupISSigKeyEntry(ISSigKeyEntries[I]);
- if SameText(ISSigKeyEntry.RuntimeID, RuntimeID) then
- Exit(True)
- end;
- Result := False;
- end;
- type
- TParam = (paName, paGroup, paKeyFile, paKeyID, paPublicX, paPublicY, paRuntimeID);
- const
- ParamISSigKeysName = 'Name';
- ParamISSigKeysGroup = 'Group';
- ParamISSigKeysKeyFile = 'KeyFile';
- ParamISSigKeysKeyID = 'KeyID';
- ParamISSigKeysPublicX = 'PublicX';
- ParamISSigKeysPublicY = 'PublicY';
- ParamISSigKeysRuntimeID = 'RuntimeID';
- ParamInfo: array[TParam] of TParamInfo = (
- (Name: ParamISSigKeysName; Flags: [piRequired, piNoEmpty]),
- (Name: ParamISSigKeysGroup; Flags: []),
- (Name: ParamISSigKeysKeyFile; Flags: [piNoEmpty]),
- (Name: ParamISSigKeysKeyID; Flags: [piNoEmpty]),
- (Name: ParamISSigKeysPublicX; Flags: [piNoEmpty]),
- (Name: ParamISSigKeysPublicY; Flags: [piNoEmpty]),
- (Name: ParamISSigKeysRuntimeID; Flags: [piNoEmpty]));
- var
- Values: array[TParam] of TParamValue;
- NewISSigKeyEntry: PSetupISSigKeyEntry;
- NewISSigKeyEntryExtraInfo: PISSigKeyEntryExtraInfo;
- begin
- ExtractParameters(Line, ParamInfo, Values);
- NewISSigKeyEntry := nil;
- NewISSigKeyEntryExtraInfo := nil;
- try
- NewISSigKeyEntryExtraInfo := AllocMem(SizeOf(TISSigKeyEntryExtraInfo));
- with NewISSigKeyEntryExtraInfo^ do begin
- { Name }
- Name := Values[paName].Data;
- if not IsValidIdentString(Name, False, False) then
- AbortCompileFmt(SCompilerLanguagesOrISSigKeysBadName, [ParamISSigKeysName])
- else if ISSigKeysNameExists(Name, True) then
- AbortCompileFmt(SCompilerISSigKeysNameOrRuntimeIDExists, [ParamISSigKeysName, Name]);
- { Group }
- var S := Values[paGroup].Data;
- while True do begin
- const GroupName = ExtractStr(S, ' ');
- if GroupName = '' then
- Break;
- if not IsValidIdentString(GroupName, False, False) then
- AbortCompileFmt(SCompilerLanguagesOrISSigKeysBadGroupName, [ParamISSigKeysGroup])
- else if SameText(Name, GroupName) or ISSigKeysNameExists(GroupName, False) then
- AbortCompileFmt(SCompilerISSigKeysNameOrRuntimeIDExists, [ParamISSigKeysName, GroupName]);
- if not HasGroupName(GroupName) then begin
- const N = Length(GroupNames);
- SetLength(GroupNames, N+1);
- GroupNames[N] := GroupName;
- end;
- end;
- end;
- NewISSigKeyEntry := AllocMem(SizeOf(TSetupISSigKeyEntry));
- with NewISSigKeyEntry^ do begin
- { KeyFile & PublicX & PublicY }
- var KeyFile := PrependSourceDirName(Values[paKeyFile].Data);
- PublicX := Values[paPublicX].Data;
- PublicY := Values[paPublicY].Data;
- if (KeyFile = '') and (PublicX = '') and (PublicY = '') then
- AbortCompile(SCompilerISSigKeysKeyNotSpecified)
- else if KeyFile <> '' then begin
- if PublicX <> '' then
- AbortCompileFmt(SCompilerParamConflict, [ParamISSigKeysKeyFile, ParamISSigKeysPublicX])
- else if PublicY <> '' then
- AbortCompileFmt(SCompilerParamConflict, [ParamISSigKeysKeyFile, ParamISSigKeysPublicY]);
- var KeyText := ISSigLoadTextFromFile(KeyFile);
- var PublicKey: TECDSAPublicKey;
- const ParseResult = ISSigParsePublicKeyText(KeyText, PublicKey);
- if ParseResult = ikrMalformed then
- AbortCompile(SCompilerISSigKeysBadKeyFile)
- else if ParseResult <> ikrSuccess then
- AbortCompile(SCompilerISSigKeysUnknownKeyImportResult);
- ISSigConvertPublicKeyToStrings(PublicKey, PublicX, PublicY);
- end else begin
- if PublicX = '' then
- AbortCompileParamError(SCompilerParamNotSpecified, ParamISSigKeysPublicX)
- else if PublicY = '' then
- AbortCompileParamError(SCompilerParamNotSpecified, ParamISSigKeysPublicY);
- try
- ISSigCheckValidPublicXOrY(PublicX);
- except
- AbortCompileFmt(SCompilerParamInvalidWithError, [ParamISSigKeysPublicX, GetExceptMessage]);
- end;
- try
- ISSigCheckValidPublicXOrY(PublicY);
- except
- AbortCompileFmt(SCompilerParamInvalidWithError, [ParamISSigKeysPublicY, GetExceptMessage]);
- end;
- end;
- { KeyID }
- var KeyID := Values[paKeyID].Data;
- if KeyID <> '' then begin
- try
- ISSigCheckValidKeyID(KeyID);
- except
- AbortCompileFmt(SCompilerParamInvalidWithError, [ParamISSigKeysKeyID, GetExceptMessage]);
- end;
- if not ISSigIsValidKeyIDForPublicXY(KeyID, PublicX, PublicY) then
- AbortCompile(SCompilerISSigKeysBadKeyID);
- end;
- RuntimeID := Values[paRuntimeID].Data;
- if (RuntimeID <> '') and ISSigKeysRuntimeIDExists(RuntimeID) then
- AbortCompileFmt(SCompilerISSigKeysNameOrRuntimeIDExists, [ParamISSigKeysRuntimeID, RuntimeID]);
- end;
- except
- SEFreeRec(NewISSigKeyEntry, SetupISSigKeyEntryStrings, SetupISSigKeyEntryAnsiStrings);
- Dispose(NewISSigKeyEntryExtraInfo);
- raise;
- end;
- ISSigKeyEntries.Add(NewISSigKeyEntry);
- ISSigKeyEntryExtraInfos.Add(NewISSigKeyEntryExtraInfo);
- end;
- procedure TSetupCompiler.EnumFilesProc(const Line: PChar; const Ext: Integer);
- function EscapeBraces(const S: String): String;
- { Changes all '{' to '{{' }
- var
- I: Integer;
- begin
- Result := S;
- I := 1;
- while I <= Length(Result) do begin
- if Result[I] = '{' then begin
- Insert('{', Result, I);
- Inc(I);
- end;
- Inc(I);
- end;
- end;
- type
- TParam = (paFlags, paSource, paDestDir, paDestName, paCopyMode, paAttribs,
- paPermissions, paFontInstall, paExcludes, paExternalSize, paExtractArchivePassword,
- paStrongAssemblyName, paHash, paISSigAllowedKeys, paDownloadISSigSource, paDownloadUserName,
- paDownloadPassword, paComponents, paTasks, paLanguages, paCheck, paBeforeInstall,
- paAfterInstall, paMinVersion, paOnlyBelowVersion);
- const
- ParamFilesSource = 'Source';
- ParamFilesDestDir = 'DestDir';
- ParamFilesDestName = 'DestName';
- ParamFilesCopyMode = 'CopyMode';
- ParamFilesAttribs = 'Attribs';
- ParamFilesPermissions = 'Permissions';
- ParamFilesFontInstall = 'FontInstall';
- ParamFilesExcludes = 'Excludes';
- ParamFilesExternalSize = 'ExternalSize';
- ParamFilesExtractArchivePassword = 'ExtractArchivePassword';
- ParamFilesStrongAssemblyName = 'StrongAssemblyName';
- ParamFilesHash = 'Hash';
- ParamFilesISSigAllowedKeys = 'ISSigAllowedKeys';
- ParamFilesDownloadISSigSource = 'DownloadISSigSource';
- ParamFilesDownloadUserName = 'DownloadUserName';
- ParamFilesDownloadPassword = 'DownloadPassword';
- ParamInfo: array[TParam] of TParamInfo = (
- (Name: ParamCommonFlags; Flags: []),
- (Name: ParamFilesSource; Flags: [piRequired, piNoEmpty, piNoQuotes]),
- (Name: ParamFilesDestDir; Flags: [piNoEmpty, piNoQuotes]),
- (Name: ParamFilesDestName; Flags: [piNoEmpty, piNoQuotes]),
- (Name: ParamFilesCopyMode; Flags: []),
- (Name: ParamFilesAttribs; Flags: []),
- (Name: ParamFilesPermissions; Flags: []),
- (Name: ParamFilesFontInstall; Flags: [piNoEmpty]),
- (Name: ParamFilesExcludes; Flags: []),
- (Name: ParamFilesExternalSize; Flags: []),
- (Name: ParamFilesExtractArchivePassword; Flags: []),
- (Name: ParamFilesStrongAssemblyName; Flags: [piNoEmpty]),
- (Name: ParamFilesHash; Flags: [piNoEmpty]),
- (Name: ParamFilesISSigAllowedKeys; Flags: [piNoEmpty]),
- (Name: ParamFilesDownloadISSigSource; Flags: []),
- (Name: ParamFilesDownloadUserName; Flags: [piNoEmpty]),
- (Name: ParamFilesDownloadPassword; Flags: [piNoEmpty]),
- (Name: ParamCommonComponents; Flags: []),
- (Name: ParamCommonTasks; Flags: []),
- (Name: ParamCommonLanguages; Flags: []),
- (Name: ParamCommonCheck; Flags: []),
- (Name: ParamCommonBeforeInstall; Flags: []),
- (Name: ParamCommonAfterInstall; Flags: []),
- (Name: ParamCommonMinVersion; Flags: []),
- (Name: ParamCommonOnlyBelowVersion; Flags: []));
- Flags: array[0..44] of PChar = (
- 'confirmoverwrite', 'uninsneveruninstall', 'isreadme', 'regserver',
- 'sharedfile', 'restartreplace', 'deleteafterinstall',
- 'comparetimestamp', 'fontisnttruetype', 'regtypelib', 'external',
- 'skipifsourcedoesntexist', 'overwritereadonly', 'onlyifdestfileexists',
- 'recursesubdirs', 'noregerror', 'allowunsafefiles', 'uninsrestartdelete',
- 'onlyifdoesntexist', 'ignoreversion', 'promptifolder', 'dontcopy',
- 'uninsremovereadonly', 'sortfilesbyextension', 'touch', 'replacesameversion',
- 'noencryption', 'nocompression', 'dontverifychecksum',
- 'uninsnosharedfileprompt', 'createallsubdirs', '32bit', '64bit',
- 'solidbreak', 'setntfscompression', 'unsetntfscompression',
- 'sortfilesbyname', 'gacinstall', 'sign', 'signonce', 'signcheck',
- 'issigverify', 'download', 'extractarchive', 'notimestamp');
- SignFlags: array[TFileLocationSign] of String = (
- '', 'sign', 'signonce', 'signcheck');
- AttribsFlags: array[0..3] of PChar = (
- 'readonly', 'hidden', 'system', 'notcontentindexed');
- AccessMasks: array[0..2] of TNameAndAccessMask = (
- (Name: 'full'; Mask: $1F01FF),
- (Name: 'modify'; Mask: $1301BF),
- (Name: 'readexec'; Mask: $1200A9));
- var
- Values: array[TParam] of TParamValue;
- NewFileEntry, PrevFileEntry: PSetupFileEntry;
- NewFileLocationEntry: PSetupFileLocationEntry;
- NewFileLocationEntryExtraInfo: PFileLocationEntryExtraInfo;
- VersionNumbers: TFileVersionNumbers;
- SourceWildcard, ADestDir, ADestName, AInstallFontName, AStrongAssemblyName: String;
- AExcludes: TStringList;
- ReadmeFile, ExternalFile, SourceIsWildcard, RecurseSubdirs,
- AllowUnsafeFiles, Touch, NoTimeStamp, NoCompression, NoEncryption, SolidBreak: Boolean;
- Sign: TFileLocationSign;
- type
- PFileListRec = ^TFileListRec;
- TFileListRec = record
- Name: String;
- Size: Int64;
- end;
- PDirListRec = ^TDirListRec;
- TDirListRec = record
- Name: String;
- end;
- procedure CheckForUnsafeFile(const Filename, SourceFile: String;
- const IsRegistered: Boolean);
- { This generates errors on "unsafe files" }
- const
- UnsafeSysFiles: array[0..13] of String = (
- 'ADVAPI32.DLL', 'COMCTL32.DLL', 'COMDLG32.DLL', 'GDI32.DLL',
- 'KERNEL32.DLL', 'MSCOREE.DLL', 'RICHED32.DLL', 'SHDOCVW.DLL',
- 'SHELL32.DLL', 'SHLWAPI.DLL', 'URLMON.DLL', 'USER32.DLL', 'UXTHEME.DLL',
- 'WININET.DLL');
- UnsafeNonSysRegFiles: array[0..5] of String = (
- 'COMCAT.DLL', 'MSVBVM50.DLL', 'MSVBVM60.DLL', 'OLEAUT32.DLL',
- 'OLEPRO32.DLL', 'STDOLE2.TLB');
- var
- SourceFileDir, SysWow64Dir: String;
- I: Integer;
- begin
- if AllowUnsafeFiles then
- Exit;
- if ADestDir = '{sys}\' then begin
- { Files that must NOT be deployed to the user's System directory }
- { Any DLL deployed from system's own System directory }
- if not ExternalFile and
- SameText(PathExtractExt(Filename), '.DLL') then begin
- SourceFileDir := PathExpand(PathExtractDir(SourceFile));
- SysWow64Dir := GetSysWow64Dir;
- if (PathCompare(SourceFileDir, GetSystemDir) = 0) or
- ((SysWow64Dir <> '') and ((PathCompare(SourceFileDir, SysWow64Dir) = 0))) then
- AbortCompile(SCompilerFilesSystemDirUsed);
- end;
- { CTL3D32.DLL }
- if not ExternalFile and
- (CompareText(Filename, 'CTL3D32.DLL') = 0) and
- (NewFileEntry^.MinVersion.WinVersion <> 0) and
- FileSizeAndCRCIs(SourceFile, 27136, $28A66C20) then
- AbortCompileFmt(SCompilerFilesUnsafeFile, ['CTL3D32.DLL, Windows NT-specific version']);
- { Remaining files }
- for I := Low(UnsafeSysFiles) to High(UnsafeSysFiles) do
- if CompareText(Filename, UnsafeSysFiles[I]) = 0 then
- AbortCompileFmt(SCompilerFilesUnsafeFile, [UnsafeSysFiles[I]]);
- end
- else begin
- { Files that MUST be deployed to the user's System directory }
- if IsRegistered then
- for I := Low(UnsafeNonSysRegFiles) to High(UnsafeNonSysRegFiles) do
- if CompareText(Filename, UnsafeNonSysRegFiles[I]) = 0 then
- AbortCompileFmt(SCompilerFilesSystemDirNotUsed, [UnsafeNonSysRegFiles[I]]);
- end;
- end;
- procedure AddToFileList(const FileList: TList; const Filename: String;
- const Size: Int64);
- var
- Rec: PFileListRec;
- begin
- FileList.Expand;
- New(Rec);
- Rec.Name := Filename;
- Rec.Size := Size;
- FileList.Add(Rec);
- end;
- procedure AddToDirList(const DirList: TList; const Dirname: String);
- var
- Rec: PDirListRec;
- begin
- DirList.Expand;
- New(Rec);
- Rec.Name := Dirname;
- DirList.Add(Rec);
- end;
- procedure BuildFileList(const SearchBaseDir, SearchSubDir, SearchWildcard: String;
- FileList, DirList: TList; CreateAllSubDirs: Boolean);
- { Searches for any non excluded files matching "SearchBaseDir + SearchSubDir + SearchWildcard"
- and adds them to FileList. }
- var
- SearchFullPath, FileName: String;
- H: THandle;
- FindData: TWin32FindData;
- OldFileListCount, OldDirListCount: Integer;
- begin
- SearchFullPath := SearchBaseDir + SearchSubDir + SearchWildcard;
- OldFileListCount := FileList.Count;
- OldDirListCount := DirList.Count;
- H := FindFirstFile(PChar(SearchFullPath), FindData);
- if H <> INVALID_HANDLE_VALUE then begin
- try
- repeat
- if FindData.dwFileAttributes and FILE_ATTRIBUTE_DIRECTORY <> 0 then
- Continue;
- if SourceIsWildcard then begin
- if FindData.dwFileAttributes and FILE_ATTRIBUTE_HIDDEN <> 0 then
- Continue;
- FileName := FindData.cFileName;
- end
- else
- FileName := SearchWildcard; { use the case specified in the script }
- if IsExcluded(SearchSubDir + FileName, AExcludes) then
- Continue;
- AddToFileList(FileList, SearchSubDir + FileName, FindDataFileSizeToInt64(FindData));
- CallIdleProc;
- until not SourceIsWildcard or not FindNextFile(H, FindData);
- finally
- Windows.FindClose(H);
- end;
- end else
- CallIdleProc;
- if RecurseSubdirs then begin
- H := FindFirstFile(PChar(SearchBaseDir + SearchSubDir + '*'), FindData);
- if H <> INVALID_HANDLE_VALUE then begin
- try
- repeat
- if (FindData.dwFileAttributes and FILE_ATTRIBUTE_DIRECTORY <> 0) and
- (FindData.dwFileAttributes and FILE_ATTRIBUTE_HIDDEN = 0) and
- (StrComp(FindData.cFileName, '.') <> 0) and
- (StrComp(FindData.cFileName, '..') <> 0) and
- not IsExcluded(SearchSubDir + FindData.cFileName, AExcludes) then
- BuildFileList(SearchBaseDir, SearchSubDir + FindData.cFileName + '\',
- SearchWildcard, FileList, DirList, CreateAllSubDirs);
- until not FindNextFile(H, FindData);
- finally
- Windows.FindClose(H);
- end;
- end;
- end;
- if SearchSubDir <> '' then begin
- { If both FileList and DirList didn't change size, this subdir won't be
- created during install, so add it to DirList now if CreateAllSubDirs is set }
- if CreateAllSubDirs and (FileList.Count = OldFileListCount) and
- (DirList.Count = OldDirListCount) then
- AddToDirList(DirList, SearchSubDir);
- end;
- end;
- procedure ApplyNewSign(var Sign: TFileLocationSign;
- const NewSign: TFileLocationSign; const ErrorMessage: String);
- begin
- if not (Sign in [fsNoSetting, NewSign]) then
- AbortCompileFmt(ErrorMessage,
- [ParamCommonFlags, SignFlags[Sign], SignFlags[NewSign]])
- else
- Sign := NewSign;
- end;
- procedure ApplyNewVerificationType(var VerificationType: TSetupFileVerificationType;
- const NewVerificationType: TSetupFileVerificationType; const ErrorMessage: String);
- begin
- if not (VerificationType in [fvNone, NewVerificationType]) then
- AbortCompileFmt(ErrorMessage, ['Hash', 'issigverify'])
- else
- VerificationType := NewVerificationType;
- end;
- procedure ProcessFileList(const FileListBaseDir: String; FileList: TList);
- var
- FileListRec: PFileListRec;
- CheckName: String;
- SourceFile: String;
- I, J: Integer;
- NewRunEntry: PSetupRunEntry;
- begin
- for I := 0 to FileList.Count-1 do begin
- FileListRec := FileList[I];
- if NewFileEntry = nil then begin
- NewFileEntry := AllocMem(SizeOf(TSetupFileEntry));
- SEDuplicateRec(PrevFileEntry, NewFileEntry,
- SizeOf(TSetupFileEntry), SetupFileEntryStrings, SetupFileEntryAnsiStrings);
- end;
- if Ext = 0 then begin
- if ADestName = '' then begin
- if not ExternalFile then
- NewFileEntry^.DestName := ADestDir + EscapeBraces(FileListRec.Name)
- else
- { Don't append the filename to DestName on 'external' files;
- it will be determined during installation }
- NewFileEntry^.DestName := ADestDir;
- end
- else begin
- if not ExternalFile then
- NewFileEntry^.DestName := ADestDir + EscapeBraces(PathExtractPath(FileListRec.Name)) +
- ADestName
- else
- NewFileEntry^.DestName := ADestDir + ADestName;
- { ^ user is already required to escape '{' in DestName }
- Include(NewFileEntry^.Options, foCustomDestName);
- end;
- end
- else
- NewFileEntry^.DestName := '';
- SourceFile := FileListBaseDir + FileListRec.Name;
- NewFileLocationEntry := nil;
- if not ExternalFile then begin
- if not DontMergeDuplicateFiles then begin
- { See if the source filename is already in the list of files to
- be compressed. If so, merge it. }
- J := FileLocationEntryFilenames.CaseInsensitiveIndexOf(SourceFile);
- if J <> -1 then begin
- NewFileLocationEntry := FileLocationEntries[J];
- NewFileLocationEntryExtraInfo := FileLocationEntryExtraInfos[J];
- NewFileEntry^.LocationEntry := J;
- end;
- end;
- if NewFileLocationEntry = nil then begin
- NewFileLocationEntry := AllocMem(SizeOf(TSetupFileLocationEntry));
- NewFileLocationEntryExtraInfo := AllocMem(SizeOf(TFileLocationEntryExtraInfo));
- SetupHeader.CompressMethod := CompressMethod;
- FileLocationEntries.Add(NewFileLocationEntry);
- FileLocationEntryExtraInfos.Add(NewFileLocationEntryExtraInfo);
- FileLocationEntryFilenames.Add(SourceFile);
- NewFileEntry^.LocationEntry := FileLocationEntries.Count-1;
- if NewFileEntry^.FileType = ftUninstExe then
- Include(NewFileLocationEntryExtraInfo^.Flags, floIsUninstExe);
- Inc(TotalBytesToCompress, FileListRec.Size);
- if SetupHeader.CompressMethod <> cmStored then
- Include(NewFileLocationEntry^.Flags, floChunkCompressed);
- if SetupEncryptionHeader.EncryptionUse <> euNone then
- Include(NewFileLocationEntry^.Flags, floChunkEncrypted);
- if SolidBreak and UseSolidCompression then begin
- Include(NewFileLocationEntryExtraInfo^.Flags, floSolidBreak);
- { If the entry matches multiple files, it should only break prior
- to compressing the first one }
- SolidBreak := False;
- end;
- NewFileLocationEntryExtraInfo^.Verification.Typ := fvNone; { Correct value set below }
- NewFileLocationEntryExtraInfo^.Verification.Hash := NewFileEntry^.Verification.Hash;
- NewFileLocationEntryExtraInfo^.Verification.ISSigAllowedKeys := NewFileEntry^.Verification.ISSigAllowedKeys;
- end else begin
- { Verification.Typ changes checked below }
- if (NewFileLocationEntryExtraInfo^.Verification.Typ = fvHash) and
- (NewFileEntry^.Verification.Typ = fvHash) and
- not CompareMem(@NewFileLocationEntryExtraInfo^.Verification.Hash[0],
- @NewFileEntry^.Verification.Hash[0], SizeOf(TSHA256Digest)) then
- AbortCompileFmt(SCompilerFilesValueConflict, ['Hash']);
- if (NewFileLocationEntryExtraInfo^.Verification.Typ = fvISSig) and
- (NewFileEntry^.Verification.Typ = fvISSig) and
- (NewFileLocationEntryExtraInfo^.Verification.ISSigAllowedKeys <> NewFileEntry^.Verification.ISSigAllowedKeys) then
- AbortCompileFmt(SCompilerFilesValueConflict, ['ISSigAllowedKeys']);
- end;
- if Touch then
- Include(NewFileLocationEntryExtraInfo^.Flags, floTouch);
- if NoTimeStamp then
- Include(NewFileLocationEntryExtraInfo^.Flags, floNoTimeStamp);
- { Note: "nocompression"/"noencryption" on one file makes all merged
- copies uncompressed/unencrypted too }
- if NoCompression then
- Exclude(NewFileLocationEntry^.Flags, floChunkCompressed);
- if NoEncryption then
- Exclude(NewFileLocationEntry^.Flags, floChunkEncrypted);
- if Sign <> fsNoSetting then
- ApplyNewSign(NewFileLocationEntryExtraInfo.Sign, Sign, SCompilerParamErrorBadCombo2SameSource);
- if NewFileEntry^.Verification.Typ <> fvNone then
- ApplyNewVerificationType(NewFileLocationEntryExtraInfo.Verification.Typ, NewFileEntry^.Verification.Typ,
- SCompilerFilesParamFlagConflictSameSource);
- end
- else begin
- NewFileEntry^.SourceFilename := SourceFile;
- NewFileEntry^.LocationEntry := -1;
- end;
- { Read version info }
- if not ExternalFile and not(foIgnoreVersion in NewFileEntry^.Options) and
- (NewFileLocationEntry^.Flags * [floVersionInfoValid] = []) and
- (NewFileLocationEntryExtraInfo^.Flags * [floVersionInfoNotValid] = []) then begin
- AddStatus(Format(SCompilerStatusFilesVerInfo, [SourceFile]));
- if GetVersionNumbers(SourceFile, VersionNumbers) then begin
- NewFileLocationEntry^.FileVersionMS := VersionNumbers.MS;
- NewFileLocationEntry^.FileVersionLS := VersionNumbers.LS;
- Include(NewFileLocationEntry^.Flags, floVersionInfoValid);
- end
- else
- Include(NewFileLocationEntryExtraInfo^.Flags, floVersionInfoNotValid);
- end;
- { Safety checks }
- if Ext = 0 then begin
- if ADestName <> '' then
- CheckName := ADestName
- else
- CheckName := PathExtractName(FileListRec.Name);
- CheckForUnsafeFile(CheckName, SourceFile,
- (foRegisterServer in NewFileEntry^.Options) or
- (foRegisterTypeLib in NewFileEntry^.Options));
- if (ADestDir = '{sys}\') and (foIgnoreVersion in NewFileEntry^.Options) and
- not SameText(PathExtractExt(CheckName), '.scr') then
- WarningsList.Add(Format(SCompilerFilesIgnoreVersionUsedUnsafely, [CheckName]));
- end;
- if ReadmeFile then begin
- NewRunEntry := AllocMem(Sizeof(TSetupRunEntry));
- NewRunEntry.Name := NewFileEntry.DestName;
- NewRunEntry.Components := NewFileEntry.Components;
- NewRunEntry.Tasks := NewFileEntry.Tasks;
- NewRunEntry.Languages := NewFileEntry.Languages;
- NewRunEntry.Check := NewFileEntry.Check;
- NewRunEntry.BeforeInstall := '';
- NewRunEntry.AfterInstall := '';
- NewRunEntry.MinVersion := NewFileEntry.MinVersion;
- NewRunEntry.OnlyBelowVersion := NewFileEntry.OnlyBelowVersion;
- NewRunEntry.Options := [roShellExec, roSkipIfDoesntExist, roPostInstall,
- roSkipIfSilent, roRunAsOriginalUser];
- NewRunEntry.ShowCmd := SW_SHOWNORMAL;
- NewRunEntry.Wait := rwNoWait;
- NewRunEntry.Verb := '';
- RunEntries.Insert(0, NewRunEntry);
- ShiftDebugEntryIndexes(deRun); { because we inserted at the front }
- end;
- WriteDebugEntry(deFile, FileEntries.Count);
- FileEntries.Expand;
- PrevFileEntry := NewFileEntry;
- { nil before adding so there's no chance it could ever be double-freed }
- NewFileEntry := nil;
- FileEntries.Add(PrevFileEntry);
- CallIdleProc;
- end;
- end;
- procedure SortFileList(FileList: TList; L: Integer; const R: Integer;
- const ByExtension, ByName: Boolean);
- function Compare(const F1, F2: PFileListRec): Integer;
- function ComparePathStr(P1, P2: PChar): Integer;
- { Like CompareStr, but sorts backslashes correctly ('A\B' < 'AB\B') }
- var
- C1, C2: Char;
- begin
- repeat
- C1 := P1^;
- if C1 = '\' then
- C1 := #1;
- C2 := P2^;
- if C2 = '\' then
- C2 := #1;
- Result := Ord(C1) - Ord(C2);
- if Result <> 0 then
- Break;
- if C1 = #0 then
- Break;
- Inc(P1);
- Inc(P2);
- until False;
- end;
- var
- S1, S2: String;
- begin
- { Optimization: First check if we were passed the same string }
- if Pointer(F1.Name) = Pointer(F2.Name) then begin
- Result := 0;
- Exit;
- end;
- S1 := AnsiUppercase(F1.Name); { uppercase to mimic NTFS's sort order }
- S2 := AnsiUppercase(F2.Name);
- if ByExtension then
- Result := CompareStr(PathExtractExt(S1), PathExtractExt(S2))
- else
- Result := 0;
- if ByName and (Result = 0) then
- Result := CompareStr(PathExtractName(S1), PathExtractName(S2));
- if Result = 0 then begin
- { To avoid randomness in the sorting, sort by path and then name }
- Result := ComparePathStr(PChar(PathExtractPath(S1)),
- PChar(PathExtractPath(S2)));
- if Result = 0 then
- Result := CompareStr(S1, S2);
- end;
- end;
- var
- I, J: Integer;
- P: PFileListRec;
- begin
- repeat
- I := L;
- J := R;
- P := FileList[(L + R) shr 1];
- repeat
- while Compare(FileList[I], P) < 0 do
- Inc(I);
- while Compare(FileList[J], P) > 0 do
- Dec(J);
- if I <= J then begin
- FileList.Exchange(I, J);
- Inc(I);
- Dec(J);
- end;
- until I > J;
- if L < J then
- SortFileList(FileList, L, J, ByExtension, ByName);
- L := I;
- until I >= R;
- end;
- procedure ProcessDirList(DirList: TList);
- var
- DirListRec: PDirListRec;
- NewDirEntry: PSetupDirEntry;
- BaseFileEntry: PSetupFileEntry;
- I: Integer;
- begin
- if NewFileEntry <> nil then
- { If NewFileEntry is still assigned it means ProcessFileList didn't
- process any files (i.e. only directories were matched) }
- BaseFileEntry := NewFileEntry
- else
- BaseFileEntry := PrevFileEntry;
- if not(foDontCopy in BaseFileEntry.Options) then begin
- for I := 0 to DirList.Count-1 do begin
- DirListRec := DirList[I];
- NewDirEntry := AllocMem(Sizeof(TSetupDirEntry));
- NewDirEntry.DirName := ADestDir + EscapeBraces(DirListRec.Name);
- NewDirEntry.Components := BaseFileEntry.Components;
- NewDirEntry.Tasks := BaseFileEntry.Tasks;
- NewDirEntry.Languages := BaseFileEntry.Languages;
- NewDirEntry.Check := BaseFileEntry.Check;
- NewDirEntry.BeforeInstall := '';
- NewDirEntry.AfterInstall := '';
- NewDirEntry.MinVersion := BaseFileEntry.MinVersion;
- NewDirEntry.OnlyBelowVersion := BaseFileEntry.OnlyBelowVersion;
- NewDirEntry.Attribs := 0;
- NewDirEntry.PermissionsEntry := -1;
- NewDirEntry.Options := [];
- DirEntries.Add(NewDirEntry);
- end;
- end;
- end;
- var
- FileList, DirList: TList;
- SortFilesByExtension, SortFilesByName: Boolean;
- I: Integer;
- begin
- CallIdleProc;
- if Ext = 0 then
- ExtractParameters(Line, ParamInfo, Values);
- AExcludes := TStringList.Create();
- try
- AExcludes.StrictDelimiter := True;
- AExcludes.Delimiter := ',';
- PrevFileEntry := nil;
- NewFileEntry := AllocMem(SizeOf(TSetupFileEntry));
- try
- with NewFileEntry^ do begin
- MinVersion := SetupHeader.MinVersion;
- PermissionsEntry := -1;
- ADestName := '';
- ADestDir := '';
- AInstallFontName := '';
- AStrongAssemblyName := '';
- ReadmeFile := False;
- ExternalFile := False;
- RecurseSubdirs := False;
- AllowUnsafeFiles := False;
- Touch := False;
- NoTimeStamp := False;
- SortFilesByExtension := False;
- NoCompression := False;
- NoEncryption := False;
- SolidBreak := False;
- ExternalSize := 0;
- SortFilesByName := False;
- Sign := fsNoSetting;
- case Ext of
- 0: begin
- { Flags }
- while True do
- case ExtractFlag(Values[paFlags].Data, Flags) of
- -2: Break;
- -1: AbortCompileParamError(SCompilerParamUnknownFlag2, ParamCommonFlags);
- 0: Include(Options, foConfirmOverwrite);
- 1: Include(Options, foUninsNeverUninstall);
- 2: ReadmeFile := True;
- 3: Include(Options, foRegisterServer);
- 4: Include(Options, foSharedFile);
- 5: Include(Options, foRestartReplace);
- 6: Include(Options, foDeleteAfterInstall);
- 7: Include(Options, foCompareTimeStamp);
- 8: Include(Options, foFontIsntTrueType);
- 9: Include(Options, foRegisterTypeLib);
- 10: ExternalFile := True;
- 11: Include(Options, foSkipIfSourceDoesntExist);
- 12: Include(Options, foOverwriteReadOnly);
- 13: Include(Options, foOnlyIfDestFileExists);
- 14: RecurseSubdirs := True;
- 15: Include(Options, foNoRegError);
- 16: AllowUnsafeFiles := True;
- 17: Include(Options, foUninsRestartDelete);
- 18: Include(Options, foOnlyIfDoesntExist);
- 19: Include(Options, foIgnoreVersion);
- 20: Include(Options, foPromptIfOlder);
- 21: Include(Options, foDontCopy);
- 22: Include(Options, foUninsRemoveReadOnly);
- 23: SortFilesByExtension := True;
- 24: Touch := True;
- 25: Include(Options, foReplaceSameVersionIfContentsDiffer);
- 26: NoEncryption := True;
- 27: NoCompression := True;
- 28: Include(Options, foDontVerifyChecksum);
- 29: Include(Options, foUninsNoSharedFilePrompt);
- 30: Include(Options, foCreateAllSubDirs);
- 31: Include(Options, fo32Bit);
- 32: Include(Options, fo64Bit);
- 33: SolidBreak := True;
- 34: Include(Options, foSetNTFSCompression);
- 35: Include(Options, foUnsetNTFSCompression);
- 36: SortFilesByName := True;
- 37: Include(Options, foGacInstall);
- 38: ApplyNewSign(Sign, fsYes, SCompilerParamErrorBadCombo2);
- 39: ApplyNewSign(Sign, fsOnce, SCompilerParamErrorBadCombo2);
- 40: ApplyNewSign(Sign, fsCheck, SCompilerParamErrorBadCombo2);
- 41: ApplyNewVerificationType(Verification.Typ, fvISSig, SCompilerFilesParamFlagConflict);
- 42: Include(Options, foDownload);
- 43: Include(Options, foExtractArchive);
- 44: NoTimeStamp := True;
- end;
- { Source }
- SourceWildcard := Values[paSource].Data;
- { DestDir }
- if Values[paDestDir].Found then
- ADestDir := Values[paDestDir].Data
- else begin
- if foDontCopy in Options then
- { DestDir is optional when the 'dontcopy' flag is used }
- ADestDir := '{tmp}'
- else
- AbortCompileParamError(SCompilerParamNotSpecified, ParamFilesDestDir);
- end;
- { DestName }
- if ConstPos('\', Values[paDestName].Data) <> 0 then
- AbortCompileParamError(SCompilerParamNoBackslash, ParamFilesDestName);
- ADestName := Values[paDestName].Data;
- { CopyMode }
- if Values[paCopyMode].Found then begin
- Values[paCopyMode].Data := Trim(Values[paCopyMode].Data);
- if CompareText(Values[paCopyMode].Data, 'normal') = 0 then begin
- Include(Options, foPromptIfOlder);
- WarningsList.Add(Format(SCompilerFilesWarningCopyMode,
- ['normal', 'promptifolder', 'promptifolder']));
- end
- else if CompareText(Values[paCopyMode].Data, 'onlyifdoesntexist') = 0 then begin
- Include(Options, foOnlyIfDoesntExist);
- WarningsList.Add(Format(SCompilerFilesWarningCopyMode,
- ['onlyifdoesntexist', 'onlyifdoesntexist',
- 'onlyifdoesntexist']));
- end
- else if CompareText(Values[paCopyMode].Data, 'alwaysoverwrite') = 0 then begin
- Include(Options, foIgnoreVersion);
- WarningsList.Add(Format(SCompilerFilesWarningCopyMode,
- ['alwaysoverwrite', 'ignoreversion', 'ignoreversion']));
- end
- else if CompareText(Values[paCopyMode].Data, 'alwaysskipifsameorolder') = 0 then begin
- WarningsList.Add(SCompilerFilesWarningASISOO);
- end
- else if CompareText(Values[paCopyMode].Data, 'dontcopy') = 0 then begin
- Include(Options, foDontCopy);
- WarningsList.Add(Format(SCompilerFilesWarningCopyMode,
- ['dontcopy', 'dontcopy', 'dontcopy']));
- end
- else
- AbortCompileParamError(SCompilerParamInvalid2, ParamFilesCopyMode);
- end;
- { Attribs }
- while True do
- case ExtractFlag(Values[paAttribs].Data, AttribsFlags) of
- -2: Break;
- -1: AbortCompileParamError(SCompilerParamUnknownFlag2, ParamFilesAttribs);
- 0: Attribs := Attribs or FILE_ATTRIBUTE_READONLY;
- 1: Attribs := Attribs or FILE_ATTRIBUTE_HIDDEN;
- 2: Attribs := Attribs or FILE_ATTRIBUTE_SYSTEM;
- 3: Attribs := Attribs or FILE_ATTRIBUTE_NOT_CONTENT_INDEXED;
- end;
- { Permissions }
- ProcessPermissionsParameter(Values[paPermissions].Data, AccessMasks,
- PermissionsEntry);
- { FontInstall }
- AInstallFontName := Values[paFontInstall].Data;
- { StrongAssemblyName }
- AStrongAssemblyName := Values[paStrongAssemblyName].Data;
- { Excludes }
- ProcessWildcardsParameter(Values[paExcludes].Data, AExcludes, SCompilerFilesExcludeTooLong); { for an external file the Excludes field is set below }
- { ExternalSize }
- if Values[paExternalSize].Found then begin
- if not ExternalFile then
- AbortCompileFmt(SCompilerFilesParamRequiresFlag, ['ExternalSize', 'external']);
- if not StrToInteger64(Values[paExternalSize].Data, ExternalSize) then
- AbortCompileParamError(SCompilerParamInvalid2, ParamFilesExternalSize);
- Include(Options, foExternalSizePreset);
- end;
- { DownloadISSigSource }
- DownloadISSigSource := Values[paDownloadISSigSource].Data;
- { DownloadUserName }
- DownloadUserName := Values[paDownloadUserName].Data;
- { DownloadPassword }
- DownloadPassword := Values[paDownloadPassword].Data;
- { ExtractArchivePassword }
- ExtractArchivePassword := Values[paExtractArchivePassword].Data;
- { Hash }
- if Values[paHash].Found then begin
- ApplyNewVerificationType(Verification.Typ, fvHash, SCompilerFilesParamFlagConflict);
- Verification.Hash := SHA256DigestFromString(Values[paHash].Data);
- end;
- { ISSigAllowedKeys }
- var S := Values[paISSigAllowedKeys].Data;
- while True do begin
- const KeyNameOrGroupName = ExtractStr(S, ' ');
- if KeyNameOrGroupName = '' then
- Break;
- var FoundKey := False;
- for var KeyIndex := 0 to ISSigKeyEntryExtraInfos.Count-1 do begin
- var ISSigKeyEntryExtraInfo := PISSigKeyEntryExtraInfo(ISSigKeyEntryExtraInfos[KeyIndex]);
- if SameText(ISSigKeyEntryExtraInfo.Name, KeyNameOrGroupName) or
- ISSigKeyEntryExtraInfo.HasGroupName(KeyNameOrGroupName) then begin
- SetISSigAllowedKey(Verification.ISSigAllowedKeys, KeyIndex);
- FoundKey := True;
- end;
- end;
- if not FoundKey then
- AbortCompileFmt(SCompilerFilesUnknownISSigKeyNameOrGroupName, [ParamFilesISSigAllowedKeys]);
- end;
- { Common parameters }
- ProcessExpressionParameter(ParamCommonComponents, Values[paComponents].Data, EvalComponentIdentifier, True, Components);
- ProcessExpressionParameter(ParamCommonTasks, Values[paTasks].Data, EvalTaskIdentifier, True, Tasks);
- ProcessExpressionParameter(ParamCommonLanguages, Values[paLanguages].Data, EvalLanguageIdentifier, False, Languages);
- Check := Values[paCheck].Data;
- BeforeInstall := Values[paBeforeInstall].Data;
- AfterInstall := Values[paAfterInstall].Data;
- ProcessMinVersionParameter(Values[paMinVersion], MinVersion);
- ProcessOnlyBelowVersionParameter(Values[paOnlyBelowVersion], OnlyBelowVersion);
- end;
- 1: begin
- SourceWildcard := '';
- FileType := ftUninstExe;
- { Ordinary hash comparison on unins*.exe won't really work since
- Setup modifies the file after extracting it. Force same
- version to always be overwritten by including the special
- foOverwriteSameVersion option. }
- Options := [foOverwriteSameVersion];
- ExternalFile := True;
- end;
- end;
- if (ADestDir = '{tmp}') or (Copy(ADestDir, 1, 4) = '{tmp}\') then
- Include(Options, foDeleteAfterInstall);
- if foDeleteAfterInstall in Options then begin
- if foRestartReplace in Options then
- AbortCompileFmt(SCompilerFilesTmpBadFlag, ['restartreplace']);
- if foUninsNeverUninstall in Options then
- AbortCompileFmt(SCompilerFilesTmpBadFlag, ['uninsneveruninstall']);
- if foRegisterServer in Options then
- AbortCompileFmt(SCompilerFilesTmpBadFlag, ['regserver']);
- if foRegisterTypeLib in Options then
- AbortCompileFmt(SCompilerFilesTmpBadFlag, ['regtypelib']);
- if foSharedFile in Options then
- AbortCompileFmt(SCompilerFilesTmpBadFlag, ['sharedfile']);
- if foGacInstall in Options then
- AbortCompileFmt(SCompilerFilesTmpBadFlag, ['gacinstall']);
- Include(Options, foUninsNeverUninstall);
- end;
- if (fo32Bit in Options) and (fo64Bit in Options) then
- AbortCompileFmt(SCompilerParamErrorBadCombo2,
- [ParamCommonFlags, '32bit', '64bit']);
- if AInstallFontName <> '' then begin
- if not(foFontIsntTrueType in Options) then
- AInstallFontName := AInstallFontName + ' (TrueType)';
- InstallFontName := AInstallFontName;
- end;
- if (foGacInstall in Options) and (AStrongAssemblyName = '') then
- AbortCompileFmt(SCompilerParamFlagMissingParam, ['StrongAssemblyName', 'gacinstall']);
- if AStrongAssemblyName <> '' then
- StrongAssemblyName := AStrongAssemblyName;
- if not NoCompression and (foDontVerifyChecksum in Options) then
- AbortCompileFmt(SCompilerParamFlagMissing, ['nocompression', 'dontverifychecksum']);
- if ExternalFile then begin
- if Sign <> fsNoSetting then
- AbortCompileFmt(SCompilerParamErrorBadCombo2,
- [ParamCommonFlags, 'external', SignFlags[Sign]]);
- Excludes := AExcludes.DelimitedText;
- end;
- if NoTimeStamp then begin
- if Touch then
- AbortCompileFmt(SCompilerParamErrorBadCombo2, [ParamCommonFlags, 'notimestamp', 'touch']);
- if foCompareTimeStamp in Options then
- AbortCompileFmt(SCompilerParamErrorBadCombo2, [ParamCommonFlags, 'notimestamp', 'comparetimestamp']);
- end;
- if foDownload in Options then begin
- if not ExternalFile then
- AbortCompileFmt(SCompilerParamFlagMissing, ['external', 'download']);
- if not(foIgnoreVersion in Options) then
- AbortCompileFmt(SCompilerParamFlagMissing, ['ignoreversion', 'download']);
- if foCompareTimeStamp in Options then
- AbortCompileFmt(SCompilerParamErrorBadCombo2, [ParamCommonFlags, 'download', 'comparetimestamp']);
- if foSkipIfSourceDoesntExist in Options then
- AbortCompileFmt(SCompilerParamErrorBadCombo2, [ParamCommonFlags, 'download', 'skipifsourcedoesntexist']);
- if not(foExtractArchive in Options) and RecurseSubdirs then
- AbortCompileFmt(SCompilerParamErrorBadCombo2, [ParamCommonFlags, 'recursesubdirs', 'download']);
- if ADestName = '' then
- AbortCompileFmt(SCompilerParamFlagMissingParam, ['DestName', 'download']);
- if not(foExternalSizePreset in Options) then
- AbortCompileFmt(SCompilerParamFlagMissingParam, ['ExternalSize', 'download']);
- end;
- if foExtractArchive in Options then begin
- if not ExternalFile then
- AbortCompileFmt(SCompilerParamFlagMissing, ['external', 'extractarchive']);
- if not(foIgnoreVersion in Options) then
- AbortCompileFmt(SCompilerParamFlagMissing, ['ignoreversion', 'extractarchive']);
- if SetupHeader.SevenZipLibraryName = '' then
- AbortCompileFmt(SCompilerEntryValueUnsupported, ['Setup', 'ArchiveExtraction', 'basic', 'extractarchive']);
- end;
- if (foIgnoreVersion in Options) and (foReplaceSameVersionIfContentsDiffer in Options) then
- AbortCompileFmt(SCompilerParamErrorBadCombo2, ['Flags', 'ignoreversion', 'replacesameversion']);
- if (ISSigKeyEntries.Count = 0) and (Verification.Typ = fvISSig) then
- AbortCompile(SCompilerFilesISSigVerifyMissingISSigKeys);
- if (Verification.ISSigAllowedKeys <> '') and (Verification.Typ <> fvISSig) then
- AbortCompile(SCompilerFilesISSigAllowedKeysMissingISSigVerify);
- if Sign in [fsYes, fsOnce] then begin
- if Verification.Typ = fvHash then
- AbortCompileFmt(SCompilerFilesParamFlagConflict,
- [ParamCommonFlags, 'Hash', SignFlags[Sign]]);
- if Verification.Typ = fvISSig then
- AbortCompileFmt(SCompilerParamErrorBadCombo2,
- [ParamCommonFlags, SignFlags[Sign], 'issigverify']);
- if SignTools.Count = 0 then
- Sign := fsNoSetting
- end;
- if not RecurseSubdirs and (foCreateAllSubDirs in Options) then
- AbortCompileFmt(SCompilerParamFlagMissing, ['recursesubdirs', 'createallsubdirs']);
- if (foSetNTFSCompression in Options) and
- (foUnsetNTFSCompression in Options) then
- AbortCompileFmt(SCompilerParamErrorBadCombo2,
- [ParamCommonFlags, 'setntfscompression', 'unsetntfscompression']);
- if (foSharedFile in Options) and
- (Copy(ADestDir, 1, Length('{syswow64}')) = '{syswow64}') then
- WarningsList.Add(SCompilerFilesWarningSharedFileSysWow64);
- SourceIsWildcard := not(foDownload in Options) and IsWildcard(SourceWildcard);
- if ExternalFile then begin
- if RecurseSubdirs then
- Include(Options, foRecurseSubDirsExternal);
- CheckConst(SourceWildcard, MinVersion, []);
- end;
- if (ADestName <> '') and (SourceIsWildcard or (not (foDownload in Options) and (foExtractArchive in Options))) then
- AbortCompile(SCompilerFilesDestNameCantBeSpecified);
- CheckConst(ADestDir, MinVersion, []);
- ADestDir := AddBackslash(ADestDir);
- CheckConst(ADestName, MinVersion, []);
- if not ExternalFile then
- SourceWildcard := PrependSourceDirName(SourceWildcard);
- CheckCheckOrInstall(ParamCommonCheck, Check, cikCheck);
- CheckCheckOrInstall(ParamCommonBeforeInstall, BeforeInstall, cikInstall);
- CheckCheckOrInstall(ParamCommonAfterInstall, AfterInstall, cikInstall);
- CheckConst(DownloadISSigSource, MinVersion, []);
- CheckConst(DownloadUserName, MinVersion, []);
- CheckConst(DownloadPassword, MinVersion, []);
- CheckConst(ExtractArchivePassword, MinVersion, []);
- end;
- FileList := TList.Create();
- DirList := TList.Create();
- try
- if not ExternalFile then begin
- BuildFileList(PathExtractPath(SourceWildcard), '', PathExtractName(SourceWildcard), FileList, DirList, foCreateAllSubDirs in NewFileEntry.Options);
- if FileList.Count > 1 then
- SortFileList(FileList, 0, FileList.Count-1, SortFilesByExtension, SortFilesByName);
- end else
- AddToFileList(FileList, SourceWildcard, 0);
- if FileList.Count > 0 then begin
- if not ExternalFile then
- ProcessFileList(PathExtractPath(SourceWildcard), FileList)
- else
- ProcessFileList('', FileList);
- end;
- if DirList.Count > 0 then begin
- { Dirs found that need to be created. Can only happen if not external. }
- ProcessDirList(DirList);
- end;
- if (FileList.Count = 0) and (DirList.Count = 0) then begin
- { Nothing found. Can only happen if not external. }
- if not(foSkipIfSourceDoesntExist in NewFileEntry^.Options) then begin
- if SourceIsWildcard then
- AbortCompileFmt(SCompilerFilesWildcardNotMatched, [SourceWildcard])
- else
- AbortCompileFmt(SCompilerSourceFileDoesntExist, [SourceWildcard]);
- end;
- end;
- finally
- for I := DirList.Count-1 downto 0 do
- Dispose(PDirListRec(DirList[I]));
- DirList.Free();
- for I := FileList.Count-1 downto 0 do
- Dispose(PFileListRec(FileList[I]));
- FileList.Free();
- end;
- finally
- { If NewFileEntry is still assigned at this point, either an exception
- occurred or no files were matched }
- SEFreeRec(NewFileEntry, SetupFileEntryStrings, SetupFileEntryAnsiStrings);
- end;
- finally
- AExcludes.Free();
- end;
- end;
- procedure TSetupCompiler.EnumRunProc(const Line: PChar; const Ext: Integer);
- type
- TParam = (paFlags, paFilename, paParameters, paWorkingDir, paRunOnceId,
- paDescription, paStatusMsg, paVerb, paComponents, paTasks, paLanguages,
- paCheck, paBeforeInstall, paAfterInstall, paMinVersion, paOnlyBelowVersion);
- const
- ParamRunFilename = 'Filename';
- ParamRunParameters = 'Parameters';
- ParamRunWorkingDir = 'WorkingDir';
- ParamRunRunOnceId = 'RunOnceId';
- ParamRunDescription = 'Description';
- ParamRunStatusMsg = 'StatusMsg';
- ParamRunVerb = 'Verb';
- ParamInfo: array[TParam] of TParamInfo = (
- (Name: ParamCommonFlags; Flags: []),
- (Name: ParamRunFilename; Flags: [piRequired, piNoEmpty, piNoQuotes]),
- (Name: ParamRunParameters; Flags: []),
- (Name: ParamRunWorkingDir; Flags: []),
- (Name: ParamRunRunOnceId; Flags: []),
- (Name: ParamRunDescription; Flags: []),
- (Name: ParamRunStatusMsg; Flags: []),
- (Name: ParamRunVerb; Flags: []),
- (Name: ParamCommonComponents; Flags: []),
- (Name: ParamCommonTasks; Flags: []),
- (Name: ParamCommonLanguages; Flags: []),
- (Name: ParamCommonCheck; Flags: []),
- (Name: ParamCommonBeforeInstall; Flags: []),
- (Name: ParamCommonAfterInstall; Flags: []),
- (Name: ParamCommonMinVersion; Flags: []),
- (Name: ParamCommonOnlyBelowVersion; Flags: []));
- Flags: array[0..19] of PChar = (
- 'nowait', 'waituntilidle', 'shellexec', 'skipifdoesntexist',
- 'runminimized', 'runmaximized', 'showcheckbox', 'postinstall',
- 'unchecked', 'skipifsilent', 'skipifnotsilent', 'hidewizard',
- 'runhidden', 'waituntilterminated', '32bit', '64bit', 'runasoriginaluser',
- 'runascurrentuser', 'dontlogparameters', 'logoutput');
- var
- Values: array[TParam] of TParamValue;
- NewRunEntry: PSetupRunEntry;
- WaitFlagSpecified, RunAsOriginalUser, RunAsCurrentUser: Boolean;
- begin
- ExtractParameters(Line, ParamInfo, Values);
- NewRunEntry := AllocMem(SizeOf(TSetupRunEntry));
- try
- with NewRunEntry^ do begin
- MinVersion := SetupHeader.MinVersion;
- ShowCmd := SW_SHOWNORMAL;
- WaitFlagSpecified := False;
- RunAsOriginalUser := False;
- RunAsCurrentUser := False;
- { Flags }
- while True do
- case ExtractFlag(Values[paFlags].Data, Flags) of
- -2: Break;
- -1: AbortCompileParamError(SCompilerParamUnknownFlag2, ParamCommonFlags);
- 0: begin
- if WaitFlagSpecified then
- AbortCompile(SCompilerRunMultipleWaitFlags);
- Wait := rwNoWait;
- WaitFlagSpecified := True;
- end;
- 1: begin
- if WaitFlagSpecified then
- AbortCompile(SCompilerRunMultipleWaitFlags);
- Wait := rwWaitUntilIdle;
- WaitFlagSpecified := True;
- end;
- 2: Include(Options, roShellExec);
- 3: Include(Options, roSkipIfDoesntExist);
- 4: ShowCmd := SW_SHOWMINNOACTIVE;
- 5: ShowCmd := SW_SHOWMAXIMIZED;
- 6: begin
- if (Ext = 1) then
- AbortCompileParamError(SCompilerParamUnsupportedFlag, ParamCommonFlags);
- WarningsList.Add(Format(SCompilerRunFlagObsolete, ['showcheckbox', 'postinstall']));
- Include(Options, roPostInstall);
- end;
- 7: begin
- if (Ext = 1) then
- AbortCompileParamError(SCompilerParamUnsupportedFlag, ParamCommonFlags);
- Include(Options, roPostInstall);
- end;
- 8: begin
- if (Ext = 1) then
- AbortCompileParamError(SCompilerParamUnsupportedFlag, ParamCommonFlags);
- Include(Options, roUnchecked);
- end;
- 9: begin
- if (Ext = 1) then
- AbortCompileParamError(SCompilerParamUnsupportedFlag, ParamCommonFlags);
- Include(Options, roSkipIfSilent);
- end;
- 10: begin
- if (Ext = 1) then
- AbortCompileParamError(SCompilerParamUnsupportedFlag, ParamCommonFlags);
- Include(Options, roSkipIfNotSilent);
- end;
- 11: Include(Options, roHideWizard);
- 12: ShowCmd := SW_HIDE;
- 13: begin
- if WaitFlagSpecified then
- AbortCompile(SCompilerRunMultipleWaitFlags);
- Wait := rwWaitUntilTerminated;
- WaitFlagSpecified := True;
- end;
- 14: Include(Options, roRun32Bit);
- 15: Include(Options, roRun64Bit);
- 16: begin
- if (Ext = 1) then
- AbortCompileParamError(SCompilerParamUnsupportedFlag, ParamCommonFlags);
- RunAsOriginalUser := True;
- end;
- 17: RunAsCurrentUser := True;
- 18: Include(Options, roDontLogParameters);
- 19: Include(Options, roLogOutput);
- end;
- if not WaitFlagSpecified then begin
- if roShellExec in Options then
- Wait := rwNoWait
- else
- Wait := rwWaitUntilTerminated;
- end;
- if RunAsOriginalUser and RunAsCurrentUser then
- AbortCompileFmt(SCompilerParamErrorBadCombo2,
- [ParamCommonFlags, 'runasoriginaluser', 'runascurrentuser']);
- if RunAsOriginalUser or
- (not RunAsCurrentUser and (roPostInstall in Options)) then
- Include(Options, roRunAsOriginalUser);
- if roLogOutput in Options then begin
- if roShellExec in Options then
- AbortCompileFmt(SCompilerParamErrorBadCombo2,
- [ParamCommonFlags, 'logoutput', 'shellexec']);
- if (Wait <> rwWaitUntilTerminated) then
- AbortCompileFmt(SCompilerParamFlagMissing,
- ['waituntilterminated', 'logoutput']);
- if RunAsOriginalUser then
- AbortCompileFmt(SCompilerParamErrorBadCombo2,
- [ParamCommonFlags, 'logoutput', 'runasoriginaluser']);
- if roRunAsOriginalUser in Options then
- AbortCompileFmt(SCompilerParamFlagMissing3,
- ['runascurrentuser', 'logoutput', 'postinstall']);
- end;
- { Filename }
- Name := Values[paFilename].Data;
- { Parameters }
- Parameters := Values[paParameters].Data;
- { WorkingDir }
- WorkingDir := Values[paWorkingDir].Data;
- { RunOnceId }
- if Values[paRunOnceId].Data <> '' then begin
- if Ext = 0 then
- AbortCompile(SCompilerRunCantUseRunOnceId);
- end else if Ext = 1 then
- MissingRunOnceIds := True;
- RunOnceId := Values[paRunOnceId].Data;
- { Description }
- if (Ext = 1) and (Values[paDescription].Data <> '') then
- AbortCompile(SCompilerUninstallRunCantUseDescription);
- Description := Values[paDescription].Data;
- { StatusMsg }
- StatusMsg := Values[paStatusMsg].Data;
- { Verb }
- if not (roShellExec in Options) and Values[paVerb].Found then
- AbortCompileFmt(SCompilerParamFlagMissing2,
- ['shellexec', 'Verb']);
- Verb := Values[paVerb].Data;
- { Common parameters }
- ProcessExpressionParameter(ParamCommonComponents, Values[paComponents].Data, EvalComponentIdentifier, True, Components);
- ProcessExpressionParameter(ParamCommonTasks, Values[paTasks].Data, EvalTaskIdentifier, True, Tasks);
- ProcessExpressionParameter(ParamCommonLanguages, Values[paLanguages].Data, EvalLanguageIdentifier, False, Languages);
- Check := Values[paCheck].Data;
- BeforeInstall := Values[paBeforeInstall].Data;
- AfterInstall := Values[paAfterInstall].Data;
- ProcessMinVersionParameter(Values[paMinVersion], MinVersion);
- ProcessOnlyBelowVersionParameter(Values[paOnlyBelowVersion], OnlyBelowVersion);
- if (roRun32Bit in Options) and (roRun64Bit in Options) then
- AbortCompileFmt(SCompilerParamErrorBadCombo2,
- [ParamCommonFlags, '32bit', '64bit']);
- if (roRun32Bit in Options) and (roShellExec in Options) then
- AbortCompileFmt(SCompilerParamErrorBadCombo2,
- [ParamCommonFlags, '32bit', 'shellexec']);
- if (roRun64Bit in Options) and (roShellExec in Options) then
- AbortCompileFmt(SCompilerParamErrorBadCombo2,
- [ParamCommonFlags, '64bit', 'shellexec']);
- CheckCheckOrInstall(ParamCommonCheck, Check, cikCheck);
- CheckCheckOrInstall(ParamCommonBeforeInstall, BeforeInstall, cikInstall);
- CheckCheckOrInstall(ParamCommonAfterInstall, AfterInstall, cikInstall);
- CheckConst(Name, MinVersion, []);
- CheckConst(Parameters, MinVersion, []);
- CheckConst(WorkingDir, MinVersion, []);
- CheckConst(RunOnceId, MinVersion, []);
- CheckConst(Description, MinVersion, []);
- CheckConst(StatusMsg, MinVersion, []);
- CheckConst(Verb, MinVersion, []);
- end;
- except
- SEFreeRec(NewRunEntry, SetupRunEntryStrings, SetupRunEntryAnsiStrings);
- raise;
- end;
- if Ext = 0 then begin
- WriteDebugEntry(deRun, RunEntries.Count);
- RunEntries.Add(NewRunEntry)
- end
- else begin
- WriteDebugEntry(deUninstallRun, UninstallRunEntries.Count);
- UninstallRunEntries.Add(NewRunEntry);
- end;
- end;
- type
- TLanguagesParam = (paName, paMessagesFile, paLicenseFile, paInfoBeforeFile, paInfoAfterFile);
- const
- ParamLanguagesName = 'Name';
- ParamLanguagesMessagesFile = 'MessagesFile';
- ParamLanguagesLicenseFile = 'LicenseFile';
- ParamLanguagesInfoBeforeFile = 'InfoBeforeFile';
- ParamLanguagesInfoAfterFile = 'InfoAfterFile';
- LanguagesParamInfo: array[TLanguagesParam] of TParamInfo = (
- (Name: ParamLanguagesName; Flags: [piRequired, piNoEmpty]),
- (Name: ParamLanguagesMessagesFile; Flags: [piRequired, piNoEmpty]),
- (Name: ParamLanguagesLicenseFile; Flags: [piNoEmpty]),
- (Name: ParamLanguagesInfoBeforeFile; Flags: [piNoEmpty]),
- (Name: ParamLanguagesInfoAfterFile; Flags: [piNoEmpty]));
- procedure TSetupCompiler.EnumLanguagesPreProc(const Line: PChar; const Ext: Integer);
- var
- Values: array[TLanguagesParam] of TParamValue;
- NewPreLangData: TPreLangData;
- Filename: String;
- begin
- ExtractParameters(Line, LanguagesParamInfo, Values);
- PreLangDataList.Expand;
- NewPreLangData := nil;
- try
- NewPreLangData := TPreLangData.Create;
- Filename := '';
- InitPreLangData(NewPreLangData);
- { Name }
- if not IsValidIdentString(Values[paName].Data, False, False) then
- AbortCompileFmt(SCompilerLanguagesOrISSigKeysBadName, [ParamLanguagesName]);
- NewPreLangData.Name := Values[paName].Data;
- { MessagesFile }
- Filename := Values[paMessagesFile].Data;
- except
- NewPreLangData.Free;
- raise;
- end;
- PreLangDataList.Add(NewPreLangData);
- ReadMessagesFromFilesPre(Filename, PreLangDataList.Count-1);
- end;
- procedure TSetupCompiler.EnumLanguagesProc(const Line: PChar; const Ext: Integer);
- var
- Values: array[TLanguagesParam] of TParamValue;
- NewLanguageEntry: PSetupLanguageEntry;
- NewLangData: TLangData;
- Filename: String;
- begin
- ExtractParameters(Line, LanguagesParamInfo, Values);
- LanguageEntries.Expand;
- LangDataList.Expand;
- NewLangData := nil;
- NewLanguageEntry := AllocMem(SizeOf(TSetupLanguageEntry));
- try
- NewLangData := TLangData.Create;
- Filename := '';
- InitLanguageEntry(NewLanguageEntry^);
- { Name }
- if not IsValidIdentString(Values[paName].Data, False, False) then
- AbortCompileFmt(SCompilerLanguagesOrISSigKeysBadName, [ParamLanguagesName]);
- NewLanguageEntry.Name := Values[paName].Data;
- { MessagesFile }
- Filename := Values[paMessagesFile].Data;
- { LicenseFile }
- if (Values[paLicenseFile].Data <> '') then begin
- AddStatus(Format(SCompilerStatusReadingInFile, [Values[paLicenseFile].Data]));
- ReadTextFile(PrependSourceDirName(Values[paLicenseFile].Data), LanguageEntries.Count,
- NewLanguageEntry.LicenseText);
- end;
- { InfoBeforeFile }
- if (Values[paInfoBeforeFile].Data <> '') then begin
- AddStatus(Format(SCompilerStatusReadingInFile, [Values[paInfoBeforeFile].Data]));
- ReadTextFile(PrependSourceDirName(Values[paInfoBeforeFile].Data), LanguageEntries.Count,
- NewLanguageEntry.InfoBeforeText);
- end;
- { InfoAfterFile }
- if (Values[paInfoAfterFile].Data <> '') then begin
- AddStatus(Format(SCompilerStatusReadingInFile, [Values[paInfoAfterFile].Data]));
- ReadTextFile(PrependSourceDirName(Values[paInfoAfterFile].Data), LanguageEntries.Count,
- NewLanguageEntry.InfoAfterText);
- end;
- except
- NewLangData.Free;
- SEFreeRec(NewLanguageEntry, SetupLanguageEntryStrings, SetupLanguageEntryAnsiStrings);
- raise;
- end;
- LanguageEntries.Add(NewLanguageEntry);
- LangDataList.Add(NewLangData);
- ReadMessagesFromFiles(Filename, LanguageEntries.Count-1);
- end;
- procedure TSetupCompiler.EnumMessagesProc(const Line: PChar; const Ext: Integer);
- var
- P, P2: PChar;
- I, ID, LangIndex: Integer;
- N, M: String;
- begin
- P := StrScan(Line, '=');
- if P = nil then
- AbortCompile(SCompilerMessagesMissingEquals);
- SetString(N, Line, P - Line);
- N := Trim(N);
- LangIndex := ExtractLangIndex(Self, N, Ext, False);
- ID := GetEnumValue(TypeInfo(TSetupMessageID), 'msg' + N);
- if ID = -1 then begin
- if LangIndex = -2 then
- AbortCompileFmt(SCompilerMessagesNotRecognizedDefault, [N])
- else begin
- if NotRecognizedMessagesWarning then begin
- if LineFilename = '' then
- WarningsList.Add(Format(SCompilerMessagesNotRecognizedWarning, [N]))
- else
- WarningsList.Add(Format(SCompilerMessagesNotRecognizedInFileWarning,
- [N, LineFilename]));
- end;
- Exit;
- end;
- end;
- Inc(P);
- M := P;
- { Replace %n with actual CR/LF characters }
- P2 := PChar(M);
- while True do begin
- P2 := StrPos(P2, '%n');
- if P2 = nil then Break;
- P2[0] := #13;
- P2[1] := #10;
- Inc(P2, 2);
- end;
- if LangIndex = -2 then begin
- { Special -2 value means store in DefaultLangData }
- DefaultLangData.Messages[TSetupMessageID(ID)] := M;
- DefaultLangData.MessagesDefined[TSetupMessageID(ID)] := True;
- end
- else begin
- for I := 0 to LangDataList.Count-1 do begin
- if (LangIndex <> -1) and (I <> LangIndex) then
- Continue;
- TLangData(LangDataList[I]).Messages[TSetupMessageID(ID)] := M;
- TLangData(LangDataList[I]).MessagesDefined[TSetupMessageID(ID)] := True;
- end;
- end;
- end;
- procedure TSetupCompiler.EnumCustomMessagesProc(const Line: PChar; const Ext: Integer);
- function ExpandNewlines(const S: String): String;
- { Replaces '%n' with #13#10 }
- var
- L, I: Integer;
- begin
- Result := S;
- L := Length(Result);
- I := 1;
- while I < L do begin
- if Result[I] = '%' then begin
- if Result[I+1] = 'n' then begin
- Result[I] := #13;
- Result[I+1] := #10;
- end;
- Inc(I);
- end;
- Inc(I);
- end;
- end;
- var
- P: PChar;
- LangIndex: Integer;
- N: String;
- I: Integer;
- ExistingCustomMessageEntry, NewCustomMessageEntry: PSetupCustomMessageEntry;
- begin
- P := StrScan(Line, '=');
- if P = nil then
- AbortCompile(SCompilerMessagesMissingEquals);
- SetString(N, Line, P - Line);
- N := Trim(N);
- LangIndex := ExtractLangIndex(Self, N, Ext, False);
- Inc(P);
- CustomMessageEntries.Expand;
- NewCustomMessageEntry := AllocMem(SizeOf(TSetupCustomMessageEntry));
- try
- if not IsValidIdentString(N, False, True) then
- AbortCompile(SCompilerCustomMessageBadName);
- { Delete existing entries}
- for I := CustomMessageEntries.Count-1 downto 0 do begin
- ExistingCustomMessageEntry := CustomMessageEntries[I];
- if (CompareText(ExistingCustomMessageEntry.Name, N) = 0) and
- ((LangIndex = -1) or (ExistingCustomMessageEntry.LangIndex = LangIndex)) then begin
- SEFreeRec(ExistingCustomMessageEntry, SetupCustomMessageEntryStrings,
- SetupCustomMessageEntryAnsiStrings);
- CustomMessageEntries.Delete(I);
- end;
- end;
- { Setup the new one }
- NewCustomMessageEntry.Name := N;
- NewCustomMessageEntry.Value := ExpandNewlines(P);
- NewCustomMessageEntry.LangIndex := LangIndex;
- except
- SEFreeRec(NewCustomMessageEntry, SetupCustomMessageEntryStrings, SetupCustomMessageEntryAnsiStrings);
- raise;
- end;
- CustomMessageEntries.Add(NewCustomMessageEntry);
- end;
- procedure TSetupCompiler.CheckCustomMessageDefinitions;
- { Checks 'language completeness' of custom message constants }
- var
- MissingLang, Found: Boolean;
- I, J, K: Integer;
- CustomMessage1, CustomMessage2: PSetupCustomMessageEntry;
- begin
- for I := 0 to CustomMessageEntries.Count-1 do begin
- CustomMessage1 := PSetupCustomMessageEntry(CustomMessageEntries[I]);
- if CustomMessage1.LangIndex <> -1 then begin
- MissingLang := False;
- for J := 0 to LanguageEntries.Count-1 do begin
- { Check whether the outer custom message name exists for this language }
- Found := False;
- for K := 0 to CustomMessageEntries.Count-1 do begin
- CustomMessage2 := PSetupCustomMessageEntry(CustomMessageEntries[K]);
- if CompareText(CustomMessage1.Name, CustomMessage2.Name) = 0 then begin
- if (CustomMessage2.LangIndex = -1) or (CustomMessage2.LangIndex = J) then begin
- Found := True;
- Break;
- end;
- end;
- end;
- if not Found then begin
- WarningsList.Add(Format(SCompilerCustomMessagesMissingLangWarning,
- [CustomMessage1.Name, PSetupLanguageEntry(LanguageEntries[J]).Name,
- PSetupLanguageEntry(LanguageEntries[CustomMessage1.LangIndex]).Name]));
- MissingLang := True;
- end;
- end;
- if MissingLang then begin
- { The custom message CustomMessage1.Name is not 'language complete'.
- Force it to be by setting CustomMessage1.LangIndex to -1. This will
- cause languages that do not define the custom message to use this
- one (i.e. the first definition of it). Note: Languages that do define
- the custom message in subsequent entries will override this entry,
- since Setup looks for the *last* matching entry. }
- CustomMessage1.LangIndex := -1;
- end;
- end;
- end;
- end;
- procedure TSetupCompiler.CheckCustomMessageReferences;
- { Checks existence of expected custom message constants }
- var
- LineInfo: TLineInfo;
- Found: Boolean;
- S: String;
- I, J: Integer;
- begin
- for I := 0 to ExpectedCustomMessageNames.Count-1 do begin
- Found := False;
- S := ExpectedCustomMessageNames[I];
- for J := 0 to CustomMessageEntries.Count-1 do begin
- if CompareText(PSetupCustomMessageEntry(CustomMessageEntries[J]).Name, S) = 0 then begin
- Found := True;
- Break;
- end;
- end;
- if not Found then begin
- LineInfo := TLineInfo(ExpectedCustomMessageNames.Objects[I]);
- LineFilename := LineInfo.Filename;
- LineNumber := LineInfo.FileLineNumber;
- AbortCompileFmt(SCompilerCustomMessagesMissingName, [S]);
- end;
- end;
- end;
- procedure TSetupCompiler.InitPreLangData(const APreLangData: TPreLangData);
- { Initializes a TPreLangData object with the default settings }
- begin
- with APreLangData do begin
- Name := 'default';
- LanguageCodePage := 0;
- end;
- end;
- procedure TSetupCompiler.InitLanguageEntry(var ALanguageEntry: TSetupLanguageEntry);
- { Initializes a TSetupLanguageEntry record with the default settings }
- begin
- with ALanguageEntry do begin
- Name := 'default';
- LanguageName := 'English';
- LanguageID := $0409; { U.S. English }
- DialogFontName := DefaultDialogFontName;
- DialogFontSize := 9;
- DialogFontBaseScaleWidth := 7;
- DialogFontBaseScaleHeight := 15;
- WelcomeFontName := 'Segoe UI';
- WelcomeFontSize := 14;
- LicenseText := '';
- InfoBeforeText := '';
- InfoAfterText := '';
- end;
- end;
- procedure TSetupCompiler.ReadMessagesFromFilesPre(const AFiles: String;
- const ALangIndex: Integer);
- var
- S, Filename: String;
- begin
- S := AFiles;
- while True do begin
- Filename := ExtractStr(S, ',');
- if Filename = '' then
- Break;
- Filename := PathExpand(PrependSourceDirName(Filename));
- AddStatus(Format(SCompilerStatusReadingInFile, [Filename]));
- EnumIniSection(EnumLangOptionsPreProc, 'LangOptions', ALangIndex, False, True, Filename, True, True);
- CallIdleProc;
- end;
- end;
- procedure TSetupCompiler.ReadMessagesFromFiles(const AFiles: String;
- const ALangIndex: Integer);
- var
- S, Filename: String;
- begin
- S := AFiles;
- while True do begin
- Filename := ExtractStr(S, ',');
- if Filename = '' then
- Break;
- Filename := PathExpand(PrependSourceDirName(Filename));
- AddStatus(Format(SCompilerStatusReadingInFile, [Filename]));
- EnumIniSection(EnumLangOptionsProc, 'LangOptions', ALangIndex, False, True, Filename, True, False);
- CallIdleProc;
- EnumIniSection(EnumMessagesProc, 'Messages', ALangIndex, False, True, Filename, True, False);
- CallIdleProc;
- EnumIniSection(EnumCustomMessagesProc, 'CustomMessages', ALangIndex, False, True, Filename, True, False);
- CallIdleProc;
- end;
- end;
- const
- DefaultIsl = {$IFDEF DEBUG} 'compiler:..\..\Files\Default.isl' {$ELSE} 'compiler:Default.isl' {$ENDIF};
- procedure TSetupCompiler.ReadDefaultMessages;
- var
- J: TSetupMessageID;
- begin
- { Read messages from Default.isl into DefaultLangData }
- EnumIniSection(EnumMessagesProc, 'Messages', -2, False, True, DefaultIsl, True, False);
- CallIdleProc;
- { Check for missing messages in Default.isl }
- for J := Low(DefaultLangData.Messages) to High(DefaultLangData.Messages) do
- if not DefaultLangData.MessagesDefined[J] then
- AbortCompileFmt(SCompilerMessagesMissingDefaultMessage,
- [Copy(GetEnumName(TypeInfo(TSetupMessageID), Ord(J)), 4, Maxint)]);
- { ^ Copy(..., 4, Maxint) is to skip past "msg" }
- end;
- procedure TSetupCompiler.ReadMessagesFromScriptPre;
- procedure CreateDefaultLanguageEntryPre;
- var
- NewPreLangData: TPreLangData;
- begin
- PreLangDataList.Expand;
- NewPreLangData := nil;
- try
- NewPreLangData := TPreLangData.Create;
- InitPreLangData(NewPreLangData);
- except
- NewPreLangData.Free;
- raise;
- end;
- PreLangDataList.Add(NewPreLangData);
- ReadMessagesFromFilesPre(DefaultIsl, PreLangDataList.Count-1);
- end;
- begin
- { If there were no [Languages] entries, take this opportunity to create a
- default language }
- if PreLangDataList.Count = 0 then begin
- CreateDefaultLanguageEntryPre;
- CallIdleProc;
- end;
- { Then read the [LangOptions] section in the script }
- AddStatus(SCompilerStatusReadingInScriptMsgs);
- EnumIniSection(EnumLangOptionsPreProc, 'LangOptions', -1, False, True, '', True, False);
- CallIdleProc;
- end;
- procedure TSetupCompiler.ReadMessagesFromScript;
- procedure CreateDefaultLanguageEntry;
- var
- NewLanguageEntry: PSetupLanguageEntry;
- NewLangData: TLangData;
- begin
- LanguageEntries.Expand;
- LangDataList.Expand;
- NewLangData := nil;
- NewLanguageEntry := AllocMem(SizeOf(TSetupLanguageEntry));
- try
- NewLangData := TLangData.Create;
- InitLanguageEntry(NewLanguageEntry^);
- except
- NewLangData.Free;
- SEFreeRec(NewLanguageEntry, SetupLanguageEntryStrings, SetupLanguageEntryAnsiStrings);
- raise;
- end;
- LanguageEntries.Add(NewLanguageEntry);
- LangDataList.Add(NewLangData);
- ReadMessagesFromFiles(DefaultIsl, LanguageEntries.Count-1);
- end;
- function IsOptional(const MessageID: TSetupMessageID): Boolean;
- begin
- Result := False; { Currently there are no optional messages }
- end;
- var
- I: Integer;
- LangData: TLangData;
- J: TSetupMessageID;
- begin
- { If there were no [Languages] entries, take this opportunity to create a
- default language }
- if LanguageEntries.Count = 0 then begin
- CreateDefaultLanguageEntry;
- CallIdleProc;
- end;
- { Then read the [LangOptions] & [Messages] & [CustomMessages] sections in the script }
- AddStatus(SCompilerStatusReadingInScriptMsgs);
- EnumIniSection(EnumLangOptionsProc, 'LangOptions', -1, False, True, '', True, False);
- CallIdleProc;
- EnumIniSection(EnumMessagesProc, 'Messages', -1, False, True, '', True, False);
- CallIdleProc;
- EnumIniSection(EnumCustomMessagesProc, 'CustomMessages', -1, False, True, '', True, False);
- CallIdleProc;
- { Check for missing messages }
- for I := 0 to LanguageEntries.Count-1 do begin
- LangData := LangDataList[I];
- for J := Low(LangData.Messages) to High(LangData.Messages) do
- if not LangData.MessagesDefined[J] and not IsOptional(J) then begin
- { Use the message from Default.isl }
- if MissingMessagesWarning and not (J in [msgHelpTextNote, msgTranslatorNote]) then
- WarningsList.Add(Format(SCompilerMessagesMissingMessageWarning,
- [Copy(GetEnumName(TypeInfo(TSetupMessageID), Ord(J)), 4, Maxint),
- PSetupLanguageEntry(LanguageEntries[I]).Name]));
- { ^ Copy(..., 4, Maxint) is to skip past "msg" }
- LangData.Messages[J] := DefaultLangData.Messages[J];
- end;
- end;
- CallIdleProc;
- end;
- procedure TSetupCompiler.PopulateLanguageEntryData;
- { Fills in each language entry's Data field, based on the messages in
- LangDataList }
- type
- PMessagesDataStructure = ^TMessagesDataStructure;
- TMessagesDataStructure = packed record
- ID: TMessagesHdrID;
- Header: TMessagesHeader;
- MsgData: array[0..0] of Byte;
- end;
- var
- L: Integer;
- LangData: TLangData;
- M: TMemoryStream;
- I: TSetupMessageID;
- Header: TMessagesHeader;
- begin
- for L := 0 to LanguageEntries.Count-1 do begin
- LangData := LangDataList[L];
- M := TMemoryStream.Create;
- try
- M.WriteBuffer(MessagesHdrID, SizeOf(MessagesHdrID));
- FillChar(Header, SizeOf(Header), 0);
- M.WriteBuffer(Header, SizeOf(Header)); { overwritten later }
- for I := Low(LangData.Messages) to High(LangData.Messages) do
- M.WriteBuffer(PChar(LangData.Messages[I])^, (Length(LangData.Messages[I]) + 1) * SizeOf(LangData.Messages[I][1]));
- Header.NumMessages := Ord(High(LangData.Messages)) - Ord(Low(LangData.Messages)) + 1;
- Header.TotalSize := M.Size;
- Header.NotTotalSize := not Header.TotalSize;
- Header.CRCMessages := GetCRC32(PMessagesDataStructure(M.Memory).MsgData,
- M.Size - (SizeOf(MessagesHdrID) + SizeOf(Header)));
- PMessagesDataStructure(M.Memory).Header := Header;
- SetString(PSetupLanguageEntry(LanguageEntries[L]).Data, PAnsiChar(M.Memory),
- M.Size);
- finally
- M.Free;
- end;
- end;
- end;
- procedure TSetupCompiler.EnumCodeProc(const Line: PChar; const Ext: Integer);
- var
- CodeTextLineInfo: TLineInfo;
- begin
- CodeTextLineInfo := TLineInfo.Create;
- CodeTextLineInfo.Filename := LineFilename;
- CodeTextLineInfo.FileLineNumber := LineNumber;
- CodeText.AddObject(Line, CodeTextLineInfo);
- end;
- procedure TSetupCompiler.ReadCode;
- begin
- { Read [Code] section }
- AddStatus(SCompilerStatusReadingCode);
- EnumIniSection(EnumCodeProc, 'Code', 0, False, False, '', False, False);
- CallIdleProc;
- end;
- procedure TSetupCompiler.CodeCompilerOnLineToLineInfo(const Line: LongInt; var Filename: String; var FileLine: LongInt);
- var
- CodeTextLineInfo: TLineInfo;
- begin
- if (Line > 0) and (Line <= CodeText.Count) then begin
- CodeTextLineInfo := TLineInfo(CodeText.Objects[Line-1]);
- Filename := CodeTextLineInfo.Filename;
- FileLine := CodeTextLineInfo.FileLineNumber;
- end;
- end;
- procedure TSetupCompiler.CodeCompilerOnUsedLine(const Filename: String; const Line, Position: LongInt; const IsProcExit: Boolean);
- var
- OldLineFilename: String;
- OldLineNumber: Integer;
- begin
- OldLineFilename := LineFilename;
- OldLineNumber := LineNumber;
- try
- LineFilename := Filename;
- LineNumber := Line;
- WriteDebugEntry(deCodeLine, Position, IsProcExit);
- finally
- LineFilename := OldLineFilename;
- LineNumber := OldLineNumber;
- end;
- end;
- procedure TSetupCompiler.CodeCompilerOnUsedVariable(const Filename: String; const Line, Col, Param1, Param2, Param3: LongInt; const Param4: AnsiString);
- var
- Rec: TVariableDebugEntry;
- begin
- if Length(Param4)+1 <= SizeOf(Rec.Param4) then begin
- Rec.FileIndex := FilenameToFileIndex(Filename);
- Rec.LineNumber := Line;
- Rec.Col := Col;
- Rec.Param1 := Param1;
- Rec.Param2 := Param2;
- Rec.Param3 := Param3;
- FillChar(Rec.Param4, SizeOf(Rec.Param4), 0);
- AnsiStrings.StrPCopy(Rec.Param4, Param4);
- CodeDebugInfo.WriteBuffer(Rec, SizeOf(Rec));
- Inc(VariableDebugEntryCount);
- end;
- end;
- procedure TSetupCompiler.CodeCompilerOnError(const Msg: String; const ErrorFilename: String; const ErrorLine: LongInt);
- begin
- LineFilename := ErrorFilename;
- LineNumber := ErrorLine;
- AbortCompile(Msg);
- end;
- procedure TSetupCompiler.CodeCompilerOnWarning(const Msg: String);
- begin
- WarningsList.Add(Msg);
- end;
- procedure TSetupCompiler.CompileCode;
- var
- CodeStr: String;
- CompiledCodeDebugInfo: AnsiString;
- begin
- { Compile CodeText }
- if (CodeText.Count > 0) or (CodeCompiler.ExportCount > 0) then begin
- if CodeText.Count > 0 then
- AddStatus(SCompilerStatusCompilingCode);
- //don't forget highlighter!
- //setup
- CodeCompiler.AddExport('InitializeSetup', 'Boolean', True, False, '', 0);
- CodeCompiler.AddExport('DeinitializeSetup', '0', True, False, '', 0);
- CodeCompiler.AddExport('CurStepChanged', '0 @TSetupStep', True, False, '', 0);
- CodeCompiler.AddExport('NextButtonClick', 'Boolean @LongInt', True, False, '', 0);
- CodeCompiler.AddExport('BackButtonClick', 'Boolean @LongInt', True, False, '', 0);
- CodeCompiler.AddExport('CancelButtonClick', '0 @LongInt !Boolean !Boolean', True, False, '', 0);
- CodeCompiler.AddExport('ShouldSkipPage', 'Boolean @LongInt', True, False, '', 0);
- CodeCompiler.AddExport('CurPageChanged', '0 @LongInt', True, False, '', 0);
- CodeCompiler.AddExport('CheckPassword', 'Boolean @String', True, False, '', 0);
- CodeCompiler.AddExport('NeedRestart', 'Boolean', True, False, '', 0);
- CodeCompiler.AddExport('RegisterPreviousData', '0 @LongInt', True, False, '', 0);
- CodeCompiler.AddExport('CheckSerial', 'Boolean @String', True, False, '', 0);
- CodeCompiler.AddExport('InitializeWizard', '0', True, False, '', 0);
- CodeCompiler.AddExport('RegisterExtraCloseApplicationsResources', '0', True, False, '', 0);
- CodeCompiler.AddExport('CurInstallProgressChanged', '0 @LongInt @LongInt', True, False, '', 0);
- CodeCompiler.AddExport('UpdateReadyMemo', 'String @String @String @String @String @String @String @String @String', True, False, '', 0);
- CodeCompiler.AddExport('GetCustomSetupExitCode', 'LongInt', True, False, '', 0);
- CodeCompiler.AddExport('PrepareToInstall', 'String !Boolean', True, False, '', 0);
- //uninstall
- CodeCompiler.AddExport('InitializeUninstall', 'Boolean', True, False, '', 0);
- CodeCompiler.AddExport('DeinitializeUninstall', '0', True, False, '', 0);
- CodeCompiler.AddExport('CurUninstallStepChanged', '0 @TUninstallStep', True, False, '', 0);
- CodeCompiler.AddExport('UninstallNeedRestart', 'Boolean', True, False, '', 0);
- CodeCompiler.AddExport('InitializeUninstallProgressForm', '0', True, False, '', 0);
- CodeStr := CodeText.Text;
- { Remove trailing CR-LF so that ROPS will never report an error on
- line CodeText.Count, one past the last actual line }
- if Length(CodeStr) >= Length(#13#10) then
- SetLength(CodeStr, Length(CodeStr) - Length(#13#10));
- CodeCompiler.Compile(CodeStr, CompiledCodeText, CompiledCodeDebugInfo);
- if CodeCompiler.FunctionFound('SkipCurPage') then
- AbortCompileFmt(SCompilerCodeUnsupportedEventFunction, ['SkipCurPage',
- 'ShouldSkipPage']);
- WriteCompiledCodeText(CompiledCodeText);
- WriteCompiledCodeDebugInfo(CompiledCodeDebugInfo);
- end else begin
- CompiledCodeText := '';
- { Check if there were references to [Code] functions despite there being
- no [Code] section }
- CodeCompiler.CheckExports();
- end;
- end;
- procedure TSetupCompiler.AddBytesCompressedSoFar(const Value: Int64);
- begin
- Inc(BytesCompressedSoFar, Value);
- end;
- procedure TSetupCompiler.AddPreprocOption(const Value: String);
- begin
- PreprocOptionsString := PreprocOptionsString + Value + #0;
- end;
- procedure TSetupCompiler.AddSignTool(const Name, Command: String);
- var
- SignTool: TSignTool;
- begin
- SignToolList.Expand;
- SignTool := TSignTool.Create();
- SignTool.Name := Name;
- SignTool.Command := Command;
- SignToolList.Add(SignTool);
- end;
- procedure TSetupCompiler.Sign(AExeFilename: String);
- var
- I, SignToolIndex: Integer;
- SignTool: TSignTool;
- begin
- for I := 0 to SignTools.Count - 1 do begin
- SignToolIndex := FindSignToolIndexByName(SignTools[I]); //can't fail, already checked
- SignTool := TSignTool(SignToolList[SignToolIndex]);
- SignCommand(SignTool.Name, SignTool.Command, SignToolsParams[I], AExeFilename, SignToolRetryCount, SignToolRetryDelay, SignToolMinimumTimeBetween, SignToolRunMinimized);
- end;
- end;
- procedure SignCommandLog(const S: String; const Error, FirstLine: Boolean; const Data: NativeInt);
- begin
- if S <> '' then begin
- var SetupCompiler := TSetupCompiler(Data);
- SetupCompiler.AddStatus(' ' + S, Error);
- end;
- end;
- procedure TSetupCompiler.SignCommand(const AName, ACommand, AParams, AExeFilename: String; const RetryCount, RetryDelay, MinimumTimeBetween: Integer; const RunMinimized: Boolean);
- function FmtCommand(S: PChar; const AParams, AFileName: String; var AFileNameSequenceFound: Boolean): String;
- var
- P: PChar;
- Z: String;
- begin
- Result := '';
- AFileNameSequenceFound := False;
- if S = nil then Exit;
- while True do begin
- P := StrScan(S, '$');
- if P = nil then begin
- Result := Result + S;
- Break;
- end;
- if P <> S then begin
- SetString(Z, S, P - S);
- Result := Result + Z;
- S := P;
- end;
- Inc(P);
- if (P^ = 'p') then begin
- Result := Result + AParams;
- Inc(S, 2);
- end
- else if (P^ = 'f') then begin
- Result := Result + '"' + AFileName + '"';
- AFileNameSequenceFound := True;
- Inc(S, 2);
- end
- else if (P^ = 'q') then begin
- Result := Result + '"';
- Inc(S, 2);
- end
- else begin
- Result := Result + '$';
- Inc(S);
- if P^ = '$' then
- Inc(S);
- end;
- end;
- end;
- procedure InternalSignCommand(const AFormattedCommand: String;
- const Delay: Cardinal);
- begin
- {Also see IsppFuncs' Exec }
- if Delay <> 0 then begin
- AddStatus(Format(SCompilerStatusSigningWithDelay, [AName, Delay, AFormattedCommand]));
- Sleep(Delay);
- end else
- AddStatus(Format(SCompilerStatusSigning, [AName, AFormattedCommand]));
- LastSignCommandStartTick := GetTickCount;
- var StartupInfo: TStartupInfo;
- FillChar(StartupInfo, SizeOf(StartupInfo), 0);
- StartupInfo.cb := SizeOf(StartupInfo);
- StartupInfo.dwFlags := STARTF_USESHOWWINDOW;
- StartupInfo.wShowWindow := Word(IfThen(RunMinimized, SW_SHOWMINNOACTIVE, SW_SHOWNORMAL));
- var OutputReader := TCreateProcessOutputReader.Create(SignCommandLog, NativeInt(Self));
- try
- var InheritHandles := True;
- var dwCreationFlags: DWORD := CREATE_DEFAULT_ERROR_MODE or CREATE_NO_WINDOW;
- OutputReader.UpdateStartupInfo(StartupInfo);
- var ProcessInfo: TProcessInformation;
- if not CreateProcess(nil, PChar(AFormattedCommand), nil, nil, InheritHandles,
- dwCreationFlags, nil, PChar(CompilerDir), StartupInfo, ProcessInfo) then begin
- var LastError := GetLastError;
- AbortCompileFmt(SCompilerSignToolCreateProcessFailed, [LastError,
- Win32ErrorString(LastError)]);
- end;
- { Don't need the thread handle, so close it now }
- CloseHandle(ProcessInfo.hThread);
- OutputReader.NotifyCreateProcessDone;
- try
- while True do begin
- case WaitForSingleObject(ProcessInfo.hProcess, 50) of
- WAIT_OBJECT_0: Break;
- WAIT_TIMEOUT:
- begin
- OutputReader.Read(False);
- CallIdleProc(True); { Doesn't allow an Abort }
- end;
- else
- AbortCompile('Sign: WaitForSingleObject failed');
- end;
- end;
- OutputReader.Read(True);
- var ExitCode: DWORD;
- if not GetExitCodeProcess(ProcessInfo.hProcess, ExitCode) then
- AbortCompile('Sign: GetExitCodeProcess failed');
- if ExitCode <> 0 then
- AbortCompileFmt(SCompilerSignToolNonZeroExitCode, [ExitCode]);
- finally
- CloseHandle(ProcessInfo.hProcess);
- end;
- finally
- OutputReader.Free;
- end;
- end;
- var
- Params, Command: String;
- MinimumTimeBetweenDelay: Integer;
- I: Integer;
- FileNameSequenceFound1, FileNameSequenceFound2: Boolean;
- begin
- Params := FmtCommand(PChar(AParams), '', AExeFileName, FileNameSequenceFound1);
- Command := FmtCommand(PChar(ACommand), Params, AExeFileName, FileNameSequenceFound2);
- if not FileNameSequenceFound1 and not FileNameSequenceFound2 then
- AbortCompileFmt(SCompilerSignToolFileNameSequenceNotFound, [AName]);
- for I := 0 to RetryCount do begin
- try
- if (MinimumTimeBetween <> 0) and (LastSignCommandStartTick <> 0) then begin
- MinimumTimeBetweenDelay := MinimumTimeBetween - Integer(GetTickCount - LastSignCommandStartTick);
- if MinimumTimeBetweenDelay < 0 then
- MinimumTimeBetweenDelay := 0;
- end else
- MinimumTimeBetweenDelay := 0;
- InternalSignCommand(Command, MinimumTimeBetweenDelay);
- Break;
- except on E: Exception do
- if I < RetryCount then begin
- AddStatus(Format(SCompilerStatusWillRetrySigning, [E.Message, RetryCount-I]));
- Sleep(RetryDelay);
- end else
- raise;
- end;
- end;
- end;
- procedure TSetupCompiler.VerificationError(const AError: TVerificationError;
- const AFilename, ASigFilename: String);
- const
- Messages: array[TVerificationError] of String =
- (SCompilerVerificationSignatureDoesntExist, SCompilerVerificationSignatureMalformed,
- SCompilerVerificationKeyNotFound, SCompilerVerificationSignatureBad,
- SCompilerVerificationFileNameIncorrect, SCompilerVerificationFileSizeIncorrect,
- SCompilerVerificationFileHashIncorrect);
- begin
- { Also see Setup.Install for a similar function }
- AbortCompileFmt(SCompilerSourceFileVerificationFailed,
- [AFilename, Format(Messages[AError], [PathExtractName(ASigFilename)])]); { Not all messages actually have a %s parameter but that's OK }
- end;
- procedure TSetupCompiler.OnUpdateIconsAndStyle(const Operation: TUpdateIconsAndStyleOperation);
- begin
- case Operation of
- uisoIcoFileName: LineNumber := SetupDirectiveLines[ssSetupIconFile];
- uisoWizardDarkStyle: LineNumber := SetupDirectiveLines[ssWizardStyle];
- uisoStyleFileName: LineNumber := SetupDirectiveLines[ssWizardStyleFile];
- uisoStyleFileNameDynamicDark: LineNumber := SetupDirectiveLines[ssWizardStyleFileDynamicDark];
- else
- LineNumber := 0;
- end;
- end;
- procedure TSetupCompiler.Compile;
- procedure InitDebugInfo;
- var
- Header: TDebugInfoHeader;
- begin
- DebugEntryCount := 0;
- VariableDebugEntryCount := 0;
- DebugInfo.Clear;
- CodeDebugInfo.Clear;
- Header.ID := DebugInfoHeaderID;
- Header.Version := DebugInfoHeaderVersion;
- Header.DebugEntryCount := 0;
- Header.CompiledCodeTextLength := 0;
- Header.CompiledCodeDebugInfoLength := 0;
- DebugInfo.WriteBuffer(Header, SizeOf(Header));
- end;
- procedure FinalizeDebugInfo;
- var
- Header: TDebugInfoHeader;
- begin
- DebugInfo.CopyFrom(CodeDebugInfo, 0);
- { Update the header }
- DebugInfo.Seek(0, soFromBeginning);
- DebugInfo.ReadBuffer(Header, SizeOf(Header));
- Header.DebugEntryCount := DebugEntryCount;
- Header.VariableDebugEntryCount := VariableDebugEntryCount;
- Header.CompiledCodeTextLength := CompiledCodeTextLength;
- Header.CompiledCodeDebugInfoLength := CompiledCodeDebugInfoLength;
- DebugInfo.Seek(0, soFromBeginning);
- DebugInfo.WriteBuffer(Header, SizeOf(Header));
- end;
- procedure EmptyOutputDir(const Log: Boolean);
- procedure DelFile(const Filename: String);
- begin
- if DeleteFile(OutputDir + Filename) and Log then
- AddStatus(Format(SCompilerStatusDeletingPrevious, [Filename]));
- end;
- var
- H: THandle;
- FindData: TWin32FindData;
- N: String;
- I: Integer;
- HasNumbers: Boolean;
- begin
- { Delete Setup.* and Setup-*.bin if they existed in the output directory }
- if OutputBaseFilename <> '' then begin
- DelFile(OutputBaseFilename + '.exe');
- if OutputDir <> '' then begin
- H := FindFirstFile(PChar(OutputDir + OutputBaseFilename + '-*.bin'), FindData);
- if H <> INVALID_HANDLE_VALUE then begin
- try
- repeat
- if FindData.dwFileAttributes and FILE_ATTRIBUTE_DIRECTORY = 0 then begin
- N := FindData.cFileName;
- if PathStartsWith(N, OutputBaseFilename) then begin
- I := Length(OutputBaseFilename) + 1;
- if (I <= Length(N)) and (N[I] = '-') then begin
- Inc(I);
- HasNumbers := False;
- while (I <= Length(N)) and CharInSet(N[I], ['0'..'9']) do begin
- HasNumbers := True;
- Inc(I);
- end;
- if HasNumbers then begin
- if (I <= Length(N)) and CharInSet(UpCase(N[I]), ['A'..'Z']) then
- Inc(I);
- if CompareText(Copy(N, I, Maxint), '.bin') = 0 then
- DelFile(N);
- end;
- end;
- end;
- end;
- until not FindNextFile(H, FindData);
- finally
- Windows.FindClose(H);
- end;
- end;
- end;
- end;
- end;
- procedure ClearSEList(const List: TList; const NumStrings, NumAnsiStrings: Integer);
- begin
- for var I := List.Count-1 downto 0 do begin
- SEFreeRec(List[I], NumStrings, NumAnsiStrings);
- List.Delete(I);
- end;
- end;
- procedure ClearPreLangDataList;
- var
- I: Integer;
- begin
- for I := PreLangDataList.Count-1 downto 0 do begin
- TPreLangData(PreLangDataList[I]).Free;
- PreLangDataList.Delete(I);
- end;
- end;
- procedure ClearLangDataList;
- var
- I: Integer;
- begin
- for I := LangDataList.Count-1 downto 0 do begin
- TLangData(LangDataList[I]).Free;
- LangDataList.Delete(I);
- end;
- end;
- procedure ClearScriptFiles;
- var
- I: Integer;
- SL: TObject;
- begin
- for I := ScriptFiles.Count-1 downto 0 do begin
- SL := ScriptFiles.Objects[I];
- ScriptFiles.Delete(I);
- SL.Free;
- end;
- end;
- procedure ClearLineInfoList(L: TStringList);
- var
- I: Integer;
- LineInfo: TLineInfo;
- begin
- for I := L.Count-1 downto 0 do begin
- LineInfo := TLineInfo(L.Objects[I]);
- L.Delete(I);
- LineInfo.Free;
- end;
- end;
- var
- SetupFile: TFile;
- ExeFile: TFile;
- LicenseText, InfoBeforeText, InfoAfterText: AnsiString;
- WizardImages, WizardSmallImages, WizardBackImages: TWizardImages;
- WizardImagesDynamicDark, WizardSmallImagesDynamicDark, WizardBackImagesDynamicDark: TWizardImages;
- DecompressorDLL, SevenZipDLL: TMemoryStream;
- SizeOfExe, SizeOfHeaders: Int64;
- function WriteSetup0(const F: TFile): Int64;
- procedure WriteStream(Stream: TCustomMemoryStream; W: TCompressedBlockWriter);
- begin
- if Stream.Size > High(Cardinal) then
- AbortCompileFmt(SCompilerCompressInternalError, ['Unexpected Stream.Size value']);
- const Size = Cardinal(Stream.Size);
- W.Write(Size, SizeOf(Size));
- W.Write(Stream.Memory^, Size);
- end;
- function WizardImagesEqual(const Left, Right: TWizardImages): Boolean;
- begin
- if Left.Count <> Right.Count then
- Exit(False);
- for var I := 0 to Left.Count-1 do begin
- var LeftStream := Left[I];
- var RightStream := Right[I];
- if LeftStream.Size <> RightStream.Size then
- Exit(False);
- if (LeftStream.Size > 0) and
- not CompareMem(LeftStream.Memory, RightStream.Memory, LeftStream.Size) then
- Exit(False);
- end;
- Result := True;
- end;
- procedure WriteWizardImages(const WizardImages: TWizardImages; const W: TCompressedBlockWriter;
- const CompareTo: TWizardImages = nil);
- begin
- var Count: Integer;
- if WizardImages <> nil then begin
- if (CompareTo <> nil) and (WizardImages.Count > 0) and WizardImagesEqual(WizardImages, CompareTo) then begin
- Count := -1;
- W.Write(Count, SizeOf(Integer));
- end else begin
- Count := WizardImages.Count;
- W.Write(Count, SizeOf(Integer));
- for var I := 0 to Count-1 do
- WriteStream(WizardImages[I], W);
- end;
- end else begin
- Count := 0;
- W.Write(Count, SizeOf(Integer));
- end;
- end;
- var
- J: Integer;
- W: TCompressedBlockWriter;
- begin
- const StartPosition = F.Position;
- F.WriteBuffer(SetupID, SizeOf(SetupID));
- const SetupEncryptionHeaderCRC = GetCRC32(SetupEncryptionHeader, SizeOf(SetupEncryptionHeader));
- F.WriteBuffer(SetupEncryptionHeaderCRC, SizeOf(SetupEncryptionHeaderCRC));
- F.WriteBuffer(SetupEncryptionHeader, SizeOf(SetupEncryptionHeader));
- SetupHeader.NumLanguageEntries := LanguageEntries.Count;
- SetupHeader.NumCustomMessageEntries := CustomMessageEntries.Count;
- SetupHeader.NumPermissionEntries := PermissionEntries.Count;
- SetupHeader.NumTypeEntries := TypeEntries.Count;
- SetupHeader.NumComponentEntries := ComponentEntries.Count;
- SetupHeader.NumTaskEntries := TaskEntries.Count;
- SetupHeader.NumDirEntries := DirEntries.Count;
- SetupHeader.NumISSigKeyEntries := ISSigKeyEntries.Count;
- SetupHeader.NumFileEntries := FileEntries.Count;
- SetupHeader.NumFileLocationEntries := FileLocationEntries.Count;
- SetupHeader.NumIconEntries := IconEntries.Count;
- SetupHeader.NumIniEntries := IniEntries.Count;
- SetupHeader.NumRegistryEntries := RegistryEntries.Count;
- SetupHeader.NumInstallDeleteEntries := InstallDeleteEntries.Count;
- SetupHeader.NumUninstallDeleteEntries := UninstallDeleteEntries.Count;
- SetupHeader.NumRunEntries := RunEntries.Count;
- SetupHeader.NumUninstallRunEntries := UninstallRunEntries.Count;
- SetupHeader.LicenseText := LicenseText;
- SetupHeader.InfoBeforeText := InfoBeforeText;
- SetupHeader.InfoAfterText := InfoAfterText;
- SetupHeader.CompiledCodeText := CompiledCodeText;
- W := TCompressedBlockWriter.Create(F, TLZMACompressor, InternalCompressLevel,
- InternalCompressProps);
- try
- if SetupEncryptionHeader.EncryptionUse = euFull then
- W.InitEncryption(CryptKey, SetupEncryptionHeader.BaseNonce, sccCompressedBlocks1);
- SECompressedBlockWrite(W, SetupHeader, SizeOf(SetupHeader),
- SetupHeaderStrings, SetupHeaderAnsiStrings);
- for J := 0 to LanguageEntries.Count-1 do
- SECompressedBlockWrite(W, LanguageEntries[J]^, SizeOf(TSetupLanguageEntry),
- SetupLanguageEntryStrings, SetupLanguageEntryAnsiStrings);
- for J := 0 to CustomMessageEntries.Count-1 do
- SECompressedBlockWrite(W, CustomMessageEntries[J]^, SizeOf(TSetupCustomMessageEntry),
- SetupCustomMessageEntryStrings, SetupCustomMessageEntryAnsiStrings);
- for J := 0 to PermissionEntries.Count-1 do
- SECompressedBlockWrite(W, PermissionEntries[J]^, SizeOf(TSetupPermissionEntry),
- SetupPermissionEntryStrings, SetupPermissionEntryAnsiStrings);
- for J := 0 to TypeEntries.Count-1 do
- SECompressedBlockWrite(W, TypeEntries[J]^, SizeOf(TSetupTypeEntry),
- SetupTypeEntryStrings, SetupTypeEntryAnsiStrings);
- for J := 0 to ComponentEntries.Count-1 do
- SECompressedBlockWrite(W, ComponentEntries[J]^, SizeOf(TSetupComponentEntry),
- SetupComponentEntryStrings, SetupComponentEntryAnsiStrings);
- for J := 0 to TaskEntries.Count-1 do
- SECompressedBlockWrite(W, TaskEntries[J]^, SizeOf(TSetupTaskEntry),
- SetupTaskEntryStrings, SetupTaskEntryAnsiStrings);
- for J := 0 to DirEntries.Count-1 do
- SECompressedBlockWrite(W, DirEntries[J]^, SizeOf(TSetupDirEntry),
- SetupDirEntryStrings, SetupDirEntryAnsiStrings);
- for J := 0 to ISSigKeyEntries.Count-1 do
- SECompressedBlockWrite(W, ISSigKeyEntries[J]^, SizeOf(TSetupISSigKeyEntry),
- SetupISSigKeyEntryStrings, SetupISSigKeyEntryAnsiStrings);
- for J := 0 to FileEntries.Count-1 do
- SECompressedBlockWrite(W, FileEntries[J]^, SizeOf(TSetupFileEntry),
- SetupFileEntryStrings, SetupFileEntryAnsiStrings);
- for J := 0 to IconEntries.Count-1 do
- SECompressedBlockWrite(W, IconEntries[J]^, SizeOf(TSetupIconEntry),
- SetupIconEntryStrings, SetupIconEntryAnsiStrings);
- for J := 0 to IniEntries.Count-1 do
- SECompressedBlockWrite(W, IniEntries[J]^, SizeOf(TSetupIniEntry),
- SetupIniEntryStrings, SetupIniEntryAnsiStrings);
- for J := 0 to RegistryEntries.Count-1 do
- SECompressedBlockWrite(W, RegistryEntries[J]^, SizeOf(TSetupRegistryEntry),
- SetupRegistryEntryStrings, SetupRegistryEntryAnsiStrings);
- for J := 0 to InstallDeleteEntries.Count-1 do
- SECompressedBlockWrite(W, InstallDeleteEntries[J]^, SizeOf(TSetupDeleteEntry),
- SetupDeleteEntryStrings, SetupDeleteEntryAnsiStrings);
- for J := 0 to UninstallDeleteEntries.Count-1 do
- SECompressedBlockWrite(W, UninstallDeleteEntries[J]^, SizeOf(TSetupDeleteEntry),
- SetupDeleteEntryStrings, SetupDeleteEntryAnsiStrings);
- for J := 0 to RunEntries.Count-1 do
- SECompressedBlockWrite(W, RunEntries[J]^, SizeOf(TSetupRunEntry),
- SetupRunEntryStrings, SetupRunEntryAnsiStrings);
- for J := 0 to UninstallRunEntries.Count-1 do
- SECompressedBlockWrite(W, UninstallRunEntries[J]^, SizeOf(TSetupRunEntry),
- SetupRunEntryStrings, SetupRunEntryAnsiStrings);
- WriteWizardImages(WizardImages, W);
- WriteWizardImages(WizardSmallImages, W);
- WriteWizardImages(WizardBackImages, W);
- WriteWizardImages(WizardImagesDynamicDark, W, WizardImages);
- WriteWizardImages(WizardSmallImagesDynamicDark, W, WizardSmallImages);
- WriteWizardImages(WizardBackImagesDynamicDark, W, WizardBackImages);
- if SetupHeader.CompressMethod in [cmZip, cmBzip] then
- WriteStream(DecompressorDLL, W);
- if SetupHeader.SevenZipLibraryName <> '' then
- WriteStream(SevenZipDLL, W);
- W.Finish;
- finally
- W.Free;
- end;
- if not DiskSpanning then
- W := TCompressedBlockWriter.Create(F, TLZMACompressor, InternalCompressLevel,
- InternalCompressProps)
- else
- W := TCompressedBlockWriter.Create(F, nil, 0, nil);
- { ^ When disk spanning is enabled, the Setup Compiler requires that
- FileLocationEntries be a fixed size, so don't compress them }
- try
- if SetupEncryptionHeader.EncryptionUse = euFull then
- W.InitEncryption(CryptKey, SetupEncryptionHeader.BaseNonce, sccCompressedBlocks2);
- for J := 0 to FileLocationEntries.Count-1 do
- W.Write(FileLocationEntries[J]^, SizeOf(TSetupFileLocationEntry));
- W.Finish;
- finally
- W.Free;
- end;
- Result := F.Position - StartPosition;
- end;
- function CreateSetup0File: Int64;
- var
- F: TFile;
- begin
- F := TFile.Create(OutputDir + OutputBaseFilename + '-0.bin',
- fdCreateAlways, faWrite, fsNone);
- try
- Result := WriteSetup0(F);
- finally
- F.Free;
- end;
- end;
- function RoundToNearestClusterSize(const L: Int64): Int64;
- begin
- Result := (L div DiskClusterSize) * DiskClusterSize;
- if L mod DiskClusterSize <> 0 then
- Inc(Result, DiskClusterSize);
- end;
- procedure WithRetries(const AlsoRetryOnAlreadyExists: Boolean;
- const Filename: String; const Op: TProc);
- { Op should always raise EFileError or EResUpdateError on failure. }
- begin
- var SavedException: TObject := nil;
- try
- {$IFDEF TESTRETRIES} var First := True; {$ENDIF}
- PerformFileOperationWithRetries(4, AlsoRetryOnAlreadyExists,
- function {Op}(out ErrorCode: Cardinal): Boolean
- begin
- try
- {$IFDEF TESTRETRIES}
- if First and NewFileExists(Filename) then begin
- const F = TFile.Create(Filename, fdOpenExisting, faReadWrite, fsNone);
- TThread.CreateAnonymousThread(
- procedure
- begin
- while TStrongRandom.GenerateUInt32 mod 2 = 1 do
- Sleep(900);
- F.Free;
- end).Start;
- First := False;
- end;
- {$ENDIF}
- Op;
- Result := True;
- except
- on E: EFileError do
- begin
- ErrorCode := E.ErrorCode;
- SavedException.Free;
- SavedException := AcquireExceptionObject;
- Result := False;
- end;
- on E: EResUpdateError do
- begin
- ErrorCode := E.ErrorCode;
- SavedException.Free;
- SavedException := AcquireExceptionObject;
- Result := False;
- end;
- end;
- end,
- procedure {Failing}(const LastError: Cardinal)
- begin
- AddStatusFmt(SCompilerStatusOutputFileInUse, [LastError, PathExtractName(Filename)]);
- for var I := 0 to 9 do begin
- Sleep(100);
- CallIdleProc; { May raise an exception }
- end;
- end,
- procedure {Failed}(const LastError: Cardinal; var TryOnceMore: Boolean)
- begin
- if SavedException <> nil then begin
- const Ex = SavedException;
- SavedException := nil;
- raise Ex;
- end else
- AbortCompileFmt(SCompilerCompressInternalError, ['Unexpected SavedException value']);
- end);
- finally
- { SavedException will be non-nil if there was a successful retry. It can also be non-nil if
- an exception was raised outside Failed. }
- SavedException.Free;
- end;
- end;
- procedure CompressFiles(const FirstDestFile: String;
- const BytesToReserveOnFirstDisk: Int64);
- var
- CurrentTime: TSystemTime;
- procedure ApplyTouchDateTime(var FT: TFileTime);
- var
- ST: TSystemTime;
- begin
- if (TouchDateOption = tdNone) and (TouchTimeOption = ttNone) then
- Exit; { nothing to do }
- if not FileTimeToSystemTime(FT, ST) then
- AbortCompile('ApplyTouch: FileTimeToSystemTime call failed');
- case TouchDateOption of
- tdCurrent: begin
- ST.wYear := CurrentTime.wYear;
- ST.wMonth := CurrentTime.wMonth;
- ST.wDay := CurrentTime.wDay;
- end;
- tdExplicit: begin
- ST.wYear := TouchDateYear;
- ST.wMonth := TouchDateMonth;
- ST.wDay := TouchDateDay;
- end;
- end;
- case TouchTimeOption of
- ttCurrent: begin
- ST.wHour := CurrentTime.wHour;
- ST.wMinute := CurrentTime.wMinute;
- ST.wSecond := CurrentTime.wSecond;
- ST.wMilliseconds := CurrentTime.wMilliseconds;
- end;
- ttExplicit: begin
- ST.wHour := TouchTimeHour;
- ST.wMinute := TouchTimeMinute;
- ST.wSecond := TouchTimeSecond;
- ST.wMilliseconds := 0;
- end;
- end;
- if not SystemTimeToFileTime(ST, FT) then
- AbortCompile('ApplyTouch: SystemTimeToFileTime call failed');
- end;
- function GetCompressorClass(const UseCompression: Boolean): TCustomCompressorClass;
- begin
- if not UseCompression then
- Result := TStoredCompressor
- else begin
- case SetupHeader.CompressMethod of
- cmStored: begin
- Result := TStoredCompressor;
- end;
- cmZip: begin
- InitZipDLL;
- Result := TZCompressor;
- end;
- cmBzip: begin
- InitBzipDLL;
- Result := TBZCompressor;
- end;
- cmLZMA: begin
- Result := TLZMACompressor;
- end;
- cmLZMA2: begin
- Result := TLZMA2Compressor;
- end;
- else
- AbortCompile('GetCompressorClass: Unknown CompressMethod');
- Result := nil;
- end;
- end;
- end;
- procedure FinalizeChunk(const CH: TCompressionHandler;
- const LastFileLocationEntry: Integer);
- var
- I: Integer;
- FL: PSetupFileLocationEntry;
- begin
- if CH.ChunkStarted then begin
- CH.EndChunk;
- { Set LastSlice and ChunkCompressedSize on all file location
- entries that are part of the chunk }
- for I := 0 to LastFileLocationEntry do begin
- FL := FileLocationEntries[I];
- if (FL.StartOffset = CH.ChunkStartOffset) and (FL.FirstSlice = CH.ChunkFirstSlice) then begin
- FL.LastSlice := CH.CurSlice;
- FL.ChunkCompressedSize := CH.ChunkBytesWritten;
- end;
- end;
- end;
- end;
- const
- StatusFilesStoringOrCompressingVersionStrings: array [Boolean] of String = (
- SCompilerStatusFilesStoringVersion,
- SCompilerStatusFilesCompressingVersion);
- StatusFilesStoringOrCompressingStrings: array [Boolean] of String = (
- SCompilerStatusFilesStoring,
- SCompilerStatusFilesCompressing);
- var
- CH: TCompressionHandler;
- ChunkCompressed: Boolean;
- I: Integer;
- FL: PSetupFileLocationEntry;
- FLExtraInfo: PFileLocationEntryExtraInfo;
- FT: TFileTime;
- SourceFile: TFile;
- SignatureAddress, SignatureSize: Cardinal;
- HdrChecksum, ErrorCode: DWORD;
- ISSigAvailableKeys: TArrayOfECDSAKey;
- begin
- if (SetupHeader.CompressMethod in [cmLZMA, cmLZMA2]) and
- (CompressProps.WorkerProcessFilename <> '') then
- AddStatus(Format(' Using separate process for LZMA compression (%s)',
- [PathExtractName(CompressProps.WorkerProcessFilename)]));
- if TimeStampsInUTC then
- GetSystemTime(CurrentTime)
- else
- GetLocalTime(CurrentTime);
- ChunkCompressed := False; { avoid warning }
- if FirstDestFile <> '' then begin
- WithRetries(False, FirstDestFile,
- procedure
- begin
- CH := TCompressionHandler.Create(Self, FirstDestFile);
- end);
- end else
- CH := TCompressionHandler.Create(Self, '');
- SetLength(ISSigAvailableKeys, ISSigKeyEntries.Count);
- for I := 0 to ISSigKeyEntries.Count-1 do
- ISSigAvailableKeys[I] := nil;
- try
- for I := 0 to ISSigKeyEntries.Count-1 do begin
- const ISSigKeyEntry = PSetupISSigKeyEntry(ISSigKeyEntries[I]);
- ISSigAvailableKeys[I] := TECDSAKey.Create;
- try
- ISSigImportPublicKey(ISSigAvailableKeys[I], '', ISSigKeyEntry.PublicX, ISSigKeyEntry.PublicY); { shouldn't fail: values checked already }
- except
- AbortCompileFmt(SCompilerCompressInternalError, ['ISSigImportPublicKey failed: ' + GetExceptMessage]);
- end;
- end;
- if DiskSpanning then begin
- if not CH.ReserveBytesOnSlice(BytesToReserveOnFirstDisk) then
- AbortCompile(SCompilerNotEnoughSpaceOnFirstDisk);
- end;
- CompressionStartTick := GetTickCount;
- CompressionInProgress := True;
- for I := 0 to FileLocationEntries.Count-1 do begin
- FL := FileLocationEntries[I];
- FLExtraInfo := FileLocationEntryExtraInfos[I];
- if FLExtraInfo.Sign <> fsNoSetting then begin
- var SignatureFound := False;
- if FLExtraInfo.Sign in [fsOnce, fsCheck] then begin
- { Check the file for a signature }
- SourceFile := TFile.Create(FileLocationEntryFilenames[I],
- fdOpenExisting, faRead, fsRead);
- try
- if ReadSignatureAndChecksumFields(SourceFile, DWORD(SignatureAddress),
- DWORD(SignatureSize), HdrChecksum) or
- ReadSignatureAndChecksumFields64(SourceFile, DWORD(SignatureAddress),
- DWORD(SignatureSize), HdrChecksum) then
- SignatureFound := SignatureSize <> 0;
- finally
- SourceFile.Free;
- end;
- end;
- if (FLExtraInfo.Sign = fsYes) or ((FLExtraInfo.Sign = fsOnce) and not SignatureFound) then begin
- AddStatus(Format(SCompilerStatusSigningSourceFile, [FileLocationEntryFilenames[I]]));
- Sign(FileLocationEntryFilenames[I]);
- CallIdleProc;
- end else if FLExtraInfo.Sign = fsOnce then
- AddStatus(Format(SCompilerStatusSourceFileAlreadySigned, [FileLocationEntryFilenames[I]]))
- else if (FLExtraInfo.Sign = fsCheck) and not SignatureFound then
- AbortCompileFmt(SCompilerSourceFileNotSigned, [FileLocationEntryFilenames[I]]);
- end;
- if floVersionInfoValid in FL.Flags then
- AddStatus(Format(StatusFilesStoringOrCompressingVersionStrings[floChunkCompressed in FL.Flags],
- [FileLocationEntryFilenames[I],
- LongRec(FL.FileVersionMS).Hi, LongRec(FL.FileVersionMS).Lo,
- LongRec(FL.FileVersionLS).Hi, LongRec(FL.FileVersionLS).Lo]))
- else
- AddStatus(Format(StatusFilesStoringOrCompressingStrings[floChunkCompressed in FL.Flags],
- [FileLocationEntryFilenames[I]]));
- CallIdleProc;
- SourceFile := TFile.Create(FileLocationEntryFilenames[I],
- fdOpenExisting, faRead, fsRead);
- try
- var ExpectedFileHash: TSHA256Digest;
- if FLExtraInfo.Verification.Typ = fvHash then
- ExpectedFileHash := FLExtraInfo.Verification.Hash
- else if FLExtraInfo.Verification.Typ = fvISSig then begin
- { See Setup.Install's CopySourceFileToDestFile for similar code }
- if Length(ISSigAvailableKeys) = 0 then { shouldn't fail: flag stripped already }
- AbortCompileFmt(SCompilerCompressInternalError, ['Length(ISSigAvailableKeys) = 0']);
- var ExpectedFileName: String;
- var ExpectedFileSize: Int64;
- if not ISSigVerifySignature(FileLocationEntryFilenames[I],
- GetISSigAllowedKeys(ISSigAvailableKeys, FLExtraInfo.Verification.ISSigAllowedKeys),
- ExpectedFileName, ExpectedFileSize, ExpectedFileHash, FLExtraInfo.ISSigKeyUsedID,
- nil,
- procedure(const Filename, SigFilename: String)
- begin
- VerificationError(veSignatureMissing, Filename, SigFilename);
- end,
- procedure(const Filename, SigFilename: String; const VerifyResult: TISSigVerifySignatureResult)
- begin
- var VerifyResultAsString: String;
- case VerifyResult of
- vsrMalformed: VerificationError(veSignatureMalformed, Filename, SigFilename);
- vsrBad: VerificationError(veSignatureBad, Filename, SigFilename);
- vsrKeyNotFound: VerificationError(veKeyNotFound, Filename, SigFilename);
- else
- AbortCompileFmt(SCompilerCompressInternalError, ['Unknown ISSigVerifySignature result'])
- end;
- end
- ) then
- AbortCompileFmt(SCompilerCompressInternalError, ['Unexpected ISSigVerifySignature result']);
- if (ExpectedFileName <> '') and not PathSame(PathExtractName(FileLocationEntryFilenames[I]), ExpectedFileName) then
- VerificationError(veFileNameIncorrect, FileLocationEntryFilenames[I]);
- if SourceFile.Size <> ExpectedFileSize then
- VerificationError(veFileSizeIncorrect, FileLocationEntryFilenames[I]);
- { ExpectedFileHash checked below after compression }
- end;
- if CH.ChunkStarted then begin
- { End the current chunk if one of the following conditions is true:
- - we're not using solid compression
- - the "solidbreak" flag was specified on this file
- - the compression or encryption status of this file is
- different from the previous file(s) in the chunk }
- if not UseSolidCompression or
- (floSolidBreak in FLExtraInfo.Flags) or
- (ChunkCompressed <> (floChunkCompressed in FL.Flags)) or
- (CH.ChunkEncrypted <> (floChunkEncrypted in FL.Flags)) then
- FinalizeChunk(CH, I-1);
- end;
- { Start a new chunk if needed }
- if not CH.ChunkStarted then begin
- ChunkCompressed := (floChunkCompressed in FL.Flags);
- CH.NewChunk(GetCompressorClass(ChunkCompressed), CompressLevel,
- CompressProps, floChunkEncrypted in FL.Flags, CryptKey);
- end;
- FL.FirstSlice := CH.ChunkFirstSlice;
- FL.StartOffset := CH.ChunkStartOffset;
- FL.ChunkSuboffset := CH.ChunkBytesRead;
- FL.OriginalSize := SourceFile.Size;
- if not GetFileTime(SourceFile.Handle, nil, nil, @FT) then begin
- ErrorCode := GetLastError;
- AbortCompileFmt(SCompilerFunctionFailedWithCode,
- ['CompressFiles: GetFileTime', ErrorCode, Win32ErrorString(ErrorCode)]);
- end;
- if floNoTimeStamp in FLExtraInfo.Flags then
- FL.TimeStamp.Clear
- else begin
- if TimeStampsInUTC then begin
- FL.TimeStamp := FT;
- Include(FL.Flags, floTimeStampInUTC);
- end else
- FileTimeToLocalFileTime(FT, FL.TimeStamp);
- if floTouch in FLExtraInfo.Flags then
- ApplyTouchDateTime(FL.TimeStamp);
- if TimeStampRounding > 0 then begin
- var TimeStamp := Int64(FL.TimeStamp);
- Dec(TimeStamp, TimeStamp mod (TimeStampRounding * 10000000));
- FL.TimeStamp := TFileTime(TimeStamp);
- end;
- end;
- if ChunkCompressed and IsX86OrX64Executable(SourceFile) then
- Include(FL.Flags, floCallInstructionOptimized);
- CH.CompressFile(SourceFile, FL.OriginalSize,
- floCallInstructionOptimized in FL.Flags, FL.SHA256Sum);
- if FLExtraInfo.Verification.Typ <> fvNone then begin
- if not SHA256DigestsEqual(FL.SHA256Sum, ExpectedFileHash) then
- VerificationError(veFileHashIncorrect, FileLocationEntryFilenames[I]);
- AddStatus(SCompilerStatusVerified);
- end;
- finally
- SourceFile.Free;
- end;
- end;
- { Finalize the last chunk }
- FinalizeChunk(CH, FileLocationEntries.Count-1);
- CH.Finish;
- finally
- CompressionInProgress := False;
- for I := 0 to Length(ISSigAvailableKeys)-1 do
- ISSigAvailableKeys[I].Free;
- CH.Free;
- end;
- { Ensure progress bar is full, in case a file shrunk in size }
- BytesCompressedSoFar := TotalBytesToCompress;
- CallIdleProc;
- end;
- procedure CopyFileOrAbortWithRetries(const SourceFile, DestFile: String;
- const CheckTrust: Boolean; const CheckFileTrustOptions: TCheckFileTrustOptions;
- const OnCheckedTrust: TProc<Boolean>);
- begin
- if CheckTrust then begin
- try
- CheckFileTrust(SourceFile, CheckFileTrustOptions);
- except
- const Msg = Format(SCompilerCopyError3a, [SourceFile, DestFile,
- GetExceptMessage]);
- AbortCompileFmt(SCompilerCheckPrecompiledFileTrustError, [Msg]);
- end;
- end;
- if Assigned(OnCheckedTrust) then
- OnCheckedTrust(CheckTrust);
- WithRetries(False, DestFile,
- procedure
- begin
- if not CopyFile(PChar(SourceFile), PChar(DestFile), False) then begin
- var ErrorCode := GetLastError;
- const E = EFileError.CreateFmt(SCompilerCopyError3b, [SourceFile, DestFile,
- ErrorCode, Win32ErrorString(ErrorCode)]);
- E.ErrorCode := ErrorCode;
- raise E;
- end;
- end);
- end;
- function InternalSignSetupMemoryFileWithRetries(const Filename: String;
- var UnsignedFile: TMemoryFile; const UnsignedFileSize: Cardinal;
- const MismatchMessage: String): Boolean;
- var
- SignedFile, TestFile, OldFile: TMemoryFile;
- SignedFileSize: Cardinal;
- SignatureAddress, SignatureSize: Cardinal;
- HdrChecksum: DWORD;
- begin
- WithRetries(False, Filename,
- procedure
- begin
- SignedFile := TMemoryFile.Create(Filename);
- end);
- try
- SignedFileSize := SignedFile.CappedSize;
- { Check the file for a signature }
- if not ReadSignatureAndChecksumFields(SignedFile, DWORD(SignatureAddress),
- DWORD(SignatureSize), HdrChecksum) then
- AbortCompile('ReadSignatureAndChecksumFields failed');
- if SignatureAddress = 0 then begin
- { No signature found. Return False to inform the caller that the file
- needs to be signed, but first make sure it isn't somehow corrupted. }
- if (SignedFileSize = UnsignedFileSize) and
- CompareMem(UnsignedFile.Memory, SignedFile.Memory, UnsignedFileSize) then begin
- Result := False;
- Exit;
- end;
- AbortCompileFmt(MismatchMessage, [Filename]);
- end;
- if (SignedFileSize <= UnsignedFileSize) or
- (SignatureAddress <> UnsignedFileSize) or
- (SignatureSize <> SignedFileSize - UnsignedFileSize) or
- (SignatureSize >= Cardinal($100000)) then
- AbortCompile(SCompilerSignatureInvalid);
- { Sanity check: Remove the signature (in memory) and verify that
- the signed file is identical byte-for-byte to the original }
- TestFile := TMemoryFile.CreateFromMemory(SignedFile.Memory^, SignedFileSize);
- try
- { Carry checksum over from UnsignedFile to TestFile. We used to just
- zero it in TestFile, but that didn't work if the user modified
- Setup.e?? with a res-editing tool that sets a non-zero checksum. }
- if not ReadSignatureAndChecksumFields(UnsignedFile, DWORD(SignatureAddress),
- DWORD(SignatureSize), HdrChecksum) then
- AbortCompile('ReadSignatureAndChecksumFields failed (2)');
- if not UpdateSignatureAndChecksumFields(TestFile, 0, 0, HdrChecksum) then
- AbortCompile('UpdateSignatureAndChecksumFields failed');
- if not CompareMem(UnsignedFile.Memory, TestFile.Memory, UnsignedFileSize) then
- AbortCompileFmt(MismatchMessage, [Filename]);
- finally
- TestFile.Free;
- end;
- except
- SignedFile.Free;
- raise;
- end;
- { Replace UnsignedFile with the signed file }
- OldFile := UnsignedFile;
- UnsignedFile := SignedFile;
- OldFile.Free;
- Result := True;
- end;
- procedure SignSetupMemoryFile(var UnsignedFile: TMemoryFile; const EExt: String);
- var
- UnsignedFileSize: Cardinal;
- ModeID: Longint;
- Filename, TempFilename: String;
- F: TFile;
- begin
- UnsignedFileSize := UnsignedFile.CappedSize;
- UnsignedFile.Seek(SetupExeModeOffset);
- ModeID := SetupExeModeUninstaller;
- UnsignedFile.WriteBuffer(ModeID, SizeOf(ModeID));
- if SignTools.Count > 0 then begin
- Filename := SignedUninstallerDir + 'uninst' + EExt + '.tmp';
- F := TFile.Create(Filename, fdCreateAlways, faWrite, fsNone);
- try
- F.WriteBuffer(UnsignedFile.Memory^, UnsignedFileSize);
- finally
- F.Free;
- end;
- try
- Sign(Filename); { Has its own retry mechanism }
- if not InternalSignSetupMemoryFileWithRetries(Filename, UnsignedFile, UnsignedFileSize,
- SCompilerSignedFileContentsMismatch) then
- AbortCompile(SCompilerSignToolSucceededButNoSignature);
- finally
- DeleteFile(Filename);
- end;
- end else begin
- const Basename = Format('uninst-%s-%s', [SetupVersion,
- Copy(SHA256DigestToString(SHA256Buf(UnsignedFile.Memory^, UnsignedFileSize)), 1, 10)]);
- Filename := SignedUninstallerDir + Basename + EExt;
- if not NewFileExists(Filename) then begin
- { Create new signed uninstaller file }
- AddStatus(Format(SCompilerStatusSignedUninstallerNew, [Filename]));
- TempFilename := Filename + '.tmp';
- F := TFile.Create(TempFilename, fdCreateAlways, faWrite, fsNone);
- try
- F.WriteBuffer(UnsignedFile.Memory^, UnsignedFileSize);
- finally
- F.Free;
- end;
- try
- WithRetries(False, Filename,
- procedure
- begin
- if not MoveFile(PChar(TempFilename), PChar(Filename)) then
- TFile.RaiseError(GetLastError);
- end);
- except
- DeleteFile(TempFilename);
- raise;
- end;
- end
- else begin
- { Use existing signed uninstaller file }
- AddStatus(Format(SCompilerStatusSignedUninstallerExisting, [Filename]));
- end;
- if not InternalSignSetupMemoryFileWithRetries(Filename, UnsignedFile, UnsignedFileSize,
- SCompilerSignedFileContentsMismatchRetry) then
- AbortCompileFmt(SCompilerSignatureNeeded, [Filename]);
- end;
- end;
- procedure PrepareSetupMemoryFile(var M: TMemoryFile);
- var
- TempFilename, ConvertFilename: String;
- ConvertFile: TFile;
- begin
- if (SetupHeader.WizardDarkStyle <> wdsDynamic) and (WizardStyleFileDynamicDark <> '') then
- AbortCompileFmt(SCompilerCompressInternalError, ['Unexpected WizardStyleFileDynamicDark value']);
- TempFilename := '';
- try
- const EExt = '.e32';
- var EBasename, EFilename: String;
- var EPf: TPrecompiledFile;
- var EUisf: TUpdateIconsAndStyleFile;
- if (SetupHeader.WizardDarkStyle = wdsLight) and (WizardStyleFile = '') then begin
- EBasename := 'Setup' + EExt;
- EPf := pfSetup;
- EUisf := uisfSetup;
- end else begin
- EBasename := 'SetupCustomStyle' + EExt;
- EPf := pfSetupCustomStyle;
- EUisf := uisfSetupCustomStyle;
- end;
- EFilename := CompilerDir + EBasename;
- ConvertFilename := OutputDir + OutputBaseFilename + EExt + '.tmp';
- CopyFileOrAbortWithRetries(EFilename, ConvertFilename, not(EPf in DisablePrecompiledFileVerifications),
- [cftoTrustAllOnDebug], OnCheckedTrust);
- { If there was a read-only attribute, remove it }
- SetFileAttributes(PChar(ConvertFilename), FILE_ATTRIBUTE_ARCHIVE);
- TempFilename := ConvertFilename;
- if EUisf = uisfSetupCustomStyle then
- AddStatus(Format(SCompilerStatusUpdatingIconsAndVsf, [EBasename]))
- else
- AddStatus(Format(SCompilerStatusUpdatingIcons, [EBasename]));
- { OnUpdateIconsAndStyle will set proper LineNumber }
- WithRetries(False, ConvertFilename,
- procedure
- begin
- UpdateIconsAndStyle(ConvertFileName, EUisf, PrependSourceDirName(SetupIconFilename), SetupHeader.WizardDarkStyle,
- PrependSourceDirName(WizardStyleFile), PrependSourceDirName(WizardStyleFileDynamicDark), OnUpdateIconsAndStyle);
- end);
- LineNumber := 0;
- AddStatus(Format(SCompilerStatusUpdatingVersionInfo, [EBasename]));
- WithRetries(False, ConvertFilename,
- procedure
- begin
- ConvertFile := TFile.Create(ConvertFilename, fdOpenExisting, faReadWrite, fsNone);
- end);
- try
- UpdateVersionInfo(ConvertFile, TFileVersionNumbers(nil^), VersionInfoProductVersion, VersionInfoCompany,
- '', '', VersionInfoCopyright, VersionInfoProductName, VersionInfoProductTextVersion, VersionInfoOriginalFileName,
- False);
- finally
- ConvertFile.Free;
- end;
- var CapturableM: TMemoryFile;
- WithRetries(False, ConvertFilename,
- procedure
- begin
- CapturableM := TMemoryFile.Create(ConvertFilename);
- end);
- M := CapturableM;
- UpdateSetupPEHeaderFields(M, TerminalServicesAware, DEPCompatible, ASLRCompatible);
- if shSignedUninstaller in SetupHeader.Options then
- SignSetupMemoryFile(M, EExt);
- finally
- if TempFilename <> '' then
- DeleteFile(TempFilename);
- end;
- end;
- procedure CompressSetupMemoryFile(const M: TMemoryFile; const DestF: TFile;
- var UncompressedSize: LongWord; var CRC: Longint);
- { Note: This modifies the contents of M. }
- var
- Writer: TCompressedBlockWriter;
- begin
- AddStatus(SCompilerStatusCompressingSetupExe);
- UncompressedSize := M.CappedSize;
- CRC := GetCRC32(M.Memory^, UncompressedSize);
- TransformCallInstructions(M.Memory^, UncompressedSize, True, 0);
- Writer := TCompressedBlockWriter.Create(DestF, TLZMACompressor, InternalCompressLevel,
- InternalCompressProps);
- try
- Writer.Write(M.Memory^, UncompressedSize);
- Writer.Finish;
- finally
- Writer.Free;
- end;
- end;
- procedure AddDefaultSetupType(Name: String; Options: TSetupTypeOptions; Typ: TSetupTypeType);
- var
- NewTypeEntry: PSetupTypeEntry;
- begin
- NewTypeEntry := AllocMem(SizeOf(TSetupTypeEntry));
- NewTypeEntry.Name := Name;
- NewTypeEntry.Description := ''; //set at runtime
- NewTypeEntry.CheckOnce := '';
- NewTypeEntry.MinVersion := SetupHeader.MinVersion;
- NewTypeEntry.OnlyBelowVersion := SetupHeader.OnlyBelowVersion;
- NewTypeEntry.Options := Options;
- NewTypeEntry.Typ := Typ;
- TypeEntries.Add(NewTypeEntry);
- end;
- procedure MkDirs(Dir: string);
- begin
- Dir := RemoveBackslashUnlessRoot(Dir);
- if (PathExtractPath(Dir) = Dir) or DirExists(Dir) then
- Exit;
- MkDirs(PathExtractPath(Dir));
- MkDir(Dir);
- end;
- procedure CreateManifestFile;
- function FileTimeToString(const FileTime: TFileTime; const UTC: Boolean): String;
- var
- ST: TSystemTime;
- begin
- if not FileTime.HasTime then
- Result := '(not stored)'
- else if FileTimeToSystemTime(FileTime, ST) then
- Result := Format('%.4u-%.2u-%.2u %.2u:%.2u:%.2u.%.3u',
- [ST.wYear, ST.wMonth, ST.wDay, ST.wHour, ST.wMinute, ST.wSecond,
- ST.wMilliseconds])
- else
- Result := '(invalid)';
- if UTC then
- Result := Result + ' UTC';
- end;
- function SliceToString(const ASlice: Integer): String;
- begin
- Result := IntToStr(ASlice div SlicesPerDisk + 1);
- if SlicesPerDisk <> 1 then
- Result := Result + Chr(Ord('a') + ASlice mod SlicesPerDisk);
- end;
- const
- EncryptedStrings: array [Boolean] of String = ('no', 'yes');
- var
- F: TTextFileWriter;
- FL: PSetupFileLocationEntry;
- FLExtraInfo: PFileLocationEntryExtraInfo;
- S: String;
- I: Integer;
- begin
- F := TTextFileWriter.Create(PrependDirName(OutputManifestFile, OutputDir),
- fdCreateAlways, faWrite, fsRead);
- try
- S := 'Index' + #9 + 'SourceFilename' + #9 + 'TimeStamp' + #9 +
- 'Version' + #9 + 'SHA256Sum' + #9 + 'OriginalSize' + #9 +
- 'FirstSlice' + #9 + 'LastSlice' + #9 + 'StartOffset' + #9 +
- 'ChunkSuboffset' + #9 + 'ChunkCompressedSize' + #9 + 'Encrypted' + #9 +
- 'ISSigKeyID';
- F.WriteLine(S);
- for I := 0 to FileLocationEntries.Count-1 do begin
- FL := FileLocationEntries[I];
- FLExtraInfo := FileLocationEntryExtraInfos[I];
- S := IntToStr(I) + #9 + FileLocationEntryFilenames[I] + #9 +
- FileTimeToString(FL.TimeStamp, floTimeStampInUTC in FL.Flags) + #9;
- if floVersionInfoValid in FL.Flags then
- S := S + Format('%u.%u.%u.%u', [FL.FileVersionMS shr 16,
- FL.FileVersionMS and $FFFF, FL.FileVersionLS shr 16,
- FL.FileVersionLS and $FFFF]);
- S := S + #9 + SHA256DigestToString(FL.SHA256Sum) + #9 +
- IntToStr(FL.OriginalSize) + #9 +
- SliceToString(FL.FirstSlice) + #9 +
- SliceToString(FL.LastSlice) + #9 +
- IntToStr(FL.StartOffset) + #9 +
- IntToStr(FL.ChunkSuboffset) + #9 +
- IntToStr(FL.ChunkCompressedSize) + #9 +
- EncryptedStrings[floChunkEncrypted in FL.Flags] + #9 +
- FLExtraInfo.ISSigKeyUsedID;
- F.WriteLine(S);
- end;
- finally
- F.Free;
- end;
- end;
- procedure CallPreprocessorCleanupProc;
- var
- ResultCode: Integer;
- begin
- if Assigned(PreprocCleanupProc) then begin
- ResultCode := PreprocCleanupProc(PreprocCleanupProcData);
- if ResultCode <> 0 then
- AddStatusFmt(SCompilerStatusWarning +
- 'Preprocessor cleanup function failed with code %d.', [ResultCode], True);
- end;
- end;
- procedure UpdateTimeStamp(H: THandle);
- var
- FT: TFileTime;
- begin
- GetSystemTimeAsFileTime(FT);
- SetFileTime(H, nil, nil, @FT);
- end;
- const
- BadFilePathChars = '/*?"<>|';
- BadFileNameChars = BadFilePathChars + ':';
- var
- SetupMemoryFile: TMemoryFile;
- I: Integer;
- AppNameHasConsts, AppVersionHasConsts, AppPublisherHasConsts,
- AppCopyrightHasConsts, AppIdHasConsts, Uninstallable: Boolean;
- PrivilegesRequiredValue: String;
- GetActiveProcessorGroupCountFunc: function: WORD; stdcall;
- begin
- { Sanity check: A single TSetupCompiler instance cannot be used to do
- multiple compiles. A separate instance must be used for each compile,
- otherwise some settings (e.g. DefaultLangData, VersionInfo*) would be
- carried over from one compile to another. }
- if CompileWasAlreadyCalled then
- AbortCompile('Compile was already called');
- CompileWasAlreadyCalled := True;
- CompilerDir := AddBackslash(PathExpand(CompilerDir));
- InitPreprocessor;
- InitLZMADLL;
- WizardImages := nil;
- WizardSmallImages := nil;
- WizardBackImages := nil;
- WizardImagesDynamicDark := nil;
- WizardSmallImagesDynamicDark := nil;
- WizardBackImagesDynamicDark := nil;
- SetupMemoryFile := nil;
- DecompressorDLL := nil;
- SevenZipDLL := nil;
- try
- FillChar(SetupEncryptionHeader, SizeOf(SetupEncryptionHeader), 0);
- Finalize(SetupHeader);
- FillChar(SetupHeader, SizeOf(SetupHeader), 0);
- InitDebugInfo;
- PreprocIncludedFilenames.Clear;
- { Initialize defaults }
- OriginalSourceDir := AddBackslash(PathExpand(SourceDir));
- if not FixedOutput then
- Output := True;
- if not FixedOutputDir then
- OutputDir := 'Output';
- if not FixedOutputBaseFilename then
- OutputBaseFilename := 'mysetup';
- InternalCompressLevel := clLZMANormal;
- InternalCompressProps := TLZMACompressorProps.Create;
- CompressMethod := cmLZMA2;
- CompressLevel := clLZMAMax;
- CompressProps := TLZMACompressorProps.Create;
- GetActiveProcessorGroupCountFunc := GetProcAddress(GetModuleHandle(kernel32),
- 'GetActiveProcessorGroupCount');
- if Assigned(GetActiveProcessorGroupCountFunc) then begin
- const ActiveProcessorGroupCount = GetActiveProcessorGroupCountFunc;
- if ActiveProcessorGroupCount > 1 then
- CompressProps.NumThreadGroups := ActiveProcessorGroupCount;
- end;
- CompressProps.WorkerProcessCheckTrust := True;
- CompressProps.WorkerProcessOnCheckedTrust := OnCheckedTrust;
- UseSetupLdr := sl32bit;
- TerminalServicesAware := True;
- DEPCompatible := True;
- ASLRCompatible := True;
- DiskSliceSize := 2100000000;
- DiskClusterSize := 512;
- SlicesPerDisk := 1;
- ReserveBytes := 0;
- TimeStampRounding := 2;
- SetupEncryptionHeader.EncryptionUse := euNone;
- SetupEncryptionHeader.KDFIterations := DefaultKDFIterations;
- SetupHeader.MinVersion.WinVersion := 0;
- SetupHeader.MinVersion.NTVersion := $06010000;
- SetupHeader.MinVersion.NTServicePack := $100;
- SetupHeader.Options := [shDisableStartupPrompt, shCreateAppDir,
- shAlwaysShowComponentsList, shFlatComponentsList,
- shShowComponentSizes, shUpdateUninstallLogAppName,
- shAllowUNCPath, shRestartIfNeededByRun,
- shAllowCancelDuringInstall, shWizardImageStretch, shAppendDefaultDirName,
- shAppendDefaultGroupName, shUsePreviousLanguage, shCloseApplications,
- shRestartApplications, shAllowNetworkDrive, shDisableWelcomePage,
- shUsePreviousPrivileges, shWizardKeepAspectRatio, shRedirectionGuard];
- SetupHeader.PrivilegesRequired := prAdmin;
- SetupHeader.UninstallFilesDir := '{app}';
- SetupHeader.DefaultUserInfoName := '{sysuserinfoname}';
- SetupHeader.DefaultUserInfoOrg := '{sysuserinfoorg}';
- SetupHeader.DisableDirPage := dpAuto;
- SetupHeader.DisableProgramGroupPage := dpAuto;
- SetupHeader.CreateUninstallRegKey := 'yes';
- SetupHeader.Uninstallable := 'yes';
- SetupHeader.UsePreviousAppDir := 'yes';
- SetupHeader.UsePreviousGroup := 'yes';
- SetupHeader.UsePreviousSetupType := 'yes';
- SetupHeader.UsePreviousTasks := 'yes';
- SetupHeader.UsePreviousUserInfo := 'yes';
- SetupHeader.ChangesEnvironment := 'no';
- SetupHeader.ChangesAssociations := 'no';
- DefaultDialogFontName := 'Segoe UI';
- SignToolRetryCount := 2;
- SignToolRetryDelay := 500;
- SetupHeader.CloseApplicationsFilter := '*.exe,*.dll,*.chm';
- SetupHeader.WizardImageAlphaFormat := afIgnored;
- MissingRunOnceIdsWarning := True;
- MissingMessagesWarning := True;
- NotRecognizedMessagesWarning := True;
- UsedUserAreasWarning := True;
- SetupHeader.WizardDarkStyle := wdsLight;
- SetupHeader.WizardSizePercentX := 120;
- SetupHeader.WizardSizePercentY := SetupHeader.WizardSizePercentX;
- SetupHeader.WizardImageOpacity := 255;
- SetupHeader.WizardBackColor := clNone;
- SetupHeader.WizardBackColorDynamicDark := clNone;
- SetupHeader.WizardBackImageOpacity := 255;
- SetupHeader.WizardLightControlStyling := wcsAll;
- { Read [Setup] section }
- EnumIniSection(EnumSetupProc, 'Setup', 0, True, True, '', False, False);
- CallIdleProc;
- { Verify settings set in [Setup] section }
- if SetupDirectiveLines[ssAppName] = 0 then
- AbortCompileFmt(SCompilerEntryMissing2, ['Setup', 'AppName']);
- if (SetupHeader.AppVerName = '') and (SetupHeader.AppVersion = '') then
- AbortCompile(SCompilerAppVersionOrAppVerNameRequired);
- LineNumber := SetupDirectiveLines[ssAppName];
- AppNameHasConsts := CheckConst(SetupHeader.AppName, SetupHeader.MinVersion, []);
- if AppNameHasConsts then begin
- Include(SetupHeader.Options, shAppNameHasConsts);
- if not(shDisableStartupPrompt in SetupHeader.Options) then begin
- { AppName has constants so DisableStartupPrompt must be used }
- LineNumber := SetupDirectiveLines[ssDisableStartupPrompt];
- AbortCompile(SCompilerMustUseDisableStartupPrompt);
- end;
- end;
- if SetupHeader.AppId = '' then
- SetupHeader.AppId := SetupHeader.AppName
- else
- LineNumber := SetupDirectiveLines[ssAppId];
- AppIdHasConsts := CheckConst(SetupHeader.AppId, SetupHeader.MinVersion, []);
- if AppIdHasConsts and (shUsePreviousLanguage in SetupHeader.Options) then begin
- { AppId has constants so UsePreviousLanguage must not be used }
- LineNumber := SetupDirectiveLines[ssUsePreviousLanguage];
- AbortCompile(SCompilerMustNotUsePreviousLanguage);
- end;
- if AppIdHasConsts and (proDialog in SetupHeader.PrivilegesRequiredOverridesAllowed) and (shUsePreviousPrivileges in SetupHeader.Options) then begin
- { AppId has constants so UsePreviousPrivileges must not be used }
- LineNumber := SetupDirectiveLines[ssUsePreviousPrivileges];
- AbortCompile(SCompilerMustNotUsePreviousPrivileges);
- end;
- LineNumber := SetupDirectiveLines[ssAppVerName];
- CheckConst(SetupHeader.AppVerName, SetupHeader.MinVersion, []);
- LineNumber := SetupDirectiveLines[ssAppComments];
- CheckConst(SetupHeader.AppComments, SetupHeader.MinVersion, []);
- LineNumber := SetupDirectiveLines[ssAppContact];
- CheckConst(SetupHeader.AppContact, SetupHeader.MinVersion, []);
- LineNumber := SetupDirectiveLines[ssAppCopyright];
- AppCopyrightHasConsts := CheckConst(SetupHeader.AppCopyright, SetupHeader.MinVersion, []);
- LineNumber := SetupDirectiveLines[ssAppModifyPath];
- CheckConst(SetupHeader.AppModifyPath, SetupHeader.MinVersion, []);
- LineNumber := SetupDirectiveLines[ssAppPublisher];
- AppPublisherHasConsts := CheckConst(SetupHeader.AppPublisher, SetupHeader.MinVersion, []);
- LineNumber := SetupDirectiveLines[ssAppPublisherURL];
- CheckConst(SetupHeader.AppPublisherURL, SetupHeader.MinVersion, []);
- LineNumber := SetupDirectiveLines[ssAppReadmeFile];
- CheckConst(SetupHeader.AppReadmeFile, SetupHeader.MinVersion, []);
- LineNumber := SetupDirectiveLines[ssAppSupportPhone];
- CheckConst(SetupHeader.AppSupportPhone, SetupHeader.MinVersion, []);
- LineNumber := SetupDirectiveLines[ssAppSupportURL];
- CheckConst(SetupHeader.AppSupportURL, SetupHeader.MinVersion, []);
- LineNumber := SetupDirectiveLines[ssAppUpdatesURL];
- CheckConst(SetupHeader.AppUpdatesURL, SetupHeader.MinVersion, []);
- LineNumber := SetupDirectiveLines[ssAppVersion];
- AppVersionHasConsts := CheckConst(SetupHeader.AppVersion, SetupHeader.MinVersion, []);
- LineNumber := SetupDirectiveLines[ssAppMutex];
- CheckConst(SetupHeader.AppMutex, SetupHeader.MinVersion, []);
- LineNumber := SetupDirectiveLines[ssSetupMutex];
- CheckConst(SetupHeader.SetupMutex, SetupHeader.MinVersion, []);
- LineNumber := SetupDirectiveLines[ssDefaultDirName];
- CheckConst(SetupHeader.DefaultDirName, SetupHeader.MinVersion, []);
- if SetupHeader.DefaultDirName = '' then begin
- if shCreateAppDir in SetupHeader.Options then
- AbortCompileFmt(SCompilerEntryMissing2, ['Setup', 'DefaultDirName'])
- else
- SetupHeader.DefaultDirName := '?ERROR?';
- end;
- LineNumber := SetupDirectiveLines[ssDefaultGroupName];
- CheckConst(SetupHeader.DefaultGroupName, SetupHeader.MinVersion, []);
- if SetupHeader.DefaultGroupName = '' then
- SetupHeader.DefaultGroupName := '(Default)';
- LineNumber := SetupDirectiveLines[ssUninstallDisplayName];
- CheckConst(SetupHeader.UninstallDisplayName, SetupHeader.MinVersion, []);
- LineNumber := SetupDirectiveLines[ssUninstallDisplayIcon];
- CheckConst(SetupHeader.UninstallDisplayIcon, SetupHeader.MinVersion, []);
- LineNumber := SetupDirectiveLines[ssUninstallFilesDir];
- CheckConst(SetupHeader.UninstallFilesDir, SetupHeader.MinVersion, []);
- LineNumber := SetupDirectiveLines[ssDefaultUserInfoName];
- CheckConst(SetupHeader.DefaultUserInfoName, SetupHeader.MinVersion, []);
- LineNumber := SetupDirectiveLines[ssDefaultUserInfoOrg];
- CheckConst(SetupHeader.DefaultUserInfoOrg, SetupHeader.MinVersion, []);
- LineNumber := SetupDirectiveLines[ssDefaultUserInfoSerial];
- CheckConst(SetupHeader.DefaultUserInfoSerial, SetupHeader.MinVersion, []);
- if not DiskSpanning then begin
- DiskSliceSize := 4200000000; { Windows cannot run .exe's of 4 GB or more }
- DiskClusterSize := 1;
- SlicesPerDisk := 1;
- ReserveBytes := 0;
- end;
- SetupHeader.SlicesPerDisk := SlicesPerDisk;
- if SetupDirectiveLines[ssVersionInfoDescription] = 0 then begin
- { Use AppName as VersionInfoDescription if possible. If not possible,
- warn about this since AppName is a required directive }
- if not AppNameHasConsts then
- VersionInfoDescription := UnescapeBraces(SetupHeader.AppName) + ' Setup'
- else
- WarningsList.Add(Format(SCompilerDirectiveNotUsingDefault,
- ['VersionInfoDescription', 'AppName']));
- end;
- if SetupDirectiveLines[ssVersionInfoCompany] = 0 then begin
- { Use AppPublisher as VersionInfoCompany if possible, otherwise warn }
- if not AppPublisherHasConsts then
- VersionInfoCompany := UnescapeBraces(SetupHeader.AppPublisher)
- else
- WarningsList.Add(Format(SCompilerDirectiveNotUsingDefault,
- ['VersionInfoCompany', 'AppPublisher']));
- end;
- if SetupDirectiveLines[ssVersionInfoCopyright] = 0 then begin
- { Use AppCopyright as VersionInfoCopyright if possible, otherwise warn }
- if not AppCopyrightHasConsts then
- VersionInfoCopyright := UnescapeBraces(SetupHeader.AppCopyright)
- else
- WarningsList.Add(Format(SCompilerDirectiveNotUsingDefault,
- ['VersionInfoCopyright', 'AppCopyright']));
- end;
- if SetupDirectiveLines[ssVersionInfoTextVersion] = 0 then
- VersionInfoTextVersion := VersionInfoVersionOriginalValue;
- if SetupDirectiveLines[ssVersionInfoProductName] = 0 then begin
- { Use AppName as VersionInfoProductName if possible, otherwise warn }
- if not AppNameHasConsts then
- VersionInfoProductName := UnescapeBraces(SetupHeader.AppName)
- else
- WarningsList.Add(Format(SCompilerDirectiveNotUsingDefault,
- ['VersionInfoProductName', 'AppName']));
- end;
- if VersionInfoProductVersionOriginalValue = '' then
- VersionInfoProductVersion := VersionInfoVersion;
- if SetupDirectiveLines[ssVersionInfoProductTextVersion] = 0 then begin
- { Note: This depends on the initialization of VersionInfoTextVersion above }
- if VersionInfoProductVersionOriginalValue = '' then begin
- VersionInfoProductTextVersion := VersionInfoTextVersion;
- if SetupHeader.AppVersion <> '' then begin
- if not AppVersionHasConsts then
- VersionInfoProductTextVersion := UnescapeBraces(SetupHeader.AppVersion)
- else
- WarningsList.Add(Format(SCompilerDirectiveNotUsingPreferredDefault,
- ['VersionInfoProductTextVersion', 'VersionInfoTextVersion', 'AppVersion']));
- end;
- end
- else
- VersionInfoProductTextVersion := VersionInfoProductVersionOriginalValue;
- end;
- if (SetupEncryptionHeader.EncryptionUse <> euNone) and (Password = '') then begin
- LineNumber := SetupDirectiveLines[ssEncryption];
- AbortCompileFmt(SCompilerEntryMissing2, ['Setup', 'Password']);
- end;
- if (SetupDirectiveLines[ssSignedUninstaller] = 0) and (SignTools.Count > 0) then
- Include(SetupHeader.Options, shSignedUninstaller);
- if (UseSetupLdr = slNone) and
- ((SignTools.Count > 0) or (shSignedUninstaller in SetupHeader.Options)) then
- AbortCompile(SCompilerNoSetupLdrSignError);
- LineNumber := SetupDirectiveLines[ssCreateUninstallRegKey];
- CheckCheckOrInstall('CreateUninstallRegKey', SetupHeader.CreateUninstallRegKey, cikDirectiveCheck);
- LineNumber := SetupDirectiveLines[ssUninstallable];
- CheckCheckOrInstall('Uninstallable', SetupHeader.Uninstallable, cikDirectiveCheck);
- LineNumber := SetupDirectiveLines[ssUsePreviousAppDir];
- CheckCheckOrInstall('UsePreviousAppDir', SetupHeader.UsePreviousAppDir, cikDirectiveCheck);
- LineNumber := SetupDirectiveLines[ssUsePreviousGroup];
- CheckCheckOrInstall('UsePreviousGroup', SetupHeader.UsePreviousGroup, cikDirectiveCheck);
- LineNumber := SetupDirectiveLines[ssUsePreviousSetupType];
- CheckCheckOrInstall('UsePreviousSetupType', SetupHeader.UsePreviousSetupType, cikDirectiveCheck);
- LineNumber := SetupDirectiveLines[ssUsePreviousTasks];
- CheckCheckOrInstall('UsePreviousTasks', SetupHeader.UsePreviousTasks, cikDirectiveCheck);
- LineNumber := SetupDirectiveLines[ssUsePreviousUserInfo];
- CheckCheckOrInstall('UsePreviousUserInfo', SetupHeader.UsePreviousUserInfo, cikDirectiveCheck);
- LineNumber := SetupDirectiveLines[ssChangesEnvironment];
- CheckCheckOrInstall('ChangesEnvironment', SetupHeader.ChangesEnvironment, cikDirectiveCheck);
- LineNumber := SetupDirectiveLines[ssChangesAssociations];
- CheckCheckOrInstall('ChangesAssociations', SetupHeader.ChangesAssociations, cikDirectiveCheck);
- if Output and (OutputDir = '') then begin
- LineNumber := SetupDirectiveLines[ssOutput];
- AbortCompileFmt(SCompilerEntryInvalid2, ['Setup', 'OutputDir']);
- end;
- if (Output and (OutputBaseFileName = '')) or (PathLastDelimiter(BadFileNameChars + '\', OutputBaseFileName) <> 0) then begin
- LineNumber := SetupDirectiveLines[ssOutputBaseFileName];
- AbortCompileFmt(SCompilerEntryInvalid2, ['Setup', 'OutputBaseFileName']);
- end else if OutputBaseFileName = 'setup' then { Warn even if Output is False }
- WarningsList.Add(SCompilerOutputBaseFileNameSetup);
- if (SetupDirectiveLines[ssOutputManifestFile] <> 0) and
- ((Output and (OutputManifestFile = '')) or (PathLastDelimiter(BadFilePathChars, OutputManifestFile) <> 0)) then begin
- LineNumber := SetupDirectiveLines[ssOutputManifestFile];
- AbortCompileFmt(SCompilerEntryInvalid2, ['Setup', 'OutputManifestFile']);
- end;
- if shAlwaysUsePersonalGroup in SetupHeader.Options then
- UsedUserAreas.Add('AlwaysUsePersonalGroup');
- if WizardBackImageFile <> '' then begin
- if SetupDirectiveLines[ssWizardBackColor] = 0 then
- SetupHeader.WizardBackColor := clWindow
- else if SetupHeader.WizardBackColor = clNone then begin
- LineNumber := SetupDirectiveLines[ssWizardBackColor];
- AbortCompileFmt(SCompilerEntryInvalid2, ['Setup', 'WizardBackColor']);
- end;
- end else if SetupHeader.WizardBackColor = clWindow then
- SetupHeader.WizardBackColor := clNone;
- if WizardBackImageFileDynamicDark <> '' then begin
- if SetupDirectiveLines[ssWizardBackColorDynamicDark] = 0 then
- SetupHeader.WizardBackColorDynamicDark := clWindow
- else if SetupHeader.WizardBackColorDynamicDark = clNone then begin
- LineNumber := SetupDirectiveLines[ssWizardBackColorDynamicDark];
- AbortCompileFmt(SCompilerEntryInvalid2, ['Setup', 'WizardBackColorDynamicDark']);
- end;
- end else if SetupHeader.WizardBackColorDynamicDark = clWindow then
- SetupHeader.WizardBackColorDynamicDark := clNone;
- if (SetupHeader.WizardBackColor <> clNone) or (SetupHeader.WizardBackColorDynamicDark <> clNone) then begin
- if (WizardStyleSpecial = '') and (WizardStyleFile = '') then begin
- WizardStyleSpecial := 'windows11';
- SetupHeader.WizardLightControlStyling := wcsOnlyRequired; { 'excludelightcontrols' }
- if SetupDirectiveLines[ssWizardBackImageFile] <> 0 then
- Include(SetupHeader.Options, shWizardBevelsHidden); { 'hidebevels' }
- end;
- end;
- if WizardStyleSpecial <> '' then begin
- const BuiltinStyleFile = 'builtin:' + WizardStyleSpecial;
- if WizardStyleFile = '' then
- WizardStyleFile := BuiltinStyleFile;
- if WizardStyleFileDynamicDark = '' then
- WizardStyleFileDynamicDark := BuiltinStyleFile; { Might be cleared again below }
- end;
- if (WizardStyleFileDynamicDark <> '') and (SetupHeader.WizardDarkStyle <> wdsDynamic) then
- WizardStyleFileDynamicDark := ''; { Avoid unnecessary size increase - also checked for by PrepareSetupMemoryFile }
- if (SetupHeader.MinVersion.NTVersion shr 16 = $0601) and (SetupHeader.MinVersion.NTServicePack < $100) then
- WarningsList.Add(Format(SCompilerMinVersionRecommendation, ['6.1', '6.1sp1']));
- LineNumber := 0;
- SourceDir := AddBackslash(PathExpand(SourceDir));
- if not FixedOutputDir then
- OutputDir := PrependSourceDirName(OutputDir);
- OutputDir := RemoveBackslashUnlessRoot(PathExpand(OutputDir));
- LineNumber := SetupDirectiveLines[ssOutputDir];
- if not DirExists(OutputDir) then begin
- AddStatus(Format(SCompilerStatusCreatingOutputDir, [OutputDir]));
- MkDirs(OutputDir);
- end;
- LineNumber := 0;
- OutputDir := AddBackslash(OutputDir);
- if SignedUninstallerDir = '' then
- SignedUninstallerDir := OutputDir
- else begin
- SignedUninstallerDir := RemoveBackslashUnlessRoot(PathExpand(PrependSourceDirName(SignedUninstallerDir)));
- if not DirExists(SignedUninstallerDir) then begin
- AddStatus(Format(SCompilerStatusCreatingSignedUninstallerDir, [SignedUninstallerDir]));
- MkDirs(SignedUninstallerDir);
- end;
- SignedUninstallerDir := AddBackslash(SignedUninstallerDir);
- end;
- if Password <> '' then begin
- TStrongRandom.GenerateBytes(SetupEncryptionHeader.KDFSalt, SizeOf(SetupEncryptionHeader.KDFSalt));
- TStrongRandom.GenerateBytes(SetupEncryptionHeader.BaseNonce, SizeOf(SetupEncryptionHeader.BaseNonce));
- GenerateEncryptionKey(Password, SetupEncryptionHeader.KDFSalt, SetupEncryptionHeader.KDFIterations, CryptKey);
- GeneratePasswordTest(CryptKey, SetupEncryptionHeader.BaseNonce, SetupEncryptionHeader.PasswordTest);
- Include(SetupHeader.Options, shPassword);
- end;
- { Read text files }
- if LicenseFile <> '' then begin
- LineNumber := SetupDirectiveLines[ssLicenseFile];
- AddStatus(Format(SCompilerStatusReadingFile, ['LicenseFile']));
- ReadTextFile(PrependSourceDirName(LicenseFile), -1, LicenseText);
- end;
- if InfoBeforeFile <> '' then begin
- LineNumber := SetupDirectiveLines[ssInfoBeforeFile];
- AddStatus(Format(SCompilerStatusReadingFile, ['InfoBeforeFile']));
- ReadTextFile(PrependSourceDirName(InfoBeforeFile), -1, InfoBeforeText);
- end;
- if InfoAfterFile <> '' then begin
- LineNumber := SetupDirectiveLines[ssInfoAfterFile];
- AddStatus(Format(SCompilerStatusReadingFile, ['InfoAfterFile']));
- ReadTextFile(PrependSourceDirName(InfoAfterFile), -1, InfoAfterText);
- end;
- LineNumber := 0;
- CallIdleProc;
- { Read main wizard images }
- const IsForcedDark = SetupHeader.WizardDarkStyle = wdsDark;
- LineNumber := SetupDirectiveLines[ssWizardImageFile];
- AddStatus(Format(SCompilerStatusReadingFile, ['WizardImageFile']));
- if WizardImageFile <> '' then begin
- if SameText(WizardImageFile, 'compiler:WizModernImage.bmp') then begin
- WarningsList.Add(Format(SCompilerWizImageRenamed, [WizardImageFile, 'compiler:WizClassicImage.bmp']));
- WizardImageFile := 'compiler:WizClassicImage.bmp';
- end;
- WizardImages := CreateWizardImagesFromFiles('WizardImageFile', WizardImageFile);
- if SetupDirectiveLines[ssWizardImageBackColor] = 0 then
- SetupHeader.WizardImageBackColor := clWindow;
- end else if SetupDirectiveLines[ssWizardImageFile] = 0 then begin
- WizardImages := CreateWizardImagesFromResources(['WizardImage'], ['150'], IsForcedDark);
- if SetupDirectiveLines[ssWizardImageBackColor] = 0 then begin
- { The following colors were determined by using the ColorBlendRGB function to blend from the
- style's default button face color to its window color, with Mu set to 0.5. The exception is
- the $f9f3e8 which predates styles and is also used when styles are not active. }
- if WizardStyleSpecial = 'slate' then
- SetupHeader.WizardImageBackColor := $e2d2bc
- else if WizardStyleSpecial = 'zircon' then
- SetupHeader.WizardImageBackColor := $eeead0
- else
- SetupHeader.WizardImageBackColor := IfThen(IsForcedDark, $3f3a2e, $f9f3e8); { Also see below }
- end;
- end else if SetupDirectiveLines[ssWizardImageBackColor] = 0 then
- SetupHeader.WizardImageBackColor := clNone;
- if (SetupDirectiveLines[ssWizardImageBackColor] = 0) and (SetupDirectiveLines[ssWizardBackImageFile] <> 0) then
- SetupHeader.WizardImageBackColor := clNone;
- LineNumber := SetupDirectiveLines[ssWizardSmallImageFile];
- AddStatus(Format(SCompilerStatusReadingFile, ['WizardSmallImageFile']));
- if WizardSmallImageFile <> '' then begin
- if SameText(WizardSmallImageFile, 'compiler:WizModernSmallImage.bmp') then begin
- WarningsList.Add(Format(SCompilerWizImageRenamed, [WizardSmallImageFile, 'compiler:WizClassicSmallImage.bmp']));
- WizardSmallImageFile := 'compiler:WizClassicSmallImage.bmp';
- end;
- WizardSmallImages := CreateWizardImagesFromFiles('WizardSmallImageFile', WizardSmallImageFile);
- if SetupDirectiveLines[ssWizardSmallImageBackColor] = 0 then
- SetupHeader.WizardSmallImageBackColor := clWindow;
- end else if SetupDirectiveLines[ssWizardSmallImageFile] = 0 then begin
- WizardSmallImages := CreateWizardImagesFromResources(['WizardSmallImage'], ['250'], IsForcedDark);
- if SetupDirectiveLines[ssWizardSmallImageBackColor] = 0 then
- SetupHeader.WizardSmallImageBackColor := clNone;
- end else if SetupDirectiveLines[ssWizardSmallImageBackColor] = 0 then
- SetupHeader.WizardSmallImageBackColor := clNone;
- if (SetupDirectiveLines[ssWizardSmallImageBackColor] = 0) and (SetupDirectiveLines[ssWizardBackImageFile] <> 0) then
- SetupHeader.WizardSmallImageBackColor := clNone;
- LineNumber := SetupDirectiveLines[ssWizardBackImageFile];
- if LineNumber <> 0 then begin
- AddStatus(Format(SCompilerStatusReadingFile, ['WizardBackImageFile']));
- WizardBackImages := CreateWizardImagesFromFiles('WizardBackImageFile', WizardBackImageFile);
- end;
- LineNumber := 0;
- { Read dark dynamic wizard images }
- if SetupHeader.WizardDarkStyle = wdsDynamic then begin
- LineNumber := SetupDirectiveLines[ssWizardImageFileDynamicDark];
- AddStatus(Format(SCompilerStatusReadingFile, ['WizardImageFileDynamicDark']));
- if WizardImageFileDynamicDark <> '' then begin
- WizardImagesDynamicDark := CreateWizardImagesFromFiles('WizardImageFileDynamicDark', WizardImageFileDynamicDark);
- if SetupDirectiveLines[ssWizardImageBackColorDynamicDark] = 0 then
- SetupHeader.WizardImageBackColorDynamicDark := clWindow;
- end else if SetupDirectiveLines[ssWizardImageFileDynamicDark] = 0 then begin
- WizardImagesDynamicDark := CreateWizardImagesFromResources(['WizardImage'], ['150'], True);
- if SetupDirectiveLines[ssWizardImageBackColorDynamicDark] = 0 then
- SetupHeader.WizardImageBackColorDynamicDark := $3f3a2e; { See above }
- end else if SetupDirectiveLines[ssWizardImageBackColorDynamicDark] = 0 then
- SetupHeader.WizardImageBackColorDynamicDark := clNone;
- if (SetupDirectiveLines[ssWizardImageBackColorDynamicDark] = 0) and (SetupDirectiveLines[ssWizardBackImageFileDynamicDark] <> 0) then
- SetupHeader.WizardImageBackColorDynamicDark := clNone;
- LineNumber := SetupDirectiveLines[ssWizardSmallImageFileDynamicDark];
- AddStatus(Format(SCompilerStatusReadingFile, ['WizardSmallImageFileDynamicDark']));
- if WizardSmallImageFileDynamicDark <> '' then begin
- WizardSmallImagesDynamicDark := CreateWizardImagesFromFiles('WizardSmallImageFileDynamicDark', WizardSmallImageFileDynamicDark);
- if SetupDirectiveLines[ssWizardSmallImageBackColorDynamicDark] = 0 then
- SetupHeader.WizardSmallImageBackColorDynamicDark := clWindow;
- end else if SetupDirectiveLines[ssWizardSmallImageFileDynamicDark] = 0 then begin
- WizardSmallImagesDynamicDark := CreateWizardImagesFromResources(['WizardSmallImage'], ['250'], True);
- if SetupDirectiveLines[ssWizardSmallImageBackColorDynamicDark] = 0 then
- SetupHeader.WizardSmallImageBackColorDynamicDark := clNone;
- end else if SetupDirectiveLines[ssWizardSmallImageBackColorDynamicDark] = 0 then
- SetupHeader.WizardSmallImageBackColorDynamicDark := clNone;
- if (SetupDirectiveLines[ssWizardSmallImageBackColorDynamicDark] = 0) and (SetupDirectiveLines[ssWizardBackImageFileDynamicDark] <> 0) then
- SetupHeader.WizardSmallImageBackColorDynamicDark := clNone;
- LineNumber := SetupDirectiveLines[ssWizardBackImageFileDynamicDark];
- if LineNumber <> 0 then begin
- AddStatus(Format(SCompilerStatusReadingFile, ['WizardBackImageFileDynamicDark']));
- WizardBackImagesDynamicDark := CreateWizardImagesFromFiles('WizardBackImageFileDynamicDark', WizardBackImageFileDynamicDark);
- end;
- LineNumber := 0;
- end;
- { Prepare Setup executable & signed uninstaller data }
- if Output then begin
- AddStatus(SCompilerStatusPreparingSetupExe);
- PrepareSetupMemoryFile(SetupMemoryFile);
- end else
- AddStatus(SCompilerStatusSkippingPreparingSetupExe);
- { Read languages:
- 0. Determine final code pages:
- Unicode Setup uses Unicode text and does not depend on the system code page. To
- provide Setup with Unicode text without requiring Unicode .isl files (but still
- supporting Unicode .iss, license and info files), the compiler converts the .isl
- files to Unicode during compilation. It also does this if it finds ANSI plain text
- license and info files. To be able to do this it needs to know the language's code
- page but as seen above it can't simply take this from the current .isl. And license
- and info files do not even have a language code page setting.
- This means the Unicode compiler has to do an extra phase: following the logic above
- it first determines the final language code page for each language, storing these
- into an extra list called PreDataList, and then it continues as normal while using
- the final language code page for any conversions needed.
- Note: it must avoid caching the .isl files while determining the code pages, since
- the conversion is done *before* the caching.
- 1. Read Default.isl messages:
- ReadDefaultMessages calls EnumMessages for Default.isl's [Messages], with Ext set to -2.
- These messages are stored in DefaultLangData to be used as defaults for missing messages
- later on. EnumLangOptions isn't called, the defaults will (at run-time) be displayed
- using the code page of the language with the missing messages. EnumMessages for
- Default.isl's [CustomMessages] also isn't called at this point, missing custom messages
- are handled differently.
- 2. Read [Languages] section and the .isl files the entries reference:
- EnumLanguages is called for the script. For each [Languages] entry its parameters
- are read and for the MessagesFiles parameter ReadMessagesFromFiles is called. For
- each file ReadMessagesFromFiles first calls EnumLangOptions, then EnumMessages for
- [Messages], and finally another EnumMessages for [CustomMessages], all with Ext set
- to the index of the language.
- All the [LangOptions] and [Messages] data is stored in single structures per language,
- namely LanguageEntries[Ext] (langoptions) and LangDataList[Ext] (messages), any 'double'
- directives or messages overwrite each other. This means if that for example the first
- messages file does not specify a code page, but the second does, the language will
- automatically use the code page of the second file. And vice versa.
- The [CustomMessages] data is stored in a single list for all languages, with each
- entry having a LangIndex property saying to which language it belongs. If a 'double'
- custom message is found, the existing one is removed from the list.
- 3. Read [LangOptions] & [Messages] & [CustomMessages] in the script:
- ReadMessagesFromScript is called and this will first call CreateDefaultLanguageEntry
- if no languages have been defined. CreateDefaultLanguageEntry first creates a language
- with all settings set to the default, and then it calles ReadMessagesFromFiles for
- Default.isl for this language. ReadMessagesFromFiles works as described above.
- Note this is just like the script creator creating an entry for Default.isl.
- ReadMessagesFromScript then first calls EnumLangOptions, then EnumMessages for
- [Messages], and finally another EnumMessages for [CustomMessages] for the script.
- Note this is just like ReadMessagesFromFiles does for files, except that Ext is set
- to -1. This causes it to accept language identifiers ('en.LanguageCodePage=...'):
- if the identifier is set the read data is stored only for that language in the
- structures described above. If the identifier is not set, the read data is stored
- for all languages either by writing to all structures (langoptions/messages) or by
- adding an entry with LangIndex set to -1 (custommessages). This for example means
- all language code pages read so far could be overwritten from the script.
- ReadMessagesFromScript then checks for any missing messages and uses the messages
- read in the very beginning to provide defaults.
- After ReadMessagesFromScript returns, the read messages stored in the LangDataList
- entries are streamed into the LanguageEntry.Data fields by PopulateLanguageEntryData.
- 4. Check 'language completeness' of custom message constants:
- CheckCustomMessageDefinitions is used to check for missing custom messages and
- where necessary it 'promotes' a custom message by resetting its LangIndex property
- to -1. }
- { 0. Determine final language code pages }
- AddStatus(SCompilerStatusDeterminingCodePages);
- { 0.1. Read [Languages] section and [LangOptions] in the .isl files the
- entries reference }
- EnumIniSection(EnumLanguagesPreProc, 'Languages', 0, True, True, '', False, True);
- CallIdleProc;
- { 0.2. Read [LangOptions] in the script }
- ReadMessagesFromScriptPre;
- { 1. Read Default.isl messages }
- AddStatus(SCompilerStatusReadingDefaultMessages);
- ReadDefaultMessages;
- { 2. Read [Languages] section and the .isl files the entries reference }
- EnumIniSection(EnumLanguagesProc, 'Languages', 0, True, True, '', False, False);
- CallIdleProc;
- { 3. Read [LangOptions] & [Messages] & [CustomMessages] in the script }
- AddStatus(SCompilerStatusParsingMessages);
- ReadMessagesFromScript;
- PopulateLanguageEntryData;
- { 4. Check 'language completeness' of custom message constants }
- CheckCustomMessageDefinitions;
- { Read (but not compile) [Code] section }
- ReadCode;
- { Read [Types] section }
- EnumIniSection(EnumTypesProc, 'Types', 0, True, True, '', False, False);
- CallIdleProc;
- { Read [Components] section }
- EnumIniSection(EnumComponentsProc, 'Components', 0, True, True, '', False, False);
- CallIdleProc;
- { Read [Tasks] section }
- EnumIniSection(EnumTasksProc, 'Tasks', 0, True, True, '', False, False);
- CallIdleProc;
- { Read [Dirs] section }
- EnumIniSection(EnumDirsProc, 'Dirs', 0, True, True, '', False, False);
- CallIdleProc;
- { Read [Icons] section }
- EnumIniSection(EnumIconsProc, 'Icons', 0, True, True, '', False, False);
- CallIdleProc;
- { Read [INI] section }
- EnumIniSection(EnumINIProc, 'INI', 0, True, True, '', False, False);
- CallIdleProc;
- { Read [Registry] section }
- EnumIniSection(EnumRegistryProc, 'Registry', 0, True, True, '', False, False);
- CallIdleProc;
- { Read [InstallDelete] section }
- EnumIniSection(EnumDeleteProc, 'InstallDelete', 0, True, True, '', False, False);
- CallIdleProc;
- { Read [UninstallDelete] section }
- EnumIniSection(EnumDeleteProc, 'UninstallDelete', 1, True, True, '', False, False);
- CallIdleProc;
- { Read [Run] section }
- EnumIniSection(EnumRunProc, 'Run', 0, True, True, '', False, False);
- CallIdleProc;
- { Read [UninstallRun] section }
- EnumIniSection(EnumRunProc, 'UninstallRun', 1, True, True, '', False, False);
- CallIdleProc;
- if MissingRunOnceIdsWarning and MissingRunOnceIds then
- WarningsList.Add(Format(SCompilerMissingRunOnceIdsWarning, ['UninstallRun', 'RunOnceId']));
- { Read [ISSigKeys] section - must be done before reading [Files] section }
- EnumIniSection(EnumISSigKeysProc, 'ISSigKeys', 0, True, True, '', False, False);
- CallIdleProc;
- { Read [Files] section }
- if not TryStrToBoolean(SetupHeader.Uninstallable, Uninstallable) or Uninstallable then
- EnumFilesProc('', 1);
- EnumIniSection(EnumFilesProc, 'Files', 0, True, True, '', False, False);
- CallIdleProc;
- if UsedUserAreasWarning and (UsedUserAreas.Count > 0) and
- (SetupHeader.PrivilegesRequired in [prPowerUser, prAdmin]) then begin
- if SetupHeader.PrivilegesRequired = prPowerUser then
- PrivilegesRequiredValue := 'poweruser'
- else
- PrivilegesRequiredValue := 'admin';
- WarningsList.Add(Format(SCompilerUsedUserAreasWarning, ['Setup',
- 'PrivilegesRequired', PrivilegesRequiredValue, UsedUserAreas.CommaText]));
- end;
- { Read decompressor DLL. Must be done after [Files] is parsed, since
- SetupHeader.CompressMethod isn't set until then }
- case SetupHeader.CompressMethod of
- cmZip: begin
- AddStatus(Format(SCompilerStatusReadingFile, ['isunzlib.dll']));
- DecompressorDLL := CreateMemoryStreamFromFile(CompilerDir + 'isunzlib.dll',
- not(pfIsunzlib in DisablePrecompiledFileVerifications), OnCheckedTrust);
- end;
- cmBzip: begin
- AddStatus(Format(SCompilerStatusReadingFile, ['isbunzip.dll']));
- DecompressorDLL := CreateMemoryStreamFromFile(CompilerDir + 'isbunzip.dll',
- not(pfIsbunzip in DisablePrecompiledFileVerifications), OnCheckedTrust);
- end;
- end;
- { Read 7-Zip DLL }
- if SetupHeader.SevenZipLibraryName <> '' then begin
- AddStatus(Format(SCompilerStatusReadingFile, [SetupHeader.SevenZipLibraryName]));
- SevenZipDLL := CreateMemoryStreamFromFile(CompilerDir + SetupHeader.SevenZipLibraryName,
- not(pfIs7z in DisablePrecompiledFileVerifications), OnCheckedTrust);
- end;
- { Add default types if necessary }
- if (ComponentEntries.Count > 0) and (TypeEntries.Count = 0) then begin
- AddDefaultSetupType(DefaultTypeEntryNames[0], [], ttDefaultFull);
- AddDefaultSetupType(DefaultTypeEntryNames[1], [], ttDefaultCompact);
- AddDefaultSetupType(DefaultTypeEntryNames[2], [toIsCustom], ttDefaultCustom);
- end;
- { Check existence of expected custom message constants }
- CheckCustomMessageReferences;
- { Compile CodeText }
- CompileCode;
- CallIdleProc;
- { Clear any existing setup* files out of the output directory first (even
- if output is disabled. }
- EmptyOutputDir(True);
- if OutputManifestFile <> '' then
- DeleteFile(PrependDirName(OutputManifestFile, OutputDir));
- { Create setup files }
- if Output then begin
- AddStatus(SCompilerStatusCreateSetupFiles);
- ExeFilename := OutputDir + OutputBaseFilename + '.exe';
- try
- if UseSetupLdr = slNone then begin
- WithRetries(True, ExeFilename,
- procedure
- begin
- SetupFile := TFile.Create(ExeFilename, fdCreateAlways, faWrite, fsNone);
- end);
- try
- SetupFile.WriteBuffer(SetupMemoryFile.Memory^, SetupMemoryFile.CappedSize);
- SizeOfExe := SetupFile.Size;
- finally
- SetupFile.Free;
- end;
- CallIdleProc;
- if not DiskSpanning then begin
- { Create Setup-0.bin and Setup-1.bin }
- CompressFiles('', 0);
- CreateSetup0File;
- end
- else begin
- { Create Setup-0.bin and Setup-*.bin }
- SizeOfHeaders := CreateSetup0File;
- CompressFiles('', RoundToNearestClusterSize(SizeOfExe) +
- RoundToNearestClusterSize(SizeOfHeaders) +
- RoundToNearestClusterSize(ReserveBytes));
- { CompressFiles modifies setup header data, so go back and
- rewrite it }
- if CreateSetup0File <> SizeOfHeaders then
- { Make sure new and old size match. No reason why they
- shouldn't but check just in case }
- AbortCompile(SCompilerSetup0Mismatch);
- end;
- end
- else begin
- var EExt: String;
- if UseSetupLdr = sl32bit then
- EExt := '.e32'
- else
- EExt := '.e64';
- CopyFileOrAbortWithRetries(CompilerDir + 'SetupLdr' + EExt, ExeFilename, not(pfSetupLdr in DisablePrecompiledFileVerifications),
- [cftoTrustAllOnDebug], OnCheckedTrust);
- { If there was a read-only attribute, remove it }
- SetFileAttributes(PChar(ExeFilename), FILE_ATTRIBUTE_ARCHIVE);
- if (SetupIconFilename <> '') or (SetupHeader.WizardDarkStyle <> wdsDynamic) then begin
- AddStatus(Format(SCompilerStatusUpdatingIcons, ['Setup.exe']));
- { OnUpdateIconsAndStyle will set proper LineNumber }
- WithRetries(False, ExeFilename,
- procedure
- begin
- UpdateIconsAndStyle(ExeFilename, uisfSetupLdr, PrependSourceDirName(SetupIconFilename), SetupHeader.WizardDarkStyle, '', '', OnUpdateIconsAndStyle);
- end);
- LineNumber := 0;
- end;
- WithRetries(False, ExeFilename,
- procedure
- begin
- SetupFile := TFile.Create(ExeFilename, fdOpenExisting, faReadWrite, fsNone);
- end);
- try
- UpdateSetupPEHeaderFields(SetupFile, TerminalServicesAware, DEPCompatible, ASLRCompatible);
- SizeOfExe := SetupFile.Size;
- finally
- SetupFile.Free;
- end;
- CallIdleProc;
- { When disk spanning isn't used, place the compressed files inside
- Setup.exe }
- if not DiskSpanning then
- CompressFiles(ExeFilename, 0); { Uses WithRetries }
- WithRetries(False, ExeFilename,
- procedure
- begin
- ExeFile := TFile.Create(ExeFilename, fdOpenExisting, faReadWrite, fsNone);
- end);
- try
- ExeFile.SeekToEnd;
- { Move the data from Setup.e?? into the Setup.exe, and write
- header data }
- var SetupLdrOffsetTable := Default(TSetupLdrOffsetTable);
- SetupLdrOffsetTable.ID := SetupLdrOffsetTableID;
- SetupLdrOffsetTable.Version := SetupLdrOffsetTableVersion;
- SetupLdrOffsetTable.Offset0 := ExeFile.Position;
- SizeOfHeaders := WriteSetup0(ExeFile);
- SetupLdrOffsetTable.OffsetEXE := ExeFile.Position;
- CompressSetupMemoryFile(SetupMemoryFile, ExeFile, SetupLdrOffsetTable.UncompressedSizeEXE,
- SetupLdrOffsetTable.CRCEXE);
- SetupLdrOffsetTable.TotalSize := ExeFile.Size;
- if DiskSpanning then begin
- SetupLdrOffsetTable.Offset1 := 0;
- { Compress the files in Setup-*.bin after we know the size of
- Setup.exe }
- CompressFiles('',
- RoundToNearestClusterSize(SetupLdrOffsetTable.TotalSize) +
- RoundToNearestClusterSize(ReserveBytes));
- { CompressFiles modifies setup header data, so go back and
- rewrite it }
- ExeFile.Seek(SetupLdrOffsetTable.Offset0);
- if WriteSetup0(ExeFile) <> SizeOfHeaders then
- { Make sure new and old size match. No reason why they
- shouldn't but check just in case }
- AbortCompile(SCompilerSetup0Mismatch);
- end
- else
- SetupLdrOffsetTable.Offset1 := SizeOfExe;
- SetupLdrOffsetTable.TableCRC := GetCRC32(SetupLdrOffsetTable,
- SizeOf(SetupLdrOffsetTable) - SizeOf(SetupLdrOffsetTable.TableCRC));
- { Write SetupLdrOffsetTable to Setup.exe }
- if SeekToResourceData(ExeFile, Cardinal(RT_RCDATA), SetupLdrOffsetTableResID) <> SizeOf(SetupLdrOffsetTable) then
- AbortCompile('Wrong offset table resource size');
- ExeFile.WriteBuffer(SetupLdrOffsetTable, SizeOf(SetupLdrOffsetTable));
- { Update version info }
- AddStatus(Format(SCompilerStatusUpdatingVersionInfo, ['Setup.exe']));
- UpdateVersionInfo(ExeFile, VersionInfoVersion, VersionInfoProductVersion, VersionInfoCompany,
- VersionInfoDescription, VersionInfoTextVersion,
- VersionInfoCopyright, VersionInfoProductName, VersionInfoProductTextVersion, VersionInfoOriginalFileName,
- True);
- { Update manifest if needed }
- if UseSetupLdr <> slNone then begin
- AddStatus(Format(SCompilerStatusUpdatingManifest, ['Setup.exe']));
- PreventCOMCTL32Sideloading(ExeFile);
- end;
- { For some reason, on Win95 the date/time of the EXE sometimes
- doesn't get updated after it's been written to so it has to
- manually set it. (I don't get it!!) }
- UpdateTimeStamp(ExeFile.Handle);
- finally
- ExeFile.Free;
- end;
- end;
- { Sign }
- if SignTools.Count > 0 then begin
- AddStatus(SCompilerStatusSigningSetup);
- Sign(ExeFileName); { Has its own retry mechanism }
- end;
- except
- EmptyOutputDir(False);
- raise;
- end;
- CallIdleProc;
- { Create manifest file }
- if OutputManifestFile <> '' then begin
- AddStatus(SCompilerStatusCreateManifestFile);
- CreateManifestFile;
- CallIdleProc;
- end;
- end else begin
- AddStatus(SCompilerStatusSkippingCreateSetupFiles);
- ExeFilename := '';
- end;
- { Finalize debug info }
- FinalizeDebugInfo;
- { Done }
- AddStatus('');
- for I := 0 to WarningsList.Count-1 do
- AddStatus(SCompilerStatusWarning + WarningsList[I], True);
- asm jmp @1; db 0,'Inno Setup Compiler, Copyright (C) 1997-2026 Jordan Russell, '
- db 'Portions Copyright (C) 2000-2026 Martijn Laan',0; @1: end;
- { Note: Removing or modifying the copyright text is a violation of the
- Inno Setup license agreement; see LICENSE.TXT. }
- finally
- { Free / clear all the data }
- CallPreprocessorCleanupProc;
- UsedUserAreas.Clear;
- WarningsList.Clear;
- SevenZipDLL.Free;
- DecompressorDLL.Free;
- SetupMemoryFile.Free;
- WizardBackImagesDynamicDark.Free;
- WizardSmallImagesDynamicDark.Free;
- WizardImagesDynamicDark.Free;
- WizardBackImages.Free;
- WizardSmallImages.Free;
- WizardImages.Free;
- ClearSEList(LanguageEntries, SetupLanguageEntryStrings, SetupLanguageEntryAnsiStrings);
- ClearSEList(CustomMessageEntries, SetupCustomMessageEntryStrings, SetupCustomMessageEntryAnsiStrings);
- ClearSEList(PermissionEntries, SetupPermissionEntryStrings, SetupPermissionEntryAnsiStrings);
- ClearSEList(TypeEntries, SetupTypeEntryStrings, SetupTypeEntryAnsiStrings);
- ClearSEList(ComponentEntries, SetupComponentEntryStrings, SetupComponentEntryAnsiStrings);
- ClearSEList(TaskEntries, SetupTaskEntryStrings, SetupTaskEntryAnsiStrings);
- ClearSEList(DirEntries, SetupDirEntryStrings, SetupDirEntryAnsiStrings);
- ClearSEList(FileEntries, SetupFileEntryStrings, SetupFileEntryAnsiStrings);
- ClearSEList(FileLocationEntries, SetupFileLocationEntryStrings, SetupFileLocationEntryAnsiStrings);
- ClearSEList(ISSigKeyEntries, SetupISSigKeyEntryStrings, SetupISSigKeyEntryAnsiStrings);
- ClearSEList(IconEntries, SetupIconEntryStrings, SetupIconEntryAnsiStrings);
- ClearSEList(IniEntries, SetupIniEntryStrings, SetupIniEntryAnsiStrings);
- ClearSEList(RegistryEntries, SetupRegistryEntryStrings, SetupRegistryEntryAnsiStrings);
- ClearSEList(InstallDeleteEntries, SetupDeleteEntryStrings, SetupDeleteEntryAnsiStrings);
- ClearSEList(UninstallDeleteEntries, SetupDeleteEntryStrings, SetupDeleteEntryAnsiStrings);
- ClearSEList(RunEntries, SetupRunEntryStrings, SetupRunEntryAnsiStrings);
- ClearSEList(UninstallRunEntries, SetupRunEntryStrings, SetupRunEntryAnsiStrings);
- FileLocationEntryFilenames.Clear;
- for I := FileLocationEntryExtraInfos.Count-1 downto 0 do begin
- Dispose(PFileLocationEntryExtraInfo(FileLocationEntryExtraInfos[I]));
- FileLocationEntryExtraInfos.Delete(I);
- end;
- for I := ISSigKeyEntryExtraInfos.Count-1 downto 0 do begin
- Dispose(PISSigKeyEntryExtraInfo(ISSigKeyEntryExtraInfos[I]));
- ISSigKeyEntryExtraInfos.Delete(I);
- end;
- ClearLineInfoList(ExpectedCustomMessageNames);
- ClearLangDataList;
- ClearPreLangDataList;
- ClearScriptFiles;
- ClearLineInfoList(CodeText);
- FreeAndNil(CompressProps);
- FreeAndNil(InternalCompressProps);
- end;
- end;
- end.
|