FROM XML TO DBF

[edk]

Working simplified sample:

Code: Select all

#require "hbmxml.hbc"

#include "hmg.ch"

Function Main

DBCREATE( 'invoice.dbf', { { "uid", "C", 40, 0 },;
		{ "IssuerVatN" , "C", 9, 0 },;
		{ "CountVatN" , "C", 9, 0 },;
		{ "issueDate", "D", 8, 0 },;
		{ "totNetVal", "N", 10, 2 } } )

DBCREATE( 'invoiceDetails.dbf', { { "uid", "C", 40, 0 },;
		{ "LineNumber" , "N", 5, 0 },;
		{ "NetValue", "N", 10, 2 } } )
						   

DEFINE WINDOW Form_1 AT 0 , 0 WIDTH 300 HEIGHT 100 TITLE "HMG" MAIN ON INIT Start() 

END WINDOW

CENTER WINDOW Form_1
ACTIVATE WINDOW Form_1

***********************************
Function Start()

Local cXmlFile := GetFile( {{'XML File', '*.xml'}}, 'Select XML', hb_CWD(), .F. , .T. )

IF EMPTY( cXmlFile )
	RETURN Nil
ENDIF

SELECT 1
USE invoice
ZAP

SELECT 2
USE invoiceDetails
ZAP

WAIT WINDOW "Processing ..." NOWAIT

hb_XMLParser( hb_MemoRead ( cXmlFile ), .T., { | aRowXML | Parser_Request ( aRowXML ) } )

WAIT CLEAR

MsgInfo ( "Done" )

Return Nil
*******************************************************
Function Parser_Request ( aXmlOneRow ) 
Local cPath, cKey, xValue, hAttrib, xAttribValue 

cPath   := aXmlOneRow [ 1 ]
cKey    := aXmlOneRow [ 2 ]
xValue  := aXmlOneRow [ 3 ]
hAttrib := aXmlOneRow [ 4 ]

****** DO CASE for the Request.xml file structure ********
DO CASE
	CASE cKey == "uid" .AND. cPath == "RequestedDoc/invoicesDoc/invoice"
		SELECT invoice
		APPEND BLANK
		REPLACE invoice->uid WITH xValue
		
	CASE cKey == "vatNumber" .AND. cPath == "RequestedDoc/invoicesDoc/invoice/issuer"
		REPLACE invoice->IssuerVatN WITH xValue
		
	CASE cKey == "vatNumber" .AND. cPath == "RequestedDoc/invoicesDoc/invoice/counterpart"
		REPLACE invoice->CountVatN WITH xValue
		
	CASE cKey == "issueDate" .AND. cPath == "RequestedDoc/invoicesDoc/invoice/invoiceHeader"
		REPLACE invoice->issueDate WITH hb_CToD( xValue, "YYYY-MM-DD" )
		
	CASE cKey == "lineNumber" .AND. cPath == "RequestedDoc/invoicesDoc/invoice/invoiceDetails"
		SELECT invoiceDetails
		APPEND BLANK
		REPLACE invoiceDetails->uid WITH invoice->uid
		REPLACE invoiceDetails->lineNumber WITH Val ( xValue )
		
	CASE cKey == "netValue" .AND. cPath == "RequestedDoc/invoicesDoc/invoice/invoiceDetails"
		REPLACE invoiceDetails->netValue WITH Val ( xValue )

	CASE cKey == "totalNetValue" .AND. cPath == "RequestedDoc/invoicesDoc/invoice/invoiceSummary"
		SELECT invoice 
		REPLACE invoice->totNetVal WITH Val ( xValue )

END CASE
Return

*****************************************************************************
STATIC FUNCTION hb_XMLParser( cXML, lOmitHeader, xFunction )
LOCAL pXML

Default lOmitHeader := .T.

IF hb_StrIsUtf8 ( cXML )
	cXML := hb_utf8ToStr( cXML )
ENDIF

pXML := mxmlLoadString( NIL, cXML, MXML_OPAQUE_CALLBACK )
IF !Empty( pXML )
	IF lOmitHeader
		hb_XMLParser_getnodes( mxmlGetFirstChild( pXML ), xFunction )
	ELSE
		hb_XMLParser_getnodes( pXML, xFunction )
	ENDIF
	mxmlDelete( pXML )
ENDIF

RETURN

*****************************************************************************

STATIC FUNCTION hb_XMLParser_getnodes( pNode, xFunction )
LOCAL cKey, pChild, xResult, xValue, cPrevKey, hAttrib, pParrentNode, cPath

DO WHILE !Empty( pNode )

	IF mxmlGetType( pNode ) == MXML_ELEMENT
		
		cKey   := mxmlGetElement( pNode )
		pChild := mxmlGetFirstChild( pNode )
		
		IF hb_mxmlGetAttrsCount ( pNode ) > 0 .AND. !Empty( pChild ) .AND. ( mxmlGetOpaque( pNode ) = CRLF .OR. Empty ( mxmlGetOpaque( pNode ) ) )	//Support nodes with child node and attribute(s) and no value
			
			cPath := ""
			pParrentNode := mxmlGetParent( pNode )
				
			IF Left ( cKey, 8 ) == "![CDATA["
				xValue       := hb_StrShrink  ( mxmlGetCDATA ( pNode ), 2 )
				cKey         := mxmlGetElement( mxmlGetParent( pNode ) )
				pParrentNode := mxmlGetParent ( mxmlGetParent( pNode ) )
			ENDIF
				
			DO WHILE !EMPTY ( pParrentNode )
				cPrevkey := mxmlGetElement( pParrentNode )
				IF Left ( cPrevkey, 4 ) <> "?xml"
					cPath := cPrevkey + IF( !Empty( cPath ), "/", "") + cPath 
				ENDIF
				pParrentNode := mxmlGetParent( pParrentNode )
			ENDDO
			hAttrib := hb_mxmlGetAttrs( pNode )
			IF HB_ISEVALITEM( xFunction )
				Eval( xFunction, { cPath, cKey, Nil, hAttrib } )
			ENDIF
		
		ENDIF
		
		xValue := hb_XMLParser_getnodes( pChild, xFunction )

		IF xValue == NIL
			xValue := mxmlGetOpaque( pNode )
			
			IF !(xValue == CRLF)
				cPath        := ""
				pParrentNode := mxmlGetParent( pNode )
				
				IF Left ( cKey, 8 ) == "![CDATA["
					xValue       := hb_StrShrink  ( mxmlGetCDATA ( pNode ), 2 )
					cKey         := mxmlGetElement( mxmlGetParent( pNode ) )
					pParrentNode := mxmlGetParent ( mxmlGetParent( pNode ) )
				ENDIF
				
				DO WHILE !EMPTY ( pParrentNode )
					cPrevkey := mxmlGetElement( pParrentNode )
					IF Left ( cPrevkey, 4 ) <> "?xml"
						cPath := cPrevkey + IF( !Empty( cPath ), "/", "") + cPath 
					ENDIF
					pParrentNode := mxmlGetParent( pParrentNode )
				ENDDO
				hAttrib := hb_mxmlGetAttrs( pNode )
				IF HB_ISEVALITEM( xFunction )
					Eval( xFunction, { cPath, cKey, xValue, hAttrib } )
				ENDIF
				xResult := { cPath, cKey, xValue, hAttrib } 
			ENDIF
		ENDIF
		
	ENDIF
	pNode := mxmlGetNextSibling( pNode )
ENDDO
RETURN xResult

[majkll_ns]

I need a help to run given prg.

1. Try build using HMG 3.4.4 IDE
====================================

Harbour 3.2.0dev (r1703241902)
Copyright (c) 1999-2016, http://harbour-project.org/
C:/Users/mkl/AppData/Local/Temp/hbmk_8buq5p.dir/TEST.o:TEST.c:(.data+0x238): undefined reference to `HB_FUN_MXMLLOADSTRING'
C:/Users/mkl/AppData/Local/Temp/hbmk_8buq5p.dir/TEST.o:TEST.c:(.data+0x268): undefined reference to `HB_FUN_MXMLGETFIRSTCHILD'
C:/Users/mkl/AppData/Local/Temp/hbmk_8buq5p.dir/TEST.o:TEST.c:(.data+0x278): undefined reference to `HB_FUN_MXMLDELETE'
...
collect2.exe: error: ld returned 1 exit status
hbmk2[TEST]: Error: Running linker. 1
gcc.exe C:/Users/mkl/AppData/Local/Temp/hbmk_8buq5p.dir/TEST.o
C:/Users/mkl/AppData/Local/Temp/hbmk_8buq5p.dir/hbmk_dx5y41.o
D:/AW23/PROBAXML/_temp.o -pthread -static-libgcc -static-libstdc++
-static -lpthread -mwindows -Wl,--start-group -lhmg -lcrypt -ledit -leditex
-lgraph -lini -lreport -lhfcl -lmsvfw32 -lvfw32 -lhbmysql -lmysql -lhbfimage
-lhbpgsql -lsddmy -lhbvpdf -lhbct -lhbwin -lhbmzip -lminizip -lhbmemio
-lhbmisc -lhbtip -lsqlite3 -lhbsqlit3 -lsddodbc -lrddsql -lhbodbc -lodbc32
-lhbhpdf -lhbnetio -lxhb -lpng -llibhpdf -lhbzebra -lhbextern -lhbdebug
-lhbvmmt -lhbrtl -lhblang -lhbcpage -lgtcgi -lgtpca -lgtstd -lgtwin
-lgtwvt -lgtgui -lhbrdd -lhbuddall -lhbusrrdd -lrddntx -lrddcdx -lrddnsx
-lrddfpt -lhbrdd -lhbhsx -lhbsix -lhbmacro -lhbcplr -lhbpp -lhbcommon
-lhbmainwin -lkernel32 -luser32 -lgdi32 -ladvapi32 -lws2_32 -liphlpapi
-lwinspool -lcomctl32 -lcomdlg32 -lshell32 -luuid -lole32 -loleaut32
-lmpr -lwinmm -lmapi32 -limm32 -lmsimg32 -lwininet -lhbpcre -lhbzlib
-Wl,--end-group -oTEST.exe -LC:/hmg344/harbour/lib/win/mingw -LC:/hmg344/lib

hbmk2: Hint: Add option 'hbmxml.hbc' for missing function(s):
mxmlGetNextSibling(), hb_mxmlGetAttrs(), mxmlGetCDATA(),
mxmlGetParent(), mxmlGetOpaque(), hb_mxmlGetAttrsCount(),
mxmlGetElement(), mxmlGetType(), mxmlDelete(), mxmlGetFirstChild(),
mxmlLoadString()



2. after adding libs=hbmxml in # harbour contrib libs section of \HMG244\hmg32.hbc
=======================================================================

try to build using HMG 3.4.4 IDE

Harbour 3.2.0dev (r1703241902)
Copyright (c) 1999-2016, http://harbour-project.org/
C:/hmg344/harbour/lib/win/mingw\libhbmxml.a(core.o):core.c:(.text+0xe2): undefined reference to `mxmlIndexDelete'
C:/hmg344/harbour/lib/win/mingw\libhbmxml.a(core.o):core.c:(.text+0x1de): undefined reference to `mxmlRetain'
....

hbmk2[TEST]: Error: Running linker. 1
gcc.exe C:/Users/mkl/AppData/Local/Temp/hbmk_b6qcup.dir/TEST.o
C:/Users/mkl/AppData/Local/Temp/hbmk_b6qcup.dir/hbmk_7v4dl1.o
D:/AW23/PROBAXML/_temp.o
-pthread -static-libgcc -static-libstdc++ -static -lpthread
-mwindows -Wl,--start-group -lhmg -lcrypt -ledit -leditex -lgraph
-lini -lreport -lhfcl -lmsvfw32 -lvfw32 -lhbmysql -lmysql -lhbfimage
-lhbpgsql -lsddmy -lhbvpdf -lhbct -lhbwin -lhbmzip -lminizip -lhbmemio
-lhbmisc -lhbtip -lsqlite3 -lhbsqlit3 -lsddodbc -lrddsql -lhbodbc
-lodbc32 -lhbhpdf -lhbnetio -lxhb -lpng -llibhpdf -lhbzebra -lhbmxml
-lhbextern -lhbdebug -lhbvmmt -lhbrtl -lhblang -lhbcpage -lgtcgi
-lgtpca -lgtstd -lgtwin -lgtwvt -lgtgui -lhbrdd -lhbuddall -lhbusrrdd
-lrddntx -lrddcdx -lrddnsx -lrddfpt -lhbrdd -lhbhsx -lhbsix -lhbmacro
-lhbcplr -lhbpp -lhbcommon -lhbmainwin -lkernel32 -luser32 -lgdi32
-ladvapi32 -lws2_32 -liphlpapi -lwinspool -lcomctl32 -lcomdlg32
-lshell32 -luuid -lole32 -loleaut32 -lmpr -lwinmm -lmapi32 -limm32
-lmsimg32 -lwininet -lhbpcre -lhbzlib -Wl,--end-group -oTEST.exe
-LC:/hmg344/harbour/lib/win/mingw -LC:/hmg344/lib



3. after adding #include "hbmxml.hbx" in test.prg
===============================================================

HMG Errorlog File
------------------------------------
Error BASE/1003 Variable does not exist: MXML_OPAQUE_CALLBACK
Called from HB_XMLPARSER(103)
Called from START(45)
Called from (b)MAIN(19)
Called from _PROCESSINITPROCEDURE(5876)
Called from _ACTIVATEWINDOW(5627)
Called from MAIN(24)

------------------------------------


4. after adding #include "hbmxml.hbx" in test.prg
===============================================================

HMG Errorlog File
------------------------------------
Error BASE/1001 Undefined function: MXMLLOADSTRING
Called from MXMLLOADSTRING(0)
Called from HB_XMLPARSER(104)
Called from START(46)
Called from (b)MAIN(20)
Called from _PROCESSINITPROCEDURE(5876)
Called from _ACTIVATEWINDOW(5627)
Called from MAIN(25)
------------------------------------


What am I doing wrong??

[AUGE_OHR]

hi,

hbmk2: Hint: Add option 'hbmxml.hbc' for missing function(s):
mxmlGetNextSibling(), hb_mxmlGetAttrs(), mxmlGetCDATA(),
mxmlGetParent(), mxmlGetOpaque(), hb_mxmlGetAttrsCount(),
mxmlGetElement(), mxmlGetType(), mxmlDelete(), mxmlGetFirstChild(),
mxmlLoadString()

2. after adding libs=hbmxml in # harbour contrib libs section of \HMG244\hmg32.hbc
3. after adding #include "hbmxml.hbx" in test.prg
4. after adding #include "hbmxml.hbx" in test.prg

What am I doing wrong??

when want to add a "libs" do NOT use "Prefix" hb

hbmxml.hbc -> libs=mxml

when not found use "path" before "libs"

path=c:\hmg.3.4.4\HARBOUR\contrib\hbmxml

[majkll_ns]

5. after puting libs=mxml in # harbour contrib libs section of \HMG244\hmg32.hbc

still get error

Error BASE/1001 Undefined function: MXMLLOADSTRING
Called from MXMLLOADSTRING(0)
Called from HB_XMLPARSER(104)
Called from START(46)
Called from (b)MAIN(20)
Called from _PROCESSINITPROCEDURE(5876)
Called from _ACTIVATEWINDOW(5627)
Called from MAIN(25)

[edk]

I need a help to run given prg.

1. Try build using HMG 3.4.4 IDE
====================================

Harbour 3.2.0dev (r1703241902)
Copyright (c) 1999-2016, http://harbour-project.org/
C:/Users/mkl/AppData/Local/Temp/hbmk_8buq5p.dir/TEST.o:TEST.c:(.data+0x238): undefined reference to `HB_FUN_MXMLLOADSTRING'
C:/Users/mkl/AppData/Local/Temp/hbmk_8buq5p.dir/TEST.o:TEST.c:(.data+0x268): undefined reference to `HB_FUN_MXMLGETFIRSTCHILD'
C:/Users/mkl/AppData/Local/Temp/hbmk_8buq5p.dir/TEST.o:TEST.c:(.data+0x278): undefined reference to `HB_FUN_MXMLDELETE'
...

hbmk2: Hint: Add option 'hbmxml.hbc' for missing function(s):
mxmlGetNextSibling(), hb_mxmlGetAttrs(), mxmlGetCDATA(),
mxmlGetParent(), mxmlGetOpaque(), hb_mxmlGetAttrsCount(),
mxmlGetElement(), mxmlGetType(), mxmlDelete(), mxmlGetFirstChild(),
mxmlLoadString()

It's quite simple.
As hinted by the linker, just add libs=hbmxml.hbc to your project's configuration file.
You don't need to change anything in hmg32.hbc
The ready-to-use project can be found in the attachment.

majkll_ns.7z

(66.92 KiB) Downloaded 105 times

[majkll_ns]

Thank you !!

I didn't know what it mean "just add libs=hbmxml.hbc to your project's configuration file"
Just add watter
It work fine now.

In a meanwhile, i need to have something, and make own parsing.
Maybe it can help somebody else too.
(in a code, i just show first 100 keys, but once parsing is done you can do whatever)

Code: Select all

#include <hmg.ch>

Function Main

  appd  = GetStartUpFolder()+'\'
  mcrlf = chr(13)+chr(10)

  DEFINE WINDOW mainf;
    AT 140,300 ;
    WIDTH 1200 ;
    HEIGHT 750 ;
    TITLE 'ViewXML';
    MAIN

  	DEFINE MAIN MENU
        POPUP "View"
            ITEM "ViewXML" ACTION viewXml()
        END POPUP
    END MENU

	DEFINE EDITBOX Edit_1
      row 20
      col 20
      WIDTH  1100
	  HEIGHT 500
      FONTNAME "Courier"
      FONTSIZE 12 
      VISIBLE .t.
	  VALUE ' '
      hscrollbar .f.
    END EDITBOX
  end window

  Mainf.Center
  mainf.Activate
  
Return


//------------------------------------
procedure ViewXML()
//------------------------------------

fn := Getfile ( { {'XML','*.xml'} } , 'Open file' , appd , .f. )
if empty(fn)
  return
endif
yxml := filestr(fn)

// xml_keys  is  array of elements {key, value, keypath}
xml_keys := parseXML(yxml)

estr    = ''
show_key = min(len(xml_keys), 100)

for xi=1 to show_key
  xml_e = xml_keys[xi]
  m_key = xml_e[1]
  m_val = xml_e[2]
  m_pat = xml_e[3]
  estr = estr+ ppad(m_key,20)+' '+ ppad(m_val,20)+' '+ppad(m_pat,70) + mcrlf
  mainf.edit_1.value:= estr
next xi

mainf.edit_1.value:= estr
do events
return

//------------------------------------
function parseXML( yxml)
//------------------------------------
// return  array of elements {key, value, keypath}

xml_at  = 0    // parsing is done to this point
xml_lvl = 1    // key level
xml_do = .t.   // there is more to do

declare xml_path[100]  // store path in a way to key
afill(xml_path,'')
xml_ret = {}

do while xml_do
  p1 = xml_findkey(yxml, xml_at, xml_lvl)
  xml_lvl = p1[1]
  xml_typ = p1[2]
  xml_key = p1[3]
  xml_val = p1[4]
  xml_at  = p1[5]

  if xml_typ='V'  // add value to result
    xml_p =''
    for xi=1 to xml_lvl  // build path
      xml_p := xml_p + '/'+xml_path[xi]
    next xi
    xml_el = { xml_key, xml_val, xml_p}
    aadd(xml_ret, xml_el)
    DO EVENTS
  endif

  if p1[2]='-'
    xml_do = .f.
  endif
enddo
return xml_ret

//--------------------------------------------
function xml_findkey(xstr, xpos, xxml_lvl)
//--------------------------------------------
//                  <key     >value</key>  
//                  ^   ^    ^     ^    ^
//  position        m1  m2a  m2    m3   m4

local m1, m2, m2a, m3, m4
local kyx, kyv, yt1, chm2
local yxml_at, ytyp, ykey

m1 = hb_at('<',xstr,xpos)
m2 = hb_at('>',xstr,m1+1,m1+1000)
m2a= hb_at(' ',xstr,m1+1,m1+1000)
m3 = hb_at('<',xstr,m2+1)
m4 = hb_at('>',xstr,m3+1)

chm2 = substr(xstr,m2-1,1)
if m1=0 .or. m2=0
  return {0, '-', '', '', -1}
endif

if m2a=0
  m2a=m2
else
  if m2<m2a
    m2a=m2
  endif
endif

duz= m2a-m1-1
ykey   = substr(xstr,m1+1,duz)
yvalue = ''

do case
  case substr(ykey,1,1)=chr(63)
    ytyp     = 'Z'
    yxml_lvl = xxml_lvl
    yxml_at  = m2+1
  case substr(ykey,1,1)='/'
    ytyp='E'
    yxml_lvl = xxml_lvl -1
    yxml_at  = m2+1
  otherwise
    // is value here
    if chm2 = '/'
      yvalue   = substr(xstr, m2a, m2-m2a-1)
      ytyp     = 'V'
      yxml_at  = m2+1
      yxml_lvl = xxml_lvl
    elseif substr(xstr,m3,duz+2)='</'+ykey
      yvalue   = substr(xstr, m2+1, m3-m2-1)
      ytyp     = 'V'
      yxml_at  = m4+1
      yxml_lvl = xxml_lvl
    else
      ytyp='B'
      yxml_lvl = xxml_lvl +1
      xml_path[yxml_lvl]=ykey
      yxml_at  = m2+1
    endif
endcase
return {yxml_lvl, ytyp, ykey, yvalue, yxml_at}


*--------------------------------------*
FUNCTION PPAD(s,x)
*--------------------------------------*
return left(s+space(x),x)

[tomtagaris]

LITLE HELP

online Service A.A.D.E. "Business Registry Basic Information Search"


The WSDL / ENDPOINT / XSD of the upgraded service are:

WSDL : https://www1.gsis.gr/wsaade/RgWsPublic2 ... blic2?WSDL
ENDPOINT: https://www1.gsis.gr/wsaade/RgWsPublic2/RgWsPublic2
XSD : https://www1.gsis.gr/wsaade/RgWsPublic2 ... lic2?xsd=1

This is a Soap JAX-WS 2.0 Web Service (SOAP version 1.2).

For a workstation to call the service, network access to www1.gsis.gr and port 443 is required.

If Java is used, Java 1.8 or later is required due to the use of the TLS1.2 communication protocol.

Included:
a) call examples (Request XML / Response XML) of the Web Service,
b) a SoapUI project to import into SoapUI. Recommended to use SoapUI Version 5.4.0 or later due to Java 1.8 ( https://www.soapui.org/downloads/latest-release.html ).

[mjaviergutierrez]

Hola Colegas !
Probando el programa "XmlToPrg", no logro leer el archivo .xml que adjunto.
No sé, ya revise todo , lo unico que me hace ruido es que el archivo comienza con esta linea :
<?xml version="1.0" encoding="ISO-8859-1"?>
será por esa codificacion que no se puede leer ?

Saludos.

[edk]

You're right in your guess.
If the XML file is encoded in a code page other than the current code page of the HMG application, it is necessary to convert the XML character string to a code page compatible with the current one.
This version of the program gets the encoding from the declaration contained in XML, compares the code pages and, if necessary, converts the XML.
Important, if you want to use this solution in your sources, do not forget to include all code pages in prg:

Code: Select all

#include "hbextcdp.ch"

[mjaviergutierrez]

hola Colegas ! Muchas gracas "edk" , funciono Ok !
Gracias, saludos.