Articles   Members Online:
-Article/Tip Search
-News Group Search over 21 Million news group articles.
-Delphi/Pascal
-CBuilder/C++
-C#Builder/C#
-JBuilder/Java
-Kylix
Member Area
-Home
-Account Center
-Top 10 NEW!!
-Submit Article/Tip
-Forums Upgraded!!
-My Articles
-Edit Information
-Login/Logout
-Become a Member
-Why sign up!
-Newsletter
-Chat Online!
-Indexes NEW!!
Employment
-Build your resume
-Find a job
-Post a job
-Resume Search
Contacts
-Contacts
-Feedbacks
-Link to us
-Privacy/Disclaimer
Embarcadero
Visit Embarcadero
Embarcadero Community
JEDI
Links
How to rebuild the structure of a table with the use of a component. Turn on/off line numbers in source code. Switch to Orginial background IDE or DSP color Comment or reply to this aritlce/tip for discussion. Bookmark this article to my favorite article(s). Print this article
24-Dec-02
Category
DB-General
Language
Delphi 3.x
Views
128
User Rating
No Votes
# Votes
0
Replies
0
Publisher:
DSP, Administrator
Reference URL:
DKB
			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

			
Vote: How useful do you find this Article/Tip?
Bad Excellent
1 2 3 4 5 6 7 8 9 10

 

Advertisement
Share this page
Advertisement
Download from Google

Copyright © Mendozi Enterprises LLC