fileclass.pas

源代码

unit FileClass;

{
  Inno Setup
  Copyright (C) 1997-2004 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.

  $jrsoftware: issrc/Projects/FileClass.pas,v 1.16 2004/07/13 23:17:05 jr Exp $
}

interface

uses
  Windows, SysUtils, Int64Em;

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

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

  TTextFileReader = class(TFile)
  private
    FBufferOffset, FBufferSize: Cardinal;
    FEof: Boolean;
    FBuffer: array[0..4095] of AnsiChar;
    function GetEof: Boolean;
    procedure FillBuffer;
  public
    function ReadLine: AnsiString;
    property Eof: Boolean read GetEof;
  end;

  TTextFileWriter = class(TFile)
  private
    FSeekedToEnd: Boolean;
  public
    constructor Create(const AFilename: String;
      ACreateDisposition: TFileCreateDisposition; AAccess: TFileAccess;
      ASharing: TFileSharing); override;
    procedure Write(const S: String);
    procedure WriteLine(const S: String);
  end;

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

implementation

uses
  CmnFunc2;

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

{ TFile }

constructor TFile.Create(const AFilename: String;
  ACreateDisposition: TFileCreateDisposition; AAccess: TFileAccess;
  ASharing: TFileSharing);
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
  inherited Create;
  FHandle := CreateFile(PChar(AFilename), AccessFlags[AAccess],
    SharingFlags[ASharing], nil, Disps[ACreateDisposition],
    FILE_ATTRIBUTE_NORMAL, 0);
  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.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.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 TFile.RaiseLastError;
var
  ErrorCode: DWORD;
  S: String;
  E: EFileError;
begin
  ErrorCode := GetLastError;
  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;

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.ReadBuffer(var Buffer; Count: Cardinal);
begin
  if Read(Buffer, Count) <> Count then begin
    { Raise localized "Reached end of file" error }
    SetLastError(ERROR_HANDLE_EOF);
    RaiseLastError;
  end;
end;

procedure TFile.Seek(Offset: Cardinal);
var
  I: Integer64;
begin
  I.Hi := 0;
  I.Lo := Offset;
  Seek64(I);
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. }
    SetLastError(ERROR_WRITE_FAULT);
    RaiseLastError;
  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: 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 }
        SetLastError(ERROR_HANDLE_EOF);
        RaiseLastError;
      end;
      Break;
    end;

    I := FBufferOffset;
    while I < FBufferSize do begin
      if FBuffer[I] in [#10, #13] then
        Break;
      Inc(I);
    end;
    L := Length(S);
    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;

  Result := S;
end;

{ TTextFileWriter }

constructor TTextFileWriter.Create(const AFilename: String;
  ACreateDisposition: TFileCreateDisposition; AAccess: TFileAccess;
  ASharing: TFileSharing);
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;
  inherited;
end;

procedure TTextFileWriter.Write(const S: String);
{ Writes a string to the file, seeking to the end first if necessary }
const
  CRLF: array[0..1] of AnsiChar = (#13, #10);
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;
    end;
    FSeekedToEnd := True;
  end;
  WriteBuffer(Pointer(S)^, Length(S));
end;

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

end.