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