home *** CD-ROM | disk | FTP | other *** search
/ C!T ROM 2 / ctrom_ii_b.zip / ctrom_ii_b / PROGRAM / PASCAL / MKMSG104 / MKFFILE.PAS < prev    next >
Pascal/Delphi Source File  |  1994-01-09  |  8KB  |  264 lines
  1. Unit MKFFile; {Buffered File Object Unit}
  2.  
  3. {
  4.      MKFFile - Copyright 1993 by Mark May - MK Software
  5.      You are free to use this code in your programs, however
  6.      it may not be included in Source/TPU function libraries
  7.      without my permission.
  8.  
  9.      Mythical Kingom Tech BBS (513)237-7737 HST/v32
  10.      FidoNet: 1:110/290
  11.      Rime: ->MYTHKING
  12.      You may also reach me at maym@dmapub.dma.org
  13. }
  14.  
  15. {
  16.      MKFFile is a buffered file unit.  You set the buffer size when
  17.      calling the init method.  The MKFFile methods (seekfile, blkread,
  18.      blkwrite) take advantage of the buffer to minimize actual DOS calls
  19.      to access your data.  This can significantly speed up your program.
  20.      MKFFile does handle blkread/blkwrites that are larger than the
  21.      buffer size, and is intended to be truely transparant to your
  22.      application.
  23.  
  24. }
  25.  
  26. {$I MKB.Def}
  27.  
  28. Interface
  29.  
  30. Type FBufType = Array[0..$fff0] of Byte;
  31.  
  32. Type FFileObj = Object
  33.   BufFile: File;             {File to be buffered}
  34.   Buf: ^FBufType;            {Pointer to the buffer-actual size given by init}
  35.   BufStart: LongInt;         {File position of buffer start}
  36.   BufSize: LongInt;          {Size of the buffer}
  37.   BufChars: Word;            {Number of valid characters in the buffer}
  38.   CurrSize: LongInt;         {Current file size}
  39.   NeedWritten: Boolean;      {Buffer dirty/needs written flag}
  40.   IsOpen: Boolean;           {File is currently open flag}
  41.   CurrPos: LongInt;          {Current position in file/buffer}
  42.   Constructor Init(BSize: Word);
  43.     {Initialize object and set buffer size/allocate memory}
  44.   Destructor Done; Virtual;  {Done}
  45.   Function  OpenFile(FName: String; FMode: Word): Boolean;  Virtual;
  46.                              {Open a file FNAME in the filemode FMode}
  47.   Function  CloseFile: Boolean; Virtual; {Close the currently open file}
  48.   Function  BlkRead(Var V; Num: Word; Var NumRead: Word): Boolean; Virtual;
  49.     {Equivalent to BlockRead but makes use of buffer to reduce real reads}
  50.   Function  BlkWrite(Var V; Num: Word): Boolean; Virtual;
  51.     {Equivalent to BlockWrite but uses buffer to reduce real writes}
  52.   Function  SeekFile(FP: LongInt): Boolean; Virtual;
  53.     {Equivalent to seek but uses buffer to reduce real seeks}
  54.   Function  WriteBuffer: Boolean; Virtual;
  55.     {Internal use normally - flushes buffer if needed}
  56.   Function  RawSize: LongInt; Virtual;
  57.     {Pass through to filesize function}
  58.   End;
  59.  
  60.  
  61. Implementation
  62.  
  63. Uses MKFile,
  64. {$IFDEF WINDOWS}
  65.   WinDos;
  66. {$ELSE}
  67.   Dos,
  68.   {$IFDEF OPRO}
  69.   OpCrt;
  70.   {$ELSE}
  71.   Crt;
  72.   {$ENDIF}
  73. {$ENDIF}
  74.  
  75.  
  76. Constructor FFileObj.Init(BSize: Word);
  77.   Begin
  78.   Buf := Nil;
  79.   BufSize := BSize;
  80.   BufStart := -10;           {Invalidate buffer}
  81.   BufChars := 0;
  82.   IsOpen := False;           {Initialize values}
  83.   NeedWritten := False;
  84.   CurrPos := 0;
  85.   GetMem(Buf, BufSize);      {Allocate memory for buffer}
  86.   If Buf = Nil Then
  87.     Fail;
  88.   End;
  89.  
  90.  
  91. Destructor FFileObj.Done;
  92.   Begin
  93.   If IsOpen Then             {If file is open then close it}
  94.     If CloseFile Then;
  95.   If Buf <> Nil Then         {Free up memory}
  96.     FreeMem(Buf, BufSize);
  97.   End;
  98.  
  99.  
  100.  
  101. Function FFileObj.OpenFile(FName: String; FMode: Word): Boolean;
  102.   Var
  103.     Error: Boolean;
  104.  
  105.   Begin
  106.   Error := False;
  107.   If IsOpen Then             {If file is open then close it first}
  108.     Error := CloseFile;
  109.   If Not Error Then
  110.     Begin
  111.     Assign(BufFile, FName);
  112.     FileMode := FMode;
  113.     If FileExist(FName) Then
  114.       Reset(BufFile, 1)
  115.     Else
  116.       ReWrite(BufFile, 1);
  117.     Error := IoResult <> 0;
  118.     IsOpen := Not Error;
  119.     CurrPos := 0;            {Initialize file position}
  120.     BufStart := -10;         {Invalidate buffer}
  121.     BufChars := 0;
  122.     NeedWritten := False;
  123.     CurrSize := RawSize;
  124.     End;
  125.   OpenFile := Not Error;
  126.   End;
  127.  
  128.  
  129. Function FFileObj. CloseFile: Boolean;
  130.   Var
  131.     Error: Boolean;
  132.  
  133.   Begin
  134.   Error := False;
  135.   If NeedWritten Then        {If buffer needs written then write it first}
  136.     Error := Not WriteBuffer;
  137.   If Not Error Then
  138.     Begin
  139.     Close(BufFile);         {Close file}
  140.     Error := (IoResult <> 0);
  141.     End;
  142.   If Not Error Then
  143.     IsOpen := False;
  144.   CloseFile := Not Error;
  145.   End;
  146.  
  147.  
  148. Function FFileObj. BlkRead(Var V; Num: Word; Var NumRead: Word): Boolean;
  149.   Var
  150.     Tmp: LongInt;                      {Number of chars to write}
  151.     Error: Boolean;
  152.  
  153.   Begin
  154.   Error := False;
  155.   NumRead := 0;                        {Initialize number read to zero}
  156.   Error := Not SeekFile(CurrPos);          {Make currpos valid}
  157.   While ((NumRead < Num) and (Not Error)) Do
  158.     Begin
  159.     Tmp := Num - NumRead;
  160.     If Tmp > (BufChars - (CurrPos - BufStart)) Then
  161.       Tmp := (BufChars - (CurrPos - BufStart));
  162.     Move(Buf^[CurrPos - BufStart], FBufType(V)[NumRead] , Tmp);
  163.     Inc(NumRead, Tmp);
  164.     Error := Not SeekFile(CurrPos + Tmp);
  165.     If BufChars = 0 Then
  166.       Num := NumRead;
  167.     End;
  168.   BlkRead := Not Error;
  169.   End;
  170.  
  171.  
  172. Function FFileObj. BlkWrite(Var V; Num: Word): Boolean;
  173.   Var
  174.     Tmp: LongInt;                      {Number of chars to write}
  175.     NumWritten: LongInt;               {Number of chars written}
  176.     Error: Boolean;
  177.  
  178.   Begin
  179.   NumWritten := 0;
  180.   Error := False;
  181.   If CurrPos < CurrSize Then
  182.     Error := Not SeekFile(CurrPos);
  183.   While ((NumWritten < Num) and (Not Error)) Do
  184.     Begin
  185.     Tmp := Num - NumWritten;
  186.     If ((BufChars = 0) or (CurrPos >= CurrSize)) Then
  187.       Begin
  188.       If Tmp > BufSize Then
  189.         BufChars := BufSize
  190.       Else
  191.         BufChars := Tmp;
  192.       End;
  193.     If Num > (BufChars - (CurrPos - BufStart)) Then
  194.       Tmp := (BufChars - (CurrPos - BufStart));
  195.     If ((Tmp > 0) and (Not Error)) Then
  196.       Begin
  197.       Move(FBufType(V)[NumWritten], Buf^[CurrPos - BufStart] , Tmp);
  198.       Inc(NumWritten, Tmp);
  199.       NeedWritten := True;
  200.       Error := Not SeekFile(CurrPos + Tmp);
  201.       End;
  202.     End;
  203.   BlkWrite := Not Error;
  204.   End;
  205.  
  206.  
  207. Function FFileObj. SeekFile(FP: LongInt): Boolean;
  208.   Var
  209.     Error: Boolean;
  210.  
  211.   Begin
  212.   Error := Not IsOpen;                 {Error if file isn't open}
  213.   If Not Error Then
  214.     Begin
  215.     If ((FP < BufStart) or (FP > (BufStart + BufChars - 1))) Then
  216.       Begin                            {If FP isn't in buffer}
  217.       If NeedWritten Then              {Write old buffer first if needed}
  218.         Error := Not WriteBuffer;
  219.       If Not Error Then
  220.         Begin
  221.         Seek(BufFile, FP);
  222.         Error := (ioResult <> 0);      {Seek to FP}
  223.         End;
  224.       If Not Error Then
  225.         Begin
  226.         BufStart := FP;
  227.         If FP = RawSize Then
  228.           BufChars := 0
  229.         Else
  230.           Error := Not shRead(BufFile, Buf^, BufSize, BufChars); {Fill buffer}
  231.         End;
  232.       End;
  233.     If Not Error Then
  234.       CurrPos := FP;                   {Set current file position to FP}
  235.     End;
  236.   SeekFile := Not Error;
  237.   End;
  238.  
  239.  
  240. Function FFileObj.WriteBuffer: Boolean;
  241.   Var
  242.     DoneOK: Boolean;
  243.  
  244.   Begin
  245.   Seek(BufFile, BufStart);
  246.   DoneOk := (ioResult = 0);            {Seek to buffer start first}
  247.   If DoneOk Then
  248.     DoneOk := shWrite(BufFile, Buf^, BufChars); {Write buffer}
  249.   If (BufStart + BufChars) > CurrSize Then
  250.     CurrSize := BufStart + BufChars;
  251.   NeedWritten := Not DoneOk;           {Turn off needs-written flag}
  252.   WriteBuffer := DoneOk;               {Return result}
  253.   End;
  254.  
  255.  
  256. Function FFileObj.RawSize: LongInt;
  257.   Begin
  258.   RawSize := FileSize(BufFile);
  259.   If IoResult <> 0 Then;
  260.   End;
  261.  
  262.  
  263. End.
  264.