Tag: paradox

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;