ViewVC Help

View File | Revision Log | Show Annotations | Download File | View Changeset | Root Listing

root/public/ibx/trunk/design/IBSystemTables.pas

Comparing ibx/trunk/design/IBSystemTables.pas (file contents):
Revision 5 by tony, Fri Feb 18 16:26:16 2011 UTC vs.
Revision 17 by tony, Sat Dec 28 19:22:24 2013 UTC

#	Line 1 | Line 1
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	<
1	>	(*
2	>	*  IBX For Lazarus (Firebird Express)
3	>	*
4	>	*  The contents of this file are subject to the Initial Developer's
5	>	*  Public License Version 1.0 (the "License"); you may not use this
6	>	*  file except in compliance with the License. You may obtain a copy
7	>	*  of the License here:
8	>	*
9	>	*    http://www.firebirdsql.org/index.php?op=doc&id=idpl
10	>	*
11	>	*  Software distributed under the License is distributed on an "AS
12	>	*  IS" basis, WITHOUT WARRANTY OF ANY KIND, either express or
13	>	*  implied. See the License for the specific language governing rights
14	>	*  and limitations under the License.
15	>	*
16	>	*  The Initial Developer of the Original Code is Tony Whyman.
17	>	*
18	>	*  The Original Code is (C) 2011 Tony Whyman, MWA Software
19	>	*  (http://www.mwasoftware.co.uk).
20	>	*
21	>	*  All Rights Reserved.
22	>	*
23	>	*  Contributor(s): ______________________________________.
24	>	*
25	>	*)
26	>
27	>	unit IBSystemTables;
28	>
29	>	{$mode objfpc}{$H+}
30	>
31	>	interface
32	>
33	>	uses
34	>	Classes, SysUtils, IBSQL, IBDatabase, StdCtrls;
35	>
36	>	type
37	>
38	>	{ TIBSystemTables }
39	>
40	>	TIBSystemTables = class
41	>	private
42	>	FGetTableNames: TIBSQL;
43	>	FGetFieldNames: TIBSQL;
44	>	FGetPrimaryKeys: TIBSQL;
45	>	FTestSQL: TIBSQL;
46	>	FTableAndColumnSQL: TIBSQL;
47	>	FGetGeneratorsSQL: TIBSQL;
48	>	FGetProcedures: TIBSQL;
49	>	FGetProcedureParams: TIBSQL;
50	>	FGetProcedureInfo: TIBSQL;
51	>	function GetSQLType(SQLType: TIBSQLTypes): string;
52	>	procedure AddWhereClause(TableName: string; QuotedStrings: boolean; SQL: TStrings;
53	>	UseOldValues: boolean = false);
54	>	procedure GetProcParams(ProcName: string; ParamList: TStrings; InputParams: boolean); overload;
55	>	function GetWord(S: string; WordNo: integer): string;
56	>	public
57	>	constructor Create;
58	>	destructor Destroy; override;
59	>	procedure SelectDatabase(Database: TIBDatabase; Transaction: TIBTransaction);
60	>	procedure GetTableNames(TableNames: TStrings);
61	>	procedure GetFieldNames(TableName: string; FieldNames: TStrings;
62	>	IncludePrimaryKeys:boolean=true; IncludeReadOnlyFields: boolean = true);
63	>	procedure GetPrimaryKeys(TableName: string; PrimaryKeys: TStrings);
64	>	procedure GetTableAndColumns(SelectSQL: string; var FirstTableName: string;
65	>	Columns: TStrings);
66	>	procedure GetProcedureNames(ProcNames: TStrings; WithOutputParams: boolean=false);
67	>	procedure GetProcParams(ProcName: string; var ExecuteOnly: boolean;
68	>	InputParams, OutputParams: TStrings); overload;
69	>	procedure GetGenerators(GeneratorNames: TStrings);
70	>	procedure GenerateSelectSQL(TableName: string; QuotedStrings: boolean; FieldNames,SQL: TStrings);
71	>	procedure GenerateRefreshSQL(TableName: string; QuotedStrings: boolean; FieldNames,SQL: TStrings);
72	>	procedure GenerateInsertSQL(TableName: string; QuotedStrings: boolean; FieldNames, SQL: TStrings);
73	>	procedure GenerateModifySQL(TableName: string; QuotedStrings: boolean; FieldNames,SQL: TStrings);
74	>	procedure GenerateDeleteSQL(TableName: string; QuotedStrings: boolean; SQL: TStrings);
75	>	procedure GenerateExecuteSQL(ProcName: string; QuotedStrings: boolean; ExecuteOnly: boolean;
76	>	InputParams, OutputParams, ExecuteSQL: TStrings);
77	>	function GetStatementType(SQL: string; var IsStoredProcedure: boolean): TIBSQLTypes;
78	>	function GetFieldNames(FieldList: TListBox): TStrings;
79	>	procedure TestSQL(SQL: string);
80	>	end;
81	>
82	>	implementation
83	>
84	>	uses IB, Dialogs;
85	>
86	>	{ TIBSystemTables }
87	>
88	>	const
89	>	sqlGETTABLES = 'Select Trim(RDB$RELATION_NAME) as TableName From RDB$RELATIONS ' +
90	>	'Where RDB$SYSTEM_FLAG = 0 ' +
91	>	'Order by 1';
92	>
93	>	sqlGETALLFIELDS = 'Select Trim(RDB$FIELD_NAME) as ColumnName FROM RDB$RELATION_FIELDS ' +
94	>	'Where RDB$RELATION_NAME = :TableName ' +
95	>	'order by RDB$FIELD_POSITION asc ';
96	>
97	>	sqlGETFIELDS = 'Select Trim(RF.RDB$FIELD_NAME) as ColumnName FROM RDB$RELATION_FIELDS RF ' +
98	>	'JOIN RDB$FIELDS B On B.RDB$FIELD_NAME = RF.RDB$FIELD_SOURCE '+
99	>	'Where RF.RDB$RELATION_NAME = :TableName and B.RDB$COMPUTED_SOURCE is NULL ' +
100	>	'order by RF.RDB$FIELD_POSITION asc ';
101	>
102	>	sqlGETPRIMARYKEYS = 'Select Trim(S.RDB$FIELD_NAME) as ColumnName From '+
103	>	'(Select RDB$INDEX_NAME,RDB$FIELD_NAME FROM RDB$INDEX_SEGMENTS Order by RDB$FIELD_POSITION ASC) S ' +
104	>	'JOIN RDB$RELATION_CONSTRAINTS C On C.RDB$INDEX_NAME = S.RDB$INDEX_NAME ' +
105	>	'Where C.RDB$CONSTRAINT_TYPE = ''PRIMARY KEY'' and RDB$RELATION_NAME = :TableName';
106	>
107	>	sqlUPDATEFIELDS = 'Select Trim(RF.RDB$FIELD_NAME) as ColumnName FROM RDB$RELATION_FIELDS RF ' +
108	>	'JOIN RDB$FIELDS B On B.RDB$FIELD_NAME = RF.RDB$FIELD_SOURCE '+
109	>	'Where RF.RDB$RELATION_NAME = :TableName  and RF.RDB$FIELD_NAME not in ' +
110	>	'(Select RDB$FIELD_NAME FROM RDB$INDEX_SEGMENTS S JOIN RDB$RELATION_CONSTRAINTS C On C.RDB$INDEX_NAME = S.RDB$INDEX_NAME '+
111	>	'Where C.RDB$CONSTRAINT_TYPE = ''PRIMARY KEY'' and C.RDB$RELATION_NAME = RF.RDB$RELATION_NAME) and B.RDB$COMPUTED_SOURCE is NULL ' +
112	>	'order by 1 asc ';
113	>
114	>	sqlALLUPDATEFIELDS = 'Select Trim(RDB$FIELD_NAME) as ColumnName FROM RDB$RELATION_FIELDS RF ' +
115	>	'Where RF.RDB$RELATION_NAME = :TableName  and RDB$FIELD_NAME not in ' +
116	>	'(Select RDB$FIELD_NAME FROM RDB$INDEX_SEGMENTS S JOIN RDB$RELATION_CONSTRAINTS C On C.RDB$INDEX_NAME = S.RDB$INDEX_NAME '+
117	>	'Where C.RDB$CONSTRAINT_TYPE = ''PRIMARY KEY'' and C.RDB$RELATION_NAME = RF.RDB$RELATION_NAME)' +
118	>	'order by 1 asc ';
119	>
120	>	sqlGETGENERATORNAMES = 'Select RDB$GENERATOR_NAME FROM RDB$GENERATORS '+
121	>	'Where RDB$SYSTEM_FLAG = 0 '+
122	>	'Order by 1 asc';
123	>
124	>	sqlGETPROCEDURES = 'Select Trim(RDB$PROCEDURE_NAME) as ProcName, RDB$PROCEDURE_INPUTS, '+
125	>	'RDB$PROCEDURE_OUTPUTS From RDB$PROCEDURES '+
126	>	'Where RDB$SYSTEM_FLAG = 0 and RDB$PROCEDURE_TYPE <= :ProcType Order by 1 asc';
127	>
128	>	sqlGETPROCPARAM  = 'Select Trim(P.RDB$PARAMETER_NAME) as ParamName '+
129	>	'From RDB$PROCEDURE_PARAMETERS P '+
130	>	'JOIN RDB$FIELDS F On F.RDB$FIELD_NAME = P.RDB$FIELD_SOURCE '+
131	>	'Where P.RDB$SYSTEM_FLAG = 0 and P.RDB$PROCEDURE_NAME = :ProcName and P.RDB$PARAMETER_TYPE = :type '+
132	>	'Order by P.RDB$PARAMETER_NUMBER asc';
133	>
134	>	sqlCheckProcedureNames = 'Select * From RDB$PROCEDURES Where Upper(Trim(RDB$PROCEDURE_NAME)) = Upper(:ProcName)';
135	>
136	>	sqlGETPROCEDUREINFO = 'Select RDB$PROCEDURE_TYPE From RDB$PROCEDURES Where Upper(Trim(RDB$PROCEDURE_NAME)) = Upper(:ProcName)';
137	>
138	>	function TIBSystemTables.GetSQLType(SQLType: TIBSQLTypes): string;
139	>	begin
140	>	case SQLType of
141	>	SQLUnknown:              Result := 'Unknown';
142	>	SQLSelect:               Result := 'Select';
143	>	SQLInsert:               Result := 'Insert';
144	>	SQLUpdate:               Result := 'Update';
145	>	SQLDelete:               Result := 'Delete';
146	>	SQLDDL:                  Result := 'DDL';
147	>	SQLGetSegment:           Result := 'GetSegment';
148	>	SQLPutSegment:           Result := 'PutSegment';
149	>	SQLExecProcedure:        Result := 'Execute Procedure';
150	>	SQLStartTransaction:     Result := 'StartTransaction';
151	>	SQLCommit:               Result := 'Commit';
152	>	SQLRollback:             Result := 'Rollback';
153	>	SQLSelectForUpdate:      Result := 'Select for Update';
154	>	SQLSetGenerator:         Result := 'Set Generator';
155	>	end;
156	>	end;
157	>
158	>	procedure TIBSystemTables.AddWhereClause(TableName: string;
159	>	QuotedStrings: boolean; SQL: TStrings; UseOldValues: boolean);
160	>	var WhereClause: string;
161	>	Separator: string;
162	>	Count: integer;
163	>	Prefix: string;
164	>	begin
165	>	if not assigned(FGetPrimaryKeys.Database) or not FGetPrimaryKeys.Database.Connected or
166	>	not assigned(FGetPrimaryKeys.Transaction) then
167	>	Exit;
168	>	Count := 0;
169	>	WhereClause := 'Where';
170	>	Separator := ' A.';
171	>	if UseOldValues then
172	>	Prefix := ':OLD_'
173	>	else
174	>	Prefix := ':';
175	>	FGetPrimaryKeys.Prepare;
176	>	FGetPrimaryKeys.ParamByName('TableName').AsString := TableName;
177	>	FGetPrimaryKeys.ExecQuery;
178	>	try
179	>	while not FGetPrimaryKeys.EOF do
180	>	begin
181	>	Inc(Count);
182	>	if QuotedStrings then
183	>	WhereClause := WhereClause + Separator + '"' + FGetPrimaryKeys.FieldByName('ColumnName').AsString +
184	>	'" = ' + Prefix+ FGetPrimaryKeys.FieldByName('ColumnName').AsString
185	>	else
186	>	WhereClause := WhereClause + Separator + FGetPrimaryKeys.FieldByName('ColumnName').AsString +
187	>	' = ' + Prefix + FGetPrimaryKeys.FieldByName('ColumnName').AsString;
188	>	Separator := ' AND A.';
189	>	FGetPrimaryKeys.Next
190	>	end;
191	>	finally
192	>	FGetPrimaryKeys.Close
193	>	end;
194	>	if Count > 0 then
195	>	SQL.Add(WhereClause)
196	>	end;
197	>
198	>	procedure TIBSystemTables.GetProcParams(ProcName: string; ParamList: TStrings;
199	>	InputParams: boolean);
200	>	begin
201	>	if not assigned(FGetProcedureParams.Database) or not FGetProcedureParams.Database.Connected or
202	>	not assigned(FGetProcedureParams.Transaction) then
203	>	Exit;
204	>	ParamList.Clear;
205	>	with FGetProcedureParams do
206	>	begin
207	>	with Transaction do
208	>	if not InTransaction then StartTransaction;
209	>	Prepare;
210	>	ParamByName('ProcName').AsString := ProcName;
211	>	if InputParams then
212	>	ParamByName('type').AsInteger := 0
213	>	else
214	>	ParamByName('type').AsInteger := 1;
215	>	ExecQuery;
216	>	try
217	>	while not EOF do
218	>	begin
219	>	ParamList.Add(FieldByName('ParamName').AsString);
220	>	Next;
221	>	end;
222	>	finally
223	>	Close
224	>	end;
225	>	end;
226	>	end;
227	>
228	>	function TIBSystemTables.GetWord(S: string; WordNo: integer): string;
229	>	const
230	>	SpaceChars = [' ',#$0a,#$0d,#$09,'('];
231	>	var I: integer;
232	>	StartIdx: integer;
233	>	InWhiteSpace: boolean;
234	>	begin
235	>	Result := '';
236	>	StartIdx := 1;
237	>	InWhiteSpace := true;
238	>	for I := 1 to Length(S) do
239	>	begin
240	>	if InWhiteSpace then
241	>	begin
242	>	if not (S[I] in SpaceChars) then
243	>	begin
244	>	StartIdx := I;
245	>	InWhiteSpace := false
246	>	end
247	>	end
248	>	else
249	>	begin
250	>	if S[I] in SpaceChars then
251	>	begin
252	>	Dec(WordNo);
253	>	if WordNo = 0 then
254	>	begin
255	>	Result := System.copy(S,StartIdx,I - StartIdx);
256	>	Exit
257	>	end;
258	>	InWhiteSpace := true
259	>	end
260	>	end
261	>	end;
262	>	end;
263	>
264	>	constructor TIBSystemTables.Create;
265	>	begin
266	>	FGetTableNames := TIBSQL.Create(nil);
267	>	FGetFieldNames := TIBSQL.Create(nil);
268	>	FGetPrimaryKeys := TIBSQL.Create(nil);
269	>	FGetProcedures := TIBSQL.Create(nil);
270	>	FTestSQL := TIBSQL.Create(nil);
271	>	FTableAndColumnSQL := TIBSQL.Create(nil);
272	>	FGetGeneratorsSQL := TIBSQL.Create(nil);
273	>	FGetProcedureParams := TIBSQL.Create(nil);
274	>	FGetProcedureInfo := TIBSQL.Create(nil);
275	>	end;
276	>
277	>	destructor TIBSystemTables.Destroy;
278	>	begin
279	>	if assigned(FGetFieldNames) then FGetFieldNames.Free;
280	>	if assigned(FGetTableNames) then FGetTableNames.Free;
281	>	if assigned(FTestSQL) then FTestSQL.Free;
282	>	if assigned(FGetPrimaryKeys) then FGetPrimaryKeys.Free;
283	>	if assigned(FTableAndColumnSQL) then FTableAndColumnSQL.Free;
284	>	if assigned(FGetGeneratorsSQL) then FGetGeneratorsSQL.Free;
285	>	if assigned(FGetProcedures) then FGetProcedures.Free;
286	>	if assigned(FGetProcedureParams) then FGetProcedureParams.Free;
287	>	if assigned(FGetProcedureInfo) then FGetProcedureInfo.Free;
288	>	inherited Destroy;
289	>	end;
290	>
291	>	procedure TIBSystemTables.SelectDatabase(Database: TIBDatabase;
292	>	Transaction: TIBTransaction);
293	>	begin
294	>	FGetTableNames.Database := Database;
295	>	FGetTableNames.Transaction := Transaction;
296	>	FGetTableNames.SQL.Text := sqlGETTABLES;
297	>	FGetFieldNames.Database := Database;
298	>	FGetFieldNames.Transaction := Transaction;
299	>	FGetFieldNames.SQL.Text := sqlGETFIELDS;
300	>	FTestSQL.Database := Database;
301	>	FTestSQL.Transaction := Transaction;
302	>	FGetPrimaryKeys.Database := Database;
303	>	FGetPrimaryKeys.Transaction := Transaction;
304	>	FGetPrimaryKeys.SQL.Text := sqlGETPRIMARYKEYS;
305	>	FTableAndColumnSQL.Database := Database;
306	>	FTableAndColumnSQL.Transaction := Transaction;
307	>	FGetGeneratorsSQL.Database := Database;
308	>	FGetGeneratorsSQL.Transaction := Transaction;
309	>	FGetGeneratorsSQL.SQL.Text := sqlGETGENERATORNAMES;
310	>	FGetProcedureParams.Database := Database;
311	>	FGetProcedureParams.Transaction := Transaction;
312	>	FGetProcedureParams.SQL.Text := sqlGETPROCPARAM;
313	>	FGetProcedureInfo.Database := Database;
314	>	FGetProcedureInfo.Transaction := Transaction;
315	>	FGetProcedureInfo.SQL.Text := sqlGETPROCEDUREINFO;
316	>	FGetProcedures.Database := Database;
317	>	FGetProcedures.Transaction := Transaction;
318	>	FGetProcedures.SQL.Text := sqlGETPROCEDURES;
319	>	end;
320	>
321	>	procedure TIBSystemTables.GetTableNames(TableNames: TStrings);
322	>	begin
323	>	if not assigned(FGetTableNames.Database) or not FGetTableNames.Database.Connected or
324	>	not assigned(FGetTableNames.Transaction) then
325	>	Exit;
326	>	with FGetTableNames.Transaction do
327	>	if not InTransaction then StartTransaction;
328	>	TableNames.Clear;
329	>	FGetTableNames.ExecQuery;
330	>	try
331	>	while not FGetTableNames.EOF do
332	>	begin
333	>	TableNames.Add(FGetTableNames.FieldByName('TableName').AsString);
334	>	FGetTableNames.Next
335	>	end;
336	>	finally
337	>	FGetTableNames.Close
338	>	end;
339	>	end;
340	>
341	>	procedure TIBSystemTables.GetFieldNames(TableName: string;
342	>	FieldNames: TStrings; IncludePrimaryKeys: boolean;
343	>	IncludeReadOnlyFields: boolean);
344	>	begin
345	>	if not assigned(FGetFieldNames.Database) or not FGetFieldNames.Database.Connected or
346	>	not assigned(FGetFieldNames.Transaction) then
347	>	Exit;
348	>	with FGetFieldNames.Transaction do
349	>	if not InTransaction then StartTransaction;
350	>	FieldNames.Clear;
351	>	if IncludePrimaryKeys then
352	>	begin
353	>	if IncludeReadOnlyFields then
354	>	FGetFieldNames.SQL.Text := sqlGETALLFIELDS
355	>	else
356	>	FGetFieldNames.SQL.Text := sqlGETFIELDS
357	>	end
358	>	else
359	>	if  IncludeReadOnlyFields then
360	>	FGetFieldNames.SQL.Text := sqlALLUPDATEFIELDS
361	>	else
362	>	FGetFieldNames.SQL.Text := sqlUPDATEFIELDS;
363	>	FGetFieldNames.Prepare;
364	>	FGetFieldNames.ParamByName('TableName').AsString := TableName;
365	>	FGetFieldNames.ExecQuery;
366	>	try
367	>	while not FGetFieldNames.EOF do
368	>	begin
369	>	FieldNames.Add(FGetFieldNames.FieldByName('ColumnName').AsString);
370	>	FGetFieldNames.Next
371	>	end;
372	>	finally
373	>	FGetFieldNames.Close
374	>	end;
375	>	end;
376	>
377	>	procedure TIBSystemTables.GetPrimaryKeys(TableName: string; PrimaryKeys: TStrings);
378	>	begin
379	>	if not assigned(FGetPrimaryKeys.Database) or not FGetPrimaryKeys.Database.Connected or
380	>	not assigned(FGetPrimaryKeys.Transaction) then
381	>	Exit;
382	>	with FGetPrimaryKeys.Transaction do
383	>	if not InTransaction then StartTransaction;
384	>	PrimaryKeys.Clear;
385	>	FGetPrimaryKeys.Prepare;
386	>	FGetPrimaryKeys.ParamByName('TableName').AsString := TableName;
387	>	FGetPrimaryKeys.ExecQuery;
388	>	try
389	>	while not FGetPrimaryKeys.EOF do
390	>	begin
391	>	PrimaryKeys.Add(FGetPrimaryKeys.FieldByName('ColumnName').AsString);
392	>	FGetPrimaryKeys.Next
393	>	end;
394	>	finally
395	>	FGetPrimaryKeys.Close
396	>	end;
397	>	end;
398	>
399	>	procedure TIBSystemTables.GetTableAndColumns(SelectSQL: string;
400	>	var FirstTableName: string; Columns: TStrings);
401	>	var I: integer;
402	>	begin
403	>	FirstTableName := '';
404	>	if not assigned(FTableAndColumnSQL.Database) or not FTableAndColumnSQL.Database.Connected or
405	>	not assigned(FTableAndColumnSQL.Transaction) or (Trim(SelectSQL) = '') then
406	>	Exit;
407	>	with FTableAndColumnSQL.Transaction do
408	>	if not InTransaction then StartTransaction;
409	>	FTableAndColumnSQL.SQL.Text := SelectSQL;
410	>	try
411	>	FTableAndColumnSQL.Prepare;
412	>	case FTableAndColumnSQL.SQLType of
413	>	SQLSelect:
414	>	begin
415	>	if FTableAndColumnSQL.Current.Count > 0 then
416	>	FirstTableName := strpas(FTableAndColumnSQL.Current.Vars[0].Data^.relname)
417	>	else
418	>	FirstTableName := '';
419	>	if assigned(Columns) then
420	>	begin
421	>	Columns.Clear;
422	>	for I := 0 to FTableAndColumnSQL.Current.Count - 1 do
423	>	Columns.Add(FTableAndColumnSQL.Current.Vars[I].Name)
424	>	end;
425	>	end;
426	>	{ If not a select statement then return table or procedure name
427	>	as First Table Name }
428	>	SQLUpdate:
429	>	FirstTableName := GetWord(SelectSQL,2);
430	>
431	>	else
432	>	FirstTableName := GetWord(SelectSQL,3);
433	>	end
434	>	except on E:EIBError do
435	>	//      ShowMessage(E.Message);
436	>	end;
437	>	end;
438	>
439	>	procedure TIBSystemTables.GetProcedureNames(ProcNames: TStrings; WithOutputParams: boolean);
440	>	begin
441	>	if not assigned(FGetProcedures.Database) or not FGetProcedures.Database.Connected or
442	>	not assigned(FGetProcedures.Transaction) then
443	>	Exit;
444	>	ProcNames.Clear;
445	>	with FGetProcedures do
446	>	begin
447	>	with Transaction do
448	>	if not InTransaction then StartTransaction;
449	>	Prepare;
450	>	if WithOutputParams then
451	>	ParamByName('ProcType').AsInteger := 1
452	>	else
453	>	ParamByName('ProcType').AsInteger := 2;
454	>	ExecQuery;
455	>	try
456	>	while not EOF do
457	>	begin
458	>	ProcNames.Add(FieldByName('ProcName').AsString);
459	>	Next;
460	>	end;
461	>	finally
462	>	Close
463	>	end;
464	>	end;
465	>	end;
466	>
467	>	procedure TIBSystemTables.GetProcParams(ProcName: string;
468	>	var ExecuteOnly: boolean; InputParams, OutputParams: TStrings);
469	>	begin
470	>	GetProcParams(ProcName,InputParams,true);
471	>	GetProcParams(ProcName,OutputParams,false);
472	>	ExecuteOnly := OutputParams.Count = 0;
473	>	if not ExecuteOnly then
474	>	with FGetProcedureInfo do
475	>	begin
476	>	with Transaction do
477	>	if not InTransaction then StartTransaction;
478	>	Prepare;
479	>	ParamByName('ProcName').AsString := ProcName;
480	>	ExecQuery;
481	>	try
482	>	if not EOF then
483	>	ExecuteOnly := FieldByName('RDB$PROCEDURE_TYPE').AsInteger = 2
484	>	finally
485	>	Close
486	>	end;
487	>	end;
488	>	end;
489	>
490	>	procedure TIBSystemTables.GetGenerators(GeneratorNames: TStrings);
491	>	begin
492	>	if not assigned(FGetGeneratorsSQL.Database) or not FGetGeneratorsSQL.Database.Connected or
493	>	not assigned(FGetGeneratorsSQL.Transaction) then
494	>	Exit;
495	>	GeneratorNames.Clear;
496	>	with FGetGeneratorsSQL do
497	>	begin
498	>	with Transaction do
499	>	if not InTransaction then StartTransaction;
500	>	ExecQuery;
501	>	try
502	>	while not EOF do
503	>	begin
504	>	GeneratorNames.Add(FieldByName('RDB$GENERATOR_NAME').AsString);
505	>	Next;
506	>	end;
507	>	finally
508	>	Close
509	>	end;
510	>	end;
511	>
512	>	end;
513	>
514	>	procedure TIBSystemTables.GenerateSelectSQL(TableName: string; QuotedStrings: boolean; FieldNames,SQL: TStrings);
515	>	var SelectSQL: string;
516	>	Separator : string;
517	>	I: integer;
518	>	begin
519	>	SQL.Clear;
520	>	if not assigned(FGetFieldNames.Database) or not FGetFieldNames.Database.Connected or
521	>	not assigned(FGetFieldNames.Transaction) then
522	>	begin
523	>	Messagedlg('No Database Connected',mtError,[mbOK],0);
524	>	Exit;
525	>	end;
526	>	SelectSQL := 'Select';
527	>	Separator := ' A.';
528	>	for I := 0 to FieldNames.Count - 1 do
529	>	begin
530	>	if QuotedStrings then
531	>	SelectSQL := SelectSQL + Separator + '"' + FieldNames[I] + '"'
532	>	else
533	>	SelectSQL := SelectSQL + Separator + FieldNames[I];
534	>	Separator := ', A.';
535	>	end;
536	>	SelectSQL := SelectSQL + ' From ' + TableName + ' A';
537	>	SQL.Add(SelectSQL);
538	>	end;
539	>
540	>	procedure TIBSystemTables.GenerateRefreshSQL(TableName: string; QuotedStrings: boolean; FieldNames,SQL: TStrings);
541	>	begin
542	>	GenerateSelectSQL(TableName,QuotedStrings,FieldNames,SQL);
543	>	AddWhereClause(TableName,QuotedStrings,SQL)
544	>	end;
545	>
546	>	procedure TIBSystemTables.GenerateInsertSQL(TableName: string;
547	>	QuotedStrings: boolean; FieldNames,SQL: TStrings);
548	>	var InsertSQL: string;
549	>	Separator: string;
550	>	I: integer;
551	>	begin
552	>	SQL.Clear;
553	>	InsertSQL := 'Insert Into ' + TableName + '(';
554	>	Separator := '';
555	>	for I := 0 to FieldNames.Count - 1 do
556	>	begin
557	>	if QuotedStrings then
558	>	InsertSQL := InsertSQL + Separator + '"' + FieldNames[I] + '"'
559	>	else
560	>	InsertSQL := InsertSQL + Separator +  FieldNames[I] ;
561	>	Separator := ', ';
562	>	end;
563	>	InsertSQL := InsertSQL + ')';
564	>	SQL.Add(InsertSQL);
565	>	InsertSQL := 'Values(';
566	>	Separator := ':';
567	>	for I := 0 to FieldNames.Count - 1 do
568	>	begin
569	>	InsertSQL := InsertSQL + Separator +  FieldNames[I] ;
570	>	Separator := ', :';
571	>	end;
572	>	InsertSQL := InsertSQL + ')';
573	>	SQL.Add(InsertSQL);
574	>	end;
575	>
576	>	procedure TIBSystemTables.GenerateModifySQL(TableName: string; QuotedStrings: boolean;
577	>	FieldNames,SQL: TStrings);
578	>	var UpdateSQL: string;
579	>	Separator: string;
580	>	I: integer;
581	>	begin
582	>	SQL.Clear;
583	>	Separator := #$0d#$0a'  A.';
584	>	UpdateSQL := 'Update ' + TableName + ' A Set ';
585	>	for I := 0 to FieldNames.Count - 1 do
586	>	begin
587	>	if QuotedStrings then
588	>	UpdateSQL := UpdateSQL + Separator + '"' + FieldNames[I] + '" = :' + FieldNames[I]
589	>	else
590	>	UpdateSQL := UpdateSQL + Separator + FieldNames[I] + ' = :' + FieldNames[I];
591	>	Separator := ','#$0d#$0a'  A.';
592	>	end;
593	>	SQL.Add(UpdateSQL);
594	>	AddWhereClause(TableName,QuotedStrings,SQL,true)
595	>	end;
596	>
597	>	procedure TIBSystemTables.GenerateDeleteSQL(TableName: string; QuotedStrings: boolean; SQL: TStrings);
598	>	begin
599	>	SQL.Clear;
600	>	SQL.Add('Delete From ' + TableName + ' A');
601	>	AddWhereClause(TableName,QuotedStrings,SQL)
602	>	end;
603	>
604	>	procedure TIBSystemTables.GenerateExecuteSQL(ProcName: string;
605	>	QuotedStrings: boolean; ExecuteOnly: boolean; InputParams, OutputParams,
606	>	ExecuteSQL: TStrings);
607	>	var SQL: string;
608	>	I: integer;
609	>	Separator: string;
610	>	begin
611	>	Separator := '';
612	>	if not ExecuteOnly and (OutputParams.Count > 0) then //Select Query
613	>	begin
614	>	SQL := 'Select ';
615	>	for I := 0 to OutputParams.Count - 1 do
616	>	begin
617	>	if QuotedStrings then
618	>	SQL := SQL + Separator + '"' + OutputParams[I] + '"'
619	>	else
620	>	SQL := SQL + Separator + OutputParams[I];
621	>	Separator := ', ';
622	>	end;
623	>	SQL := SQL + ' From ' + ProcName;
624	>	if InputParams.Count > 0 then
625	>	begin
626	>	Separator := '(:';
627	>	for I := 0 to InputParams.Count - 1 do
628	>	begin
629	>	SQL := SQL + Separator + InputParams[I];
630	>	Separator := ', :';
631	>	end;
632	>	SQL := SQL + ')'
633	>	end
634	>	end
635	>	else // Execute Procedure
636	>	begin
637	>	if QuotedStrings then
638	>	SQL := 'Execute Procedure "' + ProcName + '"'
639	>	else
640	>	SQL := 'Execute Procedure ' + ProcName;
641	>	if InputParams.Count > 0 then
642	>	begin
643	>	Separator := ' :';
644	>	for I := 0 to InputParams.Count - 1 do
645	>	begin
646	>	if QuotedStrings then
647	>	SQL := SQL + Separator + '"' + InputParams[I] + '"'
648	>	else
649	>	SQL := SQL + Separator + InputParams[I];
650	>	Separator := ', :';
651	>	end;
652	>	end
653	>	end;
654	>	ExecuteSQL.Text := SQL
655	>	end;
656	>
657	>	function TIBSystemTables.GetStatementType(SQL: string; var IsStoredProcedure: boolean): TIBSQLTypes;
658	>	var TableName: string;
659	>	begin
660	>	Result := sqlUnknown;
661	>	if not assigned(FTestSQL.Database) or not FTestSQL.Database.Connected or
662	>	not assigned(FTestSQL.Transaction) or (Trim(SQL) = '') then
663	>	Exit;
664	>	IsStoredProcedure := false;
665	>	FTestSQL.SQL.Text := SQL;
666	>	try
667	>	FTestSQL.Prepare;
668	>	Result := FTestSQL.SQLType
669	>	except on E:EIBError do
670	>	//      ShowMessage(E.Message);
671	>	end;
672	>	if (Result = SQLSelect) and (FTestSQL.Current.Count > 0)  then
673	>	begin
674	>	TableName := strpas(FTestSQL.Current.Vars[0].Data^.relname);
675	>	FTestSQL.SQL.Text := sqlCheckProcedureNames;
676	>	FTestSQL.Prepare;
677	>	FTestSQL.ParamByName('ProcName').AsString := TableName;
678	>	FTestSQL.ExecQuery;
679	>	try
680	>	IsStoredProcedure := not FTestSQL.EOF;
681	>	finally
682	>	FTestSQL.Close
683	>	end;
684	>	end;
685	>	end;
686	>
687	>	function TIBSystemTables.GetFieldNames(FieldList: TListBox): TStrings;
688	>	var I: integer;
689	>	begin
690	>	Result := TStringList.Create;
691	>	try
692	>	if FieldList.SelCount = 0 then
693	>	Result.Assign(FieldList.Items)
694	>	else
695	>	for I := 0 to FieldList.Items.Count - 1 do
696	>	if FieldList.Selected[I] then
697	>	Result.Add(FieldList.Items[I]);
698	>	except
699	>	Result.Free;
700	>	raise
701	>	end;
702	>	end;
703	>
704	>	procedure TIBSystemTables.TestSQL(SQL: string);
705	>	begin
706	>	if not assigned(FTestSQL.Database) or not FTestSQL.Database.Connected or
707	>	not assigned(FTestSQL.Transaction) then
708	>	begin
709	>	Messagedlg('No Database Connected',mtError,[mbOK],0);
710	>	Exit;
711	>	end;
712	>	FTestSQL.SQL.Text := SQL;
713	>	try
714	>	FTestSQL.Prepare;
715	>	ShowMessage('SQL '+ GetSQLType(FTestSQL.SQLType) + ' Statement Looks OK');
716	>	except on E:EIBError do
717	>	ShowMessage(E.Message);
718	>	end;
719	>	end;
720	>
721	>	end.
722	>

Diff Legend

–	Removed lines
+	Added lines
<	Changed lines
>	Changed lines