急急急！，用ADO来实现对VF数据库的PACK操作??

Question

unit Unit1;interfaceuses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, DB,DBTables,DBConsts, DbiProcs, DbiErrs, Buttons,
  ExtCtrls,filectrl;type
  TForm1 = class(TForm)
    Panel1: TPanel;
    StaticText1: TStaticText;
    Edit1: TEdit;
    Label1: TLabel;
    Button1: TButton;
    SpeedButton1: TSpeedButton;
    Button2: TButton;
    procedure SpeedButton1Click(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;var
  Form1: TForm1;
procedure PackTable(Table:TTable);
procedure undelete(table:Ttable);
procedure BatchPackTable(const sCurrentPath: string);
procedure Batchundelete(const sCurrentPath: string);
implementation{$R *.DFM}//PackTable过程给单个.dbf数据表作优化
procedure PackTable(Table: TTable);
var
Props:CURProps;
begin
if not Table.Active then
  raise EDatabaseError.Create('数据表必需已经打开');
if not Table.Exclusive then
  raise EDatabaseError.Create('数据表必需以独占方式打开');
  Check(DbiGetCursorProps(Table.Handle, Props));
if (Props.szTableType = szDBASE) then
  Check(DbiPackTable(Table.DBHandle, Table.Handle, nil, szDBASE, True))
else
  raise EDatabaseError.Create('Table必需是dBASE或FoxPro类型');
  Table.Open;
end;//undelete过程给单个.dbf数据表反删除
procedure undelete(table:Ttable);
var
  CProps: CurProps;
  rslt:DBIResult;
  bm:TBook;
  rp:pRECProps;
begin
  Check(DbiGetCursorProps(table.Handle, CProps));
    //取得数据表的属性
if (StrIComp(CProps.szTableType, szDBASE) <> 0) then
 raise EDBEngineError.Create(DBIERR_NOTSUPPORTED);
   //如果不是Dbase或Foxpro则引起EDBEngineError 异常
  rslt:=DbiValidateProp(hDBIObj(table.Handle), curSOFTDELETEON, True);
  //可否设置软删除
if (rslt = DBIERR_NONE) then
  Check(DbiSetProp(hDBIObj(table.Handle), curSOFTDELETEON, Longint(true)));
  //设置为可以软删除
  Check(DbiGetCursorProps(table.Handle, CProps));
  //更新数据表的属性
if (CProps.bDeletedOn = False) then
  raise EDatabaseError.Create('数据表没有软删除标志！');
  //取得当前的记录位置
  bm:=table.GetBook;
  //将游标移动到第一个记录以前。注意不是Table.First!
  Check(DbiSetTobegin(table.handle));
  //不断移动，直到到数据表的最后记录
while (DBIGETNEXTRECORD(table.handle,dbinolock,nil,nil)=DBIERR_NONE) do
begin
 try
  check(DbiUndeleteRecord(table.Handle));
 except
  //屏蔽任何异常
 end;
end;
//取回原先记录的位置，重新定位
  table.GotoBook(bm);
  table.FreeBook(bm);
end;//BatchPackTable给一个目录及其子目录下的所有.dbf数据库优化
procedure BatchPackTable(const sCurrentPath: string);
var
  SearchRec: TSearchRec;
  iFindResult:integer;
  tblBeUndelete: TTable;
begin
  iFindResult := FindFirst(sCurrentPath + '*.dbf', faAnyFile, SearchRec);
  while iFindResult = 0 do
  begin
    form1.label1.Caption := '正在优化: ' + SearchRec.Name;
    form1.label1.Refresh;
    Application.ProcessMessages;
    tblBeUndelete :=TTable.Create(form1);
    Application.ProcessMessages;
    with tblBeUndelete do
    begin
      DatabaseName := sCurrentPath;
      TableName := SearchRec.Name;
      TableType := ttDBase;
      Exclusive := True;
      Open;
      Application.ProcessMessages;
      PackTable(tblBeUndelete);
      Application.ProcessMessages;
      Close;
      Free;
    end;
    Application.ProcessMessages;
    iFindResult := FindNext(SearchRec);
   end;  (* 向下搜寻子目录 *)
  iFindResult := FindFirst(sCurrentPath + '*.', faDirectory, SearchRec);
  while iFindResult = 0 do
  begin
    Application.ProcessMessages;
    if (SearchRec.Name[1] <> '.') then
    begin
      BatchPackTable(sCurrentPath + SearchRec.Name + '\');
    end;
    iFindResult := FindNext(SearchRec);
  end;
end;//Batchundelete给一个目录及其子目录下的所有.dbf数据库反删除
procedure Batchundelete(const sCurrentPath: string);
var
  SearchRec: TSearchRec;
  iFindResult:integer;
  tblBePack: TTable;
begin
  iFindResult := FindFirst(sCurrentPath + '*.dbf', faAnyFile, SearchRec);
  while iFindResult = 0 do
  begin
    form1.label1.Caption := '正在反删除: ' + SearchRec.Name;
    form1.label1.Refresh;
    Application.ProcessMessages;
    tblBePack :=TTable.Create(form1);
    Application.ProcessMessages;
    with tblBePack do
    begin
      DatabaseName := sCurrentPath;
      TableName := SearchRec.Name;
      TableType := ttDBase;
      Exclusive := True;
      Open;
      Application.ProcessMessages;
      undelete(tblBePack);
      Application.ProcessMessages;
      Close;
      Free;
    end;
    Application.ProcessMessages;
    iFindResult := FindNext(SearchRec);
   end;  (* 向下搜寻子目录 *)
  iFindResult := FindFirst(sCurrentPath + '*.', faDirectory, SearchRec);
  while iFindResult = 0 do
  begin
    Application.ProcessMessages;
    if (SearchRec.Name[1] <> '.') then
    begin
      Batchundelete(sCurrentPath + SearchRec.Name + '\');
    end;
    iFindResult := FindNext(SearchRec);
  end;
end;procedure TForm1.SpeedButton1Click(Sender: TObject);
var
 Dir:string;
begin
  Dir:= 'C:\Demo';
  if SelectDirectory(Dir, [sdAllowCreate, sdPerformCreate, sdPrompt],0) then
    edit1.text:= Dir;
end;procedure TForm1.Button1Click(Sender: TObject);
begin
try
  BatchPackTable(edit1.text+'\');
  label1.caption:='优化结束！';
except
  label1.caption:='优化过程中出错！';
end;end;procedure TForm1.Button2Click(Sender: TObject);
begin
try
  batchundelete(edit1.text+'\');
  label1.caption:='反删除完成';
except
  label1.caption:='反删除过程出错！';
end;
end;end.
************************************
你自已看看吧，应该没有问题的吧