home *** CD-ROM | disk | FTP | other *** search
/ World of Shareware - Software Farm 2 / wosw_2.zip / wosw_2 / PASCAL / TBTREE16.ZIP / FILEBUFF.PAS < prev    next >
Pascal/Delphi Source File  |  1989-07-13  |  38KB  |  870 lines
  1. (* TBTree16             Copyright (c)  1988,1989       Dean H. Farwell II    *)
  2.  
  3. unit FileBuff;
  4.  
  5. {$I-}                                         (* turn off I/O error checking *)
  6.  
  7. (*****************************************************************************)
  8. (*                                                                           *)
  9. (*      O P E N  F I L E  B U F F E R  H A N D L I N G  R O U T I N E S      *)
  10. (*                                                                           *)
  11. (*****************************************************************************)
  12.  
  13. (*  This unit handles the opening and closing of files.  It allows a user to
  14.     set a parameter on how many files can be open at a given time and then
  15.     keeps a buffer of open files.  The number of files which are in the
  16.     buffer, and are therefore open, will not exceed this limit.  The limit can
  17.     be changed at any time.  Each time a file is accessed, the list is checked
  18.     to see if the desired file is in the list.  If the file is in the list the
  19.     file id is returned.  If it is not open, it will be opened and the id will
  20.     be returned.  If the number of files currently open is equal to the
  21.     maximum the least recently accessed file will be closed prior to opening
  22.     the desired file.
  23.  
  24.     The primary advantage to using this unit is that the user does not have to
  25.     worry about opening too many files and causing a runtime error.  If all
  26.     routines which open and close files use this unit instead of explicitly
  27.     opening and closing files then the user can not accidently open too many
  28.     files.  Unfortunately, this unit presently only handles Untyped and Text
  29.     files.  It will not handle Typed files.  This is mainly due to the strong
  30.     type checking of Turbo Pascal.  There are ways around it but for now they
  31.     seem a little unwieldy.  This unit can be used for all files of
  32.     type File (ie untyped) and Text.  These routines have been thoroughly
  33.     tested for untyped files and are used extensively by other TBTREE units.
  34.     I have only done limited testing with text files.
  35.  
  36.     The main advantage of this unit is that many files can now be open at the
  37.     same time, thus the need to arbitrarily close files is alleviated.  This
  38.     should reduce overhead caused by the constant opening and closing of
  39.     files.
  40.  
  41.     All file accesses within TBTREE use this unit.  Whether you use this unit
  42.     or not, you still need to initially allocate a number of files to this
  43.     unit (in other words the user sets the maximum number of files which can
  44.     be in the file open buffer).  Obviously, you must not allocate more files
  45.     to this unit than DOS can handle.  This DOS parameter is set in the
  46.     CONFIG.SYS file at bootup time.  The absolute maximum allowed by DOS is
  47.     20.  Since Turbo Pascal needs 5 you have 15 to play with.  You can
  48.     allocate any number from 1 to 15 to this unit.  If you allocate less than
  49.     15 (actually the number in the CONFIG.SYS file minus 5) the leftover are
  50.     yours to use with Typed files, etc.  For example, if you set FILES = 20 in
  51.     the CONFIG.SYS file you can allocate 10 files to this unit and you will
  52.     have (20 - 5) - 10 = 5 left for yourself to use with typed files.  One
  53.     added note: you can change this setting at any time during execution.  You
  54.     can even set it to a number less than the number of files presently open
  55.     and files will be closed until the number is reached.
  56.  
  57.     You can use the buffer and these routines for within your application,
  58.     thus sharing it with TBTREE.  The scenario for use of these routines is as
  59.     follows:
  60.  
  61.         1.  Call SetMaxOpenFiles(n) where n is the maximum number of files
  62.             which can be open at one time.  n must be less than or equal to
  63.             the value for 'files' in the CONFIG.SYS file minus 5.  See the DOS
  64.             manual for details.  If SetMaxOpenFiles is not called, the max
  65.             number of open files will default to one (1).  This will not cause
  66.             any errors but it will probably cause a large performance
  67.             degradation.
  68.  
  69.         2.  When you want to create a file use
  70.             RewriteTextFile(xxxxxxxx.xxx,fId) or
  71.             RewriteUntypedFile(xxxxxxxx.xxx,fId) where xxxxxxxx.xxx is the
  72.             file name (including an optional drive and path) for the file to
  73.             create and fId is a file id (file variable) you have declared.
  74.             For untyped files use OpenUntypedFile routine to open your file
  75.             (if it is not open) and return the appropriate file id in fId.
  76.             For text files use OpenTextFile for reading and AppendTextFile for
  77.             writing.  You can now use fId as a file variable. For example:
  78.  
  79.                 var myFile : Text;
  80.                     str : String;
  81.  
  82.                 begin
  83.                 RewriteTextFile('autoexec.bat',myfile);
  84.                 Writeln(myFile,'verify on');
  85.                 CloseFile('autoexec.bat');
  86.                       .
  87.                       .   { to access the file see below }
  88.                       .
  89.                 OpenTextFile('autoexec.bat',myFile);
  90.                 Readln(myFile,str);
  91.                       .
  92.                       .
  93.                       .
  94.                 CloseAllFiles;     { see note 4 below }
  95.                 end;
  96.  
  97.         3.  As noted above, to access the file use
  98.             OpenUntypedFile(xxxxxxxx.xxx,fId) or
  99.             OpenTextFile(xxxxxxxx.xxx,fId) or AppendTextFile(xxxxxxxx.xxx,fId)
  100.             depending on file type, etc. This will ensure that the file will
  101.             be open and the routine will open it if it is not.  It is only
  102.             necessary to call OpenUntypedFile if there is a possibility that
  103.             the file may not be open or that fId is not current.  For example,
  104.             in the above example, AppendTextFile did not have to be called to
  105.             access autoexec.bat immediately  after executing the RewriteFile
  106.             routine.  To be safe, always call one of the open file routines
  107.             prior to accessing the file.  If the file happens to be open there
  108.             in not much overhead associated with the call.  For all the
  109.             routines except for RewriteUntypedFile and RewriteTextFile, the
  110.             file must exist.
  111.  
  112.         4.  Do not use CLOSE to close a file.  Use CloseFile(xxxxxxxx.xxx) or
  113.             CloseAllFiles instead.  This applies to both Text and Untyped
  114.             files.  See notes 5 and 6 below.
  115.  
  116.         5.  To ensure that a particular file is closed use
  117.             CloseFile(xxxxxxxx.xxx).  When you call this the file will be
  118.             closed if it is not already closed.  If it is closed then nothing
  119.             happens.
  120.  
  121.         6.  To ensure all files are closed use CloseAllFiles.
  122.  
  123. In previous versions, there was a danger of running out of heap
  124.     space and being unable to allocate enough space on the heap to put a file
  125.     on the list.  This is now handled properly by initially reserving enough
  126.     space on the heap for one entry.  In this way, you will always be able to
  127.     have at least one file open and in the list.  It reserves the space as
  128.     part of the initialization sequence when the code in the initialization
  129.     section is called.  If there is not enough heap space available, a runtime
  130.     error occurs.  If an error does not occur during the initialization, a
  131.     problem will never occur later.  However, if there is a very limited
  132.     amount of heap space available, the unit will not allow very many files to
  133.     reside on the list at one time.  This will be transparent to you except
  134.     that performance will suffer somewhat.
  135.  
  136.     One warning when using these routines and using a file variable local to a
  137.     procedure or function: BE SURE TO CLOSE THE FILE (CloseFile or
  138.     CloseAllFiles) before leaving the routine.  This restriction in not really
  139.     any different than using file variables with the Turbo Pascal supplied
  140.     routines                                                                 *)
  141.  
  142. (*\*)
  143. (* Version Information
  144.  
  145.    Version 1.1 - No Changes
  146.  
  147.    Version 1.2 - No Changes
  148.  
  149.    Version 1.3 - No Changes
  150.  
  151.    Version 1.4 - Internal changes to use the newly redesigned TIME unit
  152.  
  153.                - Changed SetMaxOpenFiles routine.  Now this routine handles
  154.                  the case where you set the number of open files to a value
  155.                  less than the number presently open.  It will close files
  156.                  automatically until the number open is equal to the number
  157.                  being set.
  158.  
  159.    Version 1.5 - I redid parts of the documentation for the unit to better
  160.                  explain its use.
  161.  
  162.                - Unit is now compile with {$I-} which means that I/O checking
  163.                  off.  I now use the IOResult routine supplied with Turbo
  164.                  Pascal to get the rusult of an I/O operation.  If the I/O
  165.                  operation was not successful then I use the ERROR unit to
  166.                  handle it.  You must become familiar with the error unit!
  167.  
  168.                - Changed code internally to use Inc and Dec where practical
  169.  
  170.                - Changed code internally to use newly added FastMove unit
  171.  
  172.                - Reworked routines for Text Files to alleviate pesky Flush
  173.                  problem.  Routines now work properly without needing to flush
  174.                  after every Write or Writeln.  Chris Cardozo was a great help
  175.                  in conquering this problem and his efforts are appreciated.
  176.  
  177.                - In previous versions, there was a danger of running out of
  178.                  heap space and being unable to allocate enough space on the
  179.                  heap to put a file on the list.  This is now handled properly
  180.                  by initially reserving enough space on the heap for one
  181.                  entry. In this way, you will always be able to have at least
  182.                  one file open and in the list.  It reserves the space as part
  183.                  of the initialization sequence when the code in the
  184.                  initialization section is called.  If there is not enough
  185.                  heap space available, a runtime error occurs.  If an error
  186.                  does not occur during the initialization, a problem will
  187.                  never occur later. However, if there is a very limited amount
  188.                  of heap space available, the unit will not allow very many
  189.                  files to reside on the list at one time.  This will be
  190.                  transparent to you except that performance will suffer
  191.                  somewhat.
  192.  
  193.    Version 1.6 - No Changes                                                  *)
  194.  
  195.  
  196. (*\*)
  197. (*////////////////////////// I N T E R F A C E //////////////////////////////*)
  198.  
  199. interface
  200.  
  201. uses
  202.     Compare,
  203.     Dos,
  204.     Error,
  205.     FastMove,
  206.     FileDecs,
  207.     Numbers,
  208.     Time;
  209.  
  210. type
  211.     OpenFileRange = Byte;
  212.  
  213.  
  214. (* This routine will close the given file and delete its entry from the
  215.    open files buffer.                                                        *)
  216.  
  217. procedure CloseFile(fName : FnString);
  218.  
  219.  
  220. (*  This routine will return the file id (fId) for a file after rewriting it.
  221.     It's operation is equivalent to the REWRITE routine of TURBO.  It will
  222.     create a new file or rewrie an existing file.  It then adds this file
  223.     to the files open buffer in the same manner as OpenFiles would.
  224.  
  225.     note - This routine is for use with Untyped files only.  Unlike with the
  226.     Turbo Pascal routine Rewrite, the user must supply recSize.  It will
  227.     not default to 128.                                                      *)
  228.  
  229. procedure RewriteUntypedFile(fName : FnString;
  230.                              var fId: File;
  231.                              recSize : Word);
  232.  
  233. (*\*)
  234. (*  This routine will return the file id (fId) for the given file.  It will
  235.     also open the file if it is not open.  If the file is not open the routine
  236.     will open it and place the file name in the file open buffer.  If the
  237.     buffer is full showing that the maximum number of files is open, the
  238.     routine will close the least recently used file prior to opening this one.
  239.     The maximum number of files which can be open is set by calling the
  240.     procedure SetMaxOpenFiles which is part of this unit.
  241.  
  242.     Note : This routine uses the TURBO routine RESET.  Therefore the
  243.            restrictions that apply to RESET apply to OpenFile.  For Example,
  244.            an error will result if OpenFile is used on a file that does not
  245.            exist.  Use RewriteUntypedFile first!
  246.  
  247.     note - This routine is for use with Untyped files only.  Unlike with the
  248.     Turbo Pascal routine Rewrite, the user must supply recSize.  It will
  249.     not default to 128.                                                      *)
  250.  
  251. procedure OpenUntypedFile(fName : FnString;
  252.                           var fId : File;
  253.                           recSize : Word);
  254.  
  255.  
  256. (*  This routine will return the file id (fId) for a file after rewriting it.
  257.     It's operation is equivalent to the REWRITE routine of TURBO.  It will
  258.     create a new file or rewrite an existing file.  It then adds this file
  259.     to the files open buffer in the same manner as OpenFiles would.
  260.  
  261.     note - This routine is for use with Text files only.                     *)
  262.  
  263. procedure RewriteTextFile(fName : FnString;
  264.                           var fId : Text);
  265.  
  266.  
  267. (*  This routine will return the file id (fId) for the given file.  It will
  268.     also open the file if it is not open.  If the file is not open the routine
  269.     will open it and place the file name in the file open buffer.  If the
  270.     buffer is full showing that the maximum number of files is open, the
  271.     routine will close the least recently used file prior to opening this one.
  272.     The maximum number of files which can be open is set by calling the
  273.     procedure SetMaxOpenFiles which is part of this unit.
  274.  
  275.     Note : This routine uses the TURBO routine RESET.  Therefore the
  276.            restrictions that apply to RESET apply to OpenFile.  For Example,
  277.            an error will result if OpenFile is used on a file that does not
  278.            exist.  Use RewriteTextFile first!
  279.  
  280.     note - This routine is for use with Text files only.                     *)
  281.  
  282. procedure OpenTextFile(fName : FnString;
  283.                        var fId : Text);
  284.  
  285. (*\*)
  286. (*  This routine will return the file id (fId) for the given file.  It will
  287.     also open the file if it is not open.  If the file is not open the routine
  288.     will open it and place the file name in the file open buffer.  If the
  289.     buffer is full showing that the maximum number of files is open, the
  290.     routine will close the least recently used file prior to opening this one.
  291.     The maximum number of files which can be open is set by calling the
  292.     procedure SetMaxOpenFiles which is part of this unit.
  293.  
  294.     Note : This routine uses the TURBO routine APPEND.  Therefore the
  295.            restrictions that apply to APEND apply to OpenFile.  For Example,
  296.            an error will result if OpenFile is used on a file that does not
  297.            exist.  Use RewriteTextFile first!
  298.  
  299.     note - This routine is for use with Text files only.                     *)
  300.  
  301. procedure AppendTextFile(fName : FnString;
  302.                        var fId : Text);
  303.  
  304. (* This routine will Close all files that are open and empty the open file
  305.    buffer.                                                                   *)
  306.  
  307. procedure CloseAllFiles;
  308.  
  309.  
  310. (* This routine will set the maximum files that can be open at a time.  It is
  311.    important that this not exceed the number of files DOS will allow to be
  312.    open.  The number DOS will allow is set in the CONFIG.SYS file.  Also
  313.    remember that Turbo Pascal needs 5 files so you really can only set this to
  314.    the value set in the CONFIG.SYS file minus 5.  See the appropriate DOS
  315.    manual for details on the FILES command.  The value is initially set to one
  316.    (1).  This routine should be called BEFORE using the buffer.  You can call
  317.    this routine ANY time with no negative effects. In version 1.4 the routine
  318.    was changed to take care of the situation where the number of files open is
  319.    greater than n.  The routine will first check to ensure that n is valid
  320.    (greater than 0).  Once this is established, n will be checked against the
  321.    number of open files.  If the number of open files exceeds n, the least
  322.    recently used files will be closed until the number of open files equals n.
  323.    Finally, the internal variable will be set and only n number of files will
  324.    ever be open at once, until this routine is called again with a new value
  325.    for n.                                                                    *)
  326.  
  327. procedure SetMaxOpenFiles(n : OpenFileRange);
  328.  
  329.  
  330. (* This routine will return the number of files which are presently open.    *)
  331.  
  332. function GetNumberOpenFiles : OpenFileRange;
  333.  
  334. (*!*)
  335. (*\*)
  336. (*///////////////////// I M P L E M E N T A T I O N /////////////////////////*)
  337.  
  338. implementation
  339.  
  340. type
  341.     FilesType = (TEXTFILE,UNTYPEDFILE);            (* only file types handled
  342.                                                                  by FILEBUFF *)
  343.  
  344.     FileOpenRecPtr = ^FileOpenRec;
  345.     FileOpenRec = record
  346.                   fName : FnString;
  347.                   timeUsed : TimeArr;
  348.                   userPtr : Pointer;      (* used to point to users file var *)
  349.                   prev : FileOpenRecPtr;
  350.                   next : FileOpenRecPtr;
  351.                   case fType : FilesType of
  352.                       TEXTFILE    : (fIdText : Text);
  353.                       UNTYPEDFILE : (fIdUntyped : File);
  354.                   end;
  355.  
  356.     FileOpenList = record
  357.                    head : FileOpenRecPtr;
  358.                    count : OpenFileRange;
  359.                    end;
  360.  
  361.  
  362. var
  363.     maxOpenFiles : OpenFileRange;
  364.     fileList : FileOpenList;
  365.     reservedFPtr : FileOpenRecPtr;
  366.  
  367.  
  368. (*\*)
  369. (* This routine deletes a file from the list of open files                   *)
  370.  
  371. procedure RemoveFileFromList(var fPtr : FileOpenRecPtr);
  372.  
  373.     begin
  374.     Dec(fileList.count);
  375.     fPtr^.prev^.next := fPtr^.next;
  376.     if fPtr^.next <> NIL then
  377.         begin
  378.         fPtr^.next^.prev := fPtr^.prev;
  379.         end;
  380.     if fPtr <> reservedFPtr then
  381.         begin          (* dispose of it only is it is not the reserved space *)
  382.         Dispose(fPtr);
  383.         end;
  384.     end;                                (* end of RemoveFileFromList routine *)
  385.  
  386.  
  387. (* This routine find the file that was least recently accessed last and returns
  388.    the appropriate pointer.  The calling routine must then close this file
  389.    before opening another.                                                   *)
  390.  
  391. function LRUFile : FileOpenRecPtr;
  392.  
  393. var
  394.     oldPtr,                            (* points to least recently used file *)
  395.     fPtr : FileOpenRecPtr;
  396.     minTime : TimeArr;        (* time least recently used file was last used *)
  397.  
  398.     begin
  399.     fPtr := fileList.head^.next;               (* point to first 'real' cell *)
  400.     oldPtr := fPtr;
  401.     SetMaxTime(minTime);
  402.     while fPtr <> NIL do                        (* go through all open files *)
  403.         begin
  404.         if CompareTime(fPtr^.timeUsed,minTime) = LESSTHAN then
  405.             begin
  406.             minTime := fPtr^.timeUsed;
  407.             oldPtr := fPtr;
  408.             end;
  409.         fPtr := fPtr^.next;
  410.         end;
  411.     LRUFile := oldPtr;
  412.     end;                                           (* end of LRUFile routine *)
  413.  
  414. (*\*)
  415. (* This routine will close the given file and delete its entry from the
  416.    open files buffer.                                                        *)
  417.  
  418. procedure CloseFile(fName : FnString);
  419.  
  420. var
  421.     fPtr : FileOpenRecPtr;
  422.     found : Boolean;
  423.     ioRes : Word;
  424.     ioErrRec : IOErrorRec;
  425.  
  426.     begin
  427.     fPtr := fileList.head^.next;
  428.     found := FALSE;
  429.     while (fPtr <> NIL) and (not found) do
  430.         begin
  431.         if fPtr^.fName = fName then
  432.             begin
  433.             repeat                           (* I/O loop with error checking *)
  434.                 begin
  435.                 case fPtr^.fType of                              (* close it *)
  436.                     TEXTFILE :
  437.                         begin
  438.                         FastMover(fPtr^.userPtr^,
  439.                                   fPtr^.fIdText,
  440.                                   128);          (* don't want the buffer .. *)
  441.                         Close(fPtr^.fIdText);
  442.                         end;
  443.                     UNTYPEDFILE :
  444.                         begin
  445.                         Close(fPtr^.fIdUntyped);
  446.                         end;
  447.                     end;                            (* end of case statement *)
  448.  
  449.                 ioRes := IOResult;
  450.                 if ioRes <> 0 then
  451.                     begin
  452.                     ioErrRec.routineName := 'CloseFile';
  453.                     ioErrRec.tBTreeIOResult := ioRes;
  454.                     UserIOError(ioErrRec);
  455.                     end;
  456.                 end;
  457.             until ioRes = 0;
  458.             RemoveFileFromList(fPtr);
  459.             found := TRUE;
  460.             end
  461.         else
  462.             begin
  463.             fPtr := fPtr^.next;
  464.             end;
  465.         end;
  466.     end;                                         (* end of CloseFile routine *)
  467.  
  468. (*\*)
  469. (* This routine will allocate enough heap space for one FileOpenRec record.
  470.    It will first check to see if there is room on the list.  If there is not,
  471.    a file will be closed to make room.  Then the routine will allocate the
  472.    heap space required.  If there is not enough room on the heap for an entry
  473.    a file will be closed to make room.  If there are no files open the
  474.    reserved heap space is used.                                              *)
  475.  
  476. procedure AllocateHeapSpaceForList(var fPtr : FileOpenRecPtr);
  477.  
  478.     begin
  479.     if fileList.count = maxOpenFiles then
  480.         begin           (* no more files fit on list   ...   close one first *)
  481.         fPtr := LRUFile;
  482.         CloseFile(fPtr^.fName);
  483.         end;
  484.     if MaxAvail < SizeOf(FileOpenRec) then
  485.         begin
  486.         if fileList.count > 0 then
  487.             begin                          (* close a file and use its space *)
  488.             fPtr := LRUFile;
  489.             CloseFile(fPtr^.fName);
  490.             New(fPtr);
  491.             end
  492.         else
  493.             begin        (* no files to close so use the reserved heap space *)
  494.             fPtr := reservedFPtr;
  495.             end;
  496.         end
  497.     else
  498.         begin                                  (* room on the heap .. use it *)
  499.         New(fPtr);
  500.         end;
  501.     end;                          (* end of AllocateHeapSpaceForList routine *)
  502.  
  503.  
  504. (* This routine will put the record pointed to by fPtr in the list and
  505.    also increments the counter                                               *)
  506.  
  507. procedure PutFileInList(var fPtr : FileOpenRecPtr);
  508.  
  509.     begin
  510.     fPtr^.prev := fileList.head;
  511.     fPtr^.next := fileList.head^.next;                (* put at head of list *)
  512.     fileList.head^.next := fPtr;
  513.     if fPtr^.next <> NIL then
  514.         begin
  515.         fPtr^.next^.prev := fPtr;
  516.         end;
  517.     Inc(fileList.count);
  518.     end;                                     (* end of PutFileInList routine *)
  519.  
  520. (*\*)
  521. (*  This routine will return the file id (fId) for a file after rewriting it.
  522.     It's operation is equivalent to the REWRITE routine of TURBO.  It will
  523.     create a new file or rewrie an existing file.  It then adds this file
  524.     to the files open buffer in the same manner as OpenFiles would.
  525.  
  526.     note - This routine is for use with Untyped files only.  Unlike with the
  527.     Turbo Pascal routine Rewrite, the user must supply recSize.  It will
  528.     not default to 128.                                                      *)
  529.  
  530. procedure RewriteUntypedFile(fName : FnString;
  531.                              var fId: File;
  532.                              recSize : Word);
  533.  
  534. var
  535.     fPtr : FileOpenRecPtr;
  536.     ioRes : Word;
  537.     ioErrRec : IOErrorRec;
  538.  
  539.     begin
  540.     CloseFile(fName);                                (* make sure its closed *)
  541.     AllocateHeapSpaceForList(fPtr);
  542.     repeat                                   (* I/O loop with error checking *)
  543.         Assign(fPtr^.fIdUntyped,fName);
  544.         Rewrite(fPtr^.fIdUntyped,recSize);                  (* open the file *)
  545.         ioRes := IOResult;
  546.         if ioRes <> 0 then
  547.             begin
  548.             ioErrRec.routineName := 'RewriteUntypedFile';
  549.             ioErrRec.tBTreeIOResult := ioRes;
  550.             UserIOError(ioErrRec);
  551.             end;
  552.     until ioRes = 0;
  553.     fPtr^.fName := fName;
  554.     fPtr^.fType := UNTYPEDFILE;
  555.     PutFileInList(fPtr);
  556.     GetTime(fPtr^.timeUsed);                            (* set the time used *)
  557.     FastMover(fPtr^.fIdUntyped,fId,SizeOf(fId));
  558.                                               (* pass back file id to caller *)
  559.     end;                                (* end of RewriteUntypedFile routine *)
  560.  
  561. (*\*)
  562. (*  This routine will return the file id (fId) for the given file.  It will
  563.     also open the file if it is not open.  If the file is not open the routine
  564.     will open it and place the file name in the file open buffer.  If the
  565.     buffer is full showing that the maximum number of files is open, the
  566.     routine will close the least recently used file prior to opening this one.
  567.     The maximum number of files which can be open is set by calling the
  568.     procedure SetMaxOpenFiles which is part of this unit.
  569.  
  570.     Note : This routine uses the TURBO routine RESET.  Therefore the
  571.            restrictions that apply to RESET apply to OpenFile.  For Example,
  572.            an error will result if OpenFile is used on a file that does not
  573.            exist.  Use RewriteUntypedFile first!
  574.  
  575.     note - This routine is for use with Untyped files only.  Unlike with the
  576.     Turbo Pascal routine Rewrite, the user must supply recSize.  It will
  577.     not default to 128.                                                      *)
  578.  
  579. procedure OpenUntypedFile(fName : FnString;
  580.                           var fId : File;
  581.                           recSize : Word);
  582.  
  583.  
  584. var
  585.     found : Boolean;
  586.     fPtr : FileOpenRecPtr;
  587.     ioRes : Word;
  588.     ioErrRec : IOErrorRec;
  589.  
  590.     begin
  591.     fPtr := fileList.head^.next;              (* points to first 'real' cell *)
  592.     found := FALSE;
  593.     while (not found) and (fPtr <> NIL) do
  594.         begin
  595.         if fPtr^.fName = fName then
  596.             begin
  597.             found := TRUE;
  598.             end
  599.         else
  600.             begin
  601.             fPtr := fptr^.next;
  602.             end;
  603.         end;
  604.     if not found then
  605.         begin
  606.         AllocateHeapSpaceForList(fPtr);
  607.         repeat                               (* I/O loop with error checking *)
  608.             Assign(fPtr^.fIdUntyped,fName);
  609.             Reset(fPtr^.fIdUntyped,recSize);                (* open the file *)
  610.             ioRes := IOResult;
  611.             if ioRes <> 0 then
  612.                 begin
  613.                 ioErrRec.routineName := 'OpenUntypedFile';
  614.                 ioErrRec.tBTreeIOResult := ioRes;
  615.                 UserIOError(ioErrRec);
  616.                 end;
  617.         until ioRes = 0;
  618.         fPtr^.fName := fName;
  619.         fPtr^.fType := UNTYPEDFILE;
  620.         PutFileInList(fPtr);
  621.         end;
  622.     GetTime(fPtr^.timeUsed);                            (* set the time used *)
  623.     FastMover(fPtr^.fIdUntyped,fId,SizeOf(fId));
  624.                                               (* pass back file id to caller *)
  625.     end;                                   (* end of OpenUntypedFile routine *)
  626.  
  627. (*\*)
  628. (*  This routine will return the file id (fId) for a file after rewriting it.
  629.     It's operation is equivalent to the REWRITE routine of TURBO.  It will
  630.     create a new file or rewrite an existing file.  It then adds this file
  631.     to the files open buffer in the same manner as OpenFiles would.
  632.  
  633.     note - This routine is for use with Text files only.                     *)
  634.  
  635. procedure RewriteTextFile(fName : FnString;
  636.                           var fId : Text);
  637.  
  638.  
  639. var
  640.     fPtr : FileOpenRecPtr;
  641.     ioRes : Word;
  642.     ioErrRec : IOErrorRec;
  643.  
  644.     begin
  645.     CloseFile(fName);                                (* make sure its closed *)
  646.     AllocateHeapSpaceForList(fPtr);
  647.     repeat                                   (* I/O loop with error checking *)
  648.         Assign(fPtr^.fIdText,fName);
  649.         Rewrite(fPtr^.fIdText);                          (* rewrite the file *)
  650.         ioRes := IOResult;
  651.         if ioRes <> 0 then
  652.             begin
  653.             ioErrRec.routineName := 'RewriteTextFile';
  654.             ioErrRec.tBTreeIOResult := ioRes;
  655.             UserIOError(ioErrRec);
  656.             end;
  657.     until ioRes = 0;
  658.     fPtr^.fName := fName;
  659.     fPtr^.fType := TEXTFILE;
  660.     fPtr^.userPtr := Addr(fId);         (* get address of user file variable *)
  661.     PutFileInList(fPtr);
  662.     GetTime(fPtr^.timeUsed);                            (* set the time used *)
  663.     FastMover(fPtr^.fIdText,fId,SizeOf(fId)); (* pass back file id to caller *)
  664.     end;                                   (* end of RewriteTextFile routine *)
  665.  
  666. (*\*)
  667. (*  This routine will return the file id (fId) for the given file.  It will
  668.     also open the file if it is not open.  If the file is not open the routine
  669.     will open it and place the file name in the file open buffer.  If the
  670.     buffer is full showing that the maximum number of files is open, the
  671.     routine will close the least recently used file prior to opening this one.
  672.     The maximum number of files which can be open is set by calling the
  673.     procedure SetMaxOpenFiles which is part of this unit.
  674.  
  675.     Note : This routine uses the TURBO routine RESET.  Therefore the
  676.            restrictions that apply to RESET apply to OpenFile.  For Example,
  677.            an error will result if OpenFile is used on a file that does not
  678.            exist.  Use RewriteTextFile first!
  679.  
  680.     note - This routine is for use with Text files only.                     *)
  681.  
  682. procedure OpenTextFile(fName : FnString;
  683.                        var fId : Text);
  684.  
  685.  
  686. var
  687.     found : Boolean;
  688.     fPtr : FileOpenRecPtr;
  689.     ioRes : Word;
  690.     ioErrRec : IOErrorRec;
  691.  
  692.     begin
  693.     fPtr := fileList.head^.next;              (* points to first 'real' cell *)
  694.     found := FALSE;
  695.     while (not found) and (fPtr <> NIL) do
  696.         begin
  697.         if fPtr^.fName = fName then
  698.             begin
  699.             found := TRUE;
  700.             end
  701.         else
  702.             begin
  703.             fPtr := fptr^.next;
  704.             end;
  705.         end;
  706.     if not found then
  707.         begin
  708.         AllocateHeapSpaceForList(fPtr);
  709.         repeat                               (* I/O loop with error checking *)
  710.             Assign(fPtr^.fIdText,fName);
  711.             Reset(fPtr^.fIdText);                           (* open the file *)
  712.             ioRes := IOResult;
  713.             if ioRes <> 0 then
  714.                 begin
  715.                 ioErrRec.routineName := 'OpenTextFile';
  716.                 ioErrRec.tBTreeIOResult := ioRes;
  717.                 UserIOError(ioErrRec);
  718.                 end;
  719.         until ioRes = 0;
  720.         fPtr^.fName := fName;
  721.         fPtr^.fType := TEXTFILE;
  722.         fPtr^.userPtr := Addr(fId);     (* get address of user file variable *)
  723.         PutFileInList(fPtr);
  724.         FastMover(fPtr^.fIdText,fId,SizeOf(fId)); (* pass back file id to
  725.                                                      caller                  *)
  726.                                                   (* notice that you do not do
  727.                                                      this if the file is open
  728.                                                      already                 *)
  729.         end;
  730.     GetTime(fPtr^.timeUsed);                            (* set the time used *)
  731.     end;                                      (* end of OpenTextFile routine *)
  732.  
  733. (*\*)
  734. (*  This routine will return the file id (fId) for the given file.  It will
  735.     also open the file if it is not open.  If the file is not open the routine
  736.     will open it and place the file name in the file open buffer.  If the
  737.     buffer is full showing that the maximum number of files is open, the
  738.     routine will close the least recently used file prior to opening this one.
  739.     The maximum number of files which can be open is set by calling the
  740.     procedure SetMaxOpenFiles which is part of this unit.
  741.  
  742.     Note : This routine uses the TURBO routine APPEND.  Therefore the
  743.            restrictions that apply to APEND apply to OpenFile.  For Example,
  744.            an error will result if OpenFile is used on a file that does not
  745.            exist.  Use RewriteTextFile first!
  746.  
  747.     note - This routine is for use with Text files only.                     *)
  748.  
  749. procedure AppendTextFile(fName : FnString;
  750.                        var fId : Text);
  751.  
  752.  
  753. var
  754.     found : Boolean;
  755.     fPtr : FileOpenRecPtr;
  756.     ioRes : Word;
  757.     ioErrRec : IOErrorRec;
  758.  
  759.     begin
  760.     fPtr := fileList.head^.next;              (* points to first 'real' cell *)
  761.     found := FALSE;
  762.     while (not found) and (fPtr <> NIL) do
  763.         begin
  764.         if fPtr^.fName = fName then
  765.             begin
  766.             found := TRUE;
  767.             end
  768.         else
  769.             begin
  770.             fPtr := fptr^.next;
  771.             end;
  772.         end;
  773.     if not found then
  774.         begin
  775.         AllocateHeapSpaceForList(fPtr);
  776.         repeat                               (* I/O loop with error checking *)
  777.             Assign(fPtr^.fIdText,fName);
  778.             Append(fPtr^.fIdText);                          (* open the file *)
  779.             ioRes := IOResult;
  780.             if ioRes <> 0 then
  781.                 begin
  782.                 ioErrRec.routineName := 'AppendTextFile';
  783.                 ioErrRec.tBTreeIOResult := ioRes;
  784.                 UserIOError(ioErrRec);
  785.                 end;
  786.         until ioRes = 0;
  787.         fPtr^.fName := fName;
  788.         fPtr^.fType := TEXTFILE;
  789.         fPtr^.userPtr := Addr(fId);     (* get address of user file variable *)
  790.         PutFileInList(fPtr);
  791.         FastMover(fPtr^.fIdText,fId,SizeOf(fId)); (* pass back file id to
  792.                                                      caller                  *)
  793.         end;
  794.     GetTime(fPtr^.timeUsed);                            (* set the time used *)
  795.     end;                                    (* end of AppendTextFile routine *)
  796.  
  797. (*\*)
  798. (* This routine will Close all files that are open and empty the open file
  799.    buffer.                                                                   *)
  800.  
  801. procedure CloseAllFiles;
  802.  
  803.     begin
  804.     while fileList.count <> 0 do
  805.         begin
  806.         CloseFile(fileList.head^.next^.fName);
  807.         end;
  808.     end;                                     (* end of CloseAllFiles routine *)
  809.  
  810.  
  811. (* This routine will set the maximum files that can be open at a time.  It is
  812.    important that this not exceed the number of files DOS will allow to be
  813.    open.  The number DOS will allow is set in the CONFIG.SYS file.  Also
  814.    remember that Turbo Pascal needs 5 files so you really can only set this to
  815.    the value set in the CONFIG.SYS file minus 5.  See the appropriate DOS
  816.    manual for details on the FILES command.  The value is initially set to one
  817.    (1).  This routine should be called BEFORE using the buffer.  You can call
  818.    this routine ANY time with no negative effects. In version 1.4 the routine
  819.    was changed to take care of the situation where the number of files open is
  820.    greater than n.  The routine will first check to ensure that n is valid
  821.    (greater than 0).  Once this is established, n will be checked against the
  822.    number of open files.  If the number of open files exceeds n, the least
  823.    recently used files will be closed until the number of open files equals n.
  824.    Finally, the internal variable will be set and only n number of files will
  825.    ever be open at once, until this routine is called again with a new value
  826.    for n.                                                                    *)
  827.  
  828. procedure SetMaxOpenFiles(n : OpenFileRange);
  829.  
  830. var
  831.     fPtr : FileOpenRecPtr;
  832.  
  833.     begin
  834.     if n > 0 then
  835.         begin
  836.         if fileList.count <= n then
  837.             begin
  838.             maxOpenFiles := n;
  839.             end
  840.         else
  841.             begin
  842.             while fileList.count > n do
  843.                 begin
  844.                 fPtr := LRUFile;
  845.                 CloseFile(fPtr^.fName);
  846.                 end;
  847.             end;
  848.         end;
  849.     end;                                   (* end of SetMaxOpenFiles routine *)
  850.  
  851. (*\*)
  852. (* This routine will return the number of files which are presently open.    *)
  853.  
  854. function GetNumberOpenFiles : OpenFileRange;
  855.  
  856.     begin
  857.     GetNumberOpenFiles := fileList.count;
  858.     end;                                (* end of GetNumberOpenFiles routine *)
  859.  
  860.  
  861. begin
  862. New(fileList.head);                 (* create an empty cell .. easier to use *)
  863. fileList.count := 0;                                     (* set in-use count *)
  864. fileList.head^.fName := '';                 (* this line not really required *)
  865. fileList.head^.prev := NIL;                           (* neither is this one *)
  866. fileList.head^.next := NIL;
  867. SetMaxOpenFiles(1);               (* initially, only one open file at a time *)
  868. New(reservedFPtr);      (* reserve heap space for at least one entry in list *)
  869. end.                                                 (* end of FileBuff unit *)
  870.