| 123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107110811091110111111121113111411151116111711181119112011211122112311241125112611271128112911301131113211331134113511361137113811391140114111421143114411451146114711481149115011511152115311541155115611571158115911601161116211631164116511661167116811691170117111721173117411751176117711781179118011811182118311841185118611871188118911901191119211931194119511961197119811991200120112021203120412051206120712081209121012111212121312141215121612171218121912201221122212231224122512261227122812291230123112321233123412351236123712381239124012411242124312441245124612471248124912501251125212531254125512561257125812591260126112621263126412651266126712681269127012711272127312741275127612771278127912801281128212831284128512861287128812891290129112921293129412951296129712981299130013011302 |
- unit Setup.WizardForm.CustomPages;
- {
- Inno Setup
- Copyright (C) 1997-2026 Jordan Russell
- Portions by Martijn Laan
- For conditions of distribution and use, see LICENSE.TXT.
- Custom wizard pages
- }
- interface
- uses
- Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, StdCtrls, Contnrs, Generics.Collections,
- Shared.Struct, Setup.WizardForm, Setup.DownloadFileFunc, Setup.ISSigVerifyFunc,
- Setup.InstFunc, Compression.SevenZipDecoder,
- NewCheckListBox, NewStaticText, NewProgressBar, PasswordEdit, RichEditViewer,
- NewCtrls, TaskbarProgressFunc;
- type
- TInputQueryWizardPage = class(TWizardPage)
- private
- FEdits: TList<TPasswordEdit>;
- FPromptLabels: TList<TNewStaticText>;
- FSubCaptionLabel: TNewStaticText;
- FY: Integer;
- function GetEdit(Index: NativeInt): TPasswordEdit;
- function GetPromptLabel(Index: NativeInt): TNewStaticText;
- function GetValue(Index: NativeInt): String;
- procedure SetValue(Index: NativeInt; const Value: String);
- public
- constructor Create(AOwner: TComponent); override;
- destructor Destroy; override;
- function Add(const APrompt: String; const APassword: Boolean): NativeInt;
- property Edits[Index: NativeInt]: TPasswordEdit read GetEdit;
- procedure Initialize(const SubCaption: String);
- property PromptLabels[Index: NativeInt]: TNewStaticText read GetPromptLabel;
- property Values[Index: NativeInt]: String read GetValue write SetValue;
- published
- property SubCaptionLabel: TNewStaticText read FSubCaptionLabel;
- end;
- TInputOptionWizardPage = class(TWizardPage)
- private
- FCheckListBox: TNewCheckListBox;
- FExclusive: Boolean;
- FSubCaptionLabel: TNewStaticText;
- function GetSelectedValueIndex: Integer;
- function GetValue(Index: Integer): Boolean;
- procedure SetSelectedValueIndex(Value: Integer);
- procedure SetValue(Index: Integer; Value: Boolean);
- public
- function Add(const ACaption: String): Integer;
- function AddEx(const ACaption: String; const ALevel: Byte; const AExclusive: Boolean): Integer;
- procedure Initialize(const SubCaption: String; const Exclusive, ListBox: Boolean);
- property SelectedValueIndex: Integer read GetSelectedValueIndex write SetSelectedValueIndex;
- property Values[Index: Integer]: Boolean read GetValue write SetValue;
- published
- property CheckListBox: TNewCheckListBox read FCheckListBox;
- property SubCaptionLabel: TNewStaticText read FSubCaptionLabel;
- end;
- TInputDirWizardPage = class(TWizardPage)
- private
- FAppendDir: Boolean;
- FButtons: TList<TNewButton>;
- FEdits: TList<TNewPathEdit>;
- FNewFolderName: String;
- FPromptLabels: TList<TNewStaticText>;
- FSubCaptionLabel: TNewStaticText;
- FY: Integer;
- procedure ButtonClick(Sender: TObject);
- function GetButton(Index: NativeInt): TNewButton;
- function GetEdit(Index: NativeInt): TNewPathEdit;
- function GetPromptLabel(Index: NativeInt): TNewStaticText;
- function GetValue(Index: NativeInt): String;
- procedure SetValue(Index: NativeInt; const Value: String);
- protected
- procedure NextButtonClick(var Continue: Boolean); override;
- public
- constructor Create(AOwner: TComponent); override;
- destructor Destroy; override;
- function Add(const APrompt: String): NativeInt;
- property Buttons[Index: NativeInt]: TNewButton read GetButton;
- property Edits[Index: NativeInt]: TNewPathEdit read GetEdit;
- procedure Initialize(const SubCaption: String; const AppendDir: Boolean;
- const NewFolderName: String);
- property PromptLabels[Index: NativeInt]: TNewStaticText read GetPromptLabel;
- property Values[Index: NativeInt]: String read GetValue write SetValue;
- published
- property NewFolderName: String read FNewFolderName write FNewFolderName;
- property SubCaptionLabel: TNewStaticText read FSubCaptionLabel;
- end;
- TInputFileWizardPage = class(TWizardPage)
- private
- FButtons: TList<TNewButton>;
- FEdits: TList<TNewPathEdit>;
- FInputFileDefaultExtensions: TStringList;
- FInputFileFilters: TStringList;
- FPromptLabels: TList<TNewStaticText>;
- FSubCaptionLabel: TNewStaticText;
- FY: Integer;
- procedure ButtonClick(Sender: TObject);
- function GetButton(Index: NativeInt): TNewButton;
- function GetEdit(Index: NativeInt): TNewPathEdit;
- function GetPromptLabel(Index: NativeInt): TNewStaticText;
- function GetValue(Index: NativeInt): String;
- procedure SetValue(Index: NativeInt; const Value: String);
- function GetIsSaveButton(Index: NativeInt): Boolean;
- procedure SetIsSaveButton(Index: NativeInt; const IsSaveButton: Boolean);
- public
- constructor Create(AOwner: TComponent); override;
- destructor Destroy; override;
- function Add(const APrompt, AFilter, ADefaultExtension: String): NativeInt;
- property Buttons[Index: NativeInt]: TNewButton read GetButton;
- property Edits[Index: NativeInt]: TNewPathEdit read GetEdit;
- procedure Initialize(const SubCaption: String);
- property PromptLabels[Index: NativeInt]: TNewStaticText read GetPromptLabel;
- property Values[Index: NativeInt]: String read GetValue write SetValue;
- property IsSaveButton[Index: NativeInt]: Boolean read GetIsSaveButton write SetIsSaveButton;
- published
- property SubCaptionLabel: TNewStaticText read FSubCaptionLabel;
- end;
- TOutputMsgWizardPage = class(TWizardPage)
- private
- FMsgLabel: TNewStaticText;
- public
- procedure Initialize(const Msg: String);
- published
- property MsgLabel: TNewStaticText read FMsgLabel;
- end;
- TOutputMsgMemoWizardPage = class(TWizardPage)
- private
- FRichEditViewer: TRichEditViewer;
- FSubCaptionLabel: TNewStaticText;
- public
- procedure Initialize(const SubCaption: String; const Msg: AnsiString);
- published
- property RichEditViewer: TRichEditViewer read FRichEditViewer;
- property SubCaptionLabel: TNewStaticText read FSubCaptionLabel;
- end;
- TOutputProgressWizardPage = class(TWizardPage)
- private
- FMsg1Label: TNewStaticText;
- FMsg2Label: TNewStaticText;
- FProgressBar: TNewProgressBar;
- FUseMarqueeStyle: Boolean;
- FSavePageID: Integer;
- procedure ProcessMsgs;
- public
- constructor Create(AOwner: TComponent); override;
- procedure Hide;
- procedure Initialize; virtual;
- procedure SetProgress(const Position, Max: Integer);
- procedure SetText(const Msg1, Msg2: String);
- procedure Show; virtual;
- published
- property Msg1Label: TNewStaticText read FMsg1Label;
- property Msg2Label: TNewStaticText read FMsg2Label;
- property ProgressBar: TNewProgressBar read FProgressBar;
- end;
- TOutputMarqueeProgressWizardPage = class(TOutputProgressWizardPage)
- public
- constructor Create(AOwner: TComponent); override;
- procedure Animate;
- procedure Initialize; override;
- procedure SetProgress(const Position, Max: Integer);
- end;
- TDownloadFile = class
- Url, BaseName, UserName, Password: String;
- Verification: TSetupFileVerification;
- DotISSigEntry: Boolean;
- Data: NativeInt; { Only valid if DotISSigEntry is False }
- end;
- TDownloadFiles = TObjectList<TDownloadFile>;
- TDownloadFileCompleted = reference to procedure(const DownloadedFile: TDownloadFile;
- const DestFile: String; var Remove: Boolean);
- TDownloadWizardPage = class(TOutputProgressWizardPage)
- private
- FFiles: TDownloadFiles;
- FOnDownloadProgress: TOnDownloadProgress;
- FShowBaseNameInsteadOfUrl: Boolean;
- FAbortButton: TNewButton;
- FShowProgressControlsOnNextProgress, FAbortedByUser: Boolean;
- FThrottler: TProgressThrottler;
- FLastBaseNameOrUrl: String;
- function DoAdd(const Url, BaseName, RequiredSHA256OfFile: String;
- const UserName, Password: String; const ISSigVerify: Boolean;
- const ISSigAllowedKeys: AnsiString; const DotISSigEntry: Boolean; const Data: NativeInt): NativeInt;
- procedure AbortButtonClick(Sender: TObject);
- function InternalOnDownloadProgress(const Url, BaseName: string; const Progress, ProgressMax: Int64): Boolean;
- function InternalOnDownloadNoProgress: Boolean;
- function InternalThrottledOnDownloadProgress(const Url, BaseName: string; const Progress, ProgressMax: Int64): Boolean;
- procedure ShowProgressControls(const AVisible: Boolean);
- public
- constructor Create(AOwner: TComponent); override;
- destructor Destroy; override;
- procedure Initialize; override;
- function Add(const Url, BaseName, RequiredSHA256OfFile: String): NativeInt;
- function AddWithISSigVerify(const Url, ISSigUrl, BaseName: String;
- const AllowedKeysRuntimeIDs: TStringList): NativeInt;
- function AddEx(const Url, BaseName, RequiredSHA256OfFile, UserName, Password: String;
- const Data: NativeInt): NativeInt;
- function AddExWithISSigVerify(const Url, ISSigUrl, BaseName, UserName, Password: String;
- const AllowedKeysRuntimeIDs: TStringList; const Data: NativeInt): NativeInt; overload;
- function AddExWithISSigVerify(const Url, ISSigUrl, BaseName, UserName, Password: String;
- const ISSigAllowedKeys: AnsiString; const Data: NativeInt): NativeInt; overload;
- procedure Clear;
- function Download(const OnDownloadFileCompleted: TDownloadFileCompleted): Int64;
- property OnDownloadProgress: TOnDownloadProgress write FOnDownloadProgress;
- procedure Show; override;
- published
- property AbortButton: TNewButton read FAbortButton;
- property AbortedByUser: Boolean read FAbortedByUser;
- property LastBaseNameOrUrl: String read FLastBaseNameOrUrl;
- property ShowBaseNameInsteadOfUrl: Boolean read FShowBaseNameInsteadOfUrl write FShowBaseNameInsteadOfUrl;
- end;
-
- TArchive = class
- FileName, DestDir, Password: String;
- FullPaths: Boolean;
- end;
- TArchives = TObjectList<TArchive>;
- TExtractionWizardPage = class(TOutputProgressWizardPage)
- private
- FArchives: TArchives;
- FOnExtractionProgress: TOnExtractionProgress;
- FShowArchiveInsteadOfFile: Boolean;
- FAbortButton: TNewButton;
- FShowProgressControlsOnNextProgress, FAbortedByUser: Boolean;
- FThrottler: TProgressThrottler;
- procedure AbortButtonClick(Sender: TObject);
- function InternalOnExtractionProgress(const ArchiveName, FileName: string; const Progress, ProgressMax: Int64): Boolean;
- function InternalThrottledOnExtractionProgress(const ArchiveName, FileName: string; const Progress, ProgressMax: Int64): Boolean;
- procedure ShowProgressControls(const AVisible: Boolean);
- public
- constructor Create(AOwner: TComponent); override;
- destructor Destroy; override;
- procedure Initialize; override;
- function Add(const ArchiveFileName, DestDir: String; const FullPaths: Boolean): NativeInt;
- function AddEx(const ArchiveFileName, DestDir, Password: String; const FullPaths: Boolean): NativeInt;
- procedure Clear;
- procedure Extract;
- property OnExtractionProgress: TOnExtractionProgress write FOnExtractionProgress;
- procedure Show; override;
- published
- property AbortButton: TNewButton read FAbortButton;
- property AbortedByUser: Boolean read FAbortedByUser;
- property ShowArchiveInsteadOfFile: Boolean read FShowArchiveInsteadOfFile write FShowArchiveInsteadOfFile;
- end;
- function ConvertAllowedKeysRuntimeIDsToISSigAllowedKeys(const AllowedKeysRuntimeIDs: TStringList): AnsiString;
- implementation
- uses
- StrUtils, ISSigFunc, SHA256,
- Shared.SetupTypes, Setup.MainFunc, Setup.SelectFolderForm,
- SetupLdrAndSetup.Messages, Shared.SetupMessageIDs, PathFunc, Shared.CommonFunc.Vcl,
- Shared.CommonFunc, BrowseFunc, Setup.LoggingFunc, Setup.SetupForm,
- Compression.SevenZipDLLDecoder;
- const
- DefaultLabelHeight = 14;
- DefaultBoxTop = 24; { relative to top of InnerNotebook }
- DefaultBoxBottom = DefaultBoxTop + 205;
- {------}
- procedure SetCtlParentAtBack(const AControl, AParent: TWinControl);
- { Like assigning to AControl.Parent, but puts the control at the *bottom* of
- the z-order instead of the top, for MSAA compatibility }
- var
- OldVisible: Boolean;
- begin
- { Hide the control so the handle won't be created yet, so that unnecessary
- "OBJ_REORDER" MSAA events don't get sent }
- OldVisible := AControl.Visible;
- AControl.Visible := False;
- TSetupForm.SetCtlParent(AControl, AParent);
- AControl.SendToBack;
- AControl.Visible := OldVisible;
- end;
- {--- InputQuery ---}
- constructor TInputQueryWizardPage.Create(AOwner: TComponent);
- begin
- inherited;
- FEdits := TList<TPasswordEdit>.Create;
- FPromptLabels := TList<TNewStaticText>.Create;
- end;
- destructor TInputQueryWizardPage.Destroy;
- begin
- FPromptLabels.Free;
- FEdits.Free;
- inherited;
- end;
- procedure TInputQueryWizardPage.Initialize(const SubCaption: String);
- begin
- FSubCaptionLabel := TNewStaticText.Create(Self);
- with FSubCaptionLabel do begin
- AutoSize := False;
- Width := SurfaceWidth;
- Height := WizardForm.ScalePixelsY(DefaultLabelHeight);
- WordWrap := True;
- Caption := SubCaption;
- end;
- TSetupForm.SetCtlParent(FSubCaptionLabel, Surface);
- FY := WizardForm.AdjustLabelHeight(FSubCaptionLabel) + WizardForm.ScalePixelsY(DefaultBoxTop);
- end;
- function TInputQueryWizardPage.Add(const APrompt: String;
- const APassword: Boolean): NativeInt;
- begin
- var PromptLabel: TNewStaticText;
- if APrompt <> '' then begin
- PromptLabel := TNewStaticText.Create(Self);
- with PromptLabel do begin
- AutoSize := False;
- Top := FY;
- Width := SurfaceWidth;
- Height := WizardForm.ScalePixelsY(DefaultLabelHeight);
- WordWrap := True;
- Caption := APrompt;
- end;
- SetCtlParentAtBack(PromptLabel, Surface);
- Inc(FY, WizardForm.AdjustLabelHeight(PromptLabel) + WizardForm.ScalePixelsY(16));
- end else
- PromptLabel := nil;
- const Edit = TPasswordEdit.Create(Self);
- with Edit do begin
- Password := APassword;
- Top := FY;
- Width := SurfaceWidth;
- end;
- SetCtlParentAtBack(Edit, Surface);
- Inc(FY, WizardForm.ScalePixelsY(36));
- if PromptLabel <> nil then
- PromptLabel.FocusControl := Edit;
- FPromptLabels.Add(PromptLabel);
- Result := FEdits.Add(Edit);
- end;
- function TInputQueryWizardPage.GetEdit(Index: NativeInt): TPasswordEdit;
- begin
- Result := FEdits[Index];
- end;
- function TInputQueryWizardPage.GetPromptLabel(Index: NativeInt): TNewStaticText;
- begin
- Result := FPromptLabels[Index];
- end;
- function TInputQueryWizardPage.GetValue(Index: NativeInt): String;
- begin
- Result := GetEdit(Index).Text;
- end;
- procedure TInputQueryWizardPage.SetValue(Index: NativeInt; const Value: String);
- begin
- GetEdit(Index).Text := Value;
- end;
- {--- InputOption ---}
- procedure TInputOptionWizardPage.Initialize(const SubCaption: String;
- const Exclusive, ListBox: Boolean);
- begin
- FSubCaptionLabel := TNewStaticText.Create(Self);
- with SubCaptionLabel do begin
- AutoSize := False;
- Width := SurfaceWidth;
- Height := WizardForm.ScalePixelsY(DefaultLabelHeight);
- WordWrap := True;
- Caption := SubCaption;
- end;
- TSetupForm.SetCtlParent(FSubCaptionLabel, Surface);
- const CaptionYDiff = WizardForm.AdjustLabelHeight(SubCaptionLabel);
- FCheckListBox := TNewCheckListBox.Create(Self);
- with FCheckListBox do begin
- Top := CaptionYDiff + WizardForm.ScalePixelsY(DefaultBoxTop);
- Width := SurfaceWidth;
- Height := WizardForm.ScalePixelsY(DefaultBoxBottom) + SurfaceExtraHeight - Top;
- Flat := ListBox and (shFlatComponentsList in SetupHeader.Options);
- end;
- SetCtlParentAtBack(FCheckListBox, Surface);
- FExclusive := Exclusive;
- if not ListBox then begin
- FCheckListBox.BorderStyle := bsNone;
- FCheckListBox.Color := SurfaceColor;
- FCheckListBox.MinItemHeight := WizardForm.ScalePixelsY(22);
- FCheckListBox.WantTabs := True;
- end;
- end;
- function TInputOptionWizardPage.Add(const ACaption: String): Integer;
- begin
- Result := AddEx(ACaption, 0, FExclusive);
- end;
- function TInputOptionWizardPage.AddEx(const ACaption: String;
- const ALevel: Byte; const AExclusive: Boolean): Integer;
- begin
- if AExclusive then
- Result := FCheckListBox.AddRadioButton(ACaption, '', ALevel, False, True, nil)
- else
- Result := FCheckListBox.AddCheckBox(ACaption, '', ALevel, False, True, True,
- True, nil);
- end;
- function TInputOptionWizardPage.GetSelectedValueIndex: Integer;
- begin
- for var I := 0 to FCheckListBox.Items.Count-1 do
- if (FCheckListBox.ItemLevel[I] = 0) and FCheckListBox.Checked[I] then begin
- Result := I;
- Exit;
- end;
- Result := -1;
- end;
- function TInputOptionWizardPage.GetValue(Index: Integer): Boolean;
- begin
- Result := FCheckListBox.Checked[Index];
- end;
- procedure TInputOptionWizardPage.SetSelectedValueIndex(Value: Integer);
- begin
- for var I := 0 to FCheckListBox.Items.Count-1 do
- if FCheckListBox.ItemLevel[I] = 0 then
- FCheckListBox.Checked[I] := (I = Value);
- end;
- procedure TInputOptionWizardPage.SetValue(Index: Integer; Value: Boolean);
- begin
- FCheckListBox.Checked[Index] := Value;
- end;
- {--- InputDir ---}
- constructor TInputDirWizardPage.Create(AOwner: TComponent);
- begin
- inherited;
- FButtons := TList<TNewButton>.Create;
- FEdits := TList<TNewPathEdit>.Create;
- FPromptLabels := TList<TNewStaticText>.Create;
- end;
- destructor TInputDirWizardPage.Destroy;
- begin
- FPromptLabels.Free;
- FEdits.Free;
- FButtons.Free;
- inherited;
- end;
- procedure TInputDirWizardPage.ButtonClick(Sender: TObject);
- begin
- if Sender is TNewButton then begin
- const I = FButtons.IndexOf(Sender as TNewButton);
- if I <> -1 then begin
- const Edit = FEdits[I];
- var S: String := Edit.Text;
- if ShowSelectFolderDialog(False, FAppendDir, S, FNewFolderName) then
- Edit.Text := S;
- end;
- end;
- end;
- procedure TInputDirWizardPage.NextButtonClick(var Continue: Boolean);
- begin
- for var I := 0 to FEdits.Count-1 do begin
- const Edit = FEdits[I];
- if not ValidateCustomDirEdit(Edit, True, True, True) then begin
- if WizardForm.Visible then
- Edit.SetFocus;
- Continue := False;
- Exit;
- end;
- end;
- inherited;
- end;
- procedure TInputDirWizardPage.Initialize(const SubCaption: String;
- const AppendDir: Boolean; const NewFolderName: String);
- begin
- FSubCaptionLabel := TNewStaticText.Create(Self);
- with FSubCaptionLabel do begin
- AutoSize := False;
- Width := SurfaceWidth;
- Height := WizardForm.ScalePixelsY(DefaultLabelHeight);
- WordWrap := True;
- Caption := SubCaption;
- end;
- TSetupForm.SetCtlParent(FSubCaptionLabel, Surface);
- FY := WizardForm.AdjustLabelHeight(FSubCaptionLabel) + WizardForm.ScalePixelsY(DefaultBoxTop);
- FAppendDir := AppendDir;
- FNewFolderName := NewFolderName;
- end;
- function TInputDirWizardPage.Add(const APrompt: String): NativeInt;
- begin
- const ButtonWidth = WizardForm.CalculateButtonWidth([SetupMessages[msgButtonWizardBrowse]]);
- var PromptLabel: TNewStaticText;
- if APrompt <> '' then begin
- PromptLabel := TNewStaticText.Create(Self);
- with PromptLabel do begin
- AutoSize := False;
- Top := FY;
- Width := SurfaceWidth;
- Height := WizardForm.ScalePixelsY(DefaultLabelHeight);
- WordWrap := True;
- Caption := APrompt;
- end;
- SetCtlParentAtBack(PromptLabel, Surface);
- Inc(FY, WizardForm.AdjustLabelHeight(PromptLabel) + WizardForm.ScalePixelsY(16));
- end else
- PromptLabel := nil;
- const Edit = TNewPathEdit.Create(Self);
- with Edit do begin
- Top := FY;
- Width := SurfaceWidth-ButtonWidth-WizardForm.ScalePixelsX(10);
- end;
- SetCtlParentAtBack(Edit, Surface);
- if PromptLabel <> nil then
- PromptLabel.FocusControl := Edit;
- const Button = TNewButton.Create(Self);
- with Button do begin
- Left := SurfaceWidth-ButtonWidth;
- Top := Edit.Top-1;
- Width := ButtonWidth;
- Height := WizardForm.NextButton.Height;
- if FEdits.Count = 0 then
- Caption := SetupMessages[msgButtonWizardBrowse]
- else
- { Can't use the same accel key for secondary buttons... }
- Caption := RemoveAccelChar(SetupMessages[msgButtonWizardBrowse]);
- OnClick := ButtonClick;
- end;
- SetCtlParentAtBack(Button, Surface);
- Inc(FY, WizardForm.ScalePixelsY(36));
- FButtons.Add(Button);
- FPromptLabels.Add(PromptLabel);
- Result := FEdits.Add(Edit);
- end;
- function TInputDirWizardPage.GetButton(Index: NativeInt): TNewButton;
- begin
- Result := FButtons[Index];
- end;
- function TInputDirWizardPage.GetEdit(Index: NativeInt): TNewPathEdit;
- begin
- Result := FEdits[Index];
- end;
- function TInputDirWizardPage.GetPromptLabel(Index: NativeInt): TNewStaticText;
- begin
- Result := FPromptLabels[Index];
- end;
- function TInputDirWizardPage.GetValue(Index: NativeInt): String;
- begin
- Result := GetEdit(Index).Text;
- end;
- procedure TInputDirWizardPage.SetValue(Index: NativeInt; const Value: String);
- begin
- GetEdit(Index).Text := RemoveBackslashUnlessRoot(PathExpand(Value));
- end;
- {--- InputFile ---}
- constructor TInputFileWizardPage.Create(AOwner: TComponent);
- begin
- inherited;
- FButtons := TList<TNewButton>.Create;
- FEdits := TList<TNewPathEdit>.Create;
- FInputFileDefaultExtensions := TStringList.Create;
- FInputFileFilters := TStringList.Create;
- FPromptLabels := TList<TNewStaticText>.Create;
- end;
- destructor TInputFileWizardPage.Destroy;
- begin
- FPromptLabels.Free;
- FInputFileFilters.Free;
- FInputFileDefaultExtensions.Free;
- FEdits.Free;
- FButtons.Free;
- inherited;
- end;
- procedure TInputFileWizardPage.ButtonClick(Sender: TObject);
- begin
- if Sender is TNewButton then begin
- { Casting to Integer because TStringList is used below, and TStringList
- indexes are still Integer in 64-bit (unlike TList, which uses NativeInt) }
- const I = Integer(FButtons.IndexOf(Sender as TNewButton));
- if I <> -1 then begin
- const Edit = FEdits[I];
- var FileName: String := Edit.Text;
- if (not IsSaveButton[I] and NewGetOpenFileName(RemoveAccelChar(SetupMessages[msgButtonWizardBrowse]),
- FileName, PathExtractPath(FileName), FInputFileFilters[I],
- FInputFileDefaultExtensions[I], Surface.Handle)) or
- (IsSaveButton[I] and NewGetSaveFileName(RemoveAccelChar(SetupMessages[msgButtonWizardBrowse]),
- FileName, PathExtractPath(FileName), FInputFileFilters[I],
- FInputFileDefaultExtensions[I], Surface.Handle)) then
- Edit.Text := FileName;
- end;
- end;
- end;
- procedure TInputFileWizardPage.Initialize(const SubCaption: String);
- begin
- FSubCaptionLabel := TNewStaticText.Create(Self);
- with FSubCaptionLabel do begin
- AutoSize := False;
- Width := SurfaceWidth;
- Height := WizardForm.ScalePixelsY(DefaultLabelHeight);
- WordWrap := True;
- Caption := SubCaption;
- end;
- TSetupForm.SetCtlParent(FSubCaptionLabel, Surface);
- FY := WizardForm.AdjustLabelHeight(FSubCaptionLabel) + WizardForm.ScalePixelsY(DefaultBoxTop);
- end;
- function TInputFileWizardPage.Add(const APrompt, AFilter,
- ADefaultExtension: String): NativeInt;
- begin
- const ButtonWidth = WizardForm.CalculateButtonWidth([SetupMessages[msgButtonWizardBrowse]]);
- var PromptLabel: TNewStaticText;
- if APrompt <> '' then begin
- PromptLabel := TNewStaticText.Create(Self);
- with PromptLabel do begin
- AutoSize := False;
- Top := FY;
- Width := SurfaceWidth;
- Height := WizardForm.ScalePixelsY(DefaultLabelHeight);
- WordWrap := True;
- Caption := APrompt;
- end;
- SetCtlParentAtBack(PromptLabel, Surface);
- Inc(FY, WizardForm.AdjustLabelHeight(PromptLabel) + WizardForm.ScalePixelsY(16));
- end else
- PromptLabel := nil;
- const Edit = TNewPathEdit.Create(Self);
- with Edit do begin
- AutoCompleteFiles := True;
- Top := FY;
- Width := SurfaceWidth-ButtonWidth-WizardForm.ScalePixelsX(10);
- end;
- SetCtlParentAtBack(Edit, Surface);
- if PromptLabel <> nil then
- PromptLabel.FocusControl := Edit;
- const Button = TNewButton.Create(Self);
- with Button do begin
- Left := SurfaceWidth-ButtonWidth;
- Top := Edit.Top-1;
- Width := ButtonWidth;
- Height := WizardForm.NextButton.Height;
- if FButtons.Count = 0 then
- Caption := SetupMessages[msgButtonWizardBrowse]
- else
- { Can't use the same accel key for secondary buttons... }
- Caption := RemoveAccelChar(SetupMessages[msgButtonWizardBrowse]);
- OnClick := ButtonClick;
- end;
- SetCtlParentAtBack(Button, Surface);
- Inc(FY, WizardForm.ScalePixelsY(36));
- FInputFileFilters.Add(AFilter);
- FInputFileDefaultExtensions.Add(ADefaultExtension);
- FButtons.Add(Button);
- FPromptLabels.Add(PromptLabel);
- Result := FEdits.Add(Edit);
- end;
- function TInputFileWizardPage.GetButton(Index: NativeInt): TNewButton;
- begin
- Result := FButtons[Index];
- end;
- function TInputFileWizardPage.GetEdit(Index: NativeInt): TNewPathEdit;
- begin
- Result := FEdits[Index];
- end;
- function TInputFileWizardPage.GetPromptLabel(Index: NativeInt): TNewStaticText;
- begin
- Result := FPromptLabels[Index];
- end;
- function TInputFileWizardPage.GetValue(Index: NativeInt): String;
- begin
- Result := GetEdit(Index).Text;
- end;
- procedure TInputFileWizardPage.SetValue(Index: NativeInt; const Value: String);
- begin
- GetEdit(Index).Text := Value;
- end;
- function TInputFileWizardPage.GetIsSaveButton(Index: NativeInt): Boolean;
- begin
- Result := GetButton(Index).Tag = 1;
- end;
- procedure TInputFileWizardPage.SetIsSaveButton(Index: NativeInt; const IsSaveButton: Boolean);
- begin
- if IsSaveButton then
- GetButton(Index).Tag := 1
- else
- GetButton(Index).Tag := 0;
- end;
- {--- OutputMsg ---}
- procedure TOutputMsgWizardPage.Initialize(const Msg: String);
- begin
- FMsgLabel := TNewStaticText.Create(Self);
- with FMsgLabel do begin
- AutoSize := False;
- Width := SurfaceWidth;
- Height := WizardForm.ScalePixelsY(DefaultLabelHeight);
- WordWrap := True;
- Caption := Msg;
- end;
- TSetupForm.SetCtlParent(FMsgLabel, Surface);
- WizardForm.AdjustLabelHeight(MsgLabel);
- end;
- {--- OutputMsgMemo ---}
- procedure TOutputMsgMemoWizardPage.Initialize(const SubCaption: String; const Msg: AnsiString);
- begin
- var Y := 0;
- if SubCaption <> '' then begin
- FSubCaptionLabel := TNewStaticText.Create(Self);
- with FSubCaptionLabel do begin
- AutoSize := False;
- Width := SurfaceWidth;
- Height := WizardForm.ScalePixelsY(DefaultLabelHeight);
- WordWrap := True;
- Caption := SubCaption;
- end;
- TSetupForm.SetCtlParent(FSubCaptionLabel, Surface);
- Inc(Y, WizardForm.ScalePixelsY(DefaultBoxTop) +
- WizardForm.AdjustLabelHeight(FSubCaptionLabel));
- end else
- FSubCaptionLabel := nil;
- FRichEditViewer := TRichEditViewer.Create(Self);
- with FRichEditViewer do begin
- Top := Y;
- Width := SurfaceWidth;
- Height := WizardForm.ScalePixelsY(DefaultBoxBottom) + SurfaceExtraHeight - Y;
- BevelKind := bkFlat;
- BorderStyle := bsNone;
- ReadOnly := True;
- ScrollBars := ssVertical;
- WantReturns := False;
- end;
- SetCtlParentAtBack(FRichEditViewer, Surface);
- with FRichEditViewer do begin
- UseRichEdit := True;
- RTFText := Msg;
- end;
- end;
- {--- OutputProgress ---}
- constructor TOutputProgressWizardPage.Create(AOwner: TComponent);
- begin
- inherited;
- Style := Style + [psAlwaysSkip, psNoButtons];
- end;
- procedure TOutputProgressWizardPage.Initialize;
- begin
- FMsg1Label := TNewStaticText.Create(Self);
- with FMsg1Label do begin
- AutoSize := False;
- ShowAccelChar := False;
- Width := SurfaceWidth;
- Height := WizardForm.StatusLabel.Height;
- WordWrap := WizardForm.StatusLabel.WordWrap;
- end;
- TSetupForm.SetCtlParent(FMsg1Label, Surface);
- FMsg2Label := TNewStaticText.Create(Self);
- with FMsg2Label do begin
- AutoSize := False;
- ForceLTRReading := True;
- ShowAccelChar := False;
- Top := WizardForm.ScalePixelsY(16);
- Width := SurfaceWidth;
- Height := WizardForm.FileNameLabel.Height;
- end;
- SetCtlParentAtBack(FMsg2Label, Surface);
- FProgressBar := TNewProgressBar.Create(Self);
- with FProgressBar do begin
- Top := WizardForm.ScalePixelsY(42);
- Width := SurfaceWidth;
- Height := WizardForm.ScalePixelsY(21);
- Visible := False;
- end;
- SetCtlParentAtBack(FProgressBar, Surface);
- end;
- procedure TOutputProgressWizardPage.Hide;
- begin
- if (WizardForm.CurPageID = ID) and (FSavePageID <> 0) then begin
- SetMessageBoxCallbackFunc(nil, 0);
- SetAppTaskbarProgressState(tpsNoProgress);
- WizardForm.SetCurPage(FSavePageID);
- FSavePageID := 0;
- end;
- end;
- procedure TOutputProgressWizardPage.ProcessMsgs;
- { Process messages to repaint and keep Windows from thinking the process is
- hung. This is safe; due to the psNoButtons style the user shouldn't be able
- to cancel or do anything else during this time. }
- begin
- if WizardForm.CurPageID = ID then
- Application.ProcessMessages;
- end;
- procedure TOutputProgressWizardPage.SetProgress(const Position, Max: Integer);
- begin
- if Max > 0 then begin
- FProgressBar.Style := npbstNormal;
- FProgressBar.Max := Max;
- FProgressBar.Position := Position;
- FProgressBar.Visible := True;
- SetAppTaskbarProgressState(tpsNormal);
- SetAppTaskbarProgressValue(UInt64(Position), UInt64(Max));
- end else begin
- if FUseMarqueeStyle then
- FProgressBar.Style := npbstMarquee
- else
- FProgressBar.Visible := False;
- SetAppTaskbarProgressState(tpsNoProgress);
- end;
- ProcessMsgs;
- end;
- procedure TOutputProgressWizardPage.SetText(const Msg1, Msg2: String);
- begin
- FMsg1Label.Caption := Msg1;
- FMsg2Label.Caption := MinimizePathName(Msg2, FMsg2Label.Font,
- FMsg2Label.Width);
- ProcessMsgs;
- end;
- procedure OutputProgressWizardPageMessageBoxCallback(const Flags: Cardinal; const After: Boolean;
- const Param: NativeInt);
- const
- States: array [TNewProgressBarState] of TTaskbarProgressState =
- (tpsNormal, tpsError, tpsPaused);
- begin
- const OutputProgressWizardPage = TOutputProgressWizardPage(Param);
- var NewState: TNewProgressBarState;
- if After then
- NewState := npbsNormal
- else if (Flags and MB_ICONSTOP) <> 0 then
- NewState := npbsError
- else
- NewState := npbsPaused;
- with OutputProgressWizardPage.ProgressBar do begin
- State := NewState;
- Invalidate;
- end;
- SetAppTaskbarProgressState(States[NewState]);
- end;
- procedure TOutputProgressWizardPage.Show;
- begin
- if WizardForm.CurPageID <> ID then begin
- FSavePageID := WizardForm.CurPageID;
- WizardForm.SetCurPage(ID);
- SetMessageBoxCallbackFunc(OutputProgressWizardPageMessageBoxCallback, NativeInt(Self));
- ProcessMsgs;
- end;
- end;
- constructor TOutputMarqueeProgressWizardPage.Create(AOwner: TComponent);
- begin
- inherited;
- FUseMarqueeStyle := True;
- end;
- procedure TOutputMarqueeProgressWizardPage.Animate;
- begin
- ProcessMsgs;
- end;
- procedure TOutputMarqueeProgressWizardPage.Initialize;
- begin
- inherited;
- FProgressBar.Visible := True;
- inherited SetProgress(0, 0);
- end;
- procedure TOutputMarqueeProgressWizardPage.SetProgress(const Position, Max: Integer);
- begin
- InternalError('Cannot call TOutputMarqueeProgressWizardPage.SetProgress');
- end;
- {--- Download ---}
- procedure TDownloadWizardPage.AbortButtonClick(Sender: TObject);
- begin
- FAbortedByUser := LoggedMsgBox(SetupMessages[msgStopDownload], '', mbConfirmation, MB_YESNO, True, ID_YES) = IDYES;
- end;
- function TDownloadWizardPage.InternalOnDownloadProgress(const Url, BaseName: string; const Progress, ProgressMax: Int64): Boolean;
- begin
- if FAbortedByUser then begin
- Log('Need to abort download.');
- Result := False;
- end else begin
- FMsg2Label.Caption := IfThen(FShowBaseNameInsteadOfUrl, PathExtractName(BaseName), Url);
- var Progress32, ProgressMax32: Integer;
- if ProgressMax > MaxInt then begin
- Progress32 := Integer(Round((Progress / ProgressMax) * MaxInt));
- ProgressMax32 := MaxInt;
- end else begin
- Progress32 := Integer(Progress);
- ProgressMax32 := Integer(ProgressMax);
- end;
- SetProgress(Progress32, ProgressMax32); { This will process messages which we need for the abort button to work }
- if FShowProgressControlsOnNextProgress then begin
- ShowProgressControls(True);
- FShowProgressControlsOnNextProgress := False;
- ProcessMsgs;
- end;
- { This will call InternalThrottledOnDownloadProgress, which will log progress and call the script's FOnDownloadProgress, but throttled }
- if FThrottler = nil then begin
- const OnDownloadProgress: TOnDownloadProgress = InternalThrottledOnDownloadProgress;
- FThrottler := TProgressThrottler.Create(OnDownloadProgress);
- end;
- Result := FThrottler.OnDownloadProgress(Url, BaseName, Progress, ProgressMax);
- end;
- end;
- function TDownloadWizardPage.InternalOnDownloadNoProgress: Boolean;
- begin
- if FAbortedByUser then begin
- Log('Need to abort download.');
- Result := False;
- end else begin
- ProcessMsgs;
- Result := True;
- end;
- end;
- function TDownloadWizardPage.InternalThrottledOnDownloadProgress(const Url, BaseName: string; const Progress, ProgressMax: Int64): Boolean;
- begin
- if ProgressMax > 0 then
- Log(Format(' %d of %d bytes done.', [Progress, ProgressMax]))
- else
- Log(Format(' %d bytes done.', [Progress]));
- if Assigned(FOnDownloadProgress) then
- Result := FOnDownloadProgress(Url, BaseName, Progress, ProgressMax)
- else
- Result := True;
- end;
- constructor TDownloadWizardPage.Create(AOwner: TComponent);
- begin
- inherited;
- FUseMarqueeStyle := True;
- FFiles := TDownloadFiles.Create;
- end;
- destructor TDownloadWizardPage.Destroy;
- begin
- FThrottler.Free;
- FFiles.Free;
- inherited;
- end;
- procedure TDownloadWizardPage.Initialize;
- begin
- inherited;
- FMsg1Label.Caption := SetupMessages[msgDownloadingLabel2];
- FAbortButton := TNewButton.Create(Self);
- with FAbortButton do begin
- Caption := SetupMessages[msgButtonStopDownload];
- Top := FProgressBar.Top + FProgressBar.Height + WizardForm.ScalePixelsY(8);
- Width := WizardForm.CalculateButtonWidth([Caption]);
- Height := WizardForm.CancelButton.Height;
- OnClick := AbortButtonClick;
- end;
- SetCtlParentAtBack(FAbortButton, Surface);
- end;
- procedure TDownloadWizardPage.Show;
- begin
- if WizardForm.CurPageID <> ID then begin
- ShowProgressControls(False);
- FShowProgressControlsOnNextProgress := True;
- end;
- inherited;
- end;
- procedure TDownloadWizardPage.ShowProgressControls(const AVisible: Boolean);
- begin
- FMsg2Label.Visible := AVisible;
- FProgressBar.Visible := AVisible;
- end;
- function TDownloadWizardPage.DoAdd(const Url, BaseName, RequiredSHA256OfFile, UserName, Password: String;
- const ISSigVerify: Boolean; const ISSigAllowedKeys: AnsiString; const DotISSigEntry: Boolean;
- const Data: NativeInt): NativeInt;
- begin
- if ISSigVerify and DotISSigEntry then
- InternalError('ISSigVerify and DotISSigEntry');
- var F := TDownloadFile.Create;
- F.Url := Url;
- F.BaseName := BaseName;
- F.UserName := UserName;
- F.Password := Password;
- F.Verification := NoVerification;
- if RequiredSHA256OfFile <> '' then begin
- F.Verification.Typ := fvHash;
- F.Verification.Hash := SHA256DigestFromString(RequiredSHA256OfFile)
- end else if ISSigVerify then begin
- F.Verification.Typ := fvISSig;
- F.Verification.ISSigAllowedKeys := ISSigAllowedKeys
- end;
- F.DotISSigEntry := DotISSigEntry;
- F.Data := Data;
- Result := FFiles.Add(F);
- end;
- function ConvertAllowedKeysRuntimeIDsToISSigAllowedKeys(const AllowedKeysRuntimeIDs: TStringList): AnsiString;
- begin
- Result := '';
- if AllowedKeysRuntimeIDs <> nil then begin
- for var I := 0 to AllowedKeysRuntimeIDs.Count-1 do begin
- const RuntimeID = AllowedKeysRuntimeIDs[I];
- if RuntimeID = '' then
- InternalError('RuntimeID cannot be empty');
- var Found := False;
- for var KeyIndex := 0 to Entries[seISSigKey].Count-1 do begin
- var ISSigKeyEntry := PSetupISSigKeyEntry(Entries[seISSigKey][KeyIndex]);
- if SameText(ISSigKeyEntry.RuntimeID, RuntimeID) then begin
- SetISSigAllowedKey(Result, Integer(KeyIndex));
- Found := True;
- Break;
- end;
- end;
- if not Found then
- InternalError(Format('Unknown RuntimeID ''%s''', [RuntimeID]));
- end;
- end;
- end;
- function TDownloadWizardPage.Add(const Url, BaseName, RequiredSHA256OfFile: String): NativeInt;
- begin
- Result := DoAdd(Url, BaseName, RequiredSHA256OfFile, '', '', False, '', False, 0);
- end;
- function TDownloadWizardPage.AddWithISSigVerify(const Url, ISSigUrl, BaseName: String;
- const AllowedKeysRuntimeIDs: TStringList): NativeInt;
- begin
- Result := AddExWithISSigVerify(Url, ISSigUrl, BaseName, '', '', AllowedKeysRuntimeIDs, 0);
- end;
- function TDownloadWizardPage.AddEx(const Url, BaseName, RequiredSHA256OfFile, UserName, Password: String;
- const Data: NativeInt): NativeInt;
- begin
- Result := DoAdd(Url, BaseName, RequiredSHA256OfFile, UserName, Password, False, '', False, Data);
- end;
- function TDownloadWizardPage.AddExWithISSigVerify(const Url, ISSigUrl, BaseName, UserName,
- Password: String; const AllowedKeysRuntimeIDs: TStringList; const Data: NativeInt): NativeInt;
- begin
- const ISSigAllowedKeys = ConvertAllowedKeysRuntimeIDsToISSigAllowedKeys(AllowedKeysRuntimeIDs);
- Result := AddExWithISSigVerify(Url, ISSigUrl, BaseName, UserName, Password, ISSigAllowedKeys, Data);
- end;
- function TDownloadWizardPage.AddExWithISSigVerify(const Url, ISSigUrl, BaseName, UserName,
- Password: String; const ISSigAllowedKeys: AnsiString; const Data: NativeInt): NativeInt;
- begin
- { Also see Setup.ScriptFunc DownloadTemporaryFileWithISSigVerify }
- DoAdd(GetISSigUrl(Url, ISSigUrl), BaseName + ISSigExt, '', UserName, Password, False, '', True, 0);
- Result := DoAdd(Url, BaseName, '', UserName, Password, True, ISSigAllowedKeys, False, Data);
- end;
- procedure TDownloadWizardPage.Clear;
- begin
- FFiles.Clear;
- end;
- function TDownloadWizardPage.Download(const OnDownloadFileCompleted: TDownloadFileCompleted): Int64;
- begin
- FAbortedByUser := False;
- Result := 0;
- try
- for var I := 0 to FFiles.Count-1 do begin
- { Don't need to set DownloadTemporaryFileOrExtractArchiveProcessMessages before downloading since we already process messages ourselves }
- const F = FFiles[I];
- FLastBaseNameOrUrl := IfThen(FShowBaseNameInsteadOfUrl, PathExtractName(F.BaseName), F.Url);
- SetDownloadTemporaryFileCredentials(F.UserName, F.Password);
- var DestFile: String;
- Result := Result + DownloadTemporaryFile(F.Url, F.BaseName, F.Verification,
- InternalOnDownloadProgress, InternalOnDownloadNoProgress, DestFile);
- if Assigned(OnDownloadFileCompleted) then begin
- var Remove := False;
- OnDownloadFileCompleted(F, DestFile, Remove);
- if Remove then
- FFiles[I] := nil;
- end;
- end;
- finally
- SetDownloadTemporaryFileCredentials('', '');
- FFiles.Pack;
- end;
- end;
- {--- Extraction ---}
- procedure TExtractionWizardPage.AbortButtonClick(Sender: TObject);
- begin
- FAbortedByUser := LoggedMsgBox(SetupMessages[msgStopExtraction], '', mbConfirmation, MB_YESNO, True, ID_YES) = IDYES;
- end;
- function TExtractionWizardPage.InternalOnExtractionProgress(const ArchiveName, FileName: string; const Progress, ProgressMax: Int64): Boolean;
- begin
- if FAbortedByUser then begin
- Log('Need to abort extraction.');
- Result := False;
- end else begin
- { Unlike TDownloadWizardPage we don't log progress here. This is because 7zMain.c already logs output dirs and names. }
- FMsg2Label.Caption := IfThen(FShowArchiveInsteadOfFile, ArchiveName, FileName);
- var Progress32, ProgressMax32: Integer;
- if ProgressMax > MaxInt then begin
- Progress32 := Integer(Round((Progress / ProgressMax) * MaxInt));
- ProgressMax32 := MaxInt;
- end else begin
- Progress32 := Integer(Progress);
- ProgressMax32 := Integer(ProgressMax);
- end;
- SetProgress(Progress32, ProgressMax32); { This will process messages which we need for the abort button to work }
- if FShowProgressControlsOnNextProgress then begin
- ShowProgressControls(True);
- FShowProgressControlsOnNextProgress := False;
- ProcessMsgs;
- end;
- { This will call InternalThrottledOnExtractionProgress, which will call the script's FOnExtractionProgress, but throttled
- Because it does nothing else we first check if FOnExtractionProgress is actually assigned }
- if Assigned(FOnExtractionProgress) then begin
- if FThrottler = nil then begin
- const OnExtractionProgress: TOnExtractionProgress = InternalThrottledOnExtractionProgress;
- FThrottler := TProgressThrottler.Create(OnExtractionProgress);
- end;
- Result := FThrottler.OnExtractionProgress(ArchiveName, FileName, Progress, ProgressMax);
- end else
- Result := True;
- end;
- end;
- function TExtractionWizardPage.InternalThrottledOnExtractionProgress(const ArchiveName, FileName: string; const Progress, ProgressMax: Int64): Boolean;
- begin
- if Assigned(FOnExtractionProgress) then { Always True, see above }
- Result := FOnExtractionProgress(ArchiveName, FileName, Progress, ProgressMax)
- else
- Result := True;
- end;
- constructor TExtractionWizardPage.Create(AOwner: TComponent);
- begin
- inherited;
- FUseMarqueeStyle := True;
- FArchives := TArchives.Create;
- end;
- destructor TExtractionWizardPage.Destroy;
- begin
- FThrottler.Free;
- FArchives.Free;
- inherited;
- end;
- procedure TExtractionWizardPage.Initialize;
- begin
- inherited;
- FMsg1Label.Caption := SetupMessages[msgExtractingLabel];
- FAbortButton := TNewButton.Create(Self);
- with FAbortButton do begin
- Caption := SetupMessages[msgButtonStopExtraction];
- Top := FProgressBar.Top + FProgressBar.Height + WizardForm.ScalePixelsY(8);
- Width := WizardForm.CalculateButtonWidth([Caption]);
- Height := WizardForm.CancelButton.Height;
- OnClick := AbortButtonClick;
- end;
- SetCtlParentAtBack(FAbortButton, Surface);
- end;
- procedure TExtractionWizardPage.Show;
- begin
- if WizardForm.CurPageID <> ID then begin
- ShowProgressControls(False);
- FShowProgressControlsOnNextProgress := True;
- end;
- inherited;
- end;
- procedure TExtractionWizardPage.ShowProgressControls(const AVisible: Boolean);
- begin
- FMsg2Label.Visible := AVisible;
- FProgressBar.Visible := AVisible;
- end;
- function TExtractionWizardPage.Add(const ArchiveFileName, DestDir: String; const FullPaths: Boolean): NativeInt;
- begin
- Result := AddEx(ArchiveFileName, DestDir, '', FullPaths);
- end;
- function TExtractionWizardPage.AddEx(const ArchiveFileName, DestDir, Password: String; const FullPaths: Boolean): NativeInt;
- begin
- const A = TArchive.Create;
- A.FileName := ArchiveFileName;
- A.DestDir := DestDir;
- A.Password := Password;
- A.FullPaths := FullPaths;
- Result := FArchives.Add(A);
- end;
- procedure TExtractionWizardPage.Clear;
- begin
- FArchives.Clear;
- end;
- procedure TExtractionWizardPage.Extract;
- begin
- FAbortedByUser := False;
- try
- for var A in FArchives do begin
- { Don't need to set DownloadTemporaryFileOrExtractArchiveProcessMessages before extraction since we already process messages ourselves }
- if SetupHeader.SevenZipLibraryName <> '' then
- ExtractArchive(A.FileName, A.DestDir, A.Password, A.FullPaths, InternalOnExtractionProgress)
- else
- Extract7ZipArchive(A.FileName, A.DestDir, A.Password, A.FullPaths, InternalOnExtractionProgress);
- end;
- except
- on E: EAbort do
- raise Exception.Create(SetupMessages[msgErrorExtractionAborted])
- else
- raise Exception.Create(FmtSetupMessage1(msgErrorExtractionFailed, GetExceptMessage));
- end;
- end;
- end.
|