1 |
< |
unit IBSystemTables; |
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; |
34 |
> |
Classes, SysUtils, IBSQL, IBDatabase, StdCtrls; |
35 |
|
|
36 |
|
type |
37 |
|
|
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); |
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); |
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; SQL: TStrings); |
71 |
< |
procedure GenerateRefreshSQL(TableName: string; QuotedStrings: boolean; SQL: 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 |
|
|
90 |
|
'Where RDB$SYSTEM_FLAG = 0 ' + |
91 |
|
'Order by 1'; |
92 |
|
|
93 |
< |
sqlGETFIELDS = 'Select Trim(RDB$FIELD_NAME) as ColumnName FROM RDB$RELATION_FIELDS ' + |
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(RDB$FIELD_NAME) as ColumnName FROM RDB$RELATION_FIELDS RF ' + |
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)' + |
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 |
156 |
|
end; |
157 |
|
|
158 |
|
procedure TIBSystemTables.AddWhereClause(TableName: string; |
159 |
< |
QuotedStrings: boolean; SQL: TStrings); |
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 |
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; |
180 |
|
begin |
181 |
|
Inc(Count); |
182 |
|
if QuotedStrings then |
183 |
< |
WhereClause := WhereClause + Separator + '"' + FGetPrimaryKeys.FieldByName('ColumnName').AsString + '" = :' + FGetPrimaryKeys.FieldByName('ColumnName').AsString |
183 |
> |
WhereClause := WhereClause + Separator + '"' + FGetPrimaryKeys.FieldByName('ColumnName').AsString + |
184 |
> |
'" = ' + Prefix+ FGetPrimaryKeys.FieldByName('ColumnName').AsString |
185 |
|
else |
186 |
< |
WhereClause := WhereClause + Separator + FGetPrimaryKeys.FieldByName('ColumnName').AsString + ' = :' + FGetPrimaryKeys.FieldByName('ColumnName').AsString; |
186 |
> |
WhereClause := WhereClause + Separator + FGetPrimaryKeys.FieldByName('ColumnName').AsString + |
187 |
> |
' = ' + Prefix + FGetPrimaryKeys.FieldByName('ColumnName').AsString; |
188 |
|
Separator := ' AND A.'; |
189 |
|
FGetPrimaryKeys.Next |
190 |
|
end; |
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; |
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 |
|
|
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); |
338 |
|
end; |
339 |
|
end; |
340 |
|
|
341 |
< |
procedure TIBSystemTables.GetFieldNames(TableName: string; FieldNames: TStrings; |
342 |
< |
IncludePrimaryKeys:boolean=true); |
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 |
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; |
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) then |
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 |
< |
FirstTableName := strpas(FTableAndColumnSQL.Current.Vars[0].Data^.relname); |
413 |
< |
if assigned(Columns) then |
414 |
< |
begin |
415 |
< |
Columns.Clear; |
416 |
< |
for I := 0 to FTableAndColumnSQL.Current.Count - 1 do |
417 |
< |
Columns.Add(FTableAndColumnSQL.Current.Vars[I].Name) |
418 |
< |
end; |
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); |
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 |
|
|
511 |
|
|
512 |
|
end; |
513 |
|
|
514 |
< |
procedure TIBSystemTables.GenerateSelectSQL(TableName: string; QuotedStrings: boolean; SQL: TStrings); |
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 |
< |
FGetFieldNames.SQL.Text := sqlGETFIELDS; |
529 |
< |
FGetFieldNames.Prepare; |
530 |
< |
FGetFieldNames.ParamByName('TableName').AsString := TableName; |
531 |
< |
FGetFieldNames.ExecQuery; |
532 |
< |
try |
533 |
< |
while not FGetFieldNames.EOF do |
534 |
< |
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 |
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; SQL: TStrings); |
540 |
> |
procedure TIBSystemTables.GenerateRefreshSQL(TableName: string; QuotedStrings: boolean; FieldNames,SQL: TStrings); |
541 |
|
begin |
542 |
< |
GenerateSelectSQL(TableName,QuotedStrings,SQL); |
542 |
> |
GenerateSelectSQL(TableName,QuotedStrings,FieldNames,SQL); |
543 |
|
AddWhereClause(TableName,QuotedStrings,SQL) |
544 |
|
end; |
545 |
|
|
558 |
|
InsertSQL := InsertSQL + Separator + '"' + FieldNames[I] + '"' |
559 |
|
else |
560 |
|
InsertSQL := InsertSQL + Separator + FieldNames[I] ; |
561 |
< |
Separator := ','; |
561 |
> |
Separator := ', '; |
562 |
|
end; |
563 |
|
InsertSQL := InsertSQL + ')'; |
564 |
|
SQL.Add(InsertSQL); |
567 |
|
for I := 0 to FieldNames.Count - 1 do |
568 |
|
begin |
569 |
|
InsertSQL := InsertSQL + Separator + FieldNames[I] ; |
570 |
< |
Separator := ',:'; |
570 |
> |
Separator := ', :'; |
571 |
|
end; |
572 |
|
InsertSQL := InsertSQL + ')'; |
573 |
|
SQL.Add(InsertSQL); |
591 |
|
Separator := ','#$0d#$0a' A.'; |
592 |
|
end; |
593 |
|
SQL.Add(UpdateSQL); |
594 |
< |
AddWhereClause(TableName,QuotedStrings,SQL) |
594 |
> |
AddWhereClause(TableName,QuotedStrings,SQL,true) |
595 |
|
end; |
596 |
|
|
597 |
|
procedure TIBSystemTables.GenerateDeleteSQL(TableName: string; QuotedStrings: boolean; SQL: TStrings); |
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; |