Home: Code Repository: Mastering Delphi 5

Project DBPACK

Project Structure

DBPACK.DPR
DBPACKF.PAS
DBPACKF.DFM

program DbPack;

uses
  Forms,
  DbPackF in 'DbPackF.pas' {Form1};

{$R *.RES}

begin
  Application.Initialize;
  Application.CreateForm(TForm1, Form1);
  Application.Run;
end.

unit DbPackF;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, DBTables, Db;

type
  TForm1 = class(TForm)
    BtnDbase: TButton;
    BtnPdx: TButton;
    ListDbase: TListBox;
    ListPdx: TListBox;
    Table1: TTable;
    procedure FormCreate(Sender: TObject);
    procedure BtnPdxClick(Sender: TObject);
    procedure BtnDbaseClick(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

uses
  BDE;

procedure PackPdoxTable (Table:TTable);
var
  TableDesc: CRTblDesc;
  WasActive: Boolean;
  hDatabase: hDbiDB;
begin
  WasActive := Table.Active;
  Screen.Cursor := crHourglass;
  try
    // open if it was closed
    // (to get the valid DBHandle)
    if not WasActive then
      Table.Open;
    // get the database handle and close the table
    hDatabase := Table.DBHandle;
    Table.Close;
    // fill the table descriptor
    FillChar (TableDesc, SizeOf (CRTblDesc), 0);
    with TableDesc do
    begin
      StrPCopy (szTblName, Table.TableName);
      StrPCopy (szTblType, szParadox);
      bPack := True;
    end;
    // restructure the table, packing it
    if hDatabase <> nil then
      Check (DBIDoRestructure (hDatabase, 1,
        @TableDesc, nil, nil, nil, False))
    else
      ShowMessage ('Database handle is nil');
  finally
    Screen.Cursor := crDefault;
    // eventually reopen
    if WasActive then
      Table.Open;
  end;
end;

procedure PackDBaseTable (Table: TTable);
var
  WasActive: Boolean;
begin
  WasActive  := Table.Active;
  Screen.Cursor := crHourglass;
  try
    // close if open
    if WasActive then
      Table.Close;
    // reopen in exclusive mode
    Table.Exclusive := True;
    Table.Open;
    // pack the table
    Check (DBIPackTable (Table.DBHandle,
      Table.Handle, nil, nil, True));
    // remove the exclusive mode
    Table.Close;
    Table.Exclusive := False;
  finally
    Screen.Cursor := crDefault;
    // eventually reopen
    if WasActive then
      Table.Open;
  end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  // get the table names
  Session.GetTableNames (Table1.DatabaseName,
    '*.db', True, False, ListPdx.Items);
  Session.GetTableNames (Table1.DatabaseName,
    '*.dbf', True, False, ListDbase.Items);
  // select the first item of each list
  ListPdx.ItemIndex := 0;
  ListDbase.ItemIndex := 0;
end;

procedure TForm1.BtnPdxClick(Sender: TObject);
begin
  Table1.TableName :=
    ListPdx.Items [ListPdx.ItemIndex];
  PackPdoxTable (Table1);
end;

procedure TForm1.BtnDbaseClick(Sender: TObject);
begin
  Table1.TableName :=
    ListDbase.Items [ListDbase.ItemIndex];
  PackDBaseTable (Table1);
end;

end.

object Form1: TForm1
  Left = 192
  Top = 107
  Width = 450
  Height = 228
  Caption = 'DbPack'
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'MS Sans Serif'
  Font.Style = []
  OldCreateOrder = True
  Visible = True
  OnCreate = FormCreate
  PixelsPerInch = 96
  TextHeight = 13
  object BtnDbase: TButton
    Left = 272
    Top = 168
    Width = 121
    Height = 25
    Caption = 'Pack dBase table'
    TabOrder = 0
    OnClick = BtnDbaseClick
  end
  object BtnPdx: TButton
    Left = 48
    Top = 168
    Width = 121
    Height = 25
    Caption = 'Pack Paradox table'
    TabOrder = 1
    OnClick = BtnPdxClick
  end
  object ListDbase: TListBox
    Left = 224
    Top = 8
    Width = 209
    Height = 153
    ItemHeight = 13
    TabOrder = 2
  end
  object ListPdx: TListBox
    Left = 8
    Top = 8
    Width = 209
    Height = 153
    ItemHeight = 13
    TabOrder = 3
  end
  object Table1: TTable
    DatabaseName = 'DBDEMOS'
    TableName = 'clients.dbf'
    Left = 32
    Top = 24
  end
end