unit udataHistSql;

// this code is under the BAF fair use license (BFUL) - https://bafbal.de/index.php?title=Bful
// creating sql statements

interface

uses
  System.SysUtils, System.Types, System.Classes, StrUtils, uBafTypes;


type
  TDataHistCmdIx = (ciGeneralTable, ciGeneralHistTable, ciGeneralHistIndex,
    ciGeneralTrigger, ciTriggerInsert, ciTriggerUpdate, ciGeneralDropTable,
    ciGeneralDropHistory, ciGeneralAlterTable, ciGeneralAlterHistory,
    ciGeneralScript,
    ciSqliteCreateTable,
    ciTriggerFb,
    ciFunctionPg, ciTriggerPg, ciDropFunctionPg, ciDropTriggerPg,
    ciTriggerInsertMy, ciTriggerUpdateMy,
    ciTriggerMsSql,
    ciTriggerOracle
    );

  TDataHistSql = class
  protected
    class function GetGeneralCreateTable(ATableDef, ADriverName: string;
        AReplace: boolean): string;
    class function GetGeneralHistTable(AConName, ATableDef: string): string;
    class function GetGeneralHistIndex(AConName, ATableDef: string): string;
    class function GetGenTrg(AConName, ATableDef, APos,
        AExt, ABegin, AEnd: string): string;
    class function GetGeneralDropTable(AConName, ATableDef: string;
        AHist: boolean): string;
    class function GetGeneralAlterTable(AConName, ATableDef, ADriverName: string;
        AHist, AReplace: boolean): string;
    class function GetSQLiteAlterTable(AConName, ATableDef: string;
        AHist, AReplace: boolean): string;
    class function GetSqliteCreateTable(ATableDef: string): string;
    class function GetTriggerFb(AConName, ATableDef: string): string;
    class function GetTriggerFuncPg(AConName, ATableDef: string): string;
    class function GetTriggerPg(ATableDef: string): string;
    class function GetDropTriggerFuncPg(ATableDef: string): string;
    class function GetDropTriggerPg(ATableDef: string): string;
    class function GetTriggerMsSql(AConName, ATableDef: string): string;
    class function GetTriggerOracle(AConName, ATableDef: string): string;
    class procedure ReplaceColumnNames(var AText: string);
    class function ParseSqlColumnDef(AText: string; var AName, AType, AExt: string): boolean;
  protected
    class procedure ReplaceTypeFirebird(var AType: string);
    class procedure ReplaceTypeMySql(var AType: string);
    class procedure ReplaceTypeMsSql(var AType: string);
    class procedure ReplaceTypeOracle(var AType: string);
    class procedure ReplaceTypePostgres(var AType: string);
  public
    class function GetButtonCount(ADriverName: string): integer;
    class function GetButton(ADriverName: string; AIndex: integer;
        var ACaption: string; var ACommandIndex: TDataHistCmdIx): boolean;
    class function GetText(AConName, ADriverName, ATableDef: string;
        ACommandIndex: TDataHistCmdIx; AMigration, AReplace: boolean): string;
    class function ExecuteScript(AConName, ADriverName, ATableDef: string;
        AMigration, AReplace: boolean): string;
    class function RefreshLookup(ADriverName, AName: string;
        AGen: TBafGeneration): string;
    class function GetDateFormat(ADriverName: string): string;
  public
    class function GetSqlCommandHistStatement(AConName, ADriverName: string;
        AGen: TBafGeneration): string;
    class function lokStart(AText: string): string;
    class function ExtractTableName(ALines: TStrings;
      var ALine: integer; var ATableName: string): boolean;

  end;


implementation

{ TDataHistSql }

uses dmMain, uBafTranslationModule, foBafDialog;

class function TDataHistSql.ExecuteScript(AConName, ADriverName, ATableDef: string;
    AMigration, AReplace: boolean): string;
var
  slTableDef, sl, slLog: TStringList;
  i, LCount: integer;
  LException: boolean;

  procedure lokExecuteSql(ASql: string);
  begin
    ASql := Trim(ASql);
    if ASql <> ';' then begin
      slLog.Add(ASql);
      slLog.Add('');
      ASql := Trim(ASql);
      if ASql[Length(ASql)] = ';' then
        Delete(ASql, Length(ASql), 1);
      try
        if AMigration then begin
          dataMain.QueryPrepare(dataMain.MigCon, QEN_COMMAND, ASql);
          LCount := dataMain.QueryExecute(dataMain.MigCon, QEN_COMMAND);
        end
        else begin
          dataMain.QueryPrepare(dataMain.DefaultCon, QEN_COMMAND, ASql);
          LCount := dataMain.QueryExecute(dataMain.DefaultCon, QEN_COMMAND);
        end;
        slLog.Add(Format('>>> Rows affected: %d', [LCount]));
        slLog.Add('');
        slLog.Add('------------------------');
      except
        on E: Exception do begin
          slLog.Add('>>> Error: ' + E.Message);
          slLog.Add('>>> Execution aborted');
          LException := true;
        end;
      end;
    end;
  end; // procedure lokExecuteSql

  procedure lokExecute;
  begin
    sl.Text := GetGeneralCreateTable(sl.Text, ADriverName, AReplace);
    if ADriverName = 'sqlite' then begin
      lokExecuteSql(GetSqliteCreateTable(sl.Text));
      lokExecuteSql(GetGeneralHistTable(AConName, sl.Text));
      lokExecuteSql(GetGeneralHistIndex(AConName, sl.Text));
      lokExecuteSql(GetGenTrg(AConName, sl.Text, 'insert', '', 'begin', 'end'));
      lokExecuteSql(GetGenTrg(AConName, sl.Text, 'update', ' of datechg', 'begin', 'end'));
    end
    else if ADriverName = 'firebird' then begin
      lokExecuteSql(sl.Text);
      lokExecuteSql(GetGeneralHistTable(AConName, sl.Text));
      lokExecuteSql(GetGeneralHistIndex(AConName, sl.Text));
      lokExecuteSql(GetTriggerFb(AConName, sl.Text));
    end
    else if ADriverName = 'postgres' then begin
      lokExecuteSql(sl.Text);
      lokExecuteSql(GetGeneralHistTable(AConName, sl.Text));
      lokExecuteSql(GetGeneralHistIndex(AConName, sl.Text));
      lokExecuteSql(GetTriggerFuncPg(AConName, sl.Text));
      lokExecuteSql(GetTriggerPg(sl.Text));
    end
    else if ADriverName = 'mysql' then begin
      lokExecuteSql(sl.Text);
      lokExecuteSql(GetGeneralHistTable(AConName, sl.Text));
      lokExecuteSql(GetGeneralHistIndex(AConName, sl.Text));
      lokExecuteSql(GetGenTrg(AConName, sl.Text, 'insert', '', 'for each row', ''));
      lokExecuteSql(GetGenTrg(AConName, sl.Text, 'update', '', 'for each row', ''));
    end
    else if ADriverName = 'mssql' then begin
      lokExecuteSql(sl.Text);
      lokExecuteSql(GetGeneralHistTable(AConName, sl.Text));
      lokExecuteSql(GetGeneralHistIndex(AConName, sl.Text));
      lokExecuteSql(GetTriggerMsSql(AConName, sl.Text));
    end
    else if ADriverName = 'oracle' then begin
      lokExecuteSql(sl.Text);
      lokExecuteSql(GetGeneralHistTable(AConName, sl.Text));
      lokExecuteSql(GetGeneralHistIndex(AConName, sl.Text));
      lokExecuteSql(GetTriggerOracle(AConName, sl.Text));
    end

  end; // procedure lokExecute

  function lokCheckSemikolon(AText: string): boolean;
  var
    p1, p2: integer;
  begin
    p1 := Pos(';', AText);
    p2 := Pos('--', AText);
    result := (p1 > 0) and ((p2 = 0) or (p2 > p1));
    if result then begin
      if Pos('CREATE TABLE', AnsiUpperCase(sl.Text)) > 0 then
        lokExecute
      else
        lokExecuteSql(sl.Text);
    end;
  end; // function lokCheckSemikolon

begin
  LException := false;
  slTableDef := TStringList.Create;
  sl := TStringList.Create;
  slLog := TStringList.Create;
  try
    slTableDef.Text := ATableDef + ';';
    for i := 0 to slTableDef.Count - 1 do begin
      sl.Add(slTableDef[i]);
      if lokCheckSemikolon(slTableDef[i]) then
        sl.Clear;
      if LException then
        break;
    end;
    result := slLog.Text;
  finally
    slLog.Free;
    sl.Free;
    slTableDef.Free;
  end;
// class function TDataHistSql.ExecuteScript
end;

class function TDataHistSql.ExtractTableName(ALines: TStrings;
    var ALine: integer; var ATableName: string): boolean;
var
  i, p1, p2: integer;
  s: string;
begin
  result := false;
  for i := 0 to ALines.Count - 1 do begin
    s := AnsiLowerCase(ALines[i]);
    p1 := Pos('create table', s);
    if p1 > 0 then begin
      p2 := Pos('(', s);
      ATableName := Trim(copy(s, p1 + 12, p2 - p1 - 12));
      ALine := i;
      result := true;
    end;
  end;
end;

class function TDataHistSql.GetButton(ADriverName: string; AIndex: integer;
  var ACaption: string; var ACommandIndex: TDataHistCmdIx): boolean;

  procedure lokResult(AButtonCaption: string; AButtonCommandIndex: TDataHistCmdIx);
  begin
    ACaption := AButtonCaption;
    ACommandIndex := AButtonCommandIndex;
    result := true;
  end;

begin
  result := false;
  if ADriverName = 'sqlite' then begin
    case AIndex of
      1: lokResult('Create Table', ciSqliteCreateTable);
      2: lokResult('History Table', ciGeneralHistTable);
      3: lokResult('History Index', ciGeneralHistIndex);
      5: lokResult('Trigger Insert', ciTriggerInsert);
      6: lokResult('Trigger Update', ciTriggerUpdate);
      8: lokResult('Drop Table', ciGeneralDropTable);
      9: lokResult('Drop History', ciGeneralDropHistory);
      11: lokResult('Alter Table', ciGeneralAlterTable);
      12: lokResult('Alter History', ciGeneralAlterHistory);
      14: lokResult('Execute Script', ciGeneralScript);
    end;
  end
  else if ADriverName = 'firebird' then begin
    case AIndex of
      1: lokResult('Create Table', ciGeneralTable);
      2: lokResult('History Table', ciGeneralHistTable);
      3: lokResult('History Index', ciGeneralHistIndex);
      4: lokResult('Trigger', ciTriggerFb);
      6: lokResult('Drop Table', ciGeneralDropTable);
      7: lokResult('Drop History', ciGeneralDropHistory);
      9: lokResult('Alter Table', ciGeneralAlterTable);
      10: lokResult('Alter History', ciGeneralAlterHistory);
      12: lokResult('Execute Script', ciGeneralScript);
    end;
  end
  else if ADriverName = 'mysql' then begin
    case AIndex of
      1: lokResult('Create Table', ciGeneralTable);
      2: lokResult('History Table', ciGeneralHistTable);
      3: lokResult('History Index', ciGeneralHistIndex);
      5: lokResult('Trigger Insert', ciTriggerInsertMy);
      6: lokResult('Trigger Update', ciTriggerUpdateMy);
      8: lokResult('Drop Table', ciGeneralDropTable);
      9: lokResult('Drop History', ciGeneralDropHistory);
      11: lokResult('Execute Script', ciGeneralScript);
    end;
  end
  else if ADriverName = 'postgres' then begin
    case AIndex of
      1: lokResult('Create Table', ciGeneralTable);
      2: lokResult('History Table', ciGeneralHistTable);
      3: lokResult('History Index', ciGeneralHistIndex);
      5: lokResult('Trigger Function', ciFunctionPg);
      6: lokResult('Trigger', ciTriggerPg);
      8: lokResult('Drop Table', ciGeneralDropTable);
      9: lokResult('Drop History', ciGeneralDropHistory);
      10: lokResult('Drop Function', ciDropFunctionPg);
      11: lokResult('Drop Trigger', ciDropTriggerPg);
      13: lokResult('Alter Table', ciGeneralAlterTable);
      14: lokResult('Alter History', ciGeneralAlterHistory);
      16: lokResult('Execute Script', ciGeneralScript);
    end;
  end
  else if ADriverName = 'mssql' then begin
    case AIndex of
      1: lokResult('Create Table', ciGeneralTable);
      2: lokResult('History Table', ciGeneralHistTable);
      3: lokResult('History Index', ciGeneralHistIndex);
      4: lokResult('Trigger', ciTriggerMsSql);
      6: lokResult('Drop Table', ciGeneralDropTable);
      7: lokResult('Drop History', ciGeneralDropHistory);
      9: lokResult('Execute Script', ciGeneralScript);
    end;
  end
  else if ADriverName = 'oracle' then begin
    case AIndex of
      1: lokResult('Create Table', ciGeneralTable);
      2: lokResult('History Table', ciGeneralHistTable);
      3: lokResult('History Index', ciGeneralHistIndex);
      4: lokResult('Trigger', ciTriggerOracle);
      6: lokResult('Drop Table', ciGeneralDropTable);
      7: lokResult('Drop History', ciGeneralDropHistory);
      9: lokResult('Alter Table', ciGeneralAlterTable);
      10: lokResult('Alter History', ciGeneralAlterHistory);
      12: lokResult('Execute Script', ciGeneralScript);
    end;
  end

  ;
end;

class function TDataHistSql.GetButtonCount(ADriverName: string): integer;
begin
  result := 0;
  if ADriverName = 'sqlite' then
    result := 14
  else if ADriverName = 'firebird' then
    result := 12
  else if ADriverName = 'mysql' then
    result := 11
  else if ADriverName = 'postgres' then
    result := 16
  else if ADriverName = 'mssql' then
    result := 9
  else if ADriverName = 'oracle' then
    result := 12

  ;
end;

class function TDataHistSql.GetDateFormat(ADriverName: string): string;
begin
  result := '';
  if ADriverName = 'sqlite' then
    result := 'yyyy-mm-dd hh:mm:ss'
  else if ADriverName = 'firebird' then
    result := 'yyyy-mm-dd hh:mm:ss'
  else if ADriverName = 'mysql' then
    result := 'yyyy-mm-dd hh:mm:ss'
  else if ADriverName = 'postgres' then
    result := 'dd.mm.yyyy hh:mm:ss'
  else if ADriverName = 'mssql' then
    result := 'dd.mm.yyyy hh:mm:ss'
  else if ADriverName = 'oracle' then
    result := 'dd.mm.yyyy hh:mm:ss'

  ;
end;

class function TDataHistSql.GetDropTriggerFuncPg(ATableDef: string): string;
var
  LTableName: string;
  LLine: integer;
  slCode: TStringList;
begin
  slCode := TStringList.Create;
  try
    slCode.Text := ATableDef;
    if ExtractTableName(slCode, LLine, LTableName) then begin
      result := 'drop function ' + LTableName + '_trig_proc';
    end; // if ExtractTableName then begin
  finally
    slCode.Free;
  end;
end;

class function TDataHistSql.GetDropTriggerPg(ATableDef: string): string;
var
  LTableName: string;
  LLine: integer;
  slCode: TStringList;
begin
  slCode := TStringList.Create;
  try
    slCode.Text := ATableDef;
    if ExtractTableName(slCode, LLine, LTableName) then begin
      // create SQL statement
      result := 'drop trigger ' + LTableName + '_trig on ' + LTableName;
    end; // if ExtractTableName then begin
  finally
    slCode.Free;
  end;
end;

class function TDataHistSql.GetGeneralAlterTable(AConName, ATableDef, ADriverName: string;
    AHist, AReplace: boolean): string;
var
  i, LLine: integer;
  s, LTableName, LName, LType, LExt: string;
  slCode, slColumns, slResult: TStringList;
begin
  slResult := TStringList.Create;
  slColumns := TStringList.Create;
  slCode := TStringList.Create;
  try
    slCode.Text := ATableDef;
    if ExtractTableName(slCode, LLine, LTableName) then begin
      LTableName := LTableName + IfThen(AHist, '_hist', '');
      dataMain.ColumnNames(AConName, LTableName, slColumns);
      slColumns.Sorted := true;
      slResult.Add('alter table ' + LTableName + ' ');
      for i := LLine to slCode.Count - 1 do begin
        s := slCode[i];
        if TDataHistSql.ParseSqlColumnDef(s, LName, LType, LExt) then begin
          if AReplace then
            ReplaceColumnNames(LName);
          LName := AnsiLowerCase(LName);
          if slColumns.IndexOf(Trim(LName)) = -1 then begin
            if ADriverName = 'sqlite' then
              LExt := StringReplace(LExt, 'primary key', 'unique', [rfReplaceAll, rfIgnoreCase])
            else if ADriverName = 'firebird' then
              ReplaceTypeFirebird(LType)
            else if ADriverName = 'mysql' then
              ReplaceTypeMySql(LType)
            else if ADriverName = 'postgres' then
              ReplaceTypePostgres(LType)
            else if ADriverName = 'mssql' then
              ReplaceTypeMsSql(LType)
            else if ADriverName = 'oracle' then
              ReplaceTypeOracle(LType)
            ;
            slResult.Add(Format('  add %s %s %s', [LName, LType, LExt]));
          end;
        end;
      end;
      result := Trim(slResult.Text);
      if result[Length(result)] = ',' then
        Delete(result, Length(result), 1);
      result := result + #13#10 ;
    end;
  finally
    slCode.Free;
    slColumns.Free;
    slResult.Free;
  end;
end;

class function TDataHistSql.GetGeneralCreateTable(ATableDef, ADriverName: string;
    AReplace: boolean): string;
var
  i, LLine: integer;
  s, LTableName, LName, LType, LExt: string;
  slCode: TStringList;
begin
  slCode := TStringList.Create;
  try
    slCode.Text := ATableDef;
    if ExtractTableName(slCode, LLine, LTableName) then begin
      slCode[LLine] := 'create table ' + LTableName + ' (';
      for i := LLine to slCode.Count - 1 do begin
        s := slCode[i];
        if TDataHistSql.ParseSqlColumnDef(s, LName, LType, LExt) then begin
          if AReplace then
            ReplaceColumnNames(LName);
          if ADriverName = 'sqlite' then
            LExt := StringReplace(LExt, 'primary key', 'unique', [rfReplaceAll, rfIgnoreCase])
          else if ADriverName = 'firebird' then
            ReplaceTypeFirebird(LType)
          else if ADriverName = 'mysql' then
            ReplaceTypeMySql(LType)
          else if ADriverName = 'postgres' then
            ReplaceTypePostgres(LType)
          else if ADriverName = 'mssql' then
            ReplaceTypeMsSql(LType)
          else if ADriverName = 'oracle' then
            ReplaceTypeOracle(LType)
          ;
          slCode[i] := Format('  %s %s %s', [LName, LType, LExt]);
        end;
      end;
      result := slCode.Text;
    end;
  finally
    slCode.Free;
  end;
end;

class function TDataHistSql.GetGeneralDropTable(AConName, ATableDef: string;
    AHist: boolean): string;
// creating the drop table Statements
var
  LLine: integer;
  LTableName: string;
  slCode: TStringList;
begin
  slCode := TStringList.Create;
  try
    slCode.Text := ATableDef;
    if ExtractTableName(slCode, LLine, LTableName) then
      result := 'drop table ' + LTableName + IfThen(AHist,
          dataMain.GetBafDbCon(AConName).HistExt, '');
  finally
    slCode.Free;
  end;
end;

class function TDataHistSql.GetGeneralHistIndex(AConName, ATableDef: string): string;
var
  LLine: integer;
  s, LTableName, LHist, LIndex: string;
  slCode: TStringList;
begin
  slCode := TStringList.Create;
  try
    slCode.Text := ATableDef;
    if ExtractTableName(slCode, LLine, LTableName)
        and (LLine < (slCode.Count - 1))then begin
      s := lokStart(slCode[LLine + 1]);
      LHist := LTableName + dataMain.GetBafDbCon(AConName).HistExt;
      LIndex := LHist + '_ix';
      result := Format('create index %s on %s (%s)', [LIndex, LHist, s]);
    end;
  finally
    slCode.Free;
  end;
end;

class function TDataHistSql.GetGeneralHistTable(AConName, ATableDef: string): string;
// creating the history table adds the extension to the table name
// and removes the key statements
var
  i, LLine: integer;
  s, LTableName: string;
  slCode: TStringList;
begin
  slCode := TStringList.Create;
  try
    slCode.Text := ATableDef;
    if ExtractTableName(slCode, LLine, LTableName) then begin
      slCode[LLine] := 'create table ' + LTableName
          + dataMain.GetBafDbCon(AConName).HistExt + ' (';
      for i := LLine to slCode.Count - 1 do begin
        s := slCode[i];
        s := StringReplace(s, 'primary key', '', [rfReplaceAll, rfIgnoreCase]);
        s := StringReplace(s, 'unique', '', [rfReplaceAll, rfIgnoreCase]);
        slCode[i] := s;
      end;
      result := slCode.Text;
    end;
  finally
    slCode.Free;
  end;
end;

class function TDataHistSql.GetGenTrg(AConName, ATableDef, APos,
    AExt, ABegin, AEnd: string): string;
var
  s, LColumn, LNew, LTableName: string;
  i, LLine: integer;
  slCode, sl: TStringList;
begin
  slCode := TStringList.Create;
  sl := TStringList.Create;
  try
    slCode.Text := ATableDef;
    if ExtractTableName(slCode, LLine, LTableName) then begin
      // List of columns
      LColumn := '';
      LNew := '';
      i := LLine + 1;
      while (i < slCode.Count) do begin
        s := lokStart(slCode[i]) + ' ';
        if s[1] = ')' then
          Break;
        LColumn := LColumn + ', ' + s;
        LNew := LNew + ', new.' + s;
        inc(i);
      end;

      // create SQL statement
      sl.Add('create trigger ' + LTableName + '_trig_' + APos);
      sl.Add('  before ' + APos + AExt);
      sl.Add('  on ' + LTableName);
//        sl.Add('  for each row');
      sl.Add(ABegin);
      sl.Add('insert into ' + LTableName + dataMain.GetBafDbCon(AConName).HistExt);
      sl.Add('  (' + copy(LColumn, 3, MaxInt) + ')');
      sl.Add('values');
      sl.Add('  (' + copy(LNew, 3, MaxInt) + ');');
      sl.Add(AEnd + ';');
      result := sl.Text;
    end; // if ExtractTableName then begin
  finally
    slCode.Free;
    sl.Free;
  end;
end;

class function TDataHistSql.GetSqlCommandHistStatement(AConName, ADriverName: string;
    AGen: TBafGeneration): string;
begin
  case AGen of
    bg302, bg303: result := Format('select u.shortname as baf_shortname, '
        + 'h.datechg as baf_datechg, '
        + 'h.* from %s h '
        + 'left outer join user_user u on u.user_user_id = h.usrchg '
        + 'where h.%s =  :k_id'
        + ' order by h.datechg desc',
        [dataMain.GetBafDbCon(AConName).CommandTableHist,
        dataMain.GetBafDbCon(AConName).CommandTableId]);
    bg303TT: result := Format('select u.bezeichnung as baf_shortname, '
        + 'h.datechg as baf_datechg, '
        + 'h.* from %s h '
        + 'left outer join neuland.user_user u on u.user_user_id = h.usrchg '
        + '  or u.userid = h.usrchg '
        + 'where h.%s =  :k_id'
        + ' order by h.datechg desc',
        [dataMain.GetBafDbCon(AConName).CommandTableHist,
        dataMain.GetBafDbCon(AConName).CommandTableId]);

    else
      result := Format('select u.shortname as baf_shortname, '
          + 'h.datechg as baf_datechg, '
          + 'h.* from %s h '
          + 'left outer join user_user u on u.user_user_id = h.userchg '
          + 'where h.%s =  :k_id'
          + ' order by h.datechg desc',
          [dataMain.GetBafDbCon(AConName).CommandTableHist,
          dataMain.GetBafDbCon(AConName).CommandTableId]);
  end;
end;

class function TDataHistSql.GetSQLiteAlterTable(AConName, ATableDef: string;
    AHist, AReplace: boolean): string;
var
  i, LLine: integer;
  s, LTableName, LName, LType, LExt: string;
  slCode, slColumns, slResult: TStringList;
begin
  slResult := TStringList.Create;
  slColumns := TStringList.Create;
  slCode := TStringList.Create;
  try
    slCode.Text := ATableDef;
    if ExtractTableName(slCode, LLine, LTableName) then begin
      LTableName := LTableName + IfThen(AHist, '_hist', '');
      dataMain.ColumnNames(AConName, LTableName, slColumns);
      slColumns.Sorted := true;
      for i := LLine to slCode.Count - 1 do begin
        s := slCode[i];
        if TDataHistSql.ParseSqlColumnDef(s, LName, LType, LExt) then begin
          if AReplace then
            ReplaceColumnNames(LName);
          LName := AnsiLowerCase(LName);
          if slColumns.IndexOf(Trim(LName)) = -1 then begin
            LExt := StringReplace(LExt, 'primary key', 'unique', [rfReplaceAll, rfIgnoreCase]);
            slResult.Add('alter table ' + LTableName + ' ');
            s := Trim(Format('  add %s %s %s', [LName, LType, LExt]));
            if s[Length(s)] = ',' then
              Delete(s, Length(s), 1);
            slResult.Add(s);
            Break;
          end;
        end;
      end;
      result := Trim(slResult.Text);
    end;
  finally
    slCode.Free;
    slColumns.Free;
    slResult.Free;
  end;
end;

class function TDataHistSql.GetSqliteCreateTable(ATableDef: string): string;
var
  i, LLine: integer;
  s, LTableName, LName, LType, LExt: string;
  slCode: TStringList;
begin
  slCode := TStringList.Create;
  try
    slCode.Text := ATableDef;
    if ExtractTableName(slCode, LLine, LTableName) then begin
      slCode[LLine] := 'create table ' + LTableName + ' (';
      for i := LLine to slCode.Count - 1 do begin
        s := slCode[i];
        if TDataHistSql.ParseSqlColumnDef(s, LName, LType, LExt) then begin
          LExt := StringReplace(LExt, 'primary key', 'unique', [rfReplaceAll, rfIgnoreCase]);
          slCode[i] := Format('  %s %s %s', [LName, LType, LExt]);
        end;
      end;
      result := slCode.Text;
    end;
  finally
    slCode.Free;
  end;
end;

class function TDataHistSql.GetText(AConName, ADriverName, ATableDef: string;
    ACommandIndex: TDataHistCmdIx; AMigration, AReplace: boolean): string;
begin
  if not (ACommandIndex in [ciGeneralScript]) then
    ATableDef := GetGeneralCreateTable(ATableDef, ADriverName, AReplace);
  if ADriverName = 'sqlite' then begin
    case ACommandIndex of
      ciSqliteCreateTable: result := ATableDef;
      ciGeneralHistTable: result := GetGeneralHistTable(AConName, ATableDef);
      ciGeneralHistIndex: result := GetGeneralHistIndex(AConName, ATableDef);
      ciTriggerInsert: result := GetGenTrg(AConName, ATableDef, 'insert', '',
          'begin', 'end');
      ciTriggerUpdate: result := GetGenTrg(AConName, ATableDef,
          'update', ' of datechg', 'begin', 'end');
      ciGeneralDropTable: result := GetGeneralDropTable(AConName, ATableDef, false);
      ciGeneralDropHistory: result := GetGeneralDropTable(AConName, ATableDef, true);
      ciGeneralAlterTable: result := GetSQLiteAlterTable(AConName, ATableDef,
          false, AReplace);
      ciGeneralAlterHistory: result := GetSQLiteAlterTable(AConName, ATableDef,
          true, AReplace);
      ciGeneralScript: result := ExecuteScript(AConName, ADriverName, ATableDef,
          AMigration, AReplace);
    end;
  end
  else if ADriverName = 'firebird' then begin
    case ACommandIndex of
      ciGeneralTable: result := ATableDef;
      ciGeneralHistTable: result := GetGeneralHistTable(AConName, ATableDef);
      ciGeneralHistIndex: result := GetGeneralHistIndex(AConName, ATableDef);
      ciTriggerFb: result := GetTriggerFb(AConName, ATableDef);
      ciGeneralDropTable: result := GetGeneralDropTable(AConName, ATableDef, false);
      ciGeneralDropHistory: result := GetGeneralDropTable(AConName, ATableDef, true);
      ciGeneralAlterTable: result := GetGeneralAlterTable(AConName, ATableDef,
          ADriverName, false, AReplace);
      ciGeneralAlterHistory: result := GetGeneralAlterTable(AConName, ATableDef,
          ADriverName, true, AReplace);
      ciGeneralScript: result := ExecuteScript(AConName, ADriverName, ATableDef,
          AMigration, AReplace);
    end;
  end
  else if ADriverName = 'mysql' then begin
    case ACommandIndex of
      ciGeneralTable: result := ATableDef;
      ciGeneralHistTable: result := GetGeneralHistTable(AConName, ATableDef);
      ciGeneralHistIndex: result := GetGeneralHistIndex(AConName, ATableDef);
      ciTriggerInsertMy: result := GetGenTrg(AConName, ATableDef,
          'insert', '', 'for each row', '');
      ciTriggerUpdateMy: result := GetGenTrg(AConName, ATableDef,
          'update', '', 'for each row', '');
      ciGeneralDropTable: result := GetGeneralDropTable(AConName, ATableDef, false);
      ciGeneralDropHistory: result := GetGeneralDropTable(AConName, ATableDef, true);
      ciGeneralScript: result := ExecuteScript(AConName, ADriverName, ATableDef,
          AMigration, AReplace);
    end;
  end
  else if ADriverName = 'postgres' then begin
    case ACommandIndex of
      ciGeneralTable: result := ATableDef;
      ciGeneralHistTable: result := GetGeneralHistTable(AConName, ATableDef);
      ciGeneralHistIndex: result := GetGeneralHistIndex(AConName, ATableDef);
      ciFunctionPg: result := GetTriggerFuncPg(AConName, ATableDef);
      ciTriggerPg: result := GetTriggerPg(ATableDef);
      ciGeneralDropTable: result := GetGeneralDropTable(AConName, ATableDef, false);
      ciGeneralDropHistory: result := GetGeneralDropTable(AConName, ATableDef, true);
      ciDropFunctionPg: result := GetDropTriggerFuncPg(ATableDef);
      ciDropTriggerPg: result := GetDropTriggerPg(ATableDef);
      ciGeneralAlterTable: result := GetGeneralAlterTable(AConName, ATableDef,
          ADriverName, false, AReplace);
      ciGeneralAlterHistory: result := GetGeneralAlterTable(AConName, ATableDef,
          ADriverName, true, AReplace);
      ciGeneralScript: result := ExecuteScript(AConName, ADriverName, ATableDef,
          AMigration, AReplace);
    end;
  end
  else if ADriverName = 'mssql' then begin
    case ACommandIndex of
      ciGeneralTable: result := ATableDef;
      ciGeneralHistTable: result := GetGeneralHistTable(AConName, ATableDef);
      ciGeneralHistIndex: result := GetGeneralHistIndex(AConName, ATableDef);
      ciTriggerMsSql: result := GetTriggerMsSql(AConName, ATableDef);
      ciGeneralDropTable: result := GetGeneralDropTable(AConName, ATableDef, false);
      ciGeneralDropHistory: result := GetGeneralDropTable(AConName, ATableDef, true);
      ciGeneralScript: result := ExecuteScript(AConName, ADriverName, ATableDef,
          AMigration, AReplace);
    end;
  end
  else if ADriverName = 'oracle' then begin
    case ACommandIndex of
      ciGeneralTable: result := ATableDef;
      ciGeneralHistTable: result := GetGeneralHistTable(AConName, ATableDef);
      ciGeneralHistIndex: result := GetGeneralHistIndex(AConName, ATableDef);
      ciTriggerOracle: result := GetTriggerOracle(AConName, ATableDef);
      ciGeneralDropTable: result := GetGeneralDropTable(AConName, ATableDef, false);
      ciGeneralDropHistory: result := GetGeneralDropTable(AConName, ATableDef, true);
      ciGeneralAlterTable: result := GetSQLiteAlterTable(AConName, ATableDef,
          false, AReplace);
      ciGeneralAlterHistory: result := GetSQLiteAlterTable(AConName, ATableDef,
          true, AReplace);
      ciGeneralScript: result := ExecuteScript(AConName, ADriverName, ATableDef,
          AMigration, AReplace);
    end;
  end;
  result := Trim(result);
  if (Length(result) > 0) and (result[Length(result)] = ';') then
    Delete(result, Length(result), 1);
end;

class function TDataHistSql.GetTriggerFb(AConName, ATableDef: string): string;
var
  s, LColumn, LNew, LTableName: string;
  i, LLine: integer;
  slCode, sl: TStringList;
begin
  slCode := TStringList.Create;
  sl := TStringList.Create;
  try
    slCode.Text := ATableDef;
    if ExtractTableName(slCode, LLine, LTableName) then begin
      // List of columns
      LColumn := '';
      LNew := '';
      i := LLine + 1;
      while (i < slCode.Count) do begin
        s := lokStart(slCode[i]) + ' ';
        if s[1] = ')' then
          Break;
        LColumn := LColumn + ', ' + s;
        LNew := LNew + ', new.' + s;
        inc(i);
      end;

      // create SQL statement
      sl.Add('create trigger ' + LTableName + '_trig for ' + LTableName);
      sl.Add('  before insert or update');
      sl.Add('as begin');
      sl.Add('insert into ' + LTableName + dataMain.GetBafDbCon(AConName).HistExt);
      sl.Add('  (' + copy(LColumn, 3, MaxInt) + ')');
      sl.Add('values');
      sl.Add('  (' + copy(LNew, 3, MaxInt) + ');');
      sl.Add('end;');
      result := sl.Text;
    end; // if ExtractTableName then begin
  finally
    slCode.Free;
    sl.Free;
  end;
end;

class function TDataHistSql.GetTriggerFuncPg(AConName, ATableDef: string): string;
var
  s, LColumn, LNew, LTableName: string;
  i, LLine: integer;
  slCode, sl: TStringList;
begin
  slCode := TStringList.Create;
  sl := TStringList.Create;
  try
    slCode.Text := ATableDef;
    if ExtractTableName(slCode, LLine, LTableName) then begin
      // List of columns
      LColumn := '';
      LNew := '';
      i := LLine + 1;
      while (i < slCode.Count) do begin
        s := lokStart(slCode[i]) + ' ';
        if s[1] = ')' then
          Break;
        if Trim(s) <> '' then begin
          LColumn := LColumn + ', ' + s;
          LNew := LNew + ', new.' + s;
        end;
        inc(i);
      end;

      // create SQL statement
      sl.Add('create function ' + LTableName + '_trig_proc() returns trigger as $'
          + LTableName + '$');
      sl.Add('begin');
      sl.Add('insert into ' + LTableName + dataMain.GetBafDbCon(AConName).HistExt);
      sl.Add('  (' + copy(LColumn, 3, MaxInt) + ')');
      sl.Add('values');
      sl.Add('  (' + copy(LNew, 3, MaxInt) + ');');
      sl.Add('return new;');
      sl.Add('end;');
      sl.Add('$' + LTableName + '$ language plpgsql;');
      result := sl.Text;
    end; // if ExtractTableName then begin
  finally
    slCode.Free;
    sl.Free;
  end;
// class function TDataHistSql.GetTriggerFuncPg
end;

class function TDataHistSql.GetTriggerMsSql(AConName, ATableDef: string): string;
var
  s, LColumn, LNew, LTableName: string;
  i, LLine: integer;
  slCode, sl: TStringList;
begin
  slCode := TStringList.Create;
  sl := TStringList.Create;
  try
    slCode.Text := ATableDef;
    if ExtractTableName(slCode, LLine, LTableName) then begin
      // List of columns
      LColumn := '';
      LNew := '';
      i := LLine + 1;
      while (i < slCode.Count) do begin
        s := lokStart(slCode[i]) + ' ';
        if s[1] = ')' then
          Break;
        LColumn := LColumn + ', ' + s;
        LNew := LNew + ', i.' + s;
        inc(i);
      end;

      // create SQL statement
      sl.Add('create trigger ' + LTableName + '_trig on ' + LTableName);
      sl.Add('  for insert, update');
      sl.Add('as begin');
      sl.Add('insert into ' + LTableName + dataMain.GetBafDbCon(AConName).HistExt);
      sl.Add('  (' + copy(LColumn, 3, MaxInt) + ')');
      sl.Add('select ' + copy(LNew, 3, MaxInt));
      sl.Add('  from inserted i;');
      sl.Add('end;');
      result := sl.Text;
    end; // if ExtractTableName then begin
  finally
    slCode.Free;
    sl.Free;
  end;
end;

class function TDataHistSql.GetTriggerOracle(AConName, ATableDef: string): string;
var
  s, LColumn, LNew, LTableName: string;
  i, LLine: integer;
  slCode, sl: TStringList;
begin
  slCode := TStringList.Create;
  sl := TStringList.Create;
  try
    slCode.Text := ATableDef;
    if ExtractTableName(slCode, LLine, LTableName) then begin
      // List of columns
      LColumn := '';
      LNew := '';
      i := LLine + 1;
      while (i < slCode.Count) do begin
        s := lokStart(slCode[i]) + ' ';
        if s[1] = ')' then
          Break;
        LColumn := LColumn + ', ' + s;
        LNew := LNew + ', :new.' + s;
        inc(i);
      end;

      // create SQL statement
      sl.Add('create or replace trigger ' + LTableName + '_trig ' );
      sl.Add('  before insert or update on ' + LTableName);
      sl.Add('for each row');
      sl.Add('begin');
      sl.Add('insert into ' + LTableName + dataMain.GetBafDbCon(AConName).HistExt);
      sl.Add('  (' + copy(LColumn, 3, MaxInt) + ')');
      sl.Add('values');
      sl.Add('  (' + copy(LNew, 3, MaxInt) + ');');
      sl.Add('end;;');
      result := sl.Text;
    end; // if ExtractTableName then begin
  finally
    slCode.Free;
    sl.Free;
  end;
end;

class function TDataHistSql.GetTriggerPg(ATableDef: string): string;
var
  s, LColumn, LNew, LTableName: string;
  i, LLine: integer;
  slCode, sl: TStringList;
begin
  slCode := TStringList.Create;
  sl := TStringList.Create;
  try
    slCode.Text := ATableDef;
    if ExtractTableName(slCode, LLine, LTableName) then begin
      // List of columns
//      LColumn := '';
//      LNew := '';
//      i := LLine + 1;
//      while (i < slCode.Count) do begin
//        s := lokStart(slCode[i]) + ' ';
//        if s[1] = ')' then
//          Break;
//        LColumn := LColumn + ', ' + s;
//        LNew := LNew + ', new.' + s;
//        inc(i);
//      end;

      // create SQL statement
      sl.Add('create trigger ' + LTableName + '_trig before insert or update on '
          + LTableName + ' for each row');
      sl.Add('  execute procedure ' + LTableName + '_trig_proc();');
      result := sl.Text;
    end; // if ExtractTableName then begin
  finally
    slCode.Free;
    sl.Free;
  end;
end;

class function TDataHistSql.lokStart(AText: string): string;
// extracts text till to the first space or carriage return
// leeding spaces ignored
var
  s: string;
  p: integer;
begin
  s := TrimLeft(AText);
  p := Pos(' ', s);
  if p > 0 then
    result := copy(s, 1, p - 1)
  else
    result := s;
end;

class function TDataHistSql.ParseSqlColumnDef(AText: string;
    var AName, AType, AExt: string): boolean;
var
  i, LStart: integer;
  LInQuote, LInBrackets, LEins, LStarted: boolean;
begin
  result := false;
  AText := AText + ' ';
  LEins := false;
  LInQuote := false;
  LInBrackets := false;
  LStarted := false;
  LStart := 1;
  for i := 1 to Length(AText) do begin
    case AText[i] of
      '"': LInQuote := not LInQuote;
      '(': LInBrackets := true;
      ')': LInBrackets := false;
      ' ': if LStarted and not LInQuote and not LInBrackets then begin
        if not LEins then begin
          AName := copy(AText, LStart, i - LStart);
          LEins := true;
          LStart := i + 1;
        end
        else begin
          AType := copy(AText, LStart, i - LStart);
          AExt :=  copy(AText, i + 1, MaxInt);
          result := Pos('create table', AnsiLowerCase(AText)) = 0;
          exit;
        end;
      end; // if not LInQuote and not LInBrackets then begin
      ',': if LStarted and not LInQuote and not LInBrackets and LEins then begin
        AType := copy(AText, LStart, i - LStart);
        AExt :=  ',';
        result := Pos('create table', AnsiLowerCase(AText)) = 0;
        exit;
      end;
      else
        LStarted := true;
    end; // case
  end; // for
end;

class function TDataHistSql.RefreshLookup(ADriverName, AName: string;
    AGen: TBafGeneration): string;
begin
  result := '';
  try
    case AGen of
      bg302, bg303, bg303TT: result := dataMain.GetSqlTextFromDevtext('_system_lookup_202', '');
      else
        result := dataMain.GetSqlTextFromDevtext('_system_lookup', '');
    end;
  except

  end;

  if result <> '' then
    exit;

  TfrmBafDialog.ShowMessage('Hinweis', 'SQL-Texte aus dem Code', nil);
  if ADriverName = 'sqlite' then begin
    case AGen of
      bg302, bg303, bg303TT: result := 'select i.ckey, ifnull(t.cvalue, ifnull(t2.cvalue, i.cvalue)) as cvalue '
        + 'from data_list l '
        + '  inner join data_list_item i on i.data_list_id = l.data_list_id '
        + '    and i.status < 7 '
        + '  left outer join translate_list_item t '
        + '    on t.data_list_item_id = i.data_list_item_id '
        + '      and t.translate_language_id = ' + QuotedStr(gvLanguageId) + ' '
        + '  left outer join translate_list_item t2 '
        + '    on t2.data_list_item_id = i.data_list_item_id '
        + '      and t2.translate_language_id = ' + QuotedStr(gvLanguageId2) + ' '
        + 'where l.name = ' + QuotedStr(AName) + ' order by i.csort, i.ckey';
    else
    result := 'select i.key, ifnull(t.value, ifnull(t2.value, i.value)) as value '
      + 'from data_list l '
      + '  inner join data_list_item i on i.data_list_id = l.data_list_id '
      + '    and i.status < 7 '
      + '  left outer join translate_list_item t '
      + '    on t.data_list_item_id = i.data_list_item_id '
      + '      and t.translate_language_id = ' + QuotedStr(gvLanguageId) + ' '
      + '  left outer join translate_list_item t2 '
      + '    on t2.data_list_item_id = i.data_list_item_id '
      + '      and t2.translate_language_id = ' + QuotedStr(gvLanguageId2) + ' '
      + 'where l.name = ' + QuotedStr(AName) + ' order by i.sort, i.key';
    end;
  end
  else if ADriverName = 'firebird' then begin
    result := 'select i.ckey, coalesce(t.cvalue, coalesce(t2.cvalue, i.cvalue)) as cvalue '
      + 'from data_list l '
      + '  inner join data_list_item i on i.data_list_id = l.data_list_id '
//      + '    and i.status < 7 '
      + '  left outer join translate_list_item t '
      + '    on t.data_list_item_id = i.data_list_item_id '
      + '      and t.translate_language_id = ' + QuotedStr(gvLanguageId) + ' '
      + '  left outer join translate_list_item t2 '
      + '    on t2.data_list_item_id = i.data_list_item_id '
      + '      and t2.translate_language_id = ' + QuotedStr(gvLanguageId2) + ' '
      + 'where l.name = ' + QuotedStr(AName) + ' order by i.csort, i.ckey';
  end
  else if ADriverName = 'postgres' then begin
    result := 'select i.ckey, ifnull(t.cvalue, ifnull(t2.cvalue, i.cvalue)) as cvalue '
      + 'from data_list l '
      + '  inner join data_list_item i on i.data_list_id = l.data_list_id '
      + '    and i.status < 7 '
      + '  left outer join translate_list_item t '
      + '    on t.data_list_item_id = i.data_list_item_id '
      + '      and t.translate_language_id = ' + QuotedStr(gvLanguageId) + ' '
      + '  left outer join translate_list_item t2 '
      + '    on t2.data_list_item_id = i.data_list_item_id '
      + '      and t2.translate_language_id = ' + QuotedStr(gvLanguageId2) + ' '
      + 'where l.name = ' + QuotedStr(AName) + ' order by i.csort, i.ckey';
  end

end;

class procedure TDataHistSql.ReplaceColumnNames(var AText: string);
begin
  AText := StringReplace(AText, ' key', ' ckey', [rfIgnoreCase]);
  AText := StringReplace(AText, ' value', ' cvalue', [rfIgnoreCase]);
  AText := StringReplace(AText, ' start', ' cstart', [rfIgnoreCase]);
  AText := StringReplace(AText, ' sort', ' csort', [rfIgnoreCase]);
  AText := StringReplace(AText, ' text', ' ctext', [rfIgnoreCase]);
  AText := StringReplace(AText, ' password', ' cpassword', [rfIgnoreCase]);
end;

class procedure TDataHistSql.ReplaceTypeFirebird(var AType: string);
begin
  AType := AnsiLowerCase(AType);
  if AType = 'date' then
    AType := 'timestamp'
  else if AType = 'datetime' then
    AType := 'timestamp'
  else if AType = 'int4' then
    AType := 'int'
  else if AType = 'number' then
    AType := 'numeric'
  else if AType = 'text' then
    AType := 'blob sub_type text'
  else if AType = 'clob' then
    AType := 'blob sub_type text';
end;

class procedure TDataHistSql.ReplaceTypeMsSql(var AType: string);
begin
  AType := AnsiLowerCase(AType);
  if AType = 'date' then
    AType := 'datetime'
  else if AType = 'timestamp' then
    AType := 'datetime'
  else if AType = 'int4' then
    AType := 'int'
  else if AType = 'number' then
    AType := 'numeric'
  else if AType = 'clob' then
    AType := 'varchar(8000)'
  else if AType = 'text' then
    AType := 'varchar(8000)';
end;

class procedure TDataHistSql.ReplaceTypeMySql(var AType: string);
begin
  AType := AnsiLowerCase(AType);
  if AType = 'date' then
    AType := 'datetime'
  else if AType = 'timestamp' then
    AType := 'datetime'
  else if AType = 'int4' then
    AType := 'int'
  else if AType = 'number' then
    AType := 'numeric'
  else if AType = 'clob' then
    AType := 'text';
end;

class procedure TDataHistSql.ReplaceTypeOracle(var AType: string);
begin
  AType := AnsiLowerCase(AType);
  if AType = 'datetime' then
    AType := 'date'
  else if AType = 'timestamp' then
    AType := 'date'
  else if AType = 'int4' then
    AType := 'int'
  else if AType = 'numeric' then
    AType := 'number'
  else if AType = 'text' then
    AType := 'clob';
end;

class procedure TDataHistSql.ReplaceTypePostgres(var AType: string);
begin
  AType := AnsiLowerCase(AType);
  if AType = 'date' then
    AType := 'timestamp'
  else if AType = 'datetime' then
    AType := 'timestamp'
  else if AType = 'int' then
    AType := 'int4'
  else if AType = 'number' then
    AType := 'numeric'
  else if AType = 'clob' then
    AType := 'text';
end;

end.

