innosetup/Projects/FileClass.pas

unit FileClass;

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

  TFile class
  Better than File and TFileStream in that does more extensive error checking
  and uses descriptive, localized system error messages.

  TTextFileReader and TTextFileWriter support ANSI and UTF8 textfiles only.

  $jrsoftware: issrc/Projects/FileClass.pas,v 1.31 2010/01/26 06:26:18 jr Exp $
}

{$I VERSION.INC}

{$IFDEF IS_D6}
{$WARN SYMBOL_PLATFORM OFF}
{$ENDIF}

interface

uses
  Windows, SysUtils, Int64Em;

type
  TFileCreateDisposition = (fdCreateAlways, fdCreateNew, fdOpenExisting,
    fdOpenAlways, fdTruncateExisting);
  TFileAccess = (faRead, faWrite, faReadWrite);
  TFileSharing = (fsNone, fsRead, fsWrite, fsReadWrite);

  TCustomFile = class
  private
    function GetCappedSize: Cardinal;
  protected
    function GetPosition: Integer64; virtual; abstract;
    function GetSize: Integer64; virtual; abstract;
  public
    class procedure RaiseError(ErrorCode: DWORD);
    class procedure RaiseLastError;
    function Read(var Buffer; Count: Cardinal): Cardinal; virtual; abstract;
    procedure ReadBuffer(var Buffer; Count: Cardinal);
    procedure Seek(Offset: Cardinal);
    procedure Seek64(Offset: Integer64); virtual; abstract;
    procedure WriteAnsiString(const S: AnsiString);
    procedure WriteBuffer(const Buffer; Count: Cardinal); virtual; abstract;
    property CappedSize: Cardinal read GetCappedSize;
    property Position: Integer64 read GetPosition;
    property Size: Integer64 read GetSize;
  end;

  TFile = class(TCustomFile)
  private
    FHandle: THandle;
    FHandleCreated: Boolean;
  protected
    function CreateHandle(const AFilename: String;
      ACreateDisposition: TFileCreateDisposition; AAccess: TFileAccess;
      ASharing: TFileSharing): THandle; virtual;
    function GetPosition: Integer64; override;
    function GetSize: Integer64; override;
  public
    constructor Create(const AFilename: String;
      ACreateDisposition: TFileCreateDisposition; AAccess: TFileAccess;
      ASharing: TFileSharing);
    constructor CreateWithExistingHandle(const AHandle: THandle);
    destructor Destroy; override;
    function Read(var Buffer; Count: Cardinal): Cardinal; override;
    procedure Seek64(Offset: Integer64); override;
    procedure SeekToEnd;
    procedure Truncate;
    procedure WriteBuffer(const Buffer; Count: Cardinal); override;
    property Handle: THandle read FHandle;
  end;

  TMemoryFile = class(TCustomFile)
  private
    FMemory: Pointer;
    FSize: Integer64;
    FPosition: Integer64;
    function ClipCount(DesiredCount: Cardinal): Cardinal;
  protected
    procedure AllocMemory(const ASize: Cardinal);
    function GetPosition: Integer64; override;
    function GetSize: Integer64; override;
  public
    constructor Create(const AFilename: String);
    constructor CreateFromMemory(const ASource; const ASize: Cardinal);
    constructor CreateFromZero(const ASize: Cardinal);
    destructor Destroy; override;
    function Read(var Buffer; Count: Cardinal): Cardinal; override;
    procedure Seek64(Offset: Integer64); override;
    procedure WriteBuffer(const Buffer; Count: Cardinal); override;
    property Memory: Pointer read FMemory;
  end;

  TTextFileReader = class(TFile)
  private
    FBufferOffset, FBufferSize: Cardinal;
    FEof: Boolean;
    FBuffer: array[0..4095] of AnsiChar;
{$IFDEF UNICODE}
    FSawFirstLine: Boolean;
    FCodePage: Cardinal;
{$ENDIF}
    function DoReadLine{$IFDEF UNICODE}(const UTF8: Boolean){$ENDIF}: AnsiString;
    function GetEof: Boolean;
    procedure FillBuffer;
  public
    function ReadLine: String;
{$IFDEF UNICODE}
    function ReadAnsiLine: AnsiString;
{$ENDIF}
    property CodePage: Cardinal write FCodePage;
    property Eof: Boolean read GetEof;
  end;

  TTextFileWriter = class(TFile)
  private
    FSeekedToEnd: Boolean;
    procedure DoWrite(const S: AnsiString{$IFDEF UNICODE}; const UTF8: Boolean{$ENDIF});
  protected
    function CreateHandle(const AFilename: String;
      ACreateDisposition: TFileCreateDisposition; AAccess: TFileAccess;
      ASharing: TFileSharing): THandle; override;
  public
    procedure Write(const S: String);
    procedure WriteLine(const S: String);
{$IFDEF UNICODE}
    procedure WriteAnsi(const S: AnsiString);
    procedure WriteAnsiLine(const S: AnsiString);
{$ENDIF}
  end;

  TFileMapping = class
  private
    FMemory: Pointer;
    FMapSize: Cardinal;
    FMappingHandle: THandle;
  public
    constructor Create(AFile: TFile; AWritable: Boolean);
    destructor Destroy; override;
    procedure Commit;
    procedure ReraiseInPageErrorAsFileException;
    property MapSize: Cardinal read FMapSize;
    property Memory: Pointer read FMemory;
  end;

  EFileError = class(Exception)
  private
    FErrorCode: DWORD;
  public
    property ErrorCode: DWORD read FErrorCode;
  end;

implementation

uses
  CmnFunc2;

const
  SGenericIOError = 'File I/O error %d';

{ TCustomFile }

function TCustomFile.GetCappedSize: Cardinal;
{ Like GetSize, but capped at $7FFFFFFF }
var
  S: Integer64;
begin
  S := GetSize;
  if (S.Hi = 0) and (S.Lo and $80000000 = 0) then
    Result := S.Lo
  else
    Result := $7FFFFFFF;
end;

class procedure TCustomFile.RaiseError(ErrorCode: DWORD);
var
  S: String;
  E: EFileError;
begin
  S := Win32ErrorString(ErrorCode);
  if S = '' then begin
    { In case there was no text for the error code. Shouldn't get here under
      normal circumstances. }
    S := Format(SGenericIOError, [ErrorCode]);
  end;
  E := EFileError.Create(S);
  E.FErrorCode := ErrorCode;
  raise E;
end;

class procedure TCustomFile.RaiseLastError;
begin
  RaiseError(GetLastError);
end;

procedure TCustomFile.ReadBuffer(var Buffer; Count: Cardinal);
begin
  if Read(Buffer, Count) <> Count then begin
    { Raise localized "Reached end of file" error }
    RaiseError(ERROR_HANDLE_EOF);
  end;
end;

procedure TCustomFile.Seek(Offset: Cardinal);
var
  I: Integer64;
begin
  I.Hi := 0;
  I.Lo := Offset;
  Seek64(I);
end;

procedure TCustomFile.WriteAnsiString(const S: AnsiString);
begin
  WriteBuffer(S[1], Length(S));
end;

{ TFile }

constructor TFile.Create(const AFilename: String;
  ACreateDisposition: TFileCreateDisposition; AAccess: TFileAccess;
  ASharing: TFileSharing);
begin
  inherited Create;
  FHandle := CreateHandle(AFilename, ACreateDisposition, AAccess, ASharing);
  if (FHandle = 0) or (FHandle = INVALID_HANDLE_VALUE) then
    RaiseLastError;
  FHandleCreated := True;
end;

constructor TFile.CreateWithExistingHandle(const AHandle: THandle);
begin
  inherited Create;
  FHandle := AHandle;
end;

destructor TFile.Destroy;
begin
  if FHandleCreated then
    CloseHandle(FHandle);
  inherited;
end;

function TFile.CreateHandle(const AFilename: String;
  ACreateDisposition: TFileCreateDisposition; AAccess: TFileAccess;
  ASharing: TFileSharing): THandle;
const
  AccessFlags: array[TFileAccess] of DWORD =
    (GENERIC_READ, GENERIC_WRITE, GENERIC_READ or GENERIC_WRITE);
  SharingFlags: array[TFileSharing] of DWORD =
    (0, FILE_SHARE_READ, FILE_SHARE_WRITE, FILE_SHARE_READ or FILE_SHARE_WRITE);
  Disps: array[TFileCreateDisposition] of DWORD =
    (CREATE_ALWAYS, CREATE_NEW, OPEN_EXISTING, OPEN_ALWAYS, TRUNCATE_EXISTING);
begin
  Result := CreateFile(PChar(AFilename), AccessFlags[AAccess],
    SharingFlags[ASharing], nil, Disps[ACreateDisposition],
    FILE_ATTRIBUTE_NORMAL, 0);
end;

function TFile.GetPosition: Integer64;
begin
  Result.Hi := 0;
  Result.Lo := SetFilePointer(FHandle, 0, @Result.Hi, FILE_CURRENT);
  if (Result.Lo = $FFFFFFFF) and (GetLastError <> 0) then
    RaiseLastError;
end;

function TFile.GetSize: Integer64;
begin
  Result.Lo := GetFileSize(FHandle, @Result.Hi);
  if (Result.Lo = $FFFFFFFF) and (GetLastError <> 0) then
    RaiseLastError;
end;

function TFile.Read(var Buffer; Count: Cardinal): Cardinal;
begin
  if not ReadFile(FHandle, Buffer, Count, DWORD(Result), nil) then
    if FHandleCreated or (GetLastError <> ERROR_BROKEN_PIPE) then
      RaiseLastError;
end;

procedure TFile.Seek64(Offset: Integer64);
begin
  if (SetFilePointer(FHandle, Integer(Offset.Lo), @Offset.Hi,
      FILE_BEGIN) = $FFFFFFFF) and (GetLastError <> 0) then
    RaiseLastError;
end;

procedure TFile.SeekToEnd;
var
  DistanceHigh: Integer;
begin
  DistanceHigh := 0;
  if (SetFilePointer(FHandle, 0, @DistanceHigh, FILE_END) = $FFFFFFFF) and
     (GetLastError <> 0) then
    RaiseLastError;
end;

procedure TFile.Truncate;
begin
  if not SetEndOfFile(FHandle) then
    RaiseLastError;
end;

procedure TFile.WriteBuffer(const Buffer; Count: Cardinal);
var
  BytesWritten: DWORD;
begin
  if not WriteFile(FHandle, Buffer, Count, BytesWritten, nil) then
    RaiseLastError;
  if BytesWritten <> Count then begin
    { I'm not aware of any case where WriteFile will return True but a short
      BytesWritten count. (An out-of-disk-space condition causes False to be
      returned.) But if that does happen, raise a generic-sounding localized
      "The system cannot write to the specified device" error. }
    RaiseError(ERROR_WRITE_FAULT);
  end;
end;

{ TMemoryFile }

constructor TMemoryFile.Create(const AFilename: String);
var
  F: TFile;
begin
  inherited Create;
  F := TFile.Create(AFilename, fdOpenExisting, faRead, fsRead);
  try
    AllocMemory(F.CappedSize);
    F.ReadBuffer(FMemory^, FSize.Lo);
  finally
    F.Free;
  end;
end;

constructor TMemoryFile.CreateFromMemory(const ASource; const ASize: Cardinal);
begin
  inherited Create;
  AllocMemory(ASize);
  Move(ASource, FMemory^, FSize.Lo);
end;

constructor TMemoryFile.CreateFromZero(const ASize: Cardinal);
begin
  inherited Create;
  AllocMemory(ASize);
  FillChar(FMemory^, FSize.Lo, 0);
end;

destructor TMemoryFile.Destroy;
begin
  if Assigned(FMemory) then
    LocalFree(HLOCAL(FMemory));
  inherited;
end;

procedure TMemoryFile.AllocMemory(const ASize: Cardinal);
begin
  FMemory := Pointer(LocalAlloc(LMEM_FIXED, ASize));
  if FMemory = nil then
    OutOfMemoryError;
  FSize.Lo := ASize;
end;

function TMemoryFile.ClipCount(DesiredCount: Cardinal): Cardinal;
var
  BytesLeft: Integer64;
begin
  { First check if FPosition is already past FSize, so the Dec6464 call below
    won't underflow }
  if Compare64(FPosition, FSize) >= 0 then begin
    Result := 0;
    Exit;
  end;
  BytesLeft := FSize;
  Dec6464(BytesLeft, FPosition);
  if (BytesLeft.Hi = 0) and (BytesLeft.Lo < DesiredCount) then
    Result := BytesLeft.Lo
  else
    Result := DesiredCount;
end;

function TMemoryFile.GetPosition: Integer64;
begin
  Result := FPosition;
end;

function TMemoryFile.GetSize: Integer64;
begin
  Result := FSize;
end;

function TMemoryFile.Read(var Buffer; Count: Cardinal): Cardinal;
begin
  Result := ClipCount(Count);
  if Result <> 0 then begin
    Move(Pointer(Cardinal(FMemory) + FPosition.Lo)^, Buffer, Result);
    Inc64(FPosition, Result);
  end;
end;

procedure TMemoryFile.Seek64(Offset: Integer64);
begin
  if Offset.Hi and $80000000 <> 0 then
    RaiseError(ERROR_NEGATIVE_SEEK);
  FPosition := Offset;
end;

procedure TMemoryFile.WriteBuffer(const Buffer; Count: Cardinal);
begin
  if ClipCount(Count) <> Count then
    RaiseError(ERROR_HANDLE_EOF);
  if Count <> 0 then begin
    Move(Buffer, Pointer(Cardinal(FMemory) + FPosition.Lo)^, Count);
    Inc64(FPosition, Count);
  end;
end;

{ TTextFileReader }

procedure TTextFileReader.FillBuffer;
begin
  if (FBufferOffset < FBufferSize) or FEof then
    Exit;
  FBufferSize := Read(FBuffer, SizeOf(FBuffer));
  FBufferOffset := 0;
  if FBufferSize = 0 then
    FEof := True;
end;

function TTextFileReader.GetEof: Boolean;
begin
  FillBuffer;
  Result := FEof;
end;

function TTextFileReader.ReadLine: String;
{$IFDEF UNICODE}
var
 S: RawByteString;
{$ENDIF}
begin
{$IFDEF UNICODE}
 S := DoReadLine(True);
 if FCodePage <> 0 then
   SetCodePage(S, FCodePage, False);
 Result := String(S);
{$ELSE}
 Result := DoReadLine;
{$ENDIF}
end; 

{$IFDEF UNICODE}
function TTextFileReader.ReadAnsiLine: AnsiString;
begin
  Result := DoReadLine(False);
end;
{$ENDIF}

function TTextFileReader.DoReadLine{$IFDEF UNICODE}(const UTF8: Boolean){$ENDIF}: AnsiString;
var
  I, L: Cardinal;
  S: AnsiString;
begin
  while True do begin
    FillBuffer;
    if FEof then begin
      { End of file reached }
      if S = '' then begin
        { If nothing was read (i.e. we were already at EOF), raise localized
          "Reached end of file" error }
        RaiseError(ERROR_HANDLE_EOF);
      end;
      Break;
    end;

    I := FBufferOffset;
    while I < FBufferSize do begin
      if FBuffer[I] in [#10, #13] then
        Break;
      Inc(I);
    end;
    L := Length(S);
    if Integer(L + (I - FBufferOffset)) < 0 then
      OutOfMemoryError;
    SetLength(S, L + (I - FBufferOffset));
    Move(FBuffer[FBufferOffset], S[L+1], I - FBufferOffset);
    FBufferOffset := I;

    if FBufferOffset < FBufferSize then begin
      { End of line reached }
      Inc(FBufferOffset);
      if FBuffer[FBufferOffset-1] = #13 then begin
        { Skip #10 if it follows #13 }
        FillBuffer;
        if (FBufferOffset < FBufferSize) and (FBuffer[FBufferOffset] = #10) then
          Inc(FBufferOffset);
      end;
      Break;
    end;
  end;
  {$IFDEF UNICODE}
  if not FSawFirstLine then begin
    { Handle UTF8 BOM if requested }
    if UTF8 and (Length(S) > 2) and (S[1] = #$EF) and (S[2] = #$BB) and (S[3] = #$BF) then begin
      Delete(S, 1, 3);
      FCodePage := CP_UTF8;
    end;
    FSawFirstLine := True;
  end;
  {$ENDIF}
  Result := S;
end;

{ TTextFileWriter }

function TTextFileWriter.CreateHandle(const AFilename: String;
  ACreateDisposition: TFileCreateDisposition; AAccess: TFileAccess;
  ASharing: TFileSharing): THandle;
begin
  { faWrite access isn't enough; we need faReadWrite access since the Write
    method may read. No, we don't have to do this automatically, but it helps
    keep it from being a 'leaky abstraction'. }
  if AAccess = faWrite then
    AAccess := faReadWrite;
  Result := inherited CreateHandle(AFilename, ACreateDisposition, AAccess,
    ASharing);
end;

{$IFDEF UNICODE}
procedure TTextFileWriter.DoWrite(const S: AnsiString; const UTF8: Boolean);
{$ELSE}
procedure TTextFileWriter.DoWrite(const S: String);
{$ENDIF}
{ Writes a string to the file, seeking to the end first if necessary }
const
  CRLF: array[0..1] of AnsiChar = (#13, #10);
{$IFDEF UNICODE}
  UTF8Preamble: array[0..2] of AnsiChar = (#$EF, #$BB, #$BF);
{$ENDIF}
var
  I: Integer64;
  C: AnsiChar;
begin
  if not FSeekedToEnd then begin
    I := GetSize;
    if (I.Lo <> 0) or (I.Hi <> 0) then begin
      { File is not empty. Figure out if we have to append a line break. }
      Dec64(I, SizeOf(C));
      Seek64(I);
      ReadBuffer(C, SizeOf(C));
      case C of
        #10: ;  { do nothing - file ends in LF or CRLF }
        #13: begin
            { If the file ends in CR, make it into CRLF }
            C := #10;
            WriteBuffer(C, SizeOf(C));
          end;
      else
        { Otherwise, append CRLF }
        WriteBuffer(CRLF, SizeOf(CRLF));
      end;
{$IFDEF UNICODE}
    end else if UTF8 then
      WriteBuffer(UTF8Preamble, SizeOf(UTF8Preamble));
{$ELSE}
    end;
{$ENDIF}
    FSeekedToEnd := True;
  end;
  WriteBuffer(Pointer(S)^, Length(S));
end;

procedure TTextFileWriter.Write(const S: String);
begin
{$IFDEF UNICODE}
  DoWrite(UTF8Encode(S), True);
{$ELSE}
  DoWrite(S);
{$ENDIF}
end;

procedure TTextFileWriter.WriteLine(const S: String);
begin
  Write(S + #13#10);
end;

{$IFDEF UNICODE}
procedure TTextFileWriter.WriteAnsi(const S: AnsiString);
begin
  DoWrite(S, False);
end;

procedure TTextFileWriter.WriteAnsiLine(const S: AnsiString);
begin
  WriteAnsi(S + #13#10);
end;
{$ENDIF}

{ TFileMapping }

type
  NTSTATUS = Longint;
var
  _RtlNtStatusToDosError: function(Status: NTSTATUS): ULONG; stdcall;

constructor TFileMapping.Create(AFile: TFile; AWritable: Boolean);
const
  Protect: array[Boolean] of DWORD = (PAGE_READONLY, PAGE_READWRITE);
  DesiredAccess: array[Boolean] of DWORD = (FILE_MAP_READ, FILE_MAP_WRITE);
begin
  inherited Create;

  { Dynamically import RtlNtStatusToDosError since Windows 95 doesn't have it }
  if not Assigned(_RtlNtStatusToDosError) and
     (Win32Platform = VER_PLATFORM_WIN32_NT) then
    _RtlNtStatusToDosError := GetProcAddress(GetModuleHandle('ntdll.dll'),
      'RtlNtStatusToDosError');

  FMapSize := AFile.CappedSize;

  FMappingHandle := CreateFileMapping(AFile.Handle, nil, Protect[AWritable], 0,
    FMapSize, nil);
  if FMappingHandle = 0 then
    TFile.RaiseLastError;

  FMemory := MapViewOfFile(FMappingHandle, DesiredAccess[AWritable], 0, 0,
    FMapSize);
  if FMemory = nil then
    TFile.RaiseLastError;
end;

destructor TFileMapping.Destroy;
begin
  if Assigned(FMemory) then
    UnmapViewOfFile(FMemory);
  if FMappingHandle <> 0 then
    CloseHandle(FMappingHandle);
  inherited;
end;

procedure TFileMapping.Commit;
{ Flushes modified pages to disk. To avoid silent data loss, this should
  always be called prior to destroying a writable TFileMapping instance -- but
  _not_ from a 'finally' section, as this method will raise an exception on
  failure. }
begin
  if not FlushViewOfFile(FMemory, 0) then
    TFile.RaiseLastError;
end;

procedure TFileMapping.ReraiseInPageErrorAsFileException;
{ In Delphi, when an I/O error occurs while accessing a memory-mapped file --
  known as an "inpage error" -- the user will see an exception message of
  "External exception C0000006" by default.
  This method examines the current exception to see if it's an inpage error
  that occurred while accessing our mapped view, and if so, it raises a new
  exception of type EFileError with a more friendly and useful message, like
  you'd see when doing non-memory-mapped I/O with TFile. }
var
  E: TObject;
begin
  E := ExceptObject;
  if (E is EExternalException) and
     (EExternalException(E).ExceptionRecord.ExceptionCode = EXCEPTION_IN_PAGE_ERROR) and
     (Cardinal(EExternalException(E).ExceptionRecord.NumberParameters) >= Cardinal(2)) and
     (Cardinal(EExternalException(E).ExceptionRecord.ExceptionInformation[1]) >= Cardinal(FMemory)) and
     (Cardinal(EExternalException(E).ExceptionRecord.ExceptionInformation[1]) < Cardinal(Cardinal(FMemory) + FMapSize)) then begin
    { NT has a third parameter containing the NT status code of the error
      condition that caused the exception. Convert that into a Win32 error code
      and use it to generate our error message. }
    if (Cardinal(EExternalException(E).ExceptionRecord.NumberParameters) >= Cardinal(3)) and
       Assigned(_RtlNtStatusToDosError) then
      TFile.RaiseError(_RtlNtStatusToDosError(EExternalException(E).ExceptionRecord.ExceptionInformation[2]))
    else begin
      { Windows 9x/Me doesn't have a third parameter, and 95 doesn't have
        RtlNtStatusToDosError, so use generic "The system cannot [read|write]
        to the specified device" errors }
      if EExternalException(E).ExceptionRecord.ExceptionInformation[0] = 0 then
        TFile.RaiseError(ERROR_READ_FAULT)
      else
        TFile.RaiseError(ERROR_WRITE_FAULT);
    end;
  end;
end;

end.