Демонстрационная программа для упаковки
{————————} { Упаковка таблиц (демонстрационная программа) } { PackMain.PAS : Главная форма } { Автор: Эйс Брейкпойнт, N.T.P. } { При содействии Дона Тейлора } { } { Программа, демонстрирующая применение модуля } { PakTable для упаковки таблиц Paradox и dBASE.} { } { Написано для *High Performance Delphi 3 } Programming* } { Copyright (c) 1997 The Coriolis Group, Inc.} { Дата последней редакции 3/5/97 } {————————} unit PackMain; interface uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, DB, DBTables, StdCtrls, Grids, DBGrids, PakTable, ExtCtrls; type TForm1 = class(TForm) AddBtn: TButton; RemoveBtn: TButton; PackBtn: TButton; QuitBtn: TButton; Table1: TTable; DataSource1: TDataSource; DBGrid1: TDBGrid; Label1: TLabel; TableNameLabel: TLabel; Label2: TLabel; FileSizeLabel: TLabel; Label3: TLabel; NumRecsLabel: TLabel; Bevel1: TBevel; Table1MessageString: TStringField; Table1ID: TAutoIncField; procedure QuitBtnClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure AddBtnClick(Sender: TObject);
procedure RemoveBtnClick(Sender: TObject);
procedure PackBtnClick(Sender: TObject);
procedure FormActivate(Sender: TObject);
private TablePathName : ShortString; procedure UpdateFileLabels; public { Public declarations } end; var Form1: TForm1; implementation {$R *.DFM} procedure TForm1.QuitBtnClick(Sender: TObject);
begin Close; end; procedure TForm1.FormCreate(Sender: TObject);
var s : ShortString; begin Table1.Active := True; s := Application.ExeName; TablePathName := Copy(s, 1, pos(".", s)) + "DB"; TableNameLabel.Caption := TablePathName; end; procedure TForm1.UpdateFileLabels; var f : File of Byte; begin { При открытой таблице доступ к ее файлу невозможен } Table1.Close; AssignFile(f, TablePathName);
{$I-} Reset(f);
{$I+} if IOResult = 0 then begin FileSizeLabel.Caption := IntToStr(FileSize(f));
CloseFile(f);
end else FileSizeLabel.Caption := "I/O error!"; { Снова открываем таблицу } Table1.Open; NumRecsLabel.Caption := IntToStr(Table1.RecordCount);
end; procedure TForm1.AddBtnClick(Sender: TObject);
var i : Integer; begin with Table1 do begin for i := 1 to 100 do begin Append; Table1.FieldByName ("MessageString").AsString := IntToStr(i) + ": Hello. My name is Mister Ed."; Post; end; { for } end; { with } UpdateFileLabels; end; procedure TForm1.RemoveBtnClick(Sender: TObject);
begin with Table1 do begin First; while not EOF do begin Edit; Delete; MoveBy(3);
end; { while } end; { with } UpdateFileLabels; end; procedure TForm1.PackBtnClick(Sender: TObject);
begin if not PackTable(Table1) then MessageDlg("Error packing the table", mtError, [mbOK], 0);
UpdateFileLabels; end; procedure TForm1.FormActivate(Sender: TObject);
begin UpdateFileLabels; end; end.
Это простое приложение демонстрирует процесс упаковки файлов Paradox. При нажатии кнопки Add в таблицу добавляются 100 новых записей; кнопка Remove удаляет каждую третью запись. Если несколько раз нажать Add и Remove и при этом следить за отображаемой информацией, становится очевидно, что операция удаления освобождает не все неиспользуемое место. Нажатие кнопки Pack Table не изменяет количества записей, но может заметно сократить общий размер файла.
Конец записи (20 марта).
