[SvenSoft]

Добрый день. Пытаюсь упаковать таблицу DBF таким образом :

Код:

procedure PackTable2(param_1: olevariant);
var
  DB: TDBF;
 
begin
 
  //---------- проверим на существование файла, и если не найдем, не будем ничего создавать ----------
  if not FileExists(param_1) then Exit;
 
  //---------- создадим экземпляр TDBF ----------
  DB := TDBF.Create(nil);
 
  try
 
   //---------- откроем файл DBF ----------
   DB.TableName := param_1;
   DB.Exclusive := False;
   //DB.Active := True; // так тоже пробовал, вместо DB.Open;
   DB.Open;
 
   //---------- пакуем таблицу -----------
   DB.PackTable; // на этом моменте возникает трабл.
 
   //---------- закрываем таблицу --------
   DB.Close;
 
  finally
 
   DB.Free;
 
  end;
 
end;

При попытке упаковать таблицу данной процедурой, выдает ошиблку, доходя до метода DB.PackTable;
Что делаю не так, подскажите пожайлуста ?..
подумал что надо к свойству DB.Exclusive := True; применить, но тогда на методе DB.Open; ошибка выскакивает. Почему, не понятно .
Можно сказать, что проблема наверное больше в том, что при установке свойства DB.Exclusive := True; (установка этого свойства дает возможность отпработать без ошибок DB.PackTable; ), не могу открыть файл DB.Open; . Подскажите почему ?

[NumLock]

Код:

unit Unit1;

interface

uses
  Bde,
  DbConsts,
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  Db, DBTables;

type
  TForm1 = class(TForm)
    Table1: TTable;
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

procedure _DBError(const Msg: string);
begin
  DatabaseError(Msg);
end;

procedure PackTable(Table: TTable);
{ This routine copied and modified from demo unit TableEnh.pas
  from Borland Int. }
var
  { FCurProp holds information about the structure of the table }
  FCurProp: CurProps;
  { 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;
  Exclusive: Boolean;
begin
  if not Table.Active then _DBError(SDataSetClosed);
  Check(DbiGetCursorProps(Table.Handle, FCurProp));
  if StrComp(FCurProp.szTableType, szParadox) = 0 then begin
    { Call DbiDoRestructure procedure if PARADOX table }
    hDb := nil;
    { Initialize the table descriptor }
    FillChar(TblDesc, SizeOf(CRTblDesc), 0);
    with TblDesc do begin
      { Place the table name in descriptor }
      StrPCopy(szTblName, Table.TableName);
      { Place the table type in descriptor }
      StrCopy(szTblType, FCurProp.szTableType);
      bPack := True;
      bProtected := FCurProp.bProtected;
    end;
    { Get the current table's directory. This is why the table MUST be
      opened until now }
    Check(DbiGetDirectory(Table.DBHandle, False, TablePath));
    { Close the table }
    Table.Close;
    try
      { 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 }
      Check(DbiOpenDatabase(nil, szCFGDBSTANDARD, dbiReadWrite, dbiOpenExcl, nil,
        0, nil, nil, hDb));
      { Set the table's directory to the old directory }
      Check(DbiSetDirectory(hDb, TablePath));
      { Pack the PARADOX table }
      Check(DbiDoRestructure(hDb, 1, @TblDesc, nil, nil, nil, False));
      { Close the temporary database handle }
      Check(DbiCloseDatabase(hDb));
    finally
      { Re-Open the table }
      Table.Open;
    end;
  end
  else if StrComp(FCurProp.szTableType, szDBase) = 0 then begin
    { Call DbiPackTable procedure if dBase table }
    Exclusive := Table.Exclusive;
    Table.Close;
    try
      Table.Exclusive := True;
      Table.Open;
      try
        Check(DbiPackTable(Table.DBHandle, Table.Handle, nil, nil, True));
      finally
        Table.Close;
      end;
    finally
      Table.Exclusive := Exclusive;
      Table.Open;
    end;
  end
  else DbiError(DBIERR_WRONGDRVTYPE);
end;

end.