wizard.pas

源代码

unit Wizard;

{
  Inno Setup
  Copyright (C) 1997-2004 Jordan Russell
  Portions by Martijn Laan
  For conditions of distribution and use, see LICENSE.TXT.

  Wizard form

  $jrsoftware: issrc/Projects/Wizard.pas,v 1.135 2004/10/10 07:24:51 jr Exp $
}

interface

{$I VERSION.INC}

uses
  Windows, SysUtils, Messages, Classes, Graphics, Controls,
  Forms, Dialogs, StdCtrls, ExtCtrls,
  SetupForm, Struct, Int64Em, NewCheckListBox, RichEditViewer, NewStaticText,
  SetupTypes, NewProgressBar, MsgIDs, PasswordEdit, FolderTreeView, BitmapImage,
  NewNotebook;

type
  TWizardForm = class;

  TWizardPage = class;
  TWizardPageClass = class of TWizardPage;
  TWizardPageStyle = set of (psAlwaysSkip, psNoButtons);
  TWizardPageNotifyEvent = procedure(Sender: TWizardPage) of object;
  TWizardPageButtonEvent = function(Sender: TWizardPage): Boolean of object;
  TWizardPageCancelEvent = procedure(Sender: TWizardPage; var ACancel, AConfirm: Boolean) of object;
  TWizardPageShouldSkipEvent = function(Sender: TWizardPage): Boolean of object;
  TWizardPage = class(TComponent)
  private
    FID: Integer;
    FOuterNotebookPage: TNewNotebookPage;
    FInnerNotebookPage: TNewNotebookPage;
    FCaption: String;
    FDescription: String;
    FOnActivate: TWizardPageNotifyEvent;
    FOnBackButtonClick: TWizardPageButtonEvent;
    FOnCancelButtonClick: TWizardPageCancelEvent;
    FOnNextButtonClick: TWizardPageButtonEvent;
    FOnShouldSkipPage: TWizardPageShouldSkipEvent;
    FStyle: TWizardPageStyle;
    FWizardForm: TWizardForm;
    function GetSurface: TNewNotebookPage;
    function GetSurfaceHeight: Integer;
    function GetSurfaceWidth: Integer;
    procedure SetCaption(const Value: String);
    procedure SetDescription(const Value: String);
    procedure SyncCaptionAndDescription;
  protected
    procedure Activate; virtual;
    procedure BackButtonClick(var AContinue: Boolean); virtual;
    procedure CancelButtonClick(var ACancel, AConfirm: Boolean); virtual;
    procedure NextButtonClick(var AContinue: Boolean); virtual;
    procedure ShouldSkipPage(var AShouldSkip: Boolean); virtual;
    property InnerNotebookPage: TNewNotebookPage read FInnerNotebookPage;
    property OuterNotebookPage: TNewNotebookPage read FOuterNotebookPage;
    property Style: TWizardPageStyle read FStyle write FStyle;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    property Caption: String read FCaption write SetCaption;
    property Description: String read FDescription write SetDescription;
    property ID: Integer read FID;
    property Surface: TNewNotebookPage read GetSurface;
    property SurfaceHeight: Integer read GetSurfaceHeight;
    property SurfaceWidth: Integer read GetSurfaceWidth;
    property OnActivate: TWizardPageNotifyEvent read FOnActivate write FOnActivate;
    property OnBackButtonClick: TWizardPageButtonEvent read FOnBackButtonClick write FOnBackButtonClick;
    property OnCancelButtonClick: TWizardPageCancelEvent read FOnCancelButtonClick write FOnCancelButtonClick;
    property OnNextButtonClick: TWizardPageButtonEvent read FOnNextButtonClick write FOnNextButtonClick;
    property OnShouldSkipPage: TWizardPageShouldSkipEvent read FOnShouldSkipPage write FOnShouldSkipPage;
  end;

  TWizardForm = class(TSetupForm)
    CancelButton: TButton;
    NextButton: TButton;
    BackButton: TButton;
    OuterNotebook: TNewNotebook;
    InnerNotebook: TNewNotebook;
    WelcomePage: TNewNotebookPage;
    InnerPage: TNewNotebookPage;
    FinishedPage: TNewNotebookPage;
    LicensePage: TNewNotebookPage;
    PasswordPage: TNewNotebookPage;
    InfoBeforePage: TNewNotebookPage;
    UserInfoPage: TNewNotebookPage;
    SelectDirPage: TNewNotebookPage;
    SelectComponentsPage: TNewNotebookPage;
    SelectProgramGroupPage: TNewNotebookPage;
    SelectTasksPage: TNewNotebookPage;
    ReadyPage: TNewNotebookPage;
    PreparingPage: TNewNotebookPage;
    InstallingPage: TNewNotebookPage;
    InfoAfterPage: TNewNotebookPage;
    DiskSpaceLabel: TNewStaticText;
    DirEdit: TEdit;
    GroupEdit: TEdit;
    NoIconsCheck: TCheckBox;
    PasswordLabel: TNewStaticText;
    PasswordEdit: TPasswordEdit;
    PasswordEditLabel: TNewStaticText;
    ReadyMemo: TMemo;
    TypesCombo: TComboBox;
    Bevel: TBevel;
    WizardBitmapImage: TBitmapImage;
    WelcomeLabel1: TNewStaticText;
    InfoBeforeMemo: TRichEditViewer;
    InfoBeforeClickLabel: TNewStaticText;
    MainPanel: TPanel;
    Bevel1: TBevel;
    PageNameLabel: TNewStaticText;
    PageDescriptionLabel: TNewStaticText;
    WizardSmallBitmapImage: TBitmapImage;
    ReadyLabel: TNewStaticText;
    FinishedLabel: TNewStaticText;
    YesRadio: TRadioButton;
    NoRadio: TRadioButton;
    WizardBitmapImage2: TBitmapImage;
    WelcomeLabel2: TNewStaticText;
    LicenseLabel1: TNewStaticText;
    LicenseMemo: TRichEditViewer;
    InfoAfterMemo: TRichEditViewer;
    InfoAfterClickLabel: TNewStaticText;
    ComponentsList: TNewCheckListBox;
    ComponentsDiskSpaceLabel: TNewStaticText;
    BeveledLabel: TNewStaticText;
    StatusLabel: TNewStaticText;
    FilenameLabel: TNewStaticText;
    ProgressGauge: TNewProgressBar;
    SelectDirLabel: TNewStaticText;
    SelectStartMenuFolderLabel: TNewStaticText;
    SelectComponentsLabel: TNewStaticText;
    SelectTasksLabel: TNewStaticText;
    LicenseAcceptedRadio: TRadioButton;
    LicenseNotAcceptedRadio: TRadioButton;
    UserInfoNameLabel: TNewStaticText;
    UserInfoNameEdit: TEdit;
    UserInfoOrgLabel: TNewStaticText;
    UserInfoOrgEdit: TEdit;
    PreparingErrorBitmapImage: TBitmapImage;
    PreparingLabel: TNewStaticText;
    FinishedHeadingLabel: TNewStaticText;
    UserInfoSerialLabel: TNewStaticText;
    UserInfoSerialEdit: TEdit;
    TasksList: TNewCheckListBox;
    RunList: TNewCheckListBox;
    DirBrowseButton: TButton;
    GroupBrowseButton: TButton;
    SelectDirBitmapImage: TBitmapImage;
    SelectGroupBitmapImage: TBitmapImage;
    SelectDirBrowseLabel: TNewStaticText;
    SelectStartMenuFolderBrowseLabel: TNewStaticText;
    procedure NextButtonClick(Sender: TObject);
    procedure BackButtonClick(Sender: TObject);
    procedure CancelButtonClick(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure NoIconsCheckClick(Sender: TObject);
    procedure TypesComboChange(Sender: TObject);
    procedure ComponentsListClickCheck(Sender: TObject);
    procedure ReadyMemoKeyPress(Sender: TObject; var Key: Char);
    procedure LicenseAcceptedRadioClick(Sender: TObject);
    procedure LicenseNotAcceptedRadioClick(Sender: TObject);
    procedure UserInfoEditChange(Sender: TObject);
    procedure DirBrowseButtonClick(Sender: TObject);
    procedure GroupBrowseButtonClick(Sender: TObject);
  private
    { Private declarations }
    FPageList: TList;
    FNextPageID: Integer;
    ExpandedDefaultDirName, ExpandedDefaultGroupName: String;
    NeedSelectTasksPageUpdate: Boolean;
    PrevAppDir, PrevGroup, PrevSetupType, PrevUserInfoName, PrevUserInfoOrg, PrevUserInfoSerial: String;
    PrevSelectedComponents, PrevDeselectedComponents: TStringList;
    PrevSelectedTasks, PrevDeselectedTasks: TStringList;
    InitialSelectedComponents: TStringList;
    InitialSetupTypeIndex: Integer;
    MaxComponentSize: Integer64;
    DoneWithWizard: Boolean;
    procedure CalcCurrentComponentsSpace;
    function CheckSerialOk: Boolean;
    procedure CreateTaskButtons(const SelectedComponents: TStringList);
    procedure FindPreviousData;
    function PageIndexFromID(const ID: Integer): Integer;
    function PrepareToInstall: Boolean;
    procedure RegisterExistingPage(const ID: Integer;
     const AOuterNotebookPage, AInnerNotebookPage: TNewNotebookPage;
     const ACaption, ADescription: String);
    procedure UpdateComponentSizes;
    procedure UpdateComponentSizesEnum(Index: Integer; HasChildren: Boolean; Ext: LongInt);
    procedure WMSysCommand(var Message: TWMSysCommand); message WM_SYSCOMMAND;
  protected
    procedure CreateParams(var Params: TCreateParams); override;
  public
    { Public declarations }
    CurPageID: Integer;
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure AddPage(const APage: TWizardPage; const AfterID: Integer);
    procedure AdjustFocus;
    function AdjustLabelHeight(const ALabel: TNewStaticText): Integer;
    procedure CallCancelButtonClick(var ACancel, AConfirm: Boolean);
    procedure ChangeFinishedLabel(const S: String);
    procedure ChangeReadyLabel(const S: String);
    procedure ClickThroughPages;
    procedure DirTreeRename(Sender: TCustomFolderTreeView; var NewName: string; var Accept: Boolean);
    function GetPreviousPageID: Integer;
    procedure GetSelectedComponents(Components: TStringList; const Descriptions, IndentDescriptions: Boolean);
    procedure GetSelectedTasks(Tasks: TStringList; const Descriptions, IndentDescriptions, GroupDescriptions: Boolean);
    function GetSetupType: PSetupTypeEntry;
    procedure GroupTreeRename(Sender: TCustomFolderTreeView; var NewName: string; var Accept: Boolean);
    procedure IncTopDecHeight(const AControl: TControl; const Amount: Integer);
    function PageFromID(const ID: Integer): TWizardPage;
    procedure SetSelectedComponents(const SelectedComponents, DeselectedComponents: TStringList);
    procedure SetSelectedComponentsFromType(const TypeName: String; OnlySelectFixedComponents: Boolean);
    procedure SetCurPage(const NewPageID: Integer);
    function ShouldSkipPage(const PageID: Integer): Boolean;
    procedure UpdatePage(const PageID: Integer);
    procedure UpdateRunList(const SelectedComponents, SelectedTasks: TStringList);
    procedure UpdateSelectTasksPage;
    function ValidateDirEdit: Boolean;
  end;

var
  WizardForm: TWizardForm;

function ExpandSetupMessage(const ID: TSetupMessageID): String;
function ListContains(const List: TStringList; const S: String): Boolean;
function ValidateCustomDirEdit(const AEdit: TEdit; const AllowUNCPath, AllowRootDirectory: Boolean): Boolean;

implementation

uses
  ShellApi, ShlObj, Msgs, Main, PathFunc, CmnFunc, CmnFunc2,
  MD5, InstFunc, SelFolderForm, Extract, Logging;

{$R *.DFM}

const
  BadDirChars = '/:*?"<>|';

var
  CurrentComponentsSpace: Integer64;

function IntToKBStr(const I: Integer64): String;
var
  X: Extended;
begin
  X := Comp(I) / 1024;
  if Frac(X) > 0 then
    X := Int(X) + 1;  { always round up }
  Result := Format('%.0n', [X]);
end;

function IntToMBStr(const I: Integer64): String;
var
  X: Extended;
begin
  X := (Comp(I) / 1048576) * 10;
  if Frac(X) > 0 then
    X := Int(X) + 1;  { always round up }
  X := X / 10;
  Result := Format('%.1n', [X]);
end;

function ExpandSetupMessageEx(const ID: TSetupMessageID;
  const Space: Integer64): String;
begin
  Result := SetupMessages[ID];
  {don't localize these}
  StringChange(Result, '[name]', ExpandedAppName);
  StringChange(Result, '[name/ver]', ExpandedAppVerName);
  StringChange(Result, '[kb]', IntToKBStr(Space));
  StringChange(Result, '[mb]', IntToMBStr(Space));
end;

function ExpandSetupMessage(const ID: TSetupMessageID): String;
begin
  Result := ExpandSetupMessageEx(ID, MinimumSpace);
end;

function ListContains(const List: TStringList; const S: String): Boolean;
{ Similar to "List.IndexOf(S) <> -1", except it uses CompareText instead of
  AnsiCompareText (which is locale-sensitive and thus unsuitable for our
  purposes). }
var
  I: Integer;
begin
  for I := 0 to List.Count-1 do
    if CompareText(List[I], S) = 0 then begin
      Result := True;
      Exit;
    end;
  Result := False;
end;

function ContainsControlCharacters(const S: String): Boolean;
{ Returns True if S contains any control characters (#0..#31) }
var
  I: Integer;
begin
  for I := 1 to Length(S) do
    if S[I] <= #31 then begin
      Result := True;
      Exit;
    end;
  Result := False;
end;

function PathComponentsContainTrailingSpaces(const S: String): Boolean;
{ Returns True if one or more components of the path contain trailing spaces,
  which are invalid in Win32. }
var
  P: PChar;
begin
  P := PChar(S);
  while P^ <> #0 do begin
    if (P^ = ' ') and ((P[1] = '\') or (P[1] = #0)) then begin
      Result := True;
      Exit;
    end;
    P := CharNext(P);
  end;
  Result := False;
end;

function PathComponentsContainInvalidDots(const S: String): Boolean;
{ Returns True if one or more components of the path contain only dots,
  i.e. '.', '..', '...', etc. One or two dots represent relative paths; three
  or more dots are invalid. }
var
  P: PChar;
  HasDots: Boolean;
begin
  P := PChar(S);
  while P^ <> #0 do begin
    { Skip over leading spaces; we want ' .' to return True also }
    while P^ = ' ' do
      Inc(P);
    HasDots := False;
    while P^ = '.' do begin
      HasDots := True;
      Inc(P);
    end;
    { Skip over trailing spaces; we want '. ' to return True also }
    while P^ = ' ' do