PC SOFT

FORUMS PROFESSIONNELS
WINDEVWEBDEV et WINDEV Mobile

Accueil → WINDEV 25 → WX - Como converter: Json para xml e xml para hfsql e hfsql em um script sql ?
WX - Como converter: Json para xml e xml para hfsql e hfsql em um script sql ?
Débuté par BOLLER, 11 fév. 2018 00:15 - Aucune réponse
Membre enregistré
3 651 messages
Popularité : +175 (223 votes)
Posté le 11 février 2018 - 00:15
Como converter: Json para xml e xml para hfsql e hfsql em um script sql ?













PROCEDURES CRIADAS

// Summary: <specify the procedure action>
// Syntax:
//[ <Result> = ] AddListaArrayUnico (<ArrayResultado> is array)
//
// Parameters:
// ArrayResultado (array): <specify the role of ArrayResultado>
// Return Value:
// array: // None
//
// For instance:
// Indicate an example.
//
Procedure AddListaArrayUnico(ArrayResultado is array of strings)

i, x, NaoAchou is int = 0

//ArrayResultadoNovo is array of strings

nTotal is int = ArrayCount(ArrayResultado)

LOOP (nTotal)

x += 1

NaoAchou = ArraySeek(ArrayResultadoNovo,tccIgnoreCase+asLinearFirst,ArrayResultado[x])

IF NaoAchou = -1

Add(ArrayResultadoNovo,ArrayResultado[x])

ELSE

i+=1

Add(ArrayResultadoNovo,ArrayResultado[x]+"_"+i)

END

END

RESULT (ArrayResultadoNovo)



Procedure ArrayDeleteDuplicateBoller(ArrayResultado is array of strings)

i, x, NaoAchou is int = 0

Array_ResultadoNovo is array of strings

nTotal is int = ArrayCount(ArrayResultado)

LOOP (nTotal)

x += 1

NaoAchou = ArraySeek(Array_ResultadoNovo,asLinearFirst,ArrayResultado[x])

IF NaoAchou = -1

Add(Array_ResultadoNovo,ArrayResultado[x])

ELSE

i+=1

Add(Array_ResultadoNovo,ArrayResultado[x]+"_"+i)

END

END

RESULT (Array_ResultadoNovo)



Procedure ArrayDeleteDuplicateBollerGlobal(ArrayResultado is array of strings)

i, x, NaoAchou is int = 0

nTotal is int = ArrayCount(ArrayResultado)

LOOP (nTotal)

x += 1

NaoAchou = ArraySeek(ArrayResultadoNovo,tccIgnoreCase+asLinearFirst,ArrayResultado[x])

IF NaoAchou = -1

Add(ArrayResultadoNovo,ArrayResultado[x])

ELSE

i+=1

Add(ArrayResultadoNovo,ArrayResultado[x]+"_"+i)

END

END

RESULT (ArrayResultadoNovo)



// Summary: <specify the procedure action>
// Syntax:
//[ <Result> = ] BuscaTamanhoValue (<XmlTxt>, <Tag>)
//
// Parameters:
// XmlTxt: <specify the role of XmlTxt>
// Tag: <specify the role of Tag>
// Return Value:
// int: // None
//
// For instance:
// Indicate an example.
//
Procedure BuscaTamanhoValue(XmlTxt, Tag)

nTamanho, nPosIni, nPosfim is int = 0

ValueXml is string = ""

IF XmlTxt <> "" AND Tag <> "" THEN

nPosIni = PositionOccurrence(XmlTxt,Tag, firstRank, FromBeginning) + Length(Tag) + 2 //<> = 2

nPosfim = PositionOccurrence(XmlTxt,Tag, nextRank, FromBeginning) - 1 //</

ValueXml = Middle(XmlTxt,nPosIni,nPosfim-nPosIni)

nTamanho = Length(ValueXml)

END

RESULT(nTamanho)



// Summary: <specify the procedure action>
// Syntax:
//[ <Result> = ] BuscaTipoValue (<XmlTxt>, <Tag>)
//
// Parameters:
// XmlTxt: <specify the role of XmlTxt>
// Tag: <specify the role of Tag>
// Return Value:
// ANSI string: // None
//
// For instance:
// Indicate an example.
//
Procedure BuscaTipoValue(XmlTxt, Tag)

nPosIni, nPosfim is int = 0

ValueXml, sTipo is string = ""

IF XmlTxt <> "" AND Tag <> ""

nPosIni = PositionOccurrence(XmlTxt,Tag, firstRank, FromBeginning) + Length(Tag) + 1 //< = 1

nPosfim = PositionOccurrence(XmlTxt,Tag, nextRank, FromBeginning) -2 //</

IF nPosfim > nPosIni AND (nPosfim-nPosIni) > 0

ValueXml = Middle(XmlTxt,nPosIni,nPosfim-nPosIni)

//Se for numero

IF IsNumeric(ValueXml) = True AND PositionOccurrence(ValueXml,".",firstRank,FromBeginning) > 0 THEN

sTipo = "hItemCurrency"

ELSE IF Length(ValueXml) = 8 AND Middle(ValueXml,1,4) > 1800 AND Middle(ValueXml,6,2) <= 31 AND IsNumeric(ValueXml) = True

sTipo = "hItemDate8"

ELSE IF Length(ValueXml) = 15 AND Middle(ValueXml,1,4) > 1800 AND Middle(ValueXml,6,2) <= 31 AND IsNumeric(ValueXml) = True

sTipo = "hItemDateTime"

ELSE IF IsNumeric(ValueXml) = True AND PositionOccurrence(ValueXml,":",firstRank,FromBeginning) = 0 AND PositionOccurrence(ValueXml,"/",firstRank,FromBeginning) = 0 AND PositionOccurrence(ValueXml,"-",firstRank,FromBeginning) = 0

sTipo = "hItemInteger8"

ELSE IF Length(ValueXml) = 10 AND Middle(ValueXml,5,1) = "-" AND Middle(ValueXml,8,1) = "-" AND IsNumeric(Middle(ValueXml,1,4)) = True

//2018-01-01
sTipo = "hItemDate8"

ELSE IF Length(ValueXml) = 10 AND Middle(ValueXml,5,1) = "/" AND Middle(ValueXml,8,1) = "/" AND IsNumeric(Middle(ValueXml,1,4)) = True

//2018/01/01
sTipo = "hItemDate8"

ELSE IF Length(ValueXml) = 10 AND Middle(ValueXml,3,1) = "-" AND Middle(ValueXml,6,1) = "-" AND IsNumeric(Middle(ValueXml,7,4)) = True

//01-01-2018
sTipo = "hItemDate8"

ELSE IF Length(ValueXml) = 10 AND Middle(ValueXml,3,1) = "/" AND Middle(ValueXml,6,1) = "/" AND IsNumeric(Middle(ValueXml,7,4)) = True

//01/01/2018
sTipo = "hItemDate8"

ELSE IF (Length(ValueXml) = 15 AND Middle(ValueXml,1,4) > 2000 AND IsNumeric(ValueXml) = True) AND PositionOccurrence(ValueXml,":",firstRank,FromBeginning) > 0

sTipo = "hItemDateTime"

END

//Se nao for numero

ELSE IF IsNumeric(ValueXml) = False THEN

IF Upper(ValueXml) = "TRUE" OR Upper(ValueXml) = "FALSE" THEN

sTipo = "hItemBoolean"

ELSE IF Length(ValueXml) <= 256

sTipo = "hItemText"

ELSE IF Length(ValueXml) > 256

sTipo = "hItemTextMemo"

END

END

END

// Se nao for identificado é texto

IF sTipo = "" THEN
sTipo = "hItemText"
END

RESULT(sTipo)



// Summary: <specify the procedure action>
// Syntax:
//[ <Result> = ] Capitalize (<Texto>)
//
// Parameters:
// Texto: <specify the role of Texto>
// Return Value:
// Unspecified Type: // None
//
// For instance:
// Indicate an example.
//
Procedure Capitalize( Texto)

ChangeCharset(charsetOccidental) // SEM ACENTO

IF Texto <> Null AND Texto <> "" THEN

Texto = Replace(Texto,"_", " ")

Texto = NoAccent(Texto)

Texto = Lower(Texto)

Texto = Upper(Middle(Texto,1,1)) + Middle(Texto,2,Length(Texto))

nEspaco01 is int = PositionOccurrence(Texto," ",firstRank,FromBeginning) + 1
IF nEspaco01 > 1 THEN
Texto = Middle(Texto,1,nEspaco01-1) + Upper(Middle(Texto,nEspaco01,1)) + Middle(Texto,nEspaco01+1,Length(Texto))
END


TOT is int = 0
POS1, POS2, POS3 is int = 0
TOT = Length(Texto)
LOOP (TOT)
POS1 +=1
POS2 = POS1 + 1
POS3 = POS2 + 1
IF Middle(Texto,POS1,1) = " " AND Middle(Texto,POS2,1) <> " "
Texto = Middle(Texto,1,POS1) + Upper(Middle(Texto,POS2,1)) + Middle(Texto,POS3,TOT)
END
END


Texto = Replace(Texto," Da ", " da ")

Texto = Replace(Texto," Das ", " das ")

Texto = Replace(Texto," De ", " de ")

Texto = Replace(Texto," Do ", " do ")

Texto = Replace(Texto," Dos ", " dos ")

END

RESULT(Texto)



Procedure IdentificarTagsNoXml(XmlConteudo)

x, Inicial, Final, Tamanho is int = 0

Tag, Anterior is string = ""

IF XmlConteudo <> "" THEN

XmlConteudo = NoAccent(XmlConteudo)
XmlConteudo = Replace(XmlConteudo,CR,"")
XmlConteudo = Replace(XmlConteudo,Charact(13),"")
XmlConteudo = Replace(XmlConteudo,Charact(10),"")

Total is int = Length(XmlConteudo)

LOOP (Total)

x += 1

IF XmlConteudo[[x]] = "<"
Inicial = x+1
ELSE IF XmlConteudo[[x]] = ">"
Final = x
IF Final <= Inicial THEN
Final = 0
END
END

IF Inicial > 0 AND Final > 0 AND Final > Inicial

Tamanho = Final - Inicial

Tag = Middle(XmlConteudo,Inicial,Tamanho)

//IGNORAR AS TAGS DE FECHAMENTO E ID
IF Middle(Tag,1,1) = "/" OR PositionOccurrence(Upper(Tag),"ID=",firstRank,FromBeginning) > 0
Tag = ""
END

//VALIDA TAGS DO NÓ
IF Tag <> "" AND Tamanho > 0 AND Anterior <> Tag AND Upper(Tag) <> "XML" AND Upper(Tag) <> "RETORNO" AND Upper(Tag) <> "TOTAL"

Anterior = Tag

//DEBUG
//add(arrXml_Tags,Tag +" / "+ Inicial +" / "+ Final +" / "+ Tamanho )
//INFO(TAG)

Add(arrXml_Tags,Tag) //VAR GLOBAL: arrXml_Tags

END

END

END

END



//TARGET CODE
ArrayDeleteDuplicate(arrXml_Tags,tccIgnoreSpace)
//TARGET CODE



// Summary: <specify the procedure action>
// Syntax:
//[ <Result> = ] JsonToXml (<JsonCode>)
//
// Parameters:
// JsonCode: <specify the role of JsonCode>
// Return Value:
// ANSI string: // None
//
// For instance:
// Indicate an example.
//
Procedure JsonToXml(JsonCode)

ArrayDeleteAll(arrXml)

nNaoAchou is int = 0

PersonXml is Variant

PersonXml = JSONToVariant(JsonCode)

sXmlResultado is string = ""

FOR EACH A1 OF PersonXml..Member

Trace(A1..Name + " value " + A1..Value)

sXmlResultado += XmlTagUnica(A1..Name,A1..Value)

FOR EACH B1 OF A1..Member

Trace(B1..Name + " value " + B1..Value)

sXmlResultado += XmlTagUnica(B1..Name,B1..Value)

FOR EACH C1 OF B1..Member

Trace(C1..Name + " value " + C1..Value)

sXmlResultado += XmlTagUnica(C1..Name,C1..Value)

FOR EACH D1 OF C1..Member

Trace(D1..Name + " value " + D1..Value)

sXmlResultado += XmlTagUnica(D1..Name,D1..Value)

FOR EACH E1 OF D1..Member

Trace(E1..Name + " value " + E1..Value)

sXmlResultado += XmlTagUnica(E1..Name,E1..Value)

FOR EACH F1 OF E1..Member

Trace(F1..Name + " value " + F1..Value)

sXmlResultado += XmlTagUnica(F1..Name,F1..Value)

FOR EACH G1 OF F1..Member

Trace(G1..Name + " value " + G1..Value)

sXmlResultado += XmlTagUnica(G1..Name,G1..Value)

FOR EACH H1 OF G1..Member

Trace(H1..Name + " value " + H1..Value)

sXmlResultado += XmlTagUnica(H1..Name,H1..Value)

FOR EACH I1 OF H1..Member

Trace(I1..Name + " value " + I1..Value)

sXmlResultado += XmlTagUnica(I1..Name,I1..Value)

FOR EACH J1 OF I1..Member

Trace(J1..Name + " value " + J1..Value)

sXmlResultado += XmlTagUnica(J1..Name,J1..Value)

FOR EACH K1 OF J1..Member

Trace(K1..Name + " value " + K1..Value)

sXmlResultado += XmlTagUnica(K1..Name,K1..Value)

FOR EACH L1 OF K1..Member

Trace(L1..Name + " value " + L1..Value)

sXmlResultado += XmlTagUnica(L1..Name,L1..Value)

FOR EACH M1 OF L1..Member

Trace(M1..Name + " value " + M1..Value)

sXmlResultado += XmlTagUnica(M1..Name,M1..Value)

FOR EACH N1 OF M1..Member

Trace(N1..Name + " value " + N1..Value)

sXmlResultado += XmlTagUnica(N1..Name,N1..Value)

FOR EACH O1 OF N1..Member

Trace(O1..Name + " value " + O1..Value)

sXmlResultado += XmlTagUnica(O1..Name,O1..Value)

FOR EACH P1 OF O1..Member

Trace(P1..Name + " value " + P1..Value)

sXmlResultado += XmlTagUnica(P1..Name,P1..Value)

FOR EACH Q1 OF P1..Member

Trace(Q1..Name + " value " + Q1..Value)

sXmlResultado += XmlTagUnica(Q1..Name,Q1..Value)

FOR EACH R1 OF Q1..Member

Trace(R1..Name + " value " + R1..Value)

sXmlResultado += XmlTagUnica(R1..Name,R1..Value)

FOR EACH S1 OF R1..Member

Trace(S1..Name + " value " + S1..Value)

sXmlResultado += XmlTagUnica(S1..Name,S1..Value)

FOR EACH T1 OF S1..Member

Trace(T1..Name + " value " + T1..Value)

sXmlResultado += XmlTagUnica(T1..Name,T1..Value)

FOR EACH U1 OF T1..Member

Trace(U1..Name + " value " + U1..Value)

sXmlResultado += XmlTagUnica(U1..Name,U1..Value)

FOR EACH V1 OF U1..Member

Trace(V1..Name + " value " + V1..Value)

sXmlResultado += XmlTagUnica(V1..Name,V1..Value)

FOR EACH W1 OF V1..Member

Trace(W1..Name + " value " + W1..Value)

sXmlResultado += XmlTagUnica(W1..Name,W1..Value)

FOR EACH X1 OF W1..Member

Trace(X1..Name + " value " + X1..Value)

sXmlResultado += XmlTagUnica(X1..Name,X1..Value)

FOR EACH Y1 OF X1..Member

Trace(Y1..Name + " value " + Y1..Value)

sXmlResultado += XmlTagUnica(Y1..Name,Y1..Value)

FOR EACH Z1 OF Y1..Member

Trace(Z1..Name + " value " + Z1..Value)

sXmlResultado += XmlTagUnica(Z1..Name,Z1..Value)

END

END

END

END

END

END

END

END

END

END

END

END

END

END

END

END

END

END

END

END

END

END

END

END

END

END

RESULT(sXmlResultado)



Procedure JsonToXmlComNulos(JsonCode)

ArrayDeleteAll(arrXml)

nNaoAchou is int = 0

PersonXml is Variant

PersonXml = JSONToVariant(JsonCode)

sXmlResultado is string = ""

FOR EACH A1 OF PersonXml..Member

Trace(A1..Name + " value " + A1..Value)

sXmlResultado += XmlTagUnicaComNulos(A1..Name,A1..Value)

FOR EACH B1 OF A1..Member

Trace(B1..Name + " value " + B1..Value)

sXmlResultado += XmlTagUnicaComNulos(B1..Name,B1..Value)

FOR EACH C1 OF B1..Member

Trace(C1..Name + " value " + C1..Value)

sXmlResultado += XmlTagUnicaComNulos(C1..Name,C1..Value)

FOR EACH D1 OF C1..Member

Trace(D1..Name + " value " + D1..Value)

sXmlResultado += XmlTagUnicaComNulos(D1..Name,D1..Value)

FOR EACH E1 OF D1..Member

Trace(E1..Name + " value " + E1..Value)

sXmlResultado += XmlTagUnicaComNulos(E1..Name,E1..Value)

FOR EACH F1 OF E1..Member

Trace(F1..Name + " value " + F1..Value)

sXmlResultado += XmlTagUnicaComNulos(F1..Name,F1..Value)

FOR EACH G1 OF F1..Member

Trace(G1..Name + " value " + G1..Value)

sXmlResultado += XmlTagUnicaComNulos(G1..Name,G1..Value)

FOR EACH H1 OF G1..Member

Trace(H1..Name + " value " + H1..Value)

sXmlResultado += XmlTagUnicaComNulos(H1..Name,H1..Value)

FOR EACH I1 OF H1..Member

Trace(I1..Name + " value " + I1..Value)

sXmlResultado += XmlTagUnicaComNulos(I1..Name,I1..Value)

FOR EACH J1 OF I1..Member

Trace(J1..Name + " value " + J1..Value)

sXmlResultado += XmlTagUnicaComNulos(J1..Name,J1..Value)

FOR EACH K1 OF J1..Member

Trace(K1..Name + " value " + K1..Value)

sXmlResultado += XmlTagUnicaComNulos(K1..Name,K1..Value)

FOR EACH L1 OF K1..Member

Trace(L1..Name + " value " + L1..Value)

sXmlResultado += XmlTagUnicaComNulos(L1..Name,L1..Value)

FOR EACH M1 OF L1..Member

Trace(M1..Name + " value " + M1..Value)

sXmlResultado += XmlTagUnicaComNulos(M1..Name,M1..Value)

FOR EACH N1 OF M1..Member

Trace(N1..Name + " value " + N1..Value)

sXmlResultado += XmlTagUnicaComNulos(N1..Name,N1..Value)

FOR EACH O1 OF N1..Member

Trace(O1..Name + " value " + O1..Value)

sXmlResultado += XmlTagUnicaComNulos(O1..Name,O1..Value)

FOR EACH P1 OF O1..Member

Trace(P1..Name + " value " + P1..Value)

sXmlResultado += XmlTagUnicaComNulos(P1..Name,P1..Value)

FOR EACH Q1 OF P1..Member

Trace(Q1..Name + " value " + Q1..Value)

sXmlResultado += XmlTagUnicaComNulos(Q1..Name,Q1..Value)

FOR EACH R1 OF Q1..Member

Trace(R1..Name + " value " + R1..Value)

sXmlResultado += XmlTagUnicaComNulos(R1..Name,R1..Value)

FOR EACH S1 OF R1..Member

Trace(S1..Name + " value " + S1..Value)

sXmlResultado += XmlTagUnicaComNulos(S1..Name,S1..Value)

FOR EACH T1 OF S1..Member

Trace(T1..Name + " value " + T1..Value)

sXmlResultado += XmlTagUnicaComNulos(T1..Name,T1..Value)

FOR EACH U1 OF T1..Member

Trace(U1..Name + " value " + U1..Value)

sXmlResultado += XmlTagUnicaComNulos(U1..Name,U1..Value)

FOR EACH V1 OF U1..Member

Trace(V1..Name + " value " + V1..Value)

sXmlResultado += XmlTagUnicaComNulos(V1..Name,V1..Value)

FOR EACH W1 OF V1..Member

Trace(W1..Name + " value " + W1..Value)

sXmlResultado += XmlTagUnicaComNulos(W1..Name,W1..Value)

FOR EACH X1 OF W1..Member

Trace(X1..Name + " value " + X1..Value)

sXmlResultado += XmlTagUnicaComNulos(X1..Name,X1..Value)

FOR EACH Y1 OF X1..Member

Trace(Y1..Name + " value " + Y1..Value)

sXmlResultado += XmlTagUnicaComNulos(Y1..Name,Y1..Value)

FOR EACH Z1 OF Y1..Member

Trace(Z1..Name + " value " + Z1..Value)

sXmlResultado += XmlTagUnicaComNulos(Z1..Name,Z1..Value)

END

END

END

END

END

END

END

END

END

END

END

END

END

END

END

END

END

END

END

END

END

END

END

END

END

END

RESULT(sXmlResultado)



Procedure LocalizarTagsEmXml(XML_Retorno is string)

//Variaveis
nXposicaoinicial is int = 0
nXposicaofinal is int = 0

X is int = 0

//Exemplo
//<Xml>
//<Retorno>
//<NoXml ID="3"> // <------------------------ motivo do erro
//<login_id>3</login_id>
//<login_email>teste@teste.com</login_email>
//<login_nome>Usuario teste</login_nome>
//<login_senha>123</login_senha>
//<login_status>1</login_status>
//<login_admin>0</login_admin>
//</NoXml> // <------------------------ motivo do erro
//<Total>1</Total>
//</Retorno>
//</Xml>


//iOS - Apple (iPhone / iPad / iPod)
IF IniOSMode() = True THEN

T, N is int = 0

RegistroXml is string

NoXml is string

i is int = 1

NoXml = XMLExtractString(XML_Retorno,"NoXml",i)

//FUNCAO IDENTIFICA TAG
IdentificarTagsNoXml(XML_Retorno)

nQtde_Registros is int = XMLExtractString(XML_Retorno,"Total") //5

LOOP (nQtde_Registros)

T = 0

N += 1

RegistroXml = PegaNoXml(XML_Retorno,N)

NoXml = XMLExtractString(RegistroXml,"NoXml",i)

FOR EACH stag OF arrXml_Tags //VAR GLOBAL

temp is string = XMLExtractString(NoXml,stag)

Add(arrXml_TagResult, temp )

END

END



//Android
ELSE IF InAndroidMode() = True

T, N is int = 0

IdentificarTagsNoXml(XML_Retorno) //FUNCAO IDENTIFICA TAG

nQtde_tags is int = ArrayCount(arrXml_Tags)

TagRegistro, RegistroXml is string

TagValor is string

nQtde_Registros is int = XMLExtractString(XML_Retorno,"Total") //5

LOOP (nQtde_Registros)

T = 0

N += 1

RegistroXml = PegaNoXml(XML_Retorno,N)

LOOP (nQtde_tags)

T += 1

TagRegistro = arrXml_Tags[T]

TagValor = XMLExtractString(RegistroXml,TagRegistro)

IF TagValor <> ""

Add(arrXml_TagResult,TagValor)

END

END

END

END

RESULT arrXml_TagResult



Procedure PegaNoXml(RetornoXml, NoXmlId) //outra procedure para facilitar, que nem dizia Jac, vamos por partes...

Inicio, Final, Tamanho is int = 0

NoXml is string = "<Xml><Retorno>"

IF RetornoXml <> "" AND NoXmlId > 0 THEN

Inicio = PositionOccurrence(RetornoXml,"<NoXml ID="+Charact(34)+NoXmlId+Charact(34)+">",firstRank,FromBeginning)

IF NoXmlId = 1
Final = PositionOccurrence(RetornoXml,"</NoXml>",firstRank,FromBeginning)
ELSE
Final = PositionOccurrence(RetornoXml,"</NoXml>",nextRank,FromBeginning)
END

Tamanho = Final - Inicio

NoXml += Middle(RetornoXml,Inicio,Tamanho)

END

NoXml += "</NoXml></Retorno></Xml>"

NoXml = Replace(NoXml,CR,"")
NoXml = Replace(NoXml,Charact(13),"")
NoXml = Replace(NoXml,Charact(10),"")

RESULT NoXml



Procedure PegaNoXmlGlobal(RetornoXml, NoXmlId) //outra procedure para facilitar, que nem dizia Jac, vamos por partes...

Inicio, Final, Tamanho is int = 0

NoXml is string = "<Xml><Retorno>"

IF RetornoXml <> "" AND NoXmlId > 0 THEN

Inicio = PositionOccurrence(RetornoXml,"<NoXml ID="+Charact(34)+NoXmlId+Charact(34)+">",firstRank,FromBeginning)

IF NoXmlId = 1
Final = PositionOccurrence(RetornoXml,"</NoXml>",firstRank,FromBeginning)
ELSE
Final = PositionOccurrence(RetornoXml,"</NoXml>",nextRank,FromBeginning)
END

Tamanho = Final - Inicio

NoXml += Middle(RetornoXml,Inicio,Tamanho)

END

NoXml += "</NoXml></Retorno></Xml>"

NoXml = Replace(NoXml,CR,"")
NoXml = Replace(NoXml,Charact(13),"")
NoXml = Replace(NoXml,Charact(10),"")

RESULT NoXml



// Summary: <specify the procedure action>
// Syntax:
//[ <Result> = ] XmlTagUnica (<Tag>, <Valor>)
//
// Parameters:
// Tag: <specify the role of Tag>
// Valor: <specify the role of Valor>
// Return Value:
// ANSI string: // None
//
// For instance:
// Indicate an example.
//
// Nulo (boolean): <specify the role of Nulo>
Procedure XmlTagUnica(Tag, Valor)

sXmlResultado is string = ""

IF ( Valor <> Null AND Length(Valor) > 0 )

NaoAchou is int = ArraySeek(arrXml,tccIgnoreCase+asLinearFirst,Tag)

Add(arrXml,Tag)

IF NaoAchou = -1

sXmlResultado += "<"+ Tag +">"+ Valor +"</"+ Tag +">"+CRLF

ELSE

i, x is int = 0

LOOP(ArrayCount(arrXml))

x += 1

IF arrXml[x] = Tag THEN

i+= 1

END

END

sXmlResultado += "<"+ Tag +"_"+ i +">"+ Valor +"</"+ Tag +"_"+ i +">"+CRLF

END

END

RESULT(sXmlResultado)



// Summary: <specify the procedure action>
// Syntax:
//[ <Result> = ] XmlTagUnicaComNulos (<Tag>, <Valor>)
//
// Parameters:
// Tag: <specify the role of Tag>
// Valor: <specify the role of Valor>
// Return Value:
// ANSI string: // None
//
// For instance:
// Indicate an example.
//
Procedure XmlTagUnicaComNulos(Tag, Valor)

sXmlResultado is string = ""


NaoAchou is int = ArraySeek(arrXml,tccIgnoreCase+asLinearFirst,Tag)

Add(arrXml,Tag)

IF NaoAchou = -1

sXmlResultado += "<"+ Tag +">"+ Valor +"</"+ Tag +">"+CRLF

ELSE

i, x is int = 0

LOOP(ArrayCount(arrXml))

x += 1

IF arrXml[x] = Tag THEN

i+= 1

END

END

sXmlResultado += "<"+ Tag +"_"+ i +">"+ Valor +"</"+ Tag +"_"+ i +">"+CRLF

END


RESULT(sXmlResultado)



// Summary: <specify the procedure action>
// Syntax:
//[ <Result> = ] ScriptCreateTable (<NameTable>, <XmlCode>, <UpLowCap>)
//
// Parameters:
// NameTable: <specify the role of NameTable>
// XmlCode: <specify the role of XmlCode>
// UpLowCap: <specify the role of UpLowCap>
// Return Value:
// ANSI string: // None
//
// For instance:
// Indicate an example.
//
// HfsqlResult: <specify the role of HfsqlResult>
Procedure ScriptCreateTable(NameTable, XmlCode, UpLowCap)

HfsqlResult is string = ""
sXmlCodeNovo is string = XmlCode

IF NameTable <> "" AND IsNumeric(NameTable) = False THEN

ArrayDeleteAll(GlobalProceduresXml.arrXml_Tags)

ArrayDeleteAll(GlobalProceduresXml.arrXml_TagResult)

ArrayDeleteAll(GlobalProceduresXml.ArrayResultadoNovo)

HfsqlResult = [
//Definicao do Arquivo
AFile is File Description
AnItem is Item Description
@Table@ is Data Source = "@Table@"
AFile..Name = "@Table@"
AFile..Type = hFileNormal
AFile..FicCryptMethod = hCryptStandard

//Campos
@Campos@

//Criação do @Table@.fic HFSQL
HDescribeFile(AFile)
HCreation(@Table@)
]

HfsqlResult = Replace(HfsqlResult,"@Table@",NameTable,IgnoreCase)

sCampos, sBlocoNovo is string = ""

GlobalProceduresXml.IdentificarTagsNoXml(sXmlCodeNovo)

GlobalProceduresXml.AddListaArrayUnico(GlobalProceduresXml.arrXml_Tags)

sCampotag is string

nTotalTags is int = ArrayCount(GlobalProceduresXml.ArrayResultadoNovo)

sCampos += [
// Describe the "@Campo@" item
AnItem..Name = "@Campo@"
AnItem..Type = @TypeField@
AnItem..Size = @Size@
HDescribeItem(AFile, AnItem)
]

i, nTamanho is int = 0

sCamposNovos, sTipo is string

ArrayDeleteDuplicate(GlobalProceduresXml.ArrayResultadoNovo)

LOOP(nTotalTags)

i += 1

sCampotag = GlobalProceduresXml.ArrayResultadoNovo[i]

nTamanho = BuscaTamanhoValue(XmlCode,sCampotag)

sTipo = BuscaTipoValue(XmlCode,sCampotag)

IF UpLowCap = 1
sCamposNovos = Replace(sCampos,"@Campo@",Upper(sCampotag),IgnoreCase)
ELSE IF UpLowCap = 2
sCamposNovos = Replace(sCampos,"@Campo@",Lower(sCampotag),IgnoreCase)
ELSE IF UpLowCap = 3
sCamposNovos = Replace(sCampos,"@Campo@",Capitalize(sCampotag),IgnoreCase)
END

sCamposNovos = Replace(sCamposNovos,"@TypeField@",sTipo,IgnoreCase)

IF sTipo = "hItemText"
sCamposNovos = Replace(sCamposNovos,"@Size@",nTamanho,IgnoreCase)
ELSE
sCamposNovos = Replace(sCamposNovos,"AnItem..Size = @Size@","",IgnoreCase)
END

sBlocoNovo += sCamposNovos + CRLF + CRLF

END

HfsqlResult = Replace(HfsqlResult,"@Campos@",sBlocoNovo,IgnoreCase)

ELSE IF NameTable = ""

Info("Informe um nome para a tabela")

ELSE

Info("Não pode ser numero")

END

RESULT(HfsqlResult)



//Global
arrXml is array of strings //Nome das Tags

arrXml_Tags is array of strings //Nome das Tags

arrXml_TagResult is array of strings //Conteudo das Tags Resultado

ArrayResultadoNovo is array of strings //Conteudo das Tags Resultado






BOTÕES
EDT_Xml = JsonToXml(EDT_Json)



EDT_Xml = JsonToXmlComNulos(EDT_Json)



EDT_Hfsql = ScriptCreateTable(EDT_Table,EDT_Xml, RADIO_UpLowCap..Value)



//Executar Formula Função em Run time

fDelete(EDT_Table+".fic",frToRecycleBin)
fDelete(EDT_Table+".ndx",frToRecycleBin)
fDelete(EDT_Table+".mmo",frToRecycleBin)

Formula is Procedure = Compile(EDT_Hfsql)

IF ErrorOccurred = False THEN
Formula()
ToastDisplay("Tabela criada com sucesso")
ELSE
Info(ErrorInfo())
END


--
Adriano José Boller
______________________________________________
Consultor e Representante Oficial da
PcSoft no Brasil
+55 (41) 99949 1800
adrianoboller@gmail.com
skype: adrianoboller
http://wxinformatica.com.br/