instfunc.pas

源代码

unit InstFunc;

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

  Misc. installation functions

  $jrsoftware: issrc/Projects/InstFunc.pas,v 1.59 2004/12/23 03:14:29 jr Exp $
}

interface

uses
  Windows, SysUtils, Struct, Int64Em, MD5;

{$I VERSION.INC}

type
  PSimpleStringListArray = ^TSimpleStringListArray;
  TSimpleStringListArray = array[0..$1FFFFFFE] of String;
  TSimpleStringList = class
  private
    FList: PSimpleStringListArray;
    FCount, FCapacity: Integer;
    function Get(Index: Integer): String;
    procedure SetCapacity(NewCapacity: Integer);
  public
    destructor Destroy; override;
    procedure Add(const S: String);
    procedure AddIfDoesntExist(const S: String);
    procedure Clear;
    function IndexOf(const S: String): Integer;

    property Count: Integer read FCount;
    property Items[Index: Integer]: String read Get; default;
  end;

  TDeleteDirProc = function(const DirName: String; Param: Pointer): Boolean;
  TDeleteFileProc = procedure(const FileName: String; Param: Pointer);

  TEnumFROFilenamesProc = procedure(const Filename: String; Param: Pointer);

function CheckForMutexes(Mutexes: String): Boolean;
function DecrementSharedCount(const Filename: String): Boolean;
procedure DelayDeleteFile(const Filename: String; const Tries: Integer);
function DelTree(const Path: String; const IsDir, DeleteFiles, DeleteSubdirsAlso: Boolean;
  const DeleteDirProc: TDeleteDirProc; const DeleteFileProc: TDeleteFileProc;
  const Param: Pointer): Boolean;
procedure EnumFileReplaceOperationsFilenames(const EnumFunc: TEnumFROFilenamesProc;
  Param: Pointer);
function GenerateNonRandomUniqueFilename(Path: String; var Filename: String): Boolean;
function GenerateUniqueName(Path: String; const Extension: String): String;
function GetComputerNameString: String;
function GetFileDateTime(const Filename: string; var DateTime: TFileTime): Boolean;
function GetMD5OfFile(const Filename: String): TMD5Digest;
function GetMD5OfString(const S: String): TMD5Digest;
function GetRegRootKeyName(const RootKey: HKEY): String;
function GetSpaceOnDisk(const DriveRoot: String;
  var FreeBytes, TotalBytes: Integer64): Boolean;
function GetUserNameString: String;
function GrantPermissionOnFile(const Filename: String;
  const Entries: TGrantPermissionEntry; const EntryCount: Integer): Boolean;
function GrantPermissionOnKey(const RootKey: HKEY; const Subkey: String;
  const Entries: TGrantPermissionEntry; const EntryCount: Integer): Boolean;
procedure IncrementSharedCount(const Filename: String;
  const AlreadyExisted: Boolean);
function InstExec(const Filename, Params: String; WorkingDir: String;
  const WaitUntilTerminated, WaitUntilIdle: Boolean; const ShowCmd: Integer;
  const ProcessMessagesProc: TProcedure; var ResultCode: Integer): Boolean;
function InstShellExec(const Verb, Filename, Params: String; WorkingDir: String;
  const WaitUntilTerminated, WaitUntilIdle: Boolean; const ShowCmd: Integer;
  const ProcessMessagesProc: TProcedure; var ResultCode: Integer): Boolean;
function IsDirEmpty(const Dir: String): Boolean;
function IsProtectedSystemFile(const Filename: String): Boolean;
function MakePendingFileRenameOperationsChecksum: TMD5Digest;
function ModifyPifFile(const Filename: String; const CloseOnExit: Boolean): Boolean;
procedure RefreshEnvironment;
procedure RegisterServer(const Filename: String; const FailCriticalErrors: Boolean);
function UnregisterServer(const Filename: String; const FailCriticalErrors: Boolean): Boolean;
procedure UnregisterFont(const FontName, FontFilename: String);
procedure RestartComputer;
procedure RestartReplace(const TempFile, DestFile: String);
procedure Win32ErrorMsg(const FunctionName: String);

implementation

uses
  Messages, ShellApi, PathFunc, CmnFunc2, Msgs, MsgIDs, FileClass;

procedure Win32ErrorMsg(const FunctionName: String);
var
  LastError: DWORD;
begin
  LastError := GetLastError;
  raise Exception.Create(FmtSetupMessage(msgErrorFunctionFailedWithMessage,
    [FunctionName, IntToStr(LastError), Win32ErrorString(LastError)]));
end;

function GetRegRootKeyName(const RootKey: HKEY): String;
begin
  case RootKey of
    HKEY_CLASSES_ROOT: Result := 'HKEY_CLASSES_ROOT';
    HKEY_CURRENT_USER: Result := 'HKEY_CURRENT_USER';
    HKEY_LOCAL_MACHINE: Result := 'HKEY_LOCAL_MACHINE';
    HKEY_USERS: Result := 'HKEY_USERS';
    HKEY_PERFORMANCE_DATA: Result := 'HKEY_PERFORMANCE_DATA';
    HKEY_CURRENT_CONFIG: Result := 'HKEY_CURRENT_CONFIG';
    HKEY_DYN_DATA: Result := 'HKEY_DYN_DATA';
  else
    { unknown - shouldn't get here }
    Result := Format('[%x]', [Cardinal(RootKey)]);
  end;
end;

function IntToBase32(Number: Longint): String;
const
  Table: array[0..31] of Char = '0123456789ABCDEFGHIJKLMNOPQRSTUV';
var
  I: Integer;
begin
  Result := '';
  for I := 0 to 4 do begin
    Insert(Table[Number and 31], Result, 1);
    Number := Number shr 5;
  end;
end;

function GenerateUniqueName(Path: String; const Extension: String): String;
var
  Rand, RandOrig: Longint;
begin
  Path := AddBackslash(Path);
  RandOrig := Random($2000000);
  Rand := RandOrig;
  repeat
    Inc(Rand);
    if Rand > $1FFFFFF then Rand := 0;
    if Rand = RandOrig then
      { practically impossible to go through 33 million possibilities,
        but check "just in case"... }
      raise Exception.Create(FmtSetupMessage1(msgErrorTooManyFilesInDir,
        RemoveBackslashUnlessRoot(Path)));
    { Generate a random name }
    Result := Path + 'is-' + IntToBase32(Rand) + Extension;
  until not FileOrDirExists(Result);
end;

function GenerateNonRandomUniqueFilename(Path: String; var Filename: String): Boolean;
{ Returns True if it overwrote an existing file. }
var
  Rand, RandOrig: Longint;
  F: THandle;
  Success: Boolean;
begin
  Path := AddBackslash(Path);
  RandOrig := $123456;
  Rand := RandOrig;
  Success := False;
  Result := False;
  repeat
    Inc(Rand);
    if Rand > $1FFFFFF then Rand := 0;
    if Rand = RandOrig then
      { practically impossible to go through 33 million possibilities,
        but check "just in case"... }
      raise Exception.Create(FmtSetupMessage1(msgErrorTooManyFilesInDir,
        RemoveBackslashUnlessRoot(Path)));
    { Generate a random name }
    Filename := Path + '_iu' + IntToBase32(Rand) + '.tmp';
    if DirExists(Filename) then Continue;
    Success := True;
    Result := NewFileExists(Filename);
    if Result then begin
      F := CreateFile(PChar(Filename), GENERIC_READ or GENERIC_WRITE, 0,
        nil, CREATE_ALWAYS, FILE_ATTRIBUTE_NORMAL, 0);
      Success := F <> INVALID_HANDLE_VALUE;
      if Success then CloseHandle(F);
    end;
  until Success;
end;

procedure RestartReplace(const TempFile, DestFile: String);
{ Renames TempFile to DestFile the next time Windows is started. If DestFile
  already existed, it will be overwritten. If DestFile is '' then TempFile
  will be deleted, however this is only supported by 95/98 and NT, not
  Windows 3.1x. }
var
  WinDir, WinInitFile, TempWinInitFile: String;
  OldF: TTextFileReader;
  NewF: TTextFileWriter;
  L, L2: String;
  RenameSectionFound, WriteLastLine: Boolean;
  NewDestFile: PChar;
begin
  if not UsingWinNT then begin
    { Because WININIT.INI allows multiple entries with the same name,
      it must manually parse the file instead of using
      WritePrivateProfileString }
    WinDir := GetWinDir;
    WinInitFile := AddBackslash(WinDir) + 'WININIT.INI';
    TempWinInitFile := GenerateUniqueName(WinDir, '.tmp');
    try
      OldF := nil;
      NewF := nil;
      try
        { Flush Windows' cache for the file first }
        WritePrivateProfileString(nil, nil, nil, PChar(WinInitFile));
        OldF := TTextFileReader.Create(WinInitFile, fdOpenAlways, faRead,
          fsRead);
        NewF := TTextFileWriter.Create(TempWinInitFile, fdCreateAlways,
          faWrite, fsNone);
        RenameSectionFound := False;
        WriteLastLine := False;
        while not OldF.Eof do begin
          L := OldF.ReadLine;
          WriteLastLine := True;
          L2 := Trim(L);
          if (L2 <> '') and (L2[1] = '[') then begin
            if CompareText(L2, '[rename]') = 0 then
              RenameSectionFound := True
            else
            if RenameSectionFound then
              Break;
          end;
          NewF.WriteLine(L);
          WriteLastLine := False;
        end;
        if not RenameSectionFound then
          NewF.WriteLine('[rename]');
        if DestFile <> '' then
          L2 := GetShortName(DestFile)
        else
          L2 := 'NUL';
        NewF.WriteLine(L2 + '=' + GetShortName(TempFile));
        if WriteLastLine then
          NewF.WriteLine(L);
        while not OldF.Eof do begin
          L := OldF.ReadLine;
          NewF.WriteLine(L);
        end;
      finally
        NewF.Free;
        OldF.Free;
      end;
      { Strip any read-only attribute }
      SetFileAttributes(PChar(WinInitFile), FILE_ATTRIBUTE_ARCHIVE);
      if not DeleteFile(WinInitFile) then
        Win32ErrorMsg('DeleteFile');
      if not MoveFile(PChar(TempWinInitFile), PChar(WinInitFile)) then
        Win32ErrorMsg('MoveFile');
    except
      DeleteFile(TempWinInitFile);
      raise;
    end;
  end
  else begin
    if DestFile <> '' then
      NewDestFile := PChar(DestFile)
    else
      NewDestFile := nil;
    if not MoveFileEx(PChar(TempFile), NewDestFile,
       MOVEFILE_DELAY_UNTIL_REBOOT or MOVEFILE_REPLACE_EXISTING) then
      Win32ErrorMsg('MoveFileEx');
  end;
end;

function DelTree(const Path: String; const IsDir, DeleteFiles, DeleteSubdirsAlso: Boolean;
  const DeleteDirProc: TDeleteDirProc; const DeleteFileProc: TDeleteFileProc;
  const Param: Pointer): Boolean;
{ Deletes the specified directory including all files and subdirectories in
  it (including those with hidden, system, and read-only attributes). Returns
  True if it was able to successfully remove everything. }
var
  BasePath, FindSpec: String;
  H: THandle;
  FindData: TWin32FindData;
  S: String;
begin
  Result := True;
  if DeleteFiles then begin
    if IsDir then begin
      BasePath := AddBackslash(Path);
      FindSpec := BasePath + '*';
    end
    else begin
      BasePath := PathExtractPath(Path);
      FindSpec := Path;
    end;
    H := FindFirstFile(PChar(FindSpec), FindData);
    if H <> INVALID_HANDLE_VALUE then begin
      repeat
        S := FindData.cFileName;
        if (S <> '.') and (S <> '..') then begin
          if FindData.dwFileAttributes and FILE_ATTRIBUTE_READONLY <> 0 then
            SetFileAttributes(PChar(BasePath + S), FindData.dwFileAttributes and
              not FILE_ATTRIBUTE_READONLY);
          if FindData.dwFileAttributes and FILE_ATTRIBUTE_DIRECTORY = 0 then begin
            if Assigned(DeleteFileProc) then
              DeleteFileProc(BasePath + S, Param)
            else
              Windows.DeleteFile(PChar(BasePath + S))
          end else begin
            if DeleteSubdirsAlso then
              if not DelTree(BasePath + S, True, True, True, DeleteDirProc,
                 DeleteFileProc, Param) then
                Result := False;
          end;
        end;
      until not FindNextFile(H, FindData);
      Windows.FindClose(H);
    end;
  end;
  if IsDir then begin
    if Assigned(DeleteDirProc) then begin
      if not DeleteDirProc(Path, Param) then
        Result := False;
    end
    else begin
      if not RemoveDirectory(PChar(Path)) then
        Result := False;
    end;
  end;
end;

function IsDirEmpty(const Dir: String): Boolean;
{ Returns True if Dir contains no files or subdirectories.
  Note: If Dir does not exist or lacks list permission, False will be
  returned. }
var
  H: THandle;
  FindData: TWin32FindData;
begin
  H := FindFirstFile(PChar(AddBackslash(Dir) + '*'), FindData);
  if H <> INVALID_HANDLE_VALUE then begin
    try
      Result := True;