trunk/design/IBSQLEditFrame.pas

(*
 *  IBX For Lazarus (Firebird Express)
 *
 *  The contents of this file are subject to the Initial Developer's
 *  Public License Version 1.0 (the "License"); you may not use this
 *  file except in compliance with the License. You may obtain a copy
 *  of the License here:
 *
 *    http://www.firebirdsql.org/index.php?op=doc&id=idpl
 *
 *  Software distributed under the License is distributed on an "AS
 *  IS" basis, WITHOUT WARRANTY OF ANY KIND, either express or
 *  implied. See the License for the specific language governing rights
 *  and limitations under the License.
 *
 *  The Initial Developer of the Original Code is Tony Whyman.
 *
 *  The Original Code is (C) 2011-17 Tony Whyman, MWA Software
 *  (http://www.mwasoftware.co.uk).
 *
 *  All Rights Reserved.
 *
 *  Contributor(s): ______________________________________.
 *
*)
unit IBSQLEditFrame;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, FileUtil, SynEdit, SynHighlighterSQL, LResources, Forms,
  Controls, ActnList, Menus, Dialogs, ComCtrls, ExtCtrls, StdCtrls, IBQuery,
  IBSQL, IBDatabase, IBUpdate, IBDatabaseInfo,
  IBCustomDataset, db, LazSynTextArea, IB;

type

  { TIBSQLEditFrame }

  TIBSQLEditFrame = class(TFrame)
    PackageNameSource: TDataSource;
    PackageNames: TIBQuery;
    ReadOnlyFieldsSource: TDataSource;
    IBUpdate6: TIBUpdate;
    ReadOnlyFields: TIBQuery;
    IBUpdate5: TIBUpdate;
    IdentityColsSource: TDataSource;
    FieldNameList: TIBQuery;
    FieldsSource: TDataSource;
    DatabaseInfo: TIBDatabaseInfo;
    IdentityCols: TIBQuery;
    IBUpdate1: TIBUpdate;
    IBUpdate2: TIBUpdate;
    IBUpdate3: TIBUpdate;
    IBUpdate4: TIBUpdate;
    SQLTransaction: TIBTransaction;
    IdentifyStatementSQL: TIBSQL;
    PrimaryKeys: TIBQuery;
    PrimaryKeySource: TDataSource;
    ProcInputParams: TIBQuery;
    ProcInputSource: TDataSource;
    ProcOutputParams: TIBQuery;
    ProcOutputSource: TDataSource;
    Redo: TAction;
    ToolButton10: TToolButton;
    ToolButton11: TToolButton;
    Undo: TAction;
    SaveToFile: TAction;
    LoadFromFile: TAction;
    BtnImages: TImageList;
    MenuItem8: TMenuItem;
    MenuItem9: TMenuItem;
    OpenDialog1: TOpenDialog;
    SaveDialog1: TSaveDialog;
    ToolBar1: TToolBar;
    ToolButton1: TToolButton;
    ToolButton2: TToolButton;
    ToolButton3: TToolButton;
    ToolButton4: TToolButton;
    ToolButton5: TToolButton;
    ToolButton6: TToolButton;
    ToolButton7: TToolButton;
    ToolButton8: TToolButton;
    ToolButton9: TToolButton;
    UserProcedures: TIBQuery;
    UserProcSource: TDataSource;
    UserTables: TIBQuery;
    UserTableSource: TDataSource;
    WrapText: TAction;
    Clear: TAction;
    MenuItem1: TMenuItem;
    MenuItem2: TMenuItem;
    MenuItem3: TMenuItem;
    MenuItem4: TMenuItem;
    MenuItem5: TMenuItem;
    MenuItem6: TMenuItem;
    MenuItem7: TMenuItem;
    PopupMenu1: TPopupMenu;
    SelectAll: TAction;
    Paste: TAction;
    CopyText: TAction;
    Cut: TAction;
    ActionList1: TActionList;
    SQLText: TSynEdit;
    SynSQLSyn1: TSynSQLSyn;
    procedure ClearExecute(Sender: TObject);
    procedure CopyTextExecute(Sender: TObject);
    procedure CutExecute(Sender: TObject);
    procedure CutUpdate(Sender: TObject);
    procedure FieldNameListBeforeOpen(DataSet: TDataSet);
    procedure IBUpdate1ApplyUpdates(Sender: TObject; UpdateKind: TUpdateKind;
      Params: ISQLParams);
    procedure LoadFromFileExecute(Sender: TObject);
    procedure PackageNamesAfterScroll(DataSet: TDataSet);
    procedure PackageNamesBeforeClose(DataSet: TDataSet);
    procedure PasteExecute(Sender: TObject);
    procedure PasteUpdate(Sender: TObject);
    procedure RedoExecute(Sender: TObject);
    procedure RedoUpdate(Sender: TObject);
    procedure SaveToFileExecute(Sender: TObject);
    procedure SelectAllExecute(Sender: TObject);
    procedure SelectAllUpdate(Sender: TObject);
    procedure UndoExecute(Sender: TObject);
    procedure UndoUpdate(Sender: TObject);
    procedure UserProceduresAfterOpen(DataSet: TDataSet);
    procedure UserProceduresBeforeClose(DataSet: TDataSet);
    procedure UserProceduresBeforeOpen(DataSet: TDataSet);
    procedure UserTablesAfterOpen(DataSet: TDataSet);
    procedure UserTablesBeforeClose(DataSet: TDataSet);
    procedure UserTablesBeforeOpen(DataSet: TDataSet);
    procedure WrapTextExecute(Sender: TObject);
    procedure WrapTextUpdate(Sender: TObject);
  private
    FDatabase: TIBDatabase;
    FExcludeIdentityColumns: boolean;
    FExecuteOnlyProcs: boolean;
    FIncludeReadOnlyFields: boolean;
    FIncludeSystemTables: boolean;
    FOnUserTablesOpened: TNotifyEvent;
    FOpening: boolean;
    FSelectProcs: boolean;
    FQuerySync: boolean;
    procedure AddWhereClause(QuotedStrings: boolean; SQL: TStrings;
      UseOldValues: boolean);
    function GetSQLType(SQLType: TIBSQLStatementTypes): string;
    procedure GetFieldNames(Dataset: TDataset; var FieldNames: TStrings;
      aIncludeReadOnly: boolean = true);
    procedure GenerateSelectSQL(TableName: string; QuotedStrings: boolean; FieldNames,PrimaryKeyNames, SQL: TStrings); overload;
    procedure GenerateInsertSQL(TableName: string; QuotedStrings: boolean;
      FieldNames, ReadOnlyFieldNames,  SQL: TStrings); overload;
    procedure GenerateModifySQL(TableName: string; QuotedStrings: boolean;
      FieldNames, ReadOnlyFieldNames, SQL: TStrings); overload;
    procedure GenerateExecuteSQL(PackageName, ProcName: string;
      QuotedStrings: boolean; ExecuteOnly: boolean; InputParams, OutputParams,
  ExecuteSQL: TStrings); overload;
    procedure GenerateDeleteSQL(TableName: string; QuotedStrings: boolean; ReadOnlyFieldNames, SQL: TStrings); overload;
    procedure SetDatabase(AValue: TIBDatabase);
    procedure SetExcludeIdentityColumns(AValue: boolean);
    procedure SetExecuteOnlyProcs(AValue: boolean);
    procedure SetIncludeReadOnlyFields(AValue: boolean);
    procedure SetIncludeSystemTables(AValue: boolean);
    procedure SetSelectProcs(AValue: boolean);

  public
    constructor Create(aOwner: TComponent); override;
    procedure DoWrapText(Lines: TStrings); overload;
    procedure DoWrapText; overload;
    procedure UnWrapText;
    procedure RefreshAll;
    procedure SelectAllFields(Checked: boolean);
    procedure GenerateSelectSQL(QuotedStrings: boolean; AddReadOnlyFields: boolean = false); overload;
    procedure GenerateSelectSQL(QuotedStrings: boolean; SQL: TStrings; AddReadOnlyFields: boolean = false); overload;
    procedure GenerateRefreshSQL(QuotedStrings: boolean);
    procedure GenerateRefreshSQL(QuotedStrings: boolean; SQL: TStrings; AddReadOnlyFields: boolean = false);
    procedure GenerateExecuteSQL(QuotedStrings: boolean); overload;
    procedure GenerateInsertSQL(QuotedStrings: boolean); overload;
    procedure GenerateInsertSQL(QuotedStrings: boolean; SQL: TStrings); overload;
    procedure GenerateModifySQL(QuotedStrings: boolean; aIncludePrimaryKeys: boolean); overload;
    procedure GenerateModifySQL(QuotedStrings: boolean; SQL: TStrings; aIncludePrimaryKeys: boolean); overload;
    procedure GenerateDeleteSQL(QuotedStrings: boolean); overload;
    procedure GenerateDeleteSQL(QuotedStrings: boolean; SQL: TStrings); overload;
    function GetStatementType(var IsStoredProcedure: boolean): TIBSQLStatementTypes;
    procedure InsertSelectedPrimaryKey;
    procedure InsertSelectedFieldName;
    procedure InsertTableName;
    procedure InsertProcName;
    procedure InsertPackageName;
    procedure InsertSelectedInputParam;
    procedure InsertSelectedOutputParam;
    procedure InsertSelectedIdentityCol;
    procedure InsertSelectedReadOnlyField;
    procedure OpenUserProcedures;
    function SyncQueryBuilder: TIBSQLStatementTypes; overload;
    function SyncQueryBuilder(SQL: TStrings): TIBSQLStatementTypes; overload;
    procedure TestSQL(GenerateParamNames: boolean);
    property Database: TIBDatabase read FDatabase write SetDatabase;
    property IncludeReadOnlyFields: boolean read FIncludeReadOnlyFields write SetIncludeReadOnlyFields;
    property IncludeSystemTables: boolean read FIncludeSystemTables write SetIncludeSystemTables;
    property ExcludeIdentityColumns: boolean read FExcludeIdentityColumns write SetExcludeIdentityColumns;
    property ExecuteOnlyProcs: boolean read FExecuteOnlyProcs write SetExecuteOnlyProcs;
    property SelectProcs: boolean read FSelectProcs write SetSelectProcs;
    property OnUserTablesOpened: TNotifyEvent read FOnUserTablesOpened write FOnUserTablesOpened;
  end;

implementation

Uses IBUtils, FBMessages, Variants;

{$R *.lfm}

const
  sNoPrimaryKeys = 'RF.RDB$FIELD_NAME not in ' +
                    '(Select RDB$FIELD_NAME FROM RDB$INDEX_SEGMENTS S JOIN RDB$RELATION_CONSTRAINTS C On C.RDB$INDEX_NAME = S.RDB$INDEX_NAME '+
                     'Where C.RDB$CONSTRAINT_TYPE = ''PRIMARY KEY'' and C.RDB$RELATION_NAME = RF.RDB$RELATION_NAME)';

{ TIBSQLEditFrame }

procedure TIBSQLEditFrame.CutUpdate(Sender: TObject);
begin
  (Sender as TAction).Enabled := SQLText.SelText <> '';
end;

procedure TIBSQLEditFrame.FieldNameListBeforeOpen(DataSet: TDataSet);
begin
  if not IncludeReadOnlyFields then
    (DataSet as TIBQuery).Parser.Add2WhereClause('B.RDB$COMPUTED_SOURCE is NULL');
  (DataSet as TIBQuery).Parser.Add2WhereClause(sNoPrimaryKeys);
  if ExcludeIdentityColumns and (DatabaseInfo.ODSMajorVersion >= 12) then
    (DataSet as TIBQuery).Parser.Add2WhereClause('RF.RDB$IDENTITY_TYPE is NULL');
end;

procedure TIBSQLEditFrame.IBUpdate1ApplyUpdates(Sender: TObject;
  UpdateKind: TUpdateKind; Params: ISQLParams);
begin
  //do nothing - dummy to allow edits without database update
end;

procedure TIBSQLEditFrame.LoadFromFileExecute(Sender: TObject);
begin
  if OpenDialog1.Execute then
    SQLText.Lines.LoadFromFile(OpenDialog1.FileName);
end;

procedure TIBSQLEditFrame.PackageNamesAfterScroll(DataSet: TDataSet);
begin
  UserProcedures.Active := false;
  UserProcedures.Active := true;
end;

procedure TIBSQLEditFrame.PackageNamesBeforeClose(DataSet: TDataSet);
begin
  UserProcedures.Active := false;
end;

procedure TIBSQLEditFrame.PasteExecute(Sender: TObject);
begin
  SQLText.PasteFromClipboard;
end;

procedure TIBSQLEditFrame.PasteUpdate(Sender: TObject);
begin
  (Sender as TAction).Enabled := SQLText.CanPaste;
end;

procedure TIBSQLEditFrame.RedoExecute(Sender: TObject);
begin
  SQLText.Redo;
end;

procedure TIBSQLEditFrame.RedoUpdate(Sender: TObject);
begin
  (Sender as TAction).Enabled := SQLText.CanRedo;
end;

procedure TIBSQLEditFrame.SaveToFileExecute(Sender: TObject);
begin
  if SaveDialog1.Execute then
    SQLText.Lines.SaveToFile(SaveDialog1.FileName);
end;

procedure TIBSQLEditFrame.SelectAllExecute(Sender: TObject);
begin
  SQLText.SelectAll;
end;

procedure TIBSQLEditFrame.SelectAllUpdate(Sender: TObject);
begin
  (Sender as TAction).Enabled := SQLText.Lines.Count > 0;
end;

procedure TIBSQLEditFrame.UndoExecute(Sender: TObject);
begin
  SQLText.Undo;
end;

procedure TIBSQLEditFrame.UndoUpdate(Sender: TObject);
begin
  (Sender as TAction).Enabled := SQLText.CanUndo;
end;

procedure TIBSQLEditFrame.UserProceduresAfterOpen(DataSet: TDataSet);
begin
  ProcInputParams.Active := true;
  ProcOutputParams.Active := true;
end;

procedure TIBSQLEditFrame.UserProceduresBeforeClose(DataSet: TDataSet);
begin
  ProcInputParams.Active := false;
  ProcOutputParams.Active := false;
end;

procedure TIBSQLEditFrame.UserProceduresBeforeOpen(DataSet: TDataSet);
begin
  if not (ExecuteOnlyProcs and SelectProcs) then
  begin
    if ExecuteOnlyProcs then
      (DataSet as TIBQuery).Parser.Add2WhereClause('RDB$PROCEDURE_TYPE = 2');
    if SelectProcs then
      (DataSet as TIBQuery).Parser.Add2WhereClause('RDB$PROCEDURE_TYPE = 1 AND RDB$PROCEDURE_OUTPUTS > 0');
  end;
  if PackageNames.Active then
  begin
    if PackageNames.FieldByName('PACKAGE_NAME_TYPE').AsInteger = 0 then {global procedures}
      (DataSet as TIBQuery).Parser.Add2WhereClause('RDB$PACKAGE_NAME is NULL')
    else
      (DataSet as TIBQuery).Parser.Add2WhereClause('RDB$PACKAGE_NAME = ''' +
           PackageNames.FieldByName('RDB$PACKAGE_NAME').AsString + '''');
  end;
//  writeln((DataSet as TIBQuery).Parser.SQLText);
end;

procedure TIBSQLEditFrame.UserTablesAfterOpen(DataSet: TDataSet);
begin
  FieldNameList.Active := true;
  PrimaryKeys.Active := true;
  IdentityCols.Active := DatabaseInfo.ODSMajorVersion >= 12;
  ReadOnlyFields.Active := true;
  FOpening := true;
  try
    if assigned(FOnUserTablesOpened) then
      OnUserTablesOpened(self);
  finally
    FOpening := false;
  end;
end;

procedure TIBSQLEditFrame.UserTablesBeforeClose(DataSet: TDataSet);
begin
  FieldNameList.Active := false;
  PrimaryKeys.Active := false;
  IdentityCols.Active := false;
  ReadOnlyFields.Active := false;
end;

procedure TIBSQLEditFrame.UserTablesBeforeOpen(DataSet: TDataSet);
begin
  if not IncludeSystemTables then
    (DataSet as TIBQuery).Parser.Add2WhereClause('RDB$SYSTEM_FLAG = 0');
end;

procedure TIBSQLEditFrame.WrapTextExecute(Sender: TObject);
begin
  UnWrapText;
  DoWrapText;
end;

procedure TIBSQLEditFrame.WrapTextUpdate(Sender: TObject);
begin
  (Sender as TAction).Enabled := SQLText.Lines.Count > 0;
end;

procedure TIBSQLEditFrame.SetDatabase(AValue: TIBDatabase);
var i: integer;
begin
  if FDatabase = AValue then Exit;
  FDatabase := AValue;
  FirebirdAPI.GetStatus.SetIBDataBaseErrorMessages([ShowIBMessage]);
  SQLTransaction.Active := false;
  SQLTransaction.DefaultDatabase := FDatabase;
  for i := 0 to ComponentCount - 1 do
    if Components[i] is TIBCustomDataset then
      TIBCustomDataset(Components[i]).Database := FDatabase
    else
    if Components[i] is TIBSQL then
      TIBSQL(Components[i]).Database := FDatabase
    else
    if Components[i] is TIBDatabaseInfo then
      TIBDatabaseInfo(Components[i]).Database := FDatabase;
  if (FDatabase <> nil) and FDatabase.Connected then
    SQLTransaction.Active := true;
end;

procedure TIBSQLEditFrame.SetExcludeIdentityColumns(AValue: boolean);
begin
  if FExcludeIdentityColumns = AValue then Exit;
  FExcludeIdentityColumns := AValue;
  RefreshAll;
end;

procedure TIBSQLEditFrame.SetExecuteOnlyProcs(AValue: boolean);
begin
  if FExecuteOnlyProcs = AValue then Exit;
  FExecuteOnlyProcs := AValue;
  RefreshAll;
end;

procedure TIBSQLEditFrame.SetIncludeReadOnlyFields(AValue: boolean);
begin
  if FIncludeReadOnlyFields = AValue then Exit;
  FIncludeReadOnlyFields := AValue;
  RefreshAll;
end;

procedure TIBSQLEditFrame.SetIncludeSystemTables(AValue: boolean);
begin
  if FIncludeSystemTables = AValue then Exit;
  FIncludeSystemTables := AValue;
  RefreshAll;
  SyncQueryBuilder;
end;

procedure TIBSQLEditFrame.SetSelectProcs(AValue: boolean);
begin
  if FSelectProcs = AValue then Exit;
  FSelectProcs := AValue;
  RefreshAll;
end;

constructor TIBSQLEditFrame.Create(aOwner: TComponent);
begin
  inherited Create(aOwner);
  FIncludeReadOnlyFields := true;
end;

procedure TIBSQLEditFrame.DoWrapText;
begin
  DoWrapText(SQLText.Lines);
  if assigned(SQLText.OnChange) then
    SQLText.OnChange(self);
end;

type
  THackedSynEdit = class(TSynEdit)
  public
    property TextArea: TLazSynTextArea read FTextArea;
  end;

procedure TIBSQLEditFrame.DoWrapText(Lines: TStrings);

var NewLines: TStringList;
    i: integer;
    MaxWidth: integer;
    MaxChars: integer;
    Line: string;
    Tokeniser: TSynSQLSyn;
    SplitAt: integer;
    SQLParam: boolean;
begin
  NewLines := TStringList.Create;
  Tokeniser := TSynSQLSyn.Create(nil); {use the highligher as a tokeniser}
  try
    Tokeniser.SQLDialect := sqlInterbase6;
    SQlText.Canvas.Font := SQLText.Font;
    with THackedSynEdit(SQLText).TextArea do
      MaxWidth := Right - Left;
    for i := 0 to Lines.Count - 1 do
    begin
      Line := Lines[i];
      repeat
        if (Length(Line) = 0) or (SQlText.Canvas.TextWidth(Line) <= MaxWidth) then
        begin
          NewLines.Add(Line);
          break; {next line}
        end
        else
        begin
          {Need to split the line at the last complete SQL token}
          MaxChars := SQlText.Canvas.TextFitInfo(Line,MaxWidth);
          SQLParam := false;
          Tokeniser.ResetRange;
          Tokeniser.SetLine(Line,i);
          SplitAt := 0;
          while (Tokeniser.GetTokenPos < MaxChars) and not Tokeniser.GetEol do
          begin
            if not SQLParam then
              SplitAt := Tokeniser.GetTokenPos; {combine param indicator with param}
            SQLParam := Tokeniser.GetToken =  ':';
            Tokeniser.Next;
          end;

          if SplitAt <= 0 then {token overflows line}
          begin
            NewLines.Add(Line);
            break; {next line}
          end;
          NewLines.Add(system.copy(Line,1,SplitAt));
          system.Delete(Line,1,SplitAt);
        end;
      until Length(Line) = 0;
    end;
    Lines.Assign(NewLines);
  finally
    NewLines.Free;
    Tokeniser.Free;
  end;
end;

const
  Separators = [' ',#$09,',','.',':'];

procedure TIBSQLEditFrame.UnWrapText;
var Line: string;
    i: integer;
begin
  Line := '';
  with SQLText do
  begin
    for i := 0 to Lines.Count - 1 do
    begin
      if (Length(Line) > 0) and not (Line[Length(Line)] in Separators) then
        Line := Line + ' ';
     Line := Line + Lines[i];
    end;

    if assigned(OnChange) then
      OnChange(self);
    Lines.Text := Line;
  end;
end;

procedure TIBSQLEditFrame.RefreshAll;
begin
  if UserTables.Active then
  begin
    UserTables.Active := false;
    UserTables.Active := true;
  end;
  if PackageNames.Active then
  begin
    PackageNames.Active := false;
    OpenUserProcedures;
  end
  else
  if UserProcedures.Active then
  begin
    UserProcedures.Active := false;
    OpenUserProcedures;
  end;
end;

procedure TIBSQLEditFrame.SelectAllFields(Checked: boolean);

  procedure DoSelectAllFields(Dataset: TDataset; aValue: boolean);
  begin
    with Dataset do
    if Active then
    begin
      DisableControls;
      try
        First;
        while not Eof do
        begin
          Edit;
          FieldByName('Selected').AsInteger := ord(aValue);
          Post;
          Next;
        end;
        First;
      finally
        EnableControls;
      end;
    end;
  end;

begin
  if FOpening or (Database = nil) or not Database.Connected then Exit;
  DoSelectAllFields(FieldNameList,Checked);
  DoSelectAllFields(PrimaryKeys,Checked);
  DoSelectAllFields(IdentityCols,Checked);
  DoSelectAllFields(ReadOnlyFields,Checked);
end;

procedure TIBSQLEditFrame.GenerateSelectSQL(QuotedStrings: boolean;
  AddReadOnlyFields: boolean);
begin
  GenerateSelectSQL(QuotedStrings,SQLText.Lines,AddReadOnlyFields);
end;

procedure TIBSQLEditFrame.GenerateRefreshSQL(QuotedStrings: boolean);
begin
  GenerateRefreshSQL(QuotedStrings,SQLText.Lines);
end;

procedure TIBSQLEditFrame.GenerateSelectSQL(QuotedStrings: boolean;
  SQL: TStrings; AddReadOnlyFields: boolean);
var FieldNames: TStrings;
    PrimaryKeyNames: TStrings;
    ReadOnlyFieldNames: TStrings;
begin
  SQL.Clear;
  FieldNames := TStringList.Create;
  PrimaryKeyNames := TStringList.Create;
  ReadOnlyFieldNames := TStringList.Create;
  try
    GetFieldNames(PrimaryKeys,PrimaryKeyNames);
    GetFieldNames(FieldNameList,FieldNames);
    if not IncludeReadOnlyFields and AddReadOnlyFields then
    begin
      GetFieldNames(ReadOnlyFields,ReadOnlyFieldNames,true);
      FieldNames.AddStrings(ReadOnlyFieldNames);
    end;
    GenerateSelectSQL(UserTables.FieldByName('RDB$RELATION_NAME').AsString,QuotedStrings,FieldNames,PrimaryKeyNames,SQL);
  finally
    FieldNames.Free;
    PrimaryKeyNames.Free;
    ReadOnlyFieldNames.Free;
  end;
  DoWrapText(SQL);
end;

procedure TIBSQLEditFrame.GenerateRefreshSQL(QuotedStrings: boolean;
  SQL: TStrings; AddReadOnlyFields: boolean);
begin
  SQL.Clear;
  GenerateSelectSQL(QuotedStrings,SQL,AddReadOnlyFields);
  AddWhereClause(QuotedStrings,SQL,false);
end;

procedure TIBSQLEditFrame.GenerateExecuteSQL(QuotedStrings: boolean);
var InputParams: TStrings;
    OutputParams: TStrings;
    PackageName: string;
begin
  SQLText.Lines.Clear;

  InputParams := TStringList.Create;
  OutputParams := TStringList.Create;
  try
    if PackageNames.Active and (PackageNames.FieldByName('Package_Name_Type').AsInteger = 1) then
      PackageName := PackageNames.FieldByName('RDB$PACKAGE_NAME').AsString
    else
      PackageName := '';
    GetFieldNames(ProcInputParams,InputParams);
    GetFieldNames(ProcOutputParams,OutputParams);
    GenerateExecuteSQL(PackageName,UserProcedures.FieldByName('RDB$PROCEDURE_NAME').AsString,
      QuotedStrings, UserProcedures.FieldByName('RDB$PROCEDURE_TYPE').AsInteger = 2,
      InputParams,OutputParams,SQLText.Lines);
  finally
    InputParams.Free;
    OutputParams.Free;
  end;
end;

procedure TIBSQLEditFrame.GenerateInsertSQL(QuotedStrings: boolean);
begin
  GenerateInsertSQL(QuotedStrings,SQLText.Lines);
end;

procedure TIBSQLEditFrame.GenerateModifySQL(QuotedStrings: boolean;
  aIncludePrimaryKeys: boolean);
begin
  GenerateModifySQL(QuotedStrings,SQLText.Lines,aIncludePrimaryKeys);
end;

procedure TIBSQLEditFrame.GenerateDeleteSQL(QuotedStrings: boolean);
begin
  GenerateDeleteSQL(QuotedStrings,SQLText.Lines);
end;

procedure TIBSQLEditFrame.GenerateInsertSQL(QuotedStrings: boolean; SQL: TStrings);
var FieldNames: TStrings;
    ReadOnlyFieldNames: TStrings;
    InsertFields: TStrings;
    I: integer;
begin
  SQL.Clear;
  FieldNames := TStringList.Create;
  ReadOnlyFieldNames := TStringList.Create;
  InsertFields := TStringList.Create;
  try
    GetFieldNames(PrimaryKeys,InsertFields);
    for I := InsertFields.Count - 1 downto 0 do
      if IdentityCols.Active and IdentityCols.Locate('ColumnName;Selected',VarArrayOf([InsertFields[I],1]),[loCaseInsensitive]) then
        InsertFields.Delete(I);
    GetFieldNames(FieldNameList,FieldNames,false);
    InsertFields.AddStrings(FieldNames);
    GetFieldNames(ReadOnlyFields,ReadOnlyFieldNames,true);
    GenerateInsertSQL(UserTables.FieldByName('RDB$RELATION_NAME').AsString,QuotedStrings,InsertFields,ReadOnlyFieldNames,SQL);
  finally
    FieldNames.Free;
    ReadOnlyFieldNames.Free;
    InsertFields.Free;
  end;
  DoWrapText(SQL);
end;

procedure TIBSQLEditFrame.GenerateModifySQL(QuotedStrings: boolean;
  SQL: TStrings; aIncludePrimaryKeys: boolean);
var FieldNames: TStrings;
    ReadOnlyFieldNames: TStrings;
    UpdateFields: TStrings;
begin
  SQL.Clear;
  FieldNames := TStringList.Create;
  ReadOnlyFieldNames := TStringList.Create;
  UpdateFields := TStringList.Create;
  try
    if aIncludePrimaryKeys then
      GetFieldNames(PrimaryKeys,UpdateFields);
    GetFieldNames(FieldNameList,FieldNames,false);
    UpdateFields.AddStrings(FieldNames);
    GetFieldNames(ReadOnlyFields,ReadOnlyFieldNames,true);
    GenerateModifySQL(UserTables.FieldByName('RDB$RELATION_NAME').AsString,
           QuotedStrings,UpdateFields,ReadOnlyFieldNames,SQL);
  finally
    FieldNames.Free;
    ReadOnlyFieldNames.Free;
    UpdateFields.Free;
  end;
end;

procedure TIBSQLEditFrame.GenerateDeleteSQL(QuotedStrings: boolean;
  SQL: TStrings);
var ReadOnlyFieldNames: TStrings;
begin
  SQL.Clear;
  ReadOnlyFieldNames := TStringList.Create;
  try
    GetFieldNames(ReadOnlyFields,ReadOnlyFieldNames,true);
    GenerateDeleteSQL(UserTables.FieldByName('RDB$RELATION_NAME').AsString,QuotedStrings,ReadOnlyFieldNames,SQL)
  finally
    ReadOnlyFieldNames.Free;
  end;
end;

procedure TIBSQLEditFrame.CutExecute(Sender: TObject);
begin
  SQLText.CutToClipboard;
end;

procedure TIBSQLEditFrame.CopyTextExecute(Sender: TObject);
begin
  SQLText.CopyToClipboard;
end;

procedure TIBSQLEditFrame.ClearExecute(Sender: TObject);
begin
  SQLText.Lines.Clear;
end;

procedure TIBSQLEditFrame.AddWhereClause(
  QuotedStrings: boolean; SQL: TStrings; UseOldValues: boolean);
var WhereClause: string;
    Separator: string;
    Count: integer;
    Prefix: string;
    ColumnName: string;
begin
  Count := 0;
  WhereClause := 'Where';
  Separator := ' A.';
  if UseOldValues then
    Prefix := ':OLD_'
  else
    Prefix := ':';
  with PrimaryKeys do
  begin
    DisableControls;
    try
      if State = dsEdit then Post;
      First;
      while not EOF do
      begin
        if FieldByName('Selected').AsInteger <> 0 then
        begin
          Inc(Count);
          ColumnName := FieldByName('ColumnName').AsString;
          if QuotedStrings then
            WhereClause := WhereClause + Separator + '"' + ColumnName +
                   '" = ' + Prefix+ AnsiUpperCase(ColumnName)
          else
            WhereClause := WhereClause + Separator + QuoteIdentifierIfNeeded(Database.SQLDialect,ColumnName) +
                   ' = ' + Prefix + AnsiUpperCase(ColumnName);
          Separator := ' AND A.';
        end;
        Next;
      end;
    finally
      EnableControls
    end;
  end;
  if Count > 0 then
    SQL.Add(WhereClause);
end;

function TIBSQLEditFrame.GetSQLType(SQLType: TIBSQLStatementTypes): string;
begin
  case SQLType of
  SQLUnknown:              Result := 'Unknown';
  SQLSelect:               Result := 'Select';
  SQLInsert:               Result := 'Insert';
  SQLUpdate:               Result := 'Update';
  SQLDelete:               Result := 'Delete';
  SQLDDL:                  Result := 'DDL';
  SQLGetSegment:           Result := 'GetSegment';
  SQLPutSegment:           Result := 'PutSegment';
  SQLExecProcedure:        Result := 'Execute Procedure';
  SQLStartTransaction:     Result := 'StartTransaction';
  SQLCommit:               Result := 'Commit';
  SQLRollback:             Result := 'Rollback';
  SQLSelectForUpdate:      Result := 'Select for Update';
  SQLSetGenerator:         Result := 'Set Generator';
  end;
end;

procedure TIBSQLEditFrame.GetFieldNames(Dataset: TDataset;
  var FieldNames: TStrings; aIncludeReadOnly: boolean);
begin
  with DataSet do
  begin
    DisableControls;
    try
      if State = dsEdit then Post;
      First;
      while not EOF do
      begin
        if (FieldByName('Selected').AsInteger <> 0) and (aIncludeReadOnly or (FieldByName('ReadOnly').AsInteger = 0)) then
          FieldNames.Add(FieldByName('ColumnName').AsString);
        Next;
      end;
    finally
      EnableControls
    end;
  end;
end;

procedure TIBSQLEditFrame.GenerateSelectSQL(TableName: string;
  QuotedStrings: boolean; FieldNames, PrimaryKeyNames, SQL: TStrings);
var SelectSQL: string;
    Separator : string;
    I: integer;
    Lines: TStrings;
begin
  SelectSQL := 'Select';
  Separator := ' A.';
  for I := 0 to PrimaryKeyNames.Count - 1 do
  begin
    if QuotedStrings then
      SelectSQL := SelectSQL + Separator + '"' + PrimaryKeyNames[I] + '"'
    else
      SelectSQL := SelectSQL + Separator + QuoteIdentifierIfNeeded(Database.SQLDialect,PrimaryKeyNames[I]);
    Separator := ', A.';
  end;
  for I := 0 to FieldNames.Count - 1 do
  begin
    if QuotedStrings then
      SelectSQL := SelectSQL + Separator + '"' + FieldNames[I] + '"'
    else
      SelectSQL := SelectSQL + Separator + QuoteIdentifierIfNeeded(Database.SQLDialect,FieldNames[I]);
    Separator := ', A.';
  end;
  if QuotedStrings then
    SelectSQL := SelectSQL + ' From "' + TableName + '" A'
  else
    SelectSQL := SelectSQL + ' From ' + QuoteIdentifierIfNeeded(Database.SQLDialect,TableName) + ' A';
  Lines := TStringList.Create;
  try
    Lines.Text := SelectSQL;
    SQL.AddStrings(Lines);
  finally
    Lines.Free;
  end;
end;

procedure TIBSQLEditFrame.GenerateInsertSQL(TableName: string;
  QuotedStrings: boolean; FieldNames, ReadOnlyFieldNames, SQL: TStrings);
var InsertSQL: string;
    Separator: string;
    Lines: TStrings;
    I: integer;
begin
  Lines := TStringList.Create;
  try
    if QuotedStrings then
      InsertSQL := 'Insert Into "' + TableName + '" ('
    else
      InsertSQL := 'Insert Into ' + QuoteIdentifierIfNeeded(Database.SQLDialect,TableName) + ' (';
    Separator := '';
    for I := 0 to FieldNames.Count - 1 do
      begin
        if QuotedStrings then
           InsertSQL := InsertSQL + Separator + '"' + FieldNames[I] + '"'
        else
           InsertSQL := InsertSQL + Separator +  QuoteIdentifierIfNeeded(Database.SQLDialect,FieldNames[I]) ;
        Separator := ', ';
      end;
    InsertSQL := InsertSQL + ')';
    Lines.Add(InsertSQL);
    InsertSQL := 'Values(';
    Separator := ':';
    for I := 0 to FieldNames.Count - 1 do
      begin
         InsertSQL := InsertSQL + Separator +  AnsiUpperCase(FieldNames[I]) ;
         Separator := ', :';
      end;
    InsertSQL := InsertSQL + ')';
    Lines.Add(InsertSQL);

    {Is database Firebird 2.1 or later?}
    if (DatabaseInfo.ODSMajorVersion > 11) or
        ((DatabaseInfo.ODSMajorVersion = 11) and (DatabaseInfo.ODSMinorVersion >= 1)) then
    begin
      InsertSQL := '';
      Separator := ' RETURNING ';
      if IdentityCols.Active and (IdentityCols.RecordCount > 0) then
      begin
        IdentityCols.First;
        while not IdentityCols.Eof do
        begin
          if (IdentityCols.FieldByName('Selected').AsInteger <> 0) and
             (not PrimaryKeys.Active or not PrimaryKeys.Locate('columnName;Selected',
                  VarArrayOf([IdentityCols.FieldByName('ColumnName').AsString,0]),[loCaseInsensitive])) then
          begin
            InsertSQL := InsertSQL + Separator + QuoteIdentifierIfNeeded(Database.SQLDialect,IdentityCols.FieldByName('ColumnName').AsString);
            Separator := ', ';
          end;
          IdentityCols.Next;
        end;
      end;
      for I := 0 to ReadOnlyFieldNames.Count - 1 do
        begin
          if QuotedStrings then
            InsertSQL := InsertSQL + Separator + '"' + ReadOnlyFieldNames[I] + '"'
          else
            InsertSQL := InsertSQL + Separator + QuoteIdentifierIfNeeded(Database.SQLDialect,ReadOnlyFieldNames[I]);
          Separator := ', ';
        end;
      Lines.Add(InsertSQL);
    end;
    SQL.AddStrings(Lines);
  finally
    Lines.Free;
  end;
end;

procedure TIBSQLEditFrame.GenerateModifySQL(TableName: string;
  QuotedStrings: boolean; FieldNames, ReadOnlyFieldNames, SQL: TStrings);
var UpdateSQL: string;
    Separator: string;
    I: integer;
begin
  Separator := '  A.';
  if QuotedStrings then
    UpdateSQL := 'Update "' + TableName + '" A Set '
  else
    UpdateSQL := 'Update ' + QuoteIdentifierIfNeeded(Database.SQLDialect,TableName) + ' A Set ';
  SQL.Add(UpdateSQL);
  for I := 0 to FieldNames.Count - 1 do
    begin
      if QuotedStrings then
        UpdateSQL := Separator + '"' + FieldNames[I] + '" = :' + AnsiUpperCase(FieldNames[I])
      else
        UpdateSQL := Separator + QuoteIdentifierIfNeeded(Database.SQLDialect,FieldNames[I]) + ' = :' + AnsiUpperCase(FieldNames[I]);
      if I < FieldNames.Count - 1 then
        UpdateSQL := UpdateSQL + ',';
      SQL.Add(UpdateSQL);
    end;
  AddWhereClause(QuotedStrings,SQL,true);

  {Is database Firebird 2.1 or later?}
  if (DatabaseInfo.ODSMajorVersion > 11) or
      ((DatabaseInfo.ODSMajorVersion = 11) and (DatabaseInfo.ODSMinorVersion >= 1)) then
  begin
    Separator := ' RETURNING A.';
    UpdateSQL := '';
    for I := 0 to ReadOnlyFieldNames.Count - 1 do
      begin
        if QuotedStrings then
          UpdateSQL := UpdateSQL + Separator + '"' + ReadOnlyFieldNames[I] + '"'
        else
          UpdateSQL := UpdateSQL + Separator + QuoteIdentifierIfNeeded(Database.SQLDialect,ReadOnlyFieldNames[I]);
        Separator := ', A.';
      end;
    SQL.Add(UpdateSQL);
  end;
end;

procedure TIBSQLEditFrame.GenerateDeleteSQL(TableName: string;
  QuotedStrings: boolean; ReadOnlyFieldNames, SQL: TStrings);
{var ReturningText, Separator: string;
    I: integer;   }
begin
  if QuotedStrings then
    SQL.Add('Delete From "' + TableName + '" A')
  else
    SQL.Add('Delete From ' + QuoteIdentifierIfNeeded(Database.SQLDialect,TableName) + ' A');
  AddWhereClause(QuotedStrings,SQL,true);
{  Separator := ' RETURNING A.';
  ReturningText := '';
  for I := 0 to ReadOnlyFieldNames.Count - 1 do
    begin
      if QuotedStrings then
        ReturningText := ReturningText + Separator + '"' + ReadOnlyFieldNames[I] + '"'
      else
        ReturningText := ReturningText + Separator + QuoteIdentifierIfNeeded(Database.SQLDialect,ReadOnlyFieldNames[I]);
      Separator := ', A.';
    end;
  SQL.Add(ReturningText);}
end;

const
  sqlCheckProcedureNames = 'Select * From RDB$PROCEDURES Where Upper(Trim(RDB$PROCEDURE_NAME)) = Upper(:ProcName)';

function TIBSQLEditFrame.GetStatementType(var IsStoredProcedure: boolean
  ): TIBSQLStatementTypes;
var TableName: string;
begin
  Result := sqlUnknown;
  if not assigned(Database) or not Database.Connected or (Trim(SQLText.Lines.Text) = '') then
    Exit;
  IsStoredProcedure := false;
  with TIBSQL.Create(nil) do
  try
    Database := self.Database;
    Transaction := SQLTransaction;
    SQL.Assign(SQLText.Lines);
    GenerateParamNames := true; {permissive}
    try
      Prepare;
      Result := SQLStatementType
    except on E:EIBError do
  //      ShowMessage(E.Message);
    end;
    if (Result = SQLSelect) and (MetaData.Count > 0)  then
    begin
      TableName := MetaData[0].GetRelationName;
      SQL.Text := sqlCheckProcedureNames;
      Prepare;
      ParamByName('ProcName').AsString := TableName;
      ExecQuery;
      try
        IsStoredProcedure := not EOF;
      finally
        Close
      end;
    end;
  finally
    Free
  end;
end;

procedure TIBSQLEditFrame.GenerateExecuteSQL(PackageName,ProcName: string;
  QuotedStrings: boolean; ExecuteOnly: boolean; InputParams, OutputParams,
  ExecuteSQL: TStrings);

  function GetProcName: string;
  begin
    if QuotedStrings then
    begin
      if PackageName = '' then
        Result := QuoteIdentifier(Database.SQLDialect,ProcName)
      else
        Result := QuoteIdentifier(Database.SQLDialect,PackageName) + '.' +
                  QuoteIdentifier(Database.SQLDialect,ProcName);
    end
    else
    if PackageName = '' then
      Result := QuoteIdentifierIfNeeded(Database.SQLDialect,ProcName)
    else
      Result := QuoteIdentifierIfNeeded(Database.SQLDialect,PackageName) + '.' +
                QuoteIdentifierIfNeeded(Database.SQLDialect,ProcName);
  end;

var SQL: string;
    I: integer;
    Separator: string;
    Lines: TStrings;
begin
  Lines := TStringList.Create;
  try
    Separator := '';
    if not ExecuteOnly and (OutputParams.Count > 0) then //Select Query
    begin
      SQL := 'Select ';
      for I := 0 to OutputParams.Count - 1 do
      begin
        if QuotedStrings then
          SQL := SQL + Separator + '"' + OutputParams[I] + '"'
        else
          SQL := SQL + Separator + QuoteIdentifierIfNeeded(Database.SQLDialect,OutputParams[I]);
        Separator := ', ';
      end;
      SQL := SQL + ' From ' + GetProcName;
      if InputParams.Count > 0 then
      begin
        Separator := '(:';
        for I := 0 to InputParams.Count - 1 do
        begin
          SQL := SQL + Separator + AnsiUpperCase(InputParams[I]);
          Separator := ', :';
        end;
        SQL := SQL + ')'
      end
    end
    else // Execute Procedure
    begin
      SQL := 'Execute Procedure ' + GetProcName;
      if InputParams.Count > 0 then
      begin
        Separator := ' :';
        for I := 0 to InputParams.Count - 1 do
        begin
          SQL := SQL + Separator + AnsiUpperCase(InputParams[I]);
          Separator := ', :';
        end;
      end
    end;
    Lines.Add(SQL + ';');
    ExecuteSQL.AddStrings(Lines);
  finally
    Lines.Free
  end
end;

procedure TIBSQLEditFrame.InsertSelectedPrimaryKey;
begin
  SQLText.SelText := PrimaryKeys.FieldByName('ColumnName').AsString;
  SQLText.SetFocus
end;

procedure TIBSQLEditFrame.InsertSelectedFieldName;
begin
  SQLText.SelText := FieldNameList.FieldByName('ColumnName').AsString;
  SQLText.SetFocus
end;

procedure TIBSQLEditFrame.InsertTableName;
begin
  SQLText.SelText := UserTables.FieldByName('RDB$RELATION_NAME').AsString;
  SQLText.SetFocus
end;

procedure TIBSQLEditFrame.InsertProcName;
begin
  SQLText.SelText := UserProcedures.FieldByName('RDB$PROCEDURE_NAME').AsString;
  SQLText.SetFocus
end;

procedure TIBSQLEditFrame.InsertPackageName;
begin
  if PackageNames.Active and (PackageNames.FieldByName('PACKAGE_NAME_TYPE').AsInteger = 1) then
  begin
    SQLText.SelText := PackageNames.FieldByName('RDB$PACKAGE_NAME').AsString;
    SQLText.SetFocus
  end;
end;

procedure TIBSQLEditFrame.InsertSelectedInputParam;
begin
  SQLText.SelText := ProcInputParams.FieldByName('ColumnName').AsString;
  SQLText.SetFocus
end;

procedure TIBSQLEditFrame.InsertSelectedOutputParam;
begin
  SQLText.SelText := ProcOutputParams.FieldByName('ColumnName').AsString;
  SQLText.SetFocus
end;

procedure TIBSQLEditFrame.InsertSelectedIdentityCol;
begin
  SQLText.SelText := IdentityCols.FieldByName('ColumnName').AsString;
  SQLText.SetFocus
end;

procedure TIBSQLEditFrame.InsertSelectedReadOnlyField;
begin
  SQLText.SelText := ReadOnlyFields.FieldByName('ColumnName').AsString;
  SQLText.SetFocus
end;

procedure TIBSQLEditFrame.OpenUserProcedures;
begin
  if DatabaseInfo.ODSMajorVersion < 12 then
    UserProcedures.Active := true
  else
    PackageNames.Active := true;
end;

procedure GetSymbols(Lines: TStrings; var WordList: TStrings; MaxSymbols: integer = 3);
var Tokeniser: TSynSQLSyn;
    i: integer;
    Token: string;
begin
  Tokeniser := TSynSQLSyn.Create(nil); {use the highligher as a tokeniser}
  try
    Tokeniser.SQLDialect := sqlInterbase6;
    for i := 0 to Lines.Count - 1 do
    begin
      Tokeniser.SetLine(Lines[i],i);
      repeat
        if not (Tokeniser.GetTokenID in [tkComment,tkSpace,tkUnknown]) then
        begin
          Dec(MaxSymbols);
          Token := Tokeniser.GetToken;
          if (Length(Token) > 1) and (Token[1] = '"') and (Token[Length(Token)] = '"') then
            WordList.AddObject(system.copy(Token,2,Length(Token)-2),WordList) {note convention to indicate quoted}
          else
            WordList.Add(AnsiUpperCase(Token));
//          writeln(WordList[WordList.Count-1]);
        end;
        if MaxSymbols = 0 then
          Exit;
        Tokeniser.Next;
      until Tokeniser.GetEol;
    end;
  finally
    Tokeniser.Free;
  end;
end;

function TIBSQLEditFrame.SyncQueryBuilder: TIBSQLStatementTypes;
begin
  Result := SyncQueryBuilder(SQLText.Lines);
end;

function TIBSQLEditFrame.SyncQueryBuilder(SQL: TStrings): TIBSQLStatementTypes;
var TableName: string;
    FirstWord: string;
    Symbols: TStrings;
    i: integer;

  function FindProcedure(StartIndex: integer): boolean;
  begin
    if StartIndex >= Symbols.Count then Exit;

    if DatabaseInfo.ODSMajorVersion < 12  then {No packages}
    begin
      UserProcedures.Active := true;
      Result := UserProcedures.Locate('RDB$PROCEDURE_NAME',Symbols[StartIndex],[]);
    end
    else
    begin
      PackageNames.Active := true;
      if (StartIndex < Symbols.Count - 2) and (Symbols[StartIndex+1] = '.') and
           PackageNames.Locate('RDB$PACKAGE_NAME',Symbols[StartIndex],[]) then
        Result := UserProcedures.Locate('RDB$PROCEDURE_NAME',Symbols[StartIndex+2],[])
      else
        Result := UserProcedures.Locate('RDB$PROCEDURE_NAME',Symbols[StartIndex],[]);
    end;
  end;

begin
  if (Database = nil) or not Database.Connected or FQuerySync then Exit;

  FQuerySync := true;
  Result := SQLUnknown;
  TableName := '';
  Symbols := TStringList.Create;
  try
   try
    IdentifyStatementSQL.Transaction.Active := true;
    IdentifyStatementSQL.SQL.Assign(SQL);
    IdentifyStatementSQL.Prepare;
    Result := IdentifyStatementSQL.SQLStatementType;
    case Result  of
    SQLSelect:
      begin
        if IdentifyStatementSQL.MetaData.Count > 0 then
          TableName := IdentifyStatementSQL.MetaData[0].GetRelationName
        else
          Exit;
        if (Pos('MON$',TableName) > 0) or (Pos('RDB$',TableName) > 0) or (Pos('SEC$',TableName) > 0) then
          IncludeSystemTables := true;

        if not UserTables.Locate('RDB$RELATION_NAME',TableName,[]) then
        begin
          {We don't know if the stored procedure is in a package because
           the relationname is always the procedure name regardless of
           whether it is a non-package procedure or in a package. Hence,
           we have to look for the From keyword to find the full procedure name}
          GetSymbols(IdentifyStatementSQL.SQL,Symbols,-1); {Get All Symbols}
          for i := 0 to Symbols.Count - 1 do
          begin
            if (Symbols[i] = 'FROM') and (Symbols.Objects[i] = nil) then
            begin
              if FindProcedure(i+1) then
                Result := SQLExecProcedure;
              Exit;
            end;
          end;
          {Should have found it - try relationname in hope rather than expectation}
          UserProcedures.Active := true;
          if UserProcedures.Locate('RDB$PROCEDURE_NAME',TableName,[]) then
          Result := SQLExecProcedure;
        end;
      end;
    { If not a select statement then return table or procedure name
      as First Table Name }
    SQLUpdate:
      begin
        GetSymbols(IdentifyStatementSQL.SQL,Symbols,2);
        UserTables.Locate('RDB$RELATION_NAME',Symbols[1],[]);
      end;

    SQLInsert:
      begin
        GetSymbols(IdentifyStatementSQL.SQL,Symbols,3);
        UserTables.Locate('RDB$RELATION_NAME',Symbols[2],[]);
      end;

    SQLDelete:
      begin
        GetSymbols(IdentifyStatementSQL.SQL,Symbols,3);
        UserTables.Locate('RDB$RELATION_NAME',Symbols[2],[]);
      end;

    SQLExecProcedure:
      begin
        GetSymbols(IdentifyStatementSQL.SQL,Symbols,5);
        FirstWord := Symbols[0];
        if FirstWord = 'INSERT' then {INSERT...RETURNING}
        begin
          UserTables.Locate('RDB$RELATION_NAME',Symbols[2],[]);
          Result := SQLInsert;
        end
        else
        if FirstWord = 'UPDATE' then {UPDATE...RETURNING}
        begin
          UserTables.Locate('RDB$RELATION_NAME',Symbols[1],[]);
          Result := SQLUpdate;
        end
        else
        if FirstWord = 'DELETE' then {DELETE...RETURNING}
        begin
          UserTables.Locate('RDB$RELATION_NAME',Symbols[2],[]);
          Result := SQLDelete;
        end
        else
          FindProcedure(2);
      end;
    end
   except on E:EIBError do
//       ShowMessage(E.Message);
   end;
  finally
    Symbols.Free;
    FQuerySync := false;
  end;
end;

procedure TIBSQLEditFrame.TestSQL(GenerateParamNames: boolean);
begin
  if not assigned(Database) or not Database.Connected then
  begin
    Messagedlg('No Database Connected',mtError,[mbOK],0);
    Exit;
  end;
  with TIBSQL.Create(nil) do
  try
    Database := self.Database;
    Transaction := SQLTransaction;
    GenerateParamNames := GenerateParamNames;
    SQL.Assign(SQLText.Lines);
    try
      Prepare;
      ShowMessage('SQL '+ GetSQLType(SQLStatementType) + ' Statement Looks OK');
    except on E:EIBError do
      ShowMessage(E.Message);
    end;
  finally
    Free
  end;
end;


end.

Revision:	209
Committed:	Wed Mar 14 12:48:51 2018 UTC (6 years, 8 months ago) by tony
Content type:	text/x-pascal
File size:	42964 byte(s)
Log Message:	Fixes Merged