home *** CD-ROM | disk | FTP | other *** search
/ C Programming Starter Kit 2.0 / SamsPublishing-CProgrammingStarterKit-v2.0-Win31.iso / bde / sdktabvc.pak / TABLEENH.PAS < prev   
Encoding:
Pascal/Delphi Source File  |  1997-07-24  |  28.5 KB  |  860 lines
  1. {$A+,B-,D+,F-,G+,I+,K+,L+,N+,P+,Q-,R-,S+,T-,V+,W-,X+,Y+}
  2. {$M 25600,4096}
  3. { unit TableEnh.pas }
  4. unit TableEnh;
  5.  
  6. interface
  7.  
  8. uses
  9.   SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  10.   Forms, Dialogs, DB, DBTables, DbiProcs, DbiTypes, DbiErrs;
  11.  
  12. type
  13.   { These exceptions are all the types of dbi errors that can occur
  14.     in this control.  It allows the user to trap for specific dbi
  15.     errors and handle them appropriately.
  16.   }
  17.   EEnhDBError = class(EDatabaseError);
  18.   EEnhDBBufferTooBig = class(EEnhDBError);
  19.   EEnhDBWrongType = class(EEnhDBError);
  20.   EEnhDBIncorrectType = class(EEnhDBError);
  21.   EEnhDBTblNotOpen = class(EEnhDBError);
  22.   { dbiPutField }
  23.   EEnhDBInvalidHndl = class(EEnhDBError);
  24.   EEnhDBOutOfRange = class(EEnhDBError);
  25.   EEnhDBInvalidXLation = class(EEnhDBError);
  26.   { dbiInsertRecord }
  27.   EEnhDBInvalidParam = class(EEnhDBError);
  28.   EEnhDBMinValErr = class(EEnhDBError);
  29.   EEnhDBMaxValErr = class(EEnhDBError);
  30.   EEnhDBReqdErr = class(EEnhDBError);
  31.   EEnhDBLookupTableErr = class(EEnhDBError);
  32.   EEnhDBKeyViol = class(EEnhDBError);
  33.   EEnhDBFileLocked = class(EEnhDBError);
  34.   EEnhDBErrorReadOnly = class(EEnhDBError);
  35.   EEnhDBNotSuffTableRights = class(EEnhDBError);
  36.   EEnhDBNotSuffSQLRights = class(EEnhDBError);
  37.   EEnhDBNoDiskSpace = class(EEnhDBError);
  38.   EEnhDBRecLockFailed = class(EEnhDBError);
  39.   EEnhDBForiegnKeyErr = class(EEnhDBError);
  40.   EEnhDBTableReadOnly = class(EEnhDBError);
  41.   { dbiSaveChanges }
  42.   EEnhDBNotSupported = class(EEnhDBError);
  43.   { dbiCopyTable }
  44.   EEnhDBInvalidFileName = class(EEnhDBError);
  45.   EEnhDBFileExists = class(EEnhDBError);
  46.   EEnhDBFamFileInvalid = class(EEnhDBError);
  47.   EEnhDBNoSuchTable = class(EEnhDBError);
  48.   EEnhDBNotSuffFamilyRights = class(EEnhDBError);
  49.   EEnhDBLocked = class(EEnhDBError);
  50.   { dbiIsRecordLocked }
  51.   EEnhDBNoCurrRec = class(EEnhDBError);
  52.   EEnhDBBOF = class(EEnhDBError);
  53.   EEnhDBEOF = class(EEnhDBError);
  54.   EEnhDBKeyOrRecDeleted = class(EEnhDBError);
  55.   { dbiTimeEncode }
  56.   EEnhDBInvalidTime = class(EEnhDBError);
  57.   { dbiOpenDatabase }
  58.   EEnhDBUnknownDB = class(EEnhDBError);
  59.   EEnhDBNoConfigFile = class(EEnhDBError);
  60.   EEnhDBInvalidDBSpec = class(EEnhDBError);
  61.   EEnhDBDBLimit = class(EEnhDBError);
  62.   { dbiRelRecordLock }
  63.   EEnhDBNotLocked = class(EEnhDBError);
  64.  
  65.   TInsertMode = (imNoLock, imReadLock, imWriteLock);
  66.  
  67.   TTableEnhanced = class(TTable)
  68.   private
  69.     { Private declarations }
  70.     FErr: Array[0..dbiMaxMsgLen] of Char;
  71.     FErrInfo: DbiErrInfo;
  72.     FErrStr: String;
  73.     FBlockSize: Longint;
  74.     FBlockTotal: Longint;
  75.     FInsertMode: TInsertMode;
  76.     FOverwrite: Boolean;
  77.     FRecordsAdded: Longint;
  78.     FSave: Boolean;
  79.     FSaveToDisk: Boolean;
  80.     FSConfig: SysConfig;
  81.     FSVersion: SysVersion;
  82.     FSInfo : SysInfo;
  83.     pRecBuf, pTmpRecBuf: pByte;
  84.     procedure DoAfterClose; Override;
  85.     procedure DoAfterOpen; Override;
  86.     function GetBlockSize: Longint;
  87.     function GetBlockTotal: Longint;
  88.     function GetTableType: PChar;
  89.     procedure PackDBaseTable;
  90.     procedure PackParadoxTable;
  91.     procedure SetBlockSize(Size: Longint);
  92.     procedure SetBlockTotal(Amount: Longint);
  93.     procedure UninitializeBuffer;
  94.     procedure IdleAction(Sender: TObject; var Done: Boolean); Virtual;
  95.   protected
  96.     { Protected declarations }
  97.     function Chk(rslt: DbiResult): DbiResult;
  98.   public
  99.     { Public declarations }
  100.     procedure AppendFast; Virtual;
  101.     function WriteBlock: Boolean; Virtual;
  102.     procedure CopyTable(DName: String); Virtual;
  103.     constructor Create(AOwner: TComponent); Override;
  104.     function GetSysConfig: SysConfig;
  105.     function GetSysInfo: SysInfo;
  106.     function GetSysVersion: SysVersion;
  107.     procedure InitBooleanField(Field: Word; Data: Boolean);
  108.     procedure InitCurrencyField(Field: Word; Data: Double);
  109.     procedure InitDateField(Field: Word; Data: TDateTime);
  110.     procedure InitFloatField(Field: Word; Data: Double);
  111.     procedure InitIntegerField(Field: Word; Data: Longint);
  112.     procedure InitSmallintField(Field: Word; Data: Integer);
  113.     procedure InitStringField(Field: Word; Data: String);
  114.     procedure InitTimeField(Field: Word; Data: TDateTime);
  115.     procedure InitTimeStampField(Field: Word; Data: TDateTime);
  116.     procedure InitializeBuffer;
  117.     procedure InsertFast; Virtual;
  118.     function IsRecordLocked: Boolean;
  119.     function IsTableLocked(LockType: dbiLockType): Word;
  120.     function IsTableShared: boolean;
  121.     procedure NextRecord;
  122.     procedure Pack;
  123.     procedure ReleaseRecordLock(All: Boolean);
  124.   published
  125.     { Published declarations }
  126.     property BlockTotal: Longint read GetBlockTotal write SetBlockTotal;
  127.     property BlockSize: Longint read GetBlockSize write SetBlockSize;
  128.     property InsertMode: TInsertMode read FInsertMode write FInsertMode;
  129.     property Overwrite: Boolean read FOverwrite write FOverwrite;
  130.     property SaveToDisk: Boolean read FSaveToDisk write FSaveToDisk;
  131.     property SaveWhenIdle: Boolean read FSave write FSave;
  132.   end;
  133.  
  134. procedure Register;
  135.  
  136. implementation
  137.  
  138. procedure Register;
  139. begin
  140.   RegisterComponents('Data Access', [TTableEnhanced]);
  141. end;
  142.  
  143. { CONSTRUCTOR: Create
  144.   PURPOSE: Override the object's constructor to accomplish some
  145.     initialization tasks at the object's creation time.
  146. }
  147. constructor TTableEnhanced.Create(AOwner: TComponent);
  148. begin
  149.   inherited Create(AOwner);
  150.   Exclusive := True;
  151.   FBlockSize := 1;
  152.   FBlockTotal := 1;
  153.   FSave := True;
  154.   Application.OnIdle := IdleAction;
  155.   FillChar(FSConfig, sizeof(FSConfig), 0);
  156.   DbiGetSysConfig(FSConfig);
  157. end;
  158.  
  159. { METHOD: DoAfterOpen
  160.   PURPOSE: Override the object's DoAfterOpen method to get the system's
  161.     version and information.  Doing this after the table is open ensures
  162.     that the dbi calls have a valid table handle.
  163. }
  164. procedure TTableEnhanced.DoAfterOpen;
  165. begin
  166.   DbiGetSysVersion(FSVersion);
  167.   DbiGetSysInfo(FSInfo);
  168. end;
  169.  
  170. { METHOD: DoAfterClose
  171.   PURPOSE: Override the object's DoAfterClose method to fill the
  172.     version and information structures with zeros.  If the structure
  173.     is retrieved when a table is not open, data will not be from the
  174.     previously opened table.
  175. }
  176. procedure TTableEnhanced.DoAfterClose;
  177. begin
  178.   FillChar(FSVersion, sizeOf(FSVersion), 0);
  179.   FillChar(FSInfo, sizeOf(FSInfo), 0);
  180. end;
  181.  
  182. { METHOD: Chk
  183.   PURPOSE: Checks the return code from any dbi function.  If an error has
  184.     occurred, create an error string and raise the appropriate exception.
  185.     Variables are declared in the object for speed reasons.
  186. }
  187. function TTableEnhanced.Chk(rslt: DbiResult): DbiResult;
  188. begin
  189.   if rslt <> dbiErr_None then
  190.   begin
  191.     { Look on the eror stack to see if there is any detailed information
  192.       about the error that has just occurred }
  193.     DbiGetErrorInfo(False, FErrInfo);
  194.     { If so construct an error string }
  195.     if FErrInfo.iError = rslt then
  196.     begin
  197.       FErrStr := Format('%s  ', [FErrInfo.szErrCode]);
  198.       if StrComp(FErrInfo.szContext[1], '') = 0 then
  199.         FErrStr := Format('%s  %s', [FErrStr, FErrInfo.szContext[1]]);
  200.       if StrComp(FErrInfo.szContext[2], '') = 0 then
  201.         FErrStr := Format('%s  %s', [FErrStr, FErrInfo.szContext[2]]);
  202.       if StrComp(FErrInfo.szContext[3], '') = 0 then
  203.         FErrStr := Format('%s  %s', [FErrStr, FErrInfo.szContext[3]]);
  204.       if StrComp(FErrInfo.szContext[4], '') = 0 then
  205.         FErrStr := Format('%s  %s', [FErrStr, FErrInfo.szContext[4]]);
  206.     end
  207.     else
  208.     begin
  209.       { Get the generic error message if there is no error information
  210.         on the stack }
  211.       DbiGetErrorString(rslt, FErr);
  212.       FErrStr := StrPas(FErr);
  213.     end;
  214.     FErrStr := Format('Speed Table Error: %d.  %s', [rslt, FErrStr]);
  215.     { Raise the appropriate exception }
  216.     case rslt of
  217.       dbiErr_InvalidHndl:
  218.         raise EEnhDBInvalidHndl.Create(FErrStr);
  219.       dbiErr_OutOfRange:
  220.         raise EEnhDBOutOfRange.Create(FErrStr);
  221.       dbiErr_InvalidXLation:
  222.         raise EEnhDBInvalidXLation.Create(FErrStr);
  223.       dbiErr_InvalidParam:
  224.         raise EEnhDBInvalidParam.Create(FErrStr);
  225.       dbiErr_MinValErr:
  226.         raise EEnhDBMinValErr.Create(FErrStr);
  227.       dbiErr_MaxValErr:
  228.         raise EEnhDBMaxValErr.Create(FErrStr);
  229.       dbiErr_ReqdErr:
  230.         raise EEnhDBReqdErr.Create(FErrStr);
  231.       dbiErr_LookupTableErr:
  232.         raise EEnhDBLookupTableErr.Create(FErrStr);
  233.       dbiErr_KeyViol:
  234.         raise EEnhDBKeyViol.Create(FErrStr);
  235.       dbiErr_FileLocked:
  236.         raise EEnhDBFileLocked.Create(FErrStr);
  237.       dbiErr_TableReadOnly:
  238.         raise EEnhDBErrorReadOnly.Create(FErrStr);
  239.       dbiErr_NotSuffTableRights:
  240.         raise EEnhDBNotSuffTableRights.Create(FErrStr);
  241.       dbiErr_NotSuffSQLRights:
  242.         raise EEnhDBNotSuffSQLRights.Create(FErrStr);
  243.       dbiErr_NoDiskSpace:
  244.         raise EEnhDBNoDiskSpace.Create(FErrStr);
  245.       dbiErr_RecLockFailed:
  246.         raise EEnhDBRecLockFailed.Create(FErrStr);
  247.       dbiErr_NotSupported:
  248.         raise EEnhDBNotSupported.Create(FErrStr);
  249.       dbiErr_InvalidFileName:
  250.         raise EEnhDBInvalidFileName.Create(FErrStr);
  251.       dbiErr_FileExists:
  252.         raise EEnhDBFileExists.Create(FErrStr);
  253.       dbiErr_FamFileInvalid:
  254.         raise EEnhDBFamFileInvalid.Create(FErrStr);
  255.       dbiErr_NoSuchTable:
  256.         raise EEnhDBNoSuchTable.Create(FErrStr);
  257.       dbiErr_NotSuffFamilyRights:
  258.         raise EEnhDBNotSuffFamilyRights.Create(FErrStr);
  259.       dbiErr_Locked:
  260.         raise EEnhDBLocked.Create(FErrStr);
  261.       dbiErr_NoCurrRec:
  262.         raise EEnhDBNoCurrRec.Create(FErrStr);
  263.       dbiErr_BOF:
  264.         raise EEnhDBBOF.Create(FErrStr);
  265.       dbiErr_EOF:
  266.         raise EEnhDBEOF.Create(FErrStr);
  267.       dbiErr_KeyOrRecDeleted:
  268.         raise EEnhDBKeyOrRecDeleted.Create(FErrStr);
  269.       dbiErr_ForiegnKeyErr:
  270.         raise EEnhDBForiegnKeyErr.Create(FErrStr);
  271.       dbiErr_InvalidTime:
  272.         raise EEnhDBInvalidTime.Create(FErrStr);
  273.       dbiErr_UnknownDB:
  274.         raise EEnhDBUnknownDB.Create(FErrStr);
  275.       dbiErr_NoConfigFile:
  276.         raise EEnhDBNoConfigFile.Create(FErrStr);
  277.       dbiErr_InvalidDBSpec:
  278.         raise EEnhDBInvalidDBSpec.Create(FErrStr);
  279.       dbiErr_DBLimit:
  280.         raise EEnhDBDBLimit.Create(FErrStr);
  281.       dbiErr_NotLocked:
  282.         raise EEnhDBNotLocked.Create(FerrStr);
  283.       else
  284.         raise EEnhDBError.Create(FErrStr);
  285.     end;
  286.   end;
  287. end;
  288.  
  289. { METHOD: GetSysVersion
  290.   PURPOSE: Returns system version information.
  291. }
  292. function TTableEnhanced.GetSysVersion: SysVersion;
  293. begin
  294.   GetSysVersion := FSVersion;
  295. end;
  296.  
  297. { METHOD: GetSysInfo
  298.   PURPOSE: Returns general system information.
  299. }
  300. function TTableEnhanced.GetSysInfo: SysInfo;
  301. begin
  302.   GetSysInfo := FSInfo;
  303. end;
  304.  
  305. { METHOD: GetSysConfig
  306.   PURPOSE: Returns system configuration information.
  307. }
  308. function TTableEnhanced.GetSysConfig: SysConfig;
  309. begin
  310.   GetSysConfig := FSConfig;
  311. end;
  312.  
  313. { METHOD: IsTableShared
  314.   PURPOSE: Returns a True if the table is opened in share mode and is
  315.     on a shared drive: otherwise returns False.
  316. }
  317. function TTableEnhanced.IsTableShared: Boolean;
  318. var
  319.   Shared: Bool;
  320.  
  321. begin
  322.   Chk(DbiIsTableShared(Handle, Shared));
  323.   IsTableShared := Shared;
  324. end;
  325.  
  326. { METHOD: IsRecordLocked
  327.   PURPOSE: Returns a True if the current record is locked: otherwise
  328.     returns False.
  329. }
  330. function TTableEnhanced.IsRecordLocked: Boolean;
  331. var
  332.   Locked: Bool;
  333.  
  334. begin
  335.   { Make sure the currently displayed record also has the table cursor
  336.     pointing to it.  This is needed when using a DBGrid. }
  337.   UpdateCursorPos;
  338.   Chk(DbiIsRecordLocked(Handle, Locked));
  339.   IsRecordLocked := Locked;
  340. end;
  341.  
  342. { METHOD: IsTableLocked
  343.   PURPOSE: Returns a True if the opened table is locked: otherwise
  344.     returns False.
  345. }
  346. function TTableEnhanced.IsTableLocked(LockType: dbiLockType): Word;
  347. var
  348.   NumLocks: Word;
  349.  
  350. begin
  351.   Chk(DbiIsTableLocked(Handle, LockType, NumLocks));
  352.   IsTableLocked := NumLocks;
  353. end;
  354.  
  355. { METHOD: IdleAction
  356.   PURPOSE: When the application is idle and SaveWhenIdle is True, save
  357.     the IDAPI table buffer to disk.
  358. }
  359. procedure TTableEnhanced.IdleAction(Sender: TObject; var Done: Boolean);
  360. begin
  361.   if FSave = True then
  362.     DbiUseIdleTime;
  363.   Done := True;
  364. end;
  365.  
  366. { METHOD: NextRecord
  367.   PURPOSE: Move the temporary record buffer pointer to the next record.
  368.     This allows the user to fill the record buffer with multiple
  369.     records before placing them in the table with WriteBlock.
  370. }
  371. procedure TTableEnhanced.NextRecord;
  372. begin
  373.   Inc(pTmpRecBuf, RecordSize);
  374. end;
  375.  
  376. { METHOD: CopyTable
  377.   PURPOSE: Copies a table, indexes and validity checks to a table of
  378.     a different name.  NOTE: If used on a SQL table, only the table
  379.     itself is copied.
  380. }
  381. procedure TTableEnhanced.CopyTable(DName: String);
  382. var
  383.  pSName: array[0..dbiMaxPathLen] of char;
  384.  pDName: array[0..dbiMaxPathLen] of char;
  385.  pTblType: array[0..dbiMaxPathLen] of char;
  386.  
  387. begin
  388.   Chk(DbiCopyTable(DBHandle, FOverwrite, StrPCopy(pSName, TableName),
  389.                    StrCopy(pTblType, GetTableType),
  390.                    StrPCopy(pDName, DName)));
  391. end;
  392.  
  393. { METHOD: InitializeBuffer
  394.   PURPOSE: Creates a record(s) buffer.  The buffer can be up to 64k
  395.     and then can be used with WriteBlock to place multiple records into
  396.     the table.
  397. }
  398. procedure TTableEnhanced.InitializeBuffer;
  399. var
  400.   W: Word;
  401.   RecordBufferSize: Longint;
  402.  
  403. begin
  404.   { Determine the buffer size that is needed }
  405.   RecordBufferSize := RecordSize * FBlockSize;
  406.   { If it is bigger than 64k, raise an exception }
  407.   if RecordBufferSize > 65535 then
  408.     raise EEnhDBBufferTooBig.Create('Attempt to allocate a buffer ' +
  409.                                    'greater than 64k');
  410.   { Allocate the record buffer }
  411.   GetMem(pRecBuf, RecordBufferSize);
  412.   { pRecBuf will ALWAYS point to the beginning of the record buffer.
  413.     Use pTmpRecBuf to fill the record buffer with field information. }
  414.   pTmpRecBuf := pRecBuf;
  415.   { After the buffer has been allocated, "empty" the record buffer }
  416.   for W := 1 to FBlockSize do
  417.   begin
  418.     Chk(DbiInitRecord(Handle, pTmpRecBuf));
  419.     Inc(pTmpRecBuf, RecordSize);
  420.   end;
  421.   pTmpRecBuf := pRecBuf;
  422. end;
  423.  
  424. { METHOD: UninitializeBuffer
  425.   PURPOSE: Frees up the memory allocated for the record buffer.  NOTE: it
  426.     is important that the BlockSize is not changed between the
  427.     InitializeBuffer call and the WriteBlock, InsertFast, or AppendFast.
  428.     This may cause a GP Fault to occur.
  429. }
  430. procedure TTableEnhanced.UninitializeBuffer;
  431. begin
  432.   FreeMem(pRecBuf, RecordSize * FBlockSize);
  433. end;
  434.  
  435. { METHOD: InsertFast
  436.   PURPOSE: Inserts a new record into the table.  This method should be
  437.     used on a table that is opened on an index.  NOTE: Even if you have
  438.     allocated and filled more than one record in the record buffer, only
  439.     the first record in the buffer will be inserted into the table.
  440.     NOTE: A word of caution; if you lock the inserted record, be sure to
  441.       release it when processing is done.  Use method ReleaseRecordLock.
  442. }
  443. procedure TTableEnhanced.InsertFast;
  444. begin
  445.   { Insert the record using the appropriate record locking }
  446.   case InsertMode of
  447.     imNoLock:
  448.       Chk(DbiInsertRecord(Handle, dbiNoLock, pRecBuf));
  449.     imReadLock:
  450.       Chk(DbiInsertRecord(Handle, dbiReadLock, pRecBuf));
  451.     imWriteLock:
  452.       Chk(DbiInsertRecord(Handle, dbiWriteLock, pRecBuf));
  453.   end;
  454.   { If SaveToDisk is True, write the buffered record to disk. }
  455.   if FSaveToDisk = True then
  456.     Chk(DbiSaveChanges(Handle));
  457.   { Free up the allocated record buffer }
  458.   UninitializeBuffer;
  459. end;
  460.  
  461. { METHOD: AppendFast
  462.   PURPOSE: Append the record to the table.  It is reccommended only for
  463.     table which do not have a currently active index.  If an index is
  464.     active, use InsertFast.  NOTE: Even if you have allocated and filled
  465.     more than one record in the record buffer, only the first record in
  466.     the buffer will be appended into the table.
  467. }
  468. procedure TTableEnhanced.AppendFast;
  469. begin
  470.   { Append the record }
  471.   Chk(DbiAppendRecord(Handle, pRecBuf));
  472.   { If SaveToDisk is True, write the buffered record to disk. }
  473.   if FSaveToDisk = True then
  474.     Chk(DbiSaveChanges(Handle));
  475. end;
  476.  
  477. { METHOD: InitTimeStampField
  478.   PURPOSE: Writes a a TimeStamp field value to the correct location in
  479.     the specified record buffer.
  480. }
  481. procedure TTableEnhanced.InitTimeStampField(Field: Word; Data: TDateTime);
  482. var
  483.   H, Min, S, MS: Word;
  484.   TheTime: DbiTypes.Time;
  485.   Y, M, D: Word;
  486.   TheDate: DbiTypes.Date;
  487.   TheTimeStamp: DbiTypes.TimeStamp;
  488.  
  489. begin
  490.   { Make sure that the field is of type ftDateTime }
  491.   if Fields[Field].DataType <> ftDateTime then
  492.     raise EEnhDBWrongType.Create(
  493.       Format('Field %d: "%s", incomaptible type.', [Field, Fields[Field].FieldName]))
  494.   else
  495.   begin
  496.     { A conversion from the Delphi Date and Time format to the BDE Date
  497.       and Time format must occur }
  498.     DecodeTime(Data, H, Min, S, MS);
  499.     DecodeDate(Data, Y, M, D);
  500.     Chk(DbiTimeEncode(H, Min, (S * 1000), TheTime));
  501.     Chk(DbiDateEncode(M, D, Y, TheDate));
  502.     Chk(DbiTimeStampEncode(TheDate, TheTime, TheTimeStamp));
  503.     { Place the Timestamp in the corrisponding field in the record buffer }
  504.     Chk(DbiPutField(Handle, Field + 1, pTmpRecBuf, @TheTimeStamp));
  505.   end;
  506. end;
  507.  
  508. { METHOD: InitTimeField
  509.   PURPOSE: Writes a Time field value to the correct location in
  510.     the specified record buffer.
  511. }
  512. procedure TTableEnhanced.InitTimeField(Field: Word; Data: TDateTime);
  513. var
  514.   H, M, S, MS: Word;
  515.   TheTime: dbiTypes.Time;
  516.  
  517. begin
  518.   { Make sure that the field is of type ftTime }
  519.   if Fields[Field].DataType <> ftTime then
  520.     raise EEnhDBWrongType.Create(
  521.       Format('Field %d: "%s", incomaptible type.', [Field, Fields[Field].FieldName]))
  522.   else
  523.   begin
  524.     { A conversion from the Delphi Time format to the BDE Time
  525.       format must occur }
  526.     DecodeTime(Data, H, M, S, MS);
  527.     Chk(DbiTimeEncode(H, M, (S * 1000), TheTime));
  528.     { Place the Time in the corrisponding field in the record buffer }
  529.     Chk(DbiPutField(Handle, Field + 1, pTmpRecBuf, @TheTime));
  530.   end;
  531. end;
  532.  
  533. { METHOD: InitDateField
  534.   PURPOSE: Writes a Date field value to the correct location in
  535.     the specified record buffer.
  536. }
  537. procedure TTableEnhanced.InitDateField(Field: Word; Data: TDateTime);
  538. var
  539.   Y, M, D: Word;
  540.   TheDate: DbiTypes.Date;
  541. begin
  542.  
  543.   { Make sure that the field is of type ftDate }
  544.   if Fields[Field].DataType <> ftDate then
  545.     raise EEnhDBWrongType.Create(
  546.       Format('Field %d: "%s", incomaptible type.', [Field, Fields[Field].FieldName]))
  547.   else
  548.   begin
  549.     { A conversion from the Delphi Date format to the BDE Date
  550.       format must occur }
  551.     DecodeDate(Data, Y, M, D);
  552.     Chk(DbiDateEncode(M, D, Y, TheDate));
  553.     { Place the Date in the corrisponding field in the record buffer }
  554.     Chk(DbiPutField(Handle, Field + 1, pTmpRecBuf, @TheDate));
  555.   end;
  556. end;
  557.  
  558. { METHOD: InitBooleanField
  559.   PURPOSE: Writes a Boolean field value to the correct location in
  560.     the specified record buffer.
  561. }
  562. procedure TTableEnhanced.InitBooleanField(Field: Word; Data: Boolean);
  563. begin
  564.   { Make sure that the field is of type ftBoolean }
  565.   if Fields[Field].DataType <> ftBoolean then
  566.     raise EEnhDBWrongType.Create(
  567.       Format('Field %d: "%s", incomaptible type.', [Field, Fields[Field].FieldName]))
  568.   else
  569.     { Place the Boolean in the corrisponding field in the record buffer }
  570.     Chk(DbiPutField(Handle, Field + 1, pTmpRecBuf, @Data));
  571. end;
  572.  
  573. { METHOD: InitIntegerField
  574.   PURPOSE: Writes a Integer field value to the correct location in
  575.     the specified record buffer.
  576. }
  577. procedure TTableEnhanced.InitIntegerField(Field: Word; Data: Longint);
  578. begin
  579.   { Make sure that the field is of type ftInteger }
  580.   if Fields[Field].DataType <> ftInteger then
  581.     raise EEnhDBWrongType.Create(
  582.       Format('Field %d: "%s", incomaptible type.', [Field, Fields[Field].FieldName]))
  583.   else
  584.     { Place the Integer in the corrisponding field in the record buffer }
  585.     Chk(DbiPutField(Handle, Field + 1, pTmpRecBuf, @Data));
  586. end;
  587.  
  588. { METHOD: InitSmallintField
  589.   PURPOSE: Writes a Smallint field value to the correct location in
  590.     the specified record buffer.
  591. }
  592. procedure TTableEnhanced.InitSmallintField(Field: Word; Data: Integer);
  593. begin
  594.   { Make sure that the field is of type ftSmallint }
  595.   if Fields[Field].DataType <> ftSmallint then
  596.     raise EEnhDBWrongType.Create(
  597.       Format('Field %d: "%s", incomaptible type.', [Field, Fields[Field].FieldName]))
  598.     else
  599.       { Place the Smallint in the corrisponding field in the record buffer }
  600.       Chk(DbiPutField(Handle, Field + 1, pTmpRecBuf, @Data));
  601. end;
  602.  
  603. { METHOD: InitCurrencyField
  604.   PURPOSE: Writes a Currency field value to the correct location in
  605.     the specified record buffer.
  606. }
  607. procedure TTableEnhanced.InitCurrencyField(Field: Word; Data: Double);
  608. begin
  609.   { Make sure that the field is of type ftCurrency }
  610.   if Fields[Field].DataType <> ftCurrency then
  611.     raise EEnhDBWrongType.Create(
  612.       Format('Field %d: "%s", incomaptible type.', [Field, Fields[Field].FieldName]))
  613.     else
  614.       { Place the Currency in the corrisponding field in the record buffer }
  615.       Chk(DbiPutField(Handle, Field + 1, pTmpRecBuf, @Data));
  616. end;
  617.  
  618. { METHOD: InitFloatField
  619.   PURPOSE: Writes a Float field value to the correct location in
  620.     the specified record buffer.
  621. }
  622. procedure TTableEnhanced.InitFloatField(Field: Word; Data: Double);
  623. begin
  624.   { Make sure that the field is of type ftFloat }
  625.   if Fields[Field].DataType <> ftFloat then
  626.     raise EEnhDBWrongType.Create(
  627.       Format('Field %d: "%s", incomaptible type.', [Field, Fields[Field].FieldName]))
  628.   else
  629.     { Place the Float in the corrisponding field in the record buffer }
  630.     Chk(DbiPutField(Handle, Field + 1, pTmpRecBuf, @Data));
  631. end;
  632.  
  633. { METHOD: InitStringField
  634.   PURPOSE: Writes a String field value to the correct location in
  635.     the specified record buffer.
  636. }
  637. procedure TTableEnhanced.InitStringField(Field: Word; Data: String);
  638. var
  639.   pData: pByte;
  640.  
  641. begin
  642.   { Make sure that the field is of type ftString }
  643.   if Fields[Field].DataType <> ftString then
  644.     raise EEnhDBWrongType.Create(
  645.       Format('Field %d: "%s", incomaptible type.', [Field, Fields[Field].FieldName]))
  646.   else
  647.   begin
  648.     { Make sure that the data to be inserted is not longer than
  649.       the field's length }
  650.     if Length(Data) > Fields[Field].DataSize then
  651.       raise EEnhDBWrongType.Create(
  652.         Format('String to be inserted is longer than field %d: "%s".',
  653.                [Field, Fields[Field].FieldName]))
  654.     else
  655.     begin
  656.       GetMem(pData, Fields[Field].DataSize);
  657.       StrPCopy(pChar(pData), Data);
  658.       { Place the String in the corrisponding field in the record buffer }
  659.       Chk(DbiPutField(Handle, Field + 1, pTmpRecBuf, pData));
  660.       FreeMem(pData, Fields[Field].DataSize);
  661.     end;
  662.   end;
  663. end;
  664.  
  665. { METHOD: GetBlockTotal
  666.   PURPOSE: Retrieve the amount of records to be inserted when using
  667.     method WriteBlock.
  668. }
  669. function TTableEnhanced.GetBlockTotal: Longint;
  670. begin
  671.   GetBlockTotal := FBlockTotal;
  672. end;
  673.  
  674. { METHOD: SetBlockTotal
  675.   PURPOSE: Set amount of records to be inserted when using
  676.     method WriteBlock.
  677. }
  678. procedure TTableEnhanced.SetBlockTotal(Amount: Longint);
  679. begin
  680.   if Amount <> FBlockTotal then
  681.   begin
  682.     { Warn user if an attempt to set below one is made }
  683.     if Amount <= 0 then
  684.       MessageDlg('BlockTotal must be greater than 1', mtError, [mbOk], 0)
  685.     else
  686.     begin
  687.       FBlockTotal := Amount;
  688.       { If the BlockSize is greater than the block total, set the
  689.         BlockSize equal to the BlockTotal }
  690.       if FBlockTotal < FBlockSize then
  691.         FBlockSize := FBlockTotal;
  692.     end;
  693.   end;
  694. end;
  695.  
  696. { METHOD: GetBlockSize
  697.   PURPOSE: Retrieve the size of the record buffer to be used with
  698.     WriteBlock.  NOTE: If using AppendFast ot InsertFast, Set the
  699.     BlockSize equal to one before initializing the buffer.
  700. }
  701. function TTableEnhanced.GetBlockSize: Longint;
  702. begin
  703.   GetBlockSize := FBlockSize;
  704. end;
  705.  
  706. { METHOD: SetBlockSize
  707.   PURPOSE: Set size of the record buffer to be used with
  708.     WriteBlock. NOTE: If using AppendFast ot InsertFast, Set the
  709.     BlockSize equal to one before initializing the buffer.
  710. }
  711. procedure TTableEnhanced.SetBlockSize(Size: Longint);
  712. begin
  713.   { Warn user if an attempt to set below one is made }
  714.   if Size <= 0 then
  715.     MessageDlg('BlockSize must be greater than 1', mtError, [mbOk], 0)
  716.   else
  717.     { If the BlockSize is greater than the BlockTotal, set the BlockSize
  718.       to BlockTotal }
  719.     if Size > FBlockTotal then
  720.       FBlockSize := FBlockTotal
  721.     else
  722.       FBlockSize := Size;
  723. end;
  724.  
  725. { METHOD: WriteBlock
  726.   PURPOSE: Write a block of records to a table.  Return False if not
  727.     all records specified in BlockTotal have been added to the table.
  728. }
  729. function TTableEnhanced.WriteBlock: Boolean;
  730. begin
  731.   if (FBlockTotal - FRecordsAdded) < FBlockSize then
  732.     FBlockSize := (FBlockTotal - FRecordsAdded)
  733.   else
  734.     WriteBlock := False;
  735.   { Write the block of records to the table }
  736.   Chk(DbiWriteBlock(Handle, FBlockSize, pRecBuf));
  737.   Inc(FRecordsAdded, FBlockSize);
  738.   if FRecordsAdded >= FBlockTotal then
  739.   begin
  740.     WriteBLock := True;
  741.     FRecordsAdded := 0;
  742.   end;
  743.   { Free up the record buffer that has been allocated }
  744.   UnInitializeBuffer;
  745. end;
  746.  
  747. { METHOD: GetTableType
  748.   PURPOSE: Return the type of table that is currently open: either
  749.     PARADOX or DBASE.
  750. }
  751. function TTableEnhanced.GetTableType: PChar;
  752. var
  753.   { FCurProp Holds information about the structure of the table }
  754.   FCurProp: CurProps;
  755.  
  756. begin
  757.   { Find out what type of table is currently opened.  NOTE: This is
  758.     different than TTablePack.TableType }
  759.   Chk(DbiGetCursorProps(Handle, FCurProp));
  760.   GetTableType := FCurProp.szTableType;
  761. end;
  762.  
  763. { METHOD: Pack
  764.   PURPOSE: Check to see which table is opened and than call the
  765.     appropriate table packing method.  NOTE: This only works with
  766.     Paradox and dBase tables.
  767. }
  768. procedure TTableEnhanced.Pack;
  769. var
  770.   TType: array[0..40] of char;
  771.  
  772. begin
  773.   { The table must be opened to get directory information about the table
  774.     before closing }
  775.   if Active <> True then
  776.     raise EEnhDBTblNotOpen.Create('Table must be opened to be packed');
  777.   { Get the type of table }
  778.   strcopy(TType, GetTableType);
  779.   if strcomp(TType, szParadox) = 0 then
  780.     { Call PackParadoxTable procedure if PARADOX table }
  781.     PackParadoxTable
  782.   else
  783.     if strcomp(TType, szDBase) = 0 then
  784.       { Call PackDBaseTable procedure if dBase table }
  785.       PackDBaseTable
  786.     else
  787.       { PARADOX and dBase table are the only types that can be packed }
  788.       raise EEnhDBIncorrectType.Create('Incorrect table type: ' +
  789.                                           StrPas(TType));
  790. end;
  791.  
  792. { METHOD: PackParadoxTable
  793.   PURPOSE: Pack the currently opened paradox table.
  794. }
  795. procedure TTableEnhanced.PackParadoxTable;
  796. var
  797.   { Specific information about the table structure, indexes, etc. }
  798.   TblDesc: CRTblDesc;
  799.   { Uses as a handle to the database }
  800.   hDb: hDbiDb;
  801.   { Path to the currently opened table }
  802.   TablePath: array[0..dbiMaxPathLen] of char;
  803.  
  804. begin
  805.   hDb := nil;
  806.   { Initialize the table descriptor }
  807.   FillChar(TblDesc, SizeOf(CRTblDesc), 0);
  808.   with TblDesc do
  809.   begin
  810.     { Place the table name in descriptor }
  811.     StrPCopy(szTblName, TableName);
  812.     { Place the table type in descriptor }
  813.     StrCopy(szTblType, GetTableType);
  814.     { Set the packing option to true }
  815.     bPack := True;
  816.   end;
  817.   { Get the current table's directory.  This is why the table MUST be
  818.     opened until now }
  819.   Chk(DbiGetDirectory(DBHandle, True, TablePath));
  820.   { Close the table }
  821.   Close;
  822.   { NOW: since the DbiDoRestructure call needs a valid DB handle BUT the
  823.     table cannot be opened, call DbiOpenDatabase to get a valid handle.
  824.     Setting TTable.Active = FALSE does not give you a valid handle }
  825.   Chk(DbiOpenDatabase(nil, 'STANDARD', dbiReadWrite, dbiOpenExcl, nil,
  826.                         0, nil, nil, hDb));
  827.   { Set the table's directory to the old directory }
  828.   Chk(DbiSetDirectory(hDb, TablePath));
  829.   { Pack the PARADOX table }
  830.   Chk(DbiDoRestructure(hDb, 1, @TblDesc, nil, nil, nil, FALSE));
  831.   { Close the temporary database handle }
  832.   Chk(DbiCloseDatabase(hDb));
  833.   { Re-Open the table }
  834.   Open;
  835. end;
  836.  
  837. { METHOD: PackDBaseTable
  838.   PURPOSE: Pack the currently opened dBase table.
  839. }
  840. procedure TTableEnhanced.PackDBaseTable;
  841. begin
  842.   { Pack the dBase Table }
  843.   Chk(DbiPackTable(DBHandle, Handle, nil, nil, True));
  844. end;
  845.  
  846. { METHOD: ReleaseRecordLock
  847.   PURPOSE: Release a lock on a record.  If All is set to True, realease
  848.     all record locks on the table.  If All is set to False, release
  849.     the lock on the current record only.
  850. }
  851. procedure TTableEnhanced.ReleaseRecordLock(All: Boolean);
  852. begin
  853.   if All = True then
  854.     Chk(DbiRelRecordLock(Handle, True))
  855.   else
  856.     Chk(DbiRelRecordLock(Handle, False));
  857. end;
  858.  
  859. end.
  860.