home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Simtel MSDOS 1992 June
/
SIMTEL_0692.cdr
/
msdos
/
pcmag
/
vol7n12.arc
/
SEEKTEXT.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1988-04-28
|
2KB
|
67 lines
PROGRAM SeekToTextDemo;
FUNCTION SeekToText(VAR TextFile : Text; OffSet : Real) : Integer;
TYPE {see the Turbo Pascal 3.X reference manual for the FIB layout}
FIBtype = RECORD
Handle, RecLength, BufOff, BufSize, BufPtr, BufEnd : Integer;
FilePath : ARRAY[1..64] OF Char;
END; {FIBtype}
VAR
ByteFile : FILE OF Byte ABSOLUTE TextFile;
FIB : FIBtype ABSOLUTE TextFile;
SaveRL : Integer;
BEGIN {SeekToText}
WITH FIB DO
BEGIN
SaveRL := RecLength; {RecLength actually holds flags and}
{maybe a char from the text file}
RecLength := 1; {A byte file "record" is one byte}
{$I-} LongSeek(ByteFile, OffSet); {$I+}
SeekToText := IOResult; {The caller must deal with IO errors}
RecLength := SaveRL; {restore values for the text file}
BufPtr := BufEnd; {force next Read/ReadLn to refill buffer}
END;
END; {PROCEDURE SeekToText}
VAR
DemoFile : Text;
i, j : Integer;
MaxLine : STRING[255];
CONST
DFOffsets : ARRAY[1..4] OF Real = (95, 0, 143, 43);
DFName = 'DEMOFILE.TXT';
BEGIN {SeekToTextDemo}
Assign(DemoFile, DFName);
{$I-} Reset(DemoFile); {$I-}
IF IOResult <> 0 THEN
BEGIN
WriteLn('Failed to open ', DFName);
Halt(IOResult);
END; {if IOResult <> 0}
FOR i := 1 TO 4 DO
BEGIN
j := SeekToText(DemoFile, DFOffsets[i]);
IF j <> 0 THEN
BEGIN
WriteLn('SeekToText failure with DFOffsets[', i, ']');
Halt(j);
END {j <> 0}
ELSE
BEGIN {j = 0}
ReadLn(DemoFile, MaxLine);
WriteLn(MaxLine);
END; {j = 0}
END; {for i := 1 to 4}
WriteLn;
{$I-} Close(DemoFile); {$I-}
IF IOResult <> 0 THEN
BEGIN
WriteLn('Failed to close ', DFName);
Halt(IOResult);
END; {if IOResult <> 0}
WriteLn('All operations concluded successfully.')
END.