romfast/foxbin2prg
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Changeset: 360 fdbozzo - 14/07/2014 18:19:38:

Browse Source
This commit is contained in:
fdbozzo
2014-07-14 18:20:20 +02:00
parent ed4a2311f0
commit f69cdd73c9
1 changed files with 186 additions and 2 deletions
Download Patch File Download Diff File Expand all files Collapse all files

188
foxbin2prg.prg
View File

@@ -268,6 +268,15 @@ LPARAMETERS tc_InputFile, tcType, tcTextName, tlGenText, tcDontShowErrors, tcDeb
#DEFINE C_LF CHR(10)
#DEFINE CR_LF C_CR + C_LF
#DEFINE C_MPROPHEADER REPLICATE( CHR(1), 517 )
*** DH 06/02/2014: added additional constants
#DEFINE C_RECORDS_I '<RECORDS>'
#DEFINE C_RECORDS_F '</RECORDS>'
#DEFINE C_RECORD_I '<RECORD>'
#DEFINE C_RECORD_F '</RECORD>'
#DEFINE C_RECNO_I '<RECNO>'
#DEFINE C_RECNO_F '</RECNO>'
*-- Fin / End
*-- From FOXPRO.H
@@ -7032,7 +7041,6 @@ DEFINE CLASS c_conversor_prg_a_dbf AS c_conversor_prg_a_bin
LOCAL toTable AS CL_DBF_TABLE OF 'FOXBIN2PRG.PRG'
LOCAL toFoxBin2Prg AS c_foxbin2prg OF 'FOXBIN2PRG.PRG'
#ENDIF
TRY
LOCAL I, lnCodError, loEx AS EXCEPTION ;
, loField AS CL_DBF_FIELD OF 'FOXBIN2PRG.PRG' ;
@@ -15280,6 +15288,8 @@ DEFINE CLASS CL_DBF_TABLE AS CL_CUS_BASE
*--
THIS.ADDOBJECT("_Fields", "CL_DBF_FIELDS")
THIS.ADDOBJECT("_Indexes", "CL_DBF_INDEXES")
*** DH 06/02/2014: added _Records
THIS.ADDOBJECT("_Records", "CL_DBF_RECORDS")
ENDPROC
@@ -15385,14 +15395,22 @@ DEFINE CLASS CL_DBF_TABLE AS CL_CUS_BASE
<<>> <FileType_Descrip><<tc_FileTypeDesc>></FileType_Descrip>
ENDTEXT
*** DH 06/02/2014: created variables
local laFields[1], lnFieldCount
*-- Fields
loFields = THIS._Fields
lcText = lcText + loFields.toText()
*** DH 06/02/2014: passed variables to toText
* lcText = lcText + loFields.toText()
lcText = lcText + loFields.toText(@laFields, @lnFieldCount)
*-- Indexes
loIndexes = THIS._Indexes
lcText = lcText + loIndexes.toText( '', '', tc_InputFile )
*** DH 06/02/2014: added _Records
lcText = lcText + This._Records.toText(@laFields, lnFieldCount)
TEXT TO lcText ADDITIVE TEXTMERGE NOSHOW FLAGS 1+2 PRETEXT 1+2
<<C_TABLE_F>>
<<>>
@@ -15959,6 +15977,172 @@ DEFINE CLASS CL_DBF_INDEX AS CL_CUS_BASE
ENDDEFINE
*** DH 06/02/2014: added classes CL_DBF_RECORDS and CL_DBF_RECORD
*******************************************************************************************************************
DEFINE CLASS CL_DBF_RECORDS AS CL_COL_BASE
#IF .F.
LOCAL THIS AS CL_DBF_RECORDS OF 'FOXBIN2PRG.PRG'
#ENDIF
*******************************************************************************************************************
PROCEDURE analizarBloque
*---------------------------------------------------------------------------------------------------
* PAR<41>METROS: (!=Obligatorio | ?=Opcional) (@=Pasar por referencia | v=Pasar por valor) (IN/OUT)
* tcLine (@! IN/OUT) Contenido de la l<>nea en an<61>lisis
* taCodeLines (@! IN ) Array de l<>neas del programa analizado
* I (@! IN/OUT) N<>mero de l<>nea en an<61>lisis
* tnCodeLines (@! IN ) Cantidad de l<>neas del programa analizado
*---------------------------------------------------------------------------------------------------
LPARAMETERS tcLine, taCodeLines, I, tnCodeLines
*** DH 06/02/2014: not implemented
ENDPROC
PROCEDURE toText
*---------------------------------------------------------------------------------------------------
* PAR<41>METROS: (!=Obligatorio | ?=Opcional) (@=Pasar por referencia | v=Pasar por valor) (IN/OUT)
* taFields (@? OUT) Array de informaci<63>n de campos
* tnField_Count (@? OUT) Cantidad de campos
*---------------------------------------------------------------------------------------------------
LPARAMETERS taFields, tnField_Count
EXTERNAL ARRAY taFields
TRY
LOCAL lcText, loEx AS EXCEPTION ;
, loRecord AS CL_DBF_RECORD OF 'FOXBIN2PRG.PRG'
lcText = ''
TEXT TO lcText ADDITIVE TEXTMERGE NOSHOW FLAGS 1+2 PRETEXT 1+2
<<>>
<<>> <<C_RECORDS_I>>
ENDTEXT
loRecord = CREATEOBJECT('CL_DBF_RECORD')
scan
lcText = lcText + loRecord.toText(@taFields, tnField_Count)
endscan
TEXT TO lcText ADDITIVE TEXTMERGE NOSHOW FLAGS 1+2 PRETEXT 1+2
<<>> <<C_RECORDS_F>>
<<>>
ENDTEXT
CATCH TO loEx
IF THIS.l_Debug AND _VFP.STARTMODE = 0
SET STEP ON
ENDIF
THROW
FINALLY
STORE NULL TO loRecord
RELEASE loRecord
ENDTRY
RETURN lcText
ENDPROC
ENDDEFINE
*******************************************************************************************************************
DEFINE CLASS CL_DBF_RECORD AS CL_CUS_BASE
#IF .F.
LOCAL THIS AS CL_DBF_RECORD OF 'FOXBIN2PRG.PRG'
#ENDIF
*******************************************************************************************************************
PROCEDURE analizarBloque
*---------------------------------------------------------------------------------------------------
* PAR<41>METROS: (!=Obligatorio | ?=Opcional) (@=Pasar por referencia | v=Pasar por valor) (IN/OUT)
* tcLine (@! IN/OUT) Contenido de la l<>nea en an<61>lisis
* taCodeLines (@! IN ) Array de l<>neas del programa analizado
* I (@! IN/OUT) N<>mero de l<>nea en an<61>lisis
* tnCodeLines (@! IN ) Cantidad de l<>neas del programa analizado
*---------------------------------------------------------------------------------------------------
LPARAMETERS tcLine, taCodeLines, I, tnCodeLines
*** DH 06/02/2014: not implemented
ENDPROC
PROCEDURE toText
*---------------------------------------------------------------------------------------------------
* PAR<41>METROS: (!=Obligatorio | ?=Opcional) (@=Pasar por referencia | v=Pasar por valor) (IN/OUT)
* taFields (@? OUT) Array de informaci<63>n de campos
* tnField_Count (@? OUT) Cantidad de campos
*---------------------------------------------------------------------------------------------------
LPARAMETERS taFields, tnField_Count
EXTERNAL ARRAY taFields
TRY
LOCAL I, lcText, loEx AS EXCEPTION, lcField, luValue
lcText = ''
TEXT TO lcText TEXTMERGE NOSHOW FLAGS 1+2 PRETEXT 1+2
<<>> <<C_RECORD_I>>
<<>> <<C_RECNO_I>><<recno()>><<C_RECNO_F>>
endtext
for I = 1 to tnField_Count
lcField = taFields[I, 1]
luValue = evaluate(lcField)
do case
case taFields[I, 2] $ 'CMV'
luValue = trim(luValue)
if This.Encode(luValue) <> luValue
luValue = '<![CDATA[' + luValue + ']]>'
endif This.Encode(luValue) <> luValue
endcase
TEXT TO lcText TEXTMERGE NOSHOW flags 1+2 PRETEXT 1+2 additive
<<>> <<'<' + lcField + '>'>><<luValue>></<<lcField>>>
endtext
next
TEXT TO lcText TEXTMERGE NOSHOW FLAGS 1+2 PRETEXT 1+2 additive
<<>> <<C_RECORD_F>>
ENDTEXT
CATCH TO loEx
IF THIS.l_Debug AND _VFP.STARTMODE = 0
SET STEP ON
ENDIF
THROW
ENDTRY
RETURN lcText
endproc
procedure Encode
lparameters tcString
local lcString
lcString = strtran(tcString, '&', '&amp;')
lcString = strtran(lcString, '>', '&gt;')
lcString = strtran(lcString, '<', '&lt;')
lcString = strtran(lcString, '"', '&quot;')
lcString = strtran(lcString, "'", '&#39;')
lcString = strtran(lcString, '/', '&#47;')
lcString = strtran(lcString, chr(13), '&#13;')
lcString = strtran(lcString, chr(10), '&#10;')
lcString = strtran(lcString, chr(9), '&#9;')
return lcString
endproc
ENDDEFINE
*** DH 06/02/2014: end of added classes
*******************************************************************************************************************
DEFINE CLASS CL_PROJ_SRV_HEAD AS CL_CUS_BASE