unit uBafTtModule;

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

interface

uses System.Math, System.SysUtils, System.Classes, uBafTypes, uBafInterpreter,
  System.Contnrs, System.StrUtils, System.UiTypes, FMX.Graphics, DB, dmMain,
  FMX.Dialogs, REST.Client, REST.Types, REST.Authenticator.Basic,
  IPPeerCommon, uStringIniFile;

type
  TBafTtModule = class(TBafInterpreterCustomModule)
  protected
    function GetDocFileName(dwVersionID: string): string;
    procedure WdRestUpdate(ACommand, AExCmd: string; ADoLog: boolean);
    procedure WdOpenDoc;
    procedure WdUpdateIndex;
    procedure WdUpdateVectorIndex;
    procedure WdUpdateVectorIndexAddRemove;
    procedure WdUpdateVectorIndexRemoveList;
    function GetDocId(AVersId, ADb: string): string;
  protected
    function GetLdapData(AParams: TStrings): string;
    function GetLdapGuid(AParams: TStrings): string;
    procedure LdapOpen;
    procedure TtRestplätze2;
    procedure TtRestplätze_pg;
    procedure AsdAdrnr;
    procedure SplitStrHnr;
  protected
    function Tournr4To5(AText: string): string;
    function Vtrnr4To5(AText: string): string;
    function NewTournr(AParams: TStrings): string;
    function Adrnr(AText: string): string;
    function Gutschein(AParams: TStrings): string;
    function Gutschein2(AParams: TStrings): string;
    function EaRabatt(AParams: TStrings): string;
    function Soundex(AParams: TStrings): string;
    function SoundexIntern(ADb, AString, ATyp: string; ALength: integer): integer;
  public
    constructor Create; override;
    destructor Destroy; override;
    function InterpretLine(AExecInter: TBafCustomInterpreter): boolean; override;
    function ReplaceFunction(ACommand: string; AParams: TStrings; var AResult: string): boolean; override;
  end;


implementation

{ TBafTtModule }

uses uOsStuff, dmWD, uTtAdd, uTtVerlegCalc, System.Variants, uBafVarModule;

function TBafTtModule.Adrnr(AText: string): string;
begin
  result := 'tt ' + copy(AText, 1, 3) + ' ' + copy(AText, 4, 3)
      + ' ' + copy(AText, 7, 3);
end;

procedure TBafTtModule.AsdAdrnr;
// Ermittelt die Adressnummer, legt ggf. neu an
var
  LBafConName, LAdrnr, LTyp, LSql: string;
  LVorname, LNachname, LStr, LHnr, LPlz, LOrt, LGebdat, LTelefon,
      LEmail, LVorname2, LNachname2, LStrasse2, LHnr2: string;
  LAnrValue, LAg, LUag, LProzSchwelle: integer;
  LMcVorname, LMcNachname, LMcStrasse: integer;
  LDatum: TDateTime;
  LParams: TBafParams;
  LDataSet: TDataSet;

  function lokStringPrep(AString, AType: string): string;
  var
    i: integer;
  begin
    result := '';
    AString := AnsiLowerCase(AString);
    for i := 1 to Length(AString) do begin
      case AString[i] of
        'ä': result := result + 'ae';
        'ö': result := result + 'oe';
        'ü': result := result + 'ue';
        'ß': result := result + 'ss';
        '-', '.', ' ': if AType = 'vn' then
          Break;
        'a'..'z':
          result := result + AString[i];
      end;
    end;
    if AType = 'str' then
      result := StringReplace(result, 'strasse', 'str', []);
  end; // function lokStringPrep

  function lokOnlyNum(AString: string): string;
  var
    i: integer;
  begin
    result := '';
    for i := 1 to Length(AString) do begin
      case AString[i] of
        '0'..'9': result := result + AString[i];
        else
          Break;
      end;
    end;
  end;

  procedure lokParams;
  begin
    LTyp := '';
    LBafConName := FindParamStringReplacedLower('db', DC_DEFAULT);
    LAnrValue := FindParamIntegerReplaced('anrede', 1);
    LVorname := FindParamStringReplaced('vorname', '');
    LNachname := FindParamStringReplaced('nachname', '');
    LNachname := StringReplace(LNachname, LVorname, '', [rfIgnoreCase]);
    LStr := FindParamStringReplaced('strasse', '');
    LHnr := FindParamStringReplaced('hnr', '');
    LPlz := FindParamStringReplaced('plz', '');
    if Length(LPlz) = 4 then
      LPlz := '0' + LPlz;
    LOrt := FindParamStringReplaced('ort', '');
    LGebdat := FindParamStringReplaced('gebdat', '');
    LDatum := StrToDateDef(LGebdat, -1);
    LGebdat := IfThen(LDatum > 0, FormatDateTime('dd.mm.yyyy', LDatum), '');
    LTelefon := FindParamStringReplaced('telefon', '');
    LEmail := FindParamStringReplaced('email', '');
    LAg := FindParamIntegerReplaced('ag', 790);
    LUag := FindParamIntegerReplaced('uag', 742);
    LMcVorname := SoundexIntern(LBafConName, LVorname, 'N', 2);
    LMcNachname := SoundexIntern(LBafConName, LNachname, 'N', 3);
    LMcStrasse := SoundexIntern(LBafConName, LStr, 'N', 3);
    LVorname2 := lokStringPrep(LVorname, 'vn');
    LNachname2 := lokStringPrep(LNachname, '');
    LStrasse2 := lokStringPrep(LStr, 'str');
    LHnr2 := lokOnlyNum(LHnr);
    LProzSchwelle := FindParamIntegerReplaced('proz', 96);
  end; // procedure lokParams

  procedure lokEmail;
//select * from asd
//  where (email = 'beduka@hotmail.de' and nachnamemc = 795  and anrede = 2)
//      or (email = 'beduka@hotmail.de' and gebdatum = '11.12.1969')
//      or (email = 'beduka@hotmail.de' and lpad(plzreg, 2, ''0'') || lpad(plzrest, 3, ''0'') = 22419
//           and strmc = 678 and vornamemc = 84 )
//  order by case when ag in (1, 900) then 1
//    when strmc = 678 and vornamemc = 84 then 2
//    when strmc = 678 then 3
//    when vornamemc = 84 then 4
//    when ag in (999, 998) then 12
//    else 23 end
  begin
    LSql := 'select adrnr from asd '
        + ' where (email = :email and nachnamemc = :nnmc  and anrede = :anrede) '
        + IfThen(Length(LGebdat) = 10, ' or (email = :email and gebdatum = :gebdat) ')
        + ' or (email = :email and lpad(plzreg, 2, ''0'') || lpad(plzrest, 3, ''0'') = :plz '
             + 'and strmc = :strmc and vornamemc = :vnmc) '
        + ' order by case when ag in (1, 900) then 1 '
        + ' when strmc = :strmc and vornamemc = :vnmc then 2 '
        + ' when strmc = :strmc then 3 '
        + ' when vornamemc = :vnmc then 4 '
        + ' when ag in (999, 998) then 12 else 23 end ';
    LParams := dataMain.QueryPrepare(LBafConName, 'asdadrnr', LSql);
    LParams.ParamAsString('email', LEmail);
    LParams.ParamAsInteger('nnmc', LMcNachname);
    LParams.ParamAsInteger('anrede', LAnrValue);
    if Length(LGebdat) = 10 then
      LParams.ParamAsString('gebdat', LGebdat);
    LParams.ParamAsInteger('strmc', LMcStrasse);
    LParams.ParamAsInteger('vnmc', LMcVorname);
    LParams.ParamAsString('plz', LPlz);
    LDataSet := dataMain.QueryOpen(LBafConName, 'asdadrnr');
    if not LDataSet.Eof then begin
      LAdrnr := LDataSet.FieldByName('adrnr').AsString;
      LTyp := 'E';
    end;
  end; // procedure lokEmail

  function lokLevenshtein: single;
  var
    LCompStr: string;
    LProzSum, LProz: single;
    LDist: integer;

    procedure lokEinzeln(AString: string);
    begin
      LDist := (FInter.GetModule('var') as TBafVarModule).BafLevenshtein(AString, LCompStr);
      LProz := 0;
      if LDist > 0 then
        LProz := 200 * LDist / (Length(AString) + Length(LCompStr));
      LProzSum := LProzSum + LProz;
    end;

  begin
    LProzSum := 0;
    LCompStr := lokStringPrep(LDataSet.FieldByName('vorname').AsString, 'vn');
    lokEinzeln(LVorname2);
    LCompStr := lokStringPrep(LDataSet.FieldByName('nachname').AsString, '');
    lokEinzeln(LNachname2);
    LCompStr := lokStringPrep(LDataSet.FieldByName('str').AsString, 'str');
    lokEinzeln(LStrasse2);
    LCompStr := lokOnlyNum(LDataSet.FieldByName('hnr').AsString);
    lokEinzeln(LHnr2);
    result := 100 - (LProzSum / 5);
  end; // function lokLevenshtein

  procedure lokMatchCode;
//select * from asd
//  where lpad(plzreg, 2, ''0'') || lpad(plzrest, 3, ''0'') = 81829 and anrede = 2 and
//    ((nachnamemc = 753 and vornamemc = 96 and strmc = 163)
//    or (nachnamemc = 753 and vornamemc = 96 and gebdatum = '11.12.1969')
//    or (nachnamemc = 753 and gebdatum = '11.12.1969' and strmc = 163)
//    or (gebdatum = '11.12.1969' and vornamemc = 96 and strmc = 163))
  var
    LProz, LProzMax: single;
    LAdrnrMax: integer;
  begin
    LProzMax := 0;
    LSql := 'select * from asd '
        + ' where lpad(plzreg, 2, ''0'') || lpad(plzrest, 3, ''0'') = :plz and anrede = :anrede and '
        + ' ((nachnamemc = :nnmc and vornamemc = :vnmc and strmc = :strmc) '
        + IfThen(Length(LGebdat) <> 10, '',
            ' or (nachnamemc = :nnmc and vornamemc = :vnmc and gebdatum = :gebdat) '
            + ' or (nachnamemc = :nnmc and gebdatum = :gebdat and strmc = :strmc) '
            + ' or (gebdatum = :gebdat and vornamemc = :vnmc and strmc = :strmc) ')
        + ')';
    LParams := dataMain.QueryPrepare(LBafConName, 'asdadrnr', LSql);
    LParams.ParamAsInteger('nnmc', LMcNachname);
    LParams.ParamAsInteger('anrede', LAnrValue);
    if Length(LGebdat) = 10 then
      LParams.ParamAsString('gebdat', LGebdat);
    LParams.ParamAsInteger('strmc', LMcStrasse);
    LParams.ParamAsInteger('vnmc', LMcVorname);
    LParams.ParamAsString('plz', LPlz);
    LDataSet := dataMain.QueryOpen(LBafConName, 'asdadrnr');
    while not LDataSet.Eof do begin
      LProz := lokLevenshtein;
      if LProz > LProzMax then begin
        LProzMax := LProz;
        LAdrnrMax := LDataSet.FieldByName('adrnr').AsInteger;
      end;
      LDataSet.Next;
    end;
    if LProzMax > LProzSchwelle then begin
      LAdrnr := IntToStr(LAdrnrMax);
      LTyp := 'M';
    end;
  end; // procedure lokMatchCode

  procedure lokAnlegen;
  begin
    try
      // Adressnummer anlegen
      LSql := 'call TAVSYDB.NewAdrNr.CreateNextAdrNr(99)';
      LParams := dataMain.QueryPrepare(LBafConName, 'asdadrnr', LSql);
      dataMain.QueryExecute(LBafConName, 'asdadrnr');
      LSql := 'select TAVSYDB.NewAdrNr.GetNextAdrNr as adrnr from dual';
      LParams := dataMain.QueryPrepare(LBafConName, 'asdadrnr', LSql);
      LDataSet := dataMain.QueryOpen(LBafConName, 'asdadrnr');
      if not LDataSet.Eof then
        LAdrnr := LDataSet.FieldByName('adrnr').AsString;

      // noch nicht fertig
    except

    end;
  end; // procedure lokAnlegen

begin
  lokParams;
  if LEmail <> '' then
    lokEmail;
  if LTyp = '' then
    lokMatchCode;

  FExecInter.SetVarOrValue('result', LAdrnr);
  FExecInter.SetVarOrValue('resulttyp', LTyp);
// procedure TBafTtModule.AsdAdrnr
end;

constructor TBafTtModule.Create;
begin
  inherited;

end;

destructor TBafTtModule.Destroy;
begin

  inherited;
end;

function TBafTtModule.EaRabatt(AParams: TStrings): string;
var
  LParams: TBafParams;
  LDataSet: TDataSet;
  LAdrnr, LAktion, LSql, LLfdNr: string;
  LSumme, LAlter, LFahrpreis: currency;
  LCount: integer;

  function lokCalcRabatt: currency;
  begin
    LAlter := LDataSet.FieldByName('pax_alter').AsCurrency;
    LFahrpreis := LDataSet.FieldByName('fahrpreis').AsCurrency;
    if (LAlter < 100) then
      result := LFahrpreis * 0.2
    else if (LAlter < 16) then
      result := LFahrpreis * 0.5
    else if (LAlter < 10) then
      result := LFahrpreis;
  end; // function lokCalcRabatt

begin
  if AParams.Count = 2 then begin
    LAktion := AParams[0];
    LAdrnr := AParams[1];
    LSql := 'select m.lfdnrz, round((b.datum - a.gebdatum) / 365.25, 2) as pax_alter, '
        + 'b.fahrpreis   from mtf m    inner join vasd a on a.adrnr = m.adrnr '
        + 'inner join buf b on b.aktion = m.aktion and b.tournr = m.tournr '
        + 'where m.aktion = ' + LAktion
        + ' and case m.hbucher when 0 then m.adrnr else m.hbucher end = ' + LAdrnr
        + ' order by lfdnrz, pax_alter desc';
    LParams := dataMain.QueryPrepare(dataMain.DefaultCon, 'earabatt', LSql);
    dataMain.QueryExecute(dataMain.DefaultCon, 'earabatt');
    LSumme := 0;
    while not LDataSet.Eof do begin
      if LLfdNr <> LDataSet.FieldByName('lfdnrz').AsString then begin
        LLfdNr := LDataSet.FieldByName('lfdnrz').AsString;
        LCount := 0;
      end;
      inc(LCount);
      if LCount > 2 then          // Zwei Vollzahler pro Zimmer, danach Rabatt
        LSumme := LSumme + lokCalcRabatt;
      LDataSet.Next;
    end;
    result := CurrToStr(LSumme);
  end
  else
    FInter.DoLog('E', '$TT_EARABATT Anzahl der Parameter ungleich 2');
end;

function TBafTtModule.GetDocFileName(dwVersionID: string): string;
var
  LResponse: string;
  p1: integer;

  function lokGetCommand: string;
  begin
    result := '{"Mode": 1, "Entity": 0, "Conditions": [ { "Column": "dwDocID", '
        + '"Value": ' + GetDocId(dwVersionID, 'wd') + ', "SearchOperator": 1, '
//        + '"Value": ' + dwVersionID + ', "SearchOperator": 1, '
        + '"AutoWildcards": true, "SearchRelation": 0, "LeftBrackets": 0, "RightBrackets": 0 } ] }';
  end; // function lokGetCommand


  procedure lokResponse;
  begin
    p1 := Pos('"LocationComplete": "', LResponse);
    if p1 > 0 then begin
      Delete(LResponse, 1, p1 + 20);
      p1 := Pos('"', LResponse);
      if p1 > 0 then begin
        LResponse := copy(LResponse, 1, p1 - 1);
        result := 'M:' + StringReplace(LResponse, '\\', '\', [rfReplaceAll]);
      end;
    end;
  end; // procedure lokResponse

begin
  dataWD.RESTRequest1.ClearBody;
  dataWD.RESTRequest1.Resource := 'windream.web.api/search/Search';
  dataWD.RESTRequest1.AddBody(lokGetCommand, ctAPPLICATION_JSON);
  dataWD.RESTRequest1.Params.Items[0].Options
    :=  dataWD.RESTRequest1.Params.Items[0].Options + [poDoNotEncode];
  dataWD.RESTRequest1.Execute;
  LResponse := dataWD.RESTResponse1.Content;
  p1 := Pos('"HasErrors": false', LResponse);
  if p1 > 0 then
    lokResponse
  else
    FInter.DoLog('E', LResponse);
// function TBafTtModule.GetDocFileName
end;

function TBafTtModule.GetDocId(AVersId, ADb: string): string;
var
  LSql, LName: string;
  LData: TDataSet;
begin
  LSql := 'select dwDocId from BaseAttributes where dwVersionID = ' + AVersId;
  LName := FInter.Name + '~' + ADB;
  dataMain.QueryPrepare(ADB, LName, LSql);
  LData := dataMain.QueryOpen(ADB, LName);
  if not LData.Eof then
    result := LData.Fields[0].AsString
  else
    raise Exception.Create('Dokument ' + AVersId + ' existiert nicht');
end;

function TBafTtModule.GetLdapData(AParams: TStrings): string;
// - Param0 FieldName
begin
  if AParams.Count > 0 then begin
    result := dataWD.ADOQuery1.FieldByName(AParams[0]).AsString;
  end
  else
    FInter.DoLog('E', '$LDAP_DATA Anzahl der Parameter zu gering');
end;

function TBafTtModule.GetLdapGuid(AParams: TStrings): string;
// - Param0 FieldName
var
  j: integer;
  v: Variant;
  ByteGUID: array[0..15] of byte;
begin
  if AParams.Count > 0 then begin
    v := dataWD.ADOQuery1.FieldByName(AParams[0]).AsVariant;
    result := '';
    if VarArrayHighBound(v, 1) >= 15 then
    begin
      for j := 0 to 15 do
        ByteGuid[j] := v[j];
      result := result + GUIDToString(TGUID(ByteGUID));
    end;
  end
  else
    FInter.DoLog('E', '$LDAP_DATA Anzahl der Parameter zu gering');
end;

function TBafTtModule.Gutschein(AParams: TStrings): string;
// Legt einen Gutschein an und gibt die Gutscheinnummer zurück
// - Param0: Adrnr
// - Param1: Prefix
// - Param2: Betrag (ohne Nachkommastellen!!!)
// - Param3: Bemerkung
// - Param4: Gültig ab (now)
// - Param5: DB
var
  LParams: TBafParams;
  LDataSet: TDataSet;
  LGutsch, LSql, LDB: string;
  LYear, LMonth, LDay: Word;
begin
  if AParams.Count > 4 then begin
    if AParams.Count > 5 then
      LDB := AParams[5]
    else
      LDB := 'default';
    if AParams[1] = 'K' then
//select min(t.zahl + 15000 * t2.zahl) as nr   from neuland.stamm_tage t
//  left outer join neuland.stamm_tage t2 on t2.zahl between 1 and 99
//  left outer join mgs m on m.gutschein_code = 'K' and m.gutschein_nr = t.zahl + 15000 * t2.zahl
//  where t.zahl > 100 and m.gutschein_nr is null
      dataMain.QueryPrepare(LDB, 'gutsch', 'select min(t.zahl + 15000 * t2.zahl) as nr   from neuland.stamm_tage t '
         + 'left outer join neuland.stamm_tage t2 on t2.zahl between 1 and 99 '
         + 'left outer join mgs m on m.gutschein_code = ''K'' and m.gutschein_nr = t.zahl  + 15000 * t2.zahl '
         + 'where t.zahl > 100 and m.gutschein_nr is null')
    else
      dataMain.QueryPrepare(LDB, 'gutsch', 'select substr(q.nr, 1, length(q.nr) - 2) + 1 as nr '
          + 'from (select max(gutschein_nr) as nr from mgs where gutschein_code = '
          + QuotedStr(AParams[1] )   + ') q'   );
    LDataSet := dataMain.QueryOpen(LDB, 'gutsch');
    if not LDataSet.Eof then begin
      LGutsch := LDataSet.Fields[0].AsString;
      LSql := 'INSERT INTO mgs (mndtid, adrnr, gutschein_code, gutschein_nr, '
        + 'datum_gueltigbis, refmndtid, bit_pro_person, wert, bemerkung, datum_gueltigab, '
        + 'bit_entwertet) VALUES (1, :adrnr, :prefix, :gutschein_nr, :datum_gueltigbis, 28, '
        + ' ''N'', :wert, :bemerkung, :datum_gueltigab, ''N'')';
      LParams := dataMain.QueryPrepare(LDB, 'gutsch', LSql);
      LParams.ParamAsString('adrnr', AParams[0]);
      LParams.ParamAsString('prefix', AParams[1]);
      DecodeDate(now, LYear, LMonth, LDay);
      if AParams[1] <> 'K' then
        LGutsch := LGutsch + IntToStr(LYear - 2000);
      LParams.ParamAsString('gutschein_nr', LGutsch);
      IncAMonth(LYear, LMonth, LDay, 25);
      LParams.ParamAsDateTime('datum_gueltigbis', EncodeDate(LYear, LMonth, 1) - 1);
      LParams.ParamAsString('wert', AParams[2]);
      LParams.ParamAsString('bemerkung', AParams[3]);
      LParams.ParamAsDateTime('datum_gueltigab', IfThen(AnsiCompareText('now',
          AParams[4]) = 0, trunc(now), StrToDate('27.07.1940')));
      dataMain.QueryExecute(LDB, 'gutsch');
      result := AParams[1] + LGutsch;
    end
    else
      FInter.DoLog('E', '$TT_GUTSCH Sequenz lieferte keinen Wert');
  end
  else
    FInter.DoLog('E', '$TT_GUTSCH Anzahl der Parameter zu gering');

end;

function TBafTtModule.Gutschein2(AParams: TStrings): string;
// Legt einen Gutschein an und gibt die Gutscheinnummer zurück
// - Param0: Adrnr
// - Param1: Prefix
// - Param2: Betrag (ohne Nachkommastellen!!!)
// - Param3: Bemerkung
// - Param4: Gültig ab (now)
// - Param5: Gültig bis
// - Param6: DB
var
  LParams: TBafParams;
  LDataSet: TDataSet;
  LGutsch, LSql, LDB: string;
  LYear, LMonth, LDay: Word;
begin
  if AParams.Count > 5 then begin
    if AParams.Count > 6 then
      LDB := AParams[6]
    else
      LDB := 'default';
    if AParams[1] = 'K' then
//select min(t.zahl + 15000 * t2.zahl) as nr   from neuland.stamm_tage t
//  left outer join neuland.stamm_tage t2 on t2.zahl between 1 and 99
//  left outer join mgs m on m.gutschein_code = 'K' and m.gutschein_nr = t.zahl + 15000 * t2.zahl
//  where t.zahl > 100 and m.gutschein_nr is null
      dataMain.QueryPrepare(LDB, 'gutsch', 'select min(t.zahl + 15000 * t2.zahl) as nr   from neuland.stamm_tage t '
         + 'left outer join neuland.stamm_tage t2 on t2.zahl between 1 and 99 '
         + 'left outer join mgs m on m.gutschein_code = ''K'' and m.gutschein_nr = t.zahl  + 15000 * t2.zahl '
         + 'where t.zahl > 100 and m.gutschein_nr is null')
    else
      dataMain.QueryPrepare(LDB, 'gutsch', 'select max(gutschein_nr) + 1 from '
          + 'mgs where gutschein_code = ' + QuotedStr(AParams[1] ));
    LDataSet := dataMain.QueryOpen(LDB, 'gutsch');
    if not LDataSet.Eof then begin
      LGutsch := LDataSet.Fields[0].AsString;
      LSql := 'INSERT INTO mgs (mndtid, adrnr, gutschein_code, gutschein_nr, '
        + 'datum_gueltigbis, refmndtid, bit_pro_person, wert, bemerkung, datum_gueltigab, '
        + 'bit_entwertet) VALUES (1, :adrnr, :prefix, :gutschein_nr, :datum_gueltigbis, 28, '
        + ' ''N'', :wert, :bemerkung, :datum_gueltigab, ''N'')';
      LParams := dataMain.QueryPrepare(LDB, 'gutsch', LSql);
      LParams.ParamAsString('adrnr', AParams[0]);
      LParams.ParamAsString('prefix', AParams[1]);
      DecodeDate(now, LYear, LMonth, LDay);
      LParams.ParamAsString('gutschein_nr', LGutsch);
      LParams.ParamAsDateTime('datum_gueltigbis', StrToDateDef(AParams[5], now + 365));
      LParams.ParamAsString('wert', AParams[2]);
      LParams.ParamAsString('bemerkung', AParams[3]);
      LParams.ParamAsDateTime('datum_gueltigab', IfThen(AnsiCompareText('now',
          AParams[4]) = 0, trunc(now), StrToDate('27.07.1940')));
      dataMain.QueryExecute(LDB, 'gutsch');
      result := AParams[1] + LGutsch;
    end
    else
      FInter.DoLog('E', '$TT_GUTSCH2 Sequenz lieferte keinen Wert');
  end
  else
    FInter.DoLog('E', '$TT_GUTSCH2 Anzahl der Parameter zu gering');


end;

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

    result := true;
    if FExecInter.LineF = '#tt' then
    else if FExecInter.LineF = '#tt_wd_opendoc' then WdOpenDoc                                   // Öffnet ein Dokument
    else if FExecInter.LineF = '#tt_wd_ux' then WdUpdateIndex                                    // Setzt einen Index
    else if FExecInter.LineF = '#tt_wd_uvx' then WdUpdateVectorIndex                             // Setzt einen Vector-Index
    else if FExecInter.LineF = '#tt_wd_uvx_ar' then WdUpdateVectorIndexAddRemove                 // Fügt einem Vector-Index Werte hinzu oder entfernt sie
    else if FExecInter.LineF = '#tt_wd_uvx_rlist' then WdUpdateVectorIndexRemoveList             // Entfernt bein einem Vector-Index Werte


    else if FExecInter.LineF = '#tt_ks_calc' then TTtKsCalc.Calc
    else if FExecInter.LineF = '#tt_verleg_calc' then TTtVerlegCalc.Calc

    else if FExecInter.LineF = '#tt_ldap_open' then LdapOpen

    else if FExecInter.LineF = '#tt_restplaetze' then TtRestplätze2
    else if FExecInter.LineF = '#tt_restplaetze_pg' then TtRestplätze_pg

    else if FExecInter.LineF = '#tt_asd_adrnr' then AsdAdrnr
    else if FExecInter.LineF = '#tt_splt_strhnr' then SplitStrHnr



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

procedure TBafTtModule.LdapOpen;
var
  LSql, LEachRow: string;
  LMax, LRowCount: integer;
  LNoException: boolean;
begin
  if FindParamBooleanReplaced('cnd', true) then begin
    LMax := FindParamInteger('m', MaxInt);
    LEachRow := FindParamString('ern', '');
    if LEachRow = '' then
      LEachRow := FindParamStringReplaced('er', '');
    LNoException := FindParamBooleanReplaced('nex', false);
    LRowCount := 0;
    LSql := FInter.GetSqlAndClear(1);
    dataWD.ADOQuery1.Close;
    dataWD.ADOQuery1.Sql.Text := LSql;
    dataWD.ADOQuery1.Open;
    while not dataWD.ADOQuery1.Eof do begin
      FExecInter.EachRow('', LEachRow, '#sql_open', false,  LNoException);
      inc(LRowCount);
      if LRowCount >= LMax then begin
        FInter.DoLog('I', Format('#tt_ldap_open, Max (%d) reached, loop aborted', [LMax]));
        Break;
      end;
      if FInter.ProgressAborted then begin
        FInter.DoLog('I', '#tt_ldap_open, loop by user aborted');
        Break;
      end;
      dataWD.ADOQuery1.Next;
    end;
    dataWD.ADOQuery1.Close;
  end;
end;

function TBafTtModule.NewTournr(AParams: TStrings): string;
// Erstellt die nächste freie Tournr
// 0 - Variablenname des Startwerts, wird inkrementiert
// 1 - Aktion
var
  LVarName, LVarValue, LTourNr, LAktion, LSql: string;
  LDataSet: TDataSet;
begin
  LVarName := AParams[0];
  LAktion := AParams[1];
  repeat
    LVarValue := FInter.Variable[LVarName];
    FInter.Variable[LVarName] := IntToStr(StrToIntDef(LVarValue, 0) + 1);
    LTourNr := Tournr4To5(LVarValue);
    LSql := 'select count(*) from buf where aktion = ' + LAktion
       + ' and tournr = ' + LTourNr;
    dataMain.QueryPrepare(dataMain.DefaultCon, 'tournr', LSql);
    LDataSet := dataMain.QueryOpen(dataMain.DefaultCon,'tournr');
  until LDataSet.Fields[0].AsInteger = 0;
  result := LTourNr;
end;

function TBafTtModule.ReplaceFunction(ACommand: string; AParams: TStrings;
  var AResult: string): boolean;
begin
  inherited;
  result := true;
  if ACommand = '$TOURNR4TO5' then AResult := Tournr4To5(AParams[0])
  else if ACommand = '$VTRNR4TO5' then AResult := Vtrnr4To5(AParams[0])
  else if ACommand = '$NEWTOURNR' then AResult := NewTournr(AParams)
  else if ACommand = '$TT_ADRNR' then AResult := Adrnr(AParams[0])
  else if ACommand = '$TT_GUTSCH' then AResult := Gutschein(AParams)
  else if ACommand = '$TT_GUTSCH2' then AResult := Gutschein2(AParams)
  else if ACommand = '$TT_EARABATT' then AResult := EaRabatt(AParams)
  else if ACommand = '$TT_SOUNDEX' then AResult := Soundex(AParams)
  else if ACommand = '$TT_ANSI2UTF8' then AResult := StringReplace(AParams[0], '&', '&amp;', [rfReplaceAll])
  else if ACommand = '$LDAP_DATA' then AResult := GetLdapData(AParams)
  else if ACommand = '$LDAP_GUID' then AResult := GetLdapGuid(AParams)

  else result := false;
end;

function TBafTtModule.Soundex(AParams: TStrings): string;
var
  LTyp, LFunc, LDb, LLaenge: string;
begin
  if AParams.Count > 2 then begin
    LTyp := AnsiUpperCase(AParams[0]) + ' ';
    LLaenge := AnsiUpperCase(AParams[1]);
    case LTyp[1] of
      'O': LFunc := 'O'
    else
      LFunc := 'N';
    end;
    if AParams.Count > 3 then
      LDb := AParams[3]
    else
      LDb := 'default';
    result := IntToStr(SoundexIntern(LDb, AParams[2], LFunc, StrToIntDef(LLaenge, 5)));
  end
  else
    FInter.DoLog('E', '$TT_SOUNDEX Anzahl der Parameter zu gering');
end;

function TBafTtModule.SoundexIntern(ADb, AString, ATyp: string;
    ALength: integer): integer;
var
  LSql: string;
  LDataSet: TDataSet;
begin
  LSql := Format('select superlib.soundex%s(%s, %d) from dual',
      [ATyp, QuotedStr(AString), ALength]);
  dataMain.QueryPrepare(ADb, 'soundex', LSql);
  LDataSet := dataMain.QueryOpen(ADb, 'soundex');
  if not LDataSet.Eof then
    result := LDataSet.Fields[0].AsInteger;
end;

procedure TBafTtModule.SplitStrHnr;
var
  LString, LStr, LHnr: string;
  i: integer;
  LErsteZahl: boolean;
begin
  LString := FindParamStringReplaced('z', '');
  LErsteZahl := false;
  for i := 1 to Length(LString) do begin
    if LString[i] in ['0'..'9'] then
      LErsteZahl := true;
    if LErsteZahl then
      LHnr := LHnr + LString[i]
    else
      LStr := LStr + LString[i];
  end;
  FExecInter.SetVarOrValue('str', Trim(LStr));
  FExecInter.SetVarOrValue('hnr', LHnr);
end;

function TBafTtModule.Tournr4To5(AText: string): string;
// Ergänzt zu einer vierstelligen Tournr die Prüfziffer
var
  i: integer;
  t: string;
begin
  if Length(AText) = 4 then begin
    i := StrToInt(AText[4]) * 2;
    i := i + StrToInt(AText[3]) * 3;
    i := i + StrToInt(AText[2]) * 4;
    i := i + StrToInt(AText[1]) * 5;
    t := IntToStr(11 - (i mod 11));
    result := AText + copy(t, Length(t), 1);
  end
  else
    result := '';
end;

procedure TBafTtModule.TtRestplätze2;

type
  TPlatz = record
    xvs: string[40];
    belegbar: boolean;
    reserviert: boolean;
    id: string[40];
    hasid: boolean;
    anrede: byte;
  end;

  THauptbucher = record
    adrnr: integer;
    anrede: byte;
    anzahl: byte;
  end;

var
  LPax, i, LPaxVerteil, LAdrNr, LAnrede, LHbCnt, LMaxRow, LRowAffected: integer;
  LPlaetze: array[0..17, 1..5] of TPlatz;
  LHauptbucher: array[1..60] of THauptbucher;
  LParam, LXvr, LXvt, LSql, LTyp, LId, LBafConName: string;
  LParams: TParams;
  LDataset: TDataset;
  LIni: TStringIniFile;
  LDebug: boolean;


  procedure lokPlaetze;
  var
    i, LRow, LCol: integer;
  begin
    for LRow := 0 to 17 do
      for LCol := 1 to 5 do
        LPlaetze[LRow, LCol].belegbar := false;

//    FindTreeAndGrid('#open');
    LSql := FInter.GetSqlAndClear(1);
    SqlAndParams(LBafConName, 'restplaetze', LSql);
    LDataset := dataMain.QueryOpen(LBafConName, 'restplaetze');
    while not LDataset.Eof do begin
      LRow := LDataset.FieldByName('reihe').AsInteger;
      case LDataset.FieldByName('spalte').AsString[1] of
        'A': LCol := 1;
        'B': LCol := 2;
        'C': LCol := 4;
        'D': LCol := 5;
        else
          LCol := 3;
      end;
      LPlaetze[LRow, LCol].xvs := LDataset.FieldByName('res_bus_sitz_id').AsString;
      LPlaetze[LRow, LCol].belegbar := (LDataset.FieldByName('status').ASString = 'R')
          or (LDataset.FieldByName('status').ASString = 'W');
      LPlaetze[LRow, LCol].reserviert := (LDataset.FieldByName('aktiv').ASString = 'Y');
      LPlaetze[LRow, LCol].id := Trim(LDataset.FieldByName('id').AsString);
      LPlaetze[LRow, LCol].hasid := (LPlaetze[LRow, LCol].id <> '');
      LPlaetze[LRow, LCol].anrede := 0;
      LXvt := LDataset.FieldByName('res_bus_id').AsString;
      LDataset.Next;
    end;
  end; // procedure lokPlaetze

  function lokFree(ARow, ACol, AAnrede: integer): boolean;
  var
    LCol2: integer;
  begin
    result := LPlaetze[ARow, ACol].belegbar and not LPlaetze[ARow, ACol].reserviert;
    if result and (AAnrede > 0) then begin
      case ACol of
        1: LCol2 := 2;
        2: LCol2 := 1;
        4: LCol2 := 5;
        5: LCol2 := 4;
      end;
      result := (LPlaetze[ARow, LCol2].anrede = AAnrede)
          or (LPlaetze[ARow, LCol2].anrede = 0);
    end;
  end; // function lokFree

  procedure lokXvr;
  begin
    if LXvr = '' then begin
      LXvr := BafGetGuid;
      LIni.Clear;
      LIni.WriteString(SEC_ADD, 't', 'neuland.res_reservierung');
      LIni.WriteString(SEC_ADD, 'k', 'res_reservierung_id');
      LIni.WriteString(SEC_ADD, 'hst', '1');
      LIni.WriteString(SEC_ADD, 'ins', '1');
      LIni.WriteString(SEC_ADD, 'kv', LXvr);
      LIni.WriteString(SEC_DATA, 'res_reservierung_id', LXvr);
      LIni.WriteString(SEC_DATA, 'res_bus_id', LXvt);
      LIni.WriteInteger(SEC_DATA, 'adrnr', LAdrNr);
      LIni.WriteInteger(SEC_DATA, 'preis_gesamt', 0);
      LIni.WriteInteger(SEC_DATA, 'status', 8);
      dataMain.UpsertIni(LIni, LBafConName, 'BS3 - restplaetze', LRowAffected);
    end;
  end; // function lokXvr

  procedure lokBuchen(ARow, ACol, ACol2, AAnrede, AAdrnr: integer);
  begin
    if LPlaetze[ARow, ACol].hasid and (LPlaetze[ARow, ACol].id <> '') then begin
if LDebug then
  FInter.DoLog('O', '8.3a - LXvr: ' + LXvr);
      lokXvr;
if LDebug then
  FInter.DoLog('O', '8.4a - LXvr: ' + LXvr);
      LIni.Clear;
      LIni.WriteString(SEC_ADD, 't', 'neuland.res_sitz2res');
      LIni.WriteString(SEC_ADD, 'k', 'res_sitz2res_id');
      LIni.WriteString(SEC_ADD, 'hst', '1');
      LIni.WriteString(SEC_ADD, 'ins', '0');
      LIni.WriteString(SEC_ADD, 'kv', LPlaetze[ARow, ACol].id);
if LDebug then
  FInter.DoLog('O', '8.6a - LId: ' + LPlaetze[ARow, ACol].id);
    end
    else begin
if LDebug then
  FInter.DoLog('O', '8.3b - LXvr: ' + LXvr);
      lokXvr;
if LDebug then
  FInter.DoLog('O', '8.4b - LXvr: ' + LXvr);
      LIni.Clear;
      LId := BafGetGuid;
      LIni.WriteString(SEC_ADD, 't', 'neuland.res_sitz2res');
      LIni.WriteString(SEC_ADD, 'k', 'res_sitz2res_id');
      LIni.WriteString(SEC_ADD, 'hst', '1');
      LIni.WriteString(SEC_ADD, 'ins', '1');
      LIni.WriteString(SEC_ADD, 'kv', LId);

      LIni.WriteString(SEC_ADD, 'Table', 'neuland.res_sitz2res');
      LIni.WriteString(SEC_ADD, 'Changed', 'I');
      LIni.WriteString(SEC_DATA, 'res_sitz2res_id', LId);
      LIni.WriteString(SEC_DATA, 'res_bus_sitz_id', LPlaetze[ARow, ACol].xvs);
if LDebug then
  FInter.DoLog('O', '8.6b - LId: ' + LId + '  - xvs: ' + LPlaetze[ARow, ACol].xvs);
    end;
    LIni.WriteString(SEC_DATA, 'res_reservierung_id', LXvr);
    LIni.WriteString(SEC_DATA, 'res_bus_id', LXvt);
    LIni.WriteInteger(SEC_DATA, 'preis', 0);
    LIni.WriteString(SEC_DATA, 'aktiv', 'Y');
    dataMain.UpsertIni(LIni, LBafConName, 'BS3 - restplaetze', LRowAffected);
if LDebug then
  FInter.DoLog('O', '8.7 ');
    LPlaetze[ARow, ACol].reserviert := true;
    LPlaetze[ARow, ACol].anrede := AAnrede;

    if ACol2 > 0 then
      lokBuchen(ARow, ACol2, 0, AAnrede, AAdrnr);
  end; // procedure lokBuchen

  function lokBelege_2: boolean;
  var
    LRow: integer;
  begin
    result := false;
    for LRow := 17 downto 1 do begin
      if lokFree(LRow, 1, 0) and lokFree(LRow, 2, 0) then begin
        lokBuchen(LRow, 1, 2, 0, LAdrNr);
        result := true;
        exit;
      end;
      if lokFree(LRow, 4, 0) and lokFree(LRow, 5, 0) then begin
        lokBuchen(LRow, 4, 5, 0, LAdrNr);
        result := true;
        exit;
      end;
    end;
  end; // function lokBelege_2

  function lokBelege_1: boolean;
  var
    LRow, LCol: integer;
  begin
    result := false;
    for LRow := 17 downto 1 do begin
      for LCol := 1 to 5 do begin
        if LCol <> 3 then begin
          if lokFree(LRow, LCol, LAnrede) then begin
if LDebug then
  FInter.DoLog('O', Format('4.1   LXvr: %s   LCol %d   LRow %d   LAnrede %d   LAdrnr %d', [LXvr, LCol, LRow, LAnrede, LAdrnr]));
            lokBuchen(LRow, LCol, 0, LAnrede, LAdrNr);
            result := true;
            exit;
          end;
        end;
      end;
    end;
  end; // function lokBelege_1

  procedure lokBelegen2;
  var
    LRow, LCol: integer;
  begin
    while LPaxVerteil > 0 do begin   // darf eigentlich nur bei Geschlechterungelichverteilung von Einzelzimmern vorkommen
      for LRow := 17 downto 1 do begin   // wir belegen dann ohne Rücksicht auf 45-Grenze und Geschlecht
        for LCol := 1 to 5 do begin
          if lokFree(LRow, LCol, 0) then begin
if LDebug then
  FInter.DoLog('O', Format('6.1   LXvr: %s   LCol %d   LRow $d   LAdrnr %d', [LXvr, LCol, LRow, LAdrnr]));
            lokBuchen(LRow, LCol, 0, 0, LAdrNr);
            exit;
          end;
        end;
      end;
      if LTyp = 'soweit' then begin
if LDebug then
  FInter.DoLog('O', '6.2');
        FInter.DoLog('O', 'Kunde konnte nicht einem Sitzplatz zugewiesen werden');
        if gvInterType = itClient then
          ShowMessage('Kunde konnte nicht einem Sitzplatz zugewiesen werden');
        exit;
      end
      else
        raise exception.Create('Zu wenig reservierbare Plätze');
    end;
  end;

  procedure lokBelegen;
  var
    LRow, LCol, i: integer;
  begin
    for i := 1 to LHbCnt do begin
      LXvr := '';
      LPaxVerteil := LHauptbucher[i].anzahl;
if LDebug then
  FInter.DoLog('O', '5.1 Anzahl:' + IntToStr(LPaxVerteil));
      LAdrNr := LHauptbucher[i].adrnr;
      LAnrede := LHauptbucher[i].anrede;
      while LPaxVerteil > 1 do begin
        if lokBelege_2 then
          LPaxVerteil := LPaxVerteil - 2
        else
          Break;
      end;
if LDebug then
  FInter.DoLog('O', '5.2 Anzahl:' + IntToStr(LPaxVerteil));
      while LPaxVerteil > 0 do begin
        if lokBelege_1 then
          LPaxVerteil := LPaxVerteil - 1
        else
          Break;
if LDebug then
  FInter.DoLog('O', '5.3 Anzahl:' + IntToStr(LPaxVerteil));
      end;
if LDebug then
  FInter.DoLog('O', '5.4 Anzahl:' + IntToStr(LPaxVerteil));
      lokBelegen2;
    end;
  end; // procedure lokBelegen


begin
  LDebug := FindParamBooleanReplaced('dbg', false);
  LPax := FindParamIntegerReplaced(FExecInter.LineP, 'pax', 0);
  LTyp := FindParamStringReplacedLower('y', '');
  LBafConName := FindParamStringReplacedLower('db', DC_DEFAULT);
  lokPlaetze;
  LSql := FInter.GetSqlAndClear(2);
  SqlAndParams(LBafConName, 'restplaetze', LSql);
  LIni := TStringIniFile.Create('');
  try
    dataMain.StartTransaction(LBafConName);
    try
      LHbCnt := 0;
      LDataset := dataMain.QueryOpen(LBafConName, 'restplaetze');
      while not LDataset.Eof do begin
        inc(LHbCnt);
        LHauptbucher[LHbCnt].adrnr := LDataset.FieldByName('adrnr').AsInteger;
        LHauptbucher[LHbCnt].anrede := LDataset.FieldByName('anrede').AsInteger;
        LHauptbucher[LHbCnt].anzahl := System.Math.Max(LDataset.FieldByName('anztn').AsInteger
            - LDataset.FieldByName('anzres').AsInteger, 0);
        LDataset.Next;
      end;
      lokBelegen;
      dataMain.Commit(LBafConName);
    except
      dataMain.Rollback(LBafConName);
      raise;
    end;
    dataMain.QueryClose(LBafConName, 'restplaetze');
  finally
    LIni.Free;
  end;
// procedure TBafTtModule.TtRestplätze2
end;

procedure TBafTtModule.TtRestplätze_pg;

type
  TPlatz = record
    xvs: string[40];
    belegbar: boolean;
    reserviert: boolean;
    id: string[40];
    hasid: boolean;
    anrede: byte;
  end;

  THauptbucher = record
    res_kunde_id: string;
    buchung: integer;
    anrede: byte;
    anzahl: byte;
  end;

var
  i, LPaxVerteil, LPnrNumber, LAnrede, LHbCnt, LMaxRow, LRowAffected: integer;
  LPlaetze: array[0..17, 1..5] of TPlatz;
  LHauptbucher: array[1..60] of THauptbucher;
  LParam, LXvr, LXvt, LSql, LTyp, LId, LBafConName: string;
  LParams: TParams;
  LDataset: TDataset;
  LIni: TStringIniFile;
  LDebug: boolean;


  procedure lokPlaetze;
  var
    i, LRow, LCol: integer;
  begin
    for LRow := 0 to 17 do
      for LCol := 1 to 5 do
        LPlaetze[LRow, LCol].belegbar := false;

    LSql := FInter.GetSqlAndClear(1);
    SqlAndParams(LBafConName, 'restplaetze', LSql);
    LDataset := dataMain.QueryOpen(LBafConName, 'restplaetze');
    while not LDataset.Eof do begin
      LRow := LDataset.FieldByName('reihe').AsInteger;
      case LDataset.FieldByName('spalte').AsString[1] of
        'A': LCol := 1;
        'B': LCol := 2;
        'C': LCol := 4;
        'D': LCol := 5;
        else
          LCol := 3;
      end;
      LPlaetze[LRow, LCol].xvs := LDataset.FieldByName('res_bus_sitz_id').AsString;
      LPlaetze[LRow, LCol].belegbar := (LDataset.FieldByName('status').ASString = 'R')
          or (LDataset.FieldByName('status').ASString = 'W');
      LPlaetze[LRow, LCol].reserviert := (LDataset.FieldByName('aktiv').ASString = 'Y');
      LPlaetze[LRow, LCol].id := Trim(LDataset.FieldByName('id').AsString);
      LPlaetze[LRow, LCol].hasid := (LPlaetze[LRow, LCol].id <> '');
      LPlaetze[LRow, LCol].anrede := 0;
      LXvt := LDataset.FieldByName('res_bus_id').AsString;
      LDataset.Next;
    end;
  end; // procedure lokPlaetze

  function lokFree(ARow, ACol, AAnrede: integer): boolean;
  var
    LCol2: integer;
  begin
    result := LPlaetze[ARow, ACol].belegbar and not LPlaetze[ARow, ACol].reserviert;
    if result and (AAnrede > 0) then begin
      case ACol of
        1: LCol2 := 2;
        2: LCol2 := 1;
        4: LCol2 := 5;
        5: LCol2 := 4;
      end;
      result := (LPlaetze[ARow, LCol2].anrede = AAnrede)
          or (LPlaetze[ARow, LCol2].anrede = 0);
    end;
  end; // function lokFree

  procedure lokXvr;
  begin
    if LXvr <> '' then begin
//      LXvr := BafGetGuid;
      LIni.Clear;
      LIni.WriteString(SEC_ADD, 't', 'res_kunde');
      LIni.WriteString(SEC_ADD, 'k', 'res_kunde_id');
      LIni.WriteString(SEC_ADD, 'hst', '1');
      LIni.WriteString(SEC_ADD, 'ins', '0');
      LIni.WriteString(SEC_ADD, 'kv', LXvr);
      LIni.WriteString(SEC_DATA, 'res_kunde_id', LXvr);
      LIni.WriteString(SEC_DATA, 'res_bus_id', LXvt);
      LIni.WriteInteger(SEC_DATA, 'pnr_number', LPnrNumber);
      LIni.WriteInteger(SEC_DATA, 'preis_gesamt', 0);
      LIni.WriteInteger(SEC_DATA, 'status', 42);
      dataMain.UpsertIni(LIni, LBafConName, 'BS3 - restplaetze', LRowAffected);
    end;
  end; // function lokXvr

  procedure lokBuchen(ARow, ACol, ACol2, AAnrede: integer);
  begin
    if LPlaetze[ARow, ACol].hasid and (LPlaetze[ARow, ACol].id <> '') then begin
if LDebug then
  FInter.DoLog('O', '8.3a - LXvr: ' + LXvr);
      lokXvr;
if LDebug then
  FInter.DoLog('O', '8.4a - LXvr: ' + LXvr);
      LIni.Clear;
      LIni.WriteString(SEC_ADD, 't', 'res_sitz2res');
      LIni.WriteString(SEC_ADD, 'k', 'res_sitz2res_id');
      LIni.WriteString(SEC_ADD, 'hst', '1');
      LIni.WriteString(SEC_ADD, 'ins', '0');
      LIni.WriteString(SEC_ADD, 'kv', LPlaetze[ARow, ACol].id);
if LDebug then
  FInter.DoLog('O', '8.6a - LId: ' + LPlaetze[ARow, ACol].id);
    end
    else begin
//if LDebug then
//  FInter.DoLog('O', '8.3b - LXvr: ' + LXvr);
      lokXvr;
//if LDebug then
//  FInter.DoLog('O', '8.4b - LXvr: ' + LXvr);
      LIni.Clear;
      LId := BafGetGuid;
      LIni.WriteString(SEC_ADD, 't', 'res_sitz2res');
      LIni.WriteString(SEC_ADD, 'k', 'res_sitz2res_id');
      LIni.WriteString(SEC_ADD, 'hst', '1');
      LIni.WriteString(SEC_ADD, 'ins', '1');
      LIni.WriteString(SEC_ADD, 'kv', LId);

      LIni.WriteString(SEC_ADD, 'Table', 'res_sitz2res');
      LIni.WriteString(SEC_ADD, 'Changed', 'I');
      LIni.WriteString(SEC_DATA, 'res_sitz2res_id', LId);
      LIni.WriteString(SEC_DATA, 'res_bus_sitz_id', LPlaetze[ARow, ACol].xvs);
if LDebug then
  FInter.DoLog('O', '8.6b - LId: ' + LId + '  - xvs: ' + LPlaetze[ARow, ACol].xvs);
    end;
    LIni.WriteString(SEC_DATA, 'res_kunde_id', LXvr);
    LIni.WriteString(SEC_DATA, 'res_bus_id', LXvt);
    LIni.WriteInteger(SEC_DATA, 'preis', 0);
    LIni.WriteString(SEC_DATA, 'aktiv', 'Y');
    dataMain.UpsertIni(LIni, LBafConName, 'BS3 - restplaetze', LRowAffected);
if LDebug then
  FInter.DoLog('O', '8.7 ');
    LPlaetze[ARow, ACol].reserviert := true;
    LPlaetze[ARow, ACol].anrede := AAnrede;

    if ACol2 > 0 then
      lokBuchen(ARow, ACol2, 0, AAnrede);
  end; // procedure lokBuchen

  function lokBelege_2: boolean;
  var
    LRow: integer;
  begin
    result := false;
    for LRow := 17 downto 1 do begin
      if lokFree(LRow, 1, 0) and lokFree(LRow, 2, 0) then begin
        lokBuchen(LRow, 1, 2, 0);
        result := true;
        exit;
      end;
      if lokFree(LRow, 4, 0) and lokFree(LRow, 5, 0) then begin
        lokBuchen(LRow, 4, 5, 0);
        result := true;
        exit;
      end;
    end;
  end; // function lokBelege_2

  function lokBelege_1: boolean;
  var
    LRow, LCol: integer;
  begin
    result := false;
    for LRow := 17 downto 1 do begin
      for LCol := 1 to 5 do begin
        if LCol <> 3 then begin
          if lokFree(LRow, LCol, LAnrede) then begin
if LDebug then
  FInter.DoLog('O', Format('4.1   LXvr: %s   LCol %d   LRow %d   LAnrede %d   LPnrNumber %d', [LXvr, LCol, LRow, LAnrede, LPnrNumber]));
            lokBuchen(LRow, LCol, 0, LAnrede);
            result := true;
            exit;
          end;
        end;
      end;
    end;
  end; // function lokBelege_1

  procedure lokBelegen2;
  var
    LRow, LCol: integer;
  begin
    while LPaxVerteil > 0 do begin   // darf eigentlich nur bei Geschlechterungelichverteilung von Einzelzimmern vorkommen
      for LRow := 17 downto 1 do begin   // wir belegen dann ohne Rücksicht auf 45-Grenze und Geschlecht
        for LCol := 1 to 5 do begin
          if lokFree(LRow, LCol, 0) then begin
if LDebug then
  FInter.DoLog('O', Format('6.1   LXvr: %s   LCol %d   LRow $d   LPnrNumber %d', [LXvr, LCol, LRow, LPnrNumber]));
            lokBuchen(LRow, LCol, 0, 0);
            exit;
          end;
        end;
      end;
      if LTyp = 'soweit' then begin
if LDebug then
  FInter.DoLog('O', '6.2');
        FInter.DoLog('O', 'Kunde konnte nicht einem Sitzplatz zugewiesen werden');
        if gvInterType = itClient then
          ShowMessage('Kunde konnte nicht einem Sitzplatz zugewiesen werden');
        exit;
      end
      else
        raise exception.Create('Zu wenig reservierbare Plätze');
    end;
  end;

  procedure lokBelegen;
  var
    LRow, LCol, i: integer;
  begin
    for i := 1 to LHbCnt do begin
      LXvr := LHauptbucher[i].res_kunde_id;
      LPaxVerteil := LHauptbucher[i].anzahl;
if LDebug then
  FInter.DoLog('O', '5.1 Anzahl:' + IntToStr(LPaxVerteil));
      LPnrNumber := LHauptbucher[i].buchung;
      LAnrede := LHauptbucher[i].anrede;
      while LPaxVerteil > 1 do begin
        if lokBelege_2 then
          LPaxVerteil := LPaxVerteil - 2
        else
          Break;
      end;
if LDebug then
  FInter.DoLog('O', '5.2 Anzahl:' + IntToStr(LPaxVerteil));
      while LPaxVerteil > 0 do begin
        if lokBelege_1 then
          LPaxVerteil := LPaxVerteil - 1
        else
          Break;
if LDebug then
  FInter.DoLog('O', '5.3 Anzahl:' + IntToStr(LPaxVerteil));
      end;
if LDebug then
  FInter.DoLog('O', '5.4 Anzahl:' + IntToStr(LPaxVerteil));
      lokBelegen2;
    end;
  end; // procedure lokBelegen


begin
  LDebug := FindParamBooleanReplaced('dbg', false);
  LTyp := FindParamStringReplacedLower('y', '');
  LBafConName := FindParamStringReplacedLower('db', DC_DEFAULT);
  lokPlaetze;
  LSql := FInter.GetSqlAndClear(2);
  SqlAndParams(LBafConName, 'restplaetze', LSql);
  LIni := TStringIniFile.Create('');
  try
    dataMain.StartTransaction(LBafConName);
    try
      LHbCnt := 0;
      LDataset := dataMain.QueryOpen(LBafConName, 'restplaetze');
      while not LDataset.Eof do begin
        inc(LHbCnt);
        LHauptbucher[LHbCnt].buchung := LDataset.FieldByName('pnr_number').AsInteger;
        LHauptbucher[LHbCnt].res_kunde_id := LDataset.FieldByName('res_kunde_id').AsString;
        LHauptbucher[LHbCnt].anrede := LDataset.FieldByName('anrede').AsInteger;
        LHauptbucher[LHbCnt].anzahl := System.Math.Max(LDataset.FieldByName('anztn').AsInteger
            - LDataset.FieldByName('anzres').AsInteger, 0);
        LDataset.Next;
      end;
      lokBelegen;
      dataMain.Commit(LBafConName);
    except
      dataMain.Rollback(LBafConName);
      raise;
    end;
    dataMain.QueryClose(LBafConName, 'restplaetze');
  finally
    LIni.Free;
  end;
// procedure TBafTtModule.TtRestplätze_pg
end;

function TBafTtModule.Vtrnr4To5(AText: string): string;
// Ergänzt zu einer vierstelligen VTR_NR die Prüfziffer
var
  i: integer;
  t: string;
begin
  if Length(AText) = 4 then begin
    i := StrToInt(AText[4]) * 2;
    i := i + StrToInt(AText[3]) * 3;
    i := i + StrToInt(AText[2]) * 4;
    i := i + StrToInt(AText[1]) * 5;
    i := i mod 11;
    if i > 0 then
      i := 11 - i;
    t := IntToStr(i);
    result := AText + copy(t, Length(t), 1);
  end
  else
    result := '';
end;

procedure TBafTtModule.WdOpenDoc;
var
  fn: string;
begin
  if FindParamBooleanReplaced('cnd', true) then begin
    fn := GetDocFileName(FindParamStringReplaced('z', ''));
    BafOpenFile(fn);
  end;
end;

procedure TBafTtModule.WdRestUpdate(ACommand, AExCmd: string; ADoLog: boolean);
var
  LResponse, LStatusText: string;
  p1: integer;
begin
  dataWD.RESTRequest1.ClearBody;
  dataWD.RESTRequest1.Method := rmPOST;
  dataWD.RESTRequest1.Resource := '/windream.web.api/documents/Update';
  ACommand := BafConvertUmlaute(ACommand);
  if ADoLog then
    FInter.DoLog('I', ACommand);
  dataWD.RESTRequest1.AddBody(ACommand, ctAPPLICATION_JSON);
  dataWD.RESTRequest1.Params.Items[0].Options
    :=  dataWD.RESTRequest1.Params.Items[0].Options + [poDoNotEncode];

  dataWD.RESTRequest1.Execute;
  LResponse := dataWD.RESTResponse1.Content;
  LStatusText := dataWD.RESTRequest1.Response.StatusText;
  if ADoLog then
    FInter.DoLog('I', dataWD.RESTResponse1.Content);
  p1 := Pos('"HasErrors": false', LResponse);
  if p1 = 0 then begin
    if AExCmd = '' then
      FInter.DoLog('E', LStatusText + ' - ' + LResponse)
    else begin
      FInter.DoLog('W', LStatusText + ' - ' + LResponse);
      TBafInterpreterLevel.ExecInNewLevel(AExCmd, FExecInter, FInter);
    end;
  end;
end;

procedure TBafTtModule.WdUpdateIndex;
var
  LCmd, LValue, LQuote, LExCmd, LDB, LDocID: string;
  LDoQuote, LDoLog: boolean;
begin
  if FindParamBooleanReplaced('cnd', true) then begin
    LDB := FindParamStringReplaced('db', 'wd');
    LDocId := GetDocId(FindParamStringReplaced('kid', ''), LDB);
    LExCmd := FindParamString('exc', '');
    if FindParamBooleanReplaced('dq', true) then
      LQuote := '"';
    LValue := LQuote + FindParamStringReplaced('z', '') + LQuote;
    LCmd := '{"Item": {' + #13#10
        + '"Attributes": [  {' + #13#10
        + '"Name": "' + FindParamStringReplaced('n', '') + '",' + #13#10
        + '"Value": ' + LValue + '  }  ],' + #13#10
        + '"Id": ' + LDocId + '}, ' + #13#10
        + '"ResponseDetails": 0,' + #13#10
        + '"CreateNewVersion": false   }';
    if FindParamBooleanReplaced('log', false) then begin
      FInter.DoLog('I', LCmd);
      LDoLog := true;
    end;
    WdRestUpdate(LCmd, LExCmd, LDoLog);
  end;
end;

procedure TBafTtModule.WdUpdateVectorIndex;
var
  LCmd, LValue, LValues, LQuote, LList, s, LExCmd, LDB, LDocId: string;
  i: integer;
  LDoQuote, LDoLog: boolean;
  sl: TStringList;

  procedure lokCheckList;
  var
    i: integer;
  begin
    LList := FindParamStringReplaced('lst', '');
    if LList <> '' then begin
      sl := TStringList.Create;
      try
        sl.Text := LList;
        for i := 0 to sl.Count - 1 do begin
          s := Trim(sl[i]);
          if s <> '' then
            LValues := LValues + ', ' + LQuote + s + LQuote;
        end;
      finally
        sl.Free;
      end;
    end;
  end; // procedure lokCheckList

begin
  if FindParamBooleanReplaced('cnd', true) then begin
    LDB := FindParamStringReplaced('db', 'wd');
    LDocId := GetDocId(FindParamStringReplaced('kid', ''), LDB);
    LExCmd := FindParamString('exc', '');
    if FindParamBooleanReplaced('dq', true) then
      LQuote := '"';
    i := 1;
    LValue := FindParamStringReplaced('z' + IntToStr(i), '');
    while LValue <> '' do begin
      LValues := LValues + ', ' + LQuote + LValue + LQuote;
      inc(i);
      LValue := FindParamStringReplaced('z' + IntToStr(i), '');
    end;
    lokCheckList;
    LCmd := '{"Item": {' + #13#10
        + '"Attributes": [  {' + #13#10
        + '"Name": "' + FindParamStringReplaced('n', '') + '",' + #13#10
        + '"Value": [' + copy(LValues, 3, MaxInt) + ']   }  ],' + #13#10
        + '"Id": ' + LDocId + '}, ' + #13#10
        + '"ResponseDetails": 0,' + #13#10
        + '"CreateNewVersion": false   }';
    LDoLog := false;
    if FindParamBooleanReplaced('log', false) then begin
      FInter.DoLog('I', LCmd);
      LDoLog := true;
    end;
    WdRestUpdate(LCmd, LExCmd, LDoLog);
  end;
end;

procedure TBafTtModule.WdUpdateVectorIndexAddRemove;
var
  LCmd, LValue, LValues, LQuote, LDocID, LSql, LVectorName, s, LDB,
      LName, LExCmd: string;
  i: integer;
  LDoQuote, LNoException, LDoLog: boolean;
  sl, sl2: TStringList;
  LData: TDataSet;

  procedure lokBestehende;
  // Ermittelt die bestehenden Index-Werte und entfernt davon die wri-Werte
  begin
    sl := TStringList.Create;
    try
      sl.Sorted := true;
      sl.Duplicates := dupIgnore;
      i := 1;
      LValue := FindParamStringReplaced('wri' + IntToStr(i), '');
      while LValue <> '' do begin
        sl.Add(AnsiUpperCase(LValue));
        inc(i);
        LValue := FindParamStringReplaced('wri' + IntToStr(i), '');
      end;
      LSql := Format('SELECT  ISNULL(v.szValue, v.dwValue) AS value   FROM dbo.Attribute a '
          + 'INNER JOIN dbo.Vector v ON v.dwDocId = %s AND v.dwAttrID = a.dwAttrID '
          + 'WHERE upper(a.szAttrName) = UPPER(%s)', [LDocID, QuotedStr(LVectorName)]);
      dataMain.QueryPrepare(LDB, LName, LSql);
      LData := dataMain.QueryOpen(LDB, LName);
      while not LData.Eof do begin
        LValue := LData.Fields[0].AsString;
        if (sl.IndexOf(AnsiUpperCase(LValue)) = -1) and (LValue <> '') then
          sl2.Add(LQuote + LValue + LQuote);
        LData.Next;
      end;
    finally
      sl.Free;
    end;
  end; // procedure lokBestehende;

begin
  if FindParamBooleanReplaced('cnd', true) then begin
    sl2 := TStringList.Create;
    try
      sl2.Sorted := true;
      sl2.Duplicates := dupIgnore;
      if FindParamBooleanReplaced('dq', true) then
        LQuote := '"';
      LNoException := FindParamBooleanReplaced('nex', false);
      LDB := FindParamStringReplaced('db', 'wd');
      LName := FInter.Name + '~' + LDB;
      LDocID := GetDocId(FindParamStringReplaced('kid', ''), LDB);
      LVectorName := FindParamStringReplaced('n', '');
      LDoLog := FindParamBooleanReplaced('log', false);
      LExCmd := FindParamString('exc', '');
      lokBestehende;
      i := 1;
      LValue := FindParamStringReplaced('z' + IntToStr(i), '');
      while LValue <> '' do begin
        sl2.Add(LQuote + LValue + LQuote);
        inc(i);
        LValue := FindParamStringReplaced('z' + IntToStr(i), '');
      end;
      LValues := '';
      for i := 0 to sl2.Count - 1 do
        LValues := LValues + ', ' + sl2[i];
    finally
      sl2.Free;
    end;
    LCmd := '{"Item": {' + #13#10
        + '"Attributes": [  {' + #13#10
        + '"Name": "' + LVectorName + '",' + #13#10
        + '"Value": [' + copy(LValues, 3, MaxInt) + ']   }  ],' + #13#10
        + '"Id": ' + LDocID + '}, ' + #13#10
        + '"ResponseDetails": 0,' + #13#10
        + '"CreateNewVersion": false   }';
    try
      WdRestUpdate(LCmd, LExCmd, LDoLog);
    except
      if not LNoException then begin
        Clipboard.AsText := LCmd;
        raise;
      end;
    end;
  end;
// procedure TBafTtModule.WdUpdateVectorIndexAddRemove
end;

procedure TBafTtModule.WdUpdateVectorIndexRemoveList;
var
  LCmd, LValue, LValues, LQuote, LDocID, LSql, LVectorName, s, LList,
      LName, LDB, LExCmd: string;
  i, LPos: integer;
  LDoQuote, LNoException, LInQuote, LDoLog: boolean;
  sl, sl2: TStringList;
  LData: TDataSet;

  procedure lokBestehende;
  // Ermittelt die bestehenden Index-Werte und entfernt davon die wri-Werte
  var
    i: integer;
  begin
    sl := TStringList.Create;
    try
      sl.Sorted := true;
      sl.Duplicates := dupIgnore;
      LList := FindParamStringReplaced('wril', '');
      LInQuote := false;
      for i := 1 to Length(LList) do begin
        if LList[i] = #39 then begin
          if LInQuote then begin
            LInQuote := false;
            s := copy(LList, LPos + 1, i - LPos - 1);
            sl.Add(AnsiUpperCase(s));
          end
          else begin
            LInQuote := true;
            LPos := i;
          end;
        end;
      end;
      LSql := Format('SELECT  ISNULL(v.szValue, v.dwValue) AS value   FROM dbo.Attribute a '
          + 'INNER JOIN dbo.Vector v ON v.dwDocId = %s AND v.dwAttrID = a.dwAttrID '
          + 'WHERE upper(a.szAttrName) = UPPER(%s)', [LDocID, QuotedStr(LVectorName)]);
      LName := FInter.Name + '~' + LDB;
      dataMain.QueryPrepare(LDB, LName, LSql);
      LData := dataMain.QueryOpen(LDB, LName);
      while not LData.Eof do begin
        LValue := LData.Fields[0].AsString;
        if (sl.IndexOf(AnsiUpperCase(LValue)) = -1) and (LValue <> '') then
          sl2.Add(LQuote + LValue + LQuote);
        LData.Next;
      end;
    finally
      sl.Free;
    end;
  end; // procedure lokBestehende;

begin
  if FindParamBooleanReplaced('cnd', true) then begin
    sl2 := TStringList.Create;
    try
      sl2.Sorted := true;
      sl2.Duplicates := dupIgnore;
      if FindParamBooleanReplaced('dq', true) then
        LQuote := '"';
      LNoException := FindParamBooleanReplaced('nex', false);
      LDB := FindParamStringReplaced('db', 'wd');
      LDocId := GetDocId(FindParamStringReplaced('kid', ''), LDB);
      LExCmd := FindParamString('exc', '');
      if FindParamBooleanReplaced('log', false) then begin
        FInter.DoLog('I', LCmd);
        LDoLog := true;
      end;
      LVectorName := FindParamStringReplaced('n', '');
      lokBestehende;
      i := 1;
      LValue := FindParamStringReplaced('z' + IntToStr(i), '');
      while LValue <> '' do begin
        sl2.Add(LQuote + LValue + LQuote);
        inc(i);
        LValue := FindParamStringReplaced('z' + IntToStr(i), '');
      end;
  //    Clipboard.AsText := sl2.Text;
      LValues := '';
      for i := 0 to sl2.Count - 1 do
        LValues := LValues + ', ' + sl2[i];
    finally
      sl2.Free;
    end;
    LCmd := '{"Item": {' + #13#10
        + '"Attributes": [  {' + #13#10
        + '"Name": "' + LVectorName + '",' + #13#10
        + '"Value": [' + copy(LValues, 3, MaxInt) + ']   }  ],' + #13#10
        + '"Id": ' + LDocID + '}, ' + #13#10
        + '"ResponseDetails": 0,' + #13#10
        + '"CreateNewVersion": false   }';
    try
      WdRestUpdate(LCmd, LExCmd, LDoLog);
    except
      if not LNoException then begin
        Clipboard.AsText := LCmd;
        raise;
      end;
    end;
  end;
// procedure TBafTtModule.WdUpdateVectorIndexRemoveList
end;

end.
