رصّ ملفات قواعد البيانات Packing Database Files

نحتاج بين فترة وأخرى إلى رصّ ملفات قواعد البيانات لـParadox و dBase والتي تستخدم عملية الحذف السطحي Soft Deletion للسجلات ولإعادة تنظيم الملف

بشكل عام مما يقلل من خطر تعرّضه للمشاكل، فيما يلي الإجراء المستخدم لذلك وطريقة استخدامه.

procedure TForm1.PackTable(Sender: TObject; TabName: PChar);
var
  hDb       :hDBIDb;
  hCursor   :hDBICur;
  dbResult  :DBIResult;
  PdxStruct :CRTblDesc;
begin

{Initialize the BDE.}
dbResult := DbiInit(nil);
Check(dbResult);

{Open a Database.}
dbResult := DbiOpenDatabase('', 'STANDARD', dbiREADONLY, 
                                              dbiOPENSHARED,'', 0,nil,nil,hDB);

try
  {Check raises an exception if the BDE call returns an error 
   code other than DBIERR_NONE.
   The DBTables unit must be in the uses clause to use Check.
   In Delphi 2 this procedure is located in the DB unit.}
  Check(dbResult);
except
  DbiExit;
  raise
end;

{Open a table. This returns a handle to the table's
cursor, which is required by many of the BDE calls.}
dbResult := DbiOpenTable(hDB, TabName, '', '', '', 0, 
                         dbiREADWRITE, dbiOPENEXCL,
                         xltNONE, False, nil, hCursor);
try
  Check(dbResult);
except
  DbiCloseDatabase(hDB);
  DbiExit;
  raise
end;
try
  Panel1.Caption := 'Packing '+ FileListBox1.FileName;
  Application.ProcessMessages;
  if AnsiUpperCase(ExtractFileExt(FileListBox1.FileName)) = '.DB' then begin
    {Close the Paradox table cursor handle.}
    DbiCloseCursor(hCursor);
    {The method DoRestructure requires a pointer to a record
    object of the type CRTblDesc. Initialize this record.}
    FillChar(PdxStruct, SizeOf(CRTblDesc),0);
    StrPCopy( PdxStruct.szTblName,FileListBox1.Filename);
    PdxStruct.bPack := True;
    dbResult := DbiDoRestructure(hDB, 1, @PdxStruct, nil, nil, nil, False);
    if dbResult = DBIERR_NONE then
      Panel1.Caption := 'Table successfully packed'
    else Panel1.Caption := 'Failure: error '+IntTostr(dbResult);
  end else begin
    {Packing a dBASE table is much easier.}
    dbResult := DbiPackTable(hDB, hCursor,'','',True);
    if dbResult = DBIERR_NONE then
      Panel1.Caption := 'Table successfully packed'
    else Panel1.Caption := 'Failure: error '+IntTostr(dbResult);
  end;
finally
  DbiCloseCursor(hCursor);
  DbiCloseDatabase(hDB);
  DbiExit;
end;
procedure TForm1.Button1Click(Sender: TObject);
var
  Tab: PChar;
begin
  if FileListbox1.FileName = '' then begin
    MessageDlg('No table select',mtError,[mbOK],0);
    Exit;
  end;

  GetMem(Tab,144);
  try
    StrPCopy(Tab,FileListBox1.FileName);
    PackTable(Sender,Tab);
  finally
    Dispose(tab);
  end;
end;

ملاحظة لمم تتح لي الفرصة لتجربة الكود

نسيت

uses BDE;