gphugef.pas

EMS Advanced Import Component Suite 允许你把数据从文件导入数据库中

  {:Encapsulation of 64-bit file functions, supporting normal, buffered, and
    direct access with some additional twists.
  }
  TGpHugeFile = class
  private
    hfBlockSize       : DWORD;
    hfBuffer          : pointer;
    hfBuffered        : boolean;
    hfBufferSize      : DWORD;
    hfBufFileOffs     : HugeInt;
    hfBufFilePos      : HugeInt;
    hfBufOffs         : DWORD;
    hfBufSize         : DWORD;
    hfBufWrite        : boolean;
    hfCachedSize      : HugeInt;
    hfCanCreate       : boolean;
    hfCloseOnEOF      : boolean;
    hfCloseOnNext     : boolean;
    hfCompressed      : boolean;
    hfDesiredAcc      : DWORD;
    hfDesiredShareMode: DWORD;
    hfFlagNoBuf       : boolean;
    hfFlags           : DWORD;
    hfHalfClosed      : boolean;
    hfHandle          : THandle;
    hfIsOpen          : boolean;
    hfLastSize        : integer;
    hfLockBuffer      : boolean;
    hfName            : WideString;
    hfNameA           : string;
    hfReading         : boolean;
    hfShareModeSet    : boolean;
    hfWindowsError    : DWORD;
  protected
    function  _FilePos: HugeInt; virtual;
    function  _FileSize: HugeInt; virtual;
    procedure _Seek(offset: HugeInt; movePointer: boolean); virtual;
    function  AccessFile(blockSize: integer; reset: boolean;
      diskLockTimeout: integer; diskRetryDelay: integer;
      waitObject: THandle): THFError; virtual;
    procedure AllocBuffer; virtual;
    procedure CheckHandle; virtual;
    function  Compress: boolean;
    procedure Fetch(var buf; count: DWORD; var transferred: DWORD); virtual;
    function  FlushBuffer: boolean; virtual;
    procedure FreeBuffer; virtual;
    function  GetDate: TDateTime; virtual;
    function  GetFileName: WideString;
    procedure InitReadBuffer; virtual;
    procedure InitWriteBuffer; virtual;
    procedure InternalCreateEx(FlagsAndAttributes: DWORD; DesiredAccess: DWORD;
      DesiredShareMode: DWORD);
    function  IsUnicodeMode: boolean;
    function  LoadedToTheEOF: boolean; virtual;
    function  RoundToPageSize(bufSize: DWORD): DWORD; virtual;
    procedure SetDate(const Value: TDateTime); virtual;
    procedure Transmit(const buf; count: DWORD; var transferred: DWORD); virtual;
    procedure Win32Check(condition: boolean; method: string); virtual;
  public
    constructor Create(fileName: string);
    constructor CreateEx(fileName: string;
      FlagsAndAttributes: DWORD {$IFDEF D4plus}= FILE_ATTRIBUTE_NORMAL{$ENDIF};
      DesiredAccess: DWORD      {$IFDEF D4plus}= GENERIC_READ+GENERIC_WRITE{$ENDIF};
      DesiredShareMode: DWORD   {$IFDEF D4plus}= CAutoShareMode{$ENDIF});
    constructor CreateExW(fileName: WideString;
      FlagsAndAttributes: DWORD {$IFDEF D4plus}= FILE_ATTRIBUTE_NORMAL{$ENDIF};
      DesiredAccess: DWORD      {$IFDEF D4plus}= GENERIC_READ+GENERIC_WRITE{$ENDIF};
      DesiredShareMode: DWORD   {$IFDEF D4plus}= CAutoShareMode{$ENDIF});
    constructor CreateW(fileName: WideString);
    procedure   Reset(blockSize: integer {$IFDEF D4plus}= 1{$ENDIF});
    procedure   Rewrite(blockSize: integer {$IFDEF D4plus}= 1{$ENDIF});
    procedure   ResetBuffered(
      blockSize: integer  {$IFDEF D4plus}= 1{$ENDIF};
      bufferSize: integer {$IFDEF D4plus}= 0{$ENDIF};
      lockBuffer: boolean {$IFDEF D4plus}= false{$ENDIF});
    procedure   RewriteBuffered(
      blockSize: integer  {$IFDEF D4plus}= 1{$ENDIF};
      bufferSize: integer {$IFDEF D4plus}= 0{$ENDIF};
      lockBuffer: boolean {$IFDEF D4plus}= false{$ENDIF});
    function    ResetEx(
      blockSize: integer       {$IFDEF D4plus}= 1{$ENDIF};
      bufferSize: integer      {$IFDEF D4plus}= 0{$ENDIF};
      diskLockTimeout: integer {$IFDEF D4plus}= 0{$ENDIF};
      diskRetryDelay: integer  {$IFDEF D4plus}= 0{$ENDIF};
      options: THFOpenOptions  {$IFDEF D4plus}= []{$ENDIF};
      waitObject: THandle      {$IFDEF D4plus}= 0{$ENDIF}): THFError;
    function    RewriteEx(
      blockSize: integer       {$IFDEF D4plus}= 1{$ENDIF};
      bufferSize: integer      {$IFDEF D4plus}= 0{$ENDIF};
      diskLockTimeout: integer {$IFDEF D4plus}= 0{$ENDIF};
      diskRetryDelay: integer  {$IFDEF D4plus}= 0{$ENDIF};
      options: THFOpenOptions  {$IFDEF D4plus}= []{$ENDIF};
      waitObject: THandle      {$IFDEF D4plus}= 0{$ENDIF}): THFError;
    destructor  Destroy; override;
    procedure BlockRead(var buf; count: DWORD; var transferred: DWORD);
    procedure BlockReadUnsafe(var buf; count: DWORD);
    procedure BlockWrite(const buf; count: DWORD; var transferred: DWORD);
    procedure BlockWriteUnsafe(const buf; count: DWORD);
    procedure Close;
    function  Eof: boolean;
    function  FileExists: boolean;
    function  FilePos: HugeInt;
    function  FileSize: HugeInt;
    procedure Flush;
    function  IsOpen: boolean;
    procedure Seek(offset: HugeInt);
    procedure Truncate;
    //:File date/time.
    property FileDate: TDateTime read GetDate write SetDate;
    //:File name.
    property FileName: WideString read GetFileName;
    //:True if access to file is buffered.
    property IsBuffered: boolean read hfBuffered;
    //:File handle.
    property Handle: THandle read hfHandle;
    //:Last Windows error code.
    property WindowsError: DWORD read hfWindowsError;
  end; { TGpHugeFile }

  {:All possible ways to access TGpHugeFileStream.
    @enum accRead      Read access.
    @enum accWrite     Write access.
    @enum accReadWrite Read and write access.
    @enum accAppend    Same as accReadWrite, just that Position is set
                       immediatly after the end of file.
  }
  TGpHugeFileStreamAccess = (accRead, accWrite, accReadWrite, accAppend);

  {:TStream descendant, wrapping a TGpHugeFile. Although it does not support
    huge files fully (because of TStream limitations - 'longint' is used instead
    of 'int64' in critical places), you can still use it as a buffered file
    stream.
  }
  TGpHugeFileStream = class(TStream)
  private
    hfsExternalHF  : boolean;
    hfsFile        : TGpHugeFile;
    hfsWindowsError: DWORD;
  protected
    function  GetFileName: WideString; virtual;
    function  GetWindowsError: DWORD; virtual;
    procedure SetSize(newSize: longint); override;
    procedure Win32Check(condition: boolean; method: string); virtual;
    {$IFDEF D7PLUS}
    function  GetSize: int64; override;
    procedure SetSize(const newSize: int64); overload; override;
    procedure SetSize64(const newSize: int64);
    {$ELSE}
    function  GetSize: longint; virtual;
    {$ENDIF D7PLUS}
  public
    constructor Create(const fileName: string; access: TGpHugeFileStreamAccess;
      openOptions: THFOpenOptions {$IFDEF D4plus}= [hfoBuffered]{$ENDIF};
      desiredShareMode: DWORD     {$IFDEF D4plus}= CAutoShareMode{$ENDIF};
      diskLockTimeout: integer    {$IFDEF D4plus}= 0{$ENDIF};
      diskRetryDelay: integer     {$IFDEF D4plus}= 0{$ENDIF});
    constructor CreateFromHandle(hf: TGpHugeFile);
    constructor CreateW(const fileName: WideString; access: TGpHugeFileStreamAccess;
      openOptions: THFOpenOptions {$IFDEF D4plus}= [hfoBuffered]{$ENDIF};
      desiredShareMode: DWORD     {$IFDEF D4plus}= CAutoShareMode{$ENDIF};
      diskLockTimeout: integer    {$IFDEF D4plus}= 0{$ENDIF};
      diskRetryDelay: integer     {$IFDEF D4plus}= 0{$ENDIF});
    destructor  Destroy; override;
    function  Read(var buffer; count: longint): longint; override;
    function  Seek(offset: longint; mode: word): longint; {$IFDEF D7PLUS}overload;{$ENDIF D7PLUS} override;
    {$IFDEF D7PLUS}
    function  Seek(const offset: Int64; origin: TSeekOrigin): int64; overload; override;
    {$ENDIF D7PLUS}
    function  Write(const buffer; count: longint): longint; override;
    //:Name of underlying file.
    property FileName: WideString read GetFileName;
    //:Stream size. Reintroduced to override GetSize (static in TStream) with faster version.
    {$IFDEF D7PLUS}
    property Size: int64 read GetSize write SetSize64;
    {$ELSE}
    property Size: longint read GetSize write SetSize;
    {$ENDIF D7PLUS}
    //:Last Windows error code.
    property WindowsError: DWORD read GetWindowsError;
  end; { TGpHugeFileStream }

implementation

uses
  SysConst,
  DSiWin32;

const
  {:Default buffer size. 64 KB, small enough to be VirtualLock'd in NT 4
  }
  BUF_SIZE = 64*1024;

{$IFDEF D3plus}
resourcestring
{$ELSE}
const
{$ENDIF}
  sBlockSizeMustBeGreaterThanZero = 'TGpHugeFile(%s):BlockSize must be greater than zero!';
  sFailedToAllocateBuffer         = 'TGpHugeFile(%s):Failed to allocate buffer!';
  sFileNotOpen                    = 'TGpHugeFile(%s):File not open!';
  sInvalidMode                    = 'TGpHugeFileStream(%s):Invalid mode!';
  sReadWhileInBufferedWriteMode   = 'TGpHugeFile(%s):Read while in buffered write mode!';
  sFileFailed                     = 'TGpHugeFile.%s(%s) failed. ';
  sStreamFailed                   = 'TGpHugeFileStream.%s(%s) failed. ';
  sWriteFailed                    = 'TGpHugeFile(%s):Write failed!';
  sWriteWhileInBufferedReadMode   = 'TGpHugeFile(%s):Write while in buffered read mode!';
  
{$IFDEF D4plus}
type
  {:D4 and newer define TLargeInteger as int64.
  }
  TLargeInteger = LARGE_INTEGER;
{$ENDIF}

{ TGpHugeFile }

{:Standard TGpHugeFile constructor. Prepares file for full, share none, access.
  @param   fileName Name of file to be accessed.
}
constructor TGpHugeFile.Create(fileName: string);
begin
  CreateEx(fileName, FILE_ATTRIBUTE_NORMAL, GENERIC_READ+GENERIC_WRITE, 0);
  hfShareModeSet := false;
end; { TGpHugeFile.Create }

{:Extended TGpHugeFile constructor. Caller can specify desired flags,
  attributes, and access mode.
  @param   fileName           Name of file to be accessed.
  @param   FlagsAndAttributes Flags and attributes, see CreateFile help for more details.
  @param   DesiredAccess      Desired access flags, see CreateFile help for more details.
  @param   DesiredShareMode   Desired share mode. Defaults to 'automagically select a good
                              share mode'.
}
constructor TGpHugeFile.CreateEx(fileName: string; FlagsAndAttributes,
  DesiredAccess, DesiredShareMode: DWORD);
begin
  inherited Create;
  hfNameA := fileName;
  hfName := fileName;
  InternalCreateEx(FlagsAndAttributes, DesiredAccess, DesiredShareMode);
end; { TGpHugeFile.CreateEx }

constructor TGpHugeFile.CreateExW(fileName: WideString; FlagsAndAttributes, DesiredAccess,
  DesiredShareMode: DWORD);
begin
  inherited Create;
  hfNameA := '';
  hfName := fileName;
  InternalCreateEx(FlagsAndAttributes, DesiredAccess, DesiredShareMode);
end; { TGpHugeFile.CreateExW }

constructor TGpHugeFile.CreateW(fileName: WideString);
begin
  CreateExW(fileName, FILE_ATTRIBUTE_NORMAL, GENERIC_READ+GENERIC_WRITE, 0);
  hfShareModeSet := false;
end; { TGpHugeFile.CreateW }

{:TGpHugeFile destructor. Will close file if it is still open.
}
destructor TGpHugeFile.Destroy;
begin
  Close;
  inherited Destroy;
end; { TGpHugeFile.Destroy }

{:Tests if a specified file exists.
  @returns True if file exists.
}
function TGpHugeFile.FileExists: boolean;
begin
  if IsUnicodeMode then
    FileExists := DSiFileExistsW(FileName)
  else
    FileExists := SysUtils.FileExists(FileName);
end; { TGpHugeFile.FileExists }

{:Opens/creates a file. AccessFile centralizes file opening in TGpHugeFile. It
  will set appropriate sharing mode, open or create a file, and even retry in
  a case of locked file (if so required).
  @param   blockSize       Basic unit of access (same as RecSize parameter in
                           Delphi's Reset and Rewrite).
  @param   reset           True if file is to be reset, false if it is to be
                           rewritten.
  @param   diskLockTimeout Max time (in milliseconds) AccessFile will wait for
                           lock file to become free.
  @param   diskRetryDelay  Delay (in milliseconds) between attempts to open
                           locked file.
  @param   waitObject      Handle of 'terminate' event (semaphore, mutex). If
                           this parameter is specified (not zero) and becomes
                           signalled, AccessFile will stop trying to open locked
                           file and will exit with.
  @returns Status (ok, file locked, other error).
  @raises  EGpHugeFile if 'blockSize' is less or equal to zero.
  @seeAlso ResetEx, RewriteEx
}
function TGpHugeFile.AccessFile(blockSize: integer; reset: boolean;
  diskLockTimeout: integer; diskRetryDelay: integer;
  waitObject: THandle): THFError;
var
  start: int64;

  function Elapsed: boolean;
  var
    stop: int64;
  begin
    if diskLockTimeout = 0 then
      Result := true
    else begin
      stop := GetTickCount;
      if stop < start then
        stop := stop + $100000000;
      Result := ((stop-start) > diskLockTimeout);
    end;
  end; { Elapsed }

const
  FILE_SHARING_ERRORS: set of byte = [ERROR_SHARING_VIOLATION, ERROR_LOCK_VIOLATION];

var
  awaited  : boolean;
  creat    : DWORD;
  shareMode: DWORD;

begin { TGpHugeFile.AccessFile }
  if blockSize <= 0 then
    raise EGpHugeFile.CreateFmtHelp(sBlockSizeMustBeGreaterThanZero,[FileName],hcHFInvalidBlockSize);
  hfBlockSize := blockSize;
  start := GetTickCount;
  repeat
    if reset then begin
      if hfCanCreate then
        creat := OPEN_ALWAYS
      else
        creat := OPEN_EXISTING;
    end
    else
      creat := CREATE_ALWAYS;
    SetLastError(0);
    hfWindowsError := 0;
    if hfShareModeSet then begin
      if hfDesiredShareMode = CAutoShareMode then begin
        if hfDesiredAcc = GENERIC_READ then