[Back to TEXTFILE SWAG index] [Back to Main SWAG index] [Original]

    { unit for reading text files up to 512K very quickly! }
    { Do whatever you like to this code, but please credit me somehow! }
    { by Itai Handler, FidoNet 2:406/120. }

    Unit FastText;

    Interface

    const
      Text_Eof : Boolean = true;
      NoMem    : Boolean = false;

    Function  Text_Load (FN:String):Boolean;  { init memory and read the file }
    Procedure Text_ReadLine (var S:String);   { get line from text }
    Procedure Text_GoBack (L:Word);           { updates pointer to L lines back }
    Function  Text_Lines:LongInt;             { calculate how many lines in file }
    Procedure Text_Reset;                     { reset file & seek to start }
    Procedure Text_Dispose;                   { free memory }

    Implementation

    Type
      BufType=Array[1..64000] of char;

    Const
      PUsed:Byte=0;                         { # of pointers currently in use }

    Var
      P:Array[1..8] of ^BufType;            { array of 8 pointers (512kb) }
      TextSize:LongInt;                     { size of the text file in bytes }
      PSeek:LongInt;
      PCur:LongInt;

    Function Text_Load (FN:String):Boolean; { init memory and read the file }
      Var
        FB:File of Byte;
        NumRead:Word;
        F:File;
        B:LongInt;
        FM:Byte;
        Tmp:LongInt;

      Begin
        FM:=FileMode;
        filemode:=64;
        Text_Load:=false;
        NoMem:=false;
        Assign(fb, FN);
        Reset(fb);
        TextSize:=FileSize(fb);
        Close(Fb);
        If MaxAvail>=TextSize then
          Begin
            Text_Load:=true;
            For B:=1 to 8 do if TextSize > (( Pred(B) )*64000) then
              Begin
                If B*64000>TextSize then Tmp:=(TextSize mod 64000) else
                  Tmp:=64000;
                GetMem(P[B],Tmp);
                Inc(PUsed);
              End;
            Assign(f, FN);
            Reset(f,1);
            For B:=1 to PUsed do
              Begin
                If B*64000>TextSize then Tmp:=(TextSize mod 64000) else
                  Tmp:=64000;
                BlockRead(F,P[B]^,Tmp,NumRead);
                {If NumRead<>Tmp then Text_Load:=false;}
              End;
            Close(F);
          End else NoMem:=true;
        FileMode:=FM;
      PSeek:=1;
      PCur:=1;
      Text_Eof:=false;
      End;

    Procedure Text_ReadLine (var S:String); { get line from text }
      Var
        W:Word;
        B:LongInt;
        TS:String;
        Tmp:LongInt;
      Begin
      TS:='';
        If Not Text_Eof then
          Begin
          While (PUsed>=PCur) and (Length(TS)<=255) and
           (P[PCur]^[PSeek]<>#13) {and (P[PCur]^[PSeek]<>#10)} do
              Begin
                TS:=TS+P[PCur]^[PSeek];
                Inc(PSeek);
                If (PSeek>64000) and (PCur<8) then
                  Begin
                    PSeek:=1;
                    Inc(PCur);
                  End;
              End;
          If (P[PCur]^[PSeek]=#13) and (PUsed>=PCur) then
              begin
                Inc(PSeek,2);
                If (PSeek>64000) and (PCur<8) then
                  Begin
                    PSeek:=1;
                    Inc(PCur);
                  End;
              end;
          If (PCur>PUsed) or (Pred(PCur)*64000+PSeek>TextSize) then
            Text_Eof:=true;
        End;
      S:=TS;
      End;

    Procedure Text_GoBack (L:Word);
    Var
      Cnt  : Word;
    Begin
      Cnt:=L;
      If Cnt>0 then
      Begin
        If PSeek>2 then Dec(PSeek,2) else
          If PCur>1 then Begin Dec(PCur); PSeek:=64000-PSeek+1; End;
        Repeat
          Dec(Cnt);
             Repeat
               If PSeek>0 then Dec(PSeek);
               If (PSeek=0) and (PCur>1) then
                 Begin
                   PSeek:=64000;
                   Dec(PCur);
                 End;
               If PSeek=0 then PSeek:=1;
             Until ((PSeek=1) and (PCur=1)) or (P[PCur]^[PSeek]=#13)
        Until Cnt=0;
        If not ((PSeek=1) and (PCur=1)) Then Inc(PSeek,2);
        If PSeek>64000 then PSeek:=PSeek-64000;
      End;
      Text_Eof:=false;
    End;

    Function Text_Lines:LongInt;
    (* Asm procedure was made by Arie Vayner on the 9/2/95 *)
      Var
        W:Word;
        B:LongInt;
        L:Word;
        Tmp:Word;
        O:Word;
        S:Word;
      Begin
        L:=1;
        For B:=1 to PUsed do
          Begin
            If B*64000>TextSize then Tmp:=(TextSize mod 64000) else
              Tmp:=64000;
            O:=Ofs(P[B]^);
            S:=Seg(P[B]^);
            Asm
              Push DS
              Mov DS,S
              XOR DX,DX
              MOV CX,TMP
              MOV SI,O
              CLD
            @MAINLOOP:
              LODSB
              CMP AL,10
              JE @FOUND_ONE
              LOOP @MAINLOOP
              JMP @EXITLOOP
            @FOUND_ONE:
              INC DX
              LOOP @MAINLOOP
            @EXITLOOP:
              MOV AX,DX
              MOV TMP,AX
              POP DS
            END;
            Inc(L,TMP);
          End;
        Text_Lines:=L;
      End;

    Procedure Text_Reset;                   { reset file & seek to start }
    Begin
      Text_Eof:=false;
      PCur:=1;
      PSeek:=1;
    End;

    Procedure Text_Dispose;                 { free memory }
      Var
        B:LongInt;
        Tmp:LongInt;
      Begin
        For B:=1 to PUsed do if TextSize > (B*64000) then
          Begin
            If B*64000>TextSize then Tmp:=(TextSize mod 64000) else
              Tmp:=64000;
            FreeMem(P[B],Tmp);
          End;
        PUsed:=0;
      End;
    End.

[Back to TEXTFILE SWAG index] [Back to Main SWAG index] [Original]