| 1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889909192939495969798991001011021031041051061071081091101111121131141151161171181191201211221231241251261271281291301311321331341351361371381391401411421431441451461471481491501511521531541551561571581591601611621631641651661671681691701711721731741751761771781791801811821831841851861871881891901911921931941951961971981992002012022032042052062072082092102112122132142152162172182192202212222232242252262272282292302312322332342352362372382392402412422432442452462472482492502512522532542552562572582592602612622632642652662672682692702712722732742752762772782792802812822832842852862872882892902912922932942952962972982993003013023033043053063073083093103113123133143153163173183193203213223233243253263273283293303313323333343353363373383393403413423433443453463473483493503513523533543553563573583593603613623633643653663673683693703713723733743753763773783793803813823833843853863873883893903913923933943953963973983994004014024034044054064074084094104114124134144154164174184194204214224234244254264274284294304314324334344354364374384394404414424434444454464474484494504514524534544554564574584594604614624634644654664674684694704714724734744754764774784794804814824834844854864874884894904914924934944954964974984995005015025035045055065075085095105115125135145155165175185195205215225235245255265275285295305315325335345355365375385395405415425435445455465475485495505515525535545555565575585595605615625635645655665675685695705715725735745755765775785795805815825835845855865875885895905915925935945955965975985996006016026036046056066076086096106116126136146156166176186196206216226236246256266276286296306316326336346356366376386396406416426436446456466476486496506516526536546556566576586596606616626636646656666676686696706716726736746756766776786796806816826836846856866876886896906916926936946956966976986997007017027037047057067077087097107117127137147157167177187197207217227237247257267277287297307317327337347357367377387397407417427437447457467477487497507517527537547557567577587597607617627637647657667677687697707717727737747757767777787797807817827837847857867877887897907917927937947957967977987998008018028038048058068078088098108118128138148158168178188198208218228238248258268278288298308318328338348358368378388398408418428438448458468478488498508518528538548558568578588598608618628638648658668678688698708718728738748758768778788798808818828838848858868878888898908918928938948958968978988999009019029039049059069079089099109119129139149159169179189199209219229239249259269279289299309319329339349359369379389399409419429439449459469479489499509519529539549559569579589599609619629639649659669679689699709719729739749759769779789799809819829839849859869879889899909919929939949959969979989991000100110021003100410051006100710081009101010111012101310141015101610171018101910201021102210231024102510261027102810291030103110321033103410351036103710381039104010411042104310441045104610471048104910501051105210531054105510561057105810591060106110621063106410651066106710681069107010711072107310741075107610771078107910801081108210831084108510861087108810891090109110921093109410951096109710981099110011011102110311041105110611071108110911101111111211131114111511161117111811191120112111221123112411251126112711281129113011311132113311341135113611371138113911401141114211431144114511461147114811491150115111521153115411551156115711581159116011611162116311641165116611671168116911701171117211731174117511761177117811791180118111821183118411851186118711881189119011911192119311941195119611971198119912001201120212031204120512061207120812091210121112121213121412151216121712181219122012211222122312241225122612271228122912301231123212331234123512361237123812391240124112421243124412451246124712481249125012511252125312541255125612571258125912601261126212631264126512661267126812691270127112721273127412751276127712781279128012811282128312841285128612871288128912901291129212931294129512961297129812991300130113021303130413051306130713081309131013111312131313141315131613171318131913201321132213231324132513261327132813291330133113321333133413351336133713381339134013411342134313441345134613471348134913501351 |
- unit Setup.ScriptDlg;
- {
- Inno Setup
- Copyright (C) 1997-2025 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.ScriptFunc.HelperFunc, Compression.SevenZipDecoder,
- NewCheckListBox, NewStaticText, NewProgressBar, PasswordEdit, RichEditViewer,
- BidiCtrls, TaskbarProgressFunc;
- type
- TInputQueryWizardPage = class(TWizardPage)
- private
- FEdits: TList;
- FPromptLabels: TList;
- FSubCaptionLabel: TNewStaticText;
- FY: Integer;
- function GetEdit(Index: Integer): TPasswordEdit;
- function GetPromptLabel(Index: Integer): TNewStaticText;
- function GetValue(Index: Integer): String;
- procedure SetValue(Index: Integer; const Value: String);
- public
- constructor Create(AOwner: TComponent); override;
- destructor Destroy; override;
- function Add(const APrompt: String; const APassword: Boolean): Integer;
- property Edits[Index: Integer]: TPasswordEdit read GetEdit;
- procedure Initialize(const SubCaption: String);
- property PromptLabels[Index: Integer]: TNewStaticText read GetPromptLabel;
- property Values[Index: Integer]: 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;
- FEdits: TList;
- FNewFolderName: String;
- FPromptLabels: TList;
- FSubCaptionLabel: TNewStaticText;
- FY: Integer;
- procedure ButtonClick(Sender: TObject);
- function GetButton(Index: Integer): TNewButton;
- function GetEdit(Index: Integer): TEdit;
- function GetPromptLabel(Index: Integer): TNewStaticText;
- function GetValue(Index: Integer): String;
- procedure SetValue(Index: Integer; const Value: String);
- protected
- procedure NextButtonClick(var Continue: Boolean); override;
- public
- constructor Create(AOwner: TComponent); override;
- destructor Destroy; override;
- function Add(const APrompt: String): Integer;
- property Buttons[Index: Integer]: TNewButton read GetButton;
- property Edits[Index: Integer]: TEdit read GetEdit;
- procedure Initialize(const SubCaption: String; const AppendDir: Boolean;
- const NewFolderName: String);
- property PromptLabels[Index: Integer]: TNewStaticText read GetPromptLabel;
- property Values[Index: Integer]: 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;
- FEdits: TList;
- FInputFileDefaultExtensions: TStringList;
- FInputFileFilters: TStringList;
- FPromptLabels: TList;
- FSubCaptionLabel: TNewStaticText;
- FY: Integer;
- procedure ButtonClick(Sender: TObject);
- function GetButton(Index: Integer): TNewButton;
- function GetEdit(Index: Integer): TEdit;
- function GetPromptLabel(Index: Integer): TNewStaticText;
- function GetValue(Index: Integer): String;
- procedure SetValue(Index: Integer; const Value: String);
- function GetIsSaveButton(Index: Integer): Boolean;
- procedure SetIsSaveButton(Index: Integer; const IsSaveButton: Boolean);
- public
- constructor Create(AOwner: TComponent); override;
- destructor Destroy; override;
- function Add(const APrompt, AFilter, ADefaultExtension: String): Integer;
- property Buttons[Index: Integer]: TNewButton read GetButton;
- property Edits[Index: Integer]: TEdit read GetEdit;
- procedure Initialize(const SubCaption: String);
- property PromptLabels[Index: Integer]: TNewStaticText read GetPromptLabel;
- property Values[Index: Integer]: String read GetValue write SetValue;
- property IsSaveButton[Index: Integer]: 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: Longint);
- 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: Longint);
- end;
- TDownloadFile = class
- Url, BaseName, UserName, Password: String;
- Verification: TSetupFileVerification;
- DotISSigEntry: Boolean;
- Data: NativeUInt; { 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: NativeUInt): Integer;
- 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): Integer;
- function AddWithISSigVerify(const Url, ISSigUrl, BaseName: String;
- const AllowedKeysRuntimeIDs: TStringList): Integer;
- function AddEx(const Url, BaseName, RequiredSHA256OfFile, UserName, Password: String;
- const Data: NativeUInt): Integer;
- function AddExWithISSigVerify(const Url, ISSigUrl, BaseName, UserName, Password: String;
- const AllowedKeysRuntimeIDs: TStringList; const Data: NativeUInt): Integer; overload;
- function AddExWithISSigVerify(const Url, ISSigUrl, BaseName, UserName, Password: String;
- const ISSigAllowedKeys: AnsiString; const Data: NativeUInt): Integer; 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): Integer;
- function AddEx(const ArchiveFileName, DestDir, Password: String; const FullPaths: Boolean): Integer;
- 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.InstFunc,
- Compression.SevenZipDLLDecoder;
- const
- DefaultLabelHeight = 14;
- DefaultBoxTop = 24; { relative to top of InnerNotebook }
- DefaultBoxBottom = DefaultBoxTop + 205;
- {------}
- procedure SetCtlParent(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;
- AControl.Parent := AParent;
- AControl.SendToBack;
- AControl.Visible := OldVisible;
- end;
- {--- InputQuery ---}
- constructor TInputQueryWizardPage.Create(AOwner: TComponent);
- begin
- inherited;
- FEdits := TList.Create;
- FPromptLabels := TList.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;
- Parent := Surface;
- end;
- FY := WizardForm.AdjustLabelHeight(FSubCaptionLabel) + WizardForm.ScalePixelsY(DefaultBoxTop);
- end;
- function TInputQueryWizardPage.Add(const APrompt: String;
- const APassword: Boolean): Integer;
- var
- PromptLabel: TNewStaticText;
- Edit: TPasswordEdit;
- begin
- if APrompt <> '' then begin
- PromptLabel := TNewStaticText.Create(Self);
- with PromptLabel do begin
- AutoSize := False;
- Top := FY;
- Width := SurfaceWidth;
- Height := WizardForm.ScalePixelsY(DefaultLabelHeight);
- Anchors := [akLeft, akTop, akRight];
- WordWrap := True;
- Caption := APrompt;
- end;
- SetCtlParent(PromptLabel, Surface);
- Inc(FY, WizardForm.AdjustLabelHeight(PromptLabel) + WizardForm.ScalePixelsY(16));
- end else
- PromptLabel := nil;
- Edit := TPasswordEdit.Create(Self);
- with Edit do begin
- Password := APassword;
- Top := FY;
- Width := SurfaceWidth;
- Anchors := [akLeft, akTop, akRight];
- end;
- SetCtlParent(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: Integer): TPasswordEdit;
- begin
- Result := TPasswordEdit(FEdits[Index]);
- end;
- function TInputQueryWizardPage.GetPromptLabel(Index: Integer): TNewStaticText;
- begin
- Result := TNewStaticText(FPromptLabels[Index]);
- end;
- function TInputQueryWizardPage.GetValue(Index: Integer): String;
- begin
- Result := GetEdit(Index).Text;
- end;
- procedure TInputQueryWizardPage.SetValue(Index: Integer; const Value: String);
- begin
- GetEdit(Index).Text := Value;
- end;
- {--- InputOption ---}
- procedure TInputOptionWizardPage.Initialize(const SubCaption: String;
- const Exclusive, ListBox: Boolean);
- var
- CaptionYDiff: Integer;
- begin
- FSubCaptionLabel := TNewStaticText.Create(Self);
- with SubCaptionLabel do begin
- AutoSize := False;
- Width := SurfaceWidth;
- Height := WizardForm.ScalePixelsY(DefaultLabelHeight);
- Anchors := [akLeft, akTop, akRight];
- WordWrap := True;
- Caption := SubCaption;
- Parent := Surface;
- end;
- CaptionYDiff := WizardForm.AdjustLabelHeight(SubCaptionLabel);
- FCheckListBox := TNewCheckListBox.Create(Self);
- with FCheckListBox do begin
- Top := CaptionYDiff + WizardForm.ScalePixelsY(DefaultBoxTop);
- Width := SurfaceWidth;
- Height := WizardForm.ScalePixelsY(DefaultBoxBottom) - Top;
- Anchors := [akLeft, akTop, akRight, akBottom];
- Flat := ListBox and (shFlatComponentsList in SetupHeader.Options);
- end;
- SetCtlParent(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;
- var
- I: Integer;
- begin
- for 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);
- var
- I: Integer;
- begin
- for 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.Create;
- FEdits := TList.Create;
- FPromptLabels := TList.Create;
- end;
- destructor TInputDirWizardPage.Destroy;
- begin
- FPromptLabels.Free;
- FEdits.Free;
- FButtons.Free;
- inherited;
- end;
- procedure TInputDirWizardPage.ButtonClick(Sender: TObject);
- var
- I: Integer;
- Edit: TEdit;
- S: String;
- begin
- I := FButtons.IndexOf(Sender);
- if I <> -1 then begin
- Edit := TEdit(FEdits[I]);
- S := Edit.Text;
- if ShowSelectFolderDialog(False, FAppendDir, S, FNewFolderName) then
- Edit.Text := S;
- end;
- end;
- procedure TInputDirWizardPage.NextButtonClick(var Continue: Boolean);
- var
- I: Integer;
- Edit: TEdit;
- begin
- for I := 0 to FEdits.Count-1 do begin
- 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);
- Anchors := [akLeft, akTop, akRight];
- WordWrap := True;
- Caption := SubCaption;
- Parent := Surface;
- end;
- FY := WizardForm.AdjustLabelHeight(FSubCaptionLabel) + WizardForm.ScalePixelsY(DefaultBoxTop);
- FAppendDir := AppendDir;
- FNewFolderName := NewFolderName;
- end;
- function TInputDirWizardPage.Add(const APrompt: String): Integer;
- var
- ButtonWidth: Integer;
- PromptLabel: TNewStaticText;
- Edit: TEdit;
- Button: TNewButton;
- begin
- ButtonWidth := WizardForm.CalculateButtonWidth([SetupMessages[msgButtonWizardBrowse]]);
- if APrompt <> '' then begin
- PromptLabel := TNewStaticText.Create(Self);
- with PromptLabel do begin
- AutoSize := False;
- Top := FY;
- Width := SurfaceWidth;
- Height := WizardForm.ScalePixelsY(DefaultLabelHeight);
- Anchors := [akLeft, akTop, akRight];
- WordWrap := True;
- Caption := APrompt;
- end;
- SetCtlParent(PromptLabel, Surface);
- Inc(FY, WizardForm.AdjustLabelHeight(PromptLabel) + WizardForm.ScalePixelsY(16));
- end else
- PromptLabel := nil;
- Edit := TEdit.Create(Self);
- with Edit do begin
- Top := FY;
- Width := SurfaceWidth-ButtonWidth-WizardForm.ScalePixelsX(10);
- Anchors := [akLeft, akTop, akRight];
- end;
- SetCtlParent(Edit, Surface);
- TryEnableAutoCompleteFileSystem(Edit.Handle);
- if PromptLabel <> nil then
- PromptLabel.FocusControl := Edit;
- Button := TNewButton.Create(Self);
- with Button do begin
- Left := SurfaceWidth-ButtonWidth;
- Top := Edit.Top-1;
- Width := ButtonWidth;
- Height := WizardForm.NextButton.Height;
- Anchors := [akTop, akRight];
- 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;
- SetCtlParent(Button, Surface);
- Inc(FY, WizardForm.ScalePixelsY(36));
- FButtons.Add(Button);
- FPromptLabels.Add(PromptLabel);
- Result := FEdits.Add(Edit);
- end;
- function TInputDirWizardPage.GetButton(Index: Integer): TNewButton;
- begin
- Result := TNewButton(FButtons[Index]);
- end;
- function TInputDirWizardPage.GetEdit(Index: Integer): TEdit;
- begin
- Result := TEdit(FEdits[Index]);
- end;
- function TInputDirWizardPage.GetPromptLabel(Index: Integer): TNewStaticText;
- begin
- Result := TNewStaticText(FPromptLabels[Index]);
- end;
- function TInputDirWizardPage.GetValue(Index: Integer): String;
- begin
- Result := GetEdit(Index).Text;
- end;
- procedure TInputDirWizardPage.SetValue(Index: Integer; const Value: String);
- begin
- GetEdit(Index).Text := RemoveBackslashUnlessRoot(PathExpand(Value));
- end;
- {--- InputFile ---}
- constructor TInputFileWizardPage.Create(AOwner: TComponent);
- begin
- inherited;
- FButtons := TList.Create;
- FEdits := TList.Create;
- FInputFileDefaultExtensions := TStringList.Create;
- FInputFileFilters := TStringList.Create;
- FPromptLabels := TList.Create;
- end;
- destructor TInputFileWizardPage.Destroy;
- begin
- FPromptLabels.Free;
- FInputFileFilters.Free;
- FInputFileDefaultExtensions.Free;
- FEdits.Free;
- FButtons.Free;
- inherited;
- end;
- procedure TInputFileWizardPage.ButtonClick(Sender: TObject);
- var
- I: Integer;
- Edit: TEdit;
- FileName: String;
- begin
- I := FButtons.IndexOf(Sender);
- if I <> -1 then begin
- Edit := TEdit(FEdits[I]);
- FileName := 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;
- procedure TInputFileWizardPage.Initialize(const SubCaption: String);
- begin
- FSubCaptionLabel := TNewStaticText.Create(Self);
- with FSubCaptionLabel do begin
- AutoSize := False;
- Width := SurfaceWidth;
- Height := WizardForm.ScalePixelsY(DefaultLabelHeight);
- Anchors := [akLeft, akTop, akRight];
- WordWrap := True;
- Caption := SubCaption;
- Parent := Surface;
- end;
- FY := WizardForm.AdjustLabelHeight(FSubCaptionLabel) + WizardForm.ScalePixelsY(DefaultBoxTop);
- end;
- function TInputFileWizardPage.Add(const APrompt, AFilter,
- ADefaultExtension: String): Integer;
- var
- ButtonWidth: Integer;
- PromptLabel: TNewStaticText;
- Edit: TEdit;
- Button: TNewButton;
- begin
- ButtonWidth := WizardForm.CalculateButtonWidth([SetupMessages[msgButtonWizardBrowse]]);
- if APrompt <> '' then begin
- PromptLabel := TNewStaticText.Create(Self);
- with PromptLabel do begin
- AutoSize := False;
- Top := FY;
- Width := SurfaceWidth;
- Height := WizardForm.ScalePixelsY(DefaultLabelHeight);
- Anchors := [akLeft, akTop, akRight];
- WordWrap := True;
- Caption := APrompt;
- end;
- SetCtlParent(PromptLabel, Surface);
- Inc(FY, WizardForm.AdjustLabelHeight(PromptLabel) + WizardForm.ScalePixelsY(16));
- end else
- PromptLabel := nil;
- Edit := TEdit.Create(Self);
- with Edit do begin
- Top := FY;
- Width := SurfaceWidth-ButtonWidth-WizardForm.ScalePixelsX(10);
- Anchors := [akLeft, akTop, akRight];
- end;
- SetCtlParent(Edit, Surface);
- TryEnableAutoCompleteFileSystem(Edit.Handle);
- if PromptLabel <> nil then
- PromptLabel.FocusControl := Edit;
- Button := TNewButton.Create(Self);
- with Button do begin
- Left := SurfaceWidth-ButtonWidth;
- Top := Edit.Top-1;
- Width := ButtonWidth;
- Height := WizardForm.NextButton.Height;
- Anchors := [akTop, akRight];
- 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;
- SetCtlParent(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: Integer): TNewButton;
- begin
- Result := TNewButton(FButtons[Index]);
- end;
- function TInputFileWizardPage.GetEdit(Index: Integer): TEdit;
- begin
- Result := TEdit(FEdits[Index]);
- end;
- function TInputFileWizardPage.GetPromptLabel(Index: Integer): TNewStaticText;
- begin
- Result := TNewStaticText(FPromptLabels[Index]);
- end;
- function TInputFileWizardPage.GetValue(Index: Integer): String;
- begin
- Result := GetEdit(Index).Text;
- end;
- procedure TInputFileWizardPage.SetValue(Index: Integer; const Value: String);
- begin
- GetEdit(Index).Text := Value;
- end;
- function TInputFileWizardPage.GetIsSaveButton(Index: Integer): Boolean;
- begin
- Result := GetButton(Index).Tag = 1;
- end;
- procedure TInputFileWizardPage.SetIsSaveButton(Index: Integer; 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;
- Parent := Surface;
- end;
- WizardForm.AdjustLabelHeight(MsgLabel);
- end;
- {--- OutputMsgMemo ---}
- procedure TOutputMsgMemoWizardPage.Initialize(const SubCaption: String; const Msg: AnsiString);
- var
- Y: Integer;
- begin
- Y := 0;
- if SubCaption <> '' then begin
- FSubCaptionLabel := TNewStaticText.Create(Self);
- with FSubCaptionLabel do begin
- AutoSize := False;
- Width := SurfaceWidth;
- Height := WizardForm.ScalePixelsY(DefaultLabelHeight);
- Anchors := [akLeft, akTop, akRight];
- WordWrap := True;
- Caption := SubCaption;
- Parent := Surface;
- end;
- 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) - Y;
- Anchors := [akLeft, akTop, akRight, akBottom];
- BevelKind := bkFlat;
- BorderStyle := bsNone;
- ReadOnly := True;
- ScrollBars := ssVertical;
- WantReturns := False;
- end;
- SetCtlParent(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;
- Anchors := [akLeft, akTop, akRight];
- Height := WizardForm.StatusLabel.Height;
- WordWrap := WizardForm.StatusLabel.WordWrap;
- Parent := Surface;
- end;
- FMsg2Label := TNewStaticText.Create(Self);
- with FMsg2Label do begin
- AutoSize := False;
- ForceLTRReading := True;
- ShowAccelChar := False;
- Top := WizardForm.ScalePixelsY(16);
- Width := SurfaceWidth;
- Height := WizardForm.FileNameLabel.Height;
- Anchors := [akLeft, akTop, akRight];
- end;
- SetCtlParent(FMsg2Label, Surface);
- FProgressBar := TNewProgressBar.Create(Self);
- with FProgressBar do begin
- Top := WizardForm.ScalePixelsY(42);
- Width := SurfaceWidth;
- Height := WizardForm.ScalePixelsY(21);
- Anchors := [akLeft, akTop, akRight];
- Visible := False;
- end;
- SetCtlParent(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: Longint);
- begin
- if Max > 0 then begin
- FProgressBar.Style := npbstNormal;
- FProgressBar.Max := Max;
- FProgressBar.Position := Position;
- FProgressBar.Visible := True;
- SetAppTaskbarProgressState(tpsNormal);
- SetAppTaskbarProgressValue(Position, 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: LongInt; const After: Boolean;
- const Param: LongInt);
- const
- States: array [TNewProgressBarState] of TTaskbarProgressState =
- (tpsNormal, tpsError, tpsPaused);
- var
- OutputProgressWizardPage: TOutputProgressWizardPage;
- NewState: TNewProgressBarState;
- begin
- OutputProgressWizardPage := TOutputProgressWizardPage(Param);
- 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, LongInt(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: Longint);
- 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;
- var
- Progress32, ProgressMax32: LongInt;
- begin
- if FAbortedByUser then begin
- Log('Need to abort download.');
- Result := False;
- end else begin
- FMsg2Label.Caption := IfThen(FShowBaseNameInsteadOfUrl, PathExtractName(BaseName), Url);
- if ProgressMax > MaxLongInt then begin
- Progress32 := Round((Progress / ProgressMax) * MaxLongInt);
- ProgressMax32 := MaxLongInt;
- end else begin
- Progress32 := Progress;
- ProgressMax32 := 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 { Currently always False because the Abort button isn't visible yet }
- 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]);
- Anchors := [akLeft, akTop];
- Height := WizardForm.CancelButton.Height;
- OnClick := AbortButtonClick;
- end;
- SetCtlParent(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;
- FAbortButton.Visible := AVisible;
- end;
- function TDownloadWizardPage.DoAdd(const Url, BaseName, RequiredSHA256OfFile, UserName, Password: String;
- const ISSigVerify: Boolean; const ISSigAllowedKeys: AnsiString; const DotISSigEntry: Boolean;
- const Data: NativeUInt): Integer;
- 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, 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): Integer;
- begin
- Result := DoAdd(Url, BaseName, RequiredSHA256OfFile, '', '', False, '', False, 0);
- end;
- function TDownloadWizardPage.AddWithISSigVerify(const Url, ISSigUrl, BaseName: String;
- const AllowedKeysRuntimeIDs: TStringList): Integer;
- begin
- Result := AddExWithISSigVerify(Url, ISSigUrl, BaseName, '', '', AllowedKeysRuntimeIDs, 0);
- end;
- function TDownloadWizardPage.AddEx(const Url, BaseName, RequiredSHA256OfFile, UserName, Password: String;
- const Data: NativeUInt): Integer;
- 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: NativeUInt): Integer;
- 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: NativeUInt): Integer;
- 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;
- var
- Progress32, ProgressMax32: LongInt;
- 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);
- if ProgressMax > MaxLongInt then begin
- Progress32 := Round((Progress / ProgressMax) * MaxLongInt);
- ProgressMax32 := MaxLongInt;
- end else begin
- Progress32 := Progress;
- ProgressMax32 := 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]);
- Anchors := [akLeft, akTop];
- Height := WizardForm.CancelButton.Height;
- OnClick := AbortButtonClick;
- end;
- SetCtlParent(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;
- FAbortButton.Visible := AVisible;
- end;
- function TExtractionWizardPage.Add(const ArchiveFileName, DestDir: String; const FullPaths: Boolean): Integer;
- begin
- Result := AddEx(ArchiveFileName, DestDir, '', FullPaths);
- end;
- function TExtractionWizardPage.AddEx(const ArchiveFileName, DestDir, Password: String; const FullPaths: Boolean): Integer;
- 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
- ExtractArchiveRedir(ScriptFuncDisableFsRedir, A.FileName, A.DestDir, A.Password, A.FullPaths, InternalOnExtractionProgress)
- else
- Extract7ZipArchiveRedir(ScriptFuncDisableFsRedir, 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.
|