-- Шаблон создан мастером бланков
-- 27.01.2011 12:37:13
--
БланкСШаблоном "Процедуры и функции работы с XML";


var BufAtName[]:S;
var BufAtVal[]:S;
var Buf0[]:S;
var Buf1[]:S;
var Buf2[]:S;
var Buf3[]:S;
var Buf4[]:S;
var Buf5[]:S;
var Buf6[]:S;
var Buf7[]:S;
var Buf8[]:S;
var Buf9[]:S;
var Content[]:S;
var Result[]:S;

var Namespaces[]:S;

var Namespace_url:S;
var Namespace_code:S;


var Depth[]:S;--Список открытых тегов

var DocOle:AutoObject;
var ContextOle:AutoObject;


var Mode:I;--0-текст;1-MSXML..

Func XMLHead(encoding:S):S;
 return '<?xml version="1.0" encoding="'+encoding+'"?>'+chr(10);
end;

func Installed(Warning:L):L;
var res:L;
var test:AutoObject;
  try
    try
      test=OpenAutoObject("Msxml2.DOMDocument.6.0",true);
      res=true;
    except
      res=False;
    end;
  finally
    ClearVariable(test);
  end;
  if Warning and not res:
     Message("Компонент для работы с XML не установлен"+chr(13)+"Установите MSXML 6.0 по ссылке http://goo.gl/Mi9yd",mtError);
  fi;
  ^res;
end;

Func LoadXml2OLE(XML:S):AutoObject;
var Result,err:AutoObject;
  Result=OpenAutoObject("Msxml2.DOMDocument.6.0",true);
  try
    Result.Async=False;
    Result.ValidateOnParse=True;
    Result.Load(XML);
    err=AsAutoObject(Result.parseError);
    try
     if AsInteger(err.errorcode)<>0 then
        Trace(AsString(err.reason));
     fi;
    finally
     ClearVariable(err);
    end;
  except
    Trace("Ошибка при загрузке документа "+XML);
    ClearVariable(Result);
  end;
^Result;
end;

Func XSLT_Ole2Ole(xml:AutoObject;XSLT:S):AutoObject;
var xsl:AutoObject;
var Result:AutoObject;
  Result=OpenAutoObject("Msxml2.DOMDocument.6.0",true);
  result.async = false;
  result.validateOnParse = true;
  if XSLT="": ^result; fi;
  try
   xsl=LoadXml2OLE(XSLT);
   xml.transformNodeToObject(xsl,Result);

  finally
    ClearVariable(xsl);
  end;
^Result;
end;

Func XSLT_Ole2S(xml:AutoObject;XSLT:S):S;
var xsl:AutoObject;
var Res:S;
  Res="";
  xsl=LoadXml2OLE(XSLT);
  try
   Res=AsString(xml.TransformNode(xsl));
  finally
    ClearVariable(xsl);
  end;
^Res;
end;

Func XSLT_S(Src:S;XSLT:S):S;
var Result:S;
var xml:AutoObject;
  xml=LoadXml2OLE(Src);
  try
    Result=XSLT_Ole2S(xml,XSLT);
  finally
    ClearVariable(xml);
  end;
^Result;
end;

Proc XSLT_Ole2F(xml:AutoObject;XSLT:S;Target:S);
var xsl:AutoObject;
var R:AutoObject;
var wri:AutoObject;

  R=OpenAutoObject("ADODB.Stream",true);
  xsl=LoadXml2OLE(XSLT);
  try
   try
     R.Type=1;
     R.Open;
     xml.transformNodeToObject(xsl,R);
     R.SaveToFile(Target,2);
   finally
     ClearVariable(wri);
   end;
  finally
    ClearVariable(xsl);
    ClearVariable(R);
  end;
end;

Proc XSLT(Src:S;XSLT:S;Target:S);
var xml:AutoObject;
  xml=LoadXml2OLE(Src);
  try
    XSLT_Ole2F(xml,XSLT,TARGET);
  finally
    ClearVariable(xml);
  end;
--ExecuteProgram(Раб.Бюджет2005.Контроль2Слэш("cmd /k " +  PlanVar("Std_rpo")+"\Bin\msxsl.exe")+" "+Src+" "+XSLT+" -o "+Target);
end;

func ПростойXPath(xml:AutoObject;XPath:S;Value:S;Sep:S):S;
var xs,root,templat,select,sepnod,septxt:AutoObject;
var Res:S;
  try
  xs=OpenAutoObject("Msxml2.DOMDocument.6.0",true);--СоздатьOLE;
  xs.async=False;
  xs.loadXML('<?xml version="1.0" encoding="windows-1251"?><xsl:stylesheet version="1.0" xmlns:xsl="http://www.w3.org/1999/XSL/Transform"><xsl:output method="text" encoding="windows-1251"/></xsl:stylesheet>');
  root=AsAutoObject(xs.documentElement);
  if XPath<>'/':
    templat=AsAutoObject(xs.createNode(1,"xsl:template","http://www.w3.org/1999/XSL/Transform"));
    templat.SetAttribute("match","/");
    root.AppendChild(templat);
    select=AsAutoObject(xs.createNode(1,"xsl:apply-templates","http://www.w3.org/1999/XSL/Transform"));
    select.SetAttribute("select",XPath);
    templat.AppendChild(select);
    ClearVariable(select);
    ClearVariable(templat);

  fi;
  templat=AsAutoObject(xs.createNode(1,"xsl:template","http://www.w3.org/1999/XSL/Transform"));
  templat.SetAttribute("match",XPath);
  root.AppendChild(templat);
  select=AsAutoObject(xs.createNode(1,"xsl:value-of","http://www.w3.org/1999/XSL/Transform"));
  select.SetAttribute("select",Value);
  templat.AppendChild(select);
  if Sep<>"":
     sepnod=AsAutoObject(xs.createNode(1,"xsl:text","http://www.w3.org/1999/XSL/Transform"));
     septxt=AsAutoObject(xs.createTextNode(Sep));
     sepnod.AppendChild(septxt);
     templat.AppendChild(sepnod);
  fi;
  Res=AsString(xml.TransformNode(xs));
  finally
    ClearVariable(sepnod);
    ClearVariable(septxt);
    ClearVariable(select);
    ClearVariable(root);
    ClearVariable(templat);
    ClearVariable(xs);
  end;
  ^Res;
end;

func ПроверитьПоXSD(XML:S;XSD:S;namespace:S):S;
var xd,xs,err:AutoObject;
var ret:S;
  ret="";
  xd=OpenAutoObject("Msxml2.DOMDocument.6.0",true);
  xs=OpenAutoObject("Msxml2.XMLSchemaCache.6.0",true);
  try
    xd.Async=False;
    xd.ValidateOnParse=True;
    xs.add(namespace,XSD);
    xd.schemas=xs;
    xd.load(xml);
    err=AsAutoObject(xd.parseError);
    try
     if AsInteger(err.errorcode)<>0 then
        ret=AsString(err.reason);
     fi;
    finally
     ClearVariable(err);
    end;
  finally
    ClearVariable(xd);
    ClearVariable(xs);
  end;
  ^Ret;
end;


proc Очистить;
  ClearVariable(РАБ.XML.BufAtName);
  ClearVariable(РАБ.XML.BufAtVal );
  ClearVariable(РАБ.XML.Buf0     );
  ClearVariable(РАБ.XML.Buf1     );
  ClearVariable(РАБ.XML.Buf2     );
  ClearVariable(РАБ.XML.Buf3     );
  ClearVariable(РАБ.XML.Buf4     );
  ClearVariable(РАБ.XML.Buf5     );
  ClearVariable(РАБ.XML.Buf6     );
  ClearVariable(РАБ.XML.Buf7     );
  ClearVariable(РАБ.XML.Buf8     );
  ClearVariable(РАБ.XML.Buf9     );
  ClearVariable(РАБ.XML.Content  );
  ClearVariable(РАБ.XML.Result   );

  ClearVariable(РАБ.XML.Namespaces);
  ClearVariable(РАБ.XML.Namespace_code);
  ClearVariable(РАБ.XML.Namespace_url);

  ClearVariable(РАБ.XML.DocOle  );
  ClearVariable(РАБ.XML.ContextOle  );
end;

Proc SetMode(MyMode:S);
 if UP(MyMode)="TEXT":РАБ.XML.Mode=0;
    Очистить;
   |UP(MyMode)="MSXML":РАБ.XML.Mode=1;
    Очистить;
    Раб.XML.DocOle=CreateAutoObject("Msxml2.DOMDocument.6.0");
    ContextOle=AsAutoObject(DocOle.CreateElement("Context"));
 fi;
end;

func IsoDate(DD:Date; Z:S):S;
-- DD - Дата
-- Z - указание таймзоны, если есть
-- ^Str(Year(DD))+"-"+МАСЧ(Str(Mon(DD)))+"-"+МАСЧ(Str(Day(DD))) + Z;
 ^Format("%.4d-%.2d-%.2d%s",Year(DD),Mon(DD), Day(DD), Z);

end;

func IsoDateTime(DD:Date; TT:I; Z:S):S;
-- DD - Дата
-- TT - секунд от начала суток,
-- Z - указание таймзоны, если есть
var Res:S;
var imm, icc, ihh: I;
 res = IsoDate(DD, "") + "T"; --таймзону потом прилепим в конец
 imm=Int(Trunc((TT-ihh*3600)/60));
 icc=TT-ihh*3600-imm*60;
 ihh=Int(Trunc(TT/3600));
 ^res +Format("%.2d:%.2d:%.2d", ihh, imm, icc) + Z;
end;

Proc ДобАттр(Имя:S;Знач:S);
var l:I;
  l=SearchInArray(Раб.XML.BufAtName,Имя);--1 аттрибут должен встречаться один раз. При повторе - заменяем.
  if l=-1:
     l=LengthOfArray(Раб.XML.BufAtName)+1;
     Раб.XML.BufAtName[l]=Имя;
  fi;
  Раб.XML.BufAtVal[l]=Знач;
end;

Proc ДобАттрChk(Имя:S;Знач:S);
  if Знач<>"":
     Раб.XML.ДобАттр(Имя,Знач);
  fi;
end;

Proc ДобАттрDChk(Имя:S;Знач:D;Fmt:S);
  if Знач<>1.1.100:
     if Fmt='' or Fmt='TB' or Fmt='ТБ':
        Раб.XML.ДобАттр(Имя,DatetoString(Знач));
     fi;
  fi;
end;

Proc ДобАттрNChk(Имя:S;Знач:N;Точн:I);
  if round(Знач,Точн)<>0:
     Раб.XML.ДобАттр(Имя,Str(Знач,Точн));
  fi;
end;


Proc ДобСловарьАттр(VocAtt:S);
var i,ii:I;
var tmp:S;
  ii=WordsCount(VocAtt,"#");
  for i=1..ii do
    tmp=ExtractWord(i,VocAtt,"#");
    if Pos("=",tmp)<>0:
       ДобАттр(ExtractWord(1,tmp,"="),ExtractWord(2,tmp,"="));
    fi;
  od;
end;

Proc ВРез(Добав:S);
var l:i;
 l=lengthOfArray(Раб.XML.Result);
 Раб.XML.Result[l+1]=Добав;
end;

Proc ВРезScreen(Добав:S);
var l:i;
--кавычки
l = Pos('"',Добав);
if l <> 0:
  ВРезScreen(Substr(Добав,1,l-1));
  Раб.XML.ВРез("&quot;");
  ВРезScreen(Substr(Добав,l+1,255));
  Exit;
fi;
--апостроф
l = Pos("'",Добав);
if l <> 0:
  ВРезScreen(Substr(Добав,1,l-1));
  Раб.XML.ВРез("&apos;");
  ВРезScreen(Substr(Добав,l+1,255));
  Exit;
fi;
--амперсенд
l = Pos("&",Добав);
if l <> 0:
  ВРезScreen(Substr(Добав,1,l-1));
  Раб.XML.ВРез("&amp;");
  ВРезScreen(Substr(Добав,l+1,255));
  Exit;
fi;
--меньше
l = Pos('<',Добав);
if l <> 0:
  ВРезScreen(Substr(Добав,1,l-1));
  Раб.XML.ВРез("&lt;");
  ВРезScreen(Substr(Добав,l+1,255));
  Exit;
fi;
--больше
l = Pos('>',Добав);
if l <> 0:
  ВРезScreen(Substr(Добав,1,l-1));
  Раб.XML.ВРез("&gt;");
  ВРезScreen(Substr(Добав,l+1,255));
  Exit;
fi;
--Все проверки прошли - добавляем неэкранированно
Раб.XML.ВРез(Добав);
end;

Proc ОткрытьNamespace(code:S; url:S);
  Namespace_code = code;
  if SearchInArray(Namespaces, code, True) = -1:
     Namespace_url = url;
  fi;
end;

Proc ДобавитьNamespace(code:S; url:S);
--  if SearchInArray(Namespaces, code, True) = -1:
--     Namespace_url = url;
--  fi;
  Раб.XML.ДобАттр("xmlns:"+code,url);
  InsertInArraySort(Namespaces, code);
end;

Proc ЗакрытьNamespace;
  Namespace_code = '';
  Namespace_url = '';
end;

Proc ОткрытьТэгBuf(Имя:S;KeepAttr:L);
var i,ii:I;
  if Раб.XML.Mode=0: -- текстовый режим
     if Namespace_code <> '':
        Имя = Namespace_code + ':' +Имя;
     fi;
     Раб.XML.ВРез("<"+Имя);
     --Добавляем аттрибуты
     ii=lengthofarray(Раб.XML.BufAtName);
     for i=1..ii do
       Раб.XML.ВРез(" "+Раб.XML.BufAtName[i]);
       Раб.XML.ВРез("='");
       Раб.XML.ВРезScreen(Раб.XML.BufAtVal[i]);
       Раб.XML.ВРез("'");
     od;
     if Namespace_url<>'':
        Раб.XML.ВРез(" xmlns:"+Namespace_code+"='"+Namespace_url+"'");
        InsertInArraySort(Namespaces, Namespace_code);
     fi;
     --Заканчиваем открывать тэг
     Раб.XML.ВРез(">");
     --Добавляем в список
     InsertInArray(Раб.XML.Depth,1,Имя);
     --Чистим атрибуты
     if not KeepAttr:
        ClearVariable(Раб.XML.BufAtName);
        ClearVariable(Раб.XML.BufAtVal);
     fi;
  fi;
end;

Proc ОткрытьТэг(Имя:S;Аттр:S);
  ClearVariable(Раб.XML.BufAtName);
  ClearVariable(Раб.XML.BufAtVal);
  if Аттр<>"" then
    Раб.XML.ДобСловарьАттр(Аттр);
  fi;
  Раб.XML.ОткрытьТэгBuf(Имя,False);
end;

Func ЗакрытьТэг:S;
var Имя:S;
  if Раб.XML.Mode=0: -- текстовый режим
     Имя=Раб.XML.Depth[1];
     DeletefromArray(Раб.XML.Depth,1);
     Раб.XML.ВРез("</"+Имя+">");
  fi;
  ^Имя;
end;

Proc СоздатьТэг(Имя:S;Содержимое:S;KeepAtt:L);
var i,ii:I;
var newnode,child:AutoObject;
  if Раб.XML.Mode=0: -- текстовый режим
     Раб.XML.ОткрытьТэгBuf(Имя,KeepAtt);
     --Добавляем содержимое
     if Содержимое<>"" then
        Раб.XML.ВРезScreen(Содержимое); --простое содержимое
       else
        i=LengthOfArray(Раб.XML.Result);
        if i>0 then CopyArray(Раб.XML.Content,Раб.XML.Result,1,i+1); fi;
        ClearVariable(Раб.XML.Content);
     fi;
     --Закрываем тэг
     Раб.XML.ЗакрытьТэг;
     --fi;
    |Раб.XML.Mode=1:   --msxml
     try
       newnode=AsAutoObject(DocOle.CreateElement(Имя));
       --Добавляем аттрибуты
       ii=lengthofarray(Раб.XML.BufAtName);
       for i=1..ii do
         newnode.SetAttribute(Раб.XML.BufAtName[i],Раб.XML.BufAtVal[i]);
       od;
       --Добавляем содержимое
       if Содержимое<>"" then
          child=AsAutoObject(DocOle.CreateTextNode(Содержимое));
          newnode.AppendChild(child);
          ClearVariable(child);
         |LengthOfArray(Раб.XML.Content)>0:
          for i=1..ii do
             child=AsAutoObject(DocOle.CreateTextNode(Раб.XML.Content[i]));
             newnode.AppendChild(child);
             ClearVariable(child);
          od;
         else
       fi;
     finally
       ClearVariable(newnode);
       ClearVariable(child);
     end;

   fi;
end;

Proc СоздатьТэгChk(Имя:S;Содержимое:S;KeepAtt:L);
 if LengthOfArray(Раб.XML.Content) > 0 or Содержимое<>"":
    Раб.XML.СоздатьТэг(Имя, Содержимое, KeepAtt);
 fi;
end;

Proc СоздатьТэгNChk(Имя:S;Содержимое:N; Точн:I; KeepAtt:L);
 if round(Содержимое,Точн)<>0:
    Раб.XML.СоздатьТэг(Имя, Str(Содержимое,Точн), KeepAtt);
 fi;
end;

Proc СоздатьТэгDChk(Имя:S;Содержимое:D; Fmt:S; KeepAtt:L);
 if Содержимое <> 1.1.100:
    if Fmt='' or Fmt='TB' or Fmt='ТБ':
       Раб.XML.СоздатьТэг(Имя,DatetoString(Содержимое),KeepAtt);
      |Fmt='ISODATE':
       Раб.XML.СоздатьТэг(Имя,IsoDate(Содержимое,""),KeepAtt);
      |Fmt='ISODT':
       Раб.XML.СоздатьТэг(Имя,IsoDateTime(Содержимое,0,""),KeepAtt);
    fi;
 fi;
end;


Func ЗаписьФайла(ИмяФайла:S;cp:S):L;
--Значение берем из общего резалта
var F,i,ii:I;
  if cp='' or cp='win1251' or cp='1251':
     cp = 'windows-1251';
  fi;
  F=TextFileCreate(ИмяФайла);
  try
    TextFileAppendLn(F,XMLHead(cp));
    ii=LengthOfArray(Раб.XML.Result);
    if Up(cp) = 'UTF-8': cp='utf8'; fi; -- XML to РАБ.Transcode type

    for i=1..ii do
       if cp = 'windows-1251':
          TextFileAppendLn(F,Раб.XML.Result[i]);
         else
          if cp='utf8' and Length(Раб.XML.Result[i]) > 128:
             TextFileAppendLn(F,РАБ.Transcode.TranscodeString(Substr(Раб.XML.Result[i],1,127),'win1251',cp));
             TextFileAppendLn(F,РАБ.Transcode.TranscodeString(Substr(Раб.XML.Result[i],128,128),'win1251',cp));
            else
             TextFileAppendLn(F,РАБ.Transcode.TranscodeString(Раб.XML.Result[i],'win1251',cp));
          fi;
       fi;
    od;
  finally
    TextFileClose(F);
  end;
--  if cp="UTF8" then  -- TODO: переписать на РАБ.Transcode
--      ExecuteProgram(Раб.Бюджет2005.Контроль2Слэш(PlanVar("Std_rpo")+"\Bin\win1251_utf8.exe")+" "+ИмяФайла);
--  fi;
  ^True;
end;
---=====Устаревшее===
proc ToTopLev;
 CopyArray(Раб.XML.Result,Раб.XML.Content);
 ClearVariable(Раб.XML.Result);
end;

proc ClearBuf(NBuf:I);
if NBuf=0: ClearVariable(РАБ.XML.Buf0);
  |NBuf=1: ClearVariable(РАБ.XML.Buf1);
  |NBuf=2: ClearVariable(РАБ.XML.Buf2);
  |NBuf=3: ClearVariable(РАБ.XML.Buf3);
  |NBuf=4: ClearVariable(РАБ.XML.Buf4);
  |NBuf=5: ClearVariable(РАБ.XML.Buf5);
  |NBuf=6: ClearVariable(РАБ.XML.Buf6);
  |NBuf=7: ClearVariable(РАБ.XML.Buf7);
  |NBuf=8: ClearVariable(РАБ.XML.Buf8);
  |NBuf=9: ClearVariable(РАБ.XML.Buf9);
fi;

end;

Proc FromBuf(NBuf:I);
if РАБ.XML.Mode=0:
   if NBuf=0: CopyArray(РАБ.XML.Buf0,Раб.XML.Result);
     |NBuf=1: CopyArray(РАБ.XML.Buf1,Раб.XML.Result);
     |NBuf=2: CopyArray(РАБ.XML.Buf2,Раб.XML.Result);
     |NBuf=3: CopyArray(РАБ.XML.Buf3,Раб.XML.Result);
     |NBuf=4: CopyArray(РАБ.XML.Buf4,Раб.XML.Result);
     |NBuf=5: CopyArray(РАБ.XML.Buf5,Раб.XML.Result);
     |NBuf=6: CopyArray(РАБ.XML.Buf6,Раб.XML.Result);
     |NBuf=7: CopyArray(РАБ.XML.Buf7,Раб.XML.Result);
     |NBuf=8: CopyArray(РАБ.XML.Buf8,Раб.XML.Result);
     |NBuf=9: CopyArray(РАБ.XML.Buf9,Раб.XML.Result);
   fi;
fi;
end;

proc ToBuf(NBuf:I);
if РАБ.XML.Mode=0:
   if NBuf=0: CopyArray(Раб.XML.Result,РАБ.XML.Buf0);
     |NBuf=1: CopyArray(Раб.XML.Result,РАБ.XML.Buf1);
     |NBuf=2: CopyArray(Раб.XML.Result,РАБ.XML.Buf2);
     |NBuf=3: CopyArray(Раб.XML.Result,РАБ.XML.Buf3);
     |NBuf=4: CopyArray(Раб.XML.Result,РАБ.XML.Buf4);
     |NBuf=5: CopyArray(Раб.XML.Result,РАБ.XML.Buf5);
     |NBuf=6: CopyArray(Раб.XML.Result,РАБ.XML.Buf6);
     |NBuf=7: CopyArray(Раб.XML.Result,РАБ.XML.Buf7);
     |NBuf=8: CopyArray(Раб.XML.Result,РАБ.XML.Buf8);
     |NBuf=9: CopyArray(Раб.XML.Result,РАБ.XML.Buf9);
   fi;
fi;
ClearVariable(Раб.XML.Result);
end;

Proc ФормированиеТэга(Имя:S;Содержимое:S;KeepAtt:L;KeepContent:L;Переносы:I);
--Переносы: 0-без переносов;1-только в конце;2-после тегов и содержимого
var i,ii:I;
var newnode:AutoObject;
  if Раб.XML.Mode=0: -- текстовый режим
     --Открываем тэг
     Раб.XML.ВРез("<"+Имя);
     --Добавляем аттрибуты
     ii=lengthofarray(Раб.XML.BufAtName);
     for i=1..ii do
       Раб.XML.ВРез(" "+Раб.XML.BufAtName[i]);
       Раб.XML.ВРез("='"+Раб.XML.BufAtVal[i]+"'");
     od;
     --Заканчиваем открывать тэг
     Раб.XML.ВРез(">"+if(Переносы=2,chr(10),""));
     --Добавляем содержимое
     if Содержимое<>"" then
        Раб.XML.ВРез(Содержимое); --простое содержимое
       else
        i=LengthOfArray(Раб.XML.Result);
        if i>0 then CopyArray(Раб.XML.Content,Раб.XML.Result,1,i+1); fi;
     fi;
     if Переносы=2 then Раб.XML.ВРез(chr(10)); fi;
     --Закрываем тэг
     Раб.XML.ВРез("</"+Имя+">");
     if Переносы>0 then Раб.XML.ВРез(chr(10)); fi;
     --Если надо - чистим аттрибуты
     if not KeepAtt then
       ClearVariable(Раб.XML.BufAtName);
       ClearVariable(Раб.XML.BufAtVal);
     fi;
     --Аналогично аттрибутам - содержимое
     --if not SimpCon then
       if not KeepContent then
         ClearVariable(Раб.XML.Content);
       fi;
     --fi;
    |Раб.XML.Mode=1:   --msxml
     СоздатьТэг(Имя,Содержимое,KeepAtt);

   fi;
end;



Конец
