home *** CD-ROM | disk | FTP | other *** search
/ Chip 2002 March / Chip_2002-03_cd1.bin / zkuste / delphi / kompon / d56 / GPHUGEF.ZIP / GpHugeF.pas < prev   
Encoding:
Pascal/Delphi Source File  |  2001-12-15  |  60.9 KB  |  1,720 lines
  1. {$B-,H+,J+,Q-,T-,X+}
  2.  
  3. {$UNDEF D3PLUS}
  4. {$UNDEF D4PLUS}
  5. {$IFDEF VER100}{$DEFINE D3PLUS}{$ENDIF}
  6. {$IFDEF VER120}{$DEFINE D3PLUS}{$DEFINE D4PLUS}{$ENDIF}
  7. {$IFDEF VER130}{$DEFINE D3PLUS}{$DEFINE D4PLUS}{$ENDIF}
  8. {$IFDEF VER140}{$DEFINE D3PLUS}{$DEFINE D4PLUS}{$DEFINE D6PLUS}{$ENDIF}
  9.  
  10. (*:Interface to 64-bit file functions with some added functionality.
  11.    @author Primoz Gabrijelcic
  12.    @desc <pre>
  13.    (c) 2000 Primoz Gabrijelcic
  14.    Free for personal and commercial use. No rights reserved.
  15.  
  16.    Author           : Primoz Gabrijelcic
  17.    Creation date    : 1998-09-15
  18.    Last modification: 2001-12-15
  19.    Version          : 3.07a
  20. </pre>*)(*
  21.    History:
  22.      3.07a: 2001-12-15
  23.        - Updated to compile with Delphi 6.
  24.  
  25.      3.07: 2001-07-02
  26.        - Added TGpHugeFile.FileDate setter.
  27.  
  28.      3.06b: 2001-06-27
  29.        - TGpHugeFile.FileSize function was returning wrong result when file
  30.          was open for buffered write access.
  31.  
  32.      3.06a: 2001-06-24
  33.        - Modified CreateEx behaviour - if DesiredShareMode is not set and
  34.          file is open in GENERIC_READ mode, sharing will be set to
  35.          FILE_SHARE_READ.
  36.  
  37.      3.06: 2001-06-22
  38.        - Added parameter DesiredShareMode to the CreateEx constructor.
  39.  
  40.      3.05: 2001-02-27
  41.        - Modified Reset and Rewrite methods to open file in buffered mode by
  42.          default.
  43.  
  44.      3.04: 2001-01-31
  45.        - All raised exceptions now have HelpContext set. All possible
  46.          HelpContext values are enumerated in 'const' section at the very
  47.          beginning of the unit. Thanks to Peter Evans for the suggestion.
  48.  
  49.      3.03: 2000-10-18
  50.        - Fixed bugs in hfoCloseOnEOF support in TGpHugeFile.
  51.  
  52.      3.02: 2000-10-12
  53.        - Fixed bugs in hfoCloseOnEOF support in TGpHugeFileStream.
  54.  
  55.      3.01: 2000-10-06
  56.        - TGpHugeFileStream constructor now accepts THFOpenOptions parameter,
  57.          which is passed to TGpHugeFile ResetEx/RewriteEx. Default open mode for
  58.          stream files is now hfoBuffered.
  59.        - TGpHugeFileStream constructor parameters are simpler -
  60.          FlagsAndAttributes and DesiredAccess parameters are no longer present.
  61.        - Added TGpHugeFileStream.CreateFromHandle constructor accepting instance
  62.          of TGpHugeFile, which is then used for all stream access. This
  63.          TGpHugeFile instance must already be created and open (Reset, Rewrite).
  64.          It will not be destroyed in TGpHugeFileStream destructor.
  65.        - Added read-only property TGpHugeFileStream.FileName.
  66.        - Added read-only property TGpHugeFileStream.WindowsError.
  67.        - Fully documented.
  68.        - All language-dependant string constants moved to resourcestring
  69.          section.
  70.  
  71.      3.0: 2000-10-03
  72.        - Created TGpHugeFileStream - descendant of TStream that wraps
  73.          TGpHugeFile. Although it does not support huge files fully (because of
  74.          TStream limitations), you could still use it as a buffered file stream.
  75.  
  76.      2.33: 2000-09-04
  77.        - TGpHugeFile now exposes WindowsError property, which is set to last
  78.          Windows error wherever it is checked for.
  79.  
  80.      2.32: 2000-08-01
  81.        - All raised exceptions converted to EGpHugeFile exceptions.
  82.        - All windows exceptions are now caught and converted to EGpHugeFile
  83.          exceptions.
  84.        - If file is open in read buffered mode *and* is then seeked past EOF
  85.          (Seek(FileSize)) *and* is then written into, it will switch to write
  86.          buffered mode (previous versions of GpHugeFile raised exception under
  87.          those conditions).
  88.  
  89.      2.31: 2000-05-15
  90.        - Call to Truncate is now allowed in buffered write mode. It will cause
  91.          buffer to be flushed, though.
  92.  
  93.      2.30a: 2000-05-15
  94.        - Fix introduced in 2.29a sometimes caused BlockRead to return error even
  95.          when there was some data present. This only happened when file was open
  96.          for reading (via Reset) and then extended with BlockWrite.
  97.  
  98.      2.30: 2000-05-12
  99.        - New property: IsBuffered. Returns true if file is open in buffered
  100.          mode.
  101.  
  102.      2.29a: 2000-05-02
  103.        - While reading near end of (buffered) file, ReadFile API was called much
  104.          too often. Fixed.
  105.  
  106.      2.29: 2000-04-14
  107.        - Added new ResetEx/RewriteEx parameter - waitObject. If not equal to
  108.          zero, TGpHugeFile will check it periodically in the wait loop. If
  109.          object becomes signalled, TGpHugeFile will stop trying to open the file
  110.          and will return an error.
  111.  
  112.      2.28: 2000-04-12
  113.        - Added new THFOpenOption: hfoCanCreate. Set it to allow ResetEx to
  114.          create file when it does not exist.
  115.  
  116.      2.27: 2000-04-02
  117.        - Added property FileDate.
  118.  
  119.      2.26a: 2000-03-07
  120.        - Fixed bug in hfoCloseOnEOF processing.
  121.  
  122.      2.26: 2000-03-03
  123.        - Added THFOpenOption hfoCloseOnEOF. If specified in a call to ResetEx
  124.          TGpHugeFile will close file handle as soon as last block is read from
  125.          the file. This will free file for other programs while main program may
  126.          still read data from TGpHugeFile's buffer. {*}
  127.          After the end of file is reached (and handle is closed):
  128.            - FilePos may be used.
  129.            - FileSize may be used.
  130.            - Seek and BlockRead may be used as long as the request can be
  131.              fulfilled from the buffer.
  132.          Use of this option is not recommended when access to the file is
  133.          random. {*} It was designed to use with sequential access to the file.
  134.          hfoCloseOnEOF is ignored if hfoBuffered is not set.
  135.          hfoCloseOnEOF is ignored if used in RewriteEx.
  136.  
  137.          {*} hfoCloseOnEOF can cope with a program that alternately calls
  138.          BlockRead and Seek requests. When BlockRead reaches EOF, this condition
  139.          will be marked but file handle will not be closed yet. Only when
  140.          BlockRead is called again, file will be closed, but only if between
  141.          those calls Seek did not invalidate the buffer (Seek that can be
  142.          fulfilled from the buffer is OK). This works with programs that load a
  143.          small buffer and then Seek somewhere in the middle of this buffer (like
  144.          Readln function in TGpTextFile class).
  145.  
  146.      2.25a: 2000-02-19
  147.        - Fixed bug where TGpHugeFile.Reset would create a file if file did not
  148.          exist before. Thanks to Peter Evans for finding the bug and solution. 
  149.  
  150.      2.25: 1999-12-29
  151.        - Changed implementation of TGpHugeFile.ResetEx and TGpHugeFile.RewriteEx
  152.          (called from all Reset* and Rewrite* functions). Before the change,
  153.          they were closing and reopening the file - not a very good idea if you
  154.          share a file between applications.
  155.  
  156.      2.24e: 1999-12-22
  157.        - Fixed broken TGpHugeFile.IsOpen. Thanks for Phil Hodgson for finding
  158.          this bug.
  159.  
  160.      2.24d: 1999-11-22
  161.        - Fixed small problem in file access routines. They would continue trying
  162.          to access a file event if returned error was not sharing or locking
  163.          error.
  164.  
  165.      2.24c: 1999-11-20
  166.        - Behaviour changed. If you open file with GENERIC_READ access, sharing
  167.          mode will be set to FILE_SHARE_READ. 2.24b and older set sharing mode
  168.          to 0 in all occasions.  
  169.  
  170.      2.24b: 1999-11-06
  171.        - Added (again) ResetBuffered and RewriteBuffered;
  172.  
  173.      2.24a: 1999-11-03
  174.        - Fixed Reset and Rewrite.
  175.  
  176.      2.24: 1999-11-02
  177.        - ResetBuffered and RewriteBuffered renamed to ResetEx and RewriteEx.
  178.        - Parameters diskLockTimeout and diskRetryDelay added to ResetEx and
  179.          RewriteEx.
  180.  
  181.      2.23: 1999-10-28
  182.        - Compiles with D5.
  183.  
  184.      2.22: 1999-06-14
  185.        - Better error reporting.
  186.  
  187.      2.21: 1998-12-21
  188.        - Better error checking.
  189.  
  190.      2.2: 1998-12-14
  191.        - New function IsOpen.
  192.        - Lots of SetLastError(0) calls added.
  193.  
  194.      2.12: 1998-10-28
  195.        - CreateEx enhanced.
  196.  
  197.      2.11: 1998-10-14
  198.        - Error reporting in Block*Unsafe enhanced.
  199.  
  200.      2.1: 1998-10-13
  201.        - FilePos works in buffered mode.
  202.        - Faster FilePos in unbuffered mode.
  203.        - Seek works in read buffered mode.
  204.          - In FILE_FLAG_NO_BUFFERING mode Seek works only when offset is on a
  205.            sector boundary.
  206.          - Truncate works in read buffered mode (untested).
  207.          - Dependance on MSString removed.
  208.  
  209.      2.0: 1998-10-08
  210.        - Win32 API error checking.
  211.        - Sequential access buffering (ResetBuffered, RewriteBuffered).
  212.        - Buffered files can be safely accessed in FILE_FLAG_NO_BUFFERING mode.
  213.        - New procedures BlockReadUnsafe, BlockWriteUnsafe.
  214.  
  215.      1.1: 1998-10-05
  216.        - CreateEx constructor added.
  217.          - can specify attributes (for example FILE_FLAG_SEQUENTIAL_SCAN)
  218.        - D4 compatible.
  219.  
  220.      1.0: 1998-09-15
  221.        - First published version.
  222. *)
  223.  
  224. // TODO 4 -oPrimoz Gabrijelcic: Change EGpHugeFile to CreateFmtHelp
  225.  
  226. unit GPHugeF;
  227.  
  228. interface
  229.  
  230. uses
  231.   SysUtils,
  232.   Windows,
  233.   Classes;
  234.  
  235. // HelpContext values for all raised exceptions
  236. const
  237.   //:Exception was handled and converted to EGpHugeFile but was not expected and is not categorised.
  238.   hcHFUnexpected              = 1000;
  239.   //:Windows error.
  240.   hcHFWindowsError            = 1001;
  241.   //:Unknown Windows error.
  242.   hcHFUnknownWindowsError     = 1002;
  243.   //:Invalid block size.
  244.   hcHFInvalidBlockSize        = 1003;
  245.   //:Invalid file handle.
  246.   hcHFInvalidHandle           = 1004;
  247.   //:Failed to allocate buffer.
  248.   hcHFFailedToAllocateBuffer  = 1005;
  249.   //:Write operation encountered while in buffered read mode.
  250.   hcHFWriteInBufferedReadMode = 1006;
  251.   //:Read operation encountered while in buffered write mode.
  252.   hcHFReadInBufferedWriteMode = 1007;
  253.   //:Unexpected end of file.
  254.   hcHFUnexpectedEOF           = 1008;
  255.   //:Write failed - not all data was saved.
  256.   hcHFWriteFailed             = 1009;
  257.   //:Invalid 'mode' parameter passed to Seek function.
  258.   hcHFInvalidSeekMode         = 1010;
  259.  
  260. type
  261.   {:Alias for int64 so it is Delphi-version-independent (as much as that is
  262.     possible at all).
  263.   }
  264.   HugeInt = LONGLONG;
  265.  
  266.   {:Base exception class for all exceptions raised in TGpHugeFile and
  267.     descendants.
  268.   }
  269.   EGpHugeFile       = class(Exception);
  270.  
  271.   {:Base exception class for exceptions created in TGpHugeFileStream.
  272.   }
  273.   EGpHugeFileStream = class(EGpHugeFile);
  274.  
  275.   {:Result of TGpHugeFile reset and rewrite methods.
  276.     @enum hfOK         File opened successfully.
  277.     @enum hfFileLocked Access to file failed because it is already open and
  278.                        compatible sharing is not allowed.
  279.     @enum hfError      Other file access errors (file/path not found...).
  280.    }
  281.   THFError = (hfOK, hfFileLocked, hfError);
  282.  
  283.   {:TGpHugeFile reset/rewrite options.
  284.     @enum hfoBuffered   Open file in buffered mode. Buffer size is either
  285.                         default (BUF_SIZE, currently 64 KB) or specified by the
  286.                         caller in ResetEx or RewriteEx methods.
  287.     @enum hfoLockBuffer Buffer must be locked (Windows require that for direct
  288.                         access files (FILE_FLAG_NO_BUFFERING) to work
  289.                         correctly).
  290.     @enum hfoCloseOnEOF Valid only when file is open for reading. If set,
  291.                         TGpHugeFile will close file handle as soon as last block
  292.                         is read from the file. This will free file for other
  293.                         programs while main program may still read data from
  294.                         TGpHugeFile's buffer. (*)                                <br>
  295.                         After the end of file is reached (and handle is closed): <ul><li>
  296.                           FilePos may be used.                                   </li><li>
  297.                           FileSize may be used.                                  </li><li>
  298.                           Seek and BlockRead may be used as long as the request
  299.                           can be fulfilled from the buffer.                      </li></ul><br>
  300.                         Use of this option is not recommended when access to the
  301.                         file is random. (*) It was designed to use with
  302.                         sequential or almost sequential access to the file.
  303.                         hfoCloseOnEOF is ignored if hfoBuffered is not set.
  304.                         hfoCloseOnEOF is ignored if used in RewriteEx.           <br>
  305.                         (*) hfoCloseOnEOF can cope with a program that
  306.                         alternately calls BlockRead and Seek requests. When
  307.                         BlockRead reaches EOF, this condition will be marked but
  308.                         file handle will not be closed yet. When BlockRead is
  309.                         called again, file will be closed, but only if between
  310.                         those calls Seek did not invalidate the buffer (Seek
  311.                         that can be fulfilled from the buffer is OK). This works
  312.                         with programs that load a small buffer and then Seek
  313.                         somewhere in the middle of this buffer (like Readln
  314.                         function in TGpTextFile class does).
  315.     @enum hfoCanCreate  Reset is allowed to create a file if it doesn't exist.
  316.   }
  317.   THFOpenOption  = (hfoBuffered, hfoLockBuffer, hfoCloseOnEOF, hfoCanCreate);
  318.  
  319.   {:Set of all TGpHugeFile reset/rewrite options.
  320.   }
  321.   THFOpenOptions = set of THFOpenOption;
  322.  
  323.   {:Encapsulation of 64-bit file functions, supporting normal, buffered, and
  324.     direct access with some additional twists.
  325.   }
  326.   TGpHugeFile = class
  327.   private
  328.     hfBlockSize       : DWORD;
  329.     hfBuffer          : pointer;
  330.     hfBuffered        : boolean;
  331.     hfBufferSize      : DWORD;
  332.     hfBufFileOffs     : HugeInt;
  333.     hfBufFilePos      : HugeInt;
  334.     hfBufOffs         : DWORD;
  335.     hfBufSize         : DWORD;
  336.     hfBufWrite        : boolean;
  337.     hfCachedSize      : HugeInt;
  338.     hfCanCreate       : boolean;
  339.     hfCloseOnEOF      : boolean;
  340.     hfCloseOnNext     : boolean;
  341.     hfDesiredAcc      : DWORD;
  342.     hfDesiredShareMode: DWORD;
  343.     hfFlagNoBuf       : boolean;
  344.     hfFlags           : DWORD;
  345.     hfHalfClosed      : boolean;
  346.     hfHandle          : THandle;
  347.     hfIsOpen          : boolean;
  348.     hfLastSize        : integer;
  349.     hfLockBuffer      : boolean;
  350.     hfName            : string;
  351.     hfReading         : boolean;
  352.     hfShareModeSet    : boolean;
  353.     hfWindowsError    : DWORD;
  354.   protected
  355.     function  _FilePos: HugeInt; virtual;
  356.     function  _FileSize: HugeInt; virtual;
  357.     procedure _Seek(offset: HugeInt; movePointer: boolean); virtual;
  358.     function  AccessFile(blockSize: integer; reset: boolean;
  359.       diskLockTimeout: integer; diskRetryDelay: integer;
  360.       waitObject: THandle): THFError; virtual;
  361.     procedure AllocBuffer; virtual;
  362.     procedure CheckHandle; virtual;
  363.     procedure Fetch(var buf; count: DWORD; var transferred: DWORD); virtual;
  364.     function  FlushBuffer: boolean; virtual;
  365.     procedure FreeBuffer; virtual;
  366.     function  GetDate: TDateTime; virtual;
  367.     procedure InitReadBuffer; virtual;
  368.     procedure InitWriteBuffer; virtual;
  369.     function  LoadedToTheEOF: boolean; virtual;
  370.     function  RoundToPageSize(bufSize: DWORD): DWORD; virtual;
  371.     procedure SetDate(const Value: TDateTime); virtual;
  372.     procedure Transmit(const buf; count: DWORD; var transferred: DWORD); virtual;
  373.     procedure Win32Check(condition: boolean; method: string); virtual;
  374.   public
  375.     constructor Create(fileName: string);
  376.     constructor CreateEx(fileName: string;
  377.       FlagsAndAttributes: DWORD {$IFDEF D4plus}= FILE_ATTRIBUTE_NORMAL{$ENDIF};
  378.       DesiredAccess: DWORD      {$IFDEF D4plus}= GENERIC_READ+GENERIC_WRITE{$ENDIF};
  379.       DesiredShareMode: DWORD   {$IFDEF D4plus}= $FFFF{$ENDIF});
  380.     procedure   Reset(blockSize: integer {$IFDEF D4plus}= 1{$ENDIF});
  381.     procedure   Rewrite(blockSize: integer {$IFDEF D4plus}= 1{$ENDIF});
  382.     procedure   ResetBuffered(
  383.       blockSize: integer  {$IFDEF D4plus}= 1{$ENDIF};
  384.       bufferSize: integer {$IFDEF D4plus}= 0{$ENDIF};
  385.       lockBuffer: boolean {$IFDEF D4plus}= false{$ENDIF});
  386.     procedure   RewriteBuffered(
  387.       blockSize: integer  {$IFDEF D4plus}= 1{$ENDIF};
  388.       bufferSize: integer {$IFDEF D4plus}= 0{$ENDIF};
  389.       lockBuffer: boolean {$IFDEF D4plus}= false{$ENDIF});
  390.     function    ResetEx(
  391.       blockSize: integer       {$IFDEF D4plus}= 1{$ENDIF};
  392.       bufferSize: integer      {$IFDEF D4plus}= 0{$ENDIF};
  393.       diskLockTimeout: integer {$IFDEF D4plus}= 0{$ENDIF};
  394.       diskRetryDelay: integer  {$IFDEF D4plus}= 0{$ENDIF};
  395.       options: THFOpenOptions  {$IFDEF D4plus}= []{$ENDIF};
  396.       waitObject: THandle      {$IFDEF D4plus}= 0{$ENDIF}): THFError;
  397.     function    RewriteEx(
  398.       blockSize: integer       {$IFDEF D4plus}= 1{$ENDIF};
  399.       bufferSize: integer      {$IFDEF D4plus}= 0{$ENDIF};
  400.       diskLockTimeout: integer {$IFDEF D4plus}= 0{$ENDIF};
  401.       diskRetryDelay: integer  {$IFDEF D4plus}= 0{$ENDIF};
  402.       options: THFOpenOptions  {$IFDEF D4plus}= []{$ENDIF};
  403.       waitObject: THandle      {$IFDEF D4plus}= 0{$ENDIF}): THFError;
  404.     destructor  Destroy; override;
  405.     procedure   BlockRead(var buf; count: DWORD; var transferred: DWORD);
  406.     procedure   BlockReadUnsafe(var buf; count: DWORD);
  407.     procedure   BlockWrite(const buf; count: DWORD; var transferred: DWORD);
  408.     procedure   BlockWriteUnsafe(const buf; count: DWORD);
  409.     procedure   Close;
  410.     function    FileExists: boolean;
  411.     function    FilePos: HugeInt;
  412.     function    FileSize: HugeInt;
  413.     procedure   Flush;
  414.     function    IsOpen: boolean;
  415.     procedure   Seek(offset: HugeInt);
  416.     procedure   Truncate;
  417.     {:File date/time.
  418.     }
  419.     property    FileDate: TDateTime read GetDate write SetDate;
  420.     {:File name.
  421.     }
  422.     property    FileName: string read hfName;
  423.     {:True if access to file is buffered.
  424.     }
  425.     property    IsBuffered: boolean read hfBuffered;
  426.     {:Last Windows error code.
  427.     }
  428.     property    WindowsError: DWORD read hfWindowsError;
  429.   end; { TGpHugeFile }
  430.  
  431.   {:All possible ways to access TGpHugeFileStream.
  432.     @enum accRead      Read access.
  433.     @enum accWrite     Write access.
  434.     @enum accReadWrite Read and write access.
  435.     @enum accAppend    Same as accReadWrite, just that Position is set
  436.                        immediatly after the end of file.
  437.   }
  438.   TGpHugeFileStreamAccess = (accRead, accWrite, accReadWrite, accAppend);
  439.  
  440.   {:TStream descendant, wrapping a TGpHugeFile. Although it does not support
  441.     huge files fully (because of TStream limitations - 'longint' is used instead
  442.     of 'int64' in critical places), you can still use it as a buffered file
  443.     stream.
  444.   }
  445.   TGpHugeFileStream = class(TStream)
  446.   private
  447.     hfsExternalHF  : boolean;
  448.     hfsFile        : TGpHugeFile;
  449.     hfsWindowsError: DWORD;
  450.   protected
  451.     function  GetFileName: string; virtual;
  452.     function  GetSize: longint; virtual;
  453.     function  GetWindowsError: DWORD; virtual;
  454.     procedure SetSize(newSize: longint); override;
  455.     procedure Win32Check(condition: boolean; method: string); virtual;
  456.   public
  457.     constructor Create(const fileName: string; access: TGpHugeFileStreamAccess;
  458.       openOptions: THFOpenOptions {$IFDEF D4plus}= [hfoBuffered]{$ENDIF});
  459.     constructor CreateFromHandle(hf: TGpHugeFile); 
  460.     destructor  Destroy; override;
  461.     function Read(var buffer; count: longint): longint; override;
  462.     function Seek(offset: longint; mode: word): longint; override;
  463.     function Write(const buffer; count: longint): longint; override;
  464.     {:Name of underlying file.
  465.     }
  466.     property FileName: string read GetFileName;
  467.     {:Stream size. Reintroduced to override GetSize (static in TStream) with
  468.       faster version.
  469.     }
  470.     property Size: longint read GetSize write SetSize;
  471.     {:Last Windows error code.
  472.     }
  473.     property WindowsError: DWORD read GetWindowsError;
  474.   end; { TGpHugeFileStream }
  475.  
  476. implementation
  477.  
  478. uses
  479.   SysConst;
  480.  
  481. const
  482.   {:Default buffer size. 64 KB, small enough to be VirtualLock'd in NT 4
  483.   }
  484.   BUF_SIZE = 64*1024;
  485.  
  486. {$IFDEF D3plus}
  487. resourcestring
  488. {$ELSE}
  489. const
  490. {$ENDIF}
  491.   sBlockSizeMustBeGreaterThanZero = 'TGpHugeFile(%s):BlockSize must be greater than zero!';
  492.   sFailedToAllocateBuffer         = 'TGpHugeFile(%s):Failed to allocate buffer!';
  493.   sFileNotOpen                    = 'TGpHugeFile(%s):File not open!';
  494.   sInvalidMode                    = 'TGpHugeFileStream(%s):Invalid mode!';
  495.   sReadWhileInBufferedWriteMode   = 'TGpHugeFile(%s):Read while in buffered write mode!';
  496.   sFileFailed                     = 'TGpHugeFile.%s(%s) failed. ';
  497.   sStreamFailed                   = 'TGpHugeFileStream.%s(%s) failed. ';
  498.   sWriteFailed                    = 'TGpHugeFile(%s):Write failed!';
  499.   sWriteWhileInBufferedReadMode   = 'TGpHugeFile(%s):Write while in buffered read mode!';
  500.   
  501. {$IFDEF D4plus}
  502. type
  503.   {:D4 and newer define TLargeInteger as int64.
  504.   }
  505.   TLargeInteger = LARGE_INTEGER;
  506. {$ENDIF}
  507.  
  508. { TGpHugeFile }
  509.  
  510. {:Standard TGpHugeFile constructor. Prepares file for full, share none, access.
  511.   @param   fileName Name of file to be accessed.
  512. }
  513. constructor TGpHugeFile.Create(fileName: string);
  514. begin
  515.   CreateEx(fileName,FILE_ATTRIBUTE_NORMAL,GENERIC_READ+GENERIC_WRITE,0);
  516.   hfShareModeSet := false;
  517. end; { TGpHugeFile.Create }
  518.  
  519. {:Extended TGpHugeFile constructor. Caller can specify desired flags,
  520.   attributes, and access mode.
  521.   @param   fileName           Name of file to be accessed.
  522.   @param   FlagsAndAttributes Flags and attributes, see CreateFile help for more
  523.                               details.
  524.   @param   DesiredAccess      Desired access flags, see CreateFile help for more
  525.                               details.
  526. }
  527. constructor TGpHugeFile.CreateEx(fileName: string; FlagsAndAttributes,
  528.   DesiredAccess, DesiredShareMode: DWORD);
  529. begin
  530.   inherited Create;
  531.   hfBlockSize        := 1;
  532.   hfBuffer           := nil;
  533.   hfBuffered         := false;
  534.   hfCachedSize       := -1;
  535.   hfDesiredAcc       := DesiredAccess;
  536.   hfDesiredShareMode := DesiredShareMode;
  537.   hfShareModeSet     := true;
  538.   hfFlagNoBuf        := ((FILE_FLAG_NO_BUFFERING AND FlagsAndAttributes) <> 0);
  539.   hfFlags            := FlagsAndAttributes;
  540.   hfHandle           := INVALID_HANDLE_VALUE;
  541.   hfName             := fileName;
  542. end; { TGpHugeFile.CreateEx }
  543.  
  544. {:TGpHugeFile destructor. Will close file if it is still open.
  545. }
  546. destructor TGpHugeFile.Destroy;
  547. begin
  548.   Close;
  549.   inherited Destroy;
  550. end; { TGpHugeFile.Destroy }
  551.  
  552. {:Tests if a specified file exists.
  553.   @returns True if file exists.
  554. }
  555. function TGpHugeFile.FileExists: boolean;
  556. begin
  557.   FileExists := SysUtils.FileExists(hfName);
  558. end; { TGpHugeFile.FileExists }
  559.  
  560. {:Opens/creates a file. AccessFile centralizes file opening in TGpHugeFile. It
  561.   will set appropriate sharing mode, open or create a file, and even retry in
  562.   a case of locked file (if so required).
  563.   @param   blockSize       Basic unit of access (same as RecSize parameter in
  564.                            Delphi's Reset and Rewrite).
  565.   @param   reset           True if file is to be reset, false if it is to be
  566.                            rewritten.
  567.   @param   diskLockTimeout Max time (in milliseconds) AccessFile will wait for
  568.                            lock file to become free.
  569.   @param   diskRetryDelay  Delay (in milliseconds) between attempts to open
  570.                            locked file.
  571.   @param   waitObject      Handle of 'terminate' event (semaphore, mutex). If
  572.                            this parameter is specified (not zero) and becomes
  573.                            signalled, AccessFile will stop trying to open locked
  574.                            file and will exit with.
  575.   @returns Status (ok, file locked, other error).
  576.   @raises  EGpHugeFile if 'blockSize' is less or equal to zero.
  577.   @seeAlso ResetEx, RewriteEx
  578. }
  579. function TGpHugeFile.AccessFile(blockSize: integer; reset: boolean;
  580.   diskLockTimeout: integer; diskRetryDelay: integer;
  581.   waitObject: THandle): THFError;
  582. var
  583.   start: int64;
  584.  
  585.   function Elapsed: boolean;
  586.   var
  587.     stop: int64;
  588.   begin
  589.     if diskLockTimeout = 0 then
  590.       Result := true
  591.     else begin
  592.       stop := GetTickCount;
  593.       if stop < start then
  594.         stop := stop + $100000000;
  595.       Result := ((stop-start) > diskLockTimeout);
  596.     end;
  597.   end; { Elapsed }
  598.  
  599. const
  600.   FILE_SHARING_ERRORS: set of byte = [ERROR_SHARING_VIOLATION, ERROR_LOCK_VIOLATION];
  601. var
  602.   awaited  : boolean;
  603.   creat    : DWORD;
  604.   shareMode: DWORD;
  605. begin { TGpHugeFile.AccessFile }
  606.   if blockSize <= 0 then
  607.     raise EGpHugeFile.CreateFmtHelp(sBlockSizeMustBeGreaterThanZero,[FileName],hcHFInvalidBlockSize);
  608.   hfBlockSize := blockSize;
  609.   start := GetTickCount;
  610.   repeat
  611.     if reset then begin
  612.       if hfCanCreate then
  613.         creat := OPEN_ALWAYS
  614.       else
  615.         creat := OPEN_EXISTING;
  616.     end
  617.     else
  618.       creat := CREATE_ALWAYS;
  619.     SetLastError(0);
  620.     hfWindowsError := 0;
  621.     if hfShareModeSet then begin
  622.       if hfDesiredShareMode = $FFFF then begin
  623.         if hfDesiredAcc = GENERIC_READ then
  624.           shareMode := FILE_SHARE_READ
  625.         else
  626.           shareMode := 0
  627.       end
  628.       else
  629.         shareMode := hfDesiredShareMode
  630.     end
  631.     else begin
  632.       if hfDesiredAcc = GENERIC_READ then
  633.         shareMode := FILE_SHARE_READ
  634.       else
  635.         shareMode := 0;
  636.     end;
  637.     hfHandle := CreateFile(PChar(hfName),hfDesiredAcc,shareMode,nil,creat,hfFlags,0);
  638.     awaited := false;
  639.     if hfHandle = INVALID_HANDLE_VALUE then begin
  640.       hfWindowsError := GetLastError; 
  641.       if (hfWindowsError in FILE_SHARING_ERRORS) and (diskRetryDelay > 0) and (not Elapsed) then
  642.         if waitObject <> 0 then
  643.           awaited := WaitForSingleObject(waitObject, diskRetryDelay) <> WAIT_TIMEOUT
  644.         else
  645.           Sleep(diskRetryDelay);
  646.     end
  647.     else begin
  648.       hfWindowsError := 0;
  649.       hfIsOpen := true;
  650.     end;
  651.   until (hfWindowsError = 0) or (not (hfWindowsError in FILE_SHARING_ERRORS)) or Elapsed or awaited;
  652.   if hfWindowsError = 0 then
  653.     Result := hfOK
  654.   else if hfWindowsError in FILE_SHARING_ERRORS then
  655.     Result := hfFileLocked
  656.   else
  657.     Result := hfError;
  658.   if Result = hfOK then
  659.     AllocBuffer;
  660. end; { TGpHugeFile.AccessFile }
  661.  
  662. {:Simplest form of Reset, emulating Delphi's Reset.
  663.   @param   blockSize Basic unit of access (same as RecSize parameter in Delphi's
  664.                      Reset and Rewrite).
  665.   @raises  EGpHugeFile if file could not be opened.
  666. }
  667. procedure TGpHugeFile.Reset(blockSize: integer);
  668. begin
  669.   Win32Check(ResetEx(blockSize,0,0,0,[hfoBuffered]) = hfOK,'Reset');
  670. end; { TGpHugeFile.Reset }
  671.  
  672. {:Simplest form of Rewrite, emulating Delphi's Rewrite.
  673.   @param   blockSize       Basic unit of access (same as RecSize parameter in
  674.                            Delphi's Rewrite).
  675.   @raises  EGpHugeFile if file could not be opened.
  676. }
  677. procedure TGpHugeFile.Rewrite(blockSize: integer);
  678. begin
  679.   Win32Check(RewriteEx(blockSize,0,0,0,[hfoBuffered]) = hfOK,'Rewrite');
  680. end; { TGpHugeFile.Rewrite }
  681.  
  682. {:Buffered Reset. Caller can specifiy size of buffer and require that buffer is
  683.   locked in memory (Windows require that for direct access files
  684.   (FILE_FLAG_NO_BUFFERING) to work correctly).
  685.   @param   blockSize  Basic unit of access (same as RecSize parameter in
  686.                       Delphi's Reset).
  687.   @param   bufferSize Size of buffer. 0 means default size (BUF_SIZE, currently
  688.                       64 KB).
  689.   @param   lockBuffer If true, buffer will be locked.
  690.   @raises  EGpHugeFile if file could not be opened.
  691.   @seeAlso BUF_SIZE
  692. }
  693. procedure TGpHugeFile.ResetBuffered(blockSize, bufferSize: integer;
  694.   lockBuffer: boolean);
  695. var
  696.   options: THFOpenOptions;
  697. begin
  698.   options := [hfoBuffered];
  699.   if lockBuffer then
  700.     Include(options,hfoLockBuffer);
  701.   Win32Check(ResetEx(blockSize,bufferSize,0,0,options) = hfOK,'ResetBuffered');
  702. end; { TGpHugeFile.ResetBuffered }
  703.  
  704. {:Buffered Rewrite. Caller can specifiy size of buffer and require that buffer
  705.   is locked in memory (Windows require that for direct access files
  706.   (FILE_FLAG_NO_BUFFERING) to work correctly).
  707.   @param   blockSize  Basic unit of access (same as RecSize parameter in
  708.                       Delphi's Rewrite).
  709.   @param   bufferSize Size of buffer. 0 means default size (BUF_SIZE, currently
  710.                       64 KB).
  711.   @param   lockBuffer If true, buffer will be locked.
  712.   @raises  EGpHugeFile if file could not be opened.
  713.   @seeAlso BUF_SIZE
  714. }
  715. procedure TGpHugeFile.RewriteBuffered(blockSize, bufferSize: integer;
  716.   lockBuffer: boolean);
  717. var
  718.   options: THFOpenOptions;
  719. begin
  720.   options := [hfoBuffered];
  721.   if lockBuffer then
  722.     Include(options,hfoLockBuffer);
  723.   Win32Check(RewriteEx(blockSize,bufferSize,0,0,options) = hfOK,'RewriteBuffered');
  724. end; { TGpHugeFile.RewriteBuffered }
  725.  
  726. {:Full form of Reset. Will retry if file is locked by another application (if
  727.   diskLockTimeout and diskRetryDelay are specified). Allows caller to specify
  728.   additional options. Does not raise an exception on error. 
  729.   @param   blockSize       Basic unit of access (same as RecSize parameter in
  730.                            Delphi's Reset).
  731.   @param   bufferSize      Size of buffer. 0 means default size (BUF_SIZE,
  732.                            currently 64 KB).
  733.   @param   diskLockTimeout Max time (in milliseconds) AccessFile will wait for
  734.                            lock file to become free.
  735.   @param   diskRetryDelay  Delay (in milliseconds) between attempts to open
  736.                            locked file.
  737.   @param   options         Set of possible open options.
  738.   @param   waitObject      Handle of 'terminate' event (semaphore, mutex). If
  739.                            this parameter is specified (not zero) and becomes
  740.                            signalled, AccessFile will stop trying to open locked
  741.                            file and will exit with.
  742.   @returns Status (ok, file locked, other error).
  743. }
  744. function TGpHugeFile.ResetEx(blockSize, bufferSize: integer;
  745.   diskLockTimeout: integer; diskRetryDelay: integer;
  746.   options: THFOpenOptions; waitObject: THandle): THFError;
  747. begin
  748.   hfWindowsError := 0;
  749.   try
  750.     { There's a reason behind this 'if IsOpen...' behaviour. We definitely
  751.       don't want to release file handle if ResetEx is called twice in a row as
  752.       that could lead to all sorts of sharing problems.
  753.       Delphi does this wrong - if you Reset file twice in a row, handle will be
  754.       closed and file will be reopened.
  755.     }
  756.     if hfCloseOnEOF and IsOpen then
  757.       Close; //2.26
  758.     if IsOpen then begin
  759.       if not hfReading then
  760.         FlushBuffer;
  761.       hfBuffered := false;
  762.       Seek(0);
  763.       FreeBuffer;
  764.     end;
  765.     hfBuffered := hfoBuffered in options;
  766.     hfCloseOnEOF := ([hfoCloseOnEOF,hfoBuffered] * options) = [hfoCloseOnEOF,hfoBuffered];
  767.     hfCanCreate := hfoCanCreate in options;
  768.     if hfBuffered then begin
  769.       hfBufferSize := bufferSize;
  770.       hfLockBuffer := hfoLockBuffer in options;
  771.     end;
  772.     if not IsOpen then
  773.       Result := AccessFile(blockSize,true,diskLockTimeout,diskRetryDelay,waitObject)
  774.     else begin
  775.       hfBlockSize := blockSize;
  776.       AllocBuffer;
  777.       Result := hfOK;
  778.     end;
  779.     if Result <> hfOK then
  780.       Close
  781.     else begin
  782.       if hfBuffered then
  783.         InitReadBuffer;
  784.       hfBufFilePos := 0;
  785.       hfReading := true;
  786.       hfHalfClosed := false;
  787.     end;
  788.   except
  789.     Result := hfOK;
  790.   end;
  791. end; { TGpHugeFile.ResetEx }
  792.  
  793. {:Full form of Rewrite. Will retry if file is locked by another application (if
  794.   diskLockTimeout and diskRetryDelay are specified). Allows caller to specify
  795.   additional options. Does not raise an exception on error.
  796.   @param   blockSize       Basic unit of access (same as RecSize parameter in
  797.                            Delphi's Rewrite).
  798.   @param   bufferSize      Size of buffer. 0 means default size (BUF_SIZE,
  799.                            currently 64 KB).
  800.   @param   diskLockTimeout Max time (in milliseconds) AccessFile will wait for
  801.                            lock file to become free.
  802.   @param   diskRetryDelay  Delay (in milliseconds) between attempts to open
  803.                            locked file.
  804.   @param   options         Set of possible open options.
  805.   @param   waitObject      Handle of 'terminate' event (semaphore, mutex). If
  806.                            this parameter is specified (not zero) and becomes
  807.                            signalled, AccessFile will stop trying to open locked
  808.                            file and will exit with.
  809.   @returns Status (ok, file locked, other error).
  810. }
  811. function TGpHugeFile.RewriteEx(blockSize, bufferSize: integer;
  812.   diskLockTimeout: integer; diskRetryDelay: integer;
  813.   options: THFOpenOptions; waitObject: THandle): THFError;
  814. begin
  815.   hfWindowsError := 0;
  816.   try
  817.     { There's a reason behind this 'if IsOpen...' behaviour. We definitely
  818.       don't want to release file handle if ResetEx is called twice in a row as
  819.       that could lead to all sorts of sharing problems.
  820.       Delphi does this wrong - if you Reset file twice in a row, handle will be
  821.       closed and file will be reopened.
  822.     }
  823.     if hfCloseOnEOF and IsOpen then
  824.       Close; //2.26
  825.     if IsOpen then begin
  826.       hfBuffered := false;
  827.       Seek(0);
  828.       Truncate;
  829.       FreeBuffer;
  830.     end;
  831.     hfBuffered := hfoBuffered in options;
  832.     if hfBuffered then begin
  833.       hfBufferSize := bufferSize;
  834.       hfLockBuffer := hfoLockBuffer in options;
  835.     end;
  836.     if not IsOpen then
  837.       Result := AccessFile(blockSize,false,diskLockTimeout,diskRetryDelay,waitObject)
  838.     else begin
  839.       hfBlockSize := blockSize;
  840.       AllocBuffer;
  841.       Result := hfOK;
  842.     end;
  843.     if Result <> hfOK then
  844.       Close
  845.     else begin
  846.       if hfBuffered then
  847.         InitWriteBuffer;
  848.       hfBufFilePos := 0;
  849.       hfReading := false;
  850.       hfHalfClosed := false;
  851.     end;
  852.   except
  853.     Result := hfOK;
  854.   end;
  855. end; { TGpHugeFile.RewriteEx }
  856.  
  857. {:Closes open file. If file is not open, do nothing.
  858.   @raises  EGpHugeFile on Windows errors.
  859. }
  860. procedure TGpHugeFile.Close;
  861. begin
  862.   try
  863.     if IsOpen then begin
  864.       FreeBuffer;
  865.       if hfHandle <> INVALID_HANDLE_VALUE then begin // may be freed in BlockRead
  866.         CloseHandle(hfHandle);
  867.         hfHandle := INVALID_HANDLE_VALUE;
  868.       end;
  869.       hfHalfClosed := false;
  870.       hfIsOpen := false;
  871.       hfCloseOnEOF := false;
  872.     end;
  873.   except
  874.     on EGpHugeFile do
  875.       raise;
  876.     on E:Exception do
  877.       raise EGpHugeFile.CreateHelp(E.Message,hcHFUnexpected);
  878.   end;
  879. end; { TGpHugeFile.Close }
  880.  
  881. {:Checks if file is open. Called from various TGpHugeFile methods.
  882.   @raises  EGpHugeFile if file is not open.
  883. }
  884. procedure TGpHugeFile.CheckHandle;
  885. begin
  886.   if hfHandle = INVALID_HANDLE_VALUE then
  887.     raise EGpHugeFile.CreateFmtHelp(sFileNotOpen,[FileName],hcHFInvalidHandle);
  888. end; { TGpHugeFile.CheckHandle }
  889.  
  890. {:Returns the size of file in 'block size' units (see 'blockSize' parameter to
  891.   Reset and Rewrite methods).
  892.   @returns Size of file in 'block size' units.
  893.   @raises  EGpHugeFile on Windows errors.
  894.   @seeAlso Reset, Rewrite
  895. }
  896. function TGpHugeFile.FileSize: HugeInt;
  897. var
  898.   realSize: HugeInt;
  899.   size    : TLargeInteger;
  900. begin
  901.   try
  902.     if hfHalfClosed then
  903.       Result := hfLastSize //2.26: hfoCloseOnEOF support
  904.     else begin
  905.       CheckHandle;
  906.       SetLastError(0);
  907.       size.LowPart := GetFileSize(hfHandle,@size.HighPart);
  908.       Win32Check(size.LowPart<>$FFFFFFFF,'FileSize');
  909.       if hfBufFilePos > size.QuadPart then
  910.         realSize := hfBufFilePos
  911.       else
  912.         realSize := size.QuadPart;
  913.       if hfBlockSize <> 1 then
  914.         Result := {$IFDEF D4plus}Trunc{$ELSE}int{$ENDIF}
  915.                     (realSize/hfBlockSize)
  916.       else
  917.         Result := realSize;
  918.     end;
  919.   except
  920.     on EGpHugeFile do
  921.       raise;
  922.     on E:Exception do
  923.       raise EGpHugeFile.CreateHelp(E.Message,hcHFUnexpected);
  924.   end;
  925. end; { TGpHugeFile.FileSize }
  926.  
  927. {:Writes 'count' number of 'block size' large units (see 'blockSize' parameter
  928.   to Reset and Rewrite methods) to a file (or buffer if access is buffered).
  929.   @param   buf         Data to be written.
  930.   @param   count       Number of 'block size' large units to be written.
  931.   @param   transferred (out) Number of 'block size' large units actually written.
  932.   @raises  EGpHugeFile on Windows errors.
  933.   @seeAlso Reset, Rewrite
  934. }
  935. procedure TGpHugeFile.BlockWrite(const buf; count: DWORD; var transferred: DWORD);
  936. var
  937.   trans: DWORD;
  938. begin
  939.   try
  940.     CheckHandle;
  941.     if hfBlockSize <> 1 then
  942.       count := count * hfBlockSize;
  943.     if hfBuffered then
  944.       Transmit(buf,count,trans)
  945.     else begin
  946.       SetLastError(0);
  947.       Win32Check(WriteFile(hfHandle,buf,count,trans,nil),'BlockWrite');
  948.       hfBufFilePos := hfBufFilePos + trans;
  949.     end;
  950.     if hfBlockSize <> 1 then
  951.       transferred := trans div hfBlockSize
  952.     else
  953.       transferred := trans;
  954.     hfCachedSize := -1;
  955.   except
  956.     on EGpHugeFile do
  957.       raise;
  958.     on E:Exception do
  959.       raise EGpHugeFile.CreateHelp(E.Message,hcHFUnexpected);
  960.   end;
  961. end; { TGpHugeFile.BlockWrite }
  962.  
  963. {:Reads 'count' number of 'block size' large units (see 'blockSize' parameter
  964.   to Reset and Rewrite methods) from a file (or buffer if access is buffered).
  965.   @param   buf         Buffer for read data.
  966.   @param   count       Number of 'block size' large units to be read.
  967.   @param   transferred (out) Number of 'block size' large units actually read.
  968.   @raises  EGpHugeFile on Windows errors.
  969.   @seeAlso Reset, Rewrite
  970. }
  971. procedure TGpHugeFile.BlockRead(var buf; count: DWORD; var transferred: DWORD);
  972. var
  973.   closeNow  : boolean;
  974.   oldBufSize: DWORD;
  975.   trans     : DWORD;
  976. begin
  977.   try
  978.     if (not hfBuffered) or (not hfHalfClosed) then 
  979.       CheckHandle;
  980.     closeNow := hfCloseOnNext;
  981.     if hfBlockSize <> 1 then
  982.       count := count * hfBlockSize;
  983.     oldBufSize := hfBufSize;
  984.     if hfBuffered then
  985.       Fetch(buf,count,trans)
  986.     else begin
  987.       SetLastError(0);
  988.       Win32Check(ReadFile(hfHandle,buf,count,trans,nil),'BlockRead');
  989.       hfBufFilePos := hfBufFilePos + trans;
  990.     end;
  991.     if hfBlockSize <> 1 then
  992.       transferred := trans div hfBlockSize
  993.     else
  994.       transferred := trans;
  995.     if hfCloseOnEOF then begin
  996.       if closeNow then begin
  997.         if _FilePos >= FileSize then begin
  998.           hfLastSize := FileSize;
  999.           CloseHandle(hfHandle);
  1000.           hfHandle := INVALID_HANDLE_VALUE;
  1001.           hfHalfClosed := true; // allow FilePos to work until TGpHugeFile.Close
  1002.           hfCloseOnNext := false;
  1003.           //3.03: reset the buffer pointer
  1004.           hfBufOffs := hfBufOffs + (oldBufSize - hfBufSize);
  1005.           //2.26: rewind the buffer for Seek to work
  1006.           hfBufSize := oldBufSize;
  1007.         end;
  1008.       end
  1009.       else
  1010.         hfCloseOnNext := (hfHandle <> INVALID_HANDLE_VALUE) and LoadedToTheEOF;
  1011.     end;
  1012.   except
  1013.     on EGpHugeFile do
  1014.       raise;
  1015.     on E:Exception do
  1016.       raise EGpHugeFile.CreateHelp(E.Message,hcHFUnexpected);
  1017.   end;
  1018. end; { TGpHugeFile.BlockRead }
  1019.  
  1020. {:Internal implementation of Seek method. Called from other methods, too. Moves
  1021.   actual file pointer only when necessary or required by caller. Handles
  1022.   hfoCloseOnEOF files if possible.
  1023.   @param   offset      Offset from beginning of file in 'block size' large units
  1024.                        (see 'blockSize' parameter to Reset and Rewrite methods).
  1025.   @param   movePointer If true, Windows file pointer will always be moved. If
  1026.                        false, it will only be moved when Seek destination does
  1027.                        not lie in the buffer.
  1028.   @raises  Various system exceptions.
  1029.   @seeAlso Reset, Rewrite
  1030. }
  1031. procedure TGpHugeFile._Seek(offset: HugeInt; movePointer: boolean);
  1032. var
  1033.   off: TLargeInteger;
  1034. begin
  1035.   if (not hfBuffered) or movePointer or (not hfHalfClosed) then
  1036.     CheckHandle;
  1037.   if hfBlockSize <> 1 then
  1038.     off.QuadPart := offset*hfBlockSize
  1039.   else
  1040.     off.QuadPart := offset;
  1041.   if hfBuffered then begin
  1042.     if hfBufWrite then
  1043.       FlushBuffer
  1044.     else begin
  1045.       if not movePointer then begin
  1046.         if (off.QuadPart >= hfBufFileOffs) or
  1047.            (off.QuadPart < (hfBufFileOffs-hfBufSize)) then
  1048.           movePointer := true
  1049.         else
  1050.           hfBufOffs := {$IFNDEF D4plus}Trunc{$ENDIF}
  1051.                          (off.QuadPart-(hfBufFileOffs-hfBufSize));
  1052.       end;
  1053.       if movePointer then begin
  1054.         if hfHalfClosed then begin
  1055.           if off.QuadPart <> hfBufFileOffs then //2.26: allow seek to EOF
  1056.             CheckHandle; // bang!
  1057.         end
  1058.         else begin
  1059.           SetLastError(0);
  1060.           Win32Check(SetFilePointer(
  1061.             hfHandle,off.LowPart,@off.HighPart,FILE_BEGIN)<>$FFFFFFFF,'_Seek');
  1062.         end;
  1063.         //3.02: Seek to EOF in hfHalfClosed state must not invalidate the buffer
  1064.         if not (hfHalfClosed and (off.QuadPart = hfBufFileOffs)) then begin
  1065.           hfBufFileOffs := off.QuadPart;
  1066.           hfBufFilePos  := off.QuadPart;
  1067.           hfBufOffs     := 0;
  1068.           hfBufSize     := 0;
  1069.           hfCloseOnNext := false;
  1070.         end;
  1071.       end
  1072.       else if not LoadedToTheEOF then
  1073.         hfCloseOnNext := false;
  1074.     end;
  1075.   end
  1076.   else begin
  1077.     SetLastError(0);
  1078.     Win32Check(SetFilePointer(hfHandle,off.LowPart,@off.HighPart,FILE_BEGIN)<>$FFFFFFFF,'Seek');
  1079.   end;
  1080.   hfBufFilePos := off.QuadPart;
  1081. end; { TGpHugeFile._Seek }
  1082.  
  1083. {:Repositions file pointer. Moves actual file pointer only when necessary.
  1084.   @param   offset Offset from beginning of file in 'block size' large units (see
  1085.            'blockSize' parameter to Reset and Rewrite methods).
  1086.   @raises  EGpHugeFile on Windows errors.
  1087.   @seeAlso Reset, Rewrite
  1088. }
  1089. procedure TGpHugeFile.Seek(offset: HugeInt);
  1090. begin
  1091.   try
  1092.     _Seek(offset,false);
  1093.   except
  1094.     on EGpHugeFile do
  1095.       raise;
  1096.     on E:Exception do
  1097.       raise EGpHugeFile.CreateHelp(E.Message,hcHFUnexpected);
  1098.   end;
  1099. end; { TGpHugeFile.Seek }
  1100.  
  1101. {:Returns file pointer position in bytes. Used only internally.
  1102.   @returns File pointer position in bytes.
  1103.   @raises  Various system exceptions.
  1104. }
  1105. function TGpHugeFile._FilePos: HugeInt;
  1106. var
  1107.   off: TLargeInteger;
  1108. begin
  1109.   CheckHandle;
  1110.   off.QuadPart := 0;
  1111.   off.LowPart := SetFilePointer(hfHandle,off.LowPart,@off.HighPart,FILE_CURRENT);
  1112.   Win32Check(off.LowPart <> $FFFFFFFF,'_FilePos');
  1113.   Result := off.QuadPart;
  1114. end; { TGpHugeFile. }
  1115.  
  1116. {:Truncates file at current position.
  1117.   @raises  EGpHugeFile on Windows errors.
  1118. }
  1119. procedure TGpHugeFile.Truncate;
  1120. begin
  1121.   try
  1122.     CheckHandle;
  1123.     if hfBuffered then
  1124.       _Seek(FilePos,true);
  1125.     SetLastError(0);
  1126.     Win32Check(SetEndOfFile(hfHandle),'Truncate');
  1127.   except
  1128.     on EGpHugeFile do
  1129.       raise;
  1130.     on E:Exception do
  1131.       raise EGpHugeFile.CreateHelp(E.Message,hcHFUnexpected);
  1132.   end;
  1133. end; { TGpHugeFile.Truncate }
  1134.  
  1135. {:Returns file pointer position in 'block size' large units (see 'blockSize'
  1136.   parameter to Reset and Rewrite methods). Position is retrieved from cached
  1137.   value.
  1138.   @returns File pointer position in 'block size' large units.
  1139.   @raises  EGpHugeFile on Windows errors.
  1140.   @seeAlso Reset, Rewrite
  1141. }
  1142. function TGpHugeFile.FilePos: HugeInt;
  1143. begin
  1144.   try
  1145.     if not hfHalfClosed then
  1146.       CheckHandle;
  1147.     if hfBlockSize <> 1 then
  1148.       Result := {$IFDEF D4plus}Trunc{$ELSE}int{$ENDIF}(hfBufFilePos/hfBlockSize)
  1149.     else
  1150.       Result := hfBufFilePos;
  1151.   except
  1152.     on EGpHugeFile do
  1153.       raise;
  1154.     on E:Exception do
  1155.       raise EGpHugeFile.CreateHelp(E.Message,hcHFUnexpected);
  1156.   end;
  1157. end; { TGpHugeFile.FilePos }
  1158.  
  1159. {:Flushed file buffers.
  1160.   @raises  EGpHugeFile on Windows errors.
  1161. }
  1162. procedure TGpHugeFile.Flush;
  1163. begin
  1164.   CheckHandle;
  1165.   SetLastError(0);
  1166.   Win32Check(FlushBuffer,'Flush');
  1167.   SetLastError(0);
  1168.   Win32Check(FlushFileBuffers(hfHandle),'Flush');
  1169. end; {  TGpHugeFile.Flush  }
  1170.  
  1171. {:Rounds parameter next multiplier of system page size. Used to determine
  1172.   buffer size for direct access files (FILE_FLAG_NO_BUFFERING).
  1173.   @param   bufSize Initial buffer size.
  1174.   @returns bufSize Required buffer size.
  1175. }
  1176. function TGpHugeFile.RoundToPageSize(bufSize: DWORD): DWORD;
  1177. var
  1178.   sysInfo: TSystemInfo;
  1179. begin
  1180.   GetSystemInfo(sysInfo);
  1181.   Result := (((bufSize-1) div sysInfo.dwPageSize) + 1) * sysInfo.dwPageSize;
  1182. end; { TGpHugeFile.RoundToPageSize }
  1183.  
  1184. {:Allocates file buffer (after freeing old buffer if allocated). Calculates
  1185.   correct buffer size for direct access files and locks buffer if required. Used
  1186.   only internally.
  1187.   @raises Various system exceptions.
  1188. }
  1189. procedure TGpHugeFile.AllocBuffer;
  1190. begin
  1191.   FreeBuffer;
  1192.   if hfBufferSize = 0 then
  1193.     hfBufferSize := BUF_SIZE;
  1194.   // round up buffer size to be the multiplier of page size
  1195.   // needed for FILE_FLAG_NO_BUFFERING access, does not hurt in other cases
  1196.   hfBufferSize := RoundToPageSize(hfBufferSize);
  1197.   SetLastError(0);
  1198.   hfBuffer := VirtualAlloc(nil,hfBufferSize,MEM_RESERVE+MEM_COMMIT,PAGE_READWRITE);
  1199.   Win32Check(hfBuffer<>nil,'AllocBuffer');
  1200.   if hfLockBuffer then begin
  1201.     SetLastError(0);
  1202.     Win32Check(VirtualLock(hfBuffer,hfBufferSize),'AllocBuffer');
  1203.     if hfBuffer = nil then
  1204.       raise EGpHugeFile.CreateFmtHelp(sFailedToAllocateBuffer,[FileName],hcHFFailedToAllocateBuffer);
  1205.   end;
  1206. end; { TGpHugeFile.AllocBuffer }
  1207.  
  1208. {:Frees memory buffer if allocated. Used only internally.
  1209.   @raises  Various system exceptions.
  1210. }
  1211. procedure TGpHugeFile.FreeBuffer;
  1212. begin
  1213.   if hfBuffer <> nil then begin
  1214.     SetLastError(0);
  1215.     Win32Check(FlushBuffer,'FreeBuffer');
  1216.     if hfLockBuffer then begin
  1217.       SetLastError(0);
  1218.       Win32Check(VirtualUnlock(hfBuffer,hfBufferSize),'FreeBuffer');
  1219.     end;
  1220.     SetLastError(0);
  1221.     Win32Check(VirtualFree(hfBuffer,0,MEM_RELEASE),'FreeBuffer');
  1222.     hfBuffer := nil;
  1223.   end;
  1224. end; { TGpHugeFile.FreeBuffer }
  1225.  
  1226. {:Offsets pointer by a given ammount.
  1227.   @param   ptr    Original pointer.
  1228.   @param   offset Offset (in bytes).
  1229.   @returns New pointer.
  1230. }
  1231. function OffsetPtr(ptr: pointer; offset: DWORD): pointer;
  1232. begin
  1233.   Result := pointer(DWORD(ptr)+offset);
  1234. end; { OffsetPtr }
  1235.  
  1236. {:Writes 'count' number of bytes large units to a file (or buffer if access is
  1237.   buffered).
  1238.   @param   buf         Data to be written.
  1239.   @param   count       Number of bytes to be written.
  1240.   @param   transferred (out) Number of bytes actually written.
  1241.   @raises  EGpHugeFile when trying to write while in buffered read mode and file
  1242.            pointer is not at end of file.
  1243.   @raises  Various system exceptions.
  1244.   @seeAlso Reset, Rewrite
  1245. }
  1246. procedure TGpHugeFile.Transmit(const buf; count: DWORD; var transferred: DWORD);
  1247. var
  1248.   place  : DWORD;
  1249.   bufp   : pointer;
  1250.   send   : DWORD;
  1251.   written: DWORD;
  1252. begin
  1253.   if not hfBufWrite then begin
  1254.     //2.32: If we are at the end of file, we can switch into write mode
  1255.     if FilePos = FileSize then begin
  1256.       InitWriteBuffer;
  1257.       hfReading := false;
  1258.     end
  1259.     else
  1260.       raise EGpHugeFile.CreateFmtHelp(sWriteWhileInBufferedReadMode,[FileName],hcHFWriteInBufferedReadMode);
  1261.   end;
  1262.   transferred := 0;
  1263.   place := hfBufferSize-hfBufOffs;
  1264.   if place <= count then begin
  1265.     Move(buf,OffsetPtr(hfBuffer,hfBufOffs)^,place); // fill the buffer
  1266.     hfBufOffs := hfBufferSize;
  1267.     hfBufFilePos := hfBufFileOffs+hfBufOffs;
  1268.     if not FlushBuffer then
  1269.       Exit;
  1270.     transferred := place;
  1271.     Dec(count,place);
  1272.     bufp := OffsetPtr(@buf,place);
  1273.     if count >= hfBufferSize then begin // transfer N*(buffer size)
  1274.       send := (count div hfBufferSize)*hfBufferSize;
  1275.       if not WriteFile(hfHandle,bufp^,send,written,nil) then
  1276.         Exit;
  1277.       hfBufFileOffs := hfBufFileOffs+written;
  1278.       hfBufFilePos := hfBufFileOffs;
  1279.       Inc(transferred,written);
  1280.       Dec(count,send);
  1281.       bufp := OffsetPtr(bufp,send);
  1282.     end;                           
  1283.   end
  1284.   else
  1285.     bufp := @buf;
  1286.   if count > 0 then begin // store leftovers
  1287.     Move(bufp^,OffsetPtr(hfBuffer,hfBufOffs)^,count);
  1288.     Inc(hfBufOffs,count);
  1289.     Inc(transferred,count);
  1290.     hfBufFilePos := hfBufFileOffs+hfBufOffs;
  1291.   end;
  1292. end; { TGpHugeFile.Transmit }
  1293.  
  1294. {:Reads 'count' number of bytes large units from a file (or buffer if access is
  1295.   buffered).
  1296.   @param   buf         Buffer for read data.
  1297.   @param   count       Number of bytes to be read..
  1298.   @param   transferred (out) Number of bytes actually read..
  1299.   @raises  EGpHugeFile when trying to read while in buffered write mode.
  1300.   @raises  Various system exceptions.
  1301.   @seeAlso Reset, Rewrite
  1302. }
  1303. procedure TGpHugeFile.Fetch(var buf; count: DWORD; var transferred: DWORD);
  1304. var
  1305.   got  : DWORD;
  1306.   bufp : pointer;
  1307.   read : DWORD;
  1308.   trans: DWORD;
  1309. begin
  1310.   if hfBufWrite then
  1311.     raise EGpHugeFile.CreateFmtHelp(sReadWhileInBufferedWriteMode,[FileName],hcHFReadInBufferedWriteMode);
  1312.   transferred := 0;
  1313.   got := hfBufSize-hfBufOffs;
  1314.   if got <= count then begin
  1315.     if got > 0 then begin // read from buffer
  1316.       Move(OffsetPtr(hfBuffer,hfBufOffs)^,buf,got);
  1317.       transferred := got;
  1318.       Dec(count,got);
  1319.       hfBufFilePos := hfBufFileOffs-hfBufSize+hfBufOffs+got;
  1320.     end;
  1321.     bufp := OffsetPtr(@buf,got);
  1322.     hfBufOffs := 0;
  1323.     if count >= hfBufferSize then begin // read directly
  1324.       read := (count div hfBufferSize)*hfBufferSize;
  1325.       if hfHalfClosed then
  1326.         trans := 0 //2.26
  1327.       else if not ReadFile(hfHandle,bufp^,read,trans,nil) then
  1328.         Exit;
  1329.       hfBufFileOffs := hfBufFileOffs+trans;
  1330.       hfBufFilePos := hfBufFileOffs;
  1331.       Inc(transferred,trans);
  1332.       Dec(count,read);
  1333.       bufp := OffsetPtr(bufp,read);
  1334.       if trans < read then
  1335.         Exit; // EOF
  1336.     end;
  1337.     // fill the buffer
  1338.     if not hfHalfClosed then begin 
  1339.       if LoadedToTheEOF then
  1340.         hfBufSize := 0
  1341.       else begin
  1342.         SetLastError(0);
  1343.         Win32Check(ReadFile(hfHandle,hfBuffer^,hfBufferSize,hfBufSize,nil),'Fetch');
  1344.         hfBufFileOffs := hfBufFileOffs+hfBufSize;
  1345.       end;
  1346.     end
  1347.     else begin
  1348.       //3.03: when reacing end of buffer in hfHalfClosed mode, buffer must not
  1349.       //      be invalidated
  1350.       hfBufOffs := hfBufSize;
  1351.       Exit;
  1352.     end;
  1353.   end
  1354.   else
  1355.     bufp := @buf;
  1356.   if count > 0 then begin // read from buffer
  1357.     got := hfBufSize-hfBufOffs;
  1358.     if got < count then
  1359.       count := got;
  1360.     if count > 0 then
  1361.       Move(OffsetPtr(hfBuffer,hfBufOffs)^,bufp^,count);
  1362.     Inc(hfBufOffs,count);
  1363.     Inc(transferred,count);
  1364.     hfBufFilePos := hfBufFileOffs-hfBufSize+hfBufOffs;
  1365.   end;
  1366. end; { TGpHugeFile.Fetch }
  1367.  
  1368. {:Flushed file buffers (internal implementation).
  1369.   @returns False if data could not be written.
  1370. }
  1371. function TGpHugeFile.FlushBuffer: boolean;
  1372. var
  1373.   written: DWORD;
  1374. begin
  1375.   if (hfBufOffs > 0) and hfBufWrite then begin
  1376.     if hfFlagNoBuf then
  1377.       hfBufOffs := RoundToPageSize(hfBufOffs);
  1378.     Result := WriteFile(hfHandle,hfBuffer^,hfBufOffs,written,nil);
  1379.     hfBufFileOffs := hfBufFileOffs+written;
  1380.     hfBufOffs     := 0;
  1381.     hfBufFilePos  := hfBufFileOffs;
  1382.     if hfFlagNoBuf then
  1383.       FillChar(hfBuffer^,hfBufferSize,0);
  1384.   end
  1385.   else
  1386.     Result := true;
  1387. end; { TGpHugeFile.FlushBuffer }
  1388.  
  1389. {:Reads 'count' number of 'block size' large units (see 'blockSize' parameter
  1390.   to Reset and Rewrite methods) from a file (or buffer if access is buffered).
  1391.   @param   buf         Buffer for read data.
  1392.   @param   count       Number of 'block size' large units to be read.
  1393.   @raises  EGpHugeFile on Windows errors or if not enough data could be read
  1394.            from file.
  1395.   @seeAlso Reset, Rewrite
  1396. }
  1397. procedure TGpHugeFile.BlockReadUnsafe(var buf; count: DWORD);
  1398. var
  1399.   transferred: DWORD;
  1400. begin
  1401.   BlockRead(buf,count,transferred);
  1402.   if count <> transferred then begin
  1403.     if hfBuffered then
  1404.       raise EGpHugeFile.CreateHelp(sEndOfFile,hcHFUnexpectedEOF)
  1405.     else
  1406.       Win32Check(false,'BlockReadUnsafe');
  1407.   end;
  1408. end; { TGpHugeFile.BlockReadUnsafe }
  1409.  
  1410. {:Writes 'count' number of 'block size' large units (see 'blockSize' parameter
  1411.   to Reset and Rewrite methods) to a file (or buffer if access is buffered).
  1412.   @param   buf         Data to be written.
  1413.   @param   count       Number of 'block size' large units to be written.
  1414.   @raises  EGpHugeFile on Windows errors or if data could not be written
  1415.                        completely.
  1416.   @seeAlso Reset, Rewrite
  1417. }
  1418. procedure TGpHugeFile.BlockWriteUnsafe(const buf; count: DWORD);
  1419. var
  1420.   transferred: DWORD;
  1421. begin
  1422.   BlockWrite(buf,count,transferred);
  1423.   if count <> transferred then begin
  1424.     if hfBuffered then
  1425.       raise EGpHugeFile.CreateFmtHelp(sWriteFailed,[FileName],hcHFWriteFailed)
  1426.     else
  1427.       Win32Check(false,'BlockWriteUnsafe');
  1428.   end;
  1429. end; { BlockWriteUnsafe }
  1430.  
  1431. {:Returns true if file is open.
  1432.   @returns True if file is open.
  1433. }
  1434. function TGpHugeFile.IsOpen: boolean;
  1435. begin
  1436.   Result := hfIsOpen;
  1437. end; { TGpHugeFile.IsOpen }
  1438.  
  1439. {:Checks condition and creates appropriately formatted EGpHugeFile exception.
  1440.   @param   condition If false, Win32Check will generate an exception.
  1441.   @param   method    Name of TGpHugeFile method that called Win32Check.
  1442.   @raises  EGpHugeFile if (not condition).
  1443. }
  1444. procedure TGpHugeFile.Win32Check(condition: boolean; method: string);
  1445. var
  1446.   Error: EGpHugeFile;
  1447. begin
  1448.   if not condition then begin
  1449.     hfWindowsError := GetLastError;
  1450.     if hfWindowsError <> ERROR_SUCCESS then
  1451.       Error := EGpHugeFile.CreateFmtHelp(sFileFailed+
  1452.         {$IFNDEF D6PLUS}SWin32Error{$ELSE}SOSError{$ENDIF},
  1453.         [method,hfName,hfWindowsError,SysErrorMessage(hfWindowsError)],
  1454.         hcHFWindowsError)
  1455.     else
  1456.       Error := EGpHugeFile.CreateFmtHelp(sFileFailed+
  1457.         {$IFNDEF D6PLUS}SUnkWin32Error{$ELSE}SUnkOSError{$ENDIF},
  1458.         [method,hfName],hcHFUnknownWindowsError);
  1459.     raise Error;
  1460.   end;
  1461. end; { TGpHugeFile.Win32Check }
  1462.  
  1463. {:Returns file date in Delphi format.
  1464.   @returns Returns file date in Delphi format.
  1465.   @raises  EGpHugeFile on Windows errors.
  1466. }
  1467. function TGpHugeFile.GetDate: TDateTime;
  1468. begin
  1469.   try
  1470.     CheckHandle;
  1471.     Result := FileDateToDateTime(FileAge(FileName));
  1472.   except
  1473.     on EGpHugeFile do
  1474.       raise;
  1475.     on E:Exception do
  1476.       raise EGpHugeFile.CreateHelp(E.Message,hcHFUnexpected);
  1477.   end;
  1478. end; { TGpHugeFile.GetDate }
  1479.  
  1480. {:Sets file date.
  1481.   @param   Value new file date.
  1482. }
  1483. procedure TGpHugeFile.SetDate(const Value: TDateTime);
  1484. var
  1485.   err: integer;
  1486. begin
  1487.   try
  1488.     CheckHandle;
  1489.     err := FileSetDate(hfHandle,DateTimeToFileDate(Value));
  1490.     if err <> 0 then
  1491.       raise EGpHugeFile.CreateFmtHelp(sFileFailed+SysErrorMessage(err),
  1492.         ['SetDate',hfName],hcHFWindowsError);
  1493.   except
  1494.     on EGpHugeFile do
  1495.       raise;
  1496.     on E:Exception do
  1497.       raise EGpHugeFile.CreateHelp(E.Message,hcHFUnexpected);
  1498.   end;
  1499. end; { TGpHugeFile.SetDate }
  1500.  
  1501. {:Returns true if file is loaded into the buffer up to the last byte.
  1502.   @returns Returns true if file is loaded into the buffer up to the last byte.
  1503. }
  1504. function TGpHugeFile.LoadedToTheEOF: boolean;
  1505. begin
  1506.   Result := (hfBufFileOffs >= (_FileSize*hfBlockSize));
  1507. end; { TGpHugeFile.LoadedToTheEOF }
  1508.  
  1509. {:Returns file size. If available, returns cached size.
  1510.   @returns File size in bytes.
  1511.   @raises  EGpHugeFile on Windows errors.
  1512. }
  1513. function TGpHugeFile._FileSize: HugeInt;
  1514. begin
  1515.   if hfCachedSize < 0 then
  1516.     hfCachedSize := FileSize;
  1517.   Result := hfCachedSize;
  1518. end; { TGpHugeFile._FileSize }
  1519.  
  1520. {:Initializes buffer for writing.
  1521. }
  1522. procedure TGpHugeFile.InitWriteBuffer;
  1523. begin
  1524.   hfBufSize     := 0;
  1525.   hfBufOffs     := 0;
  1526.   hfBufFileOffs := 0;
  1527.   hfBufWrite    := true;
  1528. end; { TGpHugeFile.InitWriteBuffer }
  1529.  
  1530. {:Initializes buffer for reading.
  1531. }
  1532. procedure TGpHugeFile.InitReadBuffer;
  1533. begin
  1534.   hfBufOffs     := 0;
  1535.   hfBufSize     := 0;
  1536.   hfBufFileOffs := 0;
  1537.   hfBufWrite    := false;
  1538. end; { TGpHugeFile.InitReadBuffer }
  1539.  
  1540. { TGpHugeFileStream }
  1541.  
  1542. {:Initializes stream and opens file in required access mode.
  1543.   @param   fileName    Name of file to be accessed.
  1544.   @param   access      Required access mode.
  1545.   @param   openOptions Set of possible open options.
  1546. }
  1547. constructor TGpHugeFileStream.Create(const fileName: string;
  1548.   access: TGpHugeFileStreamAccess; openOptions: THFOpenOptions);
  1549. begin
  1550.   inherited Create;
  1551.   hfsExternalHF := false;
  1552.   case access of
  1553.     accRead:
  1554.       begin
  1555.         hfsFile := TGpHugeFile.CreateEx(fileName, FILE_ATTRIBUTE_NORMAL, GENERIC_READ);
  1556.         hfsFile.Win32Check(hfsFile.ResetEx(1,0,0,0,openOptions) = hfOK, 'Reset');
  1557.       end; //accRead
  1558.     accWrite:
  1559.       begin
  1560.         hfsFile := TGpHugeFile.CreateEx(fileName, FILE_ATTRIBUTE_NORMAL, GENERIC_WRITE);
  1561.         hfsFile.Win32Check(hfsFile.RewriteEx(1,0,0,0,openOptions) = hfOK, 'Rewrite');
  1562.       end; //accWrite
  1563.     accReadWrite:
  1564.       begin
  1565.         hfsFile := TGpHugeFile.CreateEx(fileName, FILE_ATTRIBUTE_NORMAL, GENERIC_READ+GENERIC_WRITE);
  1566.         hfsFile.Win32Check(hfsFile.ResetEx(1,0,0,0,openOptions) = hfOK, 'Reset');
  1567.       end; // accReadWrite
  1568.     accAppend:
  1569.       begin
  1570.         hfsFile := TGpHugeFile.CreateEx(fileName, FILE_ATTRIBUTE_NORMAL, GENERIC_READ+GENERIC_WRITE);
  1571.         hfsFile.Win32Check(hfsFile.ResetEx(1,0,0,0,openOptions) = hfOK, 'Reset');
  1572.         hfsFile.Seek(hfsFile.FileSize);
  1573.       end; //accAppend
  1574.   end; //case
  1575. end; { TGpHugeFileStream.Create }
  1576.  
  1577. {:Initializes stream and assigns it an already open TGpHugeFile object.
  1578.   @param   hf TGpHugeFile object to be used for data storage.
  1579. }
  1580. constructor TGpHugeFileStream.CreateFromHandle(hf: TGpHugeFile);
  1581. begin
  1582.   inherited Create;
  1583.   hfsExternalHF := true;
  1584.   hfsFile := hf;
  1585. end; { TGpHugeFileStream.Create/CreateFromHandle }
  1586.  
  1587. {:Destroys stream and file access object (if created in constructor).
  1588. }
  1589. destructor TGpHugeFileStream.Destroy;
  1590. begin
  1591.   if (not hfsExternalHF) and assigned(hfsFile) then begin
  1592.     hfsFile.Close;
  1593.     hfsFile.Free;
  1594.     hfsFile := nil;
  1595.   end;
  1596.   inherited Destroy;
  1597. end; { TGpHugeFileStream.Destroy }
  1598.  
  1599. {:Returns file name.
  1600.   @returns Returns file name or empty string if file is not open.
  1601. }
  1602. function TGpHugeFileStream.GetFileName: string;
  1603. begin
  1604.   if assigned(hfsFile) then
  1605.     Result := hfsFile.FileName
  1606.   else
  1607.     Result := '';
  1608. end; { TGpHugeFileStream.GetFileName }
  1609.  
  1610. {:Returns file size. Better compatibility with hfCloseOnEOF files than default
  1611.   TStream.GetSize.
  1612.   @returns Returns file size in bytes or -1 if file is not open.
  1613. }
  1614. function TGpHugeFileStream.GetSize: longint;
  1615. begin
  1616.   if assigned(hfsFile) then
  1617.     Result := hfsFile.FileSize
  1618.   else
  1619.     Result := -1;
  1620. end; { TGpHugeFileStream.GetSize }
  1621.  
  1622. {:Returns last Windows error code.
  1623.   @returns Last Windows error code.
  1624. }
  1625. function TGpHugeFileStream.GetWindowsError: DWORD;
  1626. begin
  1627.   if hfsWindowsError <> 0 then
  1628.     Result := hfsWindowsError
  1629.   else if assigned(hfsFile) then
  1630.     Result := hfsFile.WindowsError
  1631.   else
  1632.     Result := 0;
  1633. end; { TGpHugeFileStream.GetWindowsError }
  1634.  
  1635. {:Reads 'count' number of bytes into buffer.
  1636.   @param   buffer Buffer for read data.
  1637.   @param   count  Number of bytes to be read.
  1638.   @returns Actual number of bytes read.
  1639.   @raises  EGpHugeFile on Windows errors.
  1640. }
  1641. function TGpHugeFileStream.Read(var buffer; count: longint): longint;
  1642. var
  1643.   bytesRead: cardinal;
  1644. begin
  1645.   hfsFile.BlockRead(Buffer,Count,bytesRead);
  1646.   Result := longint(bytesRead);
  1647. end; { TGpHugeFileStream.Read }
  1648.  
  1649. {:Repositions stream pointer.
  1650.   @param   offset Offset from start, current position, or end of stream (as set
  1651.                   by the 'mode' parameter).
  1652.   @param   mode   Specifies starting point for offset calculation
  1653.                   (soFromBeginning, soFromCurrent, soFromEnd).
  1654.   @returns New position of stream pointer.
  1655.   @raises  EGpHugeFile on Windows errors.
  1656.   @raises  EGpHugeFileStream on invalid value of 'mode' parameter.
  1657. }
  1658. function TGpHugeFileStream.Seek(offset: longint; mode: word): longint;
  1659. begin
  1660.   if mode = soFromBeginning then
  1661.     hfsFile.Seek(offset)
  1662.   else if mode = soFromCurrent then
  1663.     hfsFile.Seek(hfsFile.FilePos+offset)
  1664.   else if mode = soFromEnd then
  1665.     hfsFile.Seek(hfsFile.FileSize+offset)
  1666.   else
  1667.     raise EGpHugeFileStream.CreateFmtHelp(sInvalidMode,[FileName],hcHFInvalidSeekMode);
  1668.   Result := hfsFile.FilePos;
  1669. end; { TGpHugeFileStream.Seek }
  1670.  
  1671. {:Sets stream size. Truncates underlying file at specified position.
  1672.   @param   newSize New stream size.
  1673.   @raises  EGpHugeFile on Windows errors.
  1674. }
  1675. procedure TGpHugeFileStream.SetSize(newSize: longint);
  1676. begin
  1677.   hfsFile.Seek(newSize);
  1678.   hfsFile.Truncate;
  1679. end; { TGpHugeFileStream.SetSize }
  1680.  
  1681. {:Checks condition and creates appropriately formatted EGpHugeFileStream
  1682.   exception.
  1683.   @param   condition If false, Win32Check will generate an exception.
  1684.   @param   method    Name of TGpHugeFileStream method that called Win32Check.
  1685.   @raises  EGpHugeFileStream if (not condition).
  1686. }
  1687. procedure TGpHugeFileStream.Win32Check(condition: boolean; method: string);
  1688. var
  1689.   Error: EGpHugeFileStream;
  1690. begin
  1691.   if not condition then begin
  1692.     hfsWindowsError := GetLastError;
  1693.     if hfsWindowsError <> ERROR_SUCCESS then
  1694.       Error := EGpHugeFileStream.CreateFmtHelp(sStreamFailed+SWin32Error,
  1695.         [method,FileName,hfsWindowsError,SysErrorMessage(hfsWindowsError)],
  1696.         hcHFWindowsError)
  1697.     else
  1698.       Error := EGpHugeFileStream.CreateFmtHelp(sStreamFailed+SUnkWin32Error,
  1699.         [method,FileName],hcHFUnknownWindowsError);
  1700.     raise Error;
  1701.   end;
  1702. end; { TGpHugeFileStream.Win32Check }
  1703.  
  1704. {:Writes 'count' number of bytes to the file.
  1705.   @param   buffer Data to be written.
  1706.   @param   count  Number of bytes to be written.
  1707.   @returns Actual number of bytes written.
  1708.   @raises  EGpHugeFile on Windows errors.
  1709. }
  1710. function TGpHugeFileStream.Write(const buffer; count: longint): longint;
  1711. var
  1712.   bytesWritten: cardinal;
  1713. begin
  1714.   hfsFile.BlockWrite(buffer,count,bytesWritten);
  1715.   Result := longint(bytesWritten);
  1716. end; { TGpHugeFileStream.Write }
  1717.  
  1718. end.
  1719.  
  1720.