Usando a Classe para Ler xml do esocial

Projeto hbNFe (Nota Fiscal Eletronica/Danfe) para [x]Harbour

Moderador: Moderadores

malcarli
Usuário Nível 3
Usuário Nível 3
Mensagens: 239
Registrado em: 20 Ago 2015 18:14
Localização: marilia/sp

Usando a Classe para Ler xml do esocial

Mensagem por malcarli »

Bom dia colegas,

Estou usando a classe para o esocial, fiz a rotina abaixo para ler todos os eventos do xml, mas não estou conseguindo pegar o conteúdo da tag retornoEvento Id="

Alguém tem a solução ? Anexo o xml, tem que retornar 44 eventos (1 a 44)

Código: Selecionar todos

   cBlocoItens := XmlNode( cTexto, [retornoEventos])
   FOR EACH cBlocoItem IN MultipleNodeToArray( cBlocoItens, [retornoEvento])
       If Val(XmlNode( cBlocoItem, [cdResposta])) # 201
          Msginfo(XmlNode( cBlocoItem, [retornoEvento Id="]))
          Msginfo(XmlNode( cBlocoItem, [protocoloEnvioLote]))
          Msginfo(XmlNode( cBlocoItem, [cdResposta]))
          Msginfo(XmlNode( cBlocoItem, [descResposta]))
       Endif 
   NEXT
Att.

Marcelo A. L. Carli
Marília/SP
Capital Nacional do Alimento ®

https://malc-informatica.ueniweb.com
http://marcelo.lx.com.br
Email / Skype: malcarli@life.com.br
Anexos
65897910000164-20211207110627-sit.xml
(193.19 KiB) Baixado 168 vezes
Avatar do usuário
Itamar M. Lins Jr.
Administrador
Administrador
Mensagens: 7928
Registrado em: 30 Mai 2007 11:31
Localização: Ilheus Bahia
Curtiu: 1 vez

Usando a Classe para Ler xml do esocial

Mensagem por Itamar M. Lins Jr. »

Olá!
Sem ID como a função vai saber ?
Precisa da ID.

Código: Selecionar todos

cTag001        := XmlNode(cXML, 'retornoEvento Id="ID1658979100000002021120622115900001" ')
IF Empty(cTag001)
   hwg_Msgstop( ' TAG <retornoEvento Id="ID1658979100000002021120622115900001"> não localizada.' )
   RETURN .T.
ENDIF

//Ai vc pega: retornoEvento Id="ID1658979100000002021120622115900001"  isso tudo é a TAG!
cNRInsc001   := XmlNode(cTagEventos, "nrInsc")
Saudações,
Itamar M. Lins Jr.
Saudações,
Itamar M. Lins Jr.
Avatar do usuário
JoséQuintas
Administrador
Administrador
Mensagens: 20267
Registrado em: 26 Fev 2007 11:59
Localização: São Paulo-SP

Usando a Classe para Ler xml do esocial

Mensagem por JoséQuintas »

Tem solução pra isso, e confundiu.
A tag é "retornoEvento"
XmlNode tem uma parâmetro extra, que trás o bloco com tag inicial/final.

Código: Selecionar todos

cXmlNode := XmlNode( cXml, "retornoEvento", .T. )
Isso retorna o bloco inteiro, <retornoEvento Id="xxxx">...</retornoEvento>
Agora é pegar a Id.

Código: Selecionar todos

cId := Substr( cXmlNode, At( "Id=", cXmlNode ) + 4 ) // pular aspas
cId := Substr( cId, 1, At( ["], cId ) - 1 )
Se não precisa do prefixo ID, ao invés somar 4 basta somar 6.
José M. C. Quintas
Harbour 3.2, mingw, gtwvg mt, fivewin 25.04, multithread, dbfcdx, MySQL, ADOClass, PDFClass, SefazClass, (hwgui mt), (hmg3), (hmg extended), (oohg), PNotepad, ASP, stored procedure, stored function, Linux (Flagship/harbour 3.2)
"The world is full of kings and queens, who blind our eyes and steal our dreams Its Heaven and Hell"

https://github.com/JoseQuintas/
Avatar do usuário
JoséQuintas
Administrador
Administrador
Mensagens: 20267
Registrado em: 26 Fev 2007 11:59
Localização: São Paulo-SP

Usando a Classe para Ler xml do esocial

Mensagem por JoséQuintas »

Epa....
CADA um deles tem ID, é isso?
Verificar o MultipleNodeToArray(), talvez esteja fácil de acrescentar um parâmetro a mais, igual o XmlNode().
José M. C. Quintas
Harbour 3.2, mingw, gtwvg mt, fivewin 25.04, multithread, dbfcdx, MySQL, ADOClass, PDFClass, SefazClass, (hwgui mt), (hmg3), (hmg extended), (oohg), PNotepad, ASP, stored procedure, stored function, Linux (Flagship/harbour 3.2)
"The world is full of kings and queens, who blind our eyes and steal our dreams Its Heaven and Hell"

https://github.com/JoseQuintas/
Avatar do usuário
JoséQuintas
Administrador
Administrador
Mensagens: 20267
Registrado em: 26 Fev 2007 11:59
Localização: São Paulo-SP

Usando a Classe para Ler xml do esocial

Mensagem por JoséQuintas »

Código: Selecionar todos

FUNCTION MultipleNodeToArray( cXml, cNode )

   LOCAL aNodes := {}

   DO WHILE "<" + cNode + " " $ cXml .OR. "<" + cNode + ">" $ cXml
      AAdd( aNodes , XmlNode( cXml , cNode ) )
      IF ! "</" + cNode $ cXml
         cXml := ""
      ELSE
         cXml := Substr( cXml, At( "</" + cNode + ">", cXml ) + Len( "</" + cNode + ">" ) )
      ENDIF
   ENDDO

   RETURN aNodes
Tá fácil mesmo, porque acaba usando a outra.

Código: Selecionar todos

FUNCTION MultipleNodeToArray( cXml, cNode, lComTag )

   LOCAL aNodes := {}

   DO WHILE "<" + cNode + " " $ cXml .OR. "<" + cNode + ">" $ cXml
      AAdd( aNodes , XmlNode( cXml , cNode, lComTag ) )
      IF ! "</" + cNode $ cXml
         cXml := ""
      ELSE
         cXml := Substr( cXml, At( "</" + cNode + ">", cXml ) + Len( "</" + cNode + ">" ) )
      ENDIF
   ENDDO

   RETURN aNodes
Moleza, só recebe e repassa o parâmetro, o lComTag
E usa a rotina que já postei pra pegar o ID.
José M. C. Quintas
Harbour 3.2, mingw, gtwvg mt, fivewin 25.04, multithread, dbfcdx, MySQL, ADOClass, PDFClass, SefazClass, (hwgui mt), (hmg3), (hmg extended), (oohg), PNotepad, ASP, stored procedure, stored function, Linux (Flagship/harbour 3.2)
"The world is full of kings and queens, who blind our eyes and steal our dreams Its Heaven and Hell"

https://github.com/JoseQuintas/
Avatar do usuário
JoséQuintas
Administrador
Administrador
Mensagens: 20267
Registrado em: 26 Fev 2007 11:59
Localização: São Paulo-SP

Usando a Classe para Ler xml do esocial

Mensagem por JoséQuintas »

sefazclass.png
Uau.
Em 10 minutinhos, compilada pra 32/64 bits, Harbour 3.4 mingw 7.3, pronta pra download.
É uma pena que cada um usa uma coisa.
José M. C. Quintas
Harbour 3.2, mingw, gtwvg mt, fivewin 25.04, multithread, dbfcdx, MySQL, ADOClass, PDFClass, SefazClass, (hwgui mt), (hmg3), (hmg extended), (oohg), PNotepad, ASP, stored procedure, stored function, Linux (Flagship/harbour 3.2)
"The world is full of kings and queens, who blind our eyes and steal our dreams Its Heaven and Hell"

https://github.com/JoseQuintas/
malcarli
Usuário Nível 3
Usuário Nível 3
Mensagens: 239
Registrado em: 20 Ago 2015 18:14
Localização: marilia/sp

Usando a Classe para Ler xml do esocial

Mensagem por malcarli »

Bom dia Mestre Quintas, funcionou perfeitamente a alteração para pegar o id completo. O que está acontecendo agora que tem somente o id com final 36 que satifaz a condição If Val(XmlNode( cBlocoItem, [cdResposta])) # 201, mas está passando 2 vezes neste trecho. Não entendi o pq, pois está no laço do for each. Outra detalhe também é a descrição da resposta vem com caracteres diversos, tentei hb_oemtoansi e ao contrário de nada de converter corretamente.

Anexo xml.

Código: Selecionar todos

   cBlocoItens := XmlNode( cTexto, [retornoEventos])
   FOR EACH cBlocoItem IN MultipleNodeToArray( cBlocoItens, [retornoEvento], .T.)
       If Val(XmlNode( cBlocoItem, [cdResposta])) # 201
          cXmlNode:= XmlNode(cBlocoItem, "retornoEvento", .T. )
          cId     := Substr( CXmlNode, At( "Id=", cXmlNode ) + 4 ) // pular aspas
          cId     := Substr( cId, 1, At( ["], cId ) - 1 )
          Msginfo(cId)
          Msginfo([Protocolo de Envio do Lote: ] + XmlNode( cBlocoItem, [protocoloEnvioLote]))
          Msginfo([Número do Recibo: ] + XmlNode( cBlocoItem, [nrRecibo])) // só tem se for sucesso
          Msginfo([Código da Resposta: ] + XmlNode( cBlocoItem, [cdResposta]))
          Msginfo([Descrição da Resposta: ] + XmlNode( cBlocoItem, [descResposta]))

          cBlocoOcor := XmlNode( cTexto, [ocorrencias])
          FOR EACH cBlocoItemO IN MultipleNodeToArray(cBlocoOcor, [ocorrencia])
              Msginfo([Código da Ocorrência: ] + XmlNode( cBlocoItem, [codigo]))
              Msginfo([Descrição da Ocorrência: ] + XmlNode( cBlocoItem, [descricao]))
          Next
       Endif 
   Next

Anexos
65897910000164-20211207110627-sit.xml
(193.19 KiB) Baixado 164 vezes
Avatar do usuário
JoséQuintas
Administrador
Administrador
Mensagens: 20267
Registrado em: 26 Fev 2007 11:59
Localização: São Paulo-SP

Usando a Classe para Ler xml do esocial

Mensagem por JoséQuintas »

malcarli escreveu:O que está acontecendo agora que tem somente o id com final 36 que satifaz a condição mas está passando 2 vezes
Mas está pegando todos diferentes de 201
malcarli escreveu:Outra detalhe também é a descrição da resposta vem com caracteres diversos, tentei hb_oemtoansi e ao contrário de nada de converter corretamente.
Se está em UTF-8, seria converter de UTF8
OemToAnsi é de caracteres antigos/tradicionais pra Ansi, com codepage.
José M. C. Quintas
Harbour 3.2, mingw, gtwvg mt, fivewin 25.04, multithread, dbfcdx, MySQL, ADOClass, PDFClass, SefazClass, (hwgui mt), (hmg3), (hmg extended), (oohg), PNotepad, ASP, stored procedure, stored function, Linux (Flagship/harbour 3.2)
"The world is full of kings and queens, who blind our eyes and steal our dreams Its Heaven and Hell"

https://github.com/JoseQuintas/
malcarli
Usuário Nível 3
Usuário Nível 3
Mensagens: 239
Registrado em: 20 Ago 2015 18:14
Localização: marilia/sp

Usando a Classe para Ler xml do esocial

Mensagem por malcarli »

Consegui resolver o problema da acentuação e mudei o node de retornaEvento para evento e pegou somente o 36.

obg Mestre Quintas.

Código: Selecionar todos

   REQUEST HB_LANG_PT
   HB_LangSelect([PT])
   REQUEST HB_CODEPAGE_PTISO
   REQUEST HB_CODEPAGE_PT850
   HB_SETCODEPAGE([PT850])

   HB_SETCODEPAGE([PTISO])
   cBlocoItens := XmlNode( cTexto, [retornoEventos])
  ****  FOR EACH cBlocoItem IN MultipleNodeToArray( cBlocoItens, [retornoEvento], .T.)
  FOR EACH cBlocoItem IN MultipleNodeToArray( cBlocoItens, [evento], .T.)
       If Val(XmlNode(cBlocoItem, [cdResposta])) # 201
          cXmlNode:= XmlNode(cBlocoItem, "retornoEvento", .T.)
          cId     := Substr(cXmlNode, At("Id=", cXmlNode) + 4) // pular aspas
	  cId     := Substr(cId, 1, At(["], cId) - 1)
          Msginfo(cId)
          Msginfo([Protocolo de Envio do Lote: ] + XmlNode( cBlocoItem, [protocoloEnvioLote]))
*         Msginfo([Número do Recibo: ] + XmlNode( cBlocoItem, [nrRecibo])) // só tem se for sucesso
          Msginfo([Código da Resposta: ] + XmlNode( cBlocoItem, [cdResposta]))
          Msginfo([Descrição da Resposta: ] + hb_Utf8ToStr(XmlNode( cBlocoItem, [descResposta])))

          cBlocoOcor := XmlNode( cTexto, [ocorrencias])
          FOR EACH cBlocoItemO IN MultipleNodeToArray(cBlocoOcor, [ocorrencia])
              Msginfo([Código da Ocorrência: ] + XmlNode( cBlocoItem, [codigo]))
              Msginfo([Descrição da Ocorrência: ] + hb_Utf8ToStr(XmlNode( cBlocoItem, [descricao])))
          Next
       Endif 
      DOEVENTS()
   Next
   HB_SETCODEPAGE([PT850])
Avatar do usuário
JoséQuintas
Administrador
Administrador
Mensagens: 20267
Registrado em: 26 Fev 2007 11:59
Localização: São Paulo-SP

Usando a Classe para Ler xml do esocial

Mensagem por JoséQuintas »

xmlnotepad.png
Não sei se tem aí, é o xmlnotepad.
Se não me engano, era um exemplo da Microsoft usando NET, e acabou virando utilitário.
José M. C. Quintas
Harbour 3.2, mingw, gtwvg mt, fivewin 25.04, multithread, dbfcdx, MySQL, ADOClass, PDFClass, SefazClass, (hwgui mt), (hmg3), (hmg extended), (oohg), PNotepad, ASP, stored procedure, stored function, Linux (Flagship/harbour 3.2)
"The world is full of kings and queens, who blind our eyes and steal our dreams Its Heaven and Hell"

https://github.com/JoseQuintas/
malcarli
Usuário Nível 3
Usuário Nível 3
Mensagens: 239
Registrado em: 20 Ago 2015 18:14
Localização: marilia/sp

Usando a Classe para Ler xml do esocial

Mensagem por malcarli »

Continuando com eSocial e ainda usando a classe do Mestre Quintas. Preciso agora que ao ler o xml, ao selecionar um item da Tree e apague este trecho do xml, está lendo, mas não encontra e apaga o trecho. Qual o meu erro?

No exemplo abaixo oent.Tree_1.Item(oent.Tree_1.Value) = ID1529221680000002021122113145200002, ou seja preciso apagar este trecho do xml

Código: Selecionar todos

Static Procedure fApagarItem()
   Local cFile:= GetProperty([oent], [Txt_Xml], [Value]), cFilenew, cTexto, cArq

   cFilenew:= [New] + [-] + cFilePath(cFile)
   Copy File &cFile to &cFilenew

   cArq:= hb_MemoRead(cFilenew)

   If !Empty(GetProperty([oent], [Tree_1], [Value]))
       MemoTran(cArq, XmlNode(cArq, [evento Id="] + oent.Tree_1.Item(oent.Tree_1.Value) + ["]), [])
    Endif
    hb_MemoWrit(cFilenew, cArq)
Return(Nil)
obg

Att.

Marcelo A. L. Carli
Marília/SP
Capital Nacional do Alimento ®

https://malc-informatica.ueniweb.com
http://marcelo.lx.com.br
Email / Skype: malcarli@life.com.br
Anexos
1.2.202112.0000000000100048211.xml
(18.49 KiB) Baixado 178 vezes
Avatar do usuário
JoséQuintas
Administrador
Administrador
Mensagens: 20267
Registrado em: 26 Fev 2007 11:59
Localização: São Paulo-SP

Usando a Classe para Ler xml do esocial

Mensagem por JoséQuintas »

Não lembro o que é MemoTran. Não seria StrTran() ?
José M. C. Quintas
Harbour 3.2, mingw, gtwvg mt, fivewin 25.04, multithread, dbfcdx, MySQL, ADOClass, PDFClass, SefazClass, (hwgui mt), (hmg3), (hmg extended), (oohg), PNotepad, ASP, stored procedure, stored function, Linux (Flagship/harbour 3.2)
"The world is full of kings and queens, who blind our eyes and steal our dreams Its Heaven and Hell"

https://github.com/JoseQuintas/
Avatar do usuário
JoséQuintas
Administrador
Administrador
Mensagens: 20267
Registrado em: 26 Fev 2007 11:59
Localização: São Paulo-SP

Usando a Classe para Ler xml do esocial

Mensagem por JoséQuintas »

MEMOTRAN(<cString>,
[<cReplaceHardCR>],
[<cReplaceSoftCR>]) --> cNewString

Arguments

<cString> is the character string or memo field to be searched.

<cReplaceHardCR> is the character with which to replace a hard
carriage return/line feed pair. If not specified, the default value is
a semicolon (;).

<cReplaceSoftCR> is the character with which to replace a soft
carriage return/line feed pair. If not specified, the default value is
a space.
MemoTran() é pra mexer com mudança de linha, e não pra trocar string.
José M. C. Quintas
Harbour 3.2, mingw, gtwvg mt, fivewin 25.04, multithread, dbfcdx, MySQL, ADOClass, PDFClass, SefazClass, (hwgui mt), (hmg3), (hmg extended), (oohg), PNotepad, ASP, stored procedure, stored function, Linux (Flagship/harbour 3.2)
"The world is full of kings and queens, who blind our eyes and steal our dreams Its Heaven and Hell"

https://github.com/JoseQuintas/
malcarli
Usuário Nível 3
Usuário Nível 3
Mensagens: 239
Registrado em: 20 Ago 2015 18:14
Localização: marilia/sp

Usando a Classe para Ler xml do esocial

Mensagem por malcarli »

Boa tarde, problema resolvido. Segue abaixo código completo. Obrigado mais uma vez ao Mestre Quintas.

Feliz ano novo.

Att.

Marcelo A. L. Carli
Marília/SP
Capital Nacional do Alimento ®

https://malc-informatica.ueniweb.com
http://marcelo.lx.com.br
Email / Skype: malcarli@life.com.br

Código: Selecionar todos

/*****************************************************************************
 * SISTEMA  : ROTINA EVENTUAL                                                *
 * PROGRAMA : XML.PRG   		                                              *
 * OBJETIVO : Ler xml´s                                                          *
 * AUTOR    : Marcelo Antonio Lázzaro Carli                                  *
 * DATA     : 17.06.2013                                                     *
 * ULT. ALT.: 28.12.2021                                                     *
 *****************************************************************************/
#include <minigui.ch>

Function Main()
   cSistema:= [teste]
   REQUEST HB_LANG_PT
   HB_LangSelect([PT])
   REQUEST HB_CODEPAGE_PTISO
   REQUEST HB_CODEPAGE_PT850 &&& PARA INDEXAR CAMPOS ACENTUADOS
   HB_SETCODEPAGE([PT850])   &&& PARA INDEXAR CAMPOS ACENTUADOS

   Set wrap on
   Set talk off
   Set date briti             &&& data no formato dd/mm/aaaa
   Set dele on                &&& ignora registros marcados por deleção
   Set score off
   Set exact on
   Set ToolTip on
   Setcancel(.F.)             &&& evitar cancelar sistema c/ ALT + C
   Set cent on                &&& ano com 4 dígitos
   Set epoch to 2000          &&& ano a partir de 2000
   Set excl off               &&& abre arquivos em modo compartilhado
   Set navigation extended    &&& enter no lugar do tab
   Set language to portuguese &&& mensagens em português
   Set multiple off warning   &&& abrir 1 cópia somente
   Set browsesync on          &&& para o comando browse funcionar ok
   Set tooltipstyle balloon   &&& para mensagem dos campos em forma de balão
   Set menustyle extended     &&& padrão é standard, extended estilo office 2007
   Set programmaticchange off &&& introduzida na build 1.9.94
 
   DEFINE WINDOW main AT 0,0 WIDTH 640 HEIGHT 480 TITLE [Menú Principal] ICON [Demo.ico] NOTIFYICON [Demo.ico] MAIN NOSIZE NOMAXIMIZE
      DEFINE STATUSBAR FONT [Arial] SIZE 9
        STATUSITEM [Malc Informática] ICON [demo.ICO] DEFAULT ACTION {|| MsgInfo([Cliquei no ícone])}
        STATUSITEM [Computador: ] + AllTrim(NetName(.F.)) WIDTH 150
        STATUSITEM []                                     WIDTH 100
        KEYBOARD
        CLOCK
        DATE
      END STATUSBAR

      DEFINE MAIN MENU
		POPUP [&Manutenção] 
			Item [&Ler Xml] ACTION {|| fTelaXml()}   IMAGE [NEW.BMP] 
		        SEPARATOR
			Item [&Sair]    ACTION {|| main.Release} IMAGE [DOOR.BMP]
		END POPUP

      END MENU
      on key escape action {|| thiswindow.release}
   END WINDOW
   main.center
   main.maximize
   main.activate
Return (Nil)

Procedure fTelaXml()
   Set Font to "MS Sans Serif", 8
   Define WINDOW fRetif AT 0, 0 WIDTH 700 HEIGHT 630 TITLE [Retificação de Arquivos Xml's] ICON [Demo.ico] MODAL NOSIZE
       DEFINE FRAME Frame_1
           ROW    0 
           COL    5
           WIDTH  685
           HEIGHT 55
           FONTBOLD .T.
           CAPTION [Arquivo Xml]
       END FRAME

       DEFINE FRAME Frame_2
           ROW    500
           COL    5
           WIDTH  685
           HEIGHT 55
           CAPTION 'Número do Protocolo'
           FONTBOLD .T.
       END FRAME

       DEFINE LABEL Label_3
           ROW    520
           COL    20
           WIDTH  70
           HEIGHT 16
           VALUE "Protocolo"
           FONTBOLD .T.
       END LABEL

       BTN_TEXTBOX (20, 15, Txt_Xml, 660, {|| fLerXml()})

       DEFINE TREE Tree_1 ;
           AT 65, 5 ;
           WIDTH 685 ;
           HEIGHT 430
       END TREE

       DEFINE TEXTBOX Text_Protoc
           ROW    520
           COL    110
           WIDTH  235
           HEIGHT 20
           TOOLTIP   "Protocolo de Envio"
           UPPERCASE .T.
           MAXLENGTH 30
           VALUE []
       END TEXTBOX

       @ 570,100 BUTTON oBt_Ok      CAPTION [&Apagar Ítem] WIDTH 100 TOOLTIP [Apagar Ítem Atual] ACTION {|| fApagarItem()}   BOLD
       @ 570,300 BUTTON oBt_Grava   CAPTION [&Gravar Xml]  WIDTH 100 TOOLTIP [Gravar Xml]        ACTION {|| fGravaXml(GetProperty([fRetif], [Txt_Xml], [Value]))} BOLD
       on key escape action {|| thiswindow.release}
   End WINDOW

   fRetif.center
   fRetif.activate
Return (Nil)

Static Procedure fApagarItem()
   Local cFile:= GetProperty([fRetif], [Txt_Xml], [Value]), cArq

   If !Empty(GetProperty([fRetif], [Tree_1], [Value]))
      cArq:= hb_MemoRead(cFile)

      cArq:= StrTran(cArq, XmlNode(cArq, [evento Id="] + fRetif.Tree_1.Item(fRetif.Tree_1.Value) + ["]), Nil)
      cArq:= StrTran(cArq, [<evento Id="] + fRetif.Tree_1.Item(fRetif.Tree_1.Value) + ["></evento>] + hb_OsNewLine(), [])
      hb_MemoWrit(cFile, cArq)

      DoMethod([fRetif], [Tree_1], [DeleteItem], GetProperty([fRetif], [Tree_1], [Value]))
   Endif
   fGravaXml(cArq)
Return (Nil)

Static Procedure fLerXml()
   Local cBlocoItem, cBlocoItens, cBlocoOcor, cBlocoItemO, cXmlNode, cId, cFile, cTexto, nItemID:= 1

   cFile:= Getfile({{[Todos os Arquivos], [*.xml]}}, [Selecione o Arquivo], GetCurrentFolder() + [\], .F. , .T.)
   If Empty(cFile)
      Return (.F.)
   Endif
   cTexto:= Hb_MemoRead(cFile)
   _SetValue([Txt_Xml], [fRetif], cFile)

   fRetif.Tree_1.DeleteAllItems()

   HB_SETCODEPAGE([PTISO])
   cBlocoItens:= XmlNode(cTexto, [eventos])
   If !Empty(cBlocoItens)
      For EACH cBlocoItem IN MultipleNodeToArray(cBlocoItens, [evento], .T.)
             cXmlNode:= XmlNode(cBlocoItem, [evtMonit], .T.)
             cId     := Substr(cXmlNode, At([Id=], cXmlNode) + 4) // pular aspas
	     cId     := Substr(cId, 1, At(["], cId) - 1)

             NODE cId ID nItemID++
                NODE [Vínculo] ID nItemID++
                   TREEITEM [Cpf: ]       + XmlNode(cBlocoItem, [cpfTrab])     ID nItemID++
                   TREEITEM [Matrícula: ] + XmlNode(cBlocoItem, [matricula])   ID nItemID++
                END NODE

                NODE [Aso] ID nItemID++
                   TREEITEM [Tipo Aso: ]      + XmlNode(cBlocoItem, [tpExameOcup]) ID nItemID++
                   TREEITEM [Data Aso: ]      + XmlNode(cBlocoItem, [dtAso])       ID nItemID++
                   TREEITEM [Conclusão Aso: ] + XmlNode(cBlocoItem, [resAso])      ID nItemID++
                END NODE
      
                NODE [Exames] ID nItemID++
                   cBlocoOcor:= XmlNode(cBlocoItem, [evtMonit], .T.)
                   For EACH cBlocoItemO IN MultipleNodeToArray(cBlocoOcor, [exame], .T.)
                       TREEITEM [Código do Exame: ] + XmlNode(cBlocoItemO, [procRealizado]) ID nItemID++
                       TREEITEM [Data do Exame: ]   + XmlNode(cBlocoItemO, [dtExm])         ID nItemID++
                       TREEITEM [Resultado: ]       + XmlNode(cBlocoItemO, [indResult])     ID nItemID++
                   Next

                   NODE [Examinador] ID nItemID++
                      TREEITEM [Nome: ] + XmlNode(cBlocoItem, [nmMed]) ID nItemID++
                      TREEITEM [Crm: ]  + XmlNode(cBlocoItem, [nrCRM]) ID nItemID++
                      TREEITEM [Uf: ]   + XmlNode(cBlocoItem, [ufCRM]) ID nItemID++
                   END NODE
                END NODE

                NODE [Coordenador] ID nItemID++
                   TREEITEM [Nome: ] + XmlNode(cBlocoItem, [nmResp])                      ID nItemID++
                   TREEITEM [Crm: ]  + XmlNode(XmlNode(cBlocoItem, [respMonit]), [nrCRM]) ID nItemID++
                   TREEITEM [Uf: ]   + XmlNode(XmlNode(cBlocoItem, [respMonit]), [ufCRM]) ID nItemID++
               END NODE
             END NODE
             DOEVENTS()
      Next
   Else
      Msginfo([Arquivo Inválido.], cSistema)
      Return (Nil)
   Endif
   HB_SETCODEPAGE([PT850])
Return (.T.)

Static Procedure fGravaXml(cFile)
   Local cArq:= []

   If Empty(cFile)
      MsgExclamation([Arquivo não Encontrado.], cSistema)
      Return (Nil)
   Endif

   If Empty(GetProperty([fRetif], [Text_Protoc], [Value])) .or. Len(Alltrim(GetProperty([fRetif], [Text_Protoc], [Value]))) < 30
      MsgExclamation([Número do Protocolo em Branco ou] + hb_OsNewLine() + [Menor que 30 caracteres.], cSistema)
      Return (Nil)
   Endif

   cArq:= hb_MemoRead(cFile)
   cArq:= StrTran(cArq, [<indRetif>1</indRetif>], [<indRetif>2</indRetif>] + hb_OsNewLine() + ;
                        [      <nrRecibo>] + Alltrim(GetProperty([fRetif], [Text_Protoc], [Value])) + [</nrRecibo>] + hb_OsNewLine())

   hb_MemoWrit(cFile, cArq)
Return (Nil)

FUNCTION XmlTransform( cXml ) // SOMENTE PARA FUNCIONAR - ESTÁ EM ZE_XMLFUNC.PRG

   LOCAL nCont, cRemoveTag, cLetra, nPos, lTroca, nAscii

   cRemoveTag := { ;
      [<?xml version="1.0" encoding="utf-8"?>], ; // Petrobras inventou de usar assim
      [<?xml version="1.0" encoding="ISO-8859-1"?>], ; // Petrobras agora assim
      [<?xml version="1.0" encoding="UTF-8"?>], ; // o mais correto
      [<?xml version="1.0" encoding="UTF-8" standalone="yes"?>], ;
      [<?xml version="1.00"?>], ;
      [<?xml version="1.0"?>] }

   cXml := AllTrim( cXml )
   FOR nCont = 1 TO Len( cRemoveTag )
      cXml := StrTran( cXml, cRemoveTag[ nCont ], "" )
   NEXT
   IF ! ["] $ cXml // Pode ser usado aspas simples
      cXml := StrTran( cXml, ['], ["] )
   ENDIF
   IF Chr(195) $ cXml
      nPos := At( Chr(195), cXml )
      IF Asc( Substr( cXml, nPos + 1 ) ) > 122
         cXml := hb_Utf8ToStr( cXml )
      ENDIF
   ENDIF
   FOR nCont = 1 TO 2
      cXml := StrTran( cXml, Chr(26), "" )
      cXml := StrTran( cXml, Chr(13), "" )
      cXml := StrTran( cXml, Chr(10), "" )
      IF Substr( cXml, 1, 1 ) $ Chr(239) + Chr(187) + Chr(191)
         cXml := Substr( cXml, 2 )
      ENDIF
      cXml := StrTran( cXml, " />", "/>" )
      cXml := StrTran( cXml, Chr(195) + Chr(173), "i" )
      cXml := StrTran( cXml, Chr(195) + Chr(135), "C" )
      cXml := StrTran( cXml, Chr(195) + Chr(141), "I" )
      cXml := StrTran( cXml, Chr(195) + Chr(163), "a" )
      cXml := StrTran( cXml, Chr(195) + Chr(167), "c" )
      cXml := StrTran( cXml, Chr(195) + Chr(161), "a" )
      cXml := StrTran( cXml, Chr(195) + Chr(131), "A" )
      cXml := StrTran( cXml, Chr(194) + Chr(186), "o." )
      cxml := StrTran( cxml, Chr(195) + Chr(162), "a" )
      cxml := StrTran( cxml, Chr(195) + Chr(161), "a" )
      cxml := StrTran( cxml, Chr(195) + Chr(163), "a" )
      cxml := StrTran( cxml, Chr(195) + Chr(173), "i" )
      cxml := StrTran( cxml, Chr(195) + Chr(179), "o" )
      cxml := StrTran( cxml, Chr(195) + Chr(167), "c" )
      cxml := StrTran( cxml, Chr(195) + Chr(169), "e" )
      cxml := StrTran( cxml, Chr(195) + Chr(170), "e" )
      cxml := StrTran( cxml, Chr(195) + Chr(181), "o" )
      cxml := StrTran( cxml, Chr(195) + Chr(160), "o" )
      cxml := StrTran( cxml, Chr(195) + Chr(181), "o" )
      cxml := StrTran( cxml, Chr(195) + Chr(129), "A" )
      cxml := StrTran( cxml, Chr(226) + Chr(128) + Chr(156), [*] ) // aspas de destaque "cames"
      cxml := StrTran( cxml, Chr(226) + Chr(128) + Chr(157), [*] ) // aspas de destaque "cames"
      cxml := StrTran( cxml, Chr(195) + Chr(180), "o" )
      cxml := StrTran( cxml, Chr(195) + Chr(186), "u" )
      cxml := StrTran( cxml, Chr(195) + Chr(147), "O" )
      cxml := StrTran( cxml, Chr(226) + Chr(128) + Chr(153), [ ] ) // caixa d'agua
      cxml := StrTran( cxml, Chr(226) + Chr(128) + Chr(147), [-] ) // - mesmo
      cxml := StrTran( cxml, Chr(194) + Chr(179), [3] ) // m3
      // so pra corrigir no SQL
      cXml := StrTran( cXml, "+" + Chr(129), "A" )
      cXml := StrTran( cXml, "+" + Chr(137), "E" )
      cXml := StrTran( cXml, "+" + Chr(131), "A" )
      cXml := StrTran( cXml, "+" + Chr(135), "C" )
      cXml := StrTran( cXml, "?" + Chr(167), "c" )
      cXml := StrTran( cXml, "?" + Chr(163), "a" )
      cXml := StrTran( cXml, "?" + Chr(173), "i" )
      cXml := StrTran( cXml, "?" + Chr(131), "A" )
      cXml := StrTran( cXml, "?" + Chr(161), "a" )
      cXml := StrTran( cXml, "?" + Chr(141), "I" )
      cXml := StrTran( cXml, "?" + Chr(135), "C" )
      cXml := StrTran( cXml, Chr(195) + Chr(156), "a" )
      cXml := StrTran( cXml, Chr(195) + Chr(159), "A" )
      cXml := StrTran( cXml, "?" + Chr(129), "A" )
      cXml := StrTran( cXml, "?" + Chr(137), "E" )
      cXml := StrTran( cXml, Chr(195) + "?", "C" )
      cXml := StrTran( cXml, "?" + Chr(149), "O" )
      cXml := StrTran( cXml, "?" + Chr(154), "U" )
      cXml := StrTran( cXml, "+" + Chr(170), "o" )
      cXml := StrTran( cXml, "?" + Chr(128), "A" )
      cXml := StrTran( cXml, Chr(195) + Chr(166), "e" )
      cXml := StrTran( cXml, Chr(135) + Chr(227), "ca" )
      cXml := StrTran( cXml, "n" + Chr(227), "na" )
      cXml := StrTran( cXml, Chr(162), "o" )
      cXml := StrTran( cXml, " " + Chr(241) + " ", " " )
      cXml := StrTran( cXml, Chr(176), "" ) // graus
      cXml := StrTran( cXml, Chr(186), "o" ) // numero
      cXml := StrTran( cXml, Chr(220), "U" ) // u com trema
      cXml := StrTran( cXml, Chr(170), "" ) // desconhecido
   NEXT
   FOR nCont = 1 TO Len( cXml )
      cLetra := Substr( cXml, nCont, 1 )
      nAscii := Asc( cLetra )
      lTroca := .T.
      DO CASE
      CASE cLetra $ "abcdefghijklmnopqrstuvwxyz"; lTroca := .F.
      CASE cLetra $ "ABCDEFGHIJKLMNOPQRSTUVWXYZ"; lTroca := .F.
      CASE cLetra $ "01234567889"; lTroca := .F.
      CASE cLetra $ ",.:/;%*$@?<>()+-#=:_" + Chr(34) + Chr(32); lTroca := .F.
      CASE nAscii == 231; cLetra := "c"
      CASE nAscii == 199; cLetra := "C"
      CASE hb_AScan( { 193, 194, 195, 192 }, nAscii ) != 0 ; cLetra := "A"
      CASE hb_AScan( { 224, 225, 226, 227, 228, 229 }, nAscii ) != 0 ; cLetra := "a"
      CASE hb_AScan( { 242, 243, 244, 245, 246 }, nAscii ) != 0 ; cLetra := "o"
      CASE hb_AScan( { 210, 211, 212, 213, 214 }, nAscii ) != 0 ; cLetra := "O"
      CASE hb_AScan( { 200, 201, 202, 203 }, nAscii ) != 0 ; cLetra := "E"
      CASE hb_AScan( { 232, 233, 234, 235 }, nAscii ) != 0 ; cLetra := "e"
      CASE hb_AScan( { 236, 237, 238, 239 }, nAscii ) != 0 ; cLetra := "i"
      CASE hb_AScan( { 204, 205, 206, 207 }, nAscii ) != 0 ; cLetra := "I"
      CASE hb_AScan( { 249, 250, 251, 252 }, nAscii ) != 0 ; cLetra := "u"
      CASE hb_AScan( { 217, 218, 219 }, nAscii ) != 0 ; cLetra := "U"
      CASE nAscii == 128 ; cLetra := "C" // experimental
      CASE nAscii == 144 ; cLetra := "E" // experimental
      CASE nAscii == 248 ; cLetra := "" // experimental
      CASE nAscii == 167 ; cLetra := "o" // experimental
      ENDCASE
      IF lTroca
         cXml := Substr( cXml, 1, nCont - 1 ) + cLetra + Substr( cXml, nCont + 1 )
      ENDIF
   NEXT

   RETURN cXml

FUNCTION XmlNode( cXml, cNode, lComTag ) // SOMENTE PARA FUNCIONAR - ESTÁ EM ZE_XMLFUNC.PRG

   LOCAL nInicio, nFim, cResultado := ""

   hb_Default( @lComTag, .F. )
   nInicio := At( "<" + cNode, cXml )
   // a linha abaixo é depois de pegar o início, senão falha
   IF " " $ cNode
      cNode := Substr( cNode, 1, At( " ", cNode ) - 1 )
   ENDIF
   IF nInicio != 0
      IF ! lComTag
         nInicio := nInicio + Len( cNode ) + 2
         IF nInicio != 1 .AND. Substr( cXml, nInicio - 1, 1 ) != ">" // Quando tem elementos no bloco
            nInicio := hb_At( ">", cXml, nInicio ) + 1
         ENDIF
      ENDIF
      nFim := hb_At( "</" + cNode + ">", cXml, nInicio )
      IF nFim != 0
         nFim -=1
         IF lComTag
            nFim := nFim + Len( cNode ) + 3
         ENDIF
         cResultado := Substr( cXml, nInicio, nFim - nInicio + 1 )
      ENDIF
   ENDIF

   RETURN cResultado

FUNCTION MultipleNodeToArray( cXml, cNode, lComTag ) // SOMENTE PARA FUNCIONAR - ESTÁ EM ZE_XMLFUNC.PRG

   LOCAL aNodes := {}

   DO WHILE "<" + cNode + " " $ cXml .OR. "<" + cNode + ">" $ cXml
      AAdd( aNodes , XmlNode( cXml, cNode, lComTag ) )
      IF ! "</" + cNode $ cXml
         cXml := ""
      ELSE
         cXml := Substr( cXml, At( "</" + cNode + ">", cXml ) + Len( "</" + cNode + ">" ) )
      ENDIF
   ENDDO

   RETURN aNodes

Static Procedure fTag_Xml(cXml, cNomeTag, cValor, nEspaco, lFecha) // SOMENTE PARA FUNCIONAR - ESTÁ EM ZE_XMLFUNC.PRG
   Local cRetorno:= []

   hb_Default(@lFecha, .T.)
   hb_Default(@nEspaco, 5)
   hb_Default(@cValor, [])

   If Empty(cXml)
      Return (Nil)
   Endif

   cValor:= Rtrim(cValor)

   If !Empty(cValor) .or. lFecha
      cRetorno:= (spac(nEspaco) + [<] + cNomeTag + [>] + cValor + [</] + cNomeTag + [>])
   Endif

   If !Empty(cRetorno )
      Fwrite(cXml, cRetorno + hb_OsNewLine())
   Endif
Return (Nil)
Responder