ViewVC Help
View File | Revision Log | Show Annotations | Download File | View Changeset | Root Listing
root/public/ibx/trunk/design/IBSystemTables.pas
Revision: 7
Committed: Sun Aug 5 18:28:19 2012 UTC (11 years, 7 months ago) by tony
Content type: text/x-pascal
File size: 23826 byte(s)
Log Message:
Committing updates for Release R1-0-0

File Contents

# User Rev Content
1 tony 7 (*
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 tony 5
27 tony 7 unit IBSystemTables;
28    
29 tony 5 {$mode objfpc}{$H+}
30    
31     interface
32    
33     uses
34 tony 7 Classes, SysUtils, IBSQL, IBDatabase, StdCtrls;
35 tony 5
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 tony 7 FGetProcedures: TIBSQL;
49     FGetProcedureParams: TIBSQL;
50     FGetProcedureInfo: TIBSQL;
51 tony 5 function GetSQLType(SQLType: TIBSQLTypes): string;
52 tony 7 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 tony 5 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 tony 7 IncludePrimaryKeys:boolean=true; IncludeReadOnlyFields: boolean = true);
63 tony 5 procedure GetPrimaryKeys(TableName: string; PrimaryKeys: TStrings);
64     procedure GetTableAndColumns(SelectSQL: string; var FirstTableName: string;
65     Columns: TStrings);
66 tony 7 procedure GetProcedureNames(ProcNames: TStrings; WithOutputParams: boolean=false);
67     procedure GetProcParams(ProcName: string; var ExecuteOnly: boolean;
68     InputParams, OutputParams: TStrings); overload;
69 tony 5 procedure GetGenerators(GeneratorNames: TStrings);
70 tony 7 procedure GenerateSelectSQL(TableName: string; QuotedStrings: boolean; FieldNames,SQL: TStrings);
71     procedure GenerateRefreshSQL(TableName: string; QuotedStrings: boolean; FieldNames,SQL: TStrings);
72 tony 5 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 tony 7 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 tony 5 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 tony 7 sqlGETALLFIELDS = 'Select Trim(RDB$FIELD_NAME) as ColumnName FROM RDB$RELATION_FIELDS ' +
94 tony 5 'Where RDB$RELATION_NAME = :TableName ' +
95     'order by RDB$FIELD_POSITION asc ';
96    
97 tony 7 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 tony 5 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 tony 7 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 tony 5 '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 tony 7 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 tony 5 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 tony 7 QuotedStrings: boolean; SQL: TStrings; UseOldValues: boolean);
160 tony 5 var WhereClause: string;
161     Separator: string;
162     Count: integer;
163 tony 7 Prefix: string;
164 tony 5 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 tony 7 if UseOldValues then
172     Prefix := ':OLD_'
173     else
174     Prefix := ':';
175 tony 5 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 tony 7 WhereClause := WhereClause + Separator + '"' + FGetPrimaryKeys.FieldByName('ColumnName').AsString +
184     '" = ' + Prefix+ FGetPrimaryKeys.FieldByName('ColumnName').AsString
185 tony 5 else
186 tony 7 WhereClause := WhereClause + Separator + FGetPrimaryKeys.FieldByName('ColumnName').AsString +
187     ' = ' + Prefix + FGetPrimaryKeys.FieldByName('ColumnName').AsString;
188 tony 5 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 tony 7 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 tony 5 constructor TIBSystemTables.Create;
265     begin
266     FGetTableNames := TIBSQL.Create(nil);
267     FGetFieldNames := TIBSQL.Create(nil);
268     FGetPrimaryKeys := TIBSQL.Create(nil);
269 tony 7 FGetProcedures := TIBSQL.Create(nil);
270 tony 5 FTestSQL := TIBSQL.Create(nil);
271     FTableAndColumnSQL := TIBSQL.Create(nil);
272     FGetGeneratorsSQL := TIBSQL.Create(nil);
273 tony 7 FGetProcedureParams := TIBSQL.Create(nil);
274     FGetProcedureInfo := TIBSQL.Create(nil);
275 tony 5 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 tony 7 if assigned(FGetProcedures) then FGetProcedures.Free;
286     if assigned(FGetProcedureParams) then FGetProcedureParams.Free;
287     if assigned(FGetProcedureInfo) then FGetProcedureInfo.Free;
288 tony 5 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 tony 7 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 tony 5 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 tony 7 procedure TIBSystemTables.GetFieldNames(TableName: string;
342     FieldNames: TStrings; IncludePrimaryKeys: boolean;
343     IncludeReadOnlyFields: boolean);
344 tony 5 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 tony 7 begin
353     if IncludeReadOnlyFields then
354     FGetFieldNames.SQL.Text := sqlGETALLFIELDS
355     else
356 tony 5 FGetFieldNames.SQL.Text := sqlGETFIELDS
357 tony 7 end
358 tony 5 else
359 tony 7 if IncludeReadOnlyFields then
360     FGetFieldNames.SQL.Text := sqlALLUPDATEFIELDS
361     else
362 tony 5 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 tony 7 FirstTableName := '';
404 tony 5 if not assigned(FTableAndColumnSQL.Database) or not FTableAndColumnSQL.Database.Connected or
405 tony 7 not assigned(FTableAndColumnSQL.Transaction) or (Trim(SelectSQL) = '') then
406 tony 5 Exit;
407     with FTableAndColumnSQL.Transaction do
408     if not InTransaction then StartTransaction;
409     FTableAndColumnSQL.SQL.Text := SelectSQL;
410     try
411     FTableAndColumnSQL.Prepare;
412 tony 7 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 tony 5 except on E:EIBError do
435 tony 7 // ShowMessage(E.Message);
436 tony 5 end;
437     end;
438    
439 tony 7 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 tony 5 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 tony 7 procedure TIBSystemTables.GenerateSelectSQL(TableName: string; QuotedStrings: boolean; FieldNames,SQL: TStrings);
515 tony 5 var SelectSQL: string;
516     Separator : string;
517 tony 7 I: integer;
518 tony 5 begin
519 tony 7 SQL.Clear;
520 tony 5 if not assigned(FGetFieldNames.Database) or not FGetFieldNames.Database.Connected or
521     not assigned(FGetFieldNames.Transaction) then
522 tony 7 begin
523     Messagedlg('No Database Connected',mtError,[mbOK],0);
524 tony 5 Exit;
525 tony 7 end;
526 tony 5 SelectSQL := 'Select';
527     Separator := ' A.';
528 tony 7 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 tony 5 end;
536     SelectSQL := SelectSQL + ' From ' + TableName + ' A';
537     SQL.Add(SelectSQL);
538     end;
539    
540 tony 7 procedure TIBSystemTables.GenerateRefreshSQL(TableName: string; QuotedStrings: boolean; FieldNames,SQL: TStrings);
541 tony 5 begin
542 tony 7 GenerateSelectSQL(TableName,QuotedStrings,FieldNames,SQL);
543 tony 5 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 tony 7 Separator := ', ';
562 tony 5 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 tony 7 Separator := ', :';
571 tony 5 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 tony 7 AddWhereClause(TableName,QuotedStrings,SQL,true)
595 tony 5 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 tony 7 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 tony 5 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 tony 7 begin
709     Messagedlg('No Database Connected',mtError,[mbOK],0);
710 tony 5 Exit;
711 tony 7 end;
712 tony 5 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