📄 pack_database1.htm
字号:
<html><head><title>如何 Pack dBASE 资料档</title><meta http-equiv=Content-Type content=text/html; charset=gb2312><meta name=GENERATOR content=Microsoft FrontPage 3.0><style><!--
A{text-transform: none; text-decoration: none;}
A:hover {color: #F77C02 ; text-decoration: underline;} }
--></style><style type=text/css><!--
.font1 {font-size:10.5pt; line-height:15pt; align=center}
.font2 {font-size:9pt; line-height:13pt; }
A{text-transform: none; text-decoration:none;color:#0000FF}
a:hover {text-decoration:underline;color:#FFFFF}
--></style></head><body bgcolor=#FFFFFF><p><span class=font1> </span></p><h3 align=center><b><span class=font1><font color=#0000ff>如何 Pack dBASE 资料档</font></span></b></h3><ul> <p><span class=font1>小弟有一个 TTable 的 .DBF ，可是时间一久就愈来愈大了，却找不到有 Pack>这样的函数请问有可办法解决，谢谢</span></p> <p> </p> <p><span class=font1>我从 DChat.exe 的原始程式中截出一段程式来, 您可以参考看看其中 pack 的作法. 当时我用递回的方法, 将指定目录(含子目录)中的 dbf 全部 pack 一遍.</span></p> <p><span class=font1>DChat.Exe DelphiChat 讨论资料库的原始程式您可以在<a href=http://202.98.107.86/tyb/delphi/dbftools/cr_app.html tppabs=http://www.chih.com/delphi/cr_app.html>Delphi学习笔记(创作篇)</a>中找到</span></p> <pre><span class=font1>{ 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[1] <> '.') and
(gsTempDir <> sCurrentPath + SearchRec.Name + '\') then
begin
DoPackTable(sCurrentPath + SearchRec.Name + '\');
end;
iFindResult := FindNext(SearchRec);
end;
end;</span></pre></ul><p> </p><p><span class=font2>版主：西安 梁 明<br>日期：99-07-29<br>E-mail：<a href=mailto:delphifan@990.net>delphifan@990.net</a></span></p><hr></body></html>⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -