12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697989910010110210310410510610710810911011111211311411511611711811912012112212312412512612712812913013113213313413513613713813914014114214314414514614714814915015115215315415515615715815916016116216316416516616716816917017117217317417517617717817918018118218318418518618718818919019119219319419519619719819920020120220320420520620720820921021121221321421521621721821922022122222322422522622722822923023123223323423523623723823924024124224324424524624724824925025125225325425525625725825926026126226326426526626726826927027127227327427527627727827928028128228328428528628728828929029129229329429529629729829930030130230330430530630730830931031131231331431531631731831932032132232332432532632732832933033133233333433533633733833934034134234334434534634734834935035135235335435535635735835936036136236336436536636736836937037137237337437537637737837938038138238338438538638738838939039139239339439539639739839940040140240340440540640740840941041141241341441541641741841942042142242342442542642742842943043143243343443543643743843944044144244344444544644744844945045145245345445545645745845946046146246346446546646746846947047147247347447547647747847948048148248348448548648748848949049149249349449549649749849950050150250350450550650750850951051151251351451551651751851952052152252352452552652752852953053153253353453553653753853954054154254354454554654754854955055155255355455555655755855956056156256356456556656756856957057157257357457557657757857958058158258358458558658758858959059159259359459559659759859960060160260360460560660760860961061161261361461561661761861962062162262362462562662762862963063163263363463563663763863964064164264364464564664764864965065165265365465565665765865966066166266366466566666766866967067167267367467567667767867968068168268368468568668768868969069169269369469569669769869970070170270370470570670770870971071171271371471571671771871972072172272372472572672772872973073173273373473573673773873974074174274374474574674774874975075175275375475575675775875976076176276376476576676776876977077177277377477577677777877978078178278378478578678778878979079179279379479579679779879980080180280380480580680780880981081181281381481581681781881982082182282382482582682782882983083183283383483583683783883984084184284384484584684784884985085185285385485585685785885986086186286386486586686786886987087187287387487587687787887988088188288388488588688788888989089189289389489589689789889990090190290390490590690790890991091191291391491591691791891992092192292392492592692792892993093193293393493593693793893994094194294394494594694794894995095195295395495595695795895996096196296396496596696796896997097197297397497597697797897998098198298398498598698798898999099199299399499599699799899910001001100210031004100510061007100810091010101110121013101410151016101710181019102010211022102310241025102610271028102910301031103210331034103510361037103810391040104110421043104410451046104710481049105010511052105310541055105610571058105910601061106210631064106510661067106810691070107110721073107410751076107710781079108010811082108310841085108610871088108910901091109210931094109510961097109810991100110111021103110411051106110711081109111011111112111311141115111611171118111911201121112211231124112511261127112811291130113111321133113411351136113711381139114011411142114311441145114611471148114911501151115211531154115511561157115811591160116111621163116411651166116711681169117011711172117311741175117611771178117911801181118211831184118511861187118811891190119111921193119411951196119711981199120012011202120312041205120612071208120912101211121212131214121512161217121812191220122112221223122412251226122712281229123012311232123312341235123612371238123912401241124212431244124512461247124812491250125112521253125412551256125712581259126012611262126312641265126612671268126912701271127212731274127512761277127812791280128112821283128412851286128712881289129012911292129312941295129612971298129913001301130213031304130513061307130813091310131113121313131413151316131713181319132013211322132313241325132613271328132913301331133213331334133513361337 |
- 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.Install, 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 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.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, 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.
|