unit uBafJsonModule;

interface

uses System.Math, System.SysUtils, System.Classes, uBafTypes, uBafInterpreter,
    contnrs, System.StrUtils, uBafPage, uStringIniFile, System.RegularExpressions;

type
  TBafJsonMode = (jmFlat, jmFormatted, jmXmlFlat, jmXmlFormatted);
  TBafJsonType = (jtSimple, jtObject, jtArray);
  TBafJsonDataType = (jdNull, jdString, jdInt, jdFloat, jdDate, jdDateTime,
      jdFalse, jdTrue);

  TBafJsonNode = class
  private
    FChilds: TObjectList;
//    FProperties: TStringList;
    FParent: TBafJsonNode;
    FValue: string;
    FValueNumber: double;
    FName: string;
    FNodeType: TBafJsonType;
    FDataType: TBafJsonDataType;
    function GetChild(AIndex: integer): TBafJsonNode;
    function GetChildCount: integer;
  public
    constructor Create(AParent: TBafJsonNode);
    destructor Destroy; override;
    function GetText(AMode: TBafJsonMode; ALevel: integer): string;
    procedure WriteDebugText(AList: TStringList);
    function FindNode(APath, ASep: string; out ANode: TBafJsonNode;
        AAdd: boolean = false): boolean;
    function GetValueText: string;
    procedure SetValueText(AText: string; AIsString: boolean = true);
    procedure Merge(ARoot: TBafJsonNode; AMergeOverwrite: boolean = false);
    property Childs: TObjectList read FChilds;
    property Name: string read FName write FName;
    property Value: string read FValue write FValue;
    property NodeType: TBafJsonType read FNodeType write FNodeType;
    property DataType: TBafJsonDataType read FDataType write FDataType;
    property Child[AIndex: integer]: TBafJsonNode read GetChild;
    property ChildCount: integer read GetChildCount;
  end;

  TBafJsonModule = class(TBafInterpreterCustomModule)
  protected
    FParsedJsonList: TObjectList;
    FLoopNodeList: TStringList;
    procedure JsonParse(ANum: integer);
    procedure JsonLoop(ANum: integer);
    procedure JsonChange(ANum: integer);
    procedure JsonChangeData(ANum: integer);
    procedure JsonTvl(ANum: integer);
    function GetJson(AParams: TStrings): string;
    function GetJsonText(AParams: TStrings): string;
    function GetJsonValue(AParams: TStrings): string;
    function GetJsonArrayValue(AParams: TStrings): string;
    function GetJsonData(AParams: TStrings): string;
    function GetJsonDataText(AParams: TStrings): string;
    function GetJsonLfr(AParams: TStrings): string;
  protected
    class procedure FetchGridCellValue(ACurrentNode: TBafJsonNode; ACell: TBafSgCell;
        AColumn: TBafSgColumn; ARow: integer; ASep: string;
        AExecInter: TBafCustomInterpreter; ALineP: string);
  public
    constructor Create; override;
    destructor Destroy; override;
    function InterpretLine(AExecInter: TBafCustomInterpreter): boolean; override;
    function ReplaceFunction(ACommand: string; AParams: TStrings;
        var AResult: string): boolean; override;
    class procedure Parse(ARoot: TBafJsonNode; AJson: string);
    function GetParsedJson(AIndex: integer): TBafJsonNode;
    procedure JsonLoopData(ALastSeg, ATree: TObject; AExecInter: TBafCustomInterpreter;
        ALineP: string);
    class procedure FetchGridFields(ACurrentNode: TBafJsonNode; var ARow: integer;
        AXGridIndex, AXXGridindex: integer; AIncRow: boolean; ASep: string;
        AExecInter: TBafCustomInterpreter; ALineP: string; ALastSeg: TBafPageSegment);
    class function GetNodeValue(ANodeObject: TObject; APath, ASep: string;
        var AValue: string): boolean;
  end;


implementation

uses dmMain, uBafComboHelper, uBafTree;

{ TBafJsonNode }

constructor TBafJsonNode.Create(AParent: TBafJsonNode);
begin
  inherited Create;
  FParent := AParent;
  FChilds := TObjectList.Create;
  if Assigned(AParent) then
    AParent.Childs.Add(Self);
end;

destructor TBafJsonNode.Destroy;
begin
  FreeAndNil(FChilds);
  inherited;
end;

function TBafJsonNode.FindNode(APath, ASep: string; out ANode: TBafJsonNode;
    AAdd: boolean = false): boolean;
var
  ix, p, i: integer;
  LPathPre, LPathPost: string;
  LNode, LNodeChild: TBafJsonNode;
begin
  if APath = '' then begin
    ANode := Self;
    result := true;
    exit;
  end;
  p := Pos(ASep, APath);
  if p > 0 then begin
    LPathPre := copy(APath, 1, p - 1);
    LPathPost := copy(APath, p + 1, MaxInt);
  end
  else begin
    LPathPre := APath;
    LPathPost := '';
  end;
  ix := -1;
  for i := 0 to FChilds.Count - 1 do begin
    LNode := (FChilds[i] as TBafJsonNode);
    if Assigned(LNode.FParent) and (LNode.FParent.NodeType = jtArray) then begin
      ix := StrToIntDef(LPathPre, -1);
      Break;
    end
    else begin
      if AnsiCompareText(LPathPre, LNode.FName) = 0 then begin
        ix := i;
        Break;
      end;
    end;
  end;
  if not AAdd and (ix < 0) then
    result := false
  else if AAdd and (ix < 0) and (LPathPost = '') then begin
    result := true;
    ANode := TBafJsonNode.Create(Self);
    ANode.FName := LPathPre;
    FNodeType := jtObject;
  end
  else if AAdd and (ix < 0) and (LPathPost <> '') then begin
    LNodeChild := TBafJsonNode.Create(Self);
    LNodeChild.FName := LPathPre;
    LNodeChild.FNodeType := jtObject;
    result := LNodeChild.FindNode(LPathPost, ASep, ANode, AAdd);
  end
  else if LPathPost = '' then begin
    result := true;
    ANode := (FChilds[ix] as TBafJsonNode);
  end
  else
    result := (FChilds[ix] as TBafJsonNode).FindNode(LPathPost, ASep, ANode, AAdd);
end;

function TBafJsonNode.GetChild(AIndex: integer): TBafJsonNode;
begin
  result := (FChilds[AIndex] as TBafJsonNode);
end;

function TBafJsonNode.GetChildCount: integer;
begin
  result := FChilds.Count;
end;

function TBafJsonNode.GetText(AMode: TBafJsonMode; ALevel: integer): string;
var
  i: integer;
  s, LBreak: string;

  procedure lokBreak;
  var
    i: integer;
  begin
    case AMode of
      jmFormatted: begin
        LBreak := #13#10;
        for i := 1 to ALevel do
          LBreak := LBreak + '  ';
      end;
      else
        LBreak := '';
    end;
  end; // procedure lokBreak

  procedure lokSimple;
  var
    s: string;
  begin
    if FName <> '' then begin
      case FDataType of
        jdString: result := LBreak + Format('"%s":"%s"', [FName, FValue]);
        jdNull: result := LBreak + Format('"%s":null', [FName]);
        jdInt: result := LBreak + Format('"%s":%s', [FName, IntToStr(round(FValueNumber))]);
        jdFloat: begin
          s := StringReplace(FloatToStr(FValueNumber), ',', '.', []);
          result := LBreak + Format('"%s":%s', [FName, s]);
        end;
        jdDate: result := LBreak + Format('"%s":%s', [FName, FormatDateTime('dd.mm.yyyy', FValueNumber)]);
        jdDateTime: result := LBreak + Format('"%s":%s', [FName, FormatDateTime('dd.mm.yyyy hh:mm:ss', FValueNumber)]);
        jdFalse: result := LBreak + Format('"%s":false', [FName]);
        jdTrue: result := LBreak + Format('"%s":true', [FName]);
      end;
    end
    else begin
      case FDataType of
        jdString: result := LBreak + Format('"%s"', [FValue]);
        jdNull: result := LBreak + 'null';
        jdInt: result := LBreak + Format('%s', [IntToStr(round(FValueNumber))]);
        jdFloat: begin
          s := StringReplace(FloatToStr(FValueNumber), ',', '.', []);
          result := LBreak + Format('%s', [s]);
        end;
        jdDate: result := LBreak + Format('%s', [FormatDateTime('dd.mm.yyyy', FValueNumber)]);
        jdDateTime: result := LBreak + Format('%s', [FormatDateTime('dd.mm.yyyy hh:mm:ss', FValueNumber)]);
        jdFalse: result := LBreak + 'false';
        jdTrue: result := LBreak + 'true';
      end;
    end;
  end; // procedure lokSimple

begin
  result := '';
  lokBreak;
  if NodeType = jtSimple then
    lokSimple
  else begin
    if ALevel > 0 then
      result := LBreak
    else
      result := '';
    if FName <> '' then
      result := result + Format('"%s": ', [FName]);
    result := result + IfThen(NodeType = jtObject,  '{', '[');
    for i := 0 to FChilds.Count - 1 do begin
      if FChilds[i] is TBafJsonNode then
        result := result + (FChilds[i] as TBafJsonNode).GetText(AMode, ALevel + 1)
            + IfThen(i < FChilds.Count - 1, ',', '')
      else
        s := FChilds[i].ClassName;
    end;
    result := result + LBreak + IfThen(NodeType = jtObject,  '}', ']');
  end;
// function TBafJsonNode.GetText
end;

function TBafJsonNode.GetValueText: string;
begin
  case FDataType of
    jdString, jdNull: result := FValue;
    jdInt: result := IntToStr(round(FValueNumber));
    jdFloat: result := FloatToStr(FValueNumber);
    jdDate: result := FormatDateTime('dd.mm.yyyy', FValueNumber);
    jdDateTime: result := FormatDateTime('dd.mm.yyyy hh:mm:ss', FValueNumber);
    jdFalse: result := 'false';
    jdTrue: result := 'true';
  end;
end;

procedure TBafJsonNode.Merge(ARoot: TBafJsonNode; AMergeOverwrite: boolean);
var
  i: integer;
  LMyNode, LMergeNode, LMyRoot, LMergeRoot: TBafJsonNode;

  procedure lokTransferNode(ARemove: boolean);
  begin
    if ARemove then
      LMyRoot.FChilds.Remove(LMyNode);
    LMyRoot.FChilds.Add(LMergeNode);
    LMergeRoot.FChilds.OwnsObjects := false;
    try
      LMergeRoot.FChilds.Remove(LMergeNode);
    finally
      LMergeRoot.FChilds.OwnsObjects := true;
    end;
  end; // procedure lokTransferNode

  procedure lokTransferArray;
  var
    i: integer;
    LNode: TBafJsonNode;
  begin
    LMergeNode.FChilds.OwnsObjects := false;
    try
      for i := LMergeNode.FChilds.Count - 1 downto 0 do begin
        LNode := LMergeNode.FChilds[i] as TBafJsonNode;
        if LNode.NodeType = jtObject then
          LMyNode.FChilds.Add(LNode)
        else
          raise Exception.Create('Das darf nicht sein');
        LMergeNode.FChilds.Delete(i);
      end;
    finally
      LMergeNode.FChilds.OwnsObjects := true;
    end;
  end; // procedure lokTransferArray

begin
  LMyRoot := Self;
  LMergeRoot := ARoot;
  for i := LMergeRoot.FChilds.Count - 1 downto 0 do begin
    LMergeNode := LMergeRoot.FChilds[i] as TBafJsonNode;
    if LMyRoot.FindNode(LMergeNode.FName, '.', LMyNode) then begin
      case LMyNode.NodeType of
        jtSimple: begin
          LMyNode.FValue := LMergeNode.FValue;
          LMyNode.FDataType := LMergeNode.FDataType;
        end;
        jtObject: if AMergeOverwrite then
          lokTransferNode(true);
        jtArray: lokTransferArray;
      end;
    end
    else
      lokTransferNode(false);
  end;
end;

procedure TBafJsonNode.SetValueText(AText: string; AIsString: boolean = true);
var
  LCntPoint, LCntKomma, LCntMinus, LCntNumber, LCntColon: integer;
  s: string;

  procedure lokCount(AText: string);
  var
    i: integer;
  begin
    LCntPoint := 0;
    LCntKomma := 0;
    LCntMinus := 0;
    LCntNumber := 0;
    LCntColon := 0;
    for i := 1 to Length(AText) do begin
      case AText[i] of
        '0'..'9': inc(LCntNumber);
        ',': inc(LCntKomma);
        '.': inc(LCntPoint);
        '-': inc(LCntMinus);
        ':': inc(LCntColon);
      end;
    end;
  end; // procedure lokCount

begin
  if AIsString then begin
    FValue := AText;
    FDataType := jdString;
  end
  else begin
    if (AnsiCompareText(AText, 'null') = 0) or (AText = '') then
      FDataType := jdNull
    else begin
      lokCount(AText);
      if AnsiCompareText('FALSE', AText) = 0 then
        DataType := jdFalse
      else if AnsiCompareText('TRUE', AText) = 0 then
        DataType := jdTrue
      else if (LCntNumber > 0) and (LCntKomma = 0) and (LCntPoint = 0) and (LCntMinus = 0) and (LCntColon = 0) then begin
        DataType := jdInt;
        FValueNumber := StrToInt64Def(AText, 0);
      end
      else if (LCntNumber > 0) and (LCntKomma = 1) and (LCntPoint = 0) and (LCntMinus = 0) and (LCntColon = 0) then begin
        DataType := jdFloat;
        FValueNumber := StrToFloatDef(AText, 0);
      end
      else if (LCntNumber > 0) and (LCntKomma = 0) and (LCntPoint = 1) and (LCntMinus = 0) and (LCntColon = 0) then begin
        DataType := jdFloat;
        FValueNumber := StrToFloatDef(StringReplace(AText, '.', ',', []), 0);
      end
      else if (LCntNumber > 0) and (LCntKomma = 0) and (LCntPoint = 2) and (LCntMinus = 0) and (LCntColon = 0) then begin
        DataType := jdDate;
        FValueNumber := StrToDateDef(AText, 0);
      end
      else if (LCntNumber > 0) and (LCntKomma = 0) and (LCntPoint = 0) and (LCntMinus = 2) and (LCntColon = 0) then begin
        DataType := jdDate;
        s := copy(AText, 9, 2) + '.' + copy(AText, 6, 2) + '.' + copy(AText, 1, 4);
        FValueNumber := StrToDateDef(s, 0);
      end
      else if (LCntNumber > 0) and (LCntKomma = 0) and (LCntPoint = 2) and (LCntMinus = 0) and (LCntColon in [1, 2]) then begin
        DataType := jdDateTime;
        FValueNumber := StrToDateTimeDef(AText, 0);
      end

      else begin
        FValue := AText;
        FDataType := jdString;
      end;
    end;
  end;
// procedure TBafJsonNode.SetValueText
end;

procedure TBafJsonNode.WriteDebugText(AList: TStringList);
var
  s: string;
  i: integer;
begin
  case NodeType of
    jtSimple: s := 'jtSimple';
    jtObject: s := 'jtObject';
    jtArray: s := 'jtArray';
  end;
  AList.Add(Format('FName: %s  FValue: %s   Typ: %s   FChilds: %d',
    [FName, FValue, s, FChilds.Count]));
  for i := 0 to FChilds.Count - 1 do
    (FChilds[i] as TBafJsonNode).WriteDebugText(AList);
  AList.Add(Format('!! Ende !!   FName: %s  FValue: %s   Typ: %s   FChilds: %d',
    [FName, FValue, s, FChilds.Count]));
end;

{ TBafJsonModule }

constructor TBafJsonModule.Create;
begin
  inherited;
  FParsedJsonList := TObjectList.Create;
  FLoopNodeList := TStringList.Create;
end;

destructor TBafJsonModule.Destroy;
begin
  FreeAndNil(FLoopNodeList);
  FreeAndNil(FParsedJsonList);
  inherited;
end;

class procedure TBafJsonModule.FetchGridCellValue(ACurrentNode: TBafJsonNode;
  ACell: TBafSgCell; AColumn: TBafSgColumn; ARow: integer; ASep: string;
  AExecInter: TBafCustomInterpreter; ALineP: string);
var
  LFieldName, LValue: string;
  LCurrentNode: TBafJsonNode;
  i: integer;
begin
  LFieldName := AColumn.CellFieldName;
  ACell.CellType := AColumn.CellType;
  if (LFieldName <> '') and (AColumn.CellDataQuelle in [dqJSON]) then begin
    if ACurrentNode.FindNode(LFieldName, ASep, LCurrentNode) then
      LValue := LCurrentNode.GetValueText
    else
      LValue := '';
    ACell.Text := CellCheckFormat(LValue, AColumn.CellCommand);
  end
  else if AColumn.CellCommand <> '' then
    ACell.Command := AColumn.CellCommand
  else
    ACell.Text := AExecInter.FindParamStringReplaced(AColumn.LineP, 'z', '');
end;

class procedure TBafJsonModule.FetchGridFields(ACurrentNode: TBafJsonNode;
    var ARow: integer; AXGridIndex, AXXGridindex: integer; AIncRow: boolean;
    ASep: string; AExecInter: TBafCustomInterpreter; ALineP: string;
    ALastSeg: TBafPageSegment);
// Goes through the cells and gets the values from the JSON
var
  LCol, ix, ixx: integer;
  LColumn: TBafSgColumn;
  LColumns: TBafSgColumns;
  LFieldName, s: string;
  LCell: TBafSgCell;
  LCurrentNode: TBafJsonNode;

  procedure lokOther;
  begin
    if LColumn.CellHintFieldName <> '' then begin
      LFieldName := LColumn.CellHintFieldName;
      if ACurrentNode.FindNode(LFieldName, ASep, LCurrentNode) then
        LCell.Hint := LCurrentNode.FValue
      else
        LCell.Hint := LFieldName;
    end;
    if LColumn.CellReadOnlyFieldName <> '' then begin
      LFieldName := LColumn.CellReadOnlyFieldName;
      if ACurrentNode.FindNode(LFieldName, ASep, LCurrentNode) then begin
        s := LCurrentNode.FValue;
        if BafIsYesChar((s + BAFYESCHAR)[1])   // No data row, then ro=Y
            or (AnsiCompareText(s, 'true') = 0) then
          LCell.ReadOnly := true;
      end;
    end;
    if LColumn.CellType = ctLookupLive then begin
      LCell.LookupHelper := TBafComboHelper.Create(false);
      AExecInter.AddGridObjectList(LCell.LookupHelper);
    end;
    if ALastSeg.DataKey[LColumn.CellDataQIndex] = LColumn.CellFieldName then
      LCell.Parents.Row.DataKeyValue := LCell.Text;
  end; // procedure lokOther

begin
  if ALastSeg.SegmentType = stMap then
    LColumns := ALastSeg.Map.Columns
  else
    LColumns := ALastSeg.Grid.Columns;
  for LCol := 0 to LColumns.Count - 1 do begin
    LColumn := LColumns.Items[LCol];
    ix := LColumn.XGridIndex;
    ixx := LColumn.XXGridIndex;
    if ((ix = -1) or (ix = AXGridIndex))
        and ((ixx = -1) or (ixx = AXXGridIndex)) then begin
      if ALastSeg.SegmentType = stMap then
        LCell := ALastSeg.Map.Cells[rtData, LCol, ARow]
      else
        LCell := ALastSeg.Grid.Cells[rtData, LCol, ARow];
      FetchGridCellValue(ACurrentNode, LCell, LColumn, ARow, ASep,
          AExecInter, ALineP);  // <-----
      lokOther;
    end;
  end;
  if AIncRow then
    inc(ARow);
// class procedure TBafJsonModule.FetchGridFields
end;

function TBafJsonModule.GetJson(AParams: TStrings): string;
var
  LVar, LPath, LText: string;
  LIgnoreCase: boolean;
  LSep: Char;
  LNode, LNodeResult: TBafJSONNode;
begin
  if AParams.Count > 1 then begin
    LPath := AParams[1];
    LVar := AParams[0];
    LText := FInter.Variable[LVar];
    LIgnoreCase := false;
    LSep := '.';
    if AParams.Count > 2 then
      LIgnoreCase := BafIsYesChar(AParams[2]);
    if AParams.Count > 3 then
      LSep := (AParams[2] + '.')[1];
    LNode := TBafJsonNode.Create(nil);
    try
      Parse(LNode, LText);
      if LNode.FindNode(LPath, LSep, LNodeResult) then
        result := LNodeResult.GetValueText;
    finally
      LNode.Free;
    end;
  end
  else
    FInter.DoLog('E', '$JSON, number of params less 2');
end;

function TBafJsonModule.GetJsonArrayValue(AParams: TStrings): string;
// 0 - Number of XML
// 1 - path to array
// 2 - index of array-field
// 3 - path in array
// 4 - path separator
var
  LRoot, LLoop, LLoop2, LNode: TBafJsonNode;
  LPath, LSep, LArrayField: string;
  LNum, LIx: integer;
begin
  if AParams.Count > 3 then begin
    LNum := StrToIntDef(AParams[0], 1);
    LRoot := GetParsedJson(LNum);
    LSep := '.';
    if (AParams.Count > 4) then
      LSep := AParams[4];
    if LRoot.FindNode(AParams[1], LSep, LLoop) then begin
      LArrayField := AnsiLowerCase(AParams[2]);
      if LArrayField = 'first' then
        LIx := 0
      else if LArrayField = 'last' then
        LIx := LLoop.FChilds.Count - 1
      else LIx := StrToIntDef(LArrayField, 0);
      LLoop2 := LLoop.FChilds[LIx] as TBafJSONNode;
      if not LLoop2.FindNode(AParams[3], LSep, LNode) then
        exit;
      result := LNode.GetValueText;
    end;
  end
  else
    FInter.DoLog('E', '$JSON_ARRAY_VALUE, number of params less 4');
end;

function TBafJsonModule.GetJsonData(AParams: TStrings): string;
// 0 - Name of JSON loop
// 1 - path
// 2 - sep
var
  ix: integer;
  LLoop, LNode: TBafJSONNode;
  LSep: string;
begin
  if AParams.Count > 1 then begin
    ix := FLoopNodeList.IndexOf(AParams[0]);
    if ix >= 0 then begin
      LLoop := FLoopNodeList.Objects[ix] as TBafJSONNode;
      if (AParams.Count > 2) then
        LSep := AParams[2]
      else
        LSep := '.';
      if AnsiLowerCase(AParams[1]) = '!name' then begin
        result := LLoop.Name;
        if (result = '') and (LLoop.ChildCount = 1) then
          result := LLoop.Child[0].Name;
        exit;
      end;
      if not LLoop.FindNode(AParams[1], LSep, LNode) then
        exit;
      result := LNode.GetValueText;
    end;
  end
  else
    FInter.DoLog('E', '$XML_DATA, number of params less 2');
end;

function TBafJsonModule.GetJsonDataText(AParams: TStrings): string;
// 0 - Name of JSON loop
// 1 - Type (flat or frm)
// 2 - path
// 3 - path separator
var
  ix: integer;
  LType, LSep: string;
  LLoop, LNode: TBafJsonNode;
  LMode: TBafJsonMode;
begin
  if AParams.Count > 1 then begin
    ix := FLoopNodeList.IndexOf(AParams[0]);
    if ix >= 0 then begin
      LLoop := FLoopNodeList.Objects[ix] as TBafJsonNode;
      LType := AnsiLowerCase(AParams[1]);
      if (AParams.Count > 2) then begin
        if (AParams.Count > 3) then
          LSep := AParams[3]
        else
          LSep := '.';
        if not LLoop.FindNode(AParams[2], LSep, LNode) then
          exit;
      end
      else
        LNode := LLoop;
      if LType = 'flat' then
        LMode := jmFlat
      else if LType = 'xml' then
        LMode := jmXmlFlat
      else if (LType = 'xmlfrm') or (LType = 'xmlform') or (LType = 'xmlformatted')  then
        LMode := jmXmlFormatted
      else
        LMode := jmFormatted;
      if LMode in [jmFlat, jmFormatted] then
        result := LNode.GetText(LMode, 0)
      else
      ;
      if LMode in [jmFlat, jmFormatted] then
        result := LNode.GetText(LMode, 0)
      else
      ;
//        result := '{' + LNode.GetXmlText(LMode, 0, '') + #13#10 + '}';
      if LMode in [jmFlat, jmXmlFlat] then
        result := StringReplace(result, #13#10, ' ', [rfReplaceAll]);
    end;
  end
  else
    FInter.DoLog('E', '$XML_TEXT, number of params less 2');


// function TBafJsonModule.GetJsonDataText
end;

function TBafJsonModule.GetJsonLfr(AParams: TStrings): string;
// Gets the first Item from a Loop, fitting a REGEX
// 0 - Number of XML
// 1 - path
// 2 - path separator
// 3 - Prefix
// 4 - Fieldname
// 5 - Regex
var
  LRoot, LLoop, LCurrentNode: TBafJsonNode;
  LPfx, LName, LRegex: string;
  LNum, i: integer;
begin
  if AParams.Count > 4 then begin
    LNum := StrToIntDef(AParams[0], 1);
    LRoot := GetParsedJson(LNum);
    if LRoot.FindNode(AParams[1], AParams[2], LLoop) then begin
      LPfx := AParams[3];
      LName := AParams[4];
      if AParams.Count > 5 then
        LRegex := Trim(AParams[5]);
      for i := 0 to LLoop.FChilds.Count - 1 do begin
        if (LLoop.FChilds[i] as TBafJsonNode).Name = LPfx then begin
          (LLoop.FChilds[i] as TBafJsonNode).FindNode(LName, AParams[2], LCurrentNode);
          if LRegex <> '' then begin
            if TRegEx.IsMatch(LCurrentNode.FValue, LRegex) then begin
              result := LCurrentNode.FValue;
              Break;
            end;
          end
          else begin
            result := LCurrentNode.FValue;
            Break;
          end;
        end;
      end;
    end;
  end
  else
    FInter.DoLog('E', '$JSON_LFR, number of params less 5');
// function TBafJsonModule.GetJsonLfr
end;

function TBafJsonModule.GetJsonText(AParams: TStrings): string;
// 0 - Number of JSON
// 1 - Type (flat or frm)
// 2 - path
// 3 - path separator
var
  LNum: integer;
  LType, LSep: string;
  LRoot, LNode: TBafJsonNode;
  LMode: TBafJsonMode;
begin
  if AParams.Count > 1 then begin
    LNum := StrToIntDef(AParams[0], 1);
    LType := AnsiLowerCase(AParams[1]);
    LRoot := GetParsedJson(LNum);
    if (AParams.Count > 2) then begin
      if (AParams.Count > 3) then
        LSep := AParams[3]
      else
        LSep := '.';
      if not LRoot.FindNode(AParams[2], LSep, LNode) then
        exit;
    end
    else
      LNode := LRoot;
    if LType = 'flat' then
      LMode := jmFlat
    else if LType = 'xml' then
      LMode := jmXmlFlat
    else if (LType = 'xmlfrm') or (LType = 'xmlform') or (LType = 'xmlformatted')  then
      LMode := jmXmlFormatted
    else
      LMode := jmFormatted;
    if LMode in [jmFlat, jmFormatted] then
      result := LNode.GetText(LMode, 0)
    else
    ;
//      result := '{' + LNode.GetXmlText(LMode, 0, '') + #13#10 + '}';
    if LMode in [jmFlat, jmXmlFlat] then
      result := StringReplace(result, #13#10, ' ', [rfReplaceAll]);
  end
  else
    FInter.DoLog('E', '$JSON_TEXT, number of params less 2');
end;

function TBafJsonModule.GetJsonValue(AParams: TStrings): string;
// 0 - Number of XML
// 1 - path
// 2 - path separator
var
  LNum: integer;
  LType, LSep: string;
  LRoot, LNode: TBafJsonNode;
  LMode: TBafJsonMode;
begin
  if AParams.Count > 1 then begin
    LNum := StrToIntDef(AParams[0], 1);
    LRoot := GetParsedJson(LNum);
    if (AParams.Count > 2) then
      LSep := AParams[2]
    else
      LSep := '.';
    if not LRoot.FindNode(AParams[1], LSep, LNode) then
      exit;
    result := LNode.GetValueText;
  end
  else
    FInter.DoLog('E', '$JSON_VALUE, number of params less 2');
end;

class function TBafJsonModule.GetNodeValue(ANodeObject: TObject; APath,
    ASep: string; var AValue: string): boolean;
var
  LNode: TBafJsonNode;
begin
  result := false;
  if ANodeObject is TBafJsonNode then begin
    result := TBafJsonNode(ANodeObject).FindNode(APath, ASep, LNode);
    if result then
      AValue := LNode.GetValueText;
  end;
end;

function TBafJsonModule.GetParsedJson(AIndex: integer): TBafJsonNode;
begin
  while AIndex > FParsedJsonList.Count do
    FParsedJsonList.Add(TBafJsonNode.Create(nil));
  result := (FParsedJsonList[AIndex - 1] as TBafJsonNode);
end;

function TBafJsonModule.InterpretLine(AExecInter: TBafCustomInterpreter): boolean;
var
  LNum: integer;
  LInter: TBafCustomInterpreter;
begin
  LInter := FExecInter;
  try
    FExecInter := AExecInter;

    result := true;
    if FExecInter.LineF = '#json_clearall' then FParsedJsonList.Clear                        // clears all parsed JSON
    else if BafIsNumberedFunk(FExecInter.LineF, '#json_parse', LNum) then JsonParse(LNum)    // parses a JSON
    else if BafIsNumberedFunk(FExecInter.LineF, '#json_loop', LNum) then JsonLoop(LNum)      // loops through a parsed JSON
    else if BafIsNumberedFunk(FExecInter.LineF, '#json_chg', LNum) then JsonChange(LNum)     // Changes values in a parsed JSON
    else if BafIsNumberedFunk(FExecInter.LineF, '#json_chgdata', LNum) then JsonChangeData(LNum)     // Changes values in the current loop
    else if BafIsNumberedFunk(FExecInter.LineF, '#json_tvl', LNum) then JsonTvl(LNum)     // Fills a ValueList from a JSON

    else result := false;
  finally
    FExecInter := LInter;
  end;
end;

procedure TBafJsonModule.JsonChange(ANum: integer);
var
  LRoot, LNode: TBafJsonNode;
  LPath, LSep, LValue: string;
  LIsString, LAdd: boolean;
begin
  if FindParamBooleanReplaced('cnd', true) then begin
    LPath := FindParamStringReplaced('path', '');
    LSep := FindParamStringReplaced('sep', '.');
    LValue := FindParamStringReplaced('z', '');
    LIsString := FindParamBooleanReplaced('is', true);
    LAdd := FindParamBooleanReplaced('add', false);
    LRoot := GetParsedJson(ANum);
    if LRoot.FindNode(LPath, LSep, LNode, LAdd) then
      LNode.SetValueText(LValue, LIsString);
  end;
end;

procedure TBafJsonModule.JsonChangeData(ANum: integer);
var
  LName, LSep, LPath, LValue: string;
  ix: integer;
  LLoop, LNode: TBafJSONNode;
  LIsString, LAdd: boolean;
begin
  if FindParamBooleanReplaced('cnd', true) then begin
    LName := FindParamStringReplaced('n', '');
    LPath := FindParamStringReplaced('path', '');
    LSep := FindParamStringReplaced('sep', '.');
    LValue := FindParamStringReplaced('z', '');
    LIsString := FindParamBooleanReplaced('is', true);
    LAdd := FindParamBooleanReplaced('add', false);
    ix := FLoopNodeList.IndexOf(LName);
    if ix >= 0 then begin
      LLoop := FLoopNodeList.Objects[ix] as TBafJSONNode;
      if LLoop.FindNode(LPath, LSep, LNode, LAdd) then
        LNode.SetValueText(LValue, LIsString);
    end
    else
      raise Exception.Create('Loop "' + LName + '" not found');
  end;
end;

procedure TBafJsonModule.JsonLoop(ANum: integer);
var
  LRoot, LLoop: TBafJsonNode;
  LName, LPath, LSep, LEachRow, LBafConName: string;
  ix, i, LMax, LRowCount: integer;
  LEachRowTrans, LNoException: boolean;

  procedure lokInit;
  begin
    LRoot := GetParsedJson(ANum);
    LName := FindParamStringReplaced('n', '');
    LPath := FindParamStringReplaced('path', '');
    LSep := FindParamStringReplaced('sep', '.');
    LMax := FindParamInteger('m', MaxInt);
    LEachRow := FindParamString('ern', '');
    if LEachRow = '' then
      LEachRow := FindParamStringReplaced('er', '');
    LEachRowTrans := FindParamBoolean('ert', false);
    LNoException := FindParamBooleanReplaced('nex', false);
    LRowCount := 0;
    LBafConName := FindParamStringReplacedLower('db', DC_DEFAULT);
  end; // procedure lokInit

begin
  if FindParamBooleanReplaced('cnd', true) then begin
    lokInit;
    if LRoot.FindNode(LPath, LSep, LLoop) then begin
      for i := 0 to LLoop.FChilds.Count - 1 do begin
        ix := FLoopNodeList.IndexOf(LName);
        if ix < 0 then
          FLoopNodeList.AddObject(LName, LLoop.FChilds[i])
        else
          FLoopNodeList.Objects[ix] := LLoop.FChilds[i];

        FExecInter.EachRow(LBafConName, LEachRow, '#json_loop', LEachRowTrans,
            LNoException);

        inc(LRowCount);
        if LRowCount >= LMax then begin
          FInter.DoLog('I', Format('#json_loop, Max (%d) reached, loop aborted', [LMax]));
          Break;
        end;
        if FInter.ProgressAborted then begin
          FInter.DoLog('I', '#json_loop, loop by user aborted');
          Break;
        end;
      end;
    end;
  end;
// procedure TBafJsonModule.JsonLoop
end;

procedure TBafJsonModule.JsonLoopData(ALastSeg, ATree: TObject;
    AExecInter: TBafCustomInterpreter; ALineP: string);
var
  LRoot, LLoop, LCurrentNode: TBafJsonNode;
  LPath, LPfx, LSep, LLineP: string;
  i, LDataGridRow, LRow, LCol: integer;
  LLastSeg: TBafPageSegment;

  procedure lokFindAndSet(ACol, ARow: integer; ALineP: string);
  var
    s, LValue: string;
    LCell: TBafSgCell;
    LIni: TStringIniFile;


    procedure lokVlInsert;
    var
      LTree: TBafTree;
    begin
      LTree := (ATree as TBafTree);
      LCell.Inserted := true;
      LLastSeg.Grid.VlInsert := true;
      if Assigned(LTree.Selected) and (LCell.DataQIndex = 0) then begin
        LIni := LTree.Selected.Ini;
        if (LTree.Selected.GetTableName = LLastSeg.DataTable[0])
            and (LCell.DataFieldName = LIni.ReadString(SEC_ADD, 'k', ''))
            and (LIni.ReadString(SEC_DATA, LCell.DataFieldName, '') = '') then
          LIni.WriteString(SEC_DATA, LCell.DataFieldName, LCell.Text);
        FInter.DebugNodeIni(LTree.Selected.Ini);
      end;
    end; // procedure lokVlInsert

  begin
    LCell := LLastSeg.Grid.Cells[rtData, ACol, ARow];
    s := IntToStr(ACol + 1);
    if LCell.DataFieldName <> '' then begin
      if GetNodeValue(LLoop, LCell.DataFieldName, LSep, LValue) then
        LCell.Text := LValue;
    end;
    if LCell.DataHintFieldName <> '' then begin
      if GetNodeValue(LLoop, LCell.DataHintFieldName, LSep, LValue) then
        LCell.Hint := LValue
      else
        LCell.Hint := LCell.DataHintFieldName;
    end;
    if LCell.Text = '' then begin    // NullValue
      if FindParam(ALineP, 'nvic' + s, LValue) then begin
        LCell.SetTextChange(FExecInter.ReplaceFunctions(LValue), true, true);
        lokVlInsert;
      end
      else if FindParam(ALineP, 'nvc' + s, LValue) then
        LCell.SetTextChange(FExecInter.ReplaceFunctions(LValue), true, true)
      else if FindParam(ALineP, 'nvi' + s, LValue) then begin
        LCell.Text := FExecInter.ReplaceFunctions(LValue);
        lokVlInsert;
      end
      else if FindParam(ALineP, 'nv' + s, LValue) then
        LCell.Text := FExecInter.ReplaceFunctions(LValue);
    end;
  end; // procedure lokFindAndSet

begin
  LLastSeg := ALastSeg as TBafPageSegment;
  LRoot := GetParsedJson(1);
  LPath := AExecInter.FindParamStringReplaced(ALineP, 'path', '');
  LPfx := AExecInter.FindParamStringReplaced(ALineP, 'pfx', '');
  LSep := AExecInter.FindParamStringReplaced(ALineP, 'sep', '.');
  if LLastSeg.SegmentType = stValueList then begin
    if LRoot.FindNode(LPath, LSep, LLoop) then begin
      LLastSeg.Grid.GridJson := LLoop.GetText(jmFormatted, 0);
      for LRow := 0 to LLastSeg.Grid.RowCount - 1 do begin
        LLineP := LLastSeg.Grid.DataRow[LRow].LineP;
        for LCol := 0 to LLastSeg.Grid.Columns.Count - 1 do
          lokFindAndSet(LCol, LRow, LLineP);
      end;
    end;
  end
  else begin
    LDataGridRow := 0;
    if LRoot.FindNode(LPath, LSep, LLoop) then begin
      for i := 0 to LLoop.FChilds.Count - 1 do begin
        LCurrentNode := LLoop.FChilds[i] as TBafJsonNode;
        FetchGridFields(LCurrentNode, LDataGridRow, -1, -1, true, LSep,
            AExecInter, ALineP, LLastSeg);
      end;
    end;
  end;
end; // procedure TBafJsonModule.JsonLoopData

procedure TBafJsonModule.JsonParse(ANum: integer);
var
  LRoot: TBafJsonNode;
  LJson: string;
begin
  if FindParamBooleanReplaced('cnd', true) then begin
    LRoot := GetParsedJson(ANum);
    LJson := FindParamStringReplaced('json', '');
    TBafJsonModule.Parse(LRoot, LJson);
  end;
end;

procedure TBafJsonModule.JsonTvl(ANum: integer);
var
  LRoot, LLoop, LCurrentNode, LValueNode: TBafJsonNode;
  LNameKey, LNameValue, LKey, LValue, LPath, LSep: string;
  i, LTextNum: integer;
  LText: TStringList;
begin
  if FindParamBooleanReplaced('cnd', true) then begin
    LRoot := GetParsedJson(ANum);
    LNameKey := FindParamStringReplaced('ckey', '');
    LNameValue := FindParamStringReplaced('cvalue', '');
    LPath := FindParamStringReplaced('path', '');
    LSep := FindParamStringReplaced('sep', '.');
    LTextNum := FindParamIntegerReplaced('n', 1);
    LText := FInter.GetTextStringList(LTextNum);
    if FindParamBooleanReplaced('clr', true) then
      LText.Clear;
    if LRoot.FindNode(LPath, LSep, LLoop) then begin
      for i := 0 to LLoop.FChilds.Count - 1 do begin
        LCurrentNode := LLoop.FChilds[i] as TBafJsonNode;
        if LCurrentNode.FindNode(LNameKey, LSep, LValueNode) then
          LKey := LValueNode.GetValueText;
        if LCurrentNode.FindNode(LNameValue, LSep, LValueNode) then
          LValue := LValueNode.GetValueText;
        LText.Add(LKey + '=' + LValue);
      end;
    end;
  end;
end;

class procedure TBafJsonModule.Parse(ARoot: TBafJsonNode; AJson: string);
var
  i, LLevel, LStart: integer;
  LNode: TBafJsonNode;
  LInQuote, LInValue, LAbort, LWasQuoted: boolean;
  s: string;

  procedure lokStartNode(ANodeType: TBafJsonType);
  begin
    LNode.NodeType := ANodeType;
    LNode := TBafJsonNode.Create(LNode);
    inc(LLevel);
    LInValue := false;
    LStart := i + 1;
  end; // procedure lokStartNode

  procedure lokQuote;
  begin
    if LInQuote = false then begin
      LInQuote := true;
      LStart := i + 1;
      LWasQuoted := false;
    end
    else begin
      LInQuote := false;
      s := copy(AJson, LStart, i - LStart);
      if not LInValue then begin
        if Assigned(LNode.FParent) and (LNode.FParent.NodeType = jtArray) then begin
          LNode.SetValueText(s);
          LWasQuoted := true;
        end
        else
          LNode.FName := s;
        s := '';
      end;
    end;
  end; // procedure lokQuote

  procedure SetValue;
  begin
    if s <> '' then
      LNode.SetValueText(s)
    else
      LNode.SetValueText(Trim(copy(AJson, LStart, i - LStart)), false);
  end; // procedure SetValue

  procedure lokKomma;
  begin
    if LInValue or ((LNode.FParent.NodeType = jtArray) and not LWasQuoted) then
      SetValue;
    LNode := TBafJsonNode.Create(LNode.FParent);
    LInValue := false;
    LStart := i + 1;
    s := '';
  end; // procedure lokKomma

  procedure lokStopNode(ANodeType: TBafJsonType);
  begin
    if LInValue or ((LNode.FParent.NodeType = jtArray)
        and (LNode.NodeType = jtSimple) and not LWasQuoted) then
      SetValue;
    LNode := LNode.FParent;
    dec(LLevel);
  end; // procedure lokStopNode

  procedure lokCheckChar(AChar: Char);
  begin
    case AChar of
      '{': lokStartNode(jtObject);
      '[': lokStartNode(jtArray);
      '}': lokStopNode(jtObject);
      ']': lokStopNode(jtArray);
      '"': lokQuote;
      ':': if not LInValue then begin
        LInValue := true;
        LStart := i + 1;
      end;
      ',': lokKomma;
    end;
  end; // procedure lokCheckChar

begin
  ARoot.FChilds.Clear;
  LInQuote := false;
  LInValue := false;
  LAbort := false;
  LNode := ARoot;
  LLevel := 0;
  for i := 1 to Length(AJson) do begin
    if LInQuote then begin
      if AJson[i] = '"' then
        lokCheckChar(AJson[i]);
    end
    else
      lokCheckChar(AJson[i]);
    if LAbort then
      Break;
  end;
// class procedure TBafJsonModule.Parse
end;

function TBafJsonModule.ReplaceFunction(ACommand: string; AParams: TStrings;
  var AResult: string): boolean;
begin
  inherited;
  result := true;
  if ACommand = '$JSON' then AResult := GetJSON(AParams)
  else if ACommand = '$JSON_TEXT' then AResult := GetJsonText(AParams)
  else if ACommand = '$JSON_VALUE' then AResult := GetJsonValue(AParams)
  else if ACommand = '$JSON_ARRAY_VALUE' then AResult := GetJsonArrayValue(AParams)
  else if ACommand = '$JSON_DATA' then AResult := GetJsonData(AParams)
  else if ACommand = '$JSON_DATATEXT' then AResult := GetJsonDataText(AParams)
  else if ACommand = '$JSON_LFR' then AResult := GetJsonLfr(AParams)
//
  else result := false;
end;

end.
