ViewVC Help
View File | Revision Log | Show Annotations | Download File | View Changeset | Root Listing
root/public/ibx/trunk/design/IBSystemTables.pas
(Generate patch)

Comparing ibx/trunk/design/IBSystemTables.pas (file contents):
Revision 6 by tony, Fri Feb 18 16:26:16 2011 UTC vs.
Revision 7 by tony, Sun Aug 5 18:28:19 2012 UTC

# Line 1 | Line 1
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  
# Line 19 | Line 45 | type
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  
# Line 51 | Line 90 | const
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)' +
# Line 70 | Line 121 | const
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
# Line 91 | Line 156 | begin
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
# Line 102 | Line 168 | begin
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;
# Line 110 | Line 180 | begin
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;
# Line 123 | Line 195 | begin
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;
# Line 141 | Line 282 | begin
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  
# Line 163 | Line 307 | begin
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);
# Line 185 | Line 338 | begin
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
# Line 195 | Line 349 | begin
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;
# Line 238 | Line 400 | procedure TIBSystemTables.GetTableAndCol
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  
# Line 282 | Line 511 | begin
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  
# Line 333 | Line 558 | begin
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);
# Line 342 | Line 567 | begin
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);
# Line 366 | Line 591 | begin
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);
# Line 376 | Line 601 | begin
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;

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines