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

- New PRG_Compat_Level CFG value to make generated SC2/VC2 code more PRG compatible

Browse Source
This commit is contained in:
fdbozzo
2018-03-04 12:42:17 +01:00
parent 8d0e7b2e0c 66ddebc92b
commit 1d560e8f1e
3 changed files with 67 additions and 29 deletions
Download Patch File Download Diff File Expand all files Collapse all files

2
TESTS/ut__foxbin2prg.prg
View File

@@ -889,6 +889,7 @@ DEFINE CLASS ut__foxbin2prg AS FxuTestCase OF FxuTestCase.prg
loCnv = NEWOBJECT("c_foxbin2prg", "FOXBIN2PRG.PRG")
*loCnv.l_Debug = .F.
loCnv.l_ShowErrors = .F.
loCnv.n_PRG_COMPAT_LEVEL = 0
*loCnv.l_Test = .T.
*loCnv.l_PropSort_Enabled = .F. && Para buscar diferencias
*loCnv.l_MethodSort_Enabled = .F. && Para buscar diferencias
@@ -1474,6 +1475,7 @@ DEFINE CLASS ut__foxbin2prg AS FxuTestCase OF FxuTestCase.prg
loEx = NULL
loCnv = NEWOBJECT("c_foxbin2prg", "FOXBIN2PRG.PRG")
loCnv.evaluateConfiguration( '1', '1', '1', '0', '1', '4', '1', '0' )
loCnv.n_PRG_COMPAT_LEVEL = 0
*loCnv.l_Test = .T.

1
foxbin2prg.cfg.txt
View File

@@ -26,6 +26,7 @@
* RemoveZOrderSetFromProps: 0 && 0=Do not remove ZOrderSet property from object, 1=Remove ZOrderSet property from object / 0=No quitar la propiedad ZOrderSet de los objetos, 1=Quitar la propiedad ZOrderSet de los objetos
* Language: (auto) && Language of shown messages and LOGs. EN=English, FR=French, ES=Espa<70>ol, DE=German, Not defined = AUTOMATIC [DEFAULT]
* ExcludeDBFAutoincNextval: 0 && [0=Do not exclude this value from db2], 1=Exclude this value from db2
* PRG_Compat_Level: 0 && [0=Legacy], 1=Use HELPSTRING as Class Procedure comment
*-- CONVERTION OPTIONS / OPCIONES DE CONVERSI<53>N
* PJX_Conversion_Support: 2 && 0=No support, 1=Generate TXT only (Diff), 2=Generate TXT and BIN (Merge)

93
foxbin2prg.prg
View File

@@ -209,6 +209,7 @@
* 11/01/2018 FDBOZZO v1.19.49.7 Bug Fix: Cuando se convierte la estructura de un DBF puede dar error si existe un campo llamado I o X (Francisco Prieto)
* 30/01/2018 FDBOZZO v1.19.49.8 Bug Fix: Cuando se convierte a texto una libreria corrupta con registros duplicados, se genera el error "The specified key already exists" (Kirides)
* 03/03/2018 FDBOZZO v1.19.50 Mejora: La información DevInfo de los PJX estará inhabilitada por defecto y se podrá activar con el nuevo switch BodyDevInfo
* 03/03/2018 FDBOZZO v1.19.50 Mejora: Nueva opción de configuración "PRG_Compat_Level": 0=Legacy
* </HISTORIAL DE CAMBIOS Y NOTAS IMPORTANTES>
*
*---------------------------------------------------------------------------------------------------
@@ -824,6 +825,7 @@ DEFINE CLASS c_foxbin2prg AS Session
l_RemoveZOrderSetFromProps = .F.
l_Recompile = .T.
n_UseClassPerFile = 0
n_PRG_Compat_Level = 0 && 0=COMPATIBLE WITH FoxBin2Prg v1.19.49 and earlier, 1=Include HELPSTRING
n_ExcludeDBFAutoincNextval = 0
l_ClassPerFileCheck = .F.
l_RedirectClassPerFileToMain = .F.
@@ -1502,6 +1504,15 @@ DEFINE CLASS c_foxbin2prg AS Session
ENDPROC
PROCEDURE n_PRG_Compat_Level_ACCESS
IF THIS.n_CFG_Actual = 0 OR ISNULL( THIS.o_Configuration( THIS.n_CFG_Actual ) )
RETURN THIS.n_PRG_Compat_Level
ELSE
RETURN NVL( THIS.o_Configuration( THIS.n_CFG_Actual ).n_PRG_Compat_Level, THIS.n_PRG_Compat_Level )
ENDIF
ENDPROC
PROCEDURE changeFileAttribute
* Using Win32 Functions in Visual FoxPro
* example=103
@@ -2286,6 +2297,11 @@ DEFINE CLASS c_foxbin2prg AS Session
.writeLog( C_TAB + JUSTFNAME(lcConfigFile) + ' > BodyDevInfo: ' + TRANSFORM(lo_CFG.n_BodyDevInfo) )
ENDIF
CASE LEFT( laConfig(I), 17 ) == LOWER('PRG_Compat_Level:')
lcValue = ALLTRIM( SUBSTR( laConfig(I), 18 ) )
lo_CFG.n_PRG_Compat_Level = INT( VAL( lcValue ) )
.writeLog( C_TAB + JUSTFNAME(lcConfigFile) + ' > PRG_Compat_Level: ' + TRANSFORM(lo_CFG.n_PRG_Compat_Level) )
ENDCASE
ENDFOR
@@ -5188,7 +5204,6 @@ DEFINE CLASS c_foxbin2prg AS Session
ENDDEFINE
DEFINE CLASS frm_avance AS Form
Height = 110
Width = 628
@@ -8371,30 +8386,31 @@ DEFINE CLASS c_conversor_prg_a_bin AS c_conversor_base
PROCEDURE getClassMethodComment
LPARAMETERS tcMethodName AS STRING, toClase
*---------------------------------------------------------------------------------------------------
* PARÁMETROS: (v=Pasar por valor | @=Pasar por referencia) (!=Obligatorio | ?=Opcional) (IN/OUT)
* tcLine (@! IN/OUT) Línea a separar del comentario (En este punto, el único comentario puede ser un HELPSTRING)
* tcComment (@? OUT) Comentario
*---------------------------------------------------------------------------------------------------
LPARAMETERS tcLine AS STRING, tcComment as String
#IF .F.
LOCAL toClase AS CL_CLASE OF 'FOXBIN2PRG.PRG'
#ENDIF
LOCAL I, lcComentario ;
, loProcedure AS CL_PROCEDURE OF 'FOXBIN2PRG.PRG'
lcComentario = ''
LOCAL lnATC
tcComment = ''
lnATC = ATC("HELPSTRING", tcLine)
IF lnATC > 0
tcComment = ALLTRIM(SUBSTR(tcLine, lnATC + 10 ))
* Quitar comillas
tcComment = SUBSTR(tcComment, 2, LEN(tcComment) - 2)
tcLine = RTRIM(LEFT(tcLine, lnATC - 1 ), 0, CHR(9), CHR(0), ' ')
ENDIF
FOR I = 1 TO toClase._Procedure_Count
loProcedure = NULL
loProcedure = toClase._Procedures(m.I)
IF loProcedure._Nombre == tcMethodName
lcComentario = loProcedure._Comentario
EXIT
ENDIF
ENDFOR
loProcedure = NULL
RELEASE tcMethodName, toClase, loProcedure, I
RETURN lcComentario
RETURN tcComment
ENDPROC
@@ -9619,6 +9635,7 @@ DEFINE CLASS c_conversor_prg_a_bin AS c_conversor_base
*-- Estructura a reconocer: PROTECTED PROCEDURE nombre_del_procedimiento
llBloqueEncontrado = .T.
tcProcedureAbierto = ALLTRIM( SUBSTR( tcLine, 21 ) )
.getClassMethodComment( @tcProcedureAbierto, @tc_Comentario )
.evaluateProcedureDefinition( @toClase, m.I, @tc_Comentario, tcProcedureAbierto, 'protected', @toObjeto )
@@ -9626,18 +9643,21 @@ DEFINE CLASS c_conversor_prg_a_bin AS c_conversor_base
*-- Estructura a reconocer: HIDDEN PROCEDURE nombre_del_procedimiento
llBloqueEncontrado = .T.
tcProcedureAbierto = ALLTRIM( SUBSTR( tcLine, 18 ) )
.getClassMethodComment( @tcProcedureAbierto, @tc_Comentario )
.evaluateProcedureDefinition( @toClase, m.I, @tc_Comentario, tcProcedureAbierto, 'hidden', @toObjeto )
CASE UPPER( LEFT( tcLine, 10 ) ) == 'PROCEDURE '
*-- Estructura a reconocer: PROCEDURE [objeto.]nombre_del_procedimiento
llBloqueEncontrado = .T.
tcProcedureAbierto = ALLTRIM( SUBSTR( tcLine, 11 ) )
.getClassMethodComment( @tcProcedureAbierto, @tc_Comentario )
.evaluateProcedureDefinition( @toClase, m.I, @tc_Comentario, tcProcedureAbierto, 'normal', @toObjeto )
CASE UPPER( LEFT( tcLine, 19 ) ) == 'PROTECTED FUNCTION '
*-- Estructura a reconocer: PROTECTED PROCEDURE nombre_del_procedimiento
llBloqueEncontrado = .T.
tcProcedureAbierto = ALLTRIM( SUBSTR( tcLine, 20 ) )
.getClassMethodComment( @tcProcedureAbierto, @tc_Comentario )
.evaluateProcedureDefinition( @toClase, m.I, @tc_Comentario, tcProcedureAbierto, 'protected', @toObjeto )
@@ -9645,12 +9665,14 @@ DEFINE CLASS c_conversor_prg_a_bin AS c_conversor_base
*-- Estructura a reconocer: HIDDEN FUNCTION nombre_del_procedimiento
llBloqueEncontrado = .T.
tcProcedureAbierto = ALLTRIM( SUBSTR( tcLine, 17 ) )
.getClassMethodComment( @tcProcedureAbierto, @tc_Comentario )
.evaluateProcedureDefinition( @toClase, m.I, @tc_Comentario, tcProcedureAbierto, 'hidden', @toObjeto )
CASE UPPER( LEFT( tcLine, 9 ) ) == 'FUNCTION '
*-- Estructura a reconocer: FUNCTION [objeto.]nombre_del_procedimiento
llBloqueEncontrado = .T.
tcProcedureAbierto = ALLTRIM( SUBSTR( tcLine, 10 ) )
.getClassMethodComment( @tcProcedureAbierto, @tc_Comentario )
.evaluateProcedureDefinition( @toClase, m.I, @tc_Comentario, tcProcedureAbierto, 'normal', @toObjeto )
ENDCASE
@@ -13617,11 +13639,15 @@ DEFINE CLASS c_conversor_bin_a_prg AS c_conversor_base
PROCEDURE get_CLASS_METHODS
LPARAMETERS tnMethodCount, taMethods, taCode, taProtected, taPropsAndComments
LPARAMETERS tnMethodCount, taMethods, taCode, taProtected, taPropsAndComments, toFoxBin2Prg
*-- DEFINIR MÉTODOS DE LA CLASE
*-- Ubico los métodos protegidos y les cambio la definición
EXTERNAL ARRAY taMethods, taCode, taProtected, taPropsAndComments
#IF .F.
LOCAL toFoxBin2Prg AS c_foxbin2prg OF 'FOXBIN2PRG.PRG'
#ENDIF
TRY
LOCAL lcMethod, lcMethodName, lnProtectedItem, lnCommentRow, lcProcDef, lcMethods, lnLen
STORE '' TO lcMethod, lcMethodName, lcProcDef, lcMethods
@@ -13654,7 +13680,13 @@ DEFINE CLASS c_conversor_bin_a_prg AS c_conversor_base
*-- Comentarios del método (si tiene)
IF lnCommentRow > 0 AND NOT EMPTY(taPropsAndComments(lnCommentRow,2))
lcMethod = lcMethod + C_TAB + C_TAB + '&' + '& ' + taPropsAndComments(lnCommentRow,2)
* PRG_Compat_Level >= 1
IF BITAND(toFoxBin2Prg.n_PRG_Compat_Level, 1) > 0
lcMethod = lcMethod + C_TAB + C_TAB + 'HELPSTRING "' + taPropsAndComments(lnCommentRow,2) + '"'
ELSE
* PRG_Compat_Level = 0 (Default old setting)
lcMethod = lcMethod + C_TAB + C_TAB + '&' + '& ' + taPropsAndComments(lnCommentRow,2)
ENDIF
ENDIF
*-- Código del método
@@ -14407,7 +14439,7 @@ DEFINE CLASS c_conversor_bin_a_prg AS c_conversor_base
CASE lnTextNodes = 0 AND UPPER( LEFT(lcLine, 10) ) == 'PROCEDURE '
tnMethodCount = tnMethodCount + 1
DIMENSION taMethods(tnMethodCount, 3), taCode(tnMethodCount)
taMethods(tnMethodCount, 1) = RTRIM( SUBSTR(lcLine, 11) )
taMethods(tnMethodCount, 1) = RTRIM( SUBSTR(lcLine, 11), 0, CHR(9), CHR(0), ' ' )
taMethods(tnMethodCount, 2) = tnMethodCount
taMethods(tnMethodCount, 3) = ''
taCode(tnMethodCount) = 'PROCEDURE ' + taMethods(tnMethodCount, 1) + CR_LF && laLine(m.I) + CR_LF
@@ -14416,7 +14448,7 @@ DEFINE CLASS c_conversor_bin_a_prg AS c_conversor_base
CASE lnTextNodes = 0 AND UPPER( LEFT(lcLine, 9) ) == 'FUNCTION ' && NOT VALID WITH VFP IDE, BUT 3rd. PARTY SOFTWARE CAN USE IT
tnMethodCount = tnMethodCount + 1
DIMENSION taMethods(tnMethodCount, 3), taCode(tnMethodCount)
taMethods(tnMethodCount, 1) = RTRIM( SUBSTR(lcLine, 10) )
taMethods(tnMethodCount, 1) = RTRIM( SUBSTR(lcLine, 10), 0, CHR(9), CHR(0), ' ' )
taMethods(tnMethodCount, 2) = tnMethodCount
taMethods(tnMethodCount, 3) = ''
taCode(tnMethodCount) = 'PROCEDURE ' + taMethods(tnMethodCount, 1) + CR_LF && laLine(m.I) + CR_LF
@@ -14425,7 +14457,7 @@ DEFINE CLASS c_conversor_bin_a_prg AS c_conversor_base
CASE lnTextNodes = 0 AND UPPER( LEFT(lcLine, 17) ) == 'HIDDEN PROCEDURE '
tnMethodCount = tnMethodCount + 1
DIMENSION taMethods(tnMethodCount, 3), taCode(tnMethodCount)
taMethods(tnMethodCount, 1) = RTRIM( SUBSTR(lcLine, 18) )
taMethods(tnMethodCount, 1) = RTRIM( SUBSTR(lcLine, 18), 0, CHR(9), CHR(0), ' ' )
taMethods(tnMethodCount, 2) = tnMethodCount
taMethods(tnMethodCount, 3) = 'HIDDEN '
taCode(tnMethodCount) = 'HIDDEN PROCEDURE ' + taMethods(tnMethodCount, 1) + CR_LF && laLine(m.I) + CR_LF
@@ -14434,7 +14466,7 @@ DEFINE CLASS c_conversor_bin_a_prg AS c_conversor_base
CASE lnTextNodes = 0 AND UPPER( LEFT(lcLine, 16) ) == 'HIDDEN FUNCTION ' && NOT VALID WITH VFP IDE, BUT 3rd. PARTY SOFTWARE CAN USE IT
tnMethodCount = tnMethodCount + 1
DIMENSION taMethods(tnMethodCount, 3), taCode(tnMethodCount)
taMethods(tnMethodCount, 1) = RTRIM( SUBSTR(lcLine, 17) )
taMethods(tnMethodCount, 1) = RTRIM( SUBSTR(lcLine, 17), 0, CHR(9), CHR(0), ' ' )
taMethods(tnMethodCount, 2) = tnMethodCount
taMethods(tnMethodCount, 3) = 'HIDDEN '
taCode(tnMethodCount) = 'HIDDEN PROCEDURE ' + taMethods(tnMethodCount, 1) + CR_LF && laLine(m.I) + CR_LF
@@ -14443,7 +14475,7 @@ DEFINE CLASS c_conversor_bin_a_prg AS c_conversor_base
CASE lnTextNodes = 0 AND UPPER( LEFT(lcLine, 20) ) == 'PROTECTED PROCEDURE '
tnMethodCount = tnMethodCount + 1
DIMENSION taMethods(tnMethodCount, 3), taCode(tnMethodCount)
taMethods(tnMethodCount, 1) = RTRIM( SUBSTR(lcLine, 21) )
taMethods(tnMethodCount, 1) = RTRIM( SUBSTR(lcLine, 21), 0, CHR(9), CHR(0), ' ' )
taMethods(tnMethodCount, 2) = tnMethodCount
taMethods(tnMethodCount, 3) = 'PROTECTED '
taCode(tnMethodCount) = 'PROTECTED PROCEDURE ' + taMethods(tnMethodCount, 1) + CR_LF && laLine(m.I) + CR_LF
@@ -14452,7 +14484,7 @@ DEFINE CLASS c_conversor_bin_a_prg AS c_conversor_base
CASE lnTextNodes = 0 AND UPPER( LEFT(lcLine, 19) ) == 'PROTECTED FUNCTION ' && NOT VALID WITH VFP IDE, BUT 3rd. PARTY SOFTWARE CAN USE IT
tnMethodCount = tnMethodCount + 1
DIMENSION taMethods(tnMethodCount, 3), taCode(tnMethodCount)
taMethods(tnMethodCount, 1) = RTRIM( SUBSTR(lcLine, 20) )
taMethods(tnMethodCount, 1) = RTRIM( SUBSTR(lcLine, 20), 0, CHR(9), CHR(0), ' ' )
taMethods(tnMethodCount, 2) = tnMethodCount
taMethods(tnMethodCount, 3) = 'PROTECTED '
taCode(tnMethodCount) = 'PROTECTED PROCEDURE ' + taMethods(tnMethodCount, 1) + CR_LF && laLine(m.I) + CR_LF
@@ -15585,7 +15617,7 @@ DEFINE CLASS c_conversor_vcx_a_prg AS c_conversor_bin_a_prg
.method2Array( loRegClass.METHODS, @laMethods, @laCode, '', @lnMethodCount ;
, @laPropsAndComments, lnPropsAndComments_Count, @laProtected, lnProtected_Count, @toFoxBin2Prg, @loRegClass )
.get_CLASS_METHODS( @lnMethodCount, @laMethods, @laCode, @laProtected, @laPropsAndComments )
.get_CLASS_METHODS( @lnMethodCount, @laMethods, @laCode, @laProtected, @laPropsAndComments, @toFoxBin2Prg )
lnLastClass = 1
lcMethods = ''
@@ -15954,7 +15986,7 @@ DEFINE CLASS c_conversor_scx_a_prg AS c_conversor_bin_a_prg
.method2Array( loRegClass.METHODS, @laMethods, @laCode, '', @lnMethodCount ;
, @laPropsAndComments, lnPropsAndComments_Count, @laProtected, lnProtected_Count, @toFoxBin2Prg, @loRegClass )
.get_CLASS_METHODS( @lnMethodCount, @laMethods, @laCode, @laProtected, @laPropsAndComments )
.get_CLASS_METHODS( @lnMethodCount, @laMethods, @laCode, @laProtected, @laPropsAndComments, @toFoxBin2Prg )
lnLastClass = 1
lcMethods = ''
@@ -27779,6 +27811,7 @@ DEFINE CLASS CL_CFG AS CUSTOM
+ [<memberdata name="dbf_conversion_excluded" display="DBF_Conversion_Excluded"/>] ;
+ [<memberdata name="dbc_conversion_support" display="DBC_Conversion_Support"/>] ;
+ [<memberdata name="c_backgroundimage" display="c_BackgroundImage"/>] ;
+ [<memberdata name="n_prg_compat_level" display="n_PRG_Compat_Level"/>] ;
+ [<memberdata name="copyfrom" display="CopyFrom"/>] ;
+ [</VFPData>]
@@ -27827,6 +27860,7 @@ DEFINE CLASS CL_CFG AS CUSTOM
DBF_Conversion_Excluded = NULL
DBC_Conversion_Support = NULL
c_BackgroundImage = NULL
n_PRG_Compat_Level = NULL
PROCEDURE CopyFrom
@@ -27873,6 +27907,7 @@ DEFINE CLASS CL_CFG AS CUSTOM
.DBF_Conversion_Excluded = toParentCFG.DBF_Conversion_Excluded
.DBC_Conversion_Support = toParentCFG.DBC_Conversion_Support
.c_BackgroundImage = toParentCFG.c_BackgroundImage
.n_PRG_Compat_Level = toParentCFG.n_PRG_Compat_Level
ENDWITH
ENDPROC