ViewVC Help
View File | Revision Log | Show Annotations | Download File | View Changeset | Root Listing
root/public/ibx/trunk/design/IBSystemTables.pas
Revision: 17
Committed: Sat Dec 28 19:22:24 2013 UTC (10 years, 3 months ago) by tony
Content type: text/x-pascal
File size: 24548 byte(s)
Log Message:
Committing updates for Release R1-0-5

File Contents

# Content
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