unit TextIO;
{ useful text i/o features with turbo pascal:
1. large text buffers for speedier handling when needed
2. complete seek function for text files
3. write formatted output to a string variable
4. read contents of a string variable as formatted input
5. backup to the previous line of a file (if possible)
language: turbo pascal macintosh "(*MAC- -MAC*)" comments
or: turbo pascal 4.0 ibm. "(*IBM- -IBM*)" comments
by d.g.gilbert
dogStar software
po box 302, bloomington, in 47402
compuserve 71450,1570
Translated to a unit by Mike Babulic, (Jan.25,1989)
3827 Charleswood Dr. N.W.
Calgary, Alberta, CANADA
T2L 2C7
compuserve: 72307,314
NOTE: 1) This unit has been created and tested on MS/DOS only.
----- Porting to the Macintosh will involve some modification,
especially for new additions like "BackLn".
2) Obviously if you do "interesting" things in your programs
you can expect some side-effects the authors couldn't
possibly forsee. Be careful!
MODIFICATION LOG
----------------
88/01/25 - Turned demo program into a unit. (Babulic)
88/01/27 - BackLn procedure added. (Babulic)
}
interface
{$R-} { Turn off range checking }
{$I-} { Turn off I/O error checking }
(*IBM-*)
USES DOS;
TYPE
chars = PACKED ARRAY [0..maxint] OF char;
bufferPtr = ^chars;
procPtr = pointer;
tpFileRec = RECORD {turbo pascal ibm text file record}
handle : word;
mode : word;
fBufSize : word;
private : word;
fBufPos : word;
fBufEnd : word;
fBuffer : bufferPtr;
openFunc : procptr;
inOutFunc: procptr;
flushFunc: procptr;
closeFunc: procptr;
userdata : PACKED ARRAY[1..16] OF byte;
name : PACKED ARRAY [0..79] OF char;
tbuffer : PACKED ARRAY [0..127] OF char; { default buffer}
END;
(*-IBM*)
(*MAC-
USES memTypes, quickDraw, osIntf, toolIntf;
TYPE
chars = PACKED ARRAY [0..maxint] OF char;
bufferPtr = ^chars;
pointer = ^integer;
tpFileRec = RECORD {turbo pascal mac file record }
fInpFlag: boolean;
fOutFlag: boolean;
fRefNum : integer;
fVrefNum: integer;
fBufSize: integer;
fBufPos : integer;
fBufEnd : integer;
fBuffer : bufferPtr;
fInOutProc: procPtr;
END;
-MAC*)
CONST
forOutput = true; forInput = false;
FUNCTION openText( VAR f: text;
fname : STRING;
output: boolean; {true if want a rewrite }
bufsize: integer
): boolean; { true if opened successfully }
PROCEDURE closeText( VAR f: text);
FUNCTION PosText(VAR f:text):LongInt;
TYPE seekType = (seek_set, seek_cur, seek_end);
PROCEDURE seekText( VAR f: text; offset: longInt; seekFrom : seektype);
{ seek for textfiles }
procedure BackLn(var f:Text);
PROCEDURE openStrIO( VAR f: text; VAR s: STRING; out: boolean);
{ assign file input/output to string. }
PROCEDURE closeStrIO( VAR f: text; VAR s: STRING);
{ close stringiO: get length }
{==========================================================================}
implementation
(*IBM-*)
FUNCTION msDosSeek( fh:integer; index:longint; fromwhere:seekType):LongInt;
{ move file pointer to byte index (hiIndx,lowIndx), respective to fromWhere }
TYPE long = record lo,hi:word end;
VAR reg : registers;
l : long;
BEGIN WITH REG DO BEGIN
ah:= $42; { move f^ }
al:= ord(fromwhere);
cx:= long(index).hi; {hiindex}
dx:= long(index).lo; {lowIndex}
bx := fh;
msdos(reg);
IF 0 = (reg.flags AND $01) THEN
msdosSeek:= 0
ELSE BEGIN
l.hi:= dx;
l.lo:= ax;
msdosSeek := longint(l);
END;
END END; { msDosSeek }
(*-IBM*)
{--------------------------------------------------------------------------}
FUNCTION openText( VAR f: text;
fname : STRING;
output: boolean; {true if want a rewrite }
bufsize: integer
): boolean; { true if opened successfully }
VAR abuf: pointer;
err: integer;
BEGIN
(*IBM-*)
assign( f, fname);
{ now change buf to the size we want}
WITH tpfilerec(f) DO BEGIN
getmem( abuf, bufsize);
fBuffer:= abuf;
fBufSize:= bufsize;
END;
IF output THEN rewrite( f) ELSE reset(f);
err:= ioresult;
IF err <> 0 THEN dispose(abuf); {forget it}
openText:= err = 0;
(*-IBM*)
(*MAC-
IF output THEN rewrite( f, fname, bufsize)
ELSE reset( f, fname, bufsize);
openText:= ioresult = 0;
-MAC*)
END; {openText}
PROCEDURE closeText( VAR f: text);
VAR abuf: pointer;
BEGIN
(*IBM-*)
abuf:= tpfilerec(f).fBuffer;
close(f);
dispose(abuf);
(*-IBM*)
END;
FUNCTION PosText(VAR f:text):LongInt;
TYPE long = record lo,hi:word end;
VAR reg : registers;
p : longint;
l : long ABSOLUTE p;
BEGIN
WITH REG DO BEGIN
ah:= $42; { move f^ }
al:= ord(seek_cur);
cx:= 0;
dx:= 0;
bx := tpfilerec(f).handle;
msdos(reg);
l.hi:= dx;
l.lo:= ax;
END;
WITH tpfilerec(f) DO BEGIN
IF mode=fmOutput THEN
PosText := p + fBufPos
ELSE
PosText := p - fBufEnd + fBufPos;
END
END;
(*IBM-*)
CONST strFileName = '$%#temp.tmp';
CONST needStrFile: boolean = true; {1st time open tempFile }
VAR strFile : text; {.ibm -- save file i/o information for strIO}
(*-IBM*)
PROCEDURE openStrIO( VAR f: text; VAR s: STRING; out: boolean);
{ assign file input/output to string. }
BEGIN
(*IBM-*)
IF needStrFile THEN BEGIN
assign(strFile, strFileName);
rewrite(strFile); {<< need this to fill in valid turbo proc ptrs}
tpfilerec(f):= tpfilerec(strFile);
close(strFile); erase(strFile);
tpfilerec(strfile):= tpfilerec(f);
needStrFile:= false;
END;
tpfilerec(f):= tpfilerec(strFile);
WITH tpFileRec(f) DO BEGIN
IF out THEN mode:= fmOutput ELSE mode:= fmInput;
END;
(*-IBM*)
(*MAC-
WITH tpfilerec(f) DO BEGIN
fInpFlag:= NOT out;
fOutFlag:= out;
fRefNum:= 1; {dummy}
fVrefNum:= 1;
fInOutProc:= NIL;
END;
-MAC*)
WITH tpFileRec(f) DO BEGIN
fBuffer:= @s[1];
fBufSize:= 255; {assume it is full string}
IF out THEN fBufEnd:= fBufSize
ELSE fBufEnd:= length(s);
fBufPos:= 0;
END;
END; {openStrIO}
PROCEDURE closeStrIO( VAR f: text; VAR s: STRING);
{ close stringiO: get length }
VAR err: integer;
BEGIN
s[0]:= chr( tpFileRec(f).fBufPos);
END; {closeStrIO}
PROCEDURE seekText( VAR f: text; offset: longInt;
seekFrom : seektype);
{ seek for textfiles }
VAR
count: longint;
iseek: integer;
err : integer;
(*IBM-*)
uf : FILE;
BEGIN
WITH tpFileRec(f) DO BEGIN
offset := offset + fBufPos;
IF handle<0 THEN {nada - not a disk file}
ELSE IF (seekFrom=seek_cur) and (offset>=0)
and ( (mode=fmInput) and (offset<fBufEnd)
or (mode=fmOutput) and (offset<=fBufPos)) THEN
fBufPos := offset
ELSE BEGIN
offset := offset - fBufPos;
IF mode = fmOutput THEN BEGIN
{ flush buffer to disk if seek on output file}
move(f, uf, sizeof(uf)); { need right file type for blockwrite}
fileRec(uf).recsize:= 1;
blockwrite( uf, fBuffer^, fBufPos, err);
fBufPos:= 0;
END;
IF seekFrom = seek_cur THEN
offset:= offset - fBufEnd + fBufPos;
IF 0 = msdosSeek( handle, offset, seekFrom) THEN BEGIN
fBufPos:= 0; fBufEnd:= 0; {next read/write will fill buffer as needed}
END;
END;
END; {with}
(*-IBM*)
(*MAC-
BEGIN
CASE seekFrom OF
seek_set : iseek:= fsFromStart; {offset from 0}
seek_cur : iseek:= fsFromMark;
seek_end : iseek:= fsFromLEOF;
END;
WITH tpFileRec(f) DO
IF fRefNum=0 THEN {not a disk file}
ELSE BEGIN
IF fOutFlag THEN BEGIN { flush buffer to disk if seek on output file}
count:= fBufPos;
err:= fsWrite( fRefNum, count, ptr(fBuffer));
fBufPos:= 0;
END
ELSE IF seekFrom = seek_cur THEN
offset:= offset - fBufEnd + fBufPos;
IF 0 = setFpos( fRefNum, iseek, offset) THEN BEGIN
fBufEnd:= 0; fBufPos:= 0;
END;
END;
-MAC*)
END; {seekText}
procedure BackCh(var f:Text);
var p,q: longint;
ch: char;
begin with tpFileRec(f) do begin
if fBufPos>0 then
SeekText(f,-1,seek_cur)
else
{
if mode=fmOutput then begin
SeekText(f,-1,seek_cur);
end
else } begin
p := PosText(f) - 1;
q := p - fBufSize;
if q<0 then q := 0;
SeekText(f,q,seek_set);
read(f,ch);
SeekText(f,p-1,seek_cur);
end;
end end;
procedure BackLn(var f:Text);
var ch: char;
p: longint;
uf: File;
begin
BackCh(f); {Skip LF}
BackCh(f); {Skip CR}
if tpFileRec(f).mode=fmInput then begin
REPEAT
BackCh(f);
UNTIL eoln(f);
if eof(f) then
SeekText(f,0,seek_set)
else
ReadLn(f);
end
else with tpFileRec(f) do begin
reset(f);
SeekText(f,0,seek_end);
p := PosText(f);
BackLn(f);
p := PosText(f);
close(f);
append(f);
IF 0 = msdosSeek( handle,p,seek_set) THEN BEGIN
fBufPos := 0; fBufEnd := 0;
END;
end;
end;
END.
