Mega Code Archive
A form to rebuild the structure of Paradox Tables
<![CDATA[
Title: A form to rebuild the structure of Paradox Tables
Question: 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 xField:=TOld.FindField(TNew.FieldDefs[i].Name);
if xField=nil then
xRebuild:=True
else begin
if xField.DataTypeTNew.FieldDefs[i].DataType then
xRebuild:=True;
if xField.SizeTNew.FieldDefs[i].Size then
xRebuild:=True;
end;
inc(i);
end;
if TNew.FieldDefs.CountTOld.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 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.CountTOld.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.
]]>