install.pas

源代码

unit Install;

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

  Installation procedures

  $jrsoftware: issrc/Projects/Install.pas,v 1.196 2004/12/18 01:24:05 jr Exp $
}

interface

{$I VERSION.INC}

procedure PerformInstall(var Succeeded: Boolean);

procedure ExtractTemporaryFile(const BaseName: String);

implementation

uses
  Windows, SysUtils, Messages, Classes, Forms, ShlObj, Struct, Undo, SetupTypes,
  InstFunc, InstFnc2, Msgs, Main, Logging, Extract, FileClass, Compress, MD5,
  PathFunc, CmnFunc, CmnFunc2, Int64Em, MsgIDs,
  Wizard, DebugStruct, DebugClient, VerInfo,
  ScriptRunner;

type
  TSetupUninstallLog = class(TUninstallLog)
  protected
    procedure HandleException; override;
  end;

var
  CurProgress: Integer64;
  ProgressShiftCount: Cardinal;

{ TSetupUninstallLog }

procedure TSetupUninstallLog.HandleException;
begin
  Application.HandleException(Self);
end;

procedure SetFilenameLabelText(const S: String; const CallUpdate: Boolean);
begin
  WizardForm.FilenameLabel.Caption := MinimizePathName(S, WizardForm.FilenameLabel.Font, WizardForm.FileNameLabel.Width);
  if CallUpdate then
    WizardForm.FilenameLabel.Update;
end;

procedure SetStatusLabelText(const S: String);
begin
  WizardForm.StatusLabel.Caption := S;
  WizardForm.StatusLabel.Update;
  SetFilenameLabelText('', True);
end;

procedure InitProgressGauge;
var
  NewMaxValue: Integer64;
  N: Integer;
  CurFile: PSetupFileEntry;
begin
  { Calculate the MaxValue for the progress meter }
  NewMaxValue.Hi := 0;
  NewMaxValue.Lo := 1000 * Entries[seIcon].Count;
  if Entries[seIni].Count <> 0 then Inc(NewMaxValue.Lo, 1000);
  if Entries[seRegistry].Count <> 0 then Inc(NewMaxValue.Lo, 1000);
  for N := 0 to Entries[seFile].Count-1 do begin
    CurFile := PSetupFileEntry(Entries[seFile][N]);
    if ShouldProcessFileEntry(WizardComponents, WizardTasks, CurFile, False) then begin
      with CurFile^ do
        if LocationEntry <> -1 then  { not an "external" file }
          Inc6464(NewMaxValue, PSetupFileLocationEntry(Entries[seFileLocation][
           LocationEntry])^.OriginalSize)
        else
          Inc6464(NewMaxValue, ExternalSize);
      end;
  end;
  { Now keep dividing it by 2 until it fits comfortably into a Longint.
    (TNewProgressBar doesn't support 64-bit integers.) }
  ProgressShiftCount := 0;
  while (NewMaxValue.Hi <> 0) or (NewMaxValue.Lo >= Cardinal($10000000)) do begin
    Shr64(NewMaxValue, 1);
    Inc(ProgressShiftCount);
  end;
  WizardForm.ProgressGauge.Max := NewMaxValue.Lo;
end;

procedure UpdateProgressGauge;
var
  NewPosition: Integer64;
begin
  NewPosition := CurProgress;
  Shr64(NewPosition, ProgressShiftCount);
  with WizardForm.ProgressGauge do begin
    Position := NewPosition.Lo;
    Update;
  end;
end;

procedure SetProgress(const AProgress: Integer64);
begin
  CurProgress := AProgress;
  UpdateProgressGauge;
end;

procedure IncProgress(const N: Cardinal);
begin
  Inc64(CurProgress, N);
  UpdateProgressGauge;
end;

procedure IncProgress64(const N: Integer64);
begin
  Inc6464(CurProgress, N);
  UpdateProgressGauge;
end;

procedure ProcessEvents;
{ Processes any waiting events. Must call this this periodically or else
  events like clicking the Cancel button won't be processed.
  Calls Abort if NeedToAbortInstall is True, which is usually the result of
  the user clicking Cancel and the form closing. }
begin
  if NeedToAbortInstall then Abort;
  Application.ProcessMessages;
  if NeedToAbortInstall then Abort;
end;

procedure ExtractorProgressProc(Bytes: Cardinal);
begin
  IncProgress(Bytes);
  ProcessEvents;
end;

function AbortRetryIgnoreMsgBox(const Text1, Text2: String): Boolean;
{ Returns True if Ignore was selected, False if Retry was selected, or
  calls Abort if Abort was selected. }
var
  S: String;
begin
  S := Text1 + SNewLine2 + Text2;
  Log('Error message (Abort/Retry/Ignore):' + SNewLine + S);
  Result := False;
  case MsgBox(S, '', mbError, MB_ABORTRETRYIGNORE) of
    ID_ABORT: begin
        Log('User chose Abort.');
        Abort;
      end;
    ID_RETRY: begin
        Log('User chose Retry.');
      end;
    ID_IGNORE: begin
        Log('User chose Ignore.');
        Result := True;
      end;
  else
    Log('MsgBox returned an unexpected value. Assuming Abort.');
    Abort;
  end;
end;

function FileTimeToStr(const AFileTime: TFileTime): String;
{ Converts a TFileTime into a string for log purposes. }
var
  FT: TFileTime;
  ST: TSystemTime;
begin
  FileTimeToLocalFileTime(AFileTime, FT);
  if FileTimeToSystemTime(FT, ST) then
    Result := Format('%.4u-%.2u-%.2u %.2u:%.2u:%.2u.%.3u',
      [ST.wYear, ST.wMonth, ST.wDay, ST.wHour, ST.wMinute, ST.wSecond,
       ST.wMilliseconds])
  else
    Result := '(invalid)';
end;

function TryToGetMD5OfFile(const Filename: String; var Sum: TMD5Digest): Boolean;
{ Like GetMD5OfFile but traps exceptions locally. Returns True if successful. }
begin
  try
    Sum := GetMD5OfFile(Filename);
    Result := True;
  except
    Result := False;
  end;
end;

procedure CopySourceFileToDestFile(const SourceF, DestF: TFile;
  AMaxProgress: Integer64);
{ Copies all bytes from SourceF to DestF, incrementing process meter as it
  goes. Assumes file pointers of both are 0. }
var
  BytesLeft: Integer64;
  NewProgress: Integer64;
  BufSize: Cardinal;
  Buf: array[0..65535] of Byte;
begin
  Inc6464(AMaxProgress, CurProgress);
  BytesLeft := SourceF.Size;

  { To avoid file system fragmentation, preallocate all of the bytes in the
    destination file }
  DestF.Seek64(BytesLeft);
  DestF.Truncate;
  DestF.Seek(0);

  while True do begin
    BufSize := SizeOf(Buf);
    if (BytesLeft.Hi = 0) and (BytesLeft.Lo < BufSize) then
      BufSize := BytesLeft.Lo;
    if BufSize = 0 then
      Break;

    SourceF.ReadBuffer(Buf, BufSize);
    DestF.WriteBuffer(Buf, BufSize);
    Dec64(BytesLeft, BufSize);

    NewProgress := CurProgress;
    Inc64(NewProgress, BufSize);
    if Compare64(NewProgress, AMaxProgress) > 0 then
      NewProgress := AMaxProgress;
    SetProgress(NewProgress);

    ProcessEvents;
  end;

  { In case the source file was shorter than we thought it was, bump the
    progress bar to the maximum amount }
  SetProgress(AMaxProgress);
end;

procedure AddAttributesToFile(const Filename: String; Attribs: Integer);
var
  ExistingAttr: DWORD;
begin
  if Attribs <> 0 then begin
    ExistingAttr := GetFileAttributes(PChar(Filename));
    if ExistingAttr <> $FFFFFFFF then
      SetFileAttributes(PChar(Filename),
        (ExistingAttr and not FILE_ATTRIBUTE_NORMAL) or DWORD(Attribs));
  end;
end;

function ShortenOrExpandFontFilename(const Filename: String): String;
{ Expands Filename, except if it's in the Fonts directory, in which case it
  removes the path }
var
  FontDir: String;
begin
  Result := PathExpand(Filename);
  FontDir := GetShellFolder(False, sfFonts, False);
  if FontDir <> '' then
    if PathCompare(PathExtractPath(Result), AddBackslash(FontDir)) = 0 then
      Result := PathExtractName(Result);
end;

procedure PerformInstall(var Succeeded: Boolean);
type
  PRegisterFilesListRec = ^TRegisterFilesListRec;
  TRegisterFilesListRec = record
    Filename: String;
    TypeLib, NoErrorMessages: Boolean;
  end;
var
  UninstLog: TSetupUninstallLog;
  UninstallTempExeFilename, UninstallDataFilename, UninstallMsgFilename: String;
  UninstallExeCreated: (ueNone, ueNew, ueReplaced);
  UninstallDataCreated, UninstallMsgCreated, AppendUninstallData: Boolean;
  RegisterFilesList: TList;

  function GetLocalTimeAsStr: String;
  var
    SysTime: TSystemTime;
  begin
    GetLocalTime(SysTime);
    SetString(Result, PChar(@SysTime), SizeOf(SysTime));
  end;

  function GetSelectedComponentsStr: String;
  begin
    Result := WizardComponents.CommaText;
  end;

  function GetDeselectedComponentsStr: String;
  var
    ComponentEntry: PSetupComponentEntry;
    I: Integer;
    S: String;
  begin
    S := '';

    for I := 0 to Entries[seComponent].Count-1 do begin
      ComponentEntry := Entries[seComponent][I];
      if not ListContains(WizardComponents, ComponentEntry.Name) then begin
        if S <> '' then
          S := S + ',';
        S := S + ComponentEntry.Name;
      end;
    end;

    Result := S;
  end;

  function GetSelectedTasksStr: String;
  begin
    Result := WizardTasks.CommaText;
  end;

  function GetDeselectedTasksStr: String;
  var
    TaskEntry: PSetupTaskEntry;
    I: Integer;
    S: String;
  begin
    S := '';

    for I := 0 to Entries[seTask].Count-1 do begin
      TaskEntry := PSetupTaskEntry(Entries[seTask][I]);
      if ShouldProcessEntry(WizardComponents, nil, TaskEntry.Components, '', TaskEntry.Languages, '') and
         not ListContains(WizardTasks, TaskEntry.Name) then begin
        if S <> '' then
          S := S + ',';
        S := S + TaskEntry.Name;