home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
C!T ROM 2
/
ctrom_ii_b.zip
/
ctrom_ii_b
/
PROGRAM
/
PASCAL
/
PAS_0593
/
RB.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1993-05-30
|
7KB
|
252 lines
{─ Fido Pascal Conference ────────────────────────────────────────────── PASCAL ─
Msg : 389 of 412
From : Steve Gabrilowitz 1:363/1701.0 15 May 93 21:59
To : Jeff Carney
Subj : HELP! - File Pos.
────────────────────────────────────────────────────────────────────────────────
In a message to All <05-13-93 02:01> Jeff Carney wrote:
JC> Can anyone help me figure out how I can move a TEXT file position
JC> pointer backwards instead of forwards?
I have a little file on my board that purports to read a text file backwards, I
have never tried it but since it's so small I'll just post it here. The ZIP
contains two files, RB.PAS and TESTRB.PAS. First, RB.PAS:}
{$R-,S-,I-}
{
Turbo Pascal 4.0 unit to read text files backwards.
See TESTRB.PAS for a test and demonstration program. Routines here
are used in a manner very similar to normal text file read routines
except that the "reset" positions to the end of the file, and each
subsequent "readln" returns the prior line in the file until the
beginning of the file is reached.
Each string returned by ReadLnBack is in normal forward order.
One quirk will occur if an attempt is made to read from files with
lines longer than 255 characters. In this case ReadLnBack will return
the _last_ 255 characters of each such line rather than the first. This
is in keeping with the backwards nature of the unit, however.
Hope someone finds a use for this!
Written 6/7/88, Kim Kokkonen, TurboPower Software.
Released to the public domain.
}
unit RB;
{-Read text files backwards}
interface
type
BackText = file; {We use the UserData area in the untyped file
procedure AssignBack(var F : BackText; Fname : string);
{-Assign a backwards file to a file variable}
procedure ResetBack(var F : BackText; BufSize : Word);
{-Reset a backwards file, allocating buffer space (128 bytes or greater)}
procedure ReadLnBack(var F : BackText; var S : string);
{-Read next line from end of backwards file}
procedure CloseBack(var F : BackText);
{-Close backwards file, releasing buffer}
function BoF(var F : BackText) : Boolean;
{-Return true when F is positioned at beginning of file}
function BackResult : Word;
{-Return I/O status code from operation}
{======================================================================}
implementation
const
LF = #10;
type
BufferArray = array[1..65521] of Char;
BackRec = {Same as Dos.FileRec, with UserData filled in
record
Handle : Word;
Mode : Word;
RecSize : Word;
Private : array[1..26] of Byte;
Fpos : LongInt; {Current file position}
BufP : ^BufferArray; {Pointer to text buffer}
Bpos : Word; {Current position within buffer}
Bcnt : Word; {Count of characters in buffer}
Bsize : Word; {Size of text buffer, 0 if none}
UserData : array[15..16] of Byte; {Remaining UserData}
Name : array[0..79] of Char;
end;
var
BResult : Word; {Internal IoResult}
procedure AssignBack(var F : BackText; Fname : string);
{-Assign a backwards file to a file variable}
begin
if BResult = 0 then begin
Assign(file(F), Fname);
BResult := IoResult;
end;
end;
procedure ResetBack(var F : BackText; BufSize : Word);
{-Reset a backwards file, allocating buffer}
var
BR : BackRec absolute F;
begin
if BResult = 0 then
with BR do begin
{Open file}
Reset(file(F), 1);
BResult := IoResult;
if BResult <> 0 then
Exit;
{Seek to end}
Fpos := FileSize(file(F));
Seek(file(F), Fpos);
BResult := IoResult;
if BResult <> 0 then
Exit;
{Allocate buffer}
if BufSize < 128 then
BufSize := 128;
if MaxAvail < BufSize then begin
BResult := 203;
Exit;
end;
GetMem(BufP, BufSize);
Bsize := BufSize;
Bcnt := 0;
Bpos := 0;
end;
end;
function BoF(var F : BackText) : Boolean;
{-Return true when F is at beginning of file}
var
BR : BackRec absolute F;
begin
with BR do
BoF := (Fpos = 0) and (Bpos = 0);
end;
function GetCh(var F : BackText) : Char;
{-Return next character from end of file}
var
BR : BackRec absolute F;
Bread : Word;
begin
with BR do begin
if Bpos = 0 then
{Buffer used up}
if Fpos > 0 then begin
{Unread file remains, first reposition file pointer}
Bread := Bsize;
Dec(Fpos, Bread);
if Fpos < 0 then begin
{Reduce the number of characters to read}
Inc(Bread, Fpos);
Fpos := 0;
end;
Seek(file(F), Fpos);
BResult := IoResult;
if BResult <> 0 then
Exit;
{Refill buffer}
BlockRead(file(F), BufP^, Bread, Bcnt);
BResult := IoResult;
if BResult <> 0 then
Exit;
{Remove ^Z's from end of buffer}
while (Bcnt > 0) and (BufP^[Bcnt] = ^Z) do
Dec(Bcnt);
Bpos := Bcnt;
if Bpos = 0 then begin
{At beginning of file}
GetCh := LF;
Exit;
end;
end else begin
{At beginning of file}
GetCh := LF;
Exit;
end;
{Return next character}
GetCh := BufP^[Bpos];
Dec(Bpos);
end;
end;
procedure ReadLnBack(var F : BackText; var S : string);
{-Read next line from end of backwards file}
var
Slen : Byte absolute S;
Tpos : Word;
Tch : Char;
T : string;
begin
Slen := 0;
if (BResult = 0) and not BoF(F) then begin
{Build string from end backwards}
Tpos := 256;
repeat
Tch := GetCh(F);
if BResult <> 0 then
Exit;
if Tpos > 1 then begin
Dec(Tpos);
T[Tpos] := Tch;
end;
{Note that GetCh arranges to return LF at beginning of file}
until Tch = LF;
{Transfer to result string}
Slen := 255-Tpos;
if Slen > 0 then
Move(T[Tpos+1], S[1], Slen);
{Skip over (presumed) CR}
Tch := GetCh(F);
end;
end;
procedure CloseBack(var F : BackText);
{-Close backwards file, releasing buffer}
var
BR : BackRec absolute F;
begin
if BResult = 0 then
with BR do begin
Close(file(F));
BResult := IoResult;
if BResult <> 0 then
Exit;
FreeMem(BufP, Bsize);
end;
end;
function BackResult : Word;
{-Return I/O status code from operation}
begin
BackResult := BResult;
BResult := 0;
end;
begin
BResult := 0;
end.