unit uBafLoadDataThread;

interface

uses
  System.Classes, Winapi.Windows, DB, SysUtils, uBafTypes, uBafPage, dmMain,
  uBafInterpreter, ScHttp, uBafXmlModule, uBafJsonModule, uBafTree;

const BAF_DATASTORE_TIMESTAMP = 'TBafSimpleDataStore_TimeStamp';


type
  TBafLoadDataThreadType = (ttGrid, ttGridList, ttGridXml, ttGridJson,
      ttTree, ttSegGrd, ttSegGrdXml, ttVL, ttGridBulk, ttGridCache);

  TBafSimpleDataStore = class
  private
    FKeyName: string;
    FHoldingSeconds: integer;
  protected
    FKeys: TStringList;
  public
    constructor Create;
    destructor Destroy; override;
    procedure WriteData(AKeyValue, AFieldPrefix: string; AFields: TFields);
    procedure WriteList(AKeyValue, AFieldPrefix, AListSeparator: string;
        ADataSet: TDataSet);
    procedure WriteDataXml(AKeyValue, ASeparator, AFieldPrefix: string; ARootNode: TBafXmlNode);
    procedure WriteDataJson(AKeyValue, ASeparator, AFieldPrefix: string; ARootNode: TBafJsonNode);
    function HasData(AKeyValue: string; var AData: TStringList): boolean;
    function HasCacheData(AGridRow: TBafSgRow; AFilterStatement: TStrings;
        var AData: TStringList): boolean;
    function HasCacheDataSGrid(AGridRow: TBafSgRow; AFilterStatement: TStrings;
        var AData: TStringList): boolean;

    property KeyName: string read FKeyName write FKeyName;
    property HoldingSeconds: integer read FHoldingSeconds write FHoldingSeconds;
  end;

  TBafLoadDataThread = class(TThread)
  private
    FThreadType: TBafLoadDataThreadType;
    FSegment: TBafPageSegment;
    FTree: TBafTree;
    FRootNode: TBafTreeNode;
    FSQL: string;
    FBafConName: string;
    FKeyName: string;
    FKeyValue: string;
    FDoChange: boolean;
    FDoChangeIfNotEmpty: boolean;
    FDataStore: TBafSimpleDataStore;
    FExecutionTime: integer;
    FReadyCommand: string;
    FFieldPrefix: string;
    FFinished: boolean;
    FListSeparator: string;
    FRowNoInsert: boolean;
    FCacheFilterStatement: TStringList;
  private
    FRequestUri: string;
    FReadWriteTimeout: integer;
    FMethod: TScRequestMethod;
    FContentType: string;
    FAccept: string;
    FIgnoreServerCertificate: boolean;
    FRequestEncoding: string;
    FInter: TBafCustomInterpreter;
    FLineP: string;
    FWaitForData: integer;
    FResultEncoding: string;
    FConvertUtf8: boolean;
    FPath: string;
    FPrefix: string;
    FSeparator: string;
    FHoldingSeconds: integer;
    procedure SetFieldPrefix(const Value: string);
    function GetIsTerminated: boolean;
    procedure Data2Grid(AData: TStringList; AGridRow: TBafSgRow);
    procedure Fields2Indizes;
  protected
    FInternDataStore: boolean;
    FParams: TBafParams;
    FConPoolIx: integer;
    FKeyColIx: integer;
    procedure Execute; override;
    procedure ExecuteGrid;
    procedure ExecuteGridBulk;
    procedure ExecuteGridCache;
    procedure ExecuteGridXmlJson;
    procedure ExecuteTree;
    procedure ExecuteVL;
    procedure ExecuteSGrid;
    procedure ExecuteSGridCache;
    procedure GridRefresh;
    procedure TreeRefresh;
  public
    property RequestUri: string read FRequestUri write FRequestUri;
    property ReadWriteTimeout: integer read FReadWriteTimeout write FReadWriteTimeout;
    property Method: TScRequestMethod read FMethod write FMethod;
    property ContentType: string read FContentType write FContentType;
    property Accept: string read FAccept write FAccept;
    property IgnoreServerCertificate: boolean
        read FIgnoreServerCertificate write FIgnoreServerCertificate;
    property RequestEncoding: string read FRequestEncoding write FRequestEncoding;
    property Inter: TBafCustomInterpreter read FInter write FInter;
    property LineP: string read FLineP write FLineP;
    property WaitForData: integer read FWaitForData write FWaitForData;
    property ResultEncoding: string read FResultEncoding write FResultEncoding;
    property ConvertUtf8: boolean read FConvertUtf8 write FConvertUtf8;
    property Path: string read FPath write FPath;
    property Prefix: string read FPrefix write FPrefix;
    property Separator: string read FSeparator write FSeparator;
  public
    constructor Create(CreateSuspended: Boolean); overload;
    destructor Destroy; override;
    function Init: boolean;
    procedure AddCacheFilterStatement(AText: string);
    property ThreadType: TBafLoadDataThreadType read FThreadType write FThreadType;
    property Segment: TBafPageSegment read FSegment write FSegment;
    property Tree: TBafTree read FTree write FTree;
    property RootNode: TBafTreeNode read FRootNode write FRootNode;
    property SQL: string read FSql write FSql;
    property BafConName: string read FBafConName write FBafConName;
    property KeyName: string read FKeyName write FKeyName;
    property KeyValue: string read FKeyValue write FKeyValue;
    property DoChange: boolean read FDoChange write FDoChange;
    property DoChangeIfNotEmpty: boolean read FDoChangeIfNotEmpty write FDoChangeIfNotEmpty;
    property ExecutionTime: integer read FExecutionTime;
    property DataStore: TBafSimpleDataStore read FDataStore write FDataStore;
    property ReadyCommand: string read FReadyCommand write FReadyCommand;
    property FieldPrefix: string read FFieldPrefix write SetFieldPrefix;
    property Finished: boolean read FFinished write FFinished;
    property IsTerminated: boolean read GetIsTerminated;
    property ListSeparator: string read FListSeparator write FListSeparator;
    property RowNoInsert: boolean read FRowNoInsert write FRowNoInsert;
    property HoldingSeconds: integer read FHoldingSeconds write FHoldingSeconds;
  end;

  TBafLoadSegmentThread = class(TThread)
  private
    FThreadType: TBafLoadDataThreadType;
    FSegment: TBafPageSegment;
    FSQL: string;
    FBafConName: string;
    FExecutionTime: integer;
    FMaxRow: integer;
    FInter: TBafCustomInterpreter;
    FReadyCaption: string;
    FReadyCommand: string;
    FLineP: string;
  protected
    FParams: TBafParams;
    FConPoolIx: integer;
    FGridDataRow: integer;
    FErrorMEssage: string;
    procedure Execute; override;
    procedure ExecuteSegGrd;
    procedure ExecuteSegGrdXml;
    procedure GridRefresh;
    procedure FetchGridFields(ADataSet: TDataSet; var ARow: integer;
        AXGridIndex, AXXGridindex: integer; AIncRow: boolean);
    procedure FetchGridCellValue(ADataSet: TDataSet; ACell: TBafSgCell;
        AColumn: TBafSgColumn; ARow: integer);
    procedure ColumnNullValue(ACell: TBafSgCell);
    procedure ErrorMessage;
  public
    constructor Create(CreateSuspended: Boolean); overload;
    procedure Init;
    property ThreadType: TBafLoadDataThreadType read FThreadType write FThreadType;
    property Segment: TBafPageSegment read FSegment write FSegment;
    property SQL: string read FSql write FSql;
    property BafConName: string read FBafConName write FBafConName;
    property ExecutionTime: integer read FExecutionTime;
    property MaxRow: integer read FMaxRow write FMaxRow;
    property Inter: TBafCustomInterpreter read FInter write FInter;
    property ReadyCaption: string read FReadyCaption write FReadyCaption;
    property ReadyCommand: string read FReadyCommand write FReadyCommand;
    property LineP: string read FLineP write FLineP;
  end;

implementation

{ TBafLoadDataThread }

uses foBafDialog, foMain, uBafWebModule;

procedure TBafLoadDataThread.AddCacheFilterStatement(AText: string);
begin
  FCacheFilterStatement.Add(AText);
end;

constructor TBafLoadDataThread.Create(CreateSuspended: Boolean);
begin
  inherited;
  FHoldingSeconds := 10;
  FCacheFilterStatement := TStringList.Create;
end;

procedure TBafLoadDataThread.Data2Grid(AData: TStringList; AGridRow: TBafSgRow);
var
  LCol, ix: integer;
  LGridCol: TBafSgColumn;
begin
  for LCol := 0 to FSegment.Grid.Columns.Count - 1 do begin
    if Terminated then
      exit;
    LGridCol := FSegment.Grid.Columns.Items[LCol];
    // Feld einlesen
    ix := AData.IndexOfName(AnsiLowerCase(LGridCol.CellFieldName));
    if LGridCol.CellDataQuelle = dqThread then begin
      if ix >= 0 then
        AGridRow.Cells[LCol].Text := AData.ValueFromIndex[ix];
      if FRowNoInsert then
        AGridRow.Cells[LCol].Inserted := false;
    end
    else begin
      if (ix >= 0) and (AGridRow.Cells[LCol].Text = '') then
        AGridRow.Cells[LCol].Text := AData.ValueFromIndex[ix];
    end;

    if Terminated then
      exit;
    // Hint einlesen
    if (LGridCol.CellHintFieldName <> '') then begin
      ix := AData.IndexOfName(AnsiLowerCase(LGridCol.CellHintFieldName));
      if ix >= 0 then
        AGridRow.Cells[LCol].Hint := AData.ValueFromIndex[ix];
    end;
  end;
  if FRowNoInsert then
    AGridRow.RowInserted := false;
// procedure TBafLoadDataThread.Data2Grid
end;

destructor TBafLoadDataThread.Destroy;
begin
  FCacheFilterStatement.Free;
  inherited;
end;

procedure TBafLoadDataThread.Execute;
var
  c, t1, t2: int64;
begin
  inherited;
  QueryPerformanceFrequency(c);
  QueryPerformanceCounter(t1);
  if FDataStore = nil then begin
    FDataStore := TBafSimpleDataStore.Create;
    FInternDataStore := true;
    FDataStore.HoldingSeconds := FHoldingSeconds;
  end;
  if FSegment.SegmentType = stSGrid then begin
    case FThreadType of
      ttGrid, ttGridList: ExecuteSGrid;
      ttGridCache: ExecuteSGridCache;
    end;
  end
  else begin
    case FThreadType of
      ttGrid, ttGridList: ExecuteGrid;
      ttGridBulk: ExecuteGridBulk;
      ttGridCache: ExecuteGridCache;
      ttGridXml, ttGridJson: ExecuteGridXmlJson;
      ttTree: ExecuteTree;
      ttVL: ExecuteVL;
    end;
  end;
  if FInternDataStore then
    FreeAndNil(FDataStore);
  QueryPerformanceCounter(t2);
  FExecutionTime := 1000 * (t2 - t1) div c;
  FFinished := true;
end;

procedure TBafLoadDataThread.ExecuteGrid;
var
  LRow, LKeyColIx, i, LConPoolIx: integer;

  LDataSet: TDataSet;
  LGridRow: TBafSgRow;
  LKeyValue: string;
  sl: TStringList;

  procedure lokData2Grid;
  var
    LCol, ix: integer;
    LGridCol: TBafSgColumn;
  begin
    for LCol := 0 to FSegment.Grid.Columns.Count - 1 do begin
      if Terminated then
        exit;
      LGridCol := FSegment.Grid.Columns.Items[LCol];
      // Feld einlesen
      ix := sl.IndexOfName(AnsiLowerCase(LGridCol.CellFieldName));
      if LGridCol.CellDataQuelle = dqThread then begin
        if ix >= 0 then
          LGridRow.Cells[LCol].Text := sl.ValueFromIndex[ix];
        if FRowNoInsert then
          LGridRow.Cells[LCol].Inserted := false;
      end
      else begin
        if (ix >= 0) and (LGridRow.Cells[LCol].Text = '') then
          LGridRow.Cells[LCol].Text := sl.ValueFromIndex[ix];
      end;

      if Terminated then
        exit;
      // Hint einlesen
      if (LGridCol.CellHintFieldName <> '') then begin
        ix := sl.IndexOfName(AnsiLowerCase(LGridCol.CellHintFieldName));
        if ix >= 0 then
          LGridRow.Cells[LCol].Hint := sl.ValueFromIndex[ix];
      end;
    end;
    if FRowNoInsert then
      LGridRow.RowInserted := false;
  end; // procedure lokData2Grid

begin
  for LRow := 0 to FSegment.Grid.RowCount - 1 do begin
    LGridRow := FSegment.Grid.DataRow[LRow];
    LKeyValue := LGridRow.Cells[FKeyColIx].Text;
    if FDataStore.HasData(LKeyValue, sl) then
      lokData2Grid
    else begin
      if FParams.Count > 0 then
        FParams.ParamAsString(0, LKeyValue);
      try
        LDataSet := dataMain.ThreadQueryOpen(FBafConName, FConPoolIx);
      except
        // einfach weitermachen
      end;
      if Terminated then
        Break;
      if not LDataSet.Eof then begin
        case FThreadType of
          ttGrid: FDataStore.WriteData(LKeyValue, FFieldPrefix, LDataSet.Fields);
          ttGridList: FDataStore.WriteList(LKeyValue, FFieldPrefix, FListSeparator, LDataSet);
        end;
        if Terminated then
          Break;
        if FDataStore.HasData(LKeyValue, sl) then
          Data2Grid(sl, LGridRow);
      end; // if not LDataSet.Eof
    end;
    if Terminated then
      Break;
  end;

  dataMain.ThreadQueryClose(FBafConName, FConPoolIx);
  if Terminated then
    exit;
  Synchronize(GridRefresh);
// procedure TBafLoadDataThread.ExecuteGrid
end;

procedure TBafLoadDataThread.ExecuteGridBulk;
var
  LKeyList: TStringList;
  LRow, i: integer;
  LDataSet: TDataSet;

  procedure lokWriteData;
  var
    LCol, ix: integer;
    LGridCol: TBafSgColumn;
    LGridRow: TBafSgRow;
    LKeyValue: string;
    LField: TField;
  begin
    // get the row
    LKeyValue := LDataSet.FieldByName(KeyName).AsString;
    ix := LKeyList.IndexOf(LKeyValue);
    if ix >= 0 then
      LGridRow := FSegment.Grid.Row[rtData, integer(LKeyList.Objects[ix])];

    // looking for columns
    for LCol := 0 to FSegment.Grid.Columns.Count - 1 do begin
      if Terminated then
        exit;
      LGridCol := FSegment.Grid.Columns.Items[LCol];
      // read field
      if (LGridCol.CellDataQuelle = dqThread) or (LGridRow.Cells[LCol].Text = '') then begin
        LField := LDataSet.FindField(LGridCol.CellFieldName);
        if Assigned(LField) then
          LGridRow.Cells[LCol].Text := LField.AsString;
      end;

      if Terminated then
        exit;
      // read hint
      if (LGridCol.CellHintFieldName <> '') then begin
        LField := LDataSet.FindField(LGridCol.CellHintFieldName);
        if Assigned(LField) then
          LGridRow.Cells[LCol].Text := LField.AsString;
      end;
    end; // for LCol := 0 to
    inc(i);
  end; // procedure lokWriteData

begin
  LKeyList := TStringList.Create;
  try
    LKeyList.Sorted := true;
    LKeyList.Duplicates := dupIgnore;
    for LRow := 0 to FSegment.Grid.RowCount - 1 do begin
      if Terminated then
        exit;
      LKeyList.AddObject(FSegment.Grid.Cells[rtData, FKeyColIx, LRow].Text,
          TObject(LRow));
    end;
    LDataSet := dataMain.ThreadQueryOpen(FBafConName, FConPoolIx);
    if Terminated then
      exit;
    i := 0;
    while not LDataSet.Eof do begin
      if Terminated then
        Break;
      try
        lokWriteData;
      except

      end;
      LDataSet.Next;
    end;

  finally
    LKeyList.Free;
  end;

  dataMain.ThreadQueryClose(FBafConName, FConPoolIx);
  if Terminated then
    exit;
  Synchronize(GridRefresh);
// procedure TBafLoadDataThread.ExecuteGridBulk
end;

procedure TBafLoadDataThread.ExecuteGridCache;
var
  LKeyList: TStringList;
  LRow, i: integer;
  LDataSet: TDataSet;
  LGridRow: TBafSgRow;
  sl: TStringList;

begin
  LKeyList := TStringList.Create;
  try
    LDataSet := dataMain.ThreadQueryOpen(FBafConName, FConPoolIx);
    if Terminated then
      exit;
    i := 0;
    while not LDataSet.Eof do begin
      if Terminated then
        Break;
      try
        inc(i);
        FDataStore.WriteData(IntToStr(i), FFieldPrefix, LDataSet.Fields);
      except

      end;
      LDataSet.Next;
    end;

    Fields2Indizes;

    for LRow := 0 to FSegment.Grid.RowCount - 1 do begin
      LGridRow := FSegment.Grid.DataRow[LRow];
//      if FDataStore.HasData('3', sl) then
      if FDataStore.HasCacheData(LGridRow, FCacheFilterStatement, sl) then
        Data2Grid(sl, LGridRow);
    end;

  finally
    LKeyList.Free;
  end;

  dataMain.ThreadQueryClose(FBafConName, FConPoolIx);
  if Terminated then
    exit;
  Synchronize(GridRefresh);
// procedure TBafLoadDataThread.ExecuteGridCache
end;

procedure TBafLoadDataThread.ExecuteGridXmlJson;
var
  LRow, LKeyColIx, i, LConPoolIx, LDataGridRow: integer;
  LResponse: TScHttpWebResponse;
  LRequest: TScHttpWebRequest;
  LGridRow: TBafSgRow;
  LKeyValue, s: string;
  sl: TStringList;
  LBuf: TBytes;
  LError: boolean;

  procedure lokData2Grid;
  var
    LCol, ix: integer;
    LGridCol: TBafSgColumn;
  begin
    for LCol := 0 to FSegment.Grid.Columns.Count - 1 do begin
      if Terminated then
        exit;
      LGridCol := FSegment.Grid.Columns.Items[LCol];
      // Feld einlesen
      if LGridCol.CellDataQuelle = dqThread then begin
        ix := sl.IndexOfName(AnsiLowerCase(LGridCol.CellFieldName));
        if ix >= 0 then
          LGridRow.Cells[LCol].Text := sl.ValueFromIndex[ix];
      end;

      if Terminated then
        exit;
      // Hint einlesen
      if (LGridCol.CellHintFieldName <> '') then begin
        ix := sl.IndexOfName(AnsiLowerCase(LGridCol.CellHintFieldName));
        if ix >= 0 then
          LGridRow.Cells[LCol].Hint := sl.ValueFromIndex[ix];
      end;
      if Terminated then
        exit;
    end;
  end; // procedure lokData2Grid

  procedure lokParams;
  var
    s: string;
  begin
    LRequest.RequestUri := StringReplace(FRequestUri, ':' + FKeyName, LKeyValue, [rfReplaceAll, rfIgnoreCase]);
    LRequest.ReadWriteTimeout := FReadWriteTimeout;
    LRequest.Method := FMethod;
    LRequest.ContentType := FContentType;
    LRequest.Accept := FAccept;

    if FIgnoreServerCertificate then begin
      LRequest.SSLOptions.IgnoreServerCertificateConstraints := true;
      LRequest.SSLOptions.IgnoreServerCertificateInsecurity := true;
      LRequest.SSLOptions.IgnoreServerCertificateValidity := true;
    end;

    if LRequest.Method in [rmPOST, rmPUT] then begin
      s := StringReplace(FSql, ':' + FKeyName, LKeyValue, [rfReplaceAll, rfIgnoreCase]);
      LBuf := BafGetEncoding(FRequestEncoding).GetBytes(s);
      LRequest.ContentLength := Length(LBuf);
      LRequest.WriteBuffer(LBuf);
    end;
  end; // procedure lokParams

  procedure lokResponse;
  var
    Buf: TBytes;
    LCodePage: integer;
  begin
    LError := false;
    s := '';
    LResponse := nil;
    try
      LResponse := LRequest.GetResponse;
    except
      on E:HttpException do begin
        s := E.ServerMessage;
        if s = '' then
          s := E.Message;
        LError := true;
        exit;
      end;
      on E: Exception do begin
        s := E.Message;
        LError := true;
        exit;
      end;
    end;
    if LResponse.WaitForData(FWaitForData) then begin
      if FResultEncoding = 'utf8' then
        s := LResponse.ReadAsString
      else begin
        buf := LResponse.ReadAsBytes;
        s := BafGetEncoding(FResultEncoding).GetString(Buf, 0, Length(Buf));
      end;
    end;
    if FConvertUtf8 then
      s := Utf8ToAnsi(s);
    LResponse.Free;
  end; // procedure lokResponse

  procedure lokParseXml;
  var
    i: integer;
    LRoot, LLoop, LCurrentNode: TBafXmlNode;
  begin
    LRoot := TBafXmlNode.Create(nil);
    try
      TBafXmlModule.Parse(LRoot, s);
      LDataGridRow := 0;
      if LRoot.FindNode(FPath, FSeparator, LLoop) then begin
        for i := 0 to LLoop.Childs.Count - 1 do begin
          if LLoop.Childs[i] = FPrefix then begin
            LCurrentNode := LLoop.Childs.Objects[i] as TBafXmlNode;
            FDataStore.WriteDataXml(LKeyValue, FSeparator, FFieldPrefix, LCurrentNode);
          end;
        end;
      end;

    finally
      LRoot.Free;
    end;
  end; // procedure lokParseXml

  procedure lokParseJson;
  var
    i: integer;
    LRoot, LLoop, LCurrentNode: TBafJsonNode;
  begin
    LRoot := TBafJsonNode.Create(nil);
    try
      TBafJsonModule.Parse(LRoot, s);
      LDataGridRow := 0;
      if FPath = '' then begin
//        for i := 0 to LRoot.Childs.Count - 1 do begin
//          LCurrentNode := LRoot.Childs[i] as TBafJsonNode;
//          FDataStore.WriteDataJson(LKeyValue, FSeparator, LCurrentNode);
//        end;
        FDataStore.WriteDataJson(LKeyValue, FSeparator, FFieldPrefix, LRoot);
      end
      else if LRoot.FindNode(FPath, FSeparator, LLoop) then begin
        for i := 0 to LLoop.Childs.Count - 1 do begin
          LCurrentNode := LLoop.Childs[i] as TBafJsonNode;
          FDataStore.WriteDataJson(LKeyValue, FSeparator, FFieldPrefix, LCurrentNode);
        end;
      end;

    finally
      LRoot.Free;
    end;
  end; // procedure lokParseJson

begin
  if FSegment = nil then
    exit;
  for LRow := 0 to FSegment.Grid.RowCount - 1 do begin
    LGridRow := FSegment.Grid.DataRow[LRow];
    LKeyValue := LGridRow.Cells[FKeyColIx].Text;
    if FDataStore.HasData(LKeyValue, sl) then
      lokData2Grid
    else begin
      LRequest := TScHttpWebRequest.Create(nil);
      try
        lokParams;
        TBafWebModule.BafField2Header(FLineP, LRequest, FInter);
        if Terminated then
          Break;
        lokResponse;
        if Terminated then
          Break;
        case ThreadType of
          ttGridXml: lokParseXml;
          ttGridJson: lokParseJson;
        end;
        if Terminated then
          Break;
      finally
        LRequest.Free;
      end;
      if Terminated then
        Break;
      if FDataStore.HasData(LKeyValue, sl) then
        lokData2Grid;
    end;
    if Terminated then
      Break;
    if FSegment = nil then
      exit;
  end;

  Synchronize(GridRefresh);
// procedure TBafLoadDataThread.ExecuteGridXml;
end;

procedure TBafLoadDataThread.ExecuteSGrid;
var
  LRow, LKeyColIx, i, LConPoolIx: integer;

  LDataSet: TDataSet;
  LGridRow: TBafSgRow;
  LKeyValue: string;
  sl: TStringList;

  procedure lokData2Grid;
  var
    LCol, ix: integer;
    LCell: TBafSgCell;
  begin
    for LCol := 0 to FSegment.Grid.Columns.Count - 1 do begin
      if Terminated then
        exit;
      LCell := FSegment.Grid.Cells[rtData, LCol, LRow];
      ix := sl.IndexOfName(AnsiLowerCase(LCell.DataFieldName));
      // Feld einlesen
      if (LCell.DataQuelle = dqThread) and (ix >= 0) then
        LCell.Text := sl.ValueFromIndex[ix]
      else if (ix >= 0) and (LCell.Text = '') then
        LCell.Text := sl.ValueFromIndex[ix];

      if Terminated then
        exit;
      // Hint einlesen
      if (LCell.DataHintFieldName <> '') then begin
        ix := sl.IndexOfName(AnsiLowerCase(LCell.DataHintFieldName));
        if ix >= 0 then
          LCell.Hint := sl.ValueFromIndex[ix];
      end;
    end;
  end; // procedure lokData2Grid

  function lokGetKeyValue: string;
  var
    LCol: integer;
    LCell: TBafSgCell;
  begin
    result := '';
    for LCol := 0 to FSegment.Grid.Columns.Count - 1 do begin
      LCell := FSegment.Grid.Cells[rtData, LCol, LRow];
      if LCell.DataFieldName = FKeyName then begin
        result := LCell.Text;
        exit;
      end;
    end;
  end; // function lokGetKeyValue

begin
  for LRow := 0 to FSegment.Grid.RowCount - 1 do begin
    LGridRow := FSegment.Grid.DataRow[LRow];
//    LKeyValue := LGridRow.Cells[FKeyColIx].Text;
    LKeyValue := lokGetKeyValue;

    if LKeyValue <> '' then begin
      if FDataStore.HasData(LKeyValue, sl) then
        lokData2Grid
      else begin
        if FParams.Count > 0 then
          FParams.ParamAsString(0, LKeyValue);
        try
          LDataSet := dataMain.ThreadQueryOpen(FBafConName, FConPoolIx);
        except
          // einfach weitermachen
        end;
        if Terminated then
          Break;
        if not LDataSet.Eof then begin
          case FThreadType of
            ttGrid: FDataStore.WriteData(LKeyValue, FFieldPrefix, LDataSet.Fields);
            ttGridList: FDataStore.WriteList(LKeyValue, FFieldPrefix, FListSeparator, LDataSet);
          end;
          if Terminated then
            Break;
          if FDataStore.HasData(LKeyValue, sl) then
            lokData2Grid;
        end; // if not LDataSet.Eof
      end;
      if Terminated then
        Break;
    end; // if LKeyValue <> ''
  end; // for LRow := 0 to FSegment.Grid.RowCount - 1

  dataMain.ThreadQueryClose(FBafConName, FConPoolIx);
  if Terminated then
    exit;
  Synchronize(GridRefresh);
// procedure TBafLoadDataThread.ExecuteSGrid
end;

procedure TBafLoadDataThread.ExecuteSGridCache;
var
  LKeyList: TStringList;
  LRow, i: integer;
  LDataSet: TDataSet;
  LGridRow: TBafSgRow;
  sl: TStringList;

  procedure lokData2Grid;
  var
    LCol, ix: integer;
    LCell: TBafSgCell;
  begin
    for LCol := 0 to FSegment.Grid.Columns.Count - 1 do begin
      if Terminated then
        exit;
      LCell := FSegment.Grid.Cells[rtData, LCol, LRow];
      ix := sl.IndexOfName(AnsiLowerCase(LCell.DataFieldName));
      // Feld einlesen
      if (LCell.DataQuelle = dqThread) and (ix >= 0) then
        LCell.Text := sl.ValueFromIndex[ix]
      else if (ix >= 0) and (LCell.Text = '') then
        LCell.Text := sl.ValueFromIndex[ix];

      if Terminated then
        exit;
      // Hint einlesen
      if (LCell.DataHintFieldName <> '') then begin
        ix := sl.IndexOfName(AnsiLowerCase(LCell.DataHintFieldName));
        if ix >= 0 then
          LCell.Hint := sl.ValueFromIndex[ix];
      end;
    end;
  end; // procedure lokData2Grid

begin
  LKeyList := TStringList.Create;
  try
    LDataSet := dataMain.ThreadQueryOpen(FBafConName, FConPoolIx);
    if Terminated then
      exit;
    i := 0;
    while not LDataSet.Eof do begin
      if Terminated then
        Break;
      try
        inc(i);
        FDataStore.WriteData(IntToStr(i), FFieldPrefix, LDataSet.Fields);
      except

      end;
      LDataSet.Next;
    end;

    for LRow := 0 to FSegment.Grid.RowCount - 1 do begin
      LGridRow := FSegment.Grid.DataRow[LRow];
      if FDataStore.HasCacheDataSGrid(LGridRow, FCacheFilterStatement, sl) then
        lokData2Grid;
    end;

  finally
    LKeyList.Free;
  end;

  dataMain.ThreadQueryClose(FBafConName, FConPoolIx);
  if Terminated then
    exit;
  Synchronize(GridRefresh);
// procedure TBafLoadDataThread.ExecuteSGridCache
end;

procedure TBafLoadDataThread.ExecuteTree;
var
  LParams: TBafParams;
  LDataSet: TDataSet;

  procedure lokNode(ARoot: TBafTreeNode);
  var
    i: integer;
    LNode: TBafTreeNode;
    LKeyValue: string;
    sl: TStringList;

    procedure lokData2Ini;
    var
      LDataName: string;
    begin
      LDataName := LNode.Ini.ReadString(SEC_ADD, 'c1', '');
      if (LDataName <> '')
          and (LNode.Ini.ReadString(SEC_DATA, LDataName, '') = LDataName) then begin
        LNode.Ini.WriteString(SEC_DATA, LDataName, sl.Values[LDataName]);
        LNode.Ini.WriteString(SEC_DB, LDataName, sl.Values[LDataName]);
      end;
      LDataName := LNode.Ini.ReadString(SEC_ADD, 'c2', '');
      if (LDataName <> '')
          and (LNode.Ini.ReadString(SEC_DATA, LDataName, '') = LDataName) then begin
        LNode.Ini.WriteString(SEC_DATA, LDataName, sl.Values[LDataName]);
        LNode.Ini.WriteString(SEC_DB, LDataName, sl.Values[LDataName]);
      end;
      LNode.Text := LNode.GetCaption;
    end; // procedure lokData2Ini

  begin
    for i := 0 to ARoot.ChildCount - 1 do begin
      if Terminated then
        exit;
      LNode := ARoot.Childs[i];
      LKeyValue := LNode.Ini.ReadString(SEC_DATA, FKeyName, '');
      if LKeyValue <> '' then begin
        if FDataStore.HasData(LKeyValue, sl) then
          lokData2Ini
        else begin
          if LParams.Count > 0 then
            LParams.ParamAsString(0, LKeyValue);
          LDataSet := dataMain.ThreadQueryOpen(FBafConName, FConPoolIx);
          if Terminated then
            exit;
          FDataStore.WriteData(LKeyValue, FFieldPrefix, LDataSet.Fields);
          if FDataStore.HasData(LKeyValue, sl) then
            lokData2Ini;
        end;
      end;
      if LNode.ChildCount > 0 then
        lokNode(LNode);
    end;
  end; // procedure lokNode

begin
  LParams := dataMain.ThreadQueryPrepare(FBafConName, FSql, FConPoolIx);
  lokNode(RootNode);
  dataMain.ThreadQueryClose(FBafConName, FConPoolIx);
  Synchronize(TreeRefresh);
// procedure TBafLoadDataThread.ExecuteTree
end;

procedure TBafLoadDataThread.ExecuteVL;
var
  LDataSet: TDataSet;

  procedure lokData2Grid;
  var
    LRow, LCol, ix: integer;
    LCell: TBafSgCell;
    LField: TField;
    LValue: string;
  begin
    for LRow := 0 to FSegment.Grid.RowCount - 1 do begin
      for LCol := 0 to FSegment.Grid.Columns.Count - 1 do begin
        if Terminated then
          exit;
        LCell := FSegment.Grid.Cells[rtData, LCol, LRow];

        // Zelle einlesen
        LField := nil;
        if LCell.DataFieldName <> '' then
          LField := LDataSet.FindField(LCell.DataFieldName);
        if Assigned(LField) then begin
          case LCell.CellType of
            ctDateMin: LValue := FormatDateTime('dd.mm.yyyy hh:mm', LField.AsDateTime);
            ctDateSek: LValue := FormatDateTime('dd.mm.yyyy hh:mm:ss', LField.AsDateTime);
          else
            LValue := LField.AsString;
          end;
          if FDoChange then
            LCell.SetTextChange(LValue)
          else if FDoChangeIfNotEmpty and (LValue <> '') then
            LCell.SetTextChange(LValue)
          else
            LCell.Text := LValue;
        end;
        if Terminated then
          exit;

        // Hint einlesen
        LField := nil;
        if LCell.DataHintFieldName <> '' then
          LField := LDataSet.FindField(LCell.DataHintFieldName);
        if Assigned(LField) then
          LCell.Hint :=  LField.AsString;
      end;
    end;
  end; // procedure lokData2Grid

begin
  FParams := dataMain.ThreadQueryPrepare(FBafConName, FSql, FConPoolIx);
  if FParams.Count > 0 then
    FParams.ParamAsString(0, FKeyValue);
  try
    LDataSet := dataMain.ThreadQueryOpen(FBafConName, FConPoolIx);
    if not LDataSet.Eof then
      lokData2Grid;
  except
    // einfach weitermachen
  end;
  dataMain.ThreadQueryClose(FBafConName, FConPoolIx);
  Synchronize(GridRefresh);
// procedure TBafLoadDataThread.ExecuteVL
end;

procedure TBafLoadDataThread.Fields2Indizes;
var
  i: integer;
  sl: TStringList;
begin
  sl := TStringList.Create;
  try
    for i := 0 to FCacheFilterStatement.Count - 1 do begin
      sl.DelimitedText := FCacheFilterStatement[i];
      if (sl[0] = 'eq')or (sl[0] = 'eqic') then begin
        sl[1] := IntToStr(FSegment.Grid.Columns.FieldName2Ix(sl[1]));
      end
      else if sl[0] = 'date_gdd' then begin
        sl[1] := IntToStr(FSegment.Grid.Columns.FieldName2Ix(sl[1]));
      end
      else if sl[0] = 'date_ggd' then begin
        sl[1] := IntToStr(FSegment.Grid.Columns.FieldName2Ix(sl[1]));
        sl[2] := IntToStr(FSegment.Grid.Columns.FieldName2Ix(sl[2]));
      end
      else if sl[0] = 'date_ggdd' then begin
        sl[1] := IntToStr(FSegment.Grid.Columns.FieldName2Ix(sl[1]));
        sl[2] := IntToStr(FSegment.Grid.Columns.FieldName2Ix(sl[2]));
      end;

      FCacheFilterStatement[i] := sl.DelimitedText;
    end;
  finally
    sl.Free;
  end;
end;

function TBafLoadDataThread.GetIsTerminated: boolean;
begin
  result := Terminated;
end;

procedure TBafLoadDataThread.GridRefresh;
begin
  FSegment.Grid.Repaint;
end;

function TBafLoadDataThread.Init: boolean;
begin
  if FSegment = nil then
    exit;
  if FThreadType in [ttGridCache] then
    result := true
  else if FSegment.SegmentType = stSGrid then
    result := true
  else begin
    FKeyColIx := FSegment.Grid.Columns.FieldName2Ix(KeyName);
    result := not ((FKeyColIx = -1) or (Trim(KeyName) = ''));
  end;

  if result and (FThreadType in [ttGrid, ttGridList, ttGridBulk, ttGridCache]) then
    FParams := dataMain.ThreadQueryPrepare(FBafConName, FSql, FConPoolIx);
end;

procedure TBafLoadDataThread.SetFieldPrefix(const Value: string);
begin
  FFieldPrefix := AnsiLowerCase(Value);
end;

procedure TBafLoadDataThread.TreeRefresh;
begin
  FTree.Repaint;
end;

{ TBafSimpleDataStore }

constructor TBafSimpleDataStore.Create;
begin
  inherited;
  FKeys := TStringList.Create;
  FKeys.Sorted := true;
  FKeys.Duplicates := dupIgnore;
  FKeys.OwnsObjects := true;
end;

destructor TBafSimpleDataStore.Destroy;
begin
  FKeys.Free;
  inherited;
end;

function TBafSimpleDataStore.HasCacheData(AGridRow: TBafSgRow;
  AFilterStatement: TStrings; var AData: TStringList): boolean;
var
  i: integer;
  sl: TStringList;

  function lokCheckFilter: boolean;
  var
    LFilter: integer;
    LValue1, LValue2: string;
    LDate1, LDate2, LDate3, LDate4: TDateTime;
  begin
    result := true;
    for LFilter := 0 to AFilterStatement.Count - 1 do begin
      sl.DelimitedText := AFilterStatement[LFilter];
      if sl[0] = 'eq' then begin
        LValue1 := AGridRow.Cells[StrToInt(sl[1])].Text;
        LValue2 := AData.Values[sl[2]];
        if AnsiCompareStr(LValue1, LValue2) <> 0 then begin
          result := false;
          Break;
        end;
      end
      else if sl[0] = 'eqic' then begin
        LValue1 := AGridRow.Cells[StrToInt(sl[1])].Text;
        LValue2 := AData.Values[sl[2]];
        if AnsiCompareText(LValue1, LValue2) <> 0 then begin
          result := false;
          Break;
        end;
      end
      else if sl[0] = 'date_gdd' then begin
        LDate1 := StrToDateTime(AGridRow.Cells[StrToInt(sl[1])].Text);
        LDate3 := StrToDateTime(AData.Values[sl[2]]);
        LDate4 := StrToDateTime(AData.Values[sl[3]]);
        if (LDate1 > LDate4) or (LDate1 < LDate3) then begin
          result := false;
          Break;
        end;
      end
      else if sl[0] = 'date_ggd' then begin
        LDate1 := StrToDateTime(AGridRow.Cells[StrToInt(sl[1])].Text);
        LDate2 := StrToDateTime(AGridRow.Cells[StrToInt(sl[2])].Text);
        LDate3 := StrToDateTime(AData.Values[sl[3]]);
        if (LDate3 > LDate2) or (LDate3 < LDate1) then begin
          result := false;
          Break;
        end;
      end
      else if sl[0] = 'date_ggdd' then begin
        LDate1 := StrToDateTime(AGridRow.Cells[StrToInt(sl[1])].Text);
        LDate2 := StrToDateTime(AGridRow.Cells[StrToInt(sl[2])].Text);
        LDate3 := StrToDateTime(AData.Values[sl[3]]);
        LDate4 := StrToDateTime(AData.Values[sl[4]]);
        if (LDate1 > LDate4) or (LDate2 < LDate3) then begin
          result := false;
          Break;
        end;
      end

    end;
  end; // function lokCheckFilter

begin
  result := false;
  sl := TStringList.Create;
  try
    for i := 0 to FKeys.Count - 1 do begin
      AData := FKeys.Objects[i] as TStringList;
      try
        if lokCheckFilter then begin
          result := true;
          Break;
        end;
      except

      end;
    end;
    if not result then
      AData := nil;
  finally
    sl.Free;
  end;
// function TBafSimpleDataStore.HasCacheData
end;

function TBafSimpleDataStore.HasCacheDataSGrid(AGridRow: TBafSgRow;
  AFilterStatement: TStrings; var AData: TStringList): boolean;
var
  i: integer;
  sl: TStringList;

  function lokGridValue(AFieldName: string): string;
  var
    LCol: integer;
    LCell: TBafSgCell;
  begin
    result := '';
    for LCol := 0 to AGridRow.Parents.Columns.Count - 1 do begin
      LCell := AGridRow.Cells[LCol];
      if LCell.DataFieldName = AFieldName then begin
        result := LCell.Text;
        exit;
      end;
    end;
  end; // function lokGridValue(AFieldName)

  function lokCheckFilter: boolean;
  var
    LFilter: integer;
    LValue1, LValue2: string;
    LDate1, LDate2, LDate3, LDate4: TDateTime;
  begin
    result := true;
    for LFilter := 0 to AFilterStatement.Count - 1 do begin
      sl.DelimitedText := AFilterStatement[LFilter];
      if sl[0] = 'eq' then begin
        LValue1 := lokGridValue(sl[1]);
        LValue2 := AData.Values[sl[2]];
        if AnsiCompareStr(LValue1, LValue2) <> 0 then begin
          result := false;
          Break;
        end;
      end
      else if sl[0] = 'eqic' then begin
        LValue1 := lokGridValue(sl[1]);
        LValue2 := AData.Values[sl[2]];
        if AnsiCompareText(LValue1, LValue2) <> 0 then begin
          result := false;
          Break;
        end;
      end
      else if sl[0] = 'date_gdd' then begin
        LDate1 := StrToDateTime(lokGridValue(sl[1]));
        LDate3 := StrToDateTime(AData.Values[sl[2]]);
        LDate4 := StrToDateTime(AData.Values[sl[3]]);
        if (LDate1 > LDate4) or (LDate1 < LDate3) then begin
          result := false;
          Break;
        end;
      end
      else if sl[0] = 'date_ggd' then begin
        LDate1 := StrToDateTime(lokGridValue(sl[1]));
        LDate2 := StrToDateTime(lokGridValue(sl[2]));
        LDate3 := StrToDateTime(AData.Values[sl[3]]);
        if (LDate3 > LDate2) or (LDate3 < LDate1) then begin
          result := false;
          Break;
        end;
      end
      else if sl[0] = 'date_ggdd' then begin
        LDate1 := StrToDateTime(lokGridValue(sl[1]));
        LDate2 := StrToDateTime(lokGridValue(sl[2]));
        LDate3 := StrToDateTime(AData.Values[sl[3]]);
        LDate4 := StrToDateTime(AData.Values[sl[4]]);
        if (LDate1 > LDate4) or (LDate2 < LDate3) then begin
          result := false;
          Break;
        end;
      end

    end;
  end; // function lokCheckFilter

begin
  result := false;
  sl := TStringList.Create;
  try
    for i := 0 to FKeys.Count - 1 do begin
      AData := FKeys.Objects[i] as TStringList;
      try
        if lokCheckFilter then begin
          result := true;
          Break;
        end;
      except

      end;
    end;
    if not result then
      AData := nil;
  finally
    sl.Free;
  end;
// function TBafSimpleDataStore.HasCacheDataSGrid
end;

function TBafSimpleDataStore.HasData(AKeyValue: string; var AData: TStringList): boolean;
var
  ix: integer;
  LTime: TDateTime;
begin
  ix := FKeys.IndexOf(AKeyValue);
  if ix = -1 then
    result := false
  else begin
    AData := FKeys.Objects[ix] as TStringList;
    if FHoldingSeconds = 0 then
      result := true
    else begin
      LTime := StrToDateTimeDef(AData.Values[BAF_DATASTORE_TIMESTAMP], 0);
      if LTime > (now - (FHoldingSeconds / 24 * 3600)) then
        result := true
      else begin
        AData.Delete(ix);
        result := false;
        AData := nil;
      end;
    end;
  end;
end;

procedure TBafSimpleDataStore.WriteData(AKeyValue, AFieldPrefix: string; AFields: TFields);
var
  sl: TStringList;
  i: integer;
  LField: TField;
begin
  sl := TStringList.Create;
  sl.Values[BAF_DATASTORE_TIMESTAMP] := FormatDateTime('dd.mm.yyyy hh:mm:ss', now);
  for i := 0 to AFields.Count - 1 do begin
    LField := AFields[i];
    sl.Values[AFieldPrefix + AnsiLowerCase(LField.FieldName)] := LField.AsString;
  end;
  FKeys.AddObject(AKeyValue, sl);
end;

procedure TBafSimpleDataStore.WriteDataJson(AKeyValue, ASeparator, AFieldPrefix: string;
  ARootNode: TBafJsonNode);
var
  sl: TStringList;
  LField: TField;

  procedure lokAddNode(ANode: TBafJsonNode; APrefix: string);
  var
    i: integer;
    LNode: TBafJsonNode;
    s: string;
  begin
    for i := 0 to ANode.Childs.Count - 1 do begin
      LNode := (ANode.Childs[i] as TBafJsonNode);
      s := AnsiLowerCase(LNode.Name);
      sl.Values[AFieldPrefix + APrefix + s] := LNode.GetValueText;
      if LNode.NodeType = jtObject then
        lokAddNode(LNode, s + ASeparator);
    end;
  end; // procedure lokAddNode

begin
  sl := TStringList.Create;
  sl.Values[BAF_DATASTORE_TIMESTAMP] := FormatDateTime('dd.mm.yyyy hh:mm:ss', now);
  lokAddNode(ARootNode, '');
  FKeys.AddObject(AKeyValue, sl);
// procedure TBafSimpleDataStore.WriteDataJson
end;

procedure TBafSimpleDataStore.WriteDataXml(AKeyValue, ASeparator, AFieldPrefix: string;
    ARootNode: TBafXmlNode);
var
  sl: TStringList;
  LField: TField;

  procedure lokAddNode(ANode: TBafXmlNode; APrefix: string);
  var
    i: integer;
    LNode: TBafXmlNode;
    s: string;
  begin
    for i := 0 to ANode.Childs.Count - 1 do begin
      LNode := (ANode.Childs.Objects[i] as TBafXmlNode);
      s := AnsiLowerCase(LNode.Name);
      sl.Values[AFieldPrefix + APrefix + s] := LNode.Value;
      lokAddNode(LNode, s + ASeparator);
    end;
    if ANode.Childs.Count = 0 then begin
      sl.Values[AnsiLowerCase(ANode.Name)] := ANode.Value;
      lokAddNode(LNode, s + ASeparator);
    end;
  end; // procedure lokAddNode

begin
  sl := TStringList.Create;
  sl.Values[BAF_DATASTORE_TIMESTAMP] := FormatDateTime('dd.mm.yyyy hh:mm:ss', now);
  lokAddNode(ARootNode, '');
  FKeys.AddObject(AKeyValue, sl);
end;

procedure TBafSimpleDataStore.WriteList(AKeyValue, AFieldPrefix,
  AListSeparator: string; ADataSet: TDataSet);
var
  sl: TStringList;
  i: integer;
  LField: TField;
  LValue: string;
begin
  sl := TStringList.Create;
  sl.Values[BAF_DATASTORE_TIMESTAMP] := FormatDateTime('dd.mm.yyyy hh:mm:ss', now);
  for i := 0 to ADataSet.Fields.Count - 1 do begin
    ADataSet.First;
    LValue := '';
    while not ADataSet.Eof do begin
      LField := ADataSet.Fields[i];
      if LValue <> '' then
        LValue := LValue + AListSeparator;
      LValue := LValue + LField.AsString;
      ADataSet.Next;
    end;
    sl.Values[AFieldPrefix + AnsiLowerCase(LField.FieldName)] := LValue;
  end;
  FKeys.AddObject(AKeyValue, sl);
end;

{ TBafLoadSegmentThread }

procedure TBafLoadSegmentThread.ColumnNullValue(ACell: TBafSgCell);
var
  LColumn: TBafSgColumn;
begin
  if ACell.Text = '' then begin
    LColumn := ACell.Parents.Column;
    case LColumn.CellNullValueAction of
      nvValue: ACell.Text := FInter.Inter.ReplaceFunctions(LColumn.CellNullValue);
      nvInsert: begin
        ACell.Text := FInter.Inter.ReplaceFunctions(LColumn.CellNullValue);
        ACell.Parents.Row.RowInserted := true;
        ACell.Inserted := true;
      end;
      nvInsertChange: begin
        ACell.Text := FInter.Inter.ReplaceFunctions(LColumn.CellNullValue);
        ACell.HasChanged := true;
        ACell.Parents.Row.RowInserted := true;
        ACell.Inserted := true;
      end;
      nvChange: begin
        ACell.Text := FInter.Inter.ReplaceFunctions(LColumn.CellNullValue);
        ACell.HasChanged := true;
        ACell.Inserted := true;
      end;
    end;
  end;
end;

constructor TBafLoadSegmentThread.Create(CreateSuspended: Boolean);
begin
  inherited;

end;

procedure TBafLoadSegmentThread.ErrorMessage;
begin
  TfrmBafDialog.ShowMessage('Fehler bei der Thread-Ausführung', FErrorMEssage, frmMain);
end;

procedure TBafLoadSegmentThread.Execute;
var
  c, t1, t2: int64;
begin
  inherited;
  QueryPerformanceFrequency(c);
  QueryPerformanceCounter(t1);
  case FThreadType of
    ttSegGrd: ExecuteSegGrd;
    ttSegGrdXml: ExecuteSegGrdXml;
  end;
  QueryPerformanceCounter(t2);
  FExecutionTime := 1000 * (t2 - t1) div c;
end;

procedure TBafLoadSegmentThread.ExecuteSegGrd;
var
  LDataset: TDataset;
begin
  LDataset := dataMain.ThreadQueryOpen(FBafConName, FConPoolIx);
  try
    while not LDataset.Eof do begin
      FetchGridFields(LDataSet, FGridDataRow, -1, -1, true);
      if FGridDataRow >= FMaxRow then
        Break;
      LDataset.Next;
    end;
  except
    on E: Exception do begin
      FErrorMEssage := E.Message;
      Synchronize(ErrorMessage);
    end;
  end;
  dataMain.ThreadQueryClose(FBafConName, FConPoolIx);
  Synchronize(GridRefresh);
end;

procedure TBafLoadSegmentThread.ExecuteSegGrdXml;
var
  LResponse: TScHttpWebResponse;
  LRequest: TScHttpWebRequest;
  s, t, LResp, LEncReq, LEncRes, LPath, LPfx, LSep: string;
  LBuf: TBytes;
  LNum, LDataGridRow: integer;
  LError: boolean;
  LRoot, LLoop, LCurrentNode: TBafXmlNode;

  procedure lokParams;
  begin
    LRequest.RequestUri := FInter.FindParamStringReplaced(FLineP, 'url', '');
    LRequest.ReadWriteTimeout := FInter.FindParamIntegerReplaced(FLineP, 'to', 15);
    s := AnsiLowerCase(FInter.FindParamStringReplaced(FLineP, 'y', ''));
    LRequest.Method := TBafWebModule.GetRequestMethode(s);
    LRequest.ContentType := FInter.FindParamStringReplaced(FLineP, 'cy', '');
    LRequest.Accept := FInter.FindParamStringReplaced(FLineP, 'acc', '');

    if FInter.FindParamBooleanReplaced(FLineP, 'isc', false) then begin
      LRequest.SSLOptions.IgnoreServerCertificateConstraints := true;
      LRequest.SSLOptions.IgnoreServerCertificateInsecurity := true;
      LRequest.SSLOptions.IgnoreServerCertificateValidity := true;
    end;

    if LRequest.Method in [rmPOST, rmPUT] then begin
      LEncReq := FInter.FindParamStringReplaced(FLineP, 'e_req', 'utf8');
      LBuf := BafGetEncoding(LEncReq).GetBytes(FSql);
      LRequest.ContentLength := Length(LBuf);
      LRequest.WriteBuffer(LBuf);
    end;
  end; // lokParams

  procedure lokResponse;
  var
    Buf: TBytes;
    LCodePage: integer;
  begin
    LError := false;
    s := '';
    LResponse := nil;
    try
      LResponse := LRequest.GetResponse;
    except
      on E:HttpException do begin
        s := E.ServerMessage;
        if s = '' then
          s := E.Message;
        LError := true;
        exit;
      end;
      on E: Exception do begin
        s := E.Message;
        LError := true;
        exit;
      end;
    end;
    if LResponse.WaitForData(FInter.FindParamIntegerReplaced(FLineP, 'wait', 1000)) then begin
      LEncRes := FInter.FindParamStringReplaced(FLineP, 'e_res', 'utf8');
      if LEncRes = 'utf8' then
        s := LResponse.ReadAsString
      else begin
        buf := LResponse.ReadAsBytes;
        s := BafGetEncoding(LEncRes).GetString(Buf, 0, Length(Buf));
      end;
    end;
    t := LResponse.ContentEncoding + ' - ' + LResponse.ContentType;
    if FInter.FindParamBooleanReplaced(FLineP, 'cu8', false) then
      s := Utf8ToAnsi(s);
    LResponse.Free;
  end; // procedure lokResponse

  procedure lokParse;
  var
    i: integer;
  begin
    LRoot := TBafXmlNode.Create(nil);
    try
      TBafXmlModule.Parse(LRoot, s);
      LPath := FInter.FindParamStringReplaced(FLineP, 'path', '');
      LPfx := FInter.FindParamStringReplaced(FLineP, 'pfx', '');
      LSep := FInter.FindParamStringReplaced(FLineP, 'sep', '.');
      LDataGridRow := 0;
      if LRoot.FindNode(LPath, LSep, LLoop) then begin
        for i := 0 to LLoop.Childs.Count - 1 do begin
          if LLoop.Childs[i] = LPfx then begin
            LCurrentNode := LLoop.Childs.Objects[i] as TBafXmlNode;
            TBafXmlModule.FetchGridFields(LCurrentNode, LDataGridRow, -1, -1,
            true, LSep, FInter, FLineP, FSegment);
          end;
        end;
      end;

    finally
      LRoot.Free;
    end;
  end; // procedure lokParse

begin
  LRequest := TScHttpWebRequest.Create(nil);
  try
    lokParams;
    TBafWebModule.BafField2Header(FLineP, LRequest, FInter);
    lokResponse;
    lokParse;
//    if LError and FindParamBooleanReplaced('se', true) then
//      TfrmBafDialog.ShowMessage(dataMain.ProgName, s, nil);
  finally
    LRequest.Free;
  end;
// procedure TBafLoadSegmentThread.ExecuteSegGrdXml
end;

procedure TBafLoadSegmentThread.FetchGridCellValue(ADataSet: TDataSet;
  ACell: TBafSgCell; AColumn: TBafSgColumn; ARow: integer);
var
  LFieldName, LValue: string;
  LField: TField;
begin
  LFieldName := AColumn.CellFieldName;
  ACell.CellType := AColumn.CellType;
  if (LFieldName <> '') and (AColumn.CellDataQuelle in [dqSQL, dqY]) then begin
    LField := ADataSet.FindField(LFieldName);
    if Assigned(LField) then begin
      case ACell.CellType of
        ctDateMin: if  LField.AsDateTime < 1 then
            LValue := ''
          else
            LValue := FormatDateTime('dd.mm.yyyy hh:mm', LField.AsDateTime);
        ctDateSek: if  LField.AsDateTime < 1 then
            LValue := ''
          else
            LValue := FormatDateTime('dd.mm.yyyy hh:mm:ss', LField.AsDateTime);
      else
        LValue := LField.AsString;
      end;
      ACell.Text := CellCheckFormat(LValue, AColumn.CellCommand)
    end
    else begin
      if ARow = 0 then
        FInter.Inter.DoLog('E', '#grd_data / #xgrd_data, f "' + LFieldName + '" not found');
    end;
  end
  else if AColumn.CellCommand <> '' then
    ACell.Command := AColumn.CellCommand
  else
    ACell.Text := FInter.ReplaceFunctions(FInter.FindParamString(AColumn.LineP, 'z', ''));
  ColumnNullValue(ACell);
// procedure TBafLoadSegmentThread.FetchGridCellValue
end;

procedure TBafLoadSegmentThread.FetchGridFields(ADataSet: TDataSet;
  var ARow: integer; AXGridIndex, AXXGridindex: integer; AIncRow: boolean);
// Goes through the cells and gets the values from the database
var
  LCol, ix, ixx: integer;
  LColumn: TBafSgColumn;
  LColumns: TBafSgColumns;
  LFieldName: string;
  LField: TField;
  LCell: TBafSgCell;

  procedure lokOther;
  begin
    if LColumn.CellHintFieldName <> '' then begin
      LFieldName := LColumn.CellHintFieldName;
      LField := ADataSet.FindField(LFieldName);
      if Assigned(LField) then
        LCell.Hint := CellCheckFormat(LField.AsString, LColumn.CellCommand)
      else
        LCell.Hint := LFieldName;
    end;
    if LColumn.CellReadOnlyFieldName <> '' then begin
      LFieldName := LColumn.CellReadOnlyFieldName;
      LField := ADataSet.FindField(LFieldName);
      if Assigned(LField) and BafIsYesChar((LField.AsString + BAFYESCHAR)[1]) then   // No data row, then ro=Y
        LCell.ReadOnly := true;
    end;
//    if LColumn.CellType = ctLookupLive then begin
//      LCell.LookupHelper := TBafComboHelper.Create(false);
//      FGridObjectList.Add(LCell.LookupHelper);
//    end;
    if FSegment.DataKey[LColumn.CellDataQIndex] = LColumn.CellFieldName then
      LCell.Parents.Row.DataKeyValue := LCell.Text;
  end; // procedure lokOther

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

procedure TBafLoadSegmentThread.GridRefresh;
begin
  FSegment.Grid.RecalcCells;
  if FReadyCommand <> '' then
    TBafInterpreterLevel.ExecInNewLevel(FReadyCommand, Inter, Inter.Inter);
  FSegment.Parents.Page.Resize;
  if FReadyCaption <> 'D1BB0CD6-48B4-47DA-8371-F51522EB8438' then
    FSegment.Header := FReadyCaption;
end;

procedure TBafLoadSegmentThread.Init;
var
  LParamName, LParamValue: string;
  i: integer;
begin
  FParams := dataMain.ThreadQueryPrepare(FBafConName, FSql, FConPoolIx);
  for i := 0 to FParams.Count - 1 do begin
    LParamName := FParams.GetParamName(i);
    LParamValue := FInter.FindParamString(LParamName, '');
    LParamValue := FInter.ReplaceFunctions(LParamValue);
    FParams.SetValue(i, LParamValue);
  end;
  FInter := FInter.Inter;
end;

end.


