home *** CD-ROM | disk | FTP | other *** search
/ World of Shareware - Software Farm 2 / wosw_2.zip / wosw_2 / PASCAL / RLINE.ZIP / RLINE.PAS < prev    next >
Pascal/Delphi Source File  |  1989-10-10  |  14KB  |  433 lines
  1. {$A+,B-,D+,E-,F-,I-,L+,N-,O-,R-,S-,V-}
  2. {$M 16384,0,655360}
  3.  
  4. Unit RLINE;
  5.  
  6. (*********************************************************************
  7.                    Fast disk file text reading operations.
  8.  
  9.         Address comments, complaints, suggestions on CompuServe to
  10.                        Don Strenczewilk [72617,132]
  11.  
  12.  
  13.     This unit contains a fast reading object designed for high speed
  14.     reading standard ASCII disk files.
  15.  
  16.     The RLINE unit uses about 600 bytes of your programs code space,
  17.     and 0 data.
  18.  
  19.     All of RLobject's methods return the result of their operation in
  20.     the RFerror field, except for methods: FFilePos and FClose, which
  21.     have no error codes.  RFerror should be checked after each call to
  22.     one of the methods that set it, because it is re-set with each
  23.     method call.
  24.  
  25. **********************************************************************)
  26.   Interface
  27. (*********************************************************************)
  28.  
  29. USES
  30.   DOS;
  31.  
  32. TYPE
  33.   RFobject = OBJECT
  34.       _Handle  : Word;        { File handle }
  35.       _BufPtr  : Pointer;     { BufOfs, BufSeg}
  36.       _Bpo,                   { Current buffer position }
  37.       _BSize,                 { Buffer size in bytes }
  38.       _BLeft,                 { Bytes left in buffer to scan }
  39.       _NBufs   : Word;        { Number of buffers read. = 0 if none. }
  40.       _TotBytesInBuf : Word;  { Total bytes that were read into current buffer.}
  41.       RFerror : Word;          { RFobject's IOResult }
  42.  
  43.       PROCEDURE FOpen(Fn      : STRING;  { Name of file to open. }
  44.               DBSize  : Word;     { Size of buffer. 512 bytes minimum. }
  45.               VAR BufP);          { Disk buffer to use. }
  46.       PROCEDURE FClose;
  47.       PROCEDURE FReadLn(VAR S : STRING); { String variable to read next line to. }
  48.       PROCEDURE FRead(VAR Ch  : Char);  { Char variable to read next line to. }
  49.       FUNCTION FFilePos : LongInt;
  50.       PROCEDURE FSeek(FPo : LongInt);
  51.   END;
  52.  
  53.  
  54.   RFextendedP = ^RFextended;
  55.   RFextended = Object(RFobject)
  56.     FileName : string[80];
  57.  
  58.     CONSTRUCTOR Init(Fn : STRING;      { Name of file to open. }
  59.              DBSize : Word;       { Size of buffer. }
  60.              VAR BufP);           { Address of disk buffer }
  61.     Destructor Done;
  62.     FUNCTION FileSize : LongInt;
  63.     Function RFerrorString : string;
  64.     PROCEDURE Reset;
  65.   END;
  66.  
  67. TYPE
  68.   BufRec = Record
  69.     Lno : LongInt; { The first line number in the buffer }
  70.     FP : LongInt;  { file position of first line in buffer. }
  71.   END;
  72.  
  73. CONST
  74.   MaxBufs = 8191;
  75.  
  76. TYPE
  77.   BufferArray = Array[1..MaxBufs] OF BufRec;
  78.  
  79. { When FileOfLines is initialized with SizeForBuffer = 256, it can index
  80.   files up to 2,096,896 bytes long.
  81. { With SizeForBuffer = 4096, it will handle files up to 33,550,336 bytes. }
  82.  
  83.   FileOfLinesPtr = ^FileOfLines;
  84.   FileOfLines = Object(RFextended)
  85.     TBuf : Pointer;        { Disk buffer pointer. }
  86.     BufSize : Integer;        { Disk buffer size. }
  87.     LastLineNum : LongInt;      { Last line number accessed. }
  88.     LastLine : String;          { Last line read. }
  89.     TotalLines : LongInt;       { Total lines in file. }
  90.     BufRay : ^BufferArray;      { Index of buffers for paging. }
  91.     NBuffers : Integer;
  92.  
  93.     Constructor Init(FN : String;
  94.              SizeForBuffer : Word);
  95.     Destructor Done;
  96.     PROCEDURE SeekLine(Row : LongInt);
  97.   END;
  98.  
  99. (*---------------------------------------------------------------------
  100. PROCEDURE RFobject.FOpen
  101.  
  102. A file must first be successfully opened with a call to FOpen, before any of
  103. the other routines are used.
  104.  
  105. A buffer must be declared to be passed the FOpen.  There are no restrictions
  106. on the location of the buffer, so it can be a global or local variable, or
  107. allocated with New() or GetMem().
  108.  
  109.  
  110. PROCEDURE FOpen(Fn  : STRING;  { Name of file to open. }
  111.         DBSize : Word; { Size of buffer. 512 bytes minimum. }
  112.         VAR BufP);     { Disk buffer to use. }
  113.  
  114.   If successful:
  115.     Sets RFerror to 0.
  116.  
  117.   If not successful:
  118.     Sets RFerror to DOS error code if a DOS error occured,
  119.     or error 12 (Invalid File Access Code) if the buffer size is 0.
  120.  
  121. NOTES:
  122.   The SYSTEM unit FileMode variable is used as the DOS File Access Mode
  123.   passed to DOS function $3D, to open the file.  Actually, the low 3 bits
  124.   are set to zero, specifying Read-Only access, but the high 5 file
  125.   sharing bits are passed.
  126.  
  127. TRAPS:
  128.   If using a buffer allocated with New() or GetMem(), be sure to use the
  129.   caret after it for the BufP parameter. Ie. RF.FOpen(Fn, BSize, BufP^);
  130.  
  131. Never call FOpen twice with the same RFobject variable without calling
  132. FCLOSE first.
  133.  
  134. EXAMPLE:
  135. VAR
  136.   RF : RFobject;
  137.   Buffer : Array[1..2048] of Char;
  138. BEGIN
  139.   System.FileMode := 0;
  140.   RF.FOpen('HELLO.PAS', Sizeof(Buffer), Buffer);
  141.   If RFerror = 0
  142.   THEN Writeln('Success')
  143.   ELSE Writeln('Error: ', i);
  144. ...
  145.  
  146. --------------------------------------------------------------------------
  147. PROCEDURE RFobject.FClose  - When done with the file, it must be closed 
  148.                  with a call to FClose:
  149.  
  150. PROCEDURE FClose;
  151.  
  152. Closes previously opened RFrec.
  153. Returns nothing.
  154.  
  155. This procedure attempts to identify whether the file has been previously
  156. opened before it attempts to ask DOS to close it.  It does not attempt to
  157. close the file if:
  158.  
  159.  a) RF.BSize = 0. PROCEDURE FOpen sets RF.BSize to 0 if DOS open failed.
  160. or
  161.  b) RF.Handle < 5, in which case it would be a standard DOS handle, which
  162.     shouln't be closed.
  163.  
  164. TRAP: A problem that could occur with this scheme would be if (the file was
  165. never even attempted to be opened by FOpen) AND (the handle = the handle of
  166. a file that is currently opened somewhere else in the program).
  167.  
  168. ----------------------------------------------------------------------
  169. PROCEDURE RFobject.FReadLn
  170.  
  171. FReadLn - Reads a string of characters up to the next ^M, or
  172.       the physical end of file, whichever comes first.
  173.       ^Z is ignored if it occurs at the end of the file.
  174.       If a ^Z appears before the end of the file, it is passed
  175.       on to "S".
  176.  
  177.       VAR "S", which receives the string, MUST be of TYPE STRING
  178.       or STRING[255].
  179.  
  180.       The maximum length of the string returned to caller is 255
  181.       characters.  If more than 255 characters are passed in the
  182.       file before ^M or <EOF>, the remaining characters are
  183.       discarded.
  184.  
  185.  
  186. PROCEDURE FReadLn(VAR S   : STRING); { String variable to read next line to. }
  187.  
  188. On success:
  189.   Sets RFerror to 0.
  190.   S = next string read from file RF.Handle.
  191. On failure:
  192.   Sets RFerror to DOS error code,
  193.   or $FFFF if End of File
  194.  
  195. Works like a Turbo Pascal Readln(F, S); except:
  196.     (1) It works only with disk files.
  197.     (2) Only reads type STRING. ie. not integers, words, or any other type.
  198.     (3) It is much faster.
  199.     (4) Doesn't stop when a ^Z is encountered before end of file.  If a ^Z
  200.     is encountered AT the end of file, it is stripped.  Any ^Z's
  201.     encountered before the physical end of the file are passed on
  202.     to the string.
  203.     (5) RFerror is set to $FFFF after calling this if the physical
  204.     end of file is reached.  The value of "S" is invalid when the
  205.     $FFFF end of file result is set.
  206.  
  207. ----------------------------------------------------------------------
  208. PROCEDURE RFobject.FRead - Reads the next character from the file:
  209.  
  210. PROCEDURE FRead(VAR Ch  : Char);  { Char variable to read next line to. }
  211.  
  212. Works the same as FReadLn but returns one character instead of a string.
  213. All characters are passed on to Ch except ^Z if it occurs at end of file.
  214. Any ^Z found before the physical end of file is passed on to Ch.
  215.  
  216. If successful:
  217.   Sets RFerror to 0.
  218.   Ch = next character in the file.
  219.  
  220. If failed:
  221.   Sets RFerror to either DOS error code,
  222.   or $FFFF if physical End of File
  223.  
  224. ----------------------------------------------------------------------
  225. Function RFobject.FFilePos - Returns current file position for use with FSeek.
  226.  
  227. FUNCTION FFilePos : LongInt;
  228.  
  229. Returns current file position. RF must have been previously opened.
  230. If FFilePos is called before FOpen is called successfully, the results
  231. will be meaningless.
  232.  
  233. ----------------------------------------------------------------------
  234. PROCEDURE RFobject.FSeek - Seeks to position FPo in previously opened RF.
  235.  
  236. PROCEDURE FSeek(FPo : LongInt) : Word;
  237.  
  238. If successful,
  239.   RFerror is set to 0.
  240.  
  241. If failed,
  242.   RFerror is set to DOS error code.
  243.  
  244. To Reset the file, call RFSeek with FPo := 0.  Ie. FSeek(0);
  245.  
  246. On a normal ^M^J ascii file, FFilePos will most often return the position of
  247. the ^J after a call to FReadLn.  Because FReadLn strips leading ^J's, this
  248. shouldn't be a problem.  But, bear that in mind if using the FFilePos
  249. results for your own untyped file routines.
  250.  
  251. (****************************************************************************)
  252. Implementation
  253. (****************************************************************************)
  254.  
  255. { RFOBJECT ----------------------------------------------------------------}
  256.  
  257.   {$L RLINE.OBJ}
  258.   PROCEDURE RFobject.FOpen(Fn    : STRING;
  259.                DBSize : Word;
  260.                VAR BufP); EXTERNAL;
  261.   PROCEDURE RFobject.FClose; EXTERNAL;
  262.   PROCEDURE RFobject.FReadLn(VAR S : STRING); EXTERNAL;
  263.   PROCEDURE RFobject.FRead(VAR Ch : Char); EXTERNAL;
  264.   PROCEDURE RFobject.FSeek(FPo : LongInt); EXTERNAL;
  265.   FUNCTION RFobject.FFilePos : LongInt; EXTERNAL;
  266.  
  267. { RFEXTENDED --------------------------------------------------------------}
  268.  
  269.   CONSTRUCTOR RFextended.Init(Fn : STRING;   { Name of file to open. }
  270.                   DBSize : Word; { Size of buffer. }
  271.                   VAR BufP);     { Address of disk buffer }
  272.   BEGIN
  273.     FileName := FExpand(Fn);
  274.     FOpen(Fn, DBSize, BufP);
  275.   END;
  276.  
  277.   FUNCTION RFextended.FileSize : LongInt;
  278.   VAR
  279.     r : registers;
  280.     Fpos : LongInt;
  281.   BEGIN
  282.     FPos := FFilePos; { save current file position }
  283.     with r do begin
  284.       ax := $4202;
  285.       bx := _handle;
  286.       cx := 0;
  287.       dx := 0;
  288.       msdos(r);
  289.       if flags and fcarry <> 0
  290.       then RFerror := ax
  291.       else FileSize := (longint(dx) shl 16) or ax;
  292.     end;
  293.     _TotBytesInBuf := 0;  { Force FSeek to move file pointer. }
  294.     FSeek(FPos);          { restore current file position }
  295.   END;
  296.  
  297.   Function RFextended.RFerrorString : string;
  298.     { Converts RFerror to a string. }
  299.   VAR
  300.     S : STRING[80];
  301.   BEGIN
  302.     CASE RFerror OF
  303.       0 : S := 'Success';           { it's not an error. }
  304.       100 : S := 'Attempted to read past End Of File.';
  305.       101 : S := 'Disk write error.';
  306.       102 : S := 'File not assigned.';
  307.       103 : S := 'File not opened.';
  308.       104 : S := 'File not open for input.';
  309.  
  310.       2 : S := 'File not found.';
  311.       3 : S := 'Path not found.';
  312.       4 : S := 'Too many files opened.';
  313.       5 : S := 'File access denied.';
  314.       6 : S := 'Invalid file handle.';
  315.       $FFFF : S := 'End Of File.'; { special EOF number, unique to FRead and FReadln }
  316.       200 : s := 'Divide by zero.  Buffersize = 0?';
  317.     ELSE BEGIN
  318.        Str(RFerror, S);
  319.            S := 'IOerror '+S;
  320.          END;
  321.     END;
  322.     RFerrorString := S;
  323.   END;
  324.  
  325.   PROCEDURE RFextended.Reset;
  326.   BEGIN
  327.     FSeek(0);
  328.   END;
  329.  
  330.   DESTRUCTOR RFextended.Done;
  331.   BEGIN
  332.     Fclose;
  333.   END;
  334.  
  335. { FILEOFLINES -------------------------------------------------------}
  336.  
  337.   Constructor FileOfLines.Init(FN : string; SizeForBuffer : Word);
  338.   VAR
  339.     F : File;
  340.     L, RamNeeded, FSize : LongInt;
  341.     BufNum : Word;
  342.   BEGIN
  343.     TBuf := nil;
  344.     BufRay := nil;
  345.     LastLineNum := 0;
  346.     LastLine := '';
  347.     TotalLines := 0;
  348.  
  349.     If MaxAvail > SizeForBuffer            { create the disk buffer }
  350.     THEN BufSize := SizeForBuffer
  351.     ELSE BufSize := MaxAvail;
  352.     If BufSize >= 256
  353.     Then GetMem(TBuf,BufSize)
  354.     Else Fail;
  355.  
  356.     FileName := FExpand(Fn);            { open the file. }
  357.     FOpen(FileName, BufSize, TBuf^);
  358.     IF RFError = 0
  359.     THEN FSize := FileSize;
  360.  
  361.     IF RFerror <> 0 THEN
  362.       Exit;  { Don't fail so RFerror can be polled in calling routine. }
  363.  
  364.     NBuffers := ((FSize DIV BufSize) + 1); { allocate ram for bufferarray }
  365.     RamNeeded := NBuffers * SizeOf(BufRec);
  366.     If (MaxAvail < RamNeeded) OR (NBuffers > MaxBufs) THEN BEGIN
  367.       Done;
  368.       Fail;
  369.     END;
  370.     GetMem(BufRay, RamNeeded);
  371.  
  372.     { Index the file. }
  373.     BufNum := 1;
  374.     With BufRay^[1] Do BEGIN
  375.       Lno := 1;
  376.       FP := 0;
  377.     END;
  378.  
  379.     FReadLn(LastLine);
  380.     While RFerror = 0 DO BEGIN
  381.       Inc(TotalLines);
  382.       IF (_NBufs > BufNum) AND (BufNum < NBuffers) Then BEGIN
  383.     Inc(BufNum);
  384.     With BufRay^[BufNum] DO BEGIN
  385.       Lno := Succ(TotalLines);
  386.       FP := FFilePos;
  387.     END;
  388.       END;
  389.       FReadLn(LastLine);
  390.     END;
  391.  
  392.     IF RFError = $FFFF { make it to EOF with no problems? }
  393.     THEN Reset;
  394.   END;
  395.  
  396.   Destructor FileOfLines.Done;
  397.   BEGIN
  398.     If BufRay <> nil Then Freemem(BufRay,NBuffers * SizeOf(BufRec));
  399.     If TBuf <> nil Then FreeMem(TBuf,BufSize);
  400.     BufRay := nil;
  401.     TBuf := nil;
  402.     FClose;
  403.   END;
  404.  
  405.   PROCEDURE FileOfLines.SeekLine(Row : LongInt);
  406.   { Seeks and reads row and puts in string LastLine }
  407.   VAR
  408.     i : Integer;
  409.   BEGIN
  410.     If Row > TotalLines THEN BEGIN
  411.       RFerror := 100; { Attempt to read past end of file. }
  412.       Exit;
  413.     END;
  414.     IF (Row <> LastLineNum+1) THEN BEGIN
  415.       i := 2;
  416.       While (i <= NBuffers) AND (BufRay^[i].Lno < Row) Do Inc(i);
  417.       Dec(i);
  418.       With BufRay^[i] DO BEGIN
  419.     FSeek(FP);
  420.     IF RFerror = 0 THEN BEGIN
  421.       FReadLn(LastLine);
  422.       LastLineNum := Lno;
  423.     END;
  424.       END;
  425.     END;
  426.     While (RFerror = 0) AND (LastLineNum < Row) DO BEGIN
  427.       FReadLn(LastLine);
  428.       Inc(LastLineNum);
  429.     END;
  430.   END;
  431.  
  432. END.
  433.