为Delphi提供Pack功能

Delphi目前已经是国内常见的数据库编程工具，它在各方面表现不错，在支持大型多层数据库结构的同时也完全支持本地数据库。对于本地数据库中Delphi对FoxPro的支持也不错，我曾经对VB、FoxPro、Delphi的数据库操作速度进行比较，发现除了启动速度较慢外，其它各项Delphi均排在首位。而且Delphi几乎支持所有原先FoxPro所拥有的功能，对于有一定编程经验的人来说，Delphi成了编写数据库软件的一把利器，因而Delphi迅速流行起来，Delphi在我国也占有一席之地。

　　但是我在使用Delphi编程的过程中发现它也有不如人意的地方，特别是在本地数据库dBase和Paradox方面，它居然不支持十分有用的Pack和Undelete功能。对于数据库来说，因为是一个顺序存储文件，在删除部分记录时一般采用了软删除技术，也就是说将要删除的记录标记已删除的标记，但并不立即从物理上删除这些记录（删除后库文件大小不变）。

　　这样做可以避免仅仅删除一条记录就要将整个数据库重新写入存储器，提高了读写的效率。但是如果数据库长期不对已经被标记为删除的记录进行整理和真实删除，数据库就会越来越大，其中无用的数据所占的比率越来越大，使得数据库的读写效率迅速下降，而且造成查询速度的减慢。特别是在编写人事管理数据库应用软件时，库内要保存大量的图形文件（人员的照片），而这些数据还时常需要添加和删除，没用的数据不能"Pack"将占用巨大的硬盘空间，而且还将降低系统的运行速度。

　　这是编写数据库软件的人必须考虑的一个问题。经过再三查找，我找到一些资料，解决了如何对数据库进行pack，下面是其中的核心程序的一个例子，在看例子之前，我先做一些说明：

　　1． 对于dBase和Paradox库，其Pack原理是不同的：如果是Paradox 表, 必须调用 DbiDoRestructure,重建数据库结构；如果是 dBASE 表, 只需要调用DbiPackTable。

　　2． 在做Pack删除时，必须以独占方式打开数据库时。具体请参考一下的例子。

　　　（为了节省篇幅，例子中只给出关键性的程序段）

　　implementation
　　　uses BDE;//做PACK必须引用次单元里的函数
　　　{$R *.DFM}
　　　　procedure TfrmPack.FormCreate(Sender: TObject);
　　　　var
　　　　　DBName:String;
　　　　begin
　　　　DBName:=ExtractFilePath(Application.ExeName);//得到数据库的位置
　　　　　{设置Table}
　　　　　　tblDBASE.DatabaseName:=DBName;
　　　　　　tblParadox.DatabaseName:=DBName;
　　　　　　tblDBASE.TableName:='dbsTest.dbf';
　　　　　　tblParadox.TableName:='pdxTest.db';
　　　　　　tblDBASE.Active:=True;
　　　　　　tblParadox.Active:=True;
　　　　　　end;
　　　　　{物理删除数据库记录Pack a Paradox or dBASE table}
　　　　　　// The table must be opened execlusively before calling this procedure...
　　　　　　procedure TFrmPack.PackTable(FTable: TTable);
　　　　　　var
　　　　　　　Props: CURProps;
　　　　　　　　hDb: hDBIDb;
　　　　　　　TableDesc: CRTblDesc;
　　　　　　begin
　　　　　　　FTable.Active := False;
　　　　　　　{当数据库打开失败时,这个循环语句能够让用户重试}
　　　　　　　repeat
　　　　　　　try
　　　　　　　　FTable.Exclusive := True;
　　　　　　　　FTable.Active := True;
　　　　　　　　{如果正常打开数据库,则退出循环}
　　　　　　　　Break;
　　　　　　　　except
　　　　　　　　on EDatabaseError do
　　　　　　　　if Application.MessageBox(
　　　　　　　　　'以独占方式打开数据库时,出现错误---重试否?',
　　　　　　　　　'数据库错误',
　　　　　　　　　MB_OKCANCEL + MB_DEFBUTTON1) <> IDOK then
　　　　　　　　　Exit;
　　　　　　　　end;
　　　　　　　　until False;
　　　　　　　try
　　　　　　　　{Check()用于校正和报告DBI底层错误;DbiGetCursorProps()用于取表光标属性}
　　　　　　　　Check(DbiGetCursorProps(FTable.Handle, Props));// 获得表的属性已得到表的类型
　　　　　　　　{如果是Paradox 表, 必须调用 DbiDoRestructure,重建数据库结构}
　　　　　　　　　if (Props.szTableType = szPARADOX) then
　　　　　　　　　　begin
　　　　　　　　　　　FillChar(TableDesc, sizeof(TableDesc), 0);
　　　　　　　　　　　{从数据表光标获取数据库句柄}
　　　　　　　　　　Check(DbiGetObjFromObj(hDBIObj(FTable.Handle), objDATABASE, hDBIObj(hDb)));
　　　　　　　　　　{设置表的描述结构的Name/Type/bPack属性}
　　　　　　　　　　　StrPCopy(TableDesc.szTblName, FTable.TableName);
　　　　　　　　　　　StrPCopy(TableDesc.szTblType, Props.szTableType);
　　　　　　　　　　　TableDesc.bPack := True;
　　　　　　　　　　　{关闭表并调用api}
　　　　　　　　　　　　FTable.Close;
　　　　　　　　　　　　Application.ProcessMessages;
　　　　　　　　　　　　Check(DbiDoRestructure(hDb, 1, @TableDesc, nil, nil, nil, False));
　　　　　　　　　　　　Application.ProcessMessages;
　　　　　　　　　　　　FTable.Open;
　　　　　　　　　　　　end
　　　　　　　　　　　{ 如果是 dBASE 表, 只需要调用DbiPackTable...}
　　　　　　　　　　else
　　　　　　　　　　　if (Props.szTableType = szDBASE) then
　　　　　　　　　　　　begin
　　　　　　　　　　　　　Application.ProcessMessages;
　　　　　　　　　　　　　Check(DbiPackTable(FTable.DBHandle, FTable.Handle, nil, szDBASE, True));
　　　　　　　　　　　　　Application.ProcessMessages;
　　　　　　　　　　　　end
　　　　　　　　　　{不是dBase和Paradox表}
　　　　　　　　　　else
　　　　　　　　　　　raise EDatabaseError.Create('数据库必须是 Paradox 或者 dBASE 类型,才能进行物理删除操作!!');
　　　　　　　　　　　finally
　　　　　　　　　　　FTable.Active := False;
　　　　　　　　　　　FTable.Exclusive := False;
　　　　　　　　　　　FTable.Active := True;
　　　　　　　　　　end;
　　　　　　　　　end;

　　procedure TfrmPack.BitBtndBaseClick(Sender: TObject);
　　　begin
　　　　if OpenPictureDlg.Execute then
　　　　　DBImage1.Picture.LoadFromFile(OpenPictureDlg.FileName);
　　　　end;
　　procedure TfrmPack.BitBtnParadoxClick(Sender: TObject);
　　　begin
　　　　if OpenPictureDlg.Execute then
　　　　　DBImage2.Picture.LoadFromFile(OpenPictureDlg.FileName);
　　　end;
　　procedure TfrmPack.BitBtnPackdBASEClick(Sender: TObject);
　　　begin
　　　　PackTable(tbldBASE);//物理删除dDBSE库
　　　end;
　　procedure TfrmPack.BitBtnPackParadoxClick(Sender: TObject);
　　　begin
　　　　PackTable(tblParadox);//物理删除Paradox库
　　end;

　　程序的运行界面于下：



　　本程序在Windows 2000 Professional下Delphi5.0 C/S版调试通过。调试时可装入较大的Bmp图片，先点"?"删除记录，然后查看数据库的大小；再点"物理删除"按钮，再查看数据库的大小，你会发现数据库变小。本例子还可以进一步扩展，以增强其功能，限于篇幅，不必在此讨论。有兴趣的朋友可给我发Email: jollier@371.net，我可进一步解答有关的问题。

　　源程序下载

查看本文来源