[Back to DELPHI SWAG index] [Back to Main SWAG index] [Original]
//------------------------------------------------------------------------------
// ODFileUnit.Pas Copyright (C) 1997 Object Dynamics Ltd.
//
// This unit implements classes supporting file I/O using Win32 I/O functions,
// and a "C-like" I/O style. It is intended to be somewhat easier to use than
// the built-in Pascal file I/O mechanisms.
//
//
// *** IMPORTANT ***
//
// By using this code, you accept the following conditions:
//
// You may use and adapt this code freely, but it remains the
// copyright of Object Dynamics Ltd. Any adaptations must retain the
// copyright message at the head of this file.
//
// You use this code at your own risk. Object Dynamics is not responsible
// for any loss or damage caused by programs using this code.
//
//
// History:
//
// Version 1.0 Created by Neil Butterworth, September 1997
// Fixed problems with file create modes, November 1997.
//
//------------------------------------------------------------------------------
unit ODFileUnit;
interface
uses
Windows,
Messages,
SysUtils,
Classes;
type
// Windows file handle
FileHandle = integer;
// All classes raise this exception
FileError = class( Exception );
// Raw file modes
FileOpenMode = ( foRead, // open file read-only
foWrite, // open file write-only
foReadWrite // open for both
);
FileShareMode = ( fsNoShare, // file cannot be shared
fsShareRead, // file can be shared for reading
fsShareWrite, // file can be shared for writing
fsShared // file can be shared for any access
);
FileCreateOption = ( fcNew, // always creates a new file
fcExisting, // file must already exist
fcAlways // file will be created if it doesn't
// exist, else it will be opened
);
FileSeekFrom = ( sfStart, // seek from start
sfEnd, // seek from end
sfHere // seek from current position
);
// RawFile implements simple binary file with seeking & locking abilities. It
// is used to implement the other file classes.
RawFile = class( TObject )
private
mFile : FileHandle; // windows file handle
mFileName : string; // full name of file
mIsOpen : boolean; // is it open?
procedure Error( const msg : string );
public
constructor Create;
destructor Destroy; override;
// Open a file, possibly creating it. See above for the various modes.
procedure Open( const fname : string;
omode : FileOpenMode;
smode : FileShareMode;
copts : FileCreateOption );
// Read nbytes from file into buffer pointed to by buf. Returns actual
// number of bytes read, which may be less than nbytes. If the number
// of bytes read is zero, then the end of file has been reached.
function Read( buf : pointer;
nbytes : integer ) : integer;
// Write nbytes to file from buffer pointed to by buf.
procedure Write( buf : pointer;
nbytes : integer );
// Seek in a file
function Seek( moveby : integer; from : FileSeekFrom ) : integer;
// Return current read/write position in file
function FilePosition : integer;
// Perform region locking/unlocking
function Lock( pos, len : integer ) : boolean;
procedure Unlock( pos, len : integer );
// Close the file. It is always safe to call Close, even on an
// already closed file.
procedure Close;
// Accessors for file name and open state
property FileName : string read mFileName;
property IsOpen : boolean read mIsOpen;
end;
// Text file buffer. This class is used solely to implement the TextFile class.
TFBuffer = class( TObject )
private
mBuffer : array[ 0..1023 ] of char;
mPtr, mBytes : integer;
public
constructor Create;
function Fill( f : RawFile ) : boolean;
function GetLine( f : RawFile; var line : string ) : boolean;
procedure Reset;
function GetChar( f : RawFile; var c : char ) : boolean;
end;
// Text file modes
TextFileOpenMode = ( toRead, // open for reading
toReWrite, // open for overwrite existing contents
toAppend // open for append to existing contents
);
TextFileShareMode = ( smShare, // open shared (for read only)
smNoShare // open single user
);
// The TextFile class implements access to files consisting of lines
// of text. Text files do not support seeking, and have limited open and
// sharing modes (see above).
TextFile = class( TObject )
private
mFile : RawFile; // implemented via RawFile
mBuffer : TFBuffer; // text file buffer
public
constructor Create;
destructor Destroy; override;
// Open a text file
procedure Open( const fname : string;
omode : TextFileOpenMode;
smode : TextFileShareMode );
// Close file. Always safe to call, even on already closed files.
procedure Close;
// accessors for RawFile properties
function FileName : string;
function IsOpen : boolean;
// Write a line of text to file & terminate with CR/LF pair
procedure WriteLine( const line : string );
// Read a line from file, stripping CR/LF pair. Returns False if
// at end of file.
function ReadLine( var line : string ) : boolean;
end;
// This class supports random access to fixed-sized records.
RandomAccessFile = class( TObject )
private
mFile : RawFile; // RawFile implementation
mRecSize : integer; // record size
public
constructor Create;
destructor Destroy; override;
// Open or create a RandomAccessFile. The RecSize parameter indicates
// the size of the recoord in the file. This is not stored in the
// file itself.
procedure Open( const fname : string;
recsize : integer;
omode : FileOpenMode;
smode : FileShareMode;
copts : FileCreateOption );
// Usual stuff
procedure Close;
function FileName : string;
function IsOpen : boolean;
// write a record at record number recno, which must be greater or
// equal to zero. A record number greater than that of the last
// record will extend the file.
procedure WriteRecord( rec : pointer; recno : integer );
// Read a record. If the record does not exist, the function returns false.
function ReadRecord( rec : pointer; recno : integer ) : boolean;
// read the next record sequentially. The first call to this method must
// be preceded with a call to ReadRecord.
function ReadNextRecord( rec : pointer ) : boolean;
// Record locking
function LockRecord( recno : integer ) : boolean;
procedure UnlockRecord( recno : integer );
// Extend the file by count records. The new records will contain garbage.
procedure Extend( count : integer );
// Return the number of recordsin the file.
function RecordCount : integer;
end;
//------------------------------------------------------------------------------
implementation
type
// These declarations are necessary as there seems to be a problem with
// the Borland-supplied declarations in Windows.Pas, at least in Delphi 2.
LPINTEGER = ^integer;
function Win32WriteFile( f : integer; p : pointer;
nb : integer; nbr : LPINTEGER;
junk : pointer ) : BOOL; stdcall;
external kernel32 name 'WriteFile';
function Win32ReadFile( f : integer; p : pointer;
nb : integer; nbr : LPINTEGER;
junk : pointer ) : BOOL; stdcall;
external kernel32 name 'ReadFile';
const
// erroor messages
FILE_OPEN_EMSG = 'Could not open file';
FILE_NOT_OPEN_EMSG = 'File is not open';
BAD_BUFFER_SIZE_EMSG = 'Bad buffer size for Read/Write';
READ_FAILED_EMSG = 'Read failed';
WRITE_FAILED_EMSG = 'Write failed';
SEEK_FAILED_EMSG = 'Seek failed';
BAD_TFSHARE_EMSG = 'Cannot open text file for write in shared mode';
BAD_LOCK_VALUES_EMSG = 'Bad range values for lock/unlock';
UNLOCK_FAILED_EMSG = 'Unlock failed!';
BAD_REC_SIZE_EMSG = 'Record size must be greater than zero';
BAD_REC_NUMBER_EMSG = 'Bad record number';
NIL_POINTER_EMSG = 'Nil pointer';
//------------------------------------------------------------------------------
// Utility stuff
//------------------------------------------------------------------------------
// replace with assert in Delphi3
procedure CheckPointer( p : pointer );
begin
if ( p = nil ) then
raise FileError.Create( NIL_POINTER_EMSG );
end;
//------------------------------------------------------------------------------
// RawFile methods
//------------------------------------------------------------------------------
// Create new RawFile
constructor RawFile.Create;
begin
mFile := 0;
mIsOpen := false;
mFileName := '';
end;
// Destroy RawFile, closing disk image first.
destructor RawFile.Destroy;
begin
Close;
inherited Destroy;
end;
// RawFile error messaging
procedure RawFile.Error( const msg : string );
begin
raise Fileerror.CreateFmt( '%s: %s', [mFileNAme, msg ] );
end;
// Close RawFile
procedure RawFile.Close;
begin
if ( mIsOpen ) then
CloseHandle( mFile );
mIsOpen := false;
end;
// Open RawFile. Most of this is mapping my modes onto Windows modes. Calling
// this on an already open file will Close & then re-open it.
procedure RawFile.Open( const fname : string;
omode : FileOpenMode;
smode : FileShareMode;
copts : FileCreateOption );
var
oflags, sflags, cflags : integer;
begin
Close;
mFileName := fname;
oflags := 0;
sflags := 0;
cflags := 0;
if ( omode = foRead ) then
oflags := GENERIC_READ
else if ( omode = foWrite ) then
oflags := GENERIC_WRITE
else
oflags := GENERIC_READ + GENERIC_WRITE;
if ( smode = fsShareRead ) then
sflags := FILE_SHARE_READ
else if ( smode = fsShareWrite ) then
sflags := FILE_SHARE_WRITE
else if ( smode = fsShared ) then
sflags := FILE_SHARE_WRITE + FILE_SHARE_READ;
if ( copts = fcNew ) then
cflags := CREATE_ALWAYS
else if ( copts = fcExisting ) then
cflags := OPEN_EXISTING
else if ( copts = fcAlways ) then
cflags := OPEN_ALWAYS;
mFile := Windows.CreateFile( PChar( fname ), oflags, sflags, nil, cflags,
FILE_ATTRIBUTE_NORMAL, 0 );
if ( mFile = INVALID_HANDLE_VALUE ) then begin
mIsOpen := false;
Error( FILE_OPEN_EMSG );
end;
mIsOpen := true;
end;
// Read bytes from file
function RawFile.Read( buf : pointer; nbytes : integer ) : integer;
var
bread : integer;
begin
CheckPointer( buf );
if ( not IsOpen ) then // must be open
Error( FILE_NOT_OPEN_EMSG );
if ( nbytes <= 0 ) then // byte number must be sensible
Error( BAD_BUFFER_SIZE_EMSG );
if ( Win32ReadFile( mFile, buf, nbytes, @bread, nil ) ) then
result := bread
else
result := 0;
end;
// Write bytes to file
procedure RawFile.Write( buf : pointer;
nbytes : integer );
var
bwrite : integer;
begin
CheckPointer( buf );
if ( not IsOpen ) then
Error( FILE_NOT_OPEN_EMSG );
if ( nbytes <= 0 ) then
Error( BAD_BUFFER_SIZE_EMSG );
if ( not Win32WriteFile( mFile, buf, nbytes, @bwrite, nil ) ) then
Error( WRITE_FAILED_EMSG );
end;
// Get current position. This involves seeking to end of file & then back
// again and could therefore be slow.
function RawFile.FilePosition : integer;
var
pos : integer;
begin
if ( not IsOpen ) then
Error( FILE_NOT_OPEN_EMSG );
pos := SetFilePointer( mFile, 0, nil, FILE_CURRENT );
if ( pos = -1 ) then
Error( SEEK_FAILED_EMSG );
result := pos;
end;
// Seek in file, returning new position. Raises exception if seek fails.
function RawFile.Seek( moveby : integer; from : FileSeekFrom ) : integer;
var
mflags : integer;
begin
if ( not IsOpen ) then
Error( FILE_NOT_OPEN_EMSG );
if ( from = sfStart ) then
mflags := FILE_BEGIN
else if ( from = sfEnd ) then
mflags := FILE_END
else
mflags := FILE_CURRENT;
result := SetFilePointer( mFile, moveby, nil, mflags );
if ( result = -1 ) then
Error( SEEK_FAILED_EMSG );
end;
// Lock a range of bytes
function RawFile.Lock( pos, len : integer ) : boolean;
begin
if ( not IsOpen ) then
Error( FILE_NOT_OPEN_EMSG );
if ( (pos < 0) or (len <= 0 ) ) then
Error( BAD_LOCK_VALUES_EMSG );
result := LockFile( mFile, pos, 0, len, 0 );
end;
// Unlock a range of bytesa
procedure RawFile.UnLock( pos, len : integer );
begin
if ( not IsOpen ) then
Error( FILE_NOT_OPEN_EMSG );
if ( (pos < 0) or (len <= 0 ) ) then
Error( BAD_LOCK_VALUES_EMSG );
if ( not UnLockFile( mFile, pos, 0, len, 0 ) ) then
Error( UNLOCK_FAILED_EMSG );
end;
//------------------------------------------------------------------------------
// TFBuffer methods.
//------------------------------------------------------------------------------
constructor TFBuffer.Create;
begin
Reset;
end;
// Fill a buffer by reading raw bytes
function TFBuffer.Fill( f : RawFile ) : boolean;
begin
mBytes := f.Read( @mBuffer, sizeof( mBuffer )) ;
mPtr := 0;
result := mBytes <> 0;
end;
// Get single character from the buffer, which will refill itself as
// necessary. Returns false on EOF.
function TFBuffer.GetChar( f : RawFile; var c : char ) : boolean;
var
t : char;
begin
result := false;
if ( (mPtr >= mBytes) and (not Fill( f ) ) ) then // eof
exit;
t := mBuffer[mPtr];
inc( mPtr );
result := true;
if ( t = #13 ) then begin
GetChar( f, t );
c := #0;
end
else
c := t;
end;
// Read line from buffer, stripping CR/LF. The buffer re-fills as necessary.
function TFBuffer.GetLine( f : RawFile; var line : string ) : boolean;
var
c : char;
begin
line := '';
while( GetChar( f, c ) ) do begin
if ( c = #0 ) then begin
result := true;
exit;
end;
line := line + c;
end;
result := Line <> '';
end;
// empty the buffer
procedure TFBuffer.Reset;
begin
mPtr := 0;
mBytes := 0;
end;
//------------------------------------------------------------------------------
// TextFile methods. Most work is done by the RawFile and TFBuffer classes.
//------------------------------------------------------------------------------
// Constructor creates the rawfile & buffer object
constructor TextFile.Create;
begin
mFile := RawFile.Create;
mBuffer := TFBuffer.Create;
end;
// destroy rawfile & buffer
destructor TextFile.Destroy;
begin
mBuffer.Free;
mFile.Free;
inherited destroy;
end;
// Once again, open is mostly about mapping modes
procedure TextFile.Open( const fname : string;
omode : TextFileOpenMode;
smode : TextFileShareMode );
var
romode : FileOpenMode;
rsmode : FileShareMode;
rcmode : FileCreateOption;
begin
if ( omode = toRead ) then
romode := foRead
else
romode := foWrite;
if ( smode = smNoShare ) then
rsmode := fsNoShare
else if ( romode = foRead ) then
rsmode := fsShareRead
else
raise FileError.CreateFmt( '%s: %s', [fname, BAD_TFSHARE_EMSG] );
if ( omode = toRead ) then
rcmode := fcExisting
else if ( omode = toReWrite ) then
rcmode := fcNew
else if ( omode = toAppend ) then
rcmode := fcExisting;
mFile.Open( fname, romode, rsmode, rcmode );
if ( omode = toAppend ) then
mFile.Seek( 0, sfEnd );
end;
// Close file
procedure TextFile.Close;
begin
mFile.Close;
end;
// Get file name (may be empty)
function TextFile.FileName : string;
begin
result := mFile.FileName;
end;
// Get open state
function TextFile.IsOpen : boolean;
begin
result := mFile.IsOpen;
end;
// write line to text file, terminating with CR/LF pair
procedure TextFile.WriteLine( const line : string );
const
crlf : array[0..2] of char = #13#10#0;
var
p : pchar;
begin
p := pchar( line );
if ( length( line ) > 0 ) then
mFile.Write( p, length( line ) );
mFile.Write( @crlf, 2 );
end;
// Read line, trimming CR/LF.
function TextFile.ReadLine( var line : string ) : boolean;
begin
result := mBuffer.GetLine( mFile, line );
end;
//------------------------------------------------------------------------------
// RandomAccessFile methods. RawFile class does most of the work.
//------------------------------------------------------------------------------
// constructor creates rawfile
constructor RandomAccessFile.Create;
begin
mfile := RawFile.Create;
end;
destructor RandomAccessFile.Destroy;
begin
mFile.Free;
inherited Destroy;
end;
// Mode mapping not necessary, as we pass things thru to RawFile
procedure RandomAccessFile.Open( const fname : string;
recsize : integer;
omode : FileOpenMode;
smode : FileShareMode;
copts : FileCreateOption );
begin
mFile.Open( fname, omode, smode, copts );
if ( recsize <= 0 ) then begin
mFile.Close;
mFile.Error( BAD_REC_SIZE_EMSG );
end;
mRecSize := recsize;
end;
// usual stuff
procedure RandomAccessFile.Close;
begin
mFile.close;
end;
function RandomAccessFile.FileName : string;
begin
result := mFile.FileName;
end;
function RandomAccessFile.IsOpen : boolean;
begin
result := mFile.IsOpen;
end;
// write record. If record number higher than current highest, the call
// to Seek will extend the file
procedure RandomAccessFile.WriteRecord( rec : pointer; recno : integer );
begin
if ( recno < 0 ) then
mFile.Error( BAD_REC_NUMBER_EMSG );
mFile.Seek( recno * mRecSize, sfStart );
mFile.Write( rec, mRecSize );
end;
// read a record
function RandomAccessFile.ReadRecord( rec : pointer; recno : integer ) : boolean;
begin
if ( recno < 0 ) then
mFile.Error( BAD_REC_NUMBER_EMSG );
if ( RecordCount <= recno ) then
result := false
else begin
mFile.Seek( recno * mRecSize, sfStart );
result := mFile.Read( rec, mRecSize ) = mRecSize;
end;
end;
// read next record. Should have made som positioning call (like REadRecord)
// before calling this
function RandomAccessFile.ReadNextRecord( rec : pointer ) : boolean;
begin
mFile.Seek( 0, sfHere );
result := mFile.Read( rec, mRecSize ) = mRecSize;
end;
// Record locking
function RandomAccessFile.LockRecord( recno : integer ) : boolean;
begin
result := mFile.Lock( recno * mRecSize, mRecSize );
end;
// and unlocking
procedure RandomAccessFile.UnlockRecord( recno : integer );
begin
mFile.Unlock( recno * mRecSize, mRecSize );
end;
// extend file by count records
procedure RandomAccessFile.Extend( count : integer );
var
c : char;
begin
if ( count > 0 ) then
mFile.Seek( (count - 1 ) * mRecSize, sfEnd );
// for the last record we write a byte at its very end
if ( mRecSize > 1 ) then
mFile.Seek( mRecSize - 1, sfHere );
mFile.Write( @c, 1 ); // must write in order to extend
end;
// Return number of records. This causes several seeks, so may be slow
function RandomAccessFile.RecordCount : integer;
var
now : integer;
begin
now := mFile.FilePosition;
result := mFile.Seek( 0, sfEnd ) div mRecSize;
mFile.Seek( now, sfStart );
end;
//------------------------------------------------------------------------------
end.
[Back to DELPHI SWAG index] [Back to Main SWAG index] [Original]