(******************************************************************************

Copyright (c) 2022+ Pepak (https://www.pepak.net)
All rights reserved.

Redistribution and use in source and binary forms, with or without
modification, are permitted provided that the following conditions are met:
    * Redistributions of source code must retain the above copyright
      notice, this list of conditions and the following disclaimer.
    * Redistributions in binary form must reproduce the above copyright
      notice, this list of conditions and the following disclaimer in the
      documentation and/or other materials provided with the distribution.
    * Neither the name of Pepak nor the
      names of his contributors may be used to endorse or promote products
      derived from this software without specific prior written permission.

THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND
ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
DISCLAIMED. IN NO EVENT SHALL PEPAK BE LIABLE FOR ANY
DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES
(INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND
ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

******************************************************************************)

unit uTextFiles;

interface

uses
  Windows, SysUtils, Classes, uCompatibility;

type
  ETextFileError = class(Exception);
  TTextFileEncoding = (tfeAuto, tfeANSI, tfeUTF16, tfeUTF8);
  TTextFileReader = class
  private
    FStream: TStream;
    FStreamOwned: boolean;
    FStreamStartPosition: UInt64;
    FEncoding: TTextFileEncoding;
    FRawBuffer: PByte;
    FRawBufferCapacity: NativeUInt;
    FWideBuffer: PWideChar;
    FWideBufferCapacity: NativeUInt;
    {$IFNDEF UNICODE}
    FAnsiBuffer: PAnsiChar;
    FAnsiBufferCapacity: NativeUInt;
    {$ENDIF}
    FNativeBufferCurrent: PChar;
    FNativeBufferEnd: PChar;
    procedure AllocateBuffer(var Buffer: Pointer; var Capacity: NativeUInt; const DesiredCapacity: NativeUInt);
    procedure FreeBuffer(var Buffer: Pointer; var Capacity: NativeUInt);
    function CutOffIncompleteCharacter(const Buffer: PByte; var BufferEnd: PByte): NativeUInt;
    procedure DetectEncoding(var Buffer: PByte; BufferSize: integer);
    procedure LoadBufferFromStream(First: boolean);
    procedure LoadBufferFromStreamIfNeeded;
    procedure SetEncoding(const Value: TTextFileEncoding);
    function GetSize: int64;
  protected
  public
    constructor Create(const FileName: string); overload;
    constructor Create(const FileName: string; const Mode: Word); overload;
    constructor Create(Stream: TStream; StreamOwned: boolean = True); overload;
    destructor Destroy; override;
    property Encoding: TTextFileEncoding read FEncoding write SetEncoding;
    procedure Reset;
    function Eof: boolean;
    function Read(out Chr: Char): boolean;
    function ReadLine(out Line: string): boolean;
    property Size: int64 read GetSize;
  end;

implementation

resourcestring
  ERROR_NoBuffer = 'Buffer is not set';
  ERROR_FailedToAllocateBuffer = 'Failed to allocate buffer';
  ERROR_CannotRead = 'Can''t read from a write stream';
  ERROR_CannotSetEncoding = 'Can''t set encoding now';
  ERROR_ConversionFailed = 'Conversion failed';
  ERROR_UnknownEncoding = 'Unknown encoding';

const
  RawBufferSize = 64*1024; //16*1024*1024;
    // Must be at least 16 bytes to fit two of largest full UTF8 characters
    // Doesn't seem to have much effect past 64 K

{$IFDEF UNICODE}
  {$WARNINGS OFF}
  {$IF RawBufferSize < 16}
    {$MESSAGE ERROR 'RawBufferSize too small to work properly.'}
  {$IFEND}
  {$WARNINGS ON}
{$ENDIF}

{ TTextFileReader }

procedure TTextFileReader.AllocateBuffer(var Buffer: Pointer; var Capacity: NativeUInt; const DesiredCapacity: NativeUInt);
begin
  Buffer := AllocMem(DesiredCapacity);
  Capacity := DesiredCapacity;
end;

constructor TTextFileReader.Create(const FileName: string);
begin
  Create(FileName, fmOpenRead);
end;

constructor TTextFileReader.Create(const FileName: string; const Mode: Word);
begin
  Create(TFileStream.Create(FileName, Mode), True);
end;

constructor TTextFileReader.Create(Stream: TStream; StreamOwned: boolean);
begin
  inherited Create;
  FStream := Stream;
  FStreamOwned := StreamOwned;
  FStreamStartPosition := FStream.Position;
  FEncoding := tfeAuto;
  AllocateBuffer(Pointer(FRawBuffer), FRawBufferCapacity, RawBufferSize);
  AllocateBuffer(Pointer(FWideBuffer), FWideBufferCapacity, Sizeof(WideChar) * FRawBufferCapacity);
  {$IFNDEF UNICODE}
  AllocateBuffer(Pointer(FAnsiBuffer), FAnsiBufferCapacity, Sizeof(AnsiChar) * FRawBufferCapacity);
  {$ENDIF}
  Reset;
end;

function TTextFileReader.CutOffIncompleteCharacter(const Buffer: PByte; var BufferEnd: PByte): NativeUInt;
begin
  Result := 0;
  case Encoding of
    tfeAuto:
      ; // can't do anything
    tfeANSI:
      ; // not cutting needed
    tfeUTF16:
      if Odd(NativeUInt(BufferEnd) - NativeUInt(Buffer)) then
      begin
        Dec(BufferEnd);
        Inc(Result);
      end;
    tfeUTF8:
      while {$IFDEF UNICODE} BufferEnd > Buffer {$ELSE} NativeUInt(BufferEnd) > NativeUInt(Buffer) {$ENDIF} do
      begin
        Dec(BufferEnd);
        if (BufferEnd^ and $80) = 0 then
        begin
          // This is a single-byte character, keep it
          Inc(BufferEnd);
          Break;
        end;
        Inc(Result);
        if (BufferEnd^ and $c0) <> $80 then
        begin
          // This is the first of multiple characters, skip it, but keep the rest
          Break;
        end;
      end;
  end;
end;

destructor TTextFileReader.Destroy;
begin
  FreeBuffer(Pointer(FRawBuffer), FRawBufferCapacity);
  FreeBuffer(Pointer(FWideBuffer), FWideBufferCapacity);
  {$IFNDEF UNICODE}
  FreeBuffer(Pointer(FAnsiBuffer), FAnsiBufferCapacity);
  {$ENDIF}
  if FStreamOwned then
    FreeAndNil(FStream);
  inherited;
end;

procedure TTextFileReader.DetectEncoding(var Buffer: PByte; BufferSize: integer);
type
  PCharArray = ^TCharArray;
  TCharArray = array[0..2] of AnsiChar;
var
  BOM: PCharArray;
begin
  BOM := PCharArray(Buffer);
  if (BufferSize >= 3) and (BOM[0] = #$ef) and (BOM[1] = #$bb) and (BOM[2] = #$bf) then
  begin
    FEncoding := tfeUTF8;
    Inc(Buffer, 3);
  end
  else if (BufferSize >= 2) and (BOM[0] = #$ff) and (BOM[1] = #$fe) then
  begin
    FEncoding := tfeUTF16;
    Inc(Buffer, 2);
  end
  else
  begin
    FEncoding := tfeANSI;
  end;
end;

function TTextFileReader.Eof: boolean;
begin
  LoadBufferFromStreamIfNeeded;
  Result := (FNativeBufferCurrent = nil) or (FNativeBufferCurrent >= FNativeBufferEnd);
end;

procedure TTextFileReader.FreeBuffer(var Buffer: Pointer; var Capacity: NativeUInt);
begin
  Capacity := 0;
  if Buffer <> nil then
  begin
    FreeMem(Buffer);
    Buffer := nil;
  end;
end;

function TTextFileReader.GetSize: int64;
begin
  Result := FStream.Size;
end;

procedure TTextFileReader.LoadBufferFromStream(First: boolean);
var
  BytesRead: NativeUInt;
  ValidBuffer, ValidBufferEnd: PByte;
  ValidBufferLength: NativeUInt;
  CodePage: integer;
  WideLength: NativeUInt;
  {$IFNDEF UNICODE}
  AnsiLength: NativeUint;
  {$ENDIF}
  InvalidByteCount: NativeUInt;
begin
  // Load the raw contents of the stream
  BytesRead := FStream.Read(FRawBuffer^, FRawBufferCapacity);
  ValidBuffer := FRawBuffer;
  ValidBufferEnd := ValidBuffer;
  Inc(ValidBufferEnd, BytesRead);
  // If at the beginning of the file, detect the encoding
  if First and (FEncoding = tfeAuto) then
    DetectEncoding(ValidBuffer, BytesRead);
  // Remove a possible incomplete character at the end
  InvalidByteCount := CutOffIncompleteCharacter(ValidBuffer, ValidBufferEnd);
  if InvalidByteCount > 0 then
    FStream.Position := FStream.Position - InvalidByteCount;
  // Convert the raw data to native data
  ValidBufferLength := {$IFDEF UNICODE} ValidBufferEnd - ValidBuffer {$ELSE} NativeUInt(ValidBufferEnd) - NativeUInt(ValidBuffer) {$ENDIF} ;
  case Encoding of
    tfeUTF16:
      begin
        WideLength := ValidBufferLength;
        if WideLength > FWideBufferCapacity then
          WideLength := FWideBufferCapacity;
        WideLength := WideLength div Sizeof(WideChar);
        Move(ValidBuffer^, FWideBuffer^, WideLength * Sizeof(Char));
      end;
    else
      begin
        case Encoding of
          tfeANSI:
            CodePage := CP_ACP;
          tfeUTF16:
            CodePage := 1200; // Does not work in native applications
          tfeUTF8:
            CodePage := CP_UTF8;
          else
            CodePage := CP_ACP;
        end;
        WideLength := MultiByteToWideChar(CodePage, 0 (*8 {MB_ERR_INVALID_CHARS}*), PAnsiChar(ValidBuffer), ValidBufferLength, FWideBuffer, FWideBufferCapacity div Sizeof(WideChar));
      end;
  end;
  {$IFDEF UNICODE}
  FNativeBufferCurrent := FWideBuffer;
  FNativeBufferEnd := FNativeBufferCurrent;
  Inc(FNativeBufferEnd, WideLength);
  {$ELSE}
  AnsiLength := WideCharToMultiByte(CP_ACP, 0, FWideBuffer, WideLength, FAnsiBuffer, FAnsiBufferCapacity, nil, nil);
  FNativeBufferCurrent := FAnsiBuffer;
  FNativeBufferEnd := FNativeBufferCurrent;
  Inc(FNativeBufferEnd, AnsiLength);
  {$ENDIF}
end;

procedure TTextFileReader.LoadBufferFromStreamIfNeeded;
begin
  if FNativeBufferCurrent < FNativeBufferEnd then
    Exit;
  LoadBufferFromStream(FStream.Position = FStreamStartPosition);
end;

function TTextFileReader.Read(out Chr: Char): boolean;
begin
  Result := False;
  LoadBufferFromStreamIfNeeded;
  if FNativeBufferCurrent < FNativeBufferEnd then
  begin
    Chr := FNativeBufferCurrent^;
    Inc(FNativeBufferCurrent);
    Result := True;
  end;
end;

function TTextFileReader.ReadLine(out Line: string): boolean;
var
  LineStart: PChar;
  LineLength: NativeUInt;
  LinePart: string;
  CheckForLF: boolean;
begin
  LoadBufferFromStreamIfNeeded;
  Result := not Eof;
  if not Result then
    Exit;
  Line := '';
  repeat
    LineStart := FNativeBufferCurrent;
    LineLength := 0;
    while FNativeBufferCurrent < FNativeBufferEnd do
    begin
      case FNativeBufferCurrent^ of
        #13, #10:
          begin
            SetString(LinePart, LineStart, LineLength);
            Line := Line + LinePart;
            CheckForLF := (FNativeBufferCurrent^ = #13);
            Inc(FNativeBufferCurrent);
            if CheckForLF then
            begin
              LoadBufferFromStreamIfNeeded;
              if (FNativeBufferCurrent < FNativeBufferEnd) and (FNativeBufferCurrent^ = #10) then
                Inc(FNativeBufferCurrent);
            end;
            Exit;
          end
        else
          begin
            Inc(FNativeBufferCurrent);
            Inc(LineLength);
          end;
      end;
    end;
    SetString(LinePart, LineStart, LineLength);
    Line := Line + LinePart;
    LoadBufferFromStreamIfNeeded;
  until False;
end;

procedure TTextFileReader.Reset;
begin
  FStream.Position := FStreamStartPosition;
  FNativeBufferCurrent := nil;
  FNativeBufferEnd := nil;
end;

procedure TTextFileReader.SetEncoding(const Value: TTextFileEncoding);
begin
  if FStream.Position <> FStreamStartPosition then
    raise ETextFileError.Create(ERROR_CannotSetEncoding);
  FEncoding := Value;
end;

end.
