unit IBSystemTables; 

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, IBSQL, IBDatabase;

type

  { TIBSystemTables }

  TIBSystemTables = class
  private
    FGetTableNames: TIBSQL;
    FGetFieldNames: TIBSQL;
    FGetPrimaryKeys: TIBSQL;
    FTestSQL: TIBSQL;
    FTableAndColumnSQL: TIBSQL;
    FGetGeneratorsSQL: TIBSQL;
    function GetSQLType(SQLType: TIBSQLTypes): string;
    procedure AddWhereClause(TableName: string; QuotedStrings: boolean; SQL: TStrings);
 public
    constructor Create;
    destructor Destroy; override;
    procedure SelectDatabase(Database: TIBDatabase; Transaction: TIBTransaction);
    procedure GetTableNames(TableNames: TStrings);
    procedure GetFieldNames(TableName: string; FieldNames: TStrings;
              IncludePrimaryKeys:boolean=true);
    procedure GetPrimaryKeys(TableName: string; PrimaryKeys: TStrings);
    procedure GetTableAndColumns(SelectSQL: string; var FirstTableName: string;
                Columns: TStrings);
    procedure GetGenerators(GeneratorNames: TStrings);
    procedure GenerateSelectSQL(TableName: string; QuotedStrings: boolean; SQL: TStrings);
    procedure GenerateRefreshSQL(TableName: string; QuotedStrings: boolean; SQL: TStrings);
    procedure GenerateInsertSQL(TableName: string; QuotedStrings: boolean; FieldNames, SQL: TStrings);
    procedure GenerateModifySQL(TableName: string; QuotedStrings: boolean; FieldNames,SQL: TStrings);
    procedure GenerateDeleteSQL(TableName: string; QuotedStrings: boolean; SQL: TStrings);
    procedure TestSQL(SQL: string);
  end;

implementation

uses IB, Dialogs;

{ TIBSystemTables }

const
  sqlGETTABLES = 'Select Trim(RDB$RELATION_NAME) as TableName From RDB$RELATIONS ' +
                 'Where RDB$SYSTEM_FLAG = 0 ' +
                 'Order by 1';

  sqlGETFIELDS = 'Select Trim(RDB$FIELD_NAME) as ColumnName FROM RDB$RELATION_FIELDS ' +
                 'Where RDB$RELATION_NAME = :TableName ' +
                 'order by RDB$FIELD_POSITION asc ';

  sqlGETPRIMARYKEYS = 'Select Trim(S.RDB$FIELD_NAME) as ColumnName From '+
                      '(Select RDB$INDEX_NAME,RDB$FIELD_NAME FROM RDB$INDEX_SEGMENTS Order by RDB$FIELD_POSITION ASC) S ' +
                      'JOIN RDB$RELATION_CONSTRAINTS C On C.RDB$INDEX_NAME = S.RDB$INDEX_NAME ' +
                      'Where C.RDB$CONSTRAINT_TYPE = ''PRIMARY KEY'' and RDB$RELATION_NAME = :TableName';

  sqlUPDATEFIELDS = 'Select Trim(RDB$FIELD_NAME) as ColumnName FROM RDB$RELATION_FIELDS RF ' +
                    'Where RF.RDB$RELATION_NAME = :TableName  and 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)' +
                     'order by 1 asc ';

  sqlGETGENERATORNAMES = 'Select RDB$GENERATOR_NAME FROM RDB$GENERATORS '+
                         'Where RDB$SYSTEM_FLAG = 0 '+
                         'Order by 1 asc';

function TIBSystemTables.GetSQLType(SQLType: TIBSQLTypes): 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 TIBSystemTables.AddWhereClause(TableName: string;
          QuotedStrings: boolean; SQL: TStrings);
var WhereClause: string;
    Separator: string;
    Count: integer;
begin
  if not assigned(FGetPrimaryKeys.Database) or not FGetPrimaryKeys.Database.Connected or
    not assigned(FGetPrimaryKeys.Transaction) then
    Exit;
  Count := 0;
  WhereClause := 'Where';
  Separator := ' A.';
  FGetPrimaryKeys.Prepare;
  FGetPrimaryKeys.ParamByName('TableName').AsString := TableName;
  FGetPrimaryKeys.ExecQuery;
  try
    while not FGetPrimaryKeys.EOF do
    begin
      Inc(Count);
      if QuotedStrings then
        WhereClause := WhereClause + Separator + '"' + FGetPrimaryKeys.FieldByName('ColumnName').AsString + '" = :' + FGetPrimaryKeys.FieldByName('ColumnName').AsString
      else
        WhereClause := WhereClause + Separator + FGetPrimaryKeys.FieldByName('ColumnName').AsString + ' = :' + FGetPrimaryKeys.FieldByName('ColumnName').AsString;
      Separator := ' AND A.';
      FGetPrimaryKeys.Next
    end;
  finally
    FGetPrimaryKeys.Close
  end;
  if Count > 0 then
    SQL.Add(WhereClause)
end;

constructor TIBSystemTables.Create;
begin
  FGetTableNames := TIBSQL.Create(nil);
  FGetFieldNames := TIBSQL.Create(nil);
  FGetPrimaryKeys := TIBSQL.Create(nil);
  FTestSQL := TIBSQL.Create(nil);
  FTableAndColumnSQL := TIBSQL.Create(nil);
  FGetGeneratorsSQL := TIBSQL.Create(nil);
end;

destructor TIBSystemTables.Destroy;
begin
  if assigned(FGetFieldNames) then FGetFieldNames.Free;
  if assigned(FGetTableNames) then FGetTableNames.Free;
  if assigned(FTestSQL) then FTestSQL.Free;
  if assigned(FGetPrimaryKeys) then FGetPrimaryKeys.Free;
  if assigned(FTableAndColumnSQL) then FTableAndColumnSQL.Free;
  if assigned(FGetGeneratorsSQL) then FGetGeneratorsSQL.Free;
  inherited Destroy;
end;

procedure TIBSystemTables.SelectDatabase(Database: TIBDatabase;
  Transaction: TIBTransaction);
begin
    FGetTableNames.Database := Database;
    FGetTableNames.Transaction := Transaction;
    FGetTableNames.SQL.Text := sqlGETTABLES;
    FGetFieldNames.Database := Database;
    FGetFieldNames.Transaction := Transaction;
    FGetFieldNames.SQL.Text := sqlGETFIELDS;
    FTestSQL.Database := Database;
    FTestSQL.Transaction := Transaction;
    FGetPrimaryKeys.Database := Database;
    FGetPrimaryKeys.Transaction := Transaction;
    FGetPrimaryKeys.SQL.Text := sqlGETPRIMARYKEYS;
    FTableAndColumnSQL.Database := Database;
    FTableAndColumnSQL.Transaction := Transaction;
    FGetGeneratorsSQL.Database := Database;
    FGetGeneratorsSQL.Transaction := Transaction;
    FGetGeneratorsSQL.SQL.Text := sqlGETGENERATORNAMES;
end;

procedure TIBSystemTables.GetTableNames(TableNames: TStrings);
begin
  if not assigned(FGetTableNames.Database) or not FGetTableNames.Database.Connected or
    not assigned(FGetTableNames.Transaction) then
    Exit;
  with FGetTableNames.Transaction do
    if not InTransaction then StartTransaction;
  TableNames.Clear;
  FGetTableNames.ExecQuery;
  try
    while not FGetTableNames.EOF do
    begin
      TableNames.Add(FGetTableNames.FieldByName('TableName').AsString);
      FGetTableNames.Next
    end;
  finally
    FGetTableNames.Close
  end;
end;

procedure TIBSystemTables.GetFieldNames(TableName: string; FieldNames: TStrings;
              IncludePrimaryKeys:boolean=true);
begin
  if not assigned(FGetFieldNames.Database) or not FGetFieldNames.Database.Connected or
    not assigned(FGetFieldNames.Transaction) then
    Exit;
  with FGetFieldNames.Transaction do
    if not InTransaction then StartTransaction;
  FieldNames.Clear;
  if IncludePrimaryKeys then
      FGetFieldNames.SQL.Text := sqlGETFIELDS
  else
      FGetFieldNames.SQL.Text := sqlUPDATEFIELDS;
  FGetFieldNames.Prepare;
  FGetFieldNames.ParamByName('TableName').AsString := TableName;
  FGetFieldNames.ExecQuery;
  try
    while not FGetFieldNames.EOF do
    begin
      FieldNames.Add(FGetFieldNames.FieldByName('ColumnName').AsString);
      FGetFieldNames.Next
    end;
  finally
    FGetFieldNames.Close
  end;
end;

procedure TIBSystemTables.GetPrimaryKeys(TableName: string; PrimaryKeys: TStrings);
begin
  if not assigned(FGetPrimaryKeys.Database) or not FGetPrimaryKeys.Database.Connected or
    not assigned(FGetPrimaryKeys.Transaction) then
    Exit;
  with FGetPrimaryKeys.Transaction do
    if not InTransaction then StartTransaction;
  PrimaryKeys.Clear;
  FGetPrimaryKeys.Prepare;
  FGetPrimaryKeys.ParamByName('TableName').AsString := TableName;
  FGetPrimaryKeys.ExecQuery;
  try
    while not FGetPrimaryKeys.EOF do
    begin
      PrimaryKeys.Add(FGetPrimaryKeys.FieldByName('ColumnName').AsString);
      FGetPrimaryKeys.Next
    end;
  finally
    FGetPrimaryKeys.Close
  end;
end;

procedure TIBSystemTables.GetTableAndColumns(SelectSQL: string;
  var FirstTableName: string; Columns: TStrings);
var I: integer;
begin
  if not assigned(FTableAndColumnSQL.Database) or not FTableAndColumnSQL.Database.Connected or
    not assigned(FTableAndColumnSQL.Transaction) then
    Exit;
  with FTableAndColumnSQL.Transaction do
    if not InTransaction then StartTransaction;
  FTableAndColumnSQL.SQL.Text := SelectSQL;
  try
    FTableAndColumnSQL.Prepare;
    FirstTableName := strpas(FTableAndColumnSQL.Current.Vars[0].Data^.relname);
    if assigned(Columns) then
    begin
      Columns.Clear;
      for I := 0 to FTableAndColumnSQL.Current.Count - 1 do
        Columns.Add(FTableAndColumnSQL.Current.Vars[I].Name)
    end;
  except on E:EIBError do
      ShowMessage(E.Message);
  end;
end;

procedure TIBSystemTables.GetGenerators(GeneratorNames: TStrings);
begin
  if not assigned(FGetGeneratorsSQL.Database) or not FGetGeneratorsSQL.Database.Connected or
    not assigned(FGetGeneratorsSQL.Transaction) then
    Exit;
  GeneratorNames.Clear;
  with FGetGeneratorsSQL do
  begin
    with Transaction do
      if not InTransaction then StartTransaction;
    ExecQuery;
    try
      while not EOF do
      begin
        GeneratorNames.Add(FieldByName('RDB$GENERATOR_NAME').AsString);
        Next;
      end;
    finally
      Close
    end;
  end;

end;

procedure TIBSystemTables.GenerateSelectSQL(TableName: string; QuotedStrings: boolean; SQL: TStrings);
var SelectSQL: string;
    Separator : string;
begin
  if not assigned(FGetFieldNames.Database) or not FGetFieldNames.Database.Connected or
    not assigned(FGetFieldNames.Transaction) then
    Exit;
  SelectSQL := 'Select';
  Separator := ' A.';
  FGetFieldNames.SQL.Text := sqlGETFIELDS;
  FGetFieldNames.Prepare;
  FGetFieldNames.ParamByName('TableName').AsString := TableName;
  FGetFieldNames.ExecQuery;
  try
    while not FGetFieldNames.EOF do
    begin
      if QuotedStrings then
        SelectSQL := SelectSQL + Separator + '"' + FGetFieldNames.FieldByName('ColumnName').AsString + '"'
      else
        SelectSQL := SelectSQL + Separator + FGetFieldNames.FieldByName('ColumnName').AsString;
      Separator := ', A.';
      FGetFieldNames.Next
    end;
  finally
    FGetFieldNames.Close
  end;
  SelectSQL := SelectSQL + ' From ' + TableName + ' A';
  SQL.Add(SelectSQL);
end;

procedure TIBSystemTables.GenerateRefreshSQL(TableName: string; QuotedStrings: boolean; SQL: TStrings);
begin
  GenerateSelectSQL(TableName,QuotedStrings,SQL);
  AddWhereClause(TableName,QuotedStrings,SQL)
end;

procedure TIBSystemTables.GenerateInsertSQL(TableName: string;
  QuotedStrings: boolean; FieldNames,SQL: TStrings);
var InsertSQL: string;
    Separator: string;
    I: integer;
begin
  SQL.Clear;
  InsertSQL := 'Insert Into ' + TableName + '(';
  Separator := '';
  for I := 0 to FieldNames.Count - 1 do
    begin
      if QuotedStrings then
         InsertSQL := InsertSQL + Separator + '"' + FieldNames[I] + '"'
      else
         InsertSQL := InsertSQL + Separator +  FieldNames[I] ;
      Separator := ',';
    end;
  InsertSQL := InsertSQL + ')';
  SQL.Add(InsertSQL);
  InsertSQL := 'Values(';
  Separator := ':';
  for I := 0 to FieldNames.Count - 1 do
    begin
       InsertSQL := InsertSQL + Separator +  FieldNames[I] ;
       Separator := ',:';
    end;
  InsertSQL := InsertSQL + ')';
  SQL.Add(InsertSQL);
end;

procedure TIBSystemTables.GenerateModifySQL(TableName: string; QuotedStrings: boolean;
          FieldNames,SQL: TStrings);
var UpdateSQL: string;
    Separator: string;
    I: integer;
begin
  SQL.Clear;
  Separator := #$0d#$0a'  A.';
  UpdateSQL := 'Update ' + TableName + ' A Set ';
  for I := 0 to FieldNames.Count - 1 do
    begin
      if QuotedStrings then
        UpdateSQL := UpdateSQL + Separator + '"' + FieldNames[I] + '" = :' + FieldNames[I]
      else
        UpdateSQL := UpdateSQL + Separator + FieldNames[I] + ' = :' + FieldNames[I];
      Separator := ','#$0d#$0a'  A.';
    end;
  SQL.Add(UpdateSQL);
  AddWhereClause(TableName,QuotedStrings,SQL)
end;

procedure TIBSystemTables.GenerateDeleteSQL(TableName: string; QuotedStrings: boolean; SQL: TStrings);
begin
  SQL.Clear;
  SQL.Add('Delete From ' + TableName + ' A');
  AddWhereClause(TableName,QuotedStrings,SQL)
end;

procedure TIBSystemTables.TestSQL(SQL: string);
begin
  if not assigned(FTestSQL.Database) or not FTestSQL.Database.Connected or
    not assigned(FTestSQL.Transaction) then
    Exit;
  FTestSQL.SQL.Text := SQL;
  try
    FTestSQL.Prepare;
    ShowMessage('SQL '+ GetSQLType(FTestSQL.SQLType) + ' Statement Looks OK');
  except on E:EIBError do
      ShowMessage(E.Message);
  end;
end;

end.