{
        вспомогательный модуль разных операций с XML.
}
{не удалять эту строку
uses
  'Un_Progress',
  'Un_System',
  'Un_Log',
  'Un_Debug';
{не удалять эту строку}

{~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( var 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
    
//    LogStart( 'Выполняется: Un_ToolsXml.GetNodeAttribute');
    Result  := FALSE;
    xResult := aDefaultValue;
    if VarIsNull( aXml) then begin
      
      EXIT;
    end;
    // ищем название атрибута. для этого ищем "@" и до конца строки будет
    // название атрибута.
    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
                  if (xNode.childNodes.items[i].nodeName = xNodeName) then begin
                    xNodeFound := xNode.childNodes.items[i];//xNode.selectSingleNode( xNodeName);
                    BREAK;
                  end;
                xNode := xNodeFound;
              end;
        end;//case//
    until FALSE;
    
//    LogEnd( 'Выполнено: Un_ToolsXml.GetNodeAttribute');
    except
      ExceptionLog( 'Сбой скрипта: "Un_ToolsXml.GetNodeAttribute".');
  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;

{~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( var aXml: Variant;
                                xPath: string;
                                aDefaultValue: string = ''): string;
begin
  try
    GetNodeAttribute( aXml, xPath, Result, aDefaultValue);
    except
      ExceptionLog( 'Сбой скрипта: "Un_ToolsXml.GetNodeAttributeValue".');
  end;
end;


{~CopyAttrValue
  макрос: (атрибут_источник, аттр_приемник).
  копирует атрибут xFromXmlPath (полуный путь к атрибуту) из xFromXml,
  в узел xToNode с названием атрибута в этом узле: xToAddrName.
  например:
    xDocLine.setAttribute( 'ORG_ID', GetNodeAttributeValue( xXmlOrg, '//*/@ID'));
  выполнит:
    копирование атрибута //*/@ID из xXmlOrg в атрибут ORG_ID узла xDocLine.}
procedure CopyAttrValue( var xFromXml: Variant; xFromXmlPath: string;
                         var xToNode: Variant; xToAddrName: string);
begin
  xToNode.setAttribute( xToAddrName,
                        GetNodeAttributeValue( xFromXml, xFromXmlPath));
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
      ExceptionLog( 'Сбой скрипта: "Un_ToolsXML.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));
        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
    
    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;
    finally
      
  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;


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

  procedure ValidateElement( aElement: Variant;
                             aParamName: string;
                             aErrors: TStringList);
  var
    i,i2: Integer;
    xSchemaElement: 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;
  begin
    try
      
      // сохраняем имя проверяемого узла. это ускорит последующую проверку.
      xElementNodeName := aElement.nodeName;
      // полное имя (с учетом узлов верхнего уровня)
      xParamName := aParamName + xElementNodeName;
      
{
      LogXml( FORMAT( 'Анализируется узел "%s" (%s):',
                      [ xElementNodeName,
                        xParamName]),
              aElement);
}
      // ищем узел в схеме по имени проверяемого узла для проверки элемента.
      xSchemaElement := aSchema.documentElement.selectSingleNode( xElementNodeName);
      if VarIsNull( xSchemaElement) then begin
        
        xValidateText := '';
      end else begin
        // корректируем аннотацию к узлу
        aRegExp.Pattern := '%[_,A-Z]{1,30}%';
        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;
      // Проверяем атрибуты узла по схеме

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

        if VarIsNull( xNode.nodeValue)
          then xNodeValue:= ''
          else xNodeValue:= xNode.nodeValue;
        // получаем узел схемы проверки по имени атрибута
        xSchemaNode := xSchemaElement.selectSingleNode( xNodeName);
        if VarIsNull( xSchemaNode) then begin
          
          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 := xNode2.text;
            'annotation' : xAnnotationText := TRIM( 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 CONTINUE;
        // если проверка не выполнена, описываем ошибку проверки сразу в
        // списке ошибок
        aErrors.Add(
              FORMAT(  #13#10'Ошибка в параметре: "%s"'
                      +#13#10'    Раздел: "%s" (%s);'
                      +#13#10'    Атрибут: "%s" = "%s";'
                      +#13#10'    Описание: "%s".',
                      [ xAnnotationText,
                        xParamName,
                        xValidateText,
                        xNodeName,
                        xNodeValue,
                        xPatternText]));
      end;//for//
      // проверяем вложенные узлы

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

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

var
  xValidateFile: TStringList;
  xNodeAnnotation: Variant;
  i: Integer;
begin
  try

//    LogXML( 'Проверяемый документ (aXml):', aXml);
//    LogXML( 'Схема (aSchema):', aSchema);
    SetProgressBar( 0, aXml.documentElement.childNodes.length);
    WriteLog('Валидация ...'{, True});
    xValidateFile := TStringList.Create;
    try
      for i := 0 to aXml.documentElement.childNodes.length - 1 do begin
        ShowProgress( i);
        ValidateElement( aXml.documentElement.childNodes.items[i],
                         '',
                         xValidateFile);
      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));
    TextFileToXmlEx( aFileName, Result, aSchema);
    
    except
      ExceptionLog( 'Сбой скрипта: "Un_ToolsXml.TextFileToNewXml".');
  end;
end;

{~TextFileToXmlEx
  сохраняем XML в текстовом файле с разделителями согласно схеме aSchema.}
procedure TextFileToXmlEx( aFileName: String; var aToXml: Variant; var aSchema: Variant);
var
  i, j: Integer;
  xValue: TStringList;
  xNodeSchema: Variant;
  xXml: Variant;
  xXmlNode: Variant;
  SL: TStringList;
  s,sv: string;
  xSchema: Variant;
begin
  try
    
    WriteLog( 'Заполнение данных из файла: ' + aFileName{, True});
    // получаем корневой элемент схемы
//    LogXml( 'Схема:', aSchema);
    // берем корневой узел схемы. это даст немного скорости при поиске
    // узлов в схеме.
    xSchema := aSchema.documentElement;
//    LogXml( 'Схема:', xSchema);
    // создаем список значений параметров исходного файла.
    // в этом списке будем разбирать значение каждого из параметров входного
    // файла.
    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 := xSchema.getElementsByTagName( sv);
            if VarIsNull( xNodeSchema)
              then raise( FORMAT( 'Параметр "%s" не райден в схеме.', [ sv]));
            if xNodeSchema.Length = 0
              then raise( FORMAT( 'В схеме не найден блок <%s>', [ sv]));
            // берем первый найденный элемент из результата поиска
            xNodeSchema := xNodeSchema.item[0];
            if (xValue.Count <> xNodeSchema.childNodes.length)
              then raise( FORMAT( 'В блоке <%s> не совпадает количество полей описанных в схеме: '
                                 +'в схеме = %d, в файле = %d.',
                                 [ sv,
                                   xNodeSchema.childNodes.length,
                                   xValue.Count]));
            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;//for//
        finally
          SL.Free;
      end;
      finally
        xValue.Free;
    end;
    ShowProgress( 0);

    except
      ExceptionLog( 'Сбой скрипта: "Un_ToolsXml.TextFileToXml".');
  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;

begin
end.
