Import initial din SVN ROAAUTO/Trunk @HEAD

COMUN/utile/nfXml/nfxmlCREATE.PRG

@@ -0,0 +1,173 @@
+************************************************************************************
+* 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
+