


{~GetQueryXmlField
  возвращает число строк запроса aXml выполненного через QueryXml.
  в результате, если вернулась одна строка, то в aValue возвращается
  значение поля aFieldName из этой строки.
  если вернулось несколько или ни одной строки, то aValue заполняется
  пустой строкой.}
function GetQueryXmlField( aXML: variant;
                           aFieldName: string;
                           var aValue: string): integer;
begin

    try
      Result := aXML.documentElement.childNodes.Length;
      if (Result = 1)
        then aValue := aXML.documentElement.childNodes.Item[0].getAttribute( aFieldName)
        else aValue := '';

      except
        ExceptionProc( 'GetQueryXmlField');
    end;

end;


{~XmlAttrExists
  поиск атрибута xAttrName в узле XML: xNode.
  если xNonRegister:
     =false выполняется проверка имени атрибута как указано в xAttrName;
     =true - проверка атрибута без учета регистра. это не совсем корректно,
             поскольку обращение к атрибутам по имени регистрозависимо.
             это удобно использовать для поиска вообще атрибута, если
             точное имя либо не известно, либо нужно просто проверить
             наличие такого атрибута.
             крайне нежелательно указывать =true, если нужно проверить
             атрибут при последующем чтении, если такой атрибут есть.
  возвращает:
     =true если атрибут xAttrName присутствует в узле xXML.
     =false - нет атрибута в узле. }
function XmlAttrExists( xNode: variant; xAttrName: string; xNonRegister: boolean = FALSE): boolean;
var
  xAttrList: variant;
  i: integer;
  s: string;
begin
  try
    Result := FALSE;
    if VarIsNull( xNode) then Exit;
    xAttrList := xNode.attributes;
    if VarIsNull( xAttrList) then Exit;
    if xNonRegister then begin
      s := UpperCase( xAttrName);
      for i := 0 to xAttrList.length - 1 do
    	  if (UpperCase( xAttrList.item(i).NodeName) = s) then begin
    	    Result := TRUE;
    	    Exit;
    	  end;
    end else begin
//      Result := NOT VarIsNull( xNode.selectSingleNode( '@' + xAttrName));
      for i := 0 to xAttrList.length - 1 do
    	  if (xAttrList.item(i).NodeName = xAttrName) then begin
    	    Result := TRUE;
    	    Exit;
    	  end;
    end;
    except
      ExceptionLog( 'Сбой скрипта: "Un_ToolsXML.XmlAttrExists".');
  end;
end;


{~RemoveNode
  Удаляет Node из Xml с определенным наименованием.
  Параметр Node указывает уровень вложенности на котрорм надо провести удаление.
  NodeName - наименованание нода которые нужно удалить.}
procedure RemoveNode(Node: Variant; NodeName: String);
var
  i: Integer;
begin
  try
    i := 0;
    Node := Node.parentNode;
    while i <= Node.childNodes.Length - 1 do
    begin
      if Node.childNodes.Item[i].NodeName = NodeName then
        Node.removeChild(Node.childNodes.Item[i])
      else
        inc(i);
    end;
    except
      ExceptionLog( 'Сбой скрипта: "Un_ToolsXML.RemoveNode".');
  end;
end;


{~RenameNode
  Переименовывает название заданного Node в Xml.
  в параметр Xml передается Xml, в которой необходимо переименовать Node;
  в параметр Node передается значение Node в Xml, который необходимо переименовать
  NewName - наименование нового Node в Xml}
procedure RenameNode(Node: Variant; NewName: String);
  procedure CloneNode(Source, Dest: Variant);
  var
    i: Integer;
  begin
    for i := 0 to Dest.attributes.length -1 do
      Source.setAttribute(Dest.attributes.item[i].nodeName,
        Dest.attributes.item[i].nodeValue);
    for i := 0 to Dest.childNodes.length -1 do
      Source.appendChild(Dest.childNodes.Item[i].cloneNode(true));
    Dest.parentNode.removeChild(Dest);
  end;
begin
  CloneNode(Node.parentNode.appendChild(Node.ownerDocument.createElement(NewName)),
    Node);
end;


{~GetNodeAttribute
  поиск атрибута в XML по строке пути xPath.
  результат =TRUE, если такой атрибут будет найден. в этом случае значение
  атрибута будет возвращено в виде строки в параметре результата xResult.
  если атрибут не будет найден, функция вернет =FALSE, а значение xResult
  будет равно параметру xDefaultValue.
  путь поиска:
    [//][node][/][node][/]@attr
    символ "//" в начале строки показывает что нужно искать от корневого
    узла aXml.
    node - название узла
    @ - признак начала названия атрибута - обязателен!
    имя атрибута начинается после @ и до конца строки. пробелы не допускаются!
  например:
    //*/ROW@ID возвратит значение атрибута ID в таком XML:
       <EXCHQUERY completed="true"><ROW ID="xxx" /></EXCHQUERY> }
function GetNodeAttribute( aXml: Variant;
                           xPath: string;
                           var xResult: string;
                           aDefaultValue: string = ''): boolean;
var
  xNode: Variant;
  xNodeFound: Variant;
  xSlash: integer;
  xAttrName: string;
  xNodeName: string;
  i: integer;
begin

    try
  //    LogStartProc( 'Un_ToolsXml.GetNodeAttribute');
      Result  := FALSE;
      xResult := aDefaultValue;
      if VarIsNull( aXml) then EXIT;
      // ищем название атрибута. для этого ищем "@" и до конца строки будет
      // название атрибута.
      xSlash := POS('@', xPath);
      if (xSlash = -1)
        then raise ( 'Название атрибута должно указываться в строке поиска с символа "@".');
      xAttrName := TRIM( COPY( xPath, xSlash + 1, LENGTH( xPath) - xSlash));
      if (LENGTH( xAttrName) <= 0)
        then raise ( 'Название атрибута указано пустой строкой.');
      // оставляем в пути только список узлов
      xPath := COPY( xPath, 1, xSlash - 1);
      // определяем начальный узел поиска. если указан "//" ищем от корня.
      if (POS('//', xPath) = 1) then begin
        xNode := aXml.documentElement;
        DELETE( xPath, 1, 2);

      end else begin
        xNode := aXml;

      end;
  
      repeat
  
        if VarIsNull( xNode) then begin

          BREAK;
        end;
        if (LENGTH( xPath) <= 0) then begin
          if NOT XmlAttrExists( xNode, xAttrName) then begin

            BREAK;    // фиктивный оператор
          end else begin
            xResult := xNode.getAttribute( xAttrName);

            Result  := TRUE;
          end;
          BREAK;
        end;

        xSlash := POS('/', xPath);
        if (xSlash > 0) then begin
          // если указана только "/", это значит нужно перейти вглубь на
          // один элемент. фактически это тоже самое что и "*/" только "*" не
          // указан.
          if (xPath = '/') then begin
            xNodeName := '*';
            xPath     := '';
          end else begin
            // получаем название текущего узла
            xNodeName := COPY( xPath, 1, xSlash - 1);
            // оставляем в пути только список узлов
            xPath := COPY( xPath, xSlash + 1, LENGTH( xPath) - xSlash);
          end;
        end else begin
          // если слешей нет, а строка не пустая, значит там остался последний
          // узел, который нужно найти в текущем узле.
          xNodeName := xPath;
          xPath     := '';
        end;
        // переходим на указанный узел
  
        if (LENGTH( xNodeName) > 0) then
          case xNodeName of
            '.': CONTINUE;   // текущий узел

            '*': begin
                  // это случай, когда имя узла неизвестно или не нужно указывать,
                  // а нужно перейти на этот узел. поэтому берем первый вложенный
                  // узел и ереходим на него. если вложенных узлов нет, возвращаем
                  // FALSE и выходим
                  if (xNode.childNodes.length <= 0) then EXIT;
                  xNode := xNode.childNodes.items[0];
                end;

            '..': xNode := xNode.parentNode

            else
                // тут приходится перебором искать нужный узел.
                // метод selectSingleNode дает непредсказуемый результат!
                if (xNode.nodeName <> xNodeName) then begin

                  xNodeFound := NULL;
                  for i := 0 to xNode.childNodes.length - 1 do begin

                    if (xNode.childNodes.items[i].nodeName = xNodeName) then begin
                      xNodeFound := xNode.childNodes.items[i];//xNode.selectSingleNode( xNodeName);
                      BREAK;
                    end;
                  end;
                  xNode := xNodeFound;
                end;
          end;//case//
      until FALSE;
      except
        ExceptionLog( 'Сбой Un_ToolsXml.GetNodeAttribute');
    end;

end;

{~GetNodeAttributeValue
  поиск атрибута в XML по строке пути xPath.
  результат =TRUE, если такой атрибут будет найден. в этом случае значение
  атрибута будет возвращено в виде строки в параметре результата xResult.
  если атрибут не будет найден, функция вернет =FALSE, а значение xResult
  будет равно параметру xDefaultValue.
  путь поиска:
    [//][node][/][node][/]@attr
    символ "//" в начале строки показывает что нужно искать от корневого
    узла aXml.
    node - название узла
    @ - признак начала названия атрибута - обязателен!
    имя атрибута начинается после @ и до конца строки. пробелы не допускаются!
  результат:
    возвращается строка результата. эта подпрограмма не возвращает: найден
    атрибут или нет - только строку результата (из атрибута или по умолчанию).

  например:
    //*/ROW@ID возвратит значение атрибута ID в таком XML:
       <EXCHQUERY completed="true"><ROW ID="xxx" /></EXCHQUERY>}
function GetNodeAttributeValue( aXml: Variant;
                                xPath: string;
                                aDefaultValue: string = ''): string;
begin
  try
    GetNodeAttribute( aXml, xPath, Result, aDefaultValue);
    except
      ExceptionLog( 'Сбой скрипта: "Un_ToolsXml.GetNodeAttributeValue".');
  end;
end;


{~GetNodeAttributeEx
  специальная функция получения значения атрибута.
  фактически она заменяет выражение: VarToStr( aNode.GetAttribute( aAttrName))
  но так удобно отлаживать скрипт.}
function GetNodeAttributeEx( aNode: Variant;
                             aAttrName: string): string;
begin

    try
      Result := VarToStr( aNode.GetAttribute( aAttrName));

      except
        ExceptionLog( 'Сбой GetNodeAttributeEx');
    end;

end;


{~CopyNodeAttributeEx
  копирование значения атрибута aFromAttr из узла aFromNode
  в атрибут aToAttr узла aToNode.
  фактически она заменяет выражение:
     aToNode.setattribute( aToAttr, VarToStr( aFromNode.GetAttribute( aFromAttr)));
  но так удобно отлаживать скрипт.
  помимо этого возвращается значение копируемого атрибута:
     VarToStr( aFromNode.GetAttribute( aFromAttr))

  exchange #3062 - доработка
  если атрибут, из которого копируется отсутствует, то атрибут куда копируется
  не создается, а результат функции будет = пустая строка.}
function CopyNodeAttributeEx( aToNode: Variant; aToAttr: string;
                              aFromNode: Variant; aFromAttr: string): string;
begin

    try
      Result := GetNodeAttributeEx( aFromNode, aFromAttr);
      if NOT VarIsNULL( aFromNode.GetAttribute( aFromAttr))
        then aToNode.SetAttribute( aToAttr, Result);
      except
        ExceptionLog( 'Сбой CopyNodeAttributeEx');
    end;

end;


{~ChangeFormatAttrDate_DDxMMxYYYY_To_YYYYmMMmDD
  обновление формата даты атрибута aAttrName в узле xml - aXmlNode:
  вместо DD.MM.YYYY подставляется YYYY-MM-DD.
  если значение пустое - атрибует не меняется.
  ожидается значение даты, а не просто строки.
  если это не дата, будет сбой.}
procedure ChangeFormatAttrDate_DDxMMxYYYY_To_YYYYmMMmDD( aXmlNode: Variant;
                                                         aAttrName: string);
begin

    try
      if (LENGTH( GetNodeAttributeEx( aXmlNode, aAttrName)) > 0)
        then aXmlNode.SetAttribute(
                         aAttrName,
                         DateTimeToXml(
                            StrToDate(
                                GetNodeAttributeEx( aXmlNode, aAttrName))));

      except
        ExceptionProc( 'ChangeFormatAttrDate_DDxMMxYYYY_To_YYYYmMMmDD');
    end;

end;



{~CopyAttrValue
  макрос: (атрибут_источник, аттр_приемник).
  копирует атрибут xFromXmlPath (полуный путь к атрибуту) из xFromXml,
  в узел xToNode с названием атрибута в этом узле: xToAddrName.
  например:
    xDocLine.setAttribute( 'ORG_ID', GetNodeAttributeValue( xXmlOrg, '//*/@ID'));
  выполнит:
    копирование атрибута //*/@ID из xXmlOrg в атрибут ORG_ID узла xDocLine.}
procedure CopyAttrValue( aFromXml: Variant; aFromXmlPath: string;
                         aToNode: Variant; aToAddrName: string);
begin

    try
      aToNode.setAttribute( aToAddrName,
                            GetNodeAttributeEx( aFromXml, aFromXmlPath));
                            //GetNodeAttributeValue( aFromXml, aFromXmlPath));
      except
        ExceptionProc( 'CopyAttrValue');
    end;

end;

{~CopyNotEmptyAttrXmlDateTime
  копирует атрибут даты времени АЦК-финансы (yyyy-mm-dd) aFromName из узла
  aFromNode, в узел xToNode с названием атрибута в этом узле xToName в формате
  aFormatDateTime (по умолчанию, шаблон выгрузки ФК: dd.mm.yyyy).}
procedure CopyNotEmptyAttrXmlDateTime(
                    var aFromNode: Variant; aFromName: string;
                    var aToNode: Variant; aToName: string;
                    aFormatDateTime: string = 'dd.mm.yyyy');
begin
  try
    if XmlAttrExists( aFromNode, aFromName) then
      if (aFromNode.getAttribute( aFromName) <> '')
        then aToNode.setAttribute(
                  aToName,
                  FormatDateTime(
                        aFormatDateTime,
                        XmlToDateTime(
                              aFromNode.getAttribute( aFromName))));
    except
      ExceptionLog( 'Сбой скрипта: "Un_ToolsXML.CopyNotEmptyAttrXmlDateTime".');
  end;
end;

{~CopyAttrCurrent
  копирование атрибута aFromName из узла aFromNode в атрибут aToName узла
  aToNode вещественного числа (currency) с форматированием aFormat.
  по умолчанию, форматирование: %0.2f.
  если атрибут в исходном узле не будет найден - операция не выполняется.
  фактическая операция:
    aToNode(aToName) := FORMAT( aFormat, [ aFromNode( aFromName)]). }
procedure CopyAttrCurrent( var aToNode: Variant; aToName: string;
                           var aFromNode: Variant; aFromName: string;
                           aFormat: string = '%0.2f');
begin

    try
      if XmlAttrExists( aFromNode, aFromName)
        then aToNode.setAttribute(
                  aToName,
                  Format( aFormat,
                          [ StrToCurr( aFromNode.getAttribute( aFromName))]));
      except
        ExceptionLog( 'Сбой Un_ToolsXml.CopyAttrCurrent;');
    end;

end;

{~SaveXmlToFormatTextFile
  сохранение сформировнной aXML в стрктурировнный текстовый файл aFileName.}
procedure SaveXmlToFormatTextFile( aXML: variant; aFileName: String);
var FileStream: TFileStream;
  
  procedure WriteElement(Element: Variant);
  var i: Integer;
  begin
    try
      FileStream.Write( Element.nodeName, Length(Element.nodeName));
      FileStream.Write( '|', 1);
      for i := 0 to Element.attributes.length - 1 do begin
        FileStream.Write( Element.attributes.item[i].nodeValue,
                          Length(Element.attributes.item[i].nodeValue));
        FileStream.Write( '|', 1);
      end;//for//
      FileStream.Write( #13#10, 2);
      for i := 0 to Element.childNodes.length - 1
        do WriteElement( Element.childNodes.items[i]);
      except
        ExceptionLog( 'Сбой скрипта: "Un_ToolsXML.XmlToTextFileEx.WriteElement".');
    end;
  end; {End WriteElement}
  
var
  i: Integer;

begin
  try

    FileStream := TFileStream.Create(aFileName, fmCreate);
    try
      for i := 0 to aXML.documentElement.childNodes.length - 1
        do WriteElement( aXML.documentElement.childNodes.items[i]);
      finally
        FileStream.Free;
    end;

    except
      ExceptionLog( 'Сбой скрипта: "Un_ToolsXML.XmlToTextFileEx".');
  end;
end; {End XmlToTextFile}


{~CopyXmlNodeAttributes
  подпрограмма копирует все атрибуты узла xNodeFrom в узел xNodeTo. }
procedure CopyXmlNodeAttributes( var xNodeFrom: Variant; var xNodeTo: Variant);
var
  xAttrList: variant;
  i: integer;
begin

    try
      if VarIsNull( xNodeFrom) then Exit;
      if VarIsNull( xNodeTo) then Exit;
      xAttrList := xNodeFrom.attributes;
      if VarIsNull( xAttrList) then Exit;
      for i := 0 to xAttrList.length - 1
        do xNodeTo.SetAttribute( xAttrList.item(i).NodeName,
                                 xAttrList.item(i).NodeValue);

      except
        ExceptionProc( 'CopyXmlNodeAttributes');
    end;

end; {End XmlToTextFile}


{~XmlTestTask
  создание/загрузка тестового примера XML.
    если aXml указан, будет выполнена, в нем, проверка для сохранения этого xml
  как тестовый пример. если aXml будет распознан как тестовый пример, то
  aXml будет сохранен в тестовом файле и подпрограмма возвратит значение =NULL.
  если указанный aXML не будет распознан как тестовый, то в результате
  будет возвращен указанный aXML (без изменений).
    если aXml будет распознан как тестовый пример, то дополнительно проверяются
  опции в отладочном файле. если будет найдена опция
  "сохранять_входное_задание_как_пример", то aXml будет сохранен как тестовый
  пример и в журнале, и подпрограмма вернет входной aXml как результат.
    если aXml =NULL, то подпрограмма попытается загрузить и вернуть в результате
  тестовый xml из файла. если тестовый файл не будет найден, скрипт будет
  остановлен командой HALT. для старых версий AzkExchange, подпрограмма вернет
  в результате значение =NULL. поэтому после вызова этой подпрограммы нужно
  проверить, если результат =NULL то завершить выполнение скрипта.
    aTestFileName - имя файла тестовой XML. подкаталог должен быть указан в
  отладочном файле. если отладочный файл не указан, то по умолчанию принимается
  каталог = "C:\".
  
  типичный пример в главном скрипте:
    xml := XmlTestTask( xml, 'EXP_FK_KBK.xml');
    if VarIsNull( xml) then exit;
  }
function XmlTestTask( aXml: Variant; aTestFileName: string): variant;

  { возвращает имя отладочного xml файла в каталоге, либо по умолчанию,
    либо в зависимости от опций в файле отладки. }
  function GetXmlFileName_: string;
  begin
    try
      Result := '';

      // exchange #2988
      // при запуске под пользователем доступ к корневому каталогу c:\
      // заблокирован, поэтому будем сохранять в c:\temp
      if (LENGTH( Result) <= 0) then Result := 'c:\temp\';
      // exchange #2988
      // создаем каталог
      ForceDirectories( Result);
      if not DirectoryExists( Result)
        then raise('Ошибка проверки наличия каталога: ' + Result);

      Result := Result + aTestFileName;
      
      except
        ExceptionLog( 'Сбой скрипта: "Un_ToolsXml.XmlTestTask.GetXmlFileName_".');
    end;
  end;

  //Сохранение тестовых Xml
  function SaveXmlTest_: Boolean;

    function DoSaveXmlTest_( aFileName: string): Boolean;
    begin
      try
        aXml.loadXml(FormatXmlData( aXml.documentElement.xml));
        if (LENGTH( aTestFileName) > 0)
          then aXml.save( aFileName);
        LogMessage( FORMAT( 'Тестовый пример приготовлен: "%s".',
                    [ aFileName]));
        except
          ExceptionLog( 'Сбой скрипта: "Un_ToolsXml.XmlTestTask.SaveXmlTest_.DoSaveXmlTest_".');
      end;
    end; {End SaveXmlTest}

  var xFileName: string;
  begin
    try
      Result := False;
      xFileName := GetXmlFileName_;
      if aXml.documentElement.getAttribute('TESTED') = 'True' then begin
        // в задании явно указано что оно тестовое, поэтому сохраняем
        // его в файле для тестирования.
        aXml.documentElement.setAttribute('TESTED', 'False');
        DoSaveXmlTest_( xFileName);
        Result := True;

      end;
      except
        ExceptionLog( 'Сбой скрипта: "Un_ToolsXml.XmlTestTask.SaveXmlTest_".');
    end;
  end;

  //Загрузка тестовых Xml
  function LoadXmlTest_: Variant;
  var
    xXml: Variant;
    xFileName: string;
  begin
    try
      Result := null;
      xFileName := GetXmlFileName_;
      

      if not FileExists( xFileName) then begin
        ShowMessage( FORMAT( 'Не найден тестовый пример: "%s".', [ xFileName]));
        Exit;
      end;
      xXml := CreateOleObject('Microsoft.XmlDom');
      if not xXml.Load( xFileName) then begin
        ShowMessage( FORMAT( 'Ошибка при загрузке файла: "%s".', [ xFileName]));
        Exit;
      end;
      Result := xXml;
      except
        ExceptionLog( 'Сбой скрипта: "Un_ToolsXml.XmlTestTask.LoadXmlTest_".');
    end;
  end;

begin

    try
      Result := NULL;
      if VarIsNull( aXml) then begin
        
        Result := LoadXmlTest_;
        if VarIsNull(Result)
          then HaltEx( 'Отладочный пример не создан. Отладка невозможна.', TRUE);
      end else begin
        if SaveXmlTest_ then Exit;
        Result := aXml;
      end;
      except
        ExceptionLog( 'Сбой скрипта: "Un_ToolsXml.XmlTestTask".');
    end;

end;


{~Move_To_ArhivEx
  надстройка над операцией Move_To_Arhiv - перемещение экспортируемых
  ЭД из входного задания в архив.
  позволяет отключать выполнение этой операции в опциях отладки.
  так же, опционно, можно сохранять параметр aXML в логе.
  aXml - экспортируемые документы из входного задания.}
procedure Move_To_ArhivEx( aXml: variant);
begin

    try

      Move_To_Arhiv( aXml);
      except
        ExceptionLog( 'Сбой Un_ToolsXml.Move_To_ArhivEx');
    end;

end;


{~GetAnnotationXmlStringEx_
  вспомогателдьная функция для рекурсивного вызова функции GetAnnotationXmlStringEx.
  это связано с ошибкой в fastscript. }
function GetAnnotationXmlStringEx_( aNode, aElementXml: Variant;
                                   aAnnotation: string;
                                   aPos: integer;
                                   var aSubStr: string): integer;
begin

    try
      Result := GetAnnotationXmlStringEx( aNode, aElementXml, aAnnotation, aPos, aSubStr);
      except
        ExceptionLog( 'Сбой Un_ToolsXml.GetAnnotationXmlStringEx_');
    end;

end;


{~GetAnnotationXmlStringEx
  функция возвращает разобранную строку (с заменой подстрок шаблонов),
  из строки aAnnotation начиная с позиции aPos.
  результат возвращается в параметре aSubStr.
  функция возвращает позицию символа в строке, перед которым завершен
  разбор строки.
  окончание разбора строки: достижение конца строки или обнаружение: " |".
  aNode - корневой узел описания ЭД.
  например:
    aAnnotation = "тест %поле%."
    aPos := 1
    узел "поле" в узле aNode = "123"
  в результате:
    aSubStr = "тест 123."
    aPos = 13
  функция разбирает условные шаблоны в строке aAnnotation вида: "%поле%|s1 |s2 |"
  при этом разбор подстрок s1 и s2 выполняется рекурсивно.
  так же допускается вложение условных подшаблонов друг в друга.
  в azk-exchange есть проблема, при которой если вызывать саму функцию
  рекурсивно, в параметре aSubStr возвращается пусто. хотя результат
  функции возвращается какой должен. поэтому рекурсия осуществляется через
  вспомогательную функцию GetAnnotationXmlStringEx_.}
function GetAnnotationXmlStringEx( aNode, aElementXml: Variant;
                                   aAnnotation: string;
                                   aPos: integer;
                                   var aSubStr: string): integer;
var
  s: string;
  xNode: Variant;
  xNodeValue: string;
  i: integer;
  xFound: boolean;
  s1,s2: string;
//  xPos: integer;
begin

    try
//      Result  := aPos;
      aSubStr := '';
      while (aPos <= LENGTH( aAnnotation)) do begin

        case aAnnotation[ aPos] of
          // начало шаблона %поле%. нужно выделить подстроку "поле".
          '%': begin
                s := '';
                // ищем окончание подстроки "%поле%" - символ "%" справа.

                repeat
                  INC( aPos);
                  if (aPos > LENGTH( aAnnotation)) then begin
                    // если достигнут конец строки, а завершающего символа
                    // "%" нету - считаем что разобранная часть (вместе с
                    // первым символом "%" - это не шаблон "поле%.
                    // поэтому добавляем ее к результату и выходим
                    aSubStr := aSubStr + '%' + s;
                    Result  := aPos;
                    EXIT;
                  end;
                  if (aAnnotation[ aPos] = '%') then begin

                    // дальше будем анализировать след.символ в строке
                    INC( aPos);
                    // найдено окончание подстроки "%поле%.
                    // ищем среди узлов название "поле". если такое есть
                    // значит это "поле" и будем подставлять туда значение
                    // узла из xml. если такого узла не найдем - подставляем
                    // строку %поле% как есть в строку результата.
                    xNodeValue := varToStr( aElementXml.GetAttribute( s));
{                    xFound := FALSE;
                    for i := 0 to aNode.attributes.length -1 do begin
                      xNode := aNode.attributes.item[i];
                      if (xNode.NodeName = s) then begin
                        xFound := TRUE;
                        // получаем значение узла
                        xNodeValue := VarToStr( xNode.NodeValue);
                        BREAK;
                      end;
                    end;//for//
}
(*
                    if NOT xFound then begin

                      aSubStr := aSubStr + '%' + s + '%';
                      BREAK;
                    end;
*)
                    // если сразу за %поле% идет символ "|" - значит это
                    // условное отображение. символ "|" не должен быть
                    // последним в строке.
                    if (aPos < LENGTH( aAnnotation)) then
                      if (aAnnotation[ aPos] = '|') then begin

                        // дальше будем анализировать след.символ в строке
                        INC( aPos);
                        // обнаружили %поле%|
                        // дальше требуется проанализировать строку типа:
                        // %поле%|... |... |, где все что ... - это подстроки,
                        // включая вложенные шаблоны или шаблоны с условиями.
                        // для этого выполняем рекурсивный вызов подпрограммы
                        // разбора строк, начиная с тек.позиции aPos.
//                        xPos := aPos;
//                        s1 := '';
//                        s2 := '';
                        aPos := GetAnnotationXmlStringEx_( aNode, aElementXml, aAnnotation, aPos, s1);
                        aPos := GetAnnotationXmlStringEx_( aNode, aElementXml, aAnnotation, aPos, s2);
//                        aPos := xPos;

                        // разобрали шаблон: %поле%|s1 |s2 |
                        // если значение узла %поле% пустое то возвращается
                        // s2, если значение не пустое - s1.
                        if (LENGTH( xNodeValue) > 0)
                          then aSubStr := aSubStr + s1
                          else aSubStr := aSubStr + s2;
                        BREAK;
                      end;
                    // в остальном случае заменяем шаблон на значени узла
                    aSubStr := aSubStr + xNodeValue;
                    BREAK;
                  end;
                  s := s + aAnnotation[ aPos];
                until FALSE;
              end;

          // чтобы выловить " |" нужно в начале проанализировать пробел,
          // а потом символ "|". такая комбинация символов обозначает конец
          // анализа строки. фактически это конец строки подшаблона:
          // %поле%|... |... |
          //           ^----^---- завершение строк шаблона
          ' ': begin
                if (aPos >= LENGTH( aAnnotation)) then begin
                  aSubStr := aSubStr + ' ';
                  BREAK;
                end;
                if (aAnnotation[ aPos + 1] = '|') then begin
                  // т.к. проанализировали 2 символа, переходим за подстроку " |"
                  aPos := aPos + 2;
                  BREAK;
                end;
                aSubStr := aSubStr + ' ';
                INC( aPos);
              end;

         // прочие символы попадают в результат
         else begin
                aSubStr := aSubStr + aAnnotation[ aPos];
                INC( aPos);
              end;
        end;//case//
      end;//while//
      Result := aPos;
      except
        ExceptionLog( 'Сбой Un_ToolsXml.GetAnnotationXmlStringEx');
    end;

end;
{
begin
  GetAnnotationXmlStringEx( aNode, aAnnotation, 1, Result);
end;
}

{~GetAnnotationXmlString
  получение строки аннотации (aAnnotation) из описания ЭД в виде XML (узел aNode).
  функция позволяет описывать строку аннотации представленной в виде шаблона,
  в которой строки шаблонов описываются в виде %атрибут%.
  где: атрибут - атрибут из описания ЭД (строки ЭД) в виде XML в узле aNode.
  результат: строка, с подставленными значениями строк подшаблонов.
  если строка аннотации не имеет шаблоныых строк, то эта строка возвращается
  как результат без изменений этой строки.}
function GetAnnotationXmlString( aNode{, aNodeSchema}: Variant;
                                 aAnnotation: string): string;
var
  xNode: Variant;
  i: integer;
  s: string;
//  xChanges: boolean;
begin

    try
      Result := aAnnotation;

      if (POS( '%', Result) > 0) then
//        repeat
//          xChanges := FALSE;
          for i := 0 to aNode.attributes.length -1 do begin
            xNode := aNode.attributes.item[i];
            s     := '%' + xNode.NodeName + '%';
  
            if (POS( s, Result) > 0)
              then Result := StringReplace( Result, s, VarToStr( xNode.NodeValue));
  //                                  VarToStr( xNode.GetAttribute(
  //                                                    xNode);
  
            if (POS( '%', Result) <= 0)
              then BREAK;
          end;//for//
        // выходим, если небыло никаких изменений
//        until NOT xChanges;

      except
        ExceptionLog( 'Сбой Un_ToolsXml.GetAnnotationXmlString');
    end;

end;


{~GetAnnotationNodeXml
  требуется вернуть описание раздела для указанного узла aNodeSchema схемы
  aSchema по данным из Xml списка ЭД (узел с ошибкой - aNodeXml).
  например:
    если узел ZR.LS_UBP_PAY будет с ошибкой (по схеме), то нужно вернуть
    описание раздела ZR - атрибут annotation.
    в этом случае, aNodeXml должен указывать на узел ZR.LS_UBP_PAY описания ЭД
    (раздел ZR) в списке ЭД aXml, а aNodeSchema должен указывать на
    ZR.LS_UBP_PAY в схеме (aSchema).

    при этом, если в указанном атрибуте (ZR.annotation) встретятся подстроки
    шаблонов полей в виде %имя%, то нужно подставить вместо этой подстроки
    значение из соответствующего атрибута aXml.
    при этом, искать атрибут нужно на уровне узла aNodeXml (т.е. среди списка
    атрибутов aNodeXml.parent).}
function GetAnnotationNodeXml( aNodeXmlDoc, aNodeXml, aNodeSchema: Variant): string;
var
//  xNode: Variant;
//  i: integer;
  s: string;
//  xPos: integer;
begin

    try
//      Result := '';
      // получаем значение описания раздела: это не атрибут а узел
      // для этого ищем узел annotation и берем его текст. если такого узла
      // не найдем - результат будет пустой строкой.
      Result := TRIM( aNodeSchema.selectSingleNode('annotation').text);
      (*
      for i := 0 to aNodeSchema.childNodes.Length -1 do begin
        xNode := aNodeSchema.childNodes.item[i];

        if (LowerCase( xNode.nodeName) = 'annotation') then begin

          Result := TRIM( VarToStr( xNode.text));
          BREAK;
        end;//case//
      end;//for//
      *)

      // проверяем, если строка описания содержит символ "%", значит в строке
      // могут содержаться строки шаблонов (поля описания ЭД)
      // в этом случае нужно заменить такие подстроки на значения из полей
      // XML описания ЭД.
      if (LENGTH( Result) > 0) then begin
        GetAnnotationXmlStringEx_( aNodeXmlDoc, aNodeXml, Result, 1, Result);
      end;

      except
        ExceptionLog( 'Сбой Un_ToolsXml.GetAnnotationNodeXml');
    end;

end;



{~ValidateFormatXml
  процедура валидации aXml согласно атрибутов pattern схемы aSchema.
  для проверки используется объект схемы aSchema и рег.выражений aRegExp.
  результат проверки сохраняется файле aFileValidate.
  
  aSourceFileName - имя файла данных, по которому сформирован aXml.
                    этот параметр является вспомогательным и отображается в
                    списке ошибок (в начале текста), для отображения имени
                    исходного файла.
  
  РЕЗУЛЬТАТ:
    =true - проверка успешеная.
    =false - проверка не пройдена. при этом в указанном файле формируется
             результат проверки.}
function ValidateFormatXml( aXml, aSchema, aRegExp: Variant;
                            aFileValidate: string;
                            aSourceFileName: string = ''): Boolean;


  { из-за проблемы с рекурсией, приходится делать вспомогательную подпрограмму.}
  procedure ValidateElement( aNodeXmlDoc: Variant;
                             aElement: Variant;
                             aParamName: string;
                             aErrors: TStringList;
                             aNodeLevel: integer;
                             var aLineFileOut: integer);
  begin
    
        try
          ValidateElement_(  aNodeXmlDoc,
                             aElement,
                             aParamName,
                             aErrors,
                             aNodeLevel,
                             aLineFileOut);
          except
            ExceptionLog( 'Сбой Un_ToolsXml.ValidateFormatXml.ValidateElement');
        end;
    
  end;

  {~ValidateElement_
    проверка узла данных aElement (xml выгружаемого документа. корневой
    элемент документа - aNodeXmlDoc).
    в результате выполняется проверка всех подэлементов узла (параметры
    выгружаемого раздела) и рекурсивно - всех его подразделов.
    все ошибки записываются в списке строк: aErrors.
    каждый раздел начинается с новой строки, что необходимо фиксировать
    в строках ошибки. номер строки, в которую выгружается текущий проверяемый
    раздел - aNodeLevel. в дальнейшем параметр инкрементируется при переходе
    к проверке подраздела и следующих разделов.
    особенность в описании ошибок в том, что нужно описывать описание
    шапки документа (например раздел ZR), и дальше все ошибки в его подразделах.
    поскольку функция рекурсивная, для определения корневого раздела документа
    вводится уровень узла - aNodeLevel. когда проверяется корневой раздел
    документа или разделы FROM,TO,FK, то значение =1. при проверке подразделов
    значение увеличивается. это дает возможность отображать только одну строку
    шапки документа, если есть ошибки в его разделах или подразделах.
    для отображения полного названия узла (ZR.PPST.NAME или подобное),
    вводится параметр aParamName, в котором накапливается строка имени
    проверяемого узла. при проверке подэлементов в строку добавляется
    имя текущего проверяемого раздела с разделителем ".". в результате,
    если подэлементов много, то формируется строка с перечислением всех
    родительских разделов в xml.}
  procedure ValidateElement_( aNodeXmlDoc: Variant;
                             aElement: Variant;
                             aParamName: string;
                             aErrors: TStringList;
                             aNodeLevel: integer;
                             var aLineFileOut: integer);
  var
    i,i2: Integer;
    xSchemaElement: Variant;
    xSchemaElementDoc: Variant;
    xSchemaNode: Variant;
    xValidateText: string;
    xElementNodeName: string;
    xNode: Variant;
    xNode2: Variant;
    xNodeName: string;
    xNodeValue: string;
    xNodePattern: Variant;
    xPattern: string;
    xPatternText: string;
    xAnnotationText: string;
    xParamName: string;
    parentNode: Variant;
    MatchCol, Match: Variant;
    xFound: boolean;
    xTopicAnnotation: string;
    xErrorsCount: integer;
  begin
    try

      // номер раздела в выходном файле.
      // фактически это номер строки, в которую будет выгружаться текущий раздел
      // в файле aSourceFileName.
      // каждый раздел начинается с новой строки.
      INC( aLineFileOut);
      // сохраняем имя проверяемого узла. это ускорит последующую проверку.
      xElementNodeName := aElement.nodeName;
      // полное имя (с учетом узлов верхнего уровня)
      xParamName := aParamName + xElementNodeName;


      // ищем узел в схеме по имени проверяемого узла для проверки элемента.
      // не рекомендуется применять selectSingleNode, посколку функция
      // сбоит, если искомый удел отсутствует.
      xSchemaElement := NULL;
      for i2 := 0 to aSchema.documentElement.childNodes.Length -1 do begin
        xNode2 := aSchema.documentElement.childNodes.item[i2];
        if (xNode2.NodeName = xElementNodeName) then begin
          xSchemaElement := xNode2;
          BREAK;
        end;
      end;//for//
      if VarIsNull( xSchemaElement) then begin

        // тут сообщение в окно, что узел недопустим по схеме
        ShowMessage( format( 'В полученном XML раздел "%s" не описан в схеме.',
                              [ xElementNodeName]));
        xValidateText := '';
//        xTopicAnnotation := '';
      end else begin
        // корректируем аннотацию к узлу

        aRegExp.Pattern := '%[_,A-Z]{1,30}%';
        xValidateText := xSchemaElement.selectSingleNode('annotation').text;
        MatchCol := aRegExp.Execute( xValidateText);
        for i := 0 to MatchCol.Count - 1 do begin
          Match := MatchCol.Item[i];



          xValidateText := StringReplace(
                              xValidateText,
                              Match.Value,
                              aElement.getAttribute(
                                Copy( Match.Value, 2, Length(Match.Value) - 2)));
        end;//for//


      end;
      xTopicAnnotation := xValidateText;

      if (aNodeLevel = 1) then begin
        // запоминаем число ошибок на текущий момент.
        // это понадобится позже.
        xErrorsCount := aErrors.Count;

      end;

      // Проверяем атрибуты узла по схеме

      for i := 0 to aElement.attributes.length - 1 do begin
        xNode := aElement.attributes.items[i];
        xNodeName := xNode.nodeName;

          xNodeValue:= VarToStr( xNode.nodeValue);
          // получаем узел схемы проверки по имени атрибута

          xSchemaNode := NULL;
          for i2 := 0 to xSchemaElement.childNodes.Length -1 do begin
            xNode2 := xSchemaElement.childNodes.item[i2];
            if (xNode2.NodeName = xNodeName) then begin
              xSchemaNode := xNode2;
              BREAK;
            end;
          end;//for//
          if VarIsNull( xSchemaNode) then begin
            // тут сообщение в окно, что узел недопустим по схеме
            aErrors.Add(
                  format( 'В полученном XML узел "%s.%s" не описан в схеме.',
                          [ xElementNodeName,
                            xNodeName]));
            CONTINUE;
          end;
          if (xSchemaNode.childNodes.Length <= 0) then begin
            // тут сообщение в окно, что узел недопустим по схеме
            aErrors.Add( format( 'В полученном XML узел "%s.%s" не описан в схеме.',
                                  [ xElementNodeName,
                                    xNodeName]));
            CONTINUE;
          end;
          // получаем текст описания шаблона проверки и описания узла в схеме.
  
          xPatternText := '';
          xAnnotationText := '';
          for i2 := 0 to xSchemaNode.childNodes.Length -1 do begin
            xNode2 := xSchemaNode.childNodes.item[i2];
  
            case LowerCase( xNode2.nodeName) of
              'pattern'    : xPatternText := VarToStr( xNode2.text);
              'annotation' : xAnnotationText := TRIM( VarToStr( xNode2.text));
            end;//case//
          end;//for//
          // получаем описание шаблона проверки.
  
          // если атрибут шаблона не указан - отмечаем это в логе
          if XmlAttrExists( xSchemaNode, 'pattern')
            then xPattern := TRIM( xSchemaNode.getAttribute( 'pattern'))
            else xPattern := '';
          if ( LENGTH( xPattern) <= 0) then begin
  
            CONTINUE;
          end;
  
          // выполняем проверку значения атрибута по схеме.
          // если провека успешная, переходим к след.узлу.
          aRegExp.Pattern := xPattern;
          if aRegExp.Test( xNodeValue) then begin
  
            CONTINUE;
          end;

          { при отображении подразделов, необходимо отобразить описание
            раздела (см.заполнение annotation). если узел - описание ЭД
            (уровень 1), то аннотация вписывается после проверки всех
            элементов и подэлементов ЭД.
            если это подузел (например, ZVDOC в ЭД ZV), то нужно отобразить
            описание раздела ZVDOC. в этом случае добавляем это описание
            перед описанием элемента (атрибута).}
          if (aNodeLevel > 1)
            then aErrors.Add(
                    FORMAT(        'Ошибка в параметре (стр:%d): "%s"'
                            +#13#10'    %s'
                            +#13#10'    Атрибут: "%s" = "%s";'
                            +#13#10'    Описание: "%s".',
                            [ aLineFileOut,
                              xAnnotationText,
                              xTopicAnnotation,
                              xNodeName,
                              xNodeValue,
                              xPatternText]))
            else aErrors.Add(
                    FORMAT(        'Ошибка в параметре (стр:%d): "%s"'
                            +#13#10'    Атрибут: "%s" = "%s";'
                            +#13#10'    Описание: "%s".',
                            [ aLineFileOut,
                              xAnnotationText,
                              xNodeName,
                              xNodeValue,
                              xPatternText]));

      end;//for//
      // проверяем вложенные узлы

      for i := 0 to aElement.childNodes.length - 1
        do ValidateElement( aNodeXmlDoc,
                            aElement.childNodes.items[i],
                            xParamName + '.',
                            aErrors,
                            aNodeLevel + 1,
                            aLineFileOut);


      { после того как проверены все подэлементы корневого узла раздела/ЭД
        проверяем, если число ошибок прибавилось, значит добавляем перед новыми
        ошибками строку аннотации раздела. такая строка описания ЭД будет одна
        на все ошибки подэлементов такого ЭД.}

      if (aNodeLevel = 1) then begin

        if (aErrors.Count > xErrorsCount)
          then aErrors.Insert( xErrorsCount, #13#10 + xTopicAnnotation);
      end;

      
      except
        ExceptionLog( 'Сбой подпрограммы: "Un_ToolsXml.ValidateFormatXml.ValidateElement_".');
    end;
  end;

var
  xValidateFile: TStringList;
  xNodeAnnotation: Variant;
  xNode: Variant;
  i, xLineFileOut: Integer;
begin
  try

//    LogXML( 'Проверяемый документ (aXml):', aXml);
//    LogXML( 'Схема (aSchema):', aSchema);
    SetProgressBar( 0, aXml.documentElement.childNodes.length);
    WriteLog('Валидация ...', True);
    xValidateFile := TStringList.Create;
    try
      try
        // номер строки раздела в выходном файле
        xLineFileOut := 0;
        for i := 0 to aXml.documentElement.childNodes.length - 1 do begin
          ShowProgress( i);
          xNode := aXml.documentElement.childNodes.items[i];
          ValidateElement( xNode, xNode, {NULL, }'', xValidateFile, 1, xLineFileOut);
        end;
        except
          ExceptionLog( 'Сбой проверки элементов.');
      end;
      Result := (xValidateFile.Count <= 0);
      if NOT Result then begin
        WriteLog('Вывод результатов валидации в лог ...', True);
        // в журнал ошибок помещаем примечание в описании схемы
        xNodeAnnotation := aSchema.documentElement.selectSingleNode('annotation');
        if NOT VarIsNull( xNodeAnnotation)
          then xValidateFile.Insert( 0, xNodeAnnotation.Text);
        // теперь в начало журнала помещаем имя исходного файла
        if (LENGTH( aSourceFileName) > 0)
          then xValidateFile.Insert(
                  0, FORMAT( 'Проверяемый файл: "%s".'#13#10, [ aSourceFileName]));

        // сохраняем ошибки в указанном файле
        if ( LENGTH( aFileValidate) > 0)
          then xValidateFile.SaveToFile( aFileValidate)
          else WriteInfo( 'Ошибки валидации:'#13#10 + xValidateFile.Text);
      end;
      finally
        xValidateFile.Free;
    end;
    ShowProgress( 0);
    StatusBarSimpleText( '');
    // Вывод пользователю результата валидации

    except
      ExceptionLog( 'Сбой скрипта: "Un_ToolsXml.ValidateFormatXml".');
  end;
end; {End ValidateFormat}


{~TextFileToNewXmlEx
  сохраняем XML в текстовом файле с разделителями согласно схеме aSchema.}
function TextFileToNewXmlEx( aFileName, aRootName: String; var aSchema: Variant): Variant;
begin
  try
    
    
    Result := CreateOleObject('Microsoft.XmlDom');
    Result.appendChild( Result.createElement( aRootName));
    if NOT TextFileToXmlEx( aFileName, Result, aSchema) then begin
      WriteInfo( FORMAT( 'Файл %s не будет обрабатываться, поскольку он загружен с ошибками.',
                          [ aFileName]));
      Result := NULL;
    end;
    
    except
      ExceptionLog( 'Сбой скрипта: "Un_ToolsXml.TextFileToNewXml".');
  end;
end;

{~TextFileToXmlEx
  загрузка текстового файла данных aFileName в XML (aToXml) согласно схеме aSchema.
  функция доработана с учетом специфики операции Xml: getElementsByTagName.
  параметры:
    aFileName - имя загружаемого файла исходных данных;
    aToXml - корневой документ XML, в который будет выполнена загрузка данных
              из файла. XML должен быть создан, а этот параметр должен быть передан
              указатель на XML.ownerdocumetn.
    aSchema - указатель на XML схемы. сюда нужно передавать не ownerdocumetn
              а сам XML схемы.

  exchange #2571
    выполнеа доработка:
    теперь это функция, которая возвращает:
      =true - файл успешно загружен;
      =false - файл загружен с ошибками.
    ошибки записываются в журнал info.

    раньше, если были обнаружены ошибки при загрузке файла, возбуждалось
    исключение, приводящее к прерыванию работы скрипта. теперь файл загружается
    полностью, и если будут ошибки - они будут описаны в журнале info,
    и результат загрузки будет =FALSE.}
function TextFileToXmlEx( aFileName: String;
                          var aToXml: Variant;
                          var aSchema: Variant): boolean;
var
  i, j: Integer;
  xValue: TStringList;
  xNodeSchema: Variant;
  xNode2: Variant;
  xXml: Variant;
  xXmlNode: Variant;
  SL: TStringList;
  s,sv: string;
  xSchema: Variant;
begin
  Result := TRUE;   // пока считаем что файл загружен
  try

    WriteLog( 'Заполнение данных из файла: ' + aFileName, True);
    // берем корневой узел схемы. это даст немного скорости при поиске
    // узлов в схеме.
    xSchema := aSchema.documentElement;
    // создаем список значений параметров исходного файла.
    // в этом списке будем разбирать значение каждого из разделов входного
    // файла.
    xValue := TStringList.Create;
    try
      xValue.Delimiter := '|';
      // список строк исходного файла
      SL := TStringList.Create;
      try
        xXml := aToXml.documentElement;
        SL.LoadFromFile( aFileName);

        SetProgress( 0, SL.Count);     // установка прогресс бара 0...count
        for i := 0 to SL.Count - 1 do begin
          ShowProgress(i);     // прогресс
          s := StringReplace( SL.Strings[i], 'combo', '');
          xValue.DelimitedText := StringReplace(StringReplace(s, ' ', 'combo'), '"', 'hooks');

          if (xValue.Count - 1) > 0 then begin
            xValue.Delete( xValue.Count - 1);
            for j := 0 to xValue.Count - 1
              do xValue[j] := StringReplace(StringReplace(xValue[j], 'combo', ' '), 'hooks', '"');
            // имя параметра
            sv := xValue.Strings[0];

            // ищем элемент схемы. в результате возвращается список узлов, если
            // что либо найдено, либо NULL.

            xNodeSchema := NULL;
            for j := 0 to xSchema.childNodes.Length - 1 do begin
              xNode2 := xSchema.childNodes.item[ j];
              if (xNode2.NodeName = sv) then begin
                xNodeSchema := xNode2;
                BREAK;
              end;
            end;//for//

            if VarIsNull( xNodeSchema) then begin
              // exchange #2571
              // фиксируем, что файл загружен с ошибкой,
              // записываем ошибку в журнал и продолжаем загрузку файла.
              Result := FALSE;
              WriteInfo( FORMAT( 'Ошибка загрузки файла %s. В схеме не найден блок <%s>',
                                  [ aFileName,
                                    sv]));
            end else begin

              if (xValue.Count <> xNodeSchema.childNodes.length)
                then begin
                  // exchange #2571
                  // фиксируем, что файл загружен с ошибкой,
                  // записываем ошибку в журнал и продолжаем загрузку файла.
                  Result := FALSE;
                  WriteInfo( FORMAT( 'Ошибка загрузки файла %s. В блоке <%s> не совпадает количество полей описанных в схеме: '
                                   +'в схеме = %d, в файле = %d.',
                                   [ aFileName,
                                     sv,
                                     xNodeSchema.childNodes.length,
                                     xValue.Count]));
                end else begin
                  // берем первый найденный элемент из результата поиска
                  xXmlNode := xXml.appendChild( aToXml.createElement( sv));

                  for j := 1 to xNodeSchema.childNodes.Length - 1
                    do xXmlNode.setAttribute( xNodeSchema.childNodes.item[j].nodeName,
                                              xValue.Strings[j]);

                end;
            end;
          end;
        end;//for//
        finally
          SL.Free;
      end;
      finally
        xValue.Free;
    end;
    ShowProgress( 0);

    except
      ExceptionLog( 'Сбой скрипта: Un_ToolsXml.TextFileToXmlEx.');
  end;
end;


{~GetXmlDataVersion
  возвращает версию XML данных из раздела FK.}
function GetXmlDataVersion( var aXml: Variant): string;
var
  xNode: Variant;
begin
  try
    
    Result := '?';
    // ищем раздел FK в корневых элементах
    xNode := aXml.documentElement.selectSingleNode('FK');
    if VarIsNull( xNode)
      then WriteLog( 'Не найден раздел FK.')
      else
        if NOT XmlAttrExists( xNode, 'NUM_VER')
          then WriteLog( 'В разделе FK не найден атрибут "NUM_VER".')
          else Result := xNode.getAttribute( 'NUM_VER');
    
    
    except
      ExceptionLog( 'Сбой скрипта: "Un_ToolsXml.GetXmlDataVersion".');
  end;
end;


{~CompareXmlDataVersion
  проверка версии XML данных aXml с версией схемы aVersionSchema.
  результат =TRUE, если обе версии совпадают.
  если результат проверки отрицательный, то дополнительно логируем
  текст aMsgLog в пользовательском журнале. в тексте aMsgLog можно указывать
  спец слова, которые будут заменены на соответствующие версии:
    $VER_SCHEMA$ - версия схемы;
    $VER_XML$ - версия XML.
  например:
    версия $VER_XML$ не поддерживается.
  при наличие версии XML = "123" будет отображено в журнале:
    версия 123 не поддерживается. }
function CompareXmlDataVersion( var aXml: Variant;
                                aVersionSchema: string;
                                aMsgLog: string = ''): boolean;
var
  xVersionXml: string;
begin
  try
    
    xVersionXml   := GetXmlDataVersion( aXml);
    Result        := (xVersionXml = aVersionSchema);
    
    // если результат проверки отрицательный, то дополнительно логируем
    // текст в пользовательском журнале. для этого проверяем, если указан
    // параметр aMsgLog (не пустая строка), форматируем этот текст, заменяя
    // спец.строки на тексты версий и записываем в лог.
    if NOT Result then begin
      if (LENGTH( aMsgLog) > 0)
        then WriteInfo(
                StringReplace(
                  StringReplace(
                    aMsgLog,
                    '$VER_SCHEMA$', aVersionSchema),
                  '$VER_XML$', xVersionXml),
                FALSE);
    end;
    
    except
      ExceptionLog( 'Сбой скрипта: "Un_ToolsXml.CompareXmlDataVersion".');
  end;
end;


{~AttrToBoolean
  возвращает значение атрибута aAttrName в узле aNode типа boolean.
  это расширенный аналог StrToBool.
  возвращает:
    =true, если значение атрибута = "true" (регистр произвольный);
    =false - значение атрибута имеет любое другое значение, пустое или
              атрибут отсутствует.}
function AttrToBoolean( aNode: Variant; aAttrName: string): boolean;
begin

    try
      Result := (UPPERCASE( GetNodeAttributeEx( aNode, aAttrName)) = 'TRUE');
      except
        ExceptionProc( 'AttrToBoolean');
    end;

end;


procedure SetAttributeBoolean( aNode: Variant; aAttrName: string; aValue: boolean);
begin

    try
      if aValue
        then aNode.SetAttribute( aAttrName, 'True')
        else aNode.SetAttribute( aAttrName, 'False');
      except
        ExceptionProc( 'SetAttributeBoolean');
    end;

end;


{~CurrAttributeIsNotZero_
  возвращает числовое поле aAttrName узла aNode в aValue и проверяет его на 0.
  если поле пустое, возвращается FALSE и значение 0.
  результат:
    =true, если aValue <> 0.00;
    =false, если aValue = 0.00.}
function CurrAttributeIsNotZero_( aNode: Variant; aAttrName: string;
                               var aValue: Currency): boolean;
var
  s: string;
begin

    try
      s := GetNodeAttributeEx( aNode, aAttrName);
      if (LENGTH( s) <= 0) then begin
        aValue := 0.0;
        Result := FALSE;
      end else begin
        aValue := StrToCurr( s);
        Result := (Format('%0.2f', [ aValue]) <> '0.00');
      end;

      except
        ExceptionProc( 'CurrAttributeIsNotZero_');
    end;

end;


{~SetCurrAttribute_
  exchange #3095
  сохраняет числовое значение aValue в атрибуте aAttrName узла aNode.
  реализуя выгрузку числового поля через эту подпрограмму
  будет достигнута унификация кода.
  если число = 0, то если aNullIsEmpty=true, то в атрибуте сохраняется
  пустое значение. это иногда нужно при выгрузке в ФК, когда необходимо
  нулевое число выгружать пустым значением.}
procedure SetCurrAttribute_( aNode: Variant;
                             aAttrName: string;
                             aValue: Currency;
                             aNullIsEmpty: boolean = FALSE);
var
  s: string;
begin

    try
      s := Format('%0.2f', [ aValue]);
      if (s <> '0.00')
        then aNode.SetAttribute( aAttrName, s)
        else
          if aNullIsEmpty
            then aNode.SetAttribute( aAttrName, '')
            else aNode.SetAttribute( aAttrName, s);

      except
        ExceptionProc( 'SetCurrAttribute_');
    end;

end;


{~SummCurrAttribute_
  exchange #3095
  суммирует числовое поле aAttrName узла aNode с числом aValue.
  если число = 0, то если aNullIsEmpty=true, то в атрибуте сохраняется
  пустое значение. это иногда нужно при выгрузке в ФК, когда необходимо
  нулевое число выгружать пустым значением.}
procedure SummCurrAttribute_( aNode: Variant;
                              aAttrName: string;
                              aValue: Currency;
                              aNullIsEmpty: boolean = FALSE);
var
  xCurr: Currency;
begin

    try
      if CurrAttributeIsNotZero_( aNode, aAttrName, xCurr)
        then SetCurrAttribute_( aNode, aAttrName, aValue + xCurr, aNullIsEmpty)
        else SetCurrAttribute_( aNode, aAttrName, aValue, aNullIsEmpty);
        {
      xCurr := StrToCurr( GetNodeAttributeEx( aNode, aAttrName)) + aValue;//StrToCurr( aValue);
      aNode.SetAttribute( aAttrName, Format('%0.2f', [ xCurr]));
      }
      except
        ExceptionProc( 'SummCurrAttribute_');
    end;

end;

{DoAppendUniqueChild
Добавление строк в xml-документа по уникальному набору полей (ключу)
При нахождении в документе аналогичной строки, происходит апдейт сумм}
procedure DoAppendUniqueChild(aXmlDoc, aXmlLine: variant; sUniqueFieldList, sAmtList, sMarker: String);

function DoGetFieldsValue_(aNode: Variant): string;
var
  fList: TStringList;
  i: Integer;
  s: String;
begin

  try
    s := '';
    fList := TStringList.Create;
    fList.Delimiter := ',';
    fList.DelimitedText := sUniqueFieldList;
    for i := 0 to fList.Count - 1 do
    begin
      if ((i > 0) and (i < fList.Count - 1)) then
        s := s + '|';
      s := s + GetNodeAttributeEx( aNode, fList.Strings[i]);
    end;
  finally
    fList.Free;
    Result := s;
  end;

end;

var
  fValueList: TStringList;
  i: Integer;
  s, sFieldName: String;
  xNode: Variant;
  xCurr: Currency;
begin

  fValueList := TStringList.Create;
  try
    fValueList.Delimiter := ',';
    fValueList.DelimitedText := sAmtList;

    s := DoGetFieldsValue_(aXmlLine);
    for i := aXmlDoc.childNodes.length - 1 downto 0 do
    begin
      xNode := aXmlDoc.childNodes.items[i];
      if (xNode.NodeName <> sMarker) then
        BREAK;
      if (s = DoGetFieldsValue_( xNode)) then
      begin
        // совпадение полей - суммируем суммы и все
        for i := 0 to fValueList.Count - 1 do
        begin
          sFieldName := fValueList.Strings[i];
          if CurrAttributeIsNotZero_( aXmlLine, sFieldName, xCurr) then
            SummCurrAttribute_( xNode, sFieldName, xCurr);
        end;
        EXIT;
      end;
    end;
    aXmlDoc.AppendChild( aXmlLine);
  finally
    fValueList.Free;
  end;

end;


begin
end.
