Category : Pascal Source Code
Archive   : RLINE-OP.ZIP
Filename : RLTEST.PAS
{ Test program for the RLINE unit.
Does a speed comparison between FReadLn and ReadLn,
a file position/seek test,
and types a file to the screen.
Test with different files and buffer sizes (CONST BS, below).
}
USES
DOS, CRT, RLINE;
{ Global constants and variables.}
CONST
BS = 8192; { Disk Buffer size. }
TYPE
RFtester = Object(RFextended)
PROCEDURE CheckRFerror; virtual;
END;
PROCEDURE RFtester.CheckRFerror;
{ Displays some of the common errors, and waits for a keypress. }
VAR
S : STRING[80];
BEGIN
IF RFerror = 0 then exit;
WriteLn(RFerrorString);
IF (RFerror <> $FFFF)
THEN Halt(1);
END;
VAR
TBuf : ARRAY[1..BS] OF Char;
PROCEDURE PressAnyKey;
BEGIN
Writeln('Press any key.');
While ReadKey = #0 Do ;
END;
{ Timing routine. Derived from Neil Rubenking's TIMER.PAS in LIB 4. }
TYPE
OnOrOff = (On, Off);
VAR
start, time : Real;
PROCEDURE timer(O : OnOrOff);
VAR
hour, min, sec, hun : Word;
BEGIN
GetTime(hour, min, sec, hun);
time := hour*3600+min*60+sec+hun/100;
CASE O OF
On : start := time;
Off : BEGIN
time := time-start;
Write('Time: ', time:6:2, ' ');
END;
END;
END;
(************************************************************************)
PROCEDURE PrepForTimingTest(Fn : STRING);
{ Opens and read Fn, before doing the FReadLn/ReadLn timing tests.
Otherwise, the order the two tests are performed produces different
results ( probably because the disk heads start in different positions,
and maybe second test benefits from using previously filled DOS buffers. }
VAR
i : Integer;
j : LongInt;
RF : RFtester;
S : String;
BEGIN
WriteLn('Reading file to prepare for timing tests..');
RF.Init(Fn, BS, TBuf);
RF.CheckRFerror;
WHILE RF.RFerror = 0 DO RF.FReadLn(S);
RF.Done;
END;
PROCEDURE ReadLnTest(Fn : STRING);
{ Time comparison between FReadLn and ReadLn }
VAR
NLines : LongInt;
Ch : char;
RF : RFtester;
S : String;
F : Text;
i : Integer;
BEGIN
{Test FReadLn}
IF Not RF.Init(Fn, BS, TBuf) THEN BEGIN
Writeln('Not enough memory.');
Halt(1);
END;
RF.CheckRFerror;
Writeln('FReadLn timing test: Reading strings from ', Fn, '.. ');
NLines := 0;
timer(On);
RF.FReadLn(S);
While RF.RFerror = 0 DO BEGIN
Inc(NLines);
RF.FReadLn(S);
END;
RF.CheckRFerror;
timer(Off); WriteLn;
Writeln(NLines, ' lines were read.');
WriteLn;
{Test TP ReadLn}
Assign(f, Fn);
Reset(f);
RF.RFerror := IoResult;
RF.CheckRFerror;
WriteLn('ReadLn timing test: Reading strings from ', Fn, '... ');
SetTextBuf(f, TBuf);
NLines := 0;
timer(On);
REPEAT
ReadLn(f, S);
i := IoResult;
IF i = 0
THEN Inc(NLines);
UNTIL EOF(F) OR (i <> 0);
timer(Off); WriteLn;
WriteLn(NLines, ' lines were read. IoResult = ',i);
writeln;
{Test FRead}
RF.Reset;
RF.CheckRFerror;
WriteLn('FRead timing test: Reading chars from ', Fn, '.. ');
NLines := 0;
timer(On);
RF.FRead(ch);
While RF.RFerror = 0 DO BEGIN
Inc(NLines);
RF.FRead(ch);
END;
timer(Off); WriteLn;
Write(NLines, ' chars were read.');
RF.CheckRFerror;
RF.Done;
END;
PROCEDURE TypeFile(Fn : STRING);
{ TYPE a file to the screen. A useless procedure except that it
demonstrates using a buffer allocated on the heap to be used by RLINE. }
VAR
RF : RFtester; { Declare RFrec variable. }
TBuf : Pointer;
S : String;
BEGIN
ClrScr;
GetMem(TBuf, BS); { First, allocate memory for the buffer. }
{ Be certain to insert the ^ in TBuf^ when opening the file. }
RF.Init(Fn, BS, TBuf^); { try to open the file. }
RF.CheckRFerror;
RF.FReadLn(S);
While RF.RFerror = 0 DO BEGIN
IF keypressed AND (readkey = ^S) { if user pressed ^S, then pause }
THEN IF readkey <> #0 THEN ; { the display by forcing a keypress. }
WriteLn(S); { if no error, then display the line. }
RF.FReadLn(S); { Attempt to read the next line from the file. }
END;
RF.CheckRFerror;
RF.Done;
FreeMem(TBuf, BS); { Deallocate memory for the buffer. }
END;
PROCEDURE PositioningTest(Fn : STRING);
VAR
NLines, lno : LongInt;
ch : Char;
RF : RFtester;
S : String;
BEGIN
ClrScr;
WriteLn(' Pos Line Pos Line Pos Line Pos Line Pos Line');
RF.Init(Fn, BS, TBuf); { Open Fn }
RF.CheckRFerror;
window(1, 2, 80, 25);
NLines := 0;
Write(RF.FFilepos:8, NLines:8);
RF.FReadLn(S);
While RF.RFerror = 0 Do BEGIN
Inc(NLines);
Write(RF.FFilepos:8, NLines:8);
RF.FReadLn(S);
END;
WriteLn(^j^j^j^j);
window(1, 21, 80, 25);
REPEAT
Write('(10000 to quit) Seek to: '); ReadLn(lno);
RF.fseek(lno);
IF RF.RFerror = 0 THEN BEGIN
RF.FRead(ch); RF.CheckRFerror;
WriteLn('Char is: #', Ord(ch));
RF.fseek(lno); RF.CheckRFerror;
RF.FReadLn(S); RF.CheckRFerror;
WriteLn(S);
END ELSE Writeln(RF.RFerrorString);
UNTIL lno = 10000;
RF.Done;
window(1, 1, 80, 25);
END;
BEGIN
WriteLn;
IF ParamCount = 0 THEN BEGIN
Write('You must specify a Filename on command line.');
Halt(1);
END;
PrepForTimingTest(ParamStr(1));
ReadLnTest(ParamStr(1));
Pressanykey;
IF ParamCount > 1
THEN PositioningTest(ParamStr(2))
ELSE PositioningTest(ParamStr(1));
TypeFile(ParamStr(1));
END.
Very nice! Thank you for this wonderful archive. I wonder why I found it only now. Long live the BBS file archives!
This is so awesome! 😀 I’d be cool if you could download an entire archive of this at once, though.
But one thing that puzzles me is the “mtswslnkmcjklsdlsbdmMICROSOFT” string. There is an article about it here. It is definitely worth a read: http://www.os2museum.com/wp/mtswslnk/