gphugef.pas

Advanced Data Import Component Suite for Borland Delphi and C++ Builder allows you to import your da

          shareMode := FILE_SHARE_READ
        else
          shareMode := 0
      end
      else
        shareMode := hfDesiredShareMode
    end
    else begin
      if hfDesiredAcc = GENERIC_READ then
        shareMode := FILE_SHARE_READ
      else
        shareMode := 0;
    end;
    if IsUnicodeMode then
      hfHandle := CreateFileW(PWideChar(hfName), hfDesiredAcc, shareMode, nil, creat, hfFlags, 0)
    else
      hfHandle := CreateFile(PChar(hfNameA), hfDesiredAcc, shareMode, nil, creat, hfFlags, 0);
    awaited := false;
    if hfHandle = INVALID_HANDLE_VALUE then begin
      hfWindowsError := GetLastError; 
      if (hfWindowsError in FILE_SHARING_ERRORS) and (diskRetryDelay > 0) and (not Elapsed) then
        if waitObject <> 0 then
          awaited := WaitForSingleObject(waitObject, diskRetryDelay) <> WAIT_TIMEOUT
        else
          Sleep(diskRetryDelay);
    end
    else begin
      hfWindowsError := 0;
      hfIsOpen := true;
    end;
  until (hfWindowsError = 0) or (not (hfWindowsError in FILE_SHARING_ERRORS)) or Elapsed or awaited;
  if (hfWindowsError = 0) and hfCompressed then begin
    if not Compress then
      hfWindowsError := GetLastError;
  end;
  if hfWindowsError = 0 then begin
    Result := hfOK;
  end
  else if hfWindowsError in FILE_SHARING_ERRORS then
    Result := hfFileLocked
  else
    Result := hfError;
  if Result = hfOK then
    AllocBuffer;
end; { TGpHugeFile.AccessFile }

{:Simplest form of Reset, emulating Delphi's Reset.
  @param   blockSize Basic unit of access (same as RecSize parameter in Delphi's
                     Reset and Rewrite).
  @raises  EGpHugeFile if file could not be opened.
}
procedure TGpHugeFile.Reset(blockSize: integer);
begin
  Win32Check(ResetEx(blockSize,0,0,0,[hfoBuffered]) = hfOK,'Reset');
end; { TGpHugeFile.Reset }

{:Simplest form of Rewrite, emulating Delphi's Rewrite.
  @param   blockSize       Basic unit of access (same as RecSize parameter in
                           Delphi's Rewrite).
  @raises  EGpHugeFile if file could not be opened.
}
procedure TGpHugeFile.Rewrite(blockSize: integer);
begin
  Win32Check(RewriteEx(blockSize,0,0,0,[hfoBuffered]) = hfOK,'Rewrite');
end; { TGpHugeFile.Rewrite }

{:Buffered Reset. Caller can specifiy size of buffer and require that buffer is
  locked in memory (Windows require that for direct access files
  (FILE_FLAG_NO_BUFFERING) to work correctly).
  @param   blockSize  Basic unit of access (same as RecSize parameter in
                      Delphi's Reset).
  @param   bufferSize Size of buffer. 0 means default size (BUF_SIZE, currently
                      64 KB).
  @param   lockBuffer If true, buffer will be locked.
  @raises  EGpHugeFile if file could not be opened.
  @seeAlso BUF_SIZE
}
procedure TGpHugeFile.ResetBuffered(blockSize, bufferSize: integer;
  lockBuffer: boolean);
var
  options: THFOpenOptions;
begin
  options := [hfoBuffered];
  if lockBuffer then
    Include(options,hfoLockBuffer);
  Win32Check(ResetEx(blockSize,bufferSize,0,0,options) = hfOK,'ResetBuffered');
end; { TGpHugeFile.ResetBuffered }

{:Buffered Rewrite. Caller can specifiy size of buffer and require that buffer
  is locked in memory (Windows require that for direct access files
  (FILE_FLAG_NO_BUFFERING) to work correctly).
  @param   blockSize  Basic unit of access (same as RecSize parameter in
                      Delphi's Rewrite).
  @param   bufferSize Size of buffer. 0 means default size (BUF_SIZE, currently
                      64 KB).
  @param   lockBuffer If true, buffer will be locked.
  @raises  EGpHugeFile if file could not be opened.
  @seeAlso BUF_SIZE
}
procedure TGpHugeFile.RewriteBuffered(blockSize, bufferSize: integer;
  lockBuffer: boolean);
var
  options: THFOpenOptions;
begin
  options := [hfoBuffered];
  if lockBuffer then
    Include(options,hfoLockBuffer);
  Win32Check(RewriteEx(blockSize,bufferSize,0,0,options) = hfOK,'RewriteBuffered');
end; { TGpHugeFile.RewriteBuffered }

{:Full form of Reset. Will retry if file is locked by another application (if
  diskLockTimeout and diskRetryDelay are specified). Allows caller to specify
  additional options. Does not raise an exception on error. 
  @param   blockSize       Basic unit of access (same as RecSize parameter in
                           Delphi's Reset).
  @param   bufferSize      Size of buffer. 0 means default size (BUF_SIZE,
                           currently 64 KB).
  @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   options         Set of possible open options.
  @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).
}
function TGpHugeFile.ResetEx(blockSize, bufferSize: integer; diskLockTimeout: integer;
  diskRetryDelay: integer; options: THFOpenOptions; waitObject: THandle): THFError;
begin
  hfWindowsError := 0;
  try
    { There's a reason behind this 'if IsOpen...' behaviour. We definitely
      don't want to release file handle if ResetEx is called twice in a row as
      that could lead to all sorts of sharing problems.
      Delphi does this wrong - if you Reset a file twice in a row, handle will
      be closed and file will be reopened.
    }
    if hfCloseOnEOF and IsOpen then
      Close; //2.26
    if IsOpen then begin
      if not hfReading then
        FlushBuffer;
      hfBuffered := false;
      Seek(0);
      FreeBuffer;
    end;
    hfBuffered := hfoBuffered in options;
    hfCloseOnEOF := ([hfoCloseOnEOF,hfoBuffered] * options) = [hfoCloseOnEOF,hfoBuffered];
    hfCanCreate := hfoCanCreate in options;
    if hfBuffered then begin
      hfBufferSize := bufferSize;
      hfLockBuffer := hfoLockBuffer in options;
    end;
    if not IsOpen then
      Result := AccessFile(blockSize,true,diskLockTimeout,diskRetryDelay,waitObject)
    else begin
      hfBlockSize := blockSize;
      AllocBuffer;
      Result := hfOK;
    end;
    if Result <> hfOK then
      Close
    else begin
      if hfBuffered then
        InitReadBuffer;
      hfBufFilePos := 0;
      hfReading := true;
      hfHalfClosed := false;
    end;
  except
    Result := hfOK;
  end;
end; { TGpHugeFile.ResetEx }

{:Full form of Rewrite. Will retry if file is locked by another application (if
  diskLockTimeout and diskRetryDelay are specified). Allows caller to specify
  additional options. Does not raise an exception on error.
  @param   blockSize       Basic unit of access (same as RecSize parameter in
                           Delphi's Rewrite).
  @param   bufferSize      Size of buffer. 0 means default size (BUF_SIZE,
                           currently 64 KB).
  @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   options         Set of possible open options.
  @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).
}
function TGpHugeFile.RewriteEx(blockSize, bufferSize: integer;
  diskLockTimeout: integer; diskRetryDelay: integer;
  options: THFOpenOptions; waitObject: THandle): THFError;
begin
  hfWindowsError := 0;
  try
    { There's a reason behind this 'if IsOpen...' behaviour. We definitely
      don't want to release file handle if ResetEx is called twice in a row as
      that could lead to all sorts of sharing problems.
      Delphi does this wrong - if you Reset file twice in a row, handle will be
      closed and file will be reopened.
    }
    if hfCloseOnEOF and IsOpen then
      Close; //2.26
    if IsOpen then begin
      hfBuffered := false;
      Seek(0);
      Truncate;
      FreeBuffer;
    end;
    hfBuffered := hfoBuffered in options;
    if hfBuffered then begin
      hfBufferSize := bufferSize;
      hfLockBuffer := hfoLockBuffer in options;
    end;
    hfCompressed := hfoCompressed in options;
    if not IsOpen then
      Result := AccessFile(blockSize,false,diskLockTimeout,diskRetryDelay,waitObject)
    else begin
      hfBlockSize := blockSize;
      AllocBuffer;
      Result := hfOK;
    end;
    if Result <> hfOK then
      Close
    else begin
      if hfBuffered then
        InitWriteBuffer;
      hfBufFilePos := 0;
      hfReading := false;
      hfHalfClosed := false;
    end;
  except
    Result := hfOK;
  end;
end; { TGpHugeFile.RewriteEx }

{:Closes open file. If file is not open, do nothing.
  @raises  EGpHugeFile on Windows errors.
}
procedure TGpHugeFile.Close;
begin
  try
    if IsOpen then begin
      FreeBuffer;
      if hfHandle <> INVALID_HANDLE_VALUE then begin // may be freed in BlockRead
        CloseHandle(hfHandle);
        hfHandle := INVALID_HANDLE_VALUE;
      end;
      hfHalfClosed := false;
      hfIsOpen := false;
      hfCloseOnEOF := false;
    end;
  except
    on EGpHugeFile do
      raise;
    on E:Exception do
      raise EGpHugeFile.CreateHelp(E.Message,hcHFUnexpected);
  end;
end; { TGpHugeFile.Close }

{:Checks if file is open. Called from various TGpHugeFile methods.
  @raises  EGpHugeFile if file is not open.
}
procedure TGpHugeFile.CheckHandle;
begin
  if hfHandle = INVALID_HANDLE_VALUE then
    raise EGpHugeFile.CreateFmtHelp(sFileNotOpen,[FileName],hcHFInvalidHandle);
end; { TGpHugeFile.CheckHandle }

{:Returns the size of file in 'block size' units (see 'blockSize' parameter to Reset and
  Rewrite methods).
  @returns Size of file in 'block size' units.
  @raises  EGpHugeFile on Windows errors.
  @seeAlso Reset, Rewrite
}
function TGpHugeFile.FileSize: HugeInt;
var
  realSize: HugeInt;
  size    : TLargeInteger;
begin
  try
    if hfHalfClosed then
      Result := hfLastSize //2.26: hfoCloseOnEOF support
    else begin
      // TODO 1 -oPrimoz Gabrijelcic: Optimize!
      CheckHandle;
      SetLastError(0);
      size.LowPart := GetFileSize(hfHandle,@size.HighPart);
      Win32Check(size.LowPart<>$FFFFFFFF,'FileSize');
      if hfBufFilePos > size.QuadPart then
        realSize := hfBufFilePos
      else
        realSize := size.QuadPart;
      if hfBlockSize <> 1 then
        Result := {$IFDEF D4plus}Trunc{$ELSE}int{$ENDIF}
                    (realSize/hfBlockSize)
      else
        Result := realSize;
    end;
  except
    on EGpHugeFile do
      raise;
    on E:Exception do
      raise EGpHugeFile.CreateHelp(E.Message,hcHFUnexpected);
  end;
end; { TGpHugeFile.FileSize }

{:Writes 'count' number of 'block size' large units (see 'blockSize' parameter
  to Reset and Rewrite methods) to a file (or buffer if access is buffered).
  @param   buf         Data to be written.
  @param   count       Number of 'block size' large units to be written.
  @param   transferred (out) Number of 'block size' large units actually written.
  @raises  EGpHugeFile on Windows errors.
  @seeAlso Reset, Rewrite
}
procedure TGpHugeFile.BlockWrite(const buf; count: DWORD; var transferred: DWORD);
var
  trans: DWORD;
begin
  try
    CheckHandle;
    if hfBlockSize <> 1 then
      count := count * hfBlockSize;
    if hfBuffered then
      Transmit(buf,count,trans)
    else begin
      SetLastError(0);
      Win32Check(WriteFile(hfHandle,buf,count,trans,nil),'BlockWrite');
      hfBufFilePos := hfBufFilePos + trans;
    end;
    if hfBlockSize <> 1 then
      transferred := trans div hfBlockSize
    else
      transferred := trans;
    hfCachedSize := -1;
  except
    on EGpHugeFile do
      raise;