A form to rebuild the structure of Paradox Tables

Problem/Question/Abstract:

How to rebuild the structure of a table with the use of a component.

Answer:

One of the main problem when we modify programs is when the structure of a table is modified. When we have users distributed along the country the update of the program is almost imposible.

I wrote a form that read the structure of every table, compare them with the new strucure and if neccessary rebuild the table.

The form is very simply, contains 2 buttons, a BatchMove and a label. One button (BotStart) is for start the procees, other button (BotQuit) to quit the program.

Im using RxLib (The function DeleteFiles of the FileUtil Unit)

This program contains 3 examples of 3 tables, the program check the structure ov every one.

The code of the form is:

unit UVerUpd;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, ComCtrls, Db, DbTables, FileUtil;

type
  TFVerUpd = class(TForm)
    BotStart: TButton;
    BotQuit: TButton;
    StatusBar1: TStatusBar;
    Bat: TBatchMove;
    Label1: TLabel;
    procedure BotStartClick(Sender: TObject);
    procedure BotQuitClick(Sender: TObject);
    procedure FillStructure(Sender: TObject; xBase: TTable);
    procedure Check_a_Table(Sender: TObject; Tabla: string);

  private
    { Private declarations }
  public
    { Public declarations }
    xData, xDir: string;
    // xdata is the alias name
    // xdir is the directory where xdata is located
  end;

var
  FVerUpd: TFVerUpd;
function GetAliasPath(Base: string): string;

implementation

{$R *.DFM}

procedure TFVerUpd.BotStartClick(Sender: TObject);
begin
  BotStart.Enabled := False;
  xData := 'Pat41'; // the name of the alias, Pat41 is an example
  xDir := GetAliasPath(xData);

  // 3 examples

  Check_a_Table(Sender, 'Paquete.DB');
  Check_a_Table(Sender, 'TabDesc.db');
  Check_a_Table(Sender, 'Vehiculo.db');
  Close;
end;

procedure TFVerUpd.Check_a_Table(Sender: TObject; Tabla: string);
var
  TOld, TNew: TTable;
  xRebuild, xFound, xExiste: Boolean;
  i, j: Integer;
  xField: TField;
begin
  StatusBar1.Panels[0].Text := Tabla;
  StatusBar1.Panels[1].Text := '';
  TOld := TTable.Create(Self);
  TNew := TTable.Create(Self);
  with TNew do
  begin
    DataBaseName := xData;
    Tablename := Tabla;
    FillStructure(Sender, TNew)
  end;
  xExiste := FileExists(xDir + Tabla);
  if not xExiste then
    xRebuild := True
  else
  begin
    with TOld do
    begin
      DataBaseName := xData;
      TableType := ttDefault;
      Tablename := Tabla;
      FieldDefs.Update;
      for i := 0 to FieldDefs.Count - 1 do
        FieldDefs[i].CreateField(TOld);
    end;

    // review the fields

    xRebuild := False;
    i := 0;
    while (i <= TNew.FieldDefs.Count - 1) and (not xRebuild) do
    begin
      xField := TOld.FindField(TNew.FieldDefs[i].Name);
      if xField = nil then
        xRebuild := True
      else
      begin
        if xField.DataType <> TNew.FieldDefs[i].DataType then
          xRebuild := True;
        if xField.Size <> TNew.FieldDefs[i].Size then
          xRebuild := True;
      end;
      inc(i);
    end;
    if TNew.FieldDefs.Count <> TOld.FieldDefs.Count then
      xRebuild := True;

    // review the keys

    TOld.IndexDefs.Update;
    for i := 0 to TNew.IndexDefs.Count - 1 do
    begin
      xFound := False;
      j := 1;
      while (j <= TOld.Indexdefs.Count) and (not xFound) do
      begin
        if UpperCase(TNew.IndexDefs[i].Fields) = UpperCase(TOld.IndexDefs[j -
          1].Fields) then
          if TNew.IndexDefs[i].Name = TOld.IndexDefs[j - 1].Name then
            xFound := True;
        inc(j);
      end;
      if not xFound then
      begin
        xRebuild := True;
      end;
    end;

    if TNew.IndexDefs.Count <> TOld.IndexDefs.Count then
      xRebuild := True;
  end;

  // if the program has to rebuild the table

  if xRebuild then
  begin
    StatusBar1.Panels[1].Text := 'Updating';
    if xExiste then
    begin
      DeleteFiles(xDir + 'xx.*'); // RxLib
      TOld.RenameTable('xx');
      TNew.CreateTable;
      Bat.Source := TOld;
      Bat.Destination := TNew;
      Bat.Execute;
    end
    else
      TNew.CreateTable;
  end;
  TOld.Free;
  TNew.Free;
end;

procedure TFVerUpd.FillStructure(Sender: TObject; xBase: TTable);
var
  Tabla: string;
begin
  // this function fills the description of the tables
  with xBase do
  begin
    Tabla := UpperCase(TableName);

    /////////////////////////////////////////////
    if Tabla = 'PAQUETE.DB' then
    begin
      with FieldDefs do
      begin
        clear;
        add('Clave_Paq', ftInteger, 0, false);
        add('Desc_Paq', ftString, 40, false);
        add('Property_Av', ftBoolean, 0, false);
        add('Property_Min', ftCurrency, 0, false);
        add('Property_Max', ftCurrency, 0, false);
        add('Bodily_Av', ftBoolean, 0, false);
      end;
      with IndexDefs do
      begin
        clear;
        add('', 'Clave_Paq', [ixPrimary, ixUnique]);
      end;
    end;
    /////////////////////////////////////////////
    if Tabla = 'TABDESC.DB' then
    begin
      with FieldDefs do
      begin
        clear;
        add('CLAVE_DTO', ftInteger, 0, false);
        add('DESC_DTO', ftString, 40, false);
        add('TIPOL', ftInteger, 0, false);
        add('TIPO_USO', ftInteger, 0, false);
        add('POR_DES', ftFloat, 0, false);
        add('REQMEM', ftBoolean, 0, false);
        add('MENS_DESC', ftString, 100, false);
        add('CLAVE_RES', ftInteger, 0, false);
      end;
      with IndexDefs do
      begin
        clear;
        add('', 'CLAVE_DTO', [ixPrimary, ixUnique]);
      end;
    end;
    /////////////////////////////////////////////
    if Tabla = 'VEHICULO.DB' then
    begin
      with FieldDefs do
      begin
        clear;
        add('TIPO_VEH', ftInteger, 0, false);
        add('DESC_VEH', ftString, 30, false);
        add('DIASMIN_VE', ftInteger, 0, false);
        add('PRIMAMIN_V', ftCurrency, 0, false);
        add('ANTMAX_VEH', ftInteger, 0, false);
        add('NUMPAS_VEH', ftInteger, 0, false);
        add('DM_ADMIT', ftBoolean, 0, false);
      end;
      with IndexDefs do
      begin
        clear;
        add('', 'TIPO_VEH', [ixPrimary, ixUnique]);
      end;
    end;
  end;
end;

procedure TFVerUpd.BotQuitClick(Sender: TObject);
begin
  Close;
end;

function GetAliasPath(Base: string): string;
var
  ParamList: TStringList;
begin
  Result := '';
  ParamList := TStringList.Create;
  try
    Session.GetAliasParams(Base, ParamList);
    result := Uppercase(ParamList.Values['PATH']) + '\';
  finally
    ParamList.free;
  end;
end;

end.


Component Download: http://www.baltsoft.com/files/dkb/attachment/version.zip