gphugef.pas

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

    on E:Exception do
      raise EGpHugeFile.CreateHelp(E.Message,hcHFUnexpected);
  end;
end; { TGpHugeFile.BlockWrite }

{:Reads 'count' number of 'block size' large units (see 'blockSize' parameter
  to Reset and Rewrite methods) from a file (or buffer if access is buffered).
  @param   buf         Buffer for read data.
  @param   count       Number of 'block size' large units to be read.
  @param   transferred (out) Number of 'block size' large units actually read.
  @raises  EGpHugeFile on Windows errors.
  @seeAlso Reset, Rewrite
}
procedure TGpHugeFile.BlockRead(var buf; count: DWORD; var transferred: DWORD);
var
  closeNow  : boolean;
  oldBufSize: DWORD;
  trans     : DWORD;
begin
  try
    if (not hfBuffered) or (not hfHalfClosed) then 
      CheckHandle;
    closeNow := hfCloseOnNext;
    if hfBlockSize <> 1 then
      count := count * hfBlockSize;
    oldBufSize := hfBufSize;
    if hfBuffered then
      Fetch(buf,count,trans)
    else begin
      SetLastError(0);
      Win32Check(ReadFile(hfHandle,buf,count,trans,nil),'BlockRead');
      hfBufFilePos := hfBufFilePos + trans;
    end;
    if hfBlockSize <> 1 then
      transferred := trans div hfBlockSize
    else
      transferred := trans;
    if hfCloseOnEOF then begin
      if closeNow then begin
        if _FilePos >= FileSize then begin
          hfLastSize := FileSize;
          CloseHandle(hfHandle);
          hfHandle := INVALID_HANDLE_VALUE;
          hfHalfClosed := true; // allow FilePos to work until TGpHugeFile.Close
          hfCloseOnNext := false;
          //3.03: reset the buffer pointer
          hfBufOffs := hfBufOffs + (oldBufSize - hfBufSize);
          //2.26: rewind the buffer for Seek to work
          hfBufSize := oldBufSize;
        end;
      end
      else
        hfCloseOnNext := (hfHandle <> INVALID_HANDLE_VALUE) and LoadedToTheEOF;
    end;
  except
    on EGpHugeFile do
      raise;
    on E:Exception do
      raise EGpHugeFile.CreateHelp(E.Message,hcHFUnexpected);
  end;
end; { TGpHugeFile.BlockRead }

{:Internal implementation of Seek method. Called from other methods, too. Moves
  actual file pointer only when necessary or required by caller. Handles
  hfoCloseOnEOF files if possible.
  @param   offset      Offset from beginning of file in 'block size' large units
                       (see 'blockSize' parameter to Reset and Rewrite methods).
  @param   movePointer If true, Windows file pointer will always be moved. If
                       false, it will only be moved when Seek destination does
                       not lie in the buffer.
  @raises  Various system exceptions.
  @seeAlso Reset, Rewrite
}
procedure TGpHugeFile._Seek(offset: HugeInt; movePointer: boolean);
var
  off: TLargeInteger;
begin
  if (not hfBuffered) or movePointer or (not hfHalfClosed) then
    CheckHandle;
  if hfBlockSize <> 1 then
    off.QuadPart := offset*hfBlockSize
  else
    off.QuadPart := offset;
  if hfBuffered then begin
    if hfBufWrite then begin
      FlushBuffer;
      //<3.08: Cope with the delayed seek
      Win32Check(SetFilePointer(
        hfHandle,longint(off.LowPart),@off.HighPart,FILE_BEGIN)<>$FFFFFFFF,'_Seek');
      //>
    end
    else begin
      if not movePointer then begin
        if (off.QuadPart >= hfBufFileOffs) or
           (off.QuadPart < (hfBufFileOffs-hfBufSize)) then
          movePointer := true
        else
          hfBufOffs := {$IFNDEF D4plus}Trunc{$ENDIF}
                         (off.QuadPart-(hfBufFileOffs-hfBufSize));
      end;
      if movePointer then begin
        if hfHalfClosed then begin
          if off.QuadPart <> hfBufFileOffs then //2.26: allow seek to Eof
            CheckHandle; // bang!
        end
        else begin
          SetLastError(0);
          Win32Check(SetFilePointer(
            hfHandle,longint(off.LowPart),@off.HighPart,FILE_BEGIN)<>$FFFFFFFF,'_Seek');
        end;
        //3.02: Seek to Eof in hfHalfClosed state must not invalidate the buffer
        if not (hfHalfClosed and (off.QuadPart = hfBufFileOffs)) then begin
          hfBufFileOffs := off.QuadPart;
          hfBufFilePos  := off.QuadPart;
          hfBufOffs     := 0;
          hfBufSize     := 0;
          hfCloseOnNext := false;
        end;
      end
      else if not LoadedToTheEOF then
        hfCloseOnNext := false;
    end;
  end
  else begin
    SetLastError(0);
    Win32Check(SetFilePointer(hfHandle,longint(off.LowPart),@off.HighPart,FILE_BEGIN)<>$FFFFFFFF,'Seek');
  end;
  hfBufFilePos := off.QuadPart;
end; { TGpHugeFile._Seek }

{:Repositions file pointer. Moves actual file pointer only when necessary.
  @param   offset Offset from beginning of file in 'block size' large units (see
           'blockSize' parameter to Reset and Rewrite methods).
  @raises  EGpHugeFile on Windows errors.
  @seeAlso Reset, Rewrite
}
procedure TGpHugeFile.Seek(offset: HugeInt);
begin
  try
    _Seek(offset,false);
  except
    on EGpHugeFile do
      raise;
    on E:Exception do
      raise EGpHugeFile.CreateHelp(E.Message,hcHFUnexpected);
  end;
end; { TGpHugeFile.Seek }

{:Returns file pointer position in bytes. Used only internally.
  @returns File pointer position in bytes.
  @raises  Various system exceptions.
}
function TGpHugeFile._FilePos: HugeInt;
var
  off: TLargeInteger;
begin
  CheckHandle;
  off.QuadPart := 0;
  off.LowPart := SetFilePointer(hfHandle,longint(off.LowPart),@off.HighPart,FILE_CURRENT);
  Win32Check(off.LowPart <> $FFFFFFFF,'_FilePos');
  Result := off.QuadPart;
end; { TGpHugeFile. }

{:Truncates file at current position.
  @raises  EGpHugeFile on Windows errors.
}
procedure TGpHugeFile.Truncate;
begin
  try
    CheckHandle;
    if hfBuffered then
      _Seek(FilePos,true);
    SetLastError(0);
    Win32Check(SetEndOfFile(hfHandle),'Truncate');
    hfCachedSize := -1;
  except
    on EGpHugeFile do
      raise;
    on E:Exception do
      raise EGpHugeFile.CreateHelp(E.Message,hcHFUnexpected);
  end;
end; { TGpHugeFile.Truncate }

{:Returns Eof indicator.
  @since   2003-02-12
}
function TGpHugeFile.Eof: boolean;
begin
  if hfFlagNoBuf then
    Result := (FilePos >= FileSize)
  else
    Result := (FilePos >= _FileSize);
end; { TGpHugeFile.Eof }

{:Returns file pointer position in 'block size' large units (see 'blockSize'
  parameter to Reset and Rewrite methods). Position is retrieved from cached
  value.
  @returns File pointer position in 'block size' large units.
  @raises  EGpHugeFile on Windows errors.
  @seeAlso Reset, Rewrite
}
function TGpHugeFile.FilePos: HugeInt;
begin
  try
    if not hfHalfClosed then
      CheckHandle;
    if hfBlockSize <> 1 then
      Result := {$IFDEF D4plus}Trunc{$ELSE}int{$ENDIF}(hfBufFilePos/hfBlockSize)
    else
      Result := hfBufFilePos;
  except
    on EGpHugeFile do
      raise;
    on E:Exception do
      raise EGpHugeFile.CreateHelp(E.Message,hcHFUnexpected);
  end;
end; { TGpHugeFile.FilePos }

{:Flushed file buffers.
  @raises  EGpHugeFile on Windows errors.
}
procedure TGpHugeFile.Flush;
begin
  CheckHandle;
  SetLastError(0);
  Win32Check(FlushBuffer,'Flush');
  SetLastError(0);
  Win32Check(FlushFileBuffers(hfHandle),'Flush');
end; {  TGpHugeFile.Flush  }

{:Rounds parameter next multiplier of system page size. Used to determine
  buffer size for direct access files (FILE_FLAG_NO_BUFFERING).
  @param   bufSize Initial buffer size.
  @returns bufSize Required buffer size.
}
function TGpHugeFile.RoundToPageSize(bufSize: DWORD): DWORD;
var
  sysInfo: TSystemInfo;
begin
  GetSystemInfo(sysInfo);
  Result := (((bufSize-1) div sysInfo.dwPageSize) + 1) * sysInfo.dwPageSize;
end; { TGpHugeFile.RoundToPageSize }

{:Allocates file buffer (after freeing old buffer if allocated). Calculates
  correct buffer size for direct access files and locks buffer if required. Used
  only internally.
  @raises Various system exceptions.
}
procedure TGpHugeFile.AllocBuffer;
begin
  FreeBuffer;
  if hfBufferSize = 0 then
    hfBufferSize := BUF_SIZE;
  // round up buffer size to be the multiplier of page size
  // needed for FILE_FLAG_NO_BUFFERING access, does not hurt in other cases
  hfBufferSize := RoundToPageSize(hfBufferSize);
  SetLastError(0);
  hfBuffer := VirtualAlloc(nil,hfBufferSize,MEM_RESERVE+MEM_COMMIT,PAGE_READWRITE);
  Win32Check(hfBuffer<>nil,'AllocBuffer');
  if hfLockBuffer then begin
    SetLastError(0);
    Win32Check(VirtualLock(hfBuffer,hfBufferSize),'AllocBuffer');
    if hfBuffer = nil then
      raise EGpHugeFile.CreateFmtHelp(sFailedToAllocateBuffer,[FileName],hcHFFailedToAllocateBuffer);
  end;
end; { TGpHugeFile.AllocBuffer }

{:Frees memory buffer if allocated. Used only internally.
  @raises  Various system exceptions.
}
procedure TGpHugeFile.FreeBuffer;
begin
  if hfBuffer <> nil then begin
    SetLastError(0);
    Win32Check(FlushBuffer,'FreeBuffer');
    if hfLockBuffer then begin
      SetLastError(0);
      Win32Check(VirtualUnlock(hfBuffer,hfBufferSize),'FreeBuffer');
    end;
    SetLastError(0);
    Win32Check(VirtualFree(hfBuffer,0,MEM_RELEASE),'FreeBuffer');
    hfBuffer := nil;
  end;
end; { TGpHugeFile.FreeBuffer }

{:Offsets pointer by a given ammount.
  @param   ptr    Original pointer.
  @param   offset Offset (in bytes).
  @returns New pointer.
}
function OffsetPtr(ptr: pointer; offset: DWORD): pointer;
begin
  Result := pointer(DWORD(ptr)+offset);
end; { OffsetPtr }

{:Writes 'count' number of bytes large units to a file (or buffer if access is
  buffered).
  @param   buf         Data to be written.
  @param   count       Number of bytes to be written.
  @param   transferred (out) Number of bytes actually written.
  @raises  EGpHugeFile when trying to write while in buffered read mode and file
           pointer is not at end of file.
  @raises  Various system exceptions.
  @seeAlso Reset, Rewrite
}
procedure TGpHugeFile.Transmit(const buf; count: DWORD; var transferred: DWORD);
var
  place  : DWORD;
  bufp   : pointer;
  send   : DWORD;
  written: DWORD;
begin
  if not hfBufWrite then begin
    //2.32: If we are at the end of file, we can switch into write mode
    if FilePos = FileSize then begin
      InitWriteBuffer;
      hfReading := false;
    end
    else
      raise EGpHugeFile.CreateFmtHelp(sWriteWhileInBufferedReadMode,[FileName],hcHFWriteInBufferedReadMode);
  end;
  //<3.08b: Cope with the delayed seek
  if (hfBufFilePos <> hfBufFileOffs) and (hfBufOffs = 0) then
    _Seek(hfBufFilePos, true); 
  //>
  transferred := 0;
  place := hfBufferSize-hfBufOffs;
  if place <= count then begin
    Move(buf,OffsetPtr(hfBuffer,hfBufOffs)^,place); // fill the buffer
    hfBufOffs := hfBufferSize;
    hfBufFilePos := hfBufFileOffs+hfBufOffs;
    if not FlushBuffer then
      Exit;
    transferred := place;
    Dec(count,place);
    bufp := OffsetPtr(@buf,place);
    if count >= hfBufferSize then begin // transfer N*(buffer size)
      send := (count div hfBufferSize)*hfBufferSize;
      if not WriteFile(hfHandle,bufp^,send,written,nil) then
        Exit;
      hfBufFileOffs := hfBufFileOffs+written;
      hfBufFilePos := hfBufFileOffs;
      Inc(transferred,written);