Posts Tagged ‘pack table’

pack table (Paradox, dBase)

Tuesday, September 2nd, 2008

If you use the TTable component in Delphi then to find the code to pack the table (to remove the records which are marked as deleted) is not a problem. For example:
http://www.swissdelphicenter.ch/torry/showcode.php?id=35

But how to pack the table using pure BDE API? What if you do not want to use the TTable/TDatabase components?

Today I wrote the next code for this task:

uses BDE; 
 
procedure TfrmMain.piPackTableClick(Sender: TObject); 
 
  procedure DbiError(ErrorCode: DBIResult); 
  begin 
    raise Exception.CreateFmt('BDE Error Code: %x', [ErrorCode]); 
  end; 
 
  procedure Check(Status: DBIResult); 
  begin 
    if Status <> 0 then DbiError(Status); 
  end; 
 
  function StrToOem(const AnsiStr: string): string; 
  begin 
    SetLength(Result, Length(AnsiStr)); 
    if Length(Result) > 0 then 
      CharToOem(PChar(AnsiStr), PChar(Result)); 
  end; 
 
var 
  hDatabase: hDbiDb; 
  hTableCursor: hDbiCur; 
  TableDesc: CRTblDesc; 
begin 
  { check if BDE installed } 
  Check(dbiInit(nil));  
 
  { Open a database session with exclusive read/write access } 
  Check(DbiOpenDatabase('',  
                        nil, // database type (Standard) 
                        dbiReadWrite, // open mode (versus read-only) 
                        dbiOpenExcl, // exclusive (versus shared) 
                        nil, // database login password 
                        0, nil, nil, 
                        hDatabase)); 
  try 
    Check(DbiSetDirectory(hDatabase, Pointer(StrToOem(ExtractFilePath(cbFileName.Text)))));  
 
    { Open the table, returning its cursor handle } 
    Check(DbiOpenTable(hDatabase, 
          PChar(ExtractFileName(cbFileName.Text)), 
  {$IFDEF DB_PARADOX} 
          szParadox, 
  {$ENDIF}  
 
  {$IFDEF DB_DBASE} 
          szDBASE, 
  {$ENDIF} 
 
          nil, nil, 0, // no result index required 
          dbiReadOnly, dbiOpenShared, 
          xltField, // use logical field types (normal) 
          False, nil, 
          hTableCursor)); 
 
  {$IFDEF DB_PARADOX} 
    FillChar(TableDesc, SizeOf(CRTblDesc), #0); 
    with TableDesc do 
    begin 
      StrCopy(szTblName, PChar(ExtractFileName(cbFileName.Text))); 
      StrCopy(szTblType, szParadox); 
      bPack := True; 
    end; 
    Check(DbiCloseCursor(hTableCursor)); 
    Check(DbiDoRestructure(hDatabase, 1, @TableDesc, nil, nil, nil, False)); 
  {$ENDIF}  
 
  {$IFDEF DB_DBASE} 
    Check(DbiPackTable(hDatabase, hTableCursor, nil, szDBASE, True)) 
    Check(DbiCloseCursor(hTableCursor)); 
  {$ENDIF} 
  finally 
    Check(DbiCloseDatabase(hDatabase)); 
  end; 
end;