如何 Pack dBASE资料档

如何 Pack dBASE资料档

小弟有一个 TTable 的 .DBF

，可是时间一久就愈来愈大了，却找不到有 Pack>这样的函数请问有可办法解决，谢谢

　

我从 DChat.exe 的原始程式中截出一段程式来,

您可以参考看看其中 pack 的作法. 当时我用递回的方法, 将指定目录(含子目录)中的

dbf 全部 pack 一遍.

DChat.Exe DelphiChat 讨论资料库的原始程式您可以在Delphi学习笔记(创作篇)中找到

{ Delphi 1.0

uses ..., DB, DBTables, DBConsts, DbiTypes, DbiProcs, DbiErrs, ..

}

(*--------------------------------------------------*)

(* PACK 资料库

(*

(*

(*--------------------------------------------------*)

procedure TfrmMain.DoPackTable(const sCurrentPath: string);

var

SearchRec: TSearchRec;

iFindResult: integer;

tblBePack: TTable;

begin

iFindResult := FindFirst(sCurrentPath + '*.DBF', faAnyFile, SearchRec);

while iFindResult = 0 do

begin

frmWait.lblPrompt.Caption := 'Packing: ' + SearchRec.Name;

frmWait.lblPrompt.Refresh;

Application.ProcessMessages;

tblBePack := TTable.Create(Self);

Application.ProcessMessages;

with tblBePack do

begin

DatabaseName := sCurrentPath;

TableName := SearchRec.Name;

TableType := ttDBase;

Exclusive := True;

Open;

Application.ProcessMessages;

DbiPackTable(DBHandle, Handle, nil, nil, True);

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 <> '.') and

(gsTempDir <> sCurrentPath + SearchRec.Name + '\') then

begin

DoPackTable(sCurrentPath + SearchRec.Name + '\');

end;

iFindResult := FindNext(SearchRec);

end;

end;

　

版主：西安 梁 明

日期：01-11-21

E-mail：delphifan@990.net