Files
vfp_roaauto/COMUN/utile/nfXml/nfxmlCREATE.PRG

174 lines
3.5 KiB
Plaintext

************************************************************************************
* Program created by Marco Plaza , 2013-2016
* vfp2nofox@gmail.com
* @vfp2nofox
* REVISION 1.0500 2016/08/09
************************************************************************************
Parameters ovfp,nofmt
#INCLUDE NFXML.H
If Vartype(m.ovfp) # 'O' Or Vartype(m.nofmt) # 'L'
Error "Invalid parameter type"
Endif
Private All
m.crlf = Iif(!m.nofmt,Chr(13)+Chr(10),'')
cxml=''
=o2xml(m.ovfp,'','',m.crlf)
If Amembers(aa,m.ovfp,0,'U') > 1
cxml = '<xml>'+m.cxml+m.crlf+'</xml>'
Endif
cxml = '<?xml version="1.0" encoding="utf-8"?>'+m.cxml
Return Strconv(m.cxml,9)
*-----------------------------------------------------------
Function o2xml(esteo,oname,nivel,m.crlf,atributos,atclosetag)
*-----------------------------------------------------------
oname = Lower(m.oname)
Private All Except cxml
closetag = ''
otag = xtag(m.oname)
np = Amembers(aprop,m.esteo,0,'U')
Do Case
Case atributos
closetag = m.atclosetag
Case !Empty(m.otag)
cxml = m.cxml+m.crlf+m.nivel+'<'+m.otag
If Type('esteo.'+ATTRIBUTETAG) # 'O'
cxml = m.cxml+'>'
Endif
If Type('esteo.'+ATTRIBUTETAG) # 'O' Or np > 1
closetag = m.crlf+m.nivel+'</'+m.otag+'>'
Endif
Endcase
If '' # m.crlf
nivel = m.nivel+Space(3)
Endif
If np > 0
* colocar atributos de 1ero:
npa = Ascan(aprop,ATTRIBUTETAG,1,-1,1,1)
If npa > 0
=Acopy(aprop,tempa)
aprop(1) = tempa(npa)
aprop(npa) = tempa(1)
Endif
For Each vari In m.aprop
esarray = Type('esteo.&vari',1) = 'A'
esobjeto = Type('esteo.&vari') = 'O'
Do Case
Case Lower(m.vari) = ATTRIBUTETAG
=o2xml(esteo.&vari,m.vari,m.nivel,m.crlf, .T. , Iif(m.np > 1,'>','/>') )
Case esarray
For x = 1 To Alen(esteo.&vari)
m.ele = esteo.&vari(m.x)
If Vartype(m.ele) = 'O'
=o2xml(m.ele,m.vari,m.nivel,m.crlf)
Else
valorAxml( m.vari, m.ele , m.atributos , m.nivel )
Endif
Endfor
Case esobjeto
=o2xml(esteo.&vari,m.vari,m.nivel,m.crlf)
Otherwise
valorAxml( m.vari, esteo.&vari , m.atributos , m.nivel )
Endcase
Endfor
Endif
cxml = m.cxml+m.closetag
*------------------------
Function xtag(kk)
*------------------------
If Lower(m.kk) == ATTRIBUTETAG Or Lower(M.kk) == NODETEXTTAG
Return m.kk
Endif
tr = Sys(3)
kk = Strtran(m.kk,'__',m.tr)
kk = Ltrim( m.kk,1,'_')
kk = Strtran(m.kk,'_',':')
kk = Strtran(m.kk,'_l_','(')
kk = Strtran(m.kk,'_r_',')')
kk = Strtran(m.kk,'_h_','-')
kk = Strtran(m.kk,'_d_','.')
kk = Strtran(m.kk,m.tr,'_')
Return m.kk
*-------------------------------
Function escapar(valor)
*-------------------------------
If Len(Chrtran(m.valor,["'<>&],'')) # Len(m.valor)
valor = Strtran(m.valor,[&],[&amp;])
valor = Strtran(m.valor,['],[&apos;])
valor = Strtran(m.valor,[<],[&lt;])
valor = Strtran(m.valor,[>],[&gt;])
valor = Strtran(m.valor,["],[&quot;])
Endif
Return m.valor
*------------------------------------------------------
Procedure valorAxml( vari, valor , atributos , nivel )
*------------------------------------------------------
m.xtag = Lower(xtag(m.vari))
Do Case
Case Lower(m.vari) == NODETEXTTAG
m.cxml = m.cxml+m.crlf+m.nivel+escapar(Transform(m.valor))
Case !atributos
m.cxml = m.cxml+m.crlf+m.nivel+'<'+m.xtag+'>'+escapar(Transform(m.valor))+'</'+m.xtag+'>'
Otherwise
m.cxml = m.cxml+' '+m.xtag+'="'+escapar(Transform(m.valor))+'"'
Endcase