123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107110811091110111111121113111411151116111711181119112011211122112311241125112611271128112911301131113211331134113511361137113811391140114111421143114411451146114711481149115011511152115311541155115611571158115911601161116211631164116511661167116811691170117111721173117411751176117711781179118011811182118311841185118611871188118911901191119211931194119511961197119811991200120112021203120412051206120712081209121012111212121312141215121612171218121912201221122212231224122512261227122812291230123112321233123412351236123712381239124012411242124312441245124612471248124912501251125212531254125512561257125812591260126112621263126412651266126712681269127012711272127312741275127612771278127912801281128212831284128512861287128812891290129112921293129412951296129712981299130013011302130313041305130613071308130913101311131213131314131513161317131813191320132113221323132413251326132713281329133013311332133313341335133613371338133913401341134213431344134513461347134813491350135113521353135413551356135713581359136013611362136313641365136613671368136913701371137213731374137513761377137813791380138113821383138413851386138713881389139013911392139313941395139613971398139914001401140214031404140514061407140814091410141114121413141414151416141714181419142014211422142314241425142614271428142914301431143214331434143514361437143814391440144114421443144414451446144714481449145014511452145314541455145614571458145914601461146214631464146514661467146814691470147114721473147414751476147714781479148014811482148314841485148614871488148914901491149214931494149514961497149814991500150115021503150415051506150715081509151015111512151315141515151615171518151915201521152215231524152515261527152815291530153115321533153415351536153715381539154015411542154315441545154615471548154915501551155215531554155515561557155815591560156115621563156415651566156715681569157015711572157315741575157615771578157915801581158215831584158515861587158815891590159115921593159415951596159715981599160016011602160316041605160616071608160916101611161216131614161516161617161816191620162116221623162416251626162716281629163016311632163316341635163616371638163916401641164216431644164516461647164816491650165116521653165416551656165716581659166016611662166316641665166616671668166916701671167216731674167516761677167816791680168116821683168416851686168716881689169016911692169316941695169616971698169917001701170217031704170517061707170817091710171117121713171417151716171717181719172017211722172317241725172617271728172917301731173217331734173517361737173817391740174117421743174417451746174717481749175017511752175317541755175617571758175917601761176217631764176517661767176817691770177117721773177417751776177717781779178017811782178317841785178617871788178917901791179217931794179517961797179817991800180118021803180418051806180718081809181018111812181318141815181618171818181918201821182218231824182518261827182818291830183118321833183418351836183718381839184018411842184318441845184618471848184918501851185218531854185518561857185818591860186118621863186418651866186718681869187018711872187318741875187618771878187918801881188218831884188518861887188818891890189118921893189418951896189718981899190019011902190319041905190619071908190919101911191219131914191519161917191819191920192119221923192419251926192719281929193019311932193319341935193619371938193919401941194219431944194519461947194819491950195119521953195419551956195719581959196019611962196319641965196619671968196919701971197219731974197519761977197819791980198119821983198419851986198719881989199019911992199319941995199619971998199920002001200220032004200520062007200820092010201120122013201420152016201720182019202020212022202320242025202620272028202920302031203220332034203520362037203820392040204120422043204420452046204720482049205020512052205320542055205620572058205920602061206220632064206520662067206820692070207120722073207420752076207720782079208020812082208320842085208620872088208920902091209220932094209520962097209820992100210121022103210421052106210721082109211021112112211321142115211621172118211921202121212221232124212521262127212821292130213121322133213421352136213721382139214021412142214321442145214621472148214921502151215221532154215521562157215821592160216121622163216421652166216721682169217021712172217321742175217621772178217921802181218221832184218521862187218821892190219121922193219421952196219721982199220022012202220322042205220622072208220922102211221222132214221522162217221822192220222122222223222422252226222722282229223022312232223322342235223622372238223922402241224222432244224522462247224822492250225122522253225422552256225722582259226022612262226322642265226622672268226922702271227222732274227522762277227822792280228122822283228422852286228722882289229022912292229322942295229622972298229923002301230223032304230523062307230823092310231123122313231423152316231723182319232023212322232323242325232623272328232923302331233223332334233523362337233823392340234123422343234423452346234723482349235023512352235323542355235623572358235923602361236223632364236523662367236823692370237123722373237423752376237723782379238023812382238323842385238623872388238923902391239223932394239523962397239823992400240124022403240424052406240724082409241024112412241324142415241624172418241924202421242224232424242524262427242824292430243124322433243424352436243724382439244024412442244324442445244624472448244924502451245224532454245524562457245824592460246124622463246424652466246724682469247024712472247324742475247624772478247924802481248224832484248524862487248824892490249124922493249424952496249724982499250025012502250325042505250625072508250925102511251225132514251525162517251825192520252125222523252425252526252725282529253025312532253325342535253625372538253925402541254225432544254525462547254825492550255125522553255425552556255725582559256025612562256325642565256625672568256925702571257225732574257525762577257825792580258125822583258425852586258725882589259025912592259325942595259625972598259926002601260226032604260526062607260826092610261126122613261426152616261726182619262026212622262326242625262626272628262926302631263226332634263526362637263826392640264126422643264426452646264726482649265026512652265326542655265626572658265926602661266226632664266526662667266826692670267126722673267426752676267726782679268026812682268326842685268626872688268926902691269226932694269526962697269826992700270127022703270427052706270727082709271027112712271327142715271627172718271927202721272227232724272527262727272827292730273127322733273427352736273727382739274027412742274327442745274627472748274927502751275227532754275527562757275827592760276127622763276427652766276727682769277027712772277327742775277627772778277927802781278227832784278527862787278827892790279127922793279427952796279727982799280028012802280328042805280628072808280928102811281228132814281528162817281828192820282128222823282428252826282728282829283028312832283328342835283628372838283928402841284228432844284528462847284828492850285128522853285428552856285728582859286028612862286328642865286628672868286928702871287228732874287528762877287828792880288128822883288428852886288728882889289028912892289328942895289628972898289929002901290229032904290529062907290829092910291129122913291429152916291729182919292029212922292329242925292629272928292929302931293229332934293529362937293829392940294129422943294429452946294729482949295029512952295329542955295629572958295929602961296229632964296529662967296829692970297129722973297429752976297729782979298029812982298329842985298629872988298929902991299229932994299529962997299829993000300130023003300430053006300730083009301030113012301330143015301630173018301930203021302230233024302530263027302830293030303130323033303430353036303730383039304030413042304330443045304630473048304930503051305230533054305530563057305830593060306130623063306430653066306730683069307030713072307330743075307630773078307930803081308230833084308530863087308830893090309130923093309430953096309730983099310031013102310331043105310631073108310931103111311231133114311531163117311831193120312131223123312431253126312731283129313031313132313331343135313631373138313931403141314231433144314531463147314831493150315131523153315431553156315731583159316031613162316331643165316631673168316931703171317231733174317531763177317831793180318131823183318431853186318731883189319031913192319331943195319631973198319932003201320232033204320532063207320832093210321132123213321432153216321732183219322032213222322332243225322632273228322932303231323232333234323532363237323832393240324132423243324432453246324732483249325032513252325332543255325632573258325932603261326232633264326532663267326832693270327132723273327432753276327732783279328032813282328332843285328632873288328932903291329232933294329532963297329832993300330133023303330433053306330733083309331033113312331333143315331633173318331933203321332233233324332533263327332833293330333133323333333433353336333733383339334033413342334333443345334633473348334933503351335233533354335533563357335833593360336133623363336433653366336733683369337033713372337333743375337633773378337933803381338233833384338533863387338833893390339133923393339433953396339733983399340034013402340334043405340634073408340934103411341234133414341534163417341834193420342134223423342434253426342734283429343034313432343334343435343634373438343934403441344234433444344534463447344834493450345134523453345434553456345734583459346034613462346334643465346634673468346934703471347234733474347534763477347834793480348134823483348434853486348734883489349034913492349334943495349634973498349935003501350235033504350535063507350835093510351135123513351435153516351735183519352035213522352335243525352635273528352935303531353235333534353535363537353835393540354135423543354435453546354735483549355035513552355335543555355635573558355935603561356235633564356535663567356835693570357135723573357435753576357735783579358035813582358335843585358635873588358935903591359235933594359535963597359835993600360136023603360436053606360736083609361036113612361336143615361636173618361936203621362236233624362536263627362836293630363136323633363436353636363736383639364036413642364336443645364636473648364936503651365236533654365536563657365836593660366136623663366436653666366736683669367036713672367336743675367636773678367936803681368236833684368536863687368836893690369136923693369436953696369736983699370037013702370337043705370637073708370937103711371237133714371537163717371837193720372137223723372437253726372737283729373037313732373337343735373637373738373937403741374237433744374537463747374837493750375137523753375437553756375737583759376037613762376337643765376637673768376937703771377237733774377537763777377837793780378137823783378437853786378737883789379037913792379337943795379637973798379938003801380238033804380538063807380838093810381138123813381438153816381738183819382038213822382338243825382638273828382938303831383238333834383538363837383838393840384138423843384438453846384738483849385038513852385338543855385638573858385938603861386238633864386538663867386838693870387138723873387438753876387738783879388038813882388338843885388638873888388938903891389238933894389538963897389838993900390139023903390439053906390739083909391039113912391339143915391639173918391939203921392239233924392539263927392839293930393139323933393439353936393739383939394039413942394339443945394639473948394939503951395239533954395539563957395839593960396139623963396439653966396739683969397039713972397339743975397639773978397939803981398239833984398539863987398839893990399139923993399439953996399739983999400040014002400340044005400640074008400940104011401240134014401540164017401840194020402140224023402440254026402740284029403040314032403340344035403640374038403940404041404240434044404540464047404840494050405140524053405440554056405740584059406040614062406340644065406640674068406940704071407240734074407540764077407840794080408140824083408440854086408740884089409040914092409340944095409640974098409941004101410241034104410541064107410841094110411141124113411441154116411741184119412041214122412341244125412641274128 |
- unit Setup.Install;
- {
- Inno Setup
- Copyright (C) 1997-2025 Jordan Russell
- Portions by Martijn Laan
- For conditions of distribution and use, see LICENSE.TXT.
- Installation procedures
- }
- interface
- uses
- Classes, SHA256, Shared.FileClass, Shared.SetupTypes, Shared.Int64Em, Shared.Struct;
- function NoVerification: TSetupFileVerification;
- procedure VerificationError(const AError: TVerificationError;
- const ASigFilename: String = '');
- procedure DoISSigVerify(const SourceF: TFile; const SourceFS: TFileStream;
- const SourceFilename: String; const VerifySourceFilename: Boolean; const ISSigAllowedKeys: AnsiString;
- out ExpectedFileHash: TSHA256Digest);
- procedure PerformInstall(var Succeeded: Boolean; const ChangesEnvironment,
- ChangesAssociations: Boolean);
- type
- TOnDownloadProgress = function(const Url, BaseName: string; const Progress, ProgressMax: Int64): Boolean of object;
- TOnSimpleDownloadProgress = procedure(const Bytes, Param: Integer64);
- procedure ExtractTemporaryFile(const BaseName: String);
- function ExtractTemporaryFiles(const Pattern: String): Integer;
- function DownloadFile(const Url, CustomUserName, CustomPassword: String;
- const DestF: TFile; [ref] const Verification: TSetupFileVerification; const ISSigSourceFilename: String;
- const OnSimpleDownloadProgress: TOnSimpleDownloadProgress;
- const OnSimpleDownloadProgressParam: Integer64): Int64;
- function DownloadTemporaryFile(const Url, BaseName: String;
- [ref] const Verification: TSetupFileVerification; const OnDownloadProgress: TOnDownloadProgress): Int64; overload;
- function DownloadTemporaryFile(const Url, BaseName: String;
- [ref] const Verification: TSetupFileVerification; const OnDownloadProgress: TOnDownloadProgress;
- out DestFile: String): Int64; overload;
- function DownloadTemporaryFileSize(const Url: String): Int64;
- function DownloadTemporaryFileDate(const Url: String): String;
- procedure SetDownloadTemporaryFileCredentials(const User, Pass: String);
- function GetISSigUrl(const Url, ISSigUrl: String): String;
- implementation
- uses
- Windows, SysUtils, Messages, Forms, ShlObj, Setup.UninstallLog,
- SetupLdrAndSetup.InstFunc, Setup.InstFunc, Setup.InstFunc.Ole, Setup.SecurityFunc, SetupLdrAndSetup.Messages,
- Setup.MainFunc, Setup.LoggingFunc, Setup.FileExtractor,
- Compression.Base, PathFunc, ISSigFunc, Shared.CommonFunc.Vcl, Compression.SevenZipDLLDecoder,
- Shared.CommonFunc, SetupLdrAndSetup.RedirFunc, Shared.SetupMessageIDs,
- Setup.WizardForm, Shared.DebugStruct, Setup.DebugClient, Shared.VerInfoFunc, Setup.ScriptRunner, Setup.RegDLL, Setup.Helper,
- Shared.ResUpdateFunc, Setup.DotNetFunc, TaskbarProgressFunc, NewProgressBar, RestartManager,
- Net.HTTPClient, Net.URLClient, NetEncoding, RegStr;
- type
- TSetupUninstallLog = class(TUninstallLog)
- protected
- procedure HandleException; override;
- end;
- var
- CurProgress: Integer64;
- ProgressShiftCount: Cardinal;
- { TSetupUninstallLog }
- procedure TSetupUninstallLog.HandleException;
- begin
- Application.HandleException(Self);
- end;
- procedure SetFilenameLabelText(const S: String; const CallUpdate: Boolean);
- begin
- WizardForm.FilenameLabel.Caption := MinimizePathName(S, WizardForm.FilenameLabel.Font, WizardForm.FileNameLabel.Width);
- if CallUpdate then
- WizardForm.FilenameLabel.Update;
- end;
- procedure SetStatusLabelText(const S: String;
- const ClearFilenameLabelText: Boolean = True);
- begin
- if WizardForm.StatusLabel.Caption <> S then begin
- WizardForm.StatusLabel.Caption := S;
- WizardForm.StatusLabel.Update;
- end;
- if ClearFilenameLabelText then
- SetFilenameLabelText('', True);
- end;
- procedure InstallMessageBoxCallback(const Flags: LongInt; const After: Boolean;
- const Param: LongInt);
- const
- States: array [TNewProgressBarState] of TTaskbarProgressState =
- (tpsNormal, tpsError, tpsPaused);
- var
- NewState: TNewProgressBarState;
- begin
- if After then
- NewState := npbsNormal
- else if (Flags and MB_ICONSTOP) <> 0 then
- NewState := npbsError
- else
- NewState := npbsPaused;
- with WizardForm.ProgressGauge do begin
- State := NewState;
- Invalidate;
- end;
- SetAppTaskbarProgressState(States[NewState]);
- end;
- procedure CalcFilesSize(var InstallFilesSize, AfterInstallFilesSize: Integer64);
- var
- N: Integer;
- CurFile: PSetupFileEntry;
- FileSize: Integer64;
- begin
- InstallFilesSize := To64(0);
- AfterInstallFilesSize := InstallFilesSize;
- for N := 0 to Entries[seFile].Count-1 do begin
- CurFile := PSetupFileEntry(Entries[seFile][N]);
- if ShouldProcessFileEntry(WizardComponents, WizardTasks, CurFile, False) then begin
- with CurFile^ do begin
- if LocationEntry <> -1 then { not an "external" file }
- FileSize := PSetupFileLocationEntry(Entries[seFileLocation][
- LocationEntry])^.OriginalSize
- else
- FileSize := ExternalSize;
- Inc6464(InstallFilesSize, FileSize);
- if not (foDeleteAfterInstall in Options) then
- Inc6464(AfterInstallFilesSize, FileSize);
- end;
- end;
- end;
- end;
- procedure InitProgressGauge(const InstallFilesSize: Integer64);
- var
- NewMaxValue: Integer64;
- begin
- { Calculate the MaxValue for the progress meter }
- NewMaxValue := To64(1000 * Entries[seIcon].Count);
- if Entries[seIni].Count <> 0 then Inc(NewMaxValue.Lo, 1000);
- if Entries[seRegistry].Count <> 0 then Inc(NewMaxValue.Lo, 1000);
- Inc6464(NewMaxValue, InstallFilesSize);
- { To avoid progress updates that are too small to result in any visible
- change, divide the Max value by 2 until it's under 1500 }
- ProgressShiftCount := 0;
- while (NewMaxValue.Hi <> 0) or (NewMaxValue.Lo >= Cardinal(1500)) do begin
- Shr64(NewMaxValue, 1);
- Inc(ProgressShiftCount);
- end;
- WizardForm.ProgressGauge.Max := NewMaxValue.Lo;
- SetMessageBoxCallbackFunc(InstallMessageBoxCallback, 0);
- end;
- procedure UpdateProgressGauge;
- var
- NewPosition: Integer64;
- begin
- NewPosition := CurProgress;
- Shr64(NewPosition, ProgressShiftCount);
- if WizardForm.ProgressGauge.Position <> Longint(NewPosition.Lo) then begin
- WizardForm.ProgressGauge.Position := NewPosition.Lo;
- WizardForm.ProgressGauge.Update;
- end;
- SetAppTaskbarProgressValue(NewPosition.Lo, WizardForm.ProgressGauge.Max);
- if (CodeRunner <> nil) and CodeRunner.FunctionExists('CurInstallProgressChanged', True) then begin
- try
- CodeRunner.RunProcedures('CurInstallProgressChanged', [NewPosition.Lo,
- WizardForm.ProgressGauge.Max], False);
- except
- Log('CurInstallProgressChanged raised an exception.');
- Application.HandleException(nil);
- end;
- end;
- end;
- procedure FinishProgressGauge(const HideGauge: Boolean);
- begin
- SetMessageBoxCallbackFunc(nil, 0);
- if HideGauge then
- WizardForm.ProgressGauge.Visible := False;
- SetAppTaskbarProgressState(tpsNoProgress);
- end;
- procedure SetProgress(const AProgress: Integer64);
- begin
- CurProgress := AProgress;
- UpdateProgressGauge;
- end;
- procedure IncProgress(const N: Cardinal);
- begin
- Inc64(CurProgress, N);
- UpdateProgressGauge;
- end;
- procedure IncProgress64(const N: Integer64);
- begin
- Inc6464(CurProgress, N);
- UpdateProgressGauge;
- end;
- procedure ProcessEvents;
- { Processes any waiting events. Must call this this periodically or else
- events like clicking the Cancel button won't be processed.
- Calls Abort if NeedToAbortInstall is True, which is usually the result of
- the user clicking Cancel and the form closing. }
- begin
- if NeedToAbortInstall then Abort;
- Application.ProcessMessages;
- if NeedToAbortInstall then Abort;
- end;
- procedure InternalProgressProc(const Bytes: Cardinal);
- begin
- IncProgress(Bytes);
- ProcessEvents;
- end;
- procedure ExternalProgressProc64(const Bytes, MaxProgress: Integer64);
- begin
- var NewProgress := CurProgress;
- Inc6464(NewProgress, Bytes);
- { In case the source file was larger than we thought it was, stop the
- progress bar at the maximum amount. Also see CopySourceFileToDestFile. }
- if Compare64(NewProgress, MaxProgress) > 0 then
- NewProgress := MaxProgress;
- SetProgress(NewProgress);
-
- ProcessEvents;
- end;
- procedure JustProcessEventsProc64(const Bytes, Param: Integer64);
- begin
- ProcessEvents;
- end;
- function AbortRetryIgnoreTaskDialogMsgBox(const Text: String;
- const RetryIgnoreAbortButtonLabels: array of String): Boolean;
- { Returns True if Ignore was selected, False if Retry was selected, or
- calls Abort if Abort was selected. }
- begin
- Result := False;
- case LoggedTaskDialogMsgBox('', SetupMessages[msgAbortRetryIgnoreSelectAction], Text, '',
- mbError, MB_ABORTRETRYIGNORE, RetryIgnoreAbortButtonLabels, 0, True, IDABORT) of
- IDABORT: Abort;
- IDRETRY: ;
- IDIGNORE: Result := True;
- else
- Log('LoggedTaskDialogMsgBox returned an unexpected value. Assuming Abort.');
- Abort;
- end;
- end;
- function FileTimeToStr(const AFileTime: TFileTime): String;
- { Converts a TFileTime into a string for log purposes. }
- var
- FT: TFileTime;
- ST: TSystemTime;
- begin
- FileTimeToLocalFileTime(AFileTime, FT);
- if FileTimeToSystemTime(FT, 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)';
- end;
- function TryToGetSHA256OfFile(const DisableFsRedir: Boolean; const Filename: String;
- var Sum: TSHA256Digest): Boolean;
- { Like GetSHA256OfFile but traps exceptions locally. Returns True if successful. }
- begin
- try
- Sum := GetSHA256OfFile(DisableFsRedir, Filename);
- Result := True;
- except
- Result := False;
- end;
- end;
- function NoVerification: TSetupFileVerification;
- begin
- Result := Default(TSetupFileVerification);
- Result.Typ := fvNone;
- end;
- procedure VerificationError(const AError: TVerificationError;
- const ASigFilename: String);
- const
- LogMessages: array[TVerificationError] of String =
- ('Signature file does not exist', 'Signature is malformed', 'No matching key found',
- 'Signature is bad', 'File name is incorrect', 'File size is incorrect', 'File hash is incorrect');
- SetupMessageIDs: array[TVerificationError] of TSetupMessageID =
- (msgVerificationSignatureDoesntExist, msgVerificationSignatureInvalid, msgVerificationKeyNotFound,
- msgVerificationSignatureInvalid, msgVerificationFileNameIncorrect, msgVerificationFileSizeIncorrect,
- msgVerificationFileHashIncorrect);
- begin
- { Also see Compiler.SetupCompiler for a similar function }
- Log('Verification error: ' + AddPeriod(LogMessages[AError]));
- raise Exception.Create(FmtSetupMessage1(msgSourceVerificationFailed,
- FmtSetupMessage1(SetupMessageIDs[AError], PathExtractName(ASigFilename)))); { Not all messages actually have a %1 parameter but that's OK }
- end;
- procedure DoISSigVerify(const SourceF: TFile; const SourceFS: TFileStream;
- const SourceFilename: String; const VerifySourceFilename: Boolean; const ISSigAllowedKeys: AnsiString;
- out ExpectedFileHash: TSHA256Digest);
- { Does not disable FS redirection. Either SourceF or SourceFS must be set, which
- may be opened for writing instead of reading. }
- begin
- if ((SourceF = nil) and (SourceFS = nil)) or ((SourceF <> nil) and (SourceFS <> nil)) then
- InternalError('DoISSigVerify: Invalid SourceF / SourceFS combination');
- var ExpectedFileName: String;
- var ExpectedFileSize: Int64;
- if not ISSigVerifySignature(SourceFilename,
- GetISSigAllowedKeys(ISSigAvailableKeys, ISSigAllowedKeys),
- ExpectedFileName, ExpectedFileSize, ExpectedFileHash,
- nil,
- procedure(const Filename, SigFilename: String)
- begin
- VerificationError(veSignatureMissing, SigFilename);
- end,
- procedure(const Filename, SigFilename: String; const VerifyResult: TISSigVerifySignatureResult)
- begin
- case VerifyResult of
- vsrMalformed: VerificationError(veSignatureMalformed, SigFilename);
- vsrBad: VerificationError(veSignatureBad, SigFilename);
- vsrKeyNotFound: VerificationError(veKeyNotFound, SigFilename);
- else
- InternalError('Unknown ISSigVerifySignature result');
- end;
- end
- ) then
- InternalError('Unexpected ISSigVerifySignature result');
- if VerifySourceFilename and (ExpectedFileName <> '') and not PathSame(PathExtractName(SourceFilename), ExpectedFileName) then
- VerificationError(veFileNameIncorrect);
- var FileSize: Int64;
- if SourceF <> nil then
- FileSize := SourceF.Size
- else
- FileSize := SourceFS.Size;
- if FileSize <> ExpectedFileSize then
- VerificationError(veFileSizeIncorrect);
- { Caller must check ExpectedFileHash }
- end;
- const
- VerificationSuccessfulLogMessage = 'Verification successful.';
- procedure CopySourceFileToDestFile(const SourceF, DestF: TFile;
- [ref] const Verification: TSetupFileVerification; const ISSigSourceFilename: String;
- const AExpectedSize: Integer64);
- { Copies all bytes from SourceF to DestF, incrementing process meter as it
- goes. Assumes file pointers of both are 0. }
- var
- BytesLeft: Integer64;
- BufSize: Cardinal;
- Buf: array[0..16383] of Byte;
- Context: TSHA256Context;
- begin
- var ExpectedFileHash: TSHA256Digest;
- if Verification.Typ <> fvNone then begin
- if Verification.Typ = fvHash then
- ExpectedFileHash := Verification.Hash
- else
- DoISSigVerify(SourceF, nil, ISSigSourceFilename, True, Verification.ISSigAllowedKeys, ExpectedFileHash);
- { ExpectedFileHash checked below after copy }
- SHA256Init(Context);
- end;
- var MaxProgress := CurProgress;
- Inc6464(MaxProgress, AExpectedSize);
- BytesLeft := SourceF.Size;
- { To avoid file system fragmentation, preallocate all of the bytes in the
- destination file }
- DestF.Seek64(BytesLeft);
- DestF.Truncate;
- DestF.Seek(0);
- while True do begin
- BufSize := SizeOf(Buf);
- if (BytesLeft.Hi = 0) and (BytesLeft.Lo < BufSize) then
- BufSize := BytesLeft.Lo;
- if BufSize = 0 then
- Break;
- SourceF.ReadBuffer(Buf, BufSize);
- DestF.WriteBuffer(Buf, BufSize);
- Dec64(BytesLeft, BufSize);
- if Verification.Typ <> fvNone then
- SHA256Update(Context, Buf, BufSize);
- ExternalProgressProc64(To64(BufSize), MaxProgress);
- end;
- if Verification.Typ <> fvNone then begin
- if not SHA256DigestsEqual(SHA256Final(Context), ExpectedFileHash) then
- VerificationError(veFileHashIncorrect);
- Log(VerificationSuccessfulLogMessage);
- end;
- { In case the source file was shorter than we thought it was, bump the
- progress bar to the maximum amount }
- SetProgress(MaxProgress);
- end;
- procedure AddAttributesToFile(const DisableFsRedir: Boolean;
- const Filename: String; Attribs: Integer);
- var
- ExistingAttr: DWORD;
- begin
- if Attribs <> 0 then begin
- ExistingAttr := GetFileAttributesRedir(DisableFsRedir, Filename);
- if ExistingAttr <> INVALID_FILE_ATTRIBUTES then
- SetFileAttributesRedir(DisableFsRedir, Filename,
- (ExistingAttr and not FILE_ATTRIBUTE_NORMAL) or DWORD(Attribs));
- end;
- end;
- function ShortenOrExpandFontFilename(const Filename: String): String;
- { Expands Filename, except if it's in the Fonts directory, in which case it
- removes the path }
- var
- FontDir: String;
- begin
- Result := PathExpand(Filename);
- FontDir := GetShellFolder(False, sfFonts);
- if FontDir <> '' then
- if PathCompare(PathExtractDir(Result), FontDir) = 0 then
- Result := PathExtractName(Result);
- end;
- function LastErrorIndicatesPossiblyInUse(const LastError: DWORD; const CheckAlreadyExists: Boolean): Boolean;
- begin
- Result := (LastError = ERROR_ACCESS_DENIED) or
- (LastError = ERROR_SHARING_VIOLATION) or
- (CheckAlreadyExists and (LastError = ERROR_ALREADY_EXISTS));
- end;
- procedure PerformInstall(var Succeeded: Boolean; const ChangesEnvironment,
- ChangesAssociations: Boolean);
- type
- PRegisterFilesListRec = ^TRegisterFilesListRec;
- TRegisterFilesListRec = record
- Filename: String;
- Is64Bit, TypeLib, NoErrorMessages: Boolean;
- end;
- var
- UninstLog: TSetupUninstallLog;
- UninstallTempExeFilename, UninstallDataFilename, UninstallMsgFilename: String;
- UninstallExeCreated: (ueNone, ueNew, ueReplaced);
- UninstallDataCreated, UninstallMsgCreated, AppendUninstallData: Boolean;
- RegisterFilesList: TList;
- ExpandedAppId: String;
- function GetLocalTimeAsStr: String;
- var
- SysTime: TSystemTime;
- begin
- GetLocalTime(SysTime);
- SetString(Result, PChar(@SysTime), SizeOf(SysTime) div SizeOf(Char));
- end;
- procedure RecordStartInstall;
- var
- AppDir: String;
- begin
- if shCreateAppDir in SetupHeader.Options then
- AppDir := WizardDirValue
- else
- AppDir := '';
- UninstLog.Add(utStartInstall, [GetComputerNameString, GetUserNameString,
- AppDir, GetLocalTimeAsStr], 0);
- end;
- procedure PackCustomMessagesIntoString(var S: String);
- var
- M: TMemoryStream;
- Count, I, N: Integer;
- begin
- M := TMemoryStream.Create;
- try
- Count := 0;
- M.WriteBuffer(Count, SizeOf(Count)); { overwritten later }
- for I := 0 to Entries[seCustomMessage].Count-1 do begin
- with PSetupCustomMessageEntry(Entries[seCustomMessage][I])^ do begin
- if (LangIndex = -1) or (LangIndex = ActiveLanguage) then begin
- N := Length(Name);
- M.WriteBuffer(N, SizeOf(N));
- M.WriteBuffer(Name[1], N*SizeOf(Name[1]));
- N := Length(Value);
- M.WriteBuffer(N, SizeOf(N));
- M.WriteBuffer(Value[1], N*SizeOf(Value[1]));
- Inc(Count);
- end;
- end;
- end;
- M.Seek(0, soFromBeginning);
- M.WriteBuffer(Count, SizeOf(Count));
- SetString(S, PChar(M.Memory), M.Size div SizeOf(Char));
- finally
- M.Free;
- end;
- end;
- function PackCompiledCodeTextIntoString(const CompiledCodeText: AnsiString): String;
- var
- N: Integer;
- begin
- N := Length(CompiledCodeText);
- if N mod 2 = 1 then
- Inc(N); { This will lead to 1 extra byte being moved but that's ok since it is the #0 }
- N := N div 2;
- SetString(Result, PChar(Pointer(CompiledCodeText)), N);
- end;
- procedure RecordCompiledCode;
- var
- LeadBytesStr, ExpandedApp, ExpandedGroup, CustomMessagesStr: String;
- begin
- { Only use app if Setup creates one }
- if shCreateAppDir in SetupHeader.Options then
- ExpandedApp := ExpandConst('{app}')
- else
- ExpandedApp := '';
- try
- ExpandedGroup := ExpandConst('{group}');
- except
- { Yep, expanding "group" might fail with an exception }
- ExpandedGroup := '';
- end;
- if SetupHeader.CompiledCodeText <> '' then
- PackCustomMessagesIntoString(CustomMessagesStr);
- { Record [Code] even if empty to 'overwrite' old versions }
- UninstLog.Add(utCompiledCode, [PackCompiledCodeTextIntoString(SetupHeader.CompiledCodeText),
- LeadBytesStr, ExpandedApp, ExpandedGroup, WizardGroupValue,
- ExpandConst('{language}'), CustomMessagesStr], SetupBinVersion or Longint($80000000));
- end;
- type
- TRegErrorFunc = (reRegSetValueEx, reRegCreateKeyEx, reRegOpenKeyEx);
- procedure RegError(const Func: TRegErrorFunc; const RootKey: HKEY;
- const KeyName: String; const ErrorCode: Longint);
- const
- ErrorMsgs: array[TRegErrorFunc] of TSetupMessageID =
- (msgErrorRegWriteKey, msgErrorRegCreateKey, msgErrorRegOpenKey);
- FuncNames: array[TRegErrorFunc] of String =
- ('RegSetValueEx', 'RegCreateKeyEx', 'RegOpenKeyEx');
- begin
- raise Exception.Create(FmtSetupMessage(ErrorMsgs[Func],
- [GetRegRootKeyName(RootKey), KeyName]) + SNewLine2 +
- FmtSetupMessage(msgErrorFunctionFailedWithMessage,
- [FuncNames[Func], IntToStr(ErrorCode), Win32ErrorString(ErrorCode)]));
- end;
- procedure RegisterUninstallInfo(const UninstallRegKeyBaseName: String; const AfterInstallFilesSize: Integer64);
- { Stores uninstall information in the Registry so that the program can be
- uninstalled through the Control Panel Add/Remove Programs applet. }
- const
- AdminInstallModeNames: array [Boolean] of String =
- ('non administrative', 'administrative');
- BitInstallModeNames: array [Boolean] of String =
- ('32-bit', '64-bit');
- var
- RegView, OppositeRegView: TRegView;
- RegViewIs64Bit, OppositeRegViewIs64Bit: Boolean;
- RootKey, OppositeRootKey: HKEY;
- RootKeyIsHKLM, OppositeRootKeyIsHKLM: Boolean;
- SubkeyName: String;
- procedure SetStringValue(const K: HKEY; const ValueName: PChar;
- const Data: String);
- var
- ErrorCode: Longint;
- begin
- ErrorCode := RegSetValueEx(K, ValueName, 0, REG_SZ, PChar(Data),
- (Length(Data)+1)*SizeOf(Data[1]));
- if ErrorCode <> ERROR_SUCCESS then
- RegError(reRegSetValueEx, RootKey, SubkeyName, ErrorCode);
- end;
- procedure SetStringValueUnlessEmpty(const K: HKEY; const ValueName: PChar;
- const Data: String);
- begin
- if Data <> '' then
- SetStringValue(K, ValueName, Data);
- end;
- procedure SetDWordValue(const K: HKEY; const ValueName: PChar;
- const Data: DWord);
- var
- ErrorCode: Longint;
- begin
- ErrorCode := RegSetValueEx(K, ValueName, 0, REG_DWORD, @Data,
- SizeOf(Data));
- if ErrorCode <> ERROR_SUCCESS then
- RegError(reRegSetValueEx, RootKey, SubkeyName, ErrorCode);
- end;
- function GetInstallDateString: String;
- var
- ST: TSystemTime;
- begin
- GetLocalTime(ST);
- Result := Format('%.4u%.2u%.2u', [ST.wYear, ST.wMonth, ST.wDay]);
- end;
- function ExtractMajorMinorVersion(Version: String; var Major, Minor: Integer): Boolean;
- var
- P, I: Integer;
- begin
- P := Pos('.', Version);
- if P <> 0 then begin
- Val(Copy(Version, 1, P-1), Major, I);
- if I = 0 then begin
- Delete(Version, 1, P);
- P := Pos('.', Version);
- if P <> 0 then
- Val(Copy(Version, 1, P-1), Minor, I)
- else
- Val(Version, Minor, I);
- end;
- end else begin
- Val(Version, Major, I);
- Minor := 0;
- end;
- Result := I = 0;
- end;
- { Also see Main.pas }
- function ExistingInstallationAt(const RegView: TRegView; const RootKey: HKEY): Boolean;
- var
- K: HKEY;
- begin
- if RegOpenKeyExView(RegView, RootKey, PChar(SubkeyName), 0, KEY_QUERY_VALUE, K) = ERROR_SUCCESS then begin
- Result := True;
- RegCloseKey(K);
- end else
- Result := False;
- end;
- procedure HandleDuplicateDisplayNames(var DisplayName: String);
- const
- UninstallDisplayNameMarksUser: array [Boolean] of TSetupMessageId =
- (msgUninstallDisplayNameMarkCurrentUser, msgUninstallDisplayNameMarkAllUsers);
- UninstallDisplayNameMarksBits: array [Boolean] of TSetupMessageId =
- (msgUninstallDisplayNameMark32Bit, msgUninstallDisplayNameMark64Bit);
- var
- ExistingAtOppositeAdminInstallMode, ExistingAtOpposite64BitInstallMode: Boolean;
- begin
- { Check opposite administrative install mode. }
- ExistingAtOppositeAdminInstallMode := ExistingInstallationAt(RegView, OppositeRootKey);
- if RootKeyIsHKLM or not IsWin64 then begin
- { Opposite (HKCU) is shared for 32-bit and 64-bit so don't log bitness. Also don't log bitness on a 32-bit system. }
- LogFmt('Detected previous %s install? %s',
- [AdminInstallModeNames[OppositeRootKeyIsHKLM {always False}], SYesNo[ExistingAtOppositeAdminInstallMode]])
- end else begin
- { Opposite (HKLM) is not shared for 32-bit and 64-bit so log bitness. }
- LogFmt('Detected previous %s %s install? %s',
- [AdminInstallModeNames[OppositeRootKeyIsHKLM {always True}], BitInstallModeNames[RegViewIs64Bit], SYesNo[ExistingAtOppositeAdminInstallMode]]);
- end;
- if IsWin64 then begin
- { Check opposite 32-bit or 64-bit install mode. }
- if RootKeyIsHKLM then begin
- { HKLM is not shared for 32-bit and 64-bit so check it for opposite 32-bit or 64-bit install mode. Not checking HKCU
- since HKCU is shared for 32-bit and 64-bit mode and we already checked HKCU above. }
- ExistingAtOpposite64BitInstallMode := ExistingInstallationAt(OppositeRegView, RootKey {always HKLM});
- LogFmt('Detected previous %s %s install? %s',
- [AdminInstallModeNames[RootKeyIsHKLM {always True}], BitInstallModeNames[OppositeRegViewIs64Bit], SYesNo[ExistingAtOpposite64BitInstallMode]]);
- end else begin
- { HKCU is shared for 32-bit and 64-bit so not checking it but we do still need to check HKLM for opposite 32-bit or
- 64-bit install mode since we haven't already done that. }
- ExistingAtOpposite64BitInstallMode := ExistingInstallationAt(OppositeRegView, OppositeRootKey {always HKLM});
- if ExistingAtOpposite64BitInstallMode then
- ExistingAtOppositeAdminInstallMode := True;
- LogFmt('Detected previous %s %s install? %s',
- [AdminInstallModeNames[OppositeRootKeyIsHKLM {always True}], BitInstallModeNames[OppositeRegViewIs64Bit], SYesNo[ExistingAtOpposite64BitInstallMode]]);
- end;
- end else
- ExistingAtOpposite64BitInstallMode := False;
-
- { Mark new display name if needed. Note: currently we don't attempt to mark existing display names as well. }
- if ExistingAtOppositeAdminInstallMode or ExistingAtOpposite64BitInstallMode then begin
- if ExistingAtOppositeAdminInstallMode and ExistingAtOpposite64BitInstallMode then
- DisplayName := FmtSetupMessage(msgUninstallDisplayNameMarks,
- [DisplayName, SetupMessages[UninstallDisplayNameMarksUser[RootKeyIsHKLM]],
- SetupMessages[UninstallDisplayNameMarksBits[RegViewIs64Bit]]])
- else if ExistingAtOppositeAdminInstallMode then
- DisplayName := FmtSetupMessage(msgUninstallDisplayNameMark,
- [DisplayName, SetupMessages[UninstallDisplayNameMarksUser[RootKeyIsHKLM]]])
- else
- DisplayName := FmtSetupMessage(msgUninstallDisplayNameMark,
- [DisplayName, SetupMessages[UninstallDisplayNameMarksBits[RegViewIs64Bit]]]);
- LogFmt('Marked uninstall display name to avoid duplicate entries. New display name: %s', [DisplayName]);
- end;
- end;
- var
- H2: HKEY;
- ErrorCode: Longint;
- Z: String;
- MajorVersion, MinorVersion, I: Integer;
- EstimatedSize: Integer64;
- begin
- RegView := InstallDefaultRegView;
- RegViewIs64Bit := RegView = rv64Bit;
- if RegViewIs64Bit then
- OppositeRegView := rv32Bit
- else
- OppositeRegView := rv64Bit;
- OppositeRegViewIs64Bit := not RegViewIs64Bit;
- RootKey := InstallModeRootKey;
- RootKeyIsHKLM := RootKey = HKEY_LOCAL_MACHINE;
- if RootKeyIsHKLM then
- OppositeRootKey := HKEY_CURRENT_USER
- else
- OppositeRootKey := HKEY_LOCAL_MACHINE;
- OppositeRootKeyIsHKLM := not RootKeyIsHKLM;
- SubkeyName := GetUninstallRegSubkeyName(UninstallRegKeyBaseName);
- if ExistingInstallationAt(RegView, RootKey) then begin
- if RootKeyIsHKLM then begin
- { HKLM is not shared for 32-bit and 64-bit so log bitness. }
- LogFmt('Deleting uninstall key left over from previous %s %s install.',
- [AdminInstallModeNames[RootKeyIsHKLM {always True}], BitInstallModeNames[RegViewIs64Bit]]);
- end else begin
- { HKCU is shared for 32-bit and 64-bit so don't log bitness. }
- LogFmt('Deleting uninstall key left over from previous %s install.',
- [AdminInstallModeNames[RootKeyIsHKLM {always False}]])
- end;
- RegDeleteKeyIncludingSubkeys(RegView, RootKey, PChar(SubkeyName));
- end;
- LogFmt('Creating new uninstall key: %s\%s', [GetRegRootKeyName(RootKey), SubkeyName]);
- { Create uninstall key }
- ErrorCode := RegCreateKeyExView(RegView, RootKey, PChar(SubkeyName),
- 0, nil, REG_OPTION_NON_VOLATILE, KEY_SET_VALUE, nil, H2, nil);
- if ErrorCode <> ERROR_SUCCESS then
- RegError(reRegCreateKeyEx, RootKey, SubkeyName, ErrorCode);
-
- try
- Log('Writing uninstall key values.');
-
- { do not localize or change any of the following strings }
- SetStringValue(H2, 'Inno Setup: Setup Version', SetupVersion);
- if shCreateAppDir in SetupHeader.Options then
- Z := WizardDirValue
- else
- Z := '';
- SetStringValue(H2, 'Inno Setup: App Path', Z);
- SetStringValueUnlessEmpty(H2, 'InstallLocation', AddBackslash(Z));
- SetStringValue(H2, 'Inno Setup: Icon Group', WizardGroupValue);
- if WizardNoIcons then
- SetDWordValue(H2, 'Inno Setup: No Icons', 1);
- SetStringValue(H2, 'Inno Setup: User', GetUserNameString);
- if WizardSetupType <> nil then begin
- SetStringValue(H2, 'Inno Setup: Setup Type', WizardSetupType.Name);
- SetStringValue(H2, 'Inno Setup: Selected Components', StringsToCommaString(WizardComponents));
- SetStringValue(H2, 'Inno Setup: Deselected Components', StringsToCommaString(WizardDeselectedComponents));
- end;
- if HasTasks then begin
- SetStringValue(H2, 'Inno Setup: Selected Tasks', StringsToCommaString(WizardTasks));
- SetStringValue(H2, 'Inno Setup: Deselected Tasks', StringsToCommaString(WizardDeselectedTasks));
- end;
- if shUserInfoPage in SetupHeader.Options then begin
- SetStringValue(H2, 'Inno Setup: User Info: Name', WizardUserInfoName);
- SetStringValue(H2, 'Inno Setup: User Info: Organization', WizardUserInfoOrg);
- SetStringValue(H2, 'Inno Setup: User Info: Serial', WizardUserInfoSerial);
- end;
- SetStringValue(H2, 'Inno Setup: Language', PSetupLanguageEntry(Entries[seLanguage][ActiveLanguage]).Name);
- if SetupHeader.UninstallDisplayName <> '' then
- Z := ExpandConst(SetupHeader.UninstallDisplayName)
- else
- Z := ExpandedAppVerName;
- HandleDuplicateDisplayNames(Z);
- { For the entry to appear in ARP, DisplayName cannot exceed 259 characters
- on Windows 2000 and later. }
- SetStringValue(H2, 'DisplayName', Copy(Z, 1, 259));
- SetStringValueUnlessEmpty(H2, 'DisplayIcon', ExpandConst(SetupHeader.UninstallDisplayIcon));
- var ExtraUninstallString: String;
- if shUninstallLogging in SetupHeader.Options then
- ExtraUninstallString := ' /LOG'
- else
- ExtraUninstallString := '';
- SetStringValue(H2, 'UninstallString', '"' + UninstallExeFilename + '"' + ExtraUninstallString);
- SetStringValue(H2, 'QuietUninstallString', '"' + UninstallExeFilename + '" /SILENT' + ExtraUninstallString);
- SetStringValueUnlessEmpty(H2, 'DisplayVersion', ExpandConst(SetupHeader.AppVersion));
- SetStringValueUnlessEmpty(H2, 'Publisher', ExpandConst(SetupHeader.AppPublisher));
- SetStringValueUnlessEmpty(H2, 'URLInfoAbout', ExpandConst(SetupHeader.AppPublisherURL));
- SetStringValueUnlessEmpty(H2, 'HelpTelephone', ExpandConst(SetupHeader.AppSupportPhone));
- SetStringValueUnlessEmpty(H2, 'HelpLink', ExpandConst(SetupHeader.AppSupportURL));
- SetStringValueUnlessEmpty(H2, 'URLUpdateInfo', ExpandConst(SetupHeader.AppUpdatesURL));
- SetStringValueUnlessEmpty(H2, 'Readme', ExpandConst(SetupHeader.AppReadmeFile));
- SetStringValueUnlessEmpty(H2, 'Contact', ExpandConst(SetupHeader.AppContact));
- SetStringValueUnlessEmpty(H2, 'Comments', ExpandConst(SetupHeader.AppComments));
- Z := ExpandConst(SetupHeader.AppModifyPath);
- if Z <> '' then
- SetStringValue(H2, 'ModifyPath', Z)
- else
- SetDWordValue(H2, 'NoModify', 1);
- SetDWordValue(H2, 'NoRepair', 1);
- SetStringValue(H2, 'InstallDate', GetInstallDateString);
- if ExtractMajorMinorVersion(ExpandConst(SetupHeader.AppVersion), MajorVersion, MinorVersion) then begin
- { Originally MSDN said to write to Major/MinorVersion, now it says to write to VersionMajor/Minor. So write to both. }
- SetDWordValue(H2, 'MajorVersion', MajorVersion);
- SetDWordValue(H2, 'MinorVersion', MinorVersion);
- SetDWordValue(H2, 'VersionMajor', MajorVersion);
- SetDWordValue(H2, 'VersionMinor', MinorVersion);
- end;
- { Note: Windows 7 (and later?) doesn't automatically calculate sizes so set EstimatedSize ourselves. }
- if (SetupHeader.UninstallDisplaySize.Hi = 0) and (SetupHeader.UninstallDisplaySize.Lo = 0) then begin
- { Estimate the size by taking the size of all files and adding any ExtraDiskSpaceRequired. }
- EstimatedSize := AfterInstallFilesSize;
- Inc6464(EstimatedSize, SetupHeader.ExtraDiskSpaceRequired);
- for I := 0 to Entries[seComponent].Count-1 do begin
- with PSetupComponentEntry(Entries[seComponent][I])^ do begin
- if ShouldProcessEntry(WizardComponents, nil, Name, '', Languages, '') then
- Inc6464(EstimatedSize, ExtraDiskSpaceRequired);
- end;
- end;
- end else
- EstimatedSize := SetupHeader.UninstallDisplaySize;
- { ARP on Windows 7 without SP1 only pays attention to the lower 6 bytes of EstimatedSize and
- throws away the rest. For example putting in $4000001 (=4GB + 1KB) displays as 1 KB.
- So we need to check for this. }
- if (Hi(NTServicePackLevel) > 0) or IsWindows8 or (EstimatedSize.Hi = 0) then begin
- Div64(EstimatedSize, 1024);
- SetDWordValue(H2, 'EstimatedSize', EstimatedSize.Lo)
- end;
- { Also see SetPreviousData in ScriptFunc.pas }
- if CodeRunner <> nil then begin
- try
- CodeRunner.RunProcedures('RegisterPreviousData', [Integer(H2)], False);
- except
- Log('RegisterPreviousData raised an exception.');
- Application.HandleException(nil);
- end;
- end;
- finally
- RegCloseKey(H2);
- end;
- UninstLog.AddReg(utRegDeleteEntireKey, RegView, RootKey,
- [SubkeyName]);
- end;
- type
- TMakeDirFlags = set of (mdNoUninstall, mdAlwaysUninstall, mdDeleteAfterInstall,
- mdNotifyChange);
- function MakeDir(const DisableFsRedir: Boolean; Dir: String;
- const Flags: TMakeDirFlags): Boolean;
- { Returns True if a new directory was created.
- Note: If DisableFsRedir is True, the mdNotifyChange flag should not be
- specified; it won't work properly. }
- var
- ErrorCode: DWORD;
- UninstFlags: Longint;
- begin
- Result := False;
- Dir := RemoveBackslashUnlessRoot(PathExpand(Dir));
- if PathExtractName(Dir) = '' then { reached root? }
- Exit;
- if DirExistsRedir(DisableFsRedir, Dir) then begin
- if not(mdAlwaysUninstall in Flags) then
- Exit;
- end
- else begin
- MakeDir(DisableFsRedir, PathExtractDir(Dir), Flags - [mdAlwaysUninstall]);
- LogFmt('Creating directory: %s', [Dir]);
- if not CreateDirectoryRedir(DisableFsRedir, Dir) then begin
- ErrorCode := GetLastError;
- raise Exception.Create(FmtSetupMessage(msgLastErrorMessage,
- [FmtSetupMessage1(msgErrorCreatingDir, Dir), IntToStr(ErrorCode),
- Win32ErrorString(ErrorCode)]));
- end;
- Result := True;
- if mdNotifyChange in Flags then begin
- SHChangeNotify(SHCNE_MKDIR, SHCNF_PATH, PChar(Dir), nil);
- SHChangeNotify(SHCNE_UPDATEDIR, SHCNF_PATH or SHCNF_FLUSH,
- PChar(PathExtractDir(Dir)), nil);
- end;
- end;
- if mdDeleteAfterInstall in Flags then
- DeleteDirsAfterInstallList.AddObject(Dir, Pointer(Ord(DisableFsRedir)))
- else begin
- if not(mdNoUninstall in Flags) then begin
- UninstFlags := utDeleteDirOrFiles_IsDir;
- if DisableFsRedir then
- UninstFlags := UninstFlags or utDeleteDirOrFiles_DisableFsRedir;
- if mdNotifyChange in Flags then
- UninstFlags := UninstFlags or utDeleteDirOrFiles_CallChangeNotify;
- UninstLog.Add(utDeleteDirOrFiles, [Dir], UninstFlags);
- end;
- end;
- end;
- procedure CreateDirs;
- { Creates the application's directories }
- procedure ApplyPermissions(const DisableFsRedir: Boolean;
- const Filename: String; const PermsEntry: Integer);
- var
- P: PSetupPermissionEntry;
- begin
- if PermsEntry <> -1 then begin
- LogFmt('Setting permissions on directory: %s', [Filename]);
- P := Entries[sePermission][PermsEntry];
- if not GrantPermissionOnFile(DisableFsRedir, Filename,
- TGrantPermissionEntry(Pointer(P.Permissions)^),
- Length(P.Permissions) div SizeOf(TGrantPermissionEntry)) then
- LogFmt('Failed to set permissions on directory (%d).', [GetLastError]);
- end;
- end;
- procedure ApplyNTFSCompression(const DisableFsRedir: Boolean;
- const Filename: String; const Compress: Boolean);
- begin
- if Compress then
- LogFmt('Setting NTFS compression on directory: %s', [Filename])
- else
- LogFmt('Unsetting NTFS compression on directory: %s', [Filename]);
- if not SetNTFSCompressionRedir(DisableFsRedir, Filename, Compress) then
- LogFmt('Failed to set NTFS compression state (%d).', [GetLastError]);
- end;
- var
- CurDirNumber: Integer;
- Flags: TMakeDirFlags;
- N: String;
- begin
- { Create main application directory }
- MakeDir(InstallDefaultDisableFsRedir, WizardDirValue, []);
- { Create the rest of the directories, if any }
- for CurDirNumber := 0 to Entries[seDir].Count-1 do
- with PSetupDirEntry(Entries[seDir][CurDirNumber])^ do begin
- if ShouldProcessEntry(WizardComponents, WizardTasks, Components, Tasks, Languages, Check) then begin
- DebugNotifyEntry(seDir, CurDirNumber);
- NotifyBeforeInstallEntry(BeforeInstall);
- Flags := [];
- if doUninsNeverUninstall in Options then Include(Flags, mdNoUninstall);
- if doDeleteAfterInstall in Options then Include(Flags, mdDeleteAfterInstall);
- if doUninsAlwaysUninstall in Options then Include(Flags, mdAlwaysUninstall);
- N := RemoveBackslashUnlessRoot(PathExpand(ExpandConst(DirName)));
- MakeDir(InstallDefaultDisableFsRedir, N, Flags);
- AddAttributesToFile(InstallDefaultDisableFsRedir, N, Attribs);
- ApplyPermissions(InstallDefaultDisableFsRedir, N, PermissionsEntry);
- if (doSetNTFSCompression in Options) or (doUnsetNTFSCompression in Options) then
- ApplyNTFSCompression(InstallDefaultDisableFsRedir, N, doSetNTFSCompression in Options);
- NotifyAfterInstallEntry(AfterInstall);
- end;
- end;
- end;
- procedure WriteMsgData(const F: TFile);
- var
- MsgLangOpts: TMessagesLangOptions;
- LangEntry: PSetupLanguageEntry;
- begin
- FillChar(MsgLangOpts, SizeOf(MsgLangOpts), 0);
- MsgLangOpts.ID := MessagesLangOptionsID;
- StrPLCopy(MsgLangOpts.DialogFontName, LangOptions.DialogFontName,
- (SizeOf(MsgLangOpts.DialogFontName) div SizeOf(MsgLangOpts.DialogFontName[0])) - 1);
- MsgLangOpts.DialogFontSize := LangOptions.DialogFontSize;
- if LangOptions.RightToLeft then
- Include(MsgLangOpts.Flags, lfRightToLeft);
- LangEntry := Entries[seLanguage][ActiveLanguage];
- F.WriteBuffer(LangEntry.Data[1], Length(LangEntry.Data));
- F.WriteBuffer(MsgLangOpts, SizeOf(MsgLangOpts));
- end;
- procedure MarkExeHeader(const F: TFile; const ModeID: Longint);
- begin
- F.Seek(SetupExeModeOffset);
- F.WriteBuffer(ModeID, SizeOf(ModeID));
- end;
- procedure BindUninstallMsgDataToExe(const F: TFile);
- var
- UniqueValue: TSHA256Digest;
- UninstallerMsgTail: TUninstallerMsgTail;
- begin
- F.SeekToEnd;
- { First append the hash of AppId so that unins*.exe files from different
- applications won't have the same file hash. This is done to combat broken
- anti-spyware programs that catch all unins*.exe files with certain hash
- sums just because some piece of spyware was deployed with Inno Setup and
- had the unins*.exe file in its directory. }
- UniqueValue := GetSHA256OfUnicodeString(ExpandedAppId);
- F.WriteBuffer(UniqueValue, SizeOf(UniqueValue));
- UninstallerMsgTail.ID := UninstallerMsgTailID;
- UninstallerMsgTail.Offset := F.Position;
- WriteMsgData(F);
- F.WriteBuffer(UninstallerMsgTail, SizeOf(UninstallerMsgTail));
- end;
- type
- TOverwriteAll = (oaUnknown, oaOverwrite, oaKeep);
- procedure ProcessFileEntry(const CurFile: PSetupFileEntry;
- const DisableFsRedir: Boolean; AExternalSourceFile, ADestFile: String;
- const FileLocationFilenames: TStringList; const AExternalSize: Integer64;
- var ConfirmOverwriteOverwriteAll, PromptIfOlderOverwriteAll: TOverwriteAll;
- var WarnedPerUserFonts: Boolean; const AExternalFileDate: PFileTime);
- { Not external: AExternalSourceFile and ADestFile should be empty strings,
- FileLocationFilenames should be set, AExternalSize is unused,
- AExternalFileDate should not be set
- External : Opposite except AExternalFileDate still not set
- Ext. Archive: Same as external except AExternalFileDate set and
- AExternalSourceFile should be set to ArchiveFindHandle as a string
- Ext. Downl. : Same as external except
- AExternalSourceFile should be set to an URL }
- procedure InstallFont(const Filename, FontName: String;
- const PerUserFont, AddToFontTableNow: Boolean; var WarnedPerUserFonts: Boolean);
- var
- RootKey, K: HKEY;
- begin
- if PerUserFont and not WindowsVersionAtLeast(10, 0, 17134) then begin
- { Per-user fonts require Windows 10 Version 1803 (10.0.17134) or newer. }
- if not WarnedPerUserFonts then begin
- Log('Failed to set value in Fonts registry key: per-user fonts are not supported by this version of Windows.');
- WarnedPerUserFonts := True;
- end;
- end else begin
- { 64-bit Windows note: The Fonts key is evidently exempt from registry
- redirection. When a 32-bit app writes to the Fonts key, it's the main
- 64-bit key that is modified. (There is actually a Fonts key under
- Wow6432Node but it appears it's never used or updated.)
- Also: We don't bother with any FS redirection stuff here. I'm not sure
- it's safe to disable FS redirection when calling AddFontResource, or
- if it would even work. Users should be installing their fonts to the
- Fonts directory instead of the System directory anyway. }
- if PerUserFont then
- RootKey := HKEY_CURRENT_USER
- else
- RootKey := HKEY_LOCAL_MACHINE;
- if RegOpenKeyExView(rvDefault, RootKey, 'Software\Microsoft\Windows NT\CurrentVersion\Fonts', 0,
- KEY_SET_VALUE, K) = ERROR_SUCCESS then begin
- if RegSetValueEx(K, PChar(FontName), 0, REG_SZ, PChar(Filename),
- (Length(Filename)+1)*SizeOf(Filename[1])) <> ERROR_SUCCESS then
- Log('Failed to set value in Fonts registry key.');
- RegCloseKey(K);
- end
- else
- Log('Failed to open Fonts registry key.');
- end;
-
- if AddToFontTableNow then begin
- repeat
- { Note: AddFontResource doesn't set the thread's last error code }
- if AddFontResource(PChar(Filename)) <> 0 then begin
- SendNotifyMessage(HWND_BROADCAST, WM_FONTCHANGE, 0, 0);
- Break;
- end;
- until AbortRetryIgnoreTaskDialogMsgBox(
- AddPeriod(FmtSetupMessage1(msgErrorFunctionFailedNoCode, 'AddFontResource')),
- [SetupMessages[msgAbortRetryIgnoreRetry], SetupMessages[msgAbortRetryIgnoreIgnore], SetupMessages[msgAbortRetryIgnoreCancel]]);
- end;
- end;
- procedure SetFileLocationFilename(const LocationEntry: Integer;
- Filename: String);
- var
- LowercaseFilename: String;
- Hash: Longint;
- I: Integer;
- begin
- Filename := PathExpand(Filename);
- LowercaseFilename := PathLowercase(Filename);
- Hash := GetCRC32(LowercaseFilename[1], Length(LowercaseFilename)*SizeOf(LowercaseFilename[1]));
- { If Filename was already associated with another LocationEntry,
- disassociate it. If we *don't* do this, then this script won't
- produce the expected result:
- [Files]
- Source: "fileA"; DestName: "file2"
- Source: "fileB"; DestName: "file2"
- Source: "fileA"; DestName: "file1"
- 1. It extracts fileA under the name "file2"
- 2. It extracts fileB under the name "file2"
- 3. It copies file2 to file1, thinking a copy of fileA was still
- stored in file2.
- }
- for I := 0 to FileLocationFilenames.Count-1 do
- if (Longint(FileLocationFilenames.Objects[I]) = Hash) and
- (PathLowercase(FileLocationFilenames[I]) = LowercaseFilename) then begin
- FileLocationFilenames[I] := '';
- FileLocationFilenames.Objects[I] := nil;
- Break;
- end;
- FileLocationFilenames[LocationEntry] := Filename;
- FileLocationFilenames.Objects[LocationEntry] := Pointer(Hash);
- end;
- procedure ApplyPermissions(const DisableFsRedir: Boolean;
- const Filename: String; const PermsEntry: Integer);
- var
- Attr: DWORD;
- P: PSetupPermissionEntry;
- begin
- if PermsEntry <> -1 then begin
- Attr := GetFileAttributesRedir(DisableFsRedir, Filename);
- if (Attr <> INVALID_FILE_ATTRIBUTES) and (Attr and FILE_ATTRIBUTE_DIRECTORY = 0) then begin
- LogFmt('Setting permissions on file: %s', [Filename]);
- P := Entries[sePermission][PermsEntry];
- if not GrantPermissionOnFile(DisableFsRedir, Filename,
- TGrantPermissionEntry(Pointer(P.Permissions)^),
- Length(P.Permissions) div SizeOf(TGrantPermissionEntry)) then
- LogFmt('Failed to set permissions on file (%d).', [GetLastError]);
- end;
- end;
- end;
- procedure ApplyNTFSCompression(const DisableFsRedir: Boolean;
- const Filename: String; const Compress: Boolean);
- begin
- if Compress then
- LogFmt('Setting NTFS compression on file: %s', [Filename])
- else
- LogFmt('Unsetting NTFS compression on file: %s', [Filename]);
- if not SetNTFSCompressionRedir(DisableFsRedir, Filename, Compress) then
- LogFmt('Failed to set NTFS compression state (%d).', [GetLastError]);
- end;
- procedure DoHandleFailedDeleteOrMoveFileTry(const Func, TempFile, DestFile: String;
- const LastError: DWORD; var RetriesLeft: Integer; var LastOperation: String;
- var NeedsRestart, ReplaceOnRestart, DoBreak, DoContinue: Boolean);
- begin
- { Automatically retry. Wait with replace on restart until no
- retries left, unless we already know we're going to restart. }
- if ((RetriesLeft = 0) or NeedsRestart) and
- (foRestartReplace in CurFile^.Options) and IsAdmin then begin
- LogFmt('%s: The existing file appears to be in use (%d). ' +
- 'Will replace on restart.', [Func, LastError]);
- LastOperation := SetupMessages[msgErrorRestartReplace];
- NeedsRestart := True;
- RestartReplace(DisableFsRedir, TempFile, DestFile);
- ReplaceOnRestart := True;
- DoBreak := True;
- DoContinue := False;
- end else if RetriesLeft > 0 then begin
- LogFmt('%s: The existing file appears to be in use (%d). ' +
- 'Retrying.', [Func, LastError]);
- Dec(RetriesLeft);
- Sleep(1000);
- ProcessEvents;
- DoBreak := False;
- DoContinue := True;
- end else begin
- DoBreak := False;
- DoContinue := False;
- end;
- end;
- function AskOverwrite(const DestFile, Instruction, Caption: string; const ButtonLabels: array of String;
- const VerificationText: String; const Typ: TMsgBoxType; const Default, Overwrite: Integer;
- var OverwriteAll: TOverwriteAll): Boolean;
- var
- VerificationFlagChecked: BOOL;
- begin
- if OverwriteAll = oaKeep then
- Result := False { The user already said to keep (=not overwrite) all }
- else begin
- Result := LoggedTaskDialogMsgBox('', Instruction, DestFile + SNewLine2 + Caption, '',
- Typ, MB_YESNO, ButtonLabels, 0, True, Default, VerificationText, @VerificationFlagChecked) = Overwrite;
- if VerificationFlagChecked then begin
- if Result then
- OverwriteAll := oaOverwrite
- else
- OverwriteAll := oaKeep;
- end;
- end;
- end;
- var
- ProgressUpdated: Boolean;
- PreviousProgress: Integer64;
- LastOperation: String;
- CurFileLocation: PSetupFileLocationEntry;
- SourceFile, DestFile, TempFile, FontFilename: String;
- DestFileExists, DestFileExistedBefore, CheckedDestFileExistedBefore,
- TempFileLeftOver, AllowFileToBeDuplicated, ReplaceOnRestart, DoBreak,
- DoContinue: Boolean;
- Failed: String;
- CurFileVersionInfoValid: Boolean;
- CurFileVersionInfo, ExistingVersionInfo: TFileVersionNumbers;
- CurFileDateValid, ExistingFileDateValid: Boolean;
- IsProtectedFile, AllowTimeStampComparison: Boolean;
- DeleteFlags: Longint;
- CurFileDate, ExistingFileDate: TFileTime;
- RegisterRec: PRegisterFilesListRec;
- RetriesLeft: Integer;
- LastError: DWORD;
- DestF, SourceF: TFile;
- Flags: TMakeDirFlags;
- Overwrite, PerUserFont: Boolean;
- label Retry, Skip;
- begin
- Log('-- File entry --');
- CheckedDestFileExistedBefore := False;
- DestFileExistedBefore := False; { prevent warning }
- if CurFile^.LocationEntry <> -1 then
- CurFileLocation := PSetupFileLocationEntry(Entries[seFileLocation][CurFile^.LocationEntry])
- else
- CurFileLocation := nil;
- Retry:
- DestFile := '';
- TempFile := '';
- TempFileLeftOver := False;
- ProgressUpdated := False;
- PreviousProgress := CurProgress;
- LastOperation := '';
- Failed := '';
- try
- try
- ReplaceOnRestart := False;
- DeleteFlags := 0;
- if DisableFsRedir then
- DeleteFlags := DeleteFlags or utDeleteFile_DisableFsRedir;
- if foRegisterServer in CurFile^.Options then
- DeleteFlags := DeleteFlags or utDeleteFile_RegisteredServer;
- if foRegisterTypeLib in CurFile^.Options then
- DeleteFlags := DeleteFlags or utDeleteFile_RegisteredTypeLib;
- if foUninsRestartDelete in CurFile^.Options then
- DeleteFlags := DeleteFlags or utDeleteFile_RestartDelete;
- if foUninsRemoveReadOnly in CurFile^.Options then
- DeleteFlags := DeleteFlags or utDeleteFile_RemoveReadOnly;
- if foGacInstall in CurFile^.Options then
- DeleteFlags := DeleteFlags or utDeleteFile_GacInstalled;
- FontFilename := '';
- { Determine the destination filename }
- try
- case CurFile^.FileType of
- ftUninstExe: DestFile := UninstallExeFilename;
- else
- if ADestFile = '' then
- DestFile := ExpandConst(CurFile^.DestName)
- else
- DestFile := ADestFile;
- end;
- DestFile := PathExpand(DestFile);
- except
- { If an exception occurred, reset DestFile back to an empty string
- so the error message doesn't show an unexpanded name }
- DestFile := '';
- raise;
- end;
- { Update the status and filename labels }
- if foDownload in CurFile^.Options then
- SetStatusLabelText(SetupMessages[msgStatusDownloadFiles], False)
- else
- SetStatusLabelText(SetupMessages[msgStatusExtractFiles], False);
- SetFilenameLabelText(DestFile, True);
- LogFmt('Dest filename: %s', [DestFile]);
- if DisableFsRedir <> InstallDefaultDisableFsRedir then begin
- if DisableFsRedir then
- Log('Non-default bitness: 64-bit')
- else
- Log('Non-default bitness: 32-bit');
- end;
- { See if it's a protected system file. }
- if IsProtectedSystemFile(DisableFsRedir, DestFile) then begin
- Log('Dest file is protected by Windows File Protection.');
- IsProtectedFile := (CurFile^.FileType = ftUserFile);
- end else
- IsProtectedFile := False;
- DestFileExists := NewFileExistsRedir(DisableFsRedir, DestFile);
- if not CheckedDestFileExistedBefore then begin
- DestFileExistedBefore := DestFileExists;
- CheckedDestFileExistedBefore := True;
- end;
- if DestFileExistedBefore then
- DeleteFlags := DeleteFlags or utDeleteFile_ExistedBeforeInstall;
- var CurFileDateDidRead := True; { Set to False later if needed }
- if Assigned(CurFileLocation) then begin
- if floTimeStampInUTC in CurFileLocation^.Flags then
- CurFileDate := CurFileLocation^.SourceTimeStamp
- else
- LocalFileTimeToFileTime(CurFileLocation^.SourceTimeStamp, CurFileDate);
- CurFileDateValid := True;
- end else if Assigned(AExternalFileDate) then begin
- CurFileDate := AExternalFileDate^;
- CurFileDateValid := CurFileDate.HasTime;
- end else if not(foDownload in CurFile^.Options) then
- CurFileDateValid := GetFileDateTime(DisableFsRedir, AExternalSourceFile, CurFileDate)
- else begin
- CurFileDateValid := False;
- CurFileDateDidRead := False;
- end;
- if CurFileDateValid then
- LogFmt('Time stamp of our file: %s', [FileTimeToStr(CurFileDate)])
- else if CurFileDateDidRead then
- Log('Time stamp of our file: (failed to read)');
- if DestFileExists then begin
- Log('Dest file exists.');
- if foOnlyIfDoesntExist in CurFile^.Options then begin
- Log('Skipping due to "onlyifdoesntexist" flag.');
- goto Skip;
- end;
- LastOperation := SetupMessages[msgErrorReadingExistingDest];
- ExistingFileDateValid := GetFileDateTime(DisableFsRedir, DestFile, ExistingFileDate);
- if ExistingFileDateValid then
- LogFmt('Time stamp of existing file: %s', [FileTimeToStr(ExistingFileDate)])
- else
- Log('Time stamp of existing file: (failed to read)');
- { Compare version info }
- if not(foIgnoreVersion in CurFile^.Options) then begin
- AllowTimeStampComparison := False;
- { Read version info of file being installed }
- if foDownload in CurFile^.Options then
- InternalError('Unexpected Download flag');
- if foExtractArchive in CurFile^.Options then
- InternalError('Unexpected ExtractArchive flag');
- if Assigned(CurFileLocation) then begin
- CurFileVersionInfoValid := floVersionInfoValid in CurFileLocation^.Flags;
- CurFileVersionInfo.MS := CurFileLocation^.FileVersionMS;
- CurFileVersionInfo.LS := CurFileLocation^.FileVersionLS;
- end
- else
- CurFileVersionInfoValid := GetVersionNumbersRedir(DisableFsRedir,
- PathExpand(AExternalSourceFile), CurFileVersionInfo);
- if CurFileVersionInfoValid then
- LogFmt('Version of our file: %u.%u.%u.%u',
- [LongRec(CurFileVersionInfo.MS).Hi, LongRec(CurFileVersionInfo.MS).Lo,
- LongRec(CurFileVersionInfo.LS).Hi, LongRec(CurFileVersionInfo.LS).Lo])
- else
- Log('Version of our file: (none)');
- { Does the existing file have version info? }
- if GetVersionNumbersRedir(DisableFsRedir, PathExpand(DestFile), ExistingVersionInfo) then begin
- { If the file being installed has no version info, or the existing
- file is a newer version... }
- LogFmt('Version of existing file: %u.%u.%u.%u',
- [LongRec(ExistingVersionInfo.MS).Hi, LongRec(ExistingVersionInfo.MS).Lo,
- LongRec(ExistingVersionInfo.LS).Hi, LongRec(ExistingVersionInfo.LS).Lo]);
- if not CurFileVersionInfoValid or
- ((ExistingVersionInfo.MS > CurFileVersionInfo.MS) or
- ((ExistingVersionInfo.MS = CurFileVersionInfo.MS) and
- (ExistingVersionInfo.LS > CurFileVersionInfo.LS))) then begin
- { No version info, or existing file is newer, ask user what to do unless we shouldn't }
- if (foPromptIfOlder in CurFile^.Options) and not IsProtectedFile then begin
- if PromptIfOlderOverwriteAll <> oaOverwrite then begin
- Overwrite := AskOverwrite(DestFile, SetupMessages[msgExistingFileNewerSelectAction],
- SetupMessages[msgExistingFileNewer2],
- [SetupMessages[msgExistingFileNewerKeepExisting], SetupMessages[msgExistingFileNewerOverwriteExisting]],
- SetupMessages[msgExistingFileNewerOverwriteOrKeepAll],
- mbError, IDYES, IDNO, PromptIfOlderOverwriteAll);
- if not Overwrite then begin
- Log('User opted not to overwrite the existing file. Skipping.');
- goto Skip;
- end;
- end;
- end else begin
- Log('Existing file is a newer version. Skipping.');
- goto Skip;
- end;
- end
- else begin
- { If the existing file and the file being installed are the same
- version... }
- if (ExistingVersionInfo.MS = CurFileVersionInfo.MS) and
- (ExistingVersionInfo.LS = CurFileVersionInfo.LS) and
- not(foOverwriteSameVersion in CurFile^.Options) then begin
- if foReplaceSameVersionIfContentsDiffer in CurFile^.Options then begin
- { Get the two files' SHA-256 hashes and compare them }
- var ExistingFileHash: TSHA256Digest;
- if TryToGetSHA256OfFile(DisableFsRedir, DestFile, ExistingFileHash) then begin
- var CurFileHash: TSHA256Digest;
- if Assigned(CurFileLocation) then
- CurFileHash := CurFileLocation^.SHA256Sum
- else begin
- LastOperation := SetupMessages[msgErrorReadingSource];
- { This GetSHA256OfFile call could raise an exception, but
- it's very unlikely since we were already able to
- successfully read the file's version info. }
- CurFileHash := GetSHA256OfFile(DisableFsRedir, AExternalSourceFile);
- LastOperation := SetupMessages[msgErrorReadingExistingDest];
- end;
- { If the two files' SHA-256 hashes are equal, skip the file }
- if SHA256DigestsEqual(ExistingFileHash, CurFileHash) then begin
- Log('Existing file''s SHA-256 hash matches our file. Skipping.');
- goto Skip;
- end;
- Log('Existing file''s SHA-256 hash is different from our file. Proceeding.');
- end
- else
- Log('Failed to read existing file''s SHA-256 hash. Proceeding.');
- end
- else begin
- { Skip the file or fall back to time stamp comparison }
- if not(foCompareTimeStamp in CurFile^.Options) then begin
- Log('Same version. Skipping.');
- goto Skip;
- end;
- AllowTimeStampComparison := True;
- end;
- end;
- end;
- end
- else begin
- Log('Version of existing file: (none)');
- { If neither the existing file nor our file have version info,
- allow time stamp comparison }
- if not CurFileVersionInfoValid then
- AllowTimeStampComparison := True;
- end;
- end
- else begin
- { When foIgnoreVersion is in Options, always allow time stamp
- comparison }
- AllowTimeStampComparison := True;
- end;
- { Fall back to comparing time stamps if needed }
- if AllowTimeStampComparison and
- (foCompareTimeStamp in CurFile^.Options) then begin
- if foDownload in CurFile^.Options then
- InternalError('Unexpected Download flag');
- if not CurFileDateValid or not ExistingFileDateValid then begin
- { If we failed to read one of the time stamps, do the safe thing
- and just skip the file }
- Log('Couldn''t read time stamp. Skipping.');
- goto Skip;
- end;
- if CompareFileTime(ExistingFileDate, CurFileDate) = 0 then begin
- { Same time stamp }
- Log('Same time stamp. Skipping.');
- goto Skip;
- end;
- if CompareFileTime(ExistingFileDate, CurFileDate) > 0 then begin
- { Existing file has a later time stamp, ask user what to do unless we shouldn't }
- if (foPromptIfOlder in CurFile^.Options) and not IsProtectedFile then begin
- if PromptIfOlderOverwriteAll <> oaOverwrite then begin
- Overwrite := AskOverwrite(DestFile, SetupMessages[msgExistingFileNewerSelectAction],
- SetupMessages[msgExistingFileNewer2],
- [SetupMessages[msgExistingFileNewerKeepExisting], SetupMessages[msgExistingFileNewerOverwriteExisting]],
- SetupMessages[msgExistingFileNewerOverwriteOrKeepAll],
- mbError, IDYES, IDNO, PromptIfOlderOverwriteAll);
- if not Overwrite then begin
- Log('User opted not to overwrite the existing file. Skipping.');
- goto Skip;
- end;
- end;
- end else begin
- Log('Existing file has a later time stamp. Skipping.');
- goto Skip;
- end;
- end;
- end;
- LastOperation := '';
- { Don't attempt to replace an existing protected system file.
- (Do this *after* the version numbers of the new & existing files
- have been logged.) }
- if IsProtectedFile then begin
- Log('Existing file is protected by Windows File Protection. Skipping.');
- goto Skip;
- end;
- { If file already exists and foConfirmOverwrite is in Options, ask the user what to do }
- if foConfirmOverwrite in CurFile^.Options then begin
- if ConfirmOverwriteOverwriteAll <> oaOverwrite then begin
- Overwrite := AskOverwrite(DestFile, SetupMessages[msgFileExistsSelectAction],
- SetupMessages[msgFileExists2],
- [SetupMessages[msgFileExistsOverwriteExisting], SetupMessages[msgFileExistsKeepExisting]],
- SetupMessages[msgFileExistsOverwriteOrKeepAll],
- mbConfirmation, IDNO, IDYES, ConfirmOverwriteOverwriteAll);
- if not Overwrite then begin
- Log('User opted not to overwrite the existing file. Skipping.');
- goto Skip;
- end;
- end;
- end;
- { Check if existing file is read-only }
- while True do begin
- var ExistingFileAttr := GetFileAttributesRedir(DisableFsRedir, DestFile);
- if (ExistingFileAttr <> INVALID_FILE_ATTRIBUTES) and
- (ExistingFileAttr and FILE_ATTRIBUTE_READONLY <> 0) then begin
- if not(foOverwriteReadOnly in CurFile^.Options) and
- AbortRetryIgnoreTaskDialogMsgBox(
- DestFile + SNewLine2 + SetupMessages[msgExistingFileReadOnly2],
- [SetupMessages[msgExistingFileReadOnlyRetry], SetupMessages[msgExistingFileReadOnlyKeepExisting], SetupMessages[msgAbortRetryIgnoreCancel]]) then begin
- Log('User opted not to strip the existing file''s read-only attribute. Skipping.');
- goto Skip;
- end;
- LastOperation := SetupMessages[msgErrorChangingAttr];
- if SetFileAttributesRedir(DisableFsRedir, DestFile,
- ExistingFileAttr and not FILE_ATTRIBUTE_READONLY) then
- Log('Stripped read-only attribute.')
- else
- Log('Failed to strip read-only attribute.');
- if foOverwriteReadOnly in CurFile^.Options then
- Break; { don't retry }
- end
- else
- Break;
- end;
- end
- else begin
- if (foOnlyIfDestFileExists in CurFile^.Options) and not DestFileExistedBefore then begin
- Log('Skipping due to "onlyifdestfileexists" flag.');
- goto Skip;
- end;
- end;
- Log('Installing the file.');
- { Locate source file }
- SourceFile := AExternalSourceFile; { Empty string if not external }
- if DisableFsRedir = InstallDefaultDisableFsRedir then begin
- { If the file is compressed in the setup package, has the same file
- already been copied somewhere else? If so, just make a duplicate of
- that file instead of extracting it over again. }
- if (SourceFile = '') and (FileLocationFilenames <> nil) and
- (FileLocationFilenames[CurFile^.LocationEntry] <> '') and
- NewFileExistsRedir(DisableFsRedir, FileLocationFilenames[CurFile^.LocationEntry]) then
- SourceFile := FileLocationFilenames[CurFile^.LocationEntry];
- AllowFileToBeDuplicated := (SourceFile = '');
- end
- else begin
- { This file uses a non-default FS redirection setting. Files in
- FileLocationFilenames are assumed to have been installed with the
- default FS redirection setting, so we can't use a file in
- FileLocationFilenames as the source, or put this file there. }
- AllowFileToBeDuplicated := False;
- end;
- { Download or extract or copy the file to a temporary file. Create the destination
- file's directory if it didn't already exist. }
- LastOperation := SetupMessages[msgErrorCreatingTemp];
- TempFile := GenerateUniqueName(DisableFsRedir, PathExtractPath(DestFile), '.tmp');
- Flags := [];
- if foUninsNeverUninstall in CurFile^.Options then Include(Flags, mdNoUninstall);
- if foDeleteAfterInstall in CurFile^.Options then Include(Flags, mdDeleteAfterInstall);
- MakeDir(DisableFsRedir, PathExtractDir(TempFile), Flags);
- DestF := TFileRedir.Create(DisableFsRedir, TempFile, fdCreateAlways, faReadWrite, fsNone);
- try
- TempFileLeftOver := True;
- try
- ProgressUpdated := True;
- LastOperation := SetupMessages[msgErrorReadingSource];
- if SourceFile = '' then begin
- { Decompress a file }
- FileExtractor.SeekTo(CurFileLocation^, InternalProgressProc);
- LastOperation := SetupMessages[msgErrorCopying];
- FileExtractor.DecompressFile(CurFileLocation^, DestF, InternalProgressProc,
- not (foDontVerifyChecksum in CurFile^.Options));
- end
- else if foExtractArchive in CurFile^.Options then begin
- { Extract a file from archive. Note: ISSigVerify for archive has
- already been handled by RecurseExternalArchiveCopyFiles. }
- LastOperation := SetupMessages[msgErrorExtracting];
- var MaxProgress := CurProgress;
- Inc6464(MaxProgress, AExternalSize);
- ArchiveFindExtract(StrToInt(SourceFile), DestF, ExternalProgressProc64, MaxProgress);
- end
- else if foDownload in CurFile^.Options then begin
- { Download a file with or without ISSigVerify. Note: estimate of
- extra .issig size has already been added to CurFile's ExternalSize. }
- LastOperation := SetupMessages[msgErrorDownloading];
- const DownloadUserName = ExpandConst(CurFile^.DownloadUserName);
- const DownloadPassword = ExpandConst(CurFile^.DownloadPassword);
- var MaxProgress := CurProgress;
- Inc6464(MaxProgress, AExternalSize);
- if CurFile^.Verification.Typ = fvISSig then begin
- const ISSigTempFile = TempFile + ISSigExt;
- const ISSigDestF = TFileRedir.Create(DisableFsRedir, ISSigTempFile, fdCreateAlways, faReadWrite, fsNone);
- try
- { Download the .issig file }
- const ISSigUrl = GetISSigUrl(SourceFile, ExpandConst(CurFile^.DownloadISSigSource));
- DownloadFile(ISSigUrl, DownloadUserName, DownloadPassword,
- ISSigDestF, NoVerification, '', JustProcessEventsProc64, To64(0));
- FreeAndNil(ISSigDestF);
- { Download and verify the actual file }
- DownloadFile(SourceFile, DownloadUserName, DownloadPassword,
- DestF, CurFile^.Verification, TempFile, ExternalProgressProc64, MaxProgress);
- finally
- ISSigDestF.Free;
- { Delete the .issig file }
- DeleteFileRedir(DisableFsRedir, ISSigTempFile);
- end;
- end else
- DownloadFile(SourceFile, DownloadUserName, DownloadPassword,
- DestF, CurFile^.Verification, '', ExternalProgressProc64, MaxProgress);
- end
- else begin
- { Copy a duplicated non-external file, or an external file }
- SourceF := TFileRedir.Create(DisableFsRedir, SourceFile, fdOpenExisting, faRead, fsRead);
- try
- LastOperation := SetupMessages[msgErrorCopying];
- if Assigned(CurFileLocation) then
- CopySourceFileToDestFile(SourceF, DestF, NoVerification,
- '', CurFileLocation^.OriginalSize)
- else
- CopySourceFileToDestFile(SourceF, DestF, CurFile^.Verification,
- SourceFile, AExternalSize);
- finally
- SourceF.Free;
- end;
- end;
- except
- { If an exception occurred, put progress meter back to where it was }
- ProgressUpdated := False;
- SetProgress(PreviousProgress);
- raise;
- end;
- { Set time/date stamp }
- if CurFileDateValid then
- SetFileTime(DestF.Handle, nil, nil, @CurFileDate);
- { If it's the uninstall program, bind the messages }
- if CurFile^.FileType = ftUninstExe then begin
- AllowFileToBeDuplicated := False;
- MarkExeHeader(DestF, SetupExeModeUninstaller);
- if not(shSignedUninstaller in SetupHeader.Options) and
- not DetachedUninstMsgFile then
- BindUninstallMsgDataToExe(DestF);
- end;
- finally
- DestF.Free;
- end;
- { If it's a font, unregister the existing one to ensure that Windows
- 'notices' the file is being replaced, and to increase the chances
- of the file being unlocked/closed before we replace it. }
- if CurFile^.InstallFontName <> '' then begin
- LastOperation := '';
- FontFilename := ShortenOrExpandFontFilename(DestFile);
- if DestFileExistedBefore then
- RemoveFontResource(PChar(FontFilename));
- end;
- { Delete existing version of file, if any. If it can't be deleted
- because it's in use and the "restartreplace" flag was specified
- on the entry, register it to be replaced when the system is
- restarted. Do retry deletion before doing this. }
- if DestFileExists and (CurFile^.FileType <> ftUninstExe) then begin
- LastOperation := SetupMessages[msgErrorReplacingExistingFile];
- RetriesLeft := 4;
- while not DeleteFileRedir(DisableFsRedir, DestFile) do begin
- { Couldn't delete the existing file... }
- LastError := GetLastError;
- { If the file inexplicably vanished, it's not a problem }
- if LastError = ERROR_FILE_NOT_FOUND then
- Break;
- { Does the error code indicate that it is possibly in use? }
- if LastErrorIndicatesPossiblyInUse(LastError, False) then begin
- DoHandleFailedDeleteOrMoveFileTry('DeleteFile', TempFile, DestFile,
- LastError, RetriesLeft, LastOperation, NeedsRestart, ReplaceOnRestart,
- DoBreak, DoContinue);
- if DoBreak then
- Break
- else if DoContinue then
- Continue;
- end;
- { Some other error occurred, or we ran out of tries }
- SetLastError(LastError);
- Win32ErrorMsg('DeleteFile');
- end;
- end;
- { Rename the temporary file to the new name now, unless the file is
- to be replaced when the system is restarted, or if the file is the
- uninstall program and an existing uninstall program already exists.
- If it can't be renamed and the "restartreplace" flag was specified
- on the entry, register it to be replaced when the system is
- restarted. Do retry renaming before doing this. }
- if not (ReplaceOnRestart or
- ((CurFile^.FileType = ftUninstExe) and DestFileExistedBefore)) then begin
- LastOperation := SetupMessages[msgErrorRenamingTemp];
- { Since the DeleteFile above succeeded you would expect the rename to
- also always succeed, but if it doesn't retry anyway. }
- RetriesLeft := 4;
- while not MoveFileRedir(DisableFsRedir, TempFile, DestFile) do begin
- { Couldn't rename the temporary file... }
- LastError := GetLastError;
- { Does the error code indicate that it is possibly in use? }
- if LastErrorIndicatesPossiblyInUse(LastError, True) then begin
- DoHandleFailedDeleteOrMoveFileTry('MoveFile', TempFile, DestFile,
- LastError, RetriesLeft, LastOperation, NeedsRestart, ReplaceOnRestart,
- DoBreak, DoContinue);
- if DoBreak then
- Break
- else if DoContinue then
- Continue;
- end;
- { Some other error occurred, or we ran out of tries }
- SetLastError(LastError);
- Win32ErrorMsg('MoveFile'); { Throws an exception }
- end;
- { If ReplaceOnRestart is still False the rename succeeded so handle this.
- Then set any file attributes. }
- if not ReplaceOnRestart then begin
- TempFileLeftOver := False;
- TempFile := '';
- LastOperation := '';
- Log('Successfully installed the file.');
- if AllowFileToBeDuplicated then
- SetFileLocationFilename(CurFile^.LocationEntry, DestFile);
- if foDeleteAfterInstall in CurFile^.Options then
- DeleteFilesAfterInstallList.AddObject(DestFile, Pointer(Ord(DisableFsRedir)));
- { Set file attributes *after* renaming the file since Novell
- reportedly can't rename read-only files. }
- AddAttributesToFile(DisableFsRedir, DestFile, CurFile^.Attribs);
- end;
- end;
- { Leave the temporary file in place for now if the file is to be
- replaced when the system is restarted, or if the file is the uninstall
- program and an existing uninstall program already exists. }
- if ReplaceOnRestart or
- ((CurFile^.FileType = ftUninstExe) and DestFileExistedBefore) then begin
- if CurFile^.FileType = ftUninstExe then
- UninstallTempExeFilename := TempFile;
- TempFileLeftOver := False;
- LastOperation := '';
- Log('Leaving temporary file in place for now.');
- if AllowFileToBeDuplicated then
- SetFileLocationFilename(CurFile^.LocationEntry, TempFile);
- AddAttributesToFile(DisableFsRedir, TempFile, CurFile^.Attribs);
- end;
- { If it's a font, register it }
- if CurFile^.InstallFontName <> '' then begin
- LastOperation := '';
- LogFmt('Registering file as a font ("%s")', [CurFile^.InstallFontName]);
- PerUserFont := not IsAdminInstallMode;
- InstallFont(FontFilename, CurFile^.InstallFontName, PerUserFont, not ReplaceOnRestart, WarnedPerUserFonts);
- DeleteFlags := DeleteFlags or utDeleteFile_IsFont;
- if PerUserFont then
- DeleteFlags := DeleteFlags or utDeleteFile_PerUserFont;
- end;
- { There were no errors so add the uninstall log entry, unless the file
- is the uninstall program, or if it has the foSharedFile flag; shared
- files are handled below. }
- LastOperation := '';
- if CurFile^.FileType <> ftUninstExe then begin
- if not(foUninsNeverUninstall in CurFile^.Options) and
- not(foSharedFile in CurFile^.Options) then begin
- UninstLog.Add(utDeleteFile, [DestFile, TempFile,
- CurFile^.InstallFontName, FontFilename,
- CurFile^.StrongAssemblyName], DeleteFlags);
- end;
- end
- else begin
- if UninstallTempExeFilename = '' then
- UninstallExeCreated := ueNew
- else
- UninstallExeCreated := ueReplaced;
- end;
- Skip:
- { If foRegisterServer or foRegisterTypeLib is in Options, add the
- file to RegisterFilesList for registering later.
- Don't attempt to register if the file doesn't exist (which can
- happen if the foOnlyIfDestFileExists flag is used). }
- if ((foRegisterServer in CurFile^.Options) or
- (foRegisterTypeLib in CurFile^.Options)) and
- NewFileExistsRedir(DisableFsRedir, DestFile) then begin
- LastOperation := '';
- if foRegisterTypeLib in CurFile^.Options then
- Log('Will register the file (a type library) later.')
- else
- Log('Will register the file (a DLL/OCX) later.');
- New(RegisterRec);
- RegisterRec^.Filename := DestFile;
- RegisterRec^.Is64Bit := DisableFsRedir;
- RegisterRec^.TypeLib := foRegisterTypeLib in CurFile^.Options;
- RegisterRec^.NoErrorMessages := foNoRegError in CurFile^.Options;
- RegisterFilesList.Add(RegisterRec);
- end;
- { If foSharedFile is in Options, increment the reference count in the
- registry for the file, then add the uninstall log entry (which,
- unlike non-shared files, must be done on skipped files as well;
- that's why there are two places where utDeleteFile entries are
- added). }
- if foSharedFile in CurFile^.Options then begin
- LastOperation := '';
- if DisableFsRedir then begin
- Log('Incrementing shared file count (64-bit).');
- IncrementSharedCount(rv64Bit, DestFile, DestFileExistedBefore);
- end
- else begin
- Log('Incrementing shared file count (32-bit).');
- IncrementSharedCount(rv32Bit, DestFile, DestFileExistedBefore);
- end;
- if not(foUninsNeverUninstall in CurFile^.Options) then begin
- DeleteFlags := DeleteFlags or utDeleteFile_SharedFile;
- if DisableFsRedir then
- DeleteFlags := DeleteFlags or utDeleteFile_SharedFileIn64BitKey;
- if foUninsNoSharedFilePrompt in CurFile^.Options then
- DeleteFlags := DeleteFlags or utDeleteFile_NoSharedFilePrompt;
- UninstLog.Add(utDeleteFile, [DestFile, TempFile,
- CurFile^.InstallFontName, FontFilename,
- CurFile^.StrongAssemblyName], DeleteFlags);
- end
- else begin
- if DisableFsRedir then
- UninstLog.Add(utDecrementSharedCount, [DestFile],
- utDecrementSharedCount_64BitKey)
- else
- UninstLog.Add(utDecrementSharedCount, [DestFile], 0);
- end;
- end;
- { Apply permissions (even if the file wasn't replaced) }
- LastOperation := '';
- if TempFile <> '' then
- ApplyPermissions(DisableFsRedir, TempFile, CurFile^.PermissionsEntry)
- else
- ApplyPermissions(DisableFsRedir, DestFile, CurFile^.PermissionsEntry);
- { Set NTFS compression (even if the file wasn't replaced) }
- if (foSetNTFSCompression in CurFile^.Options) or (foUnsetNTFSCompression in CurFile^.Options) then begin
- LastOperation := '';
- if TempFile <> '' then
- ApplyNTFSCompression(DisableFsRedir, TempFile, foSetNTFSCompression in CurFile^.Options)
- else
- ApplyNTFSCompression(DisableFsRedir, DestFile, foSetNTFSCompression in CurFile^.Options);
- end;
- { Install into GAC (even if the file wasn't replaced) }
- if foGacInstall in CurFile^.Options then begin
- Log('Installing into GAC');
- with TAssemblyCacheInfo.Create(rvDefault) do try
- if TempFile <> '' then
- InstallAssembly(TempFile)
- else
- InstallAssembly(DestFile);
- finally
- Free;
- end;
- end;
- except
- if ExceptObject is EAbort then
- raise;
- Failed := GetExceptMessage;
- end;
- finally
- { If an exception occurred before TempFile was cleaned up, delete it now }
- if TempFileLeftOver then
- DeleteFileRedir(DisableFsRedir, TempFile);
- end;
- { Was there an exception? Display error message and offer to retry }
- if Failed <> '' then begin
- if (CurFile^.FileType = ftUninstExe) and (UninstallTempExeFilename <> '') then begin
- DeleteFile(UninstallTempExeFilename);
- UninstallTempExeFilename := '';
- UninstallExeCreated := ueNone;
- end;
- if LastOperation <> '' then
- LastOperation := LastOperation + SNewLine;
- if not AbortRetryIgnoreTaskDialogMsgBox(
- DestFile + SNewLine2 + LastOperation + Failed,
- [SetupMessages[msgAbortRetryIgnoreRetry], SetupMessages[msgFileAbortRetryIgnoreSkipNotRecommended], SetupMessages[msgAbortRetryIgnoreCancel]]) then begin
- if ProgressUpdated then
- SetProgress(PreviousProgress);
- goto Retry;
- end;
- end;
- { Increment progress meter, if not already done so }
- if not ProgressUpdated then begin
- if Assigned(CurFileLocation) then { not an "external" file }
- IncProgress64(CurFileLocation^.OriginalSize)
- else
- IncProgress64(AExternalSize);
- end;
- { Process any events between copying files }
- ProcessEvents;
- { Clear previous filename label in case an exception or debugger break
- occurs between now and when the label for the next entry is set }
- SetFilenameLabelText('', False);
- end;
- procedure CopyFiles(const Uninstallable: Boolean);
- { Copies all the application's files }
- function RecurseExternalCopyFiles(const DisableFsRedir: Boolean;
- const SearchBaseDir, SearchSubDir, SearchWildcard: String; const SourceIsWildcard: Boolean;
- const Excludes: TStrings; const CurFile: PSetupFileEntry; var ExpectedBytesLeft: Integer64;
- var ConfirmOverwriteOverwriteAll, PromptIfOlderOverwriteAll: TOverwriteAll;
- var WarnedPerUserFonts: Boolean): Boolean;
- begin
- { Also see RecurseExternalFiles and RecurseExternalGetSizeOfFiles in Setup.MainFunc
- Also see RecurseExternalArchiveCopyFiles directly below }
- Result := False;
- var FindData: TWin32FindData;
- var H := FindFirstFileRedir(DisableFsRedir, SearchBaseDir + SearchSubDir + SearchWildcard, FindData);
- if H <> INVALID_HANDLE_VALUE then begin
- try
- repeat
- if FindData.dwFileAttributes and FILE_ATTRIBUTE_DIRECTORY = 0 then begin
- var FileName: String;
- 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, Excludes) then
- Continue;
- Result := True;
- var SourceFile := SearchBaseDir + SearchSubDir + FileName;
- { Note: CurFile^.DestName only includes a a filename if foCustomDestName is set,
- see TSetupCompiler.EnumFilesProc.ProcessFileList }
- var DestFile := ExpandConst(CurFile^.DestName);
- if not(foCustomDestName in CurFile^.Options) then
- DestFile := DestFile + SearchSubDir + FileName
- else if SearchSubDir <> '' then
- DestFile := PathExtractPath(DestFile) + SearchSubDir + PathExtractName(DestFile);
- var Size: Integer64;
- Size.Hi := FindData.nFileSizeHigh;
- Size.Lo := FindData.nFileSizeLow;
- if Compare64(Size, ExpectedBytesLeft) > 0 then begin
- { Don't allow the progress bar to overflow if the size of the
- files is greater than when we last checked }
- Size := ExpectedBytesLeft;
- end;
- ProcessFileEntry(CurFile, DisableFsRedir, SourceFile, DestFile, nil,
- Size, ConfirmOverwriteOverwriteAll, PromptIfOlderOverwriteAll,
- WarnedPerUserFonts, nil);
- Dec6464(ExpectedBytesLeft, Size);
- end;
- until not FindNextFile(H, FindData);
- finally
- Windows.FindClose(H);
- end;
- end;
- if foRecurseSubDirsExternal in CurFile^.Options then begin
- H := FindFirstFileRedir(DisableFsRedir, SearchBaseDir + SearchSubDir + '*', FindData);
- if H <> INVALID_HANDLE_VALUE then begin
- try
- repeat
- if IsRecurseableDirectory(FindData) then
- Result := RecurseExternalCopyFiles(DisableFsRedir, SearchBaseDir,
- SearchSubDir + FindData.cFileName + '\', SearchWildcard,
- SourceIsWildcard, Excludes, CurFile, ExpectedBytesLeft,
- ConfirmOverwriteOverwriteAll, PromptIfOlderOverwriteAll,
- WarnedPerUserFonts) or Result;
- until not FindNextFile(H, FindData);
- finally
- Windows.FindClose(H);
- end;
- end;
- end;
- if SearchSubDir <> '' then begin
- { If Result is False this subdir won't be created, so create it now if
- CreateAllSubDirs was set }
- if not Result and (foCreateAllSubDirs in CurFile.Options) then begin
- var DestName := ExpandConst(CurFile^.DestName); { See above }
- if not(foCustomDestName in CurFile^.Options) then
- DestName := DestName + SearchSubDir
- else
- DestName := PathExtractPath(DestName) + SearchSubDir;
- var Flags: TMakeDirFlags := [];
- if foUninsNeverUninstall in CurFile^.Options then Include(Flags, mdNoUninstall);
- if foDeleteAfterInstall in CurFile^.Options then Include(Flags, mdDeleteAfterInstall);
- MakeDir(DisableFsRedir, DestName, Flags);
- Result := True;
- end;
- end;
- { When recursively searching but not picking up every file, we could
- be frozen for a long time when installing from a network. Calling
- ProcessEvents after every directory helps. }
- ProcessEvents;
- end;
- function RecurseExternalArchiveCopyFiles(const DisableFsRedir: Boolean;
- const ArchiveFilename: String; const Excludes: TStrings;
- const CurFile: PSetupFileEntry; var ExpectedBytesLeft: Integer64;
- var ConfirmOverwriteOverwriteAll, PromptIfOlderOverwriteAll: TOverwriteAll;
- var WarnedPerUserFonts: Boolean): Boolean;
- begin
- { See above }
- { If the archive doesn't exist then the caller should handle this with
- a msgSourceDoesntExist message. All other errors we handle ourselves
- with a msgErrorExtracting message, without informing the caller, unless
- you count EAbort. }
- Result := NewFileExistsRedir(DisableFsRedir, ArchiveFilename);
- if not Result then
- Exit;
- if foCustomDestName in CurFile^.Options then
- InternalError('Unexpected custom DestName');
- const DestDir = ExpandConst(CurFile^.DestName);
- Log('-- Archive entry --');
- var VerifySourceF: TFile := nil;
- try
- var FindData: TWin32FindData;
- var H: TArchiveFindHandle := INVALID_HANDLE_VALUE;
- var Failed: String;
- repeat
- try
- if CurFile^.Verification.Typ <> fvNone then begin
- if VerifySourceF = nil then
- VerifySourceF := TFileRedir.Create(DisableFsRedir, ArchiveFilename, fdOpenExisting, faRead, fsRead);
- var ExpectedFileHash: TSHA256Digest;
- if CurFile^.Verification.Typ = fvHash then
- ExpectedFileHash := CurFile^.Verification.Hash
- else begin
- DoISSigVerify(VerifySourceF, nil, ArchiveFilename, True, CurFile^.Verification.ISSigAllowedKeys,
- ExpectedFileHash);
- end;
- { Can't get the SHA-256 while extracting so need to get and check it now }
- const ActualFileHash = GetSHA256OfFile(VerifySourceF);
- if not SHA256DigestsEqual(ActualFileHash, ExpectedFileHash) then
- VerificationError(veFileHashIncorrect);
- Log(VerificationSuccessfulLogMessage);
- { Keep VerifySourceF open until extraction has completed to prevent TOCTOU problem }
- end;
- H := ArchiveFindFirstFileRedir(DisableFsRedir, ArchiveFilename, DestDir,
- ExpandConst(CurFile^.ExtractArchivePassword), foRecurseSubDirsExternal in CurFile^.Options,
- True, FindData);
- Failed := '';
- except
- if ExceptObject is EAbort then
- raise;
- Failed := GetExceptMessage;
- end;
- until (Failed = '') or
- AbortRetryIgnoreTaskDialogMsgBox(
- ArchiveFilename + SNewLine2 + SetupMessages[msgErrorExtracting] + SNewLine + Failed,
- [SetupMessages[msgAbortRetryIgnoreRetry], SetupMessages[msgFileAbortRetryIgnoreSkipNotRecommended], SetupMessages[msgAbortRetryIgnoreCancel]]);
- if H <> INVALID_HANDLE_VALUE then begin
- try
- repeat
- if FindData.dwFileAttributes and FILE_ATTRIBUTE_DIRECTORY = 0 then begin
- if IsExcluded(FindData.cFileName, Excludes) then
- Continue;
- var SourceFile := IntToStr(H);
- const DestFile = DestDir + FindData.cFileName;
- var Size: Integer64;
- Size.Hi := FindData.nFileSizeHigh;
- Size.Lo := FindData.nFileSizeLow;
- if Compare64(Size, ExpectedBytesLeft) > 0 then begin
- { Don't allow the progress bar to overflow if the size of the
- files is greater than when we last checked }
- Size := ExpectedBytesLeft;
- end;
- ProcessFileEntry(CurFile, DisableFsRedir, SourceFile, DestFile,
- nil, Size, ConfirmOverwriteOverwriteAll, PromptIfOlderOverwriteAll,
- WarnedPerUserFonts, @FindData.ftLastWriteTime);
- Dec6464(ExpectedBytesLeft, Size);
- end else if foCreateAllSubDirs in CurFile.Options then begin
- var Flags: TMakeDirFlags := [];
- if foUninsNeverUninstall in CurFile^.Options then Include(Flags, mdNoUninstall);
- if foDeleteAfterInstall in CurFile^.Options then Include(Flags, mdDeleteAfterInstall);
- MakeDir(DisableFsRedir, DestDir + FindData.cFileName, Flags);
- Result := True;
- end;
- until not ArchiveFindNextFile(H, FindData);
- finally
- ArchiveFindClose(H);
- end;
- Log('Successfully extracted the archive.');
- end else
- Log('Found no files to extract.');
- finally
- VerifySourceF.Free;
- end;
- end;
- var
- I: Integer;
- CurFileNumber: Integer;
- CurFile: PSetupFileEntry;
- SourceWildcard: String;
- ProgressBefore, ExpectedBytesLeft: Integer64;
- DisableFsRedir, FoundFiles: Boolean;
- ConfirmOverwriteOverwriteAll, PromptIfOlderOverwriteAll: TOverwriteAll;
- WarnedPerUserFonts: Boolean;
- begin
- ConfirmOverwriteOverwriteAll := oaUnknown;
- PromptIfOlderOverwriteAll := oaUnknown;
- WarnedPerUserFonts := False;
- var FileLocationFilenames: TStringList := nil;
- var Excludes: TStringList := nil;
- try
- FileLocationFilenames := TStringList.Create;
- for I := 0 to Entries[seFileLocation].Count-1 do
- FileLocationFilenames.Add('');
- Excludes := TStringList.Create;
- Excludes.StrictDelimiter := True;
- Excludes.Delimiter := ',';
- for CurFileNumber := 0 to Entries[seFile].Count-1 do begin
- CurFile := PSetupFileEntry(Entries[seFile][CurFileNumber]);
- if ((CurFile^.FileType <> ftUninstExe) or Uninstallable) and
- ShouldProcessFileEntry(WizardComponents, WizardTasks, CurFile, False) then begin
- DebugNotifyEntry(seFile, CurFileNumber);
- NotifyBeforeInstallFileEntry(CurFile);
- DisableFsRedir := InstallDefaultDisableFsRedir;
- if fo32Bit in CurFile^.Options then
- DisableFsRedir := False;
- if fo64Bit in CurFile^.Options then begin
- if not IsWin64 then
- InternalError('Cannot install files to 64-bit locations on this version of Windows');
- DisableFsRedir := True;
- end;
- if CurFile^.LocationEntry <> -1 then begin
- ProcessFileEntry(CurFile, DisableFsRedir, '', '', FileLocationFilenames, To64(0),
- ConfirmOverwriteOverwriteAll, PromptIfOlderOverwriteAll, WarnedPerUserFonts, nil);
- end
- else begin
- { File is an 'external' file }
- if CurFile^.FileType = ftUninstExe then begin
- { This is the file entry for the uninstaller program }
- SourceWildcard := NewParamStr(0);
- DisableFsRedir := False;
- end
- else
- SourceWildcard := ExpandConst(CurFile^.SourceFilename);
- Excludes.DelimitedText := CurFile^.Excludes;
- ProgressBefore := CurProgress;
- repeat
- SetProgress(ProgressBefore);
- ExpectedBytesLeft := CurFile^.ExternalSize;
- if foDownload in CurFile^.Options then begin
- { Archive download should have been done already by Setup.WizardForm's DownloadArchivesToExtract }
- if foExtractArchive in CurFile^.Options then
- InternalError('Unexpected Download flag');
- if foSkipIfSourceDoesntExist in CurFile^.Options then
- InternalError('Unexpected SkipIfSourceDoesntExist flag');
- if not(foCustomDestName in CurFile^.Options) then
- InternalError('Expected CustomDestName flag');
- { CurFile^.DestName now includes a filename, see TSetupCompiler.EnumFilesProc.ProcessFileList }
- ProcessFileEntry(CurFile, DisableFsRedir, SourceWildcard, ExpandConst(CurFile^.DestName),
- nil, ExpectedBytesLeft, ConfirmOverwriteOverwriteAll, PromptIfOlderOverwriteAll,
- WarnedPerUserFonts, nil);
- FoundFiles := True;
- end else if foExtractArchive in CurFile^.Options then
- FoundFiles := RecurseExternalArchiveCopyFiles(DisableFsRedir,
- SourceWildcard, Excludes, CurFile,
- ExpectedBytesLeft, ConfirmOverwriteOverwriteAll, PromptIfOlderOverwriteAll,
- WarnedPerUserFonts)
- else
- FoundFiles := RecurseExternalCopyFiles(DisableFsRedir,
- PathExtractPath(SourceWildcard), '', PathExtractName(SourceWildcard),
- IsWildcard(SourceWildcard), Excludes, CurFile,
- ExpectedBytesLeft, ConfirmOverwriteOverwriteAll, PromptIfOlderOverwriteAll,
- WarnedPerUserFonts);
- until FoundFiles or
- (foSkipIfSourceDoesntExist in CurFile^.Options) or
- AbortRetryIgnoreTaskDialogMsgBox(
- SetupMessages[msgErrorReadingSource] + SNewLine + AddPeriod(FmtSetupMessage(msgSourceDoesntExist, [SourceWildcard])),
- [SetupMessages[msgAbortRetryIgnoreRetry], SetupMessages[msgFileAbortRetryIgnoreSkipNotRecommended], SetupMessages[msgAbortRetryIgnoreCancel]]);
- { In case we didn't end up copying all the expected bytes, bump
- the progress bar up to the expected amount }
- Inc6464(ProgressBefore, CurFile^.ExternalSize);
- SetProgress(ProgressBefore);
- end;
- NotifyAfterInstallFileEntry(CurFile);
- end;
- end;
- finally
- Excludes.Free;
- FileLocationFilenames.Free;
- end;
- end;
- procedure CreateIcons;
- function IsPathURL(const S: String): Boolean;
- { Returns True if S begins with a scheme name and colon. Should be
- compliant with RFC 2396 section 3.1. }
- const
- SchemeAlphaChars = ['A'..'Z', 'a'..'z'];
- SchemeAllChars = SchemeAlphaChars + ['0'..'9', '+', '-', '.'];
- var
- P, I: Integer;
- begin
- Result := False;
- P := PathPos(':', S);
- if (P > 2) and CharInSet(S[1], SchemeAlphaChars) then begin
- for I := 2 to P-1 do
- if not CharInSet(S[I], SchemeAllChars) then
- Exit;
- Result := True;
- end;
- end;
- procedure CreateURLFile(const Filename, URL, IconFilename: String;
- const IconIndex: Integer);
- var
- S: String;
- F: TTextFileWriter;
- begin
- S := '[InternetShortcut]' + SNewLine + 'URL=' + URL + SNewLine;
- if IconFilename <> '' then
- S := S + 'IconFile=' + IconFilename + SNewLine +
- 'IconIndex=' + IntToStr(IconIndex) + SNewLine;
- F := TTextFileWriter.Create(Filename, fdCreateAlways, faWrite, fsNone);
- try
- if SameText(S, String(AnsiString(S))) then
- F.WriteAnsi(AnsiString(S))
- else
- F.Write(S);
- finally
- F.Free;
- end;
- end;
- procedure DeleteFolderShortcut(const Dir: String);
- var
- Attr: DWORD;
- DesktopIniFilename, S: String;
- begin
- Attr := GetFileAttributes(PChar(Dir));
- if (Attr <> INVALID_FILE_ATTRIBUTES) and (Attr and FILE_ATTRIBUTE_DIRECTORY <> 0) then begin
- { To be sure this is really a folder shortcut and not a regular folder,
- look for a desktop.ini file specifying CLSID_FolderShortcut }
- DesktopIniFilename := PathCombine(Dir, 'desktop.ini');
- S := GetIniString('.ShellClassInfo', 'CLSID2', '', DesktopIniFilename);
- if CompareText(S, '{0AFACED1-E828-11D1-9187-B532F1E9575D}') = 0 then begin
- DeleteFile(DesktopIniFilename);
- DeleteFile(PathCombine(Dir, 'target.lnk'));
- SetFileAttributes(PChar(Dir), Attr and not FILE_ATTRIBUTE_READONLY);
- RemoveDirectory(PChar(Dir));
- end;
- end;
- end;
- procedure CreateAnIcon(Name: String; const Description, Path, Parameters,
- WorkingDir, IconFilename: String; const IconIndex, ShowCmd: Integer;
- const NeverUninstall: Boolean; const CloseOnExit: TSetupIconCloseOnExit;
- const HotKey: Word; const AppUserModelID: String;
- const AppUserModelToastActivatorCLSID: PGUID;
- const ExcludeFromShowInNewInstall, PreventPinning: Boolean);
- var
- BeginsWithGroup: Boolean;
- LinkFilename, PifFilename, UrlFilename, DirFilename, ProbableFilename,
- ResultingFilename: String;
- Flags: TMakeDirFlags;
- URLShortcut: Boolean;
- begin
- BeginsWithGroup := Copy(Name, 1, 8) = '{group}\';
- { Note: PathExpand removes trailing spaces, so it can't be called on
- Name before the extensions are appended }
- Name := ExpandConst(Name);
- LinkFilename := PathExpand(Name + '.lnk');
- PifFilename := PathExpand(Name + '.pif');
- UrlFilename := PathExpand(Name + '.url');
- DirFilename := PathExpand(Name);
- Flags := [mdNotifyChange];
- if NeverUninstall then
- Include(Flags, mdNoUninstall)
- else if BeginsWithGroup then
- Include(Flags, mdAlwaysUninstall);
- URLShortcut := IsPathURL(Path);
- if URLShortcut then
- ProbableFilename := UrlFilename
- else
- ProbableFilename := LinkFilename;
- LogFmt('Dest filename: %s', [ProbableFilename]);
- SetFilenameLabelText(ProbableFilename, True);
- MakeDir(False, PathExtractDir(ProbableFilename), Flags);
- { Delete any old files first }
- DeleteFile(LinkFilename);
- DeleteFile(PifFilename);
- if NewFileExists(UrlFilename) then begin
- { Flush out any pending writes by other apps before deleting }
- WritePrivateProfileString(nil, nil, nil, PChar(UrlFilename));
- end;
- DeleteFile(UrlFilename);
- DeleteFolderShortcut(DirFilename);
- Log('Creating the icon.');
- if not URLShortcut then begin
- { Create the shortcut.
- Note: Don't call PathExpand on any of the paths since they may contain
- environment-variable strings (e.g. %SystemRoot%\...) }
- ResultingFilename := CreateShellLink(LinkFilename, Description, Path,
- Parameters, WorkingDir, IconFilename, IconIndex, ShowCmd, HotKey,
- AppUserModelID, AppUserModelToastActivatorCLSID,
- ExcludeFromShowInNewInstall, PreventPinning);
- { If a .pif file was created, apply the "Close on exit" setting }
- if (CloseOnExit <> icNoSetting) and
- SameText(PathExtractExt(ResultingFilename), '.pif') then begin
- try
- ModifyPifFile(ResultingFilename, CloseOnExit = icYes);
- except
- { Failure isn't important here. Ignore exceptions }
- end;
- end;
- end
- else begin
- { Create an Internet Shortcut (.url) file }
- CreateURLFile(UrlFilename, Path, IconFilename, IconIndex);
- ResultingFilename := UrlFilename;
- end;
- Log('Successfully created the icon.');
- { Set the global flag that is checked by the Finished wizard page }
- CreatedIcon := True;
- { Notify shell of the change }
- SHChangeNotify(SHCNE_CREATE, SHCNF_PATH, PChar(ResultingFilename), nil);
- SHChangeNotify(SHCNE_UPDATEDIR, SHCNF_PATH or SHCNF_FLUSH,
- PChar(PathExtractDir(ResultingFilename)), nil);
- { Add uninstall log entries }
- if not NeverUninstall then begin
- if URLShortcut then
- UninstLog.Add(utDeleteFile, [ResultingFilename], utDeleteFile_CallChangeNotify)
- else begin
- { Even though we only created one file, go ahead and try deleting
- both a .lnk and .pif file at uninstall time, in case the user
- alters the shortcut after installation }
- UninstLog.Add(utDeleteFile, [LinkFilename], utDeleteFile_CallChangeNotify);
- UninstLog.Add(utDeleteFile, [PifFilename], utDeleteFile_CallChangeNotify);
- end;
- end;
- end;
- function ExpandAppPath(const Filename: String): String;
- var
- K: HKEY;
- Found: Boolean;
- begin
- if RegOpenKeyExView(InstallDefaultRegView, HKEY_LOCAL_MACHINE,
- PChar(REGSTR_PATH_APPPATHS + '\' + Filename), 0, KEY_QUERY_VALUE, K) = ERROR_SUCCESS then begin
- Found := RegQueryStringValue(K, '', Result);
- RegCloseKey(K);
- if Found then
- Exit;
- end;
- Result := Filename;
- end;
- var
- CurIconNumber: Integer;
- CurIcon: PSetupIconEntry;
- FN: String;
- TACLSID: PGUID;
- begin
- for CurIconNumber := 0 to Entries[seIcon].Count-1 do begin
- try
- CurIcon := PSetupIconEntry(Entries[seIcon][CurIconNumber]);
- with CurIcon^ do begin
- if ShouldProcessIconEntry(WizardComponents, WizardTasks, WizardNoIcons, CurIcon) then begin
- DebugNotifyEntry(seIcon, CurIconNumber);
- NotifyBeforeInstallEntry(BeforeInstall);
- Log('-- Icon entry --');
- FN := ExpandConst(Filename);
- if ioUseAppPaths in Options then
- FN := ExpandAppPath(FN);
- if not(ioCreateOnlyIfFileExists in Options) or NewFileExistsRedir(IsWin64, FN) then begin
- if ioHasAppUserModelToastActivatorCLSID in Options then
- TACLSID := @AppUserModelToastActivatorCLSID
- else
- TACLSID := nil;
- CreateAnIcon(IconName, ExpandConst(Comment), FN,
- ExpandConst(Parameters), ExpandConst(WorkingDir),
- ExpandConst(IconFilename), IconIndex, ShowCmd,
- ioUninsNeverUninstall in Options, CloseOnExit, HotKey,
- ExpandConst(AppUserModelID), TACLSID,
- ioExcludeFromShowInNewInstall in Options,
- ioPreventPinning in Options)
- end else
- Log('Skipping due to "createonlyiffileexists" flag.');
- { Increment progress meter }
- IncProgress(1000);
-
- NotifyAfterInstallEntry(AfterInstall);
- end;
- end;
- except
- if not(ExceptObject is EAbort) then
- Application.HandleException(nil)
- else
- raise;
- end;
- ProcessEvents;
- { Clear previous filename label in case an exception or debugger break
- occurs between now and when the label for the next entry is set }
- SetFilenameLabelText('', False);
- end;
- end;
- procedure CreateIniEntries;
- var
- CurIniNumber: Integer;
- CurIni: PSetupIniEntry;
- IniSection, IniEntry, IniValue, IniFilename, IniDir: String;
- Skip: Boolean;
- begin
- for CurIniNumber := 0 to Entries[seIni].Count-1 do begin
- CurIni := PSetupIniEntry(Entries[seIni][CurIniNumber]);
- with CurIni^ do begin
- if ShouldProcessEntry(WizardComponents, WizardTasks, Components, Tasks, Languages, Check) then begin
- DebugNotifyEntry(seIni, CurIniNumber);
- NotifyBeforeInstallEntry(BeforeInstall);
- Log('-- INI entry --');
- IniSection := ExpandConst(Section);
- IniEntry := ExpandConst(Entry);
- IniValue := ExpandConst(Value);
- IniFilename := ExpandConst(Filename);
- LogFmt('Dest filename: %s', [IniFilename]);
- LogFmt('Section: %s', [IniSection]);
- if IniEntry <> '' then
- LogFmt('Entry: %s', [IniEntry]);
- if ioHasValue in Options then
- LogFmt('Value: %s', [IniValue]);
- if (IniEntry <> '') and (ioHasValue in Options) and
- (not(ioCreateKeyIfDoesntExist in Options) or
- not IniKeyExists(IniSection, IniEntry, IniFilename)) then begin
- Skip := False;
- IniDir := PathExtractDir(IniFilename);
- if IniDir <> '' then begin
- while True do begin
- try
- MakeDir(False, IniDir, []);
- Break;
- except
- if AbortRetryIgnoreTaskDialogMsgBox(
- GetExceptMessage,
- [SetupMessages[msgAbortRetryIgnoreRetry], SetupMessages[msgAbortRetryIgnoreIgnore], SetupMessages[msgAbortRetryIgnoreCancel]]) then begin
- Skip := True;
- Break;
- end;
- end;
- end;
- end;
- if not Skip then
- Log('Updating the .INI file.');
- repeat
- if SetIniString(IniSection, IniEntry, IniValue, IniFilename) then begin
- Log('Successfully updated the .INI file.');
- Break;
- end;
- until AbortRetryIgnoreTaskDialogMsgBox(
- FmtSetupMessage1(msgErrorIniEntry, IniFilename),
- [SetupMessages[msgAbortRetryIgnoreRetry], SetupMessages[msgAbortRetryIgnoreIgnore], SetupMessages[msgAbortRetryIgnoreCancel]]);
- end else
- Log('Skipping updating the .INI file, only updating uninstall log.');
- if ioUninsDeleteEntireSection in Options then
- UninstLog.Add(utIniDeleteSection, [IniFilename, IniSection], 0);
- if ioUninsDeleteSectionIfEmpty in Options then
- UninstLog.Add(utIniDeleteSection, [IniFilename, IniSection],
- utIniDeleteSection_OnlyIfEmpty);
- if (ioUninsDeleteEntry in Options) and (IniEntry <> '') then
- UninstLog.Add(utIniDeleteEntry, [IniFilename, IniSection, IniEntry], 0);
- { ^ add utIniDeleteEntry last since we want it done first by the
- uninstaller (in case the entry's also got the
- "uninsdeletesectionifempty" flag) }
- NotifyAfterInstallEntry(AfterInstall);
- end;
- end;
- end;
- { Increment progress meter }
- IncProgress(1000);
- end;
- procedure CreateRegistryEntries;
-
- function IsDeletableSubkey(const S: String): Boolean;
- { A sanity check to prevent people from shooting themselves in the foot by
- using
- Root: HKLM; Subkey: ""; Flags: [unins]deletekey
- or a 'code' constant in Subkey that returns a blank string or only
- backslashes. }
- var
- P: PChar;
- begin
- Result := False;
- P := PChar(S);
- while P^ <> #0 do begin
- if P^ <> '\' then begin
- Result := True;
- Break;
- end;
- Inc(P);
- end;
- end;
- procedure ApplyPermissions(const RegView: TRegView; const RootKey: HKEY;
- const Subkey: String; const PermsEntry: Integer);
- var
- P: PSetupPermissionEntry;
- begin
- LogFmt('Setting permissions on key: %s\%s',
- [GetRegRootKeyName(RootKey), Subkey]);
- P := Entries[sePermission][PermsEntry];
- if not GrantPermissionOnKey(RegView, RootKey, Subkey,
- TGrantPermissionEntry(Pointer(P.Permissions)^),
- Length(P.Permissions) div SizeOf(TGrantPermissionEntry)) then begin
- if GetLastError = ERROR_FILE_NOT_FOUND then
- Log('Could not set permissions on the key because it currently does not exist.')
- else
- LogFmt('Failed to set permissions on the key (%d).', [GetLastError]);
- end;
- end;
- const
- REG_QWORD = 11;
- var
- RK, K: HKEY;
- Disp: DWORD;
- N, V, ExistingData: String;
- ExistingType, NewType, DV: DWORD;
- S: String;
- RV: TRegView;
- CurRegNumber: Integer;
- NeedToRetry, DidDeleteKey: Boolean;
- ErrorCode: Longint;
- I: Integer;
- AnsiS: AnsiString;
- begin
- for CurRegNumber := 0 to Entries[seRegistry].Count-1 do begin
- with PSetupRegistryEntry(Entries[seRegistry][CurRegNumber])^ do begin
- if ShouldProcessEntry(WizardComponents, WizardTasks, Components, Tasks, Languages, Check) then begin
- DebugNotifyEntry(seRegistry, CurRegNumber);
- NotifyBeforeInstallEntry(BeforeInstall);
- Log('-- Registry entry --');
- RK := RootKey;
- if RK = HKEY_AUTO then
- RK := InstallModeRootKey;
- S := ExpandConst(Subkey);
- LogFmt('Key: %s\%s', [GetRegRootKeyName(RK), Subkey]);
- N := ExpandConst(ValueName);
- if N <> '' then
- LogFmt('Value name: %s', [N]);
- RV := InstallDefaultRegView;
- if (ro32Bit in Options) and (RV <> rv32Bit) then begin
- Log('Non-default bitness: 32-bit');
- RV := rv32Bit;
- end;
- if ro64Bit in Options then begin
- if not IsWin64 then
- InternalError('Cannot access 64-bit registry keys on this version of Windows');
- if RV <> rv64Bit then begin
- Log('Non-default bitness: 64-bit');
- RV := rv64Bit;
- end;
- end;
- repeat
- NeedToRetry := False;
- try
- DidDeleteKey := False;
- if roDeleteKey in Options then begin
- if IsDeletableSubkey(S) then begin
- Log('Deleting the key.');
- RegDeleteKeyIncludingSubkeys(RV, RK, PChar(S));
- DidDeleteKey := True;
- end else
- Log('Key to delete is not deletable.');
- end;
- if (roDeleteKey in Options) and (Typ = rtNone) then begin
- { We've deleted the key, and no value is to be created.
- Our work is done. }
- if DidDeleteKey then
- Log('Successfully deleted the key.');
- end else if (roDeleteValue in Options) and (Typ = rtNone) then begin
- { We're going to delete a value with no intention of creating
- another, so don't create the key if it didn't exist. }
- if RegOpenKeyExView(RV, RK, PChar(S), 0, KEY_SET_VALUE, K) = ERROR_SUCCESS then begin
- Log('Deleting the value.');
- RegDeleteValue(K, PChar(N));
- RegCloseKey(K);
- Log('Successfully deleted the value.');
- { Our work is done. }
- end else
- Log('Key of value to delete does not exist.');
- end
- else begin
- { Apply any permissions *before* calling RegCreateKeyExView or
- RegOpenKeyExView, since we may (in a rather unlikely scenario)
- need those permissions in order for those calls to succeed }
- if PermissionsEntry <> -1 then
- ApplyPermissions(RV, RK, S, PermissionsEntry);
- { Create or open the key }
- if not(roDontCreateKey in Options) then begin
- Log('Creating or opening the key.');
- ErrorCode := RegCreateKeyExView(RV, RK, PChar(S), 0, nil,
- REG_OPTION_NON_VOLATILE, KEY_QUERY_VALUE or KEY_SET_VALUE,
- nil, K, @Disp);
- if ErrorCode = ERROR_SUCCESS then begin
- { Apply permissions again if a new key was created }
- if (Disp = REG_CREATED_NEW_KEY) and (PermissionsEntry <> -1) then begin
- Log('New key created, need to set permissions again.');
- ApplyPermissions(RV, RK, S, PermissionsEntry);
- end;
- end
- else begin
- if not(roNoError in Options) then
- RegError(reRegCreateKeyEx, RK, S, ErrorCode);
- end;
- end
- else begin
- if Typ <> rtNone then begin
- Log('Opening the key.');
- ErrorCode := RegOpenKeyExView(RV, RK, PChar(S), 0,
- KEY_QUERY_VALUE or KEY_SET_VALUE, K);
- if (ErrorCode <> ERROR_SUCCESS) and (ErrorCode <> ERROR_FILE_NOT_FOUND) then
- if not(roNoError in Options) then
- RegError(reRegOpenKeyEx, RK, S, ErrorCode);
- end
- else begin
- { We're not creating a value, and we're not just deleting a
- value (that was checked above), so there is no reason to
- even open the key }
- Log('Not creating the key or a value, skipping the key and only updating uninstall log.');
- ErrorCode := ERROR_FILE_NOT_FOUND;
- end;
- end;
- { If there was no error opening the key, proceed with deleting
- and/or creating the value }
- if ErrorCode = ERROR_SUCCESS then
- try
- if roDeleteValue in Options then begin
- Log('Deleting the value.');
- RegDeleteValue(K, PChar(N));
- end;
- if (Typ <> rtNone) and
- (not(roCreateValueIfDoesntExist in Options) or
- not RegValueExists(K, PChar(N))) then begin
- Log('Creating or setting the value.');
- case Typ of
- rtString, rtExpandString, rtMultiString: begin
- NewType := REG_SZ;
- case Typ of
- rtExpandString: NewType := REG_EXPAND_SZ;
- rtMultiString: NewType := REG_MULTI_SZ;
- end;
- if Typ <> rtMultiString then begin
- if (Pos('{olddata}', ValueData) <> 0) and
- RegQueryStringValue(K, PChar(N), ExistingData) then
- { successful }
- else
- ExistingData := '';
- if roPreserveStringType in Options then begin
- if (RegQueryValueEx(K, PChar(N), nil, @ExistingType, nil, nil) = ERROR_SUCCESS) and
- ((ExistingType = REG_SZ) or (ExistingType = REG_EXPAND_SZ)) then
- NewType := ExistingType;
- end;
- V := ExpandConstEx(ValueData, ['olddata', ExistingData])
- end
- else begin
- if (Pos('{olddata}', ValueData) <> 0) and
- RegQueryMultiStringValue(K, PChar(N), ExistingData) then
- { successful }
- else
- ExistingData := '';
- V := ExpandConstEx(ValueData, ['olddata', ExistingData,
- 'break', #0]);
- { Multi-string data requires two null terminators:
- one after the last string, and one to mark the end.
- Delphi's String type is implicitly null-terminated,
- so only one null needs to be added to the end. }
- if (V <> '') and (V[Length(V)] <> #0) then
- V := V + #0;
- end;
- ErrorCode := RegSetValueEx(K, PChar(N), 0, NewType,
- PChar(V), (Length(V)+1)*SizeOf(V[1]));
- if (ErrorCode <> ERROR_SUCCESS) and
- not(roNoError in Options) then
- RegError(reRegSetValueEx, RK, S, ErrorCode);
- end;
- rtDWord: begin
- DV := StrToInt(ExpandConst(ValueData));
- ErrorCode := RegSetValueEx(K, PChar(N), 0, REG_DWORD,
- @DV, SizeOf(DV));
- if (ErrorCode <> ERROR_SUCCESS) and
- not(roNoError in Options) then
- RegError(reRegSetValueEx, RK, S, ErrorCode);
- end;
- rtQWord: begin
- const QV: UInt64 = StrToUInt64(ExpandConst(ValueData));
- ErrorCode := RegSetValueEx(K, PChar(N), 0, REG_QWORD,
- @QV, SizeOf(QV));
- if (ErrorCode <> ERROR_SUCCESS) and
- not(roNoError in Options) then
- RegError(reRegSetValueEx, RK, S, ErrorCode);
- end;
- rtBinary: begin
- AnsiS := '';
- for I := 1 to Length(ValueData) do
- AnsiS := AnsiS + AnsiChar(Ord(ValueData[I]));
- ErrorCode := RegSetValueEx(K, PChar(N), 0, REG_BINARY,
- PAnsiChar(AnsiS), Length(AnsiS));
- if (ErrorCode <> ERROR_SUCCESS) and
- not(roNoError in Options) then
- RegError(reRegSetValueEx, RK, S, ErrorCode);
- end;
- end;
- Log('Successfully created or set the value.');
- end else if roDeleteValue in Options then
- Log('Successfully deleted the value.')
- else
- Log('Successfully created the key.')
- { Our work is done. }
- finally
- RegCloseKey(K);
- end;
- end;
- except
- if not AbortRetryIgnoreTaskDialogMsgBox(
- GetExceptMessage,
- [SetupMessages[msgAbortRetryIgnoreRetry], SetupMessages[msgAbortRetryIgnoreIgnore], SetupMessages[msgAbortRetryIgnoreCancel]]) then begin
- Log('Retrying.');
- NeedToRetry := True;
- end;
- end;
- until not NeedToRetry;
-
- if roUninsDeleteEntireKey in Options then
- if IsDeletableSubkey(S) then
- UninstLog.AddReg(utRegDeleteEntireKey, RV, RK, [S]);
- if roUninsDeleteEntireKeyIfEmpty in Options then
- if IsDeletableSubkey(S) then
- UninstLog.AddReg(utRegDeleteKeyIfEmpty, RV, RK, [S]);
- if roUninsDeleteValue in Options then
- UninstLog.AddReg(utRegDeleteValue, RV, RK, [S, N]);
- { ^ must add roUninsDeleteValue after roUninstDeleteEntireKey*
- since the entry may have both the roUninsDeleteValue and
- roUninsDeleteEntireKeyIfEmpty options }
- if roUninsClearValue in Options then
- UninstLog.AddReg(utRegClearValue, RV, RK, [S, N]);
- NotifyAfterInstallEntry(AfterInstall);
- end;
- end;
- end;
- { Increment progress meter }
- IncProgress(1000);
- end;
- procedure RegisterFiles;
- procedure RegisterServersOnRestart;
- function CreateRegSvrExe(const Dir: String): String;
- var
- ExeFilename: String;
- SourceF, DestF: TFile;
- NumRead: Cardinal;
- Buf: array[0..16383] of Byte;
- begin
- ExeFilename := GenerateUniqueName(False, Dir, '.exe');
- DestF := nil;
- SourceF := TFile.Create(NewParamStr(0), fdOpenExisting, faRead, fsRead);
- try
- DestF := TFile.Create(ExeFilename, fdCreateAlways, faWrite, fsNone);
- try
- DestF.Seek64(SourceF.Size);
- DestF.Truncate;
- DestF.Seek(0);
- while True do begin
- NumRead := SourceF.Read(Buf, SizeOf(Buf));
- if NumRead = 0 then
- Break;
- DestF.WriteBuffer(Buf, NumRead);
- end;
- if not(shSignedUninstaller in SetupHeader.Options) then
- MarkExeHeader(DestF, SetupExeModeRegSvr);
- except
- FreeAndNil(DestF);
- DeleteFile(ExeFilename);
- raise;
- end;
- finally
- DestF.Free;
- SourceF.Free;
- end;
- Result := ExeFilename;
- end;
- procedure CreateRegSvrMsg(const Filename: String);
- var
- F: TFile;
- begin
- F := TFile.Create(Filename, fdCreateAlways, faWrite, fsNone);
- try
- WriteMsgData(F);
- finally
- F.Free;
- end;
- end;
- const
- Chars: array[Boolean, Boolean] of Char = (('s', 't'), ('S', 'T'));
- var
- RegSvrExeFilename: String;
- F: TTextFileWriter;
- Rec: PRegisterFilesListRec;
- RootKey, H: HKEY;
- I, J: Integer;
- Disp: DWORD;
- ValueName, Data: String;
- ErrorCode: Longint;
- begin
- { Create RegSvr program used to register OLE servers & type libraries on
- the next reboot }
- if IsAdmin then begin
- try
- RegSvrExeFilename := CreateRegSvrExe(WinDir);
- except
- { In case Windows directory is write protected, try the Temp directory.
- Windows directory is our first choice since some people (ignorantly)
- put things like "DELTREE C:\WINDOWS\TEMP\*.*" in their AUTOEXEC.BAT.
- Also, each user has his own personal Temp directory which may not
- be accessible by other users. }
- RegSvrExeFilename := CreateRegSvrExe(GetTempDir);
- end;
- end
- else begin
- { Always use Temp directory when user doesn't have admin privileges }
- RegSvrExeFilename := CreateRegSvrExe(GetTempDir);
- end;
- LogFmt('Registration executable created: %s', [RegSvrExeFilename]);
- try
- CreateRegSvrMsg(PathChangeExt(RegSvrExeFilename, '.msg'));
- F := TTextFileWriter.Create(PathChangeExt(RegSvrExeFilename, '.lst'),
- fdCreateAlways, faWrite, fsNone);
- try
- F.WriteLine('; This file was created by the installer for:');
- F.WriteLine('; ' + ExpandedAppVerName);
- F.WriteLine('; Location: ' + SetupLdrOriginalFilename);
- F.WriteLine('');
- F.WriteLine('; List of files to be registered on the next reboot. DO NOT EDIT!');
- F.WriteLine('');
- for I := 0 to RegisterFilesList.Count-1 do begin
- Rec := RegisterFilesList[I];
- Data := '[..]' + Rec.Filename;
- Data[2] := Chars[Rec.Is64Bit, Rec.TypeLib];
- if Rec.NoErrorMessages then
- Data[3] := 'q';
- F.WriteLine(Data);
- end;
- finally
- F.Free;
- end;
- if IsAdmin then
- RootKey := HKEY_LOCAL_MACHINE
- else
- RootKey := HKEY_CURRENT_USER;
- ErrorCode := RegCreateKeyExView(rvDefault, RootKey, REGSTR_PATH_RUNONCE, 0, nil,
- REG_OPTION_NON_VOLATILE, KEY_SET_VALUE or KEY_QUERY_VALUE,
- nil, H, @Disp);
- if ErrorCode <> ERROR_SUCCESS then
- RegError(reRegCreateKeyEx, RootKey, REGSTR_PATH_RUNONCE, ErrorCode);
- try
- J := 0;
- while True do begin
- Inc(J);
- ValueName := Format('InnoSetupRegFile.%.10d', [J]); { don't localize }
- { ^ Note: Names of values written to the "RunOnce" key cannot
- exceed 31 characters! Otherwise the original Windows
- Explorer 4.0 will not process them. }
- if not RegValueExists(H, PChar(ValueName)) then begin
- Data := '"' + RegSvrExeFilename + '" /REG';
- if not IsAdmin then
- Data := Data + 'U'; { /REG -> /REGU when not running as admin }
- { Note: RegSvr expects /REG(U) to be the first parameter }
- Data := Data + ' /REGSVRMODE';
- ErrorCode := RegSetValueEx(H, PChar(ValueName), 0, REG_SZ, PChar(Data),
- (Length(Data)+1)*SizeOf(Data[1]));
- if ErrorCode <> ERROR_SUCCESS then
- RegError(reRegSetValueEx, RootKey, REGSTR_PATH_RUNONCE, ErrorCode);
- Break;
- end;
- end;
- finally
- RegCloseKey(H);
- end;
- except
- DeleteFile(PathChangeExt(RegSvrExeFilename, '.lst'));
- DeleteFile(PathChangeExt(RegSvrExeFilename, '.msg'));
- DeleteFile(RegSvrExeFilename);
- raise;
- end;
- end;
- procedure RegisterSvr(const Is64Bit: Boolean; const Filename: String;
- const NoErrorMessages: Boolean);
- var
- NeedToRetry: Boolean;
- begin
- repeat
- if Is64Bit then
- LogFmt('Registering 64-bit DLL/OCX: %s', [Filename])
- else
- LogFmt('Registering 32-bit DLL/OCX: %s', [Filename]);
- NeedToRetry := False;
- try
- RegisterServer(False, Is64Bit, Filename, NoErrorMessages);
- Log('Registration successful.');
- except
- Log('Registration failed:' + SNewLine + GetExceptMessage);
- if not NoErrorMessages then
- if not AbortRetryIgnoreTaskDialogMsgBox(
- Filename + SNewLine2 + FmtSetupMessage1(msgErrorRegisterServer, GetExceptMessage),
- [SetupMessages[msgAbortRetryIgnoreRetry], SetupMessages[msgFileAbortRetryIgnoreIgnoreNotRecommended], SetupMessages[msgAbortRetryIgnoreCancel]]) then
- NeedToRetry := True;
- end;
- until not NeedToRetry;
- end;
- procedure RegisterTLib(const Is64Bit: Boolean; const Filename: String;
- const NoErrorMessages: Boolean);
- var
- NeedToRetry: Boolean;
- begin
- repeat
- if Is64Bit then
- LogFmt('Registering 64-bit type library: %s', [Filename])
- else
- LogFmt('Registering 32-bit type library: %s', [Filename]);
- NeedToRetry := False;
- try
- if Is64Bit then
- HelperRegisterTypeLibrary(False, Filename)
- else
- RegisterTypeLibrary(Filename);
- Log('Registration successful.');
- except
- Log('Registration failed:' + SNewLine + GetExceptMessage);
- if not NoErrorMessages then
- if not AbortRetryIgnoreTaskDialogMsgBox(
- Filename + SNewLine2 + FmtSetupMessage1(msgErrorRegisterTypeLib, GetExceptMessage),
- [SetupMessages[msgAbortRetryIgnoreRetry], SetupMessages[msgFileAbortRetryIgnoreIgnoreNotRecommended], SetupMessages[msgAbortRetryIgnoreCancel]]) then
- NeedToRetry := True;
- end;
- until not NeedToRetry;
- end;
- var
- I: Integer;
- begin
- if not NeedsRestart then
- for I := 0 to RegisterFilesList.Count-1 do begin
- with PRegisterFilesListRec(RegisterFilesList[I])^ do
- if not TypeLib then
- RegisterSvr(Is64Bit, Filename, NoErrorMessages)
- else
- RegisterTLib(Is64Bit, Filename, NoErrorMessages);
- end
- else begin
- { When a restart is needed, all "regserver" & "regtypelib" files will get
- registered on the next logon }
- Log('Delaying registration of all files until the next logon since a restart is needed.');
- try
- RegisterServersOnRestart;
- except
- Application.HandleException(nil);
- end;
- end;
- end;
- procedure ProcessInstallDeleteEntries;
- var
- I: Integer;
- begin
- for I := 0 to Entries[seInstallDelete].Count-1 do
- with PSetupDeleteEntry(Entries[seInstallDelete][I])^ do
- if ShouldProcessEntry(WizardComponents, WizardTasks, Components, Tasks, Languages, Check) then begin
- DebugNotifyEntry(seInstallDelete, I);
- NotifyBeforeInstallEntry(BeforeInstall);
- case DeleteType of
- dfFiles, dfFilesAndOrSubdirs:
- DelTree(InstallDefaultDisableFsRedir, ExpandConst(Name), False, True, DeleteType = dfFilesAndOrSubdirs, False,
- nil, nil, nil);
- dfDirIfEmpty:
- DelTree(InstallDefaultDisableFsRedir, ExpandConst(Name), True, False, False, False, nil, nil, nil);
- end;
- NotifyAfterInstallEntry(AfterInstall);
- end;
- end;
- procedure RecordUninstallDeleteEntries;
- const
- DefFlags: array[TSetupDeleteType] of Longint = (
- utDeleteDirOrFiles_Extra or utDeleteDirOrFiles_DeleteFiles,
- utDeleteDirOrFiles_Extra or utDeleteDirOrFiles_DeleteFiles or
- utDeleteDirOrFiles_DeleteSubdirsAlso,
- utDeleteDirOrFiles_Extra or utDeleteDirOrFiles_IsDir);
- var
- I: Integer;
- Flags: Longint;
- begin
- for I := Entries[seUninstallDelete].Count-1 downto 0 do
- { ^ process backwards so the uninstaller will process them in the order
- they appear in the script }
- with PSetupDeleteEntry(Entries[seUninstallDelete][I])^ do
- if ShouldProcessEntry(WizardComponents, WizardTasks, Components, Tasks, Languages, Check) then begin
- DebugNotifyEntry(seUninstallDelete, I);
- NotifyBeforeInstallEntry(BeforeInstall);
- Flags := DefFlags[DeleteType];
- if InstallDefaultDisableFsRedir then
- Flags := Flags or utDeleteDirOrFiles_DisableFsRedir;
- UninstLog.Add(utDeleteDirOrFiles, [ExpandConst(Name)], Flags);
- NotifyAfterInstallEntry(AfterInstall);
- end;
- end;
- procedure RecordUninstallRunEntries;
- var
- I: Integer;
- RunEntry: PSetupRunEntry;
- Flags: Longint;
- begin
- for I := Entries[seUninstallRun].Count-1 downto 0 do begin
- { ^ process backwards so the uninstaller will process them in the order
- they appear in the script }
- RunEntry := PSetupRunEntry(Entries[seUninstallRun][I]);
- if ShouldProcessEntry(WizardComponents, WizardTasks, RunEntry.Components,
- RunEntry.Tasks, RunEntry.Languages, RunEntry.Check) then begin
- DebugNotifyEntry(seUninstallRun, I);
- NotifyBeforeInstallEntry(RunEntry.BeforeInstall);
- Flags := 0;
- case RunEntry.Wait of
- rwNoWait: Flags := Flags or utRun_NoWait;
- rwWaitUntilIdle: Flags := Flags or utRun_WaitUntilIdle;
- end;
- if roShellExec in RunEntry.Options then
- Flags := Flags or (utRun_ShellExec or utRun_ShellExecRespectWaitFlags)
- else begin
- if ShouldDisableFsRedirForRunEntry(RunEntry) then
- Flags := Flags or utRun_DisableFsRedir;
- end;
- if roSkipIfDoesntExist in RunEntry.Options then
- Flags := Flags or utRun_SkipIfDoesntExist;
- case RunEntry.ShowCmd of
- SW_SHOWMINNOACTIVE: Flags := Flags or utRun_RunMinimized;
- SW_SHOWMAXIMIZED: Flags := Flags or utRun_RunMaximized;
- SW_HIDE: Flags := Flags or utRun_RunHidden;
- end;
- if roDontLogParameters in RunEntry.Options then
- Flags := Flags or utRun_DontLogParameters;
- if roLogOutput in RunEntry.Options then
- Flags := Flags or utRun_LogOutput;
- UninstLog.Add(utRun, [ExpandConst(RunEntry.Name),
- ExpandConst(RunEntry.Parameters), ExpandConst(RunEntry.WorkingDir),
- ExpandConst(RunEntry.RunOnceId), ExpandConst(RunEntry.Verb)],
- Flags);
- NotifyAfterInstallEntry(RunEntry.AfterInstall);
- end;
- end;
- end;
- procedure GenerateUninstallInfoFilename;
- var
- ExistingFiles: array[0..999] of Boolean;
- BaseDir: String;
- procedure FindFiles;
- var
- H: THandle;
- FindData: TWin32FindData;
- S: String;
- begin
- H := FindFirstFile(PChar(AddBackslash(BaseDir) + 'unins???.*'),
- FindData);
- if H <> INVALID_HANDLE_VALUE then begin
- repeat
- S := FindData.cFilename;
- if (Length(S) >= 9) and (CompareText(Copy(S, 1, 5), 'unins') = 0) and
- CharInSet(S[6], ['0'..'9']) and CharInSet(S[7], ['0'..'9']) and CharInSet(S[8], ['0'..'9']) and
- (S[9] = '.') then
- ExistingFiles[StrToInt(Copy(S, 6, 3))] := True;
- until not FindNextFile(H, FindData);
- Windows.FindClose(H);
- end;
- end;
- procedure GenerateFilenames(const I: Integer);
- var
- BaseFilename: String;
- begin
- BaseFilename := AddBackslash(BaseDir) + Format('unins%.3d', [I]);
- UninstallExeFilename := BaseFilename + '.exe';
- UninstallDataFilename := BaseFilename + '.dat';
- UninstallMsgFilename := BaseFilename + '.msg';
- end;
- procedure ReserveDataFile;
- var
- H: THandle;
- begin
- { Create an empty .dat file to reserve the filename. }
- H := CreateFile(PChar(UninstallDataFilename), GENERIC_READ or GENERIC_WRITE,
- 0, nil, CREATE_NEW, FILE_ATTRIBUTE_NORMAL, 0);
- if H = INVALID_HANDLE_VALUE then
- Win32ErrorMsg('CreateFile');
- CloseHandle(H);
- UninstallDataCreated := True;
- end;
- var
- I: Integer;
- ExistingFlags: TUninstallLogFlags;
- begin
- { Note: We never disable FS redirection when writing to UninstallFilesDir.
- If someone sets UninstallFilesDir to "sys", we can't place a 32-bit
- uninstaller in the 64-bit system directory, because it wouldn't see its
- .dat file -- it would try to open 'windows\system32\unins???.dat' but
- fail because system32 maps to syswow64 by default.
- Not to mention, 32-bit EXEs really have no business being in the 64-bit
- system directory, and vice versa. Might result in undefined behavior? }
- { Because we don't disable FS redirection, we have to change any system32
- to syswow64, otherwise Add/Remove Programs would look for the
- UninstallString executable in the 64-bit system directory (at least
- when using a 64-bit Uninstall key) }
- BaseDir := ReplaceSystemDirWithSysWow64(PathExpand(ExpandConst(SetupHeader.UninstallFilesDir)));
- LogFmt('Directory for uninstall files: %s', [BaseDir]);
- MakeDir(False, BaseDir, []);
- FillChar(ExistingFiles, SizeOf(ExistingFiles), 0); { set all to False }
- FindFiles;
- { Look for an existing .dat file to append to or overwrite }
- if SetupHeader.UninstallLogMode <> lmNew then
- for I := 0 to 999 do
- if ExistingFiles[I] then begin
- GenerateFilenames(I);
- if NewFileExists(UninstallDataFilename) and
- UninstLog.CanAppend(UninstallDataFilename, ExistingFlags) then begin
- if SetupHeader.UninstallLogMode = lmAppend then begin
- LogFmt('Will append to existing uninstall log: %s', [UninstallDataFilename]);
- AppendUninstallData := True;
- end
- else
- LogFmt('Will overwrite existing uninstall log: %s', [UninstallDataFilename]);
- Exit;
- end;
- end;
- { None found; use a new .dat file }
- for I := 0 to 999 do
- if not ExistingFiles[I] then begin
- GenerateFilenames(I);
- LogFmt('Creating new uninstall log: %s', [UninstallDataFilename]);
- ReserveDataFile;
- Exit;
- end;
- raise Exception.Create(FmtSetupMessage1(msgErrorTooManyFilesInDir,
- BaseDir));
- end;
- procedure RenameUninstallExe;
- begin
- { If the uninstall EXE wasn't extracted to a .tmp file because it isn't
- replacing an existing uninstall EXE, exit. }
- if UninstallTempExeFilename = '' then
- Exit;
- Log('Renaming uninstaller.');
- var Timer: TOneShotTimer;
- var RetriesLeft := 4;
- while True do begin
- Timer.Start(1000);
- if MoveFileReplace(UninstallTempExeFilename, UninstallExeFilename) then
- Break;
- var LastError := GetLastError;
- { Does the error code indicate that the file is possibly in use? }
- if LastErrorIndicatesPossiblyInUse(LastError, False) then begin
- if RetriesLeft > 0 then begin
- LogFmt('The existing file appears to be in use (%d). ' +
- 'Retrying.', [LastError]);
- Dec(RetriesLeft);
- Timer.SleepUntilExpired;
- ProcessEvents;
- Continue;
- end;
- end;
- const LastOperation = SetupMessages[msgErrorReplacingExistingFile];
- const Failed = AddPeriod(FmtSetupMessage(msgErrorFunctionFailedWithMessage,
- ['MoveFileEx', IntToStr(LastError), Win32ErrorString(LastError)]));
- const Text = UninstallExeFilename + SNewLine2 + LastOperation + SNewLine + Failed;
- case LoggedTaskDialogMsgBox('', SetupMessages[msgRetryCancelSelectAction], Text, '',
- mbError, MB_RETRYCANCEL, [SetupMessages[msgRetryCancelRetry], SetupMessages[msgRetryCancelCancel]],
- 0, True, IDCANCEL) of
- IDRETRY: ;
- IDCANCEL: Abort;
- else
- Log('LoggedTaskDialogMsgBox returned an unexpected value. Assuming Cancel.');
- Abort;
- end;
- end;
- UninstallTempExeFilename := '';
- end;
- procedure CreateUninstallMsgFile;
- { If the uninstaller EXE has a digital signature, or if Setup was started
- with /DETACHEDMSG, create the unins???.msg file }
- var
- F: TFile;
- begin
- { If this installation didn't create or replace an unins???.exe file,
- do nothing }
- if (UninstallExeCreated <> ueNone) and
- ((shSignedUninstaller in SetupHeader.Options) or DetachedUninstMsgFile) then begin
- LogFmt('Writing uninstaller messages: %s', [UninstallMsgFilename]);
- F := TFile.Create(UninstallMsgFilename, fdCreateAlways, faWrite, fsNone);
- try
- if UninstallExeCreated = ueNew then
- UninstallMsgCreated := True;
- WriteMsgData(F);
- finally
- F.Free;
- end;
- end;
- end;
- procedure ProcessNeedRestartEvent;
- begin
- if (CodeRunner <> nil) and CodeRunner.FunctionExists('NeedRestart', True) then begin
- if not NeedsRestart then begin
- try
- if CodeRunner.RunBooleanFunctions('NeedRestart', [''], bcTrue, False, False) then begin
- NeedsRestart := True;
- Log('Will restart because NeedRestart returned True.');
- end;
- except
- Log('NeedRestart raised an exception.');
- Application.HandleException(nil);
- end;
- end
- else
- Log('Not calling NeedRestart because a restart has already been deemed necessary.');
- end;
- end;
- procedure ProcessComponentEntries;
- var
- I: Integer;
- begin
- for I := 0 to Entries[seComponent].Count-1 do begin
- with PSetupComponentEntry(Entries[seComponent][I])^ do begin
- if ShouldProcessEntry(WizardComponents, nil, Name, '', Languages, '') and (coRestart in Options) then begin
- NeedsRestart := True;
- Break;
- end;
- end;
- end;
- end;
- procedure ProcessTasksEntries;
- var
- I: Integer;
- begin
- for I := 0 to Entries[seTask].Count-1 do begin
- with PSetupTaskEntry(Entries[seTask][I])^ do begin
- if ShouldProcessEntry(nil, WizardTasks, '', Name, Languages, '') and (toRestart in Options) then begin
- NeedsRestart := True;
- Break;
- end;
- end;
- end;
- end;
- procedure ShutdownApplications;
- const
- ERROR_FAIL_SHUTDOWN = 351;
- ForcedStrings: array [Boolean] of String = ('', ' (forced)');
- ForcedActionFlag: array [Boolean] of ULONG = (0, RmForceShutdown);
- var
- Forced: Boolean;
- Error: DWORD;
- begin
- Forced := InitForceCloseApplications or
- ((shForceCloseApplications in SetupHeader.Options) and not InitNoForceCloseApplications);
- Log('Shutting down applications using our files.' + ForcedStrings[Forced]);
- RmDoRestart := True;
- Error := RmShutdown(RmSessionHandle, ForcedActionFlag[Forced], nil);
- while Error = ERROR_FAIL_SHUTDOWN do begin
- Log('Some applications could not be shut down.');
- if AbortRetryIgnoreTaskDialogMsgBox(
- SetupMessages[msgErrorCloseApplications],
- [SetupMessages[msgAbortRetryIgnoreRetry], SetupMessages[msgAbortRetryIgnoreIgnore], SetupMessages[msgAbortRetryIgnoreCancel]]) then
- Break;
- Log('Retrying to shut down applications using our files.' + ForcedStrings[Forced]);
- Error := RmShutdown(RmSessionHandle, ForcedActionFlag[Forced], nil);
- end;
- { Close session on all errors except for ERROR_FAIL_SHUTDOWN, should still call RmRestart in that case. }
- if (Error <> ERROR_SUCCESS) and (Error <> ERROR_FAIL_SHUTDOWN) then begin
- RmEndSession(RmSessionHandle);
- LogFmt('RmShutdown returned an error: %d', [Error]);
- RmDoRestart := False;
- end;
- end;
- var
- Uninstallable, UninstLogCleared: Boolean;
- I: Integer;
- UninstallRegKeyBaseName: String;
- InstallFilesSize, AfterInstallFilesSize: Integer64;
- begin
- Succeeded := False;
- Log('Starting the installation process.');
- SetCurrentDir(WinSystemDir);
- CalcFilesSize(InstallFilesSize, AfterInstallFilesSize);
- InitProgressGauge(InstallFilesSize);
- UninstallExeCreated := ueNone;
- UninstallDataCreated := False;
- UninstallMsgCreated := False;
- AppendUninstallData := False;
- UninstLogCleared := False;
- RegisterFilesList := nil;
- UninstLog := TSetupUninstallLog.Create;
- try
- try
- { Get AppId, UninstallRegKeyBaseName, and Uninstallable now so the user
- can't change them while we're installing }
- ExpandedAppId := ExpandConst(SetupHeader.AppId);
- if ExpandedAppId = '' then
- InternalError('Failed to get a non empty installation "AppId"');
- if TUninstallLog.WriteSafeHeaderString(nil, ExpandedAppId, 0) > 128 then
- InternalError('"AppId" cannot exceed 128 bytes (encoded)');
- UninstallRegKeyBaseName := GetUninstallRegKeyBaseName(ExpandedAppId);
- Uninstallable := EvalDirectiveCheck(SetupHeader.Uninstallable);
- { Init }
- UninstLog.InstallMode64Bit := Is64BitInstallMode;
- UninstLog.AppName := ExpandedAppName;
- UninstLog.AppId := ExpandedAppId;
- if IsAdminInstallMode then
- Include(UninstLog.Flags, ufAdminInstallMode);
- if IsWin64 then
- Include(UninstLog.Flags, ufWin64);
- if IsAdmin then { Setup or [Code] might have done administrative actions, even if IsAdminInstallMode is False }
- Include(UninstLog.Flags, ufAdminInstalled)
- else if IsPowerUserOrAdmin then
- { Note: This flag is only set in 5.1.9 and later }
- Include(UninstLog.Flags, ufPowerUserInstalled);
- if SetupHeader.WizardStyle = wsModern then
- Include(UninstLog.Flags, ufModernStyle);
- if shUninstallRestartComputer in SetupHeader.Options then
- Include(UninstLog.Flags, ufAlwaysRestart);
- if ChangesEnvironment then
- Include(UninstLog.Flags, ufChangesEnvironment);
- RecordStartInstall;
- RecordCompiledCode;
- RegisterFilesList := TList.Create;
- { Process Component entries, if any }
- ProcessComponentEntries;
- ProcessEvents;
- { Process Tasks entries, if any }
- ProcessTasksEntries;
- ProcessEvents;
- { Shutdown applications, if any }
- if RmSessionStarted and RmFoundApplications then begin
- if WizardPreparingYesRadio then begin
- SetStatusLabelText(SetupMessages[msgStatusClosingApplications]);
- ShutdownApplications;
- ProcessEvents;
- end else
- Log('User chose not to shutdown applications using our files.');
- end;
- { Process InstallDelete entries, if any }
- ProcessInstallDeleteEntries;
- ProcessEvents;
- if ExpandedAppMutex <> '' then
- UninstLog.Add(utMutexCheck, [ExpandedAppMutex], 0);
- if ChangesAssociations then
- UninstLog.Add(utRefreshFileAssoc, [''], 0);
- { Record UninstallDelete entries, if any }
- RecordUninstallDeleteEntries;
- ProcessEvents;
- { Create the application directory and extra dirs }
- SetStatusLabelText(SetupMessages[msgStatusCreateDirs]);
- CreateDirs;
- ProcessEvents;
- if Uninstallable then begin
- { Generate the filenames for the uninstall info in the application
- directory }
- SetStatusLabelText(SetupMessages[msgStatusSavingUninstall]);
- GenerateUninstallInfoFilename;
- end;
- { Copy the files }
- SetStatusLabelText(SetupMessages[msgStatusExtractFiles]);
- CopyFiles(Uninstallable);
- ProcessEvents;
- { Create program icons, if any }
- if HasIcons then begin
- SetStatusLabelText(SetupMessages[msgStatusCreateIcons]);
- CreateIcons;
- ProcessEvents;
- end;
- { Create INI entries, if any }
- if Entries[seIni].Count <> 0 then begin
- SetStatusLabelText(SetupMessages[msgStatusCreateIniEntries]);
- CreateIniEntries;
- ProcessEvents;
- end;
- { Create registry entries, if any }
- if Entries[seRegistry].Count <> 0 then begin
- SetStatusLabelText(SetupMessages[msgStatusCreateRegistryEntries]);
- CreateRegistryEntries;
- ProcessEvents;
- end;
- { Call the NeedRestart event function now.
- Note: This can't be done after RegisterFiles, since RegisterFiles
- relies on the setting of the NeedsRestart variable. }
- SetStatusLabelText('');
- ProcessNeedRestartEvent;
- ProcessEvents;
- { Register files, if any }
- if RegisterFilesList.Count <> 0 then begin
- SetStatusLabelText(SetupMessages[msgStatusRegisterFiles]);
- RegisterFiles;
- ProcessEvents;
- end;
- { Save uninstall information. After uninstall info is saved, you cannot
- make any more modifications to the user's system. Any additional
- modifications you want to add must be done before this is called. }
- if Uninstallable then begin
- SetStatusLabelText(SetupMessages[msgStatusSavingUninstall]);
- Log('Saving uninstall information.');
- RenameUninstallExe;
- CreateUninstallMsgFile;
- { Register uninstall information so the program can be uninstalled
- through the Add/Remove Programs Control Panel applet. This is done
- on NT 3.51 too, so that the uninstall entry for the app will appear
- if the user later upgrades to NT 4.0+. }
- if EvalDirectiveCheck(SetupHeader.CreateUninstallRegKey) then
- RegisterUninstallInfo(UninstallRegKeyBaseName, AfterInstallFilesSize);
- RecordUninstallRunEntries;
- UninstLog.Add(utEndInstall, [GetLocalTimeAsStr], 0);
- UninstLog.Save(UninstallDataFilename, AppendUninstallData,
- shUpdateUninstallLogAppName in SetupHeader.Options);
- if Debugging then
- DebugNotifyUninstExe(UninstallExeFileName);
- end;
- SetStatusLabelText('');
- UninstLogCleared := True;
- UninstLog.Clear;
- except
- try
- { Show error message, if any, and set the exit code we'll be returning }
- if not(ExceptObject is EAbort) then begin
- Log(Format('Fatal exception during installation process (%s):' + SNewLine,
- [ExceptObject.ClassName]) + GetExceptMessage);
- SetupExitCode := ecInstallationError;
- Application.HandleException(nil);
- LoggedMsgBox(SetupMessages[msgSetupAborted], '', mbCriticalError, MB_OK, True, IDOK);
- end
- else begin
- Log('User canceled the installation process.');
- SetupExitCode := ecInstallationCancelled;
- end;
- { Undo any changes it's made so far }
- if not UninstLogCleared then begin
- Log('Rolling back changes.');
- try
- SetStatusLabelText(SetupMessages[msgStatusRollback]);
- WizardForm.ProgressGauge.Visible := False;
- FinishProgressGauge(True);
- WizardForm.CancelButton.Enabled := False;
- WizardForm.Update;
- except
- { ignore any exceptions, just in case... }
- end;
- if UninstallTempExeFilename <> '' then
- DeleteFile(UninstallTempExeFilename);
- if UninstallExeCreated = ueNew then
- DeleteFile(UninstallExeFilename);
- if UninstallDataCreated then
- DeleteFile(UninstallDataFilename);
- if UninstallMsgCreated then
- DeleteFile(UninstallMsgFilename);
- UninstLog.PerformUninstall(False, nil);
- { Sleep for a bit so that the user has time to read the "Rolling
- back changes" message }
- if WizardForm.Visible then
- Sleep(1500);
- end;
- except
- { No exception should be generated by the above code, but just in
- case, handle any exception now so that Application.Terminate is
- always called below.
- Note that we can't just put Application.Terminate in a finally
- section, because it would prevent the display of an exception
- message box later (MessageBox() dislikes WM_QUIT). }
- Application.HandleException(nil);
- end;
- Exit;
- end;
- finally
- if Assigned(RegisterFilesList) then begin
- for I := RegisterFilesList.Count-1 downto 0 do
- Dispose(PRegisterFilesListRec(RegisterFilesList[I]));
- RegisterFilesList.Free;
- end;
- UninstLog.Free;
- FinishProgressGauge(False);
- end;
- Log('Installation process succeeded.');
- Succeeded := True;
- end;
- procedure InternalExtractTemporaryFile(const DestName: String;
- const CurFile: PSetupFileEntry; const CurFileLocation: PSetupFileLocationEntry;
- const CreateDirs: Boolean);
- var
- DestFile: String;
- DestF: TFile;
- CurFileDate: TFileTime;
- begin
- DestFile := AddBackslash(TempInstallDir) + DestName;
- Log('Extracting temporary file: ' + DestFile);
- { Does not disable FS redirection, like everything else working on the temp dir }
- if CreateDirs then
- ForceDirectories(False, PathExtractPath(DestFile));
- DestF := TFile.Create(DestFile, fdCreateAlways, faWrite, fsNone);
- try
- try
- FileExtractor.SeekTo(CurFileLocation^, nil);
- FileExtractor.DecompressFile(CurFileLocation^, DestF, nil,
- not (foDontVerifyChecksum in CurFile^.Options));
- if floTimeStampInUTC in CurFileLocation^.Flags then
- CurFileDate := CurFileLocation^.SourceTimeStamp
- else
- LocalFileTimeToFileTime(CurFileLocation^.SourceTimeStamp, CurFileDate);
- SetFileTime(DestF.Handle, nil, nil, @CurFileDate);
- finally
- DestF.Free;
- end;
- except
- DeleteFile(DestFile);
- raise;
- end;
- AddAttributesToFile(False, DestFile, CurFile^.Attribs);
- end;
- procedure ExtractTemporaryFile(const BaseName: String);
- function EscapeBraces(const S: String): String;
- { Changes all '{' to '{{'. Uses ConstLeadBytes^ for the lead byte table. }
- 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;
- var
- EscapedBaseName: String;
- CurFileNumber: Integer;
- CurFile: PSetupFileEntry;
- begin
- { We compare BaseName to the filename portion of TSetupFileEntry.DestName
- which has braces escaped, but BaseName does not; escape it to match }
- EscapedBaseName := EscapeBraces(BaseName);
- for CurFileNumber := 0 to Entries[seFile].Count-1 do begin
- CurFile := PSetupFileEntry(Entries[seFile][CurFileNumber]);
- if (CurFile^.LocationEntry <> -1) and (CompareText(PathExtractName(CurFile^.DestName), EscapedBaseName) = 0) then begin
- InternalExtractTemporaryFile(BaseName, CurFile, Entries[seFileLocation][CurFile^.LocationEntry], False);
- Exit;
- end;
- end;
- InternalErrorFmt('ExtractTemporaryFile: The file "%s" was not found', [BaseName]);
- end;
- function ExtractTemporaryFiles(const Pattern: String): Integer;
- var
- LowerPattern, DestName: String;
- CurFileNumber: Integer;
- CurFile: PSetupFileEntry;
- begin
- if Length(Pattern) >= MAX_PATH then
- InternalError('ExtractTemporaryFiles: Pattern too long');
- LowerPattern := PathLowercase(Pattern);
- Result := 0;
- for CurFileNumber := 0 to Entries[seFile].Count-1 do begin
- CurFile := PSetupFileEntry(Entries[seFile][CurFileNumber]);
- if CurFile^.LocationEntry <> -1 then begin
- { Use ExpandConstEx2 to unescape any braces not in an embedded constant,
- while leaving constants unexpanded }
- DestName := ExpandConstEx2(CurFile^.DestName, [''], False);
- if WildcardMatch(PChar(PathLowercase(DestName)), PChar(LowerPattern)) then begin
- Delete(DestName, 1, PathDrivePartLengthEx(DestName, True)); { Remove any drive part }
- if Pos('{tmp}\', DestName) = 1 then
- Delete(DestName, 1, Length('{tmp}\'));
- if Pos(':', DestName) <> 0 then
- InternalError('ExtractTemporaryFiles: Invalid character in matched file name');
- InternalExtractTemporaryFile(DestName, CurFile, Entries[seFileLocation][CurFile^.LocationEntry], True);
- Inc(Result);
- end;
- end;
- end;
- if Result = 0 then
- InternalErrorFmt('ExtractTemporaryFiles: No files matching "%s" found', [Pattern]);
- end;
- type
- THTTPDataReceiver = class
- private
- FBaseName, FUrl: String;
- FOnDownloadProgress: TOnDownloadProgress;
- FOnSimpleDownloadProgress: TOnSimpleDownloadProgress;
- FOnSimpleDownloadProgressParam: Integer64;
- FAborted: Boolean;
- FProgress, FProgressMax: Int64;
- FLastReportedProgress: Int64;
- public
- property BaseName: String write FBaseName;
- property Url: String write FUrl;
- property OnDownloadProgress: TOnDownloadProgress write FOnDownloadProgress;
- property OnSimpleDownloadProgress: TOnSimpleDownloadProgress write FOnSimpleDownloadProgress;
- property OnSimpleDownloadProgressParam: Integer64 write FOnSimpleDownloadProgressParam;
- property Aborted: Boolean read FAborted;
- property Progress: Int64 read FProgress;
- property ProgressMax: Int64 read FProgressMax;
- procedure OnReceiveData(const Sender: TObject; AContentLength: Int64; AReadCount: Int64; var Abort: Boolean);
- end;
- procedure THTTPDataReceiver.OnReceiveData(const Sender: TObject; AContentLength: Int64; AReadCount: Int64; var Abort: Boolean);
- begin
- FProgress := AReadCount;
- FProgressMax := AContentLength;
- try
- if Assigned(FOnDownloadProgress) then begin
- if not FOnDownloadProgress(FUrl, FBaseName, FProgress, FProgressMax) then
- Abort := True;
- end else if Assigned(FOnSimpleDownloadProgress) then begin
- try
- FOnSimpleDownloadProgress(Integer64(Progress-FLastReportedProgress), FOnSimpleDownloadProgressParam);
- finally
- FLastReportedProgress := Progress;
- end;
- end;
- except
- if ExceptObject is EAbort then { FOnSimpleDownloadProgress always uses Abort to abort }
- Abort := True
- else
- raise;
- end;
- if not Abort and DownloadTemporaryFileOrExtractArchiveProcessMessages then
- Application.ProcessMessages;
- if Abort then
- FAborted := True
- end;
- procedure SetUserAgentAndSecureProtocols(const AHTTPClient: THTTPClient);
- begin
- AHTTPClient.UserAgent := SetupTitle + ' ' + SetupVersion;
- { TLS 1.2 isn't enabled by default on older versions of Windows }
- AHTTPClient.SecureProtocols := [THTTPSecureProtocol.TLS1, THTTPSecureProtocol.TLS11, THTTPSecureProtocol.TLS12];
- end;
- function MaskPasswordInUrl(const Url: String): String;
- var
- Uri: TUri;
- begin
- Uri := TUri.Create(Url);
- if Uri.Password <> '' then begin
- Uri.Password := '***';
- Result := Uri.ToString;
- end else
- Result := URL;
- end;
- var
- DownloadTemporaryFileUser, DownloadTemporaryFilePass: String;
- procedure SetDownloadTemporaryFileCredentials(const User, Pass: String);
- begin
- DownloadTemporaryFileUser := User;
- DownloadTemporaryFilePass := Pass;
- end;
- function GetCredentialsAndCleanUrl(const Url, CustomUser, CustomPass: String; var User, Pass, CleanUrl: String) : Boolean;
- begin
- const Uri = TUri.Create(Url); { This is a record so no need to free }
- if CustomUser = '' then
- User := TNetEncoding.URL.Decode(Uri.Username)
- else
- User := CustomUser;
- if CustomPass = '' then
- Pass := TNetEncoding.URL.Decode(Uri.Password, [TURLEncoding.TDecodeOption.PlusAsSpaces])
- else
- Pass := CustomPass;
- Uri.Username := '';
- Uri.Password := '';
- CleanUrl := Uri.ToString;
- Result := (User <> '') or (Pass <> '');
- if Result then
- LogFmt('Download is using basic authentication: %s, ***', [User])
- else
- Log('Download is not using basic authentication');
- end;
- function GetISSigUrl(const Url, ISSigUrl: String): String;
- begin
- if ISSigUrl <> '' then
- Result := ISSigUrl
- else begin
- const Uri = TUri.Create(Url); { This is a record so no need to free }
- Uri.Path := Uri.Path + ISSigExt;
- Result := Uri.ToString;
- end;
- end;
- function DownloadFile(const Url, CustomUserName, CustomPassword: String;
- const DestF: TFile; [ref] const Verification: TSetupFileVerification; const ISSigSourceFilename: String;
- const OnSimpleDownloadProgress: TOnSimpleDownloadProgress;
- const OnSimpleDownloadProgressParam: Integer64): Int64;
- var
- HandleStream: THandleStream;
- HTTPDataReceiver: THTTPDataReceiver;
- HTTPClient: THTTPClient;
- HTTPResponse: IHTTPResponse;
- User, Pass, CleanUrl: String;
- HasCredentials : Boolean;
- begin
- if Url = '' then
- InternalError('DownloadFile: Invalid Url value');
- LogFmt('Downloading file from %s', [MaskPasswordInURL(Url)]);
- HTTPDataReceiver := nil;
- HTTPClient := nil;
- HandleStream := nil;
- try
- HasCredentials := GetCredentialsAndCleanUrl(URL,
- CustomUserName, CustomPassword, User, Pass, CleanUrl);
- { Setup downloader }
- HTTPDataReceiver := THTTPDataReceiver.Create;
- HTTPDataReceiver.Url := CleanUrl;
- HTTPDataReceiver.OnSimpleDownloadProgress := OnSimpleDownloadProgress;
- HTTPDataReceiver.OnSimpleDownloadProgressParam := OnSimpleDownloadProgressParam;
- HTTPClient := THTTPClient.Create; { http://docwiki.embarcadero.com/RADStudio/Rio/en/Using_an_HTTP_Client }
- SetUserAgentAndSecureProtocols(HTTPClient);
- HTTPClient.OnReceiveData := HTTPDataReceiver.OnReceiveData;
- { Download to specified handle }
- HandleStream := THandleStream.Create(DestF.Handle);
- if HasCredentials then begin
- const Base64 = TBase64Encoding.Create(0);
- try
- HTTPClient.CustomHeaders['Authorization'] := 'Basic ' + Base64.Encode(User + ':' + Pass);
- finally
- Base64.Free;
- end;
- end;
- HTTPResponse := HTTPClient.Get(CleanUrl, HandleStream);
- Result := 0; { silence compiler }
- if HTTPDataReceiver.Aborted then
- Abort
- else if (HTTPResponse.StatusCode < 200) or (HTTPResponse.StatusCode > 299) then
- raise Exception.Create(Format('%d %s', [HTTPResponse.StatusCode, HTTPResponse.StatusText]))
- else begin
- { Download completed, get size and close it }
- Result := HandleStream.Size;
- FreeAndNil(HandleStream);
- { Check verification if specified, otherwise check everything else we can check }
- if Verification.Typ <> fvNone then begin
- var ExpectedFileHash: TSHA256Digest;
- if Verification.Typ = fvHash then
- ExpectedFileHash := Verification.Hash
- else
- DoISSigVerify(DestF, nil, ISSigSourceFilename, False, Verification.ISSigAllowedKeys, ExpectedFileHash);
- const FileHash = GetSHA256OfFile(DestF);
- if not SHA256DigestsEqual(FileHash, ExpectedFileHash) then
- VerificationError(veFileHashIncorrect);
- Log(VerificationSuccessfulLogMessage);
- end else begin
- if HTTPDataReceiver.ProgressMax > 0 then begin
- if HTTPDataReceiver.Progress <> HTTPDataReceiver.ProgressMax then
- raise Exception.Create(FmtSetupMessage(msgErrorProgress, [IntToStr(HTTPDataReceiver.Progress), IntToStr(HTTPDataReceiver.ProgressMax)]))
- else if HTTPDataReceiver.ProgressMax <> Result then
- raise Exception.Create(FmtSetupMessage(msgErrorFileSize, [IntToStr(HTTPDataReceiver.ProgressMax), IntToStr(Result)]));
- end;
- end;
- end;
- finally
- HandleStream.Free;
- HTTPClient.Free;
- HTTPDataReceiver.Free;
- end;
- end;
- function DownloadTemporaryFile(const Url, BaseName: String;
- [ref] const Verification: TSetupFileVerification; const OnDownloadProgress: TOnDownloadProgress;
- out DestFile: String): Int64;
- var
- TempFile: String;
- TempF: TFile;
- HandleStream: THandleStream;
- TempFileLeftOver: Boolean;
- HTTPDataReceiver: THTTPDataReceiver;
- HTTPClient: THTTPClient;
- HTTPResponse: IHTTPResponse;
- RetriesLeft: Integer;
- LastError: DWORD;
- User, Pass, CleanUrl: String;
- HasCredentials : Boolean;
- begin
- if Url = '' then
- InternalError('DownloadTemporaryFile: Invalid Url value');
- if BaseName = '' then
- InternalError('DownloadTemporaryFile: Invalid BaseName value');
- DestFile := AddBackslash(TempInstallDir) + BaseName;
- LogFmt('Downloading temporary file from %s: %s', [MaskPasswordInURL(Url), DestFile]);
- { Does not disable FS redirection, like everything else working on the temp dir }
- { Prepare directory }
- if NewFileExists(DestFile) then begin
- if Verification.Typ = fvHash then begin
- if SHA256DigestsEqual(GetSHA256OfFile(False, DestFile), Verification.Hash) then begin
- Log(' File already downloaded.');
- Result := 0;
- Exit;
- end;
- end else if Verification.Typ = fvISSig then begin
- var ExistingFileName: String;
- var ExistingFileSize: Int64;
- var ExistingFileHash: TSHA256Digest;
- if ISSigVerifySignature(DestFile, GetISSigAllowedKeys(ISSigAvailableKeys, Verification.ISSigAllowedKeys),
- ExistingFileName, ExistingFileSize, ExistingFileHash, nil, nil, nil) then begin
- const DestF = TFile.Create(DestFile, fdOpenExisting, faRead, fsReadWrite);
- try
- { Not checking ExistingFileName because we can't be sure what the original filename was }
- if (DestF.Size = ExistingFileSize) and
- (SHA256DigestsEqual(GetSHA256OfFile(DestF), ExistingFileHash)) then begin
- Log(' File already downloaded.');
- Result := 0;
- Exit;
- end;
- finally
- DestF.Free;
- end;
- end;
- end;
- SetFileAttributes(PChar(DestFile), GetFileAttributes(PChar(DestFile)) and not FILE_ATTRIBUTE_READONLY);
- DelayDeleteFile(False, DestFile, 13, 50, 250);
- end else
- ForceDirectories(False, PathExtractPath(DestFile));
- HTTPDataReceiver := nil;
- HTTPClient := nil;
- TempF := nil;
- TempFileLeftOver := False;
- HandleStream := nil;
- try
- HasCredentials := GetCredentialsAndCleanUrl(URL,
- DownloadTemporaryFileUser, DownloadTemporaryFilePass, User, Pass, CleanUrl);
- { Setup downloader }
- HTTPDataReceiver := THTTPDataReceiver.Create;
- HTTPDataReceiver.BaseName := BaseName;
- HTTPDataReceiver.Url := CleanUrl;
- HTTPDataReceiver.OnDownloadProgress := OnDownloadProgress;
- HTTPClient := THTTPClient.Create; { http://docwiki.embarcadero.com/RADStudio/Rio/en/Using_an_HTTP_Client }
- SetUserAgentAndSecureProtocols(HTTPClient);
- HTTPClient.OnReceiveData := HTTPDataReceiver.OnReceiveData;
- { Create temporary file }
- TempFile := GenerateUniqueName(False, PathExtractPath(DestFile), '.tmp');
- TempF := TFile.Create(TempFile, fdCreateAlways, faWrite, fsNone);
- TempFileLeftOver := True;
- { To test redirects: https://jrsoftware.org/download.php/is.exe
- To test expired certificates: https://expired.badssl.com/
- To test self-signed certificates: https://self-signed.badssl.com/
- To test basic authentication: https://guest:[email protected]/HTTP/Basic/
- To test 100 MB file: https://speed.hetzner.de/100MB.bin
- To test 1 GB file: https://speed.hetzner.de/1GB.bin
- To test file without a content length: https://github.com/jrsoftware/issrc/archive/main.zip }
- { Download to temporary file}
- HandleStream := THandleStream.Create(TempF.Handle);
- if HasCredentials then begin
- const Base64 = TBase64Encoding.Create(0);
- try
- HTTPClient.CustomHeaders['Authorization'] := 'Basic ' + Base64.Encode(User + ':' + Pass);
- finally
- Base64.Free;
- end;
- end;
- HTTPResponse := HTTPClient.Get(CleanUrl, HandleStream);
- if HTTPDataReceiver.Aborted then
- raise Exception.Create(SetupMessages[msgErrorDownloadAborted])
- else if (HTTPResponse.StatusCode < 200) or (HTTPResponse.StatusCode > 299) then
- raise Exception.Create(FmtSetupMessage(msgErrorDownloadFailed, [IntToStr(HTTPResponse.StatusCode), HTTPResponse.StatusText]))
- else begin
- { Download completed, get size and close it }
- Result := HandleStream.Size;
- FreeAndNil(HandleStream);
- { Check verification if specified, otherwise check everything else we can check }
- if Verification.Typ <> fvNone then begin
- var ExpectedFileHash: TSHA256Digest;
- if Verification.Typ = fvHash then
- ExpectedFileHash := Verification.Hash
- else
- DoISSigVerify(TempF, nil, DestFile, False, Verification.ISSigAllowedKeys, ExpectedFileHash);
- FreeAndNil(TempF);
- const FileHash = GetSHA256OfFile(False, TempFile);
- if not SHA256DigestsEqual(FileHash, ExpectedFileHash) then
- VerificationError(veFileHashIncorrect);
- Log(VerificationSuccessfulLogMessage);
- end else begin
- FreeAndNil(TempF);
- if HTTPDataReceiver.ProgressMax > 0 then begin
- if HTTPDataReceiver.Progress <> HTTPDataReceiver.ProgressMax then
- raise Exception.Create(FmtSetupMessage(msgErrorProgress, [IntToStr(HTTPDataReceiver.Progress), IntToStr(HTTPDataReceiver.ProgressMax)]))
- else if HTTPDataReceiver.ProgressMax <> Result then
- raise Exception.Create(FmtSetupMessage(msgErrorFileSize, [IntToStr(HTTPDataReceiver.ProgressMax), IntToStr(Result)]));
- end;
- end;
- { Rename the temporary file to the new name now, with retries if needed }
- RetriesLeft := 4;
- while not MoveFile(PChar(TempFile), PChar(DestFile)) do begin
- { Couldn't rename the temporary file... }
- LastError := GetLastError;
- { Does the error code indicate that it is possibly in use? }
- if LastErrorIndicatesPossiblyInUse(LastError, True) then begin
- LogFmt(' The existing file appears to be in use (%d). ' +
- 'Retrying.', [LastError]);
- Dec(RetriesLeft);
- Sleep(1000);
- if RetriesLeft > 0 then
- Continue;
- end;
- { Some other error occurred, or we ran out of tries }
- SetLastError(LastError);
- Win32ErrorMsg('MoveFile'); { Throws an exception }
- end;
- TempFileLeftOver := False;
- end;
- finally
- HandleStream.Free;
- TempF.Free;
- HTTPClient.Free;
- HTTPDataReceiver.Free;
- if TempFileLeftOver then
- DeleteFile(TempFile);
- end;
- end;
- function DownloadTemporaryFile(const Url, BaseName: String;
- [ref] const Verification: TSetupFileVerification; const OnDownloadProgress: TOnDownloadProgress): Int64;
- begin
- var DestFile: String;
- Result := DownloadTemporaryFile(Url, BaseName, Verification, OnDownloadProgress, DestFile);
- end;
- procedure DownloadTemporaryFileSizeAndDate(const Url: String; var FileSize: Int64; var FileDate: String);
- var
- HTTPClient: THTTPClient;
- HTTPResponse: IHTTPResponse;
- User, Pass, CleanUrl: string;
- HasCredentials : Boolean;
- Base64: TBase64Encoding;
- begin
- HTTPClient := THTTPClient.Create;
- Base64 := nil;
- try
- HasCredentials := GetCredentialsAndCleanUrl(Url,
- DownloadTemporaryFileUser, DownloadTemporaryFilePass, User, Pass, CleanUrl);
- if HasCredentials then begin
- Base64 := TBase64Encoding.Create(0);
- HTTPClient.CustomHeaders['Authorization'] := 'Basic ' + Base64.Encode(User + ':' + Pass);
- end;
- SetUserAgentAndSecureProtocols(HTTPClient);
- HTTPResponse := HTTPClient.Head(CleanUrl);
- if (HTTPResponse.StatusCode < 200) or (HTTPResponse.StatusCode > 299) then
- raise Exception.Create(FmtSetupMessage(msgErrorDownloadSizeFailed, [IntToStr(HTTPResponse.StatusCode), HTTPResponse.StatusText]))
- else begin
- FileSize := HTTPResponse.ContentLength;
- FileDate := HTTPResponse.LastModified;
- end;
- finally
- Base64.Free;
- HTTPClient.Free;
- end;
- end;
- function DownloadTemporaryFileSize(const Url: String): Int64;
- var
- FileSize: Int64;
- FileDate: String;
- begin
- if Url = '' then
- InternalError('DownloadTemporaryFileSize: Invalid Url value');
- LogFmt('Getting size of %s.', [MaskPasswordInUrl(Url)]);
- DownloadTemporaryFileSizeAndDate(Url, FileSize, FileDate);
- Result := FileSize;
- end;
- function DownloadTemporaryFileDate(const Url: String): String;
- var
- FileSize: Int64;
- FileDate: String;
- begin
- if Url = '' then
- InternalError('DownloadTemporaryFileDate: Invalid Url value');
- LogFmt('Getting last modified date of %s.', [MaskPasswordInUrl(Url)]);
- DownloadTemporaryFileSizeAndDate(Url, FileSize, FileDate);
- Result := FileDate;
- end;
- end.
|