main.pas

源代码

unit Main;

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

  Background form

  $jrsoftware: issrc/Projects/Main.pas,v 1.217 2004/12/24 09:05:54 jr Exp $
}

interface

{$I VERSION.INC}

uses
  Windows, SysUtils, Messages, Classes, Graphics, Controls, Forms, Dialogs,
  SetupForm, StdCtrls, Struct, DebugStruct, Int64Em,
  SetupTypes, ScriptRunner;

type
  TMainForm = class(TSetupForm)
    procedure FormResize(Sender: TObject);
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
    procedure FormPaint(Sender: TObject);
    procedure FormKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
  private
    { Private declarations }
    IsMinimized, HideWizard: Boolean;
    function MainWindowHook(var Message: TMessage): Boolean;
    procedure UpdateWizardFormVisibility;
    procedure WMSysCommand(var Message: TWMSysCommand); message WM_SYSCOMMAND;
    procedure WMEraseBkgnd(var Message: TWMEraseBkgnd); message WM_ERASEBKGND;
    procedure WMGetDlgCode(var Message: TWMGetDlgCode); message WM_GETDLGCODE;
    procedure WMQueryEndSession(var Message: TWMQueryEndSession); message WM_QUERYENDSESSION;
    procedure WMShowWindow(var Message: TWMShowWindow); message WM_SHOWWINDOW;
  public
    { Public declarations }
    CurStep: TSetupStep;
    InExecuteLoop: Integer;
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure Finish;
    procedure InitializeWizard;
    function Install: Boolean;
    procedure SetStep(const AStep: TSetupStep; const HandleExceptions: Boolean);
    class procedure ShowException(Sender: TObject; E: Exception);
    class procedure ShowExceptionMsg(const S: String);
    procedure ShowAboutBox;
  end;

  TEntryType = (seLanguage, seCustomMessage, sePermission, seType, seComponent,
    seTask, seDir, seFile, seFileLocation, seIcon, seIni, seRegistry,
    seInstallDelete, seUninstallDelete, seRun, seUninstallRun);

const
  EntryStrings: array[TEntryType] of Integer = (SetupLanguageEntryStrings,
    SetupCustomMessageEntryStrings, SetupPermissionEntryStrings,
    SetupTypeEntryStrings, SetupComponentEntryStrings, SetupTaskEntryStrings,
    SetupDirEntryStrings, SetupFileEntryStrings, SetupFileLocationEntryStrings,
    SetupIconEntryStrings, SetupIniEntryStrings, SetupRegistryEntryStrings,
    SetupDeleteEntryStrings, SetupDeleteEntryStrings, SetupRunEntryStrings,
    SetupRunEntryStrings);

  { Exit codes that are assigned to the SetupExitCode variable.
    Note: SetupLdr also returns exit codes with the same numbers. }
  ecInitializationError = 1;     { Setup failed to initialize. }
  ecCancelledBeforeInstall = 2;  { User clicked Cancel before the actual
                                   installation started. }
  ecNextStepError = 3;           { A fatal exception occurred while moving to
                                   the next step. }
  ecInstallationError = 4;       { A fatal exception occurred during
                                   installation. }
  ecInstallationCancelled = 5;   { User clicked Cancel during installation,
                                   or clicked Abort at an Abort-Retry-Ignore
                                   dialog. }
  ecKilledByDebugger = 6;        { User killed the Setup process from within
                                   the debugger. }

var
  MainForm: TMainForm;

  { Variables for command line parameters }
  SetupLdrMode: Boolean;
  SetupLdrWnd: HWND;
  SetupLdrOriginalFilename: String;
  SetupLdrOffset0, SetupLdrOffset1: Longint;
  InitLang: String;
  InitDir, InitProgramGroup: String;
  InitLoadInf, InitSaveInf: String;
  InitNoIcons, InitSilent, InitVerySilent, InitNoRestart, InitNoCancel: Boolean;
  InitComponents: TStringList;
  InitPassword: String;
  InitRestartExitCode: Integer;
  DetachedUninstMsgFile: Boolean;

  { Debugger }
  OriginalEntryIndexes: array[TEntryType] of TList;

  { 'Constants' }
  SourceDir, TempInstallDir, WinDir, WinSystemDir, SystemDrive,
    ProgramFilesDir, CommonFilesDir, DAODir, CmdFilename, SysUserInfoName,
    SysUserInfoOrg, UninstallExeFilename: String;

  { Uninstall 'constants' }
  UninstallExpandedAppId, UninstallExpandedApp, UninstallExpandedGroup,
  UninstallExpandedGroupName, UninstallExpandedLanguage: String;
  UninstallSilent: Boolean;

  { Variables read in from the SETUP.0 file }
  SetupHeader: TSetupHeader;
  LangOptions: TSetupLanguageEntry;
  Entries: array[TEntryType] of TList;
  WizardImage: TBitmap;
  WizardSmallImage: TBitmap;
  DecompressorDLL, DecryptDLL: TMemoryStream;

  { User options }
  ActiveLanguage: Integer = -1;
  ActiveLicenseText, ActiveInfoBeforeText, ActiveInfoAfterText: String;
  WizardUserInfoName, WizardUserInfoOrg, WizardUserInfoSerial, WizardDirValue, WizardGroupValue: String;
  WizardNoIcons: Boolean;
  WizardSetupType: PSetupTypeEntry;
  WizardComponents, WizardTasks: TStringList;
  NeedToAbortInstall: Boolean;

  { Check/BeforeInstall/AfterInstall 'contants' }
  CheckOrInstallCurrentFileName: String;

  { Other }
  ShowLanguageDialog: Boolean;
  InstallMode: (imNormal, imSilent, imVerySilent);
  HasIcons, IsNT, IsAdmin, IsPowerUser, NeedPassword, NeedSerial, NeedsRestart,
    RestartSystem, IsUninstaller: Boolean;
  HasCustomType, HasComponents, HasTasks, HasTaskIcons: Boolean;
  WindowsVersion: Cardinal;
  NTServicePackLevel: Word;
  MinimumSpace: Integer64;
  DeleteFilesAfterInstallList, DeleteDirsAfterInstallList: TStringList;
  ExpandedAppName, ExpandedAppVerName, ExpandedAppCopyright: String;
  StartParam: Integer;
  ConstReadOnly: Boolean;
  SetupExitCode: Integer;
  CreatedIcon: Boolean;

  CodeRunner: TScriptRunner;

function GetUninstallRegKeyBaseName(const ExpandedAppId: String): String;
function TestPassword(const Password: String): Boolean;
procedure NotifyBeforeInstallEntry(const BeforeInstall: String);
procedure NotifyBeforeInstallFileEntry(const FileEntry: PSetupFileEntry);
procedure NotifyAfterInstallEntry(const AfterInstall: String);
procedure NotifyAfterInstallFileEntry(const FileEntry: PSetupFileEntry);
function ShouldProcessEntry(const WizardComponents, WizardTasks: TStringList;
  const Components, Tasks, Languages, Check: String): Boolean;
function ShouldProcessFileEntry(const WizardComponents, WizardTasks: TStringList;
  const FileEntry: PSetupFileEntry; const IgnoreCheck: Boolean): Boolean;
function ShouldProcessRunEntry(const WizardComponents, WizardTasks: TStringList;
  const RunEntry: PSetupRunEntry): Boolean;
function ShouldProcessIconEntry(const WizardComponents, WizardTasks: TStringList;
  const WizardNoIcons: Boolean; const IconEntry: PSetupIconEntry): Boolean;
function ExpandConst(const S: String): String;
function ExpandConstEx(const S: String; const CustomConsts: array of String): String;
procedure DebugNotifyEntry(EntryType: TEntryType; Number: Integer);
procedure DeinitSetup(Killing, AllowCustomSetupExitCode: Boolean);
function ExitSetupMsgBox: Boolean;
procedure InitMainNonSHFolderConsts;
function CreateTempDir: String;
procedure LoadSHFolderDLL;
procedure UnloadSHFolderDLL;
function GetRealShellFolder(const Common: Boolean; const ID: TShellFolderID;
  ReadOnly: Boolean): String;
function GetShellFolder(Common: Boolean; const ID: TShellFolderID;
  ReadOnly: Boolean): String;
function GetShellFolderByCSIDL(Folder: Integer; const Create: Boolean): String;
procedure InitializeCommonVars;
procedure InitializeSetup;
function InstallOnThisVersion(const MinVersion: TSetupVersionData;
  const OnlyBelowVersion: TSetupVersionData): TInstallOnThisVersionResult;
procedure InternalError(const Id: String);
procedure SetActiveLanguage(const I: Integer);
function PreviousInstallNotCompleted: Boolean;
function IsRecurseableDirectory(const FindData: TWin32FindData): Boolean;
procedure CodeRunnerOnDllImport(var DllName: String; var ForceDelayLoad: Boolean);
procedure CodeRunnerOnDebug(const Position: LongInt; var ContinueStepOver: Boolean);
procedure CodeRunnerOnDebugIntermediate(const Position: LongInt);
procedure CodeRunnerOnException(const Exception: String; const Position: LongInt);
procedure SetTaskbarButtonVisibility(const AVisible: Boolean);

implementation

uses
  ShellAPI, ShlObj,
  Msgs, MsgIDs, Install, InstFunc, InstFnc2, PathFunc, CmnFunc, CmnFunc2,
  Compress, zlib, bzlib, LZMA, ArcFour, SetupEnt, SelLangForm, Wizard,
  DebugClient, VerInfo, Extract, FileClass, Logging, MD5, SimpleExpression;

{$R *.DFM}

var
  ShellFolders: array[Boolean, TShellFolderID] of String;
  ShellFoldersRead: array[Boolean, TShellFolderID] of Boolean;
  SHFolderDLLHandle: HMODULE;
  SHGetFolderPathFunc: function(hwndOwner: HWND; nFolder: Integer;
    hToken: THandle; dwFlags: DWORD; pszPath: PAnsiChar): HRESULT; stdcall;

  DecompressorDLLHandle: HMODULE;
  DecryptDLLHandle: HMODULE;

type
  TDummyClass = class
    public
      class function ExpandCheckOrInstallConstant(Sender: TSimpleExpression;
        const Constant: String): String;
      class function EvalInstallIdentifier(Sender: TSimpleExpression;
        const Name: String; const Parameters: array of const): Boolean;
      class function EvalComponentOrTaskIdentifier(Sender: TSimpleExpression;
        const Name: String; const Parameters: array of const): Boolean;
      class function EvalLanguageIdentifier(Sender: TSimpleExpression;
        const Name: String; const Parameters: array of const): Boolean;
      class function EvalCheckIdentifier(Sender: TSimpleExpression;
        const Name: String; const Parameters: array of const): Boolean;
  end;

{ Misc. functions }

function GetUninstallRegKeyBaseName(const ExpandedAppId: String): String;
begin
  { Set uninstall registry key base name }
  Result := ExpandedAppId;
  { Uninstall registry keys can only be up to 63 characters, otherwise Win95
    ignores them. Limit to 57 since Setup will add _isXXX to the end later. }
  if Length(Result) > 57 then
    { Only keep the first 48 characters, then add an tilde and the CRC
      of the original string (to make the trimmed string unique). The
      resulting string is 57 characters long. }
    FmtStr(Result, '%.48s~%.8x', [Result, GetCRC32(Result[1], Length(Result))]);
end;

function TestPassword(const Password: String): Boolean;
var
  Context: TMD5Context;
  Hash: TMD5Digest;
begin
  MD5Init(Context);
  MD5Update(Context, PAnsiChar('PasswordCheckHash')^, Length('PasswordCheckHash'));
  MD5Update(Context, SetupHeader.PasswordSalt, SizeOf(SetupHeader.PasswordSalt));
  MD5Update(Context, Pointer(Password)^, Length(Password));
  Hash := MD5Final(Context);
  Result := MD5DigestsEqual(Hash, SetupHeader.PasswordHash);
end;

class function TDummyClass.ExpandCheckOrInstallConstant(Sender: TSimpleExpression;
  const Constant: String): String;
begin
  Result := ExpandConst(Constant);
end;

class function TDummyClass.EvalInstallIdentifier(Sender: TSimpleExpression;
  const Name: String; const Parameters: array of const): Boolean;
begin
  CodeRunner.RunProcedure(Name, Parameters, True);
  Result := True;  { Result doesn't matter }
end;

procedure NotifyInstallEntry(const Install: String);

  procedure EvalInstall(const Expression: String);
  var
    SimpleExpression: TSimpleExpression;
  begin
    try
      SimpleExpression := TSimpleExpression.Create;
      try
        SimpleExpression.Expression := Expression;
        SimpleExpression.OnEvalIdentifier := TDummyClass.EvalInstallIdentifier;
        SimpleExpression.OnExpandConstant := TDummyClass.ExpandCheckOrInstallConstant;
        SimpleExpression.ParametersAllowed := True;
        SimpleExpression.SingleIdentifierMode := True;
        SimpleExpression.Eval;
      finally
        SimpleExpression.Free;
      end;
    except
      InternalError(Format('Expression error ''%s''', [GetExceptMessage]));
    end;
  end;

begin
  if Install <> '' then begin
    try
      if CodeRunner = nil then
        InternalError('"BeforeInstall" or "AfterInstall" parameter with no CodeRunner');
      EvalInstall(Install);
    except
      { Don't allow exceptions raised by Before/AfterInstall functions to be propagated out }
      Application.HandleException(nil);
    end;
  end;
end;

procedure NotifyBeforeInstallEntry(const BeforeInstall: String);
begin
  NotifyInstallEntry(BeforeInstall);
end;

procedure NotifyBeforeInstallFileEntry(const FileEntry: PSetupFileEntry);
begin
  CheckOrInstallCurrentFileName := FileEntry.DestName;
  NotifyInstallEntry(FileEntry.BeforeInstall);
  CheckOrInstallCurrentFileName := '';
end;

procedure NotifyAfterInstallEntry(const AfterInstall: String);
begin
  NotifyInstallEntry(AfterInstall);
end;

procedure NotifyAfterInstallFileEntry(const FileEntry: PSetupFileEntry);
begin
  CheckOrInstallCurrentFileName := FileEntry.DestName;
  NotifyInstallEntry(FileEntry.AfterInstall);
  CheckOrInstallCurrentFileName := '';
end;

class function TDummyClass.EvalComponentOrTaskIdentifier(Sender: TSimpleExpression;
  const Name: String; const Parameters: array of const): Boolean;
var
  WizardItems: TStringList;
begin
  WizardItems := TStringList(Sender.Tag);
  Result := ListContains(WizardItems, Name);
end;

class function TDummyClass.EvalLanguageIdentifier(Sender: TSimpleExpression;
  const Name: String; const Parameters: array of const): Boolean;
begin
  Result := CompareText(PSetupLanguageEntry(Entries[seLanguage][ActiveLanguage]).Name, Name) = 0;
end;

class function TDummyClass.EvalCheckIdentifier(Sender: TSimpleExpression;
  const Name: String; const Parameters: array of const): Boolean;
var
  Default: Boolean;
begin
  Default := Boolean(Sender.Tag);
  Result := CodeRunner.RunBooleanFunction(Name, Parameters, True, Default);
end;

function ShouldProcessEntry(const WizardComponents, WizardTasks: TStringList;
  const Components, Tasks, Languages, Check: String): Boolean;

  function EvalExpression(const Expression: String;
    OnEvalIdentifier: TSimpleExpressionOnEvalIdentifier; Tag: LongInt): Boolean;
  var
    SimpleExpression: TSimpleExpression;
  begin
    try
      SimpleExpression := TSimpleExpression.Create;
      try
        SimpleExpression.Lazy := True;
        SimpleExpression.Expression := Expression;
        SimpleExpression.OnEvalIdentifier := OnEvalIdentifier;
        SimpleExpression.ParametersAllowed := False;
        SimpleExpression.SilentOrAllowed := True;
        SimpleExpression.SingleIdentifierMode := False;
        SimpleExpression.Tag := Tag;