Criei uma variável HASH, com os mesmos nomes da tag do XML, se houver tag com mais de uma ocorrência no mesmo nível, converte para vetor.
Testei o básico se der algum erro reporte na medida do possível corrijo
Retorna a posição atual no vetor: XML_GetValor(hXml, '{-P-}')
Código: Selecionar todos
#pragma /w2
#pragma /es2
#define TESTE
#command DEFAULT <var> TO <def> [, <varn> TO <defn>] => ;
<var> := if(<var> = NIL,<def>,<var>) [; <varn> := if(<varn> = NIL,<defn>,<varn>)]
#command DEFAULT EMPTY <var> TO <def> [, <varn> TO <defn>] => ;
<var> := if(Empty(<var>),<def>,<var>) [; <varn> := if(Empty(<varn>),<defn>,<varn>)]
//#include "boni_cmd.ch"
//#include "xml.ch"
/*
ABERTURA:
<!-- comentario
<!CDATA[ ignora caracter especias
<? xml definicao
FECHAMENTO:
--> comentario
]]> CDATA
?> xml definicao
/> tipo simples
*/
#ifdef TESTE
PROCEDURE Teste( cArqXml )
LOCAL hXml, sItemCodigo, xx, lOk
//BoniErrorSys()
DEFA cArqXml TO "nfe.xml"
CLS
IF !File(cArqXml)
Alerta('Arquivo não existe ' + cArqXml)
ENDIF
hXml := XML_Hash(cArqXml, @lOk)
IF !lOk
Alerta('Erro na Estrutura do XML')
ENDIF
//caso tenha so um item, muda hash para vetor, sem perder item, assim nao tem que ficar testando no sistema se tem só 1 item, EX: itens de NFe
//esta função deve ser chamada, sempre que houver nos, com nomes iguais, com ocorrência de zero a (n-vezes)
XML_CriaLista(@hXml['nfeProc','NFe','infNFe', 'det'])
//Vantagem de usar XML_GetValor(hXml, {"nfeProc", "NFe", "infNFe", "ide", "dSaiEnt"})
//ao inves de hXml['nfeProc','NFe','infNFe','ide','dSaiEnt'], diretamente
//percorre o hash procurando as Key, se não existir, não gera erro, retorna NIL
//formas diferentes de achar um valor, todas validas
? XML_GetValor(hXml, 'nfeProc,NFe,infNFe,ide,cUF'), ;
XML_GetValor(hXml, "<nfeProc>,<NFe>,<infNFe>,<ide>,<cUF>"), ;
XML_GetValor(hXml, "<nfeProc><NFe><infNFe><ide><cUF>"), ;
XML_GetValor(hXml, {"nfeProc", "NFe", "infNFe", "ide", "cUF"}), ;
XML_GetValor(hXml, {"<nfeProc>", "<NFe>", "<infNFe>", "<ide>", "<cUF>"}), ;
XML_GetValor(hXml, {"nfeProc", "NFe", "infNFe", "det", "{1}", "prod", "cProd"}), ;
XML_GetValor(hXml, {"nfeProc", "NFe", "infNFe", "det", '1', "prod", "cProd"}), ;
XML_GetValor(hXml, {"nfeProc", "NFe", "infNFe", "det", 1, "prod", "cProd"})
?
FOR xx := 1 To 900
sItemCodigo := XML_GetValor(hXml, {"nfeProc", "NFe", "infNFe", "det", "{" + LTrim(Str(xx)) + "}", "prod", "cProd"}) //codigo do produto
IF sItemCodigo = NIL
EXIT
ENDIF
? Str(xx, 3), Str(XML_GetValor(hXml, '{-P-}'), 3), sItemCodigo, ;
Trim(XML_GetValor(hXml, {"<nfeProc>", "<NFe>", "<infNFe>", "<det>",, "_parametro"})), ;
Str(XML_GetValor(hXml, '{-P-}'), 3), ;
Trim(XML_GetValor(hXml, {"<nfeProc>", "<NFe>", "<infNFe>", "<det>", "<{}>", "<prod>", "<xProd>"})), ; //nome do produto
Str(XML_GetValor(hXml, '{-P-}'), 3)
IF xx % 21 = 0
wait
ENDIF
NEXT
?
/*
{} Mantem no item atual
{+} Posiciona no proximo item
{-} Posiciona no item anterior
{+n} Posiciona no proximo <n> item
{-n} Posiciona no <n> item anterior
{var="valor"} procura por ocorrencia em parametro, e se posiciona nele
*/
//para testar daqui para baixo e bom que tenha um NFe de 8 Itens ou mais, senão retorna em branco se item não existir
? 'Total de Itens na NFe ' + Str(Len(hXml["nfeProc", "NFe", "infNFe", "det"]))
sItemCodigo := XML_GetValor(hXml, {"<nfeProc>", "<NFe>", "<infNFe>", "<det>", "<{1}>", "<prod>", "<cProd>"})
? ' 1', Str(XML_GetValor(hXml, '{-P-}'), 3), PadR(sItemCodigo, 5), ''
?? ' ' + XML_GetValor(hXml, {"<nfeProc>", "<NFe>", "<infNFe>", "<det>",, "<prod>", "<xProd>"})
sItemCodigo := XML_GetValor(hXml, {"<nfeProc>", "<NFe>", "<infNFe>", "<det>", "<{+}>", "<prod>", "<cProd>"}, '')
? ' 2', Str(XML_GetValor(hXml, '{-P-}'), 3), PadR(sItemCodigo, 5), ''
?? XML_GetValor(hXml, {"<nfeProc>", "<NFe>", "<infNFe>", "<det>", "<{}>", "<prod>", "<xProd>"}, '')
?? ' ' + Str(XML_GetValor(hXml, '{-P-}'), 3)
sItemCodigo := XML_GetValor(hXml, {"<nfeProc>", "<NFe>", "<infNFe>", "<det>", "<{+}>", "<prod>", "<cProd>"}, '')
? ' 3', Str(XML_GetValor(hXml, '{-P-}'), 3), PadR(sItemCodigo, 5), ''
?? ' ' + XML_GetValor(hXml, {"<nfeProc>", "<NFe>", "<infNFe>", "<det>",, "<prod>", "<xProd>"}, '')
sItemCodigo := XML_GetValor(hXml, {"<nfeProc>", "<NFe>", "<infNFe>", "<det>", "<{+}>", "<prod>", "<cProd>"}, '')
? ' 4', Str(XML_GetValor(hXml, '{-P-}'), 3), PadR(sItemCodigo, 5), ''
?? ' ' + XML_GetValor(hXml, {"<nfeProc>", "<NFe>", "<infNFe>", "<det>",, "<prod>", "<xProd>"}, '')
sItemCodigo := XML_GetValor(hXml, {"<nfeProc>", "<NFe>", "<infNFe>", "<det>", "<{-}>", "<prod>", "<cProd>"}, '')
? ' 3', Str(XML_GetValor(hXml, '{-P-}'), 3), PadR(sItemCodigo, 5), ''
?? ' ' + XML_GetValor(hXml, {"<nfeProc>", "<NFe>", "<infNFe>", "<det>",, "<prod>", "<xProd>"}, '')
sItemCodigo := XML_GetValor(hXml, {"<nfeProc>", "<NFe>", "<infNFe>", "<det>", "<{+2}>", "<prod>", "<cProd>"}, '')
? ' 5', Str(XML_GetValor(hXml, '{-P-}'), 3), PadR(sItemCodigo, 5), ''
?? ' ' + XML_GetValor(hXml, {"<nfeProc>", "<NFe>", "<infNFe>", "<det>",, "<prod>", "<xProd>"}, '')
sItemCodigo := XML_GetValor(hXml, {"<nfeProc>", "<NFe>", "<infNFe>", "<det>", "<{-3}>", "<prod>", "<cProd>"}, '')
? ' 2', Str(XML_GetValor(hXml, '{-P-}'), 3), PadR(sItemCodigo, 5), ''
?? ' ' + XML_GetValor(hXml, {"<nfeProc>", "<NFe>", "<infNFe>", "<det>", "<{}>", "<prod>", "<xProd>"}, '')
sItemCodigo := XML_GetValor(hXml, {"<nfeProc>", "<NFe>", "<infNFe>", "<det>", "8", "<prod>", "<cProd>"}, '')
? ' 8', Str(XML_GetValor(hXml, '{-P-}'), 3), PadR(sItemCodigo, 5), ''
?? ' ' + XML_GetValor(hXml, {"<nfeProc>", "<NFe>", "<infNFe>", "<det>", "<{}>", "<prod>", "<xProd>"}, '')
sItemCodigo := XML_GetValor(hXml, {"<nfeProc>", "<NFe>", "<infNFe>", "<det>", '<{nItem="7"}>', "<prod>", "<cProd>"}, '')
? ' 7', Str(XML_GetValor(hXml, '{-P-}'), 3), PadR(sItemCodigo, 5), ''
?? ' ' + XML_GetValor(hXml, {"<nfeProc>", "<NFe>", "<infNFe>", "<det>", "<{}>", "<prod>", "<xProd>"}, '')
wait
RETURN
#endif
*************************************************************************
//Quando tiver um tempo vou criar uma classe
//Esta função e genérica
//Pode ser usada para NFe, ou qualquer XML, conforme o exemplo acima
FUNCTION Xml_Hash( cArqXml, lOk )
LOCAL sXml, hXml
lOk := .T.
sXml := FileRead( cArqXml,, .t. )
hXml := HashMath()
IF !Xml_Hash_Formata( sXml, @hXml )
lOk := .F.
ENDIF
RETURN hXml
//populaciona arquivo xml na variável HASH, usa recursividade para próximo nó,
//retorna quando não tiver mais subnível
FUNCTION Xml_Hash_Formata( sXml, hXml, sParametro )
LOCAL aXml, sKeyBusca, nPos, nPos1, cLinha, nPosFim, xx, yy, nPosInicial, nPosFimKey, sSeparaKey, lOk
DEFA hXml TO HashMath()
sXml := StrTran(sXml, '><', '>' + CrLf() + '<', .F.)
aXml := Split(sXml, CrLf(), .F.)
nPosInicial := aScan(aXml, {|p| '<?XML ' $ Upper(p)}) + 1
nPosFim := Len(aXml)
lOk := .T.
IF !Empty( sParametro )
hXml[ '_parametro' ] := sParametro
sParametro := ''
ENDIF
FOR xx := nPosInicial TO nPosFim
cLinha := Trim(aXml[xx])
IF Empty(aXml[xx])
LOOP
ENDIF
nPos := At(">", cLinha)
nPos1 := At(" ", cLinha)
IF !Empty(nPos1) .and. nPos > nPos1
nPos := nPos1
ENDIF
sKeyBusca := SubStr(cLinha, 2, nPos - 2)
IF Right(cLinha, 2) = '/>'
nPosFimKey := - xx
ELSE
nPosFimKey := aScan(aXml, {|p| Upper('</' + sKeyBusca + '>') $ Upper(p)})
ENDIF
IF nPosFimKey < 0
hXml[sKeyBusca] := AllTrim(SubStr(cLinha, Len(sKeyBusca) + 3, Len(cLinha) - Len(sKeyBusca) - 4))
aXml[xx] := ''
ELSEIF xx = nPosFimKey
hXml[sKeyBusca] := AllTrim(SubStr(cLinha, Len(sKeyBusca) + 3, Len(cLinha) - (Len(sKeyBusca)*2) - 5))
aXml[xx] := ''
ELSEIF Empty(nPosFimKey)
lOk := .F.
ELSE
sSeparaKey := ''
FOR yy := xx + 1 TO nPosFimKey -1
sSeparaKey += aXml[yy]
aXml[yy] := ''
NEXT
aXml[xx] := ''
aXml[nPosFimKey] := ''
sParametro := NIL
IF hIskey(hXml, sKeyBusca, .T.)
hXml[sKeyBusca] := XML_CriaLista(hXml[sKeyBusca])
AAdd(hXml[sKeyBusca], HashMath())
IF ' ' $ cLinha
sParametro := AllTrim(SubStr(cLinha, nPos, Len(cLinha)-nPos))
ENDIF
nPos := Len(hXml[sKeyBusca])
IF !Xml_Hash_Formata(sSeparaKey, @hXml[sKeyBusca, nPos], sParametro)
lOk := .F.
ENDIF
ELSE
hXml[sKeyBusca] := NIL
IF ' ' $ cLinha
sParametro := AllTrim(SubStr(cLinha, nPos, Len(cLinha)-nPos))
ENDIF
IF !Xml_Hash_Formata(sSeparaKey, @hXml[sKeyBusca], sParametro)
lOk := .F.
ENDIF
ENDIF
ENDIF
NEXT
RETURN lOk
//recupera valor, sem gerar erro caso chave não exista
FUNCTION XML_GetValor( hXml, uKeyBusca, uDefault, lUpper)
LOCAL hXmlChaveRet, aKeyBusca, xx
IF !ValType(hXml) = "H"
RETURN uDefault
ENDIF
IF ValType(uKeyBusca) = 'C'
uKeyBusca := StrTran(uKeyBusca, '><', '>,<')
aKeyBusca := Split(uKeyBusca, ',')
ELSEIF ValType(uKeyBusca) = 'A'
aKeyBusca := uKeyBusca
ELSEIF ValType(uKeyBusca) = 'N'
aKeyBusca := { xStr(uKeyBusca) }
ELSE
RETURN uDefault
ENDIF
FOR xx := 1 TO Len(aKeyBusca)
DEFA aKeyBusca[xx] TO ''
IF !ValType(aKeyBusca[xx]) = 'C'
aKeyBusca[xx] := xStr(aKeyBusca[xx])
ELSE
IF Left(aKeyBusca[xx], 1) = "<"
aKeyBusca[xx] := SubStr(aKeyBusca[xx], 2)
ENDIF
IF Right(aKeyBusca[xx], 1) = ">"
aKeyBusca[xx] := Left(aKeyBusca[xx], Len(aKeyBusca[xx])-1)
ENDIF
ENDIF
NEXT
hXmlChaveRet := hXml
FOR xx := 1 TO Len(aKeyBusca)
hXmlChaveRet := XML_GetValor1( hXmlChaveRet, aKeyBusca[xx], lUpper )
IF hXmlChaveRet = NIL
hXmlChaveRet := uDefault
EXIT
ENDIF
NEXT
RETURN hXmlChaveRet
STATIC FUNCTION XML_GetValor1( hXML, sKeyBusca, lUpper )
STATIC nItem := 0
LOCAL sRet, sItemMove, xx
DEFA lUpper TO .T.
IF sKeyBusca == '{-P-}' //USADO PARA TESTAR SEM PRECISAR DEBUGAR
RETURN nItem
ENDIF
IF ValType(hXml) = 'A'
IF sKeyBusca == '{}' .or. Empty(sKeyBusca)
sKeyBusca := nItem
ELSEIF sKeyBusca == '{+}'
nItem ++
sKeyBusca := nItem
ELSEIF sKeyBusca == '{-}'
nItem --
sKeyBusca := nItem
ELSEIF Left(sKeyBusca,2) == '{+' .and. Right(sKeyBusca, 1) = '}'
sItemMove := SubStr(sKeyBusca, 3, Len(sKeyBusca)-3)
sKeyBusca := Val(sItemMove)
nItem += sKeyBusca
sKeyBusca := nItem
ELSEIF Left(sKeyBusca,2) == '{-' .and. Right(sKeyBusca, 1) = '}'
sItemMove := SubStr(sKeyBusca, 3, Len(sKeyBusca)-3)
sKeyBusca := Val(sItemMove)
nItem -= sKeyBusca
sKeyBusca := nItem
ELSEIF Left(sKeyBusca, 1) = '{' .and. Right(sKeyBusca, 1) = '}' .and. Val(SubStr(sKeyBusca, 2, Len(sKeyBusca)-2)) > 0
sItemMove := SubStr(sKeyBusca, 2, Len(sKeyBusca)-2)
nItem := Val(sItemMove)
sKeyBusca := nItem
ELSEIF Val(sKeyBusca) > 0
nItem := Val(sKeyBusca)
sKeyBusca := nItem
ELSE
IF Left(sKeyBusca, 1) = '{' .and. Right(sKeyBusca, 1) = '}'
sItemMove := SubStr(sKeyBusca, 2, Len(sKeyBusca)-2)
nItem := 0
sKeyBusca := 0
IF !Empty(sItemMove)
FOR xx := 1 TO Len(hXml)
IF iif(Empty(lUpper), hXml[xx, '_parametro'], Upper(hXml[xx, '_parametro'])) = iif(Empty(lUpper), sItemMove, Upper(sItemMove))
nItem := xx
sKeyBusca := xx
ENDIF
NEXT
ENDIF
ELSE
nItem := 0
sKeyBusca := 0
ENDIF
ENDIF
IF sKeyBusca <= 0 .or. sKeyBusca > Len(hXml)
sRet := NIL
nItem := 0
ELSE
sRet := hXml[sKeyBusca]
nItem := sKeyBusca
ENDIF
ELSE
IF sKeyBusca == '{1}' .or. sKeyBusca == '{}' .or. Empty(sKeyBusca)
sRet := hXml
nItem := 1
ELSEIF Left(sKeyBusca, 1) = '{' .and. Right(sKeyBusca, 1) = '}'
sItemMove := SubStr(sKeyBusca, 2, Len(sKeyBusca)-2)
IF iif(Empty(lUpper), hXml['_parametro'], Upper(hXml['_parametro'])) = iif(Empty(lUpper), sItemMove, Upper(sItemMove))
sRet := hXml
ENDIF
nItem := 0
ELSEIF hIsKey(hXml, sKeyBusca, lUpper )
sRet := hXml[sKeyBusca]
ELSE
sRet := NIL
ENDIF
ENDIF
RETURN sRet
//cria lista de elementos com mesmo nome, EX itens de NFe elemento [prod]
FUNCTION XML_CriaLista(hXml)
LOCAL hXmlTmp
IF !ValType(hXml) = 'A'
hXmlTmp := hXml
hXml := {}
AAdd(hXml, hXmlTmp)
ENDIF
RETURN hXml
FUNCTION alerta(sMsg)
RETURN Alert(sMsg)
function XStr(uParO, lTrim, nDec, lTrimZero)
LOCAL uPar
LOCAL cTipo
LOCAL cRet
DEFA lTrim TO .T.
IF ValType(uParO) = "O"
//IF ExecutaBlock( {|| uParO:Buffer } ) //previne erro em tempo de execução
uPar := uParO:Buffer
//ENDIF
ELSE
uPar := uParO
ENDIF
cTipo := ValType(uPar)
do case
case cTipo = "C" .OR. cTipo = "M"
IF lTrim
cRet:= Trim(uPar)
ELSE
cRet:= uPar
ENDIF
case cTipo = "N"
IF lTrim
cRet:= LTrim(Str(uPar)) //nTrim(uPar, nDec, lTrimZero)
HB_SYMBOL_UNUSED( lTrimZero )
ELSEIF nDec = NIL
cRet:= Str(uPar)
ELSE
cRet:= Str(uPar, Len(Str(uPar)), nDec)
ENDIF
case cTipo = "D"
IF Empty( lTrim )
cRet := DToS( uPar )
ELSE
cRet := DToC( uPar )
ENDIF
//case cTipo = "T"
// cRet:= xData(uPar)
// IF Empty( lTrim )
// cRet := DToS(cRet)
// ELSE
// cRet := DToC(cRet)
// ENDIF
case cTipo = "L"
cRet:= iif(uPar, ".T.", ".F.")
other
cRet := ""
endcase
return cRet
FUNCTION CrLf()
RETURN Chr(13) + Chr(10)
FUNCTION FileRead(sArquivo)
RETURN MemoRead(sArquivo)
FUNCTION HashMath( has )
DEFA has TO { => }
HB_HCASEMATCH( has, .F. )
RETURN has
FUNCTION hIsKey( Hash, sKeyBusca, lNoCaseMath )
LOCAL sKey, lOk
DEFA lNoCaseMath TO .T.
lOk := .F.
IF !Empty(lNoCaseMath)
sKeyBusca := Upper( sKeyBusca )
ENDIF
FOR EACH sKey IN Hash:Keys
IF lNoCaseMath .and. sKeyBusca == Upper(sKey)
lOk := .T.
EXIT
ELSEIF sKeyBusca == sKey
lOk := .T.
EXIT
ENDIF
NEXT
RETURN lOk
Function Split(sString, aDelimitador, lDeliByte, sComent, lUpper, nTrim, sIgnoraString)
loca aRet := {}, xx, aDeli
DEFA aDelimitador TO ';'
DEFA lDeliByte TO .T.
DEFA lUpper TO .F.
DEFA nTrim TO 0 //0-Nada, 1-Trim, 2-LTrim, 3-AllTrim
DEFA sIgnoraString TO ""
IF lUpper
sString := Upper(sString)
ENDIF
IF ValType(aDelimitador) = "C"
IF lDeliByte
aDelimitador := StrByteArray( aDelimitador )
ELSE
aDelimitador := { aDelimitador }
ENDIF
ENDIF
aRet := Split1( sString, aDelimitador[ 1 ], sComent, nTrim, sIgnoraString )
IF Len(aDelimitador) > 1
aDeli := Array(Len(aDelimitador) - 1)
aCopy(aDelimitador, aDeli, 2, len(aDeli))
ELSE
RETU aRet
ENDIF
FOR xx = 1 TO Len(aRet)
sString := Split(aRet[ xx ], aDeli,, sComent, lUpper, nTrim, sIgnoraString)
IF Len(sString) > 1
aRet[ xx ] := sString
ENDIF
NEXT
RETURN aRet
static function Split1(sString, sDelimitador, sComent, nTrim, sIgnoraString)
loca aRet := {}, nPos, xx, nPosI := 0, nPosF := 0, sAjusta := ""
DEFA sDelimitador TO Chr(13) + Chr(10)
DEFA sComent TO ""
DEFA nTrim TO 0 //0-Nada, 1-Trim, 2-LTrim, 3-AllTrim
DEFA sIgnoraString TO ""
IF Len( sIgnoraString ) = 1
sIgnoraString := sIgnoraString + sIgnoraString
ENDIF
IF Right(sString, 1) = sDelimitador
sString += sDelimitador
ENDIF
WHILE Len(sString) > 0
nPosI := 0
nPosF := 0
IF !Empty( sIgnoraString )
nPosI := At(Left(sIgnoraString, 1), sString)
nPosF := AtCount(Right(sIgnoraString, 1), sString, 2)
ENDIF
nPos := At(sDelimitador, sString)
IF nPosI > 0 .and. nPosF > 0 .and. nPos > nPosI .and. nPos < nPosF
sAjusta := sAjusta + Left(sString, nPosF)
sString := SubStr( sString, nPosF + 1)
LOOP
ENDIF
IF nPos > 0
IF Empty(sComent) .or. !sString = sComent
aadd(aRet, sAjusta + Left(sString, nPos - 1))
ENDIF
sString := SubStr(sString, nPos + Len(sDelimitador))
sAjusta := ""
ELSE
IF Empty(sComent) .or. !sString = sComent
aadd(aRet, AllTrim(sAjusta + sString) )
ENDIF
sString := ""
sAjusta := ""
ENDIF
ENDDO
IF nTrim > 0
FOR xx = 1 to Len( aRet )
IF nTrim = 1
aRet[xx] := Trim( aRet[xx] )
ELSEIF nTrim = 2
aRet[xx] := LTrim( aRet[xx] )
ELSEIF nTrim = 3
aRet[xx] := AllTrim( aRet[xx] )
ENDIF
#ifdef TESTE
? xx, aRet[ xx ]
#endif
NEXT
ENDIF
RETURN aRet
FUNCTION AtCount( sBusca, sTxt, nCount, lUpper )
LOCAL nPos, nPosI
DEFA nCount TO 1
DEFA lUpper TO .f.
IF lUpper
sBusca := Upper( sBusca )
sTxt := Upper( sTxt )
ENDIF
nPosI := (Len( sBusca ) * -1) + 1
WHILE ( nPos := At( sBusca, SubStr( sTxt, nPosI + Len( sBusca ) ) ) ) > 0
IF nPosI <= 0
nPosI := nPos
ELSE
nPosI += ( nPos + Len( sBusca ) - 1 )
ENDIF
nCount --
IF nCount <= 0
EXIT
ENDIF
ENDDO
IF nCount > 0
RETURN 0
ENDIF
RETURN nPosI
Function StrByteArray(sString, nByte)
loca xx, aRet := {}
DEFA nByte TO 1
FOR xx = 1 TO Len(sString) STEP nByte
aadd(aRet, SubStr(sString, xx, nByte))
NEXT
RETU aRet