Author: Alejandro Castro
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:
1 unit UVerUpd;
2
3 interface
4
5 uses
6 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
7 StdCtrls, ComCtrls, Db, DbTables, FileUtil;
8
9 type
10 TFVerUpd = class(TForm)
11 BotStart: TButton;
12 BotQuit: TButton;
13 StatusBar1: TStatusBar;
14 Bat: TBatchMove;
15 Label1: TLabel;
16 procedure BotStartClick(Sender: TObject);
17 procedure BotQuitClick(Sender: TObject);
18 procedure FillStructure(Sender: TObject; xBase: TTable);
19 procedure Check_a_Table(Sender: TObject; Tabla: string);
20
21 private
22 { Private declarations }
23 public
24 { Public declarations }
25 xData, xDir: string;
26 // xdata is the alias name
27 // xdir is the directory where xdata is located
28 end;
29
30 var
31 FVerUpd: TFVerUpd;
32 function GetAliasPath(Base: string): string;
33
34 implementation
35
36 {$R *.DFM}
37
38 procedure TFVerUpd.BotStartClick(Sender: TObject);
39 begin
40 BotStart.Enabled := False;
41 xData := 'Pat41'; // the name of the alias, Pat41 is an example
42 xDir := GetAliasPath(xData);
43
44 // 3 examples
45
46 Check_a_Table(Sender, 'Paquete.DB');
47 Check_a_Table(Sender, 'TabDesc.db');
48 Check_a_Table(Sender, 'Vehiculo.db');
49 Close;
50 end;
51
52 procedure TFVerUpd.Check_a_Table(Sender: TObject; Tabla: string);
53 var
54 TOld, TNew: TTable;
55 xRebuild, xFound, xExiste: Boolean;
56 i, j: Integer;
57 xField: TField;
58 begin
59 StatusBar1.Panels[0].Text := Tabla;
60 StatusBar1.Panels[1].Text := '';
61 TOld := TTable.Create(Self);
62 TNew := TTable.Create(Self);
63 with TNew do
64 begin
65 DataBaseName := xData;
66 Tablename := Tabla;
67 FillStructure(Sender, TNew)
68 end;
69 xExiste := FileExists(xDir + Tabla);
70 if not xExiste then
71 xRebuild := True
72 else
73 begin
74 with TOld do
75 begin
76 DataBaseName := xData;
77 TableType := ttDefault;
78 Tablename := Tabla;
79 FieldDefs.Update;
80 for i := 0 to FieldDefs.Count - 1 do
81 FieldDefs[i].CreateField(TOld);
82 end;
83
84 // review the fields
85
86 xRebuild := False;
87 i := 0;
88 while (i <= TNew.FieldDefs.Count - 1) and (not xRebuild) do
89 begin
90 xField := TOld.FindField(TNew.FieldDefs[i].Name);
91 if xField = nil then
92 xRebuild := True
93 else
94 begin
95 if xField.DataType <> TNew.FieldDefs[i].DataType then
96 xRebuild := True;
97 if xField.Size <> TNew.FieldDefs[i].Size then
98 xRebuild := True;
99 end;
100 inc(i);
101 end;
102 if TNew.FieldDefs.Count <> TOld.FieldDefs.Count then
103 xRebuild := True;
104
105 // review the keys
106
107 TOld.IndexDefs.Update;
108 for i := 0 to TNew.IndexDefs.Count - 1 do
109 begin
110 xFound := False;
111 j := 1;
112 while (j <= TOld.Indexdefs.Count) and (not xFound) do
113 begin
114 if UpperCase(TNew.IndexDefs[i].Fields) = UpperCase(TOld.IndexDefs[j -
115 1].Fields) then
116 if TNew.IndexDefs[i].Name = TOld.IndexDefs[j - 1].Name then
117 xFound := True;
118 inc(j);
119 end;
120 if not xFound then
121 begin
122 xRebuild := True;
123 end;
124 end;
125
126 if TNew.IndexDefs.Count <> TOld.IndexDefs.Count then
127 xRebuild := True;
128 end;
129
130 // if the program has to rebuild the table
131
132 if xRebuild then
133 begin
134 StatusBar1.Panels[1].Text := 'Updating';
135 if xExiste then
136 begin
137 DeleteFiles(xDir + 'xx.*'); // RxLib
138 TOld.RenameTable('xx');
139 TNew.CreateTable;
140 Bat.Source := TOld;
141 Bat.Destination := TNew;
142 Bat.Execute;
143 end
144 else
145 TNew.CreateTable;
146 end;
147 TOld.Free;
148 TNew.Free;
149 end;
150
151 procedure TFVerUpd.FillStructure(Sender: TObject; xBase: TTable);
152 var
153 Tabla: string;
154 begin
155 // this function fills the description of the tables
156 with xBase do
157 begin
158 Tabla := UpperCase(TableName);
159
160 /////////////////////////////////////////////
161 if Tabla = 'PAQUETE.DB' then
162 begin
163 with FieldDefs do
164 begin
165 clear;
166 add('Clave_Paq', ftInteger, 0, false);
167 add('Desc_Paq', ftString, 40, false);
168 add('Property_Av', ftBoolean, 0, false);
169 add('Property_Min', ftCurrency, 0, false);
170 add('Property_Max', ftCurrency, 0, false);
171 add('Bodily_Av', ftBoolean, 0, false);
172 end;
173 with IndexDefs do
174 begin
175 clear;
176 add('', 'Clave_Paq', [ixPrimary, ixUnique]);
177 end;
178 end;
179 /////////////////////////////////////////////
180 if Tabla = 'TABDESC.DB' then
181 begin
182 with FieldDefs do
183 begin
184 clear;
185 add('CLAVE_DTO', ftInteger, 0, false);
186 add('DESC_DTO', ftString, 40, false);
187 add('TIPOL', ftInteger, 0, false);
188 add('TIPO_USO', ftInteger, 0, false);
189 add('POR_DES', ftFloat, 0, false);
190 add('REQMEM', ftBoolean, 0, false);
191 add('MENS_DESC', ftString, 100, false);
192 add('CLAVE_RES', ftInteger, 0, false);
193 end;
194 with IndexDefs do
195 begin
196 clear;
197 add('', 'CLAVE_DTO', [ixPrimary, ixUnique]);
198 end;
199 end;
200 /////////////////////////////////////////////
201 if Tabla = 'VEHICULO.DB' then
202 begin
203 with FieldDefs do
204 begin
205 clear;
206 add('TIPO_VEH', ftInteger, 0, false);
207 add('DESC_VEH', ftString, 30, false);
208 add('DIASMIN_VE', ftInteger, 0, false);
209 add('PRIMAMIN_V', ftCurrency, 0, false);
210 add('ANTMAX_VEH', ftInteger, 0, false);
211 add('NUMPAS_VEH', ftInteger, 0, false);
212 add('DM_ADMIT', ftBoolean, 0, false);
213 end;
214 with IndexDefs do
215 begin
216 clear;
217 add('', 'TIPO_VEH', [ixPrimary, ixUnique]);
218 end;
219 end;
220 end;
221 end;
222
223 procedure TFVerUpd.BotQuitClick(Sender: TObject);
224 begin
225 Close;
226 end;
227
228 function GetAliasPath(Base: string): string;
229 var
230 ParamList: TStringList;
231 begin
232 Result := '';
233 ParamList := TStringList.Create;
234 try
235 Session.GetAliasParams(Base, ParamList);
236 result := Uppercase(ParamList.Values['PATH']) + '\';
237 finally
238 ParamList.free;
239 end;
240 end;
241
242 end.
Component Download: http://www.baltsoft.com/files/dkb/attachment/version.zip
|
