unit uBafInterpreter;

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

// - the interpreter, the InterpreterLevel and the CustomModule
// - the parser for boolean expressions

// the real work will be done in the modules inheriting from
// TBafInterpreterCustomModule

// https://bafbal.de/index.php?title=Interpreter

interface

uses SysUtils, Classes, contnrs, uBafTypes, FMX.StdCtrls, Data.DB, FMX.Types,
  System.Math, System.StrUtils, IniFiles,  System.UITypes, uStringIniFile,
  FMX.Forms;

type
  TBafInterpreter = class;

  TBafInterpreterModuleType = (mtGlobal, mtLevel);
  TBafInterpreterEvent = (ieBeforeExec, ieAfterExec, ieBeforeLine, ieAfterLine,
      ieAfterShow);

  TBafInterpreterNeedCode = procedure(AInter: TBafInterpreter; AName: string;
      ACode: TStrings) of object;
  TBafInterpreterNeedInfo = procedure(AInter: TBafInterpreter; AName,
      AParam: string; var AInfo: string) of object;
  TBafInterpreterLog = procedure(AInter: TBafInterpreter; ALogType,
      ALogText: string) of object;
  TBafInterpreterCaption = procedure(AInter: TBafInterpreter;
      ACaption: string) of object;
  TBafDebugNode = procedure(AInter: TBafInterpreter; AIni: TStringIniFile) of object;

  TBafCustomInterpreter = class
  protected
    FLineF, FLineP: string;
    FCode: TStringList;
    FInter: TBafInterpreter;  // top level
    FParentInter: TBafCustomInterpreter;      // prior level
    FFilterStatus: TBafInterpreterFilterStatus;
    FBreak: boolean;
    F9Stop: boolean;
    FCommandParameters: TStringList;
    procedure SetInter(const Value: TBafInterpreter);
  protected    // Values
    FValues: TStringList;
    function GetValues(Index: integer): string;
    procedure SetValues(Index: integer; const Value: string);
    procedure SetVal;
    procedure AddVal;
    procedure ClearVals;
    function EmptyV(ANotEmpty: boolean; AParams: TStrings): string;
  protected
    function BoolStatementAuswerten(AStmnt: string): boolean;
    procedure SetFilterStatus;
    procedure WriteLog;
    procedure WriteLogI;
    procedure SetExceptionInfo;
  protected    // functions
    function GetValue(AParam: string): string;
    function GetProcParam(AParam: string): string;
    function IsCmdParam(AParams: TStrings; ANot: boolean = false): string;

  public
    constructor Create;
    destructor Destroy; override;
    procedure TabNew;
    procedure TabClose;
  public
    function FindParam(AName: string; var AParam: string): boolean; overload;
    function FindParam(AZeile, AName: string; var AParam: string): boolean; overload;
    function FindParamInteger(AName: string; ADefault: integer): integer; overload;
    function FindParamInteger(AZeile, AName: string; ADefault: integer): integer;  overload;
    function FindParamIntegerReplaced(AZeile, AName: string; ADefault: integer): integer;
    function FindParamString(AName: string; ADefault: string): string; overload;
    function FindParamString(LineP, AName: string; ADefault: string): string; overload;
    function FindParamStringReplaced(LineP, AName: string; ADefault: string): string;
    function FindParamStringLower(AName: string; ADefault: string): string; overload;
    function FindParamStringLower(ALineP, AName: string; ADefault: string): string; overload;
    function FindParamBoolean(AName: string; ADefault: boolean): boolean; overload;
    function FindParamBoolean(AZeile, AName: string; ADefault: boolean): boolean; overload;
    function FindParamBooleanReplaced(ALineP, AName: string; ADefault: boolean): boolean;
    function FindParamSingle(AName: string; ADefault: single): single; overload;
    function FindParamSingle(AZeile, AName: string; ADefault: single): single; overload;
    function FindParamSingleReplaced(AZeile, AName: string; ADefault: single): single;
    function FindParamColor(AName: string; ADefault: TColor): TColor; overload;
    function FindParamColor(AZeile, AName: string; ADefault: TColor): TColor; overload;
    function FindParamCelltype(AName: string): TBafPageCellType; overload;
    function FindParamCelltype(ALineP, AName: string): TBafPageCellType; overload;
    function GetRight(APostfix: string = ''): TBafRight; overload;
    function GetRight(AZeile, APostfix: string): TBafRight; overload;
    function GetPrimaryKey(ALineP: string; APostfix: string = ''): string;
    function FindParamAlignment(AZeileP, AParamName: string; ADefault: TBafAlignment): TBafAlignment;
    function FindParamQuelle(ALineP: string; ADefault: TBafDataQuelle;
        var AIndex: integer; APostfix: string = ''): TBafDataQuelle;
  public
    procedure Fields2Ini(AIni: TCustomIniFile); overload;
    procedure Fields2Ini(ALine: string; AIni: TCustomIniFile); overload;
    procedure Fields2IniData(AZeile, ASep: string; AIni: TCustomIniFile; ADataObject: TObject;
        AAutoKey: boolean; AQuelle: TBafDataQuelle = dqSQL);
    procedure Vars2Strings(ALine: string; AVars: TStrings);
  public
    procedure Execute(ACommand: string; AClear: boolean = false);
    procedure ExecuteCode(ACode: TStrings);
    procedure interpret;
    procedure InterpretLine(AZeile: string);
    function ReplaceFunctions(AText: string): string;
    function ReplaceFunction(ACommand: string; AParams: TStrings): string;
    function ParseBoolStatement(AStmnt: string): boolean;
    procedure ExecutionBreak;
    procedure AfterShow;
    procedure EachRow(ABafConName, AEachRow, AProcedure: string;
        AEachRowTrans, ANoException: boolean);
    procedure ExportSegmentPdf(ASegment: TObject);
    procedure ExportSegmentXls(ASegment: TObject);
    procedure ExportPageXls(APage: TObject);
    procedure ExportPagePdf(APage: TObject);
    function GetFormObject(AFormObject: TBafFrmObject): TObject; virtual;
    procedure AddGridObjectList(AObject: TObject);
    procedure WriteSrvLog(AText: string);
  public
    function GetModulType: TBafInterpreterModuleType; virtual;
    procedure SetVarOrValue(AName, AValue: string);
    function GetVarOrValue(AName: string): string;
    property Inter: TBafInterpreter read FInter write SetInter;
    property ParentInter: TBafCustomInterpreter read FParentInter;
    property Code: TStringList read FCode;
    property FilterStatus: TBafInterpreterFilterStatus read FFilterStatus write FFilterStatus;
    property LineF: string read FLineF;
    property LineP: string read FLineP write FLineP;
    property Values[Index: integer]: string read GetValues write SetValues;
  end;


  TBafInterpreterCustomModule = class
  protected
    FInter: TBafInterpreter;
    FExecInter: TBafCustomInterpreter;
    FScale: integer;
    procedure SetScale(const Value: integer); virtual;
    function FindParam(AName: string; var AParam: string): boolean; overload;
    function FindParam(AZeileP, AName: string; var AParam: string): boolean; overload;
    function FindParamInteger(ALineP, AName: string; ADefault: integer): integer; overload;
    function FindParamInteger(AName: string; ADefault: integer): integer; overload;
    function FindParamIntegerReplaced(AName: string; ADefault: integer): integer; overload;
    function FindParamIntegerReplaced(ALineP, AName: string; ADefault: integer): integer; overload;
    function FindParamString(AZeileP, AName: string; ADefault: string): string; overload;
    function FindParamString(AName: string; ADefault: string): string; overload;
    function FindParamStringLower(AName: string; ADefault: string): string; overload;
    function FindParamStringLower(ALineP, AName: string; ADefault: string): string; overload;
    function FindParamStringReplaced(AName: string; ADefault: string): string; overload;
    function FindParamStringReplaced(ALineP, AName: string; ADefault: string): string; overload;
    function FindParamStringReplacedLower(AName: string; ADefault: string): string; overload;
    function FindParamStringReplacedLower(ALineP, AName: string; ADefault: string): string; overload;
    function FindParamBoolean(AName: string; ADefault: boolean): boolean; overload;
    function FindParamBoolean(ALineP, AName: string; ADefault: boolean): boolean; overload;
    function FindParamBooleanReplaced(ALineP, AName: string; ADefault: boolean): boolean; overload;
    function FindParamBooleanReplaced(AName: string; ADefault: boolean): boolean; overload;
    function FindParamSingle(AName: string; ADefault: single): single;
    function FindParamSingleReplaced(AName: string; ADefault: single): single; overload;
    function FindParamSingleReplaced(ALineP, AName: string; ADefault: single): single; overload;
    function FindParamColor(AName: string; ADefault: TColor): TColor;
    function FindParamCelltype(AName: string): TBafPageCellType; overload;
    function FindParamCelltype(ALineP, AName: string): TBafPageCellType; overload;
    function FindParamCharCase(ALineP, AName: string; ADefault: TEditCharCase): TEditCharCase;

  protected
    function GetVariable(AName: string): string; virtual;
    procedure SetVariable(AName: string; const Value: string); virtual;
    function GetRightOfDef(AName: string): TBafRight; virtual;
    function GetCode(AClear: boolean): string; virtual;
    function GetProc(AIndex: integer): string; virtual;
    procedure ExportSegmentPdf(ASegment: TObject); virtual;
    procedure ExportSegmentXls(ASegment: TObject); virtual;
    procedure ExportPageXls(APage: TObject); virtual;
    procedure ExportPagePdf(APage: TObject); virtual;
    function GetFormObject(AFormObject: TBafFrmObject): TObject; virtual;
    procedure AddGridObjectList(AObject: TObject); virtual;
    procedure WriteSrvLog(AText: string); virtual;
    function GetIni(AIndex: integer): TStringIniFile; virtual;
  public
    constructor Create; virtual;
    function GetModulType: TBafInterpreterModuleType; virtual;
    procedure RegisterModule(AInter: TBafInterpreter); virtual;
    procedure DoModuleEvent(AInter: TBafCustomInterpreter; AEvent: TBafInterpreterEvent; AText: string); virtual;
    function InterpretLine(AExecInter: TBafCustomInterpreter): boolean; virtual;
    function ReplaceFunction(ACommand: string; AParams: TStrings; var AResult: string): boolean; virtual;
    property Scale: integer read FScale write SetScale;
  public
    procedure SqlAndParams(ABafConName, AName, ASql: string);
    function GetSqlAndClear(AIndex: integer; var ASql: string): boolean; virtual;
    function GetTextStringList(AIndex: integer): TStringList; virtual;
    function GetKatStringList(AIndex: integer): TStringList; virtual;
    function GetFrmComponent(AType: string): TComponent; virtual;
  end;

  TBafInterpreterModuleClass = class of TBafInterpreterCustomModule;

  TBafInterpreterLevel = class(TBafCustomInterpreter)
  public
    constructor Create(AInter: TBafInterpreter; AParent: TBafCustomInterpreter);
    destructor Destroy; override;
    function GetModulType: TBafInterpreterModuleType; override;
    class procedure ExecInNewLevel(ACommand: string; AParent: TBafCustomInterpreter;
        ARoot: TBafInterpreter);
  end;


  TBafInterpreter = class(TBafCustomInterpreter)
  private
    FOnLog: TBafInterpreterLog;
    FOnNeedCode: TBafInterpreterNeedCode;
    FOnNeedInfo: TBafInterpreterNeedInfo;
    FParentPanel: TPanel;
    FOnCaption: TBafInterpreterCaption;
    FScale: integer;
    FName: string;
    FClientTabCaption: string;
    FOnDebugLog: TBafInterpreterCaption;
    FDebugLogActive: boolean;
    FOnDebugNode: TBafDebugNode;
    FCommandName: string;
    FInterType: TBafInterType;
    FOnReturn2Tab: TNotifyEvent;
    FOnClose: TNotifyEvent;
    FIsConsole: boolean;
    FLogHideCommand: boolean;
    FOnChangeLanguage: TNotifyEvent;
    FSrvDebgLog: boolean;
    FExceptionInfo: string;
    FProgressAborted: boolean;
    procedure SetScale(const Value: integer);
  protected
    FModuleList: TStringList;
    function GetVariable(AName: string): string;
    procedure SetVariable(AName: string; const Value: string);
  protected
    FTimer: TTimer;
    FTimerCommandList: TStringList;
    procedure TimerTimer(Sender: TObject);
  public
    constructor Create(AInterType: TBafInterType);
    destructor Destroy; override;
    procedure RegisterModule(AName: string; AModule: TBafInterpreterCustomModule);
    procedure DoNeedCode(AName: string; ACode: TStrings);
    procedure DoLog(ALogType, ALogText: string);
    procedure DoCaption(ACaption: string);
    procedure DoModuleEvent(AEvent: TBafInterpreterEvent; AText: string);
    function NeedInfo(AName, AParam: string): string;
    function GetSqlAndClear(AIndex: integer): string;
    function GetCode(AClear: boolean): string;
    procedure DebugLog(AText: string);
    procedure DebugNodeIni(AIni: TStringIniFile);
    procedure DebugDbRow(ADataSet: TDataSet; AFull: boolean = false);
    function GetRightOfDef(AName: string): TBafRight;
    procedure CommandOnTimer(ACommand: string);
    procedure Return2Tab;
    procedure ChangeLanguage;
    function GetTextStringList(AIndex: integer): TStringList;
    function GetKatStringList(AIndex: integer): TStringList;
    function GetFrmComponent(AType: string): TComponent;
    function GetIni(AIndex: integer): TStringIniFile;
    property OnNeedCommand: TBafInterpreterNeedCode read FOnNeedCode write FOnNeedCode;
    property OnNeedInfo: TBafInterpreterNeedInfo read FOnNeedInfo write FOnNeedInfo;
    property OnLog: TBafInterpreterLog read FOnLog write FOnLog;
    property OnCaption: TBafInterpreterCaption read FOnCaption write FOnCaption;
    property OnDebugLog: TBafInterpreterCaption read FOnDebugLog write FOnDebugLog;
    property OnDebugNode: TBafDebugNode read FOnDebugNode write FOnDebugNode;
    property Variable[AName: string]: string read GetVariable write SetVariable;
    property ParentPanel: TPanel read FParentPanel write FParentPanel;
    property Scale: integer read FScale write SetScale;
    property Name: string read FName write FName;
    property ClientTabCaption: string read FClientTabCaption write FClientTabCaption;
    property DebugLogActive: boolean read FDebugLogActive write FDebugLogActive;
    property CommandName: string read FCommandName;
    property InterType: TBafInterType read FInterType;
    property OnReturn2Tab: TNotifyEvent read FOnReturn2Tab write FOnReturn2Tab;
    property OnClose: TNotifyEvent read FOnClose write FOnClose;
    property IsConsole: boolean read FIsConsole write FIsConsole;
    property LogHideCommand: boolean read FLogHideCommand write FLogHideCommand;
    property SrvDebgLog: boolean read FSrvDebgLog write FSrvDebgLog;
    property ExceptionInfo: string read FExceptionInfo write FExceptionInfo;
    property ProgressAborted: boolean read FProgressAborted write FProgressAborted;
    property OnChangeLanguage: TNotifyEvent read FOnChangeLanguage write FOnChangeLanguage;
    function GetModule(AName: string):TBafInterpreterCustomModule;
  end;



implementation

{ TBafInterpreter }

uses uBafClientTab, dmMain, uBafInterpreterModuleList, uBafJsonModule;

procedure TBafInterpreter.ChangeLanguage;
begin
  if Assigned(FOnChangeLanguage) then
    FOnChangeLanguage(Self);
end;

procedure TBafInterpreter.CommandOnTimer(ACommand: string);
begin
  FTimerCommandList.Add(ACommand);
  FTimer.Enabled := true;
end;

constructor TBafInterpreter.Create(AInterType: TBafInterType);
begin
  inherited Create;
  FInterType := AInterType;
  FModuleList := TStringList.Create(dupError, true, false);
  FModuleList.OwnsObjects := true;
  FTimer := TTimer.Create(nil);
  FTimer.Enabled := false;
  FTimer.Interval := 50;
  FTimer.OnTimer := TimerTimer;
  FTimerCommandList := TStringList.Create;
end;

procedure TBafInterpreter.DebugDbRow(ADataSet: TDataSet; AFull: boolean);
begin
  { TODO : not yet }
end;

procedure TBafInterpreter.DebugLog(AText: string);
begin
  if FDebugLogActive and Assigned(FOnDebugLog) then
    FOnDebugLog(self, AText);
  if SrvDebgLog and Assigned(FOnLog) then
    FOnLog(Self, 'D', AText);
end;

procedure TBafInterpreter.DebugNodeIni(AIni: TStringIniFile);
begin
  if Assigned(FOnDebugNode) then
    FOnDebugNode(Self, AIni);
end;

destructor TBafInterpreter.Destroy;
begin
  FreeAndNil(FTimer);
  FreeAndNil(FTimerCommandList);
  FreeAndNil(FModuleList);
  inherited;
end;

procedure TBafInterpreter.DoCaption(ACaption: string);
begin
  if Assigned(FOnCaption) then
    FOnCaption(Self, ACaption);
end;

procedure TBafInterpreter.DoLog(ALogType, ALogText: string);
var
  s: string;
begin
  if (ALogType = 'E') and (FExceptionInfo <> '') then
    ALogText := FExceptionInfo + ' - ' + ALogText;
  if Assigned(FOnLog) then begin
    if (ALogType <> 'C') or not FLogHideCommand then
      FOnLog(Self, ALogType, ALogText);
  end;
  s := '(' + ALogType + ')  ' + ALogText;
  DebugLog(s);
  if ALogType = 'E' then
    raise Exception.Create('Error: ' + ALogText);
  if gvInterType = itSrvProc then
    WriteSrvLog(s);
end;

procedure TBafInterpreter.DoModuleEvent(AEvent: TBafInterpreterEvent; AText: string);
var
  i: integer;
begin
  for i := 0 to FModuleList.Count - 1 do
    (FModuleList.Objects[i] as TBafInterpreterCustomModule).DoModuleEvent(Self, AEvent, AText);
end;

procedure TBafInterpreter.DoNeedCode(AName: string; ACode: TStrings);
var
  i: integer;
begin
  i := StrToIntDef(AName, -1);
  if (i > 0) and not (AName[1] in ['x', 'X']) then
    ACode.Text := GetModule('var').GetProc(i)
  else if Assigned(FOnNeedCode) then
    FOnNeedCode(Self, AName, ACode);
end;

function TBafInterpreter.GetCode(AClear: boolean): string;
begin
  result := GetModule('var').GetCode(AClear);
end;

function TBafInterpreter.GetFrmComponent(AType: string): TComponent;
var
  LModule: TBafInterpreterCustomModule;
begin
  result := nil;
  LModule := GetModule('frm');
  if Assigned(LModule) then
    result := LModule.GetFrmComponent(AType);
end;

function TBafInterpreter.GetIni(AIndex: integer): TStringIniFile;
begin
  result := GetModule('var').GetIni(AIndex);
end;

function TBafInterpreter.GetKatStringList(AIndex: integer): TStringList;
begin
  result := GetModule('var').GetKatStringList(AIndex);
end;

function TBafInterpreter.GetModule(AName: string): TBafInterpreterCustomModule;
var
  ix: integer;
begin
  result := nil;
  ix := FModuleList.IndexOf(AName);
  if ix > -1 then
    result := (FModuleList.Objects[ix] as TBafInterpreterCustomModule);
end;

function TBafInterpreter.GetRightOfDef(AName: string): TBafRight;
begin
  result := GetModule('var').GetRightOfDef(AName);
end;

function TBafInterpreter.GetSqlAndClear(AIndex: integer): string;
begin
  GetModule('db').GetSqlAndClear(AIndex, result);
end;

function TBafInterpreter.GetTextStringList(AIndex: integer): TStringList;
begin
  result := GetModule('var').GetTextStringList(AIndex);
end;

function TBafInterpreter.GetVariable(AName: string): string;
begin
  result := GetModule('var').GetVariable(AName);
end;

function TBafInterpreter.NeedInfo(AName, AParam: string): string;
begin
  result := '';
  if Assigned(FOnNeedInfo) then
    FOnNeedInfo(Self, AName, AParam, result);
end;

procedure TBafInterpreter.RegisterModule(AName: string; AModule: TBafInterpreterCustomModule);
begin
  FModuleList.AddObject(AName, AModule);
  AModule.RegisterModule(Self);
end;

procedure TBafInterpreter.Return2Tab;
begin
  if Assigned(FOnReturn2Tab) then
    FOnReturn2Tab(Self);
end;

procedure TBafInterpreter.SetScale(const Value: integer);
var
  i: integer;
begin
  FScale := Value;
  for i := 0 to FModuleList.Count - 1 do
    (FModuleList.Objects[i] as TBafInterpreterCustomModule).Scale := Value;
end;

procedure TBafInterpreter.SetVariable(AName: string; const Value: string);
begin
  GetModule('var').SetVariable(AName, Value);
end;

procedure TBafInterpreter.TimerTimer(Sender: TObject);
var
  LCommand: string;
begin
  FTimer.Enabled := false;
  try
    LCommand := FTimerCommandList[0];
    FTimerCommandList.Delete(0);
    Execute(LCommand);
  finally
    if FTimerCommandList.Count > 0 then
      FTimer.Enabled := true;
  end;
end;

{ TBafInterpreterLevel }

constructor TBafInterpreterLevel.Create(AInter: TBafInterpreter;
    AParent: TBafCustomInterpreter);
begin
  inherited Create;
  Inter := AInter;
  FParentInter := AParent;
end;

destructor TBafInterpreterLevel.Destroy;
begin

  inherited;
end;

class procedure TBafInterpreterLevel.ExecInNewLevel(ACommand: string;
    AParent: TBafCustomInterpreter; ARoot: TBafInterpreter);
var
  LInter, LParent: TBafCustomInterpreter;
begin
  LParent := AParent;
  if LParent = nil then
    LParent := ARoot;
  LInter := TBafInterpreterLevel.Create(ARoot, LParent);
  try
    LInter.Execute(ACommand);
  finally
    LInter.Free;
  end;
end;

function TBafInterpreterLevel.GetModulType: TBafInterpreterModuleType;
begin
  result := mtLevel;
end;

{ TBafCustomInterpreter }

procedure TBafCustomInterpreter.ClearVals;
begin
  FValues.Clear;
end;

constructor TBafCustomInterpreter.Create;
begin
  inherited;
  FCode := TStringList.Create;
  FValues := TStringList.Create;
  FCommandParameters := TStringList.Create;
end;

destructor TBafCustomInterpreter.Destroy;
begin
  FreeAndNil(FCommandParameters);
  FreeAndNil(FValues);
  FreeAndNil(FCode);
  inherited;
end;

procedure TBafCustomInterpreter.EachRow(ABafConName, AEachRow, AProcedure: string;
  AEachRowTrans, ANoException: boolean);
begin
  if AEachRowTrans then begin
    dataMain.StartTransaction(ABafConName);
    try
      TBafInterpreterLevel.ExecInNewLevel(AEachRow, Self, FInter);
      dataMain.Commit(ABafConName);
    except
      on E: Exception do begin
        dataMain.Rollback(ABafConName);
        if ANoException then
          FInter.DoLog('W', AProcedure + ' - exception raised: ' + E.Message)
        else
          FInter.DoLog('E', AProcedure + ' - exception raised: ' + E.Message);
      end;
    end;
  end
  else begin
    try
      TBafInterpreterLevel.ExecInNewLevel(AEachRow, Self, FInter);
    except
      on E: Exception do begin
        if ANoException then
          FInter.DoLog('W', AProcedure + ' - exception raised: ' + E.Message)
        else
          FInter.DoLog('E', AProcedure + ' - exception raised: ' + E.Message);
      end;
    end;
  end;
end;

function TBafCustomInterpreter.EmptyV(ANotEmpty: boolean; AParams: TStrings): string;
var
  LValue: string;
begin
  if AParams.Count > 0 then begin
    LValue := Values[StrToIntDef(AParams[0], 0)];
    if ANotEmpty then
      result := IfThen(Trim(LValue) = '', BAFNOCHAR, BAFYESCHAR)
    else
      result := IfThen(Trim(LValue) = '', BAFYESCHAR, BAFNOCHAR);
  end
  else
    FInter.DoLog('E', '$EMPTYVAL(n) / $NEMPTYVAL(n) - number of params low');
end;

procedure TBafCustomInterpreter.Execute(ACommand: string; AClear: boolean = false);

  procedure lokExtractProcedureParameters;
  var
    i, p1, LKlammerCount, LVorne: integer;
    LInQuote: boolean;
    s: string;

    procedure lokParameter;
    begin
      s := Trim(copy(ACommand, LVorne, i - LVorne));
      FCommandParameters.Add(s);
      LVorne := i + 1;
    end;

  begin
    FCommandParameters.Clear;
    p1 := Pos('(', ACommand);
    LVorne := p1 + 1;
    LKlammerCount := 0;
    LInQuote := false;
    if (p1 > 0)  then begin
      for i := LVorne to Length(ACommand) do begin
        case ACommand[i] of
          '"': LInQuote := not LInQuote;
          '(': inc(LKlammerCount);
          ')': begin
            dec(LKlammerCount);
            if (LKlammerCount = -1) and not LInQuote then
              lokParameter;
          end;
          ',': begin
            if (LKlammerCount = 0) and not LInQuote then
              lokParameter;
          end;
        end;
      end;
      ACommand := Trim(copy(ACommand, 1, p1 - 1));
    end;
  end; // procedure lokExtractProcedureParameters

begin
  if AClear then begin
    InterpretLine('#text_clearall');
    InterpretLine('#kat_clearall');
    InterpretLine('#cmd_clearall');
    InterpretLine('#var_clearall');
    InterpretLine('#val_clearall');
    InterpretLine('#sql_clearall');
    InterpretLine('#rights_clear');
    FInter.ExceptionInfo := '';
  end;
  if (Length(ACommand) > 0) then begin
    Inter.DoLog('C', ACommand);
    if  (ACommand[1] = '#') then
      FCode.Text := ACommand
    else begin
      lokExtractProcedureParameters;
      FInter.FCommandName := ACommand;
      Inter.DoNeedCode(ACommand, FCode);
    end;

    FInter.DoModuleEvent(ieBeforeExec, ACommand);
    try
      interpret;
    finally
      FInter.DoModuleEvent(ieAfterExec, ACommand);
    end;

  end;
// procedure TBafCustomInterpreter.Execute
end;

procedure TBafCustomInterpreter.ExecuteCode(ACode: TStrings);
begin
  FCode.Assign(ACode);
  FInter.DoModuleEvent(ieBeforeExec, '');
  try
    interpret;
  finally
    FInter.DoModuleEvent(ieAfterExec, '');
  end;
end;

procedure TBafCustomInterpreter.ExecutionBreak;
begin
  FBreak := true;
end;

procedure TBafCustomInterpreter.ExportPagePdf(APage: TObject);
begin
  FInter.GetModule('pdf').ExportPagePdf(APage);
end;

procedure TBafCustomInterpreter.ExportPageXls(APage: TObject);
begin
  FInter.GetModule('xls').ExportPageXls(APage);
end;

procedure TBafCustomInterpreter.ExportSegmentPdf(ASegment: TObject);
begin
  FInter.GetModule('pdf').ExportSegmentPdf(ASegment);
end;

procedure TBafCustomInterpreter.ExportSegmentXls(ASegment: TObject);
begin
  FInter.GetModule('xls').ExportSegmentXls(ASegment);
end;

procedure TBafCustomInterpreter.AddGridObjectList(AObject: TObject);
begin
  FInter.GetModule('frm').ExportSegmentXls(AObject);
end;

procedure TBafCustomInterpreter.AddVal;
var
  LNum: integer;
  LValue, LRightName, LTyp: string;
begin
  if FindParamBooleanReplaced(LineP, 'cnd', true) then begin
    LRightName := FindParamStringLower('r', 'frm');
    if (LRightName = 'frm')
        or (FInter.GetRightOfDef(LRightName) = brWrite) then begin
      LNum := StrToIntDef(Trim(FindParamString('n', '')), -1);
      if LNum >= 0 then begin
        LValue := ReplaceFunctions(FindParamString('z', ''));
        LTyp := ReplaceFunctions(FindParamStringLower('y', ''));
        if LTyp = 'int' then
          Values[LNum] := IntToStr(StrToIntDef(Values[LNum], 0)
              + StrToIntDef(LValue, 0))
        else if LTyp = 'curr' then
          Values[LNum] := CurrToStr(StrToCurrDef(Values[LNum], 0)
              + StrToCurrDef(LValue, 0))
        else if LTyp = 'date' then
          Values[LNum] := FormatDateTime('dd.mm.yyyy', StrToDateTimeDef(Values[LNum], 0)
              + StrToFloatDef(LValue, 0))
        else if LTyp = 'datetime' then
          Values[LNum] := FormatDateTime('dd.mm.yyyy hh:mm:ss',
              StrToDateTimeDef(Values[LNum], 0) + StrToFloatDef(LValue, 0))
        else
          Values[LNum] := Values[LNum] + LValue;
      end
      else
        FInter.DoLog('E', 'SetVal, Parameter n is not numeric');
    end;
  end
end;

procedure TBafCustomInterpreter.AfterShow;
begin
  FInter.DoModuleEvent(ieAfterShow, '');
end;

function TBafCustomInterpreter.BoolStatementAuswerten(AStmnt: string): boolean;
type
  TOpType = (opEqual, opCaseInsensitive, opGreater, opGreaterEqual, opSmaller,
      opSmallerEqual, opNotEqual);
var
  s, LLinks, LRechts: string;
  LLi, LRe: currency;
  LResult: boolean;
  p: integer;

  function lokCheck(ATrenn: string; AType: TOpType): boolean;
  begin
    p := Pos(ATrenn, AStmnt);
    result := p > 0;
    if result then begin
      LLinks := Trim(copy(AStmnt, 1, p - 1));
      LRechts := Trim(copy(AStmnt, p + Length(ATrenn), MaxInt));
      LLi := StrToCurrDef(LLinks, MaxCurrency);
      LRe := StrToCurrDef(LRechts, MaxCurrency);
      case AType of
        opEqual: LResult := AnsiCompareStr(LLinks, LRechts) = 0;
        opNotEqual: LResult := AnsiCompareStr(LLinks, LRechts) <> 0;
        opCaseInsensitive: LResult := AnsiCompareText(LLinks, LRechts) = 0;
        opGreaterEqual: LResult := (LLi >= LRe) and (LLi <> MaxCurrency);
        opGreater: LResult := (LLi > LRe) and (LLi <> MaxCurrency);
        opSmallerEqual: LResult := (LLi <= LRe) and (LRe <> MaxCurrency);
        opSmaller: LResult := (LLi < LRe) and (LRe <> MaxCurrency);
      end;
    end;
  end; // function lokCheck

begin
  if lokCheck('==', opCaseInsensitive) then
    result := LResult
  else if lokCheck('<>', opNotEqual) then
    result := LResult
  else if lokCheck('!=', opNotEqual) then
    result := LResult
  else if lokCheck('>=', opGreaterEqual) then
    result := LResult
  else if lokCheck('>', opGreater) then
    result := LResult
  else if lokCheck('<=', opSmallerEqual) then
    result := LResult
  else if lokCheck('<', opSmaller) then
    result := LResult
  else if lokCheck('=', opEqual) then
    result := LResult
  else begin
    s := Trim(AStmnt);
    result := ((Length(s) = 1) and CharInSet(s[1], BAFYESCHARS)) or (s = '');
  end;
end;

procedure TBafCustomInterpreter.Fields2Ini(AIni: TCustomIniFile);
begin
  Fields2Ini(LineP, AIni);
end;

procedure TBafCustomInterpreter.Fields2Ini(ALine: string; AIni: TCustomIniFile);
// add the columns to a Ini
var
  i, p1, p2, LProgress: integer;
  LData: string;
  LInQuote: boolean;
begin
  LProgress := 0;
  p1 := 0;
  p2 := 0;
  LInQuote := false;
  ALine := ALine + ' ';
  for i := 1 to Length(ALine) do begin
    if ALine[i] = '"' then
      LInQuote := not LInQuote;
    if not LInQuote then begin
      if (LProgress = 0) and (ALine[i] = 'f')
          and (i < Length(ALine)) and (ALine[i + 1] = '_')
          and (i > 1) and (ALine[i - 1] = ' ') then begin
        LProgress := 1;     // start a columd def
        p1 := i + 2;
      end
      else if (LProgress = 1) and (ALine[i] = '=') then begin
        LProgress := 2;     // in the column the equal sign starts
        p2 := i;
      end
      else if (LProgress = 2) and (i = p2 + 1) and (ALine[i] = '"') then
        LProgress := 3     // column value quoted
      else if (LProgress = 2) and (ALine[i] = ' ') then begin
        if ALine[P2 + 1] = '"' then
          LData := copy(ALine, p2 + 2, i - p2 - 3)
        else
          LData := copy(ALine, p2 + 1, i - p2 - 1);
        LData := ReplaceFunctions(LData);
        AIni.WriteString(SEC_DATA, copy(ALine, p1, p2 - p1), LData);
        LProgress := 0;
      end
      else if (LProgress = 3) and (ALine[i] = '"') then begin
        raise Exception.Create('TBafCustomInterpreter.Fields2Ini LProgress 3');
        LData := copy(ALine, p2 + (LProgress - 1), i - p2 - (LProgress - 1));
        LData := ReplaceFunctions(LData);
        AIni.WriteString(SEC_DATA, copy(ALine, p1, p2 - p1), LData);
        LProgress := 0;
      end;
    end; // if not LInQuote then begin
  end; // for i := 1 to
end;

procedure TBafCustomInterpreter.Fields2IniData(AZeile, ASep: string; AIni: TCustomIniFile;
    ADataObject: TObject; AAutoKey: boolean; AQuelle: TBafDataQuelle = dqSQL);
// adds the column to the ini
var
  i, p1, p2, LProgress: integer;
  LData, LName, LValue: string;
  LInQuote: boolean;
  LField: TField;

  function GetData(AData: string): string;
  begin
    case AQuelle of
      dqTable, dqSql: begin
        LField := (ADataObject as TDataSet).FindField(AData);
        if Assigned(LField) then
          result := LField.AsString
        else
          result := ReplaceFunctions(AData);
      end;
      dqJSON: begin
        if TBafJsonModule.GetNodeValue(ADataObject, LName, ASep, LValue) then
          result := LValue
        else
          result := ReplaceFunctions(AData);
      end;
    end;
  end; // function GetData

  procedure lokInsert(AName, AData: string);
  begin
    if AName <> '' then begin
      if AData = '!' then
        AData := AName;
      AData := GetData(AData);
      AIni.WriteString(SEC_DATA, AName, AData);
      AIni.WriteString(SEC_DB, AName, AData);
    end;
  end; // procedure lokInsert

  procedure lokAutoKey;
  // the primary key column and c1 and c2 are added automatically
  begin
    LName := AIni.ReadString(SEC_ADD, 'k', '');
    if (LName <> '') and (AIni.ReadString(SEC_DATA, LName, '') = '') then begin
      LData := GetData(LName);
      AIni.WriteString(SEC_DATA, LName, LData);
      AIni.WriteString(SEC_DB, LName, LData);
    end;
    LName := AIni.ReadString(SEC_ADD, 'c1', '');
    lokInsert(LName, LName);
    LName := AIni.ReadString(SEC_ADD, 'c2', '');
    lokInsert(LName, LName);
  end; // procedure lokAutoKey;

begin
  LProgress := 0;
  p1 := 0;
  p2 := 0;
  LInQuote := false;
  for i := 1 to Length(AZeile) do begin
    if AZeile[i] = '"' then
      LInQuote := not LInQuote;
    if not LInQuote then begin
      if (LProgress = 0) and (AZeile[i] = 'f') and (i < Length(AZeile)) and (AZeile[i + 1] = '_') then begin
        LProgress := 1;     // a column def begins
        p1 := i + 2;
      end
      else if (LProgress = 1) and (AZeile[i] = '=') then begin
        LProgress := 2;     // after the =
        p2 := i;
      end
      else if (LProgress = 2) and (i = p2 + 1) and (AZeile[i] = '"') then
        LProgress := 3     // Quoted
      else if ((LProgress = 2) and (AZeile[i] = ' '))
          or ((LProgress = 2) and (i = Length(AZeile)))
          or ((LProgress = 3) and (AZeile[i] = '"')) then begin
        LName := copy(AZeile, p1, p2 - p1);
        LData := copy(AZeile, p2 + (LProgress - 1), i - p2 - (LProgress - 1) + integer(i = Length(AZeile)));
        lokInsert(LName, LData);
        LProgress := 0;
      end;
    end; // if not LInQuote then begin
  end; // for i := 1 to
  if AAutoKey then
    lokAutoKey;
end;

function TBafCustomInterpreter.FindParam(AZeile, AName: string;
    var AParam: string): boolean;
var
  p, p1, i, LRest: integer;
  LInQuote: boolean;
  LName, LCopy: string;
begin
  result := false;
  LInQuote := false;
  LName := AnsiLowerCase(AName + '=');
  p := -1;
  LRest := Length(AZeile) - Length(LName);
  for i := 1 to LRest do begin
    if AZeile[i] = '"' then
      LInQuote := not LInQuote;
    if not LInQuote then begin
      if i = 1 then begin
        LCopy := AnsiLowerCase(copy(AZeile, 1, Length(LName)));
        if LName = LCopy then begin
          p := 1;
          Break;
        end;
      end;
      if (AZeile[i] = ' ') or (i = LRest) then begin
        LCopy := AnsiLowerCase(copy(AZeile, i + 1, Length(LName)));
        if LName = LCopy then begin
          p := i + 1;
          Break;
        end;
      end;
    end; // if not LInQuote then begin
  end;
  if p > 0 then begin
    p1 := p + Length(AName) + 1;
    for i := p1 to Length(AZeile) do begin
      if (AZeile[i] = '"') and (i = p1) then begin
        LInQuote := true;
        inc(p1);
      end
      else if  (not LInQuote and (AZeile[i] = ' ')) or (LInQuote and (AZeile[i] = '"')) then begin
        result := true;
        AParam := copy(AZeile, p1, i - p1);
        exit;
      end
      else if  not LInQuote and (i = Length(AZeile)) then begin
        result := true;
        AParam := copy(AZeile, p1, i);
        exit;
      end;
    end;
  end;
end;

function TBafCustomInterpreter.FindParamAlignment(AZeileP, AParamName: string;
  ADefault: TBafAlignment): TBafAlignment;
begin
  result := BafGetAlign(FindParamString(AZeileP, AParamName, ''), taLeftJustify);
end;

function TBafCustomInterpreter.FindParam(AName: string; var AParam: string): boolean;
begin
  result := FindParam(FLineP, AName, AParam);
end;

function TBafCustomInterpreter.FindParamBoolean(AZeile, AName: string; ADefault: boolean): boolean;
var
  LParam: string;
begin
  result := ADefault;
  if FindParam(AZeile, AName, LParam) then
    result := BafIsYesChar(LParam);
end;

function TBafCustomInterpreter.FindParamBooleanReplaced(ALineP, AName: string;
  ADefault: boolean): boolean;
var
  s, LDefault: string;
begin
  LDefault := IfThen(ADefault, BAFYESCHAR, BAFNOCHAR);
  s := FindParamString(ALineP, AName, LDefault);
  s := ReplaceFunctions(s);
  result := BafIsYesChar(s);
end;

function TBafCustomInterpreter.FindParamColor(AName: string; ADefault: TColor): TColor;
begin
  result := FindParamColor(FLineP, AName, ADefault);
end;

function TBafCustomInterpreter.FindParamCelltype(AName: string): TBafPageCellType;
begin
  result := FindParamCelltype(FLineP, AName);
end;

function TBafCustomInterpreter.FindParamCelltype(ALineP, AName: string): TBafPageCellType;
begin
  result := BafGetCellType(FInter.FindParamStringLower(ALineP, AName, ''));
end;

function TBafCustomInterpreter.FindParamColor(AZeile, AName: string; ADefault: TColor): TColor;
var
  LParam: string;
begin
  result := ADefault;
  if FindParam(AZeile, AName, LParam) then
    result := BafName2Color(LParam);
end;

function TBafCustomInterpreter.FindParamBoolean(AName: string; ADefault: boolean): boolean;
begin
  result := FindParamBoolean(FLineP, AName, ADefault);
end;

function TBafCustomInterpreter.FindParamInteger(AName: string; ADefault: integer): integer;
begin
  result := FindParamInteger(FLineP, AName, ADefault);
end;

function TBafCustomInterpreter.FindParamInteger(AZeile, AName: string; ADefault: integer): integer;
var
  LParam: string;
begin
  result := ADefault;
  if FindParam(AZeile, AName, LParam) then
    result := StrToIntDef(LParam, ADefault);
end;

function TBafCustomInterpreter.FindParamIntegerReplaced(AZeile, AName: string;
    ADefault: integer): integer;
var
  LParam: string;
begin
  result := ADefault;
  if FindParam(AZeile, AName, LParam) then begin
    LParam := ReplaceFunctions(LParam);
    result := StrToIntDef(LParam, ADefault);
  end;
end;

function TBafCustomInterpreter.FindParamQuelle(ALineP: string;
    ADefault: TBafDataQuelle; var AIndex: integer; APostfix: string = ''): TBafDataQuelle;
var
  s: string;
begin
  AIndex := 0;
  s := FindParamStringLower(ALineP, 'q' + APostfix, '');
  if (s = 't') or (s = 'tbl') or (s = 'tab') or (s = 'table') then
    result := dqTable
  else if (s = 's') or (s = 'sql') then
    result := dqSQL
  else if (s = 'add') or (s = 'sqladd') then
    result := dqSqlAdd
  else if (s = 'merge') or (s = 'sqlmerge') then
    result := dqSqlMerge
  else if (s = 'd') or (s = 'data') or (s = 'dat') then
    result := dqData
  else if (s = 'l') or (s = 'link') or (s = 'linked') then
    result := dqLink
  else if (Length(s) > 0) and (s[1] = 'y') then begin
    result := dqY;
    AIndex := StrToIntDef(copy(s, 2, MaxInt), 0);
  end
  else if (s = 'j') or (s = 'join') then
    result := dqJoin
  else if (s = 'f') or (s = 'file') then
    result := dqFile
  else if (s = 'http') or (s = 'https') then
    result := dqHttp
  else if (s = 'xml') then
    result := dqXML
  else if (Length(s) = 7) and (copy(s, 1, 6) = 'thread') then begin
    result := dqThread;
    AIndex := StrToIntDef(copy(s, 7, 1), 0);
  end
  else if (s = 'thread') then
    result := dqThread
  else if (s = 'xmlthread') then
    result := dqXMLThread
  else if (s = 'json') then
    result := dqJSON
  else if (s = 'jsonthread') then
    result := dqJSONThread
  else if (s = 'text') then
    result := dqText
  else if (s = 'none') then
    result := dqNone
  else
    result := ADefault;
end;

function TBafCustomInterpreter.FindParamSingle(AName: string; ADefault: single): single;
begin
  result := FindParamSingle(FLineP, AName, ADefault);
end;

function TBafCustomInterpreter.FindParamSingle(AZeile, AName: string; ADefault: single): single;
var
  LParam: string;
begin
  result := ADefault;
  if FindParam(AZeile, AName, LParam) then
    result := StrToFloatDef(LParam, ADefault);
end;

function TBafCustomInterpreter.FindParamSingleReplaced(AZeile, AName: string; ADefault: single): single;
var
  LParam: string;
begin
  result := ADefault;
  if FindParam(AZeile, AName, LParam) then begin
    LParam := ReplaceFunctions(LParam);
    result := StrToFloatDef(LParam, ADefault);
  end;
end;

function TBafCustomInterpreter.FindParamString(LineP, AName, ADefault: string): string;
var
  LParam: string;
begin
  result := ADefault;
  if FindParam(LineP, AName, LParam) then
    result := LParam;
end;

function TBafCustomInterpreter.FindParamStringLower(AName, ADefault: string): string;
begin
  result := AnsiLowerCase(FindParamString(AName, ADefault));
end;

function TBafCustomInterpreter.FindParamStringLower(ALineP, AName, ADefault: string): string;
begin
  result := AnsiLowerCase(FindParamString(ALineP, AName, ADefault));
end;

function TBafCustomInterpreter.FindParamStringReplaced(LineP, AName,
  ADefault: string): string;
var
  LParam: string;
begin
  result := ADefault;
  if FindParam(LineP, AName, LParam) then
    result := ReplaceFunctions(LParam);
end;

function TBafCustomInterpreter.GetFormObject(AFormObject: TBafFrmObject): TObject;
begin
  result := FInter.GetModule('frm').GetFormObject(AFormObject);
end;

function TBafCustomInterpreter.GetModulType: TBafInterpreterModuleType;
begin
  result := mtGlobal;
end;

function TBafCustomInterpreter.GetPrimaryKey(ALineP: string;
    APostfix: string = ''): string;
// gets the key out of a table name
var
  s: string;
  p: integer;
begin
  result := ReplaceFunctions(FindParamString(ALineP, 'k' + APostfix, ''));
  if result = '' then begin
    s := ReplaceFunctions(FindParamString(ALineP, 't' + APostfix, ''));
    p := Pos('.', s);
    if p > 0 then
      s := copy(s, p + 1, MaxInt);
    if s <> '' then
      result := s + dataMain.DefaultCon.IdExt;
  end;
end;

function TBafCustomInterpreter.GetProcParam(AParam: string): string;
var
  LNum: integer;
begin
  LNum := StrToIntDef(AParam, -1);
  if LNum = -1 then
    Inter.DoLog('E', '$PP(z): z not numeric or < 0')
  else begin
    if LNum < FCommandParameters.Count then
      result := FCommandParameters[LNum];
  end;
end;

function TBafCustomInterpreter.GetRight(APostfix: string = ''): TBafRight;
begin
  result := GetRight(FLineP, APostfix);
end;

function TBafCustomInterpreter.GetRight(AZeile, APostfix: string): TBafRight;
// Calcs Rights and ReadOnly
var
  LReadOnly: boolean;
begin
  AZeile := AnsiLowerCase(AZeile);
  LReadOnly := FindParamBooleanReplaced(AZeile, 'ro' + APostfix, false);
  result := FInter.GetRightOfDef(FindParamStringLower('r' + APostfix, 'frm'));
  if (result = brWrite) and LReadOnly then
    result := brRead;
end;

function TBafCustomInterpreter.GetValue(AParam: string): string;
var
  LNum: integer;
begin
  LNum := StrToIntDef(AParam, -1);
  if LNum = -1 then
    Inter.DoLog('E', '$VAL(z): z not numeric or < 0')
  else
    result := Values[LNum];
end;

function TBafCustomInterpreter.GetValues(Index: integer): string;
begin
  if (Index < FValues.Count) and (Index >= 0) then
    result := FValues[Index]
end;

function TBafCustomInterpreter.GetVarOrValue(AName: string): string;
var
  LNum: integer;
begin
  LNum := StrToIntDef(AName, -1);
  if LNum >= 0 then
    result := Values[LNum]
  else if AName <> '' then
    result := FInter.Variable[AName];
end;

procedure TBafCustomInterpreter.interpret;
var
  i: integer;
  LZeile: string;
  LCursor: TCursor;

  procedure lokDebug;
  begin
    // not used in the moment
  end;

  procedure lokExecLine;
  begin
    if copy(LZeile, 1, 2) = '~~' then begin
      lokDebug;
      FilterStatus := fsNone;
    end
    else if copy(LZeile, 1, 4) = '----' then begin
      lokDebug;
      FBreak := true;
    end
    else case FilterStatus of
      fsNone, fsInFilter: begin
        if copy(LZeile, 1, 2) <> '--' then begin
          if copy(LZeile, 1, 6) = '#break' then
            F9Stop := true;
          lokDebug;
          InterpretLine(LZeile);
        end;
      end;
      fsOutFilter: begin
        if (copy(LZeile, 1, 1) = '~') and (copy(LZeile, 1, 2) <> '~~') then begin
          lokDebug;
          InterpretLine(LZeile);
        end;
      end;
    end;  // else case
  end; // lokExecLine

begin
  FilterStatus := fsNone;
  for i := 0 to FCode.Count - 1 do begin
    LZeile := Trim(FCode[i]);
    if FBreak then begin
      FBreak := false;
      Break;
    end;
    lokExecLine;
  end;
// procedure TBafCustomInterpreter.interpret
end;

function TBafCustomInterpreter.IsCmdParam(AParams: TStrings; ANot: boolean = false): string;
var
  i, LNum: integer;
  s: string;
begin
  if ANot then
    result := BAFYESCHAR
  else
    result := BAFNOCHAR;
  LNum := StrToIntDef(AParams[0], -1);
  if LNum < 0 then
    Inter.DoLog('E', '$ICP(z): z not numeric or < 0')
  else begin
    if LNum < FCommandParameters.Count then begin
      s := FCommandParameters[LNum];
      for i := 1 to AParams.Count - 1 do begin
        if AnsiCompareText(s, AParams[i]) = 0 then begin
          if ANot then
            result := BAFNOCHAR
          else
            result := BAFYESCHAR;
          exit;
        end;
      end;
    end;
  end;
end;

procedure TBafCustomInterpreter.TabClose;
// also closing a dialog
begin
  if Assigned(FInter.FOnClose) then
    FInter.FOnClose(Self);
end;

procedure TBafCustomInterpreter.TabNew;
var
  LCmd: string;
  LDoDebug: boolean;
begin
  LCmd := FindParamStringReplaced(FLineP, 'cmd', '');
  LDoDebug := FindParamBooleanReplaced(FLineP, 'debug', false);
  TBafClientTab.NewTab(FindParamStringReplaced(FLineP, 'c', 'New Tab'), LCmd, LDoDebug);
end;

function TBafCustomInterpreter.ParseBoolStatement(AStmnt: string): boolean;
type
  TNextItem = (niNix, niOr, niAnd);
var
  i, p, LBracketOpen, LBracketOpenPos, LNext: integer;
  LUpp, s, LRechtsStmnt: string;
  LNextItem: TNextItem;
  LLeft: boolean;

  procedure lokCheckItem(ASub: string; AItem: TNextItem);
  begin
    p := Pos(ASub, LUpp);
    if p > 0 then begin
      LNext := System.Math.Min(LNext, p);
      LNextItem := AItem;
    end;
  end; // procedure lokCheckItem

  procedure lokReplaceBrackets;
  begin
    LBracketOpen := 0;
    i := 1;
    while i <= Length(AStmnt) do begin
      if AStmnt[i] = '(' then begin
        inc(LBracketOpen);
        if LBracketOpen = 1 then
          LBracketOpenPos := i;
      end
      else if AStmnt[i] = ')' then begin
        dec(LBracketOpen);
        if LBracketOpen = 0 then begin
          s := copy(AStmnt, LBracketOpenPos + 1, i - LBracketOpenPos - 1);
          Delete(AStmnt, LBracketOpenPos, i - LBracketOpenPos + 1);
          s := ' ' + IfThen(ParseBoolStatement(s), BAFYESCHAR, BAFNOCHAR) + ' ';
          Insert(s, AStmnt, LBracketOpenPos);
          i := LBracketOpenPos + 1;
        end;
      end;
      inc(i);
    end; // while
  end; // procedure lokReplaceBrackets

begin
  LLeft := false;
  result := false;
  lokReplaceBrackets;

  LUpp := AnsiUpperCase(AStmnt);
  LNext := Length(LUpp);
  LNextItem := niNix;
  lokCheckItem(' OR ', niOr);
  lokCheckItem(' AND ', niAnd);

  if LNextItem in [niOr, niAnd] then begin
    s := Trim(copy(AStmnt, 1, LNext - 1));
    LLeft := BoolStatementAuswerten(s);
    LRechtsStmnt := copy(AStmnt, LNext + 4 + integer(LNextItem = niAnd), MaxInt);
  end;

  case LNextItem of
    niNix: result := BoolStatementAuswerten(AStmnt);
    niOr: begin
      if LLeft then
        result := true
      else
        result := ParseBoolStatement(LRechtsStmnt);
    end;
    niAnd: begin
      if not LLeft then
        result := false
      else
        result := ParseBoolStatement(LRechtsStmnt);
    end;
  end;
// function TBafCustomInterpreter.ParseBoolStatement
end;

function TBafCustomInterpreter.ReplaceFunction(ACommand: string; AParams: TStrings): string;
var
  i: integer;
begin
  result := '';
  ACommand := AnsiUpperCase(ACommand);
  if ACommand = '$INTER' then result := FInter.Name
  else if ACommand = '$VAL' then result := GetValue(Trim(AParams[0]))
  else if ACommand = '$EMPTYVAL' then result := EmptyV(false, AParams)
  else if ACommand = '$NEMPTYVAL' then result := EmptyV(true, AParams)
  else if ACommand = '$PP' then result := GetProcParam(Trim(AParams[0]))
  else if ACommand = '$CP' then result := GetProcParam(Trim(AParams[0]))
  else if ACommand = '$IPP' then result := IsCmdParam(AParams)
  else if ACommand = '$ICP' then result := IsCmdParam(AParams)
  else if ACommand = '$NICP' then result := IsCmdParam(AParams, true)
  else if ACommand = '$INCP' then result := IsCmdParam(AParams, true)
  else if ACommand = '$HISTSQL' then result := FInter.NeedInfo('histsql', '')
  else if ACommand = '$HISTCON' then result := FInter.NeedInfo('histcon', '')
  else if ACommand = '$HISTTABLE' then result := FInter.NeedInfo('histtable', '')
  else if ACommand = '$HISTMEMOFIELD' then result := FInter.NeedInfo('histmemofield', '')

  else begin
    for i := 0 to FInter.FModuleList.Count - 1 do begin
      if (FInter.FModuleList.Objects[i] as TBafInterpreterCustomModule).ReplaceFunction(ACommand, AParams, result) then
        exit;
    end;
    Inter.DoLog('W', 'unknown function: ' + ACommand);
  end;
end;

function TBafCustomInterpreter.ReplaceFunctions(AText: string): string;
type
  TParamState = (psOut, psInCommand, psInParam);
var
  LParams: TStringList;
  i, LKlammernAuf: integer;
  LInParam: TParamState;
  LCommand, LParam: string;

  procedure lokInParam;
  begin
    if AText[i] = '(' then begin
      LParam := LParam + AText[i];
       inc(LKlammernAuf);
    end
    else if AText[i] = ')' then begin
      dec(LKlammernAuf);
      if LKlammernAuf = 0 then begin
        if Pos('$', LParam) > 0 then
          LParam := ReplaceFunctions(LParam);
        LParams.Add(LParam);
        result := result + ReplaceFunction(LCommand, LParams);
        LParam := '';
        LParams.Clear;
        LCommand := '';
        LInParam := psOut;
      end
      else
        LParam := LParam + AText[i];
    end
    else if (AText[i] = ',') and (LKlammernAuf = 1) then begin
      if Pos('$', LParam) > 0 then
        LParam := ReplaceFunctions(LParam);
      LParams.Add(LParam);
      LParam := '';
    end
    else
      LParam := LParam + AText[i];
  end; // procedure lokInParam

begin
  result := '';
  LParams := TStringList.Create;
  try
    LCommand := '';
    LParam := '';
    LInParam := psOut;
    LKlammernAuf := 0;
    for i := 1 to Length(AText) do begin
      case LInParam of
        psOut: begin             // out of the function
          if AText[i] = '$' then begin
             LInParam := psInCommand;
             LCommand := '$';
          end
          else
            result := result + AText[i];
        end; // case psOut
        psInCommand: begin       // in the function
          if AText[i] = '(' then begin
             LInParam := psInParam;
             inc(LKlammernAuf);
          end
          else
            LCommand := LCommand + AText[i];
        end; // case psOut
        psInParam: lokInParam;     // in the parameters list

      end; // case LInParam of
    end; // for i := 1 to Length(AText)

  finally
    LParams.Free;
  end;
  if (result = '') and (Pos('$CELL$', LCommand) > 0) then
    result := LCommand;
  if AText <> result then
    FInter.DebugLog(AText + '     -----     ' + result);
// function TBafCustomInterpreter.ReplaceParameters
end;

procedure TBafCustomInterpreter.SetExceptionInfo;
begin
  FInter.ExceptionInfo := ReplaceFunctions(FindParamString('z', ''));
end;

procedure TBafCustomInterpreter.SetFilterStatus;
var
  LResult: boolean;
  s: string;
begin
  if FilterStatus in [fsInFilter, fsFilterDone] then begin
    FilterStatus := fsFilterDone;
    exit;
  end;

  FilterStatus := fsOutFilter;
  s := ReplaceFunctions(FLineP);
  LResult := ParseBoolStatement(s);

  if LResult then
    FilterStatus := fsInFilter;
end;

procedure TBafCustomInterpreter.SetInter(const Value: TBafInterpreter);
begin
  FInter := Value;
end;

procedure TBafCustomInterpreter.SetVal;
var
  LNum: integer;
  LValue, LRightName: string;
begin
  if FindParamBooleanReplaced(LineP, 'cnd', true) then begin
    LRightName := FindParamStringLower('r', 'frm');
    if (LRightName = 'frm')
        or (FInter.GetRightOfDef(LRightName) = brWrite) then begin
      LNum := StrToIntDef(Trim(FindParamString('n', '')), -1);
      if LNum >= 0 then begin
        LValue := ReplaceFunctions(FindParamString('z', ''));
        if LValue = '' then
          LValue := ReplaceFunctions(FindParamString('ie', ''));
        if FindParamBooleanReplaced(LineP, 'rf', false) then
          LValue := ReplaceFunctions(LValue);
        Values[LNum] := LValue;
      end
      else
        FInter.DoLog('E', 'SetVal, Parameter n is not numeric');
    end;
  end
end;

procedure TBafCustomInterpreter.SetValues(Index: integer; const Value: string);
begin
  while Index >= FValues.Count do
    FValues.Add('');
  FValues[Index] := Value;
end;

procedure TBafCustomInterpreter.SetVarOrValue(AName, AValue: string);
var
  LParam: string;
  LNum: integer;
begin
  LParam := FindParamStringReplaced(FLineP, AName, '');
  LNum := StrToIntDef(LParam, -1);
  if LNum >= 0 then
    Values[LNum] := AValue
  else if LParam <> '' then
    FInter.Variable[LParam] := AValue;
end;

procedure TBafCustomInterpreter.Vars2Strings(ALine: string; AVars: TStrings);
// adds der Vars to the list AVars
var
  i, p1, p2, LProgress: integer;
  LData: string;
  LInQuote: boolean;
begin
  LProgress := 0;
  p1 := 0;
  p2 := 0;
  LInQuote := false;
  ALine := ALine + ' ';
  for i := 1 to Length(ALine) do begin
    if ALine[i] = '"' then
      LInQuote := not LInQuote;
    if not LInQuote then begin
      if (LProgress = 0) and (ALine[i] = 'v') and (i < Length(ALine)) and (ALine[i + 1] = '_') then begin
        LProgress := 1;     // a column definitions begins
        p1 := i + 2;
      end
      else if (LProgress = 1) and (ALine[i] = '=') then begin
        LProgress := 2;     // after the =
        p2 := i;
      end
      else if (LProgress = 2) and (i = p2 + 1) and (ALine[i] = '"') then
        LProgress := 3     // quoted
      else if ((LProgress = 2) and (ALine[i] = ' '))
          or ((LProgress = 3) and (ALine[i] = '"')) then begin
        LData := copy(ALine, p2 + (LProgress - 1), i - p2 - (LProgress - 1));
        LData := ReplaceFunctions(LData);
        AVars.Add(copy(ALine, p1, p2 - p1) + '=' + LData);
        LProgress := 0;
      end;
    end; // if not LInQuote then begin
  end; // for i := 1 to
end;

procedure TBafCustomInterpreter.WriteLog;
var
  s: string;
begin
  s := ReplaceFunctions(FindParamString('c', '#log, Parameter c nicht gesetzt') + '   ');
  Inter.DoLog(FindParamString('y', 'I'), s);
end;

procedure TBafCustomInterpreter.WriteLogI;
begin
  Inter.DoLog('I', ReplaceFunctions(FLineP));
end;

procedure TBafCustomInterpreter.WriteSrvLog(AText: string);
begin
  FInter.GetModule('frm').WriteSrvLog(AText);
end;

procedure TBafCustomInterpreter.InterpretLine(AZeile: string);
var
  p, i: integer;
begin
  if Pos('$CODEN$', AZeile) > 0 then
    AZeile := AZeile + '   ' + FInter.GetCode(false)
  else if Pos('$CODE$', AZeile) > 0 then
    AZeile := AZeile + '   ' + FInter.GetCode(true);
  FInter.DebugLog(AZeile);
  p := Pos(' ', AZeile);
  if p > 1 then begin
    FLineF := Trim(AnsiLowerCase(copy(AZeile, 1, p - 1)));
    FLineP := copy(AZeile, p + 1, MaxInt);
  end
  else begin
    FLineF := Trim(AZeile);
    FLineP := '';
  end;

  BafPerformanceLog(FLineF);

  if FLineF = '' then exit                                                     // empty line is ignored
  else if FLineF = '~' then SetFilterStatus                                    // a filter conditions
  else if FLineF = '#log' then WriteLog                                        // writes to then log
  else if FLineF = '#logi' then WriteLogI                                      // writes an info to the log
  else if FLineF = '#setval' then SetVal
  else if FLineF = '#val_set' then SetVal                                      // sets a value
  else if FLineF = '#val_add' then AddVal                                      // sets a value
  else if FLineF = '#clearvals' then ClearVals
  else if FLineF = '#val_clearall' then ClearVals                              // clears all values
  else if FLineF = '#newtabcmd' then TabNew
  else if FLineF = '#tab_new' then TabNew                                      // executed a command in a new tab
  else if FLineF = '#tab_close' then TabClose                                  // vloses a tab
  else if FLineF = '#exception_info' then SetExceptionInfo                     // sets the exception info


  else begin  // through alle the modules
    for i := 0 to FInter.FModuleList.Count - 1 do begin
      if (FInter.FModuleList.Objects[i] as TBafInterpreterCustomModule).InterpretLine(Self) then
        exit;
    end;
    Inter.DoLog('W', 'unknown procedure: ' + FLineF);
  end;
end;

function TBafCustomInterpreter.FindParamString(AName, ADefault: string): string;
begin
  result := FindParamString(FLineP, AName, ADefault);
end;

{ TBafInterpreterCustomModule }

procedure TBafInterpreterCustomModule.AddGridObjectList(AObject: TObject);
begin

end;

constructor TBafInterpreterCustomModule.Create;
begin

end;

procedure TBafInterpreterCustomModule.DoModuleEvent(AInter: TBafCustomInterpreter;
    AEvent: TBafInterpreterEvent; AText: string);
begin

end;

procedure TBafInterpreterCustomModule.ExportPagePdf(APage: TObject);
begin

end;

procedure TBafInterpreterCustomModule.ExportPageXls(APage: TObject);
begin

end;

procedure TBafInterpreterCustomModule.ExportSegmentPdf(ASegment: TObject);
begin

end;

procedure TBafInterpreterCustomModule.ExportSegmentXls(ASegment: TObject);
begin

end;

function TBafInterpreterCustomModule.FindParam(AName: string; var AParam: string): boolean;
begin
  result := FExecInter.FindParam(AName, AParam);
end;

function TBafInterpreterCustomModule.FindParam(AZeileP, AName: string; var AParam: string): boolean;
begin
  result := FExecInter.FindParam(AZeileP, AName, AParam);
end;

function TBafInterpreterCustomModule.FindParamBoolean(ALineP, AName: string; ADefault: boolean): boolean;
begin
  result := FExecInter.FindParamBoolean(ALineP, AName, ADefault);
end;

function TBafInterpreterCustomModule.FindParamBooleanReplaced(AName: string; ADefault: boolean): boolean;
begin
  result := FindParamBooleanReplaced(FExecInter.LineP, AName, ADefault);
end;

function TBafInterpreterCustomModule.FindParamBooleanReplaced(ALineP, AName: string; ADefault: boolean): boolean;
var
  s, LDefault: string;
begin
  LDefault := IfThen(ADefault, BAFYESCHAR, BAFNOCHAR);
  if Assigned(FExecInter) then begin
    s := FExecInter.FindParamString(ALineP, AName, LDefault);
    s := FExecInter.ReplaceFunctions(s);
  end
  else begin
    s := FInter.FindParamString(ALineP, AName, LDefault);
    s := FInter.ReplaceFunctions(s);
  end;
  result := BafIsYesChar(s);
end;

function TBafInterpreterCustomModule.FindParamBoolean(AName: string; ADefault: boolean): boolean;
begin
  result := FExecInter.FindParamBoolean(FExecInter.FLineP, AName, ADefault);
end;


function TBafInterpreterCustomModule.FindParamCelltype(AName: string): TBafPageCellType;
begin
  result := FExecInter.FindParamCelltype(AName);
end;

function TBafInterpreterCustomModule.FindParamCelltype(ALineP, AName: string): TBafPageCellType;
begin
  result := FExecInter.FindParamCelltype(ALineP, AName);
end;

function TBafInterpreterCustomModule.FindParamCharCase(ALineP, AName: string; ADefault: TEditCharCase): TEditCharCase;
var
  s: string;
begin
  if ALineP = '' then
    s := FindParamStringLower(AName, '') + ' '
  else
    s := FindParamStringLower(ALineP, AName, '') + ' ';
  case s[1] of
    'n': result := TEditCharCase.ecNormal;
    'l': result := TEditCharCase.ecLowerCase;
    'u': result := TEditCharCase.ecUpperCase;
  else
    result := ADefault;
  end;
end;

function TBafInterpreterCustomModule.FindParamColor(AName: string; ADefault: TColor): TColor;
begin
  result := FExecInter.FindParamColor(FExecInter.FLineP, AName, ADefault);
end;

function TBafInterpreterCustomModule.FindParamInteger(ALineP, AName: string; ADefault: integer): integer;
begin
  result := FExecInter.FindParamInteger(ALineP, AName, ADefault);
end;

function TBafInterpreterCustomModule.FindParamInteger(AName: string; ADefault: integer): integer;
begin
  result := FExecInter.FindParamInteger(FExecInter.FLineP, AName, ADefault);
end;

function TBafInterpreterCustomModule.FindParamIntegerReplaced(AName: string;
  ADefault: integer): integer;
begin
  result := FExecInter.FindParamIntegerReplaced(FExecInter.LineP, AName, ADefault);
end;

function TBafInterpreterCustomModule.FindParamIntegerReplaced(ALineP, AName: string; ADefault: integer): integer;
begin
  result := FExecInter.FindParamIntegerReplaced(ALineP, AName, ADefault);
end;

function TBafInterpreterCustomModule.FindParamSingle(AName: string; ADefault: single): single;
begin
  result := FExecInter.FindParamSingle(FExecInter.FLineP, AName, ADefault);
end;

function TBafInterpreterCustomModule.FindParamSingleReplaced(ALineP,
  AName: string; ADefault: single): single;
begin
  result := FExecInter.FindParamSingleReplaced(ALineP, AName, ADefault);
end;

function TBafInterpreterCustomModule.FindParamSingleReplaced(AName: string; ADefault: single): single;
begin
  result := FExecInter.FindParamSingleReplaced(FExecInter.FLineP, AName, ADefault);
end;

function TBafInterpreterCustomModule.FindParamString(AName, ADefault: string): string;
begin
  result := FExecInter.FindParamString(FExecInter.FLineP, AName, ADefault);
end;

function TBafInterpreterCustomModule.FindParamStringLower(ALineP, AName, ADefault: string): string;
begin
  result := AnsiLowerCase(FindParamString(ALineP, AName, ADefault));
end;

function TBafInterpreterCustomModule.FindParamString(AZeileP, AName, ADefault: string): string;
begin
  result := FExecInter.FindParamString(AZeileP, AName, ADefault);
end;

function TBafInterpreterCustomModule.FindParamStringLower(AName, ADefault: string): string;
begin
  result := AnsiLowerCase(FindParamString(AName, ADefault));
end;

function TBafInterpreterCustomModule.FindParamStringReplaced(ALineP, AName, ADefault: string): string;
begin
  if Assigned(FExecInter) then begin
    result := FExecInter.FindParamString(ALineP, AName, ADefault);
    result := FExecInter.ReplaceFunctions(result);
  end
  else begin
    result := FInter.FindParamString(ALineP, AName, ADefault);
    result := FInter.ReplaceFunctions(result);
  end;
end;

function TBafInterpreterCustomModule.FindParamStringReplacedLower(ALineP, AName,
  ADefault: string): string;
begin
  if Assigned(FExecInter) then begin
    result := FExecInter.FindParamString(ALineP, AName, ADefault);
    result := AnsiLowerCase(FExecInter.ReplaceFunctions(result));
  end
  else begin
    result := FInter.FindParamString(ALineP, AName, ADefault);
    result := AnsiLowerCase(FInter.ReplaceFunctions(result));
  end;
end;

function TBafInterpreterCustomModule.FindParamStringReplacedLower(AName,
  ADefault: string): string;
begin
  result := FExecInter.FindParamString(FExecInter.FLineP, AName, ADefault);
  result := AnsiLowerCase(FExecInter.ReplaceFunctions(result));
end;

function TBafInterpreterCustomModule.FindParamStringReplaced(AName, ADefault: string): string;
begin
  result := FExecInter.FindParamString(FExecInter.FLineP, AName, ADefault);
  result := FExecInter.ReplaceFunctions(result);
end;

function TBafInterpreterCustomModule.GetCode(AClear: boolean): string;
begin
  result := '';
end;

function TBafInterpreterCustomModule.GetFormObject(AFormObject: TBafFrmObject): TObject;
begin
  result := nil;
end;

function TBafInterpreterCustomModule.GetFrmComponent(AType: string): TComponent;
begin
  result := nil;
end;

function TBafInterpreterCustomModule.GetIni(AIndex: integer): TStringIniFile;
begin
  result := nil;
end;

function TBafInterpreterCustomModule.GetKatStringList(AIndex: integer): TStringList;
begin
  result := nil;
end;

function TBafInterpreterCustomModule.GetModulType: TBafInterpreterModuleType;
begin
  result := mtGlobal;
end;

function TBafInterpreterCustomModule.GetProc(AIndex: integer): string;
begin

end;

function TBafInterpreterCustomModule.GetRightOfDef(AName: string): TBafRight;
begin
  result := brNone;
end;

function TBafInterpreterCustomModule.GetSqlAndClear(AIndex: integer; var ASql: string): boolean;
begin
  result := false;
end;

function TBafInterpreterCustomModule.GetTextStringList(AIndex: integer): TStringList;
begin
  result := nil;
end;

function TBafInterpreterCustomModule.GetVariable(AName: string): string;
begin

end;


function TBafInterpreterCustomModule.ReplaceFunction(ACommand: string;
    AParams: TStrings; var AResult: string): boolean;
begin
  result := false;
end;

procedure TBafInterpreterCustomModule.RegisterModule(AInter: TBafInterpreter);
begin
  FInter := AInter;
end;

procedure TBafInterpreterCustomModule.SetScale(const Value: integer);
begin
  FScale := Value;
end;

procedure TBafInterpreterCustomModule.SetVariable(AName: string;
  const Value: string);
begin

end;

procedure TBafInterpreterCustomModule.SqlAndParams(ABafConName, AName, ASql: string);
var
  LParamName, LParamValue: string;
  i: integer;
  LParams: TBafParams;
begin
  LParams := dataMain.QueryPrepare(ABafConName, AName, ASql);
  for i := 0 to LParams.Count - 1 do begin
    LParamName := LParams.GetParamName(i);
    LParamValue := FindParamStringReplaced(LParamName, '');
    LParams.SetValue(i, LParamValue);
  end;
end;

procedure TBafInterpreterCustomModule.WriteSrvLog(AText: string);
begin

end;

function TBafInterpreterCustomModule.InterpretLine(AExecInter: TBafCustomInterpreter): boolean;
// the routine has to return true if the command is recognized
var
  LInter: TBafCustomInterpreter;
begin
  result := false;
  LInter := FExecInter;
  try
    FExecInter := AExecInter;
  finally
    FExecInter := LInter;
  end;
end;

end.

