PARAMETERS menosuboru, poradie, povmenosuboru, kodedistred

#DEFINE CRLF CHR(13)+CHR(10)

chybatxt=""
IF VARTYPE(m.menosuboru)=="C" AND FILE(m.menosuboru)
	suborxml = FILETOSTR(m.menosuboru)

    DO CASE
    CASE ATC('encoding="utf-8"', suborxml) > 0
        kodovastranka = 11
    OTHERWISE
        kodovastranka = 0
    ENDCASE

	DO CASE 

    CASE ATC("K.A.P.", m.suborxml) > 0     && <IssuingSystem>Sklad6 - K.A.P. Software (http://www.kapsw.cz)
        DO spracuj_xmlkapsw WITH m.suborxml, poradie, povmenosuboru, m.menosuboru, m.kodedistred

    CASE ATC("ZAR G3", m.suborxml) > 0        && Cezar G3
        DO spracuj_xmlcezar WITH m.suborxml, poradie, povmenosuboru, m.menosuboru, m.kodedistred

    CASE ATC("ZAR G4 SQL", m.suborxml) > 0        && Cezar G4 SQL
        DO spracuj_xmlcezar WITH m.suborxml, poradie, povmenosuboru, m.menosuboru, m.kodedistred

    CASE hladajsekciu("VENDOR_REGNO",UPPER(m.suborxml))>0 AND hladajsekciu("CUSTOMER_BRANCH",UPPER(m.suborxml))>0
        DO spracuj_xmlunikom WITH m.suborxml, poradie, povmenosuboru, m.menosuboru, m.kodedistred

	CASE hladajsekciu("SUPPLIER",UPPER(m.suborxml))>0 AND hladajsekciu("PURCHASER",UPPER(m.suborxml))>0
		DO spracuj_xmlbidfood WITH m.suborxml, poradie, povmenosuboru, m.menosuboru, m.kodedistred

	CASE hladajsekciu("ORION_MESSAGE",UPPER(m.suborxml))>0
		DO spracuj_xmlorion WITH m.suborxml, poradie, povmenosuboru, m.menosuboru, m.kodedistred

	CASE hladajsekciu("OBERON",m.suborxml)>0
		DO spracuj_xmloberon WITH m.suborxml, poradie, povmenosuboru, m.menosuboru, m.kodedistred

	CASE hladajsekciu("Dodavatel",m.suborxml)>0 AND INLIST(vratsekciu("ICO",vratsekciu("Identifikacneudaje",vratsekciu("Dodavatel",vratsekciu("Doklad",m.suborxml,1,"X"),1,"X"),1,"X"),1,"C"),"36497967","53108256")
		DO spracuj_xmlpasbardejov WITH m.suborxml, poradie, povmenosuboru, m.menosuboru, m.kodedistred

	CASE hladajsekciu("deliverynotes",m.suborxml)>0
		DO spracuj_xmlellal WITH m.suborxml, poradie, povmenosuboru, m.menosuboru, m.kodedistred

	CASE hladajsekciu("Dokument",m.suborxml)>0 AND vratsekciu("Creator",vratsekciu("Subor",vratsekciu("Dokument",m.suborxml,1,"X"),1,"X"),1,"C")="BarIS" AND vratsekciu("ICO",vratsekciu("Firma",vratsekciu("Odosielatel",vratsekciu("Dokument",m.suborxml,1,"X"),1,"X"),1,"X"),1,"C")=""
		DO spracuj_xmllabas WITH m.suborxml, poradie, povmenosuboru, m.menosuboru, m.kodedistred

    CASE ATC("money S3", vratsekciu("IssuingSystem",m.suborxml,1,"C")) > 0
        DO spracuj_xmlmoney_S3    WITH m.suborxml, poradie, povmenosuboru, m.menosuboru, m.kodedistred

	CASE hladajsekciu("IssuingSystem",m.suborxml)>0 AND "pohoda"$LOWER(vratsekciu("IssuingSystem",m.suborxml,1,"C"))
		DO spracuj_xmlpohodu WITH m.suborxml, poradie, povmenosuboru, m.menosuboru, m.kodedistred

    CASE ATC('version="6.0.1"', m.suborxml) > 0 .and. ATC('xmlns="http://isdoc.cz/namespace/2013"', m.suborxml) > 0
        DO spracuj_xmlpohodu WITH m.suborxml, poradie, povmenosuboru, m.menosuboru, m.kodedistred

	CASE hladajsekciu("HeliosIQ_1",STRTRAN(m.suborxml,CHR(0),""))>0
		DO spracuj_xmlhelios WITH m.suborxml, poradie, povmenosuboru, m.menosuboru, m.kodedistred

	CASE hladajsekciu("S5Data",m.suborxml)>0
		DO spracuj_xmlmoney WITH m.suborxml, poradie, povmenosuboru, m.menosuboru, m.kodedistred

	CASE hladajsekciu("WAC_Object", m.suborxml)>0 OR "WAC_Object"$m.suborxml
		DO spracuj_xmlwac_object WITH m.suborxml, poradie, povmenosuboru, m.menosuboru, m.kodedistred

    CASE ATC("<ID>8590764000009</ID>",  suborxml) > 0
        DO spracuj_xmlmakro      WITH m.suborxml, poradie, povmenosuboru, m.menosuboru, m.kodedistred

	ENDCASE 
ENDIF 


*    *    *    *    *    *    *    *    *    *    *    *    *    *    *    *    *    *    *    *    *    *    *    *    *    *    *    *    
FUNCTION hladajsekciu
PARAMETERS menosekcie, xmltext
LOCAL koniecsekcie, pocetzaciatkov, pocetkoncov
IF LEFT(m.menosekcie,1) # "<"
	m.menosekcie="<"+m.menosekcie
ENDIF  
koniecsekcie="</"+SUBSTR(m.menosekcie,2)

pocetzaciatkov=OCCURS(m.menosekcie+">",m.xmltext)
pocetkoncov   =OCCURS(m.koniecsekcie+">",m.xmltext)
IF m.pocetzaciatkov>0 AND m.pocetkoncov=m.pocetzaciatkov
	RETURN m.pocetzaciatkov
ELSE
	pocetzaciatkov=OCCURS(m.menosekcie+" >",m.xmltext)
	IF m.pocetzaciatkov>0 AND m.pocetkoncov=m.pocetzaciatkov
		RETURN m.pocetzaciatkov
	ELSE 
        pocetzaciatkov=OCCURS(m.menosekcie  ,m.xmltext)
        pocetkoncov   =OCCURS(m.koniecsekcie,m.xmltext)
		IF m.pocetzaciatkov>0 AND m.pocetkoncov=m.pocetzaciatkov
			RETURN m.pocetzaciatkov
		ELSE 
			RETURN 0
		ENDIF 
	ENDIF 
ENDIF 
	

*    *    *    *    *    *    *    *    *    *    *    *    *    *    *    *    *    *    *    *    *    *    *    *    *    *    *    *    
FUNCTION vratsekciu
PARAMETERS menosekcie, xmltext, poradie, typvystupu, konverzia
IF EMPTY(m.poradie)
    poradie = 1
ENDIF 
LOCAL koniecsekcie, zaciatok, koniec, retazec
IF LEFT(m.menosekcie,1) # "<"
	menosekcie = "<" + m.menosekcie
ENDIF  
koniecsekcie="</"+SUBSTR(m.menosekcie,2)
*** Pozicia uvodneho znaku zaciatku sekcie ***
DO CASE 
	CASE ATC(m.menosekcie+">",m.xmltext,m.poradie)>0
        zaciatok = ATC(m.menosekcie+">",m.xmltext,m.poradie)
	CASE ATC(m.menosekcie+" >",m.xmltext,m.poradie)>0
        zaciatok = ATC(m.menosekcie+" >",m.xmltext,m.poradie)
	OTHERWISE 
        zaciatok = ATC(m.menosekcie,m.xmltext,m.poradie)
ENDCASE 
*** Pozicia prveho znaku po ukoncovacom znaku sekcie ***
zaciatok = m.zaciatok + ATC(">",SUBSTR(m.xmltext,m.zaciatok))

*** Pozicia prveho znaku konca sekcie ***
DO CASE 
	CASE ATC(m.koniecsekcie+">",m.xmltext,m.poradie)>0
        koniec=ATC(m.koniecsekcie+">",m.xmltext,m.poradie)
	CASE ATC(m.koniecsekcie+" >",m.xmltext,m.poradie)>0
        koniec=ATC(m.koniecsekcie+" >",m.xmltext,m.poradie)
	OTHERWISE 
        koniec=ATC(m.koniecsekcie,m.xmltext,m.poradie)
ENDCASE 
retazec=SUBSTR(m.xmltext,m.zaciatok,m.koniec-m.zaciatok)

DO CASE 
CASE EMPTY(m.typvystupu) OR m.typvystupu="X"		&&& Nic sa nemeni - predpokldam, ze vraciam XML
    *nic

CASE m.typvystupu="C"		                        &&& Vraciam premennu character - ak je v hlavicke xml UTF, urobim konverziu na 1250
		DO CASE 
		CASE EMPTY(m.konverzia)
            * nic
		CASE m.konverzia=11
	        retazec=STRCONV(m.retazec,11)
		ENDCASE 
		*** Ponahradzam nahradne XML znaky
    retazec=STRTRAN(m.retazec,"&lt;"  ,"<")
    retazec=STRTRAN(m.retazec,"&gt;"  ,">")
    retazec=STRTRAN(m.retazec,"&amp;" ,"&")
        retazec=STRTRAN(m.retazec,"&apos;","'")
        retazec=STRTRAN(m.retazec,"&quot;",'"')
		*** Odpracem sekciu CDATA
		IF LEFT(m.retazec,9)=="<![CDATA["
	        retazec=SUBSTR(m.retazec,10)
			IF RIGHT(m.retazec,3)="]]>"
		        retazec=LEFT(m.retazec,LENC(m.retazec)-3)
			ENDIF 
		ENDIF 

CASE m.typvystupu="N"	                        	&&& Vraciam cislo. Najprv prehodim bodku na znak ako je lokalne nastaveny, potom pustim VAL
    retazec = VAL(STRTRAN(m.retazec,".",SET("point")))

CASE m.typvystupu="D"                                  &&& Konverzia na datum
		TRY 
        retazec = DATE( VAL(SUBSTR(m.retazec,1,4)), VAL(SUBSTR(m.retazec,6,2)), VAL(SUBSTR(m.retazec,9,2)))    && 2019-05-21T00:00:00
		CATCH 
        retazec = DATE()
		ENDTRY 

CASE m.typvystupu="xxD - nahrazeno sekci vyse"	                          	&&& Konverzia na datum
		DO CASE 
			CASE AT("-",m.retazec,1)=5 AND AT("-",m.retazec,2)=8
		        retazec=RIGHT(m.retazec,2)+"."+SUBSTR(m.retazec,6,2)+"."+LEFT(m.retazec,4)
		ENDCASE  
		TRY 
	        retazec=CTOD(m.retazec)
		CATCH 
	        retazec=DATE()
		ENDTRY 
ENDCASE 

RETURN m.retazec



