unit uBafXmlModule;

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


interface

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

type
  TBafXmlMode = (xmFlat, xmFormatted, xmJsonFlat, xmJsonFormatted);

  TBafXmlNode = class
  private
    FChilds: TStringList;
    FProperties: TStringList;
    FAdditional: TStringList;
    FParent: TBafXmlNode;
    FValue: string;
    FName: string;
  public
    constructor Create(AParent: TBafXmlNode);
    destructor Destroy; override;
    function GetText(AMode: TBafXmlMode; ALevel: integer): string;
    function GetJsonText(AMode: TBafXmlMode; ALevel: integer; AArrayName: string): string;
    function FindNode(APath, ASep: string; out ANode: TBafXmlNode): boolean;
    property Childs: TStringList read FChilds;
    property Name: string read FName;
    property Value: string read FValue;
  end;

  TBafXmlModule = class(TBafInterpreterCustomModule)
  protected
    FParsedXmlList: TObjectList;
    FLoopNodeList: TStringList;
    procedure XmlParse(ANum: integer);
    procedure XmlLoop(ANum: integer);
    procedure XmlChange(ANum: integer);
    procedure XmlGetArrayValues(ANum: integer);
    function GetParsedXml(AIndex: integer): TBafXmlNode;
    function GetXMLText(AParams: TStrings): string;
    function GetXMLValue(AParams: TStrings): string;
    function GetXMLData(AParams: TStrings): string;
    function GetXMLDataText(AParams: TStrings): string;
    function GetXML_Lfr(AParams: TStrings): string;
    function GetXML_Valex(AParams: TStrings): string;
  protected
    function GetXML(AParams: TStrings): string;
    function BafXmlObjectParse(AXml, APath: string;
        AIgnoreNameCase: boolean = false; APathSep: Char = '.'): string;
  protected
    class procedure FetchGridCellValue(ACurrentNode: TBafXmlNode; 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;
    procedure XmlLoopData(ALastSeg: TObject; AExecInter: TBafCustomInterpreter;
        ALineP: string);
    class procedure Parse(ARoot: TBafXmlNode; AXml: string);
    class procedure FetchGridFields(ACurrentNode: TBafXmlNode; var ARow: integer;
        AXGridIndex, AXXGridindex: integer; AIncRow: boolean; ASep: string;
        AExecInter: TBafCustomInterpreter; ALineP: string; ALastSeg: TBafPageSegment);
  end;


implementation

uses dmMain, uBafComboHelper, uOsStuff;

{ TBafXmlModule }

function TBafXmlModule.BafXmlObjectParse(AXml, APath: string;
  AIgnoreNameCase: boolean; APathSep: Char): string;
var
  i, p, LBracketStart, LResultStart, LSlashPos: integer;
  LAbort, LInBrackets, LSlash, LSpace, LInQuote: boolean;
  LPath, s, LLastAdd: string;

  function lokEquals(AString1, AString2: string): boolean;
  begin
    if AIgnoreNameCase then
      result := (AnsiCompareText(AString1, AString2) = 0)
    else
      result := (AString1 = AString2);
  end; // function lokEquals

  procedure lokEnd;
  begin
    if LInBrackets and LSlash and (LSlashPos = i - 1) then begin
      s := LLastAdd;
      if lokEquals(copy(LPath, Length(LPath) - Length(s) + 1, Length(s)), s) then
        Delete(LPath, Length(LPath) - Length(s), Length(s) + 1);
      if lokEquals(LPath, APath) and (LResultStart > 0) then begin
        result := copy(AXml, LResultStart, LBracketStart - LResultStart);
        LAbort := true;
      end;
    end
    else if LInBrackets and LSlash then begin
      if lokEquals(LPath, APathSep + APath) and (LResultStart > 0) then begin
        result := copy(AXml, LResultStart, LBracketStart - LResultStart);
        LAbort := true;
      end;
      s := copy(AXml, LBracketStart + 2, i - LBracketStart - 2);
      if lokEquals(copy(LPath, Length(LPath) - Length(s) + 1, Length(s)), s) then
        Delete(LPath, Length(LPath) - Length(s), Length(s) + 1);
    end
    else if LInBrackets and LSpace then
      LInBrackets := false
    else if LInBrackets then begin
      LLastAdd := copy(AXml, LBracketStart + 1, i - LBracketStart - 1);
      LPath := LPath + APathSep + LLastAdd;
      LInBrackets := false;
      if lokEquals(LPath, APathSep + APath) and (LResultStart = 0) then
        LResultStart := i + 1;
    end;
    LSlash := false;
    LSpace := false;
  end; // procedure lokEnd

  procedure lokCheckChar;
  begin
    case AXml[i] of
      '<': if not LInQuote then begin
        LInBrackets := true;
        LBracketStart := i;
      end;
      ' ': if LInBrackets and not LSlash and not LInQuote then begin
        LLastAdd := copy(AXml, LBracketStart + 1, i - LBracketStart - 1);
        LPath := LPath + APathSep + LLastAdd;
        LSpace := true;
        if lokEquals(LPath, APath) and (LResultStart = 0) then
          LResultStart := i + 1;
      end;
      '>': if not LInQuote then
        lokEnd;
      '/': if LInBrackets and not LInQuote then begin
        LSlash := true;
        LSlashPos := i;
      end;
      '"': if LInBrackets then
        LInQuote := not LInQuote;
    end; // case
  end; // procedure lokCheckChar

begin
  LAbort := false;
  LInBrackets := false;
  LSlash := false;
  LSpace := false;
  LResultStart := 0;
  LInQuote := false;
  for i := 1 to Length(AXml) do begin
    lokCheckChar;
    if LAbort then
      Break;
  end;
// function TBafXmlModule.BafXmlObjectParse
end;

constructor TBafXmlModule.Create;
begin
  inherited;
  FParsedXmlList := TObjectList.Create;
  FLoopNodeList := TStringList.Create;
end;

destructor TBafXmlModule.Destroy;
begin
  FreeAndNil(FLoopNodeList);
  FreeAndNil(FParsedXmlList);
  inherited;
end;

class procedure TBafXmlModule.FetchGridCellValue(ACurrentNode: TBafXmlNode;
  ACell: TBafSgCell; AColumn: TBafSgColumn; ARow: integer; ASep: string;
  AExecInter: TBafCustomInterpreter; ALineP: string);
var
  LFieldName, LValue: string;
  LCurrentNode: TBafXmlNode;
  i: integer;
begin
  LFieldName := AColumn.CellFieldName;
  ACell.CellType := AColumn.CellType;
  if (LFieldName <> '') and (AColumn.CellDataQuelle in [dqXML]) then begin
    if ACurrentNode.FindNode(LFieldName, ASep, LCurrentNode) then
      LValue := LCurrentNode.FValue
    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', '');
//  ColumnNullValue(ACell);
end;

class procedure TBafXmlModule.FetchGridFields(ACurrentNode: TBafXmlNode;
    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 XML
var
  LCol, ix, ixx: integer;
  LColumn: TBafSgColumn;
  LColumns: TBafSgColumns;
  LFieldName, s: string;
  LCell: TBafSgCell;
  LCurrentNode: TBafXmlNode;

  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);
// procedure TBafXmlModule.FetchGridFields
end;

function TBafXmlModule.GetParsedXml(AIndex: integer): TBafXmlNode;
begin
  while AIndex > FParsedXmlList.Count do
    FParsedXmlList.Add(TBafXmlNode.Create(nil));
  result := (FParsedXmlList[AIndex - 1] as TBafXmlNode);
end;

function TBafXmlModule.GetXML(AParams: TStrings): string;
var
  LVar, LPath, LText: string;
  LIgnoreCase: boolean;
  LSep: Char;
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];
    result := BafXmlObjectParse(LSep + LText, LPath, LIgnoreCase, LSep);
  end
  else
    FInter.DoLog('E', '$XML, number of params less 2');
// function TBafXmlModule.GetXML
end;

function TBafXmlModule.GetXMLData(AParams: TStrings): string;
// 0 - Name of XML loop
// 1 - path
// 2 - sep
var
  ix: integer;
  LLoop, LNode: TBafXmlNode;
  LSep: string;
begin
  if AParams.Count > 1 then begin
    ix := FLoopNodeList.IndexOf(AParams[0]);
    if ix >= 0 then begin
      LLoop := FLoopNodeList.Objects[ix] as TBafXmlNode;
      if (AParams.Count > 2) then
        LSep := AParams[2]
      else
        LSep := '.';
      if not LLoop.FindNode(AParams[1], LSep, LNode) then
        exit;
      result := LNode.FValue;
    end;
  end
  else
    FInter.DoLog('E', '$XML_DATA, number of params less 2');
end;

function TBafXmlModule.GetXMLDataText(AParams: TStrings): string;
// 0 - Name of XML loop
// 1 - Type (flat or frm)
// 2 - path
// 3 - path separator
var
  ix: integer;
  LType, LSep: string;
  LLoop, LNode: TBafXmlNode;
  LMode: TBafXmlMode;
begin
  if AParams.Count > 1 then begin
    ix := FLoopNodeList.IndexOf(AParams[0]);
    if ix >= 0 then begin
      LLoop := FLoopNodeList.Objects[ix] as TBafXmlNode;
      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 := xmFlat
      else if LType = 'json' then
        LMode := xmJsonFlat
      else if (LType = 'jsonfrm') or (LType = 'jsonform') or (LType = 'jsonformatted')  then
        LMode := xmJsonFormatted
      else
        LMode := xmFormatted;
      if LMode in [xmFlat, xmFormatted] then
        result := LNode.GetText(LMode, 0)
      else
        result := '{' + LNode.GetJsonText(LMode, 0, '') + #13#10 + '}';
      if LMode in [xmFlat, xmJsonFlat] then
        result := StringReplace(result, #13#10, ' ', [rfReplaceAll]);
    end;
  end
  else
    FInter.DoLog('E', '$XML_TEXT, number of params less 2');
// function TBafXmlModule.GetXMLDataText
end;

function TBafXmlModule.GetXMLText(AParams: TStrings): string;
// 0 - Number of XML
// 1 - Type (flat or frm)
// 2 - path
// 3 - path separator
var
  LNum: integer;
  LType, LSep: string;
  LRoot, LNode: TBafXmlNode;
  LMode: TBafXmlMode;
begin
  if AParams.Count > 1 then begin
    LNum := StrToIntDef(AParams[0], 1);
    LType := AnsiLowerCase(AParams[1]);
    LRoot := GetParsedXml(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 := xmFlat
    else if LType = 'json' then
      LMode := xmJsonFlat
    else if (LType = 'jsonfrm') or (LType = 'jsonform') or (LType = 'jsonformatted')  then
      LMode := xmJsonFormatted
    else
      LMode := xmFormatted;
    if LMode in [xmFlat, xmFormatted] then
      result := LNode.GetText(LMode, 0)
    else
      result := '{' + LNode.GetJsonText(LMode, 0, '') + #13#10 + '}';
    if LMode in [xmFlat, xmJsonFlat] then
      result := StringReplace(result, #13#10, ' ', [rfReplaceAll]);
  end
  else
    FInter.DoLog('E', '$XML_TEXT, number of params less 2');
end;

function TBafXmlModule.GetXMLValue(AParams: TStrings): string;
// 0 - Number of XML
// 1 - path
// 2 - path separator
var
  LNum: integer;
  LType, LSep: string;
  LRoot, LNode: TBafXmlNode;
  LMode: TBafXmlMode;
begin
  if AParams.Count > 1 then begin
    LNum := StrToIntDef(AParams[0], 1);
    LRoot := GetParsedXml(LNum);
    if (AParams.Count > 2) then
      LSep := AParams[2]
    else
      LSep := '.';
    if not LRoot.FindNode(AParams[1], LSep, LNode) then
      exit;
    result := LNode.FValue;
  end
  else
    FInter.DoLog('E', '$XML_VALUE, number of params less 2');
end;


function TBafXmlModule.GetXML_Lfr(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: TBafXmlNode;
  LPfx, LName, LRegex: string;
  LNum, i: integer;
begin
  if AParams.Count > 4 then begin
    LNum := StrToIntDef(AParams[0], 1);
    LRoot := GetParsedXml(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] = LPfx then begin
          (LLoop.FChilds.Objects[i] as TBafXmlNode).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', '$XML_LFR, number of params less 5');
// function TBafXmlModule.GetXML_Lfr
end;

function TBafXmlModule.GetXML_Valex(AParams: TStrings): string;
// Checks whether a value exists
// 0 - Number of XML
// 1 - path
// 2 - path separator
// 3 - Prefix
// 4 - Fieldname
// 5 - Fieldvalue / Regex
// 6 - Typ: ic - ignore case, regex,
// 7 - Result Yes
// 8 - Result No
var
  LRoot, LLoop, LCurrentNode: TBafXmlNode;
  LPfx, LName, LValue, LTyp: string;
  LNum, i: integer;
  LResult: boolean;

  function lokResult: string;
  begin
    if LResult then begin
      if AParams.Count > 7 then
        result := AParams[7]
      else
        result := 'Y';
    end
    else begin
      if AParams.Count > 8 then
        result := AParams[8]
      else
        result := 'N';
    end;
  end; // function lokResult

  function lokCheck: boolean;
  begin
    if LTyp = 'ic' then
      result := (AnsiCompareText(LCurrentNode.FValue, LValue) = 0)
    else if LTyp = 'ic' then
      result := TRegEx.IsMatch(LCurrentNode.FValue, LValue)
    else
      result := (LCurrentNode.FValue = LValue)
  end; // function lokCheck: boolean

begin
  if AParams.Count > 5 then begin
    LNum := StrToIntDef(AParams[0], 1);
    LRoot := GetParsedXml(LNum);
    LResult := false;
    if LRoot.FindNode(AParams[1], AParams[2], LLoop) then begin
      LPfx := AParams[3];
      LName := AParams[4];
      LValue := AParams[5];
      if AParams.Count > 6 then
        LTyp := AnsiLowerCase(AParams[6]);
      for i := 0 to LLoop.FChilds.Count - 1 do begin
        if LLoop.FChilds[i] = LPfx then begin
          (LLoop.FChilds.Objects[i] as TBafXmlNode).FindNode(LName, AParams[2], LCurrentNode);
          LResult := lokCheck;
          if LResult then
            Break;
        end;
      end; // for i
    end;
    result := lokResult;
  end
  else
    FInter.DoLog('E', '$XML_VALEX, number of params less 6');
// function TBafXmlModule.GetXML_Valex
end;

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

    result := true;
    if FExecInter.LineF = '#xml_clearall' then FParsedXmlList.Clear                          // clears all parsed xml
    else if BafIsNumberedFunk(FExecInter.LineF, '#xml_parse', LNum) then XmlParse(LNum)      // parses a XML
    else if BafIsNumberedFunk(FExecInter.LineF, '#xml_loop', LNum) then XmlLoop(LNum)        // loops through a parsed XML
    else if BafIsNumberedFunk(FExecInter.LineF, '#xml_chg', LNum) then XmlChange(LNum)       // Changes values in a parsed XML
    else if BafIsNumberedFunk(FExecInter.LineF, '#xml_gav', LNum) then XmlGetArrayValues(LNum)       // Get the values of an array

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

end;

class procedure TBafXmlModule.Parse(ARoot: TBafXmlNode; AXml: string);
var
  LRoot, LCurrentNode, LNewNode: TBafXmlNode;
  i, p, LBracketStart, LResultStart, LSlashPos, LLastSpace, LNameEnd: integer;
  LAbort, LInBrackets, LSlash, LSpace, LInQuote, LNodeAdded, LInAdditional: boolean;
  LXml, LPath, s, LLastAdd: string;

  procedure lokSpace(AAddPos: integer);
  begin
    if LSpace then begin
      // we are in the props
      LLastAdd := copy(LXml, LLastSpace + 1, i - LLastSpace - 1 + AAddPos);
      LCurrentNode.FProperties.Add(LLastAdd);
    end
    else begin
      // Node name
      LLastAdd := copy(LXml, LBracketStart + 1, i - LBracketStart - 1 + AAddPos);
      LNewNode := TBafXmlNode.Create(LCurrentNode);
      LNewNode.FName := LLastAdd;
      LCurrentNode.FChilds.AddObject(LLastAdd, LNewNode);
      LCurrentNode := LNewNode;
      LSpace := true;
      LLastSpace := i;
      LNodeAdded := true;
    end;
  end; // procedure lokSpace

  procedure lokEnd;
  begin
    if LInBrackets then begin
      if LInAdditional then begin
        s := copy(LXml, LBracketStart, i - LBracketStart + 1);
        LCurrentNode.FAdditional.Add(s);
      end
      else if LSlash and (LSlashPos = i - 1) then begin
        lokSpace(-1);
        LNodeAdded := false;
        LCurrentNode := LCurrentNode.FParent;
      end
      else if LSlash then begin
        if LNodeAdded then begin
          LCurrentNode.FValue := Trim(copy(LXml, LNameEnd + 1, LBracketStart - LNameEnd - 1));
          LNodeAdded := false;
        end;
        LCurrentNode := LCurrentNode.FParent;
      end
      else begin
        lokSpace(0);
        LNameEnd := i;
      end;
    end;
    LSlash := false;
    LSpace := false;
    LInBrackets := false;
    LInAdditional := false;
  end; // procedure lokEnd

  procedure lokCheckChar;
  begin
    case LXml[i] of
      '<': if not LInQuote then begin
        LInBrackets := true;
        LBracketStart := i;
      end;
      '!': if LInBrackets and not LInQuote then begin
        if LBracketStart + 1 = i then
          LInAdditional := true;
      end;
      ' ': if LInBrackets and not LSlash and not LInQuote and not LInAdditional then
        lokSpace(0);
      '>': if not LInQuote then
        lokEnd;
      '/': if LInBrackets and not LInQuote then begin
        LSlash := true;
        LSlashPos := i;
      end;
      '"': if LInBrackets then
        LInQuote := not LInQuote;
    end; // case
  end; // procedure lokCheckChar

begin
  LRoot := ARoot;
  LRoot.FAdditional.Clear;
  LRoot.FChilds.Clear;
  LCurrentNode := LRoot;
  LXml := AXml;
  LAbort := false;
  LInBrackets := false;
  LSlash := false;
  LSpace := false;
  LNodeAdded := false;
  LResultStart := 0;
  LInQuote := false;
  for i := 1 to Length(LXml) do begin
    lokCheckChar;
    if LAbort then
      Break;
  end;
// class procedure TBafXmlModule.Parse
end;

function TBafXmlModule.ReplaceFunction(ACommand: string; AParams: TStrings;
  var AResult: string): boolean;
begin
  inherited;
  result := true;
  if ACommand = '$XML' then AResult := GetXML(AParams)
  else if ACommand = '$XML_TEXT' then AResult := GetXMLText(AParams)
  else if ACommand = '$XML_VALUE' then AResult := GetXMLValue(AParams)
  else if ACommand = '$XML_DATA' then AResult := GetXMLData(AParams)
  else if ACommand = '$XML_DATATEXT' then AResult := GetXMLDataText(AParams)
  else if ACommand = '$XML_LFR' then AResult := GetXML_Lfr(AParams)
  else if ACommand = '$XML_VALEX' then AResult := GetXML_Valex(AParams)



  else result := false;
end;

procedure TBafXmlModule.XmlChange(ANum: integer);
var
  LRoot, LNode: TBafXmlNode;
  LPath, LSep, LValue: string;
begin
  if FindParamBooleanReplaced('cnd', true) then begin
    LPath := FindParamStringReplaced('path', '');
    LSep := FindParamStringReplaced('sep', '.');
    LValue := FindParamStringReplaced('z', '');
    LRoot := GetParsedXml(ANum);
    if LRoot.FindNode(LPath, LSep, LNode) then
      LNode.FValue := LValue;
  end;
end;

procedure TBafXmlModule.XmlGetArrayValues(ANum: integer);
var
  LRoot, LLoop, LLoop2, LCurrentNode: TBafXmlNode;
  LPath, LPfx, LSep, LFnName, LName, LFnValue, LValue, LVar: string;
  i, j, ix: integer;

  procedure lokInit;
  begin
    LRoot := GetParsedXml(ANum);
    LPath := FindParamStringReplaced('path', '');
    LPfx := FindParamStringReplaced('pfx', '');
    LSep := FindParamStringReplaced('sep', '.');
    LFnName := FindParamStringReplaced('name', '!');
    if LFnName = '!' then
      LFnName := 'name';
    LFnValue := FindParamStringReplaced('value', '!');
    if LFnValue = '!' then
      LFnValue := 'value';
  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
        LName := '';
        LValue := '';
        if LLoop.FChilds[i] = LPfx then begin
          LLoop2 := LLoop.FChilds.Objects[i] as TBafXmlNode;
          if LLoop2.FindNode(LFnName, LSep, LCurrentNode) then
            LName := AnsiLowerCase(LCurrentNode.Value);
          if LLoop2.FindNode(LFnValue, LSep, LCurrentNode) then
            LValue := LCurrentNode.Value;
          if LName <> '' then
            FExecInter.SetVarOrValue('f_' + LName, LValue);
//          if LName <> '' then begin
//            LVar := FindParamStringReplacedLower('f_' + LName, '');
//            if LVar <> '' then
//              FExecInter.SetVarOrValue(LVar, LValue);
//          end;
        end;
      end; // for i :=
    end; // if LRoot.FindNode
  end; // if FindParamBooleanReplaced
// procedure TBafXmlModule.XmlGetArrayValues
end;

procedure TBafXmlModule.XmlLoop(ANum: integer);
var
  LRoot, LLoop, LCurrentNode: TBafXmlNode;
  LName, LPath, LPfx, LSep, LEachRow, LBafConName: string;
  ix, i, LMax, LRowCount: integer;
  LEachRowTrans, LNoException: boolean;

  procedure lokInit;
  begin
    LRoot := GetParsedXml(ANum);
    LName := FindParamStringReplaced('n', '');
    LPath := FindParamStringReplaced('path', '');
    LPfx := FindParamStringReplaced('pfx', '');
    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
        if LLoop.FChilds[i] = LPfx then begin
          ix := FLoopNodeList.IndexOf(LName);
          if ix < 0 then
            FLoopNodeList.AddObject(LName, LLoop.FChilds.Objects[i])
          else
            FLoopNodeList.Objects[ix] := LLoop.FChilds.Objects[i];

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

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

procedure TBafXmlModule.XmlLoopData(ALastSeg: TObject;
    AExecInter: TBafCustomInterpreter; ALineP: string);
var
  LRoot, LLoop, LCurrentNode: TBafXmlNode;
  LPath, LPfx, LSep: string;
  i, LDataGridRow: integer;
  LLastSeg: TBafPageSegment;
begin
  LLastSeg := ALastSeg as TBafPageSegment;
  LRoot := GetParsedXml(1);
  LPath := AExecInter.FindParamStringReplaced(ALineP, 'path', '');
  LPfx := AExecInter.FindParamStringReplaced(ALineP, 'pfx', '');
  LSep := AExecInter.FindParamStringReplaced(ALineP, 'sep', '.');
  LDataGridRow := 0;
  if LPath = '' then begin
    LLoop := LRoot;
    for i := 0 to LLoop.FChilds.Count - 1 do begin
      if LLoop.FChilds[i] = LPfx then begin
        LCurrentNode := LLoop.FChilds.Objects[i] as TBafXmlNode;
        FetchGridFields(LCurrentNode, LDataGridRow, -1, -1, true, LSep,
            AExecInter, ALineP, LLastSeg);
      end;
    end;
  end
  else begin
    if LRoot.FindNode(LPath, LSep, LLoop) then begin
      for i := 0 to LLoop.FChilds.Count - 1 do begin
        if LLoop.FChilds[i] = LPfx then begin
          LCurrentNode := LLoop.FChilds.Objects[i] as TBafXmlNode;
          FetchGridFields(LCurrentNode, LDataGridRow, -1, -1, true, LSep,
              AExecInter, ALineP, LLastSeg);
        end;
      end;
    end;
  end; // esle
// procedure TBafXmlModule.XmlLoopData
end;

procedure TBafXmlModule.XmlParse(ANum: integer);
var
  LRoot: TBafXmlNode;
  LXml: string;
begin
  if FindParamBooleanReplaced('cnd', true) then begin
    LRoot := GetParsedXml(ANum);
    LXml := FindParamStringReplaced('xml', '');
    TBafXmlModule.Parse(LRoot, LXml);
  end;
end;

{ TBafXmlNode }

constructor TBafXmlNode.Create(AParent: TBafXmlNode);
begin
  FParent := AParent;
  FChilds := TStringList.Create;
  FChilds.OwnsObjects := true;
  FProperties := TStringList.Create;
  FAdditional := TStringList.Create;
end;

destructor TBafXmlNode.Destroy;
begin
  FreeAndNil(FAdditional);
  FreeAndNil(FChilds);
  FreeAndNil(FProperties);
  inherited;
end;

function TBafXmlNode.FindNode(APath, ASep: string; out ANode: TBafXmlNode): boolean;
var
  ix, p: integer;
  LPathPre, LPathPost, LArray: string;

  function lokSep: boolean;
  var
    i, pa: integer;
    LInArray: boolean;
  begin
    LInArray := false;
    for i := 1 to Length(APath) do begin
      if APath[i] = ASep[1] then begin
        if not LInArray then begin
          p := i;
          Break;
        end;
      end
      else if APath[i] = '[' then begin
        LInArray := true;
        pa := i + 1;
      end
      else if (APath[i] = ']') and LInArray then begin
        LInArray := false;
        LArray := copy(APath, pa, i - pa);
      end
    end; // for i := 1 to Length(APath)
    result := (LArray <> '');

    if p > 0 then begin
      if result then
        LPathPre := copy(APath, 1, pa - 2)
      else
        LPathPre := copy(APath, 1, p - 1);
      LPathPost := copy(APath, p + 1, MaxInt);
    end
    else begin
      if result then
        LPathPre := copy(APath, 1, pa - 2)
      else
        LPathPre := APath;
      LPathPost := '';
    end;
  end; // procedure lokSep

  function lokArray: boolean;
  var
    i, pa: integer;
    LPath, LValue: string;
    LCurrentNode: TBafXmlNode;
  begin
    result := false;
    pa := Pos('=', LArray);
    if pa > 1 then begin
      LPath := copy(LArray, 1, pa - 1);
      LValue := copy(LArray, pa + 1, MaxInt);

      for i := 0 to FChilds.Count - 1 do begin
        if FChilds[i] = LPathPre then begin
          if (FChilds.Objects[i] as TBafXmlNode).FindNode(LPath, ASep, LCurrentNode) then begin
            if AnsiCompareText(LCurrentNode.Value, LValue) = 0 then begin
              if LPathPost = '' then begin
                result := true;
                ANode := (FChilds.Objects[i] as TBafXmlNode);
              end
              else
                result := (FChilds.Objects[i] as TBafXmlNode).FindNode(LPathPost, ASep, ANode);
              Break;
            end;
          end;
        end;
      end; // for i
    end;
  end; // lokArray

begin
  if lokSep then
    result := lokArray
  else begin
    ix := FChilds.IndexOf(LPathPre);
    if ix < 0 then
      result := false
    else if LPathPost = '' then begin
      result := true;
      ANode := (FChilds.Objects[ix] as TBafXmlNode);
    end
    else
      result := (FChilds.Objects[ix] as TBafXmlNode).FindNode(LPathPost, ASep, ANode);
  end;
// function TBafXmlNode.FindNode
end;

function TBafXmlNode.GetJsonText(AMode: TBafXmlMode; ALevel: integer;
    AArrayName: string): string;
var
  i: integer;
  LBreak, LLastArrayName: string;
  LNode0, LNode1: TBafXmlNode;

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

begin
  if Assigned(FParent) then begin
    if (FName = AArrayName) and (AArrayName <> '') then begin
      result := LBreak + '{' + LBreak;
    end
    else if FChilds.Count = 0 then begin
      result := IfThen(FChilds.Count > 0, '{', '');
      lokBreak(-1);
      result := result + LBreak +  '"' + FName + '": "' + FValue + '"'
    end
    else begin
      result := '';
      if ALevel > 1 then
        dec(ALevel);
      inc(ALevel);
      lokBreak(-1);
      result := result + LBreak +  '"' + FName + '": {';
    end;
  end;
  LLastArrayName := '';
  for i := 0 to FChilds.Count - 1 do begin
    LNode0 := FChilds.Objects[i + 0] as TBafXmlNode;
    if i < (FChilds.Count - 1) then begin
      LNode1 := FChilds.Objects[i + 1] as TBafXmlNode;
      if (LNode0.FName = LNode1.FName) and (LLastArrayName = '') then begin
        LLastArrayName := LNode0.FName;
        lokBreak;
        result := result + LBreak + '"' + LLastArrayName + '": [';
        inc(ALevel);
        lokBreak;
        result := result + LBreak;
        result := result + (FChilds.Objects[i] as TBafXmlNode).
            GetJsonText(AMode, ALevel + 1, LLastArrayName) + ',' + LBreak;
      end
      else if (LNode0.FName <> LNode1.FName) and (LLastArrayName = LNode0.FName) then begin
        result := result + (FChilds.Objects[i] as TBafXmlNode).
            GetJsonText(AMode, ALevel + 1, LLastArrayName);
        LLastArrayName := '';
        dec(ALevel);
        lokBreak;
        result := result + LBreak + '],';
      end
      else if (LNode0.FName = LNode1.FName) and (LLastArrayName = LNode0.FName) then begin
        result := result + (FChilds.Objects[i] as TBafXmlNode).
            GetJsonText(AMode, ALevel + 1, LLastArrayName) + ',' + LBreak;
      end
      else begin
        result := result + (FChilds.Objects[i] as TBafXmlNode).
            GetJsonText(AMode, ALevel + 1, LLastArrayName) + ',';
      end;
    end
    else begin
      if (LLastArrayName = LNode0.FName) then begin
        result := result + (FChilds.Objects[i] as TBafXmlNode).
            GetJsonText(AMode, ALevel + 1, LLastArrayName);
        LLastArrayName := '';
        dec(ALevel);
        lokBreak;
        result := result + LBreak + ']';
      end
      else begin
        result := result + (FChilds.Objects[i] as TBafXmlNode).
            GetJsonText(AMode, ALevel + 1, LLastArrayName);
      end;
    end;
  end;
  if Assigned(FParent) then begin
    dec(ALevel);
    lokBreak;
    result := result + IfThen(FChilds.Count > 0, LBreak + '}', '');
  end;
// function TBafXmlNode.GetJsonText
end;

function TBafXmlNode.GetText(AMode: TBafXmlMode; ALevel: integer): string;
var
  i: integer;
  LBreak: string;

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

begin
  result := '';
  for i := 0 to FAdditional.Count - 1 do begin
    result := result + FAdditional[i];
    lokBreak;
  end;
  if Assigned(FParent) then begin
    result := result + '<' + FName;
    for i := 0 to FProperties.Count - 1 do
      result := result + ' ' + FProperties[i];
    if (FValue = '') and (FChilds.Count = 0) then
      result := result + '/>'
    else
      result := result + '>' + FValue;
  end;
  lokBreak;
  for i := 0 to FChilds.Count - 1 do
    result := result + LBreak
        + (FChilds.Objects[i] as TBafXmlNode).GetText(AMode, ALevel + 1);
  if Assigned(FParent) then begin
    if (FValue = '') and (FChilds.Count = 0) then
    else if (FChilds.Count = 0) then
      result := result + '</' + FName + '>'
    else
      result := result + copy(LBreak, 1, Length(LBreak) - 2) + '</' + FName + '>';
  end;
// function TBafXmlNode.GetText
end;

end.
