From: kenaston@digital.net
Subject: Doing a Seek on a text file
Date: 07 Jul 2000 00:00:00 GMT
Message-ID: <3965F098.6D258BF9@digital.net>
Content-Transfer-Encoding: 7bit
Organization: Posted via Supernews, http://www.supernews.com
X-Accept-Language: en
Content-Type: text/plain; charset=us-ascii
MIME-Version: 1.0
Newsgroups: borland.public.delphi.objectpascal
X-Complaints-To: newsabuse@supernews.com

A couple weeks ago I asked if anyone had written routines
to provide Seek access to text files to make reading faster.
I wrote my own (adapted from what I wrote in Turbo Pascal).
I'm posting it here in case anyone else could use it.

It is very simple, and is only for reading text files, not writing.
Replace AssignFile with AssignText, then call FilePosText
to get the current file position and use SeekText to set the
file pointer to the desired file location.  I am still able to
use Pascal's read and readln routines.

I don't understand why the Pascal standard can't do something
similar, as I find this capability very useful in the programs I
do.

Below is the TextRead unit if anyone is interested.  I plan to
make it work for text files being written to, but that'll be later.
If anyone knows of something like it that already exists, please
tell me and save me the development time.  Thanks.

Walter
--------------------------

unit TextRead;

{
   TextRead - a simple Seek access to text files in read mode.
   By and copyright by: Walter Kenaston, 7 July 2000
}

{ $define D4 = when Delphi version is 4.0 or greater}

interface

procedure AssignText (var T: text; FName: String);
function  FilePosText (var T: text): cardinal;
procedure SeekText (var T: text; const N: cardinal);

implementation

uses Windows, SysUtils;

const
   PosSize = SizeOf(cardinal);
   lpIndex = 1;

function TextInput (var t: TTextRec): integer;
var
   bval    : boolean;
{$ifdef D4}
   NumToRead : cardinal;
   NumRead   : cardinal;
{$else}
   NumToRead : integer;
   NumRead   : integer;
{$endif}
   pOverlap  : POverlapped;
   l       : cardinal;
begin
   with t do
   begin
   NumToRead := t.BufSize;
   pOverlap := nil;
   bval := ReadFile (t.handle, t.BufPtr^, NumToRead, NumRead, pOverlap);
   if (not bval) then
      begin
      result := GetLastError;
      exit;
      end;

   result := 0;
   BufPos := 0;
   move (UserData[lpIndex], l, PosSize);
   l := l + BufEnd;
   move (l, UserData[lpIndex], PosSize);
   BufEnd := NumRead;
   end
end;

function TextIgnore (var t: TTextRec): integer;
begin;
   result := 0;
end;

function TextClose (var t: TTextRec): integer;
begin
   CloseHandle(t.handle);
   t.Mode := fmClosed;
   result := GetLastError;
end;

function TextOpen (var t: TTextRec): integer;
var
{$ifdef D4}
   DAccess   : cardinal;
   ShareMode : cardinal;
   pSecurity : PSecurityAttributes;
   CreatDist : cardinal;
   FlagsnAttr: cardinal;
   HTempl    : cardinal;
{$else}
   DAccess   : integer;
   ShareMode : integer;
   pSecurity : PSecurityAttributes;
   CreatDist : integer;
   FlagsnAttr: integer;
   HTempl    : integer;
{$endif}
begin
   result := 1;
   with t do
   begin
   if      (t.Mode = fmInput) then
      begin
      t.InOutFunc := @TextInput;
      t.FlushFunc := @TextIgnore;
      t.CloseFunc := @TextClose;
      DAccess   := GENERIC_READ;
      ShareMode := FILE_SHARE_READ;
      pSecurity := nil;
      CreatDist := OPEN_EXISTING;
      FlagsnAttr:= FILE_ATTRIBUTE_READONLY;
      HTempl    := 0;
      t.Handle := CreateFile(@t.Name[0], DAccess, ShareMode, pSecurity, CreatDist,
                     FlagsnATtr, HTempl);
      if (t.handle = INVALID_HANDLE_VALUE) then
         begin
         result := GetLastError;
         exit;
         end
      else
         begin
         t.BufPos := 0;
         t.BufEnd := 0;
         FillChar (t.UserData[1], SizeOf(t.UserData), 0);
         result := TextInput (t);
         end
      end

   else if (t.Mode = fmOutput) then
      begin;
      t.InOutFunc := @TextIgnore;
      t.FlushFunc := @TextIgnore;
      t.CloseFunc := @TextClose;
      end

   else if (t.Mode = fmInOut) then
      begin;
      t.Mode      := fmOutput;
      t.InOutFunc := @TextIgnore;
      t.FlushFunc := @TextIgnore;
      t.CloseFunc := @TextClose;
      end;

   end

end;

procedure AssignText (var T: text; FName: String);
var
   len   : cardinal;
begin
   with TTextRec(T) do
   begin
   handle   := -1;
   Mode     := fmClosed;
   BufSize  := sizeof(Buffer);
   BufPtr   := @Buffer;
   FlushFunc:= @TextIgnore;
   OpenFunc := @TextOpen;
   CloseFunc:= @TextClose;
   len := length(FName);
   move (Fname[1], Name[0], len);
   Name[len]:= #0;
   end;
end;

function  FilePosText (var T: text): cardinal;
var
   l   : cardinal;
begin
   move (TTextRec(t).UserData[lpIndex], l, PosSize);
   result := l + TTextRec(t).BufPos;
end;

procedure SeekText (var T: text; const N: cardinal);
var
   l    : cardinal;
begin
   with TTextRec(t) do
   begin
   move (UserData[lpIndex], l, PosSize);
   if ((N >= l) and (N < l+BufEnd)) then
      begin // Desired position within current buffer; readjust current position
      BufPos := N - l;
      end
   else
      begin // Desired position outside current buffer; read in different segment
      l := BufSize * (N div BufSize);
      move (l, UserData[lpIndex], PosSize);
      l := SetFilePointer (Handle, l, nil, FILE_BEGIN);
      BufEnd := BufSize;
      TextInput (TTextRec(t));
      BufPos := N mod BufSize;
      end;
   end;
end;

end.