tpsystools_4.04/source/StStrms.pas

// Upgraded to Delphi 2009: Sebastian Zierer

(* ***** BEGIN LICENSE BLOCK *****
 * Version: MPL 1.1
 *
 * The contents of this file are subject to the Mozilla Public License Version
 * 1.1 (the "License"); you may not use this file except in compliance with
 * the License. You may obtain a copy of the License at
 * http://www.mozilla.org/MPL/
 *
 * Software distributed under the License is distributed on an "AS IS" basis,
 * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License
 * for the specific language governing rights and limitations under the
 * License.
 *
 * The Original Code is TurboPower SysTools
 *
 * The Initial Developer of the Original Code is
 * TurboPower Software
 *
 * Portions created by the Initial Developer are Copyright (C) 1996-2002
 * the Initial Developer. All Rights Reserved.
 *
 * Contributor(s):
 *
 * ***** END LICENSE BLOCK ***** *)

{*********************************************************}
{* SysTools: StStrms.pas 4.04                            *}
{*********************************************************}
{* SysTools: Specialized Stream Classes for SysTools     *}
{*********************************************************}

{$I StDefine.inc}

unit StStrms;

interface

uses
  Windows,
  SysUtils,
  Classes,

  StBase,
  StConst;

type
  TStMemSize = Integer;

  TStBufferedStream = class(TStream)
    private
      FBufCount: TStMemSize;   {count of valid bytes in buffer}
      FBuffer  : PAnsiChar;    {buffer into underlying stream}
      FBufOfs  : longint;      {offset of buffer in underlying stream}
      FBufPos  : TStMemSize;   {current position in buffer}
      FBufSize : TStMemSize;   {size of buffer}
      FDirty   : boolean;      {has data in buffer been changed?}
      FSize    : Int64;      {size of underlying stream}
      FStream  : TStream;      {underlying stream}
      {$IFNDEF VERSION3}
      FOnSetStreamSize : TStSetStreamSize;
                               {event to set underlying stream's size}
      {$ENDIF}
    protected
      procedure bsSetStream(aValue : TStream);

      procedure bsInitForNewStream; virtual;
      function bsReadChar(var aCh : AnsiChar) : boolean;
      procedure bsReadFromStream;
      procedure bsWriteToStream;

      {$IFDEF VERSION3}
      procedure SetSize(NewSize : longint); override;
      {$ENDIF}
    public
      constructor Create(aStream : TStream);
      constructor CreateEmpty;
      destructor Destroy; override;

      function Read(var Buffer; Count : longint) : longint; override;
      function Seek(Offset : longint; Origin : word) : longint; override;
      function Write(const Buffer; Count : longint) : longint; override;
      {$IFNDEF VERSION3}
      procedure SetSize(NewSize : longint);
      {$ENDIF}

      property FastSize : Int64 read FSize;
      property Stream : TStream read FStream write bsSetStream;

      {$IFNDEF VERSION3}
      property OnSetStreamSize : TStSetStreamSize
                 read FOnSetStreamSize write FOnSetStreamSize;
      {$ENDIF}
   end;

type
{!!.01 - moved to StBase.pas }
(*
  TStLineTerminator = ( {possible line terminators...}
     ltNone,            {..no terminator, ie fixed length lines}
     ltCR,              {..carriage return (#13)}
     ltLF,              {..line feed (#10)}
     ltCRLF,            {..carriage return/line feed (#13/#10)}
     ltOther);          {..another character}
*)
{!!.01 - end moved }


  // TODO-UNICODE: add TStUnicodeTextStream

  TStAnsiTextStream = class(TStBufferedStream)
    private
      FLineEndCh   : AnsiChar;
      FLineLen     : integer;
      FLineTerm    : TStLineTerminator;
      FFixedLine   : PAnsiChar;
      FLineCount   : longint;
      FLineCurrent : longint;
      FLineCurOfs  : longint;
      FLineIndex   : TList;
      FLineInxStep : longint;
      FLineInxTop  : integer;
    protected
      function atsGetLineCount : longint;

      procedure atsSetLineTerm(aValue : TStLineTerminator);
      procedure atsSetLineEndCh(aValue : AnsiChar);
      procedure atsSetLineLen(aValue : integer);

      procedure atsGetLine(var aStartPos : longint;
                           var aEndPos   : longint;
                           var aLen      : longint);
      procedure atsResetLineIndex;

      procedure bsInitForNewStream; override;
    public
      constructor Create(aStream : TStream);
      destructor Destroy; override;

      function AtEndOfStream : boolean;

      function ReadLine : AnsiString;
      function ReadLineArray(aCharArray : PAnsiChar; aLen : TStMemSize)
                                                          : TStMemSize;
      function ReadLineZ(aSt : PAnsiChar; aMaxLen : TStMemSize) : PAnsiChar;

      function SeekNearestLine(aOffset : longint) : longint;
      function SeekLine(aLineNum : longint) : longint;

      procedure WriteLine(const aSt : AnsiString);
      procedure WriteLineArray(aCharArray : PAnsiChar; aLen : TStMemSize);
      procedure WriteLineZ(aSt : PAnsiChar);

      property FixedLineLength : integer
                  read FLineLen write atsSetLineLen;
      property LineCount : longint
                  read atsGetLineCount;
      property LineTermChar : AnsiChar
                  read FLineEndCh write atsSetLineEndCh;
      property LineTerminator : TStLineTerminator
                  read FLineTerm write atsSetLineTerm;
  end;

  TStMemoryMappedFile = class(TStream)
  protected {private}
    FBuffer     : Pointer;
    FHeaderSize : Word;
    FDataSize   : Cardinal;
    FHandle     : THandle;
    FMapObj     : THandle;
    FMaxHi      : Cardinal;
    FMaxLo      : Cardinal;
    FMutex      : THandle;
    FPos        : Cardinal;
    FReadOnly   : Boolean;
    FSharedData : Boolean;

  protected
    function GetDataSize : Cardinal;

  public
    constructor Create(const FileName   : string;                      {!!.02}
                             MaxSize    : Cardinal;
                             ReadOnly   : Boolean;
                             SharedData : Boolean);
    destructor Destroy; override;

    function Read(var Buffer; Count : Longint) : Longint; override;
    function Seek(Offset : Longint; Origin : Word) : Longint; override;
    function Write(const Buffer; Count : Longint) : Longint; override;

    property DataSize : Cardinal
      read GetDataSize;

    property MaxSize : Cardinal
      read FMaxLo;

    property Position : Cardinal
      read FPos;

    property ReadOnly : Boolean
      read FReadOnly;

    property SharedData : Boolean
      read FSharedData;
  end;

implementation

const
  LineTerm : array [TStLineTerminator] of
               array [0..1] of AnsiChar =
                 ('', #13, #10, #13#10, '');

const
  LineIndexCount = 1024;
  LineIndexMax   = pred(LineIndexCount);


{--- Helper routines ---------------------------------------------------------}

function MinLong(A, B : longint) : longint;
begin
  if A < B then
    Result := A
  else
    Result := B;
end;


{-----------------------------------------------------------------------------}
{                          TStBufferedStream                                  }
{-----------------------------------------------------------------------------}

constructor TStBufferedStream.Create(aStream : TStream);
begin
  inherited Create;

  {allocate the buffer}
  FBufSize := 4096;
  GetMem(FBuffer, FBufSize);

  {save the stream}
  if (aStream = nil) then
    RaiseStError(EStBufStreamError, stscNilStream);
  FStream := aStream;

  bsInitForNewStream;
end;

{-----------------------------------------------------------------------------}

constructor TStBufferedStream.CreateEmpty;
begin
  inherited Create;

  {allocate the buffer}
  FBufSize := 4096;
  GetMem(FBuffer, FBufSize);

  bsInitForNewStream
end;

{-----------------------------------------------------------------------------}

destructor TStBufferedStream.Destroy;
begin
  if (FBuffer <> nil) then begin
    if FDirty and (FStream <> nil) then
      bsWriteToStream;
    FreeMem(FBuffer, FBufSize);
  end;

  inherited Destroy;
end;

{-----------------------------------------------------------------------------}

procedure TStBufferedStream.bsInitForNewStream;
begin
  if (FStream <> nil) then
    FSize := FStream.Size
  else
    FSize := 0;
  FBufCount := 0;
  FBufOfs := 0;
  FBufPos := 0;
  FDirty := false;
end;

{-----------------------------------------------------------------------------}

function TStBufferedStream.bsReadChar(var aCh : AnsiChar) : boolean;
begin
  {is there anything to read?}
  if (FSize = (FBufOfs + FBufPos)) then begin
    Result := false;
    Exit;
  end;
  {if we get here, we'll definitely read a character}
  Result := true;
  {make sure that the buffer has some data in it}
  if (FBufCount = 0) then
    bsReadFromStream
  else if (FBufPos = FBufCount) then begin
    if FDirty then
      bsWriteToStream;
    FBufPos := 0;
    inc(FBufOfs, FBufSize);
    bsReadFromStream;
  end;
  {get the next character}
  aCh := AnsiChar(FBuffer[FBufPos]);
  inc(FBufPos);
end;

{-----------------------------------------------------------------------------}

procedure TStBufferedStream.bsReadFromStream;
var
  NewPos : longint;
begin
  {assumptions: FBufOfs is where to read the buffer
                FBufSize is the number of bytes to read
                FBufCount will be the number of bytes read}
  NewPos := FStream.Seek(FBufOfs, soFromBeginning);
  if (NewPos <> FBufOfs) then
    RaiseStError(EStBufStreamError, stscNoSeekForRead);
  FBufCount := FStream.Read(FBuffer^, FBufSize);
end;

{-----------------------------------------------------------------------------}

procedure TStBufferedStream.bsSetStream(aValue : TStream);
begin
  if (aValue <> FStream) then begin
    {if the buffer is dirty, flush it to the current stream}
    if FDirty and (FStream <> nil) then
      bsWriteToStream;
    {remember the stream and initialize all fields}
    FStream := aValue;
    bsInitForNewStream;
  end;
end;

{-----------------------------------------------------------------------------}

procedure TStBufferedStream.bsWriteToStream;
var
  NewPos       : longint;
  BytesWritten : longint;
begin
  {assumptions: FDirty is true
                FBufOfs is where to write the buffer
                FBufCount is the number of bytes to write
                FDirty will be set false afterwards}
  NewPos := FStream.Seek(FBufOfs, soFromBeginning);
  if (NewPos <> FBufOfs) then
    RaiseStError(EStBufStreamError, stscNoSeekForWrite);
  BytesWritten := FStream.Write(FBuffer^, FBufCount);
  if (BytesWritten <> FBufCount) then
    RaiseStError(EStBufStreamError, stscCannotWrite);
  FDirty := false;
end;

{-----------------------------------------------------------------------------}

function TStBufferedStream.Read(var Buffer; Count : longint) : longint;
var
  BytesToGo   : longint;
  BytesToRead : longint;
//  BufAsBytes  : TByteArray absolute Buffer;                          {!!.02}
//  DestPos     : longint;                                             {!!.02}
  BufAsBytes  : PByte;                                                 {!!.02}
begin
  BufAsBytes := @Buffer;                                               {!!.02}

  if (FStream = nil) then
    RaiseStError(EStBufStreamError, stscNilStream);
  {calculate the number of bytes we could read if possible}
  BytesToGo := MinLong(Count, FSize - (FBufOfs + FBufPos));
  {we will return this number of bytes or raise an exception}
  Result := BytesToGo;
  {are we going to read some data after all?}
  if (BytesToGo > 0) then begin
    {make sure that the buffer has some data in it}
    if (FBufCount = 0) then
      bsReadFromStream;
    {read as much as we can from the current buffer}
    BytesToRead := MinLong(BytesToGo, FBufCount - FBufPos);
    {transfer that number of bytes}
//    Move(FBuffer[FBufPos], BufAsBytes[0], BytesToRead);              {!!.02}
    Move(FBuffer[FBufPos], BufAsBytes^, BytesToRead);                  {!!.02}
    {update our counters}
    inc(FBufPos, BytesToRead);
    dec(BytesToGo, BytesToRead);
    {if we have more bytes to read then we've reached the end of the
     buffer and so we need to read another, and another, etc}
//    DestPos := 0;                                                    {!!.02}
    while BytesToGo > 0 do begin
      {if the current buffer is dirty, write it out}
      if FDirty then
        bsWriteToStream;
      {position and read the next buffer}
      FBufPos := 0;
      inc(FBufOfs, FBufSize);
      bsReadFromStream;
      {calculate the new destination position, and the number of bytes
       to read from this buffer}
//      inc(DestPos, BytesToRead);                                     {!!.02}
      Inc(BufAsBytes, BytesToRead);                                    {!!.02}
      BytesToRead := MinLong(BytesToGo, FBufCount - FBufPos);
      {transfer that number of bytes}
//      Move(FBuffer[FBufPos], BufAsBytes[DestPos], BytesToRead);      {!!.02}
      Move(FBuffer[FBufPos], BufAsBytes^, BytesToRead);                {!!.02}

      {update our counters}
      inc(FBufPos, BytesToRead);
      dec(BytesToGo, BytesToRead);
    end;
  end;
end;

{-----------------------------------------------------------------------------}

function TStBufferedStream.Seek(Offset : longint; Origin : word) : longint;
var
  NewPos : longint;
  NewOfs : longint;
begin
  if (FStream = nil) then
    RaiseStError(EStBufStreamError, stscNilStream);
  {optimization: to help code that just wants the current stream
   position (ie, reading the Position property), check for this as a
   special case}
  if (Offset = 0) and (Origin = soFromCurrent) then begin
    Result := FBufOfs + FBufPos;
    Exit;
  end;
  {calculate the desired position}
  case Origin of
    soFromBeginning : NewPos := Offset;
    soFromCurrent   : NewPos := (FBufOfs + FBufPos) + Offset;
    soFromEnd       : NewPos := FSize + Offset;
  else
    RaiseStError(EStBufStreamError, stscBadOrigin);
    NewPos := 0; {to fool the compiler's warning--we never get here}
  end;
  {force the new position to be valid}
  if (NewPos < 0) then
    NewPos := 0
  else if (NewPos > FSize) then
    NewPos := FSize;
  {calculate the offset for the buffer}
  NewOfs := (NewPos div FBufSize) * FBufSize;
  {if the offset differs, we have to move the buffer window}
  if (NewOfs <> FBufOfs) then begin
    {check to see whether we have to write the current buffer to the
     original stream first}
    if FDirty then
      bsWriteToStream;
    {mark the buffer as empty}
    FBufOfs := NewOfs;
    FBufCount := 0;
  end;
  {set the position within the buffer}
  FBufPos := NewPos - FBufOfs;
  Result := NewPos;
end;

{-----------------------------------------------------------------------------}

procedure TStBufferedStream.SetSize(NewSize : longint);
var
  NewPos : longint;
begin
  {get rid of the simple case first where the new size and the old
   size are the same}
  if (NewSize = FSize) then
    Exit;
  {if the buffer is dirty, write it out}
  if FDirty then
    bsWriteToStream;
  {now set the size of the underlying stream}
  FStream.Size := NewSize;
  {patch up the buffer fields so that the buffered stream points to
   somewhere in the newly resized stream}
  NewPos := FBufOfs + FBufPos;
  if (NewPos > NewSize) then
    NewPos := NewSize;
  bsInitForNewStream;
  Seek(NewPos, soFromBeginning);
end;

{-----------------------------------------------------------------------------}

function TStBufferedStream.Write(const Buffer; Count : longint) : longint;
var
  BytesToGo   : longint;
  BytesToWrite: longint;
//  BufAsBytes  : TByteArray absolute Buffer;                          {!!.02}
//  DestPos     : longint;                                             {!!.02}
  BufAsBytes  : PByte;                                                 {!!.02}
begin
  BufAsBytes := @Buffer;                                               {!!.02}

  if (FStream = nil) then
    RaiseStError(EStBufStreamError, stscNilStream);
  {calculate the number of bytes we should be able to write}
  BytesToGo := Count;
  {we will return this number of bytes or raise an exception}
  Result := BytesToGo;
  {are we going to write some data?}
  if (BytesToGo > 0) then begin
    {try and make sure that the buffer has some data in it}
    if (FBufCount = 0) then
      bsReadFromStream;
    {write as much as we can to the current buffer}
    BytesToWrite := MinLong(BytesToGo, FBufSize - FBufPos);
    {transfer that number of bytes}
//    Move(BufAsBytes[0], FBuffer[FBufPos], BytesToWrite);             {!!.02}
    Move(BufAsBytes^, FBuffer[FBufPos], BytesToWrite);                 {!!.02}
    FDirty := true;
    {update our counters}
    inc(FBufPos, BytesToWrite);
    if (FBufCount < FBufPos) then begin
      FBufCount := FBufPos;
      FSize := FBufOfs + FBufPos;
    end;
    dec(BytesToGo, BytesToWrite);
    {if we have more bytes to write then we've reached the end of the
     buffer and so we need to write another, and another, etc}
//    DestPos := 0;                                                    {!!.02}
    while BytesToGo > 0 do begin
      {as the current buffer is dirty, write it out}
      bsWriteToStream;
      {position and read the next buffer, if required}
      FBufPos := 0;
      inc(FBufOfs, FBufSize);
      if (FBufOfs < FSize) then
        bsReadFromStream
      else
        FBufCount := 0;
      {calculate the new destination position, and the number of bytes
       to write to this buffer}
//      inc(DestPos, BytesToWrite);                                    {!!.02}
      Inc(BufAsBytes, BytesToWrite);                                   {!!.02}
      BytesToWrite := MinLong(BytesToGo, FBufSize - FBufPos);
      {transfer that number of bytes}
//      Move(BufAsBytes[DestPos], FBuffer[0], BytesToWrite);           {!!.02}
      Move(BufAsBytes^, FBuffer[0], BytesToWrite);                     {!!.02}
      FDirty := true;
      {update our counters}
      inc(FBufPos, BytesToWrite);
      if (FBufCount < FBufPos) then begin
        FBufCount := FBufPos;
        FSize := FBufOfs + FBufPos;
      end;
      dec(BytesToGo, BytesToWrite);
    end;
  end;
end;

{-----------------------------------------------------------------------------}
{                           TStAnsiTextStream                                 }
{-----------------------------------------------------------------------------}

constructor TStAnsiTextStream.Create(aStream : TStream);
begin
  inherited Create(aStream);

  {set up the line index variables}
  atsResetLineIndex;
end;

{-----------------------------------------------------------------------------}

destructor TStAnsiTextStream.Destroy;
begin
  {if needed, free the fixed line buffer}
  if (FFixedLine <> nil) then
    FreeMem(FFixedLine, FixedLineLength);
  {free the line index}
  FLineIndex.Free;
  inherited Destroy;
end;

{-----------------------------------------------------------------------------}

function TStAnsiTextStream.AtEndOfStream : boolean;
begin
  Result := FSize = (FBufOfs + FBufPos);
end;

{-----------------------------------------------------------------------------}

procedure TStAnsiTextStream.atsGetLine(var aStartPos : longint;
                                       var aEndPos   : longint;
                                       var aLen      : longint);
var
  Done   : boolean;
  Ch     : AnsiChar;
  PrevCh : AnsiChar;
begin
  if (LineTerminator = ltNone) then begin
    aStartPos := FBufOfs + FBufPos;
    aEndPos := Seek(aStartPos + FixedLineLength, soFromBeginning);
    aLen := aEndPos - aStartPos;
  end
  else begin
    aStartPos := FBufOfs + FBufPos;
    Ch := #0;
    Done := false;
    while not Done do begin
      PrevCh := Ch;
      if not bsReadChar(Ch) then begin
        Done := true;
        aEndPos := FBufOfs + FBufPos;
        aLen := aEndPos - aStartPos;
      end
      else begin
        case LineTerminator of
          ltNone : {this'll never get hit};
          ltCR   : if (Ch = #13) then begin
                     Done := true;
                     aEndPos := FBufOfs + FBufPos;
                     aLen := aEndPos - aStartPos - 1;
                   end;
          ltLF   : if (Ch = #10) then begin
                     Done := true;
                     aEndPos := FBufOfs + FBufPos;
                     aLen := aEndPos - aStartPos - 1;
                   end;
          ltCRLF : if (Ch = #10) then begin
                     Done := true;
                     aEndPos := FBufOfs + FBufPos;
                     if PrevCh = #13 then
                       aLen := aEndPos - aStartPos - 2
                     else
                       aLen := aEndPos - aStartPos - 1;
                   end;
          ltOther: if (Ch = LineTermChar) then begin
                     Done := true;
                     aEndPos := FBufOfs + FBufPos;
                     aLen := aEndPos - aStartPos - 1;
                   end;
        else
          RaiseStError(EStBufStreamError, stscBadTerminator);
        end;
      end;
    end;
  end;
end;

{-----------------------------------------------------------------------------}

function TStAnsiTextStream.atsGetLineCount : longint;
begin
  if FLineCount < 0 then
    Result := MaxLongInt
  else
    Result := FLineCount;
end;

{-----------------------------------------------------------------------------}

procedure TStAnsiTextStream.atsResetLineIndex;
begin
  {make sure we have a line index}
  if (FLineIndex = nil) then begin
    FLineIndex := TList.Create;  {create the index: even elements are}
    FLineIndex.Count := LineIndexCount * 2; {linenums, odd are offsets}

    {if we didn't have a line index, set up some reasonable defaults}
    FLineTerm := ltCRLF;  {normal Windows text file terminator}
    FLineEndCh := #10;    {not used straight away}
    FLineLen := 80;       {not used straight away}
  end;
  FLineIndex[0] := pointer(0); {the first line is line 0 and...}
  FLineIndex[1] := pointer(0); {...it starts at position 0}
  FLineInxTop := 0;            {the top valid index}
  FLineInxStep := 1;           {step count before add a line to index}
  FLineCount := -1;            {number of lines (-1 = don't know)}
  FLineCurrent := 0;           {current line}
  FLineCurOfs := 0;            {current line offset}
end;

{-----------------------------------------------------------------------------}

procedure TStAnsiTextStream.atsSetLineTerm(aValue : TStLineTerminator);
begin
  if (aValue <> LineTerminator) and ((FBufOfs + FBufPos) = 0) then begin
    {if there was no terminator, free the line buffer}
    if (LineTerminator = ltNone) then begin
      FreeMem(FFixedLine, FixedLineLength);
      FFixedLine := nil;
    end;
    {set the new value}
    FLineTerm := aValue;
    {if there is no terminator now, allocate the line buffer}
    if (LineTerminator = ltNone) then begin
      GetMem(FFixedLine, FixedLineLength);
    end;
    atsResetLineIndex;
  end;
end;

{-----------------------------------------------------------------------------}

procedure TStAnsiTextStream.atsSetLineEndCh(aValue : AnsiChar);
begin
  if ((FBufOfs + FBufPos) = 0) then begin
    FLineEndCh := aValue;
    atsResetLineIndex;
  end;
end;

{-----------------------------------------------------------------------------}

procedure TStAnsiTextStream.atsSetLineLen(aValue : integer);
begin
  if (aValue <> FixedLineLength) and ((FBufOfs + FBufPos) = 0) then begin
    {validate the new length first}
    if (aValue < 1) or (aValue > 1024) then
      RaiseStError(EStBufStreamError, stscBadLineLength);

    {set the new value; note that if there is no terminator we need to
     free the old line buffer, and then allocate a new one}
    if (LineTerminator = ltNone) then
      FreeMem(FFixedLine, FixedLineLength);
    FLineLen := aValue;
    if (LineTerminator = ltNone) then
      GetMem(FFixedLine, FixedLineLength);
    atsResetLineIndex;
  end;
end;

{-----------------------------------------------------------------------------}

procedure TStAnsiTextStream.bsInitForNewStream;
begin
  inherited bsInitForNewStream;
  atsResetLineIndex;
end;

{-----------------------------------------------------------------------------}

function TStAnsiTextStream.ReadLine : AnsiString;
var
  CurPos : longint;
  EndPos : longint;
  Len    : longint;
  StLen  : longint;
begin
  atsGetLine(CurPos, EndPos, Len);
  if (LineTerminator = ltNone) then begin
    {at this point, Len will either equal FixedLineLength, or it will
     be less than it because we read the last line of all and it was
     short}
    StLen := FixedLineLength;
    SetLength(Result, StLen);
    if (Len < StLen) then
      FillChar(Result[Len+1], StLen-Len, ' ');
  end
  else {LineTerminator is not ltNone} begin
    SetLength(Result, Len);
  end;
  {read the line}
  if Len > 0 then begin
    Seek(CurPos, soFromBeginning);
    Read(Result[1], Len);
  end
  else {it's a blank line }
    Result := '';
  Seek(EndPos, soFromBeginning);
end;

{-----------------------------------------------------------------------------}

function TStAnsiTextStream.ReadLineArray(aCharArray : PAnsiChar;
                                         aLen       : TStMemSize)
                                                    : TStMemSize;
var
  CurPos : longint;
  EndPos : longint;
  Len    : longint;
  StLen  : longint;
begin
  atsGetLine(CurPos, EndPos, Len);
  if (LineTerminator = ltNone) then begin
    {at this point, Len will either equal FixedLineLength, or it will
     be less than it because we read the last line of all and it was
     short}
    StLen := FixedLineLength;
    if (StLen > aLen) then
      StLen := aLen;
    if (Len < StLen) then
      FillChar(aCharArray[Len], StLen-Len, ' ');
    Result := StLen;
  end
  else {LineTerminator is not ltNone} begin
    if (Len > aLen) then
      Len := aLen;
    Result := Len;
  end;
  Seek(CurPos, soFromBeginning);
  Read(aCharArray[0], Len);
  Seek(EndPos, soFromBeginning);
end;

{-----------------------------------------------------------------------------}

function TStAnsiTextStream.ReadLineZ(aSt : PAnsiChar; aMaxLen : TStMemSize) : PAnsiChar;
var
  CurPos : longint;
  EndPos : longint;
  Len    : longint;
  StLen  : longint;
begin
  Result := aSt;
  atsGetLine(CurPos, EndPos, Len);
  if (LineTerminator = ltNone) then begin
    {at this point, Len will either equal FixedLineLength, or it will
     be less than it because we read the last line of all and it was
     short}
    StLen := FixedLineLength;
    if (StLen > aMaxLen) then
      StLen := aMaxLen;
    if (Len < StLen) then
      FillChar(Result[Len], StLen-Len, ' ');
    Result[StLen] := #0;
  end
  else {LineTerminator is not ltNone} begin
    if (Len > aMaxLen) then
      Len := aMaxLen;
    Result[Len] := #0;
  end;
  Seek(CurPos, soFromBeginning);
  Read(Result[0], Len);
  Seek(EndPos, soFromBeginning);
end;

{-----------------------------------------------------------------------------}

function TStAnsiTextStream.SeekNearestLine(aOffset : longint) : longint;
var
  CurLine : longint;
  CurOfs  : longint;
  CurPos  : longint;
  EndPos  : longint;
  Len     : longint;
  i       : longint;
  Done    : boolean;
  L, R, M : integer;
begin
  {if the offset we want is for the current line, reposition at the
   current line offset, return the current line number and exit}
  if (aOffset = FLineCurOfs) then begin
    Seek(FLineCurOfs, soFromBeginning);
    Result := FLineCurrent;
    Exit;
  end;
  {if the offset requested is less than or equal to zero, just
   position at line zero (ie, the start of the stream)}
  if (aOffset <= 0) then begin
    Seek(0, soFromBeginning);
    FLineCurrent := 0;
    FLineCurOfs := 0;
    Result := 0;
    Exit;
  end;
  {if the offset requested is greater than or equal to the size of the
   stream, position at the end of the stream (note that if we don't
   know the number of lines in the stream yet, FLineCount is set to
   -1 and we can't take this shortcut because we need to return the
   true value)}
  if (FLineCount >= 0) and (aOffset >= FSize) then begin
    Seek(0, soFromEnd);
    FLineCurrent := FLineCount;
    FLineCurOfs := FSize;
    Result := FLineCount;
    Exit;
  end;
  {if the offset requested is greater than the top item in the
   line index, we shall have to build up the index until we get to the
   line we require, or just beyond}
  if (aOffset > longint(FLineIndex[FLineInxTop+1])) then begin
    {position at the last known line offset}
    CurLine := longint(FLineIndex[FLineInxTop]);
    CurOfs := longint(FLineIndex[FLineInxTop+1]);
    Seek(CurOfs, soFromBeginning);
    Done := false;
    {continue reading lines in chunks of FLineInxStep and add an index
     entry for each chunk}
    while not Done do begin
      for i := 0 to pred(FLineInxStep) do begin
        atsGetLine(CurPos, EndPos, Len);
        inc(CurLine);
        CurOfs := EndPos;
        if (EndPos = FSize) then begin
          Done := true;
          Break;
        end;
      end;
      if Done then
        FLineCount := CurLine
      else begin
        inc(FLineInxTop, 2);
        if (FLineInxTop = (LineIndexCount * 2)) then begin
          {we've exhausted the space in the index: rescale}
          FLineInxTop := FLineInxTop div 2;
          for i := 0 to pred(FLineInxTop) do begin
            if Odd(i) then
              FLineIndex.Exchange((i*2)-1, i)
            else
              FLineIndex.Exchange(i*2, i);
          end;
          FLineInxStep := FLineInxStep * 2;
        end;
        FLineIndex[FLineInxTop] := pointer(CurLine);
        FLineIndex[FLineInxTop+1] := pointer(CurOfs);
        if (aOffset <= CurOfs) then
          Done := true;
      end;
    end;
  end;
  {we can now work out where the nearest item in the index is to the
   line we require}
  L := 1;
  R := FLineInxTop+1;
  while (L <= R) do begin
    M := (L + R) div 2;
    if not Odd(M) then
      inc(M);
    if (aOffset < longint(FLineIndex[M])) then
      R := M - 2
    else if (aOffset > longint(FLineIndex[M])) then
      L := M + 2
    else begin
      FLineCurrent := longint(FLineIndex[M-1]);
      FLineCurOfs := longint(FLineIndex[M]);
      Seek(FLineCurOfs, soFromBeginning);
      Result := FLineCurrent;
      Exit;
    end;
  end;
  {the item at L-2 will have the nearest smaller offset than the
   one we want, hence the nearest smaller line is at L-3; start here
   and read through the stream forwards}
  CurLine := longint(FLineIndex[L-3]);
  Seek(longint(FLineIndex[L-2]), soFromBeginning);
  while true do begin
    atsGetLine(CurPos, EndPos, Len);
    inc(CurLine);
    if (EndPos > aOffset) then begin
      FLineCurrent := CurLine - 1;
       FLineCurOfs := CurPos;
      Seek(CurPos, soFromBeginning);
      Result := CurLine - 1;
      Exit;
    end
    else if (CurLine = FLineCount) or (EndPos = aOffset) then begin
      FLineCurrent := CurLine;
      FLineCurOfs := EndPos;
      Seek(EndPos, soFromBeginning);
      Result := CurLine;
      Exit;
    end;
  end;
end;

{-----------------------------------------------------------------------------}

function TStAnsiTextStream.SeekLine(aLineNum : longint) : longint;
var
  CurLine : longint;
  CurOfs  : longint;
  CurPos  : longint;
  EndPos  : longint;
  Len     : longint;
  i       : longint;
  Done    : boolean;
  L, R, M : integer;
begin
  {if the line number we want is the current line, reposition at the
   current line offset, return the current line number and exit}
  if (aLineNum = FLineCurrent) then begin
    Seek(FLineCurOfs, soFromBeginning);
    Result := FLineCurrent;
    Exit;
  end;
  {if the line number requested is less than or equal to zero, just
   position at line zero (ie, the start of the stream)}
  if (aLineNum <= 0) then begin
    Seek(0, soFromBeginning);
    FLineCurrent := 0;
    FLineCurOfs := 0;
    Result := 0;
    Exit;
  end;
  {if the line number requested is greater than or equal to the line
   count, position at the end of the stream (note that if we don't
   know the number of lines in the stream yet, FLineCount is set to
   -1)}
  if (FLineCount >= 0) and (aLineNum > FLineCount) then begin
    Seek(0, soFromEnd);
    FLineCurrent := FLineCount;
    FLineCurOfs := FSize;
    Result := FLineCount;
    Exit;
  end;
  {if the line number requested is greater than the top item in the
   line index, we shall have to build up the index until we get to the
   line we require, or just beyond}
  if (aLineNum > longint(FLineIndex[FLineInxTop])) then begin
    {position at the last known line offset}
    CurLine := longint(FLineIndex[FLineInxTop]);
    CurOfs := longint(FLineIndex[FLineInxTop+1]);
    Seek(CurOfs, soFromBeginning);
    Done := false;
    {continue reading lines in chunks of FLineInxStep and add an index
     entry for each chunk}
    while not Done do begin
      for i := 0 to pred(FLineInxStep) do begin
        atsGetLine(CurPos, EndPos, Len);
        inc(CurLine);
        CurOfs := EndPos;
        if (EndPos = FSize) then begin
          Done := true;
          Break;
        end;
      end;
      if Done then
        FLineCount := CurLine
      else begin
        inc(FLineInxTop, 2);
        if (FLineInxTop = (LineIndexCount * 2)) then begin
          {we've exhausted the space in the index: rescale}
          FLineInxTop := FLineInxTop div 2;
          for i := 0 to pred(FLineInxTop) do begin
            if Odd(i) then
              FLineIndex.Exchange((i*2)-1, i)
            else
              FLineIndex.Exchange(i*2, i);
          end;
          FLineInxStep := FLineInxStep * 2;
        end;
        FLineIndex[FLineInxTop] := pointer(CurLine);
        FLineIndex[FLineInxTop+1] := pointer(CurOfs);
        if (aLineNum <= CurLine) then
          Done := true;
      end;
    end;
  end;
  {we can now work out where the nearest item in the index is to the
   line we require}
  L := 0;
  R := FLineInxTop;
  while (L <= R) do begin
    M := (L + R) div 2;
    if Odd(M) then
      dec(M);
    if (aLineNum < longint(FLineIndex[M])) then
      R := M - 2
    else if (aLineNum > longint(FLineIndex[M])) then
      L := M + 2
    else begin
      FLineCurrent := longint(FLineIndex[M]);
      FLineCurOfs := longint(FLineIndex[M+1]);
      Seek(FLineCurOfs, soFromBeginning);
      Result := FLineCurrent;
      Exit;
    end;
  end;
  {the item at L-2 will have the nearest smaller line number than the
   one we want; start here and read through the stream forwards}
  CurLine := longint(FLineIndex[L-2]);
  Seek(longint(FLineIndex[L-1]), soFromBeginning);
  while true do begin
    atsGetLine(CurPos, EndPos, Len);
    inc(CurLine);
    if (CurLine = FLineCount) or (CurLine = aLineNum) then begin
      FLineCurrent := CurLine;
      FLineCurOfs := EndPos;
      Seek(EndPos, soFromBeginning);
      Result := CurLine;
      Exit;
    end;
  end;
end;

{-----------------------------------------------------------------------------}

procedure TStAnsiTextStream.WriteLine(const aSt : AnsiString);
var
  Len : Integer;
begin
  Len := Length(aSt);
  if Len > 0 then
    WriteLineArray(PAnsiChar(aSt), Len)
  else
    WriteLineArray('', 0);
end;

{-----------------------------------------------------------------------------}

procedure TStAnsiTextStream.WriteLineArray(aCharArray : PAnsiChar;
                                           aLen       : TStMemSize);
var
  C : AnsiChar;
begin
  if (aCharArray = nil) then
    aLen := 0;
  if (LineTerminator = ltNone) then begin
    if (aLen >= FixedLineLength) then
      Write(aCharArray[0], FixedLineLength)
    else begin
      FillChar(FFixedLine[aLen], FixedLineLength-aLen, ' ');
      if (aLen > 0) then
        Move(aCharArray[0], FFixedLine[0], aLen);
      Write(FFixedLine[0], FixedLineLength);
    end;
  end
  else begin
    if (aLen > 0) then
      Write(aCharArray[0], aLen);
    case LineTerminator of
      ltNone : {this'll never get hit};
      ltCR   : Write(LineTerm[ltCR], 1);
      ltLF   : Write(LineTerm[ltLF], 1);
      ltCRLF : Write(LineTerm[ltCRLF], 2);
      ltOther: begin
                 C := LineTermChar;
                 Write(C, 1);
               end;
    else
      RaiseStError(EStBufStreamError, stscBadTerminator);
    end;
  end;
end;

{-----------------------------------------------------------------------------}

procedure TStAnsiTextStream.WriteLineZ(aSt : PAnsiChar);
var
  LenSt : TStMemSize;
begin
  if (aSt = nil) then
    LenSt := 0
  else
    LenSt := StrLen(aSt);
  WriteLineArray(aSt, LenSt);
end;


{-----------------------------------------------------------------------------}
{                           TStMemoryMappedFile                               }
{-----------------------------------------------------------------------------}

constructor TStMemoryMappedFile.Create(const FileName   : string;      {!!.02}
                                             MaxSize    : Cardinal;
                                             ReadOnly   : Boolean;
                                             SharedData : Boolean);
var
  RO1,
  RO2,
  RO3,
  RO4,
  FHi    : DWORD;
  SetSize: Boolean;
begin
  inherited Create;

  FMutex := CreateMutex(nil, False, nil);
  FSharedData := SharedData;
  if (FSharedData) then
    FHeaderSize := SizeOf(Word) + SizeOf(Cardinal)
  else
    FHeaderSize := 0;

  FReadOnly := ReadOnly;
  if (SharedData) then
    FReadOnly := False;
  if (FReadOnly) then begin
    RO1 := GENERIC_READ;
    RO2 := FILE_ATTRIBUTE_READONLY;
    RO3 := PAGE_READONLY;
    RO4 := FILE_MAP_READ;
    FMaxHi := 0;
    FMaxLo := 0;
  end else begin
    RO1 := GENERIC_READ or GENERIC_WRITE;
    RO2 := FILE_ATTRIBUTE_NORMAL;
    RO3 := PAGE_READWRITE;
    RO4 := FILE_MAP_WRITE;
    FMaxHi := 0;
    FMaxLo := MaxSize;
  end;

  if (not SharedData) then begin
    FHandle := CreateFile(PChar(FileName),
                          RO1,
                          FILE_SHARE_READ or FILE_SHARE_WRITE,
                          nil,
                          OPEN_ALWAYS,
                          RO2,
                          0);

    if (FHandle = INVALID_HANDLE_VALUE) then
      RaiseStError(EStMMFileError, stscCreateFileFailed);

    {reset FMaxLo if file is read/write and less < FileSize}
    {the result is that the file size cannot be changed but the contents can}
    {still be modified}
    FDataSize := GetFileSize(FHandle, @FHi);
    if (FDataSize <> $FFFFFFFF) then begin
      if (not ReadOnly) and (FDataSize > FMaxLo) then
        FMaxLo := FDataSize;
    end else begin
      CloseHandle(FHandle);
      RaiseStError(EStMMFileError, stscGetSizeFailed);
    end;
  end else
    FDataSize := 0;

  if (not SharedData) then begin
    FMapObj := CreateFileMapping(FHandle, nil, RO3, FMaxHi, FMaxLo, nil);
    SetSize := False;
  end else begin
    if (FMaxLo > (High(Cardinal) - FHeaderSize)) then
      FMaxLo := High(Cardinal) - FHeaderSize
    else
      FMaxLo := FMaxLo + FHeaderSize;
    FMapObj := CreateFileMapping(THandle($FFFFFFFF), nil, RO3,
                                 FMaxHi, FMaxLo, 'STMMFILE1');
    SetSize := (GetLastError = ERROR_ALREADY_EXISTS);
  end;

  if (FMapObj = INVALID_HANDLE_VALUE) then
    RaiseStError(EStMMFileError, stscFileMappingFailed);

  FBuffer := MapViewOfFile(FMapObj, RO4, 0, 0, FMaxLo);
  if (not Assigned(FBuffer)) then
    RaiseStError(EStMMFileError, stscCreateViewFailed);

  if (SharedData) then begin
    if (SetSize) then
      Move(PByteArray(FBuffer)[SizeOf(Word)-1], FDataSize, SizeOf(Cardinal))
    else begin
      Move(FHeaderSize, PByteArray(FBuffer)[0], SizeOf(Word));
      FDataSize := 0;
      Move(FDataSize, PByteArray(FBuffer)[SizeOf(Word)-1], SizeOf(Cardinal));
    end;
  end;
  {set position to beginning}
  FPos := FHeaderSize;
end;

{-----------------------------------------------------------------------------}

destructor TStMemoryMappedFile.Destroy;
begin
{Close the View and Mapping object}
  UnmapViewOfFile(FBuffer);
  FBuffer := nil;
  CloseHandle(FMapObj);

  if (not SharedData) then begin
{set the file pointer to the end of the actual data}
    SetFilePointer(FHandle, FDataSize, nil, FILE_BEGIN);
{set the EOF marker to the end of actual data}
    SetEndOfFile(FHandle);
    CloseHandle(FHandle);
  end;

  {now the Mutex can be cleared}
  CloseHandle(FMutex);
  FMutex := 0;

  inherited Destroy;
end;

{-----------------------------------------------------------------------------}

function TStMemoryMappedFile.GetDataSize : Cardinal;
begin
  Move(PByteArray(FBuffer)[SizeOf(Word)-1], FDataSize, SizeOf(Cardinal));
  Result := FDataSize;
end;

{-----------------------------------------------------------------------------}

function TStMemoryMappedFile.Read(var Buffer; Count : Longint) : Longint;
var
//  ByteArray : TByteArray absolute Buffer;                            {!!.02}
  ByteArray : PByte;                                                   {!!.02}
begin
  ByteArray := @Buffer;                                                {!!.02}
  {check to make sure that the read does not go beyond the actual data}
  if (((FPos-FHeaderSize) + DWORD(Count)) > FDataSize) then
    Count := FDataSize - FPos + FHeaderSize;

  if (SharedData) then begin
    WaitForSingleObject(FMutex, INFINITE);
    try
//      Move(PByteArray(FBuffer)[FPos], ByteArray[0], Count);          {!!.02}
      Move(PByteArray(FBuffer)[FPos], ByteArray^, Count);              {!!.02}
      Inc(FPos, Count);
      Result := Count;
    finally
      ReleaseMutex(FMutex);
    end;
  end else begin
//    Move(PByteArray(FBuffer)[FPos], ByteArray[0], Count);            {!!.02}
    Move(PByteArray(FBuffer)[FPos], ByteArray^, Count);                {!!.02}
    Inc(FPos, Count);
    Result := Count;
  end;
end;

{-----------------------------------------------------------------------------}

function TStMemoryMappedFile.Write(const Buffer; Count : Longint) : Longint;
var
//  ByteArray : TByteArray absolute Buffer;                            {!!.02}
  ByteArray : PByte;                                                   {!!.02}
begin
  ByteArray := @Buffer;                                                {!!.02}
  if (ReadOnly) then begin
    Result := 0;
    Exit;
  end;

  {check that the write does not go beyond the maximum file size}
  if ((FPos + DWORD(Count)) > pred(FMaxLo)) then
    Count := pred(FMaxLo - FPos);

  if (SharedData) then begin
    WaitForSingleObject(FMutex, INFINITE);
    try
//      Move(ByteArray[0], PByteArray(FBuffer)[FPos], Count);          {!!.02}
      Move(ByteArray^, PByteArray(FBuffer)[FPos], Count);              {!!.02}
      Inc(FPos, Count);
      {if the write went beyond the previous end of data, update FDataSize}
      if ((FPos-FHeaderSize) > FDataSize) then
        FDataSize := FPos-FHeaderSize;
      Move(FDataSize, PByteArray(FBuffer)[SizeOf(Word)-1], SizeOf(Cardinal));
      Result := Count;
    finally
      ReleaseMutex(FMutex);
    end;
  end else begin
//    Move(ByteArray[0], PByteArray(FBuffer)[FPos], Count);            {!!.02}
    Move(ByteArray^, PByteArray(FBuffer)[FPos], Count);                {!!.02}
    Inc(FPos, Count);
    {if the write went beyond the previous end of data, update FDataSize}
    if ((FPos-FHeaderSize) > FDataSize) then
      FDataSize := FPos-FHeaderSize;
    Move(FDataSize, PByteArray(FBuffer)[SizeOf(Word)-1], SizeOf(Cardinal));
    Result := Count;
  end;
end;

{-----------------------------------------------------------------------------}

function TStMemoryMappedFile.Seek(Offset : Longint; Origin : Word) : Longint;
begin
  if (SharedData) then begin
    WaitForSingleObject(FMutex, INFINITE);
    try
      case Origin of
        {$WARNINGS OFF}
        soFromBeginning : FPos := Offset + FHeaderSize;
        soFromCurrent   : FPos := FPos + Offset + FHeaderSize;
        {the seek should be based on actual data, not the mapped size since}
        {the "data" between FDataSize and the mapped size is undefined}
        soFromEnd       : FPos := FDataSize + Offset + FHeaderSize;
        {$WARNINGS ON}
      else
        RaiseStError(EStMMFileError, stscBadOrigin);
      end;

      {force the new position to be valid}
      if ((FPos-FHeaderSize) > FDataSize) then
        FPos := FDataSize + FHeaderSize;
      Result := FPos;
    finally
      ReleaseMutex(FMutex);
    end;
  end else begin
    {$WARNINGS OFF}
    case Origin of
      soFromBeginning : FPos := Offset + FHeaderSize;
      soFromCurrent   : FPos := FPos + Offset + FHeaderSize;
      {the seek should be based on actual data, not the mapped size since}
      {the "data" between FDataSize and the mapped size is undefined}
      soFromEnd       : FPos := FDataSize + Offset + FHeaderSize;
    else
      RaiseStError(EStMMFileError, stscBadOrigin);
    end;
    {$WARNINGS ON}

    {force the new position to be valid}
    if ((FPos-FHeaderSize) > FDataSize) then
      FPos := FDataSize + FHeaderSize;
    Result := FPos;
  end;
end;

{-----------------------------------------------------------------------------}

end.
