TeslaRel410/BORLAND/BDE/EXAMPLES/DELPHI/TABLEENH/VCL/TABLEENH.PAS

{$A+,B-,D+,F-,G+,I+,K+,L+,N+,P+,Q-,R-,S+,T-,V+,W-,X+,Y+}
{$M 25600,4096}
{ unit TableEnh.pas }
unit TableEnh;

interface

uses
  SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  Forms, Dialogs, DB, DBTables, DbiProcs, DbiTypes, DbiErrs;

type
  { These exceptions are all the types of dbi errors that can occur
    in this control.  It allows the user to trap for specific dbi
    errors and handle them appropriately.
  }
  EEnhDBError = class(EDatabaseError);
  EEnhDBBufferTooBig = class(EEnhDBError);
  EEnhDBWrongType = class(EEnhDBError);
  EEnhDBIncorrectType = class(EEnhDBError);
  EEnhDBTblNotOpen = class(EEnhDBError);
  { dbiPutField }
  EEnhDBInvalidHndl = class(EEnhDBError);
  EEnhDBOutOfRange = class(EEnhDBError);
  EEnhDBInvalidXLation = class(EEnhDBError);
  { dbiInsertRecord }
  EEnhDBInvalidParam = class(EEnhDBError);
  EEnhDBMinValErr = class(EEnhDBError);
  EEnhDBMaxValErr = class(EEnhDBError);
  EEnhDBReqdErr = class(EEnhDBError);
  EEnhDBLookupTableErr = class(EEnhDBError);
  EEnhDBKeyViol = class(EEnhDBError);
  EEnhDBFileLocked = class(EEnhDBError);
  EEnhDBErrorReadOnly = class(EEnhDBError);
  EEnhDBNotSuffTableRights = class(EEnhDBError);
  EEnhDBNotSuffSQLRights = class(EEnhDBError);
  EEnhDBNoDiskSpace = class(EEnhDBError);
  EEnhDBRecLockFailed = class(EEnhDBError);
  EEnhDBForiegnKeyErr = class(EEnhDBError);
  EEnhDBTableReadOnly = class(EEnhDBError);
  { dbiSaveChanges }
  EEnhDBNotSupported = class(EEnhDBError);
  { dbiCopyTable }
  EEnhDBInvalidFileName = class(EEnhDBError);
  EEnhDBFileExists = class(EEnhDBError);
  EEnhDBFamFileInvalid = class(EEnhDBError);
  EEnhDBNoSuchTable = class(EEnhDBError);
  EEnhDBNotSuffFamilyRights = class(EEnhDBError);
  EEnhDBLocked = class(EEnhDBError);
  { dbiIsRecordLocked }
  EEnhDBNoCurrRec = class(EEnhDBError);
  EEnhDBBOF = class(EEnhDBError);
  EEnhDBEOF = class(EEnhDBError);
  EEnhDBKeyOrRecDeleted = class(EEnhDBError);
  { dbiTimeEncode }
  EEnhDBInvalidTime = class(EEnhDBError);
  { dbiOpenDatabase }
  EEnhDBUnknownDB = class(EEnhDBError);
  EEnhDBNoConfigFile = class(EEnhDBError);
  EEnhDBInvalidDBSpec = class(EEnhDBError);
  EEnhDBDBLimit = class(EEnhDBError);
  { dbiRelRecordLock }
  EEnhDBNotLocked = class(EEnhDBError);

  TInsertMode = (imNoLock, imReadLock, imWriteLock);

  TTableEnhanced = class(TTable)
  private
    { Private declarations }
    FErr: Array[0..dbiMaxMsgLen] of Char;
    FErrInfo: DbiErrInfo;
    FErrStr: String;
    FBlockSize: Longint;
    FBlockTotal: Longint;
    FInsertMode: TInsertMode;
    FOverwrite: Boolean;
    FRecordsAdded: Longint;
    FSave: Boolean;
    FSaveToDisk: Boolean;
    FSConfig: SysConfig;
    FSVersion: SysVersion;
    FSInfo : SysInfo;
    pRecBuf, pTmpRecBuf: pByte;
    procedure DoAfterClose; Override;
    procedure DoAfterOpen; Override;
    function GetBlockSize: Longint;
    function GetBlockTotal: Longint;
    function GetTableType: PChar;
    procedure PackDBaseTable;
    procedure PackParadoxTable;
    procedure SetBlockSize(Size: Longint);
    procedure SetBlockTotal(Amount: Longint);
    procedure UninitializeBuffer;
    procedure IdleAction(Sender: TObject; var Done: Boolean); Virtual;
  protected
    { Protected declarations }
    function Chk(rslt: DbiResult): DbiResult;
  public
    { Public declarations }
    procedure AppendFast; Virtual;
    function WriteBlock: Boolean; Virtual;
    procedure CopyTable(DName: String); Virtual;
    constructor Create(AOwner: TComponent); Override;
    function GetSysConfig: SysConfig;
    function GetSysInfo: SysInfo;
    function GetSysVersion: SysVersion;
    procedure InitBooleanField(Field: Word; Data: Boolean);
    procedure InitCurrencyField(Field: Word; Data: Double);
    procedure InitDateField(Field: Word; Data: TDateTime);
    procedure InitFloatField(Field: Word; Data: Double);
    procedure InitIntegerField(Field: Word; Data: Longint);
    procedure InitSmallintField(Field: Word; Data: Integer);
    procedure InitStringField(Field: Word; Data: String);
    procedure InitTimeField(Field: Word; Data: TDateTime);
    procedure InitTimeStampField(Field: Word; Data: TDateTime);
    procedure InitializeBuffer;
    procedure InsertFast; Virtual;
    function IsRecordLocked: Boolean;
    function IsTableLocked(LockType: dbiLockType): Word;
    function IsTableShared: boolean;
    procedure NextRecord;
    procedure Pack;
    procedure ReleaseRecordLock(All: Boolean);
  published
    { Published declarations }
    property BlockTotal: Longint read GetBlockTotal write SetBlockTotal;
    property BlockSize: Longint read GetBlockSize write SetBlockSize;
    property InsertMode: TInsertMode read FInsertMode write FInsertMode;
    property Overwrite: Boolean read FOverwrite write FOverwrite;
    property SaveToDisk: Boolean read FSaveToDisk write FSaveToDisk;
    property SaveWhenIdle: Boolean read FSave write FSave;
  end;

procedure Register;

implementation

procedure Register;
begin
  RegisterComponents('Data Access', [TTableEnhanced]);
end;

{ CONSTRUCTOR: Create
  PURPOSE: Override the object's constructor to accomplish some
    initialization tasks at the object's creation time.
}
constructor TTableEnhanced.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  Exclusive := True;
  FBlockSize := 1;
  FBlockTotal := 1;
  FSave := True;
  Application.OnIdle := IdleAction;
  FillChar(FSConfig, sizeof(FSConfig), 0);
  DbiGetSysConfig(FSConfig);
end;

{ METHOD: DoAfterOpen
  PURPOSE: Override the object's DoAfterOpen method to get the system's
    version and information.  Doing this after the table is open ensures
    that the dbi calls have a valid table handle.
}
procedure TTableEnhanced.DoAfterOpen;
begin
  DbiGetSysVersion(FSVersion);
  DbiGetSysInfo(FSInfo);
end;

{ METHOD: DoAfterClose
  PURPOSE: Override the object's DoAfterClose method to fill the
    version and information structures with zeros.  If the structure
    is retrieved when a table is not open, data will not be from the
    previously opened table.
}
procedure TTableEnhanced.DoAfterClose;
begin
  FillChar(FSVersion, sizeOf(FSVersion), 0);
  FillChar(FSInfo, sizeOf(FSInfo), 0);
end;

{ METHOD: Chk
  PURPOSE: Checks the return code from any dbi function.  If an error has
    occurred, create an error string and raise the appropriate exception.
    Variables are declared in the object for speed reasons.
}
function TTableEnhanced.Chk(rslt: DbiResult): DbiResult;
begin
  if rslt <> dbiErr_None then
  begin
    { Look on the eror stack to see if there is any detailed information
      about the error that has just occurred }
    DbiGetErrorInfo(False, FErrInfo);
    { If so construct an error string }
    if FErrInfo.iError = rslt then
    begin
      FErrStr := Format('%s  ', [FErrInfo.szErrCode]);
      if StrComp(FErrInfo.szContext[1], '') = 0 then
        FErrStr := Format('%s  %s', [FErrStr, FErrInfo.szContext[1]]);
      if StrComp(FErrInfo.szContext[2], '') = 0 then
        FErrStr := Format('%s  %s', [FErrStr, FErrInfo.szContext[2]]);
      if StrComp(FErrInfo.szContext[3], '') = 0 then
        FErrStr := Format('%s  %s', [FErrStr, FErrInfo.szContext[3]]);
      if StrComp(FErrInfo.szContext[4], '') = 0 then
        FErrStr := Format('%s  %s', [FErrStr, FErrInfo.szContext[4]]);
    end
    else
    begin
      { Get the generic error message if there is no error information
        on the stack }
      DbiGetErrorString(rslt, FErr);
      FErrStr := StrPas(FErr);
    end;
    FErrStr := Format('Speed Table Error: %d.  %s', [rslt, FErrStr]);
    { Raise the appropriate exception }
    case rslt of
      dbiErr_InvalidHndl:
        raise EEnhDBInvalidHndl.Create(FErrStr);
      dbiErr_OutOfRange:
        raise EEnhDBOutOfRange.Create(FErrStr);
      dbiErr_InvalidXLation:
        raise EEnhDBInvalidXLation.Create(FErrStr);
      dbiErr_InvalidParam:
        raise EEnhDBInvalidParam.Create(FErrStr);
      dbiErr_MinValErr:
        raise EEnhDBMinValErr.Create(FErrStr);
      dbiErr_MaxValErr:
        raise EEnhDBMaxValErr.Create(FErrStr);
      dbiErr_ReqdErr:
        raise EEnhDBReqdErr.Create(FErrStr);
      dbiErr_LookupTableErr:
        raise EEnhDBLookupTableErr.Create(FErrStr);
      dbiErr_KeyViol:
        raise EEnhDBKeyViol.Create(FErrStr);
      dbiErr_FileLocked:
        raise EEnhDBFileLocked.Create(FErrStr);
      dbiErr_TableReadOnly:
        raise EEnhDBErrorReadOnly.Create(FErrStr);
      dbiErr_NotSuffTableRights:
        raise EEnhDBNotSuffTableRights.Create(FErrStr);
      dbiErr_NotSuffSQLRights:
        raise EEnhDBNotSuffSQLRights.Create(FErrStr);
      dbiErr_NoDiskSpace:
        raise EEnhDBNoDiskSpace.Create(FErrStr);
      dbiErr_RecLockFailed:
        raise EEnhDBRecLockFailed.Create(FErrStr);
      dbiErr_NotSupported:
        raise EEnhDBNotSupported.Create(FErrStr);
      dbiErr_InvalidFileName:
        raise EEnhDBInvalidFileName.Create(FErrStr);
      dbiErr_FileExists:
        raise EEnhDBFileExists.Create(FErrStr);
      dbiErr_FamFileInvalid:
        raise EEnhDBFamFileInvalid.Create(FErrStr);
      dbiErr_NoSuchTable:
        raise EEnhDBNoSuchTable.Create(FErrStr);
      dbiErr_NotSuffFamilyRights:
        raise EEnhDBNotSuffFamilyRights.Create(FErrStr);
      dbiErr_Locked:
        raise EEnhDBLocked.Create(FErrStr);
      dbiErr_NoCurrRec:
        raise EEnhDBNoCurrRec.Create(FErrStr);
      dbiErr_BOF:
        raise EEnhDBBOF.Create(FErrStr);
      dbiErr_EOF:
        raise EEnhDBEOF.Create(FErrStr);
      dbiErr_KeyOrRecDeleted:
        raise EEnhDBKeyOrRecDeleted.Create(FErrStr);
      dbiErr_ForiegnKeyErr:
        raise EEnhDBForiegnKeyErr.Create(FErrStr);
      dbiErr_InvalidTime:
        raise EEnhDBInvalidTime.Create(FErrStr);
      dbiErr_UnknownDB:
        raise EEnhDBUnknownDB.Create(FErrStr);
      dbiErr_NoConfigFile:
        raise EEnhDBNoConfigFile.Create(FErrStr);
      dbiErr_InvalidDBSpec:
        raise EEnhDBInvalidDBSpec.Create(FErrStr);
      dbiErr_DBLimit:
        raise EEnhDBDBLimit.Create(FErrStr);
      dbiErr_NotLocked:
        raise EEnhDBNotLocked.Create(FerrStr);
      else
        raise EEnhDBError.Create(FErrStr);
    end;
  end;
end;

{ METHOD: GetSysVersion
  PURPOSE: Returns system version information.
}
function TTableEnhanced.GetSysVersion: SysVersion;
begin
  GetSysVersion := FSVersion;
end;

{ METHOD: GetSysInfo
  PURPOSE: Returns general system information.
}
function TTableEnhanced.GetSysInfo: SysInfo;
begin
  GetSysInfo := FSInfo;
end;

{ METHOD: GetSysConfig
  PURPOSE: Returns system configuration information.
}
function TTableEnhanced.GetSysConfig: SysConfig;
begin
  GetSysConfig := FSConfig;
end;

{ METHOD: IsTableShared
  PURPOSE: Returns a True if the table is opened in share mode and is
    on a shared drive: otherwise returns False.
}
function TTableEnhanced.IsTableShared: Boolean;
var
  Shared: Bool;

begin
  Chk(DbiIsTableShared(Handle, Shared));
  IsTableShared := Shared;
end;

{ METHOD: IsRecordLocked
  PURPOSE: Returns a True if the current record is locked: otherwise
    returns False.
}
function TTableEnhanced.IsRecordLocked: Boolean;
var
  Locked: Bool;

begin
  { Make sure the currently displayed record also has the table cursor
    pointing to it.  This is needed when using a DBGrid. }
  UpdateCursorPos;
  Chk(DbiIsRecordLocked(Handle, Locked));
  IsRecordLocked := Locked;
end;

{ METHOD: IsTableLocked
  PURPOSE: Returns a True if the opened table is locked: otherwise
    returns False.
}
function TTableEnhanced.IsTableLocked(LockType: dbiLockType): Word;
var
  NumLocks: Word;

begin
  Chk(DbiIsTableLocked(Handle, LockType, NumLocks));
  IsTableLocked := NumLocks;
end;

{ METHOD: IdleAction
  PURPOSE: When the application is idle and SaveWhenIdle is True, save
    the IDAPI table buffer to disk.
}
procedure TTableEnhanced.IdleAction(Sender: TObject; var Done: Boolean);
begin
  if FSave = True then
    DbiUseIdleTime;
  Done := True;
end;

{ METHOD: NextRecord
  PURPOSE: Move the temporary record buffer pointer to the next record.
    This allows the user to fill the record buffer with multiple
    records before placing them in the table with WriteBlock.
}
procedure TTableEnhanced.NextRecord;
begin
  Inc(pTmpRecBuf, RecordSize);
end;

{ METHOD: CopyTable
  PURPOSE: Copies a table, indexes and validity checks to a table of
    a different name.  NOTE: If used on a SQL table, only the table
    itself is copied.
}
procedure TTableEnhanced.CopyTable(DName: String);
var
 pSName: array[0..dbiMaxPathLen] of char;
 pDName: array[0..dbiMaxPathLen] of char;
 pTblType: array[0..dbiMaxPathLen] of char;

begin
  Chk(DbiCopyTable(DBHandle, FOverwrite, StrPCopy(pSName, TableName),
                   StrCopy(pTblType, GetTableType),
                   StrPCopy(pDName, DName)));
end;

{ METHOD: InitializeBuffer
  PURPOSE: Creates a record(s) buffer.  The buffer can be up to 64k
    and then can be used with WriteBlock to place multiple records into
    the table.
}
procedure TTableEnhanced.InitializeBuffer;
var
  W: Word;
  RecordBufferSize: Longint;

begin
  { Determine the buffer size that is needed }
  RecordBufferSize := RecordSize * FBlockSize;
  { If it is bigger than 64k, raise an exception }
  if RecordBufferSize > 65535 then
    raise EEnhDBBufferTooBig.Create('Attempt to allocate a buffer ' +
                                   'greater than 64k');
  { Allocate the record buffer }
  GetMem(pRecBuf, RecordBufferSize);
  { pRecBuf will ALWAYS point to the beginning of the record buffer.
    Use pTmpRecBuf to fill the record buffer with field information. }
  pTmpRecBuf := pRecBuf;
  { After the buffer has been allocated, "empty" the record buffer }
  for W := 1 to FBlockSize do
  begin
    Chk(DbiInitRecord(Handle, pTmpRecBuf));
    Inc(pTmpRecBuf, RecordSize);
  end;
  pTmpRecBuf := pRecBuf;
end;

{ METHOD: UninitializeBuffer
  PURPOSE: Frees up the memory allocated for the record buffer.  NOTE: it
    is important that the BlockSize is not changed between the
    InitializeBuffer call and the WriteBlock, InsertFast, or AppendFast.
    This may cause a GP Fault to occur.
}
procedure TTableEnhanced.UninitializeBuffer;
begin
  FreeMem(pRecBuf, RecordSize * FBlockSize);
end;

{ METHOD: InsertFast
  PURPOSE: Inserts a new record into the table.  This method should be
    used on a table that is opened on an index.  NOTE: Even if you have
    allocated and filled more than one record in the record buffer, only
    the first record in the buffer will be inserted into the table.
    NOTE: A word of caution; if you lock the inserted record, be sure to
      release it when processing is done.  Use method ReleaseRecordLock.
}
procedure TTableEnhanced.InsertFast;
begin
  { Insert the record using the appropriate record locking }
  case InsertMode of
    imNoLock:
      Chk(DbiInsertRecord(Handle, dbiNoLock, pRecBuf));
    imReadLock:
      Chk(DbiInsertRecord(Handle, dbiReadLock, pRecBuf));
    imWriteLock:
      Chk(DbiInsertRecord(Handle, dbiWriteLock, pRecBuf));
  end;
  { If SaveToDisk is True, write the buffered record to disk. }
  if FSaveToDisk = True then
    Chk(DbiSaveChanges(Handle));
  { Free up the allocated record buffer }
  UninitializeBuffer;
end;

{ METHOD: AppendFast
  PURPOSE: Append the record to the table.  It is reccommended only for
    table which do not have a currently active index.  If an index is
    active, use InsertFast.  NOTE: Even if you have allocated and filled
    more than one record in the record buffer, only the first record in
    the buffer will be appended into the table.
}
procedure TTableEnhanced.AppendFast;
begin
  { Append the record }
  Chk(DbiAppendRecord(Handle, pRecBuf));
  { If SaveToDisk is True, write the buffered record to disk. }
  if FSaveToDisk = True then
    Chk(DbiSaveChanges(Handle));
end;

{ METHOD: InitTimeStampField
  PURPOSE: Writes a a TimeStamp field value to the correct location in
    the specified record buffer.
}
procedure TTableEnhanced.InitTimeStampField(Field: Word; Data: TDateTime);
var
  H, Min, S, MS: Word;
  TheTime: DbiTypes.Time;
  Y, M, D: Word;
  TheDate: DbiTypes.Date;
  TheTimeStamp: DbiTypes.TimeStamp;

begin
  { Make sure that the field is of type ftDateTime }
  if Fields[Field].DataType <> ftDateTime then
    raise EEnhDBWrongType.Create(
      Format('Field %d: "%s", incomaptible type.', [Field, Fields[Field].FieldName]))
  else
  begin
    { A conversion from the Delphi Date and Time format to the BDE Date
      and Time format must occur }
    DecodeTime(Data, H, Min, S, MS);
    DecodeDate(Data, Y, M, D);
    Chk(DbiTimeEncode(H, Min, (S * 1000), TheTime));
    Chk(DbiDateEncode(M, D, Y, TheDate));
    Chk(DbiTimeStampEncode(TheDate, TheTime, TheTimeStamp));
    { Place the Timestamp in the corrisponding field in the record buffer }
    Chk(DbiPutField(Handle, Field + 1, pTmpRecBuf, @TheTimeStamp));
  end;
end;

{ METHOD: InitTimeField
  PURPOSE: Writes a Time field value to the correct location in
    the specified record buffer.
}
procedure TTableEnhanced.InitTimeField(Field: Word; Data: TDateTime);
var
  H, M, S, MS: Word;
  TheTime: dbiTypes.Time;

begin
  { Make sure that the field is of type ftTime }
  if Fields[Field].DataType <> ftTime then
    raise EEnhDBWrongType.Create(
      Format('Field %d: "%s", incomaptible type.', [Field, Fields[Field].FieldName]))
  else
  begin
    { A conversion from the Delphi Time format to the BDE Time
      format must occur }
    DecodeTime(Data, H, M, S, MS);
    Chk(DbiTimeEncode(H, M, (S * 1000), TheTime));
    { Place the Time in the corrisponding field in the record buffer }
    Chk(DbiPutField(Handle, Field + 1, pTmpRecBuf, @TheTime));
  end;
end;

{ METHOD: InitDateField
  PURPOSE: Writes a Date field value to the correct location in
    the specified record buffer.
}
procedure TTableEnhanced.InitDateField(Field: Word; Data: TDateTime);
var
  Y, M, D: Word;
  TheDate: DbiTypes.Date;
begin

  { Make sure that the field is of type ftDate }
  if Fields[Field].DataType <> ftDate then
    raise EEnhDBWrongType.Create(
      Format('Field %d: "%s", incomaptible type.', [Field, Fields[Field].FieldName]))
  else
  begin
    { A conversion from the Delphi Date format to the BDE Date
      format must occur }
    DecodeDate(Data, Y, M, D);
    Chk(DbiDateEncode(M, D, Y, TheDate));
    { Place the Date in the corrisponding field in the record buffer }
    Chk(DbiPutField(Handle, Field + 1, pTmpRecBuf, @TheDate));
  end;
end;

{ METHOD: InitBooleanField
  PURPOSE: Writes a Boolean field value to the correct location in
    the specified record buffer.
}
procedure TTableEnhanced.InitBooleanField(Field: Word; Data: Boolean);
begin
  { Make sure that the field is of type ftBoolean }
  if Fields[Field].DataType <> ftBoolean then
    raise EEnhDBWrongType.Create(
      Format('Field %d: "%s", incomaptible type.', [Field, Fields[Field].FieldName]))
  else
    { Place the Boolean in the corrisponding field in the record buffer }
    Chk(DbiPutField(Handle, Field + 1, pTmpRecBuf, @Data));
end;

{ METHOD: InitIntegerField
  PURPOSE: Writes a Integer field value to the correct location in
    the specified record buffer.
}
procedure TTableEnhanced.InitIntegerField(Field: Word; Data: Longint);
begin
  { Make sure that the field is of type ftInteger }
  if Fields[Field].DataType <> ftInteger then
    raise EEnhDBWrongType.Create(
      Format('Field %d: "%s", incomaptible type.', [Field, Fields[Field].FieldName]))
  else
    { Place the Integer in the corrisponding field in the record buffer }
    Chk(DbiPutField(Handle, Field + 1, pTmpRecBuf, @Data));
end;

{ METHOD: InitSmallintField
  PURPOSE: Writes a Smallint field value to the correct location in
    the specified record buffer.
}
procedure TTableEnhanced.InitSmallintField(Field: Word; Data: Integer);
begin
  { Make sure that the field is of type ftSmallint }
  if Fields[Field].DataType <> ftSmallint then
    raise EEnhDBWrongType.Create(
      Format('Field %d: "%s", incomaptible type.', [Field, Fields[Field].FieldName]))
    else
      { Place the Smallint in the corrisponding field in the record buffer }
      Chk(DbiPutField(Handle, Field + 1, pTmpRecBuf, @Data));
end;

{ METHOD: InitCurrencyField
  PURPOSE: Writes a Currency field value to the correct location in
    the specified record buffer.
}
procedure TTableEnhanced.InitCurrencyField(Field: Word; Data: Double);
begin
  { Make sure that the field is of type ftCurrency }
  if Fields[Field].DataType <> ftCurrency then
    raise EEnhDBWrongType.Create(
      Format('Field %d: "%s", incomaptible type.', [Field, Fields[Field].FieldName]))
    else
      { Place the Currency in the corrisponding field in the record buffer }
      Chk(DbiPutField(Handle, Field + 1, pTmpRecBuf, @Data));
end;

{ METHOD: InitFloatField
  PURPOSE: Writes a Float field value to the correct location in
    the specified record buffer.
}
procedure TTableEnhanced.InitFloatField(Field: Word; Data: Double);
begin
  { Make sure that the field is of type ftFloat }
  if Fields[Field].DataType <> ftFloat then
    raise EEnhDBWrongType.Create(
      Format('Field %d: "%s", incomaptible type.', [Field, Fields[Field].FieldName]))
  else
    { Place the Float in the corrisponding field in the record buffer }
    Chk(DbiPutField(Handle, Field + 1, pTmpRecBuf, @Data));
end;

{ METHOD: InitStringField
  PURPOSE: Writes a String field value to the correct location in
    the specified record buffer.
}
procedure TTableEnhanced.InitStringField(Field: Word; Data: String);
var
  pData: pByte;

begin
  { Make sure that the field is of type ftString }
  if Fields[Field].DataType <> ftString then
    raise EEnhDBWrongType.Create(
      Format('Field %d: "%s", incomaptible type.', [Field, Fields[Field].FieldName]))
  else
  begin
    { Make sure that the data to be inserted is not longer than
      the field's length }
    if Length(Data) > Fields[Field].DataSize then
      raise EEnhDBWrongType.Create(
        Format('String to be inserted is longer than field %d: "%s".',
               [Field, Fields[Field].FieldName]))
    else
    begin
      GetMem(pData, Fields[Field].DataSize);
      StrPCopy(pChar(pData), Data);
      { Place the String in the corrisponding field in the record buffer }
      Chk(DbiPutField(Handle, Field + 1, pTmpRecBuf, pData));
      FreeMem(pData, Fields[Field].DataSize);
    end;
  end;
end;

{ METHOD: GetBlockTotal
  PURPOSE: Retrieve the amount of records to be inserted when using
    method WriteBlock.
}
function TTableEnhanced.GetBlockTotal: Longint;
begin
  GetBlockTotal := FBlockTotal;
end;

{ METHOD: SetBlockTotal
  PURPOSE: Set amount of records to be inserted when using
    method WriteBlock.
}
procedure TTableEnhanced.SetBlockTotal(Amount: Longint);
begin
  if Amount <> FBlockTotal then
  begin
    { Warn user if an attempt to set below one is made }
    if Amount <= 0 then
      MessageDlg('BlockTotal must be greater than 1', mtError, [mbOk], 0)
    else
    begin
      FBlockTotal := Amount;
      { If the BlockSize is greater than the block total, set the
        BlockSize equal to the BlockTotal }
      if FBlockTotal < FBlockSize then
        FBlockSize := FBlockTotal;
    end;
  end;
end;

{ METHOD: GetBlockSize
  PURPOSE: Retrieve the size of the record buffer to be used with
    WriteBlock.  NOTE: If using AppendFast ot InsertFast, Set the
    BlockSize equal to one before initializing the buffer.
}
function TTableEnhanced.GetBlockSize: Longint;
begin
  GetBlockSize := FBlockSize;
end;

{ METHOD: SetBlockSize
  PURPOSE: Set size of the record buffer to be used with
    WriteBlock. NOTE: If using AppendFast ot InsertFast, Set the
    BlockSize equal to one before initializing the buffer.
}
procedure TTableEnhanced.SetBlockSize(Size: Longint);
begin
  { Warn user if an attempt to set below one is made }
  if Size <= 0 then
    MessageDlg('BlockSize must be greater than 1', mtError, [mbOk], 0)
  else
    { If the BlockSize is greater than the BlockTotal, set the BlockSize
      to BlockTotal }
    if Size > FBlockTotal then
      FBlockSize := FBlockTotal
    else
      FBlockSize := Size;
end;

{ METHOD: WriteBlock
  PURPOSE: Write a block of records to a table.  Return False if not
    all records specified in BlockTotal have been added to the table.
}
function TTableEnhanced.WriteBlock: Boolean;
begin
  if (FBlockTotal - FRecordsAdded) < FBlockSize then
    FBlockSize := (FBlockTotal - FRecordsAdded)
  else
    WriteBlock := False;
  { Write the block of records to the table }
  Chk(DbiWriteBlock(Handle, FBlockSize, pRecBuf));
  Inc(FRecordsAdded, FBlockSize);
  if FRecordsAdded >= FBlockTotal then
  begin
    WriteBLock := True;
    FRecordsAdded := 0;
  end;
  { Free up the record buffer that has been allocated }
  UnInitializeBuffer;
end;

{ METHOD: GetTableType
  PURPOSE: Return the type of table that is currently open: either
    PARADOX or DBASE.
}
function TTableEnhanced.GetTableType: PChar;
var
  { FCurProp Holds information about the structure of the table }
  FCurProp: CurProps;

begin
  { Find out what type of table is currently opened.  NOTE: This is
    different than TTablePack.TableType }
  Chk(DbiGetCursorProps(Handle, FCurProp));
  GetTableType := FCurProp.szTableType;
end;

{ METHOD: Pack
  PURPOSE: Check to see which table is opened and than call the
    appropriate table packing method.  NOTE: This only works with
    Paradox and dBase tables.
}
procedure TTableEnhanced.Pack;
var
  TType: array[0..40] of char;

begin
  { The table must be opened to get directory information about the table
    before closing }
  if Active <> True then
    raise EEnhDBTblNotOpen.Create('Table must be opened to be packed');
  { Get the type of table }
  strcopy(TType, GetTableType);
  if strcomp(TType, szParadox) = 0 then
    { Call PackParadoxTable procedure if PARADOX table }
    PackParadoxTable
  else
    if strcomp(TType, szDBase) = 0 then
      { Call PackDBaseTable procedure if dBase table }
      PackDBaseTable
    else
      { PARADOX and dBase table are the only types that can be packed }
      raise EEnhDBIncorrectType.Create('Incorrect table type: ' +
                                          StrPas(TType));
end;

{ METHOD: PackParadoxTable
  PURPOSE: Pack the currently opened paradox table.
}
procedure TTableEnhanced.PackParadoxTable;
var
  { Specific information about the table structure, indexes, etc. }
  TblDesc: CRTblDesc;
  { Uses as a handle to the database }
  hDb: hDbiDb;
  { Path to the currently opened table }
  TablePath: array[0..dbiMaxPathLen] of char;

begin
  hDb := nil;
  { Initialize the table descriptor }
  FillChar(TblDesc, SizeOf(CRTblDesc), 0);
  with TblDesc do
  begin
    { Place the table name in descriptor }
    StrPCopy(szTblName, TableName);
    { Place the table type in descriptor }
    StrCopy(szTblType, GetTableType);
    { Set the packing option to true }
    bPack := True;
  end;
  { Get the current table's directory.  This is why the table MUST be
    opened until now }
  Chk(DbiGetDirectory(DBHandle, True, TablePath));
  { Close the table }
  Close;
  { NOW: since the DbiDoRestructure call needs a valid DB handle BUT the
    table cannot be opened, call DbiOpenDatabase to get a valid handle.
    Setting TTable.Active = FALSE does not give you a valid handle }
  Chk(DbiOpenDatabase(nil, 'STANDARD', dbiReadWrite, dbiOpenExcl, nil,
                        0, nil, nil, hDb));
  { Set the table's directory to the old directory }
  Chk(DbiSetDirectory(hDb, TablePath));
  { Pack the PARADOX table }
  Chk(DbiDoRestructure(hDb, 1, @TblDesc, nil, nil, nil, FALSE));
  { Close the temporary database handle }
  Chk(DbiCloseDatabase(hDb));
  { Re-Open the table }
  Open;
end;

{ METHOD: PackDBaseTable
  PURPOSE: Pack the currently opened dBase table.
}
procedure TTableEnhanced.PackDBaseTable;
begin
  { Pack the dBase Table }
  Chk(DbiPackTable(DBHandle, Handle, nil, nil, True));
end;

{ METHOD: ReleaseRecordLock
  PURPOSE: Release a lock on a record.  If All is set to True, realease
    all record locks on the table.  If All is set to False, release
    the lock on the current record only.
}
procedure TTableEnhanced.ReleaseRecordLock(All: Boolean);
begin
  if All = True then
    Chk(DbiRelRecordLock(Handle, True))
  else
    Chk(DbiRelRecordLock(Handle, False));
end;

end.