Changeset: 363 fdbozzo - 15/07/2014 20:46:01:

foxbin2prg.prg

@@ -285,6 +285,15 @@ LPARAMETERS tc_InputFile, tcType, tcTextName, tlGenText, tcDontShowErrors, tcDeb
 #DEFINE C_NULL_CHAR					CHR(0)
 #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 num="##">'	&& *** FDBOZZO 2014/07/15: Optimized RECORD tag adding num property to not use REGNUM field
+#DEFINE C_RECORD_F					'</RECORD>'
+#DEFINE C_RECNO_I					'<RECNO>'
+#DEFINE C_RECNO_F					'</RECNO>'
+
 *-- Fin / End
 
 *-- From FOXPRO.H
@@ -15794,6 +15803,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
 
 
@@ -15885,6 +15896,9 @@ DEFINE CLASS CL_DBF_TABLE AS CL_CUS_BASE
 			LOCAL lcText, loEx AS EXCEPTION ;
 				, loFields AS CL_DBF_FIELDS OF 'FOXBIN2PRG.PRG' ;
 				, loIndexes AS CL_DBF_INDEXES OF 'FOXBIN2PRG.PRG'
+			*** DH 06/02/2014: created variables
+			LOCAL laFields[1], lnFieldCount
+
 			STORE NULL TO loIndexes, loFields
 			lcText	= ''
 
@@ -15901,12 +15915,18 @@ DEFINE CLASS CL_DBF_TABLE AS CL_CUS_BASE
 
 			*-- 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>>
 				<<>>
@@ -16473,6 +16493,185 @@ 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, lcFieldType
+			lcText	= ''
+
+			*** FDBOZZO 2014/07/15: New "num" property invalidates the use of REGNUM field
+			TEXT TO lcText TEXTMERGE NOSHOW FLAGS 1+2 PRETEXT 1+2
+				<<>>		<<STRTRAN( C_RECORD_I, '##', TRANSFORM(RECNO()) )>>
+			ENDTEXT
+
+			FOR I = 1 TO tnField_Count
+				lcField		= taFields[I, 1]
+				lcFieldType	= taFields[I, 2]
+
+				*** FDBOZZO 2014/07/15: Added field restrictions on binary and general fields
+				DO CASE
+				CASE lcFieldType == 'G'
+					luValue		= 'GENERAL FIELD NOT SUPPORTED'
+				CASE lcFieldType == 'W'
+					luValue		= 'BLOB FIELD NOT SUPPORTED'
+				CASE lcFieldType == 'Q'
+					luValue		= 'VARBINARY FIELD NOT SUPPORTED'
+				OTHERWISE
+					luValue		= EVALUATE(lcField)
+				ENDCASE
+
+				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