type
  TTextStream = class(TFileStream)
  private
      bufStream  : array[0..BufTextStreamSize] of char;
      BufPtr  : integer;               {Positions within buffer. Meaning depends}
      BufEnd  : integer;               {... on read or write mode}
      bufpos  : integer;
     procedure readBuffer;
  public
   function Read(var Buffer; Count: Longint): Longint; override;
   function readLn(var ss : ShortString):longint;
  end;



implementation

  function HeapFunc(Size : Word) : Integer;
    {-Return nil pointer if insufficient memory}
  begin
    HeapFunc := 1;
  end;

  function GetMemCheck(var P; Bytes : integer) : Boolean;
    {-Allocate heap space, returning true if successful}
  var
    Pt : Pointer absolute P;
  begin
    GetMem(Pt, Bytes);
    GetMemCheck := (Pt <> nil);
  end;


function tTextStream.read(var Buffer; Count: Longint): Longint;
var
    UserBuf : ByteArray absolute Buffer;
    UserPos : integer;
    Bytes : integer;
    io    : longint;

begin
    userPos:=0;
    while Count > 0 do begin
      if BufPtr >= BufEnd then begin
        readBuffer;
      end;
      Bytes := BufEnd-BufPtr;
      if bytes=0 then begin
        break;
      end else if Count <= Bytes then begin
          move(BufStream[BufPtr], UserBuf[UserPos], count);
          inc(BufPtr, count);
          inc(userPos,count);
          break;
      end else begin
          dec(Count, Bytes);
          inc(BufPtr, Bytes);
          move(BufStream[BufPtr], UserBuf[UserPos], Bytes);
          inc(UserPos, Bytes);
      end;

      {Adjust counters}
    end;
    result:=userPos;


end;


function StrLScan(const Str: PChar; Chr: Char;maxLen : cardinal): PChar; assembler;
asm
        PUSH    EDI
        MOV     EDI,Str
        MOV     AL,Chr
        REPNE   SCASB
        MOV     EAX,0
        JNE     @@1
        MOV     EAX,EDI
        DEC     EAX
@@1:    POP     EDI
end;


   procedure tTextStream.readBuffer;
   var
     io : longint;
   begin
        io:= inherited read(bufStream,BufTextStreamSize);
        if io=0 then begin
          bufPtr:=0;
          bufEnd:=0;
          exit;
        end;
        bufPtr:=0;
        bufEnd:=io;
        inc(bufPos,io);
   end;


function tTextStream.readln(var ss : shortString): Longint;
var
    UserPos : integer;
    Bytes : integer;

    i     : longint;
    count : integer;


   function endofLine(i : integer):boolean;
   begin
     result:= (bufStream[i]=#13) or (bufStream[i]=#10);
   end;
   procedure skipendofLine;
   begin
    if bufPtr>=BufEnd then readBuffer;
    if bufStream[bufPtr]=#13 then begin
      inc(bufPtr);
      if bufPtr>=BufEnd then readBuffer;
    end;
    if bufStream[bufPtr]=#10 then inc(bufPtr);

   end;

   function findEndLine: longint;
   var

     pp,pc,pk : pchar;
   begin

     pp:=@(bufstream[bufPtr]);
//     pc:=pp;
     result:=bufEnd-bufPtr;

     pc:=strLScan(pp,#10,bufEnd-bufPtr);
     if pc=nil then begin
       pc:=strLScan(pp,#13,bufEnd-bufPtr);
     end else if pchar(pc-1)^=#13 then dec(pc);

     if (pc<>nil) and endOfLine(longint(pc)-longint(@bufStream)) then begin
         result:= longint(pc)-longint(pp);
         count:=result;
     end;
   end;

   function findEndLine2: longint;
   var
     i : integer;
     pp,pc,pk : pchar;
   begin
     result:=bufEnd-bufPtr;
     for i:=bufPtr to bufEnd do begin
       if (bufstream[i]<#14) and endOfLine(i) then begin
         result:=i-bufPtr;
         count:=result;
         exit;
       end;
     end;
   end;

   function findEndLine3: longint;
   var

     pp,pc,pk : pchar;
   begin

     pp:=@(bufstream[bufPtr]);
     pc:=pp;
     pk:=@(bufstream[bufEnd]);
     result:=bufEnd-bufPtr;
     repeat

        if (pc^<#14) and endOfLine(longint(pc)-longint(@bufStream)) then begin
         result:= longint(pc)-longint(pp);
         count:=result;
         exit;
        end;
        inc(pc);
      until (pc=pk);
   end;

begin
    userPos:=0;
    count:=255;
    while Count > 0 do begin
      if BufPtr >= BufEnd then begin
        readBuffer;
      end;
      bytes:=BufEnd-bufPtr;
      if bytes=0 then begin
        if userPos=0 then userPos:=-1;
        break;
      end;
      bytes:=findEndLine;
      if Count <= Bytes then begin
          move(BufStream[BufPtr], ss[UserPos+1], count);
          inc(BufPtr, count);
          inc(userPos,count);
          break;
       end else begin
         dec(Count, Bytes);
         inc(BufPtr, Bytes);
         move(BufStream[BufPtr], ss[UserPos+1], Bytes);
         inc(UserPos, Bytes);
      end;

      {Adjust counters}
    end;
    ss[0]:=char(userPos);
    skipEndOfLine;
    result:=userPos;


end;
