unit uBafDbModule;

// this code is under the BAF fair use license (BFUL) - https://bafbal.de/index.php?title=Bful
// module for database access
// https://bafbal.de/index.php?title=Modul_DB

interface

uses System.Math, System.SysUtils, System.Classes, uBafTypes, uBafInterpreter,
  System.Contnrs, IniFiles, Data.DB, System.StrUtils, uStringIniFile;

type
  TDefLineObject = class
    FKeyColumn: string;
    FKeyColumnValue: string;

  end;

  TBafDbModule = class(TBafInterpreterCustomModule)
  protected   // SQL
    FSqlList: TObjectList;
    function GetStringList(AIndex: integer): TStringList;
    procedure SetSql(AIndex: integer);
    procedure SetSqlText(AIndex: integer);
    procedure SetSqlLine(AIndex: integer);
    procedure ClearSql(AIndex: integer);
    procedure ExecSql(AIndex: integer);
    function ExecSqlFunc(AParam: string): string;
  protected // Query
    procedure OpenSql(AIndex: integer);
    procedure OpenSqlVal(AIndex: integer; AExecInter: TBafCustomInterpreter);
    procedure OpenSqlValRows(AIndex: integer; AExecInter: TBafCustomInterpreter);
    procedure OpenSqlValList(AIndex: integer; AExecInter: TBafCustomInterpreter);
    procedure OpenSqlTvl(AIndex: integer);
    procedure OpenSqlKvl(AIndex: integer);
    function GetData(AParams: TStrings): string;
    function IsNull(AParams: TStrings): string;
    function GetDataXml(AParams: TStrings): string;
    function GetDataDef(AParams: TStrings): string;
    function GetSqlConcat(AParams: TStrings): string;
    function GetSqlNvl(AParams: TStrings): string;
//    function GetSqlAs(AParams: TStrings): string;
    procedure DebugFullRow;
  protected  // FillTables, InTransaction
    FDefLines: TStringList;
    FImportDefs: TStringList;
    procedure DefLine;
    procedure FillTables;
    procedure InTransaction;
    procedure Upsert;
    procedure Upsert2;
    procedure ExportTables;
    procedure ImportDefs;
    procedure ImportTables;
    procedure Migrate(AIndex: integer);
    procedure BafAddDatabase;
  public
    constructor Create; override;
    destructor Destroy; override;
    function InterpretLine(AExecInter: TBafCustomInterpreter): boolean; override;
    function ReplaceFunction(ACommand: string; AParams: TStrings; var AResult: string): boolean; override;
    function GetSqlAndClear(AIndex: integer; var ASql: string): boolean; override;

  end;

implementation

{ TBafDbModule }

uses dmMain;

procedure TBafDbModule.BafAddDatabase;
var
  LName, LDbName: string;
  LCon: TBafDbCon;
begin
  if FindParamBooleanReplaced('cnd', true) then begin
    LName := FindParamStringReplacedLower('db', '');
    LCon := dataMain.GetBafDbCon(LName);
    if LCon = nil then begin
      LDbName := FindParamStringReplacedLower('n', '');
      dataMain.DbAdditionalConnect(LName, LDbName);
    end;
  end;
end;

procedure TBafDbModule.ClearSql(AIndex: integer);
begin
  if FindParamBooleanReplaced('cnd', true) then
    GetStringList(AIndex).Clear;
end;


constructor TBafDbModule.Create;
begin
  inherited;
  FSqlList := TObjectList.Create(true);
  FDefLines := TStringList.Create;
  FDefLines.OwnsObjects := true;
  FImportDefs := TStringList.Create;
end;

procedure TBafDbModule.DebugFullRow;
var
  LQueryName: string;
begin
  LQueryName := FindParamStringLower('n', '');
  if LQueryName <> '' then
    LQueryName := FInter.Name + '~' + LQueryName
  else
    LQueryName := FInter.Name;
//  FInter.DebugDbRow(dataMain.QueryData(LQueryName), true);
end;

procedure TBafDbModule.DefLine;
var
  LDef: TDefLineObject;
begin
  LDef := TDefLineObject.Create;
  LDef.FKeyColumn := FindParamString('lk', '');
  LDef.FKeyColumnValue := BAF_OTHER;
  FDefLines.AddObject(FExecInter.LineP, LDef);
end;

destructor TBafDbModule.Destroy;
begin
  FreeAndNil(FImportDefs);
  FreeAndNil(FDefLines);
  FreeAndNil(FSqlList);
  inherited;
end;

procedure TBafDbModule.ExecSql(AIndex: integer);
var
  LBafConName, LSql, LParam, LName: string;
  LNum, LRows: integer;
begin
  LBafConName := FindParamStringReplacedLower('db', DC_DEFAULT);
  GetSqlAndClear(AIndex, LSql);
  try
    LName := FInter.Name + '~' + LBafConName;
    SqlAndParams(LBafConName, LName, LSql);
    LRows := 0;
    if FindParamBooleanReplaced('cnd', true) then
      LRows := dataMain.QueryExecute(LBafConName, LName);
    if FindParam('z', LParam) then begin
      LNum := StrToIntDef(Trim(LParam), -1);
      if LNum < 0 then
        FInter.DoLog('E', '#sql_exec: z nicht nummerisch oder kleiner 0')
      else
        FExecInter.Values[LNum] := IntToStr(LRows);
    end;
    if FindParamBooleanReplaced('srv_ops', false) then
      FInter.DoLog('ops', IntToStr(LRows));
  except
//    Clipboard.AsText := LSql;
    raise;
  end;
end;

function TBafDbModule.ExecSqlFunc(AParam: string): string;
// AParam can be a number or a sql statement
var
  LBafConName, LSql, LName: string;
  LNum: integer;
  LData: TDataSet;
begin
  LBafConName := FindParamStringReplacedLower('db', DC_DEFAULT);
  LNum := StrToIntDef(Trim(AParam), -1);
  if LNum > 0 then
    GetSqlAndClear(LNum, LSql)
  else
    LSql := AParam;
  LName := FInter.Name + '~' + LBafConName;
  dataMain.QueryPrepare(LBafConName, LName, LSql);
  LData := dataMain.QueryOpen(LBafConName, LName);
  if not LData.Eof then
    result := LData.Fields[0].AsString;
end;

procedure TBafDbModule.ExportTables;
var
  LBafConName, LFileName, LTableName, s, LSql, LFieldName: string;
  sl: TStringList;
  i: integer;

  procedure lokWriteTable;
  var
    LDataSet: TDataSet;
    i: integer;
  begin
    sl.Add('========================================');
    LSql := 'select * from ' + LTableName;
    dataMain.QueryPrepare(LBafConName, 'export', LSql);
    LDataSet := dataMain.QueryOpen(LBafConName, 'export');
    while not LDataSet.Eof do begin
      sl.Add('---------------------------------------');
      sl.Add('@@' + AnsiLowerCase(LTableName) + '@@');
      for i := 0 to LDataSet.Fields.Count - 1 do begin
        LFieldName := AnsiLowerCase(LDataSet.Fields[i].FieldName);
        if not ((LFieldName = 'datechg') or  (LFieldName = 'usrchg') or
            (LFieldName = 'progchg')) then begin
          sl.Add('@@@' + LFieldName + '@@@');
          sl.Add(LDataSet.Fields[i].AsString);
        end;
      end;
      LDataSet.Next;
    end;
  end; // procedure lokWriteTable

begin
  LFileName := FindParamStringReplaced('fn', '');
  LBafConName := FindParamStringReplacedLower('db', DC_DEFAULT);
  if LFileName = 'abort' then
    exit;
  sl := TStringList.Create;
  try
    for i := 0 to 9 do begin
      s := IfThen(i = 0, 't', 't' + IntToStr(i));
      LTableName := FindParamStringReplaced(s, '');
      if LTableName <> '' then
        lokWriteTable;
    end;
    sl.SaveToFile(LFileName);
  finally
    sl.Free;
  end;
end;

procedure TBafDbModule.FillTables;
var
  LBafConName, LSql, LKeyValue, LName: string;
  LDataSet: TDataSet;
  LField: TField;
  i, LMax, LCount, LRowAffected: integer;
  LDef, LSubDef: TDefLineObject;

  procedure lokAddItem(AZeileP: string; AIndex: integer);
  var
    i: integer;
    LIni: TStringIniFile;
    LTable, LKeyField: string;
    LHist: boolean;
  begin
    // if we start at the top level, we have to reset all below
    LDef.FKeyColumnValue := LKeyValue;
    for i := AIndex + 1 to FDefLines.Count - 1 do begin
      LSubDef := TDefLineObject(FDefLines.Objects[i]);
      LSubDef.FKeyColumnValue := BAF_OTHER;
    end;
    LTable := FindParamString(AZeileP, 't', '');
    LKeyField := FInter.GetPrimaryKey(AZeileP);
    if (LTable = '') or (LKeyField = '') then
      FInter.DoLog('E', '#filltables, param t or k empty')
    else begin
      LHist := FindParamBoolean('hst', true);
      LIni := TStringIniFile.Create('');
      try
        LIni.WriteString(SEC_ADD, 't', LTable);
        LIni.WriteString(SEC_ADD, 'k', LKeyField);
        LIni.WriteBool(SEC_ADD, 'hst', LHist);
        LIni.WriteBool(SEC_ADD, 'autoins', true);

//        FExecInter.Fields2IniData(AZeileP, LIni, LDataSet, false);

        LIni.WriteString(SEC_ADD, 'kv', LIni.ReadString(SEC_DATA, LKeyField, ''));

        dataMain.UpsertIni(LIni, LBafConName,
            dataMain.GetBafDbCon(LBafConName).ProgChg + FInter.CommandName, LRowAffected);
      finally
        FreeAndNil(LIni);
      end;
    end;
  end; // procedure lokAddItem


begin
  try
    LBafConName := FindParamStringReplacedLower('db', DC_DEFAULT);
    LName := FInter.Name + '~' + LBafConName;
    LSql := FInter.GetSqlAndClear(1);
    if LSql <> '' then begin
      LMax := FindParamInteger('m', MaxInt);
      LCount := 0;
      SqlAndParams(LBafConName, LName + '~#filltables', LSql);
      LDataSet := dataMain.QueryOpen(LBafConName, LName + '~#filltables');
      while not LDataSet.Eof do begin
        // going through FDefLines and create DB content
        for i := 0 to FDefLines.Count - 1 do begin
          LDef := TDefLineObject(FDefLines.Objects[i]);
          LField := LDataSet.FindField(LDef.FKeyColumn);
          if Assigned(LField) then
            LKeyValue := LDataSet.FindField(LDef.FKeyColumn).AsString
          else
            FInter.DoLog('E', Format('#filltables, Spalte nicht gefunden', [LDef.FKeyColumn]));
          if LKeyValue <> LDef.FKeyColumnValue then
            lokAddItem(FDefLines[i], i);
        end; // for i
        inc(LCount);
        if LCount >= LMax then
          Break;
        LDataSet.Next;
      end;
    end;
  finally
    FDefLines.Clear;
  end;
// procedure TBafDbModule.FillTables
end;

function TBafDbModule.ReplaceFunction(ACommand: string; AParams: TStrings;
  var AResult: string): boolean;
begin
  inherited;
  result := true;
  if ACommand = '$SQL' then AResult := ExecSqlFunc(AParams[0])
  else if ACommand = '$SQLTEXT' then AResult := GetStringList(StrToIntDef(AParams[0], 1)).Text
  else if ACommand = '$SQL_CONCAT' then AResult := GetSqlConcat(AParams)
  else if ACommand = '$SQL_NVL' then AResult := GetSqlNvl(AParams)
//  else if ACommand = '$SQL_AS' then AResult := GetSqlAs(AParams)
  else if ACommand = '$DATA' then AResult := GetData(AParams)
  else if ACommand = '$ISNULL' then AResult := IsNull(AParams)
  else if ACommand = '$DATAXML' then AResult := GetDataXml(AParams)
  else if ACommand = '$DDEF' then AResult := GetDataDef(AParams)


  else result := false;
end;

function TBafDbModule.GetData(AParams: TStrings): string;
var
  LName: string;
  LField: TField;
// 0 - Name of DataSource
// 1 - FieldName
// 2 - Replace für NullValue
// 3 - accnd, if missing fields should not lead to an error
// 4 - DB Name
begin
  if AParams[0] <> '' then
    LName := FInter.Name + '~' + AParams[0] + '~'
  else
    LName := FInter.Name;
//  if AParams.Count > 4 then
//    LField := dataMain.QueryData(Trim(AParams[4]), LName).FindField(Trim(AParams[1]))
//  else
//    LField := dataMain.QueryData(dataMain.DefaultCon, LName).FindField(Trim(AParams[1]));
  LField := dataMain.QueryData(LName).FindField(Trim(AParams[1]));
  if (AParams.Count > 3) and (AnsiLowerCase(AParams[3]) = 'accnd') then begin
    if Assigned(LField) then
      result := LField.AsString;
  end
  else
    result := LField.AsString;
  if (result = '') and (AParams.Count > 2) then
    result := AParams[2];
end;

function TBafDbModule.GetDataDef(AParams: TStrings): string;
var
  LName: string;
begin
  if AParams.Count > 0 then begin
    LName := AnsiLowerCase(AParams[0]);



  end;
end;

function TBafDbModule.GetDataXml(AParams: TStrings): string;
var
  LXml, LTag: string;
  i, LPos: integer;
begin
  result := '';
  LXml := dataMain.QueryData(dataMain.DefaultCon, AParams[0]).FieldByName(Trim(AParams[1])).AsString;
  for i := 2 to AParams.Count - 1 do begin
    LTag := '<' + Trim(AParams[i]) + '>';
    LPos := Pos(LTag, LXml);
    if LPos > 0 then begin
      Delete(LXml, 1, LPos + Length(LTag) - 1);
      if i = (AParams.Count - 1) then begin
        LTag := '</' + Trim(AParams[i]) + '>';
        LPos := Pos(LTag, LXml);
        if LPos > 0 then begin
          result := copy(LXml, 1, LPos - 1);
        end;
      end;
    end
    else
      exit;
  end;
end;

function TBafDbModule.GetSqlAndClear(AIndex: integer; var ASql: string): boolean;
var
  sl: TStringList;
begin
  sl := GetStringList(AIndex);
  ASql := sl.Text;
  sl.Clear;
  result := true;
end;

//function TBafDbModule.GetSqlAs(AParams: TStrings): string;
//var
//  LDriverName: string;
//begin
//  result := '';
//  if AParams.Count > 1 then begin
//    LDriverName := AnsiLowerCase(AParams[0]);
//    if LDriverName = 'default' then
//      LDriverName := dataMain.Driver;
//
//    if (LDriverName = 'sqlite') or (LDriverName = 'firebird')
//        or (LDriverName = 'postgres') or (LDriverName = 'oracle') then begin
//
//      result := 'as ' + QuotedStr(AParams[1]) ;
//    end
//    else if LDriverName = 'mysql' then begin
//    end
//    else if LDriverName = 'mssql' then begin
//      result := 'as "' + AParams[1] + '"'
//    end;
//  end;
//end;

function TBafDbModule.GetSqlConcat(AParams: TStrings): string;
var
  LDriverName: string;
  i: integer;
begin
  result := '';
  if AParams.Count > 1 then begin
    LDriverName := AnsiLowerCase(AParams[0]);
    if LDriverName = 'default' then
      LDriverName := dataMain.Driver;

    if (LDriverName = 'sqlite') or (LDriverName = 'firebird')
        or (LDriverName = 'postgres') or (LDriverName = 'oracle') then begin
      for i := 1 to AParams.Count - 1 do
        result := result + ' || ' + AParams[i];
      Delete(result, 1, 4);
    end
    else if LDriverName = 'mysql' then begin
      for i := 1 to AParams.Count - 1 do
        result := result + ', ' + AParams[i];
      result := 'concat(' + copy(result, 3, MaxInt) + ')';
    end
    else if LDriverName = 'mssql' then begin
      for i := 1 to AParams.Count - 1 do
        result := result + ' + ' + AParams[i];
      Delete(result, 1, 3);
    end;
  end;
end;

function TBafDbModule.GetSqlNvl(AParams: TStrings): string;
var
  LDriverName: string;
  i: integer;
begin
  result := '';
  if AParams.Count > 2 then begin
    LDriverName := AnsiLowerCase(AParams[0]);
    if LDriverName = 'default' then
      LDriverName := dataMain.Driver;

     if (LDriverName = 'sqlite') or (LDriverName = 'mysql') then
       result := Format('ifnull(%s, %s)', [AParams[1], AParams[2]])
     else if (LDriverName = 'firebird') or (LDriverName = 'postgres') then
       result := Format('coalesce(%s, %s)', [AParams[1], AParams[2]])
     else if LDriverName = 'oracle' then
       result := Format('NVL(%s, %s)', [AParams[1], AParams[2]])
     else if LDriverName = 'mssql' then
       result := Format('isnull(%s, %s)', [AParams[1], AParams[2]]);
  end;
end;

function TBafDbModule.GetStringList(AIndex: integer): TStringList;
begin
  while AIndex > FSqlList.Count do
    FSqlList.Add(TStringList.Create);
  result := (FSqlList[AIndex - 1] as TStringList);
end;

procedure TBafDbModule.InTransaction;
var
  LBafConName, LCommand, LCaption, LExcept: string;
  LNoException: boolean;
begin
  if FindParamBooleanReplaced('cnd', true) then begin
    LBafConName := FindParamStringReplacedLower('db', DC_DEFAULT);
    if dataMain.CanTransaction(LBafConName) then begin
      dataMain.StartTransaction(LBafConName);
      try
        LCaption := FindParamStringReplaced('c', '');
        LCommand := FindParamStringReplaced('cmd', '');
        LExcept := FindParamStringReplaced('ex', '');
        LNoException := FindParamBooleanReplaced('nex', false);
        TBafInterpreterLevel.ExecInNewLevel(LCommand, FExecInter, FInter);
        dataMain.Commit(LBafConName);
      except
        dataMain.Rollback(LBafConName);
        TBafInterpreterLevel.ExecInNewLevel(LExcept, FExecInter, FInter);
        FInter.DoLog('E', LCaption + ' - rollback transaction');
        if not LNoException then
          raise;
      end;
    end
    else
      FInter.DoLog('E', 'already in a transaction');
  end; // if FindParamBooleanReplaced('cnd', true)
// procedure TBafDbModule.InTransaction
end;

function TBafDbModule.IsNull(AParams: TStrings): string;
// for not existing filds result is always Y
var
  LQueryName: string;
  LField: TField;
begin
  LQueryName := AParams[0];
  if LQueryName <> '' then
    LQueryName := FInter.Name + '~' + LQueryName
  else
    LQueryName := FInter.Name;
  LField := dataMain.QueryData(dataMain.DefaultCon, LQueryName).FindField(Trim(AParams[1]));
  if LField = nil then
    result := BAFYESCHAR
  else
    result := IfThen(LField.IsNull, BAFYESCHAR, BAFNOCHAR);
end;

procedure TBafDbModule.Migrate;
// migrates data in another table, perhaps on a other DB
var
  LBafConName, LBafConNameDest, LSql, LName, LTableNameDest, LKeyFieldDest,
      LTypDest: string;
  LMax, LRowCount, LRowAffected: integer;
  LNoException, LHistDest: boolean;
  LData: TDataSet;
  LIni: TStringIniFile;

  procedure lokParams;
  begin
    LName := 'sql_migrate';
    LBafConName := FindParamStringReplacedLower('db', DC_DEFAULT);
    LBafConNameDest := FindParamStringReplacedLower('db_dest', DC_DEFAULT);
    LHistDest := FindParamBooleanReplaced('hst_dest', true);
    LTableNameDest := FindParamStringReplaced('t_dest', '');
    LKeyFieldDest := FInter.GetPrimaryKey(FExecInter.LineP, '_dest');
    LMax := FindParamIntegerReplaced('m', MaxInt);
    LNoException := FindParamBooleanReplaced('nex', false);
    LTypDest := FindParamStringReplacedLower('y_dest', 'i');
  end; // procedure lokParams

  procedure lokMigrate;
  var
    i: integer;
  begin
    LIni := TStringIniFile.Create('');
    try
      LIni.WriteString(SEC_ADD, 't', LTableNameDest);
      LIni.WriteString(SEC_ADD, 'k', LKeyFieldDest);
      LIni.WriteBool(SEC_ADD, 'hst', LHistDest);
      if LTypDest = 'i' then
        LIni.WriteBool(SEC_ADD, 'ins', true)
      else if LTypDest = 'a' then
        LIni.WriteBool(SEC_ADD, 'autoins', true);

      for i := 0 to LData.FieldCount - 1 do
        LIni.WriteString(SEC_DATA, LData.Fields[i].FieldName, LData.Fields[i].AsString);

      LIni.WriteString(SEC_ADD, 'kv', LIni.ReadString(SEC_DATA, LKeyFieldDest, ''));
      dataMain.UpsertIni(LIni, LBafConNameDest,
          dataMain.GetBafDbCon(LBafConNameDest).ProgChg + FInter.CommandName, LRowAffected);
    finally
      FreeAndNil(LIni);
    end;
  end; // procedure lokMigrate

begin
  lokParams;
  LName := FInter.Name + '~' + LName;
  GetSqlAndClear(AIndex, LSql);
  if FindParamBooleanReplaced('cnd', true) then begin
    SqlAndParams(LBafConName, LName, LSql);
    try
      LData := dataMain.QueryOpen(LBafConName, LName);
      if not LData.Eof then begin
        LRowCount := 0;
        while not LData.Eof do begin
          try
            lokMigrate;
          except
            on E: Exception do begin
              if LNoException then
                FInter.DoLog('W', '#sql_migrate - exception raised: ' + E.Message)
              else
                FInter.DoLog('E', '#sql_migrate - exception raised: ' + E.Message);
            end;
          end;
          inc(LRowCount);
          if LRowCount >= LMax then begin
            FInter.DoLog('I', Format('OpenSql, Max (%d) reached, loop aborted', [LMax]));
            Break;
          end;
          LData.Next;
        end;
      end;
    finally
      dataMain.QueryClose(LBafConName, LName);
    end;
  end;
// procedure TBafDbModule.Migrate
end;

procedure TBafDbModule.OpenSql(AIndex: integer);
var
  LBafConName, LSql, LEachRow, LName: string;
  LMax, LRowCount, LSleep: integer;
  LEachRowTrans, LNoException, LCheckAbortCondition: boolean;
  LData: TDataSet;

  procedure lokParams;
  begin
    LName := Trim(FindParamString('n', ''));
    if LName = '' then
      FInter.DoLog('E', '#sql_open, n empty');

    LMax := FindParamIntegerReplaced('m', MaxInt);
    LEachRow := FindParamString('ern', '');
    if LEachRow = '' then
      LEachRow := FindParamStringReplaced('er', '');
    LEachRowTrans := FindParamBooleanReplaced('ert', false);
    LNoException := FindParamBooleanReplaced('nex', false);
    LSleep := FindParamIntegerReplaced('sleep', 0);
    LCheckAbortCondition := (FindParamString('acnd', '') <> '');
  end; // procedure lokParams

begin
  lokParams;
  LName := FInter.Name + '~' + LName + '~';
  GetSqlAndClear(AIndex, LSql);
  if FindParamBooleanReplaced('cnd', true) then begin
    LBafConName := FindParamStringReplacedLower('db', DC_DEFAULT);
    SqlAndParams(LBafConName, LName, LSql);
    try
      LData := dataMain.QueryOpen(LBafConName, LName);
      if (LEachRow <> '') and not LData.Eof then begin
        LRowCount := 0;
        while not LData.Eof do begin
          FExecInter.EachRow(LBafConName, LEachRow, '#sql_open', LEachRowTrans,
              LNoException);
          inc(LRowCount);
          if LRowCount >= LMax then begin
            FInter.DoLog('I', Format('#sql_open, Max (%d) reached, loop aborted', [LMax]));
            Break;
          end;
          if FInter.ProgressAborted then begin
            FInter.DoLog('I', '#sql_open, loop by user aborted');
            Break;
          end;
          if LCheckAbortCondition and FindParamBooleanReplaced('acnd', false) then begin
            FInter.DoLog('I', '#sql_open, loop aborted by condition');
            Break;
          end;
          if LSleep > 0 then
            Sleep(LSleep);
          LData.Next;
        end;
      end;
    finally
      dataMain.QueryClose(LBafConName, LName);
    end;
  end;
// procedure TBafDbModule.OpenSql
end;

procedure TBafDbModule.OpenSqlKvl(AIndex: integer);
var
  LBafConName, LSql, LFieldName, LParam, LName, LKat, LLastKat: string;
  ix, LNum: integer;
  LData: TDataSet;
  LKatList, LText: TStringList;
begin
  GetSqlAndClear(AIndex, LSql);
  if FindParamBooleanReplaced('cnd', true) then begin
    LBafConName := FindParamStringReplacedLower('db', DC_DEFAULT);
    LNum := FindParamIntegerReplaced('n', 0);
    if LNum > 0 then begin
      LKatList := FInter.GetKatStringList(LNum);
      if FindParamBooleanReplaced('clr', true) then
        LKatList.Clear;
      LName := FInter.Name + '~' + LBafConName;
      SqlAndParams(LBafConName, LName, LSql);
      LData := dataMain.QueryOpen(LBafConName, LName);
      LLastKat := '{D3144876-13EC-40CE-A557-23CD24EFB3A5}';
      while not LData.Eof do begin
        LKat := AnsiLowerCase(LData.FieldByName('ckat').AsString);
        if LKat <> LLastKat then begin
          ix := LKatList.IndexOf(LKat);
          if ix = -1 then begin
            LText := TStringList.Create;
            LKatList.AddObject(LKat, LText);
          end
          else
            LText := (LKatList.Objects[ix] as TStringList);
          LLastKat := LKat;
        end; // if LKat <> LLastKat
        LText.Add(LData.FieldByName('ckey').AsString + '='
            + LData.FieldByName('cvalue').AsString);
        LData.Next;
      end; // while not LData.Eof
    end
    else
      FInter.DoLog('E', '#sql_openkvl: n nicht nummerisch oder kleiner 1')
  end;
end;

procedure TBafDbModule.OpenSqlTvl(AIndex: integer);
var
  LBafConName, LSql, LFieldName, LParam, LName: string;
  i, LNum: integer;
  LData: TDataSet;
  LText: TStringList;
begin
  GetSqlAndClear(AIndex, LSql);
  if FindParamBooleanReplaced('cnd', true) then begin
    LBafConName := FindParamStringReplacedLower('db', DC_DEFAULT);
    LNum := FindParamIntegerReplaced('n', 0);
    if LNum > 0 then begin
      LText := FInter.GetTextStringList(LNum);
      if FindParamBooleanReplaced('clr', true) then
        LText.Clear;
      LName := FInter.Name + '~' + LBafConName;
      SqlAndParams(LBafConName, LName, LSql);
      LData := dataMain.QueryOpen(LBafConName, LName);
      while not LData.Eof do begin
        LText.Add(LData.FieldByName('ckey').AsString + '='
            + LData.FieldByName('cvalue').AsString);
        LData.Next;
      end; // while not LData.Eof
    end
    else
      FInter.DoLog('E', '#sql_opentvl: n nicht nummerisch oder kleiner 1')
  end;
end;

procedure TBafDbModule.OpenSqlVal(AIndex: integer; AExecInter: TBafCustomInterpreter);
var
  LBafConName, LSql, LFieldName, LParam, LCount, LRecCount, LName: string;
  i, LNum, LNext: integer;
  LData: TDataSet;
  LDoEmpty, LAllFields: boolean;

  procedure lokAllFields(AValue: string);
  begin
    LFieldName := LData.Fields[i].FieldName;
    if LAllFields then
      FInter.Variable[LFieldName] := AValue
    else if FindParam('f_' + LFieldName, LParam) then begin
      LNum := StrToIntDef(LParam, -1);
      if LNum >= 0 then
        AExecInter.Values[LNum] := AValue
      else if LParam = '!' then
        FInter.Variable[LFieldName] := AValue
      else
        FInter.Variable[LParam] := AValue;
    end;
  end; // procedure lokAllFields

begin
  GetSqlAndClear(AIndex, LSql);
  if FindParamBooleanReplaced('cnd', true) then begin
    LBafConName := FindParamStringReplacedLower('db', DC_DEFAULT);
    LNext := FindParamIntegerReplaced('row', 0);
    LDoEmpty := FindParamBooleanReplaced('de', false);
    LAllFields := FindParamBooleanReplaced('af', false);
    LName := FInter.Name + '~' + LBafConName;
    SqlAndParams(LBafConName, LName, LSql);
    LData := dataMain.QueryOpen(LBafConName, LName);
    if not LData.Eof then begin
      for i := 1 to LNext do
        LData.Next;
      for i := 0 to LData.Fields.Count - 1 do
        lokAllFields(LData.Fields[i].AsString);
    end
    else if LDoEmpty then begin
      for i := 0 to LData.Fields.Count - 1 do
        lokAllFields('');
    end;

    LCount := FindParamStringReplaced('cnt', '');
    if LCount <> '' then begin
      LRecCount := IntToStr(LData.RecordCount);
      LNum := StrToIntDef(LCount, -1);
      if LNum >= 0 then
        AExecInter.Values[LNum] := LRecCount
      else
        FInter.Variable[LCount] := LRecCount;
    end;
  end;
end;

procedure TBafDbModule.OpenSqlValList(AIndex: integer;
  AExecInter: TBafCustomInterpreter);
var
  LBafConName, LSql, LFieldName, LName: string;
  LData: TDataSet;
  LList: TStringList;
begin
  GetSqlAndClear(AIndex, LSql);
  if FindParamBooleanReplaced('cnd', true) then begin
    LBafConName := FindParamStringReplacedLower('db', DC_DEFAULT);
    LName := FInter.Name + '~' + LBafConName;
    SqlAndParams(LBafConName, LName, LSql);
    LList := FInter.GetTextStringList(FindParamIntegerReplaced('n', 1));
    LFieldName := FindParamStringReplaced('f', '');
    if (LFieldName = '') then
      FInter.DoLog('E', '#sql_openvallist, param f is empty');
    LData := dataMain.QueryOpen(LBafConName, LName);
    while not LData.Eof do begin
      LList.Add(LData.FieldByName(LFieldName).AsString);
      LData.Next;
    end;
  end;
end;

procedure TBafDbModule.OpenSqlValRows(AIndex: integer; AExecInter: TBafCustomInterpreter);
var
  LBafConName, LSql, LFieldName, LParam, LSep, LName: string;
  i, LNum: integer;
  LFirst: boolean;
  LData: TDataSet;
begin
  GetSqlAndClear(AIndex, LSql);
  if FindParamBooleanReplaced('cnd', true) then begin
    LBafConName := FindParamStringReplacedLower('db', DC_DEFAULT);
    LName := FInter.Name + '~' + LBafConName;
    SqlAndParams(LBafConName, LName, LSql);
    LSep := FindParamStringReplaced('sep', ',');
    LFirst := true;
    LData := dataMain.QueryOpen(LBafConName, LName);
    while not LData.Eof do begin
      for i := 0 to LData.Fields.Count - 1 do begin
        LFieldName := LData.Fields[i].FieldName;
        if FindParam('f_' + LFieldName, LParam) then begin
          LNum := StrToIntDef(LParam, -1);
          if LNum >= 0 then begin
            if LFirst then
              AExecInter.Values[LNum] := LData.Fields[i].AsString
            else
              AExecInter.Values[LNum] := FExecInter.Values[LNum] + LSep + LData.Fields[i].AsString;
          end
          else if LParam = '!' then begin
            if LFirst then
              FInter.Variable[LFieldName] := LData.Fields[i].AsString
            else
              FInter.Variable[LFieldName] := FInter.Variable[LFieldName] + LSep + LData.Fields[i].AsString;
          end
          else begin
            if LFirst then
              FInter.Variable[LParam] := LData.Fields[i].AsString
            else
              FInter.Variable[LParam] := FInter.Variable[LParam] + LSep + LData.Fields[i].AsString;
          end;
        end;
      end;
      LFirst := false;
      LData.Next;
    end;
  end;
end;

procedure TBafDbModule.SetSql(AIndex: integer);
var
  s: string;
begin
  s := FExecInter.ReplaceFunctions(FExecInter.LineP);
  GetStringList(AIndex).Add(s);
end;

procedure TBafDbModule.SetSqlLine(AIndex: integer);
var
  s: string;
begin
  if FindParamBooleanReplaced('cnd', true) then begin
    s := FindParamStringReplaced('z', '');
    GetStringList(AIndex).Add(s);
  end;
end;

procedure TBafDbModule.SetSqlText(AIndex: integer);
var
  LName, LDriverName: string;
begin
  if FindParamBooleanReplaced('cnd', true) then begin
    LName := FindParamStringReplaced('n', '');
    LDriverName := FindParamStringReplaced('d', '');
    GetStringList(AIndex).Text := dataMain.GetSqlTextFromDevtext(LName, LDriverName);
  end;
end;

procedure TBafDbModule.Upsert;
var
  LHist: boolean;
  LIni: TStringIniFile;
  LBafConName, LKeyField, LTyp, LName: string;
  LRowAffected, LNum: integer;
begin
  if FindParamBooleanReplaced('cnd', true) then begin
    LBafConName := FindParamStringReplacedLower('db', DC_DEFAULT);
    LHist := FindParamBoolean('hst', true);
    LIni := TStringIniFile.Create('');
    try
      LIni.WriteString(SEC_ADD, 't', FindParamStringReplaced('t', ''));
      LKeyField := FInter.GetPrimaryKey(FExecInter.LineP);
      LIni.WriteString(SEC_ADD, 'k', LKeyField);
      LIni.WriteBool(SEC_ADD, 'hst', LHist);
      LTyp := FindParamStringReplacedLower('y', 'i');
      if LTyp = 'i' then
        LIni.WriteBool(SEC_ADD, 'ins', true)
      else if LTyp = 'a' then
        LIni.WriteBool(SEC_ADD, 'autoins', true)
      else if LTyp = 'c' then begin
        LIni.WriteBool(SEC_ADD, 'autoins', true);
        LIni.WriteBool(SEC_ADD, 'checkupdate', true);
      end;

      FExecInter.Fields2Ini(LIni);
      LIni.WriteString(SEC_ADD, 'kv', LIni.ReadString(SEC_DATA, LKeyField, ''));

      dataMain.UpsertIni(LIni, LBafConName,
          dataMain.GetBafDbCon(LBafConName).ProgChg + FInter.CommandName, LRowAffected, nil);

      FExecInter.SetVarOrValue('n', IntToStr(LRowAffected));
    finally
      FreeAndNil(LIni);
    end;
  end; // if FindParamBooleanReplaced
// procedure TBafDbModule.Upsert
end;

procedure TBafDbModule.Upsert2;
var
  LHist: boolean;
  LIni: TStringIniFile;
  LBafConName, LKeyField, LTyp, LName, LSql, LTable, LKeyValue, LUpsert2Key: string;
  LRowAffected, LNum: integer;
  LUpsert2KeyValue: TUpsert2KeyValue;

  procedure lokSql;
  var
    i: integer;
    s, LKeyName, LKeyValue, LKeyType: string;
  begin
    LSql := Format('select %s as id from %s where 1 = 1 ', [LKeyField, LTable]);
    for i := 1 to 9 do begin
      s := IntToStr(i);
      LKeyName := FindParamStringReplaced('kf' + s, '');
      if LKeyName <> '' then begin
        LKeyValue := LIni.ReadString(SEC_DATA, LKeyName, '');
        LKeyType := FindParamStringReplacedLower('ky' + s, '');
        if LKeyType = 'int' then
          LSql := LSql + Format('and %s = %s ', [LKeyName, LKeyValue])
        else if LKeyType = 'date' then
          LSql := LSql + Format('and %s = %s ', [LKeyName,
              QuotedStr(FormatDateTime('yyyy-mm-dd', StrToDateDef(LKeyValue, -1)))])
        else
          LSql := LSql + Format('and %s = %s ', [LKeyName, QuotedStr(LKeyValue)]);
      end; // if LKeyName <> ''
    end; // for i := 1 to 9
  end; // procedure lokSql

begin
  if FindParamBooleanReplaced('cnd', true) then begin
    LBafConName := FindParamStringReplacedLower('db', DC_DEFAULT);
    LHist := FindParamBoolean('hst', true);
    LIni := TStringIniFile.Create('');
    try
      LTable := FindParamStringReplaced('t', '');
      LIni.WriteString(SEC_ADD, 't', LTable);
      LKeyField := FInter.GetPrimaryKey(FExecInter.LineP);
      LIni.WriteString(SEC_DATA, LKeyField, '');
      LIni.WriteString(SEC_ADD, 'k', LKeyField);
      LIni.WriteBool(SEC_ADD, 'hst', LHist);
      FExecInter.Fields2Ini(LIni);
      lokSql;

      LUpsert2Key := FindParamStringReplacedLower('yk', 'guid');
      if LUpsert2Key = 'null'
        then LUpsert2KeyValue := ukvNull
      else if LUpsert2Key = '0'
        then LUpsert2KeyValue := ukv0
      else if LUpsert2Key = 'value'
        then LUpsert2KeyValue := ukvValue
      else LUpsert2KeyValue := ukvGuid;

      dataMain.UpsertIni2(LIni, LBafConName,
          dataMain.GetBafDbCon(LBafConName).ProgChg + FInter.CommandName, LSql,
          LRowAffected, LKeyValue, LUpsert2KeyValue, nil);

      FExecInter.SetVarOrValue('n', IntToStr(LRowAffected));
      FExecInter.SetVarOrValue('nk', LKeyValue);
    finally
      FreeAndNil(LIni);
    end;
  end; // if FindParamBooleanReplaced
// procedure TBafDbModule.Upsert2
end;

procedure TBafDbModule.ImportDefs;
begin
  FImportDefs.Add(FExecInter.LineP);
end;

procedure TBafDbModule.ImportTables;
var
  LBafConName, LFileName, LLine, LTableName, LKeyName, LImportType, LFieldName, s: string;
  LIniVorlage: string;
  sl, slField, slGuidRep, slMultiLine, slMultiLine2: TStringList;
  i, LRowAffected: integer;
  LFirstTable: boolean;
  LIni: TStringIniFile;

  procedure lokNewField;
  begin
    if LFieldName <> '' then begin
      if slField.Count > 1 then begin
        if slMultiLine = nil then
          slMultiLine := TStringList.Create;
        slMultiLine2 := TStringList.Create;
        slMultiLine2.Assign(slField);
        slMultiLine.AddObject(LFieldName, slMultiLine2);
        LIni.WriteString(SEC_DATA, LFieldName, '');
      end
      else
        LIni.WriteString(SEC_DATA, LFieldName, Trim(slField.Text));
    end;
    LFieldName := copy(LLine, 4, Length(LLine) - 6);
    slField.Clear;
  end;

  procedure lokFinishRow;
  begin
    s := LIni.ReadString(SEC_DATA, LKeyName, '');
    LIni.WriteString(SEC_ADD, 'kv', s);
    if LImportType = 'guid_only' then begin
      LIni.WriteBool(SEC_ADD, 'autoins', true);
      dataMain.UpsertIni(LIni, LBafConName,
          dataMain.GetBafDbCon(LBafConName).ProgChg + FInter.CommandName,
          LRowAffected, slMultiLine);
    end;
    if Assigned(slMultiLine) then
      slMultiLine.Clear;
    LIni.AsString := LIniVorlage;
    LFieldName := '';
  end;

  procedure lokNewTable;
  var
    i: integer;
    LDef: string;
  begin
    LTableName := s;
    for i := 0 to FImportDefs.Count - 1 do begin
      LDef := FImportDefs[i];
      s := FindParamStringLower(LDef, 't', '');
      if s = LTableName then begin
        LImportType := FindParamStringLower(FImportDefs[i], 'y', 'guid_only');
        LIni.Clear;
        LIni.WriteString(SEC_ADD, 't', LTableName);
        LKeyName := FindParamStringLower(LDef, 'k', '');
        if LKeyName = '' then
          LKeyName := FExecInter.GetPrimaryKey(LDef);
        LIni.WriteString(SEC_ADD, 'k', LKeyName);
        LIni.WriteBool(SEC_ADD, 'hst', FindParamBooleanReplaced(LDef, 'hst', true));
        LIniVorlage := LIni.AsString;
        exit;
      end;
    end;
  end; // procedure lokNewTable

  procedure lokNewRow;
  begin
    if not LFirstTable then begin
      lokNewField;
      lokFinishRow;
    end;
    LFirstTable := false;
    s := copy(LLine, 3, Length(LLine) - 4);
    if s <> LTableName then
      lokNewTable;
    slMultiLine := nil;
  end;

  procedure lokProcLine;
  begin
    if copy(LLine, 1, 5) = '-----' then         // ignore
    else if copy(LLine, 1, 5) = '=====' then    // ignore
    else if (copy(LLine, 1, 3) = '@@@')
        and (copy(LLine, Length(LLine) - 2, 3) = '@@@') then
      lokNewField
    else if (copy(LLine, 1, 2) = '@@')
        and (copy(LLine, Length(LLine) - 1, 2) = '@@') then
      lokNewRow
    else
      slField.Add(LLine);
  end; // procedure lokProcLine

begin
  LFileName := FindParamStringReplaced('fn', '');
  LBafConName := FindParamStringReplacedLower('db', DC_DEFAULT);
  if LFileName = 'abort' then
    exit;
  if FileExists(LFileName) then begin
    sl := TStringList.Create;
    slField := TStringList.Create;
    slGuidRep := TStringList.Create;
    LIni := TStringIniFile.Create('');
    try
      try
        dataMain.StartTransaction(LBafConName);
        LFirstTable := true;
        sl.LoadFromFile(LFileName);
        for i := 0 to sl.Count - 1 do begin
          LLine := sl[i];
          lokProcLine;
        end;
        lokNewField;
        lokFinishRow;
        dataMain.Commit(LBafConName);
      except
        dataMain.Rollback(LBafConName);
        raise;
      end;
    finally
      LIni.Free;
      slGuidRep.Free;
      slField.Free;
      sl.Free;
    end;
  end
  else
    FInter.DoLog('E', '#sql_importtables, File does not exist: ' + LFileName);
  FImportDefs.Clear;
// procedure TBafDbModule.ImprtTables
end;

function TBafDbModule.InterpretLine(AExecInter: TBafCustomInterpreter): boolean;
var
  LNum: integer;
  LInter: TBafCustomInterpreter;
begin
  result := true;
  LInter := FExecInter;
  try
    FExecInter := AExecInter;
    if BafIsNumberedFunk(FExecInter.LineF, '#sql', LNum) then SetSql(LNum)                 // adds one line to the sql statement
    else if BafIsNumberedFunk(FExecInter.LineF, '#sql_line', LNum) then SetSqlLine(LNum)    // adds one line to the sql statement
    else if BafIsNumberedFunk(FExecInter.LineF, '#sql_text', LNum) then SetSqlText(LNum)    // sets the sql text
    else if BafIsNumberedFunk(FExecInter.LineF, '#clearsql', LNum) then ClearSql(LNum)     // clears the sql statement
    else if BafIsNumberedFunk(FExecInter.LineF, '#sql_clear', LNum) then ClearSql(LNum)    // clears the sql statement
    else if FExecInter.LineF = '#sql_clearall' then FSqlList.Clear                         // clears all sql statements
    else if BafIsNumberedFunk(FExecInter.LineF, '#execsql', LNum) then ExecSql(LNum)       // execute the sql statement
    else if BafIsNumberedFunk(FExecInter.LineF, '#sql_exec', LNum) then ExecSql(LNum)      // execute the sql statement
    else if BafIsNumberedFunk(FExecInter.LineF, '#opensql', LNum) then OpenSql(LNum)       // opens a select statement
    else if BafIsNumberedFunk(FExecInter.LineF, '#sql_open', LNum) then OpenSql(LNum)      // opens a select statement
    else if BafIsNumberedFunk(FExecInter.LineF, '#opensqlval', LNum) then OpenSqlVal(LNum, AExecInter)               // opens a select statement and writes the result in a val or var
    else if BafIsNumberedFunk(FExecInter.LineF, '#sql_openval', LNum) then OpenSqlVal(LNum, AExecInter)              // opens a select statement and writes the result in a val or var
    else if BafIsNumberedFunk(FExecInter.LineF, '#opensqlvalrows', LNum) then OpenSqlValRows(LNum, AExecInter)       // opens a select statement and writes the result in a val or var, multible rows
    else if BafIsNumberedFunk(FExecInter.LineF, '#sql_openvalrows', LNum) then OpenSqlValRows(LNum, AExecInter)      // opens a select statement and writes the result in a val or var, multible rows
    else if BafIsNumberedFunk(FExecInter.LineF, '#sql_openvallist', LNum) then OpenSqlValList(LNum, AExecInter)      // opens a select statement and writes the result in a list
    else if BafIsNumberedFunk(FExecInter.LineF, '#sql_opentvl', LNum) then OpenSqlTvl(LNum)      // opens a select statement and creates a TextValueList
    else if BafIsNumberedFunk(FExecInter.LineF, '#sql_openkvl', LNum) then OpenSqlKvl(LNum)      // opens a select statement and creates a TextValueList

    else if FExecInter.LineF = '#defline' then DefLine
    else if FExecInter.LineF = '#sql_defline' then DefLine
    else if FExecInter.LineF = '#filltables' then FillTables
    else if FExecInter.LineF = '#sql_filltables' then FillTables

    else if FExecInter.LineF = '#intransaction' then InTransaction
    else if FExecInter.LineF = '#sql_intransaction' then InTransaction
    else if FExecInter.LineF = '#upsert' then Upsert
    else if FExecInter.LineF = '#sql_upsert' then Upsert
    else if FExecInter.LineF = '#upsert2' then Upsert2
    else if FExecInter.LineF = '#sql_upsert2' then Upsert2

    else if FExecInter.LineF = '#debugfullrow' then DebugFullRow
    else if FExecInter.LineF = '#sql_debugfullrow' then DebugFullRow

    else if FExecInter.LineF = '#sql_exporttables' then ExportTables
    else if FExecInter.LineF = '#sql_importdefs' then ImportDefs
    else if FExecInter.LineF = '#sql_importtables' then ImportTables
    else if BafIsNumberedFunk(FExecInter.LineF, '#sql_migrate', LNum) then Migrate(LNum)

    else if FExecInter.LineF = '#db_add' then BafAddDatabase



    else result := false;


  finally
    FExecInter := LInter;
  end;

end;

end.
