ViewVC Help
View File | Revision Log | Show Annotations | Download File | View Changeset | Root Listing
root/public/ibx/trunk/design/IBSystemTables.pas
Revision: 5
Committed: Fri Feb 18 16:26:16 2011 UTC (13 years, 1 month ago) by tony
Content type: text/x-pascal
File size: 13298 byte(s)
Log Message:
Committing updates for Release pre-release

File Contents

# Content
1 unit IBSystemTables;
2
3 {$mode objfpc}{$H+}
4
5 interface
6
7 uses
8 Classes, SysUtils, IBSQL, IBDatabase;
9
10 type
11
12 { TIBSystemTables }
13
14 TIBSystemTables = class
15 private
16 FGetTableNames: TIBSQL;
17 FGetFieldNames: TIBSQL;
18 FGetPrimaryKeys: TIBSQL;
19 FTestSQL: TIBSQL;
20 FTableAndColumnSQL: TIBSQL;
21 FGetGeneratorsSQL: TIBSQL;
22 function GetSQLType(SQLType: TIBSQLTypes): string;
23 procedure AddWhereClause(TableName: string; QuotedStrings: boolean; SQL: TStrings);
24 public
25 constructor Create;
26 destructor Destroy; override;
27 procedure SelectDatabase(Database: TIBDatabase; Transaction: TIBTransaction);
28 procedure GetTableNames(TableNames: TStrings);
29 procedure GetFieldNames(TableName: string; FieldNames: TStrings;
30 IncludePrimaryKeys:boolean=true);
31 procedure GetPrimaryKeys(TableName: string; PrimaryKeys: TStrings);
32 procedure GetTableAndColumns(SelectSQL: string; var FirstTableName: string;
33 Columns: TStrings);
34 procedure GetGenerators(GeneratorNames: TStrings);
35 procedure GenerateSelectSQL(TableName: string; QuotedStrings: boolean; SQL: TStrings);
36 procedure GenerateRefreshSQL(TableName: string; QuotedStrings: boolean; SQL: TStrings);
37 procedure GenerateInsertSQL(TableName: string; QuotedStrings: boolean; FieldNames, SQL: TStrings);
38 procedure GenerateModifySQL(TableName: string; QuotedStrings: boolean; FieldNames,SQL: TStrings);
39 procedure GenerateDeleteSQL(TableName: string; QuotedStrings: boolean; SQL: TStrings);
40 procedure TestSQL(SQL: string);
41 end;
42
43 implementation
44
45 uses IB, Dialogs;
46
47 { TIBSystemTables }
48
49 const
50 sqlGETTABLES = 'Select Trim(RDB$RELATION_NAME) as TableName From RDB$RELATIONS ' +
51 'Where RDB$SYSTEM_FLAG = 0 ' +
52 'Order by 1';
53
54 sqlGETFIELDS = 'Select Trim(RDB$FIELD_NAME) as ColumnName FROM RDB$RELATION_FIELDS ' +
55 'Where RDB$RELATION_NAME = :TableName ' +
56 'order by RDB$FIELD_POSITION asc ';
57
58 sqlGETPRIMARYKEYS = 'Select Trim(S.RDB$FIELD_NAME) as ColumnName From '+
59 '(Select RDB$INDEX_NAME,RDB$FIELD_NAME FROM RDB$INDEX_SEGMENTS Order by RDB$FIELD_POSITION ASC) S ' +
60 'JOIN RDB$RELATION_CONSTRAINTS C On C.RDB$INDEX_NAME = S.RDB$INDEX_NAME ' +
61 'Where C.RDB$CONSTRAINT_TYPE = ''PRIMARY KEY'' and RDB$RELATION_NAME = :TableName';
62
63 sqlUPDATEFIELDS = 'Select Trim(RDB$FIELD_NAME) as ColumnName FROM RDB$RELATION_FIELDS RF ' +
64 'Where RF.RDB$RELATION_NAME = :TableName and RDB$FIELD_NAME not in ' +
65 '(Select RDB$FIELD_NAME FROM RDB$INDEX_SEGMENTS S JOIN RDB$RELATION_CONSTRAINTS C On C.RDB$INDEX_NAME = S.RDB$INDEX_NAME '+
66 'Where C.RDB$CONSTRAINT_TYPE = ''PRIMARY KEY'' and C.RDB$RELATION_NAME = RF.RDB$RELATION_NAME)' +
67 'order by 1 asc ';
68
69 sqlGETGENERATORNAMES = 'Select RDB$GENERATOR_NAME FROM RDB$GENERATORS '+
70 'Where RDB$SYSTEM_FLAG = 0 '+
71 'Order by 1 asc';
72
73 function TIBSystemTables.GetSQLType(SQLType: TIBSQLTypes): string;
74 begin
75 case SQLType of
76 SQLUnknown: Result := 'Unknown';
77 SQLSelect: Result := 'Select';
78 SQLInsert: Result := 'Insert';
79 SQLUpdate: Result := 'Update';
80 SQLDelete: Result := 'Delete';
81 SQLDDL: Result := 'DDL';
82 SQLGetSegment: Result := 'GetSegment';
83 SQLPutSegment: Result := 'PutSegment';
84 SQLExecProcedure: Result := 'Execute Procedure';
85 SQLStartTransaction: Result := 'StartTransaction';
86 SQLCommit: Result := 'Commit';
87 SQLRollback: Result := 'Rollback';
88 SQLSelectForUpdate: Result := 'Select for Update';
89 SQLSetGenerator: Result := 'Set Generator';
90 end;
91 end;
92
93 procedure TIBSystemTables.AddWhereClause(TableName: string;
94 QuotedStrings: boolean; SQL: TStrings);
95 var WhereClause: string;
96 Separator: string;
97 Count: integer;
98 begin
99 if not assigned(FGetPrimaryKeys.Database) or not FGetPrimaryKeys.Database.Connected or
100 not assigned(FGetPrimaryKeys.Transaction) then
101 Exit;
102 Count := 0;
103 WhereClause := 'Where';
104 Separator := ' A.';
105 FGetPrimaryKeys.Prepare;
106 FGetPrimaryKeys.ParamByName('TableName').AsString := TableName;
107 FGetPrimaryKeys.ExecQuery;
108 try
109 while not FGetPrimaryKeys.EOF do
110 begin
111 Inc(Count);
112 if QuotedStrings then
113 WhereClause := WhereClause + Separator + '"' + FGetPrimaryKeys.FieldByName('ColumnName').AsString + '" = :' + FGetPrimaryKeys.FieldByName('ColumnName').AsString
114 else
115 WhereClause := WhereClause + Separator + FGetPrimaryKeys.FieldByName('ColumnName').AsString + ' = :' + FGetPrimaryKeys.FieldByName('ColumnName').AsString;
116 Separator := ' AND A.';
117 FGetPrimaryKeys.Next
118 end;
119 finally
120 FGetPrimaryKeys.Close
121 end;
122 if Count > 0 then
123 SQL.Add(WhereClause)
124 end;
125
126 constructor TIBSystemTables.Create;
127 begin
128 FGetTableNames := TIBSQL.Create(nil);
129 FGetFieldNames := TIBSQL.Create(nil);
130 FGetPrimaryKeys := TIBSQL.Create(nil);
131 FTestSQL := TIBSQL.Create(nil);
132 FTableAndColumnSQL := TIBSQL.Create(nil);
133 FGetGeneratorsSQL := TIBSQL.Create(nil);
134 end;
135
136 destructor TIBSystemTables.Destroy;
137 begin
138 if assigned(FGetFieldNames) then FGetFieldNames.Free;
139 if assigned(FGetTableNames) then FGetTableNames.Free;
140 if assigned(FTestSQL) then FTestSQL.Free;
141 if assigned(FGetPrimaryKeys) then FGetPrimaryKeys.Free;
142 if assigned(FTableAndColumnSQL) then FTableAndColumnSQL.Free;
143 if assigned(FGetGeneratorsSQL) then FGetGeneratorsSQL.Free;
144 inherited Destroy;
145 end;
146
147 procedure TIBSystemTables.SelectDatabase(Database: TIBDatabase;
148 Transaction: TIBTransaction);
149 begin
150 FGetTableNames.Database := Database;
151 FGetTableNames.Transaction := Transaction;
152 FGetTableNames.SQL.Text := sqlGETTABLES;
153 FGetFieldNames.Database := Database;
154 FGetFieldNames.Transaction := Transaction;
155 FGetFieldNames.SQL.Text := sqlGETFIELDS;
156 FTestSQL.Database := Database;
157 FTestSQL.Transaction := Transaction;
158 FGetPrimaryKeys.Database := Database;
159 FGetPrimaryKeys.Transaction := Transaction;
160 FGetPrimaryKeys.SQL.Text := sqlGETPRIMARYKEYS;
161 FTableAndColumnSQL.Database := Database;
162 FTableAndColumnSQL.Transaction := Transaction;
163 FGetGeneratorsSQL.Database := Database;
164 FGetGeneratorsSQL.Transaction := Transaction;
165 FGetGeneratorsSQL.SQL.Text := sqlGETGENERATORNAMES;
166 end;
167
168 procedure TIBSystemTables.GetTableNames(TableNames: TStrings);
169 begin
170 if not assigned(FGetTableNames.Database) or not FGetTableNames.Database.Connected or
171 not assigned(FGetTableNames.Transaction) then
172 Exit;
173 with FGetTableNames.Transaction do
174 if not InTransaction then StartTransaction;
175 TableNames.Clear;
176 FGetTableNames.ExecQuery;
177 try
178 while not FGetTableNames.EOF do
179 begin
180 TableNames.Add(FGetTableNames.FieldByName('TableName').AsString);
181 FGetTableNames.Next
182 end;
183 finally
184 FGetTableNames.Close
185 end;
186 end;
187
188 procedure TIBSystemTables.GetFieldNames(TableName: string; FieldNames: TStrings;
189 IncludePrimaryKeys:boolean=true);
190 begin
191 if not assigned(FGetFieldNames.Database) or not FGetFieldNames.Database.Connected or
192 not assigned(FGetFieldNames.Transaction) then
193 Exit;
194 with FGetFieldNames.Transaction do
195 if not InTransaction then StartTransaction;
196 FieldNames.Clear;
197 if IncludePrimaryKeys then
198 FGetFieldNames.SQL.Text := sqlGETFIELDS
199 else
200 FGetFieldNames.SQL.Text := sqlUPDATEFIELDS;
201 FGetFieldNames.Prepare;
202 FGetFieldNames.ParamByName('TableName').AsString := TableName;
203 FGetFieldNames.ExecQuery;
204 try
205 while not FGetFieldNames.EOF do
206 begin
207 FieldNames.Add(FGetFieldNames.FieldByName('ColumnName').AsString);
208 FGetFieldNames.Next
209 end;
210 finally
211 FGetFieldNames.Close
212 end;
213 end;
214
215 procedure TIBSystemTables.GetPrimaryKeys(TableName: string; PrimaryKeys: TStrings);
216 begin
217 if not assigned(FGetPrimaryKeys.Database) or not FGetPrimaryKeys.Database.Connected or
218 not assigned(FGetPrimaryKeys.Transaction) then
219 Exit;
220 with FGetPrimaryKeys.Transaction do
221 if not InTransaction then StartTransaction;
222 PrimaryKeys.Clear;
223 FGetPrimaryKeys.Prepare;
224 FGetPrimaryKeys.ParamByName('TableName').AsString := TableName;
225 FGetPrimaryKeys.ExecQuery;
226 try
227 while not FGetPrimaryKeys.EOF do
228 begin
229 PrimaryKeys.Add(FGetPrimaryKeys.FieldByName('ColumnName').AsString);
230 FGetPrimaryKeys.Next
231 end;
232 finally
233 FGetPrimaryKeys.Close
234 end;
235 end;
236
237 procedure TIBSystemTables.GetTableAndColumns(SelectSQL: string;
238 var FirstTableName: string; Columns: TStrings);
239 var I: integer;
240 begin
241 if not assigned(FTableAndColumnSQL.Database) or not FTableAndColumnSQL.Database.Connected or
242 not assigned(FTableAndColumnSQL.Transaction) then
243 Exit;
244 with FTableAndColumnSQL.Transaction do
245 if not InTransaction then StartTransaction;
246 FTableAndColumnSQL.SQL.Text := SelectSQL;
247 try
248 FTableAndColumnSQL.Prepare;
249 FirstTableName := strpas(FTableAndColumnSQL.Current.Vars[0].Data^.relname);
250 if assigned(Columns) then
251 begin
252 Columns.Clear;
253 for I := 0 to FTableAndColumnSQL.Current.Count - 1 do
254 Columns.Add(FTableAndColumnSQL.Current.Vars[I].Name)
255 end;
256 except on E:EIBError do
257 ShowMessage(E.Message);
258 end;
259 end;
260
261 procedure TIBSystemTables.GetGenerators(GeneratorNames: TStrings);
262 begin
263 if not assigned(FGetGeneratorsSQL.Database) or not FGetGeneratorsSQL.Database.Connected or
264 not assigned(FGetGeneratorsSQL.Transaction) then
265 Exit;
266 GeneratorNames.Clear;
267 with FGetGeneratorsSQL do
268 begin
269 with Transaction do
270 if not InTransaction then StartTransaction;
271 ExecQuery;
272 try
273 while not EOF do
274 begin
275 GeneratorNames.Add(FieldByName('RDB$GENERATOR_NAME').AsString);
276 Next;
277 end;
278 finally
279 Close
280 end;
281 end;
282
283 end;
284
285 procedure TIBSystemTables.GenerateSelectSQL(TableName: string; QuotedStrings: boolean; SQL: TStrings);
286 var SelectSQL: string;
287 Separator : string;
288 begin
289 if not assigned(FGetFieldNames.Database) or not FGetFieldNames.Database.Connected or
290 not assigned(FGetFieldNames.Transaction) then
291 Exit;
292 SelectSQL := 'Select';
293 Separator := ' A.';
294 FGetFieldNames.SQL.Text := sqlGETFIELDS;
295 FGetFieldNames.Prepare;
296 FGetFieldNames.ParamByName('TableName').AsString := TableName;
297 FGetFieldNames.ExecQuery;
298 try
299 while not FGetFieldNames.EOF do
300 begin
301 if QuotedStrings then
302 SelectSQL := SelectSQL + Separator + '"' + FGetFieldNames.FieldByName('ColumnName').AsString + '"'
303 else
304 SelectSQL := SelectSQL + Separator + FGetFieldNames.FieldByName('ColumnName').AsString;
305 Separator := ', A.';
306 FGetFieldNames.Next
307 end;
308 finally
309 FGetFieldNames.Close
310 end;
311 SelectSQL := SelectSQL + ' From ' + TableName + ' A';
312 SQL.Add(SelectSQL);
313 end;
314
315 procedure TIBSystemTables.GenerateRefreshSQL(TableName: string; QuotedStrings: boolean; SQL: TStrings);
316 begin
317 GenerateSelectSQL(TableName,QuotedStrings,SQL);
318 AddWhereClause(TableName,QuotedStrings,SQL)
319 end;
320
321 procedure TIBSystemTables.GenerateInsertSQL(TableName: string;
322 QuotedStrings: boolean; FieldNames,SQL: TStrings);
323 var InsertSQL: string;
324 Separator: string;
325 I: integer;
326 begin
327 SQL.Clear;
328 InsertSQL := 'Insert Into ' + TableName + '(';
329 Separator := '';
330 for I := 0 to FieldNames.Count - 1 do
331 begin
332 if QuotedStrings then
333 InsertSQL := InsertSQL + Separator + '"' + FieldNames[I] + '"'
334 else
335 InsertSQL := InsertSQL + Separator + FieldNames[I] ;
336 Separator := ',';
337 end;
338 InsertSQL := InsertSQL + ')';
339 SQL.Add(InsertSQL);
340 InsertSQL := 'Values(';
341 Separator := ':';
342 for I := 0 to FieldNames.Count - 1 do
343 begin
344 InsertSQL := InsertSQL + Separator + FieldNames[I] ;
345 Separator := ',:';
346 end;
347 InsertSQL := InsertSQL + ')';
348 SQL.Add(InsertSQL);
349 end;
350
351 procedure TIBSystemTables.GenerateModifySQL(TableName: string; QuotedStrings: boolean;
352 FieldNames,SQL: TStrings);
353 var UpdateSQL: string;
354 Separator: string;
355 I: integer;
356 begin
357 SQL.Clear;
358 Separator := #$0d#$0a' A.';
359 UpdateSQL := 'Update ' + TableName + ' A Set ';
360 for I := 0 to FieldNames.Count - 1 do
361 begin
362 if QuotedStrings then
363 UpdateSQL := UpdateSQL + Separator + '"' + FieldNames[I] + '" = :' + FieldNames[I]
364 else
365 UpdateSQL := UpdateSQL + Separator + FieldNames[I] + ' = :' + FieldNames[I];
366 Separator := ','#$0d#$0a' A.';
367 end;
368 SQL.Add(UpdateSQL);
369 AddWhereClause(TableName,QuotedStrings,SQL)
370 end;
371
372 procedure TIBSystemTables.GenerateDeleteSQL(TableName: string; QuotedStrings: boolean; SQL: TStrings);
373 begin
374 SQL.Clear;
375 SQL.Add('Delete From ' + TableName + ' A');
376 AddWhereClause(TableName,QuotedStrings,SQL)
377 end;
378
379 procedure TIBSystemTables.TestSQL(SQL: string);
380 begin
381 if not assigned(FTestSQL.Database) or not FTestSQL.Database.Connected or
382 not assigned(FTestSQL.Transaction) then
383 Exit;
384 FTestSQL.SQL.Text := SQL;
385 try
386 FTestSQL.Prepare;
387 ShowMessage('SQL '+ GetSQLType(FTestSQL.SQLType) + ' Statement Looks OK');
388 except on E:EIBError do
389 ShowMessage(E.Message);
390 end;
391 end;
392
393 end.
394