var
  fileQueryList: String;
  QueryList: TStringList;

{~QueryInitialization
 Инициализация кеша запросов.}
procedure QueryInitialization(Xml: Variant = null);
begin
  QueryList := TStringList.Create;
  if VarIsNull(Xml) then
    Exit;
  fileQueryList := ExtractFilePath(Xml.documentElement.
    getAttribute('INI_FILE')) + 'QueryList.tmp';
  if not StrToBool(VarToStrDef(Xml.documentElement.getAttribute('PACKETFIRST'), 'true')) and
    FileExists(fileQueryList) then
      QueryList.LoadFromFile(fileQueryList);
end; {End QueryInitialization}

{~QueryFinalization
 Деинициализация кеша запросов}
procedure QueryFinalization(Xml: Variant = null);
begin
  if not VarIsNull(Xml) then
    if StrToBool(VarToStrDef(Xml.documentElement.getAttribute('PACKETLAST'), 'true')) and
      FileExists(fileQueryList) then
      DeleteFile(fileQueryList)
    else if not StrToBool(VarToStrDef(Xml.documentElement.getAttribute('PACKETLAST'), 'true')) then
      QueryList.SaveToFile(fileQueryList);
  QueryList.Free;
end; {End QueryFinalization}


{~QueryRun
  выполняет запрос объекта aQuery и возвращает результат в виде XML }
function QueryRun( aQuery: TRunQuery; aSQLText: string): Variant;
begin

    try
      Result := CreateOleObject('Microsoft.XmlDom');
      Result.LoadXML( aQuery.Run( aSQLText));

      except
        ExceptionLog( 'Сбой QueryTools.QueryRun');
    end;

end;

{~QueryStr
 Функция низжего уровня (основа для остальных) - возвращает строку
 sqlText - SQL запрос формата 'Select .. From .. Where .. = ?'
 parValue - список параметров подставляемые вместо ? в sqlText,
  например [..,..,..,]}
function QueryStr(sqlText: String; parValue: Variant = Null;
                  casheUse: Boolean = true): String;
var
  i: Integer;
  str: String;
  function parValueStr(parValue: Variant): String;
  begin
    Result := '';
    if VarIsNull(parValue) then Exit;
    if VarIsArray(parValue)
      then
        begin
          for i := 0 to Length(parValue) - 1
            do Result := Result + parValueStr(parValue[i]);
        end
      else
        Result := VarToStr(parValue);
  end;
  procedure parValueAdd(parValue: Variant);
  begin
    if VarIsNull(parValue) then Exit;
    if VarIsArray(parValue)
      then
        begin
          for i := 0 to Length(parValue) - 1
            do parValueAdd(parValue[i]);
        end
      else
        // exchange 2690
        // здесь вместо проверки значения даты проверямем тип variant
        // и только если это дата - только тогда значение даты.
        // если этого не делать а проверять, как раньше, только значение
        // даты, то вещественное число, подходяшее по формату ДД.ММ,
        // воспринимается как дата.
        // например сумма 18.03 (если разделитель в строке даты - точка),
        // воспринимается как дата 1900-01-17. преобразование выполняется
        // неявно через строку: 18.03 число -> ValidDate( 18.03) =true
        // что в результате приводит к типу дата.
        if (VarType(parValue) <> varDate)  //ValidDate(parValue)
          then Query.AddStr( VarToStr(parValue))
          else
            if ValidDate(parValue)
              then Query.AddDate( parValue)
              else Query.AddStr( VarToStr(parValue));
  end;
begin

    try
      str := MD5String(sqlText + parValueStr(parValue));
      if casheUse and (QueryList.IndexOfName(str) >= 0) then begin
        Result := QueryList.ValueFromIndex(QueryList.IndexOfName(str));

        Exit;
      end;
      parValueAdd(parValue);
      Result := Query.Run(sqlText);

      if casheUse then QueryList.Add(str + '=' + result);
      except
        ExceptionLog( 'Сбой QueryTools.QueryStr');
    end;

end; {End QueryStr}

{~QueryXml
 Функция обёртка над QueryStr, отличие возвращает XML
 При отсутствие результата выборки: Result.documentElement.childNodes.length = 0}
function QueryXml(sqlText: String; parValue: Variant = Null;
                  casheUse: Boolean = true): Variant;
begin
  try
    
    try
      Result := CreateOleObject('Microsoft.XmlDom');
      Result.LoadXML(QueryStr(sqlText, parValue, casheUse));
      
      except
        ExceptionLog( 'Сбой QueryTools.QueryXml');
    end;
    finally
      
  end;
end; {End QueryXml}

{~QueryXml2
 Функция надстройки над QueryXml.
 в результате возвращает Result.documentElement, а не корневой узел.
 это дает сократить одну операцию в скриптах.}
function QueryXml2(sqlText: String; parValue: Variant = Null;
                  casheUse: Boolean = true): Variant;
begin
  try
    
    try
    {
      Result := CreateOleObject('Microsoft.XmlDom');
      Result.LoadXML(QueryStr(sqlText, parValue, casheUse));
      }
      Result := QueryXml(sqlText, parValue, casheUse);
      Result := Result.DocumentElement;
      
      except
        ExceptionLog( 'Сбой QueryTools.QueryXml2');
    end;
    finally
      
  end;
end;

{~IsEmptyQueryXml
  функция выполняет запрос aSQL с параметрами aParams (aCasheUse-кешируемость)
  в результате возвращается:
    =TRUE - если результат есть
    =FALSE - результат пустой.}
function IsEmptyQueryXml( aSQL: String; aParams: Variant = Null;
                          aCasheUse: Boolean = true): boolean;
var
  xResultXml: Variant;
begin

    try
      xResultXml := QueryXml( aSQL, aParams, aCasheUse);
      Result     := (xResultXml.documentElement.ChildNodes.length <= 0);
      
      except
        ExceptionLog( 'Сбой QueryTools.IsEmptyQueryXml');
    end;

end;

{~QueryField
 Функция обёртка над QueryXml, отличие  - возвращает значение поля
 Добавлен параметр fldName - наименование поля, в случае}
function QueryField(sqlText: String; parValue: Variant; fldName: String;
                    casheUse: Boolean = true): String;
var
  Xml: Variant;
begin

    try
      Xml := QueryXml(sqlText, parValue, casheUse);
      if Xml.documentElement.ChildNodes.length = 0 then
      begin
        Result := '';
        Exit;
      end;
      result := Xml.documentElement.firstChild.getAttribute(fldName);
        if result = null then
          raise('Поля: ' + fldName + ' нет в результирующей XML по запросу: ' + SQLText);
      except
        ExceptionLog( 'Сбой QueryTools.QueryField');
    end;

end; {End QueryField}

{~QueryGetParamsFromValue
Параметр Value подается в виде значения, например 1,2,3. Возвращает в качестве
результата ?, ?, ?. В parValue создается как массив значений в виде [1][2][3].
Чаще всего используется для конструкций in в запросах.}
function QueryGetParamsFromValue(Value: String; var parValue: array of string): String;
var
  i, j: Integer;
  isParse: Boolean;
begin
  Result := '';
  Value := StringReplace(Value, ' ', '');
  if (Value[1] = ',') or (Value[Length(Value)] = ',') or (Value = '') then
    Raise('Функция QueryGetParamsFromValue: некорректное значение параметра Value');
  isParse := False;
  j := 0;
  SetLength(parValue, j + 1);
  parValue[j] := '';
  for i := 1 to Length(Value) do
  begin
    if Value[i] = ',' then
    begin
      Result := Result + '?, ';
      inc(j);
      SetLength(parValue, j + 1);
      isParse := True;
    end
    else
      parValue[j] := parValue[j] + Value[i];
  end;
  if isParse then
    Result := Result + '?'
  else
    Result := '?';
end;


{~QueryGetIDListForClass
  формирует список ID через запятую из списка документов aXML, только для тех
  документов, у которых класс совпадает с aClassID.
  параметры
    aXml - входной документ XML (узел, в котором перечислены описания документов);
    aClassID - строка идентификатора класса;
    aCountInGroup - необязательный параметр: количество элементов в группе
                    (по умолчанию = 1000).
  результат:
    список ID через запятую.
    разделитель ";" является разделителем групп по aCountInGroup элементов.
    в результате можно сформировать запрос вида:
      (ID in (g1) or ID in (g2) or ...)
    где: g1,g2,... - группы ID разделенные ";"}
function QueryGetIDListForClass( var aXml: Variant;
                                 aClassID: string;
                                 aCountInGroup: integer = 700): string;
var
  i,n: integer;
  xNode: Variant;
begin

    Result := '';
    try
      if NOT VarIsNull( aXml) then begin
        n := 0;
        for i := 0 to aXml.childNodes.length - 1 do begin
          xNode := aXml.childNodes.items[i];
          if (xNode.getAttribute('DOCUMENTCLASS_ID') = aClassID) then begin
            // при перечислении более 1000 записей, вместо "," указываем ";".
            if (n > 0) then
              if (n < aCountInGroup)
                then Result := Result + ','
                else begin
                  Result := Result + ';';
                  n := 0;
                end;
            Result := Result + xNode.getAttribute('ID');
          end;
        end;//for//
      end;

      except
        ExceptionLog( 'Сбой QueryTools.QueryGetIDListForClass');
    end;

end;


{~BuildQueryByIDListString
  exchange #2782
  форматирование списка строк через запятую aIDList в подзапрос SQL
  (в формате aFormat) разделенных на группы с названием полей aField
  оператором aWhere (in) и разделителем aBunch (or).
  число элементов в группе = aMaxCount (900).

  это нужно, если имеется фильтр в sql запросе, например:
   ... where ... id in (...) ...

  где:
    список значений (...) - aIDList, это перечень id через запятую.
    если указать явно список в запросе, то при количестве id >1000
    буде возникать сбой в oracle - не поддерживается список элементов
    больше тысячи.

  поэтому перечень нужно разделять на группы с объединением:
    (id in (...) or id in (...) ...)

  строка форматирования aFormat определяет, как будет сформирована
  конечная строка в подзапросе sql (по умолчанию: and %s).
  если условие указывается сразу после where, то шаблон форматирования
  нужно указывать как %s. }
function BuildQueryByIDListString( aIDList: string;
                                   aField: string = 'ID';
                                   aFormat: string = ' and %s ';
                                   aWhere: string = 'IN';
                                   aBunch: string = 'or';
                                   aMaxCount: integer = 700): string;
var
  i,n: integer;
  s: string;
begin

    try
      s := aIDList;
      n := aMaxCount;
      for i := 1 to LENGTH( s) do
        if (s[ i] = ',') then begin
          DEC( n);
          if (n <= 0) then begin
            s[ i] := ';';
            n := aMaxCount;
          end;
        end;
      if (LENGTH( aFormat) > 0)
        then Result := FORMAT( aFormat,
                                [ BuildQueryByIDList( s, aField, aWhere, aBunch)])
        else Result := BuildQueryByIDList( s, aField, aWhere, aBunch);
      except
        ExceptionLog( 'Сбой QueryTools.BuildQueryByIDListString');
    end;

end;

{~BuildSqlQueryByParamsCount
  exchange #3054
  создание списка параметров "?" с количеством aCount в подзапрос SQL
  (в формате aFormat) разделенных на группы с названием полей aField
  оператором aWhere (in) и разделителем aBunch (or).
  число элементов в группе = aMaxCount (900).}
function BuildSqlQueryByParamsCount( aCount: integer;
                               aField: string = 'ID';
                               aFormat: string = ' and %s ';
                               aWhere: string = 'IN';
                               aMaxCount: integer = 700): string;
var
  j,n: integer;
  s: string;
begin

    try
      if (aCount <= 0)
        then Result := '(0=0)'   // заглушка в запрос
        else begin
          Result := '';
          s := '';
          n := 0;
          for j := 1 to aCount do begin
            if (LENGTH( s) > 0)
              then s := s + ',';
            s := s + '?';//xSL.Strings[ j];
            INC( n);
            if (n > aMaxCount) then begin
              if (LENGTH( Result) > 0)
                then Result := Result + ' OR ';
              Result := Result + aField + ' ' + aWhere + ' (' + s + ')';//'(' + s + ')';
              n := 0;
              s := '';
            end;
          end;//for//
          if (n > 0) then begin
            if (LENGTH( Result) > 0)
              then Result := Result + ' OR ';
            Result := Result + aField + ' ' + aWhere + ' (' + s + ')';//'(' + s + ')';
          end;
          if (LENGTH( Result) > 0)
            then Result := '(' + Result + ')';
        end;
      except
        ExceptionLog( 'Сбой QueryTools.BuildSqlQueryByParamsCount');
    end;

end;


{~BuildQueryByIDList
  формирует запрос SQL из списка идентификаторов вида:
   [(] поле условие (группа) [связка поле условие (группа)] ... [)]
  где:
    поле - aField;
    условие - aWhere (in или not in)
    связка -aBunch (or или and)

  aIDList - набор значений, сформированных функцией QueryGetIDListForClass.
  допускается разделение списка на группы (символом ";").}
function BuildQueryByIDList( aIDList: string;
                             aField: string = 'ID';
                             aWhere: string = 'IN';
                             aBunch: string = 'or'): string;
var
  xPos: integer;
  s,sSubStr: string;
  sResultFormat: string;
begin

    Result := '';
    try
      s := aIDList;
      xPos := POS(';', s);
      // если несколько групп, то объединяем весь запрос в скобки
      if (xPos <= 0)
        then sResultFormat := ''
        else sResultFormat := '(%s)';
      repeat
        if (xPos <= 0) then begin
          sSubStr:= s;
          s      := '';
        end else begin
          sSubStr:= COPY( s, 1, xPos - 1);
          DELETE(s, 1, xPos);
        end;
        // конструкция запроса: поле IN/not in (...)
        Result := Result + ' ' + aField + ' ' + aWhere + ' (' + sSubStr + ')';
        if (LENGTH( s) <= 0) then BREAK;
        // продолжение запроса: связка and или or
        Result := Result + ' ' + aBunch + ' ';
        // поиск следующей группы
        xPos := POS(';', s);
      until FALSE;
      if (LENGTH( sResultFormat) > 0)
        then Result := FORMAT( sResultFormat, [ Result]);
      except
        ExceptionLog( 'Сбой QueryTools.BuildQueryByIDList');
    end;

end;


{~QueryListField
  возвращает на выходе перечисление значения числовых полей aField через
  запятую, для запроса aQuery с параметрами aParams.
  это удобно выполнять, когда требуется получить перечень ID для какого
  либо запроса.}
function QueryListField( aQuery: string;
                         aParams: Variant;
                         aField: string = 'ID'): string;
var
  xResultXML: Variant;
  xResultDoc: Variant;
  i: integer;
begin

    try
      Result := '';
      // запрашиваем в БД
      xResultXML := QueryXml( aQuery, aParams);
      xResultDoc := xResultXML.documentElement;
      for i := 0 to xResultDoc.ChildNodes.Length - 1 do begin
        if (i > 0) then Result := Result + ',';
        Result := Result + xResultDoc.childNodes.Item[0].GetAttribute( aField);
      end;//for//

      except
        ExceptionLog( 'Сбой QueryTools.QueryListField');
    end;

end;


{~ExistsSingleFieldFromSQL
 возвращает =true, если строчное значение поля есть результата запроса aSQL}
function ExistsSingleFieldFromSQL( aSQL: string; aParams: Variant): boolean;
var s: string;
begin

    try
      Result := ExistsSingleFieldFromSQLEx( aSQL, aParams, s);
      except
        ExceptionLog( 'Сбой: QueryTools.GetSingleFieldFromSQL');
    end;

end;


{~ExistsSingleFieldFromSQLEx
  получает результат запроса SQL в параметр aResultValue.
  поскольку ожидается результат в единственном поле, то имени атрибута (поля)
  результата указывать не нужно.
  если результат функции =FALSE, в поле значения результата aResultValue
  возвращается пустая строка.
 возвращает
    =true, если получен результат запроса aSQL.
    =false, если в результате запроса возвращается null, или запрос не указан,
            или результат возвращается в виде множества значений (>1 значения).}
function ExistsSingleFieldFromSQLEx( aSQL: string;
                                     aParams: Variant;
                                     var aResultValue: string): boolean;
var
  xXml: variant;
begin

    try
      Result := FALSE;
      aResultValue := '';

        if ( TRIM( aSQL) = '') then EXIT;
        xXml := QueryXml( aSql, aParams);
        if VarIsNull( xXml) then EXIT;
        Result := ( xXml.documentElement.childNodes.Length > 0);
        if Result
          then aResultValue := xXml.documentElement.childNodes.item[0].attributes.Item[0].nodeValue;

      except
        ExceptionLog( 'Сбой: QueryTools.ExistsSingleFieldFromSQLEx');
    end;

end;


{~GetSingleFieldFromSQL
 возвращает строчное значение единственного поля результата запроса aSQL.
 если результат запроса SQL есть (<>NULL) то возвращается строчное значение
 этого результата запроса.
 если запрос не выполнен, или результат =NULL, или в результате запроса
 возвращается множество значений, то в качестве результата
 возвращается строка, указанная в значении параметра aDefault.
 Параметры:
   aSQL - запрос SQL;
   aParams - параметры для запроса (одно значение или список Variant);
   aDefault - значение результата по умолчанию (необязательное. по умолчанию
              указывается пустая строка).
 ~Результат~
   строка результата запроса или значение из параметра aDefault.}
function GetSingleFieldFromSQL( aSQL: string;
                                aParams: Variant;
                                aDefault: string = ''): string;
begin

    try
      if NOT ExistsSingleFieldFromSQLEx( aSQL, aParams, Result)
        then Result := aDefault;
      except
        ExceptionLog( 'Сбой: QueryTools.GetSingleFieldFromSQL');
    end;

end;


{~UpdateXmlNameFromSQL
 обновляет атрибут aAttrName в aXml значением запроса aSQL.

 Параметры:
   aSQL - запрос SQL;
   aParams - параметры для запроса (одно значение или список Variant);
   aXML - XML, в котором нужно установить атрибут результата запроса;
   aAttrName - название атрибута, в который будет записан результат запроса;

  результат:
    =true - атрибут в XML обновлен,
    =false - обновление атрибута не выполнено.

  например:
    для Exchange #2344 вызов процедуры для AP такой:
      UpdateXmlNameFromSQL(
        'expschedule',
        '(document_id=?) and (org_credentials_id is not null)'
        'org_credentials_name',
        xml,
        'CNAME_UBP')}
function UpdateXmlNameFromSQL( aSQL: string;
                               aParams: Variant;
                               var aXML: variant;
                               aAttrName: string): boolean;
var
  xValue: string;
begin

    try
      // если XML не указан - результат отрицательный, иначе выполняем запрос
      if NOT VarIsNull( aXML)
        then Result := FALSE
        else Result := ExistsSingleFieldFromSQLEx( aSQL, aParams, xValue);

      if Result then begin
        aXML.setAttribute( aAttrName, xValue);

      end;
      except
        ExceptionLog( 'Сбой: QueryTools.UpdateXmlNameFromSQL');
    end;

end;


{==============================================================================}

function GetDocumentNameByClass( aClass: string; aSubName: string = ''): string;
begin

    try
      Result := QueryField( 'select caption from documentclass where id=?',
                            [ aClass],
                            'CAPTION');
      // дополнение к названию ЭД
      if (LENGTH( aSubName) > 0)
        then Result := Result + FORMAT( ' (%s)', [ aSubName]);

      except
        ExceptionLog( 'Сбой QueryTools.GetDocumentNameByClass');
    end;

end;


{~GetDocumentInfo
  возвращает описание документа в виде: "aPrefix "название" номер дата"
  по описанию документа в виде XML: aSourceXml.
  где:
    aPrefix - параметр aPrefix (по умолчанию - не указан)
    название - название ЭД по классу входного документа.}
function GetDocumentInfo( var aSourceXml: Variant;
                          aPrefix: string = ''): string;
begin

    try
      // название ЭД по номеру класса вида: " "название" номер дата"
      // при этом префикс строки не указывается. он будет разный для
      // предварительного сообщения и для ошибок экспорта.
      Result := DefineAZKDocumentNumberAndData(
                    GetDocumentNameByClass(
                              aSourceXml.getAttribute('DOCUMENTCLASS_ID')),
                    aSourceXml,
                    aPrefix);
      except
        ExceptionLog( 'Сбой QueryTools.GetDocumentInfo');
    end;

end;


begin
end.
