diff --git a/Documentacion/github/.gitignore b/Documentacion/github/.gitignore new file mode 100644 index 0000000..a923fe1 --- /dev/null +++ b/Documentacion/github/.gitignore @@ -0,0 +1,11 @@ +# we use the exclude-all-include-special approach, easier then excluding any odd stuff later +#exclude general +*.* + +#include general +# docs +!*.md + +#include special +#default git +!*.gitignore diff --git a/Documentacion/github/pictures/.gitignore b/Documentacion/github/pictures/.gitignore new file mode 100644 index 0000000..c26aa05 --- /dev/null +++ b/Documentacion/github/pictures/.gitignore @@ -0,0 +1,12 @@ +# we use the exclude-all-include-special approach, easier then excluding any odd stuff later +#exclude general +*.* + +#include general +#grafics +!*.gif +!*.png + +#include special +#default git +!*.gitignore diff --git a/foxbin2prg.exe b/foxbin2prg.exe index 5c0d3df..0a00226 100644 Binary files a/foxbin2prg.exe and b/foxbin2prg.exe differ diff --git a/foxbin2prg.prg b/foxbin2prg.prg index 393cd73..d70800f 100644 --- a/foxbin2prg.prg +++ b/foxbin2prg.prg @@ -225,12 +225,11 @@ * 01/04/2020 DH v1.19.51 Bug Fix: Manejo de AutoIncrement incompatible con Project Explorer (Dan Lauer) * 01/04/2020 FDBOZZO v1.19.51 Bug Fix: La conversión de tablas falla si algún campo contiene una palabra reservada como UNIQUE (DAJU78) * 01/04/2020 FDBOZZO v1.19.51 Bug Fix: No se respetan las propiedades de VCX/SCX con nombre "note" (Tracy Pearson) - -* 14/02/2021 Lutz Scheffler conversion dbf -> prg, error if only test mode (toFoxBin2Prg.l_ProcessFiles is false) -* minor translations -* 14/02/2021 Lutz Scheffler conversion prg -> dbf, fields with .NULL. value are incorectly recreated -* 15/02/2021 Lutz Scheffler processing directory, flush log file after loop instead of file -* 16/02/2021 Lutz Scheffler conversion prg -> vcx, files per class could create one class multiple times +* 14/02/2021 LScheffler v1.19.52 Bug Fix: conversion dbf -> prg, error if only test mode (toFoxBin2Prg.l_ProcessFiles is false) +* 14/02/2021 LScheffler v1.19.52 Bug Fix: conversion prg -> dbf, fields with .NULL. value are incorectly recreated +* 15/02/2021 LScheffler v1.19.53 Bug Fix: processing directory, flush log file after loop instead of file +* 16/02/2021 LScheffler v1.19.53 Bug Fix: conversion prg -> vcx, files per class could create one class multiple times +* 03/03/2021 LScheffler v1.19.54 Bug Fix: DBF_Conversion_Condition, problem with macro expansion * * *--------------------------------------------------------------------------------------------------- @@ -400,213 +399,213 @@ *--------------------------------------------------------------------------------------------------- * Ej: DO FOXBIN2PRG.PRG WITH "C:\DESA\INTEGRACION\LIBRERIA.VCX" *--------------------------------------------------------------------------------------------------- -LPARAMETERS tc_InputFile, tcType, tcTextName, tlGenText, tcDontShowErrors, tcDebug, tcDontShowProgress, tcOriginalFileName ; +Lparameters tc_InputFile, tcType, tcTextName, tlGenText, tcDontShowErrors, tcDebug, tcDontShowProgress, tcOriginalFileName ; , tcRecompile, tcNoTimestamps, tcCFG_File *-- NO modificar! / Do NOT change! -#DEFINE C_CMT_I '*--' -#DEFINE C_CMT_F '--*' -#DEFINE C_CLASSCOMMENTS_I '*' -#DEFINE C_CLASSCOMMENTS_F '*' -#DEFINE C_LEN_CLASSCOMMENTS_I LEN(C_CLASSCOMMENTS_I) -#DEFINE C_LEN_CLASSCOMMENTS_F LEN(C_CLASSCOMMENTS_F) -#DEFINE C_CLASSDATA_I '*< CLASSDATA:' -#DEFINE C_CLASSDATA_F '/>' -#DEFINE C_LEN_CLASSDATA_I LEN(C_CLASSDATA_I) -#DEFINE C_EXTERNAL_CLASS_I '*< EXTERNAL_CLASS:' -#DEFINE C_EXTERNAL_CLASS_F '/>' -#DEFINE C_LEN_EXTERNAL_CLASS_I LEN(C_EXTERNAL_CLASS_I) -#DEFINE C_EXTERNAL_MEMBER_I '*< EXTERNAL_MEMBER:' -#DEFINE C_EXTERNAL_MEMBER_F '/>' -#DEFINE C_LEN_EXTERNAL_MEMBER_I LEN(C_EXTERNAL_MEMBER_I) -#DEFINE C_OBJECTDATA_I '*< OBJECTDATA:' -#DEFINE C_OBJECTDATA_F '/>' -#DEFINE C_LEN_OBJECTDATA_I LEN(C_OBJECTDATA_I) -#DEFINE C_OLE_I '*< OLE:' -#DEFINE C_OLE_F '/>' -#DEFINE C_LEN_OLE_I LEN(C_OLE_I) -#DEFINE C_DEFINED_PAM_I '*' -#DEFINE C_DEFINED_PAM_F '*' -#DEFINE C_LEN_DEFINED_PAM_I LEN(C_DEFINED_PAM_I) -#DEFINE C_LEN_DEFINED_PAM_F LEN(C_DEFINED_PAM_F) -#DEFINE C_END_OBJECT_I '*< END OBJECT:' -#DEFINE C_END_OBJECT_F '/>' -#DEFINE C_LEN_END_OBJECT_I LEN(C_END_OBJECT_I) -#DEFINE C_FB2PRG_META_I '*< FOXBIN2PRG:' -#DEFINE C_FB2PRG_META_F '/>' -#DEFINE C_LIBCOMMENT_I '*< LIBCOMMENT:' -#DEFINE C_LIBCOMMENT_F '/>' -#DEFINE C_DEFINE_CLASS 'DEFINE CLASS' -#DEFINE C_ENDDEFINE 'ENDDEFINE' -#DEFINE C_TEXT 'TEXT' -#DEFINE C_ENDTEXT 'ENDTEXT' -#DEFINE C_PROCEDURE 'PROCEDURE' -#DEFINE C_ENDPROC 'ENDPROC' -#DEFINE C_WITH 'WITH' -#DEFINE C_ENDWITH 'ENDWITH' -#DEFINE C_SRV_HEAD_I '*' -#DEFINE C_SRV_HEAD_F '*' -#DEFINE C_SRV_DATA_I '*' -#DEFINE C_SRV_DATA_F '*' -#DEFINE C_DEVINFO_I '*' -#DEFINE C_DEVINFO_F '*' -#DEFINE C_BUILDPROJ_I '*' -#DEFINE C_BUILDPROJ_F '*' -#DEFINE C_PROJPROPS_I '*' -#DEFINE C_PROJPROPS_F '*' -#DEFINE C_FILE_META_I '*< FileMetadata:' -#DEFINE C_FILE_META_F '/>' -#DEFINE C_FILE_CMTS_I '*' -#DEFINE C_FILE_CMTS_F '*' -#DEFINE C_FILE_EXCL_I '*' -#DEFINE C_FILE_EXCL_F '*' -#DEFINE C_FILE_TXT_I '*' -#DEFINE C_FILE_TXT_F '*' -#DEFINE C_FB2P_VALUE_I '' -#DEFINE C_FB2P_VALUE_F '' -#DEFINE C_LEN_FB2P_VALUE_I LEN(C_FB2P_VALUE_I) -#DEFINE C_LEN_FB2P_VALUE_F LEN(C_FB2P_VALUE_F) -#DEFINE C_VFPDATA_I '' -#DEFINE C_VFPDATA_F '' -#DEFINE C_MEMBERDATA_I C_VFPDATA_I -#DEFINE C_MEMBERDATA_F C_VFPDATA_F -#DEFINE C_LEN_MEMBERDATA_I LEN(C_MEMBERDATA_I) -#DEFINE C_LEN_MEMBERDATA_F LEN(C_MEMBERDATA_F) -#DEFINE C_DATA_I '' -#DEFINE C_TAG_REPORTE 'Reportes' -#DEFINE C_TAG_REPORTE_I '<' + C_TAG_REPORTE + '>' -#DEFINE C_TAG_REPORTE_F '' -#DEFINE C_DBF_HEAD_I '' -#DEFINE C_LEN_DBF_HEAD_I LEN(C_DBF_HEAD_I) -#DEFINE C_LEN_DBF_HEAD_F LEN(C_DBF_HEAD_F) -#DEFINE C_CDX_I '' -#DEFINE C_CDX_F '' -#DEFINE C_LEN_CDX_I LEN(C_CDX_I) -#DEFINE C_LEN_CDX_F LEN(C_CDX_F) -#DEFINE C_LEN_INDEX_I LEN(C_INDEX_I) -#DEFINE C_LEN_INDEX_F LEN(C_INDEX_F) -#DEFINE C_DATABASE_I '' -#DEFINE C_DATABASE_F '' -#DEFINE C_STORED_PROC_I '' -#DEFINE C_TABLE_I '' -#DEFINE C_TABLE_F '
' -#DEFINE C_TABLES_I '' -#DEFINE C_TABLES_F '' -#DEFINE C_VIEW_I '' -#DEFINE C_VIEW_F '' -#DEFINE C_VIEWS_I '' -#DEFINE C_VIEWS_F '' -#DEFINE C_FIELD_ORDER_I '' -#DEFINE C_FIELD_ORDER_F '' -#DEFINE C_FIELD_I '' -#DEFINE C_FIELD_F '' -#DEFINE C_FIELDS_I '' -#DEFINE C_FIELDS_F '' -#DEFINE C_CONNECTION_I '' -#DEFINE C_CONNECTION_F '' -#DEFINE C_CONNECTIONS_I '' -#DEFINE C_CONNECTIONS_F '' -#DEFINE C_RELATION_I '' -#DEFINE C_RELATION_F '' -#DEFINE C_RELATIONS_I '' -#DEFINE C_RELATIONS_F '' -#DEFINE C_INDEX_I '' -#DEFINE C_INDEX_F '' -#DEFINE C_INDEXES_I '' -#DEFINE C_INDEXES_F '' -#DEFINE C_PROC_CODE_I '*' -#DEFINE C_PROC_CODE_F '*' -#DEFINE C_SETUPCODE_I '*' -#DEFINE C_SETUPCODE_F '*' -#DEFINE C_CLEANUPCODE_I '*' -#DEFINE C_CLEANUPCODE_F '*' -#DEFINE C_MENUCODE_I '*' -#DEFINE C_MENUCODE_F '*' -#DEFINE C_MENUTYPE_I '*' -#DEFINE C_MENUTYPE_F '' -#DEFINE C_MENULOCATION_I '*' -#DEFINE C_MENULOCATION_F '' +#Define C_CMT_I '*--' +#Define C_CMT_F '--*' +#Define C_CLASSCOMMENTS_I '*' +#Define C_CLASSCOMMENTS_F '*' +#Define C_LEN_CLASSCOMMENTS_I Len(C_CLASSCOMMENTS_I) +#Define C_LEN_CLASSCOMMENTS_F Len(C_CLASSCOMMENTS_F) +#Define C_CLASSDATA_I '*< CLASSDATA:' +#Define C_CLASSDATA_F '/>' +#Define C_LEN_CLASSDATA_I Len(C_CLASSDATA_I) +#Define C_EXTERNAL_CLASS_I '*< EXTERNAL_CLASS:' +#Define C_EXTERNAL_CLASS_F '/>' +#Define C_LEN_EXTERNAL_CLASS_I Len(C_EXTERNAL_CLASS_I) +#Define C_EXTERNAL_MEMBER_I '*< EXTERNAL_MEMBER:' +#Define C_EXTERNAL_MEMBER_F '/>' +#Define C_LEN_EXTERNAL_MEMBER_I Len(C_EXTERNAL_MEMBER_I) +#Define C_OBJECTDATA_I '*< OBJECTDATA:' +#Define C_OBJECTDATA_F '/>' +#Define C_LEN_OBJECTDATA_I Len(C_OBJECTDATA_I) +#Define C_OLE_I '*< OLE:' +#Define C_OLE_F '/>' +#Define C_LEN_OLE_I Len(C_OLE_I) +#Define C_DEFINED_PAM_I '*' +#Define C_DEFINED_PAM_F '*' +#Define C_LEN_DEFINED_PAM_I Len(C_DEFINED_PAM_I) +#Define C_LEN_DEFINED_PAM_F Len(C_DEFINED_PAM_F) +#Define C_END_OBJECT_I '*< END OBJECT:' +#Define C_END_OBJECT_F '/>' +#Define C_LEN_END_OBJECT_I Len(C_END_OBJECT_I) +#Define C_FB2PRG_META_I '*< FOXBIN2PRG:' +#Define C_FB2PRG_META_F '/>' +#Define C_LIBCOMMENT_I '*< LIBCOMMENT:' +#Define C_LIBCOMMENT_F '/>' +#Define C_DEFINE_CLASS 'DEFINE CLASS' +#Define C_ENDDEFINE 'ENDDEFINE' +#Define C_TEXT 'TEXT' +#Define C_ENDTEXT 'ENDTEXT' +#Define C_PROCEDURE 'PROCEDURE' +#Define C_ENDPROC 'ENDPROC' +#Define C_WITH 'WITH' +#Define C_ENDWITH 'ENDWITH' +#Define C_SRV_HEAD_I '*' +#Define C_SRV_HEAD_F '*' +#Define C_SRV_DATA_I '*' +#Define C_SRV_DATA_F '*' +#Define C_DEVINFO_I '*' +#Define C_DEVINFO_F '*' +#Define C_BUILDPROJ_I '*' +#Define C_BUILDPROJ_F '*' +#Define C_PROJPROPS_I '*' +#Define C_PROJPROPS_F '*' +#Define C_FILE_META_I '*< FileMetadata:' +#Define C_FILE_META_F '/>' +#Define C_FILE_CMTS_I '*' +#Define C_FILE_CMTS_F '*' +#Define C_FILE_EXCL_I '*' +#Define C_FILE_EXCL_F '*' +#Define C_FILE_TXT_I '*' +#Define C_FILE_TXT_F '*' +#Define C_FB2P_VALUE_I '' +#Define C_FB2P_VALUE_F '' +#Define C_LEN_FB2P_VALUE_I Len(C_FB2P_VALUE_I) +#Define C_LEN_FB2P_VALUE_F Len(C_FB2P_VALUE_F) +#Define C_VFPDATA_I '' +#Define C_VFPDATA_F '' +#Define C_MEMBERDATA_I C_VFPDATA_I +#Define C_MEMBERDATA_F C_VFPDATA_F +#Define C_LEN_MEMBERDATA_I Len(C_MEMBERDATA_I) +#Define C_LEN_MEMBERDATA_F Len(C_MEMBERDATA_F) +#Define C_DATA_I '' +#Define C_TAG_REPORTE 'Reportes' +#Define C_TAG_REPORTE_I '<' + C_TAG_REPORTE + '>' +#Define C_TAG_REPORTE_F '' +#Define C_DBF_HEAD_I '' +#Define C_LEN_DBF_HEAD_I Len(C_DBF_HEAD_I) +#Define C_LEN_DBF_HEAD_F Len(C_DBF_HEAD_F) +#Define C_CDX_I '' +#Define C_CDX_F '' +#Define C_LEN_CDX_I Len(C_CDX_I) +#Define C_LEN_CDX_F Len(C_CDX_F) +#Define C_LEN_INDEX_I Len(C_INDEX_I) +#Define C_LEN_INDEX_F Len(C_INDEX_F) +#Define C_DATABASE_I '' +#Define C_DATABASE_F '' +#Define C_STORED_PROC_I '' +#Define C_TABLE_I '' +#Define C_TABLE_F '
' +#Define C_TABLES_I '' +#Define C_TABLES_F '' +#Define C_VIEW_I '' +#Define C_VIEW_F '' +#Define C_VIEWS_I '' +#Define C_VIEWS_F '' +#Define C_FIELD_ORDER_I '' +#Define C_FIELD_ORDER_F '' +#Define C_FIELD_I '' +#Define C_FIELD_F '' +#Define C_FIELDS_I '' +#Define C_FIELDS_F '' +#Define C_CONNECTION_I '' +#Define C_CONNECTION_F '' +#Define C_CONNECTIONS_I '' +#Define C_CONNECTIONS_F '' +#Define C_RELATION_I '' +#Define C_RELATION_F '' +#Define C_RELATIONS_I '' +#Define C_RELATIONS_F '' +#Define C_INDEX_I '' +#Define C_INDEX_F '' +#Define C_INDEXES_I '' +#Define C_INDEXES_F '' +#Define C_PROC_CODE_I '*' +#Define C_PROC_CODE_F '*' +#Define C_SETUPCODE_I '*' +#Define C_SETUPCODE_F '*' +#Define C_CLEANUPCODE_I '*' +#Define C_CLEANUPCODE_F '*' +#Define C_MENUCODE_I '*' +#Define C_MENUCODE_F '*' +#Define C_MENUTYPE_I '*' +#Define C_MENUTYPE_F '' +#Define C_MENULOCATION_I '*' +#Define C_MENULOCATION_F '' *-- -#DEFINE C_TAB CHR(9) -#DEFINE C_CR CHR(13) -#DEFINE C_LF CHR(10) -#DEFINE C_NULL_CHAR CHR(0) -#DEFINE CR_LF C_CR + C_LF -#DEFINE C_MPROPHEADER REPLICATE( CHR(1), 517 ) +#Define C_TAB Chr(9) +#Define C_CR Chr(13) +#Define C_LF Chr(10) +#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 '' -#DEFINE C_RECORDS_F '' -#DEFINE C_RECORD_I '' && *** FDBOZZO 2016/06/06: Quitado el REGNUM para evitar diferencias innecesarias -#DEFINE C_RECORD_F '' -#DEFINE C_RECNO_I '' -#DEFINE C_RECNO_F '' +#Define C_RECORDS_I '' +#Define C_RECORDS_F '' +#Define C_RECORD_I '' && *** FDBOZZO 2016/06/06: Quitado el REGNUM para evitar diferencias innecesarias +#Define C_RECORD_F '' +#Define C_RECNO_I '' +#Define C_RECNO_F '' *-- Fin / End *-- From FOXPRO.H *-- File Object Type Property -#DEFINE FILETYPE_DATABASE "d" && Database (.DBC) -#DEFINE FILETYPE_FREETABLE "D" && Free table (.DBF) -#DEFINE FILETYPE_QUERY "Q" && Query (.QPR) -#DEFINE FILETYPE_FORM "K" && Form (.SCX) -#DEFINE FILETYPE_REPORT "R" && Report (.FRX) -#DEFINE FILETYPE_LABEL "B" && Label (.LBX) -#DEFINE FILETYPE_CLASSLIB "V" && Class Library (.VCX) -#DEFINE FILETYPE_PROGRAM "P" && Program (.PRG) -#DEFINE FILETYPE_PROJECT "J" && Project (.PJX) [NON STANDARD!] -#DEFINE FILETYPE_APILIB "L" && API Library (.FLL) -#DEFINE FILETYPE_APPLICATION "Z" && Application (.APP) -#DEFINE FILETYPE_MENU "M" && Menu (.MNX) -#DEFINE FILETYPE_TEXT "T" && Text (.TXT, .H., etc.) -#DEFINE FILETYPE_OTHER "x" && Other file types not enumerated above +#Define FILETYPE_DATABASE "d" && Database (.DBC) +#Define FILETYPE_FREETABLE "D" && Free table (.DBF) +#Define FILETYPE_QUERY "Q" && Query (.QPR) +#Define FILETYPE_FORM "K" && Form (.SCX) +#Define FILETYPE_REPORT "R" && Report (.FRX) +#Define FILETYPE_LABEL "B" && Label (.LBX) +#Define FILETYPE_CLASSLIB "V" && Class Library (.VCX) +#Define FILETYPE_PROGRAM "P" && Program (.PRG) +#Define FILETYPE_PROJECT "J" && Project (.PJX) [NON STANDARD!] +#Define FILETYPE_APILIB "L" && API Library (.FLL) +#Define FILETYPE_APPLICATION "Z" && Application (.APP) +#Define FILETYPE_MENU "M" && Menu (.MNX) +#Define FILETYPE_TEXT "T" && Text (.TXT, .H., etc.) +#Define FILETYPE_OTHER "x" && Other file types not enumerated above *-- Menu OBJTYPE constants -#DEFINE C_OBJTYPE_MENUTYPE_DEFAULT 1 -#DEFINE C_OBJTYPE_MENUTYPE_BARorPOPUP 2 -#DEFINE C_OBJTYPE_MENUTYPE_OPTION 3 -#DEFINE C_OBJTYPE_MENUTYPE_SHORTCUT 4 -#DEFINE C_OBJTYPE_MENUTYPE_MENUBARONTOP 5 +#Define C_OBJTYPE_MENUTYPE_DEFAULT 1 +#Define C_OBJTYPE_MENUTYPE_BARorPOPUP 2 +#Define C_OBJTYPE_MENUTYPE_OPTION 3 +#Define C_OBJTYPE_MENUTYPE_SHORTCUT 4 +#Define C_OBJTYPE_MENUTYPE_MENUBARONTOP 5 *-- Menu OBJCODE constants -#DEFINE C_OBJCODE_MENUBARPOPUP_MENUPAD 0 -#DEFINE C_OBJCODE_MENUBARPOPUP_MENUBAR 1 -#DEFINE C_OBJCODE_MENUDEFAULT_DEFAULT 22 -#DEFINE C_OBJCODE_MENUOPTION_COMMAND 67 -#DEFINE C_OBJCODE_MENUOPTION_SUBMENU 77 -#DEFINE C_OBJCODE_MENUOPTION_BARNUM 78 -#DEFINE C_OBJCODE_MENUOPTION_PROCEDURE 80 +#Define C_OBJCODE_MENUBARPOPUP_MENUPAD 0 +#Define C_OBJCODE_MENUBARPOPUP_MENUBAR 1 +#Define C_OBJCODE_MENUDEFAULT_DEFAULT 22 +#Define C_OBJCODE_MENUOPTION_COMMAND 67 +#Define C_OBJCODE_MENUOPTION_SUBMENU 77 +#Define C_OBJCODE_MENUOPTION_BARNUM 78 +#Define C_OBJCODE_MENUOPTION_PROCEDURE 80 *-- Menu Location constants -#DEFINE C_MENULOCATION_REPLACE 0 -#DEFINE C_MENULOCATION_APPEND 1 -#DEFINE C_MENULOCATION_BEFORE 2 -#DEFINE C_MENULOCATION_AFTER 3 +#Define C_MENULOCATION_REPLACE 0 +#Define C_MENULOCATION_APPEND 1 +#Define C_MENULOCATION_BEFORE 2 +#Define C_MENULOCATION_AFTER 3 *-- Server Object Instancing Property -#DEFINE SERVERINSTANCE_SINGLEUSE 1 && Single use server -#DEFINE SERVERINSTANCE_NOTCREATABLE 2 && Instances creatable only inside Visual FoxPro -#DEFINE SERVERINSTANCE_MULTIUSE 3 && Multi-use server +#Define SERVERINSTANCE_SINGLEUSE 1 && Single use server +#Define SERVERINSTANCE_NOTCREATABLE 2 && Instances creatable only inside Visual FoxPro +#Define SERVERINSTANCE_MULTIUSE 3 && Multi-use server *-- FileTypes for ADIR() -#DEFINE C_FILETYPE_DIRECTORY "D" -#DEFINE C_FILETYPE_FILE "F" -#DEFINE C_FILETYPE_QUERYSUPPORT "Q" +#Define C_FILETYPE_DIRECTORY "D" +#Define C_FILETYPE_FILE "F" +#Define C_FILETYPE_QUERYSUPPORT "Q" *-- Fin / End *-- Predefine 64MB of RAM -SYS(3050,1,64*1024*1024) -SYS(3050,2,64*1024*1024) +Sys(3050,1,64*1024*1024) +Sys(3050,2,64*1024*1024) -IF _VFP.StartMode > 0 THEN - SYS(2450,1) && Set Application Search Path Order to APP/EXE 1st when not in Dev-Mode -ENDIF +If _vfp.StartMode > 0 Then + Sys(2450,1) && Set Application Search Path Order to APP/EXE 1st when not in Dev-Mode +Endif -LOCAL loCnv AS c_foxbin2prg OF 'FOXBIN2PRG.PRG' -LOCAL lnResp, loEx AS EXCEPTION +Local loCnv As c_foxbin2prg Of 'FOXBIN2PRG.PRG' +Local lnResp, loEx As Exception *SET COVERAGE TO c:\desa\foxbin2prg\foxbin2prg_coverage.log *SYS(2030,1) && Enable system component debugging @@ -620,53 +619,53 @@ LOCAL lnResp, loEx AS EXCEPTION + 'tcType = ' + TRANSFORM(tcType) ) *-- En el caso de recibir "BIN2PRG" o "PRG2BIN" en el primer parámetro, los invierto. -tc_InputFile = EVL(tc_InputFile,'') -tcType = EVL(tcType,'') +tc_InputFile = Evl(tc_InputFile,'') +tcType = Evl(tcType,'') -IF ATC('-BIN2PRG','-'+tc_InputFile) > 0 OR ATC('-PRG2BIN','-'+tc_InputFile) > 0 ; - OR ATC('-SHOWMSG','-'+tc_InputFile) > 0 OR ATC('-INTERACTIVE','-'+tc_InputFile) > 0 ; - OR ATC('-SIMERR_I0','-'+tc_InputFile) > 0 OR ATC('-SIMERR_I1','-'+tc_InputFile) > 0 ; - OR ATC('-SIMERR_O1','-'+tc_InputFile) > 0 THEN +If Atc('-BIN2PRG','-'+tc_InputFile) > 0 Or Atc('-PRG2BIN','-'+tc_InputFile) > 0 ; + OR Atc('-SHOWMSG','-'+tc_InputFile) > 0 Or Atc('-INTERACTIVE','-'+tc_InputFile) > 0 ; + OR Atc('-SIMERR_I0','-'+tc_InputFile) > 0 Or Atc('-SIMERR_I1','-'+tc_InputFile) > 0 ; + OR Atc('-SIMERR_O1','-'+tc_InputFile) > 0 Then pcParamX = tc_InputFile tc_InputFile = tcType tcType = pcParamX - RELEASE pcParamX -ENDIF + Release pcParamX +Endif -TRY - loEx = NULL - loCnv = CREATEOBJECT("c_foxbin2prg") - lnResp = loCnv.execute( tc_InputFile, tcType, tcTextName, tlGenText, tcDontShowErrors, tcDebug ; - , tcDontShowProgress, NULL, @loEx, .F., tcOriginalFileName, tcRecompile, tcNoTimestamps ; - , .F., .F., .F., tcCFG_File ) -CATCH TO loEx - *-- Esto solo es para errores en el INIT, ya que los demás se deben capturar y tratar antes. - lnResp = loEx.ErrorNo - MESSAGEBOX( 'Error ' + TRANSFORM(loEx.ErrorNo) + ', ' + loEx.Message + C_CR ; - + loEx.Procedure + ', Line ' + TRANSFORM(loEx.LineNo) + C_CR ; - + loEx.Details ; - , 0+16+4096 ; - , '' ; - , 60000 ) -ENDTRY +Try + loEx = Null + loCnv = Createobject("c_foxbin2prg") + lnResp = loCnv.execute( tc_InputFile, tcType, tcTextName, tlGenText, tcDontShowErrors, tcDebug ; + , tcDontShowProgress, Null, @loEx, .F., tcOriginalFileName, tcRecompile, tcNoTimestamps ; + , .F., .F., .F., tcCFG_File ) + Catch To loEx +*-- Esto solo es para errores en el INIT, ya que los demás se deben capturar y tratar antes. + lnResp = loEx.ErrorNo + Messagebox( 'Error ' + Transform(loEx.ErrorNo) + ', ' + loEx.Message + C_CR ; + + loEx.Procedure + ', Line ' + Transform(loEx.Lineno) + C_CR ; + + loEx.Details ; + , 0+16+4096 ; + , '' ; + , 60000 ) +Endtry -ADDPROPERTY(_SCREEN, 'ExitCode', lnResp) +AddProperty(_Screen, 'ExitCode', lnResp) *SET COVERAGE TO -IF _VFP.STARTMODE <> 4 OR NOT SYS(16) == SYS(16,0) && 4 = Visual FoxPro was started as a distributable .app or .exe file. - STORE NULL TO loEx, loCnv - RELEASE loEx, loCnv - RETURN lnResp && lnResp contiene un código de error, pero invocado desde SourceSafe puede contener el tipo de soporte de archivo (0,1,2). -ENDIF +If _vfp.StartMode <> 4 Or Not Sys(16) == Sys(16,0) && 4 = Visual FoxPro was started as a distributable .app or .exe file. + Store Null To loEx, loCnv + Release loEx, loCnv + Return lnResp && lnResp contiene un código de error, pero invocado desde SourceSafe puede contener el tipo de soporte de archivo (0,1,2). +Endif -IF EMPTY(lnResp) - STORE NULL TO loEx, loCnv - RELEASE loEx, loCnv - QUIT -ENDIF +If Empty(lnResp) + Store Null To loEx, loCnv + Release loEx, loCnv + Quit +Endif -STORE NULL TO loEx, loCnv -RELEASE loEx, loCnv +Store Null To loEx, loCnv +Release loEx, loCnv *-- Muy útil para procesos batch que capturan el código de error *KillMode 1 @@ -674,9 +673,9 @@ RELEASE loEx, loCnv *ExitProcess(1) && Esta debe ser de las últimas instrucciones *KillMode 2 - This one works better. -DECLARE INTEGER OpenProcess IN Win32API INTEGER dwDesiredAccess, INTEGER bInheritHandle, INTEGER dwProcessID -lnHandle = OpenProcess(1, 1, _VFP.PROCESSID) -DECLARE INTEGER TerminateProcess IN Win32API INTEGER hProcess, INTEGER uExitCode +Declare Integer OpenProcess In Win32API Integer dwDesiredAccess, Integer bInheritHandle, Integer dwProcessID +lnHandle = OpenProcess(1, 1, _vfp.ProcessID) +Declare Integer TerminateProcess In Win32API Integer hProcess, Integer uExitCode =TerminateProcess(lnHandle,1) *KillMode 3 @@ -689,8 +688,8 @@ DECLARE INTEGER TerminateProcess IN Win32API INTEGER hProcess, INTEGER uExitCode -DEFINE CLASS c_foxbin2prg AS Session - _MEMBERDATA = [] ; +Define Class c_foxbin2prg As Session + _MemberData = [] ; + [] ; + [] ; + [] ; @@ -812,12 +811,12 @@ DEFINE CLASS c_foxbin2prg AS Session + [] - DIMENSION a_ProcessedFiles(1, 6) - PROTECTED n_CFG_Actual, l_Main_CFG_Loaded, o_Configuration, l_CFG_CachedAccess - *-- + Dimension a_ProcessedFiles(1, 6) + Protected n_CFG_Actual, l_Main_CFG_Loaded, o_Configuration, l_CFG_CachedAccess +*-- n_FB2PRG_Version = 1.19 - c_FB2PRG_Version_Real = '1.19.51' - *-- + c_FB2PRG_Version_Real = '1.19.54.1' +*-- c_Language = '' && EN, FR, ES, DE c_SimulateError = '' && SIMERR_I0, SIMERR_I1, SIMERR_O1 c_loc_processing_file = '' @@ -826,7 +825,7 @@ DEFINE CLASS c_foxbin2prg AS Session c_Foxbin2prg_FullPath = '' c_Foxbin2prg_ConfigFile = '' c_CurDir = '' - c_TempDir = SYS(2023) + c_TempDir = Sys(2023) c_InputFile = '' c_ClassToConvert = '' && Guarda el nombre de la clase a convertir, indicada en tcInputFile como "archivo.vcx::clase" c_ClassOperationType = '' && (I)mport o (E)xport. Se usa solo para manejar clases individuales. @@ -882,13 +881,13 @@ DEFINE CLASS c_foxbin2prg AS Session n_Order_View_Fields = 1 n_ProcessedFiles = 0 && Contador usado para los archivos file.class.ext n_ProcessedFilesCount = 0 && Contador genérico de procesados - o_Conversor = NULL - o_Frm_Avance = NULL - o_WSH = NULL - o_FSO = NULL && Scripting.FileSystemObject - o_TextStream = NULL && Scripting.TextStream - o_FNC = NULL && Filename_caps object - o_Configuration = NULL + o_Conversor = Null + o_Frm_Avance = Null + o_WSH = Null + o_FSO = Null && Scripting.FileSystemObject + o_TextStream = Null && Scripting.TextStream + o_FNC = Null && Filename_caps object + o_Configuration = Null run_AfterCreateTable = '' run_AfterCreate_DB2 = '' c_VC2 = 'VC2' && VCX @@ -915,1784 +914,1784 @@ DEFINE CLASS c_foxbin2prg AS Session DBF_Conversion_Excluded = '' - PROCEDURE INIT - LPARAMETERS tcCFG_File, tcCancelWithEscKey + Procedure Init + Lparameters tcCFG_File, tcCancelWithEscKey - #IF .F. - LOCAL THIS AS c_foxbin2prg OF 'FOXBIN2PRG.PRG' - #ENDIF + #If .F. + Local This As c_foxbin2prg Of 'FOXBIN2PRG.PRG' + #Endif - LOCAL lcSys16, lnPosProg, lc_Foxbin2prg_EXE, laValues(1,5), lcPicturePath, laDir(1,5) ; + Local lcSys16, lnPosProg, lc_Foxbin2prg_EXE, laValues(1,5), lcPicturePath, laDir(1,5) ; , lcLang - SET DELETED ON - SET DATE YMD - SET HOURS TO 24 - SET CENTURY ON - SET SAFETY OFF - SET MULTILOCKS ON - SET TABLEPROMPT OFF - SET POINT TO '.' - SET SEPARATOR TO ',' - tcCancelWithEscKey = EVL(tcCancelWithEscKey, '') + Set Deleted On + Set Date YMD + Set Hours To 24 + Set Century On + Set Safety Off + Set Multilocks On + Set TablePrompt Off + Set Point To '.' + Set Separator To ',' + tcCancelWithEscKey = Evl(tcCancelWithEscKey, '') - IF NOT EMPTY(tcCancelWithEscKey) - THIS.l_CancelWithEscKey = ( tcCancelWithEscKey == '1' ) - ENDIF + If Not Empty(tcCancelWithEscKey) + This.l_CancelWithEscKey = ( tcCancelWithEscKey == '1' ) + Endif - THIS.declareDLL() + This.declareDLL() - * Check if SYS(2023) point to "Program Files" - IF ATC("\PROGRAM FILES", THIS.c_TempDir) > 0 OR ATC("\ARCHIVOS DE PROGRAMA", THIS.c_TempDir) > 0 - THIS.c_TempDir = GETENV("TEMP") - ENDIF +* Check if SYS(2023) point to "Program Files" + If Atc("\PROGRAM FILES", This.c_TempDir) > 0 Or Atc("\ARCHIVOS DE PROGRAMA", This.c_TempDir) > 0 + This.c_TempDir = Getenv("TEMP") + Endif - THIS.c_LogFile = ADDBS( THIS.c_TempDir ) + 'FoxBin2Prg_Debug.LOG' - THIS.c_ErrorLogFile = ADDBS( THIS.c_TempDir ) + 'FoxBin2Prg_Error.LOG' + This.c_LogFile = Addbs( This.c_TempDir ) + 'FoxBin2Prg_Debug.LOG' + This.c_ErrorLogFile = Addbs( This.c_TempDir ) + 'FoxBin2Prg_Error.LOG' - IF ADIR(laDir, THIS.c_ErrorLogFile) > 0 THEN - IF ADIR(laDir, THIS.c_ErrorLogFile + '.BAK') > 0 THEN - THIS.changeFileAttribute( THIS.c_ErrorLogFile + '.BAK', '-R-S-H' ) - ERASE (THIS.c_ErrorLogFile + '.BAK') - ENDIF + If Adir(laDir, This.c_ErrorLogFile) > 0 Then + If Adir(laDir, This.c_ErrorLogFile + '.BAK') > 0 Then + This.changeFileAttribute( This.c_ErrorLogFile + '.BAK', '-R-S-H' ) + Erase (This.c_ErrorLogFile + '.BAK') + Endif - THIS.changeFileAttribute( THIS.c_ErrorLogFile, '-R-S-H' ) - RENAME (THIS.c_ErrorLogFile) TO (THIS.c_ErrorLogFile + '.BAK') - ENDIF + This.changeFileAttribute( This.c_ErrorLogFile, '-R-S-H' ) + Rename (This.c_ErrorLogFile) To (This.c_ErrorLogFile + '.BAK') + Endif - IF ADIR(laDir, THIS.c_LogFile) > 0 THEN - ERASE (THIS.c_LogFile + '.BAK') - RENAME (THIS.c_LogFile) TO (THIS.c_LogFile + '.BAK') - ENDIF + If Adir(laDir, This.c_LogFile) > 0 Then + Erase (This.c_LogFile + '.BAK') + Rename (This.c_LogFile) To (This.c_LogFile + '.BAK') + Endif - lcSys16 = SYS(16) - IF LEFT(lcSys16,10) == 'PROCEDURE ' - lnPosProg = AT(" ", lcSys16, 2) + 1 - ELSE + lcSys16 = Sys(16) + If Left(lcSys16,10) == 'PROCEDURE ' + lnPosProg = At(" ", lcSys16, 2) + 1 + Else lnPosProg = 1 - ENDIF + Endif - THIS.c_CurDir = SYS(5) + CURDIR() && Directorio actual, que no necesariamente es donde está FoxBin2Prg - THIS.c_Foxbin2prg_FullPath = SUBSTR( lcSys16, lnPosProg ) - THIS.c_Foxbin2prg_ConfigFile = EVL( tcCFG_File, FORCEEXT( THIS.c_Foxbin2prg_FullPath, 'CFG' ) ) - THIS.c_BackgroundImage = THIS.get_AbsolutePath( ADDBS(JUSTPATH(THIS.c_Foxbin2prg_FullPath)) + 'foxbin2prg.jpg' ) - lc_Foxbin2prg_EXE = FORCEEXT( THIS.c_Foxbin2prg_FullPath, 'EXE' ) - THIS.c_FB2PRG_EXE_Version = 'v' + IIF( AGETFILEVERSION( laValues, lc_Foxbin2prg_EXE ) = 0, TRANSFORM(THIS.c_FB2PRG_Version_Real), laValues(11) ) - ADDPROPERTY(_SCREEN, 'c_FB2PRG_EXE_Version', THIS.c_FB2PRG_EXE_Version) - ADDPROPERTY(_SCREEN, 'ExitCode', 0) + This.c_CurDir = Sys(5) + Curdir() && Directorio actual, que no necesariamente es donde está FoxBin2Prg + This.c_Foxbin2prg_FullPath = Substr( lcSys16, lnPosProg ) + This.c_Foxbin2prg_ConfigFile = Evl( tcCFG_File, Forceext( This.c_Foxbin2prg_FullPath, 'CFG' ) ) + This.c_BackgroundImage = This.get_AbsolutePath( Addbs(Justpath(This.c_Foxbin2prg_FullPath)) + 'foxbin2prg.jpg' ) + lc_Foxbin2prg_EXE = Forceext( This.c_Foxbin2prg_FullPath, 'EXE' ) + This.c_FB2PRG_EXE_Version = 'v' + Iif( Agetfileversion( laValues, lc_Foxbin2prg_EXE ) = 0, Transform(This.c_FB2PRG_Version_Real), laValues(11) ) + AddProperty(_Screen, 'c_FB2PRG_EXE_Version', This.c_FB2PRG_EXE_Version) + AddProperty(_Screen, 'ExitCode', 0) - THIS.writeLog( REPLICATE( '*', 100 ) ) - THIS.writeLog( 'FoxBin2Prg INIT -', 2 ) - THIS.writeLog( REPLICATE( '*', 100 ) ) - THIS.writeLog( 'FoxBin2Prg: [' + THIS.c_Foxbin2prg_FullPath + '] (EXE Version: ' + THIS.c_FB2PRG_EXE_Version + ', FoxPro Version: ' + VERSION(4) + ')' ) - THIS.writeLog( TEXTMERGE( '- Internal CFG: <> / External CFG: <> / CodePage Used: <>)' ) ) + This.writeLog( Replicate( '*', 100 ) ) + This.writeLog( 'FoxBin2Prg INIT -', 2 ) + This.writeLog( Replicate( '*', 100 ) ) + This.writeLog( 'FoxBin2Prg: [' + This.c_Foxbin2prg_FullPath + '] (EXE Version: ' + This.c_FB2PRG_EXE_Version + ', FoxPro Version: ' + Version(4) + ')' ) + This.writeLog( Textmerge( '- Internal CFG: <> / External CFG: <> / CodePage Used: <>)' ) ) - * Get default language info - * ISO 639-2 Language Codes: https://www.loc.gov/standards/iso639-2/php/code_list.php - lcLang = THIS.getLocaleInfo(0x00000067) && ie: spa +* Get default language info +* ISO 639-2 Language Codes: https://www.loc.gov/standards/iso639-2/php/code_list.php + lcLang = This.getLocaleInfo(0x00000067) && ie: spa - DO CASE - CASE lcLang = 'spa' - lcLang = 'ES' - CASE INLIST(lcLang, 'den', 'deu', 'ger', 'gmh', 'goh', 'gsw', 'nds') - lcLang = 'DE' - CASE INLIST(lcLang, 'cpf', 'fra', 'fre', 'frm', 'fro') - lcLang = 'FR' - OTHERWISE && Default: EN - lcLang = 'EN' - ENDCASE + Do Case + Case lcLang = 'spa' + lcLang = 'ES' + Case Inlist(lcLang, 'den', 'deu', 'ger', 'gmh', 'goh', 'gsw', 'nds') + lcLang = 'DE' + Case Inlist(lcLang, 'cpf', 'fra', 'fre', 'frm', 'fro') + lcLang = 'FR' + Otherwise && Default: EN + lcLang = 'EN' + Endcase - THIS.changeLanguage(lcLang) + This.changeLanguage(lcLang) - THIS.o_FSO = CREATEOBJECT("Scripting.FileSystemObject") - *THIS.o_WSH = CREATEOBJECT("WScript.Shell") - THIS.o_Configuration = CREATEOBJECT("COLLECTION") - THIS.evaluateConfiguration() - RELEASE lcSys16, lnPosProg, lc_Foxbin2prg_EXE, laValues - RETURN - ENDPROC + This.o_FSO = Createobject("Scripting.FileSystemObject") +*THIS.o_WSH = CREATEOBJECT("WScript.Shell") + This.o_Configuration = Createobject("COLLECTION") + This.evaluateConfiguration() + Release lcSys16, lnPosProg, lc_Foxbin2prg_EXE, laValues + Return + Endproc - PROCEDURE DESTROY - TRY - LOCAL lcFileCDX - lcFileCDX = FORCEPATH( "TABLABIN.CDX", JUSTPATH(THIS.c_InputFile) ) + Procedure Destroy + Try + Local lcFileCDX + lcFileCDX = Forcepath( "TABLABIN.CDX", Justpath(This.c_InputFile) ) - ERASE ( lcFileCDX ) + Erase ( lcFileCDX ) - THIS.writeLog( 'FoxBin2Prg UNLOAD -', 2 ) - THIS.writeLog( REPLICATE( '*', 100 ) ) - THIS.writeLog( ) - THIS.writeLog_Flush() - THIS.unloadProgressbarForm() - THIS.o_Configuration = NULL - THIS.o_WSH = NULL - THIS.o_FSO = NULL - IF VARTYPE(_SCREEN.o_FoxBin2Prg_Lang) = "O" THEN - _SCREEN.o_FoxBin2Prg_Lang = NULL - ENDIF - CATCH + This.writeLog( 'FoxBin2Prg UNLOAD -', 2 ) + This.writeLog( Replicate( '*', 100 ) ) + This.writeLog( ) + This.writeLog_Flush() + This.unloadProgressbarForm() + This.o_Configuration = Null + This.o_WSH = Null + This.o_FSO = Null + If Vartype(_Screen.o_FoxBin2Prg_Lang) = "O" Then + _Screen.o_FoxBin2Prg_Lang = Null + Endif + Catch - FINALLY - THIS.o_FSO = NULL - THIS.o_WSH = NULL - THIS.o_FNC = NULL - *-- Funciones para changeFileAttributes - CLEAR DLLS fb2p_SetFileAttributes, fb2p_GetFileAttributes - *-- Funciones para escribir en StdOut - CLEAR DLLS fb2p_GetStdHandle, fb2p_WriteFile - *-- Funciones para changeFileTime - CLEAR DLLS fb2p_SetFileTime, fb2p_GetFileAttributesEx, fb2p_LocalFileTimeToFileTime ; - , fb2p_FileTimeToSystemTime, fb2p_SystemTimeToFileTime, fb2p_lopen, fb2p_lclose - ENDTRY + Finally + This.o_FSO = Null + This.o_WSH = Null + This.o_FNC = Null +*-- Funciones para changeFileAttributes + Clear Dlls fb2p_SetFileAttributes, fb2p_GetFileAttributes +*-- Funciones para escribir en StdOut + Clear Dlls fb2p_GetStdHandle, fb2p_WriteFile +*-- Funciones para changeFileTime + Clear Dlls fb2p_SetFileTime, fb2p_GetFileAttributesEx, fb2p_LocalFileTimeToFileTime ; + , fb2p_FileTimeToSystemTime, fb2p_SystemTimeToFileTime, fb2p_lopen, fb2p_lclose + Endtry - RETURN - ENDPROC + Return + Endproc - PROCEDURE addProcessedFile - *--------------------------------------------------------------------------------------------------- - * PARÁMETROS: (v=Pasar por valor | @=Pasar por referencia) (!=Obligatorio | ?=Opcional) (IN/OUT) - * tcFile (v? IN ) Path del archivo (ej: 'C:\DESA\pruebas varias\lib.vcx') - * tcInOutType (v? IN ) Archivo de entrada o de salida ("I"=Input file, "O"=Output file) - * tcProcessed (v? IN ) Procesado ("P0"=Not Processed, "P1"=Processed) - * tcHasErrors (v? IN ) Tuvo Errores ("E0"=No Errors, "E1"=Has Errors) - * tcSupported (v? IN ) Archivo soportado ("S0"=Unsupported, "S1"=Supported) - * tcExpanded (v? IN ) Tipo de archivo ("X0"=Normal file, "X1"=Expanded multipart file) - *--------------------------------------------------------------------------------------------------- - LPARAMETERS tcFile, tcInOutType, tcProcessed, tcHasErrors, tcSupported, tcExpanded + Procedure addProcessedFile +*--------------------------------------------------------------------------------------------------- +* PARÁMETROS: (v=Pasar por valor | @=Pasar por referencia) (!=Obligatorio | ?=Opcional) (IN/OUT) +* tcFile (v? IN ) Path del archivo (ej: 'C:\DESA\pruebas varias\lib.vcx') +* tcInOutType (v? IN ) Archivo de entrada o de salida ("I"=Input file, "O"=Output file) +* tcProcessed (v? IN ) Procesado ("P0"=Not Processed, "P1"=Processed) +* tcHasErrors (v? IN ) Tuvo Errores ("E0"=No Errors, "E1"=Has Errors) +* tcSupported (v? IN ) Archivo soportado ("S0"=Unsupported, "S1"=Supported) +* tcExpanded (v? IN ) Tipo de archivo ("X0"=Normal file, "X1"=Expanded multipart file) +*--------------------------------------------------------------------------------------------------- + Lparameters tcFile, tcInOutType, tcProcessed, tcHasErrors, tcSupported, tcExpanded - LOCAL llAdded + Local llAdded - IF NOT EMPTY(tcFile) THEN - WITH THIS AS c_foxbin2prg OF 'FOXBIN2PRG.PRG' - *-- Buscar si fue procesado antes - IF NOT .wasProcessed(tcFile) THEN + If Not Empty(tcFile) Then + With This As c_foxbin2prg Of 'FOXBIN2PRG.PRG' +*-- Buscar si fue procesado antes + If Not .wasProcessed(tcFile) Then .n_ProcessedFiles = .n_ProcessedFiles + 1 - DIMENSION .a_ProcessedFiles(.n_ProcessedFiles, 6) + Dimension .a_ProcessedFiles(.n_ProcessedFiles, 6) .a_ProcessedFiles(.n_ProcessedFiles, 1) = tcFile - .a_ProcessedFiles(.n_ProcessedFiles, 2) = EVL(tcInOutType, '') - .a_ProcessedFiles(.n_ProcessedFiles, 3) = EVL(tcProcessed, '') - .a_ProcessedFiles(.n_ProcessedFiles, 4) = EVL(tcHasErrors, '') - .a_ProcessedFiles(.n_ProcessedFiles, 5) = EVL(tcSupported, '') - .a_ProcessedFiles(.n_ProcessedFiles, 6) = EVL(tcExpanded, '') + .a_ProcessedFiles(.n_ProcessedFiles, 2) = Evl(tcInOutType, '') + .a_ProcessedFiles(.n_ProcessedFiles, 3) = Evl(tcProcessed, '') + .a_ProcessedFiles(.n_ProcessedFiles, 4) = Evl(tcHasErrors, '') + .a_ProcessedFiles(.n_ProcessedFiles, 5) = Evl(tcSupported, '') + .a_ProcessedFiles(.n_ProcessedFiles, 6) = Evl(tcExpanded, '') llAdded = .T. - ENDIF - ENDWITH - ENDIF + Endif + Endwith + Endif - RETURN llAdded - ENDPROC + Return llAdded + Endproc - PROCEDURE wasProcessed - *--------------------------------------------------------------------------------------------------- - * PARÁMETROS: (v=Pasar por valor | @=Pasar por referencia) (!=Obligatorio | ?=Opcional) (IN/OUT) - * tcFileMask (v! IN ) Fullpath del archivo del que se desea saber si se procesó - *--------------------------------------------------------------------------------------------------- - LPARAMETERS tcFile, tnID + Procedure wasProcessed +*--------------------------------------------------------------------------------------------------- +* PARÁMETROS: (v=Pasar por valor | @=Pasar por referencia) (!=Obligatorio | ?=Opcional) (IN/OUT) +* tcFileMask (v! IN ) Fullpath del archivo del que se desea saber si se procesó +*--------------------------------------------------------------------------------------------------- + Lparameters tcFile, tnID tnID = 0 - IF THIS.n_ProcessedFiles = 0 - RETURN .F. - ENDIF + If This.n_ProcessedFiles = 0 + Return .F. + Endif - tnID = ASCAN( THIS.a_ProcessedFiles, tcFile, 1, 0, 1, 1+2+4 ) + tnID = Ascan( This.a_ProcessedFiles, tcFile, 1, 0, 1, 1+2+4 ) - RETURN (tnID > 0) - ENDPROC + Return (tnID > 0) + Endproc - PROCEDURE updateProgressbar - LPARAMETERS tcTexto, tnValor, tnTotal, tnTipo + Procedure updateProgressbar + Lparameters tcTexto, tnValor, tnTotal, tnTipo - TRY - *-- Si o_Frm_Avance se habilitó de forma externa, n_ShowProgressbar podría ser 0 para controlarlo desde fuera. - WITH THIS AS c_foxbin2prg OF 'FOXBIN2PRG.PRG' - IF VARTYPE(.o_Frm_Avance) = "O" THEN - *-- Cuando esta rutina se invoca desde el script, este método es el #1 y no puede cancelarse todavía - IF .o_Frm_Avance.l_Cancelled AND PROGRAM(-1) > 1 THEN - ERROR 1799 - ENDIF - .o_Frm_Avance.updateProgressbar( tcTexto, tnValor, tnTotal, tnTipo ) - ENDIF - ENDWITH + Try +*-- Si o_Frm_Avance se habilitó de forma externa, n_ShowProgressbar podría ser 0 para controlarlo desde fuera. + With This As c_foxbin2prg Of 'FOXBIN2PRG.PRG' + If Vartype(.o_Frm_Avance) = "O" Then +*-- Cuando esta rutina se invoca desde el script, este método es el #1 y no puede cancelarse todavía + If .o_Frm_Avance.l_Cancelled And Program(-1) > 1 Then + Error 1799 + Endif + .o_Frm_Avance.updateProgressbar( tcTexto, tnValor, tnTotal, tnTipo ) + Endif + Endwith - CATCH - THROW - ENDTRY - ENDPROC + Catch + Throw + Endtry + Endproc - PROCEDURE changeLanguage - LPARAMETERS tcLanguageId - _SCREEN.AddProperty( "o_FoxBin2Prg_Lang", CREATEOBJECT("CL_LANG", tcLanguageId) ) - *-- Localized properties - THIS.c_Language = _SCREEN.o_FoxBin2Prg_Lang.C_LANGUAGE_LOC - THIS.c_loc_processing_file = _SCREEN.o_FoxBin2Prg_Lang.C_PROCESSING_LOC - THIS.c_loc_process_progress = _SCREEN.o_FoxBin2Prg_Lang.C_PROCESS_PROGRESS_LOC - ENDPROC + Procedure changeLanguage + Lparameters tcLanguageId + _Screen.AddProperty( "o_FoxBin2Prg_Lang", Createobject("CL_LANG", tcLanguageId) ) +*-- Localized properties + This.c_Language = _Screen.o_FoxBin2Prg_Lang.C_LANGUAGE_LOC + This.c_loc_processing_file = _Screen.o_FoxBin2Prg_Lang.C_PROCESSING_LOC + This.c_loc_process_progress = _Screen.o_FoxBin2Prg_Lang.C_PROCESS_PROGRESS_LOC + Endproc - PROCEDURE clearProcessedFiles - *-- Limpia las estadísticas de archivos procesados que se usan para optimizar - *-- el procesamiento y evitar el reproceso de los mismos archivos, por ejemplo, - *-- de un mismo VCX compartido por 2 ó más proyectos. - WITH THIS AS c_foxbin2prg OF 'FOXBIN2PRG.PRG' + Procedure clearProcessedFiles +*-- Limpia las estadísticas de archivos procesados que se usan para optimizar +*-- el procesamiento y evitar el reproceso de los mismos archivos, por ejemplo, +*-- de un mismo VCX compartido por 2 ó más proyectos. + With This As c_foxbin2prg Of 'FOXBIN2PRG.PRG' .n_ProcessedFilesCount = 0 .n_ProcessedFiles = 0 - DIMENSION .a_ProcessedFiles(1, 6) + Dimension .a_ProcessedFiles(1, 6) .a_ProcessedFiles = '' - *-- Los errores previos también se limpian. +*-- Los errores previos también se limpian. .l_Error = .F. .l_Errors = .F. - ENDWITH - ENDPROC + Endwith + Endproc - PROCEDURE declareDLL - *-- Funciones para escribir en StdOut - DECLARE INTEGER 'GetStdHandle' IN WIN32API AS fb2p_GetStdHandle INTEGER nHandleType - DECLARE INTEGER 'WriteFile' IN WIN32API AS fb2p_WriteFile INTEGER hFile, STRING @ cBuffer, INTEGER nBytes, INTEGER @ nBytes2, INTEGER @ nBytes3 - *-- Funciones para changeFileTime - DECLARE INTEGER 'SetFileTime' IN WIN32API AS fb2p_SetFileTime INTEGER hFile, STRING lpCreationTime, STRING lpLastAccessTime, STRING lpLastWriteTime - DECLARE INTEGER 'GetFileAttributesEx' IN Win32API AS fb2p_GetFileAttributesEx STRING lpFileName, INTEGER fInfoLevelId, STRING @ lpFileInformation - DECLARE INTEGER 'LocalFileTimeToFileTime' IN Win32API AS fb2p_LocalFileTimeToFileTime STRING LOCALFILETIME, STRING @ FILETIME - DECLARE INTEGER 'FileTimeToSystemTime' IN Win32API AS fb2p_FileTimeToSystemTime STRING FILETIME, STRING @ SYSTEMTIME - DECLARE INTEGER 'SystemTimeToFileTime' IN Win32API AS fb2p_SystemTimeToFileTime STRING lpSYSTEMTIME, STRING @ FILETIME - DECLARE INTEGER '_lopen' IN Win32API AS fb2p_lopen STRING lpFileName, INTEGER iReadWrite - DECLARE INTEGER '_lclose' IN Win32API AS fb2p_lclose INTEGER hFile - *-- Funciones para changeFileAttributes - DECLARE SHORT 'SetFileAttributes' IN Win32API AS fb2p_SetFileAttributes STRING tcFileName, INTEGER dwFileAttributes - DECLARE INTEGER 'GetFileAttributes' IN Win32API AS fb2p_GetFileAttributes STRING tcFileName - *-- - ENDPROC + Procedure declareDLL +*-- Funciones para escribir en StdOut + Declare Integer 'GetStdHandle' In WIN32API As fb2p_GetStdHandle Integer nHandleType + Declare Integer 'WriteFile' In WIN32API As fb2p_WriteFile Integer hFile, String @ cBuffer, Integer nBytes, Integer @ nBytes2, Integer @ nBytes3 +*-- Funciones para changeFileTime + Declare Integer 'SetFileTime' In WIN32API As fb2p_SetFileTime Integer hFile, String lpCreationTime, String lpLastAccessTime, String lpLastWriteTime + Declare Integer 'GetFileAttributesEx' In Win32API As fb2p_GetFileAttributesEx String lpFileName, Integer fInfoLevelId, String @ lpFileInformation + Declare Integer 'LocalFileTimeToFileTime' In Win32API As fb2p_LocalFileTimeToFileTime String LOCALFILETIME, String @ FILETIME + Declare Integer 'FileTimeToSystemTime' In Win32API As fb2p_FileTimeToSystemTime String FILETIME, String @ SYSTEMTIME + Declare Integer 'SystemTimeToFileTime' In Win32API As fb2p_SystemTimeToFileTime String lpSYSTEMTIME, String @ FILETIME + Declare Integer '_lopen' In Win32API As fb2p_lopen String lpFileName, Integer iReadWrite + Declare Integer '_lclose' In Win32API As fb2p_lclose Integer hFile +*-- Funciones para changeFileAttributes + Declare SHORT 'SetFileAttributes' In Win32API As fb2p_SetFileAttributes String tcFileName, Integer dwFileAttributes + Declare Integer 'GetFileAttributes' In Win32API As fb2p_GetFileAttributes String tcFileName +*-- + Endproc - PROCEDURE get_AbsolutePath - LPARAMETERS tc_InputFile, tc_FullPath + Procedure get_AbsolutePath + Lparameters tc_InputFile, tc_FullPath - *-- Ajusto la ruta si no es absoluta - tc_InputFile = EVL(tc_InputFile,'') - tc_FullPath = EVL(tc_FullPath, THIS.c_Foxbin2prg_FullPath) +*-- Ajusto la ruta si no es absoluta + tc_InputFile = Evl(tc_InputFile,'') + tc_FullPath = Evl(tc_FullPath, This.c_Foxbin2prg_FullPath) - IF NOT EMPTY( JUSTEXT(tc_FullPath) ) THEN - *-- Se indicó PATH+archivo.ext - tc_FullPath = JUSTPATH(tc_FullPath) - ENDIF + If Not Empty( Justext(tc_FullPath) ) Then +*-- Se indicó PATH+archivo.ext + tc_FullPath = Justpath(tc_FullPath) + Endif - tc_FullPath = ADDBS( tc_FullPath ) + tc_FullPath = Addbs( tc_FullPath ) - IF LEN(tc_InputFile) > 1 ; - AND LEFT(LTRIM(tc_InputFile),2) <> '\\' ; - AND SUBSTR(LTRIM(tc_InputFile),2,1) <> ':' THEN - tc_InputFile = FULLPATH(tc_InputFile, tc_FullPath) - ENDIF + If Len(tc_InputFile) > 1 ; + AND Left(Ltrim(tc_InputFile),2) <> '\\' ; + AND Substr(Ltrim(tc_InputFile),2,1) <> ':' Then + tc_InputFile = Fullpath(tc_InputFile, tc_FullPath) + Endif - RETURN tc_InputFile - ENDPROC + Return tc_InputFile + Endproc - FUNCTION get_l_ConfigEvaluated - RETURN THIS.l_Main_CFG_Loaded - ENDFUNC + Function get_l_ConfigEvaluated + Return This.l_Main_CFG_Loaded + Endfunc - FUNCTION get_l_CFG_CachedAccess - RETURN THIS.l_CFG_CachedAccess - ENDFUNC + Function get_l_CFG_CachedAccess + Return This.l_CFG_CachedAccess + Endfunc - FUNCTION get_Processed - *--------------------------------------------------------------------------------------------------- - * PARÁMETROS: (v=Pasar por valor | @=Pasar por referencia) (!=Obligatorio | ?=Opcional) (IN/OUT) - * taProcessed (@! OUT) Array donde se devolverá la información de los archivos de la máscara indicada - * tcFileMask (v? IN ) Máscara de archivo a buscar (nombre, "*", "?") - *--------------------------------------------------------------------------------------------------- - * ESTRUCTURA DEL ARRAY DEVUELTO: - * col(1) tcFile - Path del archivo (ej: 'C:\DESA\pruebas varias\lib.vcx') - * col(2) tcInOutType - Archivo de entrada o de salida ("I"=Input file, "O"=Output file) - * col(3) tcProcessed - Procesado ("P0"=Not Processed, "P1"=Processed) - * col(4) tcHasErrors - Tuvo Errores ("E0"=No Errors, "E1"=Has Errors) - * col(5) tcSupported - Archivo soportado ("S0"=Unsupported, "S1"=Supported) - * col(6) tcExpanded - Tipo de archivo ("X0"=Normal file, "X1"=Expanded multipart file) - *--------------------------------------------------------------------------------------------------- - LPARAMETERS taProcessed, tcFileMask + Function get_Processed +*--------------------------------------------------------------------------------------------------- +* PARÁMETROS: (v=Pasar por valor | @=Pasar por referencia) (!=Obligatorio | ?=Opcional) (IN/OUT) +* taProcessed (@! OUT) Array donde se devolverá la información de los archivos de la máscara indicada +* tcFileMask (v? IN ) Máscara de archivo a buscar (nombre, "*", "?") +*--------------------------------------------------------------------------------------------------- +* ESTRUCTURA DEL ARRAY DEVUELTO: +* col(1) tcFile - Path del archivo (ej: 'C:\DESA\pruebas varias\lib.vcx') +* col(2) tcInOutType - Archivo de entrada o de salida ("I"=Input file, "O"=Output file) +* col(3) tcProcessed - Procesado ("P0"=Not Processed, "P1"=Processed) +* col(4) tcHasErrors - Tuvo Errores ("E0"=No Errors, "E1"=Has Errors) +* col(5) tcSupported - Archivo soportado ("S0"=Unsupported, "S1"=Supported) +* col(6) tcExpanded - Tipo de archivo ("X0"=Normal file, "X1"=Expanded multipart file) +*--------------------------------------------------------------------------------------------------- + Lparameters taProcessed, tcFileMask - EXTERNAL ARRAY taProcessed + External Array taProcessed - LOCAL lnCount, I + Local lnCount, I lnCount = 0 - WITH THIS AS c_foxbin2prg OF 'FOXBIN2PRG.PRG' - tcFileMask = EVL(tcFileMask, '*') + With This As c_foxbin2prg Of 'FOXBIN2PRG.PRG' + tcFileMask = Evl(tcFileMask, '*') - FOR I = 1 TO .n_ProcessedFiles - IF LIKE( tcFileMask, JUSTFNAME(.a_ProcessedFiles(m.I,1)) ) THEN + For I = 1 To .n_ProcessedFiles + If Like( tcFileMask, Justfname(.a_ProcessedFiles(m.I,1)) ) Then lnCount = lnCount + 1 - DIMENSION taProcessed(lnCount,6) + Dimension taProcessed(lnCount,6) taProcessed(lnCount,1) = .a_ProcessedFiles(m.I,1) taProcessed(lnCount,2) = .a_ProcessedFiles(m.I,2) taProcessed(lnCount,3) = .a_ProcessedFiles(m.I,3) taProcessed(lnCount,4) = .a_ProcessedFiles(m.I,4) taProcessed(lnCount,5) = .a_ProcessedFiles(m.I,5) taProcessed(lnCount,6) = .a_ProcessedFiles(m.I,6) - ENDIF - ENDFOR - ENDWITH - - RETURN lnCount - ENDFUNC - - - PROCEDURE n_Debug_ACCESS - IF THIS.n_CFG_Actual = 0 OR ISNULL( THIS.o_Configuration( THIS.n_CFG_Actual ) ) - RETURN THIS.n_Debug - ELSE - RETURN NVL( THIS.o_Configuration( THIS.n_CFG_Actual ).n_Debug, THIS.n_Debug ) - ENDIF - ENDPROC - - - PROCEDURE n_BodyDevInfo_ACCESS - IF THIS.n_CFG_Actual = 0 OR ISNULL( THIS.o_Configuration( THIS.n_CFG_Actual ) ) - RETURN THIS.n_BodyDevInfo - ELSE - RETURN NVL( THIS.o_Configuration( THIS.n_CFG_Actual ).n_BodyDevInfo, THIS.n_BodyDevInfo ) - ENDIF - ENDPROC - - - PROCEDURE l_ShowErrors_ACCESS - IF THIS.n_CFG_Actual = 0 OR ISNULL( THIS.o_Configuration( THIS.n_CFG_Actual ) ) - RETURN THIS.l_ShowErrors - ELSE - RETURN NVL( THIS.o_Configuration( THIS.n_CFG_Actual ).l_ShowErrors, THIS.l_ShowErrors ) - ENDIF - ENDPROC - - - PROCEDURE n_ShowProgressbar_ACCESS - IF THIS.n_CFG_Actual = 0 OR ISNULL( THIS.o_Configuration( THIS.n_CFG_Actual ) ) - RETURN THIS.n_ShowProgressbar - ELSE - RETURN NVL( THIS.o_Configuration( THIS.n_CFG_Actual ).n_ShowProgressbar, THIS.n_ShowProgressbar ) - ENDIF - ENDPROC - - - PROCEDURE l_NoTimestamps_ACCESS - IF THIS.n_CFG_Actual = 0 OR ISNULL( THIS.o_Configuration( THIS.n_CFG_Actual ) ) - RETURN THIS.l_NoTimestamps - ELSE - RETURN NVL( THIS.o_Configuration( THIS.n_CFG_Actual ).l_NoTimestamps, THIS.l_NoTimestamps ) - ENDIF - ENDPROC - - - PROCEDURE n_UseClassPerFile_ACCESS - IF THIS.n_CFG_Actual = 0 OR ISNULL( THIS.o_Configuration( THIS.n_CFG_Actual ) ) - RETURN THIS.n_UseClassPerFile - ELSE - RETURN NVL( THIS.o_Configuration( THIS.n_CFG_Actual ).n_UseClassPerFile, THIS.n_UseClassPerFile ) - ENDIF - ENDPROC - - - PROCEDURE l_RedirectClassPerFileToMain_ACCESS - IF THIS.n_CFG_Actual = 0 OR ISNULL( THIS.o_Configuration( THIS.n_CFG_Actual ) ) - RETURN THIS.l_RedirectClassPerFileToMain - ELSE - RETURN NVL( THIS.o_Configuration( THIS.n_CFG_Actual ).l_RedirectClassPerFileToMain, THIS.l_RedirectClassPerFileToMain ) - ENDIF - ENDPROC - - - PROCEDURE n_RedirectClassType_ACCESS - IF THIS.n_CFG_Actual = 0 OR ISNULL( THIS.o_Configuration( THIS.n_CFG_Actual ) ) - RETURN THIS.n_RedirectClassType - ELSE - RETURN NVL( THIS.o_Configuration( THIS.n_CFG_Actual ).n_RedirectClassType, THIS.n_RedirectClassType ) - ENDIF - ENDPROC - - - PROCEDURE l_RemoveNullCharsFromCode_ACCESS - IF THIS.n_CFG_Actual = 0 OR ISNULL( THIS.o_Configuration( THIS.n_CFG_Actual ) ) - RETURN THIS.l_RemoveNullCharsFromCode - ELSE - RETURN NVL( THIS.o_Configuration( THIS.n_CFG_Actual ).l_RemoveNullCharsFromCode, THIS.l_RemoveNullCharsFromCode ) - ENDIF - ENDPROC - - - PROCEDURE l_RemoveZOrderSetFromProps_ACCESS - IF THIS.n_CFG_Actual = 0 OR ISNULL( THIS.o_Configuration( THIS.n_CFG_Actual ) ) - RETURN THIS.l_RemoveZOrderSetFromProps - ELSE - RETURN NVL( THIS.o_Configuration( THIS.n_CFG_Actual ).l_RemoveZOrderSetFromProps, THIS.l_RemoveZOrderSetFromProps ) - ENDIF - ENDPROC - - - PROCEDURE l_ClassPerFileCheck_ACCESS - IF THIS.n_CFG_Actual = 0 OR ISNULL( THIS.o_Configuration( THIS.n_CFG_Actual ) ) - RETURN THIS.l_ClassPerFileCheck - ELSE - RETURN NVL( THIS.o_Configuration( THIS.n_CFG_Actual ).l_ClassPerFileCheck, THIS.l_ClassPerFileCheck ) - ENDIF - ENDPROC - - - PROCEDURE l_ClearUniqueID_ACCESS - IF THIS.n_CFG_Actual = 0 OR ISNULL( THIS.o_Configuration( THIS.n_CFG_Actual ) ) - RETURN THIS.l_ClearUniqueID - ELSE - RETURN NVL( THIS.o_Configuration( THIS.n_CFG_Actual ).l_ClearUniqueID, THIS.l_ClearUniqueID ) - ENDIF - ENDPROC - - - PROCEDURE l_ClearDBFLastUpdate_ACCESS - IF THIS.n_CFG_Actual = 0 OR ISNULL( THIS.o_Configuration( THIS.n_CFG_Actual ) ) - RETURN THIS.l_ClearDBFLastUpdate - ELSE - RETURN NVL( THIS.o_Configuration( THIS.n_CFG_Actual ).l_ClearDBFLastUpdate, THIS.l_ClearDBFLastUpdate ) - ENDIF - ENDPROC - - - PROCEDURE n_OptimizeByFilestamp_ACCESS - IF THIS.n_CFG_Actual = 0 OR ISNULL( THIS.o_Configuration( THIS.n_CFG_Actual ) ) - RETURN THIS.n_OptimizeByFilestamp - ELSE - RETURN NVL( THIS.o_Configuration( THIS.n_CFG_Actual ).n_OptimizeByFilestamp, THIS.n_OptimizeByFilestamp ) - ENDIF - ENDPROC - - - PROCEDURE n_ExtraBackupLevels_ACCESS - IF THIS.n_CFG_Actual = 0 OR ISNULL( THIS.o_Configuration( THIS.n_CFG_Actual ) ) - RETURN THIS.n_ExtraBackupLevels - ELSE - RETURN NVL( THIS.o_Configuration( THIS.n_CFG_Actual ).n_ExtraBackupLevels, THIS.n_ExtraBackupLevels ) - ENDIF - ENDPROC - - - PROCEDURE c_VC2_ACCESS - IF THIS.n_CFG_Actual = 0 OR ISNULL( THIS.o_Configuration( THIS.n_CFG_Actual ) ) - RETURN THIS.c_VC2 - ELSE - RETURN NVL( THIS.o_Configuration( THIS.n_CFG_Actual ).c_VC2, THIS.c_VC2 ) - ENDIF - ENDPROC - - - PROCEDURE c_SC2_ACCESS - IF THIS.n_CFG_Actual = 0 OR ISNULL( THIS.o_Configuration( THIS.n_CFG_Actual ) ) - RETURN THIS.c_SC2 - ELSE - RETURN NVL( THIS.o_Configuration( THIS.n_CFG_Actual ).c_SC2, THIS.c_SC2 ) - ENDIF - ENDPROC - - - PROCEDURE c_PJ2_ACCESS - IF THIS.n_CFG_Actual = 0 OR ISNULL( THIS.o_Configuration( THIS.n_CFG_Actual ) ) - RETURN THIS.c_PJ2 - ELSE - RETURN NVL( THIS.o_Configuration( THIS.n_CFG_Actual ).c_PJ2, THIS.c_PJ2 ) - ENDIF - ENDPROC - - - PROCEDURE c_FR2_ACCESS - IF THIS.n_CFG_Actual = 0 OR ISNULL( THIS.o_Configuration( THIS.n_CFG_Actual ) ) - RETURN THIS.c_FR2 - ELSE - RETURN NVL( THIS.o_Configuration( THIS.n_CFG_Actual ).c_FR2, THIS.c_FR2 ) - ENDIF - ENDPROC - - - PROCEDURE c_LB2_ACCESS - IF THIS.n_CFG_Actual = 0 OR ISNULL( THIS.o_Configuration( THIS.n_CFG_Actual ) ) - RETURN THIS.c_LB2 - ELSE - RETURN NVL( THIS.o_Configuration( THIS.n_CFG_Actual ).c_LB2, THIS.c_LB2 ) - ENDIF - ENDPROC - - - PROCEDURE c_DB2_ACCESS - IF THIS.n_CFG_Actual = 0 OR ISNULL( THIS.o_Configuration( THIS.n_CFG_Actual ) ) - RETURN THIS.c_DB2 - ELSE - RETURN NVL( THIS.o_Configuration( THIS.n_CFG_Actual ).c_DB2, THIS.c_DB2 ) - ENDIF - ENDPROC - - - PROCEDURE c_DC2_ACCESS - IF THIS.n_CFG_Actual = 0 OR ISNULL( THIS.o_Configuration( THIS.n_CFG_Actual ) ) - RETURN THIS.c_DC2 - ELSE - RETURN NVL( THIS.o_Configuration( THIS.n_CFG_Actual ).c_DC2, THIS.c_DC2 ) - ENDIF - ENDPROC - - - PROCEDURE c_MN2_ACCESS - IF THIS.n_CFG_Actual = 0 OR ISNULL( THIS.o_Configuration( THIS.n_CFG_Actual ) ) - RETURN THIS.c_MN2 - ELSE - RETURN NVL( THIS.o_Configuration( THIS.n_CFG_Actual ).c_MN2, THIS.c_MN2 ) - ENDIF - ENDPROC - - - PROCEDURE c_FK2_ACCESS - IF THIS.n_CFG_Actual = 0 OR ISNULL( THIS.o_Configuration( THIS.n_CFG_Actual ) ) - RETURN THIS.c_FK2 - ELSE - RETURN NVL( THIS.o_Configuration( THIS.n_CFG_Actual ).c_FK2, THIS.c_FK2 ) - ENDIF - ENDPROC - - - PROCEDURE c_ME2_ACCESS - IF THIS.n_CFG_Actual = 0 OR ISNULL( THIS.o_Configuration( THIS.n_CFG_Actual ) ) - RETURN THIS.c_ME2 - ELSE - RETURN NVL( THIS.o_Configuration( THIS.n_CFG_Actual ).c_ME2, THIS.c_ME2 ) - ENDIF - ENDPROC - - - PROCEDURE PJX_Conversion_Support_ACCESS - IF THIS.n_CFG_Actual = 0 OR ISNULL( THIS.o_Configuration( THIS.n_CFG_Actual ) ) - RETURN THIS.PJX_Conversion_Support - ELSE - RETURN NVL( THIS.o_Configuration( THIS.n_CFG_Actual ).PJX_Conversion_Support, THIS.PJX_Conversion_Support ) - ENDIF - ENDPROC - - - PROCEDURE VCX_Conversion_Support_ACCESS - IF THIS.n_CFG_Actual = 0 OR ISNULL( THIS.o_Configuration( THIS.n_CFG_Actual ) ) - RETURN THIS.VCX_Conversion_Support - ELSE - RETURN NVL( THIS.o_Configuration( THIS.n_CFG_Actual ).VCX_Conversion_Support, THIS.VCX_Conversion_Support ) - ENDIF - ENDPROC - - - PROCEDURE SCX_Conversion_Support_ACCESS - IF THIS.n_CFG_Actual = 0 OR ISNULL( THIS.o_Configuration( THIS.n_CFG_Actual ) ) - RETURN THIS.SCX_Conversion_Support - ELSE - RETURN NVL( THIS.o_Configuration( THIS.n_CFG_Actual ).SCX_Conversion_Support, THIS.SCX_Conversion_Support ) - ENDIF - ENDPROC - - - PROCEDURE FRX_Conversion_Support_ACCESS - IF THIS.n_CFG_Actual = 0 OR ISNULL( THIS.o_Configuration( THIS.n_CFG_Actual ) ) - RETURN THIS.FRX_Conversion_Support - ELSE - RETURN NVL( THIS.o_Configuration( THIS.n_CFG_Actual ).FRX_Conversion_Support, THIS.FRX_Conversion_Support ) - ENDIF - ENDPROC - - - PROCEDURE LBX_Conversion_Support_ACCESS - IF THIS.n_CFG_Actual = 0 OR ISNULL( THIS.o_Configuration( THIS.n_CFG_Actual ) ) - RETURN THIS.LBX_Conversion_Support - ELSE - RETURN NVL( THIS.o_Configuration( THIS.n_CFG_Actual ).LBX_Conversion_Support, THIS.LBX_Conversion_Support ) - ENDIF - ENDPROC - - - PROCEDURE MNX_Conversion_Support_ACCESS - IF THIS.n_CFG_Actual = 0 OR ISNULL( THIS.o_Configuration( THIS.n_CFG_Actual ) ) - RETURN THIS.MNX_Conversion_Support - ELSE - RETURN NVL( THIS.o_Configuration( THIS.n_CFG_Actual ).MNX_Conversion_Support, THIS.MNX_Conversion_Support ) - ENDIF - ENDPROC - - - PROCEDURE FKY_Conversion_Support_ACCESS - IF THIS.n_CFG_Actual = 0 OR ISNULL( THIS.o_Configuration( THIS.n_CFG_Actual ) ) - RETURN THIS.FKY_Conversion_Support - ELSE - RETURN NVL( THIS.o_Configuration( THIS.n_CFG_Actual ).FKY_Conversion_Support, THIS.FKY_Conversion_Support ) - ENDIF - ENDPROC - - - PROCEDURE MEM_Conversion_Support_ACCESS - IF THIS.n_CFG_Actual = 0 OR ISNULL( THIS.o_Configuration( THIS.n_CFG_Actual ) ) - RETURN THIS.MEM_Conversion_Support - ELSE - RETURN NVL( THIS.o_Configuration( THIS.n_CFG_Actual ).MEM_Conversion_Support, THIS.MEM_Conversion_Support ) - ENDIF - ENDPROC - - - PROCEDURE DBF_Conversion_Support_ACCESS - IF THIS.n_CFG_Actual = 0 OR ISNULL( THIS.o_Configuration( THIS.n_CFG_Actual ) ) - RETURN THIS.DBF_Conversion_Support - ELSE - RETURN NVL( THIS.o_Configuration( THIS.n_CFG_Actual ).DBF_Conversion_Support, THIS.DBF_Conversion_Support ) - ENDIF - ENDPROC - - - PROCEDURE DBF_Conversion_Included_ACCESS - IF THIS.n_CFG_Actual = 0 OR ISNULL( THIS.o_Configuration( THIS.n_CFG_Actual ) ) - RETURN THIS.DBF_Conversion_Included - ELSE - RETURN NVL( THIS.o_Configuration( THIS.n_CFG_Actual ).DBF_Conversion_Included, THIS.DBF_Conversion_Included ) - ENDIF - ENDPROC - - - PROCEDURE DBF_Conversion_Excluded_ACCESS - IF THIS.n_CFG_Actual = 0 OR ISNULL( THIS.o_Configuration( THIS.n_CFG_Actual ) ) - RETURN THIS.DBF_Conversion_Excluded - ELSE - RETURN NVL( THIS.o_Configuration( THIS.n_CFG_Actual ).DBF_Conversion_Excluded, THIS.DBF_Conversion_Excluded ) - ENDIF - ENDPROC - - - PROCEDURE DBC_Conversion_Support_ACCESS - IF THIS.n_CFG_Actual = 0 OR ISNULL( THIS.o_Configuration( THIS.n_CFG_Actual ) ) - RETURN THIS.DBC_Conversion_Support - ELSE - RETURN NVL( THIS.o_Configuration( THIS.n_CFG_Actual ).DBC_Conversion_Support, THIS.DBC_Conversion_Support ) - ENDIF - ENDPROC - - - PROCEDURE c_BackgroundImage_ACCESS - IF THIS.n_CFG_Actual = 0 OR ISNULL( THIS.o_Configuration( THIS.n_CFG_Actual ) ) - RETURN THIS.c_BackgroundImage - ELSE - RETURN NVL( THIS.o_Configuration( THIS.n_CFG_Actual ).c_BackgroundImage, THIS.c_BackgroundImage ) - ENDIF - ENDPROC - - - PROCEDURE n_ExcludeDBFAutoincNextval_ACCESS - IF THIS.n_CFG_Actual = 0 OR ISNULL( THIS.o_Configuration( THIS.n_CFG_Actual ) ) - RETURN THIS.n_ExcludeDBFAutoincNextval - ELSE - RETURN NVL( THIS.o_Configuration( THIS.n_CFG_Actual ).n_ExcludeDBFAutoincNextval, THIS.n_ExcludeDBFAutoincNextval ) - ENDIF - 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 - * Changing file attributes - LPARAMETERS tcFileName, tcAttrib - tcAttrib = UPPER(tcAttrib) - - #DEFINE FILE_ATTRIBUTE_READONLY 1 - #DEFINE FILE_ATTRIBUTE_HIDDEN 2 - #DEFINE FILE_ATTRIBUTE_SYSTEM 4 - #DEFINE FILE_ATTRIBUTE_DIRECTORY 16 - #DEFINE FILE_ATTRIBUTE_ARCHIVE 32 - #DEFINE FILE_ATTRIBUTE_NORMAL 128 - #DEFINE FILE_ATTRIBUTE_TEMPORARY 512 - #DEFINE FILE_ATTRIBUTE_COMPRESSED 2048 - - TRY - LOCAL loEx AS EXCEPTION, dwFileAttributes, dwFileAttributes_Orig, lnRet - lnRet = 0 - - * read current attributes for this file - dwFileAttributes = fb2p_GetFileAttributes(tcFileName) - dwFileAttributes_Orig = dwFileAttributes - - IF dwFileAttributes = -1 - * the file does not exist - EXIT - ENDIF - - IF dwFileAttributes > 0 - IF '+R' $ tcAttrib - dwFileAttributes = BITOR(dwFileAttributes, FILE_ATTRIBUTE_READONLY) - ENDIF - IF '+A' $ tcAttrib - dwFileAttributes = BITOR(dwFileAttributes, FILE_ATTRIBUTE_ARCHIVE) - ENDIF - IF '+S' $ tcAttrib - dwFileAttributes = BITOR(dwFileAttributes, FILE_ATTRIBUTE_SYSTEM) - ENDIF - IF '+H' $ tcAttrib - dwFileAttributes = BITOR(dwFileAttributes, FILE_ATTRIBUTE_HIDDEN) - ENDIF - IF '+D' $ tcAttrib - dwFileAttributes = BITOR(dwFileAttributes, FILE_ATTRIBUTE_DIRECTORY) - ENDIF - IF '+N' $ tcAttrib - dwFileAttributes = BITOR(dwFileAttributes, FILE_ATTRIBUTE_NORMAL) - ENDIF - IF '+T' $ tcAttrib - dwFileAttributes = BITOR(dwFileAttributes, FILE_ATTRIBUTE_TEMPORARY) - ENDIF - IF '+C' $ tcAttrib - dwFileAttributes = BITOR(dwFileAttributes, FILE_ATTRIBUTE_COMPRESSED) - ENDIF - - IF '-R' $ tcAttrib AND BITAND(dwFileAttributes, FILE_ATTRIBUTE_READONLY) = FILE_ATTRIBUTE_READONLY - dwFileAttributes = dwFileAttributes - FILE_ATTRIBUTE_READONLY - ENDIF - IF '-A' $ tcAttrib AND BITAND(dwFileAttributes, FILE_ATTRIBUTE_ARCHIVE) = FILE_ATTRIBUTE_ARCHIVE - dwFileAttributes = dwFileAttributes - FILE_ATTRIBUTE_ARCHIVE - ENDIF - IF '-S' $ tcAttrib AND BITAND(dwFileAttributes, FILE_ATTRIBUTE_SYSTEM) = FILE_ATTRIBUTE_SYSTEM - dwFileAttributes = dwFileAttributes - FILE_ATTRIBUTE_SYSTEM - ENDIF - IF '-H' $ tcAttrib AND BITAND(dwFileAttributes, FILE_ATTRIBUTE_HIDDEN) = FILE_ATTRIBUTE_HIDDEN - dwFileAttributes = dwFileAttributes - FILE_ATTRIBUTE_HIDDEN - ENDIF - IF '-D' $ tcAttrib AND BITAND(dwFileAttributes, FILE_ATTRIBUTE_DIRECTORY) = FILE_ATTRIBUTE_DIRECTORY - dwFileAttributes = dwFileAttributes - FILE_ATTRIBUTE_DIRECTORY - ENDIF - IF '-N' $ tcAttrib AND BITAND(dwFileAttributes, FILE_ATTRIBUTE_NORMAL) = FILE_ATTRIBUTE_NORMAL - dwFileAttributes = dwFileAttributes - FILE_ATTRIBUTE_NORMAL - ENDIF - IF '-T' $ tcAttrib AND BITAND(dwFileAttributes, FILE_ATTRIBUTE_TEMPORARY) = FILE_ATTRIBUTE_TEMPORARY - dwFileAttributes = dwFileAttributes - FILE_ATTRIBUTE_TEMPORARY - ENDIF - IF '-C' $ tcAttrib AND BITAND(dwFileAttributes, FILE_ATTRIBUTE_COMPRESSED) = FILE_ATTRIBUTE_COMPRESSED - dwFileAttributes = dwFileAttributes - FILE_ATTRIBUTE_COMPRESSED - ENDIF - - * setting selected attributes - lnRet = fb2p_SetFileAttributes(tcFileName, dwFileAttributes) - ENDIF - - CATCH TO loEx - THROW - - FINALLY - THIS.writeLog( C_TAB + LOWER(PROGRAM()) + ' >> [' + tcFileName + '] lnRet = ' + TRANSFORM(lnRet) + ', dwFileAttributes_Orig = ' + TRANSFORM(dwFileAttributes_Orig) ) - RELEASE tcFileName, tcAttrib, dwFileAttributes - ENDTRY - - RETURN lnRet - ENDPROC - - - PROCEDURE changeFileTime - *--------------------------------------------------------------------------------------------------- - * CAMBIAR LA FECHA/HORA DE UN ARCHIVO - *--------------------------------------------------------------------------------------------------- - * PARÁMETROS: (v=Pasar por valor | @=Pasar por referencia) (!=Obligatorio | ?=Opcional) (IN/OUT) - * tcFileName (v! IN ) Nombre del archivo - * tcTimeType (v? IN ) C=Creation time, W=Last Write, A=Last Access - * tnYear (v? IN ) Año (>=1800) - * tnMonth (v? IN ) Mes (1-12) - * tnDay (v? IN ) Día (1-31) - * tnHour (v? IN ) Hora (0-23) - * tnMinute (v? IN ) Minuto (0-59) - * tnSec (v? IN ) Segundo (0-59) - * tnThou (v? IN ) ¿? (0-999) - *--------------------------------------------------------------------------------------------------- - LPARAMETERS m.tcFileName, m.tcTimeType, m.tnYear, m.tnMonth, m.tnDay, m.tnHour, m.tnMinute, m.tnSec, m.tnThou - - #DEFINE OF_READWRITE 2 - - LOCAL m.lpFileInformation, m.cS, m.nPar, m.fh, M.lpFileInformation, m.lpSysTime, m.cCreation ; + Endif + Endfor + Endwith + + Return lnCount + Endfunc + + + Procedure n_Debug_ACCESS + If This.n_CFG_Actual = 0 Or Isnull( This.o_Configuration( This.n_CFG_Actual ) ) + Return This.n_Debug + Else + Return Nvl( This.o_Configuration( This.n_CFG_Actual ).n_Debug, This.n_Debug ) + Endif + Endproc + + + Procedure n_BodyDevInfo_ACCESS + If This.n_CFG_Actual = 0 Or Isnull( This.o_Configuration( This.n_CFG_Actual ) ) + Return This.n_BodyDevInfo + Else + Return Nvl( This.o_Configuration( This.n_CFG_Actual ).n_BodyDevInfo, This.n_BodyDevInfo ) + Endif + Endproc + + + Procedure l_ShowErrors_ACCESS + If This.n_CFG_Actual = 0 Or Isnull( This.o_Configuration( This.n_CFG_Actual ) ) + Return This.l_ShowErrors + Else + Return Nvl( This.o_Configuration( This.n_CFG_Actual ).l_ShowErrors, This.l_ShowErrors ) + Endif + Endproc + + + Procedure n_ShowProgressbar_ACCESS + If This.n_CFG_Actual = 0 Or Isnull( This.o_Configuration( This.n_CFG_Actual ) ) + Return This.n_ShowProgressbar + Else + Return Nvl( This.o_Configuration( This.n_CFG_Actual ).n_ShowProgressbar, This.n_ShowProgressbar ) + Endif + Endproc + + + Procedure l_NoTimestamps_ACCESS + If This.n_CFG_Actual = 0 Or Isnull( This.o_Configuration( This.n_CFG_Actual ) ) + Return This.l_NoTimestamps + Else + Return Nvl( This.o_Configuration( This.n_CFG_Actual ).l_NoTimestamps, This.l_NoTimestamps ) + Endif + Endproc + + + Procedure n_UseClassPerFile_ACCESS + If This.n_CFG_Actual = 0 Or Isnull( This.o_Configuration( This.n_CFG_Actual ) ) + Return This.n_UseClassPerFile + Else + Return Nvl( This.o_Configuration( This.n_CFG_Actual ).n_UseClassPerFile, This.n_UseClassPerFile ) + Endif + Endproc + + + Procedure l_RedirectClassPerFileToMain_ACCESS + If This.n_CFG_Actual = 0 Or Isnull( This.o_Configuration( This.n_CFG_Actual ) ) + Return This.l_RedirectClassPerFileToMain + Else + Return Nvl( This.o_Configuration( This.n_CFG_Actual ).l_RedirectClassPerFileToMain, This.l_RedirectClassPerFileToMain ) + Endif + Endproc + + + Procedure n_RedirectClassType_ACCESS + If This.n_CFG_Actual = 0 Or Isnull( This.o_Configuration( This.n_CFG_Actual ) ) + Return This.n_RedirectClassType + Else + Return Nvl( This.o_Configuration( This.n_CFG_Actual ).n_RedirectClassType, This.n_RedirectClassType ) + Endif + Endproc + + + Procedure l_RemoveNullCharsFromCode_ACCESS + If This.n_CFG_Actual = 0 Or Isnull( This.o_Configuration( This.n_CFG_Actual ) ) + Return This.l_RemoveNullCharsFromCode + Else + Return Nvl( This.o_Configuration( This.n_CFG_Actual ).l_RemoveNullCharsFromCode, This.l_RemoveNullCharsFromCode ) + Endif + Endproc + + + Procedure l_RemoveZOrderSetFromProps_ACCESS + If This.n_CFG_Actual = 0 Or Isnull( This.o_Configuration( This.n_CFG_Actual ) ) + Return This.l_RemoveZOrderSetFromProps + Else + Return Nvl( This.o_Configuration( This.n_CFG_Actual ).l_RemoveZOrderSetFromProps, This.l_RemoveZOrderSetFromProps ) + Endif + Endproc + + + Procedure l_ClassPerFileCheck_ACCESS + If This.n_CFG_Actual = 0 Or Isnull( This.o_Configuration( This.n_CFG_Actual ) ) + Return This.l_ClassPerFileCheck + Else + Return Nvl( This.o_Configuration( This.n_CFG_Actual ).l_ClassPerFileCheck, This.l_ClassPerFileCheck ) + Endif + Endproc + + + Procedure l_ClearUniqueID_ACCESS + If This.n_CFG_Actual = 0 Or Isnull( This.o_Configuration( This.n_CFG_Actual ) ) + Return This.l_ClearUniqueID + Else + Return Nvl( This.o_Configuration( This.n_CFG_Actual ).l_ClearUniqueID, This.l_ClearUniqueID ) + Endif + Endproc + + + Procedure l_ClearDBFLastUpdate_ACCESS + If This.n_CFG_Actual = 0 Or Isnull( This.o_Configuration( This.n_CFG_Actual ) ) + Return This.l_ClearDBFLastUpdate + Else + Return Nvl( This.o_Configuration( This.n_CFG_Actual ).l_ClearDBFLastUpdate, This.l_ClearDBFLastUpdate ) + Endif + Endproc + + + Procedure n_OptimizeByFilestamp_ACCESS + If This.n_CFG_Actual = 0 Or Isnull( This.o_Configuration( This.n_CFG_Actual ) ) + Return This.n_OptimizeByFilestamp + Else + Return Nvl( This.o_Configuration( This.n_CFG_Actual ).n_OptimizeByFilestamp, This.n_OptimizeByFilestamp ) + Endif + Endproc + + + Procedure n_ExtraBackupLevels_ACCESS + If This.n_CFG_Actual = 0 Or Isnull( This.o_Configuration( This.n_CFG_Actual ) ) + Return This.n_ExtraBackupLevels + Else + Return Nvl( This.o_Configuration( This.n_CFG_Actual ).n_ExtraBackupLevels, This.n_ExtraBackupLevels ) + Endif + Endproc + + + Procedure c_VC2_ACCESS + If This.n_CFG_Actual = 0 Or Isnull( This.o_Configuration( This.n_CFG_Actual ) ) + Return This.c_VC2 + Else + Return Nvl( This.o_Configuration( This.n_CFG_Actual ).c_VC2, This.c_VC2 ) + Endif + Endproc + + + Procedure c_SC2_ACCESS + If This.n_CFG_Actual = 0 Or Isnull( This.o_Configuration( This.n_CFG_Actual ) ) + Return This.c_SC2 + Else + Return Nvl( This.o_Configuration( This.n_CFG_Actual ).c_SC2, This.c_SC2 ) + Endif + Endproc + + + Procedure c_PJ2_ACCESS + If This.n_CFG_Actual = 0 Or Isnull( This.o_Configuration( This.n_CFG_Actual ) ) + Return This.c_PJ2 + Else + Return Nvl( This.o_Configuration( This.n_CFG_Actual ).c_PJ2, This.c_PJ2 ) + Endif + Endproc + + + Procedure c_FR2_ACCESS + If This.n_CFG_Actual = 0 Or Isnull( This.o_Configuration( This.n_CFG_Actual ) ) + Return This.c_FR2 + Else + Return Nvl( This.o_Configuration( This.n_CFG_Actual ).c_FR2, This.c_FR2 ) + Endif + Endproc + + + Procedure c_LB2_ACCESS + If This.n_CFG_Actual = 0 Or Isnull( This.o_Configuration( This.n_CFG_Actual ) ) + Return This.c_LB2 + Else + Return Nvl( This.o_Configuration( This.n_CFG_Actual ).c_LB2, This.c_LB2 ) + Endif + Endproc + + + Procedure c_DB2_ACCESS + If This.n_CFG_Actual = 0 Or Isnull( This.o_Configuration( This.n_CFG_Actual ) ) + Return This.c_DB2 + Else + Return Nvl( This.o_Configuration( This.n_CFG_Actual ).c_DB2, This.c_DB2 ) + Endif + Endproc + + + Procedure c_DC2_ACCESS + If This.n_CFG_Actual = 0 Or Isnull( This.o_Configuration( This.n_CFG_Actual ) ) + Return This.c_DC2 + Else + Return Nvl( This.o_Configuration( This.n_CFG_Actual ).c_DC2, This.c_DC2 ) + Endif + Endproc + + + Procedure c_MN2_ACCESS + If This.n_CFG_Actual = 0 Or Isnull( This.o_Configuration( This.n_CFG_Actual ) ) + Return This.c_MN2 + Else + Return Nvl( This.o_Configuration( This.n_CFG_Actual ).c_MN2, This.c_MN2 ) + Endif + Endproc + + + Procedure c_FK2_ACCESS + If This.n_CFG_Actual = 0 Or Isnull( This.o_Configuration( This.n_CFG_Actual ) ) + Return This.c_FK2 + Else + Return Nvl( This.o_Configuration( This.n_CFG_Actual ).c_FK2, This.c_FK2 ) + Endif + Endproc + + + Procedure c_ME2_ACCESS + If This.n_CFG_Actual = 0 Or Isnull( This.o_Configuration( This.n_CFG_Actual ) ) + Return This.c_ME2 + Else + Return Nvl( This.o_Configuration( This.n_CFG_Actual ).c_ME2, This.c_ME2 ) + Endif + Endproc + + + Procedure PJX_Conversion_Support_ACCESS + If This.n_CFG_Actual = 0 Or Isnull( This.o_Configuration( This.n_CFG_Actual ) ) + Return This.PJX_Conversion_Support + Else + Return Nvl( This.o_Configuration( This.n_CFG_Actual ).PJX_Conversion_Support, This.PJX_Conversion_Support ) + Endif + Endproc + + + Procedure VCX_Conversion_Support_ACCESS + If This.n_CFG_Actual = 0 Or Isnull( This.o_Configuration( This.n_CFG_Actual ) ) + Return This.VCX_Conversion_Support + Else + Return Nvl( This.o_Configuration( This.n_CFG_Actual ).VCX_Conversion_Support, This.VCX_Conversion_Support ) + Endif + Endproc + + + Procedure SCX_Conversion_Support_ACCESS + If This.n_CFG_Actual = 0 Or Isnull( This.o_Configuration( This.n_CFG_Actual ) ) + Return This.SCX_Conversion_Support + Else + Return Nvl( This.o_Configuration( This.n_CFG_Actual ).SCX_Conversion_Support, This.SCX_Conversion_Support ) + Endif + Endproc + + + Procedure FRX_Conversion_Support_ACCESS + If This.n_CFG_Actual = 0 Or Isnull( This.o_Configuration( This.n_CFG_Actual ) ) + Return This.FRX_Conversion_Support + Else + Return Nvl( This.o_Configuration( This.n_CFG_Actual ).FRX_Conversion_Support, This.FRX_Conversion_Support ) + Endif + Endproc + + + Procedure LBX_Conversion_Support_ACCESS + If This.n_CFG_Actual = 0 Or Isnull( This.o_Configuration( This.n_CFG_Actual ) ) + Return This.LBX_Conversion_Support + Else + Return Nvl( This.o_Configuration( This.n_CFG_Actual ).LBX_Conversion_Support, This.LBX_Conversion_Support ) + Endif + Endproc + + + Procedure MNX_Conversion_Support_ACCESS + If This.n_CFG_Actual = 0 Or Isnull( This.o_Configuration( This.n_CFG_Actual ) ) + Return This.MNX_Conversion_Support + Else + Return Nvl( This.o_Configuration( This.n_CFG_Actual ).MNX_Conversion_Support, This.MNX_Conversion_Support ) + Endif + Endproc + + + Procedure FKY_Conversion_Support_ACCESS + If This.n_CFG_Actual = 0 Or Isnull( This.o_Configuration( This.n_CFG_Actual ) ) + Return This.FKY_Conversion_Support + Else + Return Nvl( This.o_Configuration( This.n_CFG_Actual ).FKY_Conversion_Support, This.FKY_Conversion_Support ) + Endif + Endproc + + + Procedure MEM_Conversion_Support_ACCESS + If This.n_CFG_Actual = 0 Or Isnull( This.o_Configuration( This.n_CFG_Actual ) ) + Return This.MEM_Conversion_Support + Else + Return Nvl( This.o_Configuration( This.n_CFG_Actual ).MEM_Conversion_Support, This.MEM_Conversion_Support ) + Endif + Endproc + + + Procedure DBF_Conversion_Support_ACCESS + If This.n_CFG_Actual = 0 Or Isnull( This.o_Configuration( This.n_CFG_Actual ) ) + Return This.DBF_Conversion_Support + Else + Return Nvl( This.o_Configuration( This.n_CFG_Actual ).DBF_Conversion_Support, This.DBF_Conversion_Support ) + Endif + Endproc + + + Procedure DBF_Conversion_Included_ACCESS + If This.n_CFG_Actual = 0 Or Isnull( This.o_Configuration( This.n_CFG_Actual ) ) + Return This.DBF_Conversion_Included + Else + Return Nvl( This.o_Configuration( This.n_CFG_Actual ).DBF_Conversion_Included, This.DBF_Conversion_Included ) + Endif + Endproc + + + Procedure DBF_Conversion_Excluded_ACCESS + If This.n_CFG_Actual = 0 Or Isnull( This.o_Configuration( This.n_CFG_Actual ) ) + Return This.DBF_Conversion_Excluded + Else + Return Nvl( This.o_Configuration( This.n_CFG_Actual ).DBF_Conversion_Excluded, This.DBF_Conversion_Excluded ) + Endif + Endproc + + + Procedure DBC_Conversion_Support_ACCESS + If This.n_CFG_Actual = 0 Or Isnull( This.o_Configuration( This.n_CFG_Actual ) ) + Return This.DBC_Conversion_Support + Else + Return Nvl( This.o_Configuration( This.n_CFG_Actual ).DBC_Conversion_Support, This.DBC_Conversion_Support ) + Endif + Endproc + + + Procedure c_BackgroundImage_ACCESS + If This.n_CFG_Actual = 0 Or Isnull( This.o_Configuration( This.n_CFG_Actual ) ) + Return This.c_BackgroundImage + Else + Return Nvl( This.o_Configuration( This.n_CFG_Actual ).c_BackgroundImage, This.c_BackgroundImage ) + Endif + Endproc + + + Procedure n_ExcludeDBFAutoincNextval_ACCESS + If This.n_CFG_Actual = 0 Or Isnull( This.o_Configuration( This.n_CFG_Actual ) ) + Return This.n_ExcludeDBFAutoincNextval + Else + Return Nvl( This.o_Configuration( This.n_CFG_Actual ).n_ExcludeDBFAutoincNextval, This.n_ExcludeDBFAutoincNextval ) + Endif + 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 +* Changing file attributes + Lparameters tcFileName, tcAttrib + tcAttrib = Upper(tcAttrib) + + #Define FILE_ATTRIBUTE_READONLY 1 + #Define FILE_ATTRIBUTE_HIDDEN 2 + #Define FILE_ATTRIBUTE_SYSTEM 4 + #Define FILE_ATTRIBUTE_DIRECTORY 16 + #Define FILE_ATTRIBUTE_ARCHIVE 32 + #Define FILE_ATTRIBUTE_NORMAL 128 + #Define FILE_ATTRIBUTE_TEMPORARY 512 + #Define FILE_ATTRIBUTE_COMPRESSED 2048 + + Try + Local loEx As Exception, dwFileAttributes, dwFileAttributes_Orig, lnRet + lnRet = 0 + +* read current attributes for this file + dwFileAttributes = fb2p_GetFileAttributes(tcFileName) + dwFileAttributes_Orig = dwFileAttributes + + If dwFileAttributes = -1 +* the file does not exist + Exit + Endif + + If dwFileAttributes > 0 + If '+R' $ tcAttrib + dwFileAttributes = Bitor(dwFileAttributes, FILE_ATTRIBUTE_READONLY) + Endif + If '+A' $ tcAttrib + dwFileAttributes = Bitor(dwFileAttributes, FILE_ATTRIBUTE_ARCHIVE) + Endif + If '+S' $ tcAttrib + dwFileAttributes = Bitor(dwFileAttributes, FILE_ATTRIBUTE_SYSTEM) + Endif + If '+H' $ tcAttrib + dwFileAttributes = Bitor(dwFileAttributes, FILE_ATTRIBUTE_HIDDEN) + Endif + If '+D' $ tcAttrib + dwFileAttributes = Bitor(dwFileAttributes, FILE_ATTRIBUTE_DIRECTORY) + Endif + If '+N' $ tcAttrib + dwFileAttributes = Bitor(dwFileAttributes, FILE_ATTRIBUTE_NORMAL) + Endif + If '+T' $ tcAttrib + dwFileAttributes = Bitor(dwFileAttributes, FILE_ATTRIBUTE_TEMPORARY) + Endif + If '+C' $ tcAttrib + dwFileAttributes = Bitor(dwFileAttributes, FILE_ATTRIBUTE_COMPRESSED) + Endif + + If '-R' $ tcAttrib And Bitand(dwFileAttributes, FILE_ATTRIBUTE_READONLY) = FILE_ATTRIBUTE_READONLY + dwFileAttributes = dwFileAttributes - FILE_ATTRIBUTE_READONLY + Endif + If '-A' $ tcAttrib And Bitand(dwFileAttributes, FILE_ATTRIBUTE_ARCHIVE) = FILE_ATTRIBUTE_ARCHIVE + dwFileAttributes = dwFileAttributes - FILE_ATTRIBUTE_ARCHIVE + Endif + If '-S' $ tcAttrib And Bitand(dwFileAttributes, FILE_ATTRIBUTE_SYSTEM) = FILE_ATTRIBUTE_SYSTEM + dwFileAttributes = dwFileAttributes - FILE_ATTRIBUTE_SYSTEM + Endif + If '-H' $ tcAttrib And Bitand(dwFileAttributes, FILE_ATTRIBUTE_HIDDEN) = FILE_ATTRIBUTE_HIDDEN + dwFileAttributes = dwFileAttributes - FILE_ATTRIBUTE_HIDDEN + Endif + If '-D' $ tcAttrib And Bitand(dwFileAttributes, FILE_ATTRIBUTE_DIRECTORY) = FILE_ATTRIBUTE_DIRECTORY + dwFileAttributes = dwFileAttributes - FILE_ATTRIBUTE_DIRECTORY + Endif + If '-N' $ tcAttrib And Bitand(dwFileAttributes, FILE_ATTRIBUTE_NORMAL) = FILE_ATTRIBUTE_NORMAL + dwFileAttributes = dwFileAttributes - FILE_ATTRIBUTE_NORMAL + Endif + If '-T' $ tcAttrib And Bitand(dwFileAttributes, FILE_ATTRIBUTE_TEMPORARY) = FILE_ATTRIBUTE_TEMPORARY + dwFileAttributes = dwFileAttributes - FILE_ATTRIBUTE_TEMPORARY + Endif + If '-C' $ tcAttrib And Bitand(dwFileAttributes, FILE_ATTRIBUTE_COMPRESSED) = FILE_ATTRIBUTE_COMPRESSED + dwFileAttributes = dwFileAttributes - FILE_ATTRIBUTE_COMPRESSED + Endif + +* setting selected attributes + lnRet = fb2p_SetFileAttributes(tcFileName, dwFileAttributes) + Endif + + Catch To loEx + Throw + + Finally + This.writeLog( C_TAB + Lower(Program()) + ' >> [' + tcFileName + '] lnRet = ' + Transform(lnRet) + ', dwFileAttributes_Orig = ' + Transform(dwFileAttributes_Orig) ) + Release tcFileName, tcAttrib, dwFileAttributes + Endtry + + Return lnRet + Endproc + + + Procedure changeFileTime +*--------------------------------------------------------------------------------------------------- +* CAMBIAR LA FECHA/HORA DE UN ARCHIVO +*--------------------------------------------------------------------------------------------------- +* PARÁMETROS: (v=Pasar por valor | @=Pasar por referencia) (!=Obligatorio | ?=Opcional) (IN/OUT) +* tcFileName (v! IN ) Nombre del archivo +* tcTimeType (v? IN ) C=Creation time, W=Last Write, A=Last Access +* tnYear (v? IN ) Año (>=1800) +* tnMonth (v? IN ) Mes (1-12) +* tnDay (v? IN ) Día (1-31) +* tnHour (v? IN ) Hora (0-23) +* tnMinute (v? IN ) Minuto (0-59) +* tnSec (v? IN ) Segundo (0-59) +* tnThou (v? IN ) ¿? (0-999) +*--------------------------------------------------------------------------------------------------- + Lparameters m.tcFileName, m.tcTimeType, m.tnYear, m.tnMonth, m.tnDay, m.tnHour, m.tnMinute, m.tnSec, m.tnThou + + #Define OF_READWRITE 2 + + Local m.lpFileInformation, m.cS, m.nPar, m.fh, M.lpFileInformation, m.lpSysTime, m.cCreation ; , M.cLastAccess, m.cLastWrite, m.cBuffTime, m.cBuffTime1, M.cTT,m.nYear1, m.nMonth1, m.nDay1, m.nHour1 ; , M.nMinute1, m.nSec1, m.nThou1, llRetorno - TRY - m.nPar = PCOUNT() + Try + m.nPar = Pcount() - IF m.nPar < 1 - EXIT - ENDIF + If m.nPar < 1 + Exit + Endif - m.cTT = IIF( m.nPar >= 2 AND VARTYPE(m.tcTimeType) = "C" AND NOT EMPTY(m.tcTimeType), LOWER(SUBSTR(m.tcTimeType,1,1)), "c" ) - m.nYear1 = IIF( m.nPar >= 3 AND VARTYPE(m.tnYear) $ "FIN" AND m.tnYear >= 1800, ROUND(m.tnYear,0), -1 ) - m.nMonth1 = IIF( m.nPar >= 4 AND VARTYPE(m.tnMonth) $ "FIN" AND BETWEEN(m.tnMonth,1,12), ROUND(m.tnMonth,0), -1 ) - m.nDay1 = IIF( m.nPar >= 5 AND VARTYPE(m.tnDay) $ "FIN" AND BETWEEN(m.tnDay,1,31), ROUND(m.tnDay,0), -1 ) - m.nHour1 = IIF( m.nPar >= 6 AND VARTYPE(m.tnHour) $ "FIN" AND BETWEEN(m.tnHour,0,23), ROUND(m.tnHour,0), -1 ) - m.nMinute1 = IIF( m.nPar >= 7 AND VARTYPE(m.tnMinute) $ "FIN" AND BETWEEN(m.tnMinute,0,59), ROUND(m.tnMinute,0), -1 ) - m.nSec1 = IIF( m.nPar >= 8 AND VARTYPE(m.tnSec) $ "FIN" AND BETWEEN(m.tnSec,0,59), ROUND(m.tnSec,0), -1 ) - m.nThou1 = IIF( m.nPar >= 9 AND VARTYPE(m.tnThou) $ "FIN" AND BETWEEN(m.tnThou,0,999), ROUND(m.tnThou,0), -1 ) - m.lpFileInformation = REPLICATE( CHR(0), 53 ) && just a buffer - m.lpSysTime = REPLICATE( CHR(0), 16 ) && just a buffer + m.cTT = Iif( m.nPar >= 2 And Vartype(m.tcTimeType) = "C" And Not Empty(m.tcTimeType), Lower(Substr(m.tcTimeType,1,1)), "c" ) + m.nYear1 = Iif( m.nPar >= 3 And Vartype(m.tnYear) $ "FIN" And m.tnYear >= 1800, Round(m.tnYear,0), -1 ) + m.nMonth1 = Iif( m.nPar >= 4 And Vartype(m.tnMonth) $ "FIN" And Between(m.tnMonth,1,12), Round(m.tnMonth,0), -1 ) + m.nDay1 = Iif( m.nPar >= 5 And Vartype(m.tnDay) $ "FIN" And Between(m.tnDay,1,31), Round(m.tnDay,0), -1 ) + m.nHour1 = Iif( m.nPar >= 6 And Vartype(m.tnHour) $ "FIN" And Between(m.tnHour,0,23), Round(m.tnHour,0), -1 ) + m.nMinute1 = Iif( m.nPar >= 7 And Vartype(m.tnMinute) $ "FIN" And Between(m.tnMinute,0,59), Round(m.tnMinute,0), -1 ) + m.nSec1 = Iif( m.nPar >= 8 And Vartype(m.tnSec) $ "FIN" And Between(m.tnSec,0,59), Round(m.tnSec,0), -1 ) + m.nThou1 = Iif( m.nPar >= 9 And Vartype(m.tnThou) $ "FIN" And Between(m.tnThou,0,999), Round(m.tnThou,0), -1 ) + m.lpFileInformation = Replicate( Chr(0), 53 ) && just a buffer + m.lpSysTime = Replicate( Chr(0), 16 ) && just a buffer - IF fb2p_GetFileAttributesEx(m.tcFileName, 0, @lpFileInformation) = 0 - EXIT - ENDIF + If fb2p_GetFileAttributesEx(m.tcFileName, 0, @lpFileInformation) = 0 + Exit + Endif - m.cCreation = SUBSTR(m.lpFileInformation,5,8) - m.cLastAccess = SUBSTR(m.lpFileInformation,13,8) - m.cLastWrite = SUBSTR(m.lpFileInformation,21,8) - m.cBuffTime = IIF(m.cTT="w",m.cLastWrite, IIF(m.cTT="a",m.cLastAccess,m.cCreation)) + m.cCreation = Substr(m.lpFileInformation,5,8) + m.cLastAccess = Substr(m.lpFileInformation,13,8) + m.cLastWrite = Substr(m.lpFileInformation,21,8) + m.cBuffTime = Iif(m.cTT="w",m.cLastWrite, Iif(m.cTT="a",m.cLastAccess,m.cCreation)) - fb2p_FileTimeToSystemTime(m.cBuffTime, @lpSysTime) + fb2p_FileTimeToSystemTime(m.cBuffTime, @lpSysTime) - m.lpSysTime = ; - IIF( m.nYear1 >= 0, BINTOC(m.nYear1,"2RS"), SUBSTR(m.lpSysTime,1,2) ) ; - + IIF( m.nMonth1 >= 0, BINTOC(m.nMonth1,"2RS"), SUBSTR(m.lpSysTime,3,2) ) ; - + SUBSTR(m.lpSysTime,5,2) ; - + IIF( m.nDay1 >= 0, BINTOC(m.nDay1,"2RS"), SUBSTR(m.lpSysTime,7,2) ) ; - + IIF( m.nHour1 >= 0, BINTOC(m.nHour1,"2RS"), SUBSTR(m.lpSysTime,9,2) ) ; - + IIF( m.nMinute1 >= 0, BINTOC(m.nMinute1,"2RS"), SUBSTR(m.lpSysTime,11,2) ) ; - + IIF( m.nSec1 >= 0, BINTOC(m.nSec1,"2RS"), SUBSTR(m.lpSysTime,13,2) ) ; - + IIF( m.nThou1 >= 0, BINTOC(m.nThou1,"2RS"), SUBSTR(m.lpSysTime,15,2) ) + m.lpSysTime = ; + IIF( m.nYear1 >= 0, BinToC(m.nYear1,"2RS"), Substr(m.lpSysTime,1,2) ) ; + + Iif( m.nMonth1 >= 0, BinToC(m.nMonth1,"2RS"), Substr(m.lpSysTime,3,2) ) ; + + Substr(m.lpSysTime,5,2) ; + + Iif( m.nDay1 >= 0, BinToC(m.nDay1,"2RS"), Substr(m.lpSysTime,7,2) ) ; + + Iif( m.nHour1 >= 0, BinToC(m.nHour1,"2RS"), Substr(m.lpSysTime,9,2) ) ; + + Iif( m.nMinute1 >= 0, BinToC(m.nMinute1,"2RS"), Substr(m.lpSysTime,11,2) ) ; + + Iif( m.nSec1 >= 0, BinToC(m.nSec1,"2RS"), Substr(m.lpSysTime,13,2) ) ; + + Iif( m.nThou1 >= 0, BinToC(m.nThou1,"2RS"), Substr(m.lpSysTime,15,2) ) - fb2p_SystemTimeToFileTime(m.lpSysTime,@cBuffTime) - m.cBuffTime1 = m.cBuffTime - fb2p_LocalFileTimeToFileTime(m.cBuffTime1,@cBuffTime) + fb2p_SystemTimeToFileTime(m.lpSysTime,@cBuffTime) + m.cBuffTime1 = m.cBuffTime + fb2p_LocalFileTimeToFileTime(m.cBuffTime1,@cBuffTime) - DO CASE - CASE m.cTT = "w" - m.cLastWrite=m.cBuffTime - CASE m.cTT = "a" - m.cLastAccess=m.cBuffTime - OTHERWISE && "c" - m.cCreation=m.cBuffTime - ENDCASE + Do Case + Case m.cTT = "w" + m.cLastWrite=m.cBuffTime + Case m.cTT = "a" + m.cLastAccess=m.cBuffTime + Otherwise && "c" + m.cCreation=m.cBuffTime + Endcase - m.fh = fb2p_lopen (m.tcFileName, OF_READWRITE) + m.fh = fb2p_lopen (m.tcFileName, OF_READWRITE) - IF m.fh < 0 - EXIT - ENDIF + If m.fh < 0 + Exit + Endif - fb2p_SetFileTime (m.fh,m.cCreation, m.cLastAccess, m.cLastWrite) - fb2p_lclose(m.fh) - llRetorno = .T. - ENDTRY + fb2p_SetFileTime (m.fh,m.cCreation, m.cLastAccess, m.cLastWrite) + fb2p_lclose(m.fh) + llRetorno = .T. + Endtry - RETURN llRetorno - ENDPROC + Return llRetorno + Endproc - PROCEDURE compileFoxProBinary - LPARAMETERS tcFileName - LOCAL lcType - tcFileName = EVL(tcFileName, THIS.c_OutputFile) - lcType = UPPER(JUSTEXT(tcFileName)) + Procedure compileFoxProBinary + Lparameters tcFileName + Local lcType + tcFileName = Evl(tcFileName, This.c_OutputFile) + lcType = Upper(Justext(tcFileName)) - DO CASE - CASE lcType = 'VCX' - COMPILE CLASSLIB (tcFileName) + Do Case + Case lcType = 'VCX' + Compile Classlib (tcFileName) - CASE lcType = 'SCX' - COMPILE FORM (tcFileName) + Case lcType = 'SCX' + Compile Form (tcFileName) - CASE lcType = 'FRX' - COMPILE REPORT (tcFileName) + Case lcType = 'FRX' + Compile Report (tcFileName) - CASE lcType = 'LBX' - COMPILE LABEL (tcFileName) + Case lcType = 'LBX' + Compile Label (tcFileName) - CASE lcType = 'DBC' - COMPILE DATABASE (tcFileName) + Case lcType = 'DBC' + Compile Database (tcFileName) - ENDCASE + Endcase - RELEASE tcFileName, lcType - RETURN - ENDPROC + Release tcFileName, lcType + Return + Endproc - PROCEDURE doBackup - *--------------------------------------------------------------------------------------------------- - * PARÁMETROS: (v=Pasar por valor | @=Pasar por referencia) (!=Obligatorio | ?=Opcional) (IN/OUT) - * toEx (@? IN ) Objeto Exception con información del error - * tlRelanzarError (v? IN ) Indica si se debe relanzar el error - * tcBakFile_1 (@? OUT) Nombre del archivo backup 1 (vcx,scx,pjx,frx,lbx,dbf,dbc,mnx,vc2,sc2,pj2,etc) - * tcBakFile_2 (@? OUT) Nombre del archivo backup 2 (vct,sct,pjt,frt,lbt,fpt,dct,mnt,etc) - * tcBakFile_3 (@? OUT) Nombre del archivo backup 3 (cdx,dcx,etc) - * tcOutputFile (v? IN ) Nombre del archivo de salida. Si no se indica se asume .c_OutputFile - *--------------------------------------------------------------------------------------------------- - LPARAMETERS toEx, tlRelanzarError, tcBakFile_1, tcBakFile_2, tcBakFile_3, tcOutputFile + Procedure doBackup +*--------------------------------------------------------------------------------------------------- +* PARÁMETROS: (v=Pasar por valor | @=Pasar por referencia) (!=Obligatorio | ?=Opcional) (IN/OUT) +* toEx (@? IN ) Objeto Exception con información del error +* tlRelanzarError (v? IN ) Indica si se debe relanzar el error +* tcBakFile_1 (@? OUT) Nombre del archivo backup 1 (vcx,scx,pjx,frx,lbx,dbf,dbc,mnx,vc2,sc2,pj2,etc) +* tcBakFile_2 (@? OUT) Nombre del archivo backup 2 (vct,sct,pjt,frt,lbt,fpt,dct,mnt,etc) +* tcBakFile_3 (@? OUT) Nombre del archivo backup 3 (cdx,dcx,etc) +* tcOutputFile (v? IN ) Nombre del archivo de salida. Si no se indica se asume .c_OutputFile +*--------------------------------------------------------------------------------------------------- + Lparameters toEx, tlRelanzarError, tcBakFile_1, tcBakFile_2, tcBakFile_3, tcOutputFile - #IF .F. - LOCAL toFoxBin2Prg AS c_foxbin2prg OF 'FOXBIN2PRG.PRG' - #ENDIF + #If .F. + Local toFoxBin2Prg As c_foxbin2prg Of 'FOXBIN2PRG.PRG' + #Endif - TRY - LOCAL lcNext_Bak, lcExt_1, lcExt_2, lcExt_3, tcOutputFile_Ext1, tcOutputFile_Ext2, tcOutputFile_Ext3, laDir(1,5) ; - , loLang as CL_LANG OF 'FOXBIN2PRG.PRG' - STORE '' TO tcBakFile_1, tcBakFile_2, tcBakFile_3, lcExt_1, lcExt_2, lcExt_3 ; - , tcOutputFile_Ext1, tcOutputFile_Ext2, tcOutputFile_Ext3 + Try + Local lcNext_Bak, lcExt_1, lcExt_2, lcExt_3, tcOutputFile_Ext1, tcOutputFile_Ext2, tcOutputFile_Ext3, laDir(1,5) ; + , loLang As CL_LANG Of 'FOXBIN2PRG.PRG' + Store '' To tcBakFile_1, tcBakFile_2, tcBakFile_3, lcExt_1, lcExt_2, lcExt_3 ; + , tcOutputFile_Ext1, tcOutputFile_Ext2, tcOutputFile_Ext3 - WITH THIS AS c_foxbin2prg OF 'FOXBIN2PRG.PRG' - IF .n_ExtraBackupLevels > 0 THEN - loLang = _SCREEN.o_FoxBin2Prg_Lang - tcOutputFile = EVL( tcOutputFile, .c_OutputFile ) - lcNext_Bak = .getNext_BAK( tcOutputFile ) - lcExt_1 = JUSTEXT( tcOutputFile ) - tcBakFile_1 = FORCEEXT(tcOutputFile, lcExt_1 + lcNext_Bak) + With This As c_foxbin2prg Of 'FOXBIN2PRG.PRG' + If .n_ExtraBackupLevels > 0 Then + loLang = _Screen.o_FoxBin2Prg_Lang + tcOutputFile = Evl( tcOutputFile, .c_OutputFile ) + lcNext_Bak = .getNext_BAK( tcOutputFile ) + lcExt_1 = Justext( tcOutputFile ) + tcBakFile_1 = Forceext(tcOutputFile, lcExt_1 + lcNext_Bak) - DO CASE - CASE INLIST( lcExt_1, .c_PJ2, .c_VC2, .c_SC2, .c_FR2, .c_LB2, .c_DB2, .c_DC2, .c_MN2, .c_FK2, .c_ME2, 'PJM' ) - *-- Extensiones TEXTO + Do Case + Case Inlist( lcExt_1, .c_PJ2, .c_VC2, .c_SC2, .c_FR2, .c_LB2, .c_DB2, .c_DC2, .c_MN2, .c_FK2, .c_ME2, 'PJM' ) +*-- Extensiones TEXTO - CASE lcExt_1 = 'DBF' - *-- DBF - lcExt_2 = 'FPT' - lcExt_3 = 'CDX' - tcBakFile_2 = FORCEEXT(tcOutputFile, lcExt_2 + lcNext_Bak) - tcBakFile_3 = FORCEEXT(tcOutputFile, lcExt_3 + lcNext_Bak) + Case lcExt_1 = 'DBF' +*-- DBF + lcExt_2 = 'FPT' + lcExt_3 = 'CDX' + tcBakFile_2 = Forceext(tcOutputFile, lcExt_2 + lcNext_Bak) + tcBakFile_3 = Forceext(tcOutputFile, lcExt_3 + lcNext_Bak) - CASE lcExt_1 = 'DBC' - *-- DBC - lcExt_2 = 'DCT' - lcExt_3 = 'DCX' - tcBakFile_2 = FORCEEXT(tcOutputFile, lcExt_2 + lcNext_Bak) - tcBakFile_3 = FORCEEXT(tcOutputFile, lcExt_3 + lcNext_Bak) + Case lcExt_1 = 'DBC' +*-- DBC + lcExt_2 = 'DCT' + lcExt_3 = 'DCX' + tcBakFile_2 = Forceext(tcOutputFile, lcExt_2 + lcNext_Bak) + tcBakFile_3 = Forceext(tcOutputFile, lcExt_3 + lcNext_Bak) - CASE INLIST( lcExt_1, 'PJX', 'VCX', 'SCX', 'FRX', 'LBX', 'MNX' ) - *-- PJX, VCX, SCX, FRX, LBX, MNX - lcExt_2 = LEFT(lcExt_1,2) + 'T' - tcBakFile_2 = FORCEEXT(tcOutputFile, lcExt_2 + lcNext_Bak) + Case Inlist( lcExt_1, 'PJX', 'VCX', 'SCX', 'FRX', 'LBX', 'MNX' ) +*-- PJX, VCX, SCX, FRX, LBX, MNX + lcExt_2 = Left(lcExt_1,2) + 'T' + tcBakFile_2 = Forceext(tcOutputFile, lcExt_2 + lcNext_Bak) - OTHERWISE - *-- PKY, MEM + Otherwise +*-- PKY, MEM - ENDCASE + Endcase - IF NOT EMPTY(lcExt_1) - tcOutputFile_Ext1 = FORCEEXT(tcOutputFile, lcExt_1) + If Not Empty(lcExt_1) + tcOutputFile_Ext1 = Forceext(tcOutputFile, lcExt_1) - IF ADIR( laDir, tcOutputFile_Ext1 ) > 0 THEN - *-- LOG - DO CASE - CASE EMPTY(lcExt_2) - .writeLog( C_TAB + loLang.C_BACKUP_OF_LOC + tcOutputFile_Ext1 ) - CASE EMPTY(lcExt_3) - .writeLog( C_TAB + loLang.C_BACKUP_OF_LOC + tcOutputFile_Ext1 + '/' + lcExt_2 ) - OTHERWISE - .writeLog( C_TAB + loLang.C_BACKUP_OF_LOC + tcOutputFile_Ext1 + '/' + lcExt_2 + '/' + lcExt_3 ) - ENDCASE + If Adir( laDir, tcOutputFile_Ext1 ) > 0 Then +*-- LOG + Do Case + Case Empty(lcExt_2) + .writeLog( C_TAB + loLang.C_BACKUP_OF_LOC + tcOutputFile_Ext1 ) + Case Empty(lcExt_3) + .writeLog( C_TAB + loLang.C_BACKUP_OF_LOC + tcOutputFile_Ext1 + '/' + lcExt_2 ) + Otherwise + .writeLog( C_TAB + loLang.C_BACKUP_OF_LOC + tcOutputFile_Ext1 + '/' + lcExt_2 + '/' + lcExt_3 ) + Endcase - *-- COPIA BACKUP - COPY FILE ( tcOutputFile_Ext1 ) TO ( tcBakFile_1 ) +*-- COPIA BACKUP + Copy File ( tcOutputFile_Ext1 ) To ( tcBakFile_1 ) - IF NOT EMPTY(lcExt_2) - tcOutputFile_Ext2 = FORCEEXT(tcOutputFile, lcExt_2) + If Not Empty(lcExt_2) + tcOutputFile_Ext2 = Forceext(tcOutputFile, lcExt_2) - IF ADIR( laDir, tcOutputFile_Ext2 ) > 0 THEN - COPY FILE ( tcOutputFile_Ext2 ) TO ( tcBakFile_2 ) - ENDIF - ENDIF + If Adir( laDir, tcOutputFile_Ext2 ) > 0 Then + Copy File ( tcOutputFile_Ext2 ) To ( tcBakFile_2 ) + Endif + Endif - IF NOT EMPTY(lcExt_3) - tcOutputFile_Ext3 = FORCEEXT(tcOutputFile, lcExt_3) + If Not Empty(lcExt_3) + tcOutputFile_Ext3 = Forceext(tcOutputFile, lcExt_3) - IF ADIR( laDir, tcOutputFile_Ext3 ) > 0 THEN - COPY FILE ( tcOutputFile_Ext3 ) TO ( tcBakFile_3 ) - ENDIF - ENDIF - ENDIF - ENDIF - ENDIF - ENDWITH && THIS + If Adir( laDir, tcOutputFile_Ext3 ) > 0 Then + Copy File ( tcOutputFile_Ext3 ) To ( tcBakFile_3 ) + Endif + Endif + Endif + Endif + Endif + Endwith && THIS - CATCH TO toEx - IF THIS.n_Debug > 0 AND _VFP.STARTMODE = 0 - SET STEP ON - ENDIF + Catch To toEx + If This.n_Debug > 0 And _vfp.StartMode = 0 + Set Step On + Endif - IF tlRelanzarError - THROW - ENDIF + If tlRelanzarError + Throw + Endif - FINALLY - RELEASE toEx, tlRelanzarError, tcBakFile_1, tcBakFile_2, tcBakFile_3 ; - , lcNext_Bak, lcExt_1, lcExt_2, lcExt_3, tcOutputFile_Ext1, tcOutputFile_Ext2, tcOutputFile_Ext3 ; - , tcOutputFile - ENDTRY + Finally + Release toEx, tlRelanzarError, tcBakFile_1, tcBakFile_2, tcBakFile_3 ; + , lcNext_Bak, lcExt_1, lcExt_2, lcExt_3, tcOutputFile_Ext1, tcOutputFile_Ext2, tcOutputFile_Ext3 ; + , tcOutputFile + Endtry - RETURN - ENDPROC + Return + Endproc - PROCEDURE loadProgressbarForm - IF VARTYPE(THIS.o_Frm_Avance) <> "O" THEN - THIS.o_Frm_Avance = CREATEOBJECT("frm_avance", THIS) - THIS.o_Frm_Avance.Show() - ENDIF - ENDPROC + Procedure loadProgressbarForm + If Vartype(This.o_Frm_Avance) <> "O" Then + This.o_Frm_Avance = Createobject("frm_avance", This) + This.o_Frm_Avance.Show() + Endif + Endproc - PROCEDURE unloadProgressbarForm - LPARAMETERS tlForceUnload - IF (tlForceUnload OR THIS.n_ShowProgressbar <> 0) AND VARTYPE(THIS.o_Frm_Avance) = "O" THEN - THIS.o_Frm_Avance.Hide() - THIS.o_Frm_Avance.Release() - THIS.o_Frm_Avance = NULL - ENDIF - ENDPROC + Procedure unloadProgressbarForm + Lparameters tlForceUnload + If (tlForceUnload Or This.n_ShowProgressbar <> 0) And Vartype(This.o_Frm_Avance) = "O" Then + This.o_Frm_Avance.Hide() + This.o_Frm_Avance.Release() + This.o_Frm_Avance = Null + Endif + Endproc - PROCEDURE evaluateConfiguration - *-------------------------------------------------------------------------------------------------------------- - * PARÁMETROS: (v=Pasar por valor | @=Pasar por referencia) (!=Obligatorio | ?=Opcional) (IN/OUT) - * tcDontShowProgress (v? IN ) '1' para inhabilitar la barra de progreso - * tcDontShowErrors (v? IN ) '1' para no mostrar mensajes de error (MESSAGEBOX) - * tcNoTimestamps (v? IN ) Indica si se debe anular el timestamp ('1') o no ('0' ó vacío) - * tcDebug (v? IN ) '1' para habilitar modo debug (SOLO DESARROLLO) - * tcRecompile (v? IN ) Indica recompilar ('1') el binario una vez regenerado. [Cambio de funcionamiento por defecto] - * Este cambio es para ganar tiempo, velocidad y seguridad. Además la recompilación que hace FoxBin2Prg - * se hace desde el directorio del archivo, con lo que las referencias relativas pueden - * generar errores de compilación, típicamente los #include. - * NOTA: Si en vez de '1' se indica un Path (p.ej, el del proyecto, se usará como base para recompilar - * tcExtraBackupLevels (v? IN ) Indica la cantidad de niveles de backup a realizar (por defecto '1') - * tcClearUniqueID (v? IN ) Indica si se debe limpiar el UniqueID ('1') o no ('0' ó vacío) - * tcOptimizeByFilestamp (v? IN ) Indica si se debe optimizar por filestamp mayor o igual ('1'), solo igual ('2') o no optimizar ('0' ó vacío) - * tc_InputFile (v! IN ) Nombre completo (fullpath) del archivo a convertir o nombre del directorio a procesar - * tc_InputFile_Type (@? IN ) Tipo de archivo de entrada: (D)irectory, (F)ile, (Q)uerySupport - * toParentCFG (@? IN ) (Uso interno) Si se pasa un valor, el nuevo CFG copiará primero sus valores de aquí para heredarlos - *-------------------------------------------------------------------------------------------------------------- - LPARAMETERS tcDontShowProgress, tcDontShowErrors, tcNoTimestamps, tcDebug, tcRecompile, tcExtraBackupLevels ; + Procedure evaluateConfiguration +*-------------------------------------------------------------------------------------------------------------- +* PARÁMETROS: (v=Pasar por valor | @=Pasar por referencia) (!=Obligatorio | ?=Opcional) (IN/OUT) +* tcDontShowProgress (v? IN ) '1' para inhabilitar la barra de progreso +* tcDontShowErrors (v? IN ) '1' para no mostrar mensajes de error (MESSAGEBOX) +* tcNoTimestamps (v? IN ) Indica si se debe anular el timestamp ('1') o no ('0' ó vacío) +* tcDebug (v? IN ) '1' para habilitar modo debug (SOLO DESARROLLO) +* tcRecompile (v? IN ) Indica recompilar ('1') el binario una vez regenerado. [Cambio de funcionamiento por defecto] +* Este cambio es para ganar tiempo, velocidad y seguridad. Además la recompilación que hace FoxBin2Prg +* se hace desde el directorio del archivo, con lo que las referencias relativas pueden +* generar errores de compilación, típicamente los #include. +* NOTA: Si en vez de '1' se indica un Path (p.ej, el del proyecto, se usará como base para recompilar +* tcExtraBackupLevels (v? IN ) Indica la cantidad de niveles de backup a realizar (por defecto '1') +* tcClearUniqueID (v? IN ) Indica si se debe limpiar el UniqueID ('1') o no ('0' ó vacío) +* tcOptimizeByFilestamp (v? IN ) Indica si se debe optimizar por filestamp mayor o igual ('1'), solo igual ('2') o no optimizar ('0' ó vacío) +* tc_InputFile (v! IN ) Nombre completo (fullpath) del archivo a convertir o nombre del directorio a procesar +* tc_InputFile_Type (@? IN ) Tipo de archivo de entrada: (D)irectory, (F)ile, (Q)uerySupport +* toParentCFG (@? IN ) (Uso interno) Si se pasa un valor, el nuevo CFG copiará primero sus valores de aquí para heredarlos +*-------------------------------------------------------------------------------------------------------------- + Lparameters tcDontShowProgress, tcDontShowErrors, tcNoTimestamps, tcDebug, tcRecompile, tcExtraBackupLevels ; , tcClearUniqueID, tcOptimizeByFilestamp, tc_InputFile, tcInputFile_Type, toParentCFG - #IF .F. - LOCAL toParentCFG AS CL_CFG OF 'FOXBIN2PRG.PRG' - #ENDIF + #If .F. + Local toParentCFG As CL_CFG Of 'FOXBIN2PRG.PRG' + #Endif - LOCAL lcConfigFile, llExiste_CFG_EnDisco, laConfig(1), I, lcConfData, lcExt, lcValue, lc_CFG_Path, lcConfigLine, laDirInfo(1,5) ; + Local lcConfigFile, llExiste_CFG_EnDisco, laConfig(1), I, lcConfData, lcExt, lcValue, lc_CFG_Path, lcConfigLine, laDirInfo(1,5) ; , lnDirs, laDirs(1), llMasterEval, lcProp ; - , lo_CFG AS CL_CFG OF 'FOXBIN2PRG.PRG' ; - , loCFG_Manual AS CL_CFG OF 'FOXBIN2PRG.PRG' ; - , lo_Configuration AS Collection ; - , loLang as CL_LANG OF 'FOXBIN2PRG.PRG' ; - , loEx as Exception + , lo_CFG As CL_CFG Of 'FOXBIN2PRG.PRG' ; + , loCFG_Manual As CL_CFG Of 'FOXBIN2PRG.PRG' ; + , lo_Configuration As Collection ; + , loLang As CL_LANG Of 'FOXBIN2PRG.PRG' ; + , loEx As Exception - TRY - WITH THIS AS c_foxbin2prg OF 'FOXBIN2PRG.PRG' - STORE 0 TO lnKey - loLang = _SCREEN.o_FoxBin2Prg_Lang - tcRecompile = EVL(tcRecompile, .c_Recompile) - lcConfigFile = .c_Foxbin2prg_ConfigFile - tc_InputFile = EVL(tc_InputFile, .c_InputFile) - tcInputFile_Type = EVL(tcInputFile_Type,'') - lo_Configuration = .o_Configuration + Try + With This As c_foxbin2prg Of 'FOXBIN2PRG.PRG' + Store 0 To lnKey + loLang = _Screen.o_FoxBin2Prg_Lang + tcRecompile = Evl(tcRecompile, .c_Recompile) + lcConfigFile = .c_Foxbin2prg_ConfigFile + tc_InputFile = Evl(tc_InputFile, .c_InputFile) + tcInputFile_Type = Evl(tcInputFile_Type,'') + lo_Configuration = .o_Configuration - IF VARTYPE(lcConfigFile) = "O" - loCFG_Manual = lcConfigFile && lcConfigFile is an object CFG generated by get_DirSettings() - toParentCFG = loCFG_Manual - lcConfigFile = FULLPATH('Personalized-CFG-Object', tc_InputFile) - loCFG_Manual.c_Foxbin2prg_ConfigFile = 'Personalized-CFG-Object' - ELSE - loCFG_Manual = NULL - ENDIF + If Vartype(lcConfigFile) = "O" + loCFG_Manual = lcConfigFile && lcConfigFile is an object CFG generated by get_DirSettings() + toParentCFG = loCFG_Manual + lcConfigFile = Fullpath('Personalized-CFG-Object', tc_InputFile) + loCFG_Manual.c_Foxbin2prg_ConfigFile = 'Personalized-CFG-Object' + Else + loCFG_Manual = Null + Endif - IF VARTYPE(toParentCFG) <> 'O' THEN - toParentCFG = NULL - ENDIF + If Vartype(toParentCFG) <> 'O' Then + toParentCFG = Null + Endif - IF ISNULL(toParentCFG) THEN - .c_InputFile = tc_InputFile - ENDIF + If Isnull(toParentCFG) Then + .c_InputFile = tc_InputFile + Endif - *-- Determino el tipo de InputFile (Archivo o Directorio) - IF EMPTY(tcInputFile_Type) AND NOT EMPTY(tc_InputFile) - DO CASE - CASE LEN(tc_InputFile) = 1 - tcInputFile_Type = C_FILETYPE_QUERYSUPPORT +*-- Determino el tipo de InputFile (Archivo o Directorio) + If Empty(tcInputFile_Type) And Not Empty(tc_InputFile) + Do Case + Case Len(tc_InputFile) = 1 + tcInputFile_Type = C_FILETYPE_QUERYSUPPORT - CASE ADIR(laDirInfo, tc_InputFile, "D") = 1 AND SUBSTR( laDirInfo(1,5), 5, 1 ) = "D" - tcInputFile_Type = C_FILETYPE_DIRECTORY + Case Adir(laDirInfo, tc_InputFile, "D") = 1 And Substr( laDirInfo(1,5), 5, 1 ) = "D" + tcInputFile_Type = C_FILETYPE_DIRECTORY - OTHERWISE - tcInputFile_Type = C_FILETYPE_FILE - ENDCASE - ENDIF + Otherwise + tcInputFile_Type = C_FILETYPE_FILE + Endcase + Endif - IF .l_Main_CFG_Loaded AND NOT EMPTY(tc_InputFile) AND NOT tcInputFile_Type == C_FILETYPE_QUERYSUPPORT THEN - IF .n_CFG_EvaluateFromParam = 1 - * Si se indicó por parámetro (modo objeto), usarlo como Maestro - * Se saltea solo esta evaluación, y luego se usa la variable para determinar el Nº de CFG a usar. - .n_CFG_EvaluateFromParam = -1 && Luego se cambia por el Nº de CFG que corresponda. - ELSE - IF tcInputFile_Type == C_FILETYPE_DIRECTORY THEN - * INDICÓ DIRECTORIO - IF ISNULL(loCFG_Manual) - *lcConfigFile = FULLPATH( 'foxbin2prg.cfg', ADDBS(tc_InputFile) ) - lcConfigFile = FULLPATH( JUSTFNAME(lcConfigFile), ADDBS(tc_InputFile) ) - ENDIF - ELSE - * INDICÓ ARCHIVO - IF ISNULL(loCFG_Manual) - *lcConfigFile = FULLPATH( 'foxbin2prg.cfg', tc_InputFile ) - lcConfigFile = FULLPATH( JUSTFNAME(lcConfigFile), tc_InputFile ) - ENDIF - ENDIF - ENDIF - ENDIF + If .l_Main_CFG_Loaded And Not Empty(tc_InputFile) And Not tcInputFile_Type == C_FILETYPE_QUERYSUPPORT Then + If .n_CFG_EvaluateFromParam = 1 +* Si se indicó por parámetro (modo objeto), usarlo como Maestro +* Se saltea solo esta evaluación, y luego se usa la variable para determinar el Nº de CFG a usar. + .n_CFG_EvaluateFromParam = -1 && Luego se cambia por el Nº de CFG que corresponda. + Else + If tcInputFile_Type == C_FILETYPE_DIRECTORY Then +* INDICÓ DIRECTORIO + If Isnull(loCFG_Manual) +*lcConfigFile = FULLPATH( 'foxbin2prg.cfg', ADDBS(tc_InputFile) ) + lcConfigFile = Fullpath( Justfname(lcConfigFile), Addbs(tc_InputFile) ) + Endif + Else +* INDICÓ ARCHIVO + If Isnull(loCFG_Manual) +*lcConfigFile = FULLPATH( 'foxbin2prg.cfg', tc_InputFile ) + lcConfigFile = Fullpath( Justfname(lcConfigFile), tc_InputFile ) + Endif + Endif + Endif + Endif - lo_Configuration = .o_Configuration - .n_CFG_Actual = 0 - .l_CFG_CachedAccess = .F. - lc_CFG_Path = UPPER( JUSTPATH( lcConfigFile ) ) - lo_CFG = THIS + lo_Configuration = .o_Configuration + .n_CFG_Actual = 0 + .l_CFG_CachedAccess = .F. + lc_CFG_Path = Upper( Justpath( lcConfigFile ) ) + lo_CFG = This - *-- Búsqueda del CFG del PATH indicado en la caché - IF .l_Main_CFG_Loaded +*-- Búsqueda del CFG del PATH indicado en la caché + If .l_Main_CFG_Loaded - IF lo_Configuration.Count > 0 THEN - IF .n_CFG_EvaluateFromParam > 1 - * Especial: Si hay una configuración de bloqueo (CFG Manual), se usa - .n_CFG_Actual = .n_CFG_EvaluateFromParam - ELSE - * Normalmente se buscará el CFG del directorio analizado - .n_CFG_Actual = lo_Configuration.GetKey( lc_CFG_Path ) && 0 = No hay CFG cacheada, >0 = Hay CFG cacheada - ENDIF + If lo_Configuration.Count > 0 Then + If .n_CFG_EvaluateFromParam > 1 +* Especial: Si hay una configuración de bloqueo (CFG Manual), se usa + .n_CFG_Actual = .n_CFG_EvaluateFromParam + Else +* Normalmente se buscará el CFG del directorio analizado + .n_CFG_Actual = lo_Configuration.GetKey( lc_CFG_Path ) && 0 = No hay CFG cacheada, >0 = Hay CFG cacheada + Endif - IF .n_CFG_Actual > 0 THEN - lo_CFG = lo_Configuration.Item(.n_CFG_Actual) - .l_CFG_CachedAccess = .T. + If .n_CFG_Actual > 0 Then + lo_CFG = lo_Configuration.Item(.n_CFG_Actual) + .l_CFG_CachedAccess = .T. - IF NOT ISNULL(loCFG_Manual) - * Si le paso un objeto CFG, prevalece sobre el guardado - lo_CFG.CopyFrom(@loCFG_Manual) - ENDIF - ENDIF - ENDIF + If Not Isnull(loCFG_Manual) +* Si le paso un objeto CFG, prevalece sobre el guardado + lo_CFG.CopyFrom(@loCFG_Manual) + Endif + Endif + Endif - *-- Si no se pasó un CFG padre y no hay CFGs o no encuentra el del PATH indicado, analizo la jararquía - IF ISNULL(toParentCFG) AND (lo_Configuration.Count = 0 OR .n_CFG_Actual = 0) THEN - llMasterEval = .T. - toParentCFG = THIS +*-- Si no se pasó un CFG padre y no hay CFGs o no encuentra el del PATH indicado, analizo la jararquía + If Isnull(toParentCFG) And (lo_Configuration.Count = 0 Or .n_CFG_Actual = 0) Then + llMasterEval = .T. + toParentCFG = This - IF LEFT( lc_CFG_Path, 2 ) == '\\' THEN - *lnDirs = OCCURS( '\', lc_CFG_Path ) - 3 - lnDirs = OCCURS( '\', lc_CFG_Path ) - 2 - ELSE - lnDirs = OCCURS( '\', lc_CFG_Path ) - ENDIF + If Left( lc_CFG_Path, 2 ) == '\\' Then +*lnDirs = OCCURS( '\', lc_CFG_Path ) - 3 + lnDirs = Occurs( '\', lc_CFG_Path ) - 2 + Else + lnDirs = Occurs( '\', lc_CFG_Path ) + Endif - IF lnDirs > 0 THEN - DIMENSION laDirs(lnDirs) + If lnDirs > 0 Then + Dimension laDirs(lnDirs) - *-- Creo el array con los PATH intermedios - FOR I = lnDirs TO 1 STEP -1 - IF m.I = lnDirs THEN - laDirs(m.I) = JUSTPATH(lc_CFG_Path) - ELSE - laDirs(m.I) = JUSTPATH(laDirs(m.I+1)) - ENDIF - ENDFOR +*-- Creo el array con los PATH intermedios + For I = lnDirs To 1 Step -1 + If m.I = lnDirs Then + laDirs(m.I) = Justpath(lc_CFG_Path) + Else + laDirs(m.I) = Justpath(laDirs(m.I+1)) + Endif + Endfor - IF lnDirs = 1 AND laDirs(1) = lc_CFG_Path - *-- Cuando no hay PATH intermedios, salteo esta parte para que más abajo lo agregue. 04/02/2016. FDBOZZO - *-- Ejemplo: Puede pasar cuando se convierte un archivo en C:\ u otro disco RAIZ. - ELSE - *-- Ahora evalúo las configuraciones de los PATH intermedios desde la raíz en adelante - *-- y mantengo la última configuración CFG Padre en toParentCFG para usarla como base. - FOR I = 1 TO lnDirs - .evaluateConfiguration( '', '', '', '', '', '', '', '', laDirs(m.I), C_FILETYPE_DIRECTORY, @toParentCFG) - ENDFOR - ENDIF + If lnDirs = 1 And laDirs(1) = lc_CFG_Path +*-- Cuando no hay PATH intermedios, salteo esta parte para que más abajo lo agregue. 04/02/2016. FDBOZZO +*-- Ejemplo: Puede pasar cuando se convierte un archivo en C:\ u otro disco RAIZ. + Else +*-- Ahora evalúo las configuraciones de los PATH intermedios desde la raíz en adelante +*-- y mantengo la última configuración CFG Padre en toParentCFG para usarla como base. + For I = 1 To lnDirs + .evaluateConfiguration( '', '', '', '', '', '', '', '', laDirs(m.I), C_FILETYPE_DIRECTORY, @toParentCFG) + Endfor + Endif - .l_CFG_CachedAccess = .F. - .n_CFG_Actual = 0 - ENDIF - ENDIF - ENDIF + .l_CFG_CachedAccess = .F. + .n_CFG_Actual = 0 + Endif + Endif + Endif - DO CASE - CASE .n_CFG_Actual = 0 - *-- Si no se encontró un CFG cacheado, se busca si existe un archivo CFG en disco - llExiste_CFG_EnDisco = ( ADIR( laDirInfo, lcConfigFile ) = 1 ) + Do Case + Case .n_CFG_Actual = 0 +*-- Si no se encontró un CFG cacheado, se busca si existe un archivo CFG en disco + llExiste_CFG_EnDisco = ( Adir( laDirInfo, lcConfigFile ) = 1 ) - IF NOT llExiste_CFG_EnDisco - .l_CFG_CachedAccess = .T. && Es cacheado porque sin archivo CFG usa config.interna - ENDIF + If Not llExiste_CFG_EnDisco + .l_CFG_CachedAccess = .T. && Es cacheado porque sin archivo CFG usa config.interna + Endif - CASE ISNULL( .o_Configuration( .n_CFG_Actual ) ) - *-- Si existe una configuración y es NULL, es la predeterminada. - *-- Este es el primer objeto CFG en cargarse cuando se inicializa FoxBin2Prg, - *-- y corresponde a la ruta de instalación del EXE (ej: c:\desa\foxbin2prg\foxbin2prg.cfg) - lo_CFG = THIS + Case Isnull( .o_Configuration( .n_CFG_Actual ) ) +*-- Si existe una configuración y es NULL, es la predeterminada. +*-- Este es el primer objeto CFG en cargarse cuando se inicializa FoxBin2Prg, +*-- y corresponde a la ruta de instalación del EXE (ej: c:\desa\foxbin2prg\foxbin2prg.cfg) + lo_CFG = This - ENDCASE + Endcase - IF .l_Main_CFG_Loaded - IF .l_CFG_CachedAccess AND .n_CFG_Actual > 0 THEN - toParentCFG = lo_CFG - .writeLog( '> ' + UPPER(loLang.C_USING_THIS_SETTINGS_LOC) + ': ' + lo_CFG.c_Foxbin2prg_ConfigFile + ' => ' + tc_InputFile + '' ) - ELSE - .writeLog( '> ' + UPPER(loLang.C_CACHING_CONFIG_FOR_DIRECTORY_LOC) + ': ' + lc_CFG_Path ) - lo_CFG = CREATEOBJECT('CL_CFG') - - lo_Configuration.Add( lo_CFG, lc_CFG_Path ) - .n_CFG_Actual = lo_Configuration.Count - - IF NOT ISNULL(toParentCFG) - lo_CFG.CopyFrom(@toParentCFG) + If .l_Main_CFG_Loaded + If .l_CFG_CachedAccess And .n_CFG_Actual > 0 Then toParentCFG = lo_CFG - .writeLog( C_TAB + '- ' + loLang.C_INHERITING_FROM_LOC + ': ' + lo_CFG.c_Foxbin2prg_ConfigFile ) - ENDIF - ENDIF + .writeLog( '> ' + Upper(loLang.C_USING_THIS_SETTINGS_LOC) + ': ' + lo_CFG.c_Foxbin2prg_ConfigFile + ' => ' + tc_InputFile + '' ) + Else + .writeLog( '> ' + Upper(loLang.C_CACHING_CONFIG_FOR_DIRECTORY_LOC) + ': ' + lc_CFG_Path ) + lo_CFG = Createobject('CL_CFG') + lo_Configuration.Add( lo_CFG, lc_CFG_Path ) + .n_CFG_Actual = lo_Configuration.Count - ELSE - lo_Configuration.Add( NULL, lc_CFG_Path ) && La NULL se carga solo cuando no hay Main_CFG_loaded todavía. - .n_CFG_Actual = lo_Configuration.Count - ENDIF + If Not Isnull(toParentCFG) + lo_CFG.CopyFrom(@toParentCFG) + toParentCFG = lo_CFG + .writeLog( C_TAB + '- ' + loLang.C_INHERITING_FROM_LOC + ': ' + lo_CFG.c_Foxbin2prg_ConfigFile ) + Endif + Endif - *-- NOTA: SOLO LOS QUE NO VENGAN DE PARÁMETROS EXTERNOS DEBEN ASIGNARSE A lo_CFG AQUÍ. - IF llExiste_CFG_EnDisco AND NOT .l_CFG_CachedAccess THEN - .writeLog() - .writeLog( '> ' + loLang.C_READING_CFG_VALUES_FROM_DISK_LOC + ':' ) - .writeLog( C_TAB + loLang.C_CONFIGFILE_LOC + ' ' + lcConfigFile ) + Else + lo_Configuration.Add( Null, lc_CFG_Path ) && La NULL se carga solo cuando no hay Main_CFG_loaded todavía. + .n_CFG_Actual = lo_Configuration.Count + Endif - lo_CFG.c_Foxbin2prg_ConfigFile = lcConfigFile +*-- NOTA: SOLO LOS QUE NO VENGAN DE PARÁMETROS EXTERNOS DEBEN ASIGNARSE A lo_CFG AQUÍ. + If llExiste_CFG_EnDisco And Not .l_CFG_CachedAccess Then + .writeLog() + .writeLog( '> ' + loLang.C_READING_CFG_VALUES_FROM_DISK_LOC + ':' ) + .writeLog( C_TAB + loLang.C_CONFIGFILE_LOC + ' ' + lcConfigFile ) - FOR I = 1 TO ALINES( laConfig, FILETOSTR( lcConfigFile ), 1+4 ) - .set_Line( @lcConfigLine, @laConfig, m.I ) - .get_SeparatedLineAndComment( @lcConfigLine ) - laConfig(m.I) = LOWER( lcConfigLine ) + lo_CFG.c_Foxbin2prg_ConfigFile = lcConfigFile - DO CASE - CASE EMPTY( laConfig(m.I) ) OR INLIST( LEFT( laConfig(m.I), 1 ), '*', '#', '/', "'" ) - LOOP + For I = 1 To Alines( laConfig, Filetostr( lcConfigFile ), 1+4 ) + .set_Line( @lcConfigLine, @laConfig, m.I ) + .get_SeparatedLineAndComment( @lcConfigLine ) + laConfig(m.I) = Lower( lcConfigLine ) - CASE LEFT( laConfig(m.I), 10 ) == LOWER('Extension:') - lcConfData = ALLTRIM( SUBSTR( laConfig(m.I), 11 ) ) - lcExt = ALLTRIM( GETWORDNUM( lcConfData, 1, '=' ) ) - lcProp = 'c_' + lcExt - IF PEMSTATUS( lo_CFG, lcProp, 5 ) - lcValue = UPPER( ALLTRIM( GETWORDNUM( lcConfData, 2, '=' ) ) ) - lo_CFG.ADDPROPERTY( lcProp, lcValue ) - *.writeLog( 'Reconfiguración de extensión:' + ' ' + lcExt + ' a ' + lcValue ) - .writeLog( C_TAB + JUSTFNAME(lcConfigFile) + ' > ' + loLang.C_EXTENSION_RECONFIGURATION_LOC + ' ' + lcExt + ' -> ' + lcValue ) - ENDIF + Do Case + Case Empty( laConfig(m.I) ) Or Inlist( Left( laConfig(m.I), 1 ), '*', '#', '/', "'" ) + Loop - CASE LEFT( laConfig(m.I), 17 ) == LOWER('DontShowProgress:') - lcValue = ALLTRIM( SUBSTR( laConfig(m.I), 18 ) ) - IF NOT INLIST( TRANSFORM(tcDontShowProgress), '0', '1', '2' ) AND INLIST( lcValue, '0', '1', '2' ) THEN - tcDontShowProgress = lcValue - lo_CFG.n_ShowProgressbar = ICASE(lcValue=='0',1, lcValue=='1',0, 2) - .writeLog( C_TAB + JUSTFNAME(lcConfigFile) + ' > tcDontShowProgress: ' + TRANSFORM(tcDontShowProgress) ) - ENDIF + Case Left( laConfig(m.I), 10 ) == Lower('Extension:') + lcConfData = Alltrim( Substr( laConfig(m.I), 11 ) ) + lcExt = Alltrim( Getwordnum( lcConfData, 1, '=' ) ) + lcProp = 'c_' + lcExt + If Pemstatus( lo_CFG, lcProp, 5 ) + lcValue = Upper( Alltrim( Getwordnum( lcConfData, 2, '=' ) ) ) + lo_CFG.AddProperty( lcProp, lcValue ) +*.writeLog( 'Reconfiguración de extensión:' + ' ' + lcExt + ' a ' + lcValue ) + .writeLog( C_TAB + Justfname(lcConfigFile) + ' > ' + loLang.C_EXTENSION_RECONFIGURATION_LOC + ' ' + lcExt + ' -> ' + lcValue ) + Endif - CASE LEFT( laConfig(m.I), 16 ) == LOWER('ShowProgressbar:') - lcValue = ALLTRIM( SUBSTR( laConfig(m.I), 17 ) ) - IF INLIST( lcValue, '0', '1', '2' ) THEN - lo_CFG.n_ShowProgressbar = INT( VAL(lcValue) ) - tcDontShowProgress = '' - .writeLog( C_TAB + JUSTFNAME(lcConfigFile) + ' > ShowProgressbar: ' + lcValue ) - ENDIF + Case Left( laConfig(m.I), 17 ) == Lower('DontShowProgress:') + lcValue = Alltrim( Substr( laConfig(m.I), 18 ) ) + If Not Inlist( Transform(tcDontShowProgress), '0', '1', '2' ) And Inlist( lcValue, '0', '1', '2' ) Then + tcDontShowProgress = lcValue + lo_CFG.n_ShowProgressbar = Icase(lcValue=='0',1, lcValue=='1',0, 2) + .writeLog( C_TAB + Justfname(lcConfigFile) + ' > tcDontShowProgress: ' + Transform(tcDontShowProgress) ) + Endif - CASE LEFT( laConfig(m.I), 15 ) == LOWER('DontShowErrors:') - *-- Priorizo si tcDontShowErrors NO viene con "0" como parámetro, ya que los scripts vbs - *-- los utilizan para sobreescribir la configuración por defecto de foxbin2prg.cfg - lcValue = ALLTRIM( SUBSTR( laConfig(m.I), 16 ) ) - IF NOT INLIST( TRANSFORM(tcDontShowErrors), '0', '1' ) AND INLIST( lcValue, '0', '1' ) THEN - tcDontShowErrors = lcValue - .writeLog( C_TAB + JUSTFNAME(lcConfigFile) + ' > tcDontShowErrors: ' + TRANSFORM(tcDontShowErrors) ) - ENDIF + Case Left( laConfig(m.I), 16 ) == Lower('ShowProgressbar:') + lcValue = Alltrim( Substr( laConfig(m.I), 17 ) ) + If Inlist( lcValue, '0', '1', '2' ) Then + lo_CFG.n_ShowProgressbar = Int( Val(lcValue) ) + tcDontShowProgress = '' + .writeLog( C_TAB + Justfname(lcConfigFile) + ' > ShowProgressbar: ' + lcValue ) + Endif - CASE LEFT( laConfig(m.I), 13 ) == LOWER('NoTimestamps:') - lcValue = ALLTRIM( SUBSTR( laConfig(m.I), 14 ) ) - IF NOT INLIST( TRANSFORM(tcNoTimestamps), '0', '1' ) AND INLIST( lcValue, '0', '1' ) THEN - tcNoTimestamps = lcValue - .writeLog( C_TAB + JUSTFNAME(lcConfigFile) + ' > tcNoTimestamps: ' + TRANSFORM(tcNoTimestamps) ) - ENDIF + Case Left( laConfig(m.I), 15 ) == Lower('DontShowErrors:') +*-- Priorizo si tcDontShowErrors NO viene con "0" como parámetro, ya que los scripts vbs +*-- los utilizan para sobreescribir la configuración por defecto de foxbin2prg.cfg + lcValue = Alltrim( Substr( laConfig(m.I), 16 ) ) + If Not Inlist( Transform(tcDontShowErrors), '0', '1' ) And Inlist( lcValue, '0', '1' ) Then + tcDontShowErrors = lcValue + .writeLog( C_TAB + Justfname(lcConfigFile) + ' > tcDontShowErrors: ' + Transform(tcDontShowErrors) ) + Endif - CASE LEFT( laConfig(m.I), 6 ) == LOWER('Debug:') - lcValue = ALLTRIM( SUBSTR( laConfig(m.I), 7 ) ) - IF NOT INLIST( TRANSFORM(tcDebug), '0', '1' ) AND INLIST( lcValue, '0', '1' ) THEN - tcDebug = lcValue - .writeLog( C_TAB + JUSTFNAME(lcConfigFile) + ' > tcDebug: ' + TRANSFORM(tcDebug) ) - ENDIF + Case Left( laConfig(m.I), 13 ) == Lower('NoTimestamps:') + lcValue = Alltrim( Substr( laConfig(m.I), 14 ) ) + If Not Inlist( Transform(tcNoTimestamps), '0', '1' ) And Inlist( lcValue, '0', '1' ) Then + tcNoTimestamps = lcValue + .writeLog( C_TAB + Justfname(lcConfigFile) + ' > tcNoTimestamps: ' + Transform(tcNoTimestamps) ) + Endif - CASE LEFT( laConfig(m.I), 18 ) == LOWER('ExtraBackupLevels:') - lcValue = ALLTRIM( SUBSTR( laConfig(m.I), 19 ) ) - IF NOT ISDIGIT( TRANSFORM(tcExtraBackupLevels) ) AND ISDIGIT( lcValue ) THEN - tcExtraBackupLevels = lcValue - .writeLog( C_TAB + JUSTFNAME(lcConfigFile) + ' > tcExtraBackupLevels: ' + TRANSFORM(tcExtraBackupLevels) ) - ENDIF + Case Left( laConfig(m.I), 6 ) == Lower('Debug:') + lcValue = Alltrim( Substr( laConfig(m.I), 7 ) ) + If Not Inlist( Transform(tcDebug), '0', '1' ) And Inlist( lcValue, '0', '1' ) Then + tcDebug = lcValue + .writeLog( C_TAB + Justfname(lcConfigFile) + ' > tcDebug: ' + Transform(tcDebug) ) + Endif - CASE LEFT( laConfig(m.I), 14 ) == LOWER('ClearUniqueID:') - lcValue = ALLTRIM( SUBSTR( laConfig(m.I), 15 ) ) - IF NOT INLIST( TRANSFORM(tcClearUniqueID), '0', '1' ) AND INLIST( lcValue, '0', '1' ) THEN - tcClearUniqueID = lcValue - .writeLog( C_TAB + JUSTFNAME(lcConfigFile) + ' > ClearUniqueID: ' + TRANSFORM(lcValue) ) - ENDIF + Case Left( laConfig(m.I), 18 ) == Lower('ExtraBackupLevels:') + lcValue = Alltrim( Substr( laConfig(m.I), 19 ) ) + If Not Isdigit( Transform(tcExtraBackupLevels) ) And Isdigit( lcValue ) Then + tcExtraBackupLevels = lcValue + .writeLog( C_TAB + Justfname(lcConfigFile) + ' > tcExtraBackupLevels: ' + Transform(tcExtraBackupLevels) ) + Endif - CASE LEFT( laConfig(m.I), 19 ) == LOWER('ClearDBFLastUpdate:') - lcValue = ALLTRIM( SUBSTR( laConfig(m.I), 20 ) ) - IF INLIST( lcValue, '0', '1' ) THEN - lo_CFG.l_ClearDBFLastUpdate = ( TRANSFORM(lcValue) == '1' ) - .writeLog( C_TAB + JUSTFNAME(lcConfigFile) + ' > ClearDBFLastUpdate: ' + TRANSFORM(lcValue) ) - ENDIF + Case Left( laConfig(m.I), 14 ) == Lower('ClearUniqueID:') + lcValue = Alltrim( Substr( laConfig(m.I), 15 ) ) + If Not Inlist( Transform(tcClearUniqueID), '0', '1' ) And Inlist( lcValue, '0', '1' ) Then + tcClearUniqueID = lcValue + .writeLog( C_TAB + Justfname(lcConfigFile) + ' > ClearUniqueID: ' + Transform(lcValue) ) + Endif - CASE LEFT( laConfig(m.I), 20 ) == LOWER('OptimizeByFilestamp:') - lcValue = ALLTRIM( SUBSTR( laConfig(m.I), 21 ) ) - IF NOT INLIST( TRANSFORM(tcOptimizeByFilestamp), '0', '1', '2' ) AND INLIST( lcValue, '0', '1', '2' ) THEN - tcOptimizeByFilestamp = lcValue - .writeLog( C_TAB + JUSTFNAME(lcConfigFile) + ' > OptimizeByFilestamp: ' + TRANSFORM(lcValue) ) - ENDIF + Case Left( laConfig(m.I), 19 ) == Lower('ClearDBFLastUpdate:') + lcValue = Alltrim( Substr( laConfig(m.I), 20 ) ) + If Inlist( lcValue, '0', '1' ) Then + lo_CFG.l_ClearDBFLastUpdate = ( Transform(lcValue) == '1' ) + .writeLog( C_TAB + Justfname(lcConfigFile) + ' > ClearDBFLastUpdate: ' + Transform(lcValue) ) + Endif - CASE LEFT( laConfig(m.I), 16 ) == LOWER('UseClassPerFile:') - lcValue = ALLTRIM( SUBSTR( laConfig(m.I), 17 ) ) - IF INLIST( lcValue, '0', '1', '2' ) THEN - lo_CFG.n_UseClassPerFile = INT( VAL(lcValue) ) - .writeLog( C_TAB + JUSTFNAME(lcConfigFile) + ' > UseClassPerFile: ' + TRANSFORM(lcValue) ) - ENDIF + Case Left( laConfig(m.I), 20 ) == Lower('OptimizeByFilestamp:') + lcValue = Alltrim( Substr( laConfig(m.I), 21 ) ) + If Not Inlist( Transform(tcOptimizeByFilestamp), '0', '1', '2' ) And Inlist( lcValue, '0', '1', '2' ) Then + tcOptimizeByFilestamp = lcValue + .writeLog( C_TAB + Justfname(lcConfigFile) + ' > OptimizeByFilestamp: ' + Transform(lcValue) ) + Endif - CASE LEFT( laConfig(m.I), 18 ) == LOWER('ClassPerFileCheck:') - lcValue = ALLTRIM( SUBSTR( laConfig(m.I), 19 ) ) - IF INLIST( lcValue, '0', '1' ) THEN - lo_CFG.l_ClassPerFileCheck = ( TRANSFORM(lcValue) == '1' ) - .writeLog( C_TAB + JUSTFNAME(lcConfigFile) + ' > ClassPerFileCheck: ' + TRANSFORM(lcValue) ) - ENDIF + Case Left( laConfig(m.I), 16 ) == Lower('UseClassPerFile:') + lcValue = Alltrim( Substr( laConfig(m.I), 17 ) ) + If Inlist( lcValue, '0', '1', '2' ) Then + lo_CFG.n_UseClassPerFile = Int( Val(lcValue) ) + .writeLog( C_TAB + Justfname(lcConfigFile) + ' > UseClassPerFile: ' + Transform(lcValue) ) + Endif - CASE LEFT( laConfig(m.I), 27 ) == LOWER('RedirectClassPerFileToMain:') - lcValue = ALLTRIM( SUBSTR( laConfig(m.I), 28 ) ) - IF INLIST( lcValue, '0', '1' ) THEN - lo_CFG.l_RedirectClassPerFileToMain = ( TRANSFORM(lcValue) == '1' ) - .writeLog( C_TAB + JUSTFNAME(lcConfigFile) + ' > RedirectClassPerFileToMain: ' + TRANSFORM(lcValue) ) - ENDIF - CASE LEFT( laConfig(m.I), 18 ) == LOWER('RedirectClassType:') - lcValue = ALLTRIM( SUBSTR( laConfig(m.I), 19 ) ) - IF INLIST( lcValue, '0', '1' ) THEN - lo_CFG.n_RedirectClassType = INT( VAL( lcValue ) ) - .writeLog( C_TAB + JUSTFNAME(lcConfigFile) + ' > RedirectClassType: ' + TRANSFORM(lcValue) ) - ENDIF + Case Left( laConfig(m.I), 18 ) == Lower('ClassPerFileCheck:') + lcValue = Alltrim( Substr( laConfig(m.I), 19 ) ) + If Inlist( lcValue, '0', '1' ) Then + lo_CFG.l_ClassPerFileCheck = ( Transform(lcValue) == '1' ) + .writeLog( C_TAB + Justfname(lcConfigFile) + ' > ClassPerFileCheck: ' + Transform(lcValue) ) + Endif - CASE LEFT( laConfig(m.I), 24 ) == LOWER('RemoveNullCharsFromCode:') - lcValue = ALLTRIM( SUBSTR( laConfig(m.I), 25 ) ) - IF INLIST( lcValue, '0', '1' ) THEN - lo_CFG.l_RemoveNullCharsFromCode = ( TRANSFORM(lcValue) == '1' ) - .writeLog( C_TAB + JUSTFNAME(lcConfigFile) + ' > RemoveNullCharsFromCode: ' + TRANSFORM(lcValue) ) - ENDIF + Case Left( laConfig(m.I), 27 ) == Lower('RedirectClassPerFileToMain:') + lcValue = Alltrim( Substr( laConfig(m.I), 28 ) ) + If Inlist( lcValue, '0', '1' ) Then + lo_CFG.l_RedirectClassPerFileToMain = ( Transform(lcValue) == '1' ) + .writeLog( C_TAB + Justfname(lcConfigFile) + ' > RedirectClassPerFileToMain: ' + Transform(lcValue) ) + Endif - CASE LEFT( laConfig(m.I), 25 ) == LOWER('RemoveZOrderSetFromProps:') - lcValue = ALLTRIM( SUBSTR( laConfig(m.I), 26 ) ) - IF INLIST( lcValue, '0', '1' ) THEN - lo_CFG.l_RemoveZOrderSetFromProps = ( TRANSFORM(lcValue) == '1' ) - .writeLog( C_TAB + JUSTFNAME(lcConfigFile) + ' > RemoveZOrderSetFromProps: ' + TRANSFORM(lcValue) ) - ENDIF + Case Left( laConfig(m.I), 18 ) == Lower('RedirectClassType:') + lcValue = Alltrim( Substr( laConfig(m.I), 19 ) ) + If Inlist( lcValue, '0', '1' ) Then + lo_CFG.n_RedirectClassType = Int( Val( lcValue ) ) + .writeLog( C_TAB + Justfname(lcConfigFile) + ' > RedirectClassType: ' + Transform(lcValue) ) + Endif - CASE LEFT( laConfig(m.I), 9 ) == LOWER('Language:') - *-- CASO ESPECIAL: El lenguaje no se guarda en lo_CFG, porque es un seteo Global. - lcValue = ALLTRIM( SUBSTR( laConfig(m.I), 10 ) ) - .changeLanguage(lcValue) - .writeLog( C_TAB + JUSTFNAME(lcConfigFile) + ' > Language: ' + TRANSFORM(lcValue) + ' (' + .c_Language + ')' ) + Case Left( laConfig(m.I), 24 ) == Lower('RemoveNullCharsFromCode:') + lcValue = Alltrim( Substr( laConfig(m.I), 25 ) ) + If Inlist( lcValue, '0', '1' ) Then + lo_CFG.l_RemoveNullCharsFromCode = ( Transform(lcValue) == '1' ) + .writeLog( C_TAB + Justfname(lcConfigFile) + ' > RemoveNullCharsFromCode: ' + Transform(lcValue) ) + Endif - CASE LEFT( laConfig(m.I), 23 ) == LOWER('PJX_Conversion_Support:') - lcValue = ALLTRIM( SUBSTR( laConfig(m.I), 24 ) ) - IF INLIST( lcValue, '0', '1', '2' ) THEN - lo_CFG.PJX_Conversion_Support = INT( VAL( lcValue ) ) - .writeLog( C_TAB + JUSTFNAME(lcConfigFile) + ' > PJX_Conversion_Support: ' + TRANSFORM(lo_CFG.PJX_Conversion_Support) ) - ENDIF + Case Left( laConfig(m.I), 25 ) == Lower('RemoveZOrderSetFromProps:') + lcValue = Alltrim( Substr( laConfig(m.I), 26 ) ) + If Inlist( lcValue, '0', '1' ) Then + lo_CFG.l_RemoveZOrderSetFromProps = ( Transform(lcValue) == '1' ) + .writeLog( C_TAB + Justfname(lcConfigFile) + ' > RemoveZOrderSetFromProps: ' + Transform(lcValue) ) + Endif - CASE LEFT( laConfig(m.I), 23 ) == LOWER('VCX_Conversion_Support:') - lcValue = ALLTRIM( SUBSTR( laConfig(m.I), 24 ) ) - IF INLIST( lcValue, '0', '1', '2' ) THEN - lo_CFG.VCX_Conversion_Support = INT( VAL( lcValue ) ) - .writeLog( C_TAB + JUSTFNAME(lcConfigFile) + ' > VCX_Conversion_Support: ' + TRANSFORM(lo_CFG.VCX_Conversion_Support) ) - ENDIF + Case Left( laConfig(m.I), 9 ) == Lower('Language:') +*-- CASO ESPECIAL: El lenguaje no se guarda en lo_CFG, porque es un seteo Global. + lcValue = Alltrim( Substr( laConfig(m.I), 10 ) ) + .changeLanguage(lcValue) + .writeLog( C_TAB + Justfname(lcConfigFile) + ' > Language: ' + Transform(lcValue) + ' (' + .c_Language + ')' ) - CASE LEFT( laConfig(m.I), 23 ) == LOWER('SCX_Conversion_Support:') - lcValue = ALLTRIM( SUBSTR( laConfig(m.I), 24 ) ) - IF INLIST( lcValue, '0', '1', '2' ) THEN - lo_CFG.SCX_Conversion_Support = INT( VAL( lcValue ) ) - .writeLog( C_TAB + JUSTFNAME(lcConfigFile) + ' > SCX_Conversion_Support: ' + TRANSFORM(lo_CFG.SCX_Conversion_Support) ) - ENDIF + Case Left( laConfig(m.I), 23 ) == Lower('PJX_Conversion_Support:') + lcValue = Alltrim( Substr( laConfig(m.I), 24 ) ) + If Inlist( lcValue, '0', '1', '2' ) Then + lo_CFG.PJX_Conversion_Support = Int( Val( lcValue ) ) + .writeLog( C_TAB + Justfname(lcConfigFile) + ' > PJX_Conversion_Support: ' + Transform(lo_CFG.PJX_Conversion_Support) ) + Endif - CASE LEFT( laConfig(m.I), 23 ) == LOWER('FRX_Conversion_Support:') - lcValue = ALLTRIM( SUBSTR( laConfig(m.I), 24 ) ) - IF INLIST( lcValue, '0', '1', '2' ) THEN - lo_CFG.FRX_Conversion_Support = INT( VAL( lcValue ) ) - .writeLog( C_TAB + JUSTFNAME(lcConfigFile) + ' > FRX_Conversion_Support: ' + TRANSFORM(lo_CFG.FRX_Conversion_Support) ) - ENDIF + Case Left( laConfig(m.I), 23 ) == Lower('VCX_Conversion_Support:') + lcValue = Alltrim( Substr( laConfig(m.I), 24 ) ) + If Inlist( lcValue, '0', '1', '2' ) Then + lo_CFG.VCX_Conversion_Support = Int( Val( lcValue ) ) + .writeLog( C_TAB + Justfname(lcConfigFile) + ' > VCX_Conversion_Support: ' + Transform(lo_CFG.VCX_Conversion_Support) ) + Endif - CASE LEFT( laConfig(m.I), 23 ) == LOWER('LBX_Conversion_Support:') - lcValue = ALLTRIM( SUBSTR( laConfig(m.I), 24 ) ) - IF INLIST( lcValue, '0', '1', '2' ) THEN - lo_CFG.LBX_Conversion_Support = INT( VAL( lcValue ) ) - .writeLog( C_TAB + JUSTFNAME(lcConfigFile) + ' > LBX_Conversion_Support: ' + TRANSFORM(lo_CFG.LBX_Conversion_Support) ) - ENDIF + Case Left( laConfig(m.I), 23 ) == Lower('SCX_Conversion_Support:') + lcValue = Alltrim( Substr( laConfig(m.I), 24 ) ) + If Inlist( lcValue, '0', '1', '2' ) Then + lo_CFG.SCX_Conversion_Support = Int( Val( lcValue ) ) + .writeLog( C_TAB + Justfname(lcConfigFile) + ' > SCX_Conversion_Support: ' + Transform(lo_CFG.SCX_Conversion_Support) ) + Endif - CASE LEFT( laConfig(m.I), 23 ) == LOWER('MNX_Conversion_Support:') - lcValue = ALLTRIM( SUBSTR( laConfig(m.I), 24 ) ) - IF INLIST( lcValue, '0', '1', '2' ) THEN - lo_CFG.MNX_Conversion_Support = INT( VAL( lcValue ) ) - .writeLog( C_TAB + JUSTFNAME(lcConfigFile) + ' > MNX_Conversion_Support: ' + TRANSFORM(lo_CFG.MNX_Conversion_Support) ) - ENDIF + Case Left( laConfig(m.I), 23 ) == Lower('FRX_Conversion_Support:') + lcValue = Alltrim( Substr( laConfig(m.I), 24 ) ) + If Inlist( lcValue, '0', '1', '2' ) Then + lo_CFG.FRX_Conversion_Support = Int( Val( lcValue ) ) + .writeLog( C_TAB + Justfname(lcConfigFile) + ' > FRX_Conversion_Support: ' + Transform(lo_CFG.FRX_Conversion_Support) ) + Endif - CASE LEFT( laConfig(m.I), 23 ) == LOWER('FKY_Conversion_Support:') - lcValue = ALLTRIM( SUBSTR( laConfig(m.I), 24 ) ) - IF INLIST( lcValue, '0', '1' ) THEN - lo_CFG.FKY_Conversion_Support = INT( VAL( lcValue ) ) - .writeLog( C_TAB + JUSTFNAME(lcConfigFile) + ' > FKY_Conversion_Support: ' + TRANSFORM(lo_CFG.FKY_Conversion_Support) ) - ENDIF + Case Left( laConfig(m.I), 23 ) == Lower('LBX_Conversion_Support:') + lcValue = Alltrim( Substr( laConfig(m.I), 24 ) ) + If Inlist( lcValue, '0', '1', '2' ) Then + lo_CFG.LBX_Conversion_Support = Int( Val( lcValue ) ) + .writeLog( C_TAB + Justfname(lcConfigFile) + ' > LBX_Conversion_Support: ' + Transform(lo_CFG.LBX_Conversion_Support) ) + Endif - CASE LEFT( laConfig(m.I), 23 ) == LOWER('MEM_Conversion_Support:') - lcValue = ALLTRIM( SUBSTR( laConfig(m.I), 24 ) ) - IF INLIST( lcValue, '0', '1' ) THEN - lo_CFG.MEM_Conversion_Support = INT( VAL( lcValue ) ) - .writeLog( C_TAB + JUSTFNAME(lcConfigFile) + ' > MEM_Conversion_Support: ' + TRANSFORM(lo_CFG.MEM_Conversion_Support) ) - ENDIF + Case Left( laConfig(m.I), 23 ) == Lower('MNX_Conversion_Support:') + lcValue = Alltrim( Substr( laConfig(m.I), 24 ) ) + If Inlist( lcValue, '0', '1', '2' ) Then + lo_CFG.MNX_Conversion_Support = Int( Val( lcValue ) ) + .writeLog( C_TAB + Justfname(lcConfigFile) + ' > MNX_Conversion_Support: ' + Transform(lo_CFG.MNX_Conversion_Support) ) + Endif - CASE LEFT( laConfig(m.I), 23 ) == LOWER('DBF_Conversion_Support:') - lcValue = ALLTRIM( SUBSTR( laConfig(m.I), 24 ) ) - IF INLIST( lcValue, '0', '1', '2', '4', '8' ) THEN - lo_CFG.DBF_Conversion_Support = INT( VAL( lcValue ) ) - .writeLog( C_TAB + JUSTFNAME(lcConfigFile) + ' > DBF_Conversion_Support: ' + TRANSFORM(lo_CFG.DBF_Conversion_Support) ) - ENDIF + Case Left( laConfig(m.I), 23 ) == Lower('FKY_Conversion_Support:') + lcValue = Alltrim( Substr( laConfig(m.I), 24 ) ) + If Inlist( lcValue, '0', '1' ) Then + lo_CFG.FKY_Conversion_Support = Int( Val( lcValue ) ) + .writeLog( C_TAB + Justfname(lcConfigFile) + ' > FKY_Conversion_Support: ' + Transform(lo_CFG.FKY_Conversion_Support) ) + Endif - CASE LEFT( laConfig(m.I), 24 ) == LOWER('DBF_Conversion_Included:') - lcValue = ALLTRIM( SUBSTR( laConfig(m.I), 25 ) ) - IF NOT EMPTY(lcValue) THEN - lo_CFG.DBF_Conversion_Included = lcValue - .writeLog( C_TAB + JUSTFNAME(lcConfigFile) + ' > DBF_Conversion_Included: ' + TRANSFORM(lo_CFG.DBF_Conversion_Included) ) - ENDIF + Case Left( laConfig(m.I), 23 ) == Lower('MEM_Conversion_Support:') + lcValue = Alltrim( Substr( laConfig(m.I), 24 ) ) + If Inlist( lcValue, '0', '1' ) Then + lo_CFG.MEM_Conversion_Support = Int( Val( lcValue ) ) + .writeLog( C_TAB + Justfname(lcConfigFile) + ' > MEM_Conversion_Support: ' + Transform(lo_CFG.MEM_Conversion_Support) ) + Endif - CASE LEFT( laConfig(m.I), 24 ) == LOWER('DBF_Conversion_Excluded:') - lcValue = ALLTRIM( SUBSTR( laConfig(m.I), 25 ) ) - IF NOT EMPTY(lcValue) THEN - lo_CFG.DBF_Conversion_Excluded = lcValue - .writeLog( C_TAB + JUSTFNAME(lcConfigFile) + ' > DBF_Conversion_Excluded: ' + TRANSFORM(lo_CFG.DBF_Conversion_Excluded) ) - ENDIF + Case Left( laConfig(m.I), 23 ) == Lower('DBF_Conversion_Support:') + lcValue = Alltrim( Substr( laConfig(m.I), 24 ) ) + If Inlist( lcValue, '0', '1', '2', '4', '8' ) Then + lo_CFG.DBF_Conversion_Support = Int( Val( lcValue ) ) + .writeLog( C_TAB + Justfname(lcConfigFile) + ' > DBF_Conversion_Support: ' + Transform(lo_CFG.DBF_Conversion_Support) ) + Endif - CASE LEFT( laConfig(m.I), 23 ) == LOWER('DBC_Conversion_Support:') - lcValue = ALLTRIM( SUBSTR( laConfig(m.I), 24 ) ) - IF INLIST( lcValue, '0', '1', '2' ) THEN - lo_CFG.DBC_Conversion_Support = INT( VAL( lcValue ) ) - .writeLog( C_TAB + JUSTFNAME(lcConfigFile) + ' > DBC_Conversion_Support: ' + TRANSFORM(lo_CFG.DBC_Conversion_Support) ) - ENDIF + Case Left( laConfig(m.I), 24 ) == Lower('DBF_Conversion_Included:') + lcValue = Alltrim( Substr( laConfig(m.I), 25 ) ) + If Not Empty(lcValue) Then + lo_CFG.DBF_Conversion_Included = lcValue + .writeLog( C_TAB + Justfname(lcConfigFile) + ' > DBF_Conversion_Included: ' + Transform(lo_CFG.DBF_Conversion_Included) ) + Endif - CASE LEFT( laConfig(m.I), 16 ) == LOWER('BackgroundImage:') - lcValue = ALLTRIM( SUBSTR( laConfig(m.I), 17 ) ) - IF EMPTY(lcValue) OR ADIR( laDirInfo, lcValue ) > 0 THEN - lo_CFG.c_BackgroundImage = lcValue - .writeLog( C_TAB + JUSTFNAME(lcConfigFile) + ' > BackgroundImage: ' + TRANSFORM(lo_CFG.c_BackgroundImage) ) - ENDIF + Case Left( laConfig(m.I), 24 ) == Lower('DBF_Conversion_Excluded:') + lcValue = Alltrim( Substr( laConfig(m.I), 25 ) ) + If Not Empty(lcValue) Then + lo_CFG.DBF_Conversion_Excluded = lcValue + .writeLog( C_TAB + Justfname(lcConfigFile) + ' > DBF_Conversion_Excluded: ' + Transform(lo_CFG.DBF_Conversion_Excluded) ) + Endif - CASE LEFT( laConfig(m.I), 25 ) == LOWER('ExcludeDBFAutoincNextval:') - lcValue = ALLTRIM( SUBSTR( laConfig(m.I), 26 ) ) - IF INLIST( lcValue, '0', '1' ) THEN - lo_CFG.n_ExcludeDBFAutoincNextval = INT( VAL( lcValue ) ) - .writeLog( C_TAB + JUSTFNAME(lcConfigFile) + ' > ExcludeDBFAutoincNextval: ' + TRANSFORM(lo_CFG.n_ExcludeDBFAutoincNextval) ) - ENDIF + Case Left( laConfig(m.I), 23 ) == Lower('DBC_Conversion_Support:') + lcValue = Alltrim( Substr( laConfig(m.I), 24 ) ) + If Inlist( lcValue, '0', '1', '2' ) Then + lo_CFG.DBC_Conversion_Support = Int( Val( lcValue ) ) + .writeLog( C_TAB + Justfname(lcConfigFile) + ' > DBC_Conversion_Support: ' + Transform(lo_CFG.DBC_Conversion_Support) ) + Endif - CASE LEFT( laConfig(m.I), 12 ) == LOWER('BodyDevInfo:') - lcValue = ALLTRIM( SUBSTR( laConfig(m.I), 13 ) ) - IF INLIST( lcValue, '0', '1' ) THEN - lo_CFG.n_BodyDevInfo = INT( VAL( lcValue ) ) - .writeLog( C_TAB + JUSTFNAME(lcConfigFile) + ' > BodyDevInfo: ' + TRANSFORM(lo_CFG.n_BodyDevInfo) ) - ENDIF + Case Left( laConfig(m.I), 16 ) == Lower('BackgroundImage:') + lcValue = Alltrim( Substr( laConfig(m.I), 17 ) ) + If Empty(lcValue) Or Adir( laDirInfo, lcValue ) > 0 Then + lo_CFG.c_BackgroundImage = lcValue + .writeLog( C_TAB + Justfname(lcConfigFile) + ' > BackgroundImage: ' + Transform(lo_CFG.c_BackgroundImage) ) + 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) ) + Case Left( laConfig(m.I), 25 ) == Lower('ExcludeDBFAutoincNextval:') + lcValue = Alltrim( Substr( laConfig(m.I), 26 ) ) + If Inlist( lcValue, '0', '1' ) Then + lo_CFG.n_ExcludeDBFAutoincNextval = Int( Val( lcValue ) ) + .writeLog( C_TAB + Justfname(lcConfigFile) + ' > ExcludeDBFAutoincNextval: ' + Transform(lo_CFG.n_ExcludeDBFAutoincNextval) ) + Endif - ENDCASE - ENDFOR + Case Left( laConfig(m.I), 12 ) == Lower('BodyDevInfo:') + lcValue = Alltrim( Substr( laConfig(m.I), 13 ) ) + If Inlist( lcValue, '0', '1' ) Then + lo_CFG.n_BodyDevInfo = Int( Val( lcValue ) ) + .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 + + .writeLog( ) + + Endif && llExiste_CFG_EnDisco + +*-- ESTOS SE EVALÚAN FUERA DEL IF PORQUE NO DEPENDEN DEL CFG +*-- Y PUEDEN VENIR TAMBIÉN DE PARÁMETROS EXTERNOS. + If Inlist( Transform(tcDontShowProgress), '0', '1', '2' ) Then + lo_CFG.n_ShowProgressbar = Icase(tcDontShowProgress=='0',1, tcDontShowProgress=='1',0, 2) + Endif + If Inlist( Transform(tcDontShowErrors), '0', '1' ) Then + lo_CFG.l_ShowErrors = Not (Transform(tcDontShowErrors) == '1') + Endif +*IF NOT .l_Main_CFG_Loaded + lo_CFG.l_Recompile = (Empty(tcRecompile) Or Transform(tcRecompile) == '1' Or Directory(tcRecompile)) +*ENDIF + If Inlist( Transform(tcNoTimestamps), '0', '1' ) Then + lo_CFG.l_NoTimestamps = Not (Transform(tcNoTimestamps) == '0') + Endif + If Inlist( Transform(tcClearUniqueID), '0', '1' ) Then + lo_CFG.l_ClearUniqueID = Not (Transform(tcClearUniqueID) == '0') + Endif + If Inlist( Transform(tcDebug), '0', '1', '2' ) Then + lo_CFG.n_Debug = Int(Val(tcDebug)) + Endif + tcExtraBackupLevels = Evl( tcExtraBackupLevels, Transform( .n_ExtraBackupLevels ) ) + If Isdigit(tcExtraBackupLevels) + lo_CFG.n_ExtraBackupLevels = Int( Val( Transform(tcExtraBackupLevels) ) ) + Endif + If Inlist( Transform(tcOptimizeByFilestamp), '0', '1', '2' ) Then + lo_CFG.n_OptimizeByFilestamp = Int(Val(tcOptimizeByFilestamp)) + Endif + + .l_Main_CFG_Loaded = .T. + + If llMasterEval +* Si se inidicó un archivo CFG por parámetro (modo objeto), aqui se bloquea +* al Nº de configuración correspondiente. + If .n_CFG_EvaluateFromParam = -1 + .n_CFG_EvaluateFromParam = .n_CFG_Actual + Endif + Else +*-- Si no es llMasterEval, es porque esta llamada es cíclica desde este mismo método, +*-- y no hay parámetros para evaluar, ya que se mandan todos vacíos desde el inicial. + Exit + Endif + + .writeLog( '> ' + Upper(loLang.C_USING_THIS_SETTINGS_LOC) + ':' ) + .writeLog( C_TAB + 'n_CFG_Actual: ' + Transform(.n_CFG_Actual) + Icase(.n_CFG_Actual=1, ' [MASTER]', ' [SECONDARY]') ) + .writeLog( C_TAB + 'l_CFG_CachedAccess: ' + Transform(.l_CFG_CachedAccess) ) + .writeLog( C_TAB + 'tc_InputFile: ' + Transform(Evl(tc_InputFile,'') ) ) + .writeLog( C_TAB + 'c_Foxbin2prg_ConfigFile: ' + Transform(Evl(lo_CFG.c_Foxbin2prg_ConfigFile, '(Internal defaults)') ) ) + .writeLog( C_TAB + 'n_ShowProgressbar: ' + Transform(.n_ShowProgressbar) ) + .writeLog( C_TAB + 'l_ShowErrors: ' + Transform(.l_ShowErrors) ) + .writeLog( C_TAB + 'l_Recompile: ' + Transform(.l_Recompile) + ' (' + tcRecompile + ')' ) + .writeLog( C_TAB + 'l_NoTimestamps: ' + Transform(.l_NoTimestamps) ) + .writeLog( C_TAB + 'l_ClearUniqueID: ' + Transform(.l_ClearUniqueID) ) + .writeLog( C_TAB + 'n_UseClassPerFile: ' + Transform(.n_UseClassPerFile) ) + .writeLog( C_TAB + 'l_ClassPerFileCheck: ' + Transform(.l_ClassPerFileCheck) ) + .writeLog( C_TAB + 'l_RedirectClassPerFileToMain: ' + Transform(.l_RedirectClassPerFileToMain) ) + .writeLog( C_TAB + 'n_RedirectClassType: ' + Transform(.n_RedirectClassType) ) + .writeLog( C_TAB + 'n_Debug: ' + Transform(.n_Debug) ) + .writeLog( C_TAB + 'n_ExtraBackupLevels: ' + Transform(.n_ExtraBackupLevels) ) + .writeLog( C_TAB + 'c_BackgroundImage: ' + Transform(.c_BackgroundImage) ) + .writeLog( C_TAB + 'n_OptimizeByFilestamp: ' + Transform(.n_OptimizeByFilestamp) ) + .writeLog( C_TAB + 'n_ExcludeDBFAutoincNextval: ' + Transform(.n_ExcludeDBFAutoincNextval) ) + .writeLog( C_TAB + 'l_RemoveNullCharsFromCode: ' + Transform(.l_RemoveNullCharsFromCode) ) + .writeLog( C_TAB + 'l_RemoveZOrderSetFromProps: ' + Transform(.l_RemoveZOrderSetFromProps) ) + .writeLog( C_TAB + 'l_ClearDBFLastUpdate: ' + Transform(.l_ClearDBFLastUpdate) ) + .writeLog( C_TAB + 'c_Language: ' + Transform(.c_Language) ) .writeLog( ) + Endwith && THIS - ENDIF && llExiste_CFG_EnDisco + Catch To loEx + loEx.UserValue = loEx.UserValue + 'lcConfigFile = [' + Transform(lcConfigFile) + ']' + CR_LF + loEx.UserValue = loEx.UserValue + 'lc_CFG_Path = [' + Transform(lc_CFG_Path) + ']' + CR_LF + loEx.UserValue = loEx.UserValue + 'lcValue = [' + Transform(lcValue) + ']' + CR_LF - *-- ESTOS SE EVALÚAN FUERA DEL IF PORQUE NO DEPENDEN DEL CFG - *-- Y PUEDEN VENIR TAMBIÉN DE PARÁMETROS EXTERNOS. - IF INLIST( TRANSFORM(tcDontShowProgress), '0', '1', '2' ) THEN - lo_CFG.n_ShowProgressbar = ICASE(tcDontShowProgress=='0',1, tcDontShowProgress=='1',0, 2) - ENDIF - IF INLIST( TRANSFORM(tcDontShowErrors), '0', '1' ) THEN - lo_CFG.l_ShowErrors = NOT (TRANSFORM(tcDontShowErrors) == '1') - ENDIF - *IF NOT .l_Main_CFG_Loaded - lo_CFG.l_Recompile = (EMPTY(tcRecompile) OR TRANSFORM(tcRecompile) == '1' OR DIRECTORY(tcRecompile)) - *ENDIF - IF INLIST( TRANSFORM(tcNoTimestamps), '0', '1' ) THEN - lo_CFG.l_NoTimestamps = NOT (TRANSFORM(tcNoTimestamps) == '0') - ENDIF - IF INLIST( TRANSFORM(tcClearUniqueID), '0', '1' ) THEN - lo_CFG.l_ClearUniqueID = NOT (TRANSFORM(tcClearUniqueID) == '0') - ENDIF - IF INLIST( TRANSFORM(tcDebug), '0', '1', '2' ) THEN - lo_CFG.n_Debug = INT(VAL(tcDebug)) - ENDIF - tcExtraBackupLevels = EVL( tcExtraBackupLevels, TRANSFORM( .n_ExtraBackupLevels ) ) - IF ISDIGIT(tcExtraBackupLevels) - lo_CFG.n_ExtraBackupLevels = INT( VAL( TRANSFORM(tcExtraBackupLevels) ) ) - ENDIF - IF INLIST( TRANSFORM(tcOptimizeByFilestamp), '0', '1', '2' ) THEN - lo_CFG.n_OptimizeByFilestamp = INT(VAL(tcOptimizeByFilestamp)) - ENDIF + If This.n_Debug > 0 And _vfp.StartMode = 0 + Set Step On + Endif - .l_Main_CFG_Loaded = .T. + Throw - IF llMasterEval - * Si se inidicó un archivo CFG por parámetro (modo objeto), aqui se bloquea - * al Nº de configuración correspondiente. - IF .n_CFG_EvaluateFromParam = -1 - .n_CFG_EvaluateFromParam = .n_CFG_Actual - ENDIF - ELSE - *-- Si no es llMasterEval, es porque esta llamada es cíclica desde este mismo método, - *-- y no hay parámetros para evaluar, ya que se mandan todos vacíos desde el inicial. - EXIT - ENDIF + Finally + Store Null To lo_Configuration, lo_CFG, loEx + Release tcDontShowProgress, tcDontShowErrors, tcNoTimestamps, tcDebug, tcRecompile, tcExtraBackupLevels ; + , tcClearUniqueID, tcOptimizeByFilestamp, tc_InputFile ; + , lcConfigFile, llExiste_CFG_EnDisco, laConfig, I, lcConfData, lcExt, lcValue, lc_CFG_Path ; + , lo_CFG, lo_Configuration, loEx - .writeLog( '> ' + UPPER(loLang.C_USING_THIS_SETTINGS_LOC) + ':' ) - .writeLog( C_TAB + 'n_CFG_Actual: ' + TRANSFORM(.n_CFG_Actual) + ICASE(.n_CFG_Actual=1, ' [MASTER]', ' [SECONDARY]') ) - .writeLog( C_TAB + 'l_CFG_CachedAccess: ' + TRANSFORM(.l_CFG_CachedAccess) ) - .writeLog( C_TAB + 'tc_InputFile: ' + TRANSFORM(EVL(tc_InputFile,'') ) ) - .writeLog( C_TAB + 'c_Foxbin2prg_ConfigFile: ' + TRANSFORM(EVL(lo_CFG.c_Foxbin2prg_ConfigFile, '(Internal defaults)') ) ) - .writeLog( C_TAB + 'n_ShowProgressbar: ' + TRANSFORM(.n_ShowProgressbar) ) - .writeLog( C_TAB + 'l_ShowErrors: ' + TRANSFORM(.l_ShowErrors) ) - .writeLog( C_TAB + 'l_Recompile: ' + TRANSFORM(.l_Recompile) + ' (' + tcRecompile + ')' ) - .writeLog( C_TAB + 'l_NoTimestamps: ' + TRANSFORM(.l_NoTimestamps) ) - .writeLog( C_TAB + 'l_ClearUniqueID: ' + TRANSFORM(.l_ClearUniqueID) ) - .writeLog( C_TAB + 'n_UseClassPerFile: ' + TRANSFORM(.n_UseClassPerFile) ) - .writeLog( C_TAB + 'l_ClassPerFileCheck: ' + TRANSFORM(.l_ClassPerFileCheck) ) - .writeLog( C_TAB + 'l_RedirectClassPerFileToMain: ' + TRANSFORM(.l_RedirectClassPerFileToMain) ) - .writeLog( C_TAB + 'n_RedirectClassType: ' + TRANSFORM(.n_RedirectClassType) ) - .writeLog( C_TAB + 'n_Debug: ' + TRANSFORM(.n_Debug) ) - .writeLog( C_TAB + 'n_ExtraBackupLevels: ' + TRANSFORM(.n_ExtraBackupLevels) ) - .writeLog( C_TAB + 'c_BackgroundImage: ' + TRANSFORM(.c_BackgroundImage) ) - .writeLog( C_TAB + 'n_OptimizeByFilestamp: ' + TRANSFORM(.n_OptimizeByFilestamp) ) - .writeLog( C_TAB + 'n_ExcludeDBFAutoincNextval: ' + TRANSFORM(.n_ExcludeDBFAutoincNextval) ) - .writeLog( C_TAB + 'l_RemoveNullCharsFromCode: ' + TRANSFORM(.l_RemoveNullCharsFromCode) ) - .writeLog( C_TAB + 'l_RemoveZOrderSetFromProps: ' + TRANSFORM(.l_RemoveZOrderSetFromProps) ) - .writeLog( C_TAB + 'l_ClearDBFLastUpdate: ' + TRANSFORM(.l_ClearDBFLastUpdate) ) - .writeLog( C_TAB + 'c_Language: ' + TRANSFORM(.c_Language) ) + Endtry - .writeLog( ) - ENDWITH && THIS - - CATCH TO loEx - loEx.UserValue = loEx.UserValue + 'lcConfigFile = [' + TRANSFORM(lcConfigFile) + ']' + CR_LF - loEx.UserValue = loEx.UserValue + 'lc_CFG_Path = [' + TRANSFORM(lc_CFG_Path) + ']' + CR_LF - loEx.UserValue = loEx.UserValue + 'lcValue = [' + TRANSFORM(lcValue) + ']' + CR_LF - - IF THIS.n_Debug > 0 AND _VFP.STARTMODE = 0 - SET STEP ON - ENDIF - - THROW - - FINALLY - STORE NULL TO lo_Configuration, lo_CFG, loEx - RELEASE tcDontShowProgress, tcDontShowErrors, tcNoTimestamps, tcDebug, tcRecompile, tcExtraBackupLevels ; - , tcClearUniqueID, tcOptimizeByFilestamp, tc_InputFile ; - , lcConfigFile, llExiste_CFG_EnDisco, laConfig, I, lcConfData, lcExt, lcValue, lc_CFG_Path ; - , lo_CFG, lo_Configuration, loEx - - ENDTRY - - RETURN - ENDPROC + Return + Endproc - FUNCTION comparedFilesAreEqual - *--------------------------------------------------------------------------------------------------- - * PARÁMETROS: (v=Pasar por valor | @=Pasar por referencia) (!=Obligatorio | ?=Opcional) (IN/OUT) - * tcFilename1 (v! IN ) Nombre del archivo1 a comparar - * tcFilename2 (v! IN ) Nombre del archivo2 a comparar - * tcStrFileName2 (v! IN ) ***NO IMPLEMENTADO*** Contenido del archivo2 a comparar - *--------------------------------------------------------------------------------------------------- - LPARAMETERS tcFilename1, tcFilename2, tcStrFileName2 + Function comparedFilesAreEqual +*--------------------------------------------------------------------------------------------------- +* PARÁMETROS: (v=Pasar por valor | @=Pasar por referencia) (!=Obligatorio | ?=Opcional) (IN/OUT) +* tcFilename1 (v! IN ) Nombre del archivo1 a comparar +* tcFilename2 (v! IN ) Nombre del archivo2 a comparar +* tcStrFileName2 (v! IN ) ***NO IMPLEMENTADO*** Contenido del archivo2 a comparar +*--------------------------------------------------------------------------------------------------- + Lparameters tcFilename1, tcFilename2, tcStrFileName2 - LOCAL lnComparacion, lnLen1, lnLen2, lnHandle1, lnHandle2, lnTipoComp, lnChunkSize ; - , loEx as Exception + Local lnComparacion, lnLen1, lnLen2, lnHandle1, lnHandle2, lnTipoComp, lnChunkSize ; + , loEx As Exception - TRY - STORE -1 TO lnComparacion, lnHandle1, lnHandle2 - lnTipoComp = 0 - lnChunkSize = 65535 + Try + Store -1 To lnComparacion, lnHandle1, lnHandle2 + lnTipoComp = 0 + lnChunkSize = 65535 - DO CASE - CASE NOT EMPTY(tcFilename1) AND NOT EMPTY(tcFilename2) - lnTipoComp = 1 - lnHandle1 = FOPEN( tcFilename1 ) + Do Case + Case Not Empty(tcFilename1) And Not Empty(tcFilename2) + lnTipoComp = 1 + lnHandle1 = Fopen( tcFilename1 ) - IF lnHandle1 = -1 - EXIT - ENDIF + If lnHandle1 = -1 + Exit + Endif - lnHandle2 = FOPEN( tcFilename2 ) + lnHandle2 = Fopen( tcFilename2 ) - IF lnHandle2 = -1 - EXIT - ENDIF + If lnHandle2 = -1 + Exit + Endif - lnLen1 = FSEEK( lnHandle1, 0, 2 ) - lnLen2 = FSEEK( lnHandle2, 0, 2 ) + lnLen1 = Fseek( lnHandle1, 0, 2 ) + lnLen2 = Fseek( lnHandle2, 0, 2 ) - *-- Comparación de tamaño - IF lnLen1 <> lnLen2 THEN - lnComparacion = 0 && Son distintos - EXIT - ENDIF +*-- Comparación de tamaño + If lnLen1 <> lnLen2 Then + lnComparacion = 0 && Son distintos + Exit + Endif - *-- Comparación de contenido - FSEEK( lnHandle1, 0, 0 ) - FSEEK( lnHandle2, 0, 0 ) +*-- Comparación de contenido + Fseek( lnHandle1, 0, 0 ) + Fseek( lnHandle2, 0, 0 ) - DO WHILE NOT ( FEOF(lnHandle1) OR FEOF(lnHandle2) ) - *IF NOT SYS( 2007, FREAD( lnHandle1, lnChunkSize ), -1, 1 ) == SYS( 2007, FREAD( lnHandle2, lnChunkSize ), -1, 1 ) THEN - IF NOT FREAD( lnHandle1, lnChunkSize ) == FREAD( lnHandle2, lnChunkSize ) THEN - lnComparacion = 0 && Son distintos - EXIT - ENDIF - ENDDO + Do While Not ( Feof(lnHandle1) Or Feof(lnHandle2) ) +*IF NOT SYS( 2007, FREAD( lnHandle1, lnChunkSize ), -1, 1 ) == SYS( 2007, FREAD( lnHandle2, lnChunkSize ), -1, 1 ) THEN + If Not Fread( lnHandle1, lnChunkSize ) == Fread( lnHandle2, lnChunkSize ) Then + lnComparacion = 0 && Son distintos + Exit + Endif + Enddo - IF lnComparacion = 0 THEN - EXIT - ENDIF + If lnComparacion = 0 Then + Exit + Endif - lnComparacion = 1 && Son iguales + lnComparacion = 1 && Son iguales - ENDCASE + Endcase - CATCH TO loEx - lnComparacion = -1 && Error - THROW + Catch To loEx + lnComparacion = -1 && Error + Throw - FINALLY - DO CASE - CASE lnTipoComp = 1 - FCLOSE( lnHandle1 ) - FCLOSE( lnHandle2 ) + Finally + Do Case + Case lnTipoComp = 1 + Fclose( lnHandle1 ) + Fclose( lnHandle2 ) - ENDCASE + Endcase - ENDTRY + Endtry - RETURN lnComparacion - ENDFUNC + Return lnComparacion + Endfunc - FUNCTION filenameFoundInFilter - *--------------------------------------------------------------------------------------------------- - * PARÁMETROS: (v=Pasar por valor | @=Pasar por referencia) (!=Obligatorio | ?=Opcional) (IN/OUT) - * tcFilename (v! IN ) Nombre del archivo a evaluar - * tcFilters (v! IN ) Filtros a evaluar (*,??E.*,R*.*) - *--------------------------------------------------------------------------------------------------- - LPARAMETERS tcFileName, tcFilters + Function filenameFoundInFilter +*--------------------------------------------------------------------------------------------------- +* PARÁMETROS: (v=Pasar por valor | @=Pasar por referencia) (!=Obligatorio | ?=Opcional) (IN/OUT) +* tcFilename (v! IN ) Nombre del archivo a evaluar +* tcFilters (v! IN ) Filtros a evaluar (*,??E.*,R*.*) +*--------------------------------------------------------------------------------------------------- + Lparameters tcFileName, tcFilters - LOCAL llFound, laFiltros(1) - tcFileName = UPPER(tcFileName) + Local llFound, laFiltros(1) + tcFileName = Upper(tcFileName) - FOR I = 1 TO ALINES( laFiltros, tcFilters + ',', 1+4, ',' ) - IF LIKE( UPPER(laFiltros(m.I)), tcFileName ) + For I = 1 To Alines( laFiltros, tcFilters + ',', 1+4, ',' ) + If Like( Upper(laFiltros(m.I)), tcFileName ) llFound = .T. - EXIT - ENDIF - ENDFOR + Exit + Endif + Endfor - RELEASE tcFileName, tcFilters, laFiltros - RETURN llFound - ENDFUNC + Release tcFileName, tcFilters, laFiltros + Return llFound + Endfunc - PROCEDURE get_DBF_Configuration(tc_InputFile as String, to_out_DBF_CFG as Object, tlGenerateLog as Boolean) as Integer - *--------------------------------------------------------------------------------------------------- - * PARÁMETROS: (v=Pasar por valor | @=Pasar por referencia) (!=Obligatorio | ?=Opcional) (IN/OUT) - * tc_InputFile (@! IN ) Ruta al archivo con Extensión para comprobar si tiene soporte de conversión - * to_out_DBF_CFG (@? OUT) Objeto CFG del DBF indicado, con las propiedades que contenga el CFG y sus valores - * RETORNO (v? OUT) Devuelve 0 si no existe el archivo CFG y 1 si lo encuentra - *--------------------------------------------------------------------------------------------------- - #IF .F. - LOCAL to_out_DBF_CFG AS CL_DBF_CFG OF 'FOXBIN2PRG.PRG' - #ENDIF + Procedure get_DBF_Configuration(tc_InputFile As String, to_out_DBF_CFG As Object, tlGenerateLog As Boolean) As Integer +*--------------------------------------------------------------------------------------------------- +* PARÁMETROS: (v=Pasar por valor | @=Pasar por referencia) (!=Obligatorio | ?=Opcional) (IN/OUT) +* tc_InputFile (@! IN ) Ruta al archivo con Extensión para comprobar si tiene soporte de conversión +* to_out_DBF_CFG (@? OUT) Objeto CFG del DBF indicado, con las propiedades que contenga el CFG y sus valores +* RETORNO (v? OUT) Devuelve 0 si no existe el archivo CFG y 1 si lo encuentra +*--------------------------------------------------------------------------------------------------- + #If .F. + Local to_out_DBF_CFG As CL_DBF_CFG Of 'FOXBIN2PRG.PRG' + #Endif - LOCAL lcTableCFG, lnFileCount, laDirFile(1,5), I, lcConfigItem + Local lcTableCFG, lnFileCount, laDirFile(1,5), I, lcConfigItem lcTableCFG = tc_InputFile + '.CFG' - lnFileCount = ADIR(laDirFile, lcTableCFG) + lnFileCount = Adir(laDirFile, lcTableCFG) - IF lnFileCount = 1 - to_out_DBF_CFG = CREATEOBJECT("CL_DBF_CFG") + If lnFileCount = 1 + to_out_DBF_CFG = Createobject("CL_DBF_CFG") - IF tlGenerateLog THEN - THIS.writeLog() - THIS.writeLog(' > Found DBF configuration file: ' + lcTableCFG) - ENDIF + If tlGenerateLog Then + This.writeLog() + This.writeLog(' > Found DBF configuration file: ' + lcTableCFG) + Endif - FOR I = 1 TO ALINES( laConfig, FILETOSTR( lcTableCFG ), 1+4 ) - lcConfigItem = LOWER( laConfig(m.I) ) + For I = 1 To Alines( laConfig, Filetostr( lcTableCFG ), 1+4 ) + lcConfigItem = Lower( laConfig(m.I) ) - DO CASE - CASE INLIST( LEFT( lcConfigItem, 1 ), '*', '#', '/', "'" ) - LOOP + Do Case + Case Inlist( Left( lcConfigItem, 1 ), '*', '#', '/', "'" ) + Loop - CASE LEFT( lcConfigItem, 21 ) == LOWER('DBF_Conversion_Order:') - to_out_DBF_CFG.DBF_Conversion_Order = ALLTRIM( SUBSTR( laConfig(m.I), 22 ) ) - IF tlGenerateLog THEN - THIS.writeLog(' ' + JUSTFNAME(lcTableCFG) + ' > DBF_Conversion_Order: ' + to_out_DBF_CFG.DBF_Conversion_Order ) - ENDIF + Case Left( lcConfigItem, 21 ) == Lower('DBF_Conversion_Order:') + to_out_DBF_CFG.DBF_Conversion_Order = Alltrim( Substr( laConfig(m.I), 22 ) ) + If tlGenerateLog Then + This.writeLog(' ' + Justfname(lcTableCFG) + ' > DBF_Conversion_Order: ' + to_out_DBF_CFG.DBF_Conversion_Order ) + Endif - CASE LEFT( lcConfigItem, 25 ) == LOWER('DBF_Conversion_Condition:') - to_out_DBF_CFG.DBF_Conversion_Condition = ALLTRIM( SUBSTR( laConfig(m.I), 26 ) ) - IF tlGenerateLog THEN - THIS.writeLog(' ' + JUSTFNAME(lcTableCFG) + ' > DBF_Conversion_Condition: ' + to_out_DBF_CFG.DBF_Conversion_Condition ) - ENDIF + Case Left( lcConfigItem, 25 ) == Lower('DBF_Conversion_Condition:') + to_out_DBF_CFG.DBF_Conversion_Condition = Alltrim( Substr( laConfig(m.I), 26 ) ) + If tlGenerateLog Then + This.writeLog(' ' + Justfname(lcTableCFG) + ' > DBF_Conversion_Condition: ' + to_out_DBF_CFG.DBF_Conversion_Condition ) + Endif - CASE LEFT( lcConfigItem, 23 ) == LOWER('DBF_Conversion_Support:') - to_out_DBF_CFG.DBF_Conversion_Support = INT( VAL( SUBSTR( laConfig(m.I), 24 ) ) ) - IF tlGenerateLog THEN - THIS.writeLog(' ' + JUSTFNAME(lcTableCFG) + ' > DBF_Conversion_Support: ' + TRANSFORM(to_out_DBF_CFG.DBF_Conversion_Support) ) - ENDIF + Case Left( lcConfigItem, 23 ) == Lower('DBF_Conversion_Support:') + to_out_DBF_CFG.DBF_Conversion_Support = Int( Val( Substr( laConfig(m.I), 24 ) ) ) + If tlGenerateLog Then + This.writeLog(' ' + Justfname(lcTableCFG) + ' > DBF_Conversion_Support: ' + Transform(to_out_DBF_CFG.DBF_Conversion_Support) ) + Endif - ENDCASE - ENDFOR + Endcase + Endfor - IF tlGenerateLog THEN - THIS.writeLog() - ENDIF + If tlGenerateLog Then + This.writeLog() + Endif - ENDIF + Endif - RETURN lnFileCount - ENDPROC + Return lnFileCount + Endproc - PROCEDURE get_Ext2FromExt - *--------------------------------------------------------------------------------------------------- - * PARÁMETROS: (v=Pasar por valor | @=Pasar por referencia) (!=Obligatorio | ?=Opcional) (IN/OUT) - * tcExt (@! IN ) Extensión para comprobar si tiene soporte de conversión - * tcDir (@? IN ) Directorio del que devolver su configuración - * RETORNO (v? OUT) .T. si tiene soporte de conversión, .F. si no lo tiene - *--------------------------------------------------------------------------------------------------- - LPARAMETERS tcExt, tcDir + Procedure get_Ext2FromExt +*--------------------------------------------------------------------------------------------------- +* PARÁMETROS: (v=Pasar por valor | @=Pasar por referencia) (!=Obligatorio | ?=Opcional) (IN/OUT) +* tcExt (@! IN ) Extensión para comprobar si tiene soporte de conversión +* tcDir (@? IN ) Directorio del que devolver su configuración +* RETORNO (v? OUT) .T. si tiene soporte de conversión, .F. si no lo tiene +*--------------------------------------------------------------------------------------------------- + Lparameters tcExt, tcDir - LOCAL lcExt2 - tcExt = UPPER(tcExt) + Local lcExt2 + tcExt = Upper(tcExt) - WITH THIS AS c_foxbin2prg OF 'FOXBIN2PRG.PRG' - IF NOT EMPTY(tcDir) + With This As c_foxbin2prg Of 'FOXBIN2PRG.PRG' + If Not Empty(tcDir) .evaluateConfiguration( '', '', '', '', '', '', '', '', tcDir, 'D' ) - ENDIF + Endif - lcExt2 = ICASE( tcExt == 'PJX', .c_PJ2 ; + lcExt2 = Icase( tcExt == 'PJX', .c_PJ2 ; , tcExt == 'VCX', .c_VC2 ; , tcExt == 'SCX', .c_SC2 ; , tcExt == 'FRX', .c_FR2 ; @@ -2701,39 +2700,39 @@ DEFINE CLASS c_foxbin2prg AS Session , tcExt == 'DBF', .c_DB2 ; , tcExt == 'DBC', .c_DC2 ; , tcExt ) - ENDWITH && THIS + Endwith && THIS - RELEASE tcExt - RETURN lcExt2 - ENDPROC + Release tcExt + Return lcExt2 + Endproc - PROCEDURE hasSupport_Bin2Prg(tcFileName as String, tcDir as String) as Boolean - *--------------------------------------------------------------------------------------------------- - * PARÁMETROS: (v=Pasar por valor | @=Pasar por referencia) (!=Obligatorio | ?=Opcional) (IN/OUT) - * tcFilename (@! IN ) Extensión para comprobar si el archivo tiene soporte de conversión - * tcDir (@? IN ) Directorio del que devolver su configuración - * RETORNO (v? OUT) .T. si tiene soporte de conversión, .F. si no lo tiene - *--------------------------------------------------------------------------------------------------- - LOCAL llhasSupport, lcExt, lcDir ; - , loDBF_CFG AS CL_DBF_CFG OF 'FOXBIN2PRG.PRG' + Procedure hasSupport_Bin2Prg(tcFileName As String, tcDir As String) As Boolean +*--------------------------------------------------------------------------------------------------- +* PARÁMETROS: (v=Pasar por valor | @=Pasar por referencia) (!=Obligatorio | ?=Opcional) (IN/OUT) +* tcFilename (@! IN ) Extensión para comprobar si el archivo tiene soporte de conversión +* tcDir (@? IN ) Directorio del que devolver su configuración +* RETORNO (v? OUT) .T. si tiene soporte de conversión, .F. si no lo tiene +*--------------------------------------------------------------------------------------------------- + Local llhasSupport, lcExt, lcDir ; + , loDBF_CFG As CL_DBF_CFG Of 'FOXBIN2PRG.PRG' - WITH THIS AS c_foxbin2prg OF 'FOXBIN2PRG.PRG' - loDBF_CFG = NULL - lcExt = UPPER(JUSTEXT('.' + tcFileName)) + With This As c_foxbin2prg Of 'FOXBIN2PRG.PRG' + loDBF_CFG = Null + lcExt = Upper(Justext('.' + tcFileName)) - IF '\' $ tcFileName AND lcExt == 'DBF' THEN - lcDir = JUSTPATH(tcFileName) + If '\' $ tcFileName And lcExt == 'DBF' Then + lcDir = Justpath(tcFileName) .get_DBF_Configuration(tcFileName, @loDBF_CFG) - ELSE + Else lcDir = tcDir - ENDIF + Endif - IF NOT EMPTY(lcDir) + If Not Empty(lcDir) .evaluateConfiguration( '', '', '', '', '', '', '', '', lcDir, 'D' ) - ENDIF + Endif - llhasSupport = ICASE( lcExt == 'PJX', .PJX_Conversion_Support > 0 ; + llhasSupport = Icase( lcExt == 'PJX', .PJX_Conversion_Support > 0 ; , lcExt == 'VCX', .VCX_Conversion_Support > 0 ; , lcExt == 'SCX', .SCX_Conversion_Support > 0 ; , lcExt == 'FRX', .FRX_Conversion_Support > 0 ; @@ -2741,41 +2740,41 @@ DEFINE CLASS c_foxbin2prg AS Session , lcExt == 'MNX', .MNX_Conversion_Support > 0 ; , lcExt == 'FKY', .FKY_Conversion_Support > 0 ; , lcExt == 'MEM', .MEM_Conversion_Support > 0 ; - , lcExt == 'DBF', NOT ISNULL(loDBF_CFG) AND loDBF_CFG.DBF_Conversion_Support > 0 OR .DBF_Conversion_Support > 0 ; + , lcExt == 'DBF', Not Isnull(loDBF_CFG) And loDBF_CFG.DBF_Conversion_Support > 0 Or .DBF_Conversion_Support > 0 ; , lcExt == 'DBC', .DBC_Conversion_Support > 0 ; , .F. ) - ENDWITH && THIS + Endwith && THIS - RETURN llhasSupport - ENDPROC + Return llhasSupport + Endproc - PROCEDURE hasSupport_Prg2Bin(tcFileName as String, tcDir as String) as Boolean - *--------------------------------------------------------------------------------------------------- - * PARÁMETROS: (v=Pasar por valor | @=Pasar por referencia) (!=Obligatorio | ?=Opcional) (IN/OUT) - * tcFilename (@! IN ) Extensión para comprobar si el archivo tiene soporte de conversión - * tcDir (@? IN ) Directorio del que devolver su configuración - * RETORNO (v? OUT) .T. si tiene soporte de conversión, .F. si no lo tiene - *--------------------------------------------------------------------------------------------------- - LOCAL llhasSupport, lcExt, lcDir ; - , loDBF_CFG AS CL_DBF_CFG OF 'FOXBIN2PRG.PRG' + Procedure hasSupport_Prg2Bin(tcFileName As String, tcDir As String) As Boolean +*--------------------------------------------------------------------------------------------------- +* PARÁMETROS: (v=Pasar por valor | @=Pasar por referencia) (!=Obligatorio | ?=Opcional) (IN/OUT) +* tcFilename (@! IN ) Extensión para comprobar si el archivo tiene soporte de conversión +* tcDir (@? IN ) Directorio del que devolver su configuración +* RETORNO (v? OUT) .T. si tiene soporte de conversión, .F. si no lo tiene +*--------------------------------------------------------------------------------------------------- + Local llhasSupport, lcExt, lcDir ; + , loDBF_CFG As CL_DBF_CFG Of 'FOXBIN2PRG.PRG' - WITH THIS AS c_foxbin2prg OF 'FOXBIN2PRG.PRG' - loDBF_CFG = NULL - lcExt = UPPER(JUSTEXT('.' + tcFileName)) + With This As c_foxbin2prg Of 'FOXBIN2PRG.PRG' + loDBF_CFG = Null + lcExt = Upper(Justext('.' + tcFileName)) - IF '\' $ tcFileName AND lcExt == .c_DB2 THEN - lcDir = JUSTPATH(tcFileName) + If '\' $ tcFileName And lcExt == .c_DB2 Then + lcDir = Justpath(tcFileName) .get_DBF_Configuration(tcFileName, @loDBF_CFG) - ELSE + Else lcDir = tcDir - ENDIF + Endif - IF NOT EMPTY(lcDir) + If Not Empty(lcDir) .evaluateConfiguration( '', '', '', '', '', '', '', '', lcDir, 'D' ) - ENDIF + Endif - llhasSupport = ICASE( lcExt == .c_PJ2, .PJX_Conversion_Support = 2 ; + llhasSupport = Icase( lcExt == .c_PJ2, .PJX_Conversion_Support = 2 ; , lcExt == .c_VC2, .VCX_Conversion_Support = 2 ; , lcExt == .c_SC2, .SCX_Conversion_Support = 2 ; , lcExt == .c_FR2, .FRX_Conversion_Support = 2 ; @@ -2783,1565 +2782,1566 @@ DEFINE CLASS c_foxbin2prg AS Session , lcExt == .c_MN2, .MNX_Conversion_Support = 2 ; , lcExt == .c_FK2, .FKY_Conversion_Support = 2 ; , lcExt == .c_ME2, .MEM_Conversion_Support = 2 ; - , lcExt == .c_DB2, NOT ISNULL(loDBF_CFG) AND INLIST(loDBF_CFG.DBF_Conversion_Support, 2, 8) ; - OR (INLIST(.DBF_Conversion_Support, 2, 8) ; - AND (ISNULL(loDBF_CFG) OR NOT INLIST(loDBF_CFG.DBF_Conversion_Support, 1, 4))) ; + , lcExt == .c_DB2, Not Isnull(loDBF_CFG) And Inlist(loDBF_CFG.DBF_Conversion_Support, 2, 8) ; + OR (Inlist(.DBF_Conversion_Support, 2, 8) ; + AND (Isnull(loDBF_CFG) Or Not Inlist(loDBF_CFG.DBF_Conversion_Support, 1, 4))) ; , lcExt == .c_DC2, .DBC_Conversion_Support = 2 ; , .F. ) - ENDWITH && THIS - - RETURN llhasSupport - ENDPROC - - - PROCEDURE conversionSupportType(tcFileName as String, tlGenerarLog as Boolean) as Integer - *--------------------------------------------------------------------------------------------------- - * PARÁMETROS: (v=Pasar por valor | @=Pasar por referencia) (!=Obligatorio | ?=Opcional) (IN/OUT) - * tcFilename (@! IN ) Extensión para comprobar si el archivo tiene soporte de conversión - * RETORNO (v? OUT) Devuelve el código de soporte - *--------------------------------------------------------------------------------------------------- - LOCAL lnSupportType, lcExt, lcDir, lcFilename ; - , loDBF_CFG AS CL_DBF_CFG OF 'FOXBIN2PRG.PRG' - - TRY - WITH THIS AS c_foxbin2prg OF 'FOXBIN2PRG.PRG' - loDBF_CFG = NULL - lcExt = UPPER(JUSTEXT('.' + tcFileName)) - - IF '\' $ tcFileName AND INLIST(lcExt, .c_DB2, 'DBF') THEN - lcFilename = FORCEEXT(tcFileName, 'DBF') - lcDir = JUSTPATH(lcFilename) - .get_DBF_Configuration(lcFilename, @loDBF_CFG, tlGenerarLog) - ELSE - lcDir = SYS(5) + CURDIR() - ENDIF - - IF NOT EMPTY(lcDir) - .evaluateConfiguration( '', '', '', '', '', '', '', '', lcDir, 'D' ) - ENDIF - - lnSupportType = ICASE( ; - INLIST(lcExt, .c_PJ2, 'PJX'), .PJX_Conversion_Support ; - , INLIST(lcExt, .c_VC2, 'VCX'), .VCX_Conversion_Support ; - , INLIST(lcExt, .c_SC2, 'SCX'), .SCX_Conversion_Support ; - , INLIST(lcExt, .c_FR2, 'FRX'), .FRX_Conversion_Support ; - , INLIST(lcExt, .c_LB2, 'LBX'), .LBX_Conversion_Support ; - , INLIST(lcExt, .c_MN2, 'MNX'), .MNX_Conversion_Support ; - , INLIST(lcExt, .c_FK2, 'FKY'), .FKY_Conversion_Support ; - , INLIST(lcExt, .c_ME2, 'MEM'), .MEM_Conversion_Support ; - , INLIST(lcExt, .c_DB2, 'DBF'), ICASE( ISNULL(loDBF_CFG) OR loDBF_CFG.DBF_Conversion_Support = 0, .DBF_Conversion_Support, loDBF_CFG.DBF_Conversion_Support ) ; - , INLIST(lcExt, .c_DC2, 'DBC'), .DBC_Conversion_Support ; - , 0 ) - - lnSupportType = INT(lnSupportType) - ENDWITH && THIS - - FINALLY - STORE NULL TO loDBF_CFG - RELEASE loDBF_CFG - ENDTRY - - RETURN lnSupportType - ENDPROC - - - PROCEDURE execute - *-------------------------------------------------------------------------------------------------------------- - * PARÁMETROS: (v=Pasar por valor | @=Pasar por referencia) (!=Obligatorio | ?=Opcional) (IN/OUT) - * tc_InputFile (v! IN ) Nombre completo (fullpath) del archivo a convertir o nombre del directorio a procesar - * - En modo compatibilidad con Visual SourceSafe, se usa para preguntar el tipo de soporte de conversión para el tipo de archivo indicado - * tcType (v? IN ) Tipo de archivo de entrada. Compatibilidad con SCCTEXT.PRG - * - Si se indica "*" y tc_InputFile es un PJX, se procesan todos los archivos del proyecto y el PJX/2 - * - Si se indica "*-" y tc_InputFile es un PJX, se procesan todos los archivos del proyecto sin el PJX/2 - * - Si se indica "BIN2PRG", se procesa el directorio indicado en tc_InputFile para generar los TX2 - * - Si se indica "PRG2BIN", se procesa el directorio indicado en tc_InputFile para generar los BIN - * - En modo compatibilidad con Visual SourceSafe, indica el tipo de archivo a convertir - * tcTextName (v? IN ) Nombre del archivo texto. (Solo para compatibilidad con Visual SourceSafe) - * tlGenText (v? IN ) .T.=Genera Texto, .F.=Genera Binario. (Solo para compatibilidad con Visual SourceSafe) - * tcDontShowErrors (v? IN ) '1' para no mostrar mensajes de error (MESSAGEBOX) - * tcDebug (v? IN ) '1' para habilitar modo debug (SOLO DESARROLLO) - * tcDontShowProgress (v? IN ) '1' para inhabilitar la barra de progreso - * toModulo (@? OUT) Referencia de objeto del módulo generado (para Unit Testing) - * toEx (@? OUT) Objeto con información del error - * tlRelanzarError (v? IN ) Indica si el error debe relanzarse o no - * tcOriginalFileName (v? IN ) Sirve para los casos en los que inputFile es un nombre temporal y se quiere generar - * el nombre correcto dentro de la versión texto (por ej: en los PJ2 y las cabeceras) - * tcRecompile (v? IN ) Indica recompilar ('1') el binario una vez regenerado. [Cambio de funcionamiento por defecto] - * Este cambio es para ganar tiempo, velocidad y seguridad. Además la recompilación que hace FoxBin2Prg - * se hace desde el directorio del archivo, con lo que las referencias relativas pueden - * generar errores de compilación, típicamente los #include. - * NOTA: Si en vez de '1' se indica un Path (p.ej, el del proyecto, se usará como base para recompilar - * tcNoTimestamps (v? IN ) Indica si se debe anular el timestamp ('1') o no ('0' ó vacío) - * tcBackupLevels (v? IN ) Indica la cantidad de niveles de backup a realizar (por defecto '1') - * tcClearUniqueID (v? IN ) Indica si se debe limpiar el UniqueID ('1') o no ('0' ó vacío) - * tcOptimizeByFilestamp (v? IN ) Indica si se debe optimizar por filestamp mayor o igual ('1'), solo igual ('2') o no optimizar ('0' ó vacío) - * tcCFG_File (v? IN ) Indica si se debe usar un archivo de configuración distinto al predeterminado - *-------------------------------------------------------------------------------------------------------------- - LPARAMETERS tc_InputFile, tcType, tcTextName, tlGenText, tcDontShowErrors, tcDebug, tcDontShowProgress ; - , toModulo, toEx AS EXCEPTION, tlRelanzarError, tcOriginalFileName, tcRecompile, tcNoTimestamps ; - , tcBackupLevels, tcClearUniqueID, tcOptimizeByFilestamp, tcCFG_File, lnVFPVersion - - TRY - LOCAL I, lcPath, lnCodError, lcFileSpec, lcFile, laFiles(1,5), laDirInfo(1,5), lcInputFile_Type, lc_OldSetNotify ; - , lnFileCount, lcErrorInfo, lcErrorFile, lnPCount, laParams(1), lnConversionOption, lnErrorIcon, llError ; - , lcOldSetEscape, lcOldOnEscape, llEscKeyRestored ; - , loEx AS EXCEPTION ; - , loCFG AS CL_CFG OF 'FOXBIN2PRG.PRG' ; - , loFSO AS Scripting.FileSystemObject ; - , loLang AS CL_LANG OF 'FOXBIN2PRG.PRG' ; - , loFrm_Interactive AS frm_interactive OF 'FOXBIN2PRG.PRG' ; - , loFrm_Main AS frm_main OF 'FOXBIN2PRG.PRG' ; - , loDBF_CFG AS CL_DBF_CFG OF 'FOXBIN2PRG.PRG' ; - , loWSH AS WScript.Shell - - WITH THIS AS c_foxbin2prg OF 'FOXBIN2PRG.PRG' - lc_OldSetNotify = SET("Notify") - SET NOTIFY OFF - lnCodError = 0 - loLang = _SCREEN.o_FoxBin2Prg_Lang - loFSO = .o_FSO - loWSH = .o_WSH - loCFG = NULL - lnPCount = 0 - lcInputFile_Type = '' - .l_Error = .F. - tcType = UPPER( EVL(tcType,'') ) - llEscKeyRestored = .T. - lnVFPVersion = VERSION(5) - .declareDLL() - - IF THIS.l_CancelWithEscKey THEN - lcOldSetEscape = SET("Escape") - lcOldOnEscape = ON("Escape") - ON ESCAPE ERROR 1799 - SET ESCAPE ON - llEscKeyRestored = .F. - ENDIF - - DO CASE - CASE lnVFPVersion = 900 AND INT( VAL( SUBSTR( VERSION(4), RAT('.', VERSION(4)) + 1 ) ) ) < 3504 - ERROR loLang.C_INCORRECT_VFP9_VERSION__MISSING_SP1_LOC - - CASE lnVFPVersion < 900 - ERROR loLang.C_INCORRECT_VFP9_VERSION__MISSING_SP1_LOC - - CASE '\' $ tcType - ERROR loLang.C_INVALID_PARAMETER_LOC + ':' + CR_LF ; - + 'tcType = "' + tcType + '"' + CR_LF ; - + CR_LF ; - + loLang.C_ALLOWED_VALUES_ARE_LOC + ': ' + CR_LF ; - + '*, *-, -BIN2PRG, -PRG2BIN, -SHOWMSG, -SIMERR_I0, -SIMERR_I1, -SIMERR_O1' - - OTHERWISE - * OK all versions from 900(3504) and up. For VFPA Guys :) - ENDCASE - - DO CASE - CASE ATC('-SIMERR_I0','-'+tcType) > 0 - .c_SimulateError = 'SIMERR_I0' - CASE ATC('-SIMERR_I1','-'+tcType) > 0 - .c_SimulateError = 'SIMERR_I1' - CASE ATC('-SIMERR_O1','-'+tcType) > 0 - .c_SimulateError = 'SIMERR_O1' - ENDCASE - - IF .l_AutoClearProcessedFiles THEN - .clearProcessedFiles() && Para evitar acumular procesos anteriores - ENDIF - - *-- Funciona y lee los parámetros, pero no le veo un caso de uso claro, ya que si se eligen - *-- varios directorios de proyecto, la compilación será errónea. 12/12/2014 - *.readInputVFPParams( @laParams, @lnPCount ) - - *IF lnPCount > 0 THEN - * .writeLog( 'Params.Externos: ' + TRANSFORM(lnPCount,'@L ##') ) - * FOR I = 1 TO lnPCount - * .writeLog( 'Param.' + TRANSFORM(m.I,'@L ##') + ' [' + laParams(m.I) + ']' ) - * ENDFOR - * EXIT - *ENDIF - - *-- Reconocimiento de la clase indicada - *-- Ej: [c:\desa\test\library.vcx::classname] - IF '::' $ tc_InputFile THEN - tc_InputFile = STRTRAN(tc_InputFile, '::', '|') - .c_ClassOperationType = EVL( UPPER( LEFT( ALLTRIM( GETWORDNUM( tc_InputFile, 3, '|' ) ), 1) ), 'E') - .c_ClassToConvert = LOWER( ALLTRIM( GETWORDNUM( tc_InputFile, 2, '|' ) ) ) - * CUIDADO!, evaluar esta última, que si no las anteriores no evalúan. - tc_InputFile = LOWER( ALLTRIM( GETWORDNUM( tc_InputFile, 1, '|' ) ) ) - ELSE - .c_ClassOperationType = '' - ENDIF - - IF VARTYPE(tcCFG_File) = "O" - * Validar el objeto - loCFG = tcCFG_File - IF NOT (loCFG.Class == PROPER('CL_CFG')) - ERROR 'CFG object: Invalid class. Please, generate it with get_DirSettings()' - ENDIF - - .c_Foxbin2prg_ConfigFile = loCFG - .n_CFG_EvaluateFromParam = 1 - - ELSE - .c_Foxbin2prg_ConfigFile = EVL( tcCFG_File, .c_Foxbin2prg_ConfigFile ) - .n_CFG_EvaluateFromParam = (IIF(EMPTY(tcCFG_File), 0, 1)) - ENDIF - - *-- Ajusto la ruta si no es absoluta - tc_InputFile = .get_AbsolutePath( tc_InputFile, .c_CurDir ) - - *-- Determino el tipo de InputFile (Archivo o Directorio) - IF EMPTY(lcInputFile_Type) AND NOT EMPTY(tc_InputFile) - DO CASE - CASE LEN(tc_InputFile) = 1 - lcInputFile_Type = C_FILETYPE_QUERYSUPPORT - - CASE ADIR(laDirInfo, tc_InputFile, "D") = 1 AND SUBSTR( laDirInfo(1,5), 5, 1 ) = "D" - *-- Ejemplo: "c:\desa\" - lcInputFile_Type = C_FILETYPE_DIRECTORY - - OTHERWISE - *-- Ejemplo: "c:\desa\*.scx", "c:\desa\file.ext", (lista de archivos) - lcInputFile_Type = C_FILETYPE_FILE - ENDCASE - ENDIF - - IF EMPTY(tcRecompile) AND NOT EMPTY(lcInputFile_Type) AND NOT lcInputFile_Type == C_FILETYPE_QUERYSUPPORT THEN - IF lcInputFile_Type == C_FILETYPE_DIRECTORY THEN - tcRecompile = tc_InputFile - ELSE - tcRecompile = JUSTPATH( tc_InputFile ) - ENDIF - ENDIF - - tcRecompile = EVL(tcRecompile,'1') - .c_Recompile = tcRecompile - - .writeLog( REPLICATE( '*', 100 ) ) - .writeLog( loLang.C_MAIN_EXECUTION_LOC, 2 ) - .writeLog( REPLICATE( '*', 100 ) ) - .writeLog( '> ' + loLang.C_EXTERNAL_PARAMETERS_LOC + ':' ) - .writeLog( C_TAB + 'tc_InputFile: ' + TRANSFORM( EVL(tc_InputFile, '(empty) -> Will use Default [' + .c_InputFile + ']' ) ) ) - .writeLog( C_TAB + 'tcType: ' + TRANSFORM( EVL(tcType, '(empty)' ) ) ) - .writeLog( C_TAB + 'tcTextName: ' + TRANSFORM( EVL(tcTextName, '(empty)' ) ) ) - .writeLog( C_TAB + 'tlGenText: ' + TRANSFORM( EVL(tlGenText, '(empty)' ) ) ) - .writeLog( C_TAB + 'tcDontShowErrors: ' + TRANSFORM( EVL(tcDontShowErrors, '(empty) -> Will use Default [' + TRANSFORM(.l_ShowErrors) + ']' ) ) ) - .writeLog( C_TAB + 'tcDebug: ' + TRANSFORM( EVL(tcDebug, '(empty) -> Will use Default [' + TRANSFORM(.n_Debug) + ']' ) ) ) - .writeLog( C_TAB + 'tcDontShowProgress: ' + TRANSFORM( EVL(tcDontShowProgress, '(empty) -> Will use Default [' + TRANSFORM(.n_ShowProgressbar) + ']' ) ) ) - .writeLog( C_TAB + 'tlRelanzarError: ' + TRANSFORM( EVL(tlRelanzarError, '(empty)' ) ) ) - .writeLog( C_TAB + 'tcOriginalFileName: ' + TRANSFORM( EVL(tcOriginalFileName, '(empty) -> Will use Default [' + .c_OriginalFileName + ']' ) ) ) - .writeLog( C_TAB + 'tcRecompile: ' + TRANSFORM( EVL(tcRecompile, '(empty) -> Will use Default [' + .c_Recompile + ']' ) ) ) - .writeLog( C_TAB + 'tcNoTimestamps: ' + TRANSFORM( EVL(tcNoTimestamps, '(empty) -> Will use Default [' + TRANSFORM(.l_NoTimestamps) + ']' ) ) ) - .writeLog( C_TAB + 'tcBackupLevels: ' + TRANSFORM( EVL(tcBackupLevels, '(empty) -> Will use Default [' + TRANSFORM(.n_ExtraBackupLevels) + ']' ) ) ) - .writeLog( C_TAB + 'tcClearUniqueID: ' + TRANSFORM( EVL(tcClearUniqueID, '(empty) -> Will use Default [' + TRANSFORM(.l_ClearUniqueID) + ']' ) ) ) - .writeLog( C_TAB + 'tcOptimizeByFilestamp: ' + TRANSFORM( EVL(tcOptimizeByFilestamp, '(empty) -> Will use Default [' + TRANSFORM(.n_OptimizeByFilestamp) + ']' ) ) ) - .writeLog( ) - - *-- ARCHIVO DE CONFIGURACIÓN PRINCIPAL - .evaluateConfiguration( @tcDontShowProgress, @tcDontShowErrors, @tcNoTimestamps, @tcDebug, @tcRecompile, @tcBackupLevels ; - , @tcClearUniqueID, @tcOptimizeByFilestamp, @tc_InputFile, @lcInputFile_Type ) - - * Redefinir nombre archivo de entrada según el tipo de conversión (IMPORT/EXPORT) - IF .c_ClassOperationType = 'I' - * En el caso de importar, debo cambiar la sintaxis de tc_InputFile para poder usar - * la conversión existente de clase vc2. - * Esto deja un archivo con sintaxis "classlib.vcx::classname::import" en "classlib.classname.vc2" - IF .n_UseClassPerFile = 2 - tc_InputFile = FORCEEXT(tc_InputFile, '') + '.*.' + .c_ClassToConvert + '.' + .c_VC2 - - IF ADIR(laFiles, tc_InputFile) = 1 - tc_InputFile = FULLPATH( laFiles(1,1), tc_InputFile ) - ENDIF - - ELSE && Asumo .n_UseClassPerFile = 1 - tc_InputFile = FORCEEXT(tc_InputFile, '') + '.' + .c_ClassToConvert + '.' + .c_VC2 - - ENDIF - ENDIF - - loLang = _SCREEN.o_FoxBin2Prg_Lang - - DO CASE - CASE VERSION(5) < 900 - *-- '¡FOXBIN2PRG es solo para Visual FoxPro 9.0!' - MESSAGEBOX( loLang.C_FOXBIN2PRG_JUST_VFP_9_LOC, 0+64+4096, 'FoxBin2Prg ' + THIS.c_FB2PRG_EXE_Version + ': ' + loLang.C_FOXBIN2PRG_WARN_CAPTION_LOC + ' (' + .c_Language + ')', 60000 ) - lnCodError = 1 - - CASE EMPTY(tc_InputFile) - *-- (Ejemplo de sintaxis y uso) - *MESSAGEBOX( loLang.C_FOXBIN2PRG_SYNTAX_INFO_EXAMPLE_LOC, 0+64+4096, 'FoxBin2Prg ' + THIS.c_FB2PRG_EXE_Version + ': ' + loLang.C_FOXBIN2PRG_SYNTAX_INFO_LOC + ' (' + .c_Language + ')', 60000 ) - loFrm_Main = CREATEOBJECT('frm_main', THIS) - loFrm_Main.Show() - READ EVENTS - lnCodError = 0 - - OTHERWISE - *-- EJECUCIÓN NORMAL - - - IF ATC('-INTERACTIVE', ('-' + tcType)) > 0 ; - AND ATC('-BIN2PRG', ('-' + tcType)) = 0 AND ATC('-PRG2BIN', ('-' + tcType)) = 0 ; - AND lcInputFile_Type == C_FILETYPE_DIRECTORY THEN - *-- Se seleccionó un directorio y se puede elegir: Bin2Txt, Txt2Bin y Nada - .writeLog( loLang.C_INTERACTIVE_DIRECTORY_SELECTION_LOC ) - loFrm_Interactive = CREATEOBJECT('frm_interactive', THIS) - loFrm_Interactive.Show() - READ EVENTS - lnConversionOption = loFrm_Interactive.n_ConversionType - - IF loFrm_Interactive.l_FileTimeStampOptimization - IF .n_OptimizeByFilestamp = 0 THEN - .n_OptimizeByFilestamp = 2 - ENDIF - ELSE - .n_OptimizeByFilestamp = 0 - ENDIF - - loFrm_Interactive.Release() - loFrm_Interactive = NULL - - DO CASE - CASE lnConversionOption = 1 && Bin2Txt - tcType = tcType + '-BIN2PRG' - - CASE lnConversionOption = 2 && Txt2Bin - tcType = tcType + '-PRG2BIN' - - OTHERWISE && None - ERROR 1799 && Conversion Cancelled - ENDCASE - ENDIF - - - *-- Evaluación de FileSpec de entrada - DO CASE - CASE ATC('-BIN2PRG', ('-' + tcType)) = 0 AND ATC('-PRG2BIN', ('-' + tcType)) = 0 ; - AND lcInputFile_Type == C_FILETYPE_FILE ; - AND ( '*' $ JUSTEXT( tc_InputFile ) OR '?' $ JUSTEXT( tc_InputFile ) ) - - IF .l_ShowErrors - *MESSAGEBOX( 'No se admiten extensiones * o ? porque es peligroso (se pueden pisar binarios con archivo xx2 vacíos).', 0+48+4096, 'FOXBIN2PRG: ERROR!!', 60000 ) - MESSAGEBOX( loLang.C_ASTERISK_EXT_NOT_ALLOWED_LOC, 0+48+4096, 'FoxBin2Prg ' + THIS.c_FB2PRG_EXE_Version + ': ' + loLang.C_FOXBIN2PRG_ERROR_CAPTION_LOC, 60000 ) - EXIT - ELSE - ERROR loLang.C_ASTERISK_EXT_NOT_ALLOWED_LOC - ENDIF - - - CASE lcInputFile_Type == C_FILETYPE_FILE AND ( '*' $ JUSTSTEM( tc_InputFile ) OR '?' $ JUSTSTEM( tc_InputFile ) ) - *-- SE QUIEREN TODOS LOS ARCHIVOS DE UNA EXTENSIÓN - lcFileSpec = FULLPATH( tc_InputFile ) - .c_LogFile = ADDBS( JUSTPATH( lcFileSpec ) ) + STRTRAN( JUSTFNAME( lcFileSpec ), '*', '_ALL' ) + '.LOG' - - IF .n_Debug > 0 THEN - ERASE ( .c_LogFile ) - ENDIF - - IF EVL(tcType,'0') <> '*' THEN - IF .n_ShowProgressbar <> 0 AND .l_ProcessFiles THEN - .loadProgressbarForm() - ENDIF - - DO CASE - CASE .l_Recompile AND LEN(tcRecompile) > 3 AND DIRECTORY(tcRecompile) - CD (tcRecompile) - CASE tcRecompile == '1' - CD (JUSTPATH(lcFileSpec)) - ENDCASE - ENDIF - - lnFileCount = ADIR( laFiles, lcFileSpec, '', 1 ) - - FOR I = 1 TO lnFileCount - toModulo = NULL - lcFile = FORCEPATH( laFiles(m.I,1), JUSTPATH( lcFileSpec ) ) - - DO CASE - CASE UPPER( JUSTEXT( EVL(tc_InputFile,'') ) ) == 'PJX' AND LEFT(EVL(tcType,'0'),1) == '*' - *-- SE QUIEREN CONVERTIR A TEXTO TODOS LOS ARCHIVOS DE UNO O MÁS PROYECTOS PJX - *-- Filespec: "*.PJX", "*" - .evaluate_Full_PJX(lcFile, tcRecompile, @toModulo, @toEx, tcOriginalFileName, .c_LogFile, tcType) - - CASE UPPER( JUSTEXT( EVL(tc_InputFile,'') ) ) == .c_PJ2 AND LEFT(EVL(tcType,'0'),1) == '*' - *-- SE QUIEREN CONVERTIR A BINARIO TODOS LOS ARCHIVOS DE UNO O MÁS PROYECTOS PJ2 - *-- Filespec: "*.PJ2", "*" - .evaluate_Full_PJ2(lcFile, tcRecompile, @toModulo, @toEx, tcOriginalFileName, .c_LogFile, tcType) - - CASE ATC('-BIN2PRG', ('-' + tcType)) > 0 - *-- SE QUIEREN CONVERTIR A TEXTO TODOS LOS ARCHIVOS DE UN DIRECTORIO - *-- Filespec: "*.*" - IF .hasSupport_Bin2Prg(lcFile) THEN - .updateProgressbar( loLang.C_PROCESSING_LOC + ' ' + lcFile + '...', m.I, lnFileCount, 0 ) - lnCodError = .convert( lcFile, @toModulo, @toEx, .F., tcOriginalFileName ) - .writeLog_Flush() - - DO CASE - CASE lnCodError = 1799 && Conversion Cancelled - ERROR 1799 - - CASE lnCodError > 0 - .doWriteErrorLog( @toEx ) - llError = .T. - .l_Error = .F. - ENDCASE - ENDIF - - CASE ATC('-PRG2BIN', ('-' + tcType)) > 0 - *-- SE QUIEREN CONVERTIR A BINARIO TODOS LOS ARCHIVOS DE UN DIRECTORIO - *-- Filespec: "*.*" - IF .hasSupport_Prg2Bin(lcFile) THEN - .updateProgressbar( loLang.C_PROCESSING_LOC + ' ' + lcFile + '...', m.I, lnFileCount, 0 ) - lnCodError = .convert( lcFile, @toModulo, @toEx, .F., tcOriginalFileName ) - .writeLog_Flush() - - DO CASE - CASE lnCodError = 1799 && Conversion Cancelled - ERROR 1799 - - CASE lnCodError > 0 - .doWriteErrorLog( @toEx ) - llError = .T. - .l_Error = .F. - ENDCASE - ENDIF - - CASE EMPTY( JUSTEXT( EVL(tc_InputFile,'') ) ) - *-- NO SE INDICÓ NINGUNA EXTENSIÓN - ERROR loLang.C_INVALID_PARAMETER_LOC + ': cInputFile = "' + tc_InputFile + '"' - - OTHERWISE - *-- DEMÁS ARCHIVOS - *-- Filespec: "*.EXT" - .updateProgressbar( loLang.C_PROCESSING_LOC + ' ' + lcFile + '...', m.I, lnFileCount, 0 ) - lnCodError = .convert( lcFile, @toModulo, @toEx, .T., tcOriginalFileName ) - .writeLog_Flush() - - DO CASE - CASE lnCodError = 1799 && Conversion Cancelled - ERROR 1799 - - CASE lnCodError > 0 + Endwith && THIS + + Return llhasSupport + Endproc + + + Procedure conversionSupportType(tcFileName As String, tlGenerarLog As Boolean) As Integer +*--------------------------------------------------------------------------------------------------- +* PARÁMETROS: (v=Pasar por valor | @=Pasar por referencia) (!=Obligatorio | ?=Opcional) (IN/OUT) +* tcFilename (@! IN ) Extensión para comprobar si el archivo tiene soporte de conversión +* RETORNO (v? OUT) Devuelve el código de soporte +*--------------------------------------------------------------------------------------------------- + Local lnSupportType, lcExt, lcDir, lcFilename ; + , loDBF_CFG As CL_DBF_CFG Of 'FOXBIN2PRG.PRG' + + Try + With This As c_foxbin2prg Of 'FOXBIN2PRG.PRG' + loDBF_CFG = Null + lcExt = Upper(Justext('.' + tcFileName)) + + If '\' $ tcFileName And Inlist(lcExt, .c_DB2, 'DBF') Then + lcFilename = Forceext(tcFileName, 'DBF') + lcDir = Justpath(lcFilename) + .get_DBF_Configuration(lcFilename, @loDBF_CFG, tlGenerarLog) + Else + lcDir = Sys(5) + Curdir() + Endif + + If Not Empty(lcDir) + .evaluateConfiguration( '', '', '', '', '', '', '', '', lcDir, 'D' ) + Endif + + lnSupportType = Icase( ; + INLIST(lcExt, .c_PJ2, 'PJX'), .PJX_Conversion_Support ; + , Inlist(lcExt, .c_VC2, 'VCX'), .VCX_Conversion_Support ; + , Inlist(lcExt, .c_SC2, 'SCX'), .SCX_Conversion_Support ; + , Inlist(lcExt, .c_FR2, 'FRX'), .FRX_Conversion_Support ; + , Inlist(lcExt, .c_LB2, 'LBX'), .LBX_Conversion_Support ; + , Inlist(lcExt, .c_MN2, 'MNX'), .MNX_Conversion_Support ; + , Inlist(lcExt, .c_FK2, 'FKY'), .FKY_Conversion_Support ; + , Inlist(lcExt, .c_ME2, 'MEM'), .MEM_Conversion_Support ; + , Inlist(lcExt, .c_DB2, 'DBF'), Icase( Isnull(loDBF_CFG) Or loDBF_CFG.DBF_Conversion_Support = 0, .DBF_Conversion_Support, loDBF_CFG.DBF_Conversion_Support ) ; + , Inlist(lcExt, .c_DC2, 'DBC'), .DBC_Conversion_Support ; + , 0 ) + + lnSupportType = Int(lnSupportType) + Endwith && THIS + + Finally + Store Null To loDBF_CFG + Release loDBF_CFG + Endtry + + Return lnSupportType + Endproc + + + Procedure execute +*-------------------------------------------------------------------------------------------------------------- +* PARÁMETROS: (v=Pasar por valor | @=Pasar por referencia) (!=Obligatorio | ?=Opcional) (IN/OUT) +* tc_InputFile (v! IN ) Nombre completo (fullpath) del archivo a convertir o nombre del directorio a procesar +* - En modo compatibilidad con Visual SourceSafe, se usa para preguntar el tipo de soporte de conversión para el tipo de archivo indicado +* tcType (v? IN ) Tipo de archivo de entrada. Compatibilidad con SCCTEXT.PRG +* - Si se indica "*" y tc_InputFile es un PJX, se procesan todos los archivos del proyecto y el PJX/2 +* - Si se indica "*-" y tc_InputFile es un PJX, se procesan todos los archivos del proyecto sin el PJX/2 +* - Si se indica "BIN2PRG", se procesa el directorio indicado en tc_InputFile para generar los TX2 +* - Si se indica "PRG2BIN", se procesa el directorio indicado en tc_InputFile para generar los BIN +* - En modo compatibilidad con Visual SourceSafe, indica el tipo de archivo a convertir +* tcTextName (v? IN ) Nombre del archivo texto. (Solo para compatibilidad con Visual SourceSafe) +* tlGenText (v? IN ) .T.=Genera Texto, .F.=Genera Binario. (Solo para compatibilidad con Visual SourceSafe) +* tcDontShowErrors (v? IN ) '1' para no mostrar mensajes de error (MESSAGEBOX) +* tcDebug (v? IN ) '1' para habilitar modo debug (SOLO DESARROLLO) +* tcDontShowProgress (v? IN ) '1' para inhabilitar la barra de progreso +* toModulo (@? OUT) Referencia de objeto del módulo generado (para Unit Testing) +* toEx (@? OUT) Objeto con información del error +* tlRelanzarError (v? IN ) Indica si el error debe relanzarse o no +* tcOriginalFileName (v? IN ) Sirve para los casos en los que inputFile es un nombre temporal y se quiere generar +* el nombre correcto dentro de la versión texto (por ej: en los PJ2 y las cabeceras) +* tcRecompile (v? IN ) Indica recompilar ('1') el binario una vez regenerado. [Cambio de funcionamiento por defecto] +* Este cambio es para ganar tiempo, velocidad y seguridad. Además la recompilación que hace FoxBin2Prg +* se hace desde el directorio del archivo, con lo que las referencias relativas pueden +* generar errores de compilación, típicamente los #include. +* NOTA: Si en vez de '1' se indica un Path (p.ej, el del proyecto, se usará como base para recompilar +* tcNoTimestamps (v? IN ) Indica si se debe anular el timestamp ('1') o no ('0' ó vacío) +* tcBackupLevels (v? IN ) Indica la cantidad de niveles de backup a realizar (por defecto '1') +* tcClearUniqueID (v? IN ) Indica si se debe limpiar el UniqueID ('1') o no ('0' ó vacío) +* tcOptimizeByFilestamp (v? IN ) Indica si se debe optimizar por filestamp mayor o igual ('1'), solo igual ('2') o no optimizar ('0' ó vacío) +* tcCFG_File (v? IN ) Indica si se debe usar un archivo de configuración distinto al predeterminado +*-------------------------------------------------------------------------------------------------------------- + Lparameters tc_InputFile, tcType, tcTextName, tlGenText, tcDontShowErrors, tcDebug, tcDontShowProgress ; + , toModulo, toEx As Exception, tlRelanzarError, tcOriginalFileName, tcRecompile, tcNoTimestamps ; + , tcBackupLevels, tcClearUniqueID, tcOptimizeByFilestamp, tcCFG_File + + Try + Local I, lcPath, lnCodError, lcFileSpec, lcFile, laFiles(1,5), laDirInfo(1,5), lcInputFile_Type, lc_OldSetNotify ; + , lnFileCount, lcErrorInfo, lcErrorFile, lnPCount, laParams(1), lnConversionOption, lnErrorIcon, llError ; + , lcOldSetEscape, lcOldOnEscape, llEscKeyRestored ; + , loEx As Exception ; + , loCFG As CL_CFG Of 'FOXBIN2PRG.PRG' ; + , loFSO As Scripting.FileSystemObject ; + , loLang As CL_LANG Of 'FOXBIN2PRG.PRG' ; + , loFrm_Interactive As frm_interactive Of 'FOXBIN2PRG.PRG' ; + , loFrm_Main As frm_main Of 'FOXBIN2PRG.PRG' ; + , loDBF_CFG As CL_DBF_CFG Of 'FOXBIN2PRG.PRG' ; + , loWSH As WScript.Shell ; + , lnVFPVersion + + With This As c_foxbin2prg Of 'FOXBIN2PRG.PRG' + lc_OldSetNotify = Set("Notify") + Set Notify Off + lnCodError = 0 + loLang = _Screen.o_FoxBin2Prg_Lang + loFSO = .o_FSO + loWSH = .o_WSH + loCFG = Null + lnPCount = 0 + lcInputFile_Type = '' + .l_Error = .F. + tcType = Upper( Evl(tcType,'') ) + llEscKeyRestored = .T. + lnVFPVersion = Version(5) + .declareDLL() + + If This.l_CancelWithEscKey Then + lcOldSetEscape = Set("Escape") + lcOldOnEscape = On("Escape") + On Escape Error 1799 + Set Escape On + llEscKeyRestored = .F. + Endif + + Do Case + Case lnVFPVersion = 900 And Int( Val( Substr( Version(4), Rat('.', Version(4)) + 1 ) ) ) < 3504 + Error loLang.C_INCORRECT_VFP9_VERSION__MISSING_SP1_LOC + + Case lnVFPVersion < 900 + Error loLang.C_INCORRECT_VFP9_VERSION__MISSING_SP1_LOC + + Case '\' $ tcType + Error loLang.C_INVALID_PARAMETER_LOC + ':' + CR_LF ; + + 'tcType = "' + tcType + '"' + CR_LF ; + + CR_LF ; + + loLang.C_ALLOWED_VALUES_ARE_LOC + ': ' + CR_LF ; + + '*, *-, -BIN2PRG, -PRG2BIN, -SHOWMSG, -SIMERR_I0, -SIMERR_I1, -SIMERR_O1' + + Otherwise +* OK all versions from 900(3504) and up. For VFPA Guys :) + Endcase + + Do Case + Case Atc('-SIMERR_I0','-'+tcType) > 0 + .c_SimulateError = 'SIMERR_I0' + Case Atc('-SIMERR_I1','-'+tcType) > 0 + .c_SimulateError = 'SIMERR_I1' + Case Atc('-SIMERR_O1','-'+tcType) > 0 + .c_SimulateError = 'SIMERR_O1' + Endcase + + If .l_AutoClearProcessedFiles Then + .clearProcessedFiles() && Para evitar acumular procesos anteriores + Endif + +*-- Funciona y lee los parámetros, pero no le veo un caso de uso claro, ya que si se eligen +*-- varios directorios de proyecto, la compilación será errónea. 12/12/2014 +*.readInputVFPParams( @laParams, @lnPCount ) + +*IF lnPCount > 0 THEN +* .writeLog( 'Params.Externos: ' + TRANSFORM(lnPCount,'@L ##') ) +* FOR I = 1 TO lnPCount +* .writeLog( 'Param.' + TRANSFORM(m.I,'@L ##') + ' [' + laParams(m.I) + ']' ) +* ENDFOR +* EXIT +*ENDIF + +*-- Reconocimiento de la clase indicada +*-- Ej: [c:\desa\test\library.vcx::classname] + If '::' $ tc_InputFile Then + tc_InputFile = Strtran(tc_InputFile, '::', '|') + .c_ClassOperationType = Evl( Upper( Left( Alltrim( Getwordnum( tc_InputFile, 3, '|' ) ), 1) ), 'E') + .c_ClassToConvert = Lower( Alltrim( Getwordnum( tc_InputFile, 2, '|' ) ) ) +* CUIDADO!, evaluar esta última, que si no las anteriores no evalúan. + tc_InputFile = Lower( Alltrim( Getwordnum( tc_InputFile, 1, '|' ) ) ) + Else + .c_ClassOperationType = '' + Endif + + If Vartype(tcCFG_File) = "O" +* Validar el objeto + loCFG = tcCFG_File + If Not (loCFG.Class == Proper('CL_CFG')) + Error 'CFG object: Invalid class. Please, generate it with get_DirSettings()' + Endif + + .c_Foxbin2prg_ConfigFile = loCFG + .n_CFG_EvaluateFromParam = 1 + + Else + .c_Foxbin2prg_ConfigFile = Evl( tcCFG_File, .c_Foxbin2prg_ConfigFile ) + .n_CFG_EvaluateFromParam = (Iif(Empty(tcCFG_File), 0, 1)) + Endif + +*-- Ajusto la ruta si no es absoluta + tc_InputFile = .get_AbsolutePath( tc_InputFile, .c_CurDir ) + +*-- Determino el tipo de InputFile (Archivo o Directorio) + If Empty(lcInputFile_Type) And Not Empty(tc_InputFile) + Do Case + Case Len(tc_InputFile) = 1 + lcInputFile_Type = C_FILETYPE_QUERYSUPPORT + + Case Adir(laDirInfo, tc_InputFile, "D") = 1 And Substr( laDirInfo(1,5), 5, 1 ) = "D" +*-- Ejemplo: "c:\desa\" + lcInputFile_Type = C_FILETYPE_DIRECTORY + + Otherwise +*-- Ejemplo: "c:\desa\*.scx", "c:\desa\file.ext", (lista de archivos) + lcInputFile_Type = C_FILETYPE_FILE + Endcase + Endif + + If Empty(tcRecompile) And Not Empty(lcInputFile_Type) And Not lcInputFile_Type == C_FILETYPE_QUERYSUPPORT Then + If lcInputFile_Type == C_FILETYPE_DIRECTORY Then + tcRecompile = tc_InputFile + Else + tcRecompile = Justpath( tc_InputFile ) + Endif + Endif + + tcRecompile = Evl(tcRecompile,'1') + .c_Recompile = tcRecompile + + .writeLog( Replicate( '*', 100 ) ) + .writeLog( loLang.C_MAIN_EXECUTION_LOC, 2 ) + .writeLog( Replicate( '*', 100 ) ) + .writeLog( '> ' + loLang.C_EXTERNAL_PARAMETERS_LOC + ':' ) + .writeLog( C_TAB + 'tc_InputFile: ' + Transform( Evl(tc_InputFile, '(empty) -> Will use Default [' + .c_InputFile + ']' ) ) ) + .writeLog( C_TAB + 'tcType: ' + Transform( Evl(tcType, '(empty)' ) ) ) + .writeLog( C_TAB + 'tcTextName: ' + Transform( Evl(tcTextName, '(empty)' ) ) ) + .writeLog( C_TAB + 'tlGenText: ' + Transform( Evl(tlGenText, '(empty)' ) ) ) + .writeLog( C_TAB + 'tcDontShowErrors: ' + Transform( Evl(tcDontShowErrors, '(empty) -> Will use Default [' + Transform(.l_ShowErrors) + ']' ) ) ) + .writeLog( C_TAB + 'tcDebug: ' + Transform( Evl(tcDebug, '(empty) -> Will use Default [' + Transform(.n_Debug) + ']' ) ) ) + .writeLog( C_TAB + 'tcDontShowProgress: ' + Transform( Evl(tcDontShowProgress, '(empty) -> Will use Default [' + Transform(.n_ShowProgressbar) + ']' ) ) ) + .writeLog( C_TAB + 'tlRelanzarError: ' + Transform( Evl(tlRelanzarError, '(empty)' ) ) ) + .writeLog( C_TAB + 'tcOriginalFileName: ' + Transform( Evl(tcOriginalFileName, '(empty) -> Will use Default [' + .c_OriginalFileName + ']' ) ) ) + .writeLog( C_TAB + 'tcRecompile: ' + Transform( Evl(tcRecompile, '(empty) -> Will use Default [' + .c_Recompile + ']' ) ) ) + .writeLog( C_TAB + 'tcNoTimestamps: ' + Transform( Evl(tcNoTimestamps, '(empty) -> Will use Default [' + Transform(.l_NoTimestamps) + ']' ) ) ) + .writeLog( C_TAB + 'tcBackupLevels: ' + Transform( Evl(tcBackupLevels, '(empty) -> Will use Default [' + Transform(.n_ExtraBackupLevels) + ']' ) ) ) + .writeLog( C_TAB + 'tcClearUniqueID: ' + Transform( Evl(tcClearUniqueID, '(empty) -> Will use Default [' + Transform(.l_ClearUniqueID) + ']' ) ) ) + .writeLog( C_TAB + 'tcOptimizeByFilestamp: ' + Transform( Evl(tcOptimizeByFilestamp, '(empty) -> Will use Default [' + Transform(.n_OptimizeByFilestamp) + ']' ) ) ) + .writeLog( ) + +*-- ARCHIVO DE CONFIGURACIÓN PRINCIPAL + .evaluateConfiguration( @tcDontShowProgress, @tcDontShowErrors, @tcNoTimestamps, @tcDebug, @tcRecompile, @tcBackupLevels ; + , @tcClearUniqueID, @tcOptimizeByFilestamp, @tc_InputFile, @lcInputFile_Type ) + +* Redefinir nombre archivo de entrada según el tipo de conversión (IMPORT/EXPORT) + If .c_ClassOperationType = 'I' +* En el caso de importar, debo cambiar la sintaxis de tc_InputFile para poder usar +* la conversión existente de clase vc2. +* Esto deja un archivo con sintaxis "classlib.vcx::classname::import" en "classlib.classname.vc2" + If .n_UseClassPerFile = 2 + tc_InputFile = Forceext(tc_InputFile, '') + '.*.' + .c_ClassToConvert + '.' + .c_VC2 + + If Adir(laFiles, tc_InputFile) = 1 + tc_InputFile = Fullpath( laFiles(1,1), tc_InputFile ) + Endif + + Else && Asumo .n_UseClassPerFile = 1 + tc_InputFile = Forceext(tc_InputFile, '') + '.' + .c_ClassToConvert + '.' + .c_VC2 + + Endif + Endif + + loLang = _Screen.o_FoxBin2Prg_Lang + + Do Case + Case Version(5) < 900 +*-- '¡FOXBIN2PRG es solo para Visual FoxPro 9.0!' + Messagebox( loLang.C_FOXBIN2PRG_JUST_VFP_9_LOC, 0+64+4096, 'FoxBin2Prg ' + This.c_FB2PRG_EXE_Version + ': ' + loLang.C_FOXBIN2PRG_WARN_CAPTION_LOC + ' (' + .c_Language + ')', 60000 ) + lnCodError = 1 + + Case Empty(tc_InputFile) +*-- (Ejemplo de sintaxis y uso) +*MESSAGEBOX( loLang.C_FOXBIN2PRG_SYNTAX_INFO_EXAMPLE_LOC, 0+64+4096, 'FoxBin2Prg ' + THIS.c_FB2PRG_EXE_Version + ': ' + loLang.C_FOXBIN2PRG_SYNTAX_INFO_LOC + ' (' + .c_Language + ')', 60000 ) + loFrm_Main = Createobject('frm_main', This) + loFrm_Main.Show() + Read Events + lnCodError = 0 + + Otherwise +*-- EJECUCIÓN NORMAL + + + If Atc('-INTERACTIVE', ('-' + tcType)) > 0 ; + AND Atc('-BIN2PRG', ('-' + tcType)) = 0 And Atc('-PRG2BIN', ('-' + tcType)) = 0 ; + AND lcInputFile_Type == C_FILETYPE_DIRECTORY Then +*-- Se seleccionó un directorio y se puede elegir: Bin2Txt, Txt2Bin y Nada + .writeLog( loLang.C_INTERACTIVE_DIRECTORY_SELECTION_LOC ) + loFrm_Interactive = Createobject('frm_interactive', This) + loFrm_Interactive.Show() + Read Events + lnConversionOption = loFrm_Interactive.n_ConversionType + + If loFrm_Interactive.l_FileTimeStampOptimization + If .n_OptimizeByFilestamp = 0 Then + .n_OptimizeByFilestamp = 2 + Endif + Else + .n_OptimizeByFilestamp = 0 + Endif + + loFrm_Interactive.Release() + loFrm_Interactive = Null + + Do Case + Case lnConversionOption = 1 && Bin2Txt + tcType = tcType + '-BIN2PRG' + + Case lnConversionOption = 2 && Txt2Bin + tcType = tcType + '-PRG2BIN' + + Otherwise && None + Error 1799 && Conversion Cancelled + Endcase + Endif + + +*-- Evaluación de FileSpec de entrada + Do Case + Case Atc('-BIN2PRG', ('-' + tcType)) = 0 And Atc('-PRG2BIN', ('-' + tcType)) = 0 ; + AND lcInputFile_Type == C_FILETYPE_FILE ; + AND ( '*' $ Justext( tc_InputFile ) Or '?' $ Justext( tc_InputFile ) ) + + If .l_ShowErrors +*MESSAGEBOX( 'No se admiten extensiones * o ? porque es peligroso (se pueden pisar binarios con archivo xx2 vacíos).', 0+48+4096, 'FOXBIN2PRG: ERROR!!', 60000 ) + Messagebox( loLang.C_ASTERISK_EXT_NOT_ALLOWED_LOC, 0+48+4096, 'FoxBin2Prg ' + This.c_FB2PRG_EXE_Version + ': ' + loLang.C_FOXBIN2PRG_ERROR_CAPTION_LOC, 60000 ) + Exit + Else + Error loLang.C_ASTERISK_EXT_NOT_ALLOWED_LOC + Endif + + + Case lcInputFile_Type == C_FILETYPE_FILE And ( '*' $ Juststem( tc_InputFile ) Or '?' $ Juststem( tc_InputFile ) ) +*-- SE QUIEREN TODOS LOS ARCHIVOS DE UNA EXTENSIÓN + lcFileSpec = Fullpath( tc_InputFile ) + .c_LogFile = Addbs( Justpath( lcFileSpec ) ) + Strtran( Justfname( lcFileSpec ), '*', '_ALL' ) + '.LOG' + + If .n_Debug > 0 Then + Erase ( .c_LogFile ) + Endif + + If Evl(tcType,'0') <> '*' Then + If .n_ShowProgressbar <> 0 And .l_ProcessFiles Then + .loadProgressbarForm() + Endif + + Do Case + Case .l_Recompile And Len(tcRecompile) > 3 And Directory(tcRecompile) + Cd (tcRecompile) + Case tcRecompile == '1' + Cd (Justpath(lcFileSpec)) + Endcase + Endif + + lnFileCount = Adir( laFiles, lcFileSpec, '', 1 ) + + For I = 1 To lnFileCount + toModulo = Null + lcFile = Forcepath( laFiles(m.I,1), Justpath( lcFileSpec ) ) + + Do Case + Case Upper( Justext( Evl(tc_InputFile,'') ) ) == 'PJX' And Left(Evl(tcType,'0'),1) == '*' +*-- SE QUIEREN CONVERTIR A TEXTO TODOS LOS ARCHIVOS DE UNO O MÁS PROYECTOS PJX +*-- Filespec: "*.PJX", "*" + .evaluate_Full_PJX(lcFile, tcRecompile, @toModulo, @toEx, tcOriginalFileName, .c_LogFile, tcType) + + Case Upper( Justext( Evl(tc_InputFile,'') ) ) == .c_PJ2 And Left(Evl(tcType,'0'),1) == '*' +*-- SE QUIEREN CONVERTIR A BINARIO TODOS LOS ARCHIVOS DE UNO O MÁS PROYECTOS PJ2 +*-- Filespec: "*.PJ2", "*" + .evaluate_Full_PJ2(lcFile, tcRecompile, @toModulo, @toEx, tcOriginalFileName, .c_LogFile, tcType) + + Case Atc('-BIN2PRG', ('-' + tcType)) > 0 +*-- SE QUIEREN CONVERTIR A TEXTO TODOS LOS ARCHIVOS DE UN DIRECTORIO +*-- Filespec: "*.*" + If .hasSupport_Bin2Prg(lcFile) Then + .updateProgressbar( loLang.C_PROCESSING_LOC + ' ' + lcFile + '...', m.I, lnFileCount, 0 ) + lnCodError = .convert( lcFile, @toModulo, @toEx, .F., tcOriginalFileName ) + .writeLog_Flush() + + Do Case + Case lnCodError = 1799 && Conversion Cancelled + Error 1799 + + Case lnCodError > 0 + .doWriteErrorLog( @toEx ) + llError = .T. + .l_Error = .F. + Endcase + Endif + + Case Atc('-PRG2BIN', ('-' + tcType)) > 0 +*-- SE QUIEREN CONVERTIR A BINARIO TODOS LOS ARCHIVOS DE UN DIRECTORIO +*-- Filespec: "*.*" + If .hasSupport_Prg2Bin(lcFile) Then + .updateProgressbar( loLang.C_PROCESSING_LOC + ' ' + lcFile + '...', m.I, lnFileCount, 0 ) + lnCodError = .convert( lcFile, @toModulo, @toEx, .F., tcOriginalFileName ) + .writeLog_Flush() + + Do Case + Case lnCodError = 1799 && Conversion Cancelled + Error 1799 + + Case lnCodError > 0 + .doWriteErrorLog( @toEx ) + llError = .T. + .l_Error = .F. + Endcase + Endif + + Case Empty( Justext( Evl(tc_InputFile,'') ) ) +*-- NO SE INDICÓ NINGUNA EXTENSIÓN + Error loLang.C_INVALID_PARAMETER_LOC + ': cInputFile = "' + tc_InputFile + '"' + + Otherwise +*-- DEMÁS ARCHIVOS +*-- Filespec: "*.EXT" + .updateProgressbar( loLang.C_PROCESSING_LOC + ' ' + lcFile + '...', m.I, lnFileCount, 0 ) + lnCodError = .convert( lcFile, @toModulo, @toEx, .T., tcOriginalFileName ) + .writeLog_Flush() + + Do Case + Case lnCodError = 1799 && Conversion Cancelled + Error 1799 + + Case lnCodError > 0 + .doWriteErrorLog( @toEx ) + Endcase + Endcase + Endfor && I = 1 TO lnFileCount + + If llError + .l_Error = .T. + Endif + + Exit + + + Case Atc('-BIN2PRG', ('-' + tcType)) > 0 + .writeLog( '> ' + loLang.C_OPTION_LOC + ': BIN2PRG' ) + + If .n_ShowProgressbar <> 0 And .l_ProcessFiles Then + .loadProgressbarForm() + .o_Frm_Avance.Caption = Strtran( .o_Frm_Avance.Caption, '> -', '(Bin>Txt) -' ) + Endif + + Do Case + Case lcInputFile_Type == C_FILETYPE_DIRECTORY +*-- CONVERSION BIN2PRG DE UN DIRECTORIO Y SUBDIRECTORIOS + .writeLog( '> InputFile ' + loLang.C_IS_A_DIRECTORY_LOC ) + .writeLog() + + Do Case + Case .l_Recompile And Len(tcRecompile) > 3 And Directory(tcRecompile) + Cd (tcRecompile) + Case .l_Recompile + Cd (tc_InputFile) + Endcase + + .c_LogFile = Addbs(tc_InputFile) + tcType + '.LOG' + + If .n_Debug > 0 Then + Erase ( .c_LogFile ) + Endif + + .get_FilesFromDirectory( tc_InputFile, @laFiles, @lnFileCount ) + + For I = 1 To lnFileCount + toModulo = Null + lcFile = laFiles(m.I) + + If Not .hasSupport_Bin2Prg( lcFile ) Or Not Adir(laDirInfo, lcFile) > 0 Then + Loop + Endif + + .updateProgressbar( loLang.C_PROCESSING_LOC + ' ' + lcFile + '...', m.I, lnFileCount, 0 ) + lnCodError = .convert( lcFile, @toModulo, @toEx, .F., tcOriginalFileName ) +*!* Changed by: Lutz Scheffler 15.2.2021 +*!* change date="{^2021-02-15,06:57:00}" +* flushing the log after each file let us only see last file +* why ever, it should be appended, but we simply move +* .writeLog_Flush() after ENDFOR + +* .writeLog_Flush() + + Do Case + Case lnCodError = 1799 && Conversion Cancelled + Error 1799 + + Case lnCodError > 0 + .doWriteErrorLog( @toEx ) + Endcase + Endfor && I = 1 TO lnFileCount + .writeLog_Flush() +*!* /Changed by: Lutz Scheffler 15.2.2021 + + .updateProgressbar( loLang.C_END_OF_PROCESS_LOC, lnFileCount, lnFileCount, 0 ) + Exit + + Case Not .hasSupport_Bin2Prg( tc_InputFile ) Or Not Adir(laDirInfo, tc_InputFile) > 0 + .writeLog( '> InputFile ' + loLang.C_IS_UNSUPPORTED_LOC ) + .writeLog() + Exit + + Endcase + + + Case Atc('-PRG2BIN', ('-' + tcType)) > 0 + .writeLog( '> ' + loLang.C_OPTION_LOC + ': PRG2BIN' ) + + If .n_ShowProgressbar <> 0 And .l_ProcessFiles Then + .loadProgressbarForm() + .o_Frm_Avance.Caption = Strtran( .o_Frm_Avance.Caption, '> -', '(Txt>Bin) -' ) + Endif + + Do Case + Case lcInputFile_Type == C_FILETYPE_DIRECTORY +*-- CONVERSION PRG2BIN DE UN DIRECTORIO Y SUBDIRECTORIOS + .writeLog( '> InputFile ' + loLang.C_IS_A_DIRECTORY_LOC ) + .writeLog() + + Do Case + Case .l_Recompile And Len(tcRecompile) > 3 And Directory(tcRecompile) + Cd (tcRecompile) + Case .l_Recompile + Cd (tc_InputFile) + Endcase + + .c_LogFile = Addbs(tc_InputFile) + tcType + '.LOG' + + If .n_Debug > 0 Then + Erase ( .c_LogFile ) + Endif + + .get_FilesFromDirectory( tc_InputFile, @laFiles, @lnFileCount ) + + + For I = 1 To lnFileCount + toModulo = Null + lcFile = laFiles(m.I) + + If Not .hasSupport_Prg2Bin( lcFile ) Or Not Adir(laDirInfo, lcFile) > 0 Then + Loop + Endif + + .updateProgressbar( loLang.C_PROCESSING_LOC + ' ' + lcFile + '...', m.I, lnFileCount, 0 ) + lnCodError = .convert( lcFile, @toModulo, @toEx, .F., tcOriginalFileName ) +*!* Changed by: Lutz Scheffler 15.2.2021 +*!* change date="{^2021-02-15,06:57:00}" +* flushing the log after each file let us only see last file +* why ever, it should be appended, but we simply move +* .writeLog_Flush() after ENDFOR + +* .writeLog_Flush() + + Do Case + Case lnCodError = 1799 && Conversion Cancelled + Error 1799 + + Case lnCodError > 0 + .doWriteErrorLog( @toEx ) + Endcase + Endfor && I = 1 TO lnFileCount + .writeLog_Flush() +*!* /Changed by: Lutz Scheffler 15.2.2021 + + .updateProgressbar( loLang.C_END_OF_PROCESS_LOC, lnFileCount, lnFileCount, 0 ) + Exit + + Case Not .hasSupport_Prg2Bin( tc_InputFile ) Or Not Adir(laDirInfo, tc_InputFile) > 0 + .writeLog( '> InputFile ' + loLang.C_IS_UNSUPPORTED_LOC ) + .writeLog() + Exit + + Endcase + + + Endcase + +*-- UN ARCHIVO INDIVIDUAL O CONSULTA DE SOPORTE DE ARCHIVO + If lcInputFile_Type = C_FILETYPE_QUERYSUPPORT +*-- Consulta de soporte de conversión (compatibilidad con SourceSafe) +*-- SourceSafe consulta el tipo de soporte de cada archivo antes del Checkin/Checkout +*-- para saber si se puede hacer Diff y Merge. +*-- Para los códigos de tipo de archivo ver ayuda de "Type Property" + Do Case + Case tc_InputFile == FILETYPE_DATABASE + lnCodError = .DBC_Conversion_Support + + Case tc_InputFile == FILETYPE_FREETABLE + lnCodError = .DBF_Conversion_Support + + Case tc_InputFile == FILETYPE_FORM + lnCodError = .SCX_Conversion_Support + + Case tc_InputFile == FILETYPE_LABEL + lnCodError = .LBX_Conversion_Support + + Case tc_InputFile == FILETYPE_MENU + lnCodError = .MNX_Conversion_Support + + Case tc_InputFile == FILETYPE_REPORT + lnCodError = .FRX_Conversion_Support + + Case tc_InputFile == FILETYPE_CLASSLIB + lnCodError = .VCX_Conversion_Support + + Case tc_InputFile $ FILETYPE_PROJECT && PJX (J no exite en FoxPro, es un valor inventado para evitar conflicto con los tipos existentes) + lnCodError = .PJX_Conversion_Support + + Otherwise + lnCodError = -1 && No support. + Endcase + + Else + + Do Case + Case Upper( Justext( Evl(tc_InputFile,'') ) ) == 'PJX' And Left(Evl(tcType,'0'),1) == '*' +*-- SE QUIEREN CONVERTIR A TEXTO TODOS LOS ARCHIVOS DE UN PROYECTO PJX + .evaluate_Full_PJX(tc_InputFile, tcRecompile, @toModulo, @toEx, @tcOriginalFileName, '', tcType) + Exit + + Case Upper( Justext( Evl(tc_InputFile,'') ) ) == .c_PJ2 And Left(Evl(tcType,'0'),1) == '*' +*-- SE QUIEREN CONVERTIR A BINARIO TODOS LOS ARCHIVOS DE UN PROYECTO PJ2 + .evaluate_Full_PJ2(tc_InputFile, tcRecompile, @toModulo, @toEx, @tcOriginalFileName, '', tcType) + Exit + + Case Inlist( Evl(tcType,'0') ; + , FILETYPE_DATABASE ; + , FILETYPE_FREETABLE ; + , FILETYPE_QUERY ; + , FILETYPE_FORM ; + , FILETYPE_REPORT ; + , FILETYPE_LABEL ; + , FILETYPE_CLASSLIB ; + , FILETYPE_PROGRAM ; + , FILETYPE_PROJECT ; + , FILETYPE_APILIB ; + , FILETYPE_APPLICATION ; + , FILETYPE_MENU ; + , FILETYPE_TEXT ; + , FILETYPE_OTHER ) ; + AND Evl(tcTextName,'0') <> '0' +*-- COMPATIBILIDAD CON SOURCESAFE. 30/01/2014 + If tlGenText + .writeLog( '> ' + loLang.C_SOURCESAFE_COMPATIBILITY_MODE_LOC + ': ' + loLang.C_BINARY_TO_TEXT_LOC ) + Else +*-- Create BINARIO desde versión TEXTO +*-- Como el archivo de entrada siempre es el binario cuando se usa SCCAPI, +*-- para regenerar el binario (tlGenText=.F.) se debe usar como +*-- archivo de entrada tcTextName en su lugar. Aquí los intercambio. + tc_InputFile = tcTextName + .l_Recompile = .T. + .writeLog( '> ' + loLang.C_SOURCESAFE_COMPATIBILITY_MODE_LOC + ': ' + loLang.C_TEXT_TO_BINARY_LOC ) + Endif + Endcase + + If Adir(laDirInfo, tc_InputFile) > 0 + If .n_ShowProgressbar <> 0 And .l_ProcessFiles Then + .loadProgressbarForm() + Endif + + .writeLog( '> InputFile ' + loLang.C_IS_A_FILE_LOC ) + .writeLog() + tc_InputFile = Locfile(tc_InputFile) + + Do Case + Case .l_Recompile And Len(tcRecompile) > 3 And Directory(tcRecompile) + Cd (tcRecompile) + Case tcRecompile == '1' + Cd (Justpath(tc_InputFile)) + Endcase + + .c_LogFile = tc_InputFile + '.LOG' + + If .n_Debug > 0 Then + Erase ( .c_LogFile ) + Endif + + lnCodError = .convert( tc_InputFile, @toModulo, @toEx, .T., tcOriginalFileName ) +*.updateProgressbar( loLang.C_END_OF_PROCESS_LOC, 1, 1, 0 ) + Endif + Endif + + Endcase + Endwith && THIS + + Catch To toEx + If Not llEscKeyRestored And This.l_CancelWithEscKey Then + If Empty(lcOldOnEscape) + On Escape + Else + On Escape &lcOldOnEscape. + Endif + + If Empty(lcOldSetEscape) + Set Escape Off + Else + Set Escape &lcOldSetEscape. + Endif + llEscKeyRestored = .T. + Endif + + lnCodError = toEx.ErrorNo + lnErrorIcon = 64 + + If Vartype(loLang) <> 'O' Then + loLang = Createobject("CL_LANG","EN") + Endif + + If lnCodError <> 1799 Then && Conversion Cancelled + toEx.UserValue = toEx.UserValue + 'FoxBin2Prg: [' + This.c_Foxbin2prg_FullPath + '] (EXE Version: ' + This.c_FB2PRG_EXE_Version + ')' + CR_LF + lnErrorIcon = 16 + Endif + + If Atc('-SHOWMSG', ('-' + tcType)) > 0 Then + If lnCodError <> 1799 Then && Conversion Cancelled + toEx.UserValue = toEx.UserValue + 'lcInputFile_Type = [' + Transform(lcInputFile_Type) + ']' + CR_LF + Endif + This.l_ShowErrors = .F. && La opción "SHOWMSG" muestra su propio mensaje + Endif + + If lnCodError <> 1799 Then && Conversion Cancelled + toEx.UserValue = toEx.UserValue + 'tc_InputFile = [' + Transform(tc_InputFile) + ']' + CR_LF + Endif + + This.doWriteErrorLog( @toEx, @lcErrorInfo ) + + If This.n_Debug > 0 Then + If _vfp.StartMode = 0 + Set Step On + Endif + Endif + + If tlRelanzarError + Throw + Endif + + Finally + If Not llEscKeyRestored And This.l_CancelWithEscKey Then + If Empty(lcOldOnEscape) + On Escape + Else + On Escape &lcOldOnEscape. + Endif + + If Empty(lcOldSetEscape) + Set Escape Off + Else + Set Escape &lcOldSetEscape. + Endif + llEscKeyRestored = .T. + Endif + + If Vartype(loLang) <> 'O' Then + loLang = Createobject("CL_LANG","EN") + Endif + + Use In (Select("TABLABIN")) + This.writeLog_Flush() + This.unloadProgressbarForm() + Cd (Justpath(This.c_CurDir)) + + Do Case + Case Evl( lcInputFile_Type, C_FILETYPE_QUERYSUPPORT ) <> C_FILETYPE_QUERYSUPPORT ; + AND Atc('-SHOWMSG', ('-' + tcType)) > 0 ; + OR This.l_ShowErrors And lnCodError > 0 And Not Isnull(toEx) + This.writeErrorLog_Flush() + + Do Case + Case lnCodError = 1098 && User Error + Messagebox( toEx.Message, 0+64+4096, 'FoxBin2Prg ' + This.c_FB2PRG_EXE_Version, 60000 ) +*loWSH.Run( THIS.c_ErrorLogFile, 3 ) + This.wscriptshell_run( This.c_ErrorLogFile, 3 ) + + Case lnCodError = 1799 && Conversion Cancelled + Messagebox( loLang.C_CONVERSION_CANCELLED_BY_USER_LOC + '!', 0+64+4096, 'FoxBin2Prg ' + This.c_FB2PRG_EXE_Version, 60000 ) + + Case This.l_Errors + If Adir(laDirInfo, This.c_ErrorLogFile) > 0 Then + Messagebox( loLang.C_END_OF_PROCESS_LOC + '! (' + loLang.C_WITH_ERRORS_LOC + ')', 0+48+4096, 'FoxBin2Prg ' + This.c_FB2PRG_EXE_Version, 60000 ) +*loWSH.Run( THIS.c_ErrorLogFile, 3 ) + This.wscriptshell_run( This.c_ErrorLogFile, 3 ) + Else + Messagebox( loLang.C_END_OF_PROCESS_LOC + '! (' + loLang.C_WITH_ERRORS_LOC + ')' + CR_LF + "[Warning: Can't show Error LOG file because does not exist!]", 0+48+4096, 'FoxBin2Prg ' + This.c_FB2PRG_EXE_Version, 60000 ) + Endif + + Otherwise + Messagebox( loLang.C_END_OF_PROCESS_LOC + '', 0+64+4096, 'FoxBin2Prg ' + This.c_FB2PRG_EXE_Version, 60000 ) + + Endcase + + Endcase + + If Empty(lnCodError) And This.l_Errors + lnCodError = 1098 + Endif + + Set Notify &lc_OldSetNotify. + Store Null To loFSO, loWSH, loDBF_CFG + Release I, lcPath, lcFileSpec, lcFile, laFiles, lnFileCount, lcErrorInfo, lcErrorFile, loEx, loFSO + Endtry + + Return lnCodError + Endproc + + + Procedure evaluate_Full_PJX +*-------------------------------------------------------------------------------------------------------------- +* SE QUIEREN CONVERTIR A TEXTO TODOS LOS ARCHIVOS DE UN PROYECTO PJX +*-------------------------------------------------------------------------------------------------------------- +* PARÁMETROS: (v=Pasar por valor | @=Pasar por referencia) (!=Obligatorio | ?=Opcional) (IN/OUT) +* tc_InputFile (v! IN ) Nombre del archivo de entrada +* tcRecompile (v? IN ) Indica recompilar ('1') el binario una vez regenerado. [Cambio de funcionamiento por defecto] +* Este cambio es para ganar tiempo, velocidad y seguridad. Además la recompilación que hace FoxBin2Prg +* se hace desde el directorio del archivo, con lo que las referencias relativas pueden +* generar errores de compilación, típicamente los #include. +* NOTA: Si en vez de '1' se indica un Path (p.ej, el del proyecto, se usará como base para recompilar +* toModulo (@? OUT) Referencia de objeto del módulo generado (para Unit Testing) +* toEx (@? OUT) Objeto con información del error +* tcOriginalFileName (v? IN ) Sirve para los casos en los que inputFile es un nombre temporal y se quiere generar +* el nombre correcto dentro de la versión texto (por ej: en los PJ2 y las cabeceras) +* tcLogFile (v? IN ) Nombre del log a usar +* tcType (v? IN ) Tipo de archivo de entrada. Compatibilidad con SCCTEXT.PRG +* - Si se indica "*" y tc_InputFile es un PJX, se procesan todos los archivos del proyecto y el PJX/2 +* - Si se indica "*-" y tc_InputFile es un PJX, se procesan todos los archivos del proyecto sin el PJX/2 +*-------------------------------------------------------------------------------------------------------------- + Lparameters tc_InputFile, tcRecompile, toModulo, toEx, tcOriginalFileName, tcLogFile, tcType + + Local lcFileSpec, lnFileCount, laFiles(1,1), lcFile, lnCodError, I, lnFileCount, llError, laDirInfo(1,5) ; + , loLang As CL_LANG Of 'FOXBIN2PRG.PRG' ; + , loEx As Exception + + Try + With This As c_foxbin2prg Of 'FOXBIN2PRG.PRG' + loLang = _Screen.o_FoxBin2Prg_Lang + lcFileSpec = Fullpath( tc_InputFile ) + + If .n_ShowProgressbar <> 0 And .l_ProcessFiles Then + .loadProgressbarForm() + .o_Frm_Avance.Caption = Strtran( .o_Frm_Avance.Caption, '> -', '(Bin>Txt) -' ) + Endif + + If Empty(tcLogFile) + .c_LogFile = Addbs( Justpath( lcFileSpec ) ) + Strtran( Justfname( lcFileSpec ), '*', '_ALL' ) + '.LOG' + + If .n_Debug > 0 Then + Erase ( .c_LogFile ) + Endif + Endif + + .writeLog( '> ' + loLang.C_CONVERT_ALL_FILES_IN_A_PROJECT_LOC + ': ' + loLang.C_BINARY_TO_TEXT_LOC ) + + Do Case + Case .l_Recompile And Len(tcRecompile) > 3 And Directory(tcRecompile) + Cd (tcRecompile) + Case tcRecompile == '1' + Cd (Justpath(lcFileSpec)) + Endcase + + Select 0 + Use (tc_InputFile) Shared Again Noupdate Alias TABLABIN + lnFileCount = 0 + + Scan For Not Deleted() And Type <> 'H' + lnFileCount = lnFileCount + 1 + Dimension laFiles(lnFileCount,1) + laFiles(lnFileCount,1) = .get_AbsolutePath( Alltrim( Name, 0, ' ', Chr(0) ), Addbs( Justpath( lcFileSpec ) ) ) + Endscan + + Use In (Select("TABLABIN")) + +*-- Convierto primero el proyecto + If tcType <> '*-' Then + lcFile = tc_InputFile + lnCodError = .convert( lcFile, toModulo, @toEx, .T., tcOriginalFileName ) + .writeLog_Flush() + Endif + +*-- Luego convierto los archivos incluidos + For I = 1 To lnFileCount + lcFile = laFiles(m.I,1) + .updateProgressbar( loLang.C_PROCESSING_LOC + ' ' + lcFile + '...', m.I, lnFileCount, 0 ) + + If .hasSupport_Bin2Prg( Upper(Justext(lcFile)) ) And Adir( laDirInfo, lcFile ) > 0 Then + lnCodError = .convert( lcFile, toModulo, @toEx, .F., tcOriginalFileName ) + .writeLog_Flush() + + Do Case + Case lnCodError = 1799 && Conversion Cancelled + Error 1799 + + Case lnCodError > 0 .doWriteErrorLog( @toEx ) - ENDCASE - ENDCASE - ENDFOR && I = 1 TO lnFileCount + llError = .T. + .l_Error = .F. + Endcase + Else +*-- addProcessedFile( tcFile, tcInOutType, tcProcessed, tcHasErrors, tcSupported, tcExpanded ) + If .addProcessedFile( lcFile, 'I', 'P0', 'E0', 'S0', 'X0' ) + .updateProcessedFile() + Endif + Endif - IF llError + .writeLog_Flush() + + If llError .l_Error = .T. - ENDIF + Endif + Endfor + Endwith - EXIT + Catch To loEx + Throw + + Finally + Store Null To loLang + Release loLang + Endtry + Endproc - CASE ATC('-BIN2PRG', ('-' + tcType)) > 0 - .writeLog( '> ' + loLang.C_OPTION_LOC + ': BIN2PRG' ) + Procedure evaluate_Full_PJ2 +*-------------------------------------------------------------------------------------------------------------- +* SE QUIEREN CONVERTIR A BINARIO TODOS LOS ARCHIVOS DE UN PROYECTO PJ2 +*-------------------------------------------------------------------------------------------------------------- +* PARÁMETROS: (v=Pasar por valor | @=Pasar por referencia) (!=Obligatorio | ?=Opcional) (IN/OUT) +* tc_InputFile (v! IN ) Nombre del archivo de entrada +* tcRecompile (v? IN ) Indica recompilar ('1') el binario una vez regenerado. [Cambio de funcionamiento por defecto] +* Este cambio es para ganar tiempo, velocidad y seguridad. Además la recompilación que hace FoxBin2Prg +* se hace desde el directorio del archivo, con lo que las referencias relativas pueden +* generar errores de compilación, típicamente los #include. +* NOTA: Si en vez de '1' se indica un Path (p.ej, el del proyecto, se usará como base para recompilar +* toModulo (@? OUT) Referencia de objeto del módulo generado (para Unit Testing) +* toEx (@? OUT) Objeto con información del error +* tcOriginalFileName (v? IN ) Sirve para los casos en los que inputFile es un nombre temporal y se quiere generar +* el nombre correcto dentro de la versión texto (por ej: en los PJ2 y las cabeceras) +* tcLogFile (v? IN ) Nombre del log a usar +* tcType (v? IN ) Tipo de archivo de entrada. Compatibilidad con SCCTEXT.PRG +* - Si se indica "*" y tc_InputFile es un PJX, se procesan todos los archivos del proyecto y el PJX/2 +* - Si se indica "*-" y tc_InputFile es un PJX, se procesan todos los archivos del proyecto sin el PJX/2 +*-------------------------------------------------------------------------------------------------------------- + Lparameters tc_InputFile, tcRecompile, toModulo, toEx, tcOriginalFileName, tcLogFile, tcType - IF .n_ShowProgressbar <> 0 AND .l_ProcessFiles THEN - .loadProgressbarForm() - .o_Frm_Avance.Caption = STRTRAN( .o_Frm_Avance.Caption, '> -', '(Bin>Txt) -' ) - ENDIF + Local lcFileSpec, lnFileCount, laFiles(1,1), lcFile, lnCodError, I, lnFileCount, llError, laDirInfo(1,5) ; + , loLang As CL_LANG Of 'FOXBIN2PRG.PRG' ; + , loEx As Exception - DO CASE - CASE lcInputFile_Type == C_FILETYPE_DIRECTORY - *-- CONVERSION BIN2PRG DE UN DIRECTORIO Y SUBDIRECTORIOS - .writeLog( '> InputFile ' + loLang.C_IS_A_DIRECTORY_LOC ) - .writeLog() + Try + With This As c_foxbin2prg Of 'FOXBIN2PRG.PRG' + loLang = _Screen.o_FoxBin2Prg_Lang + lcFileSpec = Fullpath( tc_InputFile ) - DO CASE - CASE .l_Recompile AND LEN(tcRecompile) > 3 AND DIRECTORY(tcRecompile) - CD (tcRecompile) - CASE .l_Recompile - CD (tc_InputFile) - ENDCASE + If .n_ShowProgressbar <> 0 And .l_ProcessFiles Then + .loadProgressbarForm() + .o_Frm_Avance.Caption = Strtran( .o_Frm_Avance.Caption, '> -', '(Txt>Bin) -' ) + Endif - .c_LogFile = ADDBS(tc_InputFile) + tcType + '.LOG' + If Empty(tcLogFile) + .c_LogFile = Addbs( Justpath( lcFileSpec ) ) + Strtran( Justfname( lcFileSpec ), '*', '_ALL' ) + '.LOG' - IF .n_Debug > 0 THEN - ERASE ( .c_LogFile ) - ENDIF + If .n_Debug > 0 Then + Erase ( .c_LogFile ) + Endif + Endif - .get_FilesFromDirectory( tc_InputFile, @laFiles, @lnFileCount ) + .writeLog( '> ' + loLang.C_CONVERT_ALL_FILES_IN_A_PROJECT_LOC + ': ' + loLang.C_TEXT_TO_BINARY_LOC ) - FOR I = 1 TO lnFileCount - toModulo = NULL - lcFile = laFiles(m.I) + Do Case + Case .l_Recompile And Len(tcRecompile) > 3 And Directory(tcRecompile) + Cd (tcRecompile) + Case tcRecompile == '1' + Cd (Justpath(lcFileSpec)) + Endcase - IF NOT .hasSupport_Bin2Prg( lcFile ) OR NOT ADIR(laDirInfo, lcFile) > 0 THEN - LOOP - ENDIF + lnFileCount = Alines( laFiles, Strextract( Filetostr(tc_InputFile), C_BUILDPROJ_I, C_BUILDPROJ_F ), 1+4 ) - .updateProgressbar( loLang.C_PROCESSING_LOC + ' ' + lcFile + '...', m.I, lnFileCount, 0 ) - lnCodError = .convert( lcFile, @toModulo, @toEx, .F., tcOriginalFileName ) -*!* Changed by: Lutz Scheffler 15.2.2021 -*!* change date="{^2021-02-15,06:57:00}" -* flushing the log after each file let us only see last file -* why ever, it should be appended, but we simply move -* .writeLog_Flush() after ENDFOR + For I = lnFileCount To 1 Step -1 + If '.ADD(' $ laFiles(m.I) + lcFile = .get_AbsolutePath( Strextract( laFiles(m.I), ".ADD('", "')" ), Addbs( Justpath( lcFileSpec ) ) ) + laFiles(m.I) = Forceext( lcFile, .get_Ext2FromExt( Upper(Justext(lcFile)) ) ) + Else + lnFileCount = lnFileCount - 1 + Adel( laFiles, m.I ) + Dimension laFiles(lnFileCount) + Endif + Endfor -* .writeLog_Flush() +*-- Convierto primero el proyecto + If tcType <> '*-' Then + lcFile = tc_InputFile + lnCodError = .convert( lcFile, toModulo, @toEx, .T., tcOriginalFileName ) + .writeLog_Flush() + Endif - DO CASE - CASE lnCodError = 1799 && Conversion Cancelled - ERROR 1799 +*-- Luego convierto los archivos incluidos + For I = 1 To lnFileCount + lcFile = laFiles(m.I) + .updateProgressbar( loLang.C_PROCESSING_LOC + ' ' + lcFile + '...', m.I, lnFileCount, 0 ) - CASE lnCodError > 0 - .doWriteErrorLog( @toEx ) - ENDCASE - ENDFOR && I = 1 TO lnFileCount + If .hasSupport_Prg2Bin( Upper(Justext(lcFile)) ) And Adir( laDirInfo, lcFile ) > 0 Then + lnCodError = .convert( lcFile, toModulo, @toEx, .F., tcOriginalFileName ) .writeLog_Flush() -*!* /Changed by: Lutz Scheffler 15.2.2021 - .updateProgressbar( loLang.C_END_OF_PROCESS_LOC, lnFileCount, lnFileCount, 0 ) - EXIT + Do Case + Case lnCodError = 1799 && Conversion Cancelled + Error 1799 - CASE NOT .hasSupport_Bin2Prg( tc_InputFile ) OR NOT ADIR(laDirInfo, tc_InputFile) > 0 - .writeLog( '> InputFile ' + loLang.C_IS_UNSUPPORTED_LOC ) - .writeLog() - EXIT - - ENDCASE - - - CASE ATC('-PRG2BIN', ('-' + tcType)) > 0 - .writeLog( '> ' + loLang.C_OPTION_LOC + ': PRG2BIN' ) - - IF .n_ShowProgressbar <> 0 AND .l_ProcessFiles THEN - .loadProgressbarForm() - .o_Frm_Avance.Caption = STRTRAN( .o_Frm_Avance.Caption, '> -', '(Txt>Bin) -' ) - ENDIF - - DO CASE - CASE lcInputFile_Type == C_FILETYPE_DIRECTORY - *-- CONVERSION PRG2BIN DE UN DIRECTORIO Y SUBDIRECTORIOS - .writeLog( '> InputFile ' + loLang.C_IS_A_DIRECTORY_LOC ) - .writeLog() - - DO CASE - CASE .l_Recompile AND LEN(tcRecompile) > 3 AND DIRECTORY(tcRecompile) - CD (tcRecompile) - CASE .l_Recompile - CD (tc_InputFile) - ENDCASE - - .c_LogFile = ADDBS(tc_InputFile) + tcType + '.LOG' - - IF .n_Debug > 0 THEN - ERASE ( .c_LogFile ) - ENDIF - - .get_FilesFromDirectory( tc_InputFile, @laFiles, @lnFileCount ) - - - FOR I = 1 TO lnFileCount - toModulo = NULL - lcFile = laFiles(m.I) - - IF NOT .hasSupport_Prg2Bin( lcFile ) OR NOT ADIR(laDirInfo, lcFile) > 0 THEN - LOOP - ENDIF - - .updateProgressbar( loLang.C_PROCESSING_LOC + ' ' + lcFile + '...', m.I, lnFileCount, 0 ) - lnCodError = .convert( lcFile, @toModulo, @toEx, .F., tcOriginalFileName ) -*!* Changed by: Lutz Scheffler 15.2.2021 -*!* change date="{^2021-02-15,06:57:00}" -* flushing the log after each file let us only see last file -* why ever, it should be appended, but we simply move -* .writeLog_Flush() after ENDFOR - -* .writeLog_Flush() - - DO CASE - CASE lnCodError = 1799 && Conversion Cancelled - ERROR 1799 - - CASE lnCodError > 0 + Case lnCodError > 0 .doWriteErrorLog( @toEx ) - ENDCASE - ENDFOR && I = 1 TO lnFileCount - .writeLog_Flush() -*!* /Changed by: Lutz Scheffler 15.2.2021 + llError = .T. + .l_Error = .F. + Endcase + Else +*-- addProcessedFile( tcFile, tcInOutType, tcProcessed, tcHasErrors, tcSupported, tcExpanded ) + If .addProcessedFile( lcFile, 'I', 'P0', 'E0', 'S0', 'X0' ) + .updateProcessedFile() + Endif + Endif - .updateProgressbar( loLang.C_END_OF_PROCESS_LOC, lnFileCount, lnFileCount, 0 ) - EXIT - - CASE NOT .hasSupport_Prg2Bin( tc_InputFile ) OR NOT ADIR(laDirInfo, tc_InputFile) > 0 - .writeLog( '> InputFile ' + loLang.C_IS_UNSUPPORTED_LOC ) - .writeLog() - EXIT - - ENDCASE - - - ENDCASE - - *-- UN ARCHIVO INDIVIDUAL O CONSULTA DE SOPORTE DE ARCHIVO - IF lcInputFile_Type = C_FILETYPE_QUERYSUPPORT - *-- Consulta de soporte de conversión (compatibilidad con SourceSafe) - *-- SourceSafe consulta el tipo de soporte de cada archivo antes del Checkin/Checkout - *-- para saber si se puede hacer Diff y Merge. - *-- Para los códigos de tipo de archivo ver ayuda de "Type Property" - DO CASE - CASE tc_InputFile == FILETYPE_DATABASE - lnCodError = .DBC_Conversion_Support - - CASE tc_InputFile == FILETYPE_FREETABLE - lnCodError = .DBF_Conversion_Support - - CASE tc_InputFile == FILETYPE_FORM - lnCodError = .SCX_Conversion_Support - - CASE tc_InputFile == FILETYPE_LABEL - lnCodError = .LBX_Conversion_Support - - CASE tc_InputFile == FILETYPE_MENU - lnCodError = .MNX_Conversion_Support - - CASE tc_InputFile == FILETYPE_REPORT - lnCodError = .FRX_Conversion_Support - - CASE tc_InputFile == FILETYPE_CLASSLIB - lnCodError = .VCX_Conversion_Support - - CASE tc_InputFile $ FILETYPE_PROJECT && PJX (J no exite en FoxPro, es un valor inventado para evitar conflicto con los tipos existentes) - lnCodError = .PJX_Conversion_Support - - OTHERWISE - lnCodError = -1 && No support. - ENDCASE - - ELSE - - DO CASE - CASE UPPER( JUSTEXT( EVL(tc_InputFile,'') ) ) == 'PJX' AND LEFT(EVL(tcType,'0'),1) == '*' - *-- SE QUIEREN CONVERTIR A TEXTO TODOS LOS ARCHIVOS DE UN PROYECTO PJX - .evaluate_Full_PJX(tc_InputFile, tcRecompile, @toModulo, @toEx, @tcOriginalFileName, '', tcType) - EXIT - - CASE UPPER( JUSTEXT( EVL(tc_InputFile,'') ) ) == .c_PJ2 AND LEFT(EVL(tcType,'0'),1) == '*' - *-- SE QUIEREN CONVERTIR A BINARIO TODOS LOS ARCHIVOS DE UN PROYECTO PJ2 - .evaluate_Full_PJ2(tc_InputFile, tcRecompile, @toModulo, @toEx, @tcOriginalFileName, '', tcType) - EXIT - - CASE INLIST( EVL(tcType,'0') ; - , FILETYPE_DATABASE ; - , FILETYPE_FREETABLE ; - , FILETYPE_QUERY ; - , FILETYPE_FORM ; - , FILETYPE_REPORT ; - , FILETYPE_LABEL ; - , FILETYPE_CLASSLIB ; - , FILETYPE_PROGRAM ; - , FILETYPE_PROJECT ; - , FILETYPE_APILIB ; - , FILETYPE_APPLICATION ; - , FILETYPE_MENU ; - , FILETYPE_TEXT ; - , FILETYPE_OTHER ) ; - AND EVL(tcTextName,'0') <> '0' - *-- COMPATIBILIDAD CON SOURCESAFE. 30/01/2014 - IF tlGenText - .writeLog( '> ' + loLang.C_SOURCESAFE_COMPATIBILITY_MODE_LOC + ': ' + loLang.C_BINARY_TO_TEXT_LOC ) - ELSE - *-- Create BINARIO desde versión TEXTO - *-- Como el archivo de entrada siempre es el binario cuando se usa SCCAPI, - *-- para regenerar el binario (tlGenText=.F.) se debe usar como - *-- archivo de entrada tcTextName en su lugar. Aquí los intercambio. - tc_InputFile = tcTextName - .l_Recompile = .T. - .writeLog( '> ' + loLang.C_SOURCESAFE_COMPATIBILITY_MODE_LOC + ': ' + loLang.C_TEXT_TO_BINARY_LOC ) - ENDIF - ENDCASE - - IF ADIR(laDirInfo, tc_InputFile) > 0 - IF .n_ShowProgressbar <> 0 AND .l_ProcessFiles THEN - .loadProgressbarForm() - ENDIF - - .writeLog( '> InputFile ' + loLang.C_IS_A_FILE_LOC ) - .writeLog() - tc_InputFile = LOCFILE(tc_InputFile) - - DO CASE - CASE .l_Recompile AND LEN(tcRecompile) > 3 AND DIRECTORY(tcRecompile) - CD (tcRecompile) - CASE tcRecompile == '1' - CD (JUSTPATH(tc_InputFile)) - ENDCASE - - .c_LogFile = tc_InputFile + '.LOG' - - IF .n_Debug > 0 THEN - ERASE ( .c_LogFile ) - ENDIF - - lnCodError = .convert( tc_InputFile, @toModulo, @toEx, .T., tcOriginalFileName ) - *.updateProgressbar( loLang.C_END_OF_PROCESS_LOC, 1, 1, 0 ) - ENDIF - ENDIF - - ENDCASE - ENDWITH && THIS - - CATCH TO toEx - IF NOT llEscKeyRestored AND THIS.l_CancelWithEscKey THEN - IF EMPTY(lcOldOnEscape) - ON ESCAPE - ELSE - ON ESCAPE &lcOldOnEscape. - ENDIF - - IF EMPTY(lcOldSetEscape) - SET ESCAPE OFF - ELSE - SET ESCAPE &lcOldSetEscape. - ENDIF - llEscKeyRestored = .T. - ENDIF - - lnCodError = toEx.ERRORNO - lnErrorIcon = 64 - - IF VARTYPE(loLang) <> 'O' THEN - loLang = CREATEOBJECT("CL_LANG","EN") - ENDIF - - IF lnCodError <> 1799 THEN && Conversion Cancelled - toEx.UserValue = toEx.UserValue + 'FoxBin2Prg: [' + THIS.c_Foxbin2prg_FullPath + '] (EXE Version: ' + THIS.c_FB2PRG_EXE_Version + ')' + CR_LF - lnErrorIcon = 16 - ENDIF - - IF ATC('-SHOWMSG', ('-' + tcType)) > 0 THEN - IF lnCodError <> 1799 THEN && Conversion Cancelled - toEx.UserValue = toEx.UserValue + 'lcInputFile_Type = [' + TRANSFORM(lcInputFile_Type) + ']' + CR_LF - ENDIF - THIS.l_ShowErrors = .F. && La opción "SHOWMSG" muestra su propio mensaje - ENDIF - - IF lnCodError <> 1799 THEN && Conversion Cancelled - toEx.USERVALUE = toEx.USERVALUE + 'tc_InputFile = [' + TRANSFORM(tc_InputFile) + ']' + CR_LF - ENDIF - - THIS.doWriteErrorLog( @toEx, @lcErrorInfo ) - - IF THIS.n_Debug > 0 THEN - IF _VFP.STARTMODE = 0 - SET STEP ON - ENDIF - ENDIF - - IF tlRelanzarError - THROW - ENDIF - - FINALLY - IF NOT llEscKeyRestored AND THIS.l_CancelWithEscKey THEN - IF EMPTY(lcOldOnEscape) - ON ESCAPE - ELSE - ON ESCAPE &lcOldOnEscape. - ENDIF - - IF EMPTY(lcOldSetEscape) - SET ESCAPE OFF - ELSE - SET ESCAPE &lcOldSetEscape. - ENDIF - llEscKeyRestored = .T. - ENDIF - - IF VARTYPE(loLang) <> 'O' THEN - loLang = CREATEOBJECT("CL_LANG","EN") - ENDIF - - USE IN (SELECT("TABLABIN")) - THIS.writeLog_Flush() - THIS.unloadProgressbarForm() - CD (JUSTPATH(THIS.c_CurDir)) - - DO CASE - CASE EVL( lcInputFile_Type, C_FILETYPE_QUERYSUPPORT ) <> C_FILETYPE_QUERYSUPPORT ; - AND ATC('-SHOWMSG', ('-' + tcType)) > 0 ; - OR THIS.l_ShowErrors AND lnCodError > 0 AND NOT ISNULL(toEx) - THIS.writeErrorLog_Flush() - - DO CASE - CASE lnCodError = 1098 && User Error - MESSAGEBOX( toEx.Message, 0+64+4096, 'FoxBin2Prg ' + THIS.c_FB2PRG_EXE_Version, 60000 ) - *loWSH.Run( THIS.c_ErrorLogFile, 3 ) - THIS.wscriptshell_run( THIS.c_ErrorLogFile, 3 ) - - CASE lnCodError = 1799 && Conversion Cancelled - MESSAGEBOX( loLang.C_CONVERSION_CANCELLED_BY_USER_LOC + '!', 0+64+4096, 'FoxBin2Prg ' + THIS.c_FB2PRG_EXE_Version, 60000 ) - - CASE THIS.l_Errors - IF ADIR(laDirInfo, THIS.c_ErrorLogFile) > 0 THEN - MESSAGEBOX( loLang.C_END_OF_PROCESS_LOC + '! (' + loLang.C_WITH_ERRORS_LOC + ')', 0+48+4096, 'FoxBin2Prg ' + THIS.c_FB2PRG_EXE_Version, 60000 ) - *loWSH.Run( THIS.c_ErrorLogFile, 3 ) - THIS.wscriptshell_run( THIS.c_ErrorLogFile, 3 ) - ELSE - MESSAGEBOX( loLang.C_END_OF_PROCESS_LOC + '! (' + loLang.C_WITH_ERRORS_LOC + ')' + CR_LF + "[Warning: Can't show Error LOG file because does not exist!]", 0+48+4096, 'FoxBin2Prg ' + THIS.c_FB2PRG_EXE_Version, 60000 ) - ENDIF - - OTHERWISE - MESSAGEBOX( loLang.C_END_OF_PROCESS_LOC + '', 0+64+4096, 'FoxBin2Prg ' + THIS.c_FB2PRG_EXE_Version, 60000 ) - - ENDCASE - - ENDCASE - - IF EMPTY(lnCodError) AND THIS.l_Errors - lnCodError = 1098 - ENDIF - - SET NOTIFY &lc_OldSetNotify. - STORE NULL TO loFSO, loWSH, loDBF_CFG - RELEASE I, lcPath, lcFileSpec, lcFile, laFiles, lnFileCount, lcErrorInfo, lcErrorFile, loEx, loFSO - ENDTRY - - RETURN lnCodError - ENDPROC - - - PROCEDURE evaluate_Full_PJX - *-------------------------------------------------------------------------------------------------------------- - * SE QUIEREN CONVERTIR A TEXTO TODOS LOS ARCHIVOS DE UN PROYECTO PJX - *-------------------------------------------------------------------------------------------------------------- - * PARÁMETROS: (v=Pasar por valor | @=Pasar por referencia) (!=Obligatorio | ?=Opcional) (IN/OUT) - * tc_InputFile (v! IN ) Nombre del archivo de entrada - * tcRecompile (v? IN ) Indica recompilar ('1') el binario una vez regenerado. [Cambio de funcionamiento por defecto] - * Este cambio es para ganar tiempo, velocidad y seguridad. Además la recompilación que hace FoxBin2Prg - * se hace desde el directorio del archivo, con lo que las referencias relativas pueden - * generar errores de compilación, típicamente los #include. - * NOTA: Si en vez de '1' se indica un Path (p.ej, el del proyecto, se usará como base para recompilar - * toModulo (@? OUT) Referencia de objeto del módulo generado (para Unit Testing) - * toEx (@? OUT) Objeto con información del error - * tcOriginalFileName (v? IN ) Sirve para los casos en los que inputFile es un nombre temporal y se quiere generar - * el nombre correcto dentro de la versión texto (por ej: en los PJ2 y las cabeceras) - * tcLogFile (v? IN ) Nombre del log a usar - * tcType (v? IN ) Tipo de archivo de entrada. Compatibilidad con SCCTEXT.PRG - * - Si se indica "*" y tc_InputFile es un PJX, se procesan todos los archivos del proyecto y el PJX/2 - * - Si se indica "*-" y tc_InputFile es un PJX, se procesan todos los archivos del proyecto sin el PJX/2 - *-------------------------------------------------------------------------------------------------------------- - LPARAMETERS tc_InputFile, tcRecompile, toModulo, toEx, tcOriginalFileName, tcLogFile, tcType - - LOCAL lcFileSpec, lnFileCount, laFiles(1,1), lcFile, lnCodError, I, lnFileCount, llError, laDirInfo(1,5) ; - , loLang AS CL_LANG OF 'FOXBIN2PRG.PRG' ; - , loEx as Exception - - TRY - WITH THIS AS c_foxbin2prg OF 'FOXBIN2PRG.PRG' - loLang = _SCREEN.o_FoxBin2Prg_Lang - lcFileSpec = FULLPATH( tc_InputFile ) - - IF .n_ShowProgressbar <> 0 AND .l_ProcessFiles THEN - .loadProgressbarForm() - .o_Frm_Avance.Caption = STRTRAN( .o_Frm_Avance.Caption, '> -', '(Bin>Txt) -' ) - ENDIF - - IF EMPTY(tcLogFile) - .c_LogFile = ADDBS( JUSTPATH( lcFileSpec ) ) + STRTRAN( JUSTFNAME( lcFileSpec ), '*', '_ALL' ) + '.LOG' - - IF .n_Debug > 0 THEN - ERASE ( .c_LogFile ) - ENDIF - ENDIF - - .writeLog( '> ' + loLang.C_CONVERT_ALL_FILES_IN_A_PROJECT_LOC + ': ' + loLang.C_BINARY_TO_TEXT_LOC ) - - DO CASE - CASE .l_Recompile AND LEN(tcRecompile) > 3 AND DIRECTORY(tcRecompile) - CD (tcRecompile) - CASE tcRecompile == '1' - CD (JUSTPATH(lcFileSpec)) - ENDCASE - - SELECT 0 - USE (tc_InputFile) SHARED AGAIN NOUPDATE ALIAS TABLABIN - lnFileCount = 0 - - SCAN FOR NOT DELETED() AND Type <> 'H' - lnFileCount = lnFileCount + 1 - DIMENSION laFiles(lnFileCount,1) - laFiles(lnFileCount,1) = .get_AbsolutePath( ALLTRIM( NAME, 0, ' ', CHR(0) ), ADDBS( JUSTPATH( lcFileSpec ) ) ) - ENDSCAN - - USE IN (SELECT("TABLABIN")) - - *-- Convierto primero el proyecto - IF tcType <> '*-' THEN - lcFile = tc_InputFile - lnCodError = .convert( lcFile, toModulo, @toEx, .T., tcOriginalFileName ) - .writeLog_Flush() - ENDIF - - *-- Luego convierto los archivos incluidos - FOR I = 1 TO lnFileCount - lcFile = laFiles(m.I,1) - .updateProgressbar( loLang.C_PROCESSING_LOC + ' ' + lcFile + '...', m.I, lnFileCount, 0 ) - - IF .hasSupport_Bin2Prg( UPPER(JUSTEXT(lcFile)) ) AND ADIR( laDirInfo, lcFile ) > 0 THEN - lnCodError = .convert( lcFile, toModulo, @toEx, .F., tcOriginalFileName ) .writeLog_Flush() - DO CASE - CASE lnCodError = 1799 && Conversion Cancelled - ERROR 1799 + If llError + .l_Error = .T. + Endif + Endfor + Endwith - CASE lnCodError > 0 - .doWriteErrorLog( @toEx ) - llError = .T. - .l_Error = .F. - ENDCASE - ELSE - *-- addProcessedFile( tcFile, tcInOutType, tcProcessed, tcHasErrors, tcSupported, tcExpanded ) - IF .addProcessedFile( lcFile, 'I', 'P0', 'E0', 'S0', 'X0' ) - .updateProcessedFile() - ENDIF - ENDIF + Catch To loEx + Throw - .writeLog_Flush() - - IF llError - .l_Error = .T. - ENDIF - ENDFOR - ENDWITH - - CATCH TO loEx - THROW - - FINALLY - STORE NULL TO loLang - RELEASE loLang - ENDTRY - ENDPROC + Finally + Store Null To loLang + Release loLang + Endtry + Endproc - PROCEDURE evaluate_Full_PJ2 - *-------------------------------------------------------------------------------------------------------------- - * SE QUIEREN CONVERTIR A BINARIO TODOS LOS ARCHIVOS DE UN PROYECTO PJ2 - *-------------------------------------------------------------------------------------------------------------- - * PARÁMETROS: (v=Pasar por valor | @=Pasar por referencia) (!=Obligatorio | ?=Opcional) (IN/OUT) - * tc_InputFile (v! IN ) Nombre del archivo de entrada - * tcRecompile (v? IN ) Indica recompilar ('1') el binario una vez regenerado. [Cambio de funcionamiento por defecto] - * Este cambio es para ganar tiempo, velocidad y seguridad. Además la recompilación que hace FoxBin2Prg - * se hace desde el directorio del archivo, con lo que las referencias relativas pueden - * generar errores de compilación, típicamente los #include. - * NOTA: Si en vez de '1' se indica un Path (p.ej, el del proyecto, se usará como base para recompilar - * toModulo (@? OUT) Referencia de objeto del módulo generado (para Unit Testing) - * toEx (@? OUT) Objeto con información del error - * tcOriginalFileName (v? IN ) Sirve para los casos en los que inputFile es un nombre temporal y se quiere generar - * el nombre correcto dentro de la versión texto (por ej: en los PJ2 y las cabeceras) - * tcLogFile (v? IN ) Nombre del log a usar - * tcType (v? IN ) Tipo de archivo de entrada. Compatibilidad con SCCTEXT.PRG - * - Si se indica "*" y tc_InputFile es un PJX, se procesan todos los archivos del proyecto y el PJX/2 - * - Si se indica "*-" y tc_InputFile es un PJX, se procesan todos los archivos del proyecto sin el PJX/2 - *-------------------------------------------------------------------------------------------------------------- - LPARAMETERS tc_InputFile, tcRecompile, toModulo, toEx, tcOriginalFileName, tcLogFile, tcType + Hidden Procedure doWriteErrorLog + Lparameters toEx As Exception, tcErrorInfo - LOCAL lcFileSpec, lnFileCount, laFiles(1,1), lcFile, lnCodError, I, lnFileCount, llError, laDirInfo(1,5) ; - , loLang AS CL_LANG OF 'FOXBIN2PRG.PRG' ; - , loEx as Exception + Local loLang As CL_LANG Of 'FOXBIN2PRG.PRG' + loLang = _Screen.o_FoxBin2Prg_Lang - TRY - WITH THIS AS c_foxbin2prg OF 'FOXBIN2PRG.PRG' - loLang = _SCREEN.o_FoxBin2Prg_Lang - lcFileSpec = FULLPATH( tc_InputFile ) - - IF .n_ShowProgressbar <> 0 AND .l_ProcessFiles THEN - .loadProgressbarForm() - .o_Frm_Avance.Caption = STRTRAN( .o_Frm_Avance.Caption, '> -', '(Txt>Bin) -' ) - ENDIF - - IF EMPTY(tcLogFile) - .c_LogFile = ADDBS( JUSTPATH( lcFileSpec ) ) + STRTRAN( JUSTFNAME( lcFileSpec ), '*', '_ALL' ) + '.LOG' - - IF .n_Debug > 0 THEN - ERASE ( .c_LogFile ) - ENDIF - ENDIF - - .writeLog( '> ' + loLang.C_CONVERT_ALL_FILES_IN_A_PROJECT_LOC + ': ' + loLang.C_TEXT_TO_BINARY_LOC ) - - DO CASE - CASE .l_Recompile AND LEN(tcRecompile) > 3 AND DIRECTORY(tcRecompile) - CD (tcRecompile) - CASE tcRecompile == '1' - CD (JUSTPATH(lcFileSpec)) - ENDCASE - - lnFileCount = ALINES( laFiles, STREXTRACT( FILETOSTR(tc_InputFile), C_BUILDPROJ_I, C_BUILDPROJ_F ), 1+4 ) - - FOR I = lnFileCount TO 1 STEP -1 - IF '.ADD(' $ laFiles(m.I) - lcFile = .get_AbsolutePath( STREXTRACT( laFiles(m.I), ".ADD('", "')" ), ADDBS( JUSTPATH( lcFileSpec ) ) ) - laFiles(m.I) = FORCEEXT( lcFile, .get_Ext2FromExt( UPPER(JUSTEXT(lcFile)) ) ) - ELSE - lnFileCount = lnFileCount - 1 - ADEL( laFiles, m.I ) - DIMENSION laFiles(lnFileCount) - ENDIF - ENDFOR - - *-- Convierto primero el proyecto - IF tcType <> '*-' THEN - lcFile = tc_InputFile - lnCodError = .convert( lcFile, toModulo, @toEx, .T., tcOriginalFileName ) - .writeLog_Flush() - ENDIF - - *-- Luego convierto los archivos incluidos - FOR I = 1 TO lnFileCount - lcFile = laFiles(m.I) - .updateProgressbar( loLang.C_PROCESSING_LOC + ' ' + lcFile + '...', m.I, lnFileCount, 0 ) - - IF .hasSupport_Prg2Bin( UPPER(JUSTEXT(lcFile)) ) AND ADIR( laDirInfo, lcFile ) > 0 THEN - lnCodError = .convert( lcFile, toModulo, @toEx, .F., tcOriginalFileName ) - .writeLog_Flush() - - DO CASE - CASE lnCodError = 1799 && Conversion Cancelled - ERROR 1799 - - CASE lnCodError > 0 - .doWriteErrorLog( @toEx ) - llError = .T. - .l_Error = .F. - ENDCASE - ELSE - *-- addProcessedFile( tcFile, tcInOutType, tcProcessed, tcHasErrors, tcSupported, tcExpanded ) - IF .addProcessedFile( lcFile, 'I', 'P0', 'E0', 'S0', 'X0' ) - .updateProcessedFile() - ENDIF - ENDIF - - .writeLog_Flush() - - IF llError - .l_Error = .T. - ENDIF - ENDFOR - ENDWITH - - CATCH TO loEx - THROW - - FINALLY - STORE NULL TO loLang - RELEASE loLang - ENDTRY - ENDPROC - - - HIDDEN PROCEDURE doWriteErrorLog - LPARAMETERS toEx as Exception, tcErrorInfo - - LOCAL loLang as CL_LANG OF 'FOXBIN2PRG.PRG' - loLang = _SCREEN.o_FoxBin2Prg_Lang - - WITH THIS AS c_foxbin2prg OF 'FOXBIN2PRG.PRG' - IF toEx.ErrorNo = 1799 THEN && Conversion Cancelled + With This As c_foxbin2prg Of 'FOXBIN2PRG.PRG' + If toEx.ErrorNo = 1799 Then && Conversion Cancelled tcErrorInfo = loLang.C_CONVERSION_CANCELLED_BY_USER_LOC - ELSE - tcErrorInfo = .exception2Str(@toEx) + CR_LF + loLang.C_SOURCEFILE_LOC + TRANSFORM(.c_InputFile) + CR_LF - ENDIF + Else + tcErrorInfo = .exception2Str(@toEx) + CR_LF + loLang.C_SOURCEFILE_LOC + Transform(.c_InputFile) + CR_LF + Endif - ADDPROPERTY(_SCREEN, 'ExitCode', toEx.ERRORNO) + AddProperty(_Screen, 'ExitCode', toEx.ErrorNo) - *-- Escribo la información de error en la variable log de errores - .writeErrorLog( REPLICATE('-', 100), 1 ) +*-- Escribo la información de error en la variable log de errores + .writeErrorLog( Replicate('-', 100), 1 ) .writeLog( tcErrorInfo ) .writeErrorLog( tcErrorInfo ) .writeErrorLog( ) - *-- Escribo la información de error en el archivo log de errores - TRY - STRTOFILE( tcErrorInfo, EVL( .c_InputFile, 'foxbin2prg_errorlog' ) + '.ERR' ) - CATCH - ENDTRY - ENDWITH - - RETURN - ENDPROC - - - PROTECTED PROCEDURE convert - *-------------------------------------------------------------------------------------------------------------- - * PARÁMETROS: (v=Pasar por valor | @=Pasar por referencia) (!=Obligatorio | ?=Opcional) (IN/OUT) - * tc_InputFile (v! IN ) Nombre del archivo de entrada - * toModulo (@? OUT) Referencia de objeto del módulo generado (para Unit Testing) - * toEx (@? OUT) Objeto con información del error - * tlRelanzarError (v? IN ) Indica si el error debe relanzarse o no - * tcOriginalFileName (v? IN ) Sirve para los casos en los que inputFile es un nombre temporal y se quiere generar - * el nombre correcto dentro de la versión texto (por ej: en los PJ2 y las cabeceras) - *-------------------------------------------------------------------------------------------------------------- - LPARAMETERS tc_InputFile, toModulo, toEx AS EXCEPTION, tlRelanzarError, tcOriginalFileName - - TRY - LOCAL lnCodError, lcErrorInfo, laDirFile(1,5), lcExtension, lnFileCount, laFiles(1,1), I ; - , ltFilestamp, lcExtA, lcExtB, laEvents(1,1), lcForceAttribs, lnIDInputFile ; - , loLang as CL_LANG OF 'FOXBIN2PRG.PRG' ; - , loConversor as c_conversor_base OF 'FOXBIN2PRG.PRG' ; - , loFSO AS Scripting.FileSystemObject ; - , loDBF_CFG AS CL_DBF_CFG OF 'FOXBIN2PRG.PRG' - lnCodError = 0 - - WITH THIS AS c_foxbin2prg OF 'FOXBIN2PRG.PRG' - loFSO = .o_FSO - loLang = _SCREEN.o_FoxBin2Prg_Lang - lcForceAttribs = '+N' - .c_InputFile = FULLPATH( tc_InputFile ) - .l_Error = .F. - lcExtension = UPPER( JUSTEXT(.c_InputFile) ) - - .writeLog( REPLICATE( '*', 100 ) ) - .writeLog( 'CONVERSION PROCESS', 2 ) - .writeLog( REPLICATE( '*', 100 ) ) - - IF ADIR( laDirFile, .c_InputFile, '', 1 ) = 0 - *ERROR 'No se encontró el archivo [' + .c_InputFile + ']' - ERROR loLang.C_FILE_NOT_FOUND_LOC + ' [' + .c_InputFile + ']' - ENDIF - - .c_InputFile = loFSO.GetAbsolutePathName( FORCEPATH( laDirFile(1,1), JUSTPATH(.c_InputFile) ) ) - - *-- VERIFICO SI HAY ARCHIVO DE CONFIGURACIÓN SECUNDARIO - .evaluateConfiguration() - - IF .n_ForceWriteIfReadOnly = 1 THEN - lcForceAttribs = lcForceAttribs + '-R' - ENDIF - - *-- OPTIMIZACIÓN VC2/SC2/DC2: VERIFICO SI EL ARCHIVO BASE FUE PROCESADO PARA DESCARTAR REPROCESOS - IF .n_UseClassPerFile > 0 AND .l_RedirectClassPerFileToMain ; - OR NOT EMPTY(.c_ClassToConvert) - - DO CASE - CASE .n_RedirectClassType = 1 OR NOT EMPTY(.c_ClassToConvert) && Redireccionar solo esta clase - IF OCCURS('.', JUSTSTEM(.c_InputFile)) = 0 THEN - lc_BaseFile = .c_InputFile - ELSE - lc_BaseFile = FORCEPATH( FORCEEXT( JUSTSTEM( JUSTSTEM(.c_InputFile) ), JUSTEXT(.c_InputFile)) , JUSTPATH(.c_InputFile) ) - ENDIF - - CASE .n_UseClassPerFile = 1 AND INLIST(lcExtension,.c_VC2,.c_SC2) - IF OCCURS('.', JUSTSTEM(.c_InputFile)) = 0 THEN - lc_BaseFile = .c_InputFile - ELSE - lc_BaseFile = FORCEPATH( FORCEEXT( JUSTSTEM( JUSTSTEM(.c_InputFile) ), JUSTEXT(.c_InputFile)) , JUSTPATH(.c_InputFile) ) - ENDIF - - *-- Verifico si se debe forzar la redirección al archivo principal - IF '.' $ JUSTSTEM(.c_InputFile) - .c_InputFile = lc_BaseFile - ENDIF - - CASE .n_UseClassPerFile = 2 AND INLIST(lcExtension,.c_VC2,.c_SC2) OR lcExtension = .c_DC2 - IF OCCURS('.', JUSTSTEM(.c_InputFile)) = 0 THEN - lc_BaseFile = .c_InputFile - ELSE - lc_BaseFile = FORCEPATH( FORCEEXT( JUSTSTEM( JUSTSTEM( JUSTSTEM(.c_InputFile) ) ), JUSTEXT(.c_InputFile)) , JUSTPATH(.c_InputFile) ) - ENDIF - - *-- Verifico si se debe forzar la redirección al archivo principal - IF '.' $ JUSTSTEM(.c_InputFile) - .c_InputFile = lc_BaseFile - ENDIF - - ENDCASE - ENDIF - - ERASE ( .c_InputFile + '.ERR' ) - - IF NOT EMPTY(tcOriginalFileName) - tcOriginalFileName = loFSO.GetAbsolutePathName( tcOriginalFileName ) - ENDIF - - .c_OriginalFileName = EVL( tcOriginalFileName, .c_InputFile ) - - IF UPPER( JUSTEXT(.c_OriginalFileName) ) = 'PJM' AND .c_PJ2 <> 'PJM' - .c_OriginalFileName = FORCEEXT(.c_OriginalFileName,'pjx') - ENDIF - - *-- addProcessedFile( tcFile, tcInOutType, tcProcessed, tcHasErrors, tcSupported, tcExpanded ) - IF NOT .addProcessedFile( .c_InputFile, 'I', 'P1', 'E0', 'S1', 'X0' ) THEN - *.writeLog( 'OPTIMIZACIÓN: El archivo Base [' + JUSTFNAME(lc_BaseFile) + '] ya fue procesado, por lo que no se procesará [' + JUSTFNAME(.c_InputFile) + ']' ) - .writeLog( C_TAB + C_TAB + '* ' + TEXTMERGE( loLang.C_CLASSPERFILE_OPTIMIZATION_BASE_ALREADY_PROCESSED_LOC ) ) - EXIT - ENDIF - - *.updateProcessedFile() - lnIDInputFile = .n_ProcessedFiles - - .writeLog( C_TAB + 'c_OriginalFileName: ' + .c_OriginalFileName ) - .writeLog( ) - - IF NOT ADIR(laDirFile, .c_InputFile) > 0 THEN - ERROR loLang.C_FILE_DOESNT_EXIST_LOC + ' [' + .c_InputFile + ']' - ENDIF - - .normalizeFileCapitalization( .T. ) - - DO CASE - CASE lcExtension = 'VCX' - IF NOT INLIST(.VCX_Conversion_Support, 1, 2) - ERROR (TEXTMERGE(loLang.C_FILE_NAME_IS_NOT_SUPPORTED_LOC)) - ENDIF - .c_OutputFile = FORCEEXT( .c_InputFile, .c_VC2 ) - loConversor = CREATEOBJECT( 'c_conversor_vcx_a_prg' ) - .changeFileAttribute( FORCEEXT( .c_InputFile, .c_VC2 ), lcForceAttribs ) - - CASE lcExtension = 'SCX' - IF NOT INLIST(.SCX_Conversion_Support, 1, 2) - ERROR (TEXTMERGE(loLang.C_FILE_NAME_IS_NOT_SUPPORTED_LOC)) - ENDIF - .c_OutputFile = FORCEEXT( .c_InputFile, .c_SC2 ) - loConversor = CREATEOBJECT( 'c_conversor_scx_a_prg' ) - .changeFileAttribute( FORCEEXT( .c_InputFile, .c_SC2 ), lcForceAttribs ) - - CASE lcExtension = 'PJX' - IF NOT INLIST(.PJX_Conversion_Support, 1, 2) - ERROR (TEXTMERGE(loLang.C_FILE_NAME_IS_NOT_SUPPORTED_LOC)) - ENDIF - .c_OutputFile = FORCEEXT( .c_InputFile, .c_PJ2 ) - loConversor = CREATEOBJECT( 'c_conversor_pjx_a_prg' ) - .changeFileAttribute( FORCEEXT( .c_InputFile, .c_PJ2 ), lcForceAttribs ) - - CASE lcExtension = 'PJM' AND .c_PJ2 <> 'PJM' - IF NOT INLIST(.PJX_Conversion_Support, 1, 2) - ERROR (TEXTMERGE(loLang.C_FILE_NAME_IS_NOT_SUPPORTED_LOC)) - ENDIF - .c_OutputFile = FORCEEXT( .c_InputFile, .c_PJ2 ) - loConversor = CREATEOBJECT( 'c_conversor_pjm_a_prg' ) - .changeFileAttribute( FORCEEXT( .c_InputFile, .c_PJ2 ), lcForceAttribs ) - - CASE lcExtension = 'FRX' - IF NOT INLIST(.FRX_Conversion_Support, 1, 2) - ERROR (TEXTMERGE(loLang.C_FILE_NAME_IS_NOT_SUPPORTED_LOC)) - ENDIF - .c_OutputFile = FORCEEXT( .c_InputFile, .c_FR2 ) - loConversor = CREATEOBJECT( 'c_conversor_frx_a_prg' ) - .changeFileAttribute( FORCEEXT( .c_InputFile, .c_FR2 ), lcForceAttribs ) - - CASE lcExtension = 'LBX' - IF NOT INLIST(.LBX_Conversion_Support, 1, 2) - ERROR (TEXTMERGE(loLang.C_FILE_NAME_IS_NOT_SUPPORTED_LOC)) - ENDIF - .c_OutputFile = FORCEEXT( .c_InputFile, .c_LB2 ) - loConversor = CREATEOBJECT( 'c_conversor_frx_a_prg' ) - .changeFileAttribute( FORCEEXT( .c_InputFile, .c_LB2 ), lcForceAttribs ) - - CASE lcExtension = 'DBF' - lnFileCount = .get_DBF_Configuration( FORCEEXT(.c_InputFile, 'DBF'), @loDBF_CFG ) - IF NOT INLIST(.DBF_Conversion_Support, 1, 2, 4, 8) - ERROR (TEXTMERGE(loLang.C_FILE_NAME_IS_NOT_SUPPORTED_LOC)) - ENDIF - .c_OutputFile = FORCEEXT( .c_InputFile, .c_DB2 ) - loConversor = CREATEOBJECT( 'c_conversor_dbf_a_prg' ) - .changeFileAttribute( FORCEEXT( .c_InputFile, .c_DB2 ), lcForceAttribs ) - - CASE lcExtension = 'DBC' - IF NOT INLIST(.DBC_Conversion_Support, 1, 2) - ERROR (TEXTMERGE(loLang.C_FILE_NAME_IS_NOT_SUPPORTED_LOC)) - ENDIF - .c_OutputFile = FORCEEXT( .c_InputFile, .c_DC2 ) - loConversor = CREATEOBJECT( 'c_conversor_dbc_a_prg' ) - .changeFileAttribute( FORCEEXT( .c_InputFile, .c_DC2 ), lcForceAttribs ) - - CASE lcExtension = 'MNX' - IF NOT INLIST(.MNX_Conversion_Support, 1, 2) - ERROR (TEXTMERGE(loLang.C_FILE_NAME_IS_NOT_SUPPORTED_LOC)) - ENDIF - .c_OutputFile = FORCEEXT( .c_InputFile, .c_MN2 ) - loConversor = CREATEOBJECT( 'c_conversor_mnx_a_prg' ) - .changeFileAttribute( FORCEEXT( .c_InputFile, .c_MN2 ), lcForceAttribs ) - - CASE lcExtension = 'FKY' - IF NOT INLIST(.FKY_Conversion_Support, 1, 2) - ERROR (TEXTMERGE(loLang.C_FILE_NAME_IS_NOT_SUPPORTED_LOC)) - ENDIF - .c_OutputFile = FORCEEXT( .c_InputFile, .c_FK2 ) - loConversor = CREATEOBJECT( 'c_conversor_fky_a_prg' ) - .changeFileAttribute( FORCEEXT( .c_InputFile, .c_FK2 ), lcForceAttribs ) - - CASE lcExtension = 'MEM' - IF NOT INLIST(.MEM_Conversion_Support, 1, 2) - ERROR (TEXTMERGE(loLang.C_FILE_NAME_IS_NOT_SUPPORTED_LOC)) - ENDIF - .c_OutputFile = FORCEEXT( .c_InputFile, .c_ME2 ) - loConversor = CREATEOBJECT( 'c_conversor_mem_a_prg' ) - .changeFileAttribute( FORCEEXT( .c_InputFile, .c_ME2 ), lcForceAttribs ) - - CASE lcExtension = .c_VC2 - IF .VCX_Conversion_Support <> 2 - ERROR (TEXTMERGE(loLang.C_FILE_NAME_IS_NOT_SUPPORTED_LOC)) - ENDIF - IF EMPTY(.c_ClassToConvert) - .c_OutputFile = FORCEEXT( .c_InputFile, 'VCX' ) - ELSE - * Si se usó la sintaxis "classlib.vcx::clase::import", se define el OutputFile - * con la Base "classlib.vcx" y no con el archivo entero. - .c_OutputFile = FORCEEXT( lc_BaseFile, 'VCX' ) - ENDIF - loConversor = CREATEOBJECT( 'c_conversor_prg_a_vcx' ) - .changeFileAttribute( FORCEEXT( .c_InputFile, 'VCX' ), lcForceAttribs ) - .changeFileAttribute( FORCEEXT( .c_InputFile, 'VCT' ), lcForceAttribs ) - - CASE lcExtension = .c_SC2 - IF .SCX_Conversion_Support <> 2 - ERROR (TEXTMERGE(loLang.C_FILE_NAME_IS_NOT_SUPPORTED_LOC)) - ENDIF - .c_OutputFile = FORCEEXT( .c_InputFile, 'SCX' ) - loConversor = CREATEOBJECT( 'c_conversor_prg_a_scx' ) - .changeFileAttribute( FORCEEXT( .c_InputFile, 'SCX' ), lcForceAttribs ) - .changeFileAttribute( FORCEEXT( .c_InputFile, 'SCT' ), lcForceAttribs ) - - CASE lcExtension = .c_PJ2 - IF .PJX_Conversion_Support <> 2 - ERROR (TEXTMERGE(loLang.C_FILE_NAME_IS_NOT_SUPPORTED_LOC)) - ENDIF - .c_OutputFile = FORCEEXT( .c_InputFile, 'PJX' ) - loConversor = CREATEOBJECT( 'c_conversor_prg_a_pjx' ) - .changeFileAttribute( FORCEEXT( .c_InputFile, 'PJX' ), lcForceAttribs ) - .changeFileAttribute( FORCEEXT( .c_InputFile, 'PJT' ), lcForceAttribs ) - - CASE lcExtension = .c_FR2 - IF .FRX_Conversion_Support <> 2 - ERROR (TEXTMERGE(loLang.C_FILE_NAME_IS_NOT_SUPPORTED_LOC)) - ENDIF - .c_OutputFile = FORCEEXT( .c_InputFile, 'FRX' ) - loConversor = CREATEOBJECT( 'c_conversor_prg_a_frx' ) - .changeFileAttribute( FORCEEXT( .c_InputFile, 'FRX' ), lcForceAttribs ) - .changeFileAttribute( FORCEEXT( .c_InputFile, 'FRT' ), lcForceAttribs ) - - CASE lcExtension = .c_LB2 - IF .LBX_Conversion_Support <> 2 - ERROR (TEXTMERGE(loLang.C_FILE_NAME_IS_NOT_SUPPORTED_LOC)) - ENDIF - .c_OutputFile = FORCEEXT( .c_InputFile, 'LBX' ) - loConversor = CREATEOBJECT( 'c_conversor_prg_a_frx' ) - .changeFileAttribute( FORCEEXT( .c_InputFile, 'LBX' ), lcForceAttribs ) - .changeFileAttribute( FORCEEXT( .c_InputFile, 'LBT' ), lcForceAttribs ) - - CASE lcExtension = .c_DB2 - IF INLIST(.DBF_Conversion_Support, 2, 8) OR ADIR(laDirFile, FORCEEXT(.c_InputFile, 'DBF') + '.CFG') = 1 THEN - *-- Soporte txt-2-bin habilitado - ELSE - ERROR (TEXTMERGE(loLang.C_FILE_NAME_IS_NOT_SUPPORTED_LOC)) - ENDIF - .c_OutputFile = FORCEEXT( .c_InputFile, 'DBF' ) - loConversor = CREATEOBJECT( 'c_conversor_prg_a_dbf' ) - .changeFileAttribute( FORCEEXT( .c_InputFile, 'DBF' ), lcForceAttribs ) - .changeFileAttribute( FORCEEXT( .c_InputFile, 'FPT' ), lcForceAttribs ) - .changeFileAttribute( FORCEEXT( .c_InputFile, 'CDX' ), lcForceAttribs ) - - CASE lcExtension = .c_DC2 - IF .DBC_Conversion_Support <> 2 - ERROR (TEXTMERGE(loLang.C_FILE_NAME_IS_NOT_SUPPORTED_LOC)) - ENDIF - .c_OutputFile = FORCEEXT( .c_InputFile, 'DBC' ) - loConversor = CREATEOBJECT( 'c_conversor_prg_a_dbc' ) - .changeFileAttribute( FORCEEXT( .c_InputFile, 'DBC' ), lcForceAttribs ) - .changeFileAttribute( FORCEEXT( .c_InputFile, 'DCX' ), lcForceAttribs ) - .changeFileAttribute( FORCEEXT( .c_InputFile, 'DCT' ), lcForceAttribs ) - - CASE lcExtension = .c_MN2 - IF .MNX_Conversion_Support <> 2 - ERROR (TEXTMERGE(loLang.C_FILE_NAME_IS_NOT_SUPPORTED_LOC)) - ENDIF - .c_OutputFile = FORCEEXT( .c_InputFile, 'MNX' ) - loConversor = CREATEOBJECT( 'c_conversor_prg_a_mnx' ) - .changeFileAttribute( FORCEEXT( .c_InputFile, 'MNX' ), lcForceAttribs ) - .changeFileAttribute( FORCEEXT( .c_InputFile, 'MNT' ), lcForceAttribs ) - - CASE lcExtension = .c_FK2 - IF .FKY_Conversion_Support <> 2 - ERROR (TEXTMERGE(loLang.C_FILE_NAME_IS_NOT_SUPPORTED_LOC)) - ENDIF - .c_OutputFile = FORCEEXT( .c_InputFile, 'FKY' ) - loConversor = CREATEOBJECT( 'c_conversor_prg_a_fky' ) - .changeFileAttribute( FORCEEXT( .c_InputFile, 'FKY' ), lcForceAttribs ) - - CASE lcExtension = .c_ME2 - IF .MEM_Conversion_Support <> 2 - ERROR (TEXTMERGE(loLang.C_FILE_NAME_IS_NOT_SUPPORTED_LOC)) - ENDIF - .c_OutputFile = FORCEEXT( .c_InputFile, 'MEM' ) - loConversor = CREATEOBJECT( 'c_conversor_prg_a_mem' ) - .changeFileAttribute( FORCEEXT( .c_InputFile, 'MEM' ), lcForceAttribs ) - - OTHERWISE - *ERROR 'El archivo [' + .c_InputFile + '] no está soportado' - ERROR (TEXTMERGE(loLang.C_FILE_NAME_IS_NOT_SUPPORTED_LOC)) - - ENDCASE - - *-- Optimización: Comparación de los timestamps de InputFile y OutputFile para saber - *-- si el OutputFile se debe regenerar o no. - lnFileCount = ADIR( laFiles, FORCEEXT( .c_InputFile, '*' ), '', 1 ) - STORE {//::} TO .t_InputFile_TimeStamp, .t_OutputFile_TimeStamp, ltFilestamp - - IF lnFileCount > 0 THEN - *-- Busca el archivo de entrada original - I = ASCAN( laFiles, JUSTFNAME(.c_InputFile), 1, 0, 1, 1+2+4+8 ) - IF m.I > 0 THEN - .t_InputFile_TimeStamp = DATETIME( YEAR(laFiles(m.I,3)), MONTH(laFiles(m.I,3)), DAY(laFiles(m.I,3)) ; - , VAL(LEFT(laFiles(m.I,4),2)), VAL(SUBSTR(laFiles(m.I,4),4,2)), VAL(RIGHT(laFiles(m.I,4),2)) ) - ENDIF - - IF ADIR( laDirFile, .c_OutputFile ) > 0 THEN - I = ASCAN( laFiles, JUSTFNAME(.c_OutputFile), 1, 0, 1, 1+2+4+8 ) - IF m.I > 0 THEN - .t_OutputFile_TimeStamp = DATETIME( YEAR(laFiles(m.I,3)), MONTH(laFiles(m.I,3)), DAY(laFiles(m.I,3)) ; - , VAL(LEFT(laFiles(m.I,4),2)), VAL(SUBSTR(laFiles(m.I,4),4,2)), VAL(RIGHT(laFiles(m.I,4),2)) ) - ENDIF - - lcExtA = UPPER(JUSTEXT(.c_OutputFile)) - - DO CASE - CASE INLIST(lcExtA, 'SCX', 'VCX', 'MNX', 'FRX', 'LBX') - lcExtB = ICASE(lcExtA = 'SCX', 'SCT' ; - , lcExtA = 'VCX', 'VCT' ; - , lcExtA = 'MNX', 'MNT' ; - , lcExtA = 'FRX', 'FRT' ; - , lcExtA = 'LBX', 'LBT') - I = ASCAN( laFiles, JUSTFNAME( FORCEEXT(.c_OutputFile, lcExtB) ), 1, 0, 1, 1+2+4+8 ) - IF m.I > 0 THEN - ltFilestamp = DATETIME( YEAR(laFiles(m.I,3)), MONTH(laFiles(m.I,3)), DAY(laFiles(m.I,3)) ; - , VAL(LEFT(laFiles(m.I,4),2)), VAL(SUBSTR(laFiles(m.I,4),4,2)), VAL(RIGHT(laFiles(m.I,4),2)) ) - ENDIF - - ENDCASE - - *-- Tomo el máximo timestamp de los archivos de salida (??X/??T) - .t_OutputFile_TimeStamp = MAX( .t_OutputFile_TimeStamp, ltFilestamp ) - ENDIF - ENDIF - - DO CASE - CASE .n_UseClassPerFile = 0 AND .n_OptimizeByFilestamp = 1 AND .t_InputFile_TimeStamp < .t_OutputFile_TimeStamp - *-- Optimizado: El Origen es anterior al Destino - No hace falta regenerar - *.writeLog( '> El archivo de salida [<>] no se regenera porque su timestamp es más nuevo que el de entrada.' ) - .writeLog( C_TAB + C_TAB + '* ' + TEXTMERGE(loLang.C_OUTPUTFILE_TIMESTAMP_NEWER_THAN_INPUTFILE_TIMESTAMP_LOC) ) - - CASE .n_UseClassPerFile = 0 AND .n_OptimizeByFilestamp = 2 AND .t_InputFile_TimeStamp = .t_OutputFile_TimeStamp - *-- Optimizado: El Origen es igual al Destino - No hace falta regenerar - *.writeLog( '> El archivo de salida [<>] no se regenera porque su timestamp es igual que el de entrada.' ) - .writeLog( C_TAB + C_TAB + '* ' + TEXTMERGE(loLang.C_OUTPUTFILE_TIMESTAMP_EQUAL_THAN_INPUTFILE_TIMESTAMP_LOC) ) - - OTHERWISE - .c_Type = UPPER(JUSTEXT(.c_OutputFile)) - loConversor.c_InputFile = .c_InputFile - loConversor.c_OutputFile = .c_OutputFile - loConversor.c_LogFile = .c_LogFile - loConversor.n_Debug = .n_Debug - loConversor.l_Test = .l_Test - loConversor.n_FB2PRG_Version = .n_FB2PRG_Version - loConversor.l_MethodSort_Enabled = .l_MethodSort_Enabled - loConversor.l_PropSort_Enabled = .l_PropSort_Enabled - loConversor.l_ReportSort_Enabled = .l_ReportSort_Enabled - loConversor.c_OriginalFileName = .c_OriginalFileName - loConversor.c_Foxbin2prg_FullPath = .c_Foxbin2prg_FullPath - *-- - .updateProgressbar( loLang.C_PROCESSING_LOC + ' ' + .c_InputFile + '...', 0, 0, 0 ) - - IF AEVENTS( laEvents, loConversor ) = 0 THEN - BINDEVENT( loConversor, 'updateProgressbar', THIS, 'updateProgressbar' ) - ENDIF - - loConversor.convert( @toModulo, .F., THIS ) - - IF loConversor.l_Error THEN - .l_Error = .T. - ENDIF - - .n_ProcessedFilesCount = .n_ProcessedFilesCount + 1 - .writeLog() - .writeLog(loConversor.c_TextLog) && Recojo el LOG que haya generado el conversor - - *-- Logueo los errores - IF NOT EMPTY(loConversor.c_TextErr) THEN - .writeErrorLog( REPLICATE( '-', 100 ), 1 ) - .writeErrorLog( loLang.C_ERRORS_FOUND_IN_FILE_LOC + ' [' + .c_InputFile + '] ' ) - .writeErrorLog( loConversor.c_TextErr ) - .writeErrorLog( ) - ENDIF - ENDCASE - - .normalizeFileCapitalization() - ENDWITH && THIS AS c_foxbin2prg OF 'FOXBIN2PRG.PRG' - - CATCH TO toEx - lnCodError = toEx.ERRORNO - *lcErrorInfo = THIS.exception2Str(toEx) + CR_LF + CR_LF + loLang.C_SOURCEFILE_LOC + THIS.c_InputFile - - *-- updateProcessedFile( tcProcessed, tcHasErrors, tcSupported, tcReserved ) - THIS.updateProcessedFile( lnIDInputFile, '', '', 'E1' ) - - IF THIS.n_Debug > 0 THEN - IF _VFP.STARTMODE = 0 - SET STEP ON - ENDIF - ENDIF - IF tlRelanzarError && Usado en Unit Testing - THROW - ENDIF - - FINALLY - IF AEVENTS( laEvents, loConversor ) > 0 THEN - UNBINDEVENTS( loConversor ) - ENDIF - - STORE NULL TO loConversor, loFSO - - IF lnCodError = 0 AND THIS.l_Error THEN - THIS.updateProcessedFile( lnIDInputFile, '', '', 'E1' ) - ELSE - *THIS.updateProcessedFile( lnIDInputFile ) - ENDIF - - RELEASE lcErrorInfo, laDirFile, lcExtension, lnFileCount, laFiles, I ; - , ltFilestamp, lcExtA, lcExtB ; - , loConversor, loFSO - ENDTRY - - RETURN lnCodError - ENDPROC - - - PROCEDURE get_DirSettings - *--------------------------------------------------------------------------------------------------- - * PARÁMETROS: (v=Pasar por valor | @=Pasar por referencia) (!=Obligatorio | ?=Opcional) (IN/OUT) - * tcDir (@? IN ) Directorio del que devolver su configuración - * RETORNO (@? OUT) Objeto CFG - *--------------------------------------------------------------------------------------------------- - LPARAMETERS tcDir - - IF NOT EMPTY(tcDir) - THIS.evaluateConfiguration( '', '', '', '', '', '', '', '', tcDir, 'D' ) - ENDIF - - IF THIS.n_CFG_Actual = 0 THEN - loCFG = NULL - ELSE - loCFG = THIS.o_Configuration(THIS.n_CFG_Actual) - ENDIF - - IF ISNULL(loCFG) THEN - loCFG = CREATEOBJECT('CL_CFG') - loCFG.CopyFrom(THIS) - ENDIF - - RETURN loCFG - ENDPROC - - - PROCEDURE get_PROGRAM_HEADER - LOCAL lcText +*-- Escribo la información de error en el archivo log de errores + Try + Strtofile( tcErrorInfo, Evl( .c_InputFile, 'foxbin2prg_errorlog' ) + '.ERR' ) + Catch + Endtry + Endwith + + Return + Endproc + + + Protected Procedure convert +*-------------------------------------------------------------------------------------------------------------- +* PARÁMETROS: (v=Pasar por valor | @=Pasar por referencia) (!=Obligatorio | ?=Opcional) (IN/OUT) +* tc_InputFile (v! IN ) Nombre del archivo de entrada +* toModulo (@? OUT) Referencia de objeto del módulo generado (para Unit Testing) +* toEx (@? OUT) Objeto con información del error +* tlRelanzarError (v? IN ) Indica si el error debe relanzarse o no +* tcOriginalFileName (v? IN ) Sirve para los casos en los que inputFile es un nombre temporal y se quiere generar +* el nombre correcto dentro de la versión texto (por ej: en los PJ2 y las cabeceras) +*-------------------------------------------------------------------------------------------------------------- + Lparameters tc_InputFile, toModulo, toEx As Exception, tlRelanzarError, tcOriginalFileName + + Try + Local lnCodError, lcErrorInfo, laDirFile(1,5), lcExtension, lnFileCount, laFiles(1,1), I ; + , ltFilestamp, lcExtA, lcExtB, laEvents(1,1), lcForceAttribs, lnIDInputFile ; + , loLang As CL_LANG Of 'FOXBIN2PRG.PRG' ; + , loConversor As c_conversor_base Of 'FOXBIN2PRG.PRG' ; + , loFSO As Scripting.FileSystemObject ; + , loDBF_CFG As CL_DBF_CFG Of 'FOXBIN2PRG.PRG' + lnCodError = 0 + + With This As c_foxbin2prg Of 'FOXBIN2PRG.PRG' + loFSO = .o_FSO + loLang = _Screen.o_FoxBin2Prg_Lang + lcForceAttribs = '+N' + .c_InputFile = Fullpath( tc_InputFile ) + .l_Error = .F. + lcExtension = Upper( Justext(.c_InputFile) ) + + .writeLog( Replicate( '*', 100 ) ) + .writeLog( 'CONVERSION PROCESS', 2 ) + .writeLog( Replicate( '*', 100 ) ) + + If Adir( laDirFile, .c_InputFile, '', 1 ) = 0 +*ERROR 'No se encontró el archivo [' + .c_InputFile + ']' + Error loLang.C_FILE_NOT_FOUND_LOC + ' [' + .c_InputFile + ']' + Endif + + .c_InputFile = loFSO.GetAbsolutePathName( Forcepath( laDirFile(1,1), Justpath(.c_InputFile) ) ) + +*-- VERIFICO SI HAY ARCHIVO DE CONFIGURACIÓN SECUNDARIO + .evaluateConfiguration() + + If .n_ForceWriteIfReadOnly = 1 Then + lcForceAttribs = lcForceAttribs + '-R' + Endif + +*-- OPTIMIZACIÓN VC2/SC2/DC2: VERIFICO SI EL ARCHIVO BASE FUE PROCESADO PARA DESCARTAR REPROCESOS + If .n_UseClassPerFile > 0 And .l_RedirectClassPerFileToMain ; + OR Not Empty(.c_ClassToConvert) + + Do Case + Case .n_RedirectClassType = 1 Or Not Empty(.c_ClassToConvert) && Redireccionar solo esta clase + If Occurs('.', Juststem(.c_InputFile)) = 0 Then + lc_BaseFile = .c_InputFile + Else + lc_BaseFile = Forcepath( Forceext( Juststem( Juststem(.c_InputFile) ), Justext(.c_InputFile)) , Justpath(.c_InputFile) ) + Endif + + Case .n_UseClassPerFile = 1 And Inlist(lcExtension,.c_VC2,.c_SC2) + If Occurs('.', Juststem(.c_InputFile)) = 0 Then + lc_BaseFile = .c_InputFile + Else + lc_BaseFile = Forcepath( Forceext( Juststem( Juststem(.c_InputFile) ), Justext(.c_InputFile)) , Justpath(.c_InputFile) ) + Endif + +*-- Verifico si se debe forzar la redirección al archivo principal + If '.' $ Juststem(.c_InputFile) + .c_InputFile = lc_BaseFile + Endif + + Case .n_UseClassPerFile = 2 And Inlist(lcExtension,.c_VC2,.c_SC2) Or lcExtension = .c_DC2 + If Occurs('.', Juststem(.c_InputFile)) = 0 Then + lc_BaseFile = .c_InputFile + Else + lc_BaseFile = Forcepath( Forceext( Juststem( Juststem( Juststem(.c_InputFile) ) ), Justext(.c_InputFile)) , Justpath(.c_InputFile) ) + Endif + +*-- Verifico si se debe forzar la redirección al archivo principal + If '.' $ Juststem(.c_InputFile) + .c_InputFile = lc_BaseFile + Endif + + Endcase + Endif + + Erase ( .c_InputFile + '.ERR' ) + + If Not Empty(tcOriginalFileName) + tcOriginalFileName = loFSO.GetAbsolutePathName( tcOriginalFileName ) + Endif + + .c_OriginalFileName = Evl( tcOriginalFileName, .c_InputFile ) + + If Upper( Justext(.c_OriginalFileName) ) = 'PJM' And .c_PJ2 <> 'PJM' + .c_OriginalFileName = Forceext(.c_OriginalFileName,'pjx') + Endif + +*-- addProcessedFile( tcFile, tcInOutType, tcProcessed, tcHasErrors, tcSupported, tcExpanded ) + If Not .addProcessedFile( .c_InputFile, 'I', 'P1', 'E0', 'S1', 'X0' ) Then +*.writeLog( 'OPTIMIZACIÓN: El archivo Base [' + JUSTFNAME(lc_BaseFile) + '] ya fue procesado, por lo que no se procesará [' + JUSTFNAME(.c_InputFile) + ']' ) + .writeLog( C_TAB + C_TAB + '* ' + Textmerge( loLang.C_CLASSPERFILE_OPTIMIZATION_BASE_ALREADY_PROCESSED_LOC ) ) + Exit + Endif + +*.updateProcessedFile() + lnIDInputFile = .n_ProcessedFiles + + .writeLog( C_TAB + 'c_OriginalFileName: ' + .c_OriginalFileName ) + .writeLog( ) + + If Not Adir(laDirFile, .c_InputFile) > 0 Then + Error loLang.C_FILE_DOESNT_EXIST_LOC + ' [' + .c_InputFile + ']' + Endif + + .normalizeFileCapitalization( .T. ) + + Do Case + Case lcExtension = 'VCX' + If Not Inlist(.VCX_Conversion_Support, 1, 2) + Error (Textmerge(loLang.C_FILE_NAME_IS_NOT_SUPPORTED_LOC)) + Endif + .c_OutputFile = Forceext( .c_InputFile, .c_VC2 ) + loConversor = Createobject( 'c_conversor_vcx_a_prg' ) + .changeFileAttribute( Forceext( .c_InputFile, .c_VC2 ), lcForceAttribs ) + + Case lcExtension = 'SCX' + If Not Inlist(.SCX_Conversion_Support, 1, 2) + Error (Textmerge(loLang.C_FILE_NAME_IS_NOT_SUPPORTED_LOC)) + Endif + .c_OutputFile = Forceext( .c_InputFile, .c_SC2 ) + loConversor = Createobject( 'c_conversor_scx_a_prg' ) + .changeFileAttribute( Forceext( .c_InputFile, .c_SC2 ), lcForceAttribs ) + + Case lcExtension = 'PJX' + If Not Inlist(.PJX_Conversion_Support, 1, 2) + Error (Textmerge(loLang.C_FILE_NAME_IS_NOT_SUPPORTED_LOC)) + Endif + .c_OutputFile = Forceext( .c_InputFile, .c_PJ2 ) + loConversor = Createobject( 'c_conversor_pjx_a_prg' ) + .changeFileAttribute( Forceext( .c_InputFile, .c_PJ2 ), lcForceAttribs ) + + Case lcExtension = 'PJM' And .c_PJ2 <> 'PJM' + If Not Inlist(.PJX_Conversion_Support, 1, 2) + Error (Textmerge(loLang.C_FILE_NAME_IS_NOT_SUPPORTED_LOC)) + Endif + .c_OutputFile = Forceext( .c_InputFile, .c_PJ2 ) + loConversor = Createobject( 'c_conversor_pjm_a_prg' ) + .changeFileAttribute( Forceext( .c_InputFile, .c_PJ2 ), lcForceAttribs ) + + Case lcExtension = 'FRX' + If Not Inlist(.FRX_Conversion_Support, 1, 2) + Error (Textmerge(loLang.C_FILE_NAME_IS_NOT_SUPPORTED_LOC)) + Endif + .c_OutputFile = Forceext( .c_InputFile, .c_FR2 ) + loConversor = Createobject( 'c_conversor_frx_a_prg' ) + .changeFileAttribute( Forceext( .c_InputFile, .c_FR2 ), lcForceAttribs ) + + Case lcExtension = 'LBX' + If Not Inlist(.LBX_Conversion_Support, 1, 2) + Error (Textmerge(loLang.C_FILE_NAME_IS_NOT_SUPPORTED_LOC)) + Endif + .c_OutputFile = Forceext( .c_InputFile, .c_LB2 ) + loConversor = Createobject( 'c_conversor_frx_a_prg' ) + .changeFileAttribute( Forceext( .c_InputFile, .c_LB2 ), lcForceAttribs ) + + Case lcExtension = 'DBF' + lnFileCount = .get_DBF_Configuration( Forceext(.c_InputFile, 'DBF'), @loDBF_CFG ) + If Not Inlist(.DBF_Conversion_Support, 1, 2, 4, 8) + Error (Textmerge(loLang.C_FILE_NAME_IS_NOT_SUPPORTED_LOC)) + Endif + .c_OutputFile = Forceext( .c_InputFile, .c_DB2 ) + loConversor = Createobject( 'c_conversor_dbf_a_prg' ) + .changeFileAttribute( Forceext( .c_InputFile, .c_DB2 ), lcForceAttribs ) + + Case lcExtension = 'DBC' + If Not Inlist(.DBC_Conversion_Support, 1, 2) + Error (Textmerge(loLang.C_FILE_NAME_IS_NOT_SUPPORTED_LOC)) + Endif + .c_OutputFile = Forceext( .c_InputFile, .c_DC2 ) + loConversor = Createobject( 'c_conversor_dbc_a_prg' ) + .changeFileAttribute( Forceext( .c_InputFile, .c_DC2 ), lcForceAttribs ) + + Case lcExtension = 'MNX' + If Not Inlist(.MNX_Conversion_Support, 1, 2) + Error (Textmerge(loLang.C_FILE_NAME_IS_NOT_SUPPORTED_LOC)) + Endif + .c_OutputFile = Forceext( .c_InputFile, .c_MN2 ) + loConversor = Createobject( 'c_conversor_mnx_a_prg' ) + .changeFileAttribute( Forceext( .c_InputFile, .c_MN2 ), lcForceAttribs ) + + Case lcExtension = 'FKY' + If Not Inlist(.FKY_Conversion_Support, 1, 2) + Error (Textmerge(loLang.C_FILE_NAME_IS_NOT_SUPPORTED_LOC)) + Endif + .c_OutputFile = Forceext( .c_InputFile, .c_FK2 ) + loConversor = Createobject( 'c_conversor_fky_a_prg' ) + .changeFileAttribute( Forceext( .c_InputFile, .c_FK2 ), lcForceAttribs ) + + Case lcExtension = 'MEM' + If Not Inlist(.MEM_Conversion_Support, 1, 2) + Error (Textmerge(loLang.C_FILE_NAME_IS_NOT_SUPPORTED_LOC)) + Endif + .c_OutputFile = Forceext( .c_InputFile, .c_ME2 ) + loConversor = Createobject( 'c_conversor_mem_a_prg' ) + .changeFileAttribute( Forceext( .c_InputFile, .c_ME2 ), lcForceAttribs ) + + Case lcExtension = .c_VC2 + If .VCX_Conversion_Support <> 2 + Error (Textmerge(loLang.C_FILE_NAME_IS_NOT_SUPPORTED_LOC)) + Endif + If Empty(.c_ClassToConvert) + .c_OutputFile = Forceext( .c_InputFile, 'VCX' ) + Else +* Si se usó la sintaxis "classlib.vcx::clase::import", se define el OutputFile +* con la Base "classlib.vcx" y no con el archivo entero. + .c_OutputFile = Forceext( lc_BaseFile, 'VCX' ) + Endif + loConversor = Createobject( 'c_conversor_prg_a_vcx' ) + .changeFileAttribute( Forceext( .c_InputFile, 'VCX' ), lcForceAttribs ) + .changeFileAttribute( Forceext( .c_InputFile, 'VCT' ), lcForceAttribs ) + + Case lcExtension = .c_SC2 + If .SCX_Conversion_Support <> 2 + Error (Textmerge(loLang.C_FILE_NAME_IS_NOT_SUPPORTED_LOC)) + Endif + .c_OutputFile = Forceext( .c_InputFile, 'SCX' ) + loConversor = Createobject( 'c_conversor_prg_a_scx' ) + .changeFileAttribute( Forceext( .c_InputFile, 'SCX' ), lcForceAttribs ) + .changeFileAttribute( Forceext( .c_InputFile, 'SCT' ), lcForceAttribs ) + + Case lcExtension = .c_PJ2 + If .PJX_Conversion_Support <> 2 + Error (Textmerge(loLang.C_FILE_NAME_IS_NOT_SUPPORTED_LOC)) + Endif + .c_OutputFile = Forceext( .c_InputFile, 'PJX' ) + loConversor = Createobject( 'c_conversor_prg_a_pjx' ) + .changeFileAttribute( Forceext( .c_InputFile, 'PJX' ), lcForceAttribs ) + .changeFileAttribute( Forceext( .c_InputFile, 'PJT' ), lcForceAttribs ) + + Case lcExtension = .c_FR2 + If .FRX_Conversion_Support <> 2 + Error (Textmerge(loLang.C_FILE_NAME_IS_NOT_SUPPORTED_LOC)) + Endif + .c_OutputFile = Forceext( .c_InputFile, 'FRX' ) + loConversor = Createobject( 'c_conversor_prg_a_frx' ) + .changeFileAttribute( Forceext( .c_InputFile, 'FRX' ), lcForceAttribs ) + .changeFileAttribute( Forceext( .c_InputFile, 'FRT' ), lcForceAttribs ) + + Case lcExtension = .c_LB2 + If .LBX_Conversion_Support <> 2 + Error (Textmerge(loLang.C_FILE_NAME_IS_NOT_SUPPORTED_LOC)) + Endif + .c_OutputFile = Forceext( .c_InputFile, 'LBX' ) + loConversor = Createobject( 'c_conversor_prg_a_frx' ) + .changeFileAttribute( Forceext( .c_InputFile, 'LBX' ), lcForceAttribs ) + .changeFileAttribute( Forceext( .c_InputFile, 'LBT' ), lcForceAttribs ) + + Case lcExtension = .c_DB2 + If Inlist(.DBF_Conversion_Support, 2, 8) Or Adir(laDirFile, Forceext(.c_InputFile, 'DBF') + '.CFG') = 1 Then +*-- Soporte txt-2-bin habilitado + Else + Error (Textmerge(loLang.C_FILE_NAME_IS_NOT_SUPPORTED_LOC)) + Endif + .c_OutputFile = Forceext( .c_InputFile, 'DBF' ) + loConversor = Createobject( 'c_conversor_prg_a_dbf' ) + .changeFileAttribute( Forceext( .c_InputFile, 'DBF' ), lcForceAttribs ) + .changeFileAttribute( Forceext( .c_InputFile, 'FPT' ), lcForceAttribs ) + .changeFileAttribute( Forceext( .c_InputFile, 'CDX' ), lcForceAttribs ) + + Case lcExtension = .c_DC2 + If .DBC_Conversion_Support <> 2 + Error (Textmerge(loLang.C_FILE_NAME_IS_NOT_SUPPORTED_LOC)) + Endif + .c_OutputFile = Forceext( .c_InputFile, 'DBC' ) + loConversor = Createobject( 'c_conversor_prg_a_dbc' ) + .changeFileAttribute( Forceext( .c_InputFile, 'DBC' ), lcForceAttribs ) + .changeFileAttribute( Forceext( .c_InputFile, 'DCX' ), lcForceAttribs ) + .changeFileAttribute( Forceext( .c_InputFile, 'DCT' ), lcForceAttribs ) + + Case lcExtension = .c_MN2 + If .MNX_Conversion_Support <> 2 + Error (Textmerge(loLang.C_FILE_NAME_IS_NOT_SUPPORTED_LOC)) + Endif + .c_OutputFile = Forceext( .c_InputFile, 'MNX' ) + loConversor = Createobject( 'c_conversor_prg_a_mnx' ) + .changeFileAttribute( Forceext( .c_InputFile, 'MNX' ), lcForceAttribs ) + .changeFileAttribute( Forceext( .c_InputFile, 'MNT' ), lcForceAttribs ) + + Case lcExtension = .c_FK2 + If .FKY_Conversion_Support <> 2 + Error (Textmerge(loLang.C_FILE_NAME_IS_NOT_SUPPORTED_LOC)) + Endif + .c_OutputFile = Forceext( .c_InputFile, 'FKY' ) + loConversor = Createobject( 'c_conversor_prg_a_fky' ) + .changeFileAttribute( Forceext( .c_InputFile, 'FKY' ), lcForceAttribs ) + + Case lcExtension = .c_ME2 + If .MEM_Conversion_Support <> 2 + Error (Textmerge(loLang.C_FILE_NAME_IS_NOT_SUPPORTED_LOC)) + Endif + .c_OutputFile = Forceext( .c_InputFile, 'MEM' ) + loConversor = Createobject( 'c_conversor_prg_a_mem' ) + .changeFileAttribute( Forceext( .c_InputFile, 'MEM' ), lcForceAttribs ) + + Otherwise +*ERROR 'El archivo [' + .c_InputFile + '] no está soportado' + Error (Textmerge(loLang.C_FILE_NAME_IS_NOT_SUPPORTED_LOC)) + + Endcase + +*-- Optimización: Comparación de los timestamps de InputFile y OutputFile para saber +*-- si el OutputFile se debe regenerar o no. + lnFileCount = Adir( laFiles, Forceext( .c_InputFile, '*' ), '', 1 ) + Store {//::} To .t_InputFile_TimeStamp, .t_OutputFile_TimeStamp, ltFilestamp + + If lnFileCount > 0 Then +*-- Busca el archivo de entrada original + I = Ascan( laFiles, Justfname(.c_InputFile), 1, 0, 1, 1+2+4+8 ) + If m.I > 0 Then + .t_InputFile_TimeStamp = Datetime( Year(laFiles(m.I,3)), Month(laFiles(m.I,3)), Day(laFiles(m.I,3)) ; + , Val(Left(laFiles(m.I,4),2)), Val(Substr(laFiles(m.I,4),4,2)), Val(Right(laFiles(m.I,4),2)) ) + Endif + + If Adir( laDirFile, .c_OutputFile ) > 0 Then + I = Ascan( laFiles, Justfname(.c_OutputFile), 1, 0, 1, 1+2+4+8 ) + If m.I > 0 Then + .t_OutputFile_TimeStamp = Datetime( Year(laFiles(m.I,3)), Month(laFiles(m.I,3)), Day(laFiles(m.I,3)) ; + , Val(Left(laFiles(m.I,4),2)), Val(Substr(laFiles(m.I,4),4,2)), Val(Right(laFiles(m.I,4),2)) ) + Endif + + lcExtA = Upper(Justext(.c_OutputFile)) + + Do Case + Case Inlist(lcExtA, 'SCX', 'VCX', 'MNX', 'FRX', 'LBX') + lcExtB = Icase(lcExtA = 'SCX', 'SCT' ; + , lcExtA = 'VCX', 'VCT' ; + , lcExtA = 'MNX', 'MNT' ; + , lcExtA = 'FRX', 'FRT' ; + , lcExtA = 'LBX', 'LBT') + I = Ascan( laFiles, Justfname( Forceext(.c_OutputFile, lcExtB) ), 1, 0, 1, 1+2+4+8 ) + If m.I > 0 Then + ltFilestamp = Datetime( Year(laFiles(m.I,3)), Month(laFiles(m.I,3)), Day(laFiles(m.I,3)) ; + , Val(Left(laFiles(m.I,4),2)), Val(Substr(laFiles(m.I,4),4,2)), Val(Right(laFiles(m.I,4),2)) ) + Endif + + Endcase + +*-- Tomo el máximo timestamp de los archivos de salida (??X/??T) + .t_OutputFile_TimeStamp = Max( .t_OutputFile_TimeStamp, ltFilestamp ) + Endif + Endif + + Do Case + Case .n_UseClassPerFile = 0 And .n_OptimizeByFilestamp = 1 And .t_InputFile_TimeStamp < .t_OutputFile_TimeStamp +*-- Optimizado: El Origen es anterior al Destino - No hace falta regenerar +*.writeLog( '> El archivo de salida [<>] no se regenera porque su timestamp es más nuevo que el de entrada.' ) + .writeLog( C_TAB + C_TAB + '* ' + Textmerge(loLang.C_OUTPUTFILE_TIMESTAMP_NEWER_THAN_INPUTFILE_TIMESTAMP_LOC) ) + + Case .n_UseClassPerFile = 0 And .n_OptimizeByFilestamp = 2 And .t_InputFile_TimeStamp = .t_OutputFile_TimeStamp +*-- Optimizado: El Origen es igual al Destino - No hace falta regenerar +*.writeLog( '> El archivo de salida [<>] no se regenera porque su timestamp es igual que el de entrada.' ) + .writeLog( C_TAB + C_TAB + '* ' + Textmerge(loLang.C_OUTPUTFILE_TIMESTAMP_EQUAL_THAN_INPUTFILE_TIMESTAMP_LOC) ) + + Otherwise + .c_Type = Upper(Justext(.c_OutputFile)) + loConversor.c_InputFile = .c_InputFile + loConversor.c_OutputFile = .c_OutputFile + loConversor.c_LogFile = .c_LogFile + loConversor.n_Debug = .n_Debug + loConversor.l_Test = .l_Test + loConversor.n_FB2PRG_Version = .n_FB2PRG_Version + loConversor.l_MethodSort_Enabled = .l_MethodSort_Enabled + loConversor.l_PropSort_Enabled = .l_PropSort_Enabled + loConversor.l_ReportSort_Enabled = .l_ReportSort_Enabled + loConversor.c_OriginalFileName = .c_OriginalFileName + loConversor.c_Foxbin2prg_FullPath = .c_Foxbin2prg_FullPath +*-- + .updateProgressbar( loLang.C_PROCESSING_LOC + ' ' + .c_InputFile + '...', 0, 0, 0 ) + + If Aevents( laEvents, loConversor ) = 0 Then + Bindevent( loConversor, 'updateProgressbar', This, 'updateProgressbar' ) + Endif + + loConversor.convert( @toModulo, .F., This ) + + If loConversor.l_Error Then + .l_Error = .T. + Endif + + .n_ProcessedFilesCount = .n_ProcessedFilesCount + 1 + .writeLog() + .writeLog(loConversor.c_TextLog) && Recojo el LOG que haya generado el conversor + +*-- Logueo los errores + If Not Empty(loConversor.c_TextErr) Then + .writeErrorLog( Replicate( '-', 100 ), 1 ) + .writeErrorLog( loLang.C_ERRORS_FOUND_IN_FILE_LOC + ' [' + .c_InputFile + '] ' ) + .writeErrorLog( loConversor.c_TextErr ) + .writeErrorLog( ) + Endif + Endcase + + .normalizeFileCapitalization() + Endwith && THIS AS c_foxbin2prg OF 'FOXBIN2PRG.PRG' + + Catch To toEx + lnCodError = toEx.ErrorNo +*lcErrorInfo = THIS.exception2Str(toEx) + CR_LF + CR_LF + loLang.C_SOURCEFILE_LOC + THIS.c_InputFile + +*-- updateProcessedFile( tcProcessed, tcHasErrors, tcSupported, tcReserved ) + This.updateProcessedFile( lnIDInputFile, '', '', 'E1' ) + + If This.n_Debug > 0 Then + If _vfp.StartMode = 0 + Set Step On + Endif + Endif + If tlRelanzarError && Usado en Unit Testing + Throw + Endif + + Finally + If Aevents( laEvents, loConversor ) > 0 Then + Unbindevents( loConversor ) + Endif + + Store Null To loConversor, loFSO + + If lnCodError = 0 And This.l_Error Then + This.updateProcessedFile( lnIDInputFile, '', '', 'E1' ) + Else +*THIS.updateProcessedFile( lnIDInputFile ) + Endif + + Release lcErrorInfo, laDirFile, lcExtension, lnFileCount, laFiles, I ; + , ltFilestamp, lcExtA, lcExtB ; + , loConversor, loFSO + Endtry + + Return lnCodError + Endproc + + + Procedure get_DirSettings +*--------------------------------------------------------------------------------------------------- +* PARÁMETROS: (v=Pasar por valor | @=Pasar por referencia) (!=Obligatorio | ?=Opcional) (IN/OUT) +* tcDir (@? IN ) Directorio del que devolver su configuración +* RETORNO (@? OUT) Objeto CFG +*--------------------------------------------------------------------------------------------------- + Lparameters tcDir + + If Not Empty(tcDir) + This.evaluateConfiguration( '', '', '', '', '', '', '', '', tcDir, 'D' ) + Endif + + If This.n_CFG_Actual = 0 Then + loCFG = Null + Else + loCFG = This.o_Configuration(This.n_CFG_Actual) + Endif + + If Isnull(loCFG) Then + loCFG = Createobject('CL_CFG') + loCFG.CopyFrom(This) + Endif + + Return loCFG + Endproc + + + Procedure get_PROGRAM_HEADER + Local lcText lcText = '' - *-- Cabecera del PRG e inicio de DEF_CLASS +*-- Cabecera del PRG e inicio de DEF_CLASS TEXT TO lcText ADDITIVE TEXTMERGE NOSHOW FLAGS 1 PRETEXT 1+2 *-------------------------------------------------------------------------------------------------------------------------------------------------------- * (ES) AUTOGENERADO - ¡¡ATENCIÓN!! - ¡¡NO PENSADO PARA EJECUTAR!! USAR SOLAMENTE PARA INTEGRAR CAMBIOS Y ALMACENAR CON HERRAMIENTAS SCM!! @@ -4351,52 +4351,52 @@ DEFINE CLASS c_foxbin2prg AS Session * ENDTEXT - RETURN lcText - ENDPROC + Return lcText + Endproc - PROCEDURE getNext_BAK - *-------------------------------------------------------------------------------------------------------------- - * PARÁMETROS: (v=Pasar por valor | @=Pasar por referencia) (!=Obligatorio | ?=Opcional) (IN/OUT) - * tc_OutputFilename (v! IN ) Nombre del archivo de salida a crear el backup - *-------------------------------------------------------------------------------------------------------------- - LPARAMETERS tcOutputFileName - LOCAL lcNext_Bak, I, laDirInfo(1,5) + Procedure getNext_BAK +*-------------------------------------------------------------------------------------------------------------- +* PARÁMETROS: (v=Pasar por valor | @=Pasar por referencia) (!=Obligatorio | ?=Opcional) (IN/OUT) +* tc_OutputFilename (v! IN ) Nombre del archivo de salida a crear el backup +*-------------------------------------------------------------------------------------------------------------- + Lparameters tcOutputFileName + Local lcNext_Bak, I, laDirInfo(1,5) lcNext_Bak = '.BAK' - FOR I = 1 TO THIS.n_ExtraBackupLevels - IF m.I = 1 - IF NOT ADIR( laDirInfo, tcOutputFileName + '.BAK' ) > 0 THEN + For I = 1 To This.n_ExtraBackupLevels + If m.I = 1 + If Not Adir( laDirInfo, tcOutputFileName + '.BAK' ) > 0 Then lcNext_Bak = '.BAK' - EXIT - ENDIF - ELSE - IF NOT ADIR( laDirInfo, tcOutputFileName + '.' + PADL(m.I-1,1,'0') + '.BAK' ) > 0 THEN - lcNext_Bak = '.' + PADL(m.I-1,1,'0') + '.BAK' - EXIT - ENDIF - ENDIF - ENDFOR + Exit + Endif + Else + If Not Adir( laDirInfo, tcOutputFileName + '.' + Padl(m.I-1,1,'0') + '.BAK' ) > 0 Then + lcNext_Bak = '.' + Padl(m.I-1,1,'0') + '.BAK' + Exit + Endif + Endif + Endfor - RETURN lcNext_Bak - ENDPROC + Return lcNext_Bak + Endproc - PROCEDURE get_SeparatedLineAndComment - *--------------------------------------------------------------------------------------------------- - * PARÁMETROS: (v=Pasar por valor | @=Pasar por referencia) (!=Obligatorio | ?=Opcional) (IN/OUT) - * tcLine (!@ IN/OUT) Línea a separar del comentario - * tcComment (@? OUT) Comentario - * tlDeepCommentAnalysis (v? IN ) Indica realizar un análisis profundo de comentarios (para detectar casos complejos de código con '&&' embebido) - *--------------------------------------------------------------------------------------------------- - LPARAMETERS tcLine as String, tcComment as String, tlDeepCommentAnalysis as Boolean - LOCAL ln_AT_Cmt + Procedure get_SeparatedLineAndComment +*--------------------------------------------------------------------------------------------------- +* PARÁMETROS: (v=Pasar por valor | @=Pasar por referencia) (!=Obligatorio | ?=Opcional) (IN/OUT) +* tcLine (!@ IN/OUT) Línea a separar del comentario +* tcComment (@? OUT) Comentario +* tlDeepCommentAnalysis (v? IN ) Indica realizar un análisis profundo de comentarios (para detectar casos complejos de código con '&&' embebido) +*--------------------------------------------------------------------------------------------------- + Lparameters tcLine As String, tcComment As String, tlDeepCommentAnalysis As Boolean + Local ln_AT_Cmt tcComment = '' - ln_AT_Cmt = AT( '&'+'&', tcLine) + ln_AT_Cmt = At( '&'+'&', tcLine) - IF ln_AT_Cmt > 0 - IF tlDeepCommentAnalysis THEN - LOCAL laSeparador(3,3), lcSeparadoresIzq, lcSeparadoresDer, lcStr, lnAT_Amp, lnAT1, lnAT2, lnLen, I, X + If ln_AT_Cmt > 0 + If tlDeepCommentAnalysis Then + Local laSeparador(3,3), lcSeparadoresIzq, lcSeparadoresDer, lcStr, lnAT_Amp, lnAT1, lnAT2, lnLen, I, X lcStr = tcLine &&EVL(tcStr, [DEFINE BAR 2 OF OpciónAsub PROMPT "Opción A&]+[&2" &]+[& Comentario Opción A-2]) laSeparador(1,1) = '"' @@ -4410,1026 +4410,1026 @@ DEFINE CLASS c_foxbin2prg AS Session laSeparador(3,3) = 1 lcSeparadoresIzq = laSeparador(1,1) + laSeparador(2,1) + laSeparador(3,1) lcSeparadoresDer = laSeparador(1,2) + laSeparador(2,2) + laSeparador(3,2) - lnLen = LEN(lcStr) + lnLen = Len(lcStr) - *-- Anular subcadenas para luego encontrar comentarios '&&' (y analizar solo si existe al menos un '&&') +*-- Anular subcadenas para luego encontrar comentarios '&&' (y analizar solo si existe al menos un '&&') X = 1 - lnAT1 = AT(laSeparador(m.X,1), lcStr) + lnAT1 = At(laSeparador(m.X,1), lcStr) - *-- Funcionamiento: - *-- La anulación de subcadenas se hace comenzando desde la primer comilla doble ["], y luego se va - *-- cancelando hasta la siguiente. A partir de ahi, se busca carácter a carácter el siguiente separador - *-- izquierdo de cadena ( '"[ ), se busca su pareja derecha y se cancela el texto entre ambos. - *-- La anulación de subcadenas es temporal, solo para determinar la verdadera posición del comentario, - *-- por ejemplo, esto: - *-- DEFINE BAR 2 OF OpciónAsub PROMPT ""+var+'aa'+["bb]+"Opción A&&2" && Comentario Opción A-2 - *-- se convierte temporalmente en esto: - *-- DEFINE BAR 2 OF OpciónAsub PROMPT XX+var+XXXX+XXXXX+XXXXXXXXXXXXX && Comentario Opción A-2 - *-- lo que facilita encontrar el comentario '&&' real. - *-- Si se encuentra algún separador de cadena que no cierre, se genera un error 10 (Syntax Error). - IF lnAT1 > 0 THEN - FOR I = lnAT1+1 TO lnLen - IF m.X > 0 THEN - lnAT2 = AT(laSeparador(m.X,2), lcStr, laSeparador(m.X,3)) +*-- Funcionamiento: +*-- La anulación de subcadenas se hace comenzando desde la primer comilla doble ["], y luego se va +*-- cancelando hasta la siguiente. A partir de ahi, se busca carácter a carácter el siguiente separador +*-- izquierdo de cadena ( '"[ ), se busca su pareja derecha y se cancela el texto entre ambos. +*-- La anulación de subcadenas es temporal, solo para determinar la verdadera posición del comentario, +*-- por ejemplo, esto: +*-- DEFINE BAR 2 OF OpciónAsub PROMPT ""+var+'aa'+["bb]+"Opción A&&2" && Comentario Opción A-2 +*-- se convierte temporalmente en esto: +*-- DEFINE BAR 2 OF OpciónAsub PROMPT XX+var+XXXX+XXXXX+XXXXXXXXXXXXX && Comentario Opción A-2 +*-- lo que facilita encontrar el comentario '&&' real. +*-- Si se encuentra algún separador de cadena que no cierre, se genera un error 10 (Syntax Error). + If lnAT1 > 0 Then + For I = lnAT1+1 To lnLen + If m.X > 0 Then + lnAT2 = At(laSeparador(m.X,2), lcStr, laSeparador(m.X,3)) - IF lnAT2 > 0 THEN - lcStr = STUFF(lcStr, lnAT1, lnAT2-lnAT1+1, REPLICATE('X',lnAT2-lnAT1+1)) - ELSE - ln_AT_Cmt = AT( '&'+'&', lcStr) + If lnAT2 > 0 Then + lcStr = Stuff(lcStr, lnAT1, lnAT2-lnAT1+1, Replicate('X',lnAT2-lnAT1+1)) + Else + ln_AT_Cmt = At( '&'+'&', lcStr) - IF ln_AT_Cmt = 0 OR ln_AT_Cmt < lnAT1 - *-- No tiene comentario '&&' real, o sí lo tiene y además contiene un delimitador de cadena como parte del comentario - EXIT - ELSE - ERROR 'Closing string delimiter <' + laSeparador(m.X,2) + '> not found: ' + tcLine - ENDIF - ENDIF - ENDIF + If ln_AT_Cmt = 0 Or ln_AT_Cmt < lnAT1 +*-- No tiene comentario '&&' real, o sí lo tiene y además contiene un delimitador de cadena como parte del comentario + Exit + Else + Error 'Closing string delimiter <' + laSeparador(m.X,2) + '> not found: ' + tcLine + Endif + Endif + Endif - *-- Verifico si el carácter es un separador de cadenas: '"[ - X = AT( SUBSTR(lcStr, m.I, 1), lcSeparadoresIzq) +*-- Verifico si el carácter es un separador de cadenas: '"[ + X = At( Substr(lcStr, m.I, 1), lcSeparadoresIzq) - IF m.X > 0 THEN - lnAT1 = AT(laSeparador(m.X,1), lcStr) - ENDIF - ENDFOR - ENDIF + If m.X > 0 Then + lnAT1 = At(laSeparador(m.X,1), lcStr) + Endif + Endfor + Endif - ln_AT_Cmt = AT( '&'+'&', lcStr) - ENDIF && tlDeepCommentAnalysis + ln_AT_Cmt = At( '&'+'&', lcStr) + Endif && tlDeepCommentAnalysis - IF ln_AT_Cmt > 0 - tcComment = LTRIM( SUBSTR( tcLine, ln_AT_Cmt + 2 ) ) - tcLine = RTRIM( LEFT( tcLine, ln_AT_Cmt - 1 ), 0, CHR(9), ' ' ) && Quito TABS y espacios - ENDIF + If ln_AT_Cmt > 0 + tcComment = Ltrim( Substr( tcLine, ln_AT_Cmt + 2 ) ) + tcLine = Rtrim( Left( tcLine, ln_AT_Cmt - 1 ), 0, Chr(9), ' ' ) && Quito TABS y espacios + Endif - ENDIF + Endif - RETURN (ln_AT_Cmt > 0) - ENDPROC + Return (ln_AT_Cmt > 0) + Endproc - PROCEDURE normalizeFileCapitalization - LPARAMETERS tl_NormalizeInputFile, tcFileName + Procedure normalizeFileCapitalization + Lparameters tl_NormalizeInputFile, tcFileName - TRY - LOCAL lcPath, lcEXE_CAPS, lcOutputFile, llRelanzarError, lcType, laDirInfo(1,5) ; - , loEx AS EXCEPTION ; - , loLang as CL_LANG OF 'FOXBIN2PRG.PRG' ; - , loFSO AS Scripting.FileSystemObject + Try + Local lcPath, lcEXE_CAPS, lcOutputFile, llRelanzarError, lcType, laDirInfo(1,5) ; + , loEx As Exception ; + , loLang As CL_LANG Of 'FOXBIN2PRG.PRG' ; + , loFSO As Scripting.FileSystemObject - WITH THIS AS c_foxbin2prg OF 'FOXBIN2PRG.PRG' - IF NOT .l_ProcessFiles - EXIT - ENDIF + With This As c_foxbin2prg Of 'FOXBIN2PRG.PRG' + If Not .l_ProcessFiles + Exit + Endif - loLang = _SCREEN.o_FoxBin2Prg_Lang - lcPath = JUSTPATH(.c_Foxbin2prg_FullPath) - lcEXE_CAPS = FORCEPATH( 'filename_caps.exe', lcPath ) - loFSO = .o_FSO - llRelanzarError = NOT tl_NormalizeInputFile + loLang = _Screen.o_FoxBin2Prg_Lang + lcPath = Justpath(.c_Foxbin2prg_FullPath) + lcEXE_CAPS = Forcepath( 'filename_caps.exe', lcPath ) + loFSO = .o_FSO + llRelanzarError = Not tl_NormalizeInputFile - IF tl_NormalizeInputFile - tcFileName = EVL( tcFileName, .c_InputFile ) - lcType = UPPER( JUSTEXT( tcFileName ) ) - ELSE - tcFileName = EVL( tcFileName, .c_OutputFile ) - lcType = .c_Type - ENDIF + If tl_NormalizeInputFile + tcFileName = Evl( tcFileName, .c_InputFile ) + lcType = Upper( Justext( tcFileName ) ) + Else + tcFileName = Evl( tcFileName, .c_OutputFile ) + lcType = .c_Type + Endif - DO CASE - CASE .n_ExisteCapitalizacion = -1 - *-- La primera vez vale -1, hace la verificación por única vez y cachea la respuesta - IF FILE(lcEXE_CAPS) - *.writeLog( '* Se ha encontrado el programa de capitalización de nombres [' + lcEXE_CAPS + ']' ) - .writeLog( C_TAB + TEXTMERGE(loLang.C_NAMES_CAPITALIZATION_PROGRAM_FOUND_LOC) ) - SET PROCEDURE TO (lcEXE_CAPS) ADDITIVE - .o_FNC = CREATEOBJECT( 'cl_FileName_Caps' ) - RELEASE PROCEDURE (lcEXE_CAPS) + Do Case + Case .n_ExisteCapitalizacion = -1 +*-- La primera vez vale -1, hace la verificación por única vez y cachea la respuesta + If File(lcEXE_CAPS) +*.writeLog( '* Se ha encontrado el programa de capitalización de nombres [' + lcEXE_CAPS + ']' ) + .writeLog( C_TAB + Textmerge(loLang.C_NAMES_CAPITALIZATION_PROGRAM_FOUND_LOC) ) + Set Procedure To (lcEXE_CAPS) Additive + .o_FNC = Createobject( 'cl_FileName_Caps' ) + Release Procedure (lcEXE_CAPS) - .n_ExisteCapitalizacion = 1 - ELSE - *-- No existe el programa de capitalización, así que no se capitalizan los nombres. - *.writeLog( '* No se ha encontrado el programa de capitalización de nombres [' + lcEXE_CAPS + ']' ) - .writeLog( C_TAB + TEXTMERGE(loLang.C_NAMES_CAPITALIZATION_PROGRAM_NOT_FOUND_LOC) ) - .n_ExisteCapitalizacion = 0 - EXIT - ENDIF + .n_ExisteCapitalizacion = 1 + Else +*-- No existe el programa de capitalización, así que no se capitalizan los nombres. +*.writeLog( '* No se ha encontrado el programa de capitalización de nombres [' + lcEXE_CAPS + ']' ) + .writeLog( C_TAB + Textmerge(loLang.C_NAMES_CAPITALIZATION_PROGRAM_NOT_FOUND_LOC) ) + .n_ExisteCapitalizacion = 0 + Exit + Endif - CASE .n_ExisteCapitalizacion = 0 - *-- Segunda pasada en adelante: No hay programa de capitalización - EXIT + Case .n_ExisteCapitalizacion = 0 +*-- Segunda pasada en adelante: No hay programa de capitalización + Exit - OTHERWISE - *-- Segunda pasada en adelante: Hay programa de capitalización + Otherwise +*-- Segunda pasada en adelante: Hay programa de capitalización - ENDCASE + Endcase - *-- Normalizar archivo(s) de entrada. El primero siempre se normaliza (??2, ??X, DBF, DBC) - .renameFile( tcFileName, lcEXE_CAPS, loFSO, llRelanzarError ) +*-- Normalizar archivo(s) de entrada. El primero siempre se normaliza (??2, ??X, DBF, DBC) + .renameFile( tcFileName, lcEXE_CAPS, loFSO, llRelanzarError ) - DO CASE - CASE lcType = 'PJX' - .renameFile( FORCEEXT(tcFileName,'PJT'), lcEXE_CAPS, loFSO, llRelanzarError ) + Do Case + Case lcType = 'PJX' + .renameFile( Forceext(tcFileName,'PJT'), lcEXE_CAPS, loFSO, llRelanzarError ) - CASE lcType = 'VCX' - .renameFile( FORCEEXT(tcFileName,'VCT'), lcEXE_CAPS, loFSO, llRelanzarError ) + Case lcType = 'VCX' + .renameFile( Forceext(tcFileName,'VCT'), lcEXE_CAPS, loFSO, llRelanzarError ) - CASE lcType = 'SCX' - .renameFile( FORCEEXT(tcFileName,'SCT'), lcEXE_CAPS, loFSO, llRelanzarError ) + Case lcType = 'SCX' + .renameFile( Forceext(tcFileName,'SCT'), lcEXE_CAPS, loFSO, llRelanzarError ) - CASE lcType = 'FRX' - .renameFile( FORCEEXT(tcFileName,'FRT'), lcEXE_CAPS, loFSO, llRelanzarError ) + Case lcType = 'FRX' + .renameFile( Forceext(tcFileName,'FRT'), lcEXE_CAPS, loFSO, llRelanzarError ) - CASE lcType = 'LBX' - .renameFile( FORCEEXT(tcFileName,'LBT'), lcEXE_CAPS, loFSO, llRelanzarError ) + Case lcType = 'LBX' + .renameFile( Forceext(tcFileName,'LBT'), lcEXE_CAPS, loFSO, llRelanzarError ) - CASE lcType = 'DBF' - IF ADIR( laDirInfo, FORCEEXT(tcFileName,'FPT') ) > 0 THEN - .renameFile( FORCEEXT(tcFileName,'FPT'), lcEXE_CAPS, loFSO, llRelanzarError ) - ENDIF - IF ADIR( laDirInfo, FORCEEXT(tcFileName,'CDX') ) > 0 THEN - .renameFile( FORCEEXT(tcFileName,'CDX'), lcEXE_CAPS, loFSO, llRelanzarError ) - ENDIF + Case lcType = 'DBF' + If Adir( laDirInfo, Forceext(tcFileName,'FPT') ) > 0 Then + .renameFile( Forceext(tcFileName,'FPT'), lcEXE_CAPS, loFSO, llRelanzarError ) + Endif + If Adir( laDirInfo, Forceext(tcFileName,'CDX') ) > 0 Then + .renameFile( Forceext(tcFileName,'CDX'), lcEXE_CAPS, loFSO, llRelanzarError ) + Endif - CASE lcType = 'DBC' - .renameFile( FORCEEXT(tcFileName,'DCX'), lcEXE_CAPS, loFSO, llRelanzarError ) - .renameFile( FORCEEXT(tcFileName,'DCT'), lcEXE_CAPS, loFSO, llRelanzarError ) + Case lcType = 'DBC' + .renameFile( Forceext(tcFileName,'DCX'), lcEXE_CAPS, loFSO, llRelanzarError ) + .renameFile( Forceext(tcFileName,'DCT'), lcEXE_CAPS, loFSO, llRelanzarError ) - CASE lcType = 'MNX' - .renameFile( FORCEEXT(tcFileName,'MNT'), lcEXE_CAPS, loFSO, llRelanzarError ) + Case lcType = 'MNX' + .renameFile( Forceext(tcFileName,'MNT'), lcEXE_CAPS, loFSO, llRelanzarError ) - ENDCASE + Endcase - ENDWITH && THIS + Endwith && THIS - CATCH TO loEx - THROW + Catch To loEx + Throw - FINALLY - loFSO = NULL - RELEASE lcPath, lcEXE_CAPS, lcOutputFile, llRelanzarError, lcType, loFSO + Finally + loFSO = Null + Release lcPath, lcEXE_CAPS, lcOutputFile, llRelanzarError, lcType, loFSO - ENDTRY + Endtry - RETURN - ENDPROC + Return + Endproc - PROCEDURE get_FilesFromDirectory - LPARAMETERS tcDir, taFiles, tnFileCount - EXTERNAL ARRAY taFiles + Procedure get_FilesFromDirectory + Lparameters tcDir, taFiles, tnFileCount + External Array taFiles - LOCAL laFiles(1), I, lnFiles ; - , loLang as CL_LANG OF 'FOXBIN2PRG.PRG' + Local laFiles(1), I, lnFiles ; + , loLang As CL_LANG Of 'FOXBIN2PRG.PRG' - IF TYPE("ALEN(laFiles)") # "N" OR EMPTY(tnFileCount) + If Type("ALEN(laFiles)") # "N" Or Empty(tnFileCount) tnFileCount = 0 - DIMENSION taFiles(1) - ENDIF + Dimension taFiles(1) + Endif - tcDir = ADDBS(tcDir) + tcDir = Addbs(tcDir) - IF DIRECTORY(tcDir) - WITH THIS AS c_foxbin2prg OF 'FOXBIN2PRG.PRG' - loLang = _SCREEN.o_FoxBin2Prg_Lang + If Directory(tcDir) + With This As c_foxbin2prg Of 'FOXBIN2PRG.PRG' + loLang = _Screen.o_FoxBin2Prg_Lang .updateProgressbar( loLang.C_SCANNING_FILE_AND_DIR_INFO_LOC + ' ' + tcDir + '...', 0, 0, 0 ) - lnFiles = ADIR( laFiles, tcDir + '*.*', 'D', 1) + lnFiles = Adir( laFiles, tcDir + '*.*', 'D', 1) - *-- Busco los archivos - FOR I = 1 TO lnFiles - IF SUBSTR( laFiles(m.I,5), 5, 1 ) == 'D' - LOOP - ENDIF +*-- Busco los archivos + For I = 1 To lnFiles + If Substr( laFiles(m.I,5), 5, 1 ) == 'D' + Loop + Endif tnFileCount = tnFileCount + 1 - DIMENSION taFiles(tnFileCount) + Dimension taFiles(tnFileCount) taFiles(tnFileCount) = tcDir + laFiles(m.I,1) - ENDFOR + Endfor - *-- Busco los subdirectorios - FOR I = 1 TO lnFiles - IF NOT SUBSTR( laFiles(m.I,5), 5, 1 ) == 'D' OR LEFT(laFiles(m.I,1), 1) == '.' - LOOP - ENDIF +*-- Busco los subdirectorios + For I = 1 To lnFiles + If Not Substr( laFiles(m.I,5), 5, 1 ) == 'D' Or Left(laFiles(m.I,1), 1) == '.' + Loop + Endif .get_FilesFromDirectory( tcDir + laFiles(m.I,1), @taFiles, @lnFileCount ) - ENDFOR - ENDWITH - ENDIF - ENDPROC + Endfor + Endwith + Endif + Endproc - PROCEDURE loadModule - *-------------------------------------------------------------------------------------------------------------- - * CARGA EL MÓDULO INDICADO EN tc_InputFile Y DEVUELVE SU REFERENCIA DE OBJETO EN toModulo - *-------------------------------------------------------------------------------------------------------------- - * PARÁMETROS: (v=Pasar por valor | @=Pasar por referencia) (!=Obligatorio | ?=Opcional) (IN/OUT) - * tc_InputFile (v! IN ) Nombre del archivo de entrada - * toModulo (@? OUT) Referencia de objeto del módulo generado (para Unit Testing) - * toEx (@? OUT) Objeto con información del error - * tlRelanzarError (v? IN ) Indica si el error debe relanzarse o no - * tcOriginalFileName (v? IN ) Sirve para los casos en los que inputFile es un nombre temporal y se quiere generar - * el nombre correcto dentro de la versión texto (por ej: en los PJ2 y las cabeceras) - *-------------------------------------------------------------------------------------------------------------- - LPARAMETERS tc_InputFile, toModulo, toEx AS EXCEPTION, tlRelanzarError, tcOriginalFileName + Procedure loadModule +*-------------------------------------------------------------------------------------------------------------- +* CARGA EL MÓDULO INDICADO EN tc_InputFile Y DEVUELVE SU REFERENCIA DE OBJETO EN toModulo +*-------------------------------------------------------------------------------------------------------------- +* PARÁMETROS: (v=Pasar por valor | @=Pasar por referencia) (!=Obligatorio | ?=Opcional) (IN/OUT) +* tc_InputFile (v! IN ) Nombre del archivo de entrada +* toModulo (@? OUT) Referencia de objeto del módulo generado (para Unit Testing) +* toEx (@? OUT) Objeto con información del error +* tlRelanzarError (v? IN ) Indica si el error debe relanzarse o no +* tcOriginalFileName (v? IN ) Sirve para los casos en los que inputFile es un nombre temporal y se quiere generar +* el nombre correcto dentro de la versión texto (por ej: en los PJ2 y las cabeceras) +*-------------------------------------------------------------------------------------------------------------- + Lparameters tc_InputFile, toModulo, toEx As Exception, tlRelanzarError, tcOriginalFileName - TRY - LOCAL lnCodError, lcErrorInfo, laDirFile(1,5), lcExtension, lnFileCount, laFiles(1,1), I ; - , ltFilestamp, lcExtA, lcExtB, laEvents(1,1), lnIDInputFile ; - , loLang as CL_LANG OF 'FOXBIN2PRG.PRG' ; - , loConversor as c_conversor_base OF 'FOXBIN2PRG.PRG' ; - , loFSO AS Scripting.FileSystemObject - lnCodError = 0 + Try + Local lnCodError, lcErrorInfo, laDirFile(1,5), lcExtension, lnFileCount, laFiles(1,1), I ; + , ltFilestamp, lcExtA, lcExtB, laEvents(1,1), lnIDInputFile ; + , loLang As CL_LANG Of 'FOXBIN2PRG.PRG' ; + , loConversor As c_conversor_base Of 'FOXBIN2PRG.PRG' ; + , loFSO As Scripting.FileSystemObject + lnCodError = 0 - WITH THIS AS c_foxbin2prg OF 'FOXBIN2PRG.PRG' - STORE NULL TO toModulo - lc_OldSetNotify = SET("Notify") - SET NOTIFY OFF - loFSO = .o_FSO - loLang = _SCREEN.o_FoxBin2Prg_Lang - .c_InputFile = FULLPATH( tc_InputFile ) - .l_Error = .F. - lcExtension = UPPER( JUSTEXT(.c_InputFile) ) + With This As c_foxbin2prg Of 'FOXBIN2PRG.PRG' + Store Null To toModulo + lc_OldSetNotify = Set("Notify") + Set Notify Off + loFSO = .o_FSO + loLang = _Screen.o_FoxBin2Prg_Lang + .c_InputFile = Fullpath( tc_InputFile ) + .l_Error = .F. + lcExtension = Upper( Justext(.c_InputFile) ) - .writeLog( REPLICATE( '*', 100 ) ) - .writeLog( 'LOAD MODULE', 2 ) - .writeLog( REPLICATE( '*', 100 ) ) + .writeLog( Replicate( '*', 100 ) ) + .writeLog( 'LOAD MODULE', 2 ) + .writeLog( Replicate( '*', 100 ) ) - IF ADIR( laDirFile, .c_InputFile, '', 1 ) = 0 - *ERROR 'No se encontró el archivo [' + .c_InputFile + ']' - ERROR loLang.C_FILE_NOT_FOUND_LOC + ' [' + .c_InputFile + ']' - ENDIF + If Adir( laDirFile, .c_InputFile, '', 1 ) = 0 +*ERROR 'No se encontró el archivo [' + .c_InputFile + ']' + Error loLang.C_FILE_NOT_FOUND_LOC + ' [' + .c_InputFile + ']' + Endif - .c_InputFile = loFSO.GetAbsolutePathName( FORCEPATH( laDirFile(1,1), JUSTPATH(.c_InputFile) ) ) + .c_InputFile = loFSO.GetAbsolutePathName( Forcepath( laDirFile(1,1), Justpath(.c_InputFile) ) ) - *-- VERIFICO SI HAY ARCHIVO DE CONFIGURACIÓN SECUNDARIO - .evaluateConfiguration() +*-- VERIFICO SI HAY ARCHIVO DE CONFIGURACIÓN SECUNDARIO + .evaluateConfiguration() - IF NOT EMPTY(tcOriginalFileName) - tcOriginalFileName = loFSO.GetAbsolutePathName( tcOriginalFileName ) - ENDIF + If Not Empty(tcOriginalFileName) + tcOriginalFileName = loFSO.GetAbsolutePathName( tcOriginalFileName ) + Endif - .c_OriginalFileName = EVL( tcOriginalFileName, .c_InputFile ) + .c_OriginalFileName = Evl( tcOriginalFileName, .c_InputFile ) - IF UPPER( JUSTEXT(.c_OriginalFileName) ) = 'PJM' AND .c_PJ2 <> 'PJM' - .c_OriginalFileName = FORCEEXT(.c_OriginalFileName,'pjx') - ENDIF + If Upper( Justext(.c_OriginalFileName) ) = 'PJM' And .c_PJ2 <> 'PJM' + .c_OriginalFileName = Forceext(.c_OriginalFileName,'pjx') + Endif - lnIDInputFile = .n_ProcessedFiles + lnIDInputFile = .n_ProcessedFiles - .writeLog( C_TAB + 'c_OriginalFileName: ' + .c_OriginalFileName ) - .writeLog( ) + .writeLog( C_TAB + 'c_OriginalFileName: ' + .c_OriginalFileName ) + .writeLog( ) - IF NOT ADIR(laDirFile, .c_InputFile) > 0 THEN - ERROR loLang.C_FILE_DOESNT_EXIST_LOC + ' [' + .c_InputFile + ']' - ENDIF + If Not Adir(laDirFile, .c_InputFile) > 0 Then + Error loLang.C_FILE_DOESNT_EXIST_LOC + ' [' + .c_InputFile + ']' + Endif - DO CASE - CASE lcExtension = 'VCX' - loConversor = CREATEOBJECT( 'c_conversor_vcx_a_prg' ) + Do Case + Case lcExtension = 'VCX' + loConversor = Createobject( 'c_conversor_vcx_a_prg' ) - CASE lcExtension = 'SCX' - loConversor = CREATEOBJECT( 'c_conversor_scx_a_prg' ) + Case lcExtension = 'SCX' + loConversor = Createobject( 'c_conversor_scx_a_prg' ) - CASE lcExtension = 'PJX' - loConversor = CREATEOBJECT( 'c_conversor_pjx_a_prg' ) + Case lcExtension = 'PJX' + loConversor = Createobject( 'c_conversor_pjx_a_prg' ) - CASE lcExtension = 'PJM' AND .c_PJ2 <> 'PJM' - loConversor = CREATEOBJECT( 'c_conversor_pjm_a_prg' ) + Case lcExtension = 'PJM' And .c_PJ2 <> 'PJM' + loConversor = Createobject( 'c_conversor_pjm_a_prg' ) - CASE lcExtension = 'FRX' - loConversor = CREATEOBJECT( 'c_conversor_frx_a_prg' ) + Case lcExtension = 'FRX' + loConversor = Createobject( 'c_conversor_frx_a_prg' ) - CASE lcExtension = 'LBX' - loConversor = CREATEOBJECT( 'c_conversor_frx_a_prg' ) + Case lcExtension = 'LBX' + loConversor = Createobject( 'c_conversor_frx_a_prg' ) - CASE lcExtension = 'DBF' - loConversor = CREATEOBJECT( 'c_conversor_dbf_a_prg' ) + Case lcExtension = 'DBF' + loConversor = Createobject( 'c_conversor_dbf_a_prg' ) - CASE lcExtension = 'DBC' - loConversor = CREATEOBJECT( 'c_conversor_dbc_a_prg' ) + Case lcExtension = 'DBC' + loConversor = Createobject( 'c_conversor_dbc_a_prg' ) - CASE lcExtension = 'MNX' - loConversor = CREATEOBJECT( 'c_conversor_mnx_a_prg' ) + Case lcExtension = 'MNX' + loConversor = Createobject( 'c_conversor_mnx_a_prg' ) - CASE lcExtension = .c_VC2 - loConversor = CREATEOBJECT( 'c_conversor_prg_a_vcx' ) + Case lcExtension = .c_VC2 + loConversor = Createobject( 'c_conversor_prg_a_vcx' ) - CASE lcExtension = .c_SC2 - loConversor = CREATEOBJECT( 'c_conversor_prg_a_scx' ) + Case lcExtension = .c_SC2 + loConversor = Createobject( 'c_conversor_prg_a_scx' ) - CASE lcExtension = .c_PJ2 - loConversor = CREATEOBJECT( 'c_conversor_prg_a_pjx' ) + Case lcExtension = .c_PJ2 + loConversor = Createobject( 'c_conversor_prg_a_pjx' ) - CASE lcExtension = .c_FR2 - loConversor = CREATEOBJECT( 'c_conversor_prg_a_frx' ) + Case lcExtension = .c_FR2 + loConversor = Createobject( 'c_conversor_prg_a_frx' ) - CASE lcExtension = .c_LB2 - loConversor = CREATEOBJECT( 'c_conversor_prg_a_frx' ) + Case lcExtension = .c_LB2 + loConversor = Createobject( 'c_conversor_prg_a_frx' ) - CASE lcExtension = .c_DB2 - loConversor = CREATEOBJECT( 'c_conversor_prg_a_dbf' ) + Case lcExtension = .c_DB2 + loConversor = Createobject( 'c_conversor_prg_a_dbf' ) - CASE lcExtension = .c_DC2 - loConversor = CREATEOBJECT( 'c_conversor_prg_a_dbc' ) + Case lcExtension = .c_DC2 + loConversor = Createobject( 'c_conversor_prg_a_dbc' ) - CASE lcExtension = .c_MN2 - loConversor = CREATEOBJECT( 'c_conversor_prg_a_mnx' ) + Case lcExtension = .c_MN2 + loConversor = Createobject( 'c_conversor_prg_a_mnx' ) - OTHERWISE - *ERROR 'El archivo [' + .c_InputFile + '] no está soportado' - ERROR (TEXTMERGE(loLang.C_FILE_NAME_IS_NOT_SUPPORTED_LOC)) + Otherwise +*ERROR 'El archivo [' + .c_InputFile + '] no está soportado' + Error (Textmerge(loLang.C_FILE_NAME_IS_NOT_SUPPORTED_LOC)) - ENDCASE + Endcase - .c_Type = UPPER(JUSTEXT(.c_OutputFile)) - loConversor.c_InputFile = .c_InputFile - loConversor.c_OutputFile = .c_OutputFile - loConversor.c_LogFile = .c_LogFile - loConversor.n_Debug = .n_Debug - loConversor.l_Test = .l_Test - loConversor.n_FB2PRG_Version = .n_FB2PRG_Version - loConversor.l_MethodSort_Enabled = .l_MethodSort_Enabled - loConversor.l_PropSort_Enabled = .l_PropSort_Enabled - loConversor.l_ReportSort_Enabled = .l_ReportSort_Enabled - loConversor.c_OriginalFileName = .c_OriginalFileName - loConversor.c_Foxbin2prg_FullPath = .c_Foxbin2prg_FullPath - *-- - *.updateProgressbar( loLang.C_PROCESSING_LOC + ' ' + .c_InputFile + '...', 0, 0, 0 ) + .c_Type = Upper(Justext(.c_OutputFile)) + loConversor.c_InputFile = .c_InputFile + loConversor.c_OutputFile = .c_OutputFile + loConversor.c_LogFile = .c_LogFile + loConversor.n_Debug = .n_Debug + loConversor.l_Test = .l_Test + loConversor.n_FB2PRG_Version = .n_FB2PRG_Version + loConversor.l_MethodSort_Enabled = .l_MethodSort_Enabled + loConversor.l_PropSort_Enabled = .l_PropSort_Enabled + loConversor.l_ReportSort_Enabled = .l_ReportSort_Enabled + loConversor.c_OriginalFileName = .c_OriginalFileName + loConversor.c_Foxbin2prg_FullPath = .c_Foxbin2prg_FullPath +*-- +*.updateProgressbar( loLang.C_PROCESSING_LOC + ' ' + .c_InputFile + '...', 0, 0, 0 ) - *IF AEVENTS( laEvents, loConversor ) = 0 THEN - * BINDEVENT( loConversor, 'updateProgressbar', THIS, 'updateProgressbar' ) - *ENDIF +*IF AEVENTS( laEvents, loConversor ) = 0 THEN +* BINDEVENT( loConversor, 'updateProgressbar', THIS, 'updateProgressbar' ) +*ENDIF - loConversor.loadModule( @toModulo, .F., THIS ) + loConversor.loadModule( @toModulo, .F., This ) - IF loConversor.l_Error THEN - .l_Error = .T. - ENDIF + If loConversor.l_Error Then + .l_Error = .T. + Endif - *.n_ProcessedFilesCount = .n_ProcessedFilesCount + 1 - .writeLog() - .writeLog(loConversor.c_TextLog) && Recojo el LOG que haya generado el conversor +*.n_ProcessedFilesCount = .n_ProcessedFilesCount + 1 + .writeLog() + .writeLog(loConversor.c_TextLog) && Recojo el LOG que haya generado el conversor - *-- Logueo los errores - IF NOT EMPTY(loConversor.c_TextErr) THEN - .writeErrorLog( REPLICATE( '-', 100 ), 1 ) - .writeErrorLog( loLang.C_ERRORS_FOUND_IN_FILE_LOC + ' [' + .c_InputFile + '] ' ) - .writeErrorLog( loConversor.c_TextErr ) - .writeErrorLog( ) - ENDIF +*-- Logueo los errores + If Not Empty(loConversor.c_TextErr) Then + .writeErrorLog( Replicate( '-', 100 ), 1 ) + .writeErrorLog( loLang.C_ERRORS_FOUND_IN_FILE_LOC + ' [' + .c_InputFile + '] ' ) + .writeErrorLog( loConversor.c_TextErr ) + .writeErrorLog( ) + Endif - ENDWITH && THIS AS c_foxbin2prg OF 'FOXBIN2PRG.PRG' + Endwith && THIS AS c_foxbin2prg OF 'FOXBIN2PRG.PRG' - CATCH TO toEx - lnCodError = toEx.ERRORNO - *lcErrorInfo = THIS.exception2Str(toEx) + CR_LF + CR_LF + loLang.C_SOURCEFILE_LOC + THIS.c_InputFile + Catch To toEx + lnCodError = toEx.ErrorNo +*lcErrorInfo = THIS.exception2Str(toEx) + CR_LF + CR_LF + loLang.C_SOURCEFILE_LOC + THIS.c_InputFile - *-- updateProcessedFile( tcProcessed, tcHasErrors, tcSupported, tcReserved ) - *THIS.updateProcessedFile( lnIDInputFile, '', '', 'E1' ) +*-- updateProcessedFile( tcProcessed, tcHasErrors, tcSupported, tcReserved ) +*THIS.updateProcessedFile( lnIDInputFile, '', '', 'E1' ) - IF THIS.n_Debug > 0 THEN - IF _VFP.STARTMODE = 0 - SET STEP ON - ENDIF - ENDIF - IF tlRelanzarError && Usado en Unit Testing - THROW - ENDIF + If This.n_Debug > 0 Then + If _vfp.StartMode = 0 + Set Step On + Endif + Endif + If tlRelanzarError && Usado en Unit Testing + Throw + Endif - FINALLY - SET NOTIFY &lc_OldSetNotify. + Finally + Set Notify &lc_OldSetNotify. - *IF AEVENTS( laEvents, loConversor ) > 0 THEN - * UNBINDEVENTS( loConversor ) - *ENDIF +*IF AEVENTS( laEvents, loConversor ) > 0 THEN +* UNBINDEVENTS( loConversor ) +*ENDIF - STORE NULL TO loConversor, loFSO + Store Null To loConversor, loFSO - *IF lnCodError = 0 AND THIS.l_Error THEN - * THIS.updateProcessedFile( lnIDInputFile, '', '', 'E1' ) - *ELSE - * *THIS.updateProcessedFile( lnIDInputFile ) - *ENDIF +*IF lnCodError = 0 AND THIS.l_Error THEN +* THIS.updateProcessedFile( lnIDInputFile, '', '', 'E1' ) +*ELSE +* *THIS.updateProcessedFile( lnIDInputFile ) +*ENDIF - RELEASE lcErrorInfo, laDirFile, lcExtension, lnFileCount, laFiles, I ; - , ltFilestamp, lcExtA, lcExtB ; - , loConversor, loFSO - ENDTRY + Release lcErrorInfo, laDirFile, lcExtension, lnFileCount, laFiles, I ; + , ltFilestamp, lcExtA, lcExtB ; + , loConversor, loFSO + Endtry - RETURN lnCodError - ENDPROC + Return lnCodError + Endproc - PROCEDURE readInputVFPParams - LPARAMETERS taParams, tnPCount - EXTERNAL ARRAY taParams - *----------------------------------------------------------------------------- - * Obtengo la linea completa de comandos - * Adaptado de http://www.news2news.com/vfp/?example=51&function=78 - * Facilitado por Mario Lopez en el foro FoxPro de Google Español - 23/12/2013 - * https://groups.google.com/d/msg/publicesvfoxpro/llS-kTNrG9M/LA4D3fd152IJ - *----------------------------------------------------------------------------- - DECLARE INTEGER GetCommandLine IN kernel32 - DECLARE INTEGER GlobalSize IN kernel32 INTEGER HMEM - DECLARE RtlMoveMemory IN kernel32 AS CopyMemory STRING @Destination, INTEGER SOURCE, INTEGER nLength + Procedure readInputVFPParams + Lparameters taParams, tnPCount + External Array taParams +*----------------------------------------------------------------------------- +* Obtengo la linea completa de comandos +* Adaptado de http://www.news2news.com/vfp/?example=51&function=78 +* Facilitado por Mario Lopez en el foro FoxPro de Google Español - 23/12/2013 +* https://groups.google.com/d/msg/publicesvfoxpro/llS-kTNrG9M/LA4D3fd152IJ +*----------------------------------------------------------------------------- + Declare Integer GetCommandLine In kernel32 + Declare Integer GlobalSize In kernel32 Integer Hmem + Declare RtlMoveMemory In kernel32 As CopyMemory String @Destination, Integer Source, Integer nLength - LOCAL lnAddress, lnBufsize, lsBuffer + Local lnAddress, lnBufsize, lsBuffer lnAddress = GetCommandLine() && returns an address in memory lnBufsize = GlobalSize(lnAddress) - * allocating and filling a buffer - IF lnBufsize <> 0 - lsBuffer = REPLICATE(CHR(0), lnBufsize) +* allocating and filling a buffer + If lnBufsize <> 0 + lsBuffer = Replicate(Chr(0), lnBufsize) = CopyMemory(@lsBuffer, lnAddress, lnBufsize) - ENDIF + Endif - lsBuffer = STRTRAN(lsBuffer, '"'+CHR(0), '"'+CHR(13)+CHR(10)) - lsBuffer = STRTRAN(lsBuffer, '" ', '"'+CHR(13)+CHR(10), 1, 1) - lsBuffer = STRTRAN(lsBuffer, CHR(0), ' ') - tnPCount = ALINES( taParams, lsBuffer, 4 ) + lsBuffer = Strtran(lsBuffer, '"'+Chr(0), '"'+Chr(13)+Chr(10)) + lsBuffer = Strtran(lsBuffer, '" ', '"'+Chr(13)+Chr(10), 1, 1) + lsBuffer = Strtran(lsBuffer, Chr(0), ' ') + tnPCount = Alines( taParams, lsBuffer, 4 ) - IF tnPCount > 1 THEN - ADEL( taParams, 1 ) + If tnPCount > 1 Then + Adel( taParams, 1 ) tnPCount = tnPCount - 1 - DIMENSION taParams(tnPCount) - ENDIF + Dimension taParams(tnPCount) + Endif - RETURN - ENDPROC + Return + Endproc - PROCEDURE renameFile - LPARAMETERS tcFileName, tcEXE_CAPS, toFSO AS Scripting.FileSystemObject, tlRelanzarError + Procedure renameFile + Lparameters tcFileName, tcEXE_CAPS, toFSO As Scripting.FileSystemObject, tlRelanzarError - LOCAL lcLog, laFile(1,5) ; - , loLang as CL_LANG OF 'FOXBIN2PRG.PRG' - loLang = _SCREEN.o_FoxBin2Prg_Lang + Local lcLog, laFile(1,5) ; + , loLang As CL_LANG Of 'FOXBIN2PRG.PRG' + loLang = _Screen.o_FoxBin2Prg_Lang - WITH THIS AS c_foxbin2prg OF 'FOXBIN2PRG.PRG' + With This As c_foxbin2prg Of 'FOXBIN2PRG.PRG' lcLog = '' .o_FNC.Capitalize( tcFileName, '', 'F', @lcLog, tlRelanzarError, '1' ) - IF .n_Debug >= 2 THEN - lcLog = SUBSTR(lcLog,3) + If .n_Debug >= 2 Then + lcLog = Substr(lcLog,3) .writeLog() - .writeLog( C_TAB + TEXTMERGE(loLang.C_REQUESTING_CAPITALIZATION_OF_FILE_LOC) ) + .writeLog( C_TAB + Textmerge(loLang.C_REQUESTING_CAPITALIZATION_OF_FILE_LOC) ) .writeLog( lcLog ) - ENDIF - ENDWITH - ENDPROC + Endif + Endwith + Endproc - PROCEDURE renameTmpFile2Tx2File - LPARAMETERS tcFileName + Procedure renameTmpFile2Tx2File + Lparameters tcFileName - LOCAL lcTmpFile, loFSO AS Scripting.FileSystemObject, loEx as Exception + Local lcTmpFile, loFSO As Scripting.FileSystemObject, loEx As Exception - TRY - *loFSO = THIS.o_FSO - lcTmpFile = tcFileName + '.TMP' - THIS.changeFileAttribute( tcFileName, '+N' ) - ERASE (tcFileName) - RENAME (lcTmpFile) TO (tcFileName) + Try +*loFSO = THIS.o_FSO + lcTmpFile = tcFileName + '.TMP' + This.changeFileAttribute( tcFileName, '+N' ) + Erase (tcFileName) + Rename (lcTmpFile) To (tcFileName) - CATCH TO loEx - THROW + Catch To loEx + Throw - FINALLY - *loFSO = NULL - ENDTRY + Finally +*loFSO = NULL + Endtry - RETURN - ENDPROC + Return + Endproc - PROCEDURE set_Line - LPARAMETERS tcLine, taCodeLines, I - tcLine = LTRIM( taCodeLines(m.I), 0, CHR(9), ' ' ) - ENDPROC + Procedure set_Line + Lparameters tcLine, taCodeLines, I + tcLine = Ltrim( taCodeLines(m.I), 0, Chr(9), ' ' ) + Endproc - PROCEDURE errOut - *-- DEVOLUCIÓN DE SALIDA A ERROUT (-12) - LPARAMETERS tcTexto + Procedure errOut +*-- DEVOLUCIÓN DE SALIDA A ERROUT (-12) + Lparameters tcTexto - TRY - IF THIS.l_StdOutHabilitado - LOCAL loException as Exception, lcOutput, lnOutHandle, lnBytesWritten, lnOverlappedIO - lcOutput = EVL(tcTexto,'') + CR_LF - lnOutHandle = fb2p_GetStdHandle(-12) && CAPTURAR ERROR DESDE CONSOLA: FOXBIN2PRG.EXE PARAMS 2>&1 | FIND /V "" - lnBytesWritten = 0 - lnOverlappedIO = 0 - fb2p_WriteFile(lnOutHandle, @lcOutput, LEN(lcOutput), @lnBytesWritten, @lnOverlappedIO) - ENDIF + Try + If This.l_StdOutHabilitado + Local loException As Exception, lcOutput, lnOutHandle, lnBytesWritten, lnOverlappedIO + lcOutput = Evl(tcTexto,'') + CR_LF + lnOutHandle = fb2p_GetStdHandle(-12) && CAPTURAR ERROR DESDE CONSOLA: FOXBIN2PRG.EXE PARAMS 2>&1 | FIND /V "" + lnBytesWritten = 0 + lnOverlappedIO = 0 + fb2p_WriteFile(lnOutHandle, @lcOutput, Len(lcOutput), @lnBytesWritten, @lnOverlappedIO) + Endif - CATCH TO loException - THIS.l_StdOutHabilitado = .F. + Catch To loException + This.l_StdOutHabilitado = .F. - ENDTRY + Endtry - RETURN - ENDPROC + Return + Endproc - PROCEDURE stdOut - *-- DEVOLUCIÓN DE SALIDA A STDOUT (-11) - LPARAMETERS tcTexto + Procedure stdOut +*-- DEVOLUCIÓN DE SALIDA A STDOUT (-11) + Lparameters tcTexto - TRY - IF THIS.l_StdOutHabilitado - LOCAL loException as Exception, lcOutput, lnOutHandle, lnBytesWritten, lnOverlappedIO - lcOutput = EVL(tcTexto,'') + CR_LF - lnOutHandle = fb2p_GetStdHandle(-11) && CAPTURAR STDOUT DESDE CONSOLA: FOXBIN2PRG.EXE PARAMS | FIND /V "" - lnBytesWritten = 0 - lnOverlappedIO = 0 - fb2p_WriteFile(lnOutHandle, @lcOutput, LEN(lcOutput), @lnBytesWritten, @lnOverlappedIO) - ENDIF + Try + If This.l_StdOutHabilitado + Local loException As Exception, lcOutput, lnOutHandle, lnBytesWritten, lnOverlappedIO + lcOutput = Evl(tcTexto,'') + CR_LF + lnOutHandle = fb2p_GetStdHandle(-11) && CAPTURAR STDOUT DESDE CONSOLA: FOXBIN2PRG.EXE PARAMS | FIND /V "" + lnBytesWritten = 0 + lnOverlappedIO = 0 + fb2p_WriteFile(lnOutHandle, @lcOutput, Len(lcOutput), @lnBytesWritten, @lnOverlappedIO) + Endif - CATCH TO loException - THIS.l_StdOutHabilitado = .F. + Catch To loException + This.l_StdOutHabilitado = .F. - ENDTRY + Endtry - RETURN - ENDPROC + Return + Endproc - PROCEDURE updateProcessedFile - *--------------------------------------------------------------------------------------------------- - * ACTUALIZA ALGUNOS DATOS DEL ARCHIVO PROCESADO ACTUAL - *--------------------------------------------------------------------------------------------------- - * PARÁMETROS: (v=Pasar por valor | @=Pasar por referencia) (!=Obligatorio | ?=Opcional) (IN/OUT) - * tnID (v? IN ) ID del archivo a actualizar. Si no se indica se asume el actual. - * tcInOutType (v? IN ) Archivo de entrada o de salida ("I"=Input file, "O"=Output file) - * tcProcessed (v? IN ) Procesado ("P0"=Not Processed, "P1"=Processed) - * tcHasErrors (v? IN ) Tuvo Errores ("E0"=No Errors, "E1"=Has Errors) - * tcSupported (v? IN ) Archivo soportado ("S0"=Unsupported, "S1"=Supported) - * tcExpanded (v? IN ) Tipo de archivo ("X0"=Normal file, "X1"=Expanded multipart file) - *--------------------------------------------------------------------------------------------------- - LPARAMETERS tnID, tcInOutType, tcProcessed, tcHasErrors, tcSupported, tcExpanded + Procedure updateProcessedFile +*--------------------------------------------------------------------------------------------------- +* ACTUALIZA ALGUNOS DATOS DEL ARCHIVO PROCESADO ACTUAL +*--------------------------------------------------------------------------------------------------- +* PARÁMETROS: (v=Pasar por valor | @=Pasar por referencia) (!=Obligatorio | ?=Opcional) (IN/OUT) +* tnID (v? IN ) ID del archivo a actualizar. Si no se indica se asume el actual. +* tcInOutType (v? IN ) Archivo de entrada o de salida ("I"=Input file, "O"=Output file) +* tcProcessed (v? IN ) Procesado ("P0"=Not Processed, "P1"=Processed) +* tcHasErrors (v? IN ) Tuvo Errores ("E0"=No Errors, "E1"=Has Errors) +* tcSupported (v? IN ) Archivo soportado ("S0"=Unsupported, "S1"=Supported) +* tcExpanded (v? IN ) Tipo de archivo ("X0"=Normal file, "X1"=Expanded multipart file) +*--------------------------------------------------------------------------------------------------- + Lparameters tnID, tcInOutType, tcProcessed, tcHasErrors, tcSupported, tcExpanded - TRY - LOCAL loEx as Exception + Try + Local loEx As Exception - WITH THIS AS c_foxbin2prg OF 'FOXBIN2PRG.PRG' - IF .n_ProcessedFiles = 0 THEN - EXIT - ENDIF - tnID = EVL(tnID, .n_ProcessedFiles) - IF NOT EMPTY(tcInOutType) - .a_ProcessedFiles(tnID, 2) = EVL(tcProcessed, '') - ENDIF - IF NOT EMPTY(tcProcessed) - .a_ProcessedFiles(tnID, 3) = EVL(tcProcessed, '') - ENDIF - IF NOT EMPTY(tcHasErrors) - .a_ProcessedFiles(tnID, 4) = EVL(tcHasErrors, '') - ENDIF - IF NOT EMPTY(tcSupported) - .a_ProcessedFiles(tnID, 5) = EVL(tcSupported, '') - ENDIF - .stdOut( .a_ProcessedFiles(tnID,2) ; - + ',' + .a_ProcessedFiles(tnID,3) ; - + ',' + .a_ProcessedFiles(tnID,4) ; - + ',' + .a_ProcessedFiles(tnID,5) ; - + ',' + .a_ProcessedFiles(tnID,6) ; - + ',' + LOWER(.a_ProcessedFiles(tnID,1)) ) - ENDWITH + With This As c_foxbin2prg Of 'FOXBIN2PRG.PRG' + If .n_ProcessedFiles = 0 Then + Exit + Endif + tnID = Evl(tnID, .n_ProcessedFiles) + If Not Empty(tcInOutType) + .a_ProcessedFiles(tnID, 2) = Evl(tcProcessed, '') + Endif + If Not Empty(tcProcessed) + .a_ProcessedFiles(tnID, 3) = Evl(tcProcessed, '') + Endif + If Not Empty(tcHasErrors) + .a_ProcessedFiles(tnID, 4) = Evl(tcHasErrors, '') + Endif + If Not Empty(tcSupported) + .a_ProcessedFiles(tnID, 5) = Evl(tcSupported, '') + Endif + .stdOut( .a_ProcessedFiles(tnID,2) ; + + ',' + .a_ProcessedFiles(tnID,3) ; + + ',' + .a_ProcessedFiles(tnID,4) ; + + ',' + .a_ProcessedFiles(tnID,5) ; + + ',' + .a_ProcessedFiles(tnID,6) ; + + ',' + Lower(.a_ProcessedFiles(tnID,1)) ) + Endwith - CATCH TO loEx - IF THIS.n_Debug > 0 THEN - IF _VFP.STARTMODE = 0 - SET STEP ON - ENDIF - ENDIF - THROW + Catch To loEx + If This.n_Debug > 0 Then + If _vfp.StartMode = 0 + Set Step On + Endif + Endif + Throw - ENDTRY - ENDPROC + Endtry + Endproc - PROCEDURE writeErrorLog - LPARAMETERS tcText, tnTimeStamp + Procedure writeErrorLog + Lparameters tcText, tnTimeStamp - TRY - WITH THIS AS c_foxbin2prg OF 'FOXBIN2PRG.PRG' - *-- Según el valor de nTimestamp: - *-- 0 = Sin timestamp - *-- 1 = Timestamp por delante - *-- 2 = Timestamp por detrás - .c_TextErr = .c_TextErr ; - + IIF( EVL(tnTimeStamp,0) = 1, TTOC(DATETIME(),3) + ' ', '' ) ; - + EVL(tcText,'') ; - + IIF( EVL(tnTimeStamp,0) = 2, ' ' + TTOC(DATETIME(),3), '' ) ; - + CR_LF + Try + With This As c_foxbin2prg Of 'FOXBIN2PRG.PRG' +*-- Según el valor de nTimestamp: +*-- 0 = Sin timestamp +*-- 1 = Timestamp por delante +*-- 2 = Timestamp por detrás + .c_TextErr = .c_TextErr ; + + Iif( Evl(tnTimeStamp,0) = 1, Ttoc(Datetime(),3) + ' ', '' ) ; + + Evl(tcText,'') ; + + Iif( Evl(tnTimeStamp,0) = 2, ' ' + Ttoc(Datetime(),3), '' ) ; + + CR_LF - .errOut(tcText) - .l_Error = .T. - .l_Errors = .T. - ENDWITH - CATCH - ENDTRY - ENDPROC + .errOut(tcText) + .l_Error = .T. + .l_Errors = .T. + Endwith + Catch + Endtry + Endproc - PROCEDURE writeErrorLog_Flush - WITH THIS AS c_foxbin2prg OF 'FOXBIN2PRG.PRG' - IF NOT EMPTY(.c_TextErr) - STRTOFILE( .c_TextErr + CR_LF, .c_ErrorLogFile, 1 ) - ENDIF + Procedure writeErrorLog_Flush + With This As c_foxbin2prg Of 'FOXBIN2PRG.PRG' + If Not Empty(.c_TextErr) + Strtofile( .c_TextErr + CR_LF, .c_ErrorLogFile, 1 ) + Endif .c_TextErr = '' - ENDWITH - ENDPROC + Endwith + Endproc - PROCEDURE writeLog - LPARAMETERS tcText, tnTimeStamp + Procedure writeLog + Lparameters tcText, tnTimeStamp - TRY - WITH THIS AS c_foxbin2prg OF 'FOXBIN2PRG.PRG' - *-- Según el valor de nTimestamp: - *-- 0 = Sin timestamp - *-- 1 = Timestamp por delante - *-- 2 = Timestamp por detrás - .c_TextLog = .c_TextLog ; - + IIF( EVL(tnTimeStamp,0) = 1, TTOC(DATETIME(),3) + ' ', '' ) ; - + EVL(tcText,'') ; - + IIF( EVL(tnTimeStamp,0) = 2, ' ' + TTOC(DATETIME(),3), '' ) ; - + CR_LF - ENDWITH - CATCH - ENDTRY - ENDPROC + Try + With This As c_foxbin2prg Of 'FOXBIN2PRG.PRG' +*-- Según el valor de nTimestamp: +*-- 0 = Sin timestamp +*-- 1 = Timestamp por delante +*-- 2 = Timestamp por detrás + .c_TextLog = .c_TextLog ; + + Iif( Evl(tnTimeStamp,0) = 1, Ttoc(Datetime(),3) + ' ', '' ) ; + + Evl(tcText,'') ; + + Iif( Evl(tnTimeStamp,0) = 2, ' ' + Ttoc(Datetime(),3), '' ) ; + + CR_LF + Endwith + Catch + Endtry + Endproc - PROCEDURE writeLog_Flush - WITH THIS AS c_foxbin2prg OF 'FOXBIN2PRG.PRG' - IF .n_Debug > 0 AND NOT EMPTY(.c_TextLog) - STRTOFILE( .c_TextLog + CR_LF, .c_LogFile, 1 ) - ENDIF + Procedure writeLog_Flush + With This As c_foxbin2prg Of 'FOXBIN2PRG.PRG' + If .n_Debug > 0 And Not Empty(.c_TextLog) + Strtofile( .c_TextLog + CR_LF, .c_LogFile, 1 ) + Endif .c_TextLog = '' - ENDWITH - ENDPROC + Endwith + Endproc - HIDDEN PROCEDURE exception2Str - LPARAMETERS toEx AS EXCEPTION - LOCAL lcError - lcError = 'Error ' + TRANSFORM(toEx.ERRORNO) + ', ' + toEx.MESSAGE + CR_LF ; - + toEx.PROCEDURE + ', ' + TRANSFORM(toEx.LINENO) + CR_LF + Hidden Procedure exception2Str + Lparameters toEx As Exception + Local lcError + lcError = 'Error ' + Transform(toEx.ErrorNo) + ', ' + toEx.Message + CR_LF ; + + toEx.Procedure + ', ' + Transform(toEx.Lineno) + CR_LF - IF NOT EMPTY(toEx.LINECONTENTS) AND toEx.ErrorNo <> 1098 - lcError = lcError + toEx.LINECONTENTS + CR_LF - ENDIF + If Not Empty(toEx.LineContents) And toEx.ErrorNo <> 1098 + lcError = lcError + toEx.LineContents + CR_LF + Endif - IF NOT EMPTY(toEx.USERVALUE) - lcError = lcError + EVL(toEx.USERVALUE,'') - ENDIF + If Not Empty(toEx.UserValue) + lcError = lcError + Evl(toEx.UserValue,'') + Endif - RETURN lcError - ENDPROC + Return lcError + Endproc - PROCEDURE unique_ID - LPARAMETERS tcValType + Procedure unique_ID + Lparameters tcValType - tcValType = EVL(tcValType,'C') - THIS.n_ID = INT( THIS.n_ID + 1 ) + tcValType = Evl(tcValType,'C') + This.n_ID = Int( This.n_ID + 1 ) - IF tcValType = 'N' - RETURN THIS.n_ID - ELSE - RETURN '_' + TRANSFORM( THIS.n_ID, '@L #########' ) - ENDIF - ENDPROC + If tcValType = 'N' + Return This.n_ID + Else + Return '_' + Transform( This.n_ID, '@L #########' ) + Endif + Endproc - FUNCTION wscriptshell_run - * Modificación basada en la rutina RunExitCode.prg de William GC Steinford (nov 2002) - * pero compatible con el método Run de WScript.Shell para su reemplazo cuando no es posible usarlo. - * http://fox.wikis.com/wc.dll?Wiki~ProcessExitCode - *----------------------------------------------------------------------------------------------- - * 'Run' Parameter Documentation at: https://msdn.microsoft.com/en-us/library/d5fk67ky%28v=vs.84%29.aspx - *----------------------------------------------------------------------------------------------- - LPARAMETERS tcCmdLine, tnWindowStyle, tbWaitOnReturn, tlDebug - * ? WScriptShell_Run("c:\windows\system32\cmd.exe /c dir c:\*.* > \temp\dir.txt") + Function wscriptshell_run +* Modificación basada en la rutina RunExitCode.prg de William GC Steinford (nov 2002) +* pero compatible con el método Run de WScript.Shell para su reemplazo cuando no es posible usarlo. +* http://fox.wikis.com/wc.dll?Wiki~ProcessExitCode +*----------------------------------------------------------------------------------------------- +* 'Run' Parameter Documentation at: https://msdn.microsoft.com/en-us/library/d5fk67ky%28v=vs.84%29.aspx +*----------------------------------------------------------------------------------------------- + Lparameters tcCmdLine, tnWindowStyle, tbWaitOnReturn, tlDebug +* ? WScriptShell_Run("c:\windows\system32\cmd.exe /c dir c:\*.* > \temp\dir.txt") - LOCAL lnWfSO, ln_dwFlags, ln_wShowWindow, lcStartInfo, lcProcessInfo, ln_hProcess, ln_hThread ; + Local lnWfSO, ln_dwFlags, ln_wShowWindow, lcStartInfo, lcProcessInfo, ln_hProcess, ln_hThread ; , lnExitCode, ln_dwProcessId, ln_dwThreadId, tcProgFile, laDirFile(1,5) - TRY - DECLARE SHORT CreateProcess IN WIN32API ; - STRING lpszModuleName, ; - STRING @lpszCommandLine, ; - STRING lpSecurityAttributesProcess, ; - STRING lpSecurityAttributesThread, ; - SHORT bInheritHandles, ; - INTEGER dwCreateFlags, ; - STRING lpvEnvironment, ; - STRING lpszStartupDir, ; - STRING @lpStartInfo, ; - STRING @lpProcessInfo + Try + Declare SHORT CreateProcess In WIN32API ; + STRING lpszModuleName, ; + STRING @lpszCommandLine, ; + STRING lpSecurityAttributesProcess, ; + STRING lpSecurityAttributesThread, ; + SHORT bInheritHandles, ; + INTEGER dwCreateFlags, ; + STRING lpvEnvironment, ; + STRING lpszStartupDir, ; + STRING @lpStartInfo, ; + STRING @lpProcessInfo - DECLARE LONG WaitForSingleObject IN WIN32API INTEGER hHandle, LONG dwMilliseconds - DECLARE INTEGER GetExitCodeProcess IN WIN32API INTEGER ln_hProcess, INTEGER @ lnExitCode - DECLARE INTEGER CloseHandle IN kernel32.DLL INTEGER hObject - *DECLARE INTEGER ShellExecuteEx IN Shell32 STRING @lpExecInfo - DECLARE LONG ShellExecuteEx IN shell32.DLL STRING @ - DECLARE LONG HeapAlloc IN WIN32API LONG, LONG, LONG - DECLARE LONG HeapFree IN WIN32API LONG, LONG, LONG - DECLARE LONG GetProcessHeap IN WIN32API - *DECLARE LONG WaitForSingleObject IN WIN32API LONG, LONG - DECLARE LONG TerminateProcess IN WIN32API LONG, LONG + Declare Long WaitForSingleObject In WIN32API Integer hHandle, Long dwMilliseconds + Declare Integer GetExitCodeProcess In WIN32API Integer ln_hProcess, Integer @ lnExitCode + Declare Integer CloseHandle In kernel32.Dll Integer hObject +*DECLARE INTEGER ShellExecuteEx IN Shell32 STRING @lpExecInfo + Declare Long ShellExecuteEx In shell32.Dll String @ + Declare Long HeapAlloc In WIN32API Long, Long, Long + Declare Long HeapFree In WIN32API Long, Long, Long + Declare Long GetProcessHeap In WIN32API +*DECLARE LONG WaitForSingleObject IN WIN32API LONG, LONG + Declare Long TerminateProcess In WIN32API Long, Long - * NOTA: Las constantes para VFP se pueden consultar en http://www.news2news.com/vfp/w32constants.php +* NOTA: Las constantes para VFP se pueden consultar en http://www.news2news.com/vfp/w32constants.php - #DEFINE SEE_MASK_NOCLOSEPROCESS 0x00000040 - #DEFINE WAIT_MILLISECOND 3000 + #Define SEE_MASK_NOCLOSEPROCESS 0x00000040 + #Define WAIT_MILLISECOND 3000 - #DEFINE SW_SHOW 5 - #DEFINE STILL_ACTIVE 0x103 - #DEFINE cnINFINITE 0xFFFFFFFF - #DEFINE cnHalfASecond 500 && milliseconds - #DEFINE cnTimedOut 0x0102 + #Define SW_SHOW 5 + #Define STILL_ACTIVE 0x103 + #Define cnINFINITE 0xFFFFFFFF + #Define cnHalfASecond 500 && milliseconds + #Define cnTimedOut 0x0102 - *-- Constantes para WaitForSingleObject - #DEFINE WAIT_ABANDONED 0x00000080 - #DEFINE WAIT_OBJECT_0 0x00000000 - #DEFINE WAIT_TIMEOUT 0x00000102 - #DEFINE WAIT_FAILED 0xFFFFFFFF +*-- Constantes para WaitForSingleObject + #Define WAIT_ABANDONED 0x00000080 + #Define WAIT_OBJECT_0 0x00000000 + #Define WAIT_TIMEOUT 0x00000102 + #Define WAIT_FAILED 0xFFFFFFFF - tcProgFile = EVL(tcProgFile, NULL) - tcCmdLine = EVL(tcCmdLine, NULL) + tcProgFile = Evl(tcProgFile, Null) + tcCmdLine = Evl(tcCmdLine, Null) - DO CASE - CASE VARTYPE(tbWaitOnReturn) = "L" - CASE VARTYPE(tbWaitOnReturn) = "N" - tbWaitOnReturn = (tbWaitOnReturn=1) - OTHERWISE - ERROR 'Invalid value for tbWaitOnReturn parameter' - ENDCASE + Do Case + Case Vartype(tbWaitOnReturn) = "L" + Case Vartype(tbWaitOnReturn) = "N" + tbWaitOnReturn = (tbWaitOnReturn=1) + Otherwise + Error 'Invalid value for tbWaitOnReturn parameter' + Endcase - IF VARTYPE(tnWindowStyle) # "N" OR NOT BETWEEN(tnWindowStyle, 0, 10) THEN - tnWindowStyle = 10 - ENDIF + If Vartype(tnWindowStyle) # "N" Or Not Between(tnWindowStyle, 0, 10) Then + tnWindowStyle = 10 + Endif - ln_dwFlags = 1 - ln_wShowWindow = tnWindowStyle + ln_dwFlags = 1 + ln_wShowWindow = tnWindowStyle - * DOCUMENTACIÓN estructura _STARTUPINFO: - * creates the STARTUP structure to specify main window - * properties if a new window is created for a new process +* DOCUMENTACIÓN estructura _STARTUPINFO: +* creates the STARTUP structure to specify main window +* properties if a new window is created for a new process - *| typedef struct _STARTUPINFO { - *| DWORD cb; 4 - *| LPTSTR lpReserved; 4 - *| LPTSTR lpDesktop; 4 - *| LPTSTR lpTitle; 4 - *| DWORD dwX; 4 - *| DWORD dwY; 4 - *| DWORD dwXSize; 4 - *| DWORD dwYSize; 4 - *| DWORD dwXCountChars; 4 - *| DWORD dwYCountChars; 4 - *| DWORD dwFillAttribute; 4 - *| DWORD dwFlags; 4 - *| WORD wShowWindow; 2 - *| WORD cbReserved2; 2 - *| LPBYTE lpReserved2; 4 - *| HANDLE hStdInput; 4 - *| HANDLE hStdOutput; 4 - *| HANDLE hStdError; 4 - *| } STARTUPINFO, *LPSTARTUPINFO; total: 68 bytes - lcStartInfo = BINTOC(68,'4RS') ; - + BINTOC(0,'4RS') + BINTOC(0,'4RS') + BINTOC(0,'4RS') ; - + BINTOC(0,'4RS') + BINTOC(0,'4RS') + BINTOC(0,'4RS') + BINTOC(0,'4RS') ; - + BINTOC(0,'4RS') + BINTOC(0,'4RS') + BINTOC(0,'4RS') ; - + BINTOC(ln_dwFlags,'4RS') ; - + BINTOC(ln_wShowWindow,'2RS') ; - + BINTOC(0,'2RS') + BINTOC(0,'4RS') ; - + BINTOC(0,'4RS') + BINTOC(0,'4RS') + BINTOC(0,'4RS') +*| typedef struct _STARTUPINFO { +*| DWORD cb; 4 +*| LPTSTR lpReserved; 4 +*| LPTSTR lpDesktop; 4 +*| LPTSTR lpTitle; 4 +*| DWORD dwX; 4 +*| DWORD dwY; 4 +*| DWORD dwXSize; 4 +*| DWORD dwYSize; 4 +*| DWORD dwXCountChars; 4 +*| DWORD dwYCountChars; 4 +*| DWORD dwFillAttribute; 4 +*| DWORD dwFlags; 4 +*| WORD wShowWindow; 2 +*| WORD cbReserved2; 2 +*| LPBYTE lpReserved2; 4 +*| HANDLE hStdInput; 4 +*| HANDLE hStdOutput; 4 +*| HANDLE hStdError; 4 +*| } STARTUPINFO, *LPSTARTUPINFO; total: 68 bytes + lcStartInfo = BinToC(68,'4RS') ; + + BinToC(0,'4RS') + BinToC(0,'4RS') + BinToC(0,'4RS') ; + + BinToC(0,'4RS') + BinToC(0,'4RS') + BinToC(0,'4RS') + BinToC(0,'4RS') ; + + BinToC(0,'4RS') + BinToC(0,'4RS') + BinToC(0,'4RS') ; + + BinToC(ln_dwFlags,'4RS') ; + + BinToC(ln_wShowWindow,'2RS') ; + + BinToC(0,'2RS') + BinToC(0,'4RS') ; + + BinToC(0,'4RS') + BinToC(0,'4RS') + BinToC(0,'4RS') - lcProcessInfo = REPLICATE( CHR(0), 16 ) + lcProcessInfo = Replicate( Chr(0), 16 ) - * DOCUMENTACIÓN estructura _PROCESS_INFORMATION: - * https://msdn.microsoft.com/en-us/library/windows/desktop/ms684873%28v=vs.85%29.aspx - * typedef struct _PROCESS_INFORMATION { - * HANDLE hProcess; - * HANDLE hThread; - * DWORD dwProcessId; - * DWORD dwThreadId; - * } PROCESS_INFORMATION; - * +* DOCUMENTACIÓN estructura _PROCESS_INFORMATION: +* https://msdn.microsoft.com/en-us/library/windows/desktop/ms684873%28v=vs.85%29.aspx +* typedef struct _PROCESS_INFORMATION { +* HANDLE hProcess; +* HANDLE hThread; +* DWORD dwProcessId; +* DWORD dwThreadId; +* } PROCESS_INFORMATION; +* - IF CreateProcess( tcProgFile, tcCmdLine,0,0,0,0,0,0, lcStartInfo, @lcProcessInfo ) = 0 + If CreateProcess( tcProgFile, tcCmdLine,0,0,0,0,0,0, lcStartInfo, @lcProcessInfo ) = 0 - *-- Segundo intento: Si se definió un archivo (ej: un TXT,LOG,etc) intento lanzarlo - *-- con la aplicación predeterminada - IF ADIR(laDirFile, tcCmdLine) = 1 THEN - LOCAL lcInfo, lnHeap, lnLen, lnPtr +*-- Segundo intento: Si se definió un archivo (ej: un TXT,LOG,etc) intento lanzarlo +*-- con la aplicación predeterminada + If Adir(laDirFile, tcCmdLine) = 1 Then + Local lcInfo, lnHeap, lnLen, lnPtr - *-- Ejemplo adaptado de: http://www.foxite.com/archives/0000316611.htm - lnLen = LEN(tcCmdLine) + 1 - lnHeap = GetProcessHeap() - lnPtr = HeapAlloc(lnHeap, 0x8, 5 + lnLen) - SYS(2600, lnPtr, 5, [open] + CHR(0)) - SYS(2600, lnPtr+5, lnLen, tcCmdLine + CHR(0)) +*-- Ejemplo adaptado de: http://www.foxite.com/archives/0000316611.htm + lnLen = Len(tcCmdLine) + 1 + lnHeap = GetProcessHeap() + lnPtr = HeapAlloc(lnHeap, 0x8, 5 + lnLen) + Sys(2600, lnPtr, 5, [open] + Chr(0)) + Sys(2600, lnPtr+5, lnLen, tcCmdLine + Chr(0)) - * DOCUMENTACIÓN estructura _SHELLEXECUTEINFO: - * https://msdn.microsoft.com/en-us/library/windows/desktop/bb759784%28v=vs.85%29.aspx - *typedef struct _SHELLEXECUTEINFO { - * DWORD cbSize; 4 - * ULONG fMask; 4 - * HWND hwnd; 4 - * LPCTSTR lpVerb; 4 - * LPCTSTR lpFile; 4 - * LPCTSTR lpParameters; 4 - * LPCTSTR lpDirectory; 4 - * int nShow; 4 - * HINSTANCE hInstApp; 4 - * LPVOID lpIDList; 4 - * LPCTSTR lpClass; 4 - * HKEY hkeyClass; 4 - * DWORD dwHotKey; 4 - * union { - * HANDLE hIcon; - * HANDLE hMonitor; - * } DUMMYUNIONNAME; 4 - * HANDLE hProcess; 4 - *} SHELLEXECUTEINFO, *LPSHELLEXECUTEINFO; - * +* DOCUMENTACIÓN estructura _SHELLEXECUTEINFO: +* https://msdn.microsoft.com/en-us/library/windows/desktop/bb759784%28v=vs.85%29.aspx +*typedef struct _SHELLEXECUTEINFO { +* DWORD cbSize; 4 +* ULONG fMask; 4 +* HWND hwnd; 4 +* LPCTSTR lpVerb; 4 +* LPCTSTR lpFile; 4 +* LPCTSTR lpParameters; 4 +* LPCTSTR lpDirectory; 4 +* int nShow; 4 +* HINSTANCE hInstApp; 4 +* LPVOID lpIDList; 4 +* LPCTSTR lpClass; 4 +* HKEY hkeyClass; 4 +* DWORD dwHotKey; 4 +* union { +* HANDLE hIcon; +* HANDLE hMonitor; +* } DUMMYUNIONNAME; 4 +* HANDLE hProcess; 4 +*} SHELLEXECUTEINFO, *LPSHELLEXECUTEINFO; +* - lcInfo = ; - BINTOC(60, [4RS]) + ; - BINTOC(SEE_MASK_NOCLOSEPROCESS, [4RS]) + ; - BINTOC(0, [4RS]) + ; - BINTOC(lnPtr, [4RS]) + ; - BINTOC(lnPtr+5, [4RS]) + ; - BINTOC(0, [4RS]) + ; - BINTOC(0, [4RS]) + ; - BINTOC(1, [4RS]) + ; - REPLICATE(CHR(0), 28) + lcInfo = ; + BINTOC(60, [4RS]) + ; + BINTOC(SEE_MASK_NOCLOSEPROCESS, [4RS]) + ; + BINTOC(0, [4RS]) + ; + BINTOC(lnPtr, [4RS]) + ; + BINTOC(lnPtr+5, [4RS]) + ; + BINTOC(0, [4RS]) + ; + BINTOC(0, [4RS]) + ; + BINTOC(1, [4RS]) + ; + REPLICATE(Chr(0), 28) - IF ShellExecuteEx(@lcInfo) = 0 - IF tlDebug - ? "Could not call process" - ENDIF + If ShellExecuteEx(@lcInfo) = 0 + If tlDebug + ? "Could not call process" + Endif + lnExitCode = -1 + Exit + Else + HeapFree(lnHeap, 0, lnPtr) + ln_hProcess = CToBin(Right(lcInfo, 4), [4RS]) + ln_hThread = 0 + + If tlDebug + ? "Process handle = "+Transform(ln_hProcess) + ? "Thread handle = "+Transform(ln_hThread) + Endif + +*IF lnProcess != 0 +* WaitForSingleObject(ln_hProcess, WAIT_MILLISECOND) +* IF tlDebug +* ? "Terminating process!" +* ENDIF +* TerminateProcess(ln_hProcess, 0) +*ENDIF + Endif + + Else + If tlDebug + ? "Could not create process" + Endif lnExitCode = -1 - EXIT - ELSE - HeapFree(lnHeap, 0, lnPtr) - ln_hProcess = CTOBIN(RIGHT(lcInfo, 4), [4RS]) - ln_hThread = 0 + Exit + Endif + Else - IF tlDebug - ? "Process handle = "+TRANSFORM(ln_hProcess) - ? "Thread handle = "+TRANSFORM(ln_hThread) - ENDIF +* Process and thread handles returned in ProcInfo structure + ln_hProcess = CToBin( Left( lcProcessInfo, 4 ), '4RS' ) + ln_hThread = CToBin( Substr( lcProcessInfo, 5, 4 ), '4RS' ) + ln_dwProcessId = CToBin( Substr( lcProcessInfo, 9, 4 ), '4RS' ) + ln_dwThreadId = CToBin( Substr( lcProcessInfo, 13, 4 ), '4RS' ) - *IF lnProcess != 0 - * WaitForSingleObject(ln_hProcess, WAIT_MILLISECOND) - * IF tlDebug - * ? "Terminating process!" - * ENDIF - * TerminateProcess(ln_hProcess, 0) - *ENDIF - ENDIF + If tlDebug + ? "Process handle = "+Transform(ln_hProcess) + ? "Thread handle = "+Transform(ln_hThread) + ? "Process handle id = "+Transform(ln_dwProcessId) + ? "Thread handle id = "+Transform(ln_dwThreadId) + Endif + Endif - ELSE - IF tlDebug - ? "Could not create process" - ENDIF - lnExitCode = -1 - EXIT - ENDIF - ELSE + If tbWaitOnReturn Then +* // Give the process time to execute and finish + lnExitCode = STILL_ACTIVE - * Process and thread handles returned in ProcInfo structure - ln_hProcess = CTOBIN( LEFT( lcProcessInfo, 4 ), '4RS' ) - ln_hThread = CTOBIN( SUBSTR( lcProcessInfo, 5, 4 ), '4RS' ) - ln_dwProcessId = CTOBIN( SUBSTR( lcProcessInfo, 9, 4 ), '4RS' ) - ln_dwThreadId = CTOBIN( SUBSTR( lcProcessInfo, 13, 4 ), '4RS' ) + Do While lnExitCode = STILL_ACTIVE +*lnWfSO = WaitForSingleObject(ln_hProcess, cnHalfASecond) + lnWfSO = WaitForSingleObject(ln_hProcess, cnINFINITE) - IF tlDebug - ? "Process handle = "+TRANSFORM(ln_hProcess) - ? "Thread handle = "+TRANSFORM(ln_hThread) - ? "Process handle id = "+TRANSFORM(ln_dwProcessId) - ? "Thread handle id = "+TRANSFORM(ln_dwThreadId) - ENDIF - ENDIF + If tlDebug + ? 'lnWfSO = ' + Transform(lnWfSO) + Endif - IF tbWaitOnReturn THEN - * // Give the process time to execute and finish - lnExitCode = STILL_ACTIVE + If GetExitCodeProcess(ln_hProcess, @lnExitCode) <> 0 + Do Case + Case lnExitCode = STILL_ACTIVE + If tlDebug + ? "Process is still active" + Endif + Otherwise + If tlDebug + ? "Exit code = "+ Transform( lnExitCode ) + Endif + Endcase + Else + If tlDebug + ? "GetExitCodeProcess() failed" + Endif + lnExitCode = -2 + Endif - DO WHILE lnExitCode = STILL_ACTIVE - *lnWfSO = WaitForSingleObject(ln_hProcess, cnHalfASecond) - lnWfSO = WaitForSingleObject(ln_hProcess, cnINFINITE) + DoEvents + Enddo + Else + lnExitCode = 0 + Endif - IF tlDebug - ? 'lnWfSO = ' + TRANSFORM(lnWfSO) - ENDIF +*-- DOCUMENTACIÓN sobre cierre procesos/threads: +*-- https://msdn.microsoft.com/en-us/library/windows/desktop/ms682512%28v=vs.85%29.aspx + =CloseHandle(ln_hProcess) + =CloseHandle(ln_hThread) - IF GetExitCodeProcess(ln_hProcess, @lnExitCode) <> 0 - DO CASE - CASE lnExitCode = STILL_ACTIVE - IF tlDebug - ? "Process is still active" - ENDIF - OTHERWISE - IF tlDebug - ? "Exit code = "+ TRANSFORM( lnExitCode ) - ENDIF - ENDCASE - ELSE - IF tlDebug - ? "GetExitCodeProcess() failed" - ENDIF - lnExitCode = -2 - ENDIF + If tlDebug + ? '> FUNCTION RETURN VALUE = ' + Endif + Endtry - DOEVENTS - ENDDO - ELSE - lnExitCode = 0 - ENDIF - - *-- DOCUMENTACIÓN sobre cierre procesos/threads: - *-- https://msdn.microsoft.com/en-us/library/windows/desktop/ms682512%28v=vs.85%29.aspx - =CloseHandle(ln_hProcess) - =CloseHandle(ln_hThread) - - IF tlDebug - ? '> FUNCTION RETURN VALUE = ' - ENDIF - ENDTRY - - RETURN lnExitCode - ENDFUNC + Return lnExitCode + Endfunc - FUNCTION FERROR_Message(tcFileName as String) - LOCAL lcMsg, lnError - tcFileName = EVL(tcFileName,'') - lnError = FERROR() + Function FERROR_Message(tcFileName As String) + Local lcMsg, lnError + tcFileName = Evl(tcFileName,'') + lnError = Ferror() - DO CASE - CASE lnError = 2 - lcMsg = 'File not found' - CASE lnError = 4 - lcMsg = 'Too many files open (out of file handles)' - CASE lnError = 5 - lcMsg = 'Access denied' - CASE lnError = 6 - lcMsg = 'Invalid file handle given' - CASE lnError = 8 - lcMsg = 'Out of memory' - CASE lnError = 25 - lcMsg = [Seek error (can't seek before the start of a file)] - CASE lnError = 29 - lcMsg = 'Disk full' - CASE lnError = 31 - lcMsg = 'Error opening file' - OTHERWISE - lcMsg = 'Unrecognized error trying to open the file ' + tcFileName - ENDCASE + Do Case + Case lnError = 2 + lcMsg = 'File not found' + Case lnError = 4 + lcMsg = 'Too many files open (out of file handles)' + Case lnError = 5 + lcMsg = 'Access denied' + Case lnError = 6 + lcMsg = 'Invalid file handle given' + Case lnError = 8 + lcMsg = 'Out of memory' + Case lnError = 25 + lcMsg = [Seek error (can't seek before the start of a file)] + Case lnError = 29 + lcMsg = 'Disk full' + Case lnError = 31 + lcMsg = 'Error opening file' + Otherwise + lcMsg = 'Unrecognized error trying to open the file ' + tcFileName + Endcase - RETURN lcMsg - ENDFUNC + Return lcMsg + Endfunc - FUNCTION getLocaleInfo - LPARAMETERS tnSetting, tcLocale - #DEFINE C_NULL CHR(0) - LOCAL lcLocale, lnLen, lcBuffer, lnReturn, lcReturn + Function getLocaleInfo + Lparameters tnSetting, tcLocale + #Define C_NULL Chr(0) + Local lcLocale, lnLen, lcBuffer, lnReturn, lcReturn - IF VARTYPE(tcLocale) = 'C' AND NOT EMPTY(tcLocale) - lcLocale = STRCONV(tcLocale, 5) + C_NULL - ELSE - lcLocale = .NULL. - ENDIF + If Vartype(tcLocale) = 'C' And Not Empty(tcLocale) + lcLocale = Strconv(tcLocale, 5) + C_NULL + Else + lcLocale = .Null. + Endif - DECLARE INTEGER GetLocaleInfoEx in Win32API ; - string locale, long type, string @buffer, integer len + Declare Integer GetLocaleInfoEx In Win32API ; + string locale, Long Type, String @Buffer, Integer Len lnLen = 255 - lcBuffer = SPACE(lnLen) + lcBuffer = Space(lnLen) lnReturn = GetLocaleInfoEx(lcLocale, tnSetting, @lcBuffer, lnLen) - lcReturn = STRCONV(LEFT(lcBuffer, 2 * (lnReturn - 1)), 6) - RETURN lcReturn - ENDFUNC + lcReturn = Strconv(Left(lcBuffer, 2 * (lnReturn - 1)), 6) + Return lcReturn + Endfunc -ENDDEFINE +Enddefine -DEFINE CLASS frm_avance AS Form +Define Class frm_avance As Form Height = 110 Width = 628 ShowWindow = 2 @@ -5438,16 +5438,16 @@ DEFINE CLASS frm_avance AS Form AutoCenter = .T. BorderStyle = 2 ControlBox = .F. - BackColor = RGB(255,255,255) + BackColor = Rgb(255,255,255) nMax_value = 100 nMax_value2 = 100 - nSecsAtStart = (SECONDS()) + nSecsAtStart = (Seconds()) nLastSecCount = 0 nValue = 0 nValue2 = 0 l_Cancelled = .F. Name = "frm_avance" - _memberdata = [] ; + _MemberData = [] ; + [] ; + [] ; + [] ; @@ -5462,7 +5462,7 @@ DEFINE CLASS frm_avance AS Form + [] ; + [] - ADD OBJECT shp_base AS shape WITH ; + Add Object shp_base As Shape With ; Top = 28, ; Left = 12, ; Height = 13, ; @@ -5473,7 +5473,7 @@ DEFINE CLASS frm_avance AS Form BorderColor = 14215910, ; Name = "shp_base" - ADD OBJECT shp_avance AS shape WITH ; + Add Object shp_avance As Shape With ; Top = 28, ; Left = 12, ; Height = 13, ; @@ -5484,7 +5484,7 @@ DEFINE CLASS frm_avance AS Form BorderWidth = 1, ; Name = "shp_Avance" - ADD OBJECT shp_base2 AS shape WITH ; + Add Object shp_base2 As Shape With ; Top = 64, ; Left = 12, ; Height = 13, ; @@ -5495,7 +5495,7 @@ DEFINE CLASS frm_avance AS Form BorderColor = 14215910, ; Name = "shp_base2" - ADD OBJECT shp_avance2 AS shape WITH ; + Add Object shp_avance2 As Shape With ; Top = 64, ; Left = 12, ; Height = 13, ; @@ -5506,7 +5506,7 @@ DEFINE CLASS frm_avance AS Form BorderWidth = 1, ; Name = "shp_Avance2" - ADD OBJECT cmdCancel AS commandbutton WITH ; + Add Object cmdCancel As CommandButton With ; Top = 84, ; Left = 252, ; Height = 21, ; @@ -5515,7 +5515,7 @@ DEFINE CLASS frm_avance AS Form Enabled = .F., ; Name = "cmdCancel" - ADD OBJECT lin_1 AS shape WITH ; + Add Object lin_1 As Shape With ; Top = 28, ; Left = 32, ; Height = 53, ; @@ -5523,7 +5523,7 @@ DEFINE CLASS frm_avance AS Form BorderColor = 16777215, ; Name = "lin_1" - ADD OBJECT lin_2 AS shape WITH ; + Add Object lin_2 As Shape With ; Top = 28, ; Left = 52, ; Height = 53, ; @@ -5531,7 +5531,7 @@ DEFINE CLASS frm_avance AS Form BorderColor = 16777215, ; Name = "lin_2" - ADD OBJECT lin_3 AS shape WITH ; + Add Object lin_3 As Shape With ; Top = 28, ; Left = 72, ; Height = 53, ; @@ -5539,7 +5539,7 @@ DEFINE CLASS frm_avance AS Form BorderColor = 16777215, ; Name = "lin_3" - ADD OBJECT lin_4 AS shape WITH ; + Add Object lin_4 As Shape With ; Top = 28, ; Left = 92, ; Height = 53, ; @@ -5547,7 +5547,7 @@ DEFINE CLASS frm_avance AS Form BorderColor = 16777215, ; Name = "lin_4" - ADD OBJECT lin_5 AS shape WITH ; + Add Object lin_5 As Shape With ; Top = 28, ; Left = 112, ; Height = 53, ; @@ -5555,7 +5555,7 @@ DEFINE CLASS frm_avance AS Form BorderColor = 16777215, ; Name = "lin_5" - ADD OBJECT lin_6 AS shape WITH ; + Add Object lin_6 As Shape With ; Top = 28, ; Left = 132, ; Height = 53, ; @@ -5563,7 +5563,7 @@ DEFINE CLASS frm_avance AS Form BorderColor = 16777215, ; Name = "lin_6" - ADD OBJECT lin_7 AS shape WITH ; + Add Object lin_7 As Shape With ; Top = 28, ; Left = 152, ; Height = 53, ; @@ -5571,7 +5571,7 @@ DEFINE CLASS frm_avance AS Form BorderColor = 16777215, ; Name = "lin_7" - ADD OBJECT lin_8 AS shape WITH ; + Add Object lin_8 As Shape With ; Top = 28, ; Left = 172, ; Height = 53, ; @@ -5579,7 +5579,7 @@ DEFINE CLASS frm_avance AS Form BorderColor = 16777215, ; Name = "lin_8" - ADD OBJECT lin_9 AS shape WITH ; + Add Object lin_9 As Shape With ; Top = 28, ; Left = 192, ; Height = 53, ; @@ -5587,7 +5587,7 @@ DEFINE CLASS frm_avance AS Form BorderColor = 16777215, ; Name = "lin_9" - ADD OBJECT lin_10 AS shape WITH ; + Add Object lin_10 As Shape With ; Top = 28, ; Left = 212, ; Height = 53, ; @@ -5595,7 +5595,7 @@ DEFINE CLASS frm_avance AS Form BorderColor = 16777215, ; Name = "lin_10" - ADD OBJECT lin_11 AS shape WITH ; + Add Object lin_11 As Shape With ; Top = 28, ; Left = 232, ; Height = 53, ; @@ -5603,7 +5603,7 @@ DEFINE CLASS frm_avance AS Form BorderColor = 16777215, ; Name = "lin_11" - ADD OBJECT lin_12 AS shape WITH ; + Add Object lin_12 As Shape With ; Top = 28, ; Left = 252, ; Height = 53, ; @@ -5611,7 +5611,7 @@ DEFINE CLASS frm_avance AS Form BorderColor = 16777215, ; Name = "lin_12" - ADD OBJECT lin_13 AS shape WITH ; + Add Object lin_13 As Shape With ; Top = 28, ; Left = 272, ; Height = 53, ; @@ -5619,7 +5619,7 @@ DEFINE CLASS frm_avance AS Form BorderColor = 16777215, ; Name = "lin_13" - ADD OBJECT lin_14 AS shape WITH ; + Add Object lin_14 As Shape With ; Top = 28, ; Left = 292, ; Height = 53, ; @@ -5627,7 +5627,7 @@ DEFINE CLASS frm_avance AS Form BorderColor = 16777215, ; Name = "lin_14" - ADD OBJECT lin_15 AS shape WITH ; + Add Object lin_15 As Shape With ; Top = 28, ; Left = 312, ; Height = 53, ; @@ -5635,7 +5635,7 @@ DEFINE CLASS frm_avance AS Form BorderColor = 16777215, ; Name = "lin_15" - ADD OBJECT lin_16 AS shape WITH ; + Add Object lin_16 As Shape With ; Top = 28, ; Left = 332, ; Height = 53, ; @@ -5643,7 +5643,7 @@ DEFINE CLASS frm_avance AS Form BorderColor = 16777215, ; Name = "lin_16" - ADD OBJECT lin_17 AS shape WITH ; + Add Object lin_17 As Shape With ; Top = 28, ; Left = 352, ; Height = 53, ; @@ -5651,7 +5651,7 @@ DEFINE CLASS frm_avance AS Form BorderColor = 16777215, ; Name = "lin_17" - ADD OBJECT lin_18 AS shape WITH ; + Add Object lin_18 As Shape With ; Top = 28, ; Left = 372, ; Height = 53, ; @@ -5659,7 +5659,7 @@ DEFINE CLASS frm_avance AS Form BorderColor = 16777215, ; Name = "lin_18" - ADD OBJECT lin_19 AS shape WITH ; + Add Object lin_19 As Shape With ; Top = 28, ; Left = 392, ; Height = 53, ; @@ -5667,7 +5667,7 @@ DEFINE CLASS frm_avance AS Form BorderColor = 16777215, ; Name = "lin_19" - ADD OBJECT lin_20 AS shape WITH ; + Add Object lin_20 As Shape With ; Top = 28, ; Left = 412, ; Height = 53, ; @@ -5675,7 +5675,7 @@ DEFINE CLASS frm_avance AS Form BorderColor = 16777215, ; Name = "lin_20" - ADD OBJECT lin_21 AS shape WITH ; + Add Object lin_21 As Shape With ; Top = 28, ; Left = 432, ; Height = 53, ; @@ -5683,7 +5683,7 @@ DEFINE CLASS frm_avance AS Form BorderColor = 16777215, ; Name = "lin_21" - ADD OBJECT lin_22 AS shape WITH ; + Add Object lin_22 As Shape With ; Top = 28, ; Left = 452, ; Height = 53, ; @@ -5691,7 +5691,7 @@ DEFINE CLASS frm_avance AS Form BorderColor = 16777215, ; Name = "lin_22" - ADD OBJECT lin_23 AS shape WITH ; + Add Object lin_23 As Shape With ; Top = 28, ; Left = 472, ; Height = 53, ; @@ -5699,7 +5699,7 @@ DEFINE CLASS frm_avance AS Form BorderColor = 16777215, ; Name = "lin_23" - ADD OBJECT lin_24 AS shape WITH ; + Add Object lin_24 As Shape With ; Top = 28, ; Left = 492, ; Height = 53, ; @@ -5707,7 +5707,7 @@ DEFINE CLASS frm_avance AS Form BorderColor = 16777215, ; Name = "lin_24" - ADD OBJECT lin_25 AS shape WITH ; + Add Object lin_25 As Shape With ; Top = 28, ; Left = 512, ; Height = 53, ; @@ -5715,7 +5715,7 @@ DEFINE CLASS frm_avance AS Form BorderColor = 16777215, ; Name = "lin_25" - ADD OBJECT lin_26 AS shape WITH ; + Add Object lin_26 As Shape With ; Top = 28, ; Left = 532, ; Height = 53, ; @@ -5723,7 +5723,7 @@ DEFINE CLASS frm_avance AS Form BorderColor = 16777215, ; Name = "lin_26" - ADD OBJECT lin_27 AS shape WITH ; + Add Object lin_27 As Shape With ; Top = 28, ; Left = 552, ; Height = 53, ; @@ -5731,7 +5731,7 @@ DEFINE CLASS frm_avance AS Form BorderColor = 16777215, ; Name = "lin_27" - ADD OBJECT lin_28 AS shape WITH ; + Add Object lin_28 As Shape With ; Top = 28, ; Left = 572, ; Height = 53, ; @@ -5739,7 +5739,7 @@ DEFINE CLASS frm_avance AS Form BorderColor = 16777215, ; Name = "lin_28" - ADD OBJECT lin_29 AS shape WITH ; + Add Object lin_29 As Shape With ; Top = 28, ; Left = 592, ; Height = 53, ; @@ -5747,7 +5747,7 @@ DEFINE CLASS frm_avance AS Form BorderColor = 16777215, ; Name = "lin_29" - ADD OBJECT lbl_tarea AS label WITH ; + Add Object lbl_tarea As Label With ; BackStyle = 0, ; Caption = ".", ; Height = 17, ; @@ -5756,7 +5756,7 @@ DEFINE CLASS frm_avance AS Form Width = 604, ; Name = "lbl_Tarea" - ADD OBJECT lbl_tarea2 AS label WITH ; + Add Object lbl_tarea2 As Label With ; BackStyle = 0, ; Caption = ".", ; Height = 17, ; @@ -5765,7 +5765,7 @@ DEFINE CLASS frm_avance AS Form Width = 604, ; Name = "lbl_Tarea2" - ADD OBJECT 'lblStartTime' AS label WITH ; + Add Object 'lblStartTime' As Label With ; BackStyle = 0, ; Caption = "Start time: __/__/____ __:__:__", ; Height = 17, ; @@ -5774,7 +5774,7 @@ DEFINE CLASS frm_avance AS Form Top = 88, ; Width = 176 - ADD OBJECT 'lblElapsedTime' AS label WITH ; + Add Object 'lblElapsedTime' As Label With ; BackStyle = 0, ; Caption = "Elapsed Time: __:__:__", ; Height = 17, ; @@ -5783,135 +5783,135 @@ DEFINE CLASS frm_avance AS Form Top = 88, ; Width = 136 - PROCEDURE updateProgressbar - LPARAMETERS tcTexto, tnValor, tnTotal, tnTipo + Procedure updateProgressbar + Lparameters tcTexto, tnValor, tnTotal, tnTipo - WITH THISFORM AS frm_avance OF foxbin2prg.prg - LOCAL lnSecs + With Thisform As frm_avance Of foxbin2prg.prg + Local lnSecs - lnSecs = SECONDS() + lnSecs = Seconds() - IF lnSecs - .nLastSecCount > 0 THEN - .lblElapsedTime.Caption = 'Elapsed Time: ' + TTOC( {^2000-1-1,00:00:00} + lnSecs - .nSecsAtStart, 2 ) + If lnSecs - .nLastSecCount > 0 Then + .lblElapsedTime.Caption = 'Elapsed Time: ' + Ttoc( {^2000-1-1,00:00:00} + lnSecs - .nSecsAtStart, 2 ) .nLastSecCount = lnSecs - ENDIF + Endif - *-- Habilita el botón de cancelar una vez que se comienzan a pasar valores - IF NOT EMPTY(tnValor) THEN - IF NOT .cmdCancel.Enabled THEN +*-- Habilita el botón de cancelar una vez que se comienzan a pasar valores + If Not Empty(tnValor) Then + If Not .cmdCancel.Enabled Then .cmdCancel.Enabled = .T. - ENDIF - DOEVENTS - ENDIF + Endif + DoEvents + Endif - DO CASE - CASE tnTipo = 0 - IF NOT EMPTY(tcTexto) THEN - .lbl_tarea.Caption = tcTexto - ENDIF + Do Case + Case tnTipo = 0 + If Not Empty(tcTexto) Then + .lbl_tarea.Caption = tcTexto + Endif - .nValue2 = 0 + .nValue2 = 0 - IF tnTotal > 0 THEN - .nMax_value = tnTotal - .nValue = tnValor - ENDIF + If tnTotal > 0 Then + .nMax_value = tnTotal + .nValue = tnValor + Endif - CASE tnTipo = 1 - IF NOT EMPTY(tcTexto) THEN - .lbl_tarea2.Caption = tcTexto - ENDIF + Case tnTipo = 1 + If Not Empty(tcTexto) Then + .lbl_tarea2.Caption = tcTexto + Endif - IF tnTotal > 0 THEN - .nMax_value2 = tnTotal - .nValue2 = tnValor - ENDIF + If tnTotal > 0 Then + .nMax_value2 = tnTotal + .nValue2 = tnValor + Endif - CASE tnTipo = 2 - IF NOT EMPTY(tcTexto) THEN - .lbl_tarea2.Caption = tcTexto - ENDIF + Case tnTipo = 2 + If Not Empty(tcTexto) Then + .lbl_tarea2.Caption = tcTexto + Endif - IF tnTotal > 0 THEN - .nMax_value2 = tnTotal - .nValue2 = tnValor - ENDIF + If tnTotal > 0 Then + .nMax_value2 = tnTotal + .nValue2 = tnValor + Endif - ENDCASE - ENDWITH && THIS + Endcase + Endwith && THIS - RETURN - ENDPROC + Return + Endproc - PROCEDURE nValue_assign - LPARAMETERS vNewVal + Procedure nValue_assign + Lparameters vNewVal - WITH THIS + With This .nValue = m.vNewVal - .shp_avance.WIDTH = m.vNewVal * .shp_base.WIDTH / .nMax_value - ENDWITH - ENDPROC + .shp_avance.Width = m.vNewVal * .shp_base.Width / .nMax_value + Endwith + Endproc - PROCEDURE INIT - LPARAMETERS toFoxBin2Prg + Procedure Init + Lparameters toFoxBin2Prg - #IF .F. - LOCAL toFoxBin2Prg AS c_foxbin2prg OF 'FOXBIN2PRG.PRG' - LOCAL THISFORM AS frm_avance OF foxbin2prg.prg - #ENDIF + #If .F. + Local toFoxBin2Prg As c_foxbin2prg Of 'FOXBIN2PRG.PRG' + Local Thisform As frm_avance Of foxbin2prg.prg + #Endif - LOCAL laDirInfo(1,5), loLang as CL_LANG OF 'FOXBIN2PRG.PRG' + Local laDirInfo(1,5), loLang As CL_LANG Of 'FOXBIN2PRG.PRG' - IF VARTYPE(toFoxBin2Prg) = "O" THEN - IF TYPE("_SCREEN.o_FoxBin2Prg_Lang") = "O" THEN - loLang = _SCREEN.o_FoxBin2Prg_Lang - THISFORM.CAPTION = 'FoxBin2Prg ' + _SCREEN.c_FB2PRG_EXE_Version + ' > - ' + loLang.C_PROCESS_PROGRESS_LOC + ' (' + loLang.C_PRESS_ESC_TO_CANCEL + ')' - ENDIF + If Vartype(toFoxBin2Prg) = "O" Then + If Type("_SCREEN.o_FoxBin2Prg_Lang") = "O" Then + loLang = _Screen.o_FoxBin2Prg_Lang + Thisform.Caption = 'FoxBin2Prg ' + _Screen.c_FB2PRG_EXE_Version + ' > - ' + loLang.C_PROCESS_PROGRESS_LOC + ' (' + loLang.C_PRESS_ESC_TO_CANCEL + ')' + Endif - *IF ADIR( laDirInfo, FORCEEXT( toFoxBin2Prg.c_Foxbin2prg_FullPath, 'ICO' ) ) > 0 THEN - IF FILE( FORCEEXT( toFoxBin2Prg.c_Foxbin2prg_FullPath, 'ICO' ) ) THEN - THISFORM.Icon = FORCEEXT( toFoxBin2Prg.c_Foxbin2prg_FullPath, 'ICO' ) - ENDIF +*IF ADIR( laDirInfo, FORCEEXT( toFoxBin2Prg.c_Foxbin2prg_FullPath, 'ICO' ) ) > 0 THEN + If File( Forceext( toFoxBin2Prg.c_Foxbin2prg_FullPath, 'ICO' ) ) Then + Thisform.Icon = Forceext( toFoxBin2Prg.c_Foxbin2prg_FullPath, 'ICO' ) + Endif - *IF ADIR( laDirInfo, toFoxBin2Prg.c_BackgroundImage ) > 0 THEN - IF FILE( toFoxBin2Prg.c_BackgroundImage ) THEN - CLEAR RESOURCES - THISFORM.Picture = toFoxBin2Prg.c_BackgroundImage - ENDIF - ENDIF +*IF ADIR( laDirInfo, toFoxBin2Prg.c_BackgroundImage ) > 0 THEN + If File( toFoxBin2Prg.c_BackgroundImage ) Then + Clear Resources + Thisform.Picture = toFoxBin2Prg.c_BackgroundImage + Endif + Endif - THISFORM.nValue = 0 - THISFORM.nValue2 = 0 - THISFORM.nLastSecCount = SECONDS() - ENDPROC + Thisform.nValue = 0 + Thisform.nValue2 = 0 + Thisform.nLastSecCount = Seconds() + Endproc - PROCEDURE nValue2_assign - LPARAMETERS vNewVal + Procedure nValue2_assign + Lparameters vNewVal - WITH THIS + With This .nValue2 = m.vNewVal - .shp_avance2.WIDTH = m.vNewVal * .shp_base2.WIDTH / .nMax_value2 - ENDWITH - ENDPROC + .shp_avance2.Width = m.vNewVal * .shp_base2.Width / .nMax_value2 + Endwith + Endproc - PROCEDURE cmdCancel.Click - THISFORM.l_Cancelled = .T. - ENDPROC + Procedure cmdCancel.Click + Thisform.l_Cancelled = .T. + Endproc - PROCEDURE lblStartTime.Init - THIS.Caption = "Start Time: " + TTOC(DATETIME()) - ENDPROC + Procedure lblStartTime.Init + This.Caption = "Start Time: " + Ttoc(Datetime()) + Endproc -ENDDEFINE +Enddefine -DEFINE CLASS frm_interactive AS Form +Define Class frm_interactive As Form Height = 114 Width = 380 ShowWindow = 2 @@ -5925,17 +5925,17 @@ DEFINE CLASS frm_interactive AS Form AlwaysOnTop = .T. MaxButton = .F. MinButton = .F. - BackColor = RGB(255,255,255) + BackColor = Rgb(255,255,255) n_ConversionType = 3 l_FileTimeStampOptimization = .F. Name = "frm_interactive" - _memberdata = [] ; + _MemberData = [] ; + [] ; + [] ; + [] - ADD OBJECT chk_FileTimeStampOptimization AS checkbox WITH ; + Add Object chk_FileTimeStampOptimization As Checkbox With ; Alignment = 0, ; BackStyle = 0, ; Caption = "chk_FileTimeStampOptimization", ; @@ -5949,7 +5949,7 @@ DEFINE CLASS frm_interactive AS Form Visible = .F. - ADD OBJECT lbl_title AS label WITH ; + Add Object lbl_title As Label With ; WordWrap = .T., ; Alignment = 2, ; BackStyle = 0, ; @@ -5962,7 +5962,7 @@ DEFINE CLASS frm_interactive AS Form Name = "lbl_Title" - ADD OBJECT cmd_Bin2Prg AS commandbutton WITH ; + Add Object cmd_Bin2Prg As CommandButton With ; Top = 58, ; Left = 40, ; Height = 27, ; @@ -5971,7 +5971,7 @@ DEFINE CLASS frm_interactive AS Form Name = "cmd_Bin2Prg" - ADD OBJECT cmd_Prg2Bin AS commandbutton WITH ; + Add Object cmd_Prg2Bin As CommandButton With ; Top = 58, ; Left = 144, ; Height = 27, ; @@ -5980,7 +5980,7 @@ DEFINE CLASS frm_interactive AS Form Name = "cmd_Prg2Bin" - ADD OBJECT cmd_None AS commandbutton WITH ; + Add Object cmd_None As CommandButton With ; Top = 58, ; Left = 248, ; Height = 27, ; @@ -5990,82 +5990,82 @@ DEFINE CLASS frm_interactive AS Form Name = "cmd_None" - PROCEDURE INIT - LPARAMETERS toFoxBin2Prg + Procedure Init + Lparameters toFoxBin2Prg - #IF .F. - LOCAL toFoxBin2Prg AS c_foxbin2prg OF 'FOXBIN2PRG.PRG' - #ENDIF + #If .F. + Local toFoxBin2Prg As c_foxbin2prg Of 'FOXBIN2PRG.PRG' + #Endif - LOCAL laDirInfo(1,5), loLang as CL_LANG OF 'FOXBIN2PRG.PRG' + Local laDirInfo(1,5), loLang As CL_LANG Of 'FOXBIN2PRG.PRG' - IF VARTYPE(toFoxBin2Prg) = "O" THEN - IF VARTYPE(_SCREEN.o_FoxBin2Prg_Lang) = "O" THEN - loLang = _SCREEN.o_FoxBin2Prg_Lang + If Vartype(toFoxBin2Prg) = "O" Then + If Vartype(_Screen.o_FoxBin2Prg_Lang) = "O" Then + loLang = _Screen.o_FoxBin2Prg_Lang - IF PEMSTATUS(_SCREEN, 'c_FB2PRG_EXE_Version', 5) THEN - THISFORM.Caption = 'FoxBin2Prg ' + _SCREEN.c_FB2PRG_EXE_Version + ' - ' + loLang.C_CONVERT_FOLDER_LOC - ENDIF + If Pemstatus(_Screen, 'c_FB2PRG_EXE_Version', 5) Then + Thisform.Caption = 'FoxBin2Prg ' + _Screen.c_FB2PRG_EXE_Version + ' - ' + loLang.C_CONVERT_FOLDER_LOC + Endif - THISFORM.chk_FileTimeStampOptimization.Caption = loLang.C_USE_FILE_TIMESTAMP_OPTIMIZATION_LOC - THISFORM.lbl_title.Caption = loLang.C_CONVERT_FOLDER_QUESTION_LOC - THISFORM.cmd_Bin2Prg.Caption = loLang.C_BINARY_TO_TEXT_LOC - THISFORM.cmd_Prg2Bin.Caption = loLang.C_TEXT_TO_BINARY_LOC - THISFORM.cmd_None.Caption = loLang.C_CONVERT_FOLDER_NONE_LOC - ENDIF + Thisform.chk_FileTimeStampOptimization.Caption = loLang.C_USE_FILE_TIMESTAMP_OPTIMIZATION_LOC + Thisform.lbl_title.Caption = loLang.C_CONVERT_FOLDER_QUESTION_LOC + Thisform.cmd_Bin2Prg.Caption = loLang.C_BINARY_TO_TEXT_LOC + Thisform.cmd_Prg2Bin.Caption = loLang.C_TEXT_TO_BINARY_LOC + Thisform.cmd_None.Caption = loLang.C_CONVERT_FOLDER_NONE_LOC + Endif - THISFORM.l_FileTimeStampOptimization = (toFoxBin2Prg.n_OptimizeByFilestamp <> 0) + Thisform.l_FileTimeStampOptimization = (toFoxBin2Prg.n_OptimizeByFilestamp <> 0) - IF ADIR( laDirInfo, FORCEEXT( toFoxBin2Prg.c_Foxbin2prg_FullPath, 'ICO' ) ) > 0 THEN - THISFORM.Icon = FORCEEXT( toFoxBin2Prg.c_Foxbin2prg_FullPath, 'ICO' ) - ENDIF - ENDIF - ENDPROC + If Adir( laDirInfo, Forceext( toFoxBin2Prg.c_Foxbin2prg_FullPath, 'ICO' ) ) > 0 Then + Thisform.Icon = Forceext( toFoxBin2Prg.c_Foxbin2prg_FullPath, 'ICO' ) + Endif + Endif + Endproc - PROCEDURE QueryUnload - THISFORM.n_ConversionType = 3 - NODEFAULT - THISFORM.do_selection() + Procedure QueryUnload + Thisform.n_ConversionType = 3 + Nodefault + Thisform.do_selection() - ENDPROC + Endproc - PROCEDURE do_selection - THISFORM.Hide() - CLEAR EVENTS - ENDPROC + Procedure do_selection + Thisform.Hide() + Clear Events + Endproc - PROCEDURE cmd_Bin2Prg.Click - *-- Selección - THISFORM.n_ConversionType = 1 - THISFORM.do_selection() - ENDPROC + Procedure cmd_Bin2Prg.Click +*-- Selección + Thisform.n_ConversionType = 1 + Thisform.do_selection() + Endproc - PROCEDURE cmd_Prg2Bin.Click - *-- Selección - THISFORM.n_ConversionType = 2 - THISFORM.do_selection() - ENDPROC + Procedure cmd_Prg2Bin.Click +*-- Selección + Thisform.n_ConversionType = 2 + Thisform.do_selection() + Endproc - PROCEDURE cmd_None.Click - *-- Selección - THISFORM.n_ConversionType = 3 - THISFORM.do_selection() - ENDPROC + Procedure cmd_None.Click +*-- Selección + Thisform.n_ConversionType = 3 + Thisform.do_selection() + Endproc -ENDDEFINE +Enddefine -DEFINE CLASS frm_main AS form +Define Class frm_main As Form AllowOutput = .F. AlwaysOnTop = .T. AutoCenter = .T. - BackColor = (RGB(255,255,255)) + BackColor = (Rgb(255,255,255)) BorderStyle = 3 Caption = "FoxBin2Prg " Closable = .T. @@ -6081,11 +6081,11 @@ DEFINE CLASS frm_main AS form ShowWindow = 2 Width = 756 - ADD OBJECT 'edt_Help' AS editbox WITH ; + Add Object 'edt_Help' As EditBox With ; Anchor = 1+2+4+8, ; BackStyle = 0, ; BorderStyle = 0, ; - DisabledForeColor = (RGB(0,0,0)), ; + DisabledForeColor = (Rgb(0,0,0)), ; Enabled = .T., ; FontName = "Courier New", ; FontSize = 9, ; @@ -6097,7 +6097,7 @@ DEFINE CLASS frm_main AS form Top = 12, ; Width = 728 - ADD OBJECT 'cmd_Close' AS commandbutton WITH ; + Add Object 'cmd_Close' As CommandButton With ; Anchor = 4+8, ; Cancel = .T., ; Caption = "Close", ; @@ -6107,54 +6107,57 @@ DEFINE CLASS frm_main AS form Top = 344, ; Width = 84 - PROCEDURE Init - LPARAMETERS toFoxBin2Prg + Procedure Init + Lparameters toFoxBin2Prg - #IF .F. - LOCAL toFoxBin2Prg AS c_foxbin2prg OF 'FOXBIN2PRG.PRG' - #ENDIF + #If .F. + Local toFoxBin2Prg As c_foxbin2prg Of 'FOXBIN2PRG.PRG' + #Endif - LOCAL laDirInfo(1,5), loLang as CL_LANG OF 'FOXBIN2PRG.PRG' + Local laDirInfo(1,5), loLang As CL_LANG Of 'FOXBIN2PRG.PRG' - IF VARTYPE(toFoxBin2Prg) = "O" THEN - IF VARTYPE(_SCREEN.o_FoxBin2Prg_Lang) = "O" THEN - loLang = _SCREEN.o_FoxBin2Prg_Lang + If Vartype(toFoxBin2Prg) = "O" Then + If Vartype(_Screen.o_FoxBin2Prg_Lang) = "O" Then + loLang = _Screen.o_FoxBin2Prg_Lang - IF PEMSTATUS(_SCREEN, 'c_FB2PRG_EXE_Version', 5) THEN - THISFORM.Caption = 'FoxBin2Prg ' + _SCREEN.c_FB2PRG_EXE_Version + ' - ' + loLang.C_FOXBIN2PRG_SYNTAX_INFO_LOC - ENDIF + If Pemstatus(_Screen, 'c_FB2PRG_EXE_Version', 5) Then + Thisform.Caption = 'FoxBin2Prg ' + _Screen.c_FB2PRG_EXE_Version + ' - ' + loLang.C_FOXBIN2PRG_SYNTAX_INFO_LOC + Endif - THISFORM.edt_help.Value = loLang.C_FOXBIN2PRG_SYNTAX_INFO_EXAMPLE_LOC - ENDIF + Thisform.edt_help.Value = loLang.C_FOXBIN2PRG_SYNTAX_INFO_EXAMPLE_LOC+; + STRTRAN(loLang.C_FOXBIN2PRG_SYNTAX_INFO_EXAMPLE_LOC_cfg,'&'+'&','')+; + loLang.C_FOXBIN2PRG_SYNTAX_INFO_EXAMPLE_LOC_tab_cfg - IF ADIR( laDirInfo, FORCEEXT( toFoxBin2Prg.c_Foxbin2prg_FullPath, 'ICO' ) ) > 0 THEN - THISFORM.Icon = FORCEEXT( toFoxBin2Prg.c_Foxbin2prg_FullPath, 'ICO' ) - ENDIF - ENDIF + Endif - ENDPROC + If Adir( laDirInfo, Forceext( toFoxBin2Prg.c_Foxbin2prg_FullPath, 'ICO' ) ) > 0 Then + Thisform.Icon = Forceext( toFoxBin2Prg.c_Foxbin2prg_FullPath, 'ICO' ) + Endif + Endif - PROCEDURE QueryUnload - CLEAR EVENTS - NODEFAULT + Endproc - ENDPROC + Procedure QueryUnload + Clear Events + Nodefault - PROCEDURE cmd_Close.Click - THISFORM.Hide() - CLEAR EVENTS + Endproc - ENDPROC + Procedure cmd_Close.Click + Thisform.Hide() + Clear Events -ENDDEFINE + Endproc + +Enddefine -DEFINE CLASS c_conversor_base AS Custom - #IF .F. - LOCAL THIS AS c_conversor_base OF 'FOXBIN2PRG.PRG' - #ENDIF - _MEMBERDATA = [] ; +Define Class c_conversor_base As Custom + #If .F. + Local This As c_conversor_base Of 'FOXBIN2PRG.PRG' + #Endif + _MemberData = [] ; + [] ; + [] ; + [] ; @@ -6211,7 +6214,7 @@ DEFINE CLASS c_conversor_base AS Custom + [] - DIMENSION a_SpecialProps(1), a_SpecialProps_Chk(1), a_SpecialProps_Coll(1) ; + Dimension a_SpecialProps(1), a_SpecialProps_Chk(1), a_SpecialProps_Coll(1) ; , a_SpecialProps_Cbo(1), a_SpecialProps_Cmg(1), a_SpecialProps_Cmd(1), a_SpecialProps_Cur(1) ; , a_SpecialProps_CA(1), a_SpecialProps_DE(1), a_SpecialProps_Edt(1), a_SpecialProps_Frs(1) ; , a_SpecialProps_Grd(1), a_SpecialProps_Grc(1), a_SpecialProps_Grh(1), a_SpecialProps_Hlk(1) ; @@ -6240,517 +6243,526 @@ DEFINE CLASS c_conversor_base AS Custom l_ReportSort_Enabled = .T. c_OriginalFileName = '' c_ClaseActual = '' - oFSO = NULL + oFSO = Null n_Methods_LineNo = 0 && Número de línea del error dentro de "Methods" - PROCEDURE INIT - LOCAL lcSys16, lnPosProg - SET DELETED ON - SET DATE YMD - SET HOURS TO 24 - SET CENTURY ON - SET SAFETY OFF - SET MULTILOCKS ON - SET TABLEPROMPT OFF - SET BLOCKSIZE TO 0 - SET EXACT ON - IF NOT EMPTY( ON("ESCAPE") ) THEN - SET ESCAPE ON - ENDIF + Procedure Init + Local lcSys16, lnPosProg + Set Deleted On + Set Date YMD + Set Hours To 24 + Set Century On + Set Safety Off + Set Multilocks On + Set TablePrompt Off +*!* Changed by: Lutz Scheffler 21.02.2021 +*!* change date="{^2021-02-21,10:57:00}" +* Operation set to standard value +* anywhere else it will respect this to, +* so it's in the general settings or not - PUBLIC C_FB2PRG_CODE +* SET BLOCKSIZE TO 0 + +*!* /Changed by: Lutz Scheffler 21.02.2021 + + Set Exact On + If Not Empty( On("ESCAPE") ) Then + Set Escape On + Endif + + Public C_FB2PRG_CODE C_FB2PRG_CODE = '' && Contendrá todo el código generado - THIS.c_CurDir = SYS(5) + CURDIR() - THIS.oFSO = CREATEOBJECT( "Scripting.FileSystemObject") - lcSys16 = SYS(16) + This.c_CurDir = Sys(5) + Curdir() + This.oFSO = Createobject( "Scripting.FileSystemObject") + lcSys16 = Sys(16) - IF LEFT(lcSys16,10) == 'PROCEDURE ' - lnPosProg = AT(" ", lcSys16, 2) + 1 - ELSE + If Left(lcSys16,10) == 'PROCEDURE ' + lnPosProg = At(" ", lcSys16, 2) + 1 + Else lnPosProg = 1 - ENDIF + Endif - THIS.c_Foxbin2prg_FullPath = SUBSTR( lcSys16, lnPosProg ) - THIS.sortSpecialProps() - RELEASE lcSys16, lnPosProg - RETURN - ENDPROC + This.c_Foxbin2prg_FullPath = Substr( lcSys16, lnPosProg ) + This.sortSpecialProps() + Release lcSys16, lnPosProg + Return + Endproc - PROCEDURE DESTROY - LOCAL loLang as CL_LANG OF 'FOXBIN2PRG.PRG' + Procedure Destroy + Local loLang As CL_LANG Of 'FOXBIN2PRG.PRG' C_FB2PRG_CODE = '' - USE IN (SELECT("TABLABIN")) - USE IN (SELECT("foxbin2prg_keywords")) + Use In (Select("TABLABIN")) + Use In (Select("foxbin2prg_keywords")) - *-- Esta comprobación es por los TESTS, que a veces no cargan o_FoxBin2Prg_Lang - IF VARTYPE(_SCREEN.o_FoxBin2Prg_Lang) = "O" THEN - loLang = _SCREEN.o_FoxBin2Prg_Lang - THIS.writeLog( loLang.C_CONVERTER_UNLOAD_LOC ) - ENDIF +*-- Esta comprobación es por los TESTS, que a veces no cargan o_FoxBin2Prg_Lang + If Vartype(_Screen.o_FoxBin2Prg_Lang) = "O" Then + loLang = _Screen.o_FoxBin2Prg_Lang + This.writeLog( loLang.C_CONVERTER_UNLOAD_LOC ) + Endif - THIS.oFSO = NULL - ENDPROC + This.oFSO = Null + Endproc - PROCEDURE analyzeAssignmentOf_TAG - *-- DETALLES: Este método está pensado para leer los tags FB2P_VALUE y MEMBERDATA, que tienen esta sintaxis: - * - * _memberdata = - * - * && XML Metadata for customizable properties - * - * Este es un valor especial - * - *-------------------------------------------------------------------------------------------------------------- - * PARÁMETROS: (v=Pasar por valor | @=Pasar por referencia) (!=Obligatorio | ?=Opcional) (IN/OUT) - * tcPropName (v! IN ) Nombre de la propiedad - * tcValue (v! IN ) Valor (o inicio del valor) de la propiedad - * taProps (!@ IN ) El array con las líneas del código donde buscar - * tnProp_Count (!@ IN ) Cantidad de líneas de código - * I (!@ IN ) Línea actualmente evaluada - * tcTAG_I (v! IN ) TAG de inicio - * tcTAG_F (v! IN ) TAG de fin - * tnLEN_TAG_I (v! IN ) Longitud del tag de inicio - * tnLEN_TAG_F (v! IN ) Longitud del tag de fin - *-------------------------------------------------------------------------------------------------------------- - LPARAMETERS tcPropName, tcValue, taProps, tnProp_Count, I, tcTAG_I, tcTAG_F, tnLEN_TAG_I, tnLEN_TAG_F + Procedure analyzeAssignmentOf_TAG +*-- DETALLES: Este método está pensado para leer los tags FB2P_VALUE y MEMBERDATA, que tienen esta sintaxis: +* +* _memberdata = +* +* && XML Metadata for customizable properties +* +* Este es un valor especial +* +*-------------------------------------------------------------------------------------------------------------- +* PARÁMETROS: (v=Pasar por valor | @=Pasar por referencia) (!=Obligatorio | ?=Opcional) (IN/OUT) +* tcPropName (v! IN ) Nombre de la propiedad +* tcValue (v! IN ) Valor (o inicio del valor) de la propiedad +* taProps (!@ IN ) El array con las líneas del código donde buscar +* tnProp_Count (!@ IN ) Cantidad de líneas de código +* I (!@ IN ) Línea actualmente evaluada +* tcTAG_I (v! IN ) TAG de inicio +* tcTAG_F (v! IN ) TAG de fin +* tnLEN_TAG_I (v! IN ) Longitud del tag de inicio +* tnLEN_TAG_F (v! IN ) Longitud del tag de fin +*-------------------------------------------------------------------------------------------------------------- + Lparameters tcPropName, tcValue, taProps, tnProp_Count, I, tcTAG_I, tcTAG_F, tnLEN_TAG_I, tnLEN_TAG_F - EXTERNAL ARRAY taProps + External Array taProps - LOCAL llBloqueEncontrado, loEx AS EXCEPTION + Local llBloqueEncontrado, loEx As Exception - TRY - IF LEFT( tcValue, tnLEN_TAG_I) == tcTAG_I - llBloqueEncontrado = .T. - LOCAL lcLine, lnArrayCols + Try + If Left( tcValue, tnLEN_TAG_I) == tcTAG_I + llBloqueEncontrado = .T. + Local lcLine, lnArrayCols - WITH THIS AS c_conversor_base OF 'FOXBIN2PRG.PRG' + With This As c_conversor_base Of 'FOXBIN2PRG.PRG' - *-- Propiedad especial - IF tcTAG_F $ tcValue && El fin de tag está "inline" - .denormalizePropertyValue( @tcPropName, @tcValue, '' ) - EXIT - ENDIF - - tcValue = '' - lnArrayCols = ALEN(taProps,2) - - FOR I = m.I + 1 TO tnProp_Count - IF lnArrayCols = 0 - lcLine = LTRIM( taProps(m.I), 0, ' ', CHR(9) ) && Quito espacios y TABS de la izquierda - ELSE - lcLine = LTRIM( taProps(m.I,1), 0, ' ', CHR(9) ) && Quito espacios y TABS de la izquierda - ENDIF - - DO CASE - CASE LEFT( lcLine, tnLEN_TAG_F ) == tcTAG_F - *-- - tcValue = tcTAG_I + SUBSTR( tcValue, 3 ) + tcTAG_F +*-- Propiedad especial + If tcTAG_F $ tcValue && El fin de tag está "inline" .denormalizePropertyValue( @tcPropName, @tcValue, '' ) - I = m.I + 1 - EXIT + Exit + Endif - CASE tcTAG_F $ lcLine - *-- Data-Data-Data- - tcValue = tcTAG_I + SUBSTR( tcValue, 3 ) + LEFT( lcLine, AT( tcTAG_F, lcLine )-1 ) + tcTAG_F - .denormalizePropertyValue( @tcPropName, @tcValue, '' ) - I = m.I + 1 - EXIT + tcValue = '' + lnArrayCols = Alen(taProps,2) - OTHERWISE - *-- Data - tcValue = tcValue + CR_LF + lcLine - ENDCASE - ENDFOR + For I = m.I + 1 To tnProp_Count + If lnArrayCols = 0 + lcLine = Ltrim( taProps(m.I), 0, ' ', Chr(9) ) && Quito espacios y TABS de la izquierda + Else + lcLine = Ltrim( taProps(m.I,1), 0, ' ', Chr(9) ) && Quito espacios y TABS de la izquierda + Endif - ENDWITH && THIS + Do Case + Case Left( lcLine, tnLEN_TAG_F ) == tcTAG_F +*-- + tcValue = tcTAG_I + Substr( tcValue, 3 ) + tcTAG_F + .denormalizePropertyValue( @tcPropName, @tcValue, '' ) + I = m.I + 1 + Exit - I = m.I - 1 + Case tcTAG_F $ lcLine +*-- Data-Data-Data- + tcValue = tcTAG_I + Substr( tcValue, 3 ) + Left( lcLine, At( tcTAG_F, lcLine )-1 ) + tcTAG_F + .denormalizePropertyValue( @tcPropName, @tcValue, '' ) + I = m.I + 1 + Exit - ENDIF + Otherwise +*-- Data + tcValue = tcValue + CR_LF + lcLine + Endcase + Endfor - CATCH TO loEx - IF THIS.n_Debug > 0 AND _VFP.STARTMODE = 0 - SET STEP ON - ENDIF + Endwith && THIS - THROW + I = m.I - 1 - FINALLY - RELEASE tcPropName, tcValue, taProps, tnProp_Count, I, tcTAG_I, tcTAG_F, tnLEN_TAG_I, tnLEN_TAG_F, loEx - ENDTRY + Endif - RETURN llBloqueEncontrado - ENDPROC + Catch To loEx + If This.n_Debug > 0 And _vfp.StartMode = 0 + Set Step On + Endif + + Throw + + Finally + Release tcPropName, tcValue, taProps, tnProp_Count, I, tcTAG_I, tcTAG_F, tnLEN_TAG_I, tnLEN_TAG_F, loEx + Endtry + + Return llBloqueEncontrado + Endproc - PROCEDURE updateProgressbar - LPARAMETERS tcTexto, tnValor, tnTotal, tnTipo - ENDPROC + Procedure updateProgressbar + Lparameters tcTexto, tnValor, tnTotal, tnTipo + Endproc - PROCEDURE findMethodsObjectByName - LPARAMETERS tcNombreObjeto, toClase - *-- Caso 1: Un método de un objeto de la clase - *-- findMethodsObjectByName( 'command1', loClase ) - *-- Caso 2: Un método de un objeto heredado que no está definido en esta librería - *-- findMethodsObjectByName( 'cnt_descripcion.Cntlista.cmgAceptarCancelar.cmdCancelar', loClase ) - #IF .F. - LOCAL toClase AS CL_CLASE OF 'FOXBIN2PRG.PRG' - #ENDIF + Procedure findMethodsObjectByName + Lparameters tcNombreObjeto, toClase +*-- Caso 1: Un método de un objeto de la clase +*-- findMethodsObjectByName( 'command1', loClase ) +*-- Caso 2: Un método de un objeto heredado que no está definido en esta librería +*-- findMethodsObjectByName( 'cnt_descripcion.Cntlista.cmgAceptarCancelar.cmdCancelar', loClase ) + #If .F. + Local toClase As CL_CLASE Of 'FOXBIN2PRG.PRG' + #Endif - TRY - LOCAL lnObjeto, I, X, N, lcRutaDelNombre ; - , loObjeto AS CL_OBJETO OF 'FOXBIN2PRG.PRG' - STORE 0 TO N, lnObjeto + Try + Local lnObjeto, I, X, N, lcRutaDelNombre ; + , loObjeto As CL_OBJETO Of 'FOXBIN2PRG.PRG' + Store 0 To N, lnObjeto - *-- El método puede pertenecer a esta clase, a un objeto de esta clase, - *-- o a un objeto heredado que no está definido en esta clase, sino en otra, - *-- y para la cual la ruta a buscar es parcial. - *-- Por ejemplo, el caso 2 puede que el objeto que hay sea 'cnt_descripcion.Cntlista' - *-- y el botón sea heredado, pero se le haya redefinido su método Click aquí. - FOR X = OCCURS( '.', tcNombreObjeto + '.' ) TO 1 STEP -1 - N = N + 1 - lcRutaDelNombre = LEFT( tcNombreObjeto, RAT( '.', tcNombreObjeto + '.', N ) - 1 ) - FOR I = 1 TO toClase._AddObject_Count - loObjeto = toClase._AddObjects(m.I) +*-- El método puede pertenecer a esta clase, a un objeto de esta clase, +*-- o a un objeto heredado que no está definido en esta clase, sino en otra, +*-- y para la cual la ruta a buscar es parcial. +*-- Por ejemplo, el caso 2 puede que el objeto que hay sea 'cnt_descripcion.Cntlista' +*-- y el botón sea heredado, pero se le haya redefinido su método Click aquí. + For X = Occurs( '.', tcNombreObjeto + '.' ) To 1 Step -1 + N = N + 1 + lcRutaDelNombre = Left( tcNombreObjeto, Rat( '.', tcNombreObjeto + '.', N ) - 1 ) + For I = 1 To toClase._AddObject_Count + loObjeto = toClase._AddObjects(m.I) - *-- Busco tanto el [nombre] del método como [class.nombre]+[nombre] del método - IF LOWER(loObjeto._Nombre) == LOWER(toClase._ObjName) + '.' + lcRutaDelNombre ; - OR LOWER(loObjeto._Nombre) == lcRutaDelNombre - lnObjeto = m.I - EXIT - ENDIF +*-- Busco tanto el [nombre] del método como [class.nombre]+[nombre] del método + If Lower(loObjeto._Nombre) == Lower(toClase._ObjName) + '.' + lcRutaDelNombre ; + OR Lower(loObjeto._Nombre) == lcRutaDelNombre + lnObjeto = m.I + Exit + Endif - loObjeto = NULL - ENDFOR - IF lnObjeto > 0 - EXIT - ENDIF - ENDFOR + loObjeto = Null + Endfor + If lnObjeto > 0 + Exit + Endif + Endfor - CATCH TO loEx - lnCodError = loEx.ERRORNO + Catch To loEx + lnCodError = loEx.ErrorNo - IF THIS.n_Debug > 0 AND _VFP.STARTMODE = 0 - SET STEP ON - ENDIF + If This.n_Debug > 0 And _vfp.StartMode = 0 + Set Step On + Endif - THROW + Throw - FINALLY - RELEASE tcNombreObjeto, toClase, I, X, N, lcRutaDelNombre, loObjeto - ENDTRY + Finally + Release tcNombreObjeto, toClase, I, X, N, lcRutaDelNombre, loObjeto + Endtry - RETURN lnObjeto - ENDPROC + Return lnObjeto + Endproc - FUNCTION verifyValidExpression - LPARAMETERS tcAsignacion, tnCodError, tcExpNormalizada - LOCAL llError, loEx AS EXCEPTION + Function verifyValidExpression + Lparameters tcAsignacion, tnCodError, tcExpNormalizada + Local llError, loEx As Exception - TRY - tcExpNormalizada = NORMALIZE( tcAsignacion ) + Try + tcExpNormalizada = Normalize( tcAsignacion ) - CATCH TO loEx - llError = .T. - tnCodError = loEx.ERRORNO + Catch To loEx + llError = .T. + tnCodError = loEx.ErrorNo - FINALLY - RELEASE tcAsignacion, tnCodError, tcExpNormalizada, loEx - ENDTRY + Finally + Release tcAsignacion, tnCodError, tcExpNormalizada, loEx + Endtry - RETURN NOT llError - ENDFUNC + Return Not llError + Endfunc - PROCEDURE convert - *--------------------------------------------------------------------------------------------------- - * PARÁMETROS: (v=Pasar por valor | @=Pasar por referencia) (!=Obligatorio | ?=Opcional) (IN/OUT) - * toModulo (!@ OUT) Objeto generado de clase correspondiente con la información leida del texto - * toEx (!@ OUT) Objeto con información del error - * toFoxBin2Prg (!@ IN ) Referencia al objeto principal - *--------------------------------------------------------------------------------------------------- - LPARAMETERS toModulo, toEx AS EXCEPTION, toFoxBin2Prg - #IF .F. - LOCAL toFoxBin2Prg AS c_foxbin2prg OF 'FOXBIN2PRG.PRG' - #ENDIF - LOCAL loLang as CL_LANG OF 'FOXBIN2PRG.PRG' - loLang = _SCREEN.o_FoxBin2Prg_Lang - *THIS.writeLog( '' ) - THIS.writeLog( C_TAB + loLang.C_CONVERTING_FILE_LOC + ' ' + THIS.c_OutputFile + '...' ) - RELEASE toModulo, toEx, toFoxBin2Prg, loLang - RETURN - ENDPROC + Procedure convert +*--------------------------------------------------------------------------------------------------- +* PARÁMETROS: (v=Pasar por valor | @=Pasar por referencia) (!=Obligatorio | ?=Opcional) (IN/OUT) +* toModulo (!@ OUT) Objeto generado de clase correspondiente con la información leida del texto +* toEx (!@ OUT) Objeto con información del error +* toFoxBin2Prg (!@ IN ) Referencia al objeto principal +*--------------------------------------------------------------------------------------------------- + Lparameters toModulo, toEx As Exception, toFoxBin2Prg + #If .F. + Local toFoxBin2Prg As c_foxbin2prg Of 'FOXBIN2PRG.PRG' + #Endif + Local loLang As CL_LANG Of 'FOXBIN2PRG.PRG' + loLang = _Screen.o_FoxBin2Prg_Lang +*THIS.writeLog( '' ) + This.writeLog( C_TAB + loLang.C_CONVERTING_FILE_LOC + ' ' + This.c_OutputFile + '...' ) + Release toModulo, toEx, toFoxBin2Prg, loLang + Return + Endproc - PROCEDURE currentLineIsPreviousLineContinuation - LPARAMETERS taCodeLines, I + Procedure currentLineIsPreviousLineContinuation + Lparameters taCodeLines, I - LOCAL lcPrevLine, llIsContinuation + Local lcPrevLine, llIsContinuation - *-- Analizo la línea anterior para saber si termina con ";" o "," y la actual es continuación - IF m.I > 1 +*-- Analizo la línea anterior para saber si termina con ";" o "," y la actual es continuación + If m.I > 1 lcPrevLine = taCodeLines(m.I-1) - ELSE + Else lcPrevLine = '' - ENDIF + Endif - THIS.get_SeparatedLineAndComment( @lcPrevLine ) + This.get_SeparatedLineAndComment( @lcPrevLine ) - IF INLIST( RIGHT( lcPrevLine,1 ), ';', ',' ) && Esta línea es continuación de la anterior + If Inlist( Right( lcPrevLine,1 ), ';', ',' ) && Esta línea es continuación de la anterior llIsContinuation = .T. - ENDIF + Endif - RELEASE taCodeLines, I, lcPrevLine + Release taCodeLines, I, lcPrevLine - RETURN llIsContinuation - ENDPROC + Return llIsContinuation + Endproc - PROCEDURE isIndicatedToken - LPARAMETERS tcLine, ta_ID_Bloques, tnLen_IDFinBQ, X, tnIniFin - LOCAL llEncontrado, lcWord, lcWord2, lcLine, lnWordCount + Procedure isIndicatedToken + Lparameters tcLine, ta_ID_Bloques, tnLen_IDFinBQ, X, tnIniFin + Local llEncontrado, lcWord, lcWord2, lcLine, lnWordCount - TRY - *-- Pre-normalización - lcLine = tcLine + Try +*-- Pre-normalización + lcLine = tcLine - IF tnIniFin = 1 - *-- TOKENS DE INICIO - IF UPPER( LEFT( lcLine, ta_ID_Bloques(m.X,3) ) ) == ta_ID_Bloques(m.X,1) - *-- Evaluar casos especiales - lcWord = UPPER( ALLTRIM(GETWORDNUM(lcLine,1) ) ) + If tnIniFin = 1 +*-- TOKENS DE INICIO + If Upper( Left( lcLine, ta_ID_Bloques(m.X,3) ) ) == ta_ID_Bloques(m.X,1) +*-- Evaluar casos especiales + lcWord = Upper( Alltrim(Getwordnum(lcLine,1) ) ) - IF ta_ID_Bloques(m.X,1) == 'TEXT' THEN - lcLine = UPPER( lcLine ) + ' ' - lnWordCount = GETWORDCOUNT(lcLine) + If ta_ID_Bloques(m.X,1) == 'TEXT' Then + lcLine = Upper( lcLine ) + ' ' + lnWordCount = Getwordcount(lcLine) - IF lnWordCount >= 2 - lcWord2 = ALLTRIM(GETWORDNUM(lcLine,2) ) - ENDIF + If lnWordCount >= 2 + lcWord2 = Alltrim(Getwordnum(lcLine,2) ) + Endif - DO CASE - CASE NOT lcWord == 'TEXT' - EXIT + Do Case + Case Not lcWord == 'TEXT' + Exit - *CASE UPPER( LEFT( CHRTRAN( lcLine, ' ', '' ), 5 ) ) == 'TEXT=' - * EXIT - CASE lnWordCount >= 2 - IF lcWord2 == "TO" - * OK, es TEXT TO... - ELSE - * Luego de TEXT sigue cualquier otra cosa, así que puede ser - * un campo, variable, etc, que lo han llamado TEXT. - EXIT - ENDIF +*CASE UPPER( LEFT( CHRTRAN( lcLine, ' ', '' ), 5 ) ) == 'TEXT=' +* EXIT + Case lnWordCount >= 2 + If lcWord2 == "TO" +* OK, es TEXT TO... + Else +* Luego de TEXT sigue cualquier otra cosa, así que puede ser +* un campo, variable, etc, que lo han llamado TEXT. + Exit + Endif - OTHERWISE - * OK, es TEXT sin más. - ENDCASE - ENDIF + Otherwise +* OK, es TEXT sin más. + Endcase + Endif - llEncontrado = .T. - ENDIF - ELSE - *-- TOKENS DE FIN - IF UPPER( LEFT( lcLine, ta_ID_Bloques(m.X,4) ) ) == ta_ID_Bloques(m.X,2) && Fin de bloque encontrado (#ENDI, ENDTEXT, etc) - *-- Evaluar casos especiales - lcWord = UPPER( ALLTRIM(GETWORDNUM(lcLine,1) ) ) + llEncontrado = .T. + Endif + Else +*-- TOKENS DE FIN + If Upper( Left( lcLine, ta_ID_Bloques(m.X,4) ) ) == ta_ID_Bloques(m.X,2) && Fin de bloque encontrado (#ENDI, ENDTEXT, etc) +*-- Evaluar casos especiales + lcWord = Upper( Alltrim(Getwordnum(lcLine,1) ) ) - IF ta_ID_Bloques(m.X,2) == 'ENDT' AND NOT lcWord == LEFT( 'ENDTEXT', LEN(lcWord) ) - EXIT - ENDIF + If ta_ID_Bloques(m.X,2) == 'ENDT' And Not lcWord == Left( 'ENDTEXT', Len(lcWord) ) + Exit + Endif - llEncontrado = .T. - ENDIF - ENDIF + llEncontrado = .T. + Endif + Endif - FINALLY - RELEASE tcLine, ta_ID_Bloques, tnLen_IDFinBQ, X, tnIniFin, lcLine - ENDTRY + Finally + Release tcLine, ta_ID_Bloques, tnLen_IDFinBQ, X, tnIniFin, lcLine + Endtry - RETURN llEncontrado - ENDPROC + Return llEncontrado + Endproc - PROCEDURE decode_SpecialCodes_1_31 - *--------------------------------------------------------------------------------------------------- - * PARÁMETROS: (v=Pasar por valor | @=Pasar por referencia) (!=Obligatorio | ?=Opcional) (IN/OUT) - * tcText (!@ IN ) Decodifica los primeros 31 caracteres ASCII de {nCode} a CHR(nCode) - *--------------------------------------------------------------------------------------------------- - LPARAMETERS tcText - LOCAL I - FOR I = 0 TO 31 - tcText = STRTRAN( tcText, '{' + TRANSFORM(m.I) + '}', CHR(m.I) ) - ENDFOR - RELEASE I - RETURN tcText - ENDPROC + Procedure decode_SpecialCodes_1_31 +*--------------------------------------------------------------------------------------------------- +* PARÁMETROS: (v=Pasar por valor | @=Pasar por referencia) (!=Obligatorio | ?=Opcional) (IN/OUT) +* tcText (!@ IN ) Decodifica los primeros 31 caracteres ASCII de {nCode} a CHR(nCode) +*--------------------------------------------------------------------------------------------------- + Lparameters tcText + Local I + For I = 0 To 31 + tcText = Strtran( tcText, '{' + Transform(m.I) + '}', Chr(m.I) ) + Endfor + Release I + Return tcText + Endproc - PROCEDURE decode_SpecialCodes_CR_LF - *--------------------------------------------------------------------------------------------------- - * PARÁMETROS: (v=Pasar por valor | @=Pasar por referencia) (!=Obligatorio | ?=Opcional) (IN/OUT) - * tcText (!@ IN ) Decodifica los caracteres ASCII 10 y 13 de {nCode} a CHR(nCode) - *--------------------------------------------------------------------------------------------------- - LPARAMETERS tcText - tcText = STRTRAN( STRTRAN( tcText, '{10}', CHR(10) ), '{13}', CHR(13) ) - RETURN tcText - ENDPROC + Procedure decode_SpecialCodes_CR_LF +*--------------------------------------------------------------------------------------------------- +* PARÁMETROS: (v=Pasar por valor | @=Pasar por referencia) (!=Obligatorio | ?=Opcional) (IN/OUT) +* tcText (!@ IN ) Decodifica los caracteres ASCII 10 y 13 de {nCode} a CHR(nCode) +*--------------------------------------------------------------------------------------------------- + Lparameters tcText + tcText = Strtran( Strtran( tcText, '{10}', Chr(10) ), '{13}', Chr(13) ) + Return tcText + Endproc - PROCEDURE denormalizeAssignment - LPARAMETERS tcAsignacion - LOCAL lcPropName, lcValor, lnCodError, lcExpNormalizada, lnPos, lcComentario + Procedure denormalizeAssignment + Lparameters tcAsignacion + Local lcPropName, lcValor, lnCodError, lcExpNormalizada, lnPos, lcComentario - WITH THIS AS c_conversor_base OF 'FOXBIN2PRG.PRG' + With This As c_conversor_base Of 'FOXBIN2PRG.PRG' .get_SeparatedPropAndValue( @tcAsignacion, @lcPropName, @lcValor ) lcComentario = '' .denormalizePropertyValue( @lcPropName, @lcValor, @lcComentario ) tcAsignacion = lcPropName + ' = ' + lcValor - ENDWITH + Endwith - RELEASE lcPropName, lcValor, lnCodError, lcExpNormalizada, lnPos, lcComentario - RETURN tcAsignacion - ENDPROC + Release lcPropName, lcValor, lnCodError, lcExpNormalizada, lnPos, lcComentario + Return tcAsignacion + Endproc - PROCEDURE denormalizePropertyValue - *-- Este método se ejecuta cuando se regenera el binario desde el tx2 - LPARAMETERS tcProp, tcValue, tcComentario - LOCAL lnCodError, lnPos, lcValue + Procedure denormalizePropertyValue +*-- Este método se ejecuta cuando se regenera el binario desde el tx2 + Lparameters tcProp, tcValue, tcComentario + Local lnCodError, lnPos, lcValue tcComentario = '' - *-- Ajustes de algunos casos especiales - DO CASE - CASE tcProp == '_memberdata' - *-- Me quedo con lo importante y quito los CHR(0) y longitud que a veces agrega al inicio - lcValue = '' +*-- Ajustes de algunos casos especiales + Do Case + Case tcProp == '_memberdata' +*-- Me quedo con lo importante y quito los CHR(0) y longitud que a veces agrega al inicio + lcValue = '' - FOR I = 1 TO OCCURS( '/>', tcValue ) - * issue#16: memberdata property should be saved in compressed format - lcValue = lcValue + CHRTRAN( STREXTRACT( tcValue, '', m.I, 1+4 ), CR_LF, ' ' ) - ENDFOR + For I = 1 To Occurs( '/>', tcValue ) +* issue#16: memberdata property should be saved in compressed format + lcValue = lcValue + Chrtran( Strextract( tcValue, '', m.I, 1+4 ), CR_LF, ' ' ) + Endfor - * issue#16: memberdata property should be saved in compressed format - TEXT TO tcValue TEXTMERGE NOSHOW FLAGS 1 PRETEXT 1+2 +* issue#16: memberdata property should be saved in compressed format + TEXT TO tcValue TEXTMERGE NOSHOW FLAGS 1 PRETEXT 1+2 <> - ENDTEXT + ENDTEXT - IF LEN(lcValue) > 255 - tcValue = C_MPROPHEADER + STR( LEN(tcValue), 8 ) + tcValue - ELSE - tcValue = CHRTRAN( tcValue, CR_LF, '' ) - ENDIF + If Len(lcValue) > 255 + tcValue = C_MPROPHEADER + Str( Len(tcValue), 8 ) + tcValue + Else + tcValue = Chrtran( tcValue, CR_LF, '' ) + Endif - CASE LEFT( tcValue, C_LEN_FB2P_VALUE_I ) == C_FB2P_VALUE_I - *-- Valor especial Fox con cabecera CHR(1): Debo agregarla y desnormalizar el valor - tcValue = STRTRAN( STRTRAN( STREXTRACT( tcValue, C_FB2P_VALUE_I, C_FB2P_VALUE_F, 1, 1 ), ' ', C_CR ), ' ', C_LF ) - tcValue = C_MPROPHEADER + STR( LEN(tcValue), 8 ) + tcValue + Case Left( tcValue, C_LEN_FB2P_VALUE_I ) == C_FB2P_VALUE_I +*-- Valor especial Fox con cabecera CHR(1): Debo agregarla y desnormalizar el valor + tcValue = Strtran( Strtran( Strextract( tcValue, C_FB2P_VALUE_I, C_FB2P_VALUE_F, 1, 1 ), ' ', C_CR ), ' ', C_LF ) + tcValue = C_MPROPHEADER + Str( Len(tcValue), 8 ) + tcValue - ENDCASE + Endcase - RELEASE tcProp, tcComentario, lnCodError, lnPos, lcValue - RETURN tcValue - ENDPROC + Release tcProp, tcComentario, lnCodError, lnPos, lcValue + Return tcValue + Endproc - PROCEDURE denormalizeXMLValue - LPARAMETERS tcValor - *-- DESNORMALIZA EL TEXTO INDICADO, EXPANDIENDO LOS SÍMBOLOS XML ESPECIALES. - LOCAL lnPos, lnPos2, lnAscii - tcValor = STRTRAN(tcValor, CHR(38)+'gt;', '>') && > - tcValor = STRTRAN(tcValor, CHR(38)+'lt;', '<') && < - tcValor = STRTRAN(tcValor, CHR(38)+'quot;', CHR(34)) && " - tcValor = STRTRAN(tcValor, CHR(38)+'apos;', CHR(39)) && ' - tcValor = STRTRAN(tcValor, CHR(38)+'amp;', CHR(38)) && & + Procedure denormalizeXMLValue + Lparameters tcValor +*-- DESNORMALIZA EL TEXTO INDICADO, EXPANDIENDO LOS SÍMBOLOS XML ESPECIALES. + Local lnPos, lnPos2, lnAscii + tcValor = Strtran(tcValor, Chr(38)+'gt;', '>') && > + tcValor = Strtran(tcValor, Chr(38)+'lt;', '<') && < + tcValor = Strtran(tcValor, Chr(38)+'quot;', Chr(34)) && " + tcValor = Strtran(tcValor, Chr(38)+'apos;', Chr(39)) && ' + tcValor = Strtran(tcValor, Chr(38)+'amp;', Chr(38)) && & - *-- Obtengo los Hex - DO WHILE .T. - lnPos = AT( CHR(38)+'#x', tcValor ) - IF lnPos = 0 - EXIT - ENDIF - lnPos2 = lnPos + 1 + AT( ';', SUBSTR( tcValor, lnPos + 2, 4 ) ) - lnAscii = EVALUATE( '0' + SUBSTR( tcValor, lnPos + 3, lnPos2 - lnPos - 3 ) ) - tcValor = STUFF(tcValor, lnPos, lnPos2 - lnPos + 1, CHR(lnAscii)) && ASCII - ENDDO +*-- Obtengo los Hex + Do While .T. + lnPos = At( Chr(38)+'#x', tcValor ) + If lnPos = 0 + Exit + Endif + lnPos2 = lnPos + 1 + At( ';', Substr( tcValor, lnPos + 2, 4 ) ) + lnAscii = Evaluate( '0' + Substr( tcValor, lnPos + 3, lnPos2 - lnPos - 3 ) ) + tcValor = Stuff(tcValor, lnPos, lnPos2 - lnPos + 1, Chr(lnAscii)) && ASCII + Enddo - *-- Obtengo los Dec - DO WHILE .T. - lnPos = AT( CHR(38)+'#', tcValor ) - IF lnPos = 0 - EXIT - ENDIF - lnPos2 = lnPos + 1 + AT( ';', SUBSTR( tcValor, lnPos + 2, 4 ) ) - lnAscii = EVALUATE( SUBSTR( tcValor, lnPos + 2, lnPos2 - lnPos - 2 ) ) - tcValor = STUFF(tcValor, lnPos, lnPos2 - lnPos + 1, CHR(lnAscii)) && ASCII - ENDDO +*-- Obtengo los Dec + Do While .T. + lnPos = At( Chr(38)+'#', tcValor ) + If lnPos = 0 + Exit + Endif + lnPos2 = lnPos + 1 + At( ';', Substr( tcValor, lnPos + 2, 4 ) ) + lnAscii = Evaluate( Substr( tcValor, lnPos + 2, lnPos2 - lnPos - 2 ) ) + tcValor = Stuff(tcValor, lnPos, lnPos2 - lnPos + 1, Chr(lnAscii)) && ASCII + Enddo - RELEASE lnPos, lnPos2, lnAscii - RETURN tcValor - ENDPROC + Release lnPos, lnPos2, lnAscii + Return tcValor + Endproc - PROCEDURE encode_SpecialCodes_1_31 - *--------------------------------------------------------------------------------------------------- - * PARÁMETROS: (v=Pasar por valor | @=Pasar por referencia) (!=Obligatorio | ?=Opcional) (IN/OUT) - * tcText (!@ IN ) Decodifica los primeros 31 caracteres ASCII de CHR(nCode) a {nCode} - *--------------------------------------------------------------------------------------------------- - LPARAMETERS tcText - LOCAL I - FOR I = 0 TO 31 - tcText = STRTRAN( tcText, CHR(m.I), '{' + TRANSFORM(m.I) + '}' ) - ENDFOR - RELEASE I - RETURN tcText - ENDPROC + Procedure encode_SpecialCodes_1_31 +*--------------------------------------------------------------------------------------------------- +* PARÁMETROS: (v=Pasar por valor | @=Pasar por referencia) (!=Obligatorio | ?=Opcional) (IN/OUT) +* tcText (!@ IN ) Decodifica los primeros 31 caracteres ASCII de CHR(nCode) a {nCode} +*--------------------------------------------------------------------------------------------------- + Lparameters tcText + Local I + For I = 0 To 31 + tcText = Strtran( tcText, Chr(m.I), '{' + Transform(m.I) + '}' ) + Endfor + Release I + Return tcText + Endproc - PROCEDURE encode_SpecialCodes_CR_LF - *--------------------------------------------------------------------------------------------------- - * PARÁMETROS: (v=Pasar por valor | @=Pasar por referencia) (!=Obligatorio | ?=Opcional) (IN/OUT) - * tcText (!@ IN ) Codifica los caracteres ASCII 10 y 13 de CHR(nCode) a {nCode} - *--------------------------------------------------------------------------------------------------- - LPARAMETERS tcText - tcText = STRTRAN( STRTRAN( tcText, CHR(10), '{10}' ), CHR(13), '{13}' ) - RETURN tcText - ENDPROC + Procedure encode_SpecialCodes_CR_LF +*--------------------------------------------------------------------------------------------------- +* PARÁMETROS: (v=Pasar por valor | @=Pasar por referencia) (!=Obligatorio | ?=Opcional) (IN/OUT) +* tcText (!@ IN ) Codifica los caracteres ASCII 10 y 13 de CHR(nCode) a {nCode} +*--------------------------------------------------------------------------------------------------- + Lparameters tcText + tcText = Strtran( Strtran( tcText, Chr(10), '{10}' ), Chr(13), '{13}' ) + Return tcText + Endproc - HIDDEN PROCEDURE exception2Str - LPARAMETERS toEx AS EXCEPTION - LOCAL lcError - lcError = 'Error ' + TRANSFORM(toEx.ERRORNO) + ', ' + toEx.MESSAGE + CHR(13) + CHR(13) ; - + toEx.PROCEDURE + ', ' + TRANSFORM(toEx.LINENO) + CHR(13) + CHR(13) ; - + toEx.LINECONTENTS - RELEASE toEx - RETURN lcError - ENDPROC + Hidden Procedure exception2Str + Lparameters toEx As Exception + Local lcError + lcError = 'Error ' + Transform(toEx.ErrorNo) + ', ' + toEx.Message + Chr(13) + Chr(13) ; + + toEx.Procedure + ', ' + Transform(toEx.Lineno) + Chr(13) + Chr(13) ; + + toEx.LineContents + Release toEx + Return lcError + Endproc - PROCEDURE fileTypeCode - LPARAMETERS tcExtension, tcOriginalType - tcExtension = UPPER(tcExtension) - RETURN ICASE( tcExtension = 'DBC', 'd' ; - , tcExtension = 'DBF', EVL(tcOriginalType, 'D') ; + Procedure fileTypeCode + Lparameters tcExtension, tcOriginalType + tcExtension = Upper(tcExtension) + Return Icase( tcExtension = 'DBC', 'd' ; + , tcExtension = 'DBF', Evl(tcOriginalType, 'D') ; , tcExtension = 'QPR', 'Q' ; , tcExtension = 'SCX', 'K' ; , tcExtension = 'FRX', 'R' ; @@ -6766,183 +6778,183 @@ DEFINE CLASS c_conversor_base AS Custom , tcExtension = 'H', 'T' ; , tcExtension = 'SPR', 'E' ; , tcExtension = 'MPR', 'P' ; - , EVL(tcOriginalType, 'x') ) - ENDPROC + , Evl(tcOriginalType, 'x') ) + Endproc - FUNCTION getTimeStamp - *--------------------------------------------------------------------------------------------------- - * PARÁMETROS: (v=Pasar por valor | @=Pasar por referencia) (!=Obligatorio | ?=Opcional) (IN/OUT) - * tnTimeStamp (v! IN ) Timestamp en formato numérico - *--------------------------------------------------------------------------------------------------- - LPARAMETERS tnTimeStamp - *-- CONVIERTE UN DATO TIMESTAMP NUMERICO USADO POR LOS ARCHIVOS SCX/VCX/etc. EN TIPO DATETIME - TRY - LOCAL lcTimeStamp,lnYear,lnMonth,lnDay,lnHour,lnMinutes,lnSeconds,lcTime,lnHour,ltTimeStamp,lnResto ; - ,lcTimeStamp_Ret, laDirInfo[1,5], loEx AS EXCEPTION + Function getTimeStamp +*--------------------------------------------------------------------------------------------------- +* PARÁMETROS: (v=Pasar por valor | @=Pasar por referencia) (!=Obligatorio | ?=Opcional) (IN/OUT) +* tnTimeStamp (v! IN ) Timestamp en formato numérico +*--------------------------------------------------------------------------------------------------- + Lparameters tnTimeStamp +*-- CONVIERTE UN DATO TIMESTAMP NUMERICO USADO POR LOS ARCHIVOS SCX/VCX/etc. EN TIPO DATETIME + Try + Local lcTimeStamp,lnYear,lnMonth,lnDay,lnHour,lnMinutes,lnSeconds,lcTime,lnHour,ltTimeStamp,lnResto ; + ,lcTimeStamp_Ret, laDirInfo[1,5], loEx As Exception - WITH THIS AS c_conversor_base OF 'FOXBIN2PRG.PRG' - lcTimeStamp_Ret = '' + With This As c_conversor_base Of 'FOXBIN2PRG.PRG' + lcTimeStamp_Ret = '' - IF EMPTY(tnTimeStamp) - IF .lFileMode - IF ADIR(laDirInfo,.c_InputFile)=0 - EXIT - ENDIF + If Empty(tnTimeStamp) + If .lFileMode + If Adir(laDirInfo,.c_InputFile)=0 + Exit + Endif - ltTimeStamp = EVALUATE( '{^' + DTOC(laDirInfo(1,3)) + ' ' + TRANSFORM(laDirInfo(1,4)) + '}' ) + ltTimeStamp = Evaluate( '{^' + Dtoc(laDirInfo(1,3)) + ' ' + Transform(laDirInfo(1,4)) + '}' ) - *-- En mi arreglo, si la hora pasada tiene 32 segundos o más, redondeo al siguiente minuto, ya que - *-- la descodificación posterior de getTimeStamp tiene ese margen de error. - IF SEC(m.ltTimeStamp) >= 32 - ltTimeStamp = m.ltTimeStamp + 28 - ENDIF +*-- En mi arreglo, si la hora pasada tiene 32 segundos o más, redondeo al siguiente minuto, ya que +*-- la descodificación posterior de getTimeStamp tiene ese margen de error. + If Sec(m.ltTimeStamp) >= 32 + ltTimeStamp = m.ltTimeStamp + 28 + Endif - lcTimeStamp_Ret = TTOC( ltTimeStamp ) - EXIT - ENDIF + lcTimeStamp_Ret = Ttoc( ltTimeStamp ) + Exit + Endif - tnTimeStamp = .n_ClassTimeStamp + tnTimeStamp = .n_ClassTimeStamp - IF EMPTY(tnTimeStamp) - EXIT - ENDIF - ENDIF + If Empty(tnTimeStamp) + Exit + Endif + Endif - *-- YYYY YYYM MMMD DDDD HHHH HMMM MMMS SSSS - lnResto = tnTimeStamp - lnYear = INT( lnResto / 2**25 + 1980) - lnResto = lnResto % 2**25 - lnMonth = INT( lnResto / 2**21 ) - lnResto = lnResto % 2**21 - lnDay = INT( lnResto / 2**16 ) - lnResto = lnResto % 2**16 - lnHour = INT( lnResto / 2**11 ) - lnResto = lnResto % 2**11 - lnMinutes = INT( lnResto / 2**5 ) - lnResto = lnResto % 2**5 - lnSeconds = lnResto +*-- YYYY YYYM MMMD DDDD HHHH HMMM MMMS SSSS + lnResto = tnTimeStamp + lnYear = Int( lnResto / 2**25 + 1980) + lnResto = lnResto % 2**25 + lnMonth = Int( lnResto / 2**21 ) + lnResto = lnResto % 2**21 + lnDay = Int( lnResto / 2**16 ) + lnResto = lnResto % 2**16 + lnHour = Int( lnResto / 2**11 ) + lnResto = lnResto % 2**11 + lnMinutes = Int( lnResto / 2**5 ) + lnResto = lnResto % 2**5 + lnSeconds = lnResto - lcTimeStamp = PADL(lnYear,4,'0') + "/" + PADL(lnMonth,2,'0') + "/" + PADL(lnDay,2,'0') + " " ; - + PADL(lnHour,2,'0') + ":" + PADL(lnMinutes,2,'0') + ":" + PADL(lnSeconds,2,'0') + lcTimeStamp = Padl(lnYear,4,'0') + "/" + Padl(lnMonth,2,'0') + "/" + Padl(lnDay,2,'0') + " " ; + + Padl(lnHour,2,'0') + ":" + Padl(lnMinutes,2,'0') + ":" + Padl(lnSeconds,2,'0') - ltTimeStamp = EVALUATE( "{^" + lcTimeStamp + "}" ) + ltTimeStamp = Evaluate( "{^" + lcTimeStamp + "}" ) - lcTimeStamp_Ret = TTOC( ltTimeStamp ) - ENDWITH + lcTimeStamp_Ret = Ttoc( ltTimeStamp ) + Endwith - CATCH TO loEx - IF THIS.n_Debug > 0 AND _VFP.STARTMODE = 0 - SET STEP ON - ENDIF + Catch To loEx + If This.n_Debug > 0 And _vfp.StartMode = 0 + Set Step On + Endif - THROW + Throw - ENDTRY + Endtry - RETURN lcTimeStamp_Ret - ENDFUNC + Return lcTimeStamp_Ret + Endfunc - PROCEDURE get_ListNamesWithValuesFrom_InLine_MetadataTag - *-- OBTENGO EL ARRAY DE DATOS Y VALORES DE LA LINEA DE METADATOS INDICADA - *-- NOTA: Los valores NO PUEDEN contener comillas dobles en su valor, ya que generaría un error al parsearlos. - *-- Ejemplo: - *< FileMetadata: Type="V" Cpid="1252" Timestamp="1131901580" ID="1129207528" ObjRev="544" /> - *< OLE: Nombre="frm_form.Pageframe1.Page1.Cnt_controles_h.Olecontrol1" Parent="frm_form.Pageframe1.Page1.Cnt_controles_h" ObjName="Olecontrol1" Checksum="1685567300" Value="0M8R4KGxGuEAAAAAAAAAAAAAAAAAAAAAPg...ADAP7AAAA==" /> - *-------------------------------------------------------------------------------------------------------------- - * PARÁMETROS: (v=Pasar por valor | @=Pasar por referencia) (!=Obligatorio | ?=Opcional) (IN/OUT) - * tcLineWithMetadata (!@ IN ) Línea con metadatos y un tag de metadatos - * taPropsAndValues (!@ OUT) Array a devolver con las propiedades y valores encontrados - * tnPropsAndValues_Count (!@ OUT) Cantidad de propiedades encontradas - * tcLeftTag (v! IN ) TAG de inicio de los metadatos - * tcRightTag (v! IN ) TAG de fin de los metadatos - *-------------------------------------------------------------------------------------------------------------- - LPARAMETERS tcLineWithMetadata, taPropsAndValues, tnPropsAndValues_Count, tcLeftTag, tcRightTag + Procedure get_ListNamesWithValuesFrom_InLine_MetadataTag +*-- OBTENGO EL ARRAY DE DATOS Y VALORES DE LA LINEA DE METADATOS INDICADA +*-- NOTA: Los valores NO PUEDEN contener comillas dobles en su valor, ya que generaría un error al parsearlos. +*-- Ejemplo: +*< FileMetadata: Type="V" Cpid="1252" Timestamp="1131901580" ID="1129207528" ObjRev="544" /> +*< OLE: Nombre="frm_form.Pageframe1.Page1.Cnt_controles_h.Olecontrol1" Parent="frm_form.Pageframe1.Page1.Cnt_controles_h" ObjName="Olecontrol1" Checksum="1685567300" Value="0M8R4KGxGuEAAAAAAAAAAAAAAAAAAAAAPg...ADAP7AAAA==" /> +*-------------------------------------------------------------------------------------------------------------- +* PARÁMETROS: (v=Pasar por valor | @=Pasar por referencia) (!=Obligatorio | ?=Opcional) (IN/OUT) +* tcLineWithMetadata (!@ IN ) Línea con metadatos y un tag de metadatos +* taPropsAndValues (!@ OUT) Array a devolver con las propiedades y valores encontrados +* tnPropsAndValues_Count (!@ OUT) Cantidad de propiedades encontradas +* tcLeftTag (v! IN ) TAG de inicio de los metadatos +* tcRightTag (v! IN ) TAG de fin de los metadatos +*-------------------------------------------------------------------------------------------------------------- + Lparameters tcLineWithMetadata, taPropsAndValues, tnPropsAndValues_Count, tcLeftTag, tcRightTag - EXTERNAL ARRAY taPropsAndValues + External Array taPropsAndValues - LOCAL lcMetadatos, I, lcVirtualMeta, lnPos1, lnPos2, lnLastPos, lnCantComillas ; - , loLang as CL_LANG OF 'FOXBIN2PRG.PRG' ; - , loEx as Exception + Local lcMetadatos, I, lcVirtualMeta, lnPos1, lnPos2, lnLastPos, lnCantComillas ; + , loLang As CL_LANG Of 'FOXBIN2PRG.PRG' ; + , loEx As Exception - TRY - loLang = _SCREEN.o_FoxBin2Prg_Lang - STORE '' TO lcVirtualMeta - STORE 0 TO lnPos1, lnPos2, lnLastPos, tnPropsAndValues_Count, I + Try + loLang = _Screen.o_FoxBin2Prg_Lang + Store '' To lcVirtualMeta + Store 0 To lnPos1, lnPos2, lnLastPos, tnPropsAndValues_Count, I - lcMetadatos = ALLTRIM( STREXTRACT( tcLineWithMetadata, tcLeftTag, tcRightTag, 1, 1) ) + lcMetadatos = Alltrim( Strextract( tcLineWithMetadata, tcLeftTag, tcRightTag, 1, 1) ) - IF EMPTY(lcMetadatos) - * Puede que la línea esté separada con un CR erróneo. El usuario debe revisarlo - ERROR (TEXTMERGE("Can't identify Metadata TAG '<>'. May be the Source line have an extra CR/LF?")) - ENDIF + If Empty(lcMetadatos) +* Puede que la línea esté separada con un CR erróneo. El usuario debe revisarlo + Error (Textmerge("Can't identify Metadata TAG '<>'. May be the Source line have an extra CR/LF?")) + Endif - lnCantComillas = OCCURS( '"', lcMetadatos ) + lnCantComillas = Occurs( '"', lcMetadatos ) - IF lnCantComillas % 2 <> 0 && Valido que las comillas "" sean pares - *ERROR "Error de datos: No se puede parsear porque las comillas no son pares en la línea [" + lcMetadatos + "]" - ERROR (TEXTMERGE(loLang.C_DATA_ERROR_CANT_PARSE_UNPAIRING_DOUBLE_QUOTES_LOC)) - ENDIF + If lnCantComillas % 2 <> 0 && Valido que las comillas "" sean pares +*ERROR "Error de datos: No se puede parsear porque las comillas no son pares en la línea [" + lcMetadatos + "]" + Error (Textmerge(loLang.C_DATA_ERROR_CANT_PARSE_UNPAIRING_DOUBLE_QUOTES_LOC)) + Endif - lnLastPos = 1 - DIMENSION taPropsAndValues( lnCantComillas / 2, 2 ) + lnLastPos = 1 + Dimension taPropsAndValues( lnCantComillas / 2, 2 ) - *------------------------------------------------------------------------------------- - * IMPORTANTE!! - * ------------ - * SI SE SEPARAN LAS IGUALDADES CON ESPACIOS, ÉSTAS DEJAN DE RECONOCERSE!! (prop = "valor" en vez de prop="valor") - * TENER EN CUENTA AL GENERAR EL TEXTO O AL MODIFICARLO MANUALMENTE AL MERGEAR - *------------------------------------------------------------------------------------- - FOR I = 1 TO lnCantComillas STEP 2 - tnPropsAndValues_Count = tnPropsAndValues_Count + 1 +*------------------------------------------------------------------------------------- +* IMPORTANTE!! +* ------------ +* SI SE SEPARAN LAS IGUALDADES CON ESPACIOS, ÉSTAS DEJAN DE RECONOCERSE!! (prop = "valor" en vez de prop="valor") +* TENER EN CUENTA AL GENERAR EL TEXTO O AL MODIFICARLO MANUALMENTE AL MERGEAR +*------------------------------------------------------------------------------------- + For I = 1 To lnCantComillas Step 2 + tnPropsAndValues_Count = tnPropsAndValues_Count + 1 - * Type="V" Cpid="1252" - * ^ ^ => Posiciones del par de comillas dobles - lnPos1 = AT( '"', lcMetadatos, m.I ) - lnPos2 = AT( '"', lcMetadatos, m.I + 1 ) +* Type="V" Cpid="1252" +* ^ ^ => Posiciones del par de comillas dobles + lnPos1 = At( '"', lcMetadatos, m.I ) + lnPos2 = At( '"', lcMetadatos, m.I + 1 ) - * Type="V" Cpid="1252" - * ^ ^ ^ => LastPos, lnPos1 y lnPos2 - taPropsAndValues(tnPropsAndValues_Count,1) = ALLTRIM( GETWORDNUM( SUBSTR( lcMetadatos, lnLastPos, lnPos1 - lnLastPos ), 1, '=' ) ) - taPropsAndValues(tnPropsAndValues_Count,2) = SUBSTR( lcMetadatos, lnPos1 + 1, lnPos2 - lnPos1 - 1 ) +* Type="V" Cpid="1252" +* ^ ^ ^ => LastPos, lnPos1 y lnPos2 + taPropsAndValues(tnPropsAndValues_Count,1) = Alltrim( Getwordnum( Substr( lcMetadatos, lnLastPos, lnPos1 - lnLastPos ), 1, '=' ) ) + taPropsAndValues(tnPropsAndValues_Count,2) = Substr( lcMetadatos, lnPos1 + 1, lnPos2 - lnPos1 - 1 ) - lnLastPos = lnPos2 + 1 - ENDFOR + lnLastPos = lnPos2 + 1 + Endfor - CATCH TO loEx - loEx.UserValue = loEx.UserValue + TEXTMERGE('I=<>, lcMetadatos="<>", tcLineWithMetadata="<>"') + CR_LF - IF THIS.n_Debug > 0 AND _VFP.STARTMODE = 0 - SET STEP ON - ENDIF + Catch To loEx + loEx.UserValue = loEx.UserValue + Textmerge('I=<>, lcMetadatos="<>", tcLineWithMetadata="<>"') + CR_LF + If This.n_Debug > 0 And _vfp.StartMode = 0 + Set Step On + Endif - THROW + Throw - FINALLY - RELEASE tcLineWithMetadata, taPropsAndValues, tnPropsAndValues_Count, tcLeftTag, tcRightTag ; - , lcMetadatos, I, lcVirtualMeta, lnPos1, lnPos2, lnLastPos, lnCantComillas + Finally + Release tcLineWithMetadata, taPropsAndValues, tnPropsAndValues_Count, tcLeftTag, tcRightTag ; + , lcMetadatos, I, lcVirtualMeta, lnPos1, lnPos2, lnLastPos, lnCantComillas - ENDTRY + Endtry - RETURN - ENDPROC + Return + Endproc - PROCEDURE get_SeparatedLineAndComment - *--------------------------------------------------------------------------------------------------- - * PARÁMETROS: (v=Pasar por valor | @=Pasar por referencia) (!=Obligatorio | ?=Opcional) (IN/OUT) - * tcLine (!@ IN/OUT) Línea a separar del comentario - * tcComment (@? OUT) Comentario - * tlDeepCommentAnalysis (v? IN ) Indica realizar un análisis profundo de comentarios (para detectar casos complejos de código con '&&' embebido) - *--------------------------------------------------------------------------------------------------- - LPARAMETERS tcLine as String, tcComment as String, tlDeepCommentAnalysis as Boolean - LOCAL ln_AT_Cmt + Procedure get_SeparatedLineAndComment +*--------------------------------------------------------------------------------------------------- +* PARÁMETROS: (v=Pasar por valor | @=Pasar por referencia) (!=Obligatorio | ?=Opcional) (IN/OUT) +* tcLine (!@ IN/OUT) Línea a separar del comentario +* tcComment (@? OUT) Comentario +* tlDeepCommentAnalysis (v? IN ) Indica realizar un análisis profundo de comentarios (para detectar casos complejos de código con '&&' embebido) +*--------------------------------------------------------------------------------------------------- + Lparameters tcLine As String, tcComment As String, tlDeepCommentAnalysis As Boolean + Local ln_AT_Cmt tcComment = '' - ln_AT_Cmt = AT( '&'+'&', tcLine) + ln_AT_Cmt = At( '&'+'&', tcLine) - IF ln_AT_Cmt > 0 - IF tlDeepCommentAnalysis THEN - LOCAL laSeparador(3,3), lcSeparadoresIzq, lcSeparadoresDer, lcStr, lnAT_Amp, lnAT1, lnAT2, lnLen, I, X + If ln_AT_Cmt > 0 + If tlDeepCommentAnalysis Then + Local laSeparador(3,3), lcSeparadoresIzq, lcSeparadoresDer, lcStr, lnAT_Amp, lnAT1, lnAT2, lnLen, I, X lcStr = tcLine &&EVL(tcStr, [DEFINE BAR 2 OF OpciónAsub PROMPT "Opción A&]+[&2" &]+[& Comentario Opción A-2]) laSeparador(1,1) = '"' @@ -6956,991 +6968,991 @@ DEFINE CLASS c_conversor_base AS Custom laSeparador(3,3) = 1 lcSeparadoresIzq = laSeparador(1,1) + laSeparador(2,1) + laSeparador(3,1) lcSeparadoresDer = laSeparador(1,2) + laSeparador(2,2) + laSeparador(3,2) - lnLen = LEN(lcStr) + lnLen = Len(lcStr) - *-- Anular subcadenas para luego encontrar comentarios '&&' (y analizar solo si existe al menos un '&&') +*-- Anular subcadenas para luego encontrar comentarios '&&' (y analizar solo si existe al menos un '&&') X = 1 - lnAT1 = AT(laSeparador(m.X,1), lcStr) + lnAT1 = At(laSeparador(m.X,1), lcStr) - *-- Funcionamiento: - *-- La anulación de subcadenas se hace comenzando desde la primer comilla doble ["], y luego se va - *-- cancelando hasta la siguiente. A partir de ahi, se busca carácter a carácter el siguiente separador - *-- izquierdo de cadena ( '"[ ), se busca su pareja derecha y se cancela el texto entre ambos. - *-- La anulación de subcadenas es temporal, solo para determinar la verdadera posición del comentario, - *-- por ejemplo, esto: - *-- DEFINE BAR 2 OF OpciónAsub PROMPT ""+var+'aa'+["bb]+"Opción A&&2" && Comentario Opción A-2 - *-- se convierte temporalmente en esto: - *-- DEFINE BAR 2 OF OpciónAsub PROMPT XX+var+XXXX+XXXXX+XXXXXXXXXXXXX && Comentario Opción A-2 - *-- lo que facilita encontrar el comentario '&&' real. - *-- Si se encuentra algún separador de cadena que no cierre, se genera un error 10 (Syntax Error). - IF lnAT1 > 0 THEN - FOR I = lnAT1+1 TO lnLen - IF m.X > 0 THEN - lnAT2 = AT(laSeparador(m.X,2), lcStr, laSeparador(m.X,3)) +*-- Funcionamiento: +*-- La anulación de subcadenas se hace comenzando desde la primer comilla doble ["], y luego se va +*-- cancelando hasta la siguiente. A partir de ahi, se busca carácter a carácter el siguiente separador +*-- izquierdo de cadena ( '"[ ), se busca su pareja derecha y se cancela el texto entre ambos. +*-- La anulación de subcadenas es temporal, solo para determinar la verdadera posición del comentario, +*-- por ejemplo, esto: +*-- DEFINE BAR 2 OF OpciónAsub PROMPT ""+var+'aa'+["bb]+"Opción A&&2" && Comentario Opción A-2 +*-- se convierte temporalmente en esto: +*-- DEFINE BAR 2 OF OpciónAsub PROMPT XX+var+XXXX+XXXXX+XXXXXXXXXXXXX && Comentario Opción A-2 +*-- lo que facilita encontrar el comentario '&&' real. +*-- Si se encuentra algún separador de cadena que no cierre, se genera un error 10 (Syntax Error). + If lnAT1 > 0 Then + For I = lnAT1+1 To lnLen + If m.X > 0 Then + lnAT2 = At(laSeparador(m.X,2), lcStr, laSeparador(m.X,3)) - IF lnAT2 > 0 THEN - lcStr = STUFF(lcStr, lnAT1, lnAT2-lnAT1+1, REPLICATE('X',lnAT2-lnAT1+1)) - ELSE - ln_AT_Cmt = AT( '&'+'&', lcStr) + If lnAT2 > 0 Then + lcStr = Stuff(lcStr, lnAT1, lnAT2-lnAT1+1, Replicate('X',lnAT2-lnAT1+1)) + Else + ln_AT_Cmt = At( '&'+'&', lcStr) - IF ln_AT_Cmt = 0 OR ln_AT_Cmt < lnAT1 - *-- No tiene comentario '&&' real, o sí lo tiene y además contiene un delimitador de cadena como parte del comentario - EXIT - ELSE - ERROR 'Closing string delimiter <' + laSeparador(m.X,2) + '> not found: ' + tcLine - ENDIF - ENDIF - ENDIF + If ln_AT_Cmt = 0 Or ln_AT_Cmt < lnAT1 +*-- No tiene comentario '&&' real, o sí lo tiene y además contiene un delimitador de cadena como parte del comentario + Exit + Else + Error 'Closing string delimiter <' + laSeparador(m.X,2) + '> not found: ' + tcLine + Endif + Endif + Endif - *-- Verifico si el carácter es un separador de cadenas: '"[ - X = AT( SUBSTR(lcStr, m.I, 1), lcSeparadoresIzq) +*-- Verifico si el carácter es un separador de cadenas: '"[ + X = At( Substr(lcStr, m.I, 1), lcSeparadoresIzq) - IF m.X > 0 THEN - lnAT1 = AT(laSeparador(m.X,1), lcStr) - ENDIF - ENDFOR - ENDIF + If m.X > 0 Then + lnAT1 = At(laSeparador(m.X,1), lcStr) + Endif + Endfor + Endif - ln_AT_Cmt = AT( '&'+'&', lcStr) - ENDIF && tlDeepCommentAnalysis + ln_AT_Cmt = At( '&'+'&', lcStr) + Endif && tlDeepCommentAnalysis - IF ln_AT_Cmt > 0 - tcComment = LTRIM( SUBSTR( tcLine, ln_AT_Cmt + 2 ) ) - tcLine = RTRIM( LEFT( tcLine, ln_AT_Cmt - 1 ), 0, CHR(9), ' ' ) && Quito TABS y espacios - ENDIF + If ln_AT_Cmt > 0 + tcComment = Ltrim( Substr( tcLine, ln_AT_Cmt + 2 ) ) + tcLine = Rtrim( Left( tcLine, ln_AT_Cmt - 1 ), 0, Chr(9), ' ' ) && Quito TABS y espacios + Endif - ENDIF + Endif - RETURN (ln_AT_Cmt > 0) - ENDPROC + Return (ln_AT_Cmt > 0) + Endproc - PROCEDURE get_SeparatedPropAndValue - *-- Devuelve el valor separado de la propiedad. - *-- Si se indican más de 3 parámetros, evalúa el valor completo a través de las líneas de código (valores multi-línea) - *-------------------------------------------------------------------------------------------------------------- - * PARÁMETROS: (v=Pasar por valor | @=Pasar por referencia) (!=Obligatorio | ?=Opcional) (IN/OUT) - * tcAsignacion (v! IN ) Asignación completa con variable, igualdad y valor - * tcPropName (@! OUT) Nombre de la variable - * tcValue (@? OUT) Valor - * toClase (v! IN ) - * taCodeLines (@! IN ) Líneas de código a analizar - * tnCodeLines (v! IN ) Cantidad de líneas de código - * I (@! IN/OUT) Línea actual - *-------------------------------------------------------------------------------------------------------------- - LPARAMETERS tcAsignacion, tcPropName, tcValue, toClase, taCodeLines, tnCodeLines, I - LOCAL ln_AT_Cmt - STORE '' TO tcPropName, tcValue + Procedure get_SeparatedPropAndValue +*-- Devuelve el valor separado de la propiedad. +*-- Si se indican más de 3 parámetros, evalúa el valor completo a través de las líneas de código (valores multi-línea) +*-------------------------------------------------------------------------------------------------------------- +* PARÁMETROS: (v=Pasar por valor | @=Pasar por referencia) (!=Obligatorio | ?=Opcional) (IN/OUT) +* tcAsignacion (v! IN ) Asignación completa con variable, igualdad y valor +* tcPropName (@! OUT) Nombre de la variable +* tcValue (@? OUT) Valor +* toClase (v! IN ) +* taCodeLines (@! IN ) Líneas de código a analizar +* tnCodeLines (v! IN ) Cantidad de líneas de código +* I (@! IN/OUT) Línea actual +*-------------------------------------------------------------------------------------------------------------- + Lparameters tcAsignacion, tcPropName, tcValue, toClase, taCodeLines, tnCodeLines, I + Local ln_AT_Cmt + Store '' To tcPropName, tcValue - *-- EVALUAR UNA ASIGNACIÓN ESPECÍFICA INLINE - IF '=' $ tcAsignacion - ln_AT_Cmt = AT( '=', tcAsignacion) - tcPropName = ALLTRIM( LEFT( tcAsignacion, ln_AT_Cmt - 2 ), 0, ' ', CHR(9) ) && Quito espacios y TABS - tcValue = LTRIM( SUBSTR( tcAsignacion, ln_AT_Cmt + 2 ) ) +*-- EVALUAR UNA ASIGNACIÓN ESPECÍFICA INLINE + If '=' $ tcAsignacion + ln_AT_Cmt = At( '=', tcAsignacion) + tcPropName = Alltrim( Left( tcAsignacion, ln_AT_Cmt - 2 ), 0, ' ', Chr(9) ) && Quito espacios y TABS + tcValue = Ltrim( Substr( tcAsignacion, ln_AT_Cmt + 2 ) ) - IF PCOUNT() > 3 - *-- EVALUAR UNA ASIGNACIÓN QUE PUEDE SER MULTILÍNEA (memberdata, fb2p_value, etc) - WITH THIS AS c_conversor_base OF 'FOXBIN2PRG.PRG' - DO CASE - CASE .analyzeAssignmentOf_TAG( @tcPropName, @tcValue, @taCodeLines, tnCodeLines, @m.I ; - , C_FB2P_VALUE_I, C_FB2P_VALUE_F, C_LEN_FB2P_VALUE_I, C_LEN_FB2P_VALUE_F ) - *-- FB2P_VALUE + If Pcount() > 3 +*-- EVALUAR UNA ASIGNACIÓN QUE PUEDE SER MULTILÍNEA (memberdata, fb2p_value, etc) + With This As c_conversor_base Of 'FOXBIN2PRG.PRG' + Do Case + Case .analyzeAssignmentOf_TAG( @tcPropName, @tcValue, @taCodeLines, tnCodeLines, @m.I ; + , C_FB2P_VALUE_I, C_FB2P_VALUE_F, C_LEN_FB2P_VALUE_I, C_LEN_FB2P_VALUE_F ) +*-- FB2P_VALUE - CASE .analyzeAssignmentOf_TAG( @tcPropName, @tcValue, @taCodeLines, tnCodeLines, @m.I ; - , C_MEMBERDATA_I, C_MEMBERDATA_F, C_LEN_MEMBERDATA_I, C_LEN_MEMBERDATA_F ) - *-- MEMBERDATA + Case .analyzeAssignmentOf_TAG( @tcPropName, @tcValue, @taCodeLines, tnCodeLines, @m.I ; + , C_MEMBERDATA_I, C_MEMBERDATA_F, C_LEN_MEMBERDATA_I, C_LEN_MEMBERDATA_F ) +*-- MEMBERDATA - OTHERWISE - *-- Propiedad normal - .denormalizePropertyValue( @tcPropName, @tcValue, '' ) + Otherwise +*-- Propiedad normal + .denormalizePropertyValue( @tcPropName, @tcValue, '' ) - ENDCASE - ENDWITH && THIS - ENDIF - ENDIF + Endcase + Endwith && THIS + Endif + Endif - RELEASE tcAsignacion, tcPropName, tcValue, toClase, taCodeLines, tnCodeLines, I, ln_AT_Cmt - RETURN - ENDPROC + Release tcAsignacion, tcPropName, tcValue, toClase, taCodeLines, tnCodeLines, I, ln_AT_Cmt + Return + Endproc - PROCEDURE get_ValueFromNullTerminatedValue - LPARAMETERS tcNullTerminatedValue - LOCAL lcValue, lnNullPos - lnNullPos = AT(CHR(0), tcNullTerminatedValue ) - IF lnNullPos = 0 - lcValue = CHRTRAN( tcNullTerminatedValue, ['], ["] ) - ELSE - lcValue = CHRTRAN( LEFT( tcNullTerminatedValue, lnNullPos - 1 ), ['], ["] ) - ENDIF - lcValue = THIS.encode_SpecialCodes_CR_LF(lcValue) - RELEASE tcNullTerminatedValue, lnNullPos - RETURN lcValue - ENDPROC + Procedure get_ValueFromNullTerminatedValue + Lparameters tcNullTerminatedValue + Local lcValue, lnNullPos + lnNullPos = At(Chr(0), tcNullTerminatedValue ) + If lnNullPos = 0 + lcValue = Chrtran( tcNullTerminatedValue, ['], ["] ) + Else + lcValue = Chrtran( Left( tcNullTerminatedValue, lnNullPos - 1 ), ['], ["] ) + Endif + lcValue = This.encode_SpecialCodes_CR_LF(lcValue) + Release tcNullTerminatedValue, lnNullPos + Return lcValue + Endproc - PROCEDURE identifyCodeBlocks - LPARAMETERS taCodeLines, tnCodeLines, taLineasExclusion, tnBloquesExclusion, toModulo - ENDPROC + Procedure identifyCodeBlocks + Lparameters taCodeLines, tnCodeLines, taLineasExclusion, tnBloquesExclusion, toModulo + Endproc - PROCEDURE identifyExclusionBlocks - LPARAMETERS taCodeLines, tnCodeLines, ta_ID_Bloques, taLineasExclusion, tnBloquesExclusion, taBloquesExclusion - * LOS BLOQUES DE EXCLUSIÓN SON AQUELLOS QUE TIENEN TEXT/ENDTEXT OF #IF/#ENDIF Y SE USAN PARA NO BUSCAR - * INSTRUCCIONES COMO "DEFINE CLASS" O "PROCEDURE" EN LOS MISMOS. - *-------------------------------------------------------------------------------------------------------------- - * PARÁMETROS: (v=Pasar por valor | @=Pasar por referencia) (!=Obligatorio | ?=Opcional) (IN/OUT) - * taCodeLines (!@ IN ) El array con las líneas del código de texto donde buscar - * tnCodeLines (@? IN ) Cantidad de líneas de código - * ta_ID_Bloques (@? IN ) Array de pares de identificadores (2 cols). Ej: '#IF .F.','#ENDI' ; 'TEXT','ENDTEXT' ; etc - * taLineasExclusion (@? OUT) Array unidimensional con un .T. o .F. según la línea sea de exclusión o no - * tnBloquesExclusion (@? OUT) Cantidad de bloques de exclusión - *-------------------------------------------------------------------------------------------------------------- - EXTERNAL ARRAY ta_ID_Bloques, taLineasExclusion + Procedure identifyExclusionBlocks + Lparameters taCodeLines, tnCodeLines, ta_ID_Bloques, taLineasExclusion, tnBloquesExclusion, taBloquesExclusion +* LOS BLOQUES DE EXCLUSIÓN SON AQUELLOS QUE TIENEN TEXT/ENDTEXT OF #IF/#ENDIF Y SE USAN PARA NO BUSCAR +* INSTRUCCIONES COMO "DEFINE CLASS" O "PROCEDURE" EN LOS MISMOS. +*-------------------------------------------------------------------------------------------------------------- +* PARÁMETROS: (v=Pasar por valor | @=Pasar por referencia) (!=Obligatorio | ?=Opcional) (IN/OUT) +* taCodeLines (!@ IN ) El array con las líneas del código de texto donde buscar +* tnCodeLines (@? IN ) Cantidad de líneas de código +* ta_ID_Bloques (@? IN ) Array de pares de identificadores (2 cols). Ej: '#IF .F.','#ENDI' ; 'TEXT','ENDTEXT' ; etc +* taLineasExclusion (@? OUT) Array unidimensional con un .T. o .F. según la línea sea de exclusión o no +* tnBloquesExclusion (@? OUT) Cantidad de bloques de exclusión +*-------------------------------------------------------------------------------------------------------------- + External Array ta_ID_Bloques, taLineasExclusion - TRY - LOCAL lnBloques, I, X, lnPrimerID, lnLen_IDFinBQ, lnID_Bloques_Count, lcWord, lnAnidamientos, lcLine, lcPrevLine ; - , loLang as CL_LANG OF 'FOXBIN2PRG.PRG' - loLang = _SCREEN.o_FoxBin2Prg_Lang - DIMENSION taLineasExclusion(tnCodeLines), taBloquesExclusion(1,2) - STORE 0 TO tnBloquesExclusion, lnPrimerID, I, X + Try + Local lnBloques, I, X, lnPrimerID, lnLen_IDFinBQ, lnID_Bloques_Count, lcWord, lnAnidamientos, lcLine, lcPrevLine ; + , loLang As CL_LANG Of 'FOXBIN2PRG.PRG' + loLang = _Screen.o_FoxBin2Prg_Lang + Dimension taLineasExclusion(tnCodeLines), taBloquesExclusion(1,2) + Store 0 To tnBloquesExclusion, lnPrimerID, I, X - IF tnCodeLines > 1 - IF EMPTY(ta_ID_Bloques) - DIMENSION ta_ID_Bloques(2,4) - ta_ID_Bloques(1,1) = '#IF' - ta_ID_Bloques(1,2) = '#ENDI' - ta_ID_Bloques(1,3) = LEN( ta_ID_Bloques(1,1) ) - ta_ID_Bloques(1,4) = LEN( ta_ID_Bloques(1,2) ) - ta_ID_Bloques(2,1) = 'TEXT' - ta_ID_Bloques(2,2) = 'ENDT' - ta_ID_Bloques(2,3) = LEN( ta_ID_Bloques(2,1) ) - ta_ID_Bloques(2,4) = LEN( ta_ID_Bloques(2,2) ) - lnID_Bloques_Count = ALEN( ta_ID_Bloques, 1 ) - ENDIF + If tnCodeLines > 1 + If Empty(ta_ID_Bloques) + Dimension ta_ID_Bloques(2,4) + ta_ID_Bloques(1,1) = '#IF' + ta_ID_Bloques(1,2) = '#ENDI' + ta_ID_Bloques(1,3) = Len( ta_ID_Bloques(1,1) ) + ta_ID_Bloques(1,4) = Len( ta_ID_Bloques(1,2) ) + ta_ID_Bloques(2,1) = 'TEXT' + ta_ID_Bloques(2,2) = 'ENDT' + ta_ID_Bloques(2,3) = Len( ta_ID_Bloques(2,1) ) + ta_ID_Bloques(2,4) = Len( ta_ID_Bloques(2,2) ) + lnID_Bloques_Count = Alen( ta_ID_Bloques, 1 ) + Endif - *-- Búsqueda del ID de inicio de bloque - WITH THIS AS c_conversor_base OF 'FOXBIN2PRG.PRG' - FOR I = 1 TO tnCodeLines - * Reduzco los espacios. Ej: '#IF .F. && cmt' ==> '#IF .F.&&cmt' - *lcLine = LTRIM( STRTRAN( STRTRAN( CHRTRAN( taCodeLines(m.I), CHR(9), ' ' ), ' ', ' ' ), ' ', ' ' ) ) - lcLine = LTRIM( taCodeLines(m.I), 0, CHR(9), ' ' ) +*-- Búsqueda del ID de inicio de bloque + With This As c_conversor_base Of 'FOXBIN2PRG.PRG' + For I = 1 To tnCodeLines +* Reduzco los espacios. Ej: '#IF .F. && cmt' ==> '#IF .F.&&cmt' +*lcLine = LTRIM( STRTRAN( STRTRAN( CHRTRAN( taCodeLines(m.I), CHR(9), ' ' ), ' ', ' ' ), ' ', ' ' ) ) + lcLine = Ltrim( taCodeLines(m.I), 0, Chr(9), ' ' ) - IF .lineIsOnlyCommentAndNoMetadata( @lcLine ) - *-- Optimización: Excluyo las líneas que solo son comentarios - taLineasExclusion(m.I) = .T. - *-- - LOOP - ENDIF + If .lineIsOnlyCommentAndNoMetadata( @lcLine ) +*-- Optimización: Excluyo las líneas que solo son comentarios + taLineasExclusion(m.I) = .T. +*-- + Loop + Endif - lcLine = UPPER( LEFT( lcLine,1 ) ) + UPPER( LTRIM( SUBSTR( lcLine, 2 ) ) ) - lnPrimerID = 0 + lcLine = Upper( Left( lcLine,1 ) ) + Upper( Ltrim( Substr( lcLine, 2 ) ) ) + lnPrimerID = 0 - FOR X = 1 TO lnID_Bloques_Count - lnLen_IDFinBQ = LEN( ta_ID_Bloques(m.X,2) ) - IF .isIndicatedToken( @lcLine, @ta_ID_Bloques, lnLen_IDFinBQ, m.X, 1 ) ; - AND NOT .currentLineIsPreviousLineContinuation( @taCodeLines, m.I ) - lnPrimerID = m.X - lnAnidamientos = 1 - EXIT - ENDIF - ENDFOR + For X = 1 To lnID_Bloques_Count + lnLen_IDFinBQ = Len( ta_ID_Bloques(m.X,2) ) + If .isIndicatedToken( @lcLine, @ta_ID_Bloques, lnLen_IDFinBQ, m.X, 1 ) ; + AND Not .currentLineIsPreviousLineContinuation( @taCodeLines, m.I ) + lnPrimerID = m.X + lnAnidamientos = 1 + Exit + Endif + Endfor - IF lnPrimerID > 0 && Se ha identificado un ID de bloque excluyente - tnBloquesExclusion = tnBloquesExclusion + 1 - DIMENSION taBloquesExclusion(tnBloquesExclusion,2) - taBloquesExclusion(tnBloquesExclusion,1) = m.I - taLineasExclusion(m.I) = .T. - - * Búsqueda del ID de fin de bloque - FOR I = m.I + 1 TO tnCodeLines - * Reduzco los espacios. Ej: '#IF .F. && cmt' ==> '#IF .F.&&cmt' - *lcLine = LTRIM( STRTRAN( STRTRAN( CHRTRAN( taCodeLines(m.I), CHR(9), ' ' ), ' ', ' ' ), ' ', ' ' ) ) - *lcLine = LTRIM( CHRTRAN( taCodeLines(m.I), CHR(9), ' ' ) ) - lcLine = LTRIM( taCodeLines(m.I), 0, CHR(9), ' ' ) + If lnPrimerID > 0 && Se ha identificado un ID de bloque excluyente + tnBloquesExclusion = tnBloquesExclusion + 1 + Dimension taBloquesExclusion(tnBloquesExclusion,2) + taBloquesExclusion(tnBloquesExclusion,1) = m.I taLineasExclusion(m.I) = .T. - IF .lineIsOnlyCommentAndNoMetadata( @lcLine ) - LOOP - ENDIF +* Búsqueda del ID de fin de bloque + For I = m.I + 1 To tnCodeLines +* Reduzco los espacios. Ej: '#IF .F. && cmt' ==> '#IF .F.&&cmt' +*lcLine = LTRIM( STRTRAN( STRTRAN( CHRTRAN( taCodeLines(m.I), CHR(9), ' ' ), ' ', ' ' ), ' ', ' ' ) ) +*lcLine = LTRIM( CHRTRAN( taCodeLines(m.I), CHR(9), ' ' ) ) + lcLine = Ltrim( taCodeLines(m.I), 0, Chr(9), ' ' ) + taLineasExclusion(m.I) = .T. - lcLine = UPPER( LEFT( lcLine,1 ) ) + UPPER( LTRIM( SUBSTR( lcLine, 2 ) ) ) + If .lineIsOnlyCommentAndNoMetadata( @lcLine ) + Loop + Endif - DO CASE - CASE lnPrimerID = 1 AND .isIndicatedToken( @lcLine, @ta_ID_Bloques, 0, m.X, 1 ) ; - AND NOT .currentLineIsPreviousLineContinuation( @taCodeLines, m.I ) - *-- Busca el primer marcador (#IF) NOTA: No busco [TEXT] porque no se pueden anidar. - lnAnidamientos = lnAnidamientos + 1 + lcLine = Upper( Left( lcLine,1 ) ) + Upper( Ltrim( Substr( lcLine, 2 ) ) ) - CASE .isIndicatedToken( @lcLine, @ta_ID_Bloques, 0, m.X, 2 ) - *-- Busca el segundo marcador (#ENDIF o ENDTEXT) - lnAnidamientos = lnAnidamientos - 1 + Do Case + Case lnPrimerID = 1 And .isIndicatedToken( @lcLine, @ta_ID_Bloques, 0, m.X, 1 ) ; + AND Not .currentLineIsPreviousLineContinuation( @taCodeLines, m.I ) +*-- Busca el primer marcador (#IF) NOTA: No busco [TEXT] porque no se pueden anidar. + lnAnidamientos = lnAnidamientos + 1 - IF lnAnidamientos = 0 - taBloquesExclusion(tnBloquesExclusion,2) = m.I - EXIT - ENDIF - ENDCASE - ENDFOR + Case .isIndicatedToken( @lcLine, @ta_ID_Bloques, 0, m.X, 2 ) +*-- Busca el segundo marcador (#ENDIF o ENDTEXT) + lnAnidamientos = lnAnidamientos - 1 - *-- Validación - IF EMPTY(taBloquesExclusion(tnBloquesExclusion,2)) - *ERROR 'No se ha encontrado el marcador de fin [' + ta_ID_Bloques(lnPrimerID,2) ; - + '] que cierra al marcador de inicio [' + ta_ID_Bloques(lnPrimerID,1) ; - + '] de la línea ' + TRANSFORM(taBloquesExclusion(tnBloquesExclusion,1)) - .n_Methods_LineNo = taBloquesExclusion(tnBloquesExclusion,1) - ERROR (TEXTMERGE(loLang.C_END_MARKER_NOT_FOUND_LOC)) - ENDIF - ENDIF - ENDFOR - ENDWITH && THIS - ENDIF + If lnAnidamientos = 0 + taBloquesExclusion(tnBloquesExclusion,2) = m.I + Exit + Endif + Endcase + Endfor - CATCH TO loEx - IF THIS.n_Debug > 0 AND _VFP.STARTMODE = 0 - SET STEP ON - ENDIF +*-- Validación + If Empty(taBloquesExclusion(tnBloquesExclusion,2)) +*ERROR 'No se ha encontrado el marcador de fin [' + ta_ID_Bloques(lnPrimerID,2) ; ++ '] que cierra al marcador de inicio [' + ta_ID_Bloques(lnPrimerID,1) ; ++ '] de la línea ' + TRANSFORM(taBloquesExclusion(tnBloquesExclusion,1)) + .n_Methods_LineNo = taBloquesExclusion(tnBloquesExclusion,1) + Error (Textmerge(loLang.C_END_MARKER_NOT_FOUND_LOC)) + Endif + Endif + Endfor + Endwith && THIS + Endif - THROW + Catch To loEx + If This.n_Debug > 0 And _vfp.StartMode = 0 + Set Step On + Endif - FINALLY - RELEASE taCodeLines, tnCodeLines, ta_ID_Bloques, taLineasExclusion, tnBloquesExclusion, taBloquesExclusion, loLang ; - , lnBloques, I, X, lnPrimerID, lnID_Bloques_Count, lcWord, lnAnidamientos, lcLine, lcPrevLine - ENDTRY + Throw - RETURN - ENDPROC + Finally + Release taCodeLines, tnCodeLines, ta_ID_Bloques, taLineasExclusion, tnBloquesExclusion, taBloquesExclusion, loLang ; + , lnBloques, I, X, lnPrimerID, lnID_Bloques_Count, lcWord, lnAnidamientos, lcLine, lcPrevLine + Endtry + + Return + Endproc - PROCEDURE excludedLine - LPARAMETERS tn_Linea, tnBloquesExclusion, taLineasExclusion + Procedure excludedLine + Lparameters tn_Linea, tnBloquesExclusion, taLineasExclusion - RETURN taLineasExclusion(tn_Linea) - ENDPROC + Return taLineasExclusion(tn_Linea) + Endproc - PROCEDURE lineIsOnlyCommentAndNoMetadata - *--------------------------------------------------------------------------------------------------- - * PARÁMETROS: (v=Pasar por valor | @=Pasar por referencia) (!=Obligatorio | ?=Opcional) (IN/OUT) - * tcLine (!@ IN/OUT) Línea a separar del comentario - * tcComment (@? OUT) Comentario - * tlDoNotSeparateLineAndComment (v? IN ) Indica o separar la línea de código del comentario - * tlDeepCommentAnalysis (v? IN ) Indica realizar un análisis profundo de comentarios (para detectar casos complejos de código con '&&' embebido) - *--------------------------------------------------------------------------------------------------- - * NOTA: Recordar que esta función suele usarse junto a Set_Line(), que quita TABS y espacios a la izquierda. - *--------------------------------------------------------------------------------------------------- - LPARAMETERS tcLine as String, tcComment as String, tlDoNotSeparateLineAndComment as Boolean, tlDeepCommentAnalysis as Boolean - LOCAL lllineIsOnlyCommentAndNoMetadata, ln_AT_Cmt + Procedure lineIsOnlyCommentAndNoMetadata +*--------------------------------------------------------------------------------------------------- +* PARÁMETROS: (v=Pasar por valor | @=Pasar por referencia) (!=Obligatorio | ?=Opcional) (IN/OUT) +* tcLine (!@ IN/OUT) Línea a separar del comentario +* tcComment (@? OUT) Comentario +* tlDoNotSeparateLineAndComment (v? IN ) Indica o separar la línea de código del comentario +* tlDeepCommentAnalysis (v? IN ) Indica realizar un análisis profundo de comentarios (para detectar casos complejos de código con '&&' embebido) +*--------------------------------------------------------------------------------------------------- +* NOTA: Recordar que esta función suele usarse junto a Set_Line(), que quita TABS y espacios a la izquierda. +*--------------------------------------------------------------------------------------------------- + Lparameters tcLine As String, tcComment As String, tlDoNotSeparateLineAndComment As Boolean, tlDeepCommentAnalysis As Boolean + Local lllineIsOnlyCommentAndNoMetadata, ln_AT_Cmt - WITH THIS AS c_conversor_base OF 'FOXBIN2PRG.PRG' - IF tlDoNotSeparateLineAndComment + With This As c_conversor_base Of 'FOXBIN2PRG.PRG' + If tlDoNotSeparateLineAndComment tcComment = '' - ELSE + Else .get_SeparatedLineAndComment( @tcLine, @tcComment, tlDeepCommentAnalysis ) - ENDIF + Endif - DO CASE - CASE LEFT(tcLine,2) == '*<' - tcComment = tcLine + Do Case + Case Left(tcLine,2) == '*<' + tcComment = tcLine - CASE EMPTY(tcLine) OR LEFT(tcLine, 1) == '*' ; - OR UPPER(LEFT(tcLine + ' ', 5)) == 'NOTE ' ; && Vacía o Comentarios - AND NOT UPPER(LEFT(tcLine + ' ', 6)) == 'NOTE =' && Excluir asignaciones - * - lllineIsOnlyCommentAndNoMetadata = .T. + Case Empty(tcLine) Or Left(tcLine, 1) == '*' ; + OR Upper(Left(tcLine + ' ', 5)) == 'NOTE ' ; && Vacía o Comentarios + And Not Upper(Left(tcLine + ' ', 6)) == 'NOTE =' && Excluir asignaciones +* + lllineIsOnlyCommentAndNoMetadata = .T. - ENDCASE - ENDWITH + Endcase + Endwith - RELEASE tcLine, tcComment, ln_AT_Cmt - RETURN lllineIsOnlyCommentAndNoMetadata - ENDPROC + Release tcLine, tcComment, ln_AT_Cmt + Return lllineIsOnlyCommentAndNoMetadata + Endproc - PROCEDURE loadModule - *--------------------------------------------------------------------------------------------------- - * PARÁMETROS: (v=Pasar por valor | @=Pasar por referencia) (!=Obligatorio | ?=Opcional) (IN/OUT) - * toModulo (!@ OUT) Objeto generado de clase correspondiente con la información leida del texto - * toEx (!@ OUT) Objeto con información del error - * toFoxBin2Prg (!@ IN ) Referencia al objeto principal - *--------------------------------------------------------------------------------------------------- - LPARAMETERS toModulo, toEx AS EXCEPTION, toFoxBin2Prg - #IF .F. - LOCAL toFoxBin2Prg AS c_foxbin2prg OF 'FOXBIN2PRG.PRG' - #ENDIF - *LOCAL loLang as CL_LANG OF 'FOXBIN2PRG.PRG' - *loLang = _SCREEN.o_FoxBin2Prg_Lang - *THIS.writeLog( C_TAB + loLang.C_CONVERTING_FILE_LOC + ' ' + THIS.c_OutputFile + '...' ) - *RELEASE loLang - RETURN - ENDPROC + Procedure loadModule +*--------------------------------------------------------------------------------------------------- +* PARÁMETROS: (v=Pasar por valor | @=Pasar por referencia) (!=Obligatorio | ?=Opcional) (IN/OUT) +* toModulo (!@ OUT) Objeto generado de clase correspondiente con la información leida del texto +* toEx (!@ OUT) Objeto con información del error +* toFoxBin2Prg (!@ IN ) Referencia al objeto principal +*--------------------------------------------------------------------------------------------------- + Lparameters toModulo, toEx As Exception, toFoxBin2Prg + #If .F. + Local toFoxBin2Prg As c_foxbin2prg Of 'FOXBIN2PRG.PRG' + #Endif +*LOCAL loLang as CL_LANG OF 'FOXBIN2PRG.PRG' +*loLang = _SCREEN.o_FoxBin2Prg_Lang +*THIS.writeLog( C_TAB + loLang.C_CONVERTING_FILE_LOC + ' ' + THIS.c_OutputFile + '...' ) +*RELEASE loLang + Return + Endproc - PROCEDURE normalizeAssignment - LPARAMETERS tcAsignacion, tcComentario - LOCAL lcPropName, lcValor, lnCodError, lcExpNormalizada, lnPos + Procedure normalizeAssignment + Lparameters tcAsignacion, tcComentario + Local lcPropName, lcValor, lnCodError, lcExpNormalizada, lnPos - WITH THIS AS c_conversor_base OF 'FOXBIN2PRG.PRG' + With This As c_conversor_base Of 'FOXBIN2PRG.PRG' .get_SeparatedPropAndValue( @tcAsignacion, @lcPropName, @lcValor ) tcComentario = '' .normalizePropertyValue( @lcPropName, @lcValor, @tcComentario ) tcAsignacion = lcPropName + ' = ' + lcValor - ENDWITH + Endwith - RELEASE tcComentario, lcPropName, lcValor, lnCodError, lcExpNormalizada, lnPos - RETURN tcAsignacion - ENDPROC + Release tcComentario, lcPropName, lcValor, lnCodError, lcExpNormalizada, lnPos + Return tcAsignacion + Endproc - PROCEDURE normalizePropertyValue - *-- Este método se ejecuta cuando se genera el tx2 desde el binario - LPARAMETERS tcProp, tcValue, tcComentario - LOCAL lcValue, I + Procedure normalizePropertyValue +*-- Este método se ejecuta cuando se genera el tx2 desde el binario + Lparameters tcProp, tcValue, tcComentario + Local lcValue, I tcComentario = '' - *-- Limpieza de caracteres sin uso - *IF INLIST(tcValue, '..\', '..\..\' ) THEN - * MESSAGEBOX( 'Encontrado valor "' + tcValue + '" en propiedad "' + tcProp, 4096, PROGRAM() ) - * tcValue = '' - *ENDIF +*-- Limpieza de caracteres sin uso +*IF INLIST(tcValue, '..\', '..\..\' ) THEN +* MESSAGEBOX( 'Encontrado valor "' + tcValue + '" en propiedad "' + tcProp, 4096, PROGRAM() ) +* tcValue = '' +*ENDIF - *-- Ajustes de algunos casos especiales - DO CASE - CASE tcProp == '_memberdata' - lcValue = '' +*-- Ajustes de algunos casos especiales + Do Case + Case tcProp == '_memberdata' + lcValue = '' - FOR I = 1 TO OCCURS( '/>', tcValue ) - *TEXT TO lcValue TEXTMERGE ADDITIVE NOSHOW FLAGS 1+2 PRETEXT 1+2 - * <<>> <', m.I, 1+4 ), CR_LF, ' ' )>> - *ENDTEXT - lcValue = lcValue + CHR(13) + CHR(10) + CHR(9) + CHR(9) + CHRTRAN( STREXTRACT( tcValue, '', m.I, 1+4 ), CR_LF, ' ' ) - ENDFOR + For I = 1 To Occurs( '/>', tcValue ) +*TEXT TO lcValue TEXTMERGE ADDITIVE NOSHOW FLAGS 1+2 PRETEXT 1+2 +* <<>> <', m.I, 1+4 ), CR_LF, ' ' )>> +*ENDTEXT + lcValue = lcValue + Chr(13) + Chr(10) + Chr(9) + Chr(9) + Chrtran( Strextract( tcValue, '', m.I, 1+4 ), CR_LF, ' ' ) + Endfor - TEXT TO tcValue TEXTMERGE NOSHOW FLAGS 1 PRETEXT 1+2 + TEXT TO tcValue TEXTMERGE NOSHOW FLAGS 1 PRETEXT 1+2 <> <<>> - ENDTEXT - - CASE LEFT( tcValue, C_LEN_FB2P_VALUE_I ) == C_FB2P_VALUE_I - *-- Valor especial Fox con cabecera CHR(1): Debo quitarla y normalizar el valor - tcValue = C_FB2P_VALUE_I ; - + STRTRAN( STRTRAN( STRTRAN( STRTRAN( ; - STREXTRACT( tcValue, C_FB2P_VALUE_I, C_FB2P_VALUE_F, 1, 1 ) ; - , CR_LF, ' +10;' ), C_CR, ' ' ), C_LF, ' ' ), ' +10;', CR_LF ) ; - + C_FB2P_VALUE_F - - - ENDCASE - - RELEASE tcProp, lcValue, I, tcComentario - RETURN tcValue - ENDPROC - + ENDTEXT + + Case Left( tcValue, C_LEN_FB2P_VALUE_I ) == C_FB2P_VALUE_I +*-- Valor especial Fox con cabecera CHR(1): Debo quitarla y normalizar el valor + tcValue = C_FB2P_VALUE_I ; + + Strtran( Strtran( Strtran( Strtran( ; + STREXTRACT( tcValue, C_FB2P_VALUE_I, C_FB2P_VALUE_F, 1, 1 ) ; + , CR_LF, ' +10;' ), C_CR, ' ' ), C_LF, ' ' ), ' +10;', CR_LF ) ; + + C_FB2P_VALUE_F + + + Endcase + + Release tcProp, lcValue, I, tcComentario + Return tcValue + Endproc + - PROCEDURE normalizeXMLValue - LPARAMETERS tcValor - *-- NORMALIZA EL TEXTO INDICADO, COMPRIMIENDO LOS SÍMBOLOS XML ESPECIALES. - tcValor = STRTRAN(tcValor, CHR(38), CHR(38) + 'amp;') && reemplaza & por & && - tcValor = STRTRAN(tcValor, CHR(39), CHR(38) + 'apos;') && reemplaza ' por ' && - tcValor = STRTRAN(tcValor, CHR(34), CHR(38) + 'quot;') && reemplaza " por " && - tcValor = STRTRAN(tcValor, '<', CHR(38) + 'lt;') && reemplaza < por < && - tcValor = STRTRAN(tcValor, '>', CHR(38) + 'gt;') && reemplaza > por > && - tcValor = STRTRAN(tcValor, CHR(13)+CHR(10), CHR(10)) && reeemplaza CR+LF por LF - tcValor = CHRTRAN(tcValor, CHR(13), CHR(10)) && reemplaza CR por LF + Procedure normalizeXMLValue + Lparameters tcValor +*-- NORMALIZA EL TEXTO INDICADO, COMPRIMIENDO LOS SÍMBOLOS XML ESPECIALES. + tcValor = Strtran(tcValor, Chr(38), Chr(38) + 'amp;') && reemplaza & por & && + tcValor = Strtran(tcValor, Chr(39), Chr(38) + 'apos;') && reemplaza ' por ' && + tcValor = Strtran(tcValor, Chr(34), Chr(38) + 'quot;') && reemplaza " por " && + tcValor = Strtran(tcValor, '<', Chr(38) + 'lt;') && reemplaza < por < && + tcValor = Strtran(tcValor, '>', Chr(38) + 'gt;') && reemplaza > por > && + tcValor = Strtran(tcValor, Chr(13)+Chr(10), Chr(10)) && reeemplaza CR+LF por LF + tcValor = Chrtran(tcValor, Chr(13), Chr(10)) && reemplaza CR por LF - RETURN tcValor - ENDPROC + Return tcValor + Endproc - FUNCTION rowTimeStamp(ltDateTime) - * Generate a FoxPro 3.0-style row timestamp - *-- CONVIERTE UN DATO TIPO DATETIME EN TIMESTAMP NUMERICO USADO POR LOS ARCHIVOS SCX/VCX/etc. - LOCAL lcTimeValue, tnTimeStamp + Function rowTimeStamp(ltDateTime) +* Generate a FoxPro 3.0-style row timestamp +*-- CONVIERTE UN DATO TIPO DATETIME EN TIMESTAMP NUMERICO USADO POR LOS ARCHIVOS SCX/VCX/etc. + Local lcTimeValue, tnTimeStamp - TRY - IF EMPTY(ltDateTime) - tnTimeStamp = 0 - EXIT - ENDIF + Try + If Empty(ltDateTime) + tnTimeStamp = 0 + Exit + Endif - IF VARTYPE(m.ltDateTime) <> 'T' - m.ltDateTime = DATETIME() - ENDIF + If Vartype(m.ltDateTime) <> 'T' + m.ltDateTime = Datetime() + Endif - tnTimeStamp = ( YEAR(m.ltDateTime) - 1980) * 2^25 ; - + MONTH(m.ltDateTime) * 2^21 ; - + DAY(m.ltDateTime) * 2^16 ; - + HOUR(m.ltDateTime) * 2^11 ; - + MINUTE(m.ltDateTime) * 2^5 ; - + SEC(m.ltDateTime) - ENDTRY + tnTimeStamp = ( Year(m.ltDateTime) - 1980) * 2^25 ; + + Month(m.ltDateTime) * 2^21 ; + + Day(m.ltDateTime) * 2^16 ; + + Hour(m.ltDateTime) * 2^11 ; + + Minute(m.ltDateTime) * 2^5 ; + + Sec(m.ltDateTime) + Endtry - RETURN INT(tnTimeStamp) - ENDFUNC + Return Int(tnTimeStamp) + Endfunc - PROCEDURE set_UserValue - LPARAMETERS toEx as Exception - ENDPROC + Procedure set_UserValue + Lparameters toEx As Exception + Endproc - PROCEDURE sortPropsAndValues_SetAndGetSCXPropNames - *-------------------------------------------------------------------------------------------------------------- - * PARÁMETROS: (v=Pasar por valor | @=Pasar por referencia) (!=Obligatorio | ?=Opcional) (IN/OUT) - * tcOperation (v! IN ) Operación a realizar ("SETNAME" o "GETNAME") - * tcPropName (v! IN ) Nombre de la propiedad - *-------------------------------------------------------------------------------------------------------------- - LPARAMETERS tcOperation, tcPropName + Procedure sortPropsAndValues_SetAndGetSCXPropNames +*-------------------------------------------------------------------------------------------------------------- +* PARÁMETROS: (v=Pasar por valor | @=Pasar por referencia) (!=Obligatorio | ?=Opcional) (IN/OUT) +* tcOperation (v! IN ) Operación a realizar ("SETNAME" o "GETNAME") +* tcPropName (v! IN ) Nombre de la propiedad +*-------------------------------------------------------------------------------------------------------------- + Lparameters tcOperation, tcPropName - TRY - LOCAL lcPropName, lcClass, lnPos ; - , loEx AS EXCEPTION ; - , loLang as CL_LANG OF 'FOXBIN2PRG.PRG' - loLang = _SCREEN.o_FoxBin2Prg_Lang - lcPropName = tcPropName - tcOperation = UPPER(EVL(tcOperation,'')) + Try + Local lcPropName, lcClass, lnPos ; + , loEx As Exception ; + , loLang As CL_LANG Of 'FOXBIN2PRG.PRG' + loLang = _Screen.o_FoxBin2Prg_Lang + lcPropName = tcPropName + tcOperation = Upper(Evl(tcOperation,'')) - DO CASE - CASE tcOperation == 'GETNAME' - lcPropName = SUBSTR(tcPropName,5) + Do Case + Case tcOperation == 'GETNAME' + lcPropName = Substr(tcPropName,5) - CASE NOT tcOperation == 'SETNAME' - ERROR loLang.C_ONLY_SETNAME_AND_GETNAME_RECOGNIZED_LOC + Case Not tcOperation == 'SETNAME' + Error loLang.C_ONLY_SETNAME_AND_GETNAME_RECOGNIZED_LOC - CASE lcPropName == 'Name' && System "Name" property - lcPropName = 'A999' + lcPropName + Case lcPropName == 'Name' && System "Name" property + lcPropName = 'A999' + lcPropName - OTHERWISE - *-- Soporte de evaluación de propiedades por clase evaluada - WITH THIS - #IF .F. &&USED("foxbin2prg_keywords") THEN - lcClass = ICASE( .c_ClaseActual == 'grid', 'all' ; - , .c_ClaseActual == 'form', 'all' ; - , .c_ClaseActual == 'pageframe', 'all' ; - , .c_ClaseActual == 'control', 'all' ; - , .c_ClaseActual == 'container', 'all' ; - , .c_ClaseActual == 'toolbar', 'all' ; - , .c_ClaseActual ) + Otherwise +*-- Soporte de evaluación de propiedades por clase evaluada + With This + #If .F. &&USED("foxbin2prg_keywords") THEN + lcClass = Icase( .c_ClaseActual == 'grid', 'all' ; + , .c_ClaseActual == 'form', 'all' ; + , .c_ClaseActual == 'pageframe', 'all' ; + , .c_ClaseActual == 'control', 'all' ; + , .c_ClaseActual == 'container', 'all' ; + , .c_ClaseActual == 'toolbar', 'all' ; + , .c_ClaseActual ) - lnPos = IIF( SEEK( PADR(lcClass,15) + PADR(lcPropName,30), 'foxbin2prg_keywords' ), foxbin2prg_keywords.i_order, 0 ) + lnPos = Iif( Seek( Padr(lcClass,15) + Padr(lcPropName,30), 'foxbin2prg_keywords' ), foxbin2prg_keywords.i_order, 0 ) - #ELSE - DO CASE - CASE .c_ClaseActual == 'checkbox' - lnPos = ASCAN( .a_SpecialProps_Chk, lcPropName, 1, 0, 1, 1+2+4 ) + #Else + Do Case + Case .c_ClaseActual == 'checkbox' + lnPos = Ascan( .a_SpecialProps_Chk, lcPropName, 1, 0, 1, 1+2+4 ) - CASE .c_ClaseActual == 'collection' - lnPos = ASCAN( .a_SpecialProps_Coll, lcPropName, 1, 0, 1, 1+2+4 ) + Case .c_ClaseActual == 'collection' + lnPos = Ascan( .a_SpecialProps_Coll, lcPropName, 1, 0, 1, 1+2+4 ) - CASE .c_ClaseActual == 'combobox' - lnPos = ASCAN( .a_SpecialProps_Cbo, lcPropName, 1, 0, 1, 1+2+4 ) + Case .c_ClaseActual == 'combobox' + lnPos = Ascan( .a_SpecialProps_Cbo, lcPropName, 1, 0, 1, 1+2+4 ) - CASE .c_ClaseActual == 'commandgroup' - lnPos = ASCAN( .a_SpecialProps_Cmg, lcPropName, 1, 0, 1, 1+2+4 ) + Case .c_ClaseActual == 'commandgroup' + lnPos = Ascan( .a_SpecialProps_Cmg, lcPropName, 1, 0, 1, 1+2+4 ) - CASE .c_ClaseActual == 'commandbutton' - lnPos = ASCAN( .a_SpecialProps_Cmd, lcPropName, 1, 0, 1, 1+2+4 ) + Case .c_ClaseActual == 'commandbutton' + lnPos = Ascan( .a_SpecialProps_Cmd, lcPropName, 1, 0, 1, 1+2+4 ) - CASE .c_ClaseActual == 'cursor' - lnPos = ASCAN( .a_SpecialProps_Cur, lcPropName, 1, 0, 1, 1+2+4 ) + Case .c_ClaseActual == 'cursor' + lnPos = Ascan( .a_SpecialProps_Cur, lcPropName, 1, 0, 1, 1+2+4 ) - CASE .c_ClaseActual == 'cursoradapter' - lnPos = ASCAN( .a_SpecialProps_CA, lcPropName, 1, 0, 1, 1+2+4 ) + Case .c_ClaseActual == 'cursoradapter' + lnPos = Ascan( .a_SpecialProps_CA, lcPropName, 1, 0, 1, 1+2+4 ) - CASE .c_ClaseActual == 'dataenvironment' - lnPos = ASCAN( .a_SpecialProps_DE, lcPropName, 1, 0, 1, 1+2+4 ) + Case .c_ClaseActual == 'dataenvironment' + lnPos = Ascan( .a_SpecialProps_DE, lcPropName, 1, 0, 1, 1+2+4 ) - CASE .c_ClaseActual == 'editbox' - lnPos = ASCAN( .a_SpecialProps_Edt, lcPropName, 1, 0, 1, 1+2+4 ) + Case .c_ClaseActual == 'editbox' + lnPos = Ascan( .a_SpecialProps_Edt, lcPropName, 1, 0, 1, 1+2+4 ) - CASE .c_ClaseActual == 'formset' - lnPos = ASCAN( .a_SpecialProps_Frs, lcPropName, 1, 0, 1, 1+2+4 ) + Case .c_ClaseActual == 'formset' + lnPos = Ascan( .a_SpecialProps_Frs, lcPropName, 1, 0, 1, 1+2+4 ) - *-- Comento la clase grid, porque puede contener a todos los controles, como un form - *CASE .c_ClaseActual == 'grid' - * lnPos = ASCAN( .a_SpecialProps_Grd, lcPropName, 1, 0, 1, 1+2+4 ) +*-- Comento la clase grid, porque puede contener a todos los controles, como un form +*CASE .c_ClaseActual == 'grid' +* lnPos = ASCAN( .a_SpecialProps_Grd, lcPropName, 1, 0, 1, 1+2+4 ) - *-- Comento la clase form, porque puede contener a todos los controles, como un form - *CASE .c_ClaseActual == 'form' - * lnPos = ASCAN( .a_SpecialProps_Frm, lcPropName, 1, 0, 1, 1+2+4 ) +*-- Comento la clase form, porque puede contener a todos los controles, como un form +*CASE .c_ClaseActual == 'form' +* lnPos = ASCAN( .a_SpecialProps_Frm, lcPropName, 1, 0, 1, 1+2+4 ) - *-- Comento la clase pageframe, porque puede contener a todos los controles, como un form - *CASE .c_ClaseActual == 'pageframe' - * lnPos = ASCAN( .a_SpecialProps_Pgf, lcPropName, 1, 0, 1, 1+2+4 ) +*-- Comento la clase pageframe, porque puede contener a todos los controles, como un form +*CASE .c_ClaseActual == 'pageframe' +* lnPos = ASCAN( .a_SpecialProps_Pgf, lcPropName, 1, 0, 1, 1+2+4 ) - *-- Comento la clase control, porque puede contener a todos los controles, como un form - *CASE .c_ClaseActual == 'control' - * lnPos = ASCAN( .a_SpecialProps_Ctl, lcPropName, 1, 0, 1, 1+2+4 ) +*-- Comento la clase control, porque puede contener a todos los controles, como un form +*CASE .c_ClaseActual == 'control' +* lnPos = ASCAN( .a_SpecialProps_Ctl, lcPropName, 1, 0, 1, 1+2+4 ) - *-- Comento la clase container, porque puede contener a todos los controles, como un form - *CASE .c_ClaseActual == 'container' - * lnPos = ASCAN( .a_SpecialProps_Cnt, lcPropName, 1, 0, 1, 1+2+4 ) +*-- Comento la clase container, porque puede contener a todos los controles, como un form +*CASE .c_ClaseActual == 'container' +* lnPos = ASCAN( .a_SpecialProps_Cnt, lcPropName, 1, 0, 1, 1+2+4 ) - CASE .c_ClaseActual == 'column' - lnPos = ASCAN( .a_SpecialProps_Grc, lcPropName, 1, 0, 1, 1+2+4 ) + Case .c_ClaseActual == 'column' + lnPos = Ascan( .a_SpecialProps_Grc, lcPropName, 1, 0, 1, 1+2+4 ) - CASE .c_ClaseActual == 'header' - lnPos = ASCAN( .a_SpecialProps_Grh, lcPropName, 1, 0, 1, 1+2+4 ) + Case .c_ClaseActual == 'header' + lnPos = Ascan( .a_SpecialProps_Grh, lcPropName, 1, 0, 1, 1+2+4 ) - CASE .c_ClaseActual == 'hyperlink' - lnPos = ASCAN( .a_SpecialProps_Hlk, lcPropName, 1, 0, 1, 1+2+4 ) + Case .c_ClaseActual == 'hyperlink' + lnPos = Ascan( .a_SpecialProps_Hlk, lcPropName, 1, 0, 1, 1+2+4 ) - CASE .c_ClaseActual == 'image' - lnPos = ASCAN( .a_SpecialProps_Img, lcPropName, 1, 0, 1, 1+2+4 ) + Case .c_ClaseActual == 'image' + lnPos = Ascan( .a_SpecialProps_Img, lcPropName, 1, 0, 1, 1+2+4 ) - CASE .c_ClaseActual == 'label' - lnPos = ASCAN( .a_SpecialProps_Lbl, lcPropName, 1, 0, 1, 1+2+4 ) + Case .c_ClaseActual == 'label' + lnPos = Ascan( .a_SpecialProps_Lbl, lcPropName, 1, 0, 1, 1+2+4 ) - CASE .c_ClaseActual == 'line' - lnPos = ASCAN( .a_SpecialProps_Lin, lcPropName, 1, 0, 1, 1+2+4 ) + Case .c_ClaseActual == 'line' + lnPos = Ascan( .a_SpecialProps_Lin, lcPropName, 1, 0, 1, 1+2+4 ) - CASE .c_ClaseActual == 'listbox' - lnPos = ASCAN( .a_SpecialProps_Lst, lcPropName, 1, 0, 1, 1+2+4 ) + Case .c_ClaseActual == 'listbox' + lnPos = Ascan( .a_SpecialProps_Lst, lcPropName, 1, 0, 1, 1+2+4 ) - CASE .c_ClaseActual == 'olebound' - lnPos = ASCAN( .a_SpecialProps_Ole, lcPropName, 1, 0, 1, 1+2+4 ) + Case .c_ClaseActual == 'olebound' + lnPos = Ascan( .a_SpecialProps_Ole, lcPropName, 1, 0, 1, 1+2+4 ) - CASE .c_ClaseActual == 'optiongroup' - lnPos = ASCAN( .a_SpecialProps_Opg, lcPropName, 1, 0, 1, 1+2+4 ) + Case .c_ClaseActual == 'optiongroup' + lnPos = Ascan( .a_SpecialProps_Opg, lcPropName, 1, 0, 1, 1+2+4 ) - CASE .c_ClaseActual == 'optionbutton' - lnPos = ASCAN( .a_SpecialProps_Opb, lcPropName, 1, 0, 1, 1+2+4 ) + Case .c_ClaseActual == 'optionbutton' + lnPos = Ascan( .a_SpecialProps_Opb, lcPropName, 1, 0, 1, 1+2+4 ) - CASE .c_ClaseActual == 'projecthook' - lnPos = ASCAN( .a_SpecialProps_Phk, lcPropName, 1, 0, 1, 1+2+4 ) + Case .c_ClaseActual == 'projecthook' + lnPos = Ascan( .a_SpecialProps_Phk, lcPropName, 1, 0, 1, 1+2+4 ) - CASE .c_ClaseActual == 'relation' - lnPos = ASCAN( .a_SpecialProps_Rel, lcPropName, 1, 0, 1, 1+2+4 ) + Case .c_ClaseActual == 'relation' + lnPos = Ascan( .a_SpecialProps_Rel, lcPropName, 1, 0, 1, 1+2+4 ) - CASE .c_ClaseActual == 'reportlistener' - lnPos = ASCAN( .a_SpecialProps_Rls, lcPropName, 1, 0, 1, 1+2+4 ) + Case .c_ClaseActual == 'reportlistener' + lnPos = Ascan( .a_SpecialProps_Rls, lcPropName, 1, 0, 1, 1+2+4 ) - CASE .c_ClaseActual == 'separator' - lnPos = ASCAN( .a_SpecialProps_Sep, lcPropName, 1, 0, 1, 1+2+4 ) + Case .c_ClaseActual == 'separator' + lnPos = Ascan( .a_SpecialProps_Sep, lcPropName, 1, 0, 1, 1+2+4 ) - CASE .c_ClaseActual == 'shape' - lnPos = ASCAN( .a_SpecialProps_Shp, lcPropName, 1, 0, 1, 1+2+4 ) + Case .c_ClaseActual == 'shape' + lnPos = Ascan( .a_SpecialProps_Shp, lcPropName, 1, 0, 1, 1+2+4 ) - CASE .c_ClaseActual == 'spinner' - lnPos = ASCAN( .a_SpecialProps_Spn, lcPropName, 1, 0, 1, 1+2+4 ) + Case .c_ClaseActual == 'spinner' + lnPos = Ascan( .a_SpecialProps_Spn, lcPropName, 1, 0, 1, 1+2+4 ) - CASE .c_ClaseActual == 'textbox' - lnPos = ASCAN( .a_SpecialProps_Txt, lcPropName, 1, 0, 1, 1+2+4 ) + Case .c_ClaseActual == 'textbox' + lnPos = Ascan( .a_SpecialProps_Txt, lcPropName, 1, 0, 1, 1+2+4 ) - CASE .c_ClaseActual == 'timer' - lnPos = ASCAN( .a_SpecialProps_Tmr, lcPropName, 1, 0, 1, 1+2+4 ) + Case .c_ClaseActual == 'timer' + lnPos = Ascan( .a_SpecialProps_Tmr, lcPropName, 1, 0, 1, 1+2+4 ) - *-- Comento la clase toolbar, porque puede contener a todos los controles, como un form - *CASE .c_ClaseActual == 'toolbar' - * lnPos = ASCAN( .a_SpecialProps_Tbr, lcPropName, 1, 0, 1, 1+2+4 ) +*-- Comento la clase toolbar, porque puede contener a todos los controles, como un form +*CASE .c_ClaseActual == 'toolbar' +* lnPos = ASCAN( .a_SpecialProps_Tbr, lcPropName, 1, 0, 1, 1+2+4 ) - CASE .c_ClaseActual == 'xmladapter' - lnPos = ASCAN( .a_SpecialProps_XMLAda, lcPropName, 1, 0, 1, 1+2+4 ) + Case .c_ClaseActual == 'xmladapter' + lnPos = Ascan( .a_SpecialProps_XMLAda, lcPropName, 1, 0, 1, 1+2+4 ) - CASE .c_ClaseActual == 'xmlfield' - lnPos = ASCAN( .a_SpecialProps_XMLFld, lcPropName, 1, 0, 1, 1+2+4 ) + Case .c_ClaseActual == 'xmlfield' + lnPos = Ascan( .a_SpecialProps_XMLFld, lcPropName, 1, 0, 1, 1+2+4 ) - CASE .c_ClaseActual == 'xmltable' - lnPos = ASCAN( .a_SpecialProps_XMLTbl, lcPropName, 1, 0, 1, 1+2+4 ) + Case .c_ClaseActual == 'xmltable' + lnPos = Ascan( .a_SpecialProps_XMLTbl, lcPropName, 1, 0, 1, 1+2+4 ) - OTHERWISE - lnPos = ASCAN( .a_SpecialProps, lcPropName, 1, 0, 1, 1+2+4 ) - ENDCASE - #ENDIF - - *IF lnPos2 <> lnPos - * ERROR 'lnPos y lnPos2 no coinciden para "' + .c_ClaseActual + '.' + lcPropName + '"! lnPos=' + TRANSFORM(lnPos) + ', lnPos2=' + TRANSFORM(lnPos2) - *ENDIF - - *-- Genera una propiedad con el formato "A nnn Propiedad", donde los valores más altos quedan al final, - *-- de modo que primero van las props nativas, luego las del usuario y al final "name", que es especial. - *-- Ej: "A004ScaleMode", ..., "A998UserProp", "A999Name" - lcPropName = 'A' + PADL( EVL(lnPos,998), 3, '0' ) + lcPropName - ENDWITH && THIS - ENDCASE - - CATCH TO loEx - IF THIS.n_Debug > 0 AND _VFP.STARTMODE = 0 - SET STEP ON - ENDIF - - THROW - - FINALLY - RELEASE tcOperation, tcPropName, lnPos, loEx - ENDTRY - - RETURN lcPropName - ENDPROC - - - PROCEDURE sortPropsAndValues - * KNOWLEDGE BASE: - * 02/12/2013 FDBOZZO Fidel Charny me pasó un ejemplo donde se pierden propiedades físicamente - * si se ordenan alfabéticamente en un ADD OBJECT. Pierde "picture" y otras más. - * Pareciera que la última debe ser "Name". - *-------------------------------------------------------------------------------------------------------------- - * PARÁMETROS: (v=Pasar por valor | @=Pasar por referencia) (!=Obligatorio | ?=Opcional) (IN/OUT) - * taPropsAndValues (!@ IN ) El array con las propiedades y valores del objeto o clase - * tnPropsAndValues_Count (v! IN ) Cantidad de propiedades - * tnSortType (v! IN ) Tipo de sort: - * 0=Solo separar propiedades de clase y de objetos (.) - * 1=Sort completo de propiedades (para la versión TEXTO) - * 2=Sort completo de propiedades con "Name" al final (para la versión BIN) - *-------------------------------------------------------------------------------------------------------------- - LPARAMETERS taPropsAndValues, tnPropsAndValues_Count, tnSortType - - EXTERNAL ARRAY taPropsAndValues - - TRY - LOCAL I, X, lnArrayCols, laPropsAndValues(1,2), lcPropName, lcSortedMemo, lcMethods ; - , lnSelect, lcObjName - lnArrayCols = ALEN( taPropsAndValues, 2 ) - lnSelect = SELECT() - DIMENSION laPropsAndValues( tnPropsAndValues_Count, lnArrayCols ) - ACOPY( taPropsAndValues, laPropsAndValues ) - - WITH THIS AS c_conversor_base OF 'FOXBIN2PRG.PRG' - IF m.tnSortType > 0 - * CON SORT: - * - A las que no tienen '.' les pongo 'A' por delante, y al resto 'B' por delante para que queden al final - - * ATENCIÓN: 10/07/2018 - * Cuando hay ADD OBJECT multicontenedor (obj.obj.obj...), el reordenamiento - * puede producir daños colaterales, como objetos mal colocados. - * (Era de esperar: No todo se puede ordenar alfabéticamente) - * Un solución de compromiso podría ser al menos mantener juntos los objetos de mismo nombre, - * que en la práctica pueden estar todos mezclados. Al menos eso no rompería nada. - * VER: https://github.com/fdbozzo/foxbin2prg/issues/28 - * - * PASO 1: Obtener los nombres únicos y asignarles un código de orden - CREATE CURSOR C_OBJ (OBJNAME C(50), IORDER I AUTOINC) - INDEX ON OBJNAME TAG OBJNAME - - * PASO 2: Configurar las prioridades de ordenamiento (primero props, luego objs) - FOR I = 1 TO m.tnPropsAndValues_Count - IF '.' $ laPropsAndValues(m.I,1) - IF m.tnSortType = 2 - * Genera obj+props para BIN - lcObjName = GETWORDNUM(laPropsAndValues(m.I,1), 1, '.') - - IF NOT SEEK(LOWER(lcObjName), "C_OBJ") - INSERT INTO C_OBJ (OBJNAME) VALUES (LOWER(lcObjName)) - ENDIF - - laPropsAndValues(m.I,1) = 'B' + PADL(C_OBJ.IORDER,3,'0') ; - + JUSTSTEM(laPropsAndValues(m.I,1)) + '.' ; - + .sortPropsAndValues_SetAndGetSCXPropNames( 'SETNAME', JUSTEXT(laPropsAndValues(m.I,1)) ) - - *laPropsAndValues(m.I,1) = 'B000' + lcObjName + '.' ; - + .sortPropsAndValues_SetAndGetSCXPropNames( 'SETNAME', JUSTEXT(laPropsAndValues(m.I,1)) ) - ELSE - * Genera obj+props para TX2 - lcObjName = GETWORDNUM(laPropsAndValues(m.I,1), 1, '.') - - IF NOT SEEK(LOWER(lcObjName), "C_OBJ") - INSERT INTO C_OBJ (OBJNAME) VALUES (LOWER(lcObjName)) - ENDIF - - laPropsAndValues(m.I,1) = 'B' + PADL(C_OBJ.IORDER,3,'0') ; - + JUSTSTEM(laPropsAndValues(m.I,1)) + '.' ; - + JUSTEXT(laPropsAndValues(m.I,1)) - - *laPropsAndValues(m.I,1) = 'B' + PADL(I,3,'0') + laPropsAndValues(m.I,1) - ENDIF - ELSE - IF m.tnSortType = 2 - * Genera obj+props para BIN - laPropsAndValues(m.I,1) = .sortPropsAndValues_SetAndGetSCXPropNames( 'SETNAME', laPropsAndValues(m.I,1) ) - ELSE - * Genera obj+props para TX2 - laPropsAndValues(m.I,1) = 'A000' + laPropsAndValues(m.I,1) - ENDIF - ENDIF - ENDFOR - - * Paso 3: Ordenar según la prioridad previa - IF .l_PropSort_Enabled - ASORT( laPropsAndValues, 1, -1, 0, 1) - ENDIF - - - * Paso 4: Quitar metadatos y rearmar array - FOR I = 1 TO m.tnPropsAndValues_Count - *-- Quitar caracteres agregados antes del SORT - IF '.' $ laPropsAndValues(m.I,1) - IF m.tnSortType = 2 - * Genera obj+props para BIN - taPropsAndValues(m.I,1) = JUSTSTEM( SUBSTR( laPropsAndValues(m.I,1), 2+3 ) ) + '.' ; - + .sortPropsAndValues_SetAndGetSCXPropNames( 'GETNAME', JUSTEXT(laPropsAndValues(m.I,1)) ) - ELSE - * Genera obj+props para TX2 - taPropsAndValues(m.I,1) = SUBSTR( laPropsAndValues(m.I,1), 2+3 ) - ENDIF - ELSE - IF m.tnSortType = 2 - * Genera obj+props para BIN - taPropsAndValues(m.I,1) = .sortPropsAndValues_SetAndGetSCXPropNames( 'GETNAME', laPropsAndValues(m.I,1) ) - ELSE - * Genera obj+props para TX2 - taPropsAndValues(m.I,1) = SUBSTR( laPropsAndValues(m.I,1), 2+3 ) - ENDIF - ENDIF - - taPropsAndValues(m.I,2) = laPropsAndValues(m.I,2) - - IF lnArrayCols >= 3 - taPropsAndValues(m.I,3) = laPropsAndValues(m.I,3) - ENDIF - ENDFOR - - ELSE && m.tnSortType = 0 - *-- SIN SORT: Creo 2 arrays, el bueno y el temporal, y al terminar agrego el temporal al bueno. - *-- Debo separar las props.normales de las de los objetos (ocurre cuando es un ADD OBJECT) - X = 0 - - *-- PRIMERO las que no tienen punto - FOR I = 1 TO m.tnPropsAndValues_Count - IF EMPTY( laPropsAndValues(m.I,1) ) - LOOP - ENDIF - - IF NOT '.' $ laPropsAndValues(m.I,1) - X = m.X + 1 - taPropsAndValues(m.X,1) = laPropsAndValues(m.I,1) - taPropsAndValues(m.X,2) = laPropsAndValues(m.I,2) - IF lnArrayCols >= 3 - taPropsAndValues(m.X,3) = laPropsAndValues(m.I,3) - ENDIF - ENDIF - ENDFOR - - *-- LUEGO las demás props. - FOR I = 1 TO m.tnPropsAndValues_Count - IF EMPTY( laPropsAndValues(m.I,1) ) - LOOP - ENDIF - - IF '.' $ laPropsAndValues(m.I,1) - X = m.X + 1 - taPropsAndValues(m.X,1) = laPropsAndValues(m.I,1) - taPropsAndValues(m.X,2) = laPropsAndValues(m.I,2) - IF lnArrayCols >= 3 - taPropsAndValues(m.X,3) = laPropsAndValues(m.I,3) - ENDIF - ENDIF - ENDFOR - ENDIF - ENDWITH && THIS AS C_CONVERSOR_BASE OF 'FOXBIN2PRG.PRG' - - - CATCH TO loEx - IF THIS.n_Debug > 0 AND _VFP.STARTMODE = 0 - SET STEP ON - ENDIF - - THROW - - FINALLY - RELEASE taPropsAndValues, tnPropsAndValues_Count, tnSortType ; - , I, X, lnArrayCols, laPropsAndValues, lcPropName, lcSortedMemo, lcMethods - USE IN (SELECT("C_OBJ")) - SELECT (lnSelect) - ENDTRY - - RETURN - ENDPROC - - - - PROCEDURE sortSpecialProps - TRY - LOCAL I, loEx AS EXCEPTION, lcPropsFile - lcPropsFile = '' + Otherwise + lnPos = Ascan( .a_SpecialProps, lcPropName, 1, 0, 1, 1+2+4 ) + Endcase + #Endif + +*IF lnPos2 <> lnPos +* ERROR 'lnPos y lnPos2 no coinciden para "' + .c_ClaseActual + '.' + lcPropName + '"! lnPos=' + TRANSFORM(lnPos) + ', lnPos2=' + TRANSFORM(lnPos2) +*ENDIF + +*-- Genera una propiedad con el formato "A nnn Propiedad", donde los valores más altos quedan al final, +*-- de modo que primero van las props nativas, luego las del usuario y al final "name", que es especial. +*-- Ej: "A004ScaleMode", ..., "A998UserProp", "A999Name" + lcPropName = 'A' + Padl( Evl(lnPos,998), 3, '0' ) + lcPropName + Endwith && THIS + Endcase + + Catch To loEx + If This.n_Debug > 0 And _vfp.StartMode = 0 + Set Step On + Endif + + Throw + + Finally + Release tcOperation, tcPropName, lnPos, loEx + Endtry + + Return lcPropName + Endproc + + + Procedure sortPropsAndValues +* KNOWLEDGE BASE: +* 02/12/2013 FDBOZZO Fidel Charny me pasó un ejemplo donde se pierden propiedades físicamente +* si se ordenan alfabéticamente en un ADD OBJECT. Pierde "picture" y otras más. +* Pareciera que la última debe ser "Name". +*-------------------------------------------------------------------------------------------------------------- +* PARÁMETROS: (v=Pasar por valor | @=Pasar por referencia) (!=Obligatorio | ?=Opcional) (IN/OUT) +* taPropsAndValues (!@ IN ) El array con las propiedades y valores del objeto o clase +* tnPropsAndValues_Count (v! IN ) Cantidad de propiedades +* tnSortType (v! IN ) Tipo de sort: +* 0=Solo separar propiedades de clase y de objetos (.) +* 1=Sort completo de propiedades (para la versión TEXTO) +* 2=Sort completo de propiedades con "Name" al final (para la versión BIN) +*-------------------------------------------------------------------------------------------------------------- + Lparameters taPropsAndValues, tnPropsAndValues_Count, tnSortType + + External Array taPropsAndValues + + Try + Local I, X, lnArrayCols, laPropsAndValues(1,2), lcPropName, lcSortedMemo, lcMethods ; + , lnSelect, lcObjName + lnArrayCols = Alen( taPropsAndValues, 2 ) + lnSelect = Select() + Dimension laPropsAndValues( tnPropsAndValues_Count, lnArrayCols ) + Acopy( taPropsAndValues, laPropsAndValues ) + + With This As c_conversor_base Of 'FOXBIN2PRG.PRG' + If m.tnSortType > 0 +* CON SORT: +* - A las que no tienen '.' les pongo 'A' por delante, y al resto 'B' por delante para que queden al final + +* ATENCIÓN: 10/07/2018 +* Cuando hay ADD OBJECT multicontenedor (obj.obj.obj...), el reordenamiento +* puede producir daños colaterales, como objetos mal colocados. +* (Era de esperar: No todo se puede ordenar alfabéticamente) +* Un solución de compromiso podría ser al menos mantener juntos los objetos de mismo nombre, +* que en la práctica pueden estar todos mezclados. Al menos eso no rompería nada. +* VER: https://github.com/fdbozzo/foxbin2prg/issues/28 +* +* PASO 1: Obtener los nombres únicos y asignarles un código de orden + Create Cursor C_OBJ (OBJNAME C(50), IORDER I Autoinc) + Index On OBJNAME Tag OBJNAME + +* PASO 2: Configurar las prioridades de ordenamiento (primero props, luego objs) + For I = 1 To m.tnPropsAndValues_Count + If '.' $ laPropsAndValues(m.I,1) + If m.tnSortType = 2 +* Genera obj+props para BIN + lcObjName = Getwordnum(laPropsAndValues(m.I,1), 1, '.') + + If Not Seek(Lower(lcObjName), "C_OBJ") + Insert Into C_OBJ (OBJNAME) Values (Lower(lcObjName)) + Endif + + laPropsAndValues(m.I,1) = 'B' + Padl(C_OBJ.IORDER,3,'0') ; + + Juststem(laPropsAndValues(m.I,1)) + '.' ; + + .sortPropsAndValues_SetAndGetSCXPropNames( 'SETNAME', Justext(laPropsAndValues(m.I,1)) ) + +*laPropsAndValues(m.I,1) = 'B000' + lcObjName + '.' ; ++ .sortPropsAndValues_SetAndGetSCXPropNames( 'SETNAME', JUSTEXT(laPropsAndValues(m.I,1)) ) + Else +* Genera obj+props para TX2 + lcObjName = Getwordnum(laPropsAndValues(m.I,1), 1, '.') + + If Not Seek(Lower(lcObjName), "C_OBJ") + Insert Into C_OBJ (OBJNAME) Values (Lower(lcObjName)) + Endif + + laPropsAndValues(m.I,1) = 'B' + Padl(C_OBJ.IORDER,3,'0') ; + + Juststem(laPropsAndValues(m.I,1)) + '.' ; + + Justext(laPropsAndValues(m.I,1)) + +*laPropsAndValues(m.I,1) = 'B' + PADL(I,3,'0') + laPropsAndValues(m.I,1) + Endif + Else + If m.tnSortType = 2 +* Genera obj+props para BIN + laPropsAndValues(m.I,1) = .sortPropsAndValues_SetAndGetSCXPropNames( 'SETNAME', laPropsAndValues(m.I,1) ) + Else +* Genera obj+props para TX2 + laPropsAndValues(m.I,1) = 'A000' + laPropsAndValues(m.I,1) + Endif + Endif + Endfor + +* Paso 3: Ordenar según la prioridad previa + If .l_PropSort_Enabled + Asort( laPropsAndValues, 1, -1, 0, 1) + Endif + + +* Paso 4: Quitar metadatos y rearmar array + For I = 1 To m.tnPropsAndValues_Count +*-- Quitar caracteres agregados antes del SORT + If '.' $ laPropsAndValues(m.I,1) + If m.tnSortType = 2 +* Genera obj+props para BIN + taPropsAndValues(m.I,1) = Juststem( Substr( laPropsAndValues(m.I,1), 2+3 ) ) + '.' ; + + .sortPropsAndValues_SetAndGetSCXPropNames( 'GETNAME', Justext(laPropsAndValues(m.I,1)) ) + Else +* Genera obj+props para TX2 + taPropsAndValues(m.I,1) = Substr( laPropsAndValues(m.I,1), 2+3 ) + Endif + Else + If m.tnSortType = 2 +* Genera obj+props para BIN + taPropsAndValues(m.I,1) = .sortPropsAndValues_SetAndGetSCXPropNames( 'GETNAME', laPropsAndValues(m.I,1) ) + Else +* Genera obj+props para TX2 + taPropsAndValues(m.I,1) = Substr( laPropsAndValues(m.I,1), 2+3 ) + Endif + Endif + + taPropsAndValues(m.I,2) = laPropsAndValues(m.I,2) + + If lnArrayCols >= 3 + taPropsAndValues(m.I,3) = laPropsAndValues(m.I,3) + Endif + Endfor + + Else && m.tnSortType = 0 +*-- SIN SORT: Creo 2 arrays, el bueno y el temporal, y al terminar agrego el temporal al bueno. +*-- Debo separar las props.normales de las de los objetos (ocurre cuando es un ADD OBJECT) + X = 0 + +*-- PRIMERO las que no tienen punto + For I = 1 To m.tnPropsAndValues_Count + If Empty( laPropsAndValues(m.I,1) ) + Loop + Endif + + If Not '.' $ laPropsAndValues(m.I,1) + X = m.X + 1 + taPropsAndValues(m.X,1) = laPropsAndValues(m.I,1) + taPropsAndValues(m.X,2) = laPropsAndValues(m.I,2) + If lnArrayCols >= 3 + taPropsAndValues(m.X,3) = laPropsAndValues(m.I,3) + Endif + Endif + Endfor + +*-- LUEGO las demás props. + For I = 1 To m.tnPropsAndValues_Count + If Empty( laPropsAndValues(m.I,1) ) + Loop + Endif + + If '.' $ laPropsAndValues(m.I,1) + X = m.X + 1 + taPropsAndValues(m.X,1) = laPropsAndValues(m.I,1) + taPropsAndValues(m.X,2) = laPropsAndValues(m.I,2) + If lnArrayCols >= 3 + taPropsAndValues(m.X,3) = laPropsAndValues(m.I,3) + Endif + Endif + Endfor + Endif + Endwith && THIS AS C_CONVERSOR_BASE OF 'FOXBIN2PRG.PRG' + + + Catch To loEx + If This.n_Debug > 0 And _vfp.StartMode = 0 + Set Step On + Endif + + Throw + + Finally + Release taPropsAndValues, tnPropsAndValues_Count, tnSortType ; + , I, X, lnArrayCols, laPropsAndValues, lcPropName, lcSortedMemo, lcMethods + Use In (Select("C_OBJ")) + Select (lnSelect) + Endtry + + Return + Endproc + + + + Procedure sortSpecialProps + Try + Local I, loEx As Exception, lcPropsFile + lcPropsFile = '' - WITH THIS AS conversor_base OF "FOXBIN2PRG.PRG" - *-- (TODAS) => Antes era solo FORM - #IF .F. - *-- 03/04/2015 FDBOZZO - *-- Quise comparar la velocidad de los ASCAN(array) contra un SEEK a una tabla de propiedades con índice, y resulta que para - *-- unas 1500 propiedades casi no hay diferencias (10 segundos en unos 1600 archivos) :( - USE (FULLPATH( 'foxbin2prg_keywords', .c_Foxbin2prg_FullPath )) SHARED NOUPDATE AGAIN IN 0 ORDER PK && C_CLASS+C_KEYWORD - #ELSE - I = 0 + With This As conversor_base Of "FOXBIN2PRG.PRG" +*-- (TODAS) => Antes era solo FORM + #If .F. +*-- 03/04/2015 FDBOZZO +*-- Quise comparar la velocidad de los ASCAN(array) contra un SEEK a una tabla de propiedades con índice, y resulta que para +*-- unas 1500 propiedades casi no hay diferencias (10 segundos en unos 1600 archivos) :( + Use (Fullpath( 'foxbin2prg_keywords', .c_Foxbin2prg_FullPath )) Shared Noupdate Again In 0 Order PK && C_CLASS+C_KEYWORD + #Else + I = 0 - lcPropsFile = FORCEPATH( "props_all.txt", JUSTPATH( .c_Foxbin2prg_FullPath ) ) - I = ALINES( .a_SpecialProps, FILETOSTR( lcPropsFile ), 1+4 ) + lcPropsFile = Forcepath( "props_all.txt", Justpath( .c_Foxbin2prg_FullPath ) ) + I = Alines( .a_SpecialProps, Filetostr( lcPropsFile ), 1+4 ) - lcPropsFile = FORCEPATH( "props_checkbox.txt", JUSTPATH( .c_Foxbin2prg_FullPath ) ) - I = ALINES( .a_SpecialProps_Chk, FILETOSTR( lcPropsFile ), 1+4 ) + lcPropsFile = Forcepath( "props_checkbox.txt", Justpath( .c_Foxbin2prg_FullPath ) ) + I = Alines( .a_SpecialProps_Chk, Filetostr( lcPropsFile ), 1+4 ) - lcPropsFile = FORCEPATH( "props_collection.txt", JUSTPATH( .c_Foxbin2prg_FullPath ) ) - I = ALINES( .a_SpecialProps_Coll, FILETOSTR( lcPropsFile ), 1+4 ) + lcPropsFile = Forcepath( "props_collection.txt", Justpath( .c_Foxbin2prg_FullPath ) ) + I = Alines( .a_SpecialProps_Coll, Filetostr( lcPropsFile ), 1+4 ) - lcPropsFile = FORCEPATH( "props_combobox.txt", JUSTPATH( .c_Foxbin2prg_FullPath ) ) - I = ALINES( .a_SpecialProps_Cbo, FILETOSTR( lcPropsFile ), 1+4 ) + lcPropsFile = Forcepath( "props_combobox.txt", Justpath( .c_Foxbin2prg_FullPath ) ) + I = Alines( .a_SpecialProps_Cbo, Filetostr( lcPropsFile ), 1+4 ) - lcPropsFile = FORCEPATH( "props_commandgroup.txt", JUSTPATH( .c_Foxbin2prg_FullPath ) ) - I = ALINES( .a_SpecialProps_Cmg, FILETOSTR( lcPropsFile ), 1+4 ) + lcPropsFile = Forcepath( "props_commandgroup.txt", Justpath( .c_Foxbin2prg_FullPath ) ) + I = Alines( .a_SpecialProps_Cmg, Filetostr( lcPropsFile ), 1+4 ) - lcPropsFile = FORCEPATH( "props_commandbutton.txt", JUSTPATH( .c_Foxbin2prg_FullPath ) ) - I = ALINES( .a_SpecialProps_Cmd, FILETOSTR( lcPropsFile ), 1+4 ) + lcPropsFile = Forcepath( "props_commandbutton.txt", Justpath( .c_Foxbin2prg_FullPath ) ) + I = Alines( .a_SpecialProps_Cmd, Filetostr( lcPropsFile ), 1+4 ) - lcPropsFile = FORCEPATH( "props_cursor.txt", JUSTPATH( .c_Foxbin2prg_FullPath ) ) - I = ALINES( .a_SpecialProps_Cur, FILETOSTR( lcPropsFile ), 1+4 ) + lcPropsFile = Forcepath( "props_cursor.txt", Justpath( .c_Foxbin2prg_FullPath ) ) + I = Alines( .a_SpecialProps_Cur, Filetostr( lcPropsFile ), 1+4 ) - lcPropsFile = FORCEPATH( "props_cursoradapter.txt", JUSTPATH( .c_Foxbin2prg_FullPath ) ) - I = ALINES( .a_SpecialProps_CA, FILETOSTR( lcPropsFile ), 1+4 ) + lcPropsFile = Forcepath( "props_cursoradapter.txt", Justpath( .c_Foxbin2prg_FullPath ) ) + I = Alines( .a_SpecialProps_CA, Filetostr( lcPropsFile ), 1+4 ) - lcPropsFile = FORCEPATH( "props_dataenvironment.txt", JUSTPATH( .c_Foxbin2prg_FullPath ) ) - I = ALINES( .a_SpecialProps_DE, FILETOSTR( lcPropsFile ), 1+4 ) + lcPropsFile = Forcepath( "props_dataenvironment.txt", Justpath( .c_Foxbin2prg_FullPath ) ) + I = Alines( .a_SpecialProps_DE, Filetostr( lcPropsFile ), 1+4 ) - lcPropsFile = FORCEPATH( "props_editbox.txt", JUSTPATH( .c_Foxbin2prg_FullPath ) ) - I = ALINES( .a_SpecialProps_Edt, FILETOSTR( lcPropsFile ), 1+4 ) + lcPropsFile = Forcepath( "props_editbox.txt", Justpath( .c_Foxbin2prg_FullPath ) ) + I = Alines( .a_SpecialProps_Edt, Filetostr( lcPropsFile ), 1+4 ) - lcPropsFile = FORCEPATH( "props_formset.txt", JUSTPATH( .c_Foxbin2prg_FullPath ) ) - I = ALINES( .a_SpecialProps_Frs, FILETOSTR( lcPropsFile ), 1+4 ) + lcPropsFile = Forcepath( "props_formset.txt", Justpath( .c_Foxbin2prg_FullPath ) ) + I = Alines( .a_SpecialProps_Frs, Filetostr( lcPropsFile ), 1+4 ) - *lcPropsFile = FORCEPATH( "props_grid.txt", JUSTPATH( .c_Foxbin2prg_FullPath ) ) - *I = ALINES( .a_SpecialProps_Grd, FILETOSTR( lcPropsFile ), 1+4 ) +*lcPropsFile = FORCEPATH( "props_grid.txt", JUSTPATH( .c_Foxbin2prg_FullPath ) ) +*I = ALINES( .a_SpecialProps_Grd, FILETOSTR( lcPropsFile ), 1+4 ) - lcPropsFile = FORCEPATH( "props_grid_column.txt", JUSTPATH( .c_Foxbin2prg_FullPath ) ) - I = ALINES( .a_SpecialProps_Grc, FILETOSTR( lcPropsFile ), 1+4 ) + lcPropsFile = Forcepath( "props_grid_column.txt", Justpath( .c_Foxbin2prg_FullPath ) ) + I = Alines( .a_SpecialProps_Grc, Filetostr( lcPropsFile ), 1+4 ) - lcPropsFile = FORCEPATH( "props_grid_header.txt", JUSTPATH( .c_Foxbin2prg_FullPath ) ) - I = ALINES( .a_SpecialProps_Grh, FILETOSTR( lcPropsFile ), 1+4 ) + lcPropsFile = Forcepath( "props_grid_header.txt", Justpath( .c_Foxbin2prg_FullPath ) ) + I = Alines( .a_SpecialProps_Grh, Filetostr( lcPropsFile ), 1+4 ) - lcPropsFile = FORCEPATH( "props_hyperlink.txt", JUSTPATH( .c_Foxbin2prg_FullPath ) ) - I = ALINES( .a_SpecialProps_Hlk, FILETOSTR( lcPropsFile ), 1+4 ) + lcPropsFile = Forcepath( "props_hyperlink.txt", Justpath( .c_Foxbin2prg_FullPath ) ) + I = Alines( .a_SpecialProps_Hlk, Filetostr( lcPropsFile ), 1+4 ) - lcPropsFile = FORCEPATH( "props_image.txt", JUSTPATH( .c_Foxbin2prg_FullPath ) ) - I = ALINES( .a_SpecialProps_Img, FILETOSTR( lcPropsFile ), 1+4 ) + lcPropsFile = Forcepath( "props_image.txt", Justpath( .c_Foxbin2prg_FullPath ) ) + I = Alines( .a_SpecialProps_Img, Filetostr( lcPropsFile ), 1+4 ) - lcPropsFile = FORCEPATH( "props_label.txt", JUSTPATH( .c_Foxbin2prg_FullPath ) ) - I = ALINES( .a_SpecialProps_Lbl, FILETOSTR( lcPropsFile ), 1+4 ) + lcPropsFile = Forcepath( "props_label.txt", Justpath( .c_Foxbin2prg_FullPath ) ) + I = Alines( .a_SpecialProps_Lbl, Filetostr( lcPropsFile ), 1+4 ) - lcPropsFile = FORCEPATH( "props_line.txt", JUSTPATH( .c_Foxbin2prg_FullPath ) ) - I = ALINES( .a_SpecialProps_Lin, FILETOSTR( lcPropsFile ), 1+4 ) + lcPropsFile = Forcepath( "props_line.txt", Justpath( .c_Foxbin2prg_FullPath ) ) + I = Alines( .a_SpecialProps_Lin, Filetostr( lcPropsFile ), 1+4 ) - lcPropsFile = FORCEPATH( "props_listbox.txt", JUSTPATH( .c_Foxbin2prg_FullPath ) ) - I = ALINES( .a_SpecialProps_Lst, FILETOSTR( lcPropsFile ), 1+4 ) + lcPropsFile = Forcepath( "props_listbox.txt", Justpath( .c_Foxbin2prg_FullPath ) ) + I = Alines( .a_SpecialProps_Lst, Filetostr( lcPropsFile ), 1+4 ) - lcPropsFile = FORCEPATH( "props_olebound.txt", JUSTPATH( .c_Foxbin2prg_FullPath ) ) - I = ALINES( .a_SpecialProps_Ole, FILETOSTR( lcPropsFile ), 1+4 ) + lcPropsFile = Forcepath( "props_olebound.txt", Justpath( .c_Foxbin2prg_FullPath ) ) + I = Alines( .a_SpecialProps_Ole, Filetostr( lcPropsFile ), 1+4 ) - lcPropsFile = FORCEPATH( "props_optiongroup.txt", JUSTPATH( .c_Foxbin2prg_FullPath ) ) - I = ALINES( .a_SpecialProps_Opg, FILETOSTR( lcPropsFile ), 1+4 ) + lcPropsFile = Forcepath( "props_optiongroup.txt", Justpath( .c_Foxbin2prg_FullPath ) ) + I = Alines( .a_SpecialProps_Opg, Filetostr( lcPropsFile ), 1+4 ) - lcPropsFile = FORCEPATH( "props_optiongroup_option.txt", JUSTPATH( .c_Foxbin2prg_FullPath ) ) - I = ALINES( .a_SpecialProps_Opb, FILETOSTR( lcPropsFile ), 1+4 ) + lcPropsFile = Forcepath( "props_optiongroup_option.txt", Justpath( .c_Foxbin2prg_FullPath ) ) + I = Alines( .a_SpecialProps_Opb, Filetostr( lcPropsFile ), 1+4 ) - lcPropsFile = FORCEPATH( "props_projecthook.txt", JUSTPATH( .c_Foxbin2prg_FullPath ) ) - I = ALINES( .a_SpecialProps_Phk, FILETOSTR( lcPropsFile ), 1+4 ) + lcPropsFile = Forcepath( "props_projecthook.txt", Justpath( .c_Foxbin2prg_FullPath ) ) + I = Alines( .a_SpecialProps_Phk, Filetostr( lcPropsFile ), 1+4 ) - lcPropsFile = FORCEPATH( "props_relation.txt", JUSTPATH( .c_Foxbin2prg_FullPath ) ) - I = ALINES( .a_SpecialProps_Rel, FILETOSTR( lcPropsFile ), 1+4 ) + lcPropsFile = Forcepath( "props_relation.txt", Justpath( .c_Foxbin2prg_FullPath ) ) + I = Alines( .a_SpecialProps_Rel, Filetostr( lcPropsFile ), 1+4 ) - lcPropsFile = FORCEPATH( "props_reportlistener.txt", JUSTPATH( .c_Foxbin2prg_FullPath ) ) - I = ALINES( .a_SpecialProps_Rls, FILETOSTR( lcPropsFile ), 1+4 ) + lcPropsFile = Forcepath( "props_reportlistener.txt", Justpath( .c_Foxbin2prg_FullPath ) ) + I = Alines( .a_SpecialProps_Rls, Filetostr( lcPropsFile ), 1+4 ) - lcPropsFile = FORCEPATH( "props_separator.txt", JUSTPATH( .c_Foxbin2prg_FullPath ) ) - I = ALINES( .a_SpecialProps_Sep, FILETOSTR( lcPropsFile ), 1+4 ) + lcPropsFile = Forcepath( "props_separator.txt", Justpath( .c_Foxbin2prg_FullPath ) ) + I = Alines( .a_SpecialProps_Sep, Filetostr( lcPropsFile ), 1+4 ) - lcPropsFile = FORCEPATH( "props_shape.txt", JUSTPATH( .c_Foxbin2prg_FullPath ) ) - I = ALINES( .a_SpecialProps_Shp, FILETOSTR( lcPropsFile ), 1+4 ) + lcPropsFile = Forcepath( "props_shape.txt", Justpath( .c_Foxbin2prg_FullPath ) ) + I = Alines( .a_SpecialProps_Shp, Filetostr( lcPropsFile ), 1+4 ) - lcPropsFile = FORCEPATH( "props_spinner.txt", JUSTPATH( .c_Foxbin2prg_FullPath ) ) - I = ALINES( .a_SpecialProps_Spn, FILETOSTR( lcPropsFile ), 1+4 ) + lcPropsFile = Forcepath( "props_spinner.txt", Justpath( .c_Foxbin2prg_FullPath ) ) + I = Alines( .a_SpecialProps_Spn, Filetostr( lcPropsFile ), 1+4 ) - lcPropsFile = FORCEPATH( "props_textbox.txt", JUSTPATH( .c_Foxbin2prg_FullPath ) ) - I = ALINES( .a_SpecialProps_Txt, FILETOSTR( lcPropsFile ), 1+4 ) + lcPropsFile = Forcepath( "props_textbox.txt", Justpath( .c_Foxbin2prg_FullPath ) ) + I = Alines( .a_SpecialProps_Txt, Filetostr( lcPropsFile ), 1+4 ) - lcPropsFile = FORCEPATH( "props_timer.txt", JUSTPATH( .c_Foxbin2prg_FullPath ) ) - I = ALINES( .a_SpecialProps_Tmr, FILETOSTR( lcPropsFile ), 1+4 ) + lcPropsFile = Forcepath( "props_timer.txt", Justpath( .c_Foxbin2prg_FullPath ) ) + I = Alines( .a_SpecialProps_Tmr, Filetostr( lcPropsFile ), 1+4 ) - *lcPropsFile = FORCEPATH( "props_toolbar.txt", JUSTPATH( .c_Foxbin2prg_FullPath ) ) - *I = ALINES( .a_SpecialProps_Tbr, FILETOSTR( lcPropsFile ), 1+4 ) +*lcPropsFile = FORCEPATH( "props_toolbar.txt", JUSTPATH( .c_Foxbin2prg_FullPath ) ) +*I = ALINES( .a_SpecialProps_Tbr, FILETOSTR( lcPropsFile ), 1+4 ) - lcPropsFile = FORCEPATH( "props_xmladapter.txt", JUSTPATH( .c_Foxbin2prg_FullPath ) ) - I = ALINES( .a_SpecialProps_XMLAda, FILETOSTR( lcPropsFile ), 1+4 ) + lcPropsFile = Forcepath( "props_xmladapter.txt", Justpath( .c_Foxbin2prg_FullPath ) ) + I = Alines( .a_SpecialProps_XMLAda, Filetostr( lcPropsFile ), 1+4 ) - lcPropsFile = FORCEPATH( "props_xmlfield.txt", JUSTPATH( .c_Foxbin2prg_FullPath ) ) - I = ALINES( .a_SpecialProps_XMLFld, FILETOSTR( lcPropsFile ), 1+4 ) + lcPropsFile = Forcepath( "props_xmlfield.txt", Justpath( .c_Foxbin2prg_FullPath ) ) + I = Alines( .a_SpecialProps_XMLFld, Filetostr( lcPropsFile ), 1+4 ) - lcPropsFile = FORCEPATH( "props_xmltable.txt", JUSTPATH( .c_Foxbin2prg_FullPath ) ) - I = ALINES( .a_SpecialProps_XMLTbl, FILETOSTR( lcPropsFile ), 1+4 ) - #ENDIF + lcPropsFile = Forcepath( "props_xmltable.txt", Justpath( .c_Foxbin2prg_FullPath ) ) + I = Alines( .a_SpecialProps_XMLTbl, Filetostr( lcPropsFile ), 1+4 ) + #Endif - ENDWITH + Endwith - CATCH TO loEx - loEx.USERVALUE = 'lcPropsFile = ' + lcPropsFile + Catch To loEx + loEx.UserValue = 'lcPropsFile = ' + lcPropsFile - IF THIS.n_Debug > 0 AND _VFP.STARTMODE = 0 - SET STEP ON - ENDIF + If This.n_Debug > 0 And _vfp.StartMode = 0 + Set Step On + Endif - THROW + Throw - ENDTRY + Endtry - RETURN - ENDPROC + Return + Endproc - PROCEDURE writeLog - LPARAMETERS tcText, tnTimeStamp + Procedure writeLog + Lparameters tcText, tnTimeStamp - TRY - WITH THIS AS c_conversor_base OF 'FOXBIN2PRG.PRG' - *-- Según el valor de nTimestamp: - *-- 0 = Sin timestamp - *-- 1 = Timestamp por delante - *-- 2 = Timestamp por detrás - .c_TextLog = .c_TextLog ; - + IIF( EVL(tnTimeStamp,0) = 1, TTOC(DATETIME(),3) + ' ', '' ) ; - + EVL(tcText,'') ; - + IIF( EVL(tnTimeStamp,0) = 2, ' ' + TTOC(DATETIME(),3), '' ) ; - + CR_LF - ENDWITH - CATCH - ENDTRY - ENDPROC + Try + With This As c_conversor_base Of 'FOXBIN2PRG.PRG' +*-- Según el valor de nTimestamp: +*-- 0 = Sin timestamp +*-- 1 = Timestamp por delante +*-- 2 = Timestamp por detrás + .c_TextLog = .c_TextLog ; + + Iif( Evl(tnTimeStamp,0) = 1, Ttoc(Datetime(),3) + ' ', '' ) ; + + Evl(tcText,'') ; + + Iif( Evl(tnTimeStamp,0) = 2, ' ' + Ttoc(Datetime(),3), '' ) ; + + CR_LF + Endwith + Catch + Endtry + Endproc - PROCEDURE writeErrorLog - LPARAMETERS tcText + Procedure writeErrorLog + Lparameters tcText - TRY - WITH THIS AS conversor_base OF "FOXBIN2PRG.PRG" - .c_TextErr = .c_TextErr + EVL(tcText,'') + CR_LF - .l_Error = .T. - ENDWITH - CATCH - ENDTRY - ENDPROC + Try + With This As conversor_base Of "FOXBIN2PRG.PRG" + .c_TextErr = .c_TextErr + Evl(tcText,'') + CR_LF + .l_Error = .T. + Endwith + Catch + Endtry + Endproc -ENDDEFINE +Enddefine -DEFINE CLASS c_conversor_prg_a_bin AS c_conversor_base - #IF .F. - LOCAL THIS AS c_conversor_prg_a_bin OF 'FOXBIN2PRG.PRG' - #ENDIF +Define Class c_conversor_prg_a_bin As c_conversor_base + #If .F. + Local This As c_conversor_prg_a_bin Of 'FOXBIN2PRG.PRG' + #Endif - _MEMBERDATA = [] ; + _MemberData = [] ; + [] ; + [] ; + [] ; @@ -7986,137 +7998,137 @@ DEFINE CLASS c_conversor_prg_a_bin AS c_conversor_base - PROCEDURE convert - *--------------------------------------------------------------------------------------------------- - * PARÁMETROS: (v=Pasar por valor | @=Pasar por referencia) (!=Obligatorio | ?=Opcional) (IN/OUT) - * toModulo (!@ OUT) Objeto generado de clase correspondiente con la información leida del texto - * toEx (!@ OUT) Objeto con información del error - * toFoxBin2Prg (!@ IN ) Referencia al objeto principal - *--------------------------------------------------------------------------------------------------- - LPARAMETERS toModulo, toEx AS EXCEPTION, toFoxBin2Prg - #IF .F. - LOCAL toFoxBin2Prg AS c_foxbin2prg OF 'FOXBIN2PRG.PRG' - #ENDIF - DODEFAULT( @toModulo, @toEx, @toFoxBin2Prg ) - ENDPROC + Procedure convert +*--------------------------------------------------------------------------------------------------- +* PARÁMETROS: (v=Pasar por valor | @=Pasar por referencia) (!=Obligatorio | ?=Opcional) (IN/OUT) +* toModulo (!@ OUT) Objeto generado de clase correspondiente con la información leida del texto +* toEx (!@ OUT) Objeto con información del error +* toFoxBin2Prg (!@ IN ) Referencia al objeto principal +*--------------------------------------------------------------------------------------------------- + Lparameters toModulo, toEx As Exception, toFoxBin2Prg + #If .F. + Local toFoxBin2Prg As c_foxbin2prg Of 'FOXBIN2PRG.PRG' + #Endif + DoDefault( @toModulo, @toEx, @toFoxBin2Prg ) + Endproc - FUNCTION get_ValueByName_FromListNamesWithValues - *-- ASIGNO EL VALOR DEL ARRAY DE DATOS Y VALORES PARA LA PROPIEDAD INDICADA - LPARAMETERS tcPropName, tcValueType, taPropsAndValues - LOCAL lnPos, luPropValue + Function get_ValueByName_FromListNamesWithValues +*-- ASIGNO EL VALOR DEL ARRAY DE DATOS Y VALORES PARA LA PROPIEDAD INDICADA + Lparameters tcPropName, tcValueType, taPropsAndValues + Local lnPos, luPropValue - lnPos = ASCAN( taPropsAndValues, tcPropName, 1, 0, 1, 1+2+4+8) + lnPos = Ascan( taPropsAndValues, tcPropName, 1, 0, 1, 1+2+4+8) - IF lnPos = 0 OR EMPTY( taPropsAndValues( lnPos, 2 ) ) - *-- Valores no encontrados o vacíos + If lnPos = 0 Or Empty( taPropsAndValues( lnPos, 2 ) ) +*-- Valores no encontrados o vacíos luPropValue = '' - ELSE + Else luPropValue = taPropsAndValues( lnPos, 2 ) - ENDIF + Endif - DO CASE - CASE tcValueType = 'I' - luPropValue = CAST( luPropValue AS INTEGER ) + Do Case + Case tcValueType = 'I' + luPropValue = Cast( luPropValue As Integer ) - CASE tcValueType = 'N' - luPropValue = CAST( luPropValue AS DOUBLE ) + Case tcValueType = 'N' + luPropValue = Cast( luPropValue As Double ) - CASE tcValueType = 'T' - luPropValue = CAST( luPropValue AS DATETIME ) + Case tcValueType = 'T' + luPropValue = Cast( luPropValue As Datetime ) - CASE tcValueType = 'D' - luPropValue = CAST( luPropValue AS DATE ) + Case tcValueType = 'D' + luPropValue = Cast( luPropValue As Date ) - CASE tcValueType = 'E' - luPropValue = EVALUATE( luPropValue ) + Case tcValueType = 'E' + luPropValue = Evaluate( luPropValue ) - OTHERWISE && Asumo 'C' para lo demás - luPropValue = luPropValue + Otherwise && Asumo 'C' para lo demás + luPropValue = luPropValue - ENDCASE + Endcase - RELEASE tcPropName, tcValueType, taPropsAndValues, lnPos - RETURN luPropValue - ENDFUNC + Release tcPropName, tcValueType, taPropsAndValues, lnPos + Return luPropValue + Endfunc - PROCEDURE analyzeCodeBlock_FoxBin2Prg - *------------------------------------------------------ - *-- Analiza el bloque - *------------------------------------------------------ - LPARAMETERS toModulo, tcLine, taCodeLines, I, tnCodeLines + Procedure analyzeCodeBlock_FoxBin2Prg +*------------------------------------------------------ +*-- Analiza el bloque +*------------------------------------------------------ + Lparameters toModulo, tcLine, taCodeLines, I, tnCodeLines - LOCAL llBloqueEncontrado, laPropsAndValues(1,2), lnPropsAndValues_Count + Local llBloqueEncontrado, laPropsAndValues(1,2), lnPropsAndValues_Count - IF UPPER( LEFT( tcLine + ' ', LEN(C_FB2PRG_META_I) + 1 ) ) == C_FB2PRG_META_I + ' ' - WITH THIS AS c_conversor_prg_a_bin OF foxbin2prg.prg + If Upper( Left( tcLine + ' ', Len(C_FB2PRG_META_I) + 1 ) ) == C_FB2PRG_META_I + ' ' + With This As c_conversor_prg_a_bin Of foxbin2prg.prg llBloqueEncontrado = .T. - *-- Metadatos del módulo +*-- Metadatos del módulo .get_ListNamesWithValuesFrom_InLine_MetadataTag( @tcLine, @laPropsAndValues, @lnPropsAndValues_Count, C_FB2PRG_META_I, C_FB2PRG_META_F ) toModulo._Version = .get_ValueByName_FromListNamesWithValues( 'Version', 'N', @laPropsAndValues ) toModulo._SourceFile = .get_ValueByName_FromListNamesWithValues( 'SourceFile', 'C', @laPropsAndValues ) - ENDWITH - ENDIF + Endwith + Endif - RELEASE toModulo, tcLine, taCodeLines, I, tnCodeLines - RETURN llBloqueEncontrado - ENDPROC + Release toModulo, tcLine, taCodeLines, I, tnCodeLines + Return llBloqueEncontrado + Endproc - PROCEDURE analyzeCodeBlock_LIBCOMMENT - *------------------------------------------------------ - *-- Analiza el bloque * - *------------------------------------------------------ - LPARAMETERS toModulo, tcLine, taCodeLines, I, tnCodeLines + Procedure analyzeCodeBlock_LIBCOMMENT +*------------------------------------------------------ +*-- Analiza el bloque * +*------------------------------------------------------ + Lparameters toModulo, tcLine, taCodeLines, I, tnCodeLines - LOCAL llBloqueEncontrado, laPropsAndValues(1,2), lnPropsAndValues_Count + Local llBloqueEncontrado, laPropsAndValues(1,2), lnPropsAndValues_Count - IF UPPER( LEFT( tcLine, LEN(C_LIBCOMMENT_I) ) ) == C_LIBCOMMENT_I + If Upper( Left( tcLine, Len(C_LIBCOMMENT_I) ) ) == C_LIBCOMMENT_I llBloqueEncontrado = .T. - *-- Metadatos del módulo - toModulo._Comment = ALLTRIM( STREXTRACT( tcLine, C_LIBCOMMENT_I, C_LIBCOMMENT_F ) ) - ENDIF +*-- Metadatos del módulo + toModulo._Comment = Alltrim( Strextract( tcLine, C_LIBCOMMENT_I, C_LIBCOMMENT_F ) ) + Endif - RELEASE toModulo, tcLine, taCodeLines, I, tnCodeLines, laPropsAndValues, lnPropsAndValues_Count - RETURN llBloqueEncontrado - ENDPROC + Release toModulo, tcLine, taCodeLines, I, tnCodeLines, laPropsAndValues, lnPropsAndValues_Count + Return llBloqueEncontrado + Endproc - PROCEDURE createProject - LPARAMETERS tcTableOrCursor && 'TABLE' or 'CURSOR' + Procedure createProject + Lparameters tcTableOrCursor && 'TABLE' or 'CURSOR' - LOCAL lcCursorName - tcTableOrCursor = EVL( tcTableOrCursor, 'TABLE' ) - lcCursorName = ICASE( tcTableOrCursor = 'TABLE', THIS.c_OutputFile, 'TABLABIN' ) + Local lcCursorName + tcTableOrCursor = Evl( tcTableOrCursor, 'TABLE' ) + lcCursorName = Icase( tcTableOrCursor = 'TABLE', This.c_OutputFile, 'TABLABIN' ) - CREATE &tcTableOrCursor. (lcCursorName) ; - ( NAME M ; - , TYPE C(1) ; - , ID N(10) ; - , TIMESTAMP N(10) ; + Create &tcTableOrCursor. (lcCursorName) ; + ( Name M ; + , Type C(1) ; + , Id N(10) ; + , Timestamp N(10) ; , OUTFILE M ; - , HOMEDIR M ; + , HomeDir M ; , EXCLUDE L ; , MAINPROG L ; , SAVECODE L ; - , DEBUG L ; - , ENCRYPT L ; + , Debug L ; + , Encrypt L ; , NOLOGO L ; , CMNTSTYLE N(1) ; , OBJREV N(5) ; , DEVINFO M ; , SYMBOLS M ; - , OBJECT M ; + , Object M ; , CKVAL N(6) ; , CPID N(5) ; , OSTYPE C(4) ; @@ -8125,51 +8137,51 @@ DEFINE CLASS c_conversor_prg_a_bin AS c_conversor_base , RESERVED1 M ; , RESERVED2 M ; , SCCDATA M ; - , LOCAL L ; - , KEY C(32) ; - , USER M ) + , Local L ; + , Key C(32) ; + , User M ) - IF tcTableOrCursor = 'TABLE' THEN - USE (THIS.c_OutputFile) ALIAS TABLABIN AGAIN SHARED - ENDIF + If tcTableOrCursor = 'TABLE' Then + Use (This.c_OutputFile) Alias TABLABIN Again Shared + Endif - ENDPROC + Endproc - PROCEDURE createProject_RecordHeader - LPARAMETERS toProject + Procedure createProject_RecordHeader + Lparameters toProject - #IF .F. - LOCAL toProject AS CL_PROJECT OF 'FOXBIN2PRG.PRG' - #ENDIF + #If .F. + Local toProject As CL_PROJECT Of 'FOXBIN2PRG.PRG' + #Endif - INSERT INTO TABLABIN ; - ( NAME ; - , TYPE ; - , TIMESTAMP ; + Insert Into TABLABIN ; + ( Name ; + , Type ; + , Timestamp ; , OUTFILE ; - , HOMEDIR ; + , HomeDir ; , SAVECODE ; - , DEBUG ; - , ENCRYPT ; + , Debug ; + , Encrypt ; , NOLOGO ; , CMNTSTYLE ; , OBJREV ; , DEVINFO ; - , OBJECT ; + , Object ; , RESERVED1 ; , RESERVED2 ; , SCCDATA ; - , LOCAL ; - , USER ; - , KEY ) ; + , Local ; + , User ; + , Key ) ; VALUES ; - ( UPPER( FORCEPATH( EVL(THIS.c_OriginalFileName,THIS.c_OutputFile), toProject._HomeDir) ) + CHR(0) ; + ( Upper( Forcepath( Evl(This.c_OriginalFileName,This.c_OutputFile), toProject._HomeDir) ) + Chr(0) ; , 'H' ; , 0 ; - , '' + CHR(0) ; - , LOWER(toProject._HomeDir) + CHR(0) ; + , '' + Chr(0) ; + , Lower(toProject._HomeDir) + Chr(0) ; , toProject._SaveCode ; , toProject._Debug ; , toProject._Encrypted ; @@ -8177,38 +8189,38 @@ DEFINE CLASS c_conversor_prg_a_bin AS c_conversor_base , toProject._CmntStyle ; , 260 ; , toProject.getRowDeviceInfo() ; - , LOWER(toProject._HomeDir) + CHR(0) ; - , UPPER( FORCEPATH( EVL(THIS.c_OriginalFileName,THIS.c_OutputFile), toProject._HomeDir) ) + CHR(0) ; + , Lower(toProject._HomeDir) + Chr(0) ; + , Upper( Forcepath( Evl(This.c_OriginalFileName,This.c_OutputFile), toProject._HomeDir) ) + Chr(0) ; , toProject._ServerHead.getRowServerInfo() ; , toProject._SccData ; , .T. ; - , STRCONV(toProject._User,14) ; - , UPPER( JUSTSTEM( THIS.c_OutputFile) ) ) + , Strconv(toProject._User,14) ; + , Upper( Juststem( This.c_OutputFile) ) ) - ENDPROC + Endproc - PROCEDURE createClasslib - LPARAMETERS tcTableOrCursor && 'TABLE' or 'CURSOR' + Procedure createClasslib + Lparameters tcTableOrCursor && 'TABLE' or 'CURSOR' - LOCAL lcCursorName - tcTableOrCursor = EVL( tcTableOrCursor, 'TABLE' ) - lcCursorName = ICASE( tcTableOrCursor = 'TABLE', THIS.c_OutputFile, 'TABLABIN' ) + Local lcCursorName + tcTableOrCursor = Evl( tcTableOrCursor, 'TABLE' ) + lcCursorName = Icase( tcTableOrCursor = 'TABLE', This.c_OutputFile, 'TABLABIN' ) - CREATE &tcTableOrCursor. (lcCursorName) ; + Create &tcTableOrCursor. (lcCursorName) ; ( PLATFORM C(8) ; , UNIQUEID C(10) ; - , TIMESTAMP N(10) ; - , CLASS M ; + , Timestamp N(10) ; + , Class M ; , CLASSLOC M ; - , BASECLASS M ; + , BaseClass M ; , OBJNAME M ; - , PARENT M ; + , Parent M ; , PROPERTIES M ; - , PROTECTED M ; + , Protected M ; , METHODS M ; - , OBJCODE M NOCPTRANS ; + , OBJCODE M NoCPTrans ; , OLE M ; , OLE2 M ; , RESERVED1 M ; @@ -8219,24 +8231,24 @@ DEFINE CLASS c_conversor_prg_a_bin AS c_conversor_base , RESERVED6 M ; , RESERVED7 M ; , RESERVED8 M ; - , USER M ) + , User M ) - IF tcTableOrCursor = 'TABLE' THEN - USE (THIS.c_OutputFile) ALIAS TABLABIN AGAIN SHARED - ENDIF + If tcTableOrCursor = 'TABLE' Then + Use (This.c_OutputFile) Alias TABLABIN Again Shared + Endif - ENDPROC + Endproc - PROCEDURE createClasslib_RecordHeader - LPARAMETERS toModulo + Procedure createClasslib_RecordHeader + Lparameters toModulo - #IF .F. - LOCAL toModulo AS CL_CLASSLIB OF 'FOXBIN2PRG.PRG' - #ENDIF + #If .F. + Local toModulo As CL_CLASSLIB Of 'FOXBIN2PRG.PRG' + #Endif - INSERT INTO TABLABIN ; + Insert Into TABLABIN ; ( PLATFORM ; , UNIQUEID ; , RESERVED1 ; @@ -8247,30 +8259,30 @@ DEFINE CLASS c_conversor_prg_a_bin AS c_conversor_base , 'VERSION = 3.00' ; , toModulo._Comment ) - ENDPROC + Endproc - PROCEDURE createForm - LPARAMETERS tcTableOrCursor && 'TABLE' or 'CURSOR' + Procedure createForm + Lparameters tcTableOrCursor && 'TABLE' or 'CURSOR' - LOCAL lcCursorName - tcTableOrCursor = EVL( tcTableOrCursor, 'TABLE' ) - lcCursorName = ICASE( tcTableOrCursor = 'TABLE', THIS.c_OutputFile, 'TABLABIN' ) + Local lcCursorName + tcTableOrCursor = Evl( tcTableOrCursor, 'TABLE' ) + lcCursorName = Icase( tcTableOrCursor = 'TABLE', This.c_OutputFile, 'TABLABIN' ) - CREATE &tcTableOrCursor. (lcCursorName) ; + Create &tcTableOrCursor. (lcCursorName) ; ( PLATFORM C(8) ; , UNIQUEID C(10) ; - , TIMESTAMP N(10) ; - , CLASS M ; + , Timestamp N(10) ; + , Class M ; , CLASSLOC M ; - , BASECLASS M ; + , BaseClass M ; , OBJNAME M ; - , PARENT M ; + , Parent M ; , PROPERTIES M ; - , PROTECTED M ; + , Protected M ; , METHODS M ; - , OBJCODE M NOCPTRANS ; + , OBJCODE M NoCPTrans ; , OLE M ; , OLE2 M ; , RESERVED1 M ; @@ -8281,24 +8293,24 @@ DEFINE CLASS c_conversor_prg_a_bin AS c_conversor_base , RESERVED6 M ; , RESERVED7 M ; , RESERVED8 M ; - , USER M ) + , User M ) - IF tcTableOrCursor = 'TABLE' THEN - USE (THIS.c_OutputFile) ALIAS TABLABIN AGAIN SHARED - ENDIF + If tcTableOrCursor = 'TABLE' Then + Use (This.c_OutputFile) Alias TABLABIN Again Shared + Endif - ENDPROC + Endproc - PROCEDURE createForm_RecordHeader - LPARAMETERS toModulo + Procedure createForm_RecordHeader + Lparameters toModulo - #IF .F. - LOCAL toModulo AS CL_CLASSLIB OF 'FOXBIN2PRG.PRG' - #ENDIF + #If .F. + Local toModulo As CL_CLASSLIB Of 'FOXBIN2PRG.PRG' + #Endif - INSERT INTO TABLABIN ; + Insert Into TABLABIN ; ( PLATFORM ; , UNIQUEID ; , RESERVED1 ; @@ -8309,18 +8321,18 @@ DEFINE CLASS c_conversor_prg_a_bin AS c_conversor_base , 'VERSION = 3.00' ; , toModulo._Comment ) - ENDPROC + Endproc - PROCEDURE createReport - LPARAMETERS tcTableOrCursor && 'TABLE' or 'CURSOR' + Procedure createReport + Lparameters tcTableOrCursor && 'TABLE' or 'CURSOR' - LOCAL lcCursorName - tcTableOrCursor = EVL( tcTableOrCursor, 'TABLE' ) - lcCursorName = ICASE( tcTableOrCursor = 'TABLE', THIS.c_OutputFile, 'TABLABIN' ) + Local lcCursorName + tcTableOrCursor = Evl( tcTableOrCursor, 'TABLE' ) + lcCursorName = Icase( tcTableOrCursor = 'TABLE', This.c_OutputFile, 'TABLABIN' ) - CREATE &tcTableOrCursor. (lcCursorName) ; + Create &tcTableOrCursor. (lcCursorName) ; ( 'PLATFORM' C(8) ; , 'UNIQUEID' C(10) ; , 'TIMESTAMP' N(10) ; @@ -8334,14 +8346,14 @@ DEFINE CLASS c_conversor_prg_a_bin AS c_conversor_base , 'WIDTH' N(9,3) ; , 'STYLE' M ; , 'PICTURE' M ; - , 'ORDER' M NOCPTRANS ; + , 'ORDER' M NoCPTrans ; , 'UNIQUE' L ; , 'COMMENT' M ; , 'ENVIRON' L ; , 'BOXCHAR' C(1) ; , 'FILLCHAR' C(1) ; , 'TAG' M ; - , 'TAG2' M NOCPTRANS ; + , 'TAG2' M NoCPTrans ; , 'PENRED' N(5) ; , 'PENGREEN' N(5) ; , 'PENBLUE' N(5) ; @@ -8397,473 +8409,473 @@ DEFINE CLASS c_conversor_prg_a_bin AS c_conversor_base , 'SUPEXPR' M ; , 'USER' M ) - IF tcTableOrCursor = 'TABLE' THEN - USE (THIS.c_OutputFile) ALIAS TABLABIN AGAIN SHARED - ENDIF + If tcTableOrCursor = 'TABLE' Then + Use (This.c_OutputFile) Alias TABLABIN Again Shared + Endif - ENDPROC + Endproc - PROCEDURE createMenu - LPARAMETERS tcTableOrCursor && 'TABLE' or 'CURSOR' + Procedure createMenu + Lparameters tcTableOrCursor && 'TABLE' or 'CURSOR' - LOCAL lcCursorName - tcTableOrCursor = EVL( tcTableOrCursor, 'TABLE' ) - lcCursorName = ICASE( tcTableOrCursor = 'TABLE', THIS.c_OutputFile, 'TABLABIN' ) + Local lcCursorName + tcTableOrCursor = Evl( tcTableOrCursor, 'TABLE' ) + lcCursorName = Icase( tcTableOrCursor = 'TABLE', This.c_OutputFile, 'TABLABIN' ) - CREATE &tcTableOrCursor. (lcCursorName) ; + Create &tcTableOrCursor. (lcCursorName) ; ( 'OBJTYPE' Numeric(2) ; , 'OBJCODE' Numeric(2) ; - , 'NAME' MEMO ; - , 'PROMPT' MEMO ; - , 'COMMAND' MEMO ; - , 'MESSAGE' MEMO ; + , 'NAME' Memo ; + , 'PROMPT' Memo ; + , 'COMMAND' Memo ; + , 'MESSAGE' Memo ; , 'PROCTYPE' Numeric(1) ; - , 'PROCEDURE' MEMO ; + , 'PROCEDURE' Memo ; , 'SETUPTYPE' Numeric(1) ; - , 'SETUP' MEMO ; + , 'SETUP' Memo ; , 'CLEANTYPE' Numeric(1) ; - , 'CLEANUP' MEMO ; - , 'MARK' CHARACTER(1) ; - , 'KEYNAME' MEMO ; - , 'KEYLABEL' MEMO ; - , 'SKIPFOR' MEMO ; + , 'CLEANUP' Memo ; + , 'MARK' Character(1) ; + , 'KEYNAME' Memo ; + , 'KEYLABEL' Memo ; + , 'SKIPFOR' Memo ; , 'NAMECHANGE' Logical ; , 'NUMITEMS' Numeric(2) ; - , 'LEVELNAME' CHARACTER(10) ; - , 'ITEMNUM' CHARACTER(3) ; - , 'COMMENT' MEMORY(4) ; + , 'LEVELNAME' Character(10) ; + , 'ITEMNUM' Character(3) ; + , 'COMMENT' Memory(4) ; , 'LOCATION' Numeric(2) ; , 'SCHEME' Numeric(2) ; , 'SYSRES' Numeric(1) ; - , 'RESNAME' MEMORY(4) ) + , 'RESNAME' Memory(4) ) - IF tcTableOrCursor = 'TABLE' THEN - USE (THIS.c_OutputFile) ALIAS TABLABIN AGAIN SHARED - ENDIF + If tcTableOrCursor = 'TABLE' Then + Use (This.c_OutputFile) Alias TABLABIN Again Shared + Endif - ENDPROC + Endproc - PROCEDURE writeBinaryFile - LPARAMETERS toModulo - ENDPROC + Procedure writeBinaryFile + Lparameters toModulo + Endproc - PROCEDURE classProps2Memo - *-------------------------------------------------------------------------------------------------------------- - * ARMA EL MEMO DE PROPERTIES CON LAS PROPIEDADES Y SUS VALORES - *-------------------------------------------------------------------------------------------------------------- - * PARÁMETROS: (v=Pasar por valor | @=Pasar por referencia) (!=Obligatorio | ?=Opcional) (IN/OUT) - * toClase (!@ IN ) Objeto de la Clase - * toFoxBin2Prg (@? IN ) Referencia al objeto principal - *-------------------------------------------------------------------------------------------------------------- - LPARAMETERS toClase, toFoxBin2Prg + Procedure classProps2Memo +*-------------------------------------------------------------------------------------------------------------- +* ARMA EL MEMO DE PROPERTIES CON LAS PROPIEDADES Y SUS VALORES +*-------------------------------------------------------------------------------------------------------------- +* PARÁMETROS: (v=Pasar por valor | @=Pasar por referencia) (!=Obligatorio | ?=Opcional) (IN/OUT) +* toClase (!@ IN ) Objeto de la Clase +* toFoxBin2Prg (@? IN ) Referencia al objeto principal +*-------------------------------------------------------------------------------------------------------------- + Lparameters toClase, toFoxBin2Prg - #IF .F. - LOCAL toClase AS CL_CLASE OF 'FOXBIN2PRG.PRG' - LOCAL toFoxBin2Prg AS c_foxbin2prg OF 'FOXBIN2PRG.PRG' - #ENDIF + #If .F. + Local toClase As CL_CLASE Of 'FOXBIN2PRG.PRG' + Local toFoxBin2Prg As c_foxbin2prg Of 'FOXBIN2PRG.PRG' + #Endif - *-- ESTRUCTURA A ANALIZAR: Propiedades normales, con CR codificado () y con CR+LF () - * HEIGHT = 2.73 - * NAME = "c1" - * prop1 = .F. && Mi prop 1 - * prop_especial_cr = Este es el valor 1 Este el 2 Y Este bajo Shift_Enter el 3 - * prop_especial_crlf = - * Este es el valor 1 - * Este el 2 - * Y Este bajo Shift_Enter el 3 - * - * WIDTH = 27.40 - * _MEMBERDATA = - * - * - * && XML Metadata for customizable properties - *-- Fin: ESTRUCTURA A ANALIZAR: +*-- ESTRUCTURA A ANALIZAR: Propiedades normales, con CR codificado () y con CR+LF () +* HEIGHT = 2.73 +* NAME = "c1" +* prop1 = .F. && Mi prop 1 +* prop_especial_cr = Este es el valor 1 Este el 2 Y Este bajo Shift_Enter el 3 +* prop_especial_crlf = +* Este es el valor 1 +* Este el 2 +* Y Este bajo Shift_Enter el 3 +* +* WIDTH = 27.40 +* _MEMBERDATA = +* +* +* && XML Metadata for customizable properties +*-- Fin: ESTRUCTURA A ANALIZAR: - TRY - LOCAL I, lcMemo, laPropsAndValues(1,2), lnPropsAndValues_Count - lcMemo = '' + Try + Local I, lcMemo, laPropsAndValues(1,2), lnPropsAndValues_Count + lcMemo = '' - IF toClase._Prop_Count > 0 - WITH THIS AS c_conversor_prg_a_bin OF foxbin2prg.prg - .updateProgressbar( 'Generating Props for Class ' + toClase._Nombre + '...', 0, 1, 2 ) - .c_ClaseActual = LOWER(toClase._BaseClass) - DIMENSION laPropsAndValues( toClase._Prop_Count, 3 ) - ACOPY( toClase._Props, laPropsAndValues ) - lnPropsAndValues_Count = toClase._Prop_Count + If toClase._Prop_Count > 0 + With This As c_conversor_prg_a_bin Of foxbin2prg.prg + .updateProgressbar( 'Generating Props for Class ' + toClase._Nombre + '...', 0, 1, 2 ) + .c_ClaseActual = Lower(toClase._BaseClass) + Dimension laPropsAndValues( toClase._Prop_Count, 3 ) + Acopy( toClase._Props, laPropsAndValues ) + lnPropsAndValues_Count = toClase._Prop_Count - *-- REORDENO LAS PROPIEDADES - .sortPropsAndValues( @laPropsAndValues, lnPropsAndValues_Count, 2 ) +*-- REORDENO LAS PROPIEDADES + .sortPropsAndValues( @laPropsAndValues, lnPropsAndValues_Count, 2 ) - *-- ARMO EL MEMO A DEVOLVER - FOR I = 1 TO lnPropsAndValues_Count - * - * Skip ZOrderSet if configured to - * - IF toFoxBin2Prg.l_RemoveZOrderSetFromProps AND ATC( '.ZOrderSet.', '.' + laPropsAndValues(m.I, 1) + '.' ) > 0 THEN - LOOP - ENDIF - lcMemo = lcMemo + laPropsAndValues(m.I,1) + ' = ' + laPropsAndValues(m.I,2) + CR_LF - ENDFOR - ENDWITH - ENDIF && toClase._Prop_Count > 0 +*-- ARMO EL MEMO A DEVOLVER + For I = 1 To lnPropsAndValues_Count +* +* Skip ZOrderSet if configured to +* + If toFoxBin2Prg.l_RemoveZOrderSetFromProps And Atc( '.ZOrderSet.', '.' + laPropsAndValues(m.I, 1) + '.' ) > 0 Then + Loop + Endif + lcMemo = lcMemo + laPropsAndValues(m.I,1) + ' = ' + laPropsAndValues(m.I,2) + CR_LF + Endfor + Endwith + Endif && toClase._Prop_Count > 0 - CATCH TO loEx - IF THIS.n_Debug > 0 AND _VFP.STARTMODE = 0 - SET STEP ON - ENDIF + Catch To loEx + If This.n_Debug > 0 And _vfp.StartMode = 0 + Set Step On + Endif - THROW + Throw - FINALLY - RELEASE toClase, I, laPropsAndValues, lnPropsAndValues_Count - ENDTRY + Finally + Release toClase, I, laPropsAndValues, lnPropsAndValues_Count + Endtry - RETURN lcMemo - ENDPROC + Return lcMemo + Endproc - PROCEDURE objectProps2Memo - *-- ARMA EL MEMO DE PROPERTIES CON LAS PROPIEDADES Y SUS VALORES - LPARAMETERS toObjeto, toClase + Procedure objectProps2Memo +*-- ARMA EL MEMO DE PROPERTIES CON LAS PROPIEDADES Y SUS VALORES + Lparameters toObjeto, toClase - #IF .F. - LOCAL toClase AS CL_CLASE OF 'FOXBIN2PRG.PRG' ; - , toObjeto AS CL_OBJETO OF 'FOXBIN2PRG.PRG' - #ENDIF + #If .F. + Local toClase As CL_CLASE Of 'FOXBIN2PRG.PRG' ; + , toObjeto As CL_OBJETO Of 'FOXBIN2PRG.PRG' + #Endif - LOCAL lcMemo, I, laPropsAndValues(1,2) + Local lcMemo, I, laPropsAndValues(1,2) lcMemo = '' - IF toObjeto._Prop_Count > 0 - WITH THIS AS c_conversor_prg_a_bin OF foxbin2prg.prg - .c_ClaseActual = LOWER(toObjeto._BaseClass) - DIMENSION laPropsAndValues( toObjeto._Prop_Count, 2 ) - ACOPY( toObjeto._Props, laPropsAndValues ) + If toObjeto._Prop_Count > 0 + With This As c_conversor_prg_a_bin Of foxbin2prg.prg + .c_ClaseActual = Lower(toObjeto._BaseClass) + Dimension laPropsAndValues( toObjeto._Prop_Count, 2 ) + Acopy( toObjeto._Props, laPropsAndValues ) - *-- REORDENO LAS PROPIEDADES +*-- REORDENO LAS PROPIEDADES .sortPropsAndValues( @laPropsAndValues, toObjeto._Prop_Count, 2 ) - *-- ARMO EL MEMO A DEVOLVER - FOR I = 1 TO toObjeto._Prop_Count +*-- ARMO EL MEMO A DEVOLVER + For I = 1 To toObjeto._Prop_Count lcMemo = lcMemo + laPropsAndValues(m.I,1) + ' = ' + laPropsAndValues(m.I,2) + CR_LF - ENDFOR - ENDWITH - ENDIF + Endfor + Endwith + Endif - RELEASE toObjeto, toClase, I, laPropsAndValues - RETURN lcMemo - ENDPROC + Release toObjeto, toClase, I, laPropsAndValues + Return lcMemo + Endproc - PROCEDURE classMethods2Memo - LPARAMETERS toClase + Procedure classMethods2Memo + Lparameters toClase - #IF .F. - LOCAL toClase AS CL_CLASE OF 'FOXBIN2PRG.PRG' - #ENDIF + #If .F. + Local toClase As CL_CLASE Of 'FOXBIN2PRG.PRG' + #Endif - LOCAL lcMemo, I, X, lcNombreObjeto ; - , loProcedure AS CL_PROCEDURE OF 'FOXBIN2PRG.PRG' + Local lcMemo, I, X, lcNombreObjeto ; + , loProcedure As CL_PROCEDURE Of 'FOXBIN2PRG.PRG' lcMemo = '' - *-- Recorrer los métodos - WITH THIS AS c_conversor_prg_a_bin OF foxbin2prg.prg - FOR I = 1 TO toClase._Procedure_Count - loProcedure = NULL +*-- Recorrer los métodos + With This As c_conversor_prg_a_bin Of foxbin2prg.prg + For I = 1 To toClase._Procedure_Count + loProcedure = Null loProcedure = toClase._Procedures(m.I) - IF loProcedure._ProcLine_Count > 0 THEN + If loProcedure._ProcLine_Count > 0 Then .updateProgressbar( 'Generating Procedure ' + toClase._Nombre + '.' + loProcedure._Nombre + '...', m.I, toClase._Procedure_Count, 2 ) - IF '.' $ loProcedure._Nombre - *-- cboNombre.InteractiveChange ==> No debe acortarse por ser método modificado de combobox heredado de la clase - *-- cntDatos.txtEdad.Valid ==> Debe acortarse si cntDatos es un objeto existente - lcNombreObjeto = LEFT( loProcedure._Nombre, AT('.', loProcedure._Nombre) - 1 ) + If '.' $ loProcedure._Nombre +*-- cboNombre.InteractiveChange ==> No debe acortarse por ser método modificado de combobox heredado de la clase +*-- cntDatos.txtEdad.Valid ==> Debe acortarse si cntDatos es un objeto existente + lcNombreObjeto = Left( loProcedure._Nombre, At('.', loProcedure._Nombre) - 1 ) - IF .findMethodsObjectByName( lcNombreObjeto, toClase ) = 0 + If .findMethodsObjectByName( lcNombreObjeto, toClase ) = 0 TEXT TO lcMemo ADDITIVE TEXTMERGE NOSHOW FLAGS 1 PRETEXT 1+2 <> <> ENDTEXT - *lcMemo = lcMemo + C_PROCEDURE + ' ' + loProcedure._Nombre - ELSE +*lcMemo = lcMemo + C_PROCEDURE + ' ' + loProcedure._Nombre + Else TEXT TO lcMemo ADDITIVE TEXTMERGE NOSHOW FLAGS 1 PRETEXT 1+2 <> <> ENDTEXT - *lcMemo = lcMemo + C_PROCEDURE + ' ' + SUBSTR( loProcedure._Nombre, AT('.', loProcedure._Nombre) + 1 ) - ENDIF - ELSE +*lcMemo = lcMemo + C_PROCEDURE + ' ' + SUBSTR( loProcedure._Nombre, AT('.', loProcedure._Nombre) + 1 ) + Endif + Else TEXT TO lcMemo ADDITIVE TEXTMERGE NOSHOW FLAGS 1 PRETEXT 1+2 <> <> ENDTEXT - *lcMemo = lcMemo + C_PROCEDURE + ' ' + loProcedure._Nombre - ENDIF +*lcMemo = lcMemo + C_PROCEDURE + ' ' + loProcedure._Nombre + Endif - *-- Incluir las líneas del método - *.updateProgressbar( 'Generating Lines of Procedure ' + toClase._Nombre + '.' + loProcedure._Nombre + '...', m.I, toClase._Procedure_Count, 2 ) - FOR X = 1 TO loProcedure._ProcLine_Count - *TEXT TO lcMemo ADDITIVE TEXTMERGE NOSHOW FLAGS 1+2 PRETEXT 1+2 - * <> - *ENDTEXT - lcMemo = lcMemo + CHR(13) + CHR(10) + loProcedure._ProcLines(m.X) - ENDFOR +*-- Incluir las líneas del método +*.updateProgressbar( 'Generating Lines of Procedure ' + toClase._Nombre + '.' + loProcedure._Nombre + '...', m.I, toClase._Procedure_Count, 2 ) + For X = 1 To loProcedure._ProcLine_Count +*TEXT TO lcMemo ADDITIVE TEXTMERGE NOSHOW FLAGS 1+2 PRETEXT 1+2 +* <> +*ENDTEXT + lcMemo = lcMemo + Chr(13) + Chr(10) + loProcedure._ProcLines(m.X) + Endfor TEXT TO lcMemo ADDITIVE TEXTMERGE NOSHOW FLAGS 1+2 PRETEXT 1+2 <> <<>> ENDTEXT - ENDIF - ENDFOR - ENDWITH + Endif + Endfor + Endwith - loProcedure = NULL - RELEASE toClase, I, X, lcNombreObjeto, loProcedure - RETURN lcMemo - ENDPROC + loProcedure = Null + Release toClase, I, X, lcNombreObjeto, loProcedure + Return lcMemo + Endproc - PROCEDURE objectMethods2Memo - LPARAMETERS toObjeto, toClase + Procedure objectMethods2Memo + Lparameters toObjeto, toClase - #IF .F. - LOCAL toClase AS CL_CLASE OF 'FOXBIN2PRG.PRG' ; - , toObjeto AS CL_OBJETO OF 'FOXBIN2PRG.PRG' - #ENDIF + #If .F. + Local toClase As CL_CLASE Of 'FOXBIN2PRG.PRG' ; + , toObjeto As CL_OBJETO Of 'FOXBIN2PRG.PRG' + #Endif - LOCAL lcMemo, I, X, lcNombreObjeto ; - , loProcedure AS CL_PROCEDURE OF 'FOXBIN2PRG.PRG' + Local lcMemo, I, X, lcNombreObjeto ; + , loProcedure As CL_PROCEDURE Of 'FOXBIN2PRG.PRG' lcMemo = '' - *-- Recorrer los métodos - THIS.updateProgressbar( 'Generating Object Methods for ' + toClase._Nombre + '.' + toObjeto._ObjName + '...', 0, 1, 2 ) - FOR I = 1 TO toObjeto._Procedure_Count - loProcedure = NULL +*-- Recorrer los métodos + This.updateProgressbar( 'Generating Object Methods for ' + toClase._Nombre + '.' + toObjeto._ObjName + '...', 0, 1, 2 ) + For I = 1 To toObjeto._Procedure_Count + loProcedure = Null loProcedure = toObjeto._Procedures(m.I) TEXT TO lcMemo ADDITIVE TEXTMERGE NOSHOW FLAGS 1 PRETEXT 1+2 <> <> ENDTEXT - *-- Incluir las líneas del método - FOR X = 1 TO loProcedure._ProcLine_Count - lcMemo = lcMemo + CHR(13) + CHR(10) + loProcedure._ProcLines(m.X) - ENDFOR +*-- Incluir las líneas del método + For X = 1 To loProcedure._ProcLine_Count + lcMemo = lcMemo + Chr(13) + Chr(10) + loProcedure._ProcLines(m.X) + Endfor TEXT TO lcMemo ADDITIVE TEXTMERGE NOSHOW FLAGS 1+2 PRETEXT 1+2 <> <<>> ENDTEXT - ENDFOR + Endfor - loProcedure = NULL - RELEASE toObjeto, toClase, I, X, lcNombreObjeto, loProcedure - RETURN lcMemo - ENDPROC + loProcedure = Null + Release toObjeto, toClase, I, X, lcNombreObjeto, loProcedure + Return lcMemo + Endproc - PROCEDURE getClassPropertyComment - *-- Devuelve el comentario (columna 2 del array toClase._Props) de la propiedad indicada, - *-- buscándola en la columna 2 por su nombre. - LPARAMETERS tcPropName AS STRING, toClase + Procedure getClassPropertyComment +*-- Devuelve el comentario (columna 2 del array toClase._Props) de la propiedad indicada, +*-- buscándola en la columna 2 por su nombre. + Lparameters tcPropName As String, toClase - #IF .F. - LOCAL toClase AS CL_CLASE OF 'FOXBIN2PRG.PRG' - #ENDIF + #If .F. + Local toClase As CL_CLASE Of 'FOXBIN2PRG.PRG' + #Endif - LOCAL I, lcComentario + Local I, lcComentario lcComentario = '' - FOR I = 1 TO toClase._Prop_Count - IF RTRIM( GETWORDNUM( toClase._Props(m.I,1), 1, '=' ) ) == tcPropName + For I = 1 To toClase._Prop_Count + If Rtrim( Getwordnum( toClase._Props(m.I,1), 1, '=' ) ) == tcPropName lcComentario = toClase._Props( m.I, 2 ) - EXIT - ENDIF - ENDFOR + Exit + Endif + Endfor - RELEASE tcPropName, toClase, I - RETURN lcComentario - ENDPROC + Release tcPropName, toClase, I + Return lcComentario + Endproc - PROCEDURE getClassMethodComment - *--------------------------------------------------------------------------------------------------- - * 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 + Procedure getClassMethodComment +*--------------------------------------------------------------------------------------------------- +* 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 + #If .F. + Local toClase As CL_CLASE Of 'FOXBIN2PRG.PRG' + #Endif - LOCAL lnATC + Local lnATC tcComment = '' - lnATC = ATC("HELPSTRING", tcLine) + lnATC = Atc("HELPSTRING", tcLine) - IF lnATC > 0 - tcComment = ALLTRIM(SUBSTR(tcLine, lnATC + 10 )) + If lnATC > 0 + tcComment = Alltrim(Substr(tcLine, lnATC + 10 )) - * Quitar comillas - tcComment = SUBSTR(tcComment, 2, LEN(tcComment) - 2) +* Quitar comillas + tcComment = Substr(tcComment, 2, Len(tcComment) - 2) - tcLine = RTRIM(LEFT(tcLine, lnATC - 1 ), 0, CHR(9), CHR(0), ' ') - ENDIF + tcLine = Rtrim(Left(tcLine, lnATC - 1 ), 0, Chr(9), Chr(0), ' ') + Endif - RETURN tcComment - ENDPROC + Return tcComment + Endproc - PROCEDURE getTextFrom_BIN_FileStructure - TRY - LOCAL lcStructure, lnSelect - lnSelect = SELECT() - SELECT 0 - USE (THIS.c_InputFile) SHARED AGAIN ALIAS _TABLABIN - COPY STRUCTURE EXTENDED TO ( FORCEPATH( '_FRX_STRUC.DBF', ADDBS( THIS.c_TempDir ) ) ) - **** CONTINUAR SI ES NECESARIO - SIN USO POR AHORA /// DO NOT USE - NOT IMPLEMENTED! + Procedure getTextFrom_BIN_FileStructure + Try + Local lcStructure, lnSelect + lnSelect = Select() + Select 0 + Use (This.c_InputFile) Shared Again Alias _TABLABIN + Copy Structure Extended To ( Forcepath( '_FRX_STRUC.DBF', Addbs( This.c_TempDir ) ) ) +**** CONTINUAR SI ES NECESARIO - SIN USO POR AHORA /// DO NOT USE - NOT IMPLEMENTED! - CATCH TO loEx - THROW + Catch To loEx + Throw - FINALLY - USE IN (SELECT("_TABLABIN")) - SELECT (lnSelect) - ENDTRY + Finally + Use In (Select("_TABLABIN")) + Select (lnSelect) + Endtry - RETURN lcStructure - ENDPROC + Return lcStructure + Endproc - PROCEDURE defined_PAM2Memo - *-------------------------------------------------------------------------------------------------------------- - * PARÁMETROS: (v=Pasar por valor | @=Pasar por referencia) (!=Obligatorio | ?=Opcional) (IN/OUT) - * toClase (!@ IN ) Objeto de la Clase - *-------------------------------------------------------------------------------------------------------------- - LPARAMETERS toClase - RETURN toClase._Defined_PAM - ENDPROC + Procedure defined_PAM2Memo +*-------------------------------------------------------------------------------------------------------------- +* PARÁMETROS: (v=Pasar por valor | @=Pasar por referencia) (!=Obligatorio | ?=Opcional) (IN/OUT) +* toClase (!@ IN ) Objeto de la Clase +*-------------------------------------------------------------------------------------------------------------- + Lparameters toClase + Return toClase._Defined_PAM + Endproc - PROCEDURE strip_Dimensions - LPARAMETERS tcSeparatedCommaVars - LOCAL lnPos1, lnPos2, I + Procedure strip_Dimensions + Lparameters tcSeparatedCommaVars + Local lnPos1, lnPos2, I - FOR I = OCCURS( '[', tcSeparatedCommaVars ) TO 1 STEP -1 - lnPos1 = AT( '[', tcSeparatedCommaVars, m.I ) - lnPos2 = AT( ']', tcSeparatedCommaVars, m.I ) - tcSeparatedCommaVars = STUFF( tcSeparatedCommaVars, lnPos1, lnPos2 - lnPos1 + 1, '' ) - ENDFOR + For I = Occurs( '[', tcSeparatedCommaVars ) To 1 Step -1 + lnPos1 = At( '[', tcSeparatedCommaVars, m.I ) + lnPos2 = At( ']', tcSeparatedCommaVars, m.I ) + tcSeparatedCommaVars = Stuff( tcSeparatedCommaVars, lnPos1, lnPos2 - lnPos1 + 1, '' ) + Endfor - RELEASE tcSeparatedCommaVars, lnPos1, lnPos2, I - RETURN - ENDPROC + Release tcSeparatedCommaVars, lnPos1, lnPos2, I + Return + Endproc - PROCEDURE hiddenAndProtected_PAM - LPARAMETERS toClase + Procedure hiddenAndProtected_PAM + Lparameters toClase - #IF .F. - LOCAL toClase AS CL_CLASE OF 'FOXBIN2PRG.PRG' - #ENDIF + #If .F. + Local toClase As CL_CLASE Of 'FOXBIN2PRG.PRG' + #Endif - LOCAL lcMemo, I, lcPAM, lcComentario + Local lcMemo, I, lcPAM, lcComentario lcMemo = '' - WITH THIS AS c_conversor_prg_a_bin OF 'FOXBIN2PRG.PRG' + With This As c_conversor_prg_a_bin Of 'FOXBIN2PRG.PRG' .evaluate_PAM( @lcMemo, toClase._ProtectedProps, 'property', 'protected' ) .evaluate_PAM( @lcMemo, toClase._HiddenProps, 'property', 'hidden' ) .evaluate_PAM( @lcMemo, toClase._ProtectedMethods, 'method', 'protected' ) .evaluate_PAM( @lcMemo, toClase._HiddenMethods, 'method', 'hidden' ) - ENDWITH && THIS + Endwith && THIS - RELEASE toClase, I, lcPAM, lcComentario - RETURN lcMemo - ENDPROC + Release toClase, I, lcPAM, lcComentario + Return lcMemo + Endproc - PROCEDURE evaluate_PAM - LPARAMETERS tcMemo AS STRING, tcPAM AS STRING, tcPAM_Type AS STRING, tcPAM_Visibility AS STRING + Procedure evaluate_PAM + Lparameters tcMemo As String, tcPAM As String, tcPAM_Type As String, tcPAM_Visibility As String - LOCAL lcPAM, I + Local lcPAM, I - FOR I = 1 TO OCCURS( ',', tcPAM + ',' ) - lcPAM = ALLTRIM( GETWORDNUM( tcPAM, m.I, ',' ) ) + For I = 1 To Occurs( ',', tcPAM + ',' ) + lcPAM = Alltrim( Getwordnum( tcPAM, m.I, ',' ) ) - IF NOT EMPTY(lcPAM) - IF EVL(tcPAM_Visibility, 'normal') == 'hidden' + If Not Empty(lcPAM) + If Evl(tcPAM_Visibility, 'normal') == 'hidden' lcPAM = lcPAM + '^' - ENDIF + Endif tcMemo = tcMemo + lcPAM + CR_LF - ENDIF - ENDFOR + Endif + Endfor - RELEASE tcMemo, tcPAM, tcPAM_Type, tcPAM_Visibility, lcPAM, I - RETURN - ENDPROC + Release tcMemo, tcPAM, tcPAM_Type, tcPAM_Visibility, lcPAM, I + Return + Endproc - PROCEDURE insert_Object - LPARAMETERS toClase, toObjeto, toFoxBin2Prg + Procedure insert_Object + Lparameters toClase, toObjeto, toFoxBin2Prg - #IF .F. - LOCAL toClase AS CL_CLASE OF 'FOXBIN2PRG.PRG' - LOCAL toFoxBin2Prg AS c_foxbin2prg OF 'FOXBIN2PRG.PRG' - LOCAL toObjeto AS CL_OBJETO OF 'FOXBIN2PRG.PRG' - #ENDIF + #If .F. + Local toClase As CL_CLASE Of 'FOXBIN2PRG.PRG' + Local toFoxBin2Prg As c_foxbin2prg Of 'FOXBIN2PRG.PRG' + Local toObjeto As CL_OBJETO Of 'FOXBIN2PRG.PRG' + #Endif - WITH THIS AS c_conversor_prg_a_bin OF 'FOXBIN2PRG.PRG' - IF NOT .l_Test - LOCAL lcPropsMemo, lcMethodsMemo + With This As c_conversor_prg_a_bin Of 'FOXBIN2PRG.PRG' + If Not .l_Test + Local lcPropsMemo, lcMethodsMemo lcPropsMemo = .objectProps2Memo( toObjeto, toClase ) lcMethodsMemo = .objectMethods2Memo( toObjeto, toClase ) - IF EMPTY(toObjeto._TimeStamp) + If Empty(toObjeto._TimeStamp) toObjeto._TimeStamp = .rowTimeStamp( {^2013/11/04 20:00:00} ) - ENDIF - IF EMPTY(toObjeto._UniqueID) + Endif + If Empty(toObjeto._UniqueID) toObjeto._UniqueID = toFoxBin2Prg.unique_ID() - ENDIF + Endif - *-- Inserto el objeto - IF JUSTEXT(toFoxBin2Prg.c_InputFile) = toFoxBin2Prg.c_PJ2 - * Solo los PJX/PJ2 tienen el campo DEVINFO - INSERT INTO TABLABIN ; +*-- Inserto el objeto + If Justext(toFoxBin2Prg.c_InputFile) = toFoxBin2Prg.c_PJ2 +* Solo los PJX/PJ2 tienen el campo DEVINFO + Insert Into TABLABIN ; ( PLATFORM ; , UNIQUEID ; - , TIMESTAMP ; - , CLASS ; + , Timestamp ; + , Class ; , CLASSLOC ; - , BASECLASS ; + , BaseClass ; , OBJNAME ; - , PARENT ; + , Parent ; , PROPERTIES ; - , PROTECTED ; + , Protected ; , METHODS ; , OLE ; , OLE2 ; @@ -8875,7 +8887,7 @@ DEFINE CLASS c_conversor_prg_a_bin AS c_conversor_base , RESERVED6 ; , RESERVED7 ; , RESERVED8 ; - , USER ; + , User ; , DEVINFO ) ; VALUES ; ( 'WINDOWS' ; @@ -8899,20 +8911,20 @@ DEFINE CLASS c_conversor_prg_a_bin AS c_conversor_base , '' ; , '' ; , '' ; - , STRCONV(toObjeto._User,14) ; - , STRCONV(toObjeto._DevInfo,14) ) - ELSE - INSERT INTO TABLABIN ; + , Strconv(toObjeto._User,14) ; + , Strconv(toObjeto._DevInfo,14) ) + Else + Insert Into TABLABIN ; ( PLATFORM ; , UNIQUEID ; - , TIMESTAMP ; - , CLASS ; + , Timestamp ; + , Class ; , CLASSLOC ; - , BASECLASS ; + , BaseClass ; , OBJNAME ; - , PARENT ; + , Parent ; , PROPERTIES ; - , PROTECTED ; + , Protected ; , METHODS ; , OLE ; , OLE2 ; @@ -8924,7 +8936,7 @@ DEFINE CLASS c_conversor_prg_a_bin AS c_conversor_base , RESERVED6 ; , RESERVED7 ; , RESERVED8 ; - , USER ) ; + , User ) ; VALUES ; ( 'WINDOWS' ; , toObjeto._UniqueID ; @@ -8947,1489 +8959,1489 @@ DEFINE CLASS c_conversor_prg_a_bin AS c_conversor_base , '' ; , '' ; , '' ; - , STRCONV(toObjeto._User,14) ) - ENDIF - ENDIF - ENDWITH && THIS + , Strconv(toObjeto._User,14) ) + Endif + Endif + Endwith && THIS - RELEASE toClase, toObjeto, toFoxBin2Prg, lcPropsMemo, lcMethodsMemo - RETURN - ENDPROC + Release toClase, toObjeto, toFoxBin2Prg, lcPropsMemo, lcMethodsMemo + Return + Endproc - PROCEDURE insert_AllObjects - *-- Recorro primero los objetos con ZOrder definido, y luego los demás - *-- NOTA: Como consecuencia de una integración de código, puede que se hayan agregado objetos nuevos (desconocidos), - *-- pero todo lo demás tiene un ZOrder definido, que es el número de registro original * 100. - LPARAMETERS toClase, toFoxBin2Prg + Procedure insert_AllObjects +*-- Recorro primero los objetos con ZOrder definido, y luego los demás +*-- NOTA: Como consecuencia de una integración de código, puede que se hayan agregado objetos nuevos (desconocidos), +*-- pero todo lo demás tiene un ZOrder definido, que es el número de registro original * 100. + Lparameters toClase, toFoxBin2Prg - #IF .F. - LOCAL toClase AS CL_CLASE OF 'FOXBIN2PRG.PRG' - LOCAL toFoxBin2Prg AS c_foxbin2prg OF 'FOXBIN2PRG.PRG' - #ENDIF + #If .F. + Local toClase As CL_CLASE Of 'FOXBIN2PRG.PRG' + Local toFoxBin2Prg As c_foxbin2prg Of 'FOXBIN2PRG.PRG' + #Endif - TRY - LOCAL N, X, lcObjName, loObjeto AS CL_OBJETO OF 'FOXBIN2PRG.PRG' - loObjeto = NULL + Try + Local N, X, lcObjName, loObjeto As CL_OBJETO Of 'FOXBIN2PRG.PRG' + loObjeto = Null - WITH THIS AS c_conversor_prg_a_bin OF 'FOXBIN2PRG.PRG' - IF toClase._AddObject_Count > 0 - N = 0 + With This As c_conversor_prg_a_bin Of 'FOXBIN2PRG.PRG' + If toClase._AddObject_Count > 0 + N = 0 - *-- Armo array con el orden Z de los objetos - DIMENSION laObjNames( toClase._AddObject_Count, 2 ) +*-- Armo array con el orden Z de los objetos + Dimension laObjNames( toClase._AddObject_Count, 2 ) - FOR X = 1 TO toClase._AddObject_Count - loObjeto = toClase._AddObjects( m.X ) + For X = 1 To toClase._AddObject_Count + loObjeto = toClase._AddObjects( m.X ) - IF EMPTY(loObjeto._TimeStamp) - loObjeto._TimeStamp = .rowTimeStamp( {^2013/11/04 20:00:00} ) - ENDIF - IF EMPTY(loObjeto._UniqueID) - loObjeto._UniqueID = toFoxBin2Prg.unique_ID() - ENDIF + If Empty(loObjeto._TimeStamp) + loObjeto._TimeStamp = .rowTimeStamp( {^2013/11/04 20:00:00} ) + Endif + If Empty(loObjeto._UniqueID) + loObjeto._UniqueID = toFoxBin2Prg.unique_ID() + Endif - laObjNames( m.X, 1 ) = loObjeto._Nombre - laObjNames( m.X, 2 ) = loObjeto._ZOrder - loObjeto = NULL - ENDFOR + laObjNames( m.X, 1 ) = loObjeto._Nombre + laObjNames( m.X, 2 ) = loObjeto._ZOrder + loObjeto = Null + Endfor - ASORT( laObjNames, 2, -1, 0, 1 ) + Asort( laObjNames, 2, -1, 0, 1 ) - *-- Escribo los objetos en el orden Z - FOR X = 1 TO toClase._AddObject_Count - lcObjName = laObjNames( m.X, 1 ) +*-- Escribo los objetos en el orden Z + For X = 1 To toClase._AddObject_Count + lcObjName = laObjNames( m.X, 1 ) - FOR EACH loObjeto IN toClase._AddObjects FOXOBJECT - *-- Verifico que sea el objeto que corresponde - IF loObjeto._WriteOrder = 0 AND LOWER(loObjeto._Nombre) == LOWER(lcObjName) - N = N + 1 - loObjeto._WriteOrder = N + For Each loObjeto In toClase._AddObjects FoxObject +*-- Verifico que sea el objeto que corresponde + If loObjeto._WriteOrder = 0 And Lower(loObjeto._Nombre) == Lower(lcObjName) + N = N + 1 + loObjeto._WriteOrder = N + .insert_Object( @toClase, @loObjeto, @toFoxBin2Prg ) + Exit + Endif + Endfor + Endfor + + +*-- Recorro los objetos Desconocidos + For Each loObjeto In toClase._AddObjects FoxObject + If loObjeto._WriteOrder = 0 .insert_Object( @toClase, @loObjeto, @toFoxBin2Prg ) - EXIT - ENDIF - ENDFOR - ENDFOR + Endif + Endfor + Endif && toClase._AddObject_Count > 0 + Endwith && THIS - *-- Recorro los objetos Desconocidos - FOR EACH loObjeto IN toClase._AddObjects FOXOBJECT - IF loObjeto._WriteOrder = 0 - .insert_Object( @toClase, @loObjeto, @toFoxBin2Prg ) - ENDIF - ENDFOR + Catch To loEx + If This.n_Debug > 0 And _vfp.StartMode = 0 + Set Step On + Endif - ENDIF && toClase._AddObject_Count > 0 - ENDWITH && THIS + Throw - CATCH TO loEx - IF THIS.n_Debug > 0 AND _VFP.STARTMODE = 0 - SET STEP ON - ENDIF + Finally + loObjeto = Null + Release toClase, toFoxBin2Prg, N, X, lcObjName, loObjeto - THROW + Endtry - FINALLY - loObjeto = NULL - RELEASE toClase, toFoxBin2Prg, N, X, lcObjName, loObjeto - - ENDTRY - - RETURN - ENDPROC + Return + Endproc - PROCEDURE set_Line - LPARAMETERS tcLine, taCodeLines, I - tcLine = LTRIM( taCodeLines(m.I), 0, CHR(9), ' ' ) - ENDPROC + Procedure set_Line + Lparameters tcLine, taCodeLines, I + tcLine = Ltrim( taCodeLines(m.I), 0, Chr(9), ' ' ) + Endproc - PROCEDURE analyzeProcedureLines - LPARAMETERS toClase, toObjeto, tcLine, taCodeLines, I, tnCodeLines, tcProcedureAbierto, tc_Comentario ; + Procedure analyzeProcedureLines + Lparameters toClase, toObjeto, tcLine, taCodeLines, I, tnCodeLines, tcProcedureAbierto, tc_Comentario ; , taLineasExclusion, tnBloquesExclusion - EXTERNAL ARRAY taCodeLines + External Array taCodeLines - #IF .F. - LOCAL toObjeto AS CL_OBJETO OF 'FOXBIN2PRG.PRG' - LOCAL toClase AS CL_CLASE OF 'FOXBIN2PRG.PRG' - #ENDIF + #If .F. + Local toObjeto As CL_OBJETO Of 'FOXBIN2PRG.PRG' + Local toClase As CL_CLASE Of 'FOXBIN2PRG.PRG' + #Endif - TRY - LOCAL llEsProcedureDeClase ; - , loProcedure AS CL_PROCEDURE OF 'FOXBIN2PRG.PRG' ; - , loLang as CL_LANG OF 'FOXBIN2PRG.PRG' - loLang = _SCREEN.o_FoxBin2Prg_Lang - loProcedure = NULL + Try + Local llEsProcedureDeClase ; + , loProcedure As CL_PROCEDURE Of 'FOXBIN2PRG.PRG' ; + , loLang As CL_LANG Of 'FOXBIN2PRG.PRG' + loLang = _Screen.o_FoxBin2Prg_Lang + loProcedure = Null - IF '.' $ tcProcedureAbierto AND VARTYPE(toObjeto) = 'O' AND toObjeto._Procedure_Count > 0 - loProcedure = toObjeto._Procedures(toObjeto._Procedure_Count) - ELSE - llEsProcedureDeClase = .T. - loProcedure = toClase._Procedures(toClase._Procedure_Count) - ENDIF + If '.' $ tcProcedureAbierto And Vartype(toObjeto) = 'O' And toObjeto._Procedure_Count > 0 + loProcedure = toObjeto._Procedures(toObjeto._Procedure_Count) + Else + llEsProcedureDeClase = .T. + loProcedure = toClase._Procedures(toClase._Procedure_Count) + Endif - WITH THIS AS c_conversor_prg_a_bin OF 'FOXBIN2PRG.PRG' - FOR I = m.I + 1 TO tnCodeLines - .set_Line( @tcLine, @taCodeLines, m.I ) + With This As c_conversor_prg_a_bin Of 'FOXBIN2PRG.PRG' + For I = m.I + 1 To tnCodeLines + .set_Line( @tcLine, @taCodeLines, m.I ) - IF NOT .excludedLine( m.I, tnBloquesExclusion, @taLineasExclusion ) ; - AND NOT .lineIsOnlyCommentAndNoMetadata( @tcLine, @tc_Comentario ) + If Not .excludedLine( m.I, tnBloquesExclusion, @taLineasExclusion ) ; + AND Not .lineIsOnlyCommentAndNoMetadata( @tcLine, @tc_Comentario ) - DO CASE - CASE UPPER( LEFT( tcLine + ' ', 8 ) ) == 'ENDPROC ' ; && Fin del PROCEDURE - OR UPPER( LEFT( tcLine + ' ', 8 ) ) == 'ENDFUNC ' && Fin de la FUNCTION + Do Case + Case Upper( Left( tcLine + ' ', 8 ) ) == 'ENDPROC ' ; && Fin del PROCEDURE + Or Upper( Left( tcLine + ' ', 8 ) ) == 'ENDFUNC ' && Fin de la FUNCTION - tcProcedureAbierto = '' - EXIT + tcProcedureAbierto = '' + Exit - CASE UPPER( LEFT( tcLine + ' ', 10 ) ) == 'ENDDEFINE ' && Fin de bloque (ENDDEFINE) encontrado - IF llEsProcedureDeClase - *ERROR 'Error de anidamiento de estructuras. Se esperaba ENDPROC y se encontró ENDDEFINE en la clase ' ; - + toClase._Nombre + ' (' + loProcedure._Nombre + ')' ; - + ', línea ' + TRANSFORM(m.I) + ' del archivo ' + .c_InputFile - ERROR (TEXTMERGE(loLang.C_STRUCTURE_NESTING_ERROR_ENDPROC_EXPECTED_LOC)) - ELSE - *ERROR 'Error de anidamiento de estructuras. Se esperaba ENDPROC y se encontró ENDDEFINE en la clase ' ; - + toClase._Nombre + ' (' + toObjeto._Nombre + '.' + loProcedure._Nombre + ')' ; - + ', línea ' + TRANSFORM(m.I) + ' del archivo ' + .c_InputFile - ERROR (TEXTMERGE(loLang.C_STRUCTURE_NESTING_ERROR_ENDPROC_EXPECTED_2_LOC)) - ENDIF - ENDCASE - ENDIF + Case Upper( Left( tcLine + ' ', 10 ) ) == 'ENDDEFINE ' && Fin de bloque (ENDDEFINE) encontrado + If llEsProcedureDeClase +*ERROR 'Error de anidamiento de estructuras. Se esperaba ENDPROC y se encontró ENDDEFINE en la clase ' ; ++ toClase._Nombre + ' (' + loProcedure._Nombre + ')' ; ++ ', línea ' + TRANSFORM(m.I) + ' del archivo ' + .c_InputFile + Error (Textmerge(loLang.C_STRUCTURE_NESTING_ERROR_ENDPROC_EXPECTED_LOC)) + Else +*ERROR 'Error de anidamiento de estructuras. Se esperaba ENDPROC y se encontró ENDDEFINE en la clase ' ; ++ toClase._Nombre + ' (' + toObjeto._Nombre + '.' + loProcedure._Nombre + ')' ; ++ ', línea ' + TRANSFORM(m.I) + ' del archivo ' + .c_InputFile + Error (Textmerge(loLang.C_STRUCTURE_NESTING_ERROR_ENDPROC_EXPECTED_2_LOC)) + Endif + Endcase + Endif - *-- Quito 2 TABS de la izquierda (si se puede y si el integrador/desarrollador no la lió quitándolos) - DO CASE - CASE LEFT( taCodeLines(m.I),2 ) = C_TAB + C_TAB - loProcedure.add_Line( SUBSTR(taCodeLines(m.I), 3) ) - CASE LEFT( taCodeLines(m.I),1 ) = C_TAB - loProcedure.add_Line( SUBSTR(taCodeLines(m.I), 2) ) - OTHERWISE - loProcedure.add_Line( taCodeLines(m.I) ) - ENDCASE - ENDFOR - ENDWITH && THIS +*-- Quito 2 TABS de la izquierda (si se puede y si el integrador/desarrollador no la lió quitándolos) + Do Case + Case Left( taCodeLines(m.I),2 ) = C_TAB + C_TAB + loProcedure.add_Line( Substr(taCodeLines(m.I), 3) ) + Case Left( taCodeLines(m.I),1 ) = C_TAB + loProcedure.add_Line( Substr(taCodeLines(m.I), 2) ) + Otherwise + loProcedure.add_Line( taCodeLines(m.I) ) + Endcase + Endfor + Endwith && THIS - CATCH TO loEx - IF THIS.n_Debug > 0 AND _VFP.STARTMODE = 0 - SET STEP ON - ENDIF + Catch To loEx + If This.n_Debug > 0 And _vfp.StartMode = 0 + Set Step On + Endif - THROW + Throw - FINALLY - loProcedure = NULL - RELEASE toClase, toObjeto, tcLine, taCodeLines, I, tnCodeLines, tcProcedureAbierto, tc_Comentario ; - , taLineasExclusion, tnBloquesExclusion, llEsProcedureDeClase, loProcedure + Finally + loProcedure = Null + Release toClase, toObjeto, tcLine, taCodeLines, I, tnCodeLines, tcProcedureAbierto, tc_Comentario ; + , taLineasExclusion, tnBloquesExclusion, llEsProcedureDeClase, loProcedure - ENDTRY + Endtry - RETURN - ENDPROC + Return + Endproc - PROCEDURE analyzeCodeBlock_ADD_OBJECT - *-------------------------------------------------------------------------------------------------------------- - * PARÁMETROS: (v=Pasar por valor | @=Pasar por referencia) (!=Obligatorio | ?=Opcional) (IN/OUT) - * toModulo (!@ IN ) Objeto del Modulo - * toClase (!@ IN ) Objeto de la Clase - * tcLine (!@ IN ) Línea de datos en evaluación - * taCodeLines (!@ IN ) El array con las líneas del código de texto donde buscar - * I (!@ IN ) Número de línea en evaluación - * tnCodeLines (!@ IN ) Cantidad de líneas de código - * toFoxBin2Prg (?@ IN ) Referencia al objeto principal - *-------------------------------------------------------------------------------------------------------------- - LPARAMETERS toModulo, toClase, tcLine, I, taCodeLines, tnCodeLines, toFoxBin2Prg + Procedure analyzeCodeBlock_ADD_OBJECT +*-------------------------------------------------------------------------------------------------------------- +* PARÁMETROS: (v=Pasar por valor | @=Pasar por referencia) (!=Obligatorio | ?=Opcional) (IN/OUT) +* toModulo (!@ IN ) Objeto del Modulo +* toClase (!@ IN ) Objeto de la Clase +* tcLine (!@ IN ) Línea de datos en evaluación +* taCodeLines (!@ IN ) El array con las líneas del código de texto donde buscar +* I (!@ IN ) Número de línea en evaluación +* tnCodeLines (!@ IN ) Cantidad de líneas de código +* toFoxBin2Prg (?@ IN ) Referencia al objeto principal +*-------------------------------------------------------------------------------------------------------------- + Lparameters toModulo, toClase, tcLine, I, taCodeLines, tnCodeLines, toFoxBin2Prg - EXTERNAL ARRAY taCodeLines + External Array taCodeLines - #IF .F. - LOCAL toModulo AS CL_CLASSLIB OF 'FOXBIN2PRG.PRG' - LOCAL toClase AS CL_CLASE OF 'FOXBIN2PRG.PRG' - LOCAL toObjeto AS CL_OBJETO OF 'FOXBIN2PRG.PRG' - LOCAL toFoxBin2Prg AS c_foxbin2prg OF 'FOXBIN2PRG.PRG' - #ENDIF + #If .F. + Local toModulo As CL_CLASSLIB Of 'FOXBIN2PRG.PRG' + Local toClase As CL_CLASE Of 'FOXBIN2PRG.PRG' + Local toObjeto As CL_OBJETO Of 'FOXBIN2PRG.PRG' + Local toFoxBin2Prg As c_foxbin2prg Of 'FOXBIN2PRG.PRG' + #Endif - TRY - LOCAL llBloqueEncontrado + Try + Local llBloqueEncontrado - IF UPPER( LEFT( tcLine, 11 ) ) == 'ADD OBJECT ' - *-- Estructura a reconocer: ADD OBJECT 'frm_a.Check1' AS check [WITH] - WITH THIS AS c_conversor_prg_a_bin OF foxbin2prg.prg - LOCAL laPropsAndValues(1,2), lnPropsAndValues_Count, Z, lcProp, lcValue, lcNombre, lcObjName, lnPos ; - , loLang as CL_LANG OF 'FOXBIN2PRG.PRG' + If Upper( Left( tcLine, 11 ) ) == 'ADD OBJECT ' +*-- Estructura a reconocer: ADD OBJECT 'frm_a.Check1' AS check [WITH] + With This As c_conversor_prg_a_bin Of foxbin2prg.prg + Local laPropsAndValues(1,2), lnPropsAndValues_Count, Z, lcProp, lcValue, lcNombre, lcObjName, lnPos ; + , loLang As CL_LANG Of 'FOXBIN2PRG.PRG' + llBloqueEncontrado = .T. + loLang = _Screen.o_FoxBin2Prg_Lang + tcLine = Chrtran( tcLine, ['], ["] ) + + If Empty(toClase._Fin_Cab) + toClase._Fin_Cab = m.I-1 + toClase._Ini_Cuerpo = m.I + Endif + + toObjeto = Null + lcNombre = Alltrim( Chrtran( Strextract(tcLine, 'ADD OBJECT ', ' AS ', 1, 1), ['"], [] ) ) + lcObjName = Justext( '.' + lcNombre ) + .updateProgressbar( 'Analyzing Block Add Object ' + toClase._Nombre + '.' + lcObjName + '...', m.I, tnCodeLines, 1 ) + + If toClase.l_ObjectMetadataInHeader + For Z = 1 To toClase._AddObject_Count + If Lower(toClase._AddObjects(m.Z)._Nombre) == Lower(lcNombre) Then + toObjeto = toClase._AddObjects(m.Z) + Exit + Endif + Endfor + Endif + + If Isnull(toObjeto) + Z = 0 + toObjeto = Createobject('CL_OBJETO') +*-- Luego se reasigna el ZOrder, pero si no lo hace, se pone último como si se acabara de agregar. +*-- Puede pasar si se agrega manualmente al TX2 y se olvida agregar la metadata OBJECTDATA. + toObjeto._ZOrder = 9999 + toObjeto._Nombre = lcNombre + Endif + + toObjeto._ObjName = lcObjName + + If '.' $ toObjeto._Nombre + toObjeto._Parent = toClase._ObjName + '.' + Juststem( toObjeto._Nombre ) + Else + toObjeto._Parent = toClase._ObjName + Endif + + toObjeto._Nombre = toObjeto._Parent + '.' + toObjeto._ObjName + toObjeto._Class = Alltrim( Strextract(tcLine + ' WITH', ' AS ', ' WITH', 1, 1) ) + +*-- Chequeo de nombre de objeto repetido para el mismo contenedor + If toClase._aPathObjName_Count > 0 + lnPos = Ascan( toClase._aPathObjNames, toObjeto._Nombre, 1, 0, 1, 1+2+4+8 ) + + If lnPos > 0 Then +*-- ERROR: Objeto Duplicado + .writeErrorLog( '* ' + loLang.C_DUPLICATED_OBJECT_LOC + ' "' + toClase._Class + '.' + toObjeto._Nombre ; + + '" @line ' + Transform(m.I) + ', (1st.Line:' + Transform(toClase._aPathObjNames(lnPos,2)) + ')' ) + Endif + Endif + + If Not toClase.l_ObjectMetadataInHeader Or m.Z=0 + toClase.add_Object( toObjeto ) + Endif + + toClase.add_PathObjName(toObjeto._Nombre, m.I) + +*-- Propiedades del ADD OBJECT + For I = m.I + 1 To tnCodeLines + .set_Line( @tcLine, @taCodeLines, m.I ) + + If Upper( Left( tcLine, C_LEN_END_OBJECT_I) ) == C_END_OBJECT_I && Fin del ADD OBJECT y METADATOS +*< END OBJECT: baseclass = "olecontrol" Uniqueid = "_3X50L3I7V" OLEObject = "C:\WINDOWS\system32\FOXTLIB.OCX" checksum = "4101493921" /> + + .get_ListNamesWithValuesFrom_InLine_MetadataTag( @tcLine, @laPropsAndValues, @lnPropsAndValues_Count ; + , C_END_OBJECT_I, C_END_OBJECT_F ) + + toObjeto._ClassLib = .get_ValueByName_FromListNamesWithValues( 'ClassLib', 'C', @laPropsAndValues ) + toObjeto._BaseClass = .get_ValueByName_FromListNamesWithValues( 'BaseClass', 'C', @laPropsAndValues ) + + If Not toClase.l_ObjectMetadataInHeader + toObjeto._UniqueID = .get_ValueByName_FromListNamesWithValues( 'UniqueID', 'C', @laPropsAndValues ) + toObjeto._TimeStamp = Int( .rowTimeStamp( .get_ValueByName_FromListNamesWithValues( 'TimeStamp', 'T', @laPropsAndValues ) ) ) + toObjeto._ZOrder = .get_ValueByName_FromListNamesWithValues( 'ZOrder', 'I', @laPropsAndValues ) + Endif + + toObjeto._Ole2 = .get_ValueByName_FromListNamesWithValues( 'OLEObject', 'C', @laPropsAndValues ) + toObjeto._Ole = Strconv( .get_ValueByName_FromListNamesWithValues( 'Value', 'C', @laPropsAndValues ), 14 ) + + If Not Empty( toObjeto._Ole2 ) && Le agrego "OLEObject = " delante + toObjeto._Ole2 = 'OLEObject = ' + toObjeto._Ole2 + CR_LF + Endif + +*-- Ubico el objeto ole por su nombre (parent+objname), que no se repite. + If Empty(toObjeto._Ole) && Si _Ole está vacío es porque el propio control no tiene la info y está en la cabecera (antiguo guardado) + If toModulo.existeObjetoOLE( toObjeto._Nombre, @m.Z ) + toObjeto._Ole = toModulo._Ole_Objs(m.Z)._Value + Endif + Endif + + Exit + Endif + + If Right(tcLine, 3) == ', ;' && VALOR INTERMEDIO CON ", ;" + .get_SeparatedPropAndValue( Left(tcLine, Len(tcLine) - 3), @lcProp, @lcValue, toClase, @taCodeLines, @tnCodeLines, @m.I ) + +* +* Skip ZOrderSet if configured to +* + If toFoxBin2Prg.l_RemoveZOrderSetFromProps And Atc( '.ZOrderSet.', '.' + lcProp + '.' ) > 0 Then + Loop + Endif + toObjeto.add_Property( @lcProp, @lcValue ) + Else && VALOR FINAL SIN ", ;" (JUSTO ANTES DEL ) + .get_SeparatedPropAndValue( tcLine, @lcProp, @lcValue, toClase, @taCodeLines, @tnCodeLines, @m.I ) + +* +* Skip ZOrderSet if configured to +* + If toFoxBin2Prg.l_RemoveZOrderSetFromProps And Atc( '.ZOrderSet.', '.' + lcProp + '.' ) > 0 Then + Loop + Endif + toObjeto.add_Property( @lcProp, @lcValue ) + Endif + + Endfor + Endwith && THIS + Endif + + Catch To loEx + loEx.UserValue = loEx.UserValue + Textmerge('Source line=<>') + CR_LF + If This.n_Debug > 0 And _vfp.StartMode = 0 + Set Step On + Endif + + Throw + + Finally + Release toModulo, toClase, tcLine, I, taCodeLines, tnCodeLines ; + , laPropsAndValues, lnPropsAndValues_Count, Z, lcProp, lcValue, lcNombre, lcObjName + Endtry + + Return llBloqueEncontrado + Endproc + + + + + Procedure analyzeCodeBlock_DEFINED_PAM +*-------------------------------------------------------------------------------------------------------------- +* 07/01/2014 FDBOZZO Los *métodos deben ir siempre al final, si no los eventos ACCESS no se ejecutan! +*-------------------------------------------------------------------------------------------------------------- +* PARÁMETROS: (v=Pasar por valor | @=Pasar por referencia) (!=Obligatorio | ?=Opcional) (IN/OUT) +* toClase (!@ IN ) Objeto de la Clase +* tcLine (!@ IN ) Línea de datos en evaluación +* taCodeLines (!@ IN ) El array con las líneas del código de texto donde buscar +* tnCodeLines (!@ IN ) Cantidad de líneas de código +* I (!@ IN ) Número de línea en evaluación +*-------------------------------------------------------------------------------------------------------------- + Lparameters toClase, tcLine, taCodeLines, tnCodeLines, I + +*-- ESTRUCTURA A ANALIZAR (también se admite sin los símbolos ^ y *): +* +*m: *metodovacio_con_comentarios && Este método no tiene código, pero tiene comentarios. A ver que pasa! +*m: *mimetodo && Mi metodo +*p: prop1 && Mi prop 1 +*p: prop_especial_cr && +*a: ^array_1_d[1,0] && Array 1 dimensión (1) +*a: ^array_2_d[1,2] && Array una dimension (1,2) +*p: _memberdata && XML Metadata for customizable properties +* + + #If .F. + Local toClase As CL_CLASE Of 'FOXBIN2PRG.PRG' + #Endif + + Try + Local llBloqueEncontrado, lcDefinedPAM, lnPos, lnPos2, lcPAM_Name, lcItem, lcMethods, lcPAM_Type + + If Left( tcLine, C_LEN_DEFINED_PAM_I) == C_DEFINED_PAM_I llBloqueEncontrado = .T. - loLang = _SCREEN.o_FoxBin2Prg_Lang - tcLine = CHRTRAN( tcLine, ['], ["] ) + Store '' To lcDefinedPAM, lcItem, lcMethods - IF EMPTY(toClase._Fin_Cab) - toClase._Fin_Cab = m.I-1 - toClase._Ini_Cuerpo = m.I - ENDIF + With This As c_conversor_prg_a_bin Of foxbin2prg.prg + For I = m.I + 1 To tnCodeLines + .set_Line( @tcLine, @taCodeLines, m.I ) - toObjeto = NULL - lcNombre = ALLTRIM( CHRTRAN( STREXTRACT(tcLine, 'ADD OBJECT ', ' AS ', 1, 1), ['"], [] ) ) - lcObjName = JUSTEXT( '.' + lcNombre ) - .updateProgressbar( 'Analyzing Block Add Object ' + toClase._Nombre + '.' + lcObjName + '...', m.I, tnCodeLines, 1 ) + Do Case + Case Left( tcLine, C_LEN_DEFINED_PAM_F ) == C_DEFINED_PAM_F + I = m.I + 1 + Exit - IF toClase.l_ObjectMetadataInHeader - FOR Z = 1 TO toClase._AddObject_Count - IF LOWER(toClase._AddObjects(m.Z)._Nombre) == LOWER(lcNombre) THEN - toObjeto = toClase._AddObjects(m.Z) - EXIT - ENDIF - ENDFOR - ENDIF + Otherwise + lnPos = At( ':', tcLine, 1 ) + lnPos2 = At( '&'+'&', tcLine ) + lcPAM_Type = Left(tcLine,3) && *p:, *a:, *m: - IF ISNULL(toObjeto) - Z = 0 - toObjeto = CREATEOBJECT('CL_OBJETO') - *-- Luego se reasigna el ZOrder, pero si no lo hace, se pone último como si se acabara de agregar. - *-- Puede pasar si se agrega manualmente al TX2 y se olvida agregar la metadata OBJECTDATA. - toObjeto._ZOrder = 9999 - toObjeto._Nombre = lcNombre - ENDIF + If lnPos2 > 0 +*-- Con comentarios + lcPAM_Name = Lower( Alltrim( Substr( tcLine, lnPos+1, lnPos2 - lnPos - 1 ), 0, ' ', Chr(9) ) ) + lcItem = lcPAM_Name + ' ' + Substr( tcLine, lnPos2 + 3 ) + CR_LF - toObjeto._ObjName = lcObjName + Else +*-- Sin comentarios + lcPAM_Name = Lower( Alltrim( Substr( tcLine, lnPos+1 ), 0, ' ', Chr(9) ) ) + lcItem = lcPAM_Name + Iif( lcPAM_Type == '*p:' , '', ' ') + CR_LF - IF '.' $ toObjeto._Nombre - toObjeto._Parent = toClase._ObjName + '.' + JUSTSTEM( toObjeto._Nombre ) - ELSE - toObjeto._Parent = toClase._ObjName - ENDIF + Endif - toObjeto._Nombre = toObjeto._Parent + '.' + toObjeto._ObjName - toObjeto._Class = ALLTRIM( STREXTRACT(tcLine + ' WITH', ' AS ', ' WITH', 1, 1) ) +*-- Separo propiedades y métodos + If lcPAM_Type == '*m:' + If Left(lcItem,1) == '*' + lcMethods = lcMethods + lcItem + Else + lcMethods = lcMethods + '*' + lcItem + Endif + Else + If lcPAM_Type == '*a:' And Left(lcItem,1) <> '^' + lcDefinedPAM = lcDefinedPAM + '^' + lcItem + Else + lcDefinedPAM = lcDefinedPAM + lcItem + Endif + Endif + Endcase + Endfor + Endwith && THIS - *-- Chequeo de nombre de objeto repetido para el mismo contenedor - IF toClase._aPathObjName_Count > 0 - lnPos = ASCAN( toClase._aPathObjNames, toObjeto._Nombre, 1, 0, 1, 1+2+4+8 ) +*-- Junto propiedades y los métodos al final. + toClase._Defined_PAM = lcDefinedPAM + lcMethods + I = m.I - 1 + Endif - IF lnPos > 0 THEN - *-- ERROR: Objeto Duplicado - .writeErrorLog( '* ' + loLang.C_DUPLICATED_OBJECT_LOC + ' "' + toClase._Class + '.' + toObjeto._Nombre ; - + '" @line ' + TRANSFORM(m.I) + ', (1st.Line:' + TRANSFORM(toClase._aPathObjNames(lnPos,2)) + ')' ) - ENDIF - ENDIF + Catch To loEx + lnCodError = loEx.ErrorNo - IF NOT toClase.l_ObjectMetadataInHeader OR m.Z=0 - toClase.add_Object( toObjeto ) - ENDIF + If This.n_Debug > 0 And _vfp.StartMode = 0 + Set Step On + Endif - toClase.add_PathObjName(toObjeto._Nombre, m.I) + Throw - *-- Propiedades del ADD OBJECT - FOR I = m.I + 1 TO tnCodeLines - .set_Line( @tcLine, @taCodeLines, m.I ) + Finally + Release toClase, tcLine, taCodeLines, tnCodeLines, I ; + , lcDefinedPAM, lnPos, lnPos2, lcPAM_Name, lcItem, lcMethods, lcPAM_Type + Endtry - IF UPPER( LEFT( tcLine, C_LEN_END_OBJECT_I) ) == C_END_OBJECT_I && Fin del ADD OBJECT y METADATOS - *< END OBJECT: baseclass = "olecontrol" Uniqueid = "_3X50L3I7V" OLEObject = "C:\WINDOWS\system32\FOXTLIB.OCX" checksum = "4101493921" /> - - .get_ListNamesWithValuesFrom_InLine_MetadataTag( @tcLine, @laPropsAndValues, @lnPropsAndValues_Count ; - , C_END_OBJECT_I, C_END_OBJECT_F ) - - toObjeto._ClassLib = .get_ValueByName_FromListNamesWithValues( 'ClassLib', 'C', @laPropsAndValues ) - toObjeto._BaseClass = .get_ValueByName_FromListNamesWithValues( 'BaseClass', 'C', @laPropsAndValues ) - - IF NOT toClase.l_ObjectMetadataInHeader - toObjeto._UniqueID = .get_ValueByName_FromListNamesWithValues( 'UniqueID', 'C', @laPropsAndValues ) - toObjeto._TimeStamp = INT( .rowTimeStamp( .get_ValueByName_FromListNamesWithValues( 'TimeStamp', 'T', @laPropsAndValues ) ) ) - toObjeto._ZOrder = .get_ValueByName_FromListNamesWithValues( 'ZOrder', 'I', @laPropsAndValues ) - ENDIF - - toObjeto._Ole2 = .get_ValueByName_FromListNamesWithValues( 'OLEObject', 'C', @laPropsAndValues ) - toObjeto._Ole = STRCONV( .get_ValueByName_FromListNamesWithValues( 'Value', 'C', @laPropsAndValues ), 14 ) - - IF NOT EMPTY( toObjeto._Ole2 ) && Le agrego "OLEObject = " delante - toObjeto._Ole2 = 'OLEObject = ' + toObjeto._Ole2 + CR_LF - ENDIF - - *-- Ubico el objeto ole por su nombre (parent+objname), que no se repite. - IF EMPTY(toObjeto._Ole) && Si _Ole está vacío es porque el propio control no tiene la info y está en la cabecera (antiguo guardado) - IF toModulo.existeObjetoOLE( toObjeto._Nombre, @m.Z ) - toObjeto._Ole = toModulo._Ole_Objs(m.Z)._Value - ENDIF - ENDIF - - EXIT - ENDIF - - IF RIGHT(tcLine, 3) == ', ;' && VALOR INTERMEDIO CON ", ;" - .get_SeparatedPropAndValue( LEFT(tcLine, LEN(tcLine) - 3), @lcProp, @lcValue, toClase, @taCodeLines, @tnCodeLines, @m.I ) - - * - * Skip ZOrderSet if configured to - * - IF toFoxBin2Prg.l_RemoveZOrderSetFromProps AND ATC( '.ZOrderSet.', '.' + lcProp + '.' ) > 0 THEN - LOOP - ENDIF - toObjeto.add_Property( @lcProp, @lcValue ) - ELSE && VALOR FINAL SIN ", ;" (JUSTO ANTES DEL ) - .get_SeparatedPropAndValue( tcLine, @lcProp, @lcValue, toClase, @taCodeLines, @tnCodeLines, @m.I ) - - * - * Skip ZOrderSet if configured to - * - IF toFoxBin2Prg.l_RemoveZOrderSetFromProps AND ATC( '.ZOrderSet.', '.' + lcProp + '.' ) > 0 THEN - LOOP - ENDIF - toObjeto.add_Property( @lcProp, @lcValue ) - ENDIF - - ENDFOR - ENDWITH && THIS - ENDIF - - CATCH TO loEx - loEx.UserValue = loEx.UserValue + TEXTMERGE('Source line=<>') + CR_LF - IF THIS.n_Debug > 0 AND _VFP.STARTMODE = 0 - SET STEP ON - ENDIF - - THROW - - FINALLY - RELEASE toModulo, toClase, tcLine, I, taCodeLines, tnCodeLines ; - , laPropsAndValues, lnPropsAndValues_Count, Z, lcProp, lcValue, lcNombre, lcObjName - ENDTRY - - RETURN llBloqueEncontrado - ENDPROC + Return llBloqueEncontrado + Endproc - PROCEDURE analyzeCodeBlock_DEFINED_PAM - *-------------------------------------------------------------------------------------------------------------- - * 07/01/2014 FDBOZZO Los *métodos deben ir siempre al final, si no los eventos ACCESS no se ejecutan! - *-------------------------------------------------------------------------------------------------------------- - * PARÁMETROS: (v=Pasar por valor | @=Pasar por referencia) (!=Obligatorio | ?=Opcional) (IN/OUT) - * toClase (!@ IN ) Objeto de la Clase - * tcLine (!@ IN ) Línea de datos en evaluación - * taCodeLines (!@ IN ) El array con las líneas del código de texto donde buscar - * tnCodeLines (!@ IN ) Cantidad de líneas de código - * I (!@ IN ) Número de línea en evaluación - *-------------------------------------------------------------------------------------------------------------- - LPARAMETERS toClase, tcLine, taCodeLines, tnCodeLines, I - - *-- ESTRUCTURA A ANALIZAR (también se admite sin los símbolos ^ y *): - * - *m: *metodovacio_con_comentarios && Este método no tiene código, pero tiene comentarios. A ver que pasa! - *m: *mimetodo && Mi metodo - *p: prop1 && Mi prop 1 - *p: prop_especial_cr && - *a: ^array_1_d[1,0] && Array 1 dimensión (1) - *a: ^array_2_d[1,2] && Array una dimension (1,2) - *p: _memberdata && XML Metadata for customizable properties - * - - #IF .F. - LOCAL toClase AS CL_CLASE OF 'FOXBIN2PRG.PRG' - #ENDIF - - TRY - LOCAL llBloqueEncontrado, lcDefinedPAM, lnPos, lnPos2, lcPAM_Name, lcItem, lcMethods, lcPAM_Type - - IF LEFT( tcLine, C_LEN_DEFINED_PAM_I) == C_DEFINED_PAM_I - llBloqueEncontrado = .T. - STORE '' TO lcDefinedPAM, lcItem, lcMethods - - WITH THIS AS c_conversor_prg_a_bin OF foxbin2prg.prg - FOR I = m.I + 1 TO tnCodeLines - .set_Line( @tcLine, @taCodeLines, m.I ) - - DO CASE - CASE LEFT( tcLine, C_LEN_DEFINED_PAM_F ) == C_DEFINED_PAM_F - I = m.I + 1 - EXIT - - OTHERWISE - lnPos = AT( ':', tcLine, 1 ) - lnPos2 = AT( '&'+'&', tcLine ) - lcPAM_Type = LEFT(tcLine,3) && *p:, *a:, *m: - - IF lnPos2 > 0 - *-- Con comentarios - lcPAM_Name = LOWER( ALLTRIM( SUBSTR( tcLine, lnPos+1, lnPos2 - lnPos - 1 ), 0, ' ', CHR(9) ) ) - lcItem = lcPAM_Name + ' ' + SUBSTR( tcLine, lnPos2 + 3 ) + CR_LF - - ELSE - *-- Sin comentarios - lcPAM_Name = LOWER( ALLTRIM( SUBSTR( tcLine, lnPos+1 ), 0, ' ', CHR(9) ) ) - lcItem = lcPAM_Name + IIF( lcPAM_Type == '*p:' , '', ' ') + CR_LF - - ENDIF - - *-- Separo propiedades y métodos - IF lcPAM_Type == '*m:' - IF LEFT(lcItem,1) == '*' - lcMethods = lcMethods + lcItem - ELSE - lcMethods = lcMethods + '*' + lcItem - ENDIF - ELSE - IF lcPAM_Type == '*a:' AND LEFT(lcItem,1) <> '^' - lcDefinedPAM = lcDefinedPAM + '^' + lcItem - ELSE - lcDefinedPAM = lcDefinedPAM + lcItem - ENDIF - ENDIF - ENDCASE - ENDFOR - ENDWITH && THIS - - *-- Junto propiedades y los métodos al final. - toClase._Defined_PAM = lcDefinedPAM + lcMethods - I = m.I - 1 - ENDIF - - CATCH TO loEx - lnCodError = loEx.ERRORNO - - IF THIS.n_Debug > 0 AND _VFP.STARTMODE = 0 - SET STEP ON - ENDIF - - THROW - - FINALLY - RELEASE toClase, tcLine, taCodeLines, tnCodeLines, I ; - , lcDefinedPAM, lnPos, lnPos2, lcPAM_Name, lcItem, lcMethods, lcPAM_Type - ENDTRY - - RETURN llBloqueEncontrado - ENDPROC - - - - - PROCEDURE analyzeCodeBlock_DEFINE_CLASS - *-------------------------------------------------------------------------------------------------------------- - * PARÁMETROS: (v=Pasar por valor | @=Pasar por referencia) (!=Obligatorio | ?=Opcional) (IN/OUT) - * toModulo (!@ IN ) Objeto del Modulo - * toClase (!@ IN ) Objeto de la Clase - * tcLine (!@ IN ) Línea de datos en evaluación - * taCodeLines (!@ IN ) El array con las líneas del código de texto donde buscar - * I (!@ IN ) Número de línea en evaluación - * tnCodeLines (!@ IN ) Cantidad de líneas de código - * tcProcedureAbierto (!v IN ) Nombre del Procedure abierto - * taLineasExclusion (!@ IN ) Array de líneas de exclusión - * tnBloquesExclusion (!@ IN ) Cantidad de líneas de exclusión - * tc_Comentario (!v IN ) Comentario - * toFoxBin2Prg (@? IN ) Referencia al objeto principal - *-------------------------------------------------------------------------------------------------------------- - LPARAMETERS toModulo, toClase, tcLine, taCodeLines, I, tnCodeLines, tcProcedureAbierto ; + Procedure analyzeCodeBlock_DEFINE_CLASS +*-------------------------------------------------------------------------------------------------------------- +* PARÁMETROS: (v=Pasar por valor | @=Pasar por referencia) (!=Obligatorio | ?=Opcional) (IN/OUT) +* toModulo (!@ IN ) Objeto del Modulo +* toClase (!@ IN ) Objeto de la Clase +* tcLine (!@ IN ) Línea de datos en evaluación +* taCodeLines (!@ IN ) El array con las líneas del código de texto donde buscar +* I (!@ IN ) Número de línea en evaluación +* tnCodeLines (!@ IN ) Cantidad de líneas de código +* tcProcedureAbierto (!v IN ) Nombre del Procedure abierto +* taLineasExclusion (!@ IN ) Array de líneas de exclusión +* tnBloquesExclusion (!@ IN ) Cantidad de líneas de exclusión +* tc_Comentario (!v IN ) Comentario +* toFoxBin2Prg (@? IN ) Referencia al objeto principal +*-------------------------------------------------------------------------------------------------------------- + Lparameters toModulo, toClase, tcLine, taCodeLines, I, tnCodeLines, tcProcedureAbierto ; , taLineasExclusion, tnBloquesExclusion, tc_Comentario, toFoxBin2Prg - EXTERNAL ARRAY taCodeLines, tnBloquesExclusion, taLineasExclusion + External Array taCodeLines, tnBloquesExclusion, taLineasExclusion - #IF .F. - LOCAL toModulo AS CL_CLASSLIB OF 'FOXBIN2PRG.PRG' - LOCAL toClase AS CL_CLASE OF 'FOXBIN2PRG.PRG' - LOCAL toFoxBin2Prg AS c_foxbin2prg OF 'FOXBIN2PRG.PRG' - #ENDIF + #If .F. + Local toModulo As CL_CLASSLIB Of 'FOXBIN2PRG.PRG' + Local toClase As CL_CLASE Of 'FOXBIN2PRG.PRG' + Local toFoxBin2Prg As c_foxbin2prg Of 'FOXBIN2PRG.PRG' + #Endif - LOCAL llBloqueEncontrado + Local llBloqueEncontrado - IF UPPER(LEFT(tcLine + ' ', 13)) == C_DEFINE_CLASS + ' ' - TRY - llBloqueEncontrado = .T. - LOCAL Z, lcProp, lcValue, loEx AS EXCEPTION ; - , llCLASSMETADATA_Completed, llPROTECTED_Completed, llHIDDEN_Completed, llDEFINED_PAM_Completed ; - , llINCLUDE_Completed, llCLASS_PROPERTY_Completed, llOBJECTMETADATA_Completed ; - , llCLASSCOMMENTS_Completed ; - , loObjeto AS CL_OBJETO OF 'FOXBIN2PRG.PRG' ; - , loLang as CL_LANG OF 'FOXBIN2PRG.PRG' + If Upper(Left(tcLine + ' ', 13)) == C_DEFINE_CLASS + ' ' + Try + llBloqueEncontrado = .T. + Local Z, lcProp, lcValue, loEx As Exception ; + , llCLASSMETADATA_Completed, llPROTECTED_Completed, llHIDDEN_Completed, llDEFINED_PAM_Completed ; + , llINCLUDE_Completed, llCLASS_PROPERTY_Completed, llOBJECTMETADATA_Completed ; + , llCLASSCOMMENTS_Completed ; + , loObjeto As CL_OBJETO Of 'FOXBIN2PRG.PRG' ; + , loLang As CL_LANG Of 'FOXBIN2PRG.PRG' - loLang = _SCREEN.o_FoxBin2Prg_Lang - STORE '' TO tcProcedureAbierto - toClase = CREATEOBJECT('CL_CLASE') - toClase._Nombre = LOWER( ALLTRIM( STREXTRACT( tcLine, 'DEFINE CLASS ', ' AS ', 1, 1 ) ) ) - toClase._ObjName = LOWER( toClase._Nombre ) - toClase._Definicion = ALLTRIM( tcLine ) - IF NOT ' OF ' $ UPPER(tcLine) && Puede no tener "OF libreria.vcx" - toClase._Class = ALLTRIM( CHRTRAN( STREXTRACT( tcLine + ' OLEPUBLIC', ' AS ', ' OLEPUBLIC', 1, 1 ), ["'], [] ) ) - ELSE - toClase._Class = ALLTRIM( CHRTRAN( STREXTRACT( tcLine + ' OF ', ' AS ', ' OF ', 1, 1 ), ["'], [] ) ) - ENDIF - toClase._ClassLoc = LOWER( ALLTRIM( CHRTRAN( STREXTRACT( tcLine + ' OLEPUBLIC', ' OF ', ' OLEPUBLIC', 1, 1 ), ["'], [] ) ) ) - toClase._OlePublic = ' OLEPUBLIC' $ UPPER(tcLine) - toClase._Comentario = tc_Comentario - toClase._Inicio = m.I - toClase._Ini_Cab = m.I + 1 + loLang = _Screen.o_FoxBin2Prg_Lang + Store '' To tcProcedureAbierto + toClase = Createobject('CL_CLASE') + toClase._Nombre = Lower( Alltrim( Strextract( tcLine, 'DEFINE CLASS ', ' AS ', 1, 1 ) ) ) + toClase._ObjName = Lower( toClase._Nombre ) + toClase._Definicion = Alltrim( tcLine ) + If Not ' OF ' $ Upper(tcLine) && Puede no tener "OF libreria.vcx" + toClase._Class = Alltrim( Chrtran( Strextract( tcLine + ' OLEPUBLIC', ' AS ', ' OLEPUBLIC', 1, 1 ), ["'], [] ) ) + Else + toClase._Class = Alltrim( Chrtran( Strextract( tcLine + ' OF ', ' AS ', ' OF ', 1, 1 ), ["'], [] ) ) + Endif + toClase._ClassLoc = Lower( Alltrim( Chrtran( Strextract( tcLine + ' OLEPUBLIC', ' OF ', ' OLEPUBLIC', 1, 1 ), ["'], [] ) ) ) + toClase._OlePublic = ' OLEPUBLIC' $ Upper(tcLine) + toClase._Comentario = tc_Comentario + toClase._Inicio = m.I + toClase._Ini_Cab = m.I + 1 - toModulo.add_Class( toClase ) + toModulo.add_Class( toClase ) - *-- Ubico el objeto ole por su nombre (parent+objname), que no se repite. - IF toModulo.existeObjetoOLE( toClase._Nombre, @m.Z ) - toClase._Ole = toModulo._Ole_Objs(m.Z)._Value - ENDIF +*-- Ubico el objeto ole por su nombre (parent+objname), que no se repite. + If toModulo.existeObjetoOLE( toClase._Nombre, @m.Z ) + toClase._Ole = toModulo._Ole_Objs(m.Z)._Value + Endif - * Búsqueda del ID de fin de bloque (ENDDEFINE) - WITH THIS AS c_conversor_prg_a_bin OF 'FOXBIN2PRG.PRG' - FOR I = toClase._Ini_Cab TO tnCodeLines - tc_Comentario = '' - .set_Line( @tcLine, @taCodeLines, m.I ) +* Búsqueda del ID de fin de bloque (ENDDEFINE) + With This As c_conversor_prg_a_bin Of 'FOXBIN2PRG.PRG' + For I = toClase._Ini_Cab To tnCodeLines + tc_Comentario = '' + .set_Line( @tcLine, @taCodeLines, m.I ) - DO CASE - CASE .lineIsOnlyCommentAndNoMetadata( @tcLine, @tc_Comentario ) - LOOP + Do Case + Case .lineIsOnlyCommentAndNoMetadata( @tcLine, @tc_Comentario ) + Loop - CASE .analyzeCodeBlock_PROCEDURE( @toModulo, @toClase, @loObjeto, @tcLine, @taCodeLines, @m.I, @tnCodeLines ; - , @tcProcedureAbierto, @tc_Comentario, @taLineasExclusion, @tnBloquesExclusion ) - *-- OJO: Esta se analiza primero a propósito, solo porque no puede estar detrás de PROTECTED y HIDDEN - STORE .T. TO llCLASSCOMMENTS_Completed ; - , llCLASS_PROPERTY_Completed ; - , llPROTECTED_Completed ; - , llHIDDEN_Completed ; - , llINCLUDE_Completed ; - , llCLASSMETADATA_Completed ; - , llOBJECTMETADATA_Completed ; - , llDEFINED_PAM_Completed + Case .analyzeCodeBlock_PROCEDURE( @toModulo, @toClase, @loObjeto, @tcLine, @taCodeLines, @m.I, @tnCodeLines ; + , @tcProcedureAbierto, @tc_Comentario, @taLineasExclusion, @tnBloquesExclusion ) +*-- OJO: Esta se analiza primero a propósito, solo porque no puede estar detrás de PROTECTED y HIDDEN + Store .T. To llCLASSCOMMENTS_Completed ; + , llCLASS_PROPERTY_Completed ; + , llPROTECTED_Completed ; + , llHIDDEN_Completed ; + , llINCLUDE_Completed ; + , llCLASSMETADATA_Completed ; + , llOBJECTMETADATA_Completed ; + , llDEFINED_PAM_Completed - CASE NOT llPROTECTED_Completed AND .analyzeCodeBlock_PROTECTED( @toClase, @tcLine ) - llPROTECTED_Completed = .T. + Case Not llPROTECTED_Completed And .analyzeCodeBlock_PROTECTED( @toClase, @tcLine ) + llPROTECTED_Completed = .T. - CASE NOT llHIDDEN_Completed AND .analyzeCodeBlock_HIDDEN( @toClase, @tcLine ) - llHIDDEN_Completed = .T. + Case Not llHIDDEN_Completed And .analyzeCodeBlock_HIDDEN( @toClase, @tcLine ) + llHIDDEN_Completed = .T. - CASE NOT llINCLUDE_Completed AND .c_Type <> "SCX" AND .analyzeCodeBlock_INCLUDE( @toModulo, @toClase, @tcLine, @taCodeLines ; - , @m.I, @tnCodeLines, @tcProcedureAbierto ) - llINCLUDE_Completed = .T. + Case Not llINCLUDE_Completed And .c_Type <> "SCX" And .analyzeCodeBlock_INCLUDE( @toModulo, @toClase, @tcLine, @taCodeLines ; + , @m.I, @tnCodeLines, @tcProcedureAbierto ) + llINCLUDE_Completed = .T. - CASE NOT llCLASSCOMMENTS_Completed AND .analyzeCodeBlock_CLASSCOMMENTS( @toClase, @tcLine ,@taCodeLines, tnCodeLines, @m.I ) - llCLASSCOMMENTS_Completed = .T. + Case Not llCLASSCOMMENTS_Completed And .analyzeCodeBlock_CLASSCOMMENTS( @toClase, @tcLine ,@taCodeLines, tnCodeLines, @m.I ) + llCLASSCOMMENTS_Completed = .T. - CASE NOT llCLASSMETADATA_Completed AND .analyzeCodeBlock_CLASSMETADATA( @toClase, @tcLine ) - llCLASSMETADATA_Completed = .T. + Case Not llCLASSMETADATA_Completed And .analyzeCodeBlock_CLASSMETADATA( @toClase, @tcLine ) + llCLASSMETADATA_Completed = .T. - CASE NOT llOBJECTMETADATA_Completed AND .analyzeCodeBlock_OBJECTMETADATA( @toClase, @tcLine ) - * No se usa flag porque puede haber múltiples ObjectMetadata. + Case Not llOBJECTMETADATA_Completed And .analyzeCodeBlock_OBJECTMETADATA( @toClase, @tcLine ) +* No se usa flag porque puede haber múltiples ObjectMetadata. - CASE NOT llDEFINED_PAM_Completed AND .analyzeCodeBlock_DEFINED_PAM( @toClase, @tcLine, @taCodeLines, tnCodeLines, @m.I ) - llDEFINED_PAM_Completed = .T. + Case Not llDEFINED_PAM_Completed And .analyzeCodeBlock_DEFINED_PAM( @toClase, @tcLine, @taCodeLines, tnCodeLines, @m.I ) + llDEFINED_PAM_Completed = .T. - CASE .analyzeCodeBlock_ADD_OBJECT( @toModulo, @toClase, @tcLine, @m.I, @taCodeLines, @tnCodeLines, @toFoxBin2Prg ) - STORE .T. TO llCLASSCOMMENTS_Completed ; - , llCLASS_PROPERTY_Completed ; - , llPROTECTED_Completed ; - , llHIDDEN_Completed ; - , llINCLUDE_Completed ; - , llCLASSMETADATA_Completed ; - , llOBJECTMETADATA_Completed ; - , llDEFINED_PAM_Completed + Case .analyzeCodeBlock_ADD_OBJECT( @toModulo, @toClase, @tcLine, @m.I, @taCodeLines, @tnCodeLines, @toFoxBin2Prg ) + Store .T. To llCLASSCOMMENTS_Completed ; + , llCLASS_PROPERTY_Completed ; + , llPROTECTED_Completed ; + , llHIDDEN_Completed ; + , llINCLUDE_Completed ; + , llCLASSMETADATA_Completed ; + , llOBJECTMETADATA_Completed ; + , llDEFINED_PAM_Completed - CASE .analyzeCodeBlock_ENDDEFINE( @toClase, @tcLine, @m.I, @tcProcedureAbierto ) - EXIT + Case .analyzeCodeBlock_ENDDEFINE( @toClase, @tcLine, @m.I, @tcProcedureAbierto ) + Exit - CASE NOT llCLASS_PROPERTY_Completed AND EMPTY( toClase._Fin_Cab ) - *-- Propiedades de la CLASE - *-- - *-- NOTA: Las propiedades se agregan tal cual, incluso aunque estén separadas en - *-- varias líneas (memberdata y fb2p_value), ya que luego se ensamblan en classProps2Memo(). - * - .get_SeparatedPropAndValue( tcLine, @lcProp, @lcValue, @toClase, @taCodeLines, tnCodeLines, @m.I ) - toClase.add_Property( @lcProp, @lcValue, RTRIM(tc_Comentario) ) + Case Not llCLASS_PROPERTY_Completed And Empty( toClase._Fin_Cab ) +*-- Propiedades de la CLASE +*-- +*-- NOTA: Las propiedades se agregan tal cual, incluso aunque estén separadas en +*-- varias líneas (memberdata y fb2p_value), ya que luego se ensamblan en classProps2Memo(). +* + .get_SeparatedPropAndValue( tcLine, @lcProp, @lcValue, @toClase, @taCodeLines, tnCodeLines, @m.I ) + toClase.add_Property( @lcProp, @lcValue, Rtrim(tc_Comentario) ) - OTHERWISE - *-- Las líneas que pasan por aquí deberían estar vacías y ser de relleno del embellecimiento + Otherwise +*-- Las líneas que pasan por aquí deberían estar vacías y ser de relleno del embellecimiento - ENDCASE + Endcase - ENDFOR + Endfor - *-- Validación - IF EMPTY( toClase._Fin ) - *ERROR 'No se ha encontrado el marcador de fin [ENDDEFINE] ' ; - + 'que cierra al marcador de inicio [DEFINE CLASS] ' ; - + 'de la línea ' + TRANSFORM( toClase._Inicio ) + ' ' ; - + 'para el identificador [' + toClase._Nombre + ']' - ERROR (TEXTMERGE(loLang.C_ENDDEFINE_MARKER_NOT_FOUND_LOC)) - ENDIF +*-- Validación + If Empty( toClase._Fin ) +*ERROR 'No se ha encontrado el marcador de fin [ENDDEFINE] ' ; ++ 'que cierra al marcador de inicio [DEFINE CLASS] ' ; ++ 'de la línea ' + TRANSFORM( toClase._Inicio ) + ' ' ; ++ 'para el identificador [' + toClase._Nombre + ']' + Error (Textmerge(loLang.C_ENDDEFINE_MARKER_NOT_FOUND_LOC)) + Endif - toClase._PROPERTIES = .classProps2Memo( @toClase, @toFoxBin2Prg ) - toClase._PROTECTED = .hiddenAndProtected_PAM( @toClase ) - toClase._METHODS = .classMethods2Memo( @toClase ) - toClase._RESERVED1 = IIF( .c_Type = 'SCX', '', 'Class' ) - toClase._RESERVED2 = IIF( .c_Type = 'VCX' OR PROPER(toClase._Class) == 'Dataenvironment', TRANSFORM( toClase._AddObject_Count + 1 ), '' ) - toClase._RESERVED3 = .defined_PAM2Memo( @toClase ) - toClase._RESERVED4 = toClase._ClassIcon - toClase._RESERVED5 = toClase._ProjectClassIcon - toClase._RESERVED6 = toClase._Scale - toClase._RESERVED7 = toClase._Comentario - toClase._RESERVED8 = toClase._includeFile - ENDWITH && THIS + toClase._PROPERTIES = .classProps2Memo( @toClase, @toFoxBin2Prg ) + toClase._PROTECTED = .hiddenAndProtected_PAM( @toClase ) + toClase._METHODS = .classMethods2Memo( @toClase ) + toClase._RESERVED1 = Iif( .c_Type = 'SCX', '', 'Class' ) + toClase._RESERVED2 = Iif( .c_Type = 'VCX' Or Proper(toClase._Class) == 'Dataenvironment', Transform( toClase._AddObject_Count + 1 ), '' ) + toClase._RESERVED3 = .defined_PAM2Memo( @toClase ) + toClase._RESERVED4 = toClase._ClassIcon + toClase._RESERVED5 = toClase._ProjectClassIcon + toClase._RESERVED6 = toClase._Scale + toClase._RESERVED7 = toClase._Comentario + toClase._RESERVED8 = toClase._includeFile + Endwith && THIS - CATCH TO loEx - IF THIS.n_Debug > 0 AND _VFP.STARTMODE = 0 - SET STEP ON - ENDIF + Catch To loEx + If This.n_Debug > 0 And _vfp.StartMode = 0 + Set Step On + Endif - THROW + Throw - FINALLY - RELEASE toModulo, toClase, tcLine, taCodeLines, I, tnCodeLines, tcProcedureAbierto ; - , taLineasExclusion, tnBloquesExclusion, tc_Comentario, Z, lcProp, lcValue, loEx ; - , llCLASSMETADATA_Completed, llPROTECTED_Completed, llHIDDEN_Completed, llDEFINED_PAM_Completed ; - , llINCLUDE_Completed, llCLASS_PROPERTY_Completed, llOBJECTMETADATA_Completed ; - , llCLASSCOMMENTS_Completed, loObjeto - ENDTRY - ENDIF + Finally + Release toModulo, toClase, tcLine, taCodeLines, I, tnCodeLines, tcProcedureAbierto ; + , taLineasExclusion, tnBloquesExclusion, tc_Comentario, Z, lcProp, lcValue, loEx ; + , llCLASSMETADATA_Completed, llPROTECTED_Completed, llHIDDEN_Completed, llDEFINED_PAM_Completed ; + , llINCLUDE_Completed, llCLASS_PROPERTY_Completed, llOBJECTMETADATA_Completed ; + , llCLASSCOMMENTS_Completed, loObjeto + Endtry + Endif - RETURN llBloqueEncontrado - ENDPROC + Return llBloqueEncontrado + Endproc - PROCEDURE analyzeCodeBlock_ENDDEFINE - LPARAMETERS toClase, tcLine, I, tcProcedureAbierto + Procedure analyzeCodeBlock_ENDDEFINE + Lparameters toClase, tcLine, I, tcProcedureAbierto - #IF .F. - LOCAL toClase AS CL_CLASE OF 'FOXBIN2PRG.PRG' - #ENDIF + #If .F. + Local toClase As CL_CLASE Of 'FOXBIN2PRG.PRG' + #Endif - LOCAL llBloqueEncontrado + Local llBloqueEncontrado - IF UPPER( LEFT( tcLine + ' ', 10 ) ) == C_ENDDEFINE + ' ' && Fin de bloque (ENDDEF / ENDPROC) encontrado + If Upper( Left( tcLine + ' ', 10 ) ) == C_ENDDEFINE + ' ' && Fin de bloque (ENDDEF / ENDPROC) encontrado llBloqueEncontrado = .T. toClase._Fin = m.I - IF EMPTY( toClase._Ini_Cuerpo ) + If Empty( toClase._Ini_Cuerpo ) toClase._Ini_Cuerpo = m.I-1 - ENDIF + Endif toClase._Fin_Cuerpo = m.I-1 - IF EMPTY( toClase._Fin_Cab ) + If Empty( toClase._Fin_Cab ) toClase._Fin_Cab = m.I-1 - ENDIF + Endif - STORE '' TO tcProcedureAbierto - ENDIF + Store '' To tcProcedureAbierto + Endif - RELEASE toClase, tcLine, I, tcProcedureAbierto - RETURN llBloqueEncontrado - ENDPROC + Release toClase, tcLine, I, tcProcedureAbierto + Return llBloqueEncontrado + Endproc - PROCEDURE analyzeCodeBlock_HIDDEN - LPARAMETERS toClase, tcLine + Procedure analyzeCodeBlock_HIDDEN + Lparameters toClase, tcLine - #IF .F. - LOCAL toClase AS CL_CLASE OF 'FOXBIN2PRG.PRG' - #ENDIF + #If .F. + Local toClase As CL_CLASE Of 'FOXBIN2PRG.PRG' + #Endif - LOCAL llBloqueEncontrado + Local llBloqueEncontrado - IF UPPER(LEFT(tcLine, 7)) == 'HIDDEN ' + If Upper(Left(tcLine, 7)) == 'HIDDEN ' llBloqueEncontrado = .T. - toClase._HiddenProps = LOWER( ALLTRIM( SUBSTR( tcLine, 8 ) ) ) - ENDIF + toClase._HiddenProps = Lower( Alltrim( Substr( tcLine, 8 ) ) ) + Endif - RELEASE toClase, tcLine - RETURN llBloqueEncontrado - ENDPROC + Release toClase, tcLine + Return llBloqueEncontrado + Endproc - PROCEDURE analyzeCodeBlock_INCLUDE - LPARAMETERS toModulo, toClase, tcLine, taCodeLines, I, tnCodeLines, tcProcedureAbierto - LOCAL llBloqueEncontrado + Procedure analyzeCodeBlock_INCLUDE + Lparameters toModulo, toClase, tcLine, taCodeLines, I, tnCodeLines, tcProcedureAbierto + Local llBloqueEncontrado - #IF .F. - LOCAL toModulo AS CL_CLASSLIB OF 'FOXBIN2PRG.PRG' - LOCAL toClase AS CL_CLASE OF 'FOXBIN2PRG.PRG' - #ENDIF + #If .F. + Local toModulo As CL_CLASSLIB Of 'FOXBIN2PRG.PRG' + Local toClase As CL_CLASE Of 'FOXBIN2PRG.PRG' + #Endif - IF UPPER(LEFT(tcLine, 9)) == '#INCLUDE ' + If Upper(Left(tcLine, 9)) == '#INCLUDE ' llBloqueEncontrado = .T. - IF THIS.c_Type = 'SCX' - toModulo._includeFile = LOWER( ALLTRIM( CHRTRAN( SUBSTR( tcLine, 10 ), ["'], [] ) ) ) - ELSE - toClase._includeFile = LOWER( ALLTRIM( CHRTRAN( SUBSTR( tcLine, 10 ), ["'], [] ) ) ) - ENDIF - ENDIF + If This.c_Type = 'SCX' + toModulo._includeFile = Lower( Alltrim( Chrtran( Substr( tcLine, 10 ), ["'], [] ) ) ) + Else + toClase._includeFile = Lower( Alltrim( Chrtran( Substr( tcLine, 10 ), ["'], [] ) ) ) + Endif + Endif - RELEASE toModulo, toClase, tcLine, taCodeLines, I, tnCodeLines, tcProcedureAbierto - RETURN llBloqueEncontrado - ENDPROC + Release toModulo, toClase, tcLine, taCodeLines, I, tnCodeLines, tcProcedureAbierto + Return llBloqueEncontrado + Endproc - PROCEDURE analyzeCodeBlock_CLASSCOMMENTS - LPARAMETERS toClase, tcLine ,taCodeLines, tnCodeLines, I + Procedure analyzeCodeBlock_CLASSCOMMENTS + Lparameters toClase, tcLine ,taCodeLines, tnCodeLines, I - EXTERNAL ARRAY taCodeLines + External Array taCodeLines - #IF .F. - LOCAL toClase AS CL_CLASE OF 'FOXBIN2PRG.PRG' - #ENDIF + #If .F. + Local toClase As CL_CLASE Of 'FOXBIN2PRG.PRG' + #Endif - TRY - LOCAL llBloqueEncontrado + Try + Local llBloqueEncontrado - IF LEFT( tcLine, C_LEN_CLASSCOMMENTS_I ) == C_CLASSCOMMENTS_I - llBloqueEncontrado = .T. - toClase._Comentario = '' + If Left( tcLine, C_LEN_CLASSCOMMENTS_I ) == C_CLASSCOMMENTS_I + llBloqueEncontrado = .T. + toClase._Comentario = '' - WITH THIS AS c_conversor_prg_a_bin OF 'FOXBIN2PRG.PRG' - FOR I = m.I + 1 TO tnCodeLines - .set_Line( @tcLine, @taCodeLines, m.I ) + With This As c_conversor_prg_a_bin Of 'FOXBIN2PRG.PRG' + For I = m.I + 1 To tnCodeLines + .set_Line( @tcLine, @taCodeLines, m.I ) - DO CASE - CASE LEFT( tcLine, C_LEN_CLASSCOMMENTS_F ) == C_CLASSCOMMENTS_F - I = m.I + 1 - EXIT + Do Case + Case Left( tcLine, C_LEN_CLASSCOMMENTS_F ) == C_CLASSCOMMENTS_F + I = m.I + 1 + Exit - OTHERWISE - toClase._Comentario = toClase._Comentario + CR_LF + SUBSTR( tcLine, 2 ) && Le quito el '*' inicial - ENDCASE - ENDFOR - ENDWITH && THIS + Otherwise + toClase._Comentario = toClase._Comentario + CR_LF + Substr( tcLine, 2 ) && Le quito el '*' inicial + Endcase + Endfor + Endwith && THIS - I = m.I - 1 + I = m.I - 1 - IF NOT EMPTY(toClase._Comentario) - toClase._Comentario = SUBSTR( toClase._Comentario, 3 ) + CR_LF && Quito el primer CR+LF - ENDIF - ENDIF + If Not Empty(toClase._Comentario) + toClase._Comentario = Substr( toClase._Comentario, 3 ) + CR_LF && Quito el primer CR+LF + Endif + Endif - CATCH TO loEx - IF THIS.n_Debug > 0 AND _VFP.STARTMODE = 0 - SET STEP ON - ENDIF + Catch To loEx + If This.n_Debug > 0 And _vfp.StartMode = 0 + Set Step On + Endif - THROW + Throw - FINALLY - RELEASE toClase, tcLine ,taCodeLines, tnCodeLines, I - ENDTRY + Finally + Release toClase, tcLine ,taCodeLines, tnCodeLines, I + Endtry - RETURN llBloqueEncontrado - ENDPROC + Return llBloqueEncontrado + Endproc - PROCEDURE analyzeCodeBlock_CLASSMETADATA - LPARAMETERS toClase, tcLine + Procedure analyzeCodeBlock_CLASSMETADATA + Lparameters toClase, tcLine - #IF .F. - LOCAL toClase AS CL_CLASE OF 'FOXBIN2PRG.PRG' - #ENDIF + #If .F. + Local toClase As CL_CLASE Of 'FOXBIN2PRG.PRG' + #Endif - LOCAL llBloqueEncontrado + Local llBloqueEncontrado - IF UPPER(LEFT(tcLine, C_LEN_CLASSDATA_I)) == C_CLASSDATA_I && METADATA de la CLASE - *< CLASSDATA: Baseclass="custom" Timestamp="2013/11/19 11:51:04" Scale="Foxels" Uniqueid="_3WF0VSTN1" ProjectClassIcon="container.ico" ClassIcon="toolbar.ico" /> - LOCAL laPropsAndValues(1,2), lnPropsAndValues_Count + If Upper(Left(tcLine, C_LEN_CLASSDATA_I)) == C_CLASSDATA_I && METADATA de la CLASE +*< CLASSDATA: Baseclass="custom" Timestamp="2013/11/19 11:51:04" Scale="Foxels" Uniqueid="_3WF0VSTN1" ProjectClassIcon="container.ico" ClassIcon="toolbar.ico" /> + Local laPropsAndValues(1,2), lnPropsAndValues_Count llBloqueEncontrado = .T. - WITH THIS + With This .get_ListNamesWithValuesFrom_InLine_MetadataTag( @tcLine, @laPropsAndValues, @lnPropsAndValues_Count, C_CLASSDATA_I, C_CLASSDATA_F ) toClase._BaseClass = .get_ValueByName_FromListNamesWithValues( 'BaseClass', 'C', @laPropsAndValues ) - toClase._TimeStamp = INT( .rowTimeStamp( .get_ValueByName_FromListNamesWithValues( 'TimeStamp', 'T', @laPropsAndValues ) ) ) + toClase._TimeStamp = Int( .rowTimeStamp( .get_ValueByName_FromListNamesWithValues( 'TimeStamp', 'T', @laPropsAndValues ) ) ) toClase._Scale = .get_ValueByName_FromListNamesWithValues( 'Scale', 'C', @laPropsAndValues ) toClase._UniqueID = .get_ValueByName_FromListNamesWithValues( 'UniqueID', 'C', @laPropsAndValues ) toClase._ProjectClassIcon = .get_ValueByName_FromListNamesWithValues( 'ProjectClassIcon', 'C', @laPropsAndValues ) toClase._ClassIcon = .get_ValueByName_FromListNamesWithValues( 'ClassIcon', 'C', @laPropsAndValues ) toClase._Ole2 = .get_ValueByName_FromListNamesWithValues( 'OLEObject', 'C', @laPropsAndValues ) - IF EMPTY(toClase._Ole) - toClase._Ole = STRCONV( .get_ValueByName_FromListNamesWithValues( 'Value', 'C', @laPropsAndValues ), 14 ) - ENDIF - ENDWITH && THIS + If Empty(toClase._Ole) + toClase._Ole = Strconv( .get_ValueByName_FromListNamesWithValues( 'Value', 'C', @laPropsAndValues ), 14 ) + Endif + Endwith && THIS - IF NOT EMPTY( toClase._Ole2 ) && Le agrego "OLEObject = " delante + If Not Empty( toClase._Ole2 ) && Le agrego "OLEObject = " delante toClase._Ole2 = 'OLEObject = ' + toClase._Ole2 + CR_LF - ENDIF - ENDIF + Endif + Endif - RELEASE toClase, tcLine, laPropsAndValues, lnPropsAndValues_Count - RETURN llBloqueEncontrado - ENDPROC + Release toClase, tcLine, laPropsAndValues, lnPropsAndValues_Count + Return llBloqueEncontrado + Endproc - PROCEDURE analyzeCodeBlock_EXTERNAL_CLASS - *------------------------------------------------------ - *-- Analiza el bloque *< EXTERNAL_CLASS: Name="nombre-clase" Baseclass="clase-base" /> - *------------------------------------------------------ - LPARAMETERS toModulo, tcLine, taCodeLines, I, tnCodeLines + Procedure analyzeCodeBlock_EXTERNAL_CLASS +*------------------------------------------------------ +*-- Analiza el bloque *< EXTERNAL_CLASS: Name="nombre-clase" Baseclass="clase-base" /> +*------------------------------------------------------ + Lparameters toModulo, tcLine, taCodeLines, I, tnCodeLines - #IF .F. - LOCAL toModulo AS CL_CLASSLIB OF 'FOXBIN2PRG.PRG' - #ENDIF + #If .F. + Local toModulo As CL_CLASSLIB Of 'FOXBIN2PRG.PRG' + #Endif - LOCAL llBloqueEncontrado + Local llBloqueEncontrado - IF UPPER(LEFT(tcLine, C_LEN_EXTERNAL_CLASS_I)) == C_EXTERNAL_CLASS_I - LOCAL laPropsAndValues(1,2), lnPropsAndValues_Count + If Upper(Left(tcLine, C_LEN_EXTERNAL_CLASS_I)) == C_EXTERNAL_CLASS_I + Local laPropsAndValues(1,2), lnPropsAndValues_Count llBloqueEncontrado = .T. - WITH THIS AS c_conversor_prg_a_bin OF 'FOXBIN2PRG.PRG' + With This As c_conversor_prg_a_bin Of 'FOXBIN2PRG.PRG' .get_ListNamesWithValuesFrom_InLine_MetadataTag( @tcLine, @laPropsAndValues, @lnPropsAndValues_Count, C_EXTERNAL_CLASS_I, C_EXTERNAL_CLASS_F ) toModulo._ExternalClasses_Count = toModulo._ExternalClasses_Count + 1 - DIMENSION toModulo._ExternalClasses( toModulo._ExternalClasses_Count, 2 ) + Dimension toModulo._ExternalClasses( toModulo._ExternalClasses_Count, 2 ) toModulo._ExternalClasses( toModulo._ExternalClasses_Count, 1 ) = .get_ValueByName_FromListNamesWithValues( 'Name', 'C', @laPropsAndValues ) toModulo._ExternalClasses( toModulo._ExternalClasses_Count, 2 ) = .get_ValueByName_FromListNamesWithValues( 'Baseclass', 'C', @laPropsAndValues ) ; + '.' + toModulo._ExternalClasses( toModulo._ExternalClasses_Count, 1 ) - ENDWITH && THIS - ENDIF + Endwith && THIS + Endif - RETURN llBloqueEncontrado - ENDPROC + Return llBloqueEncontrado + Endproc - PROCEDURE analyzeCodeBlock_EXTERNAL_MEMBER - *------------------------------------------------------ - *-- Analiza el bloque *< EXTERNAL_MEMBER: Name="nombre-miembro" Type="tipo-de-miembro" /> - *------------------------------------------------------ - LPARAMETERS toDatabase, tcLine, taCodeLines, I, tnCodeLines + Procedure analyzeCodeBlock_EXTERNAL_MEMBER +*------------------------------------------------------ +*-- Analiza el bloque *< EXTERNAL_MEMBER: Name="nombre-miembro" Type="tipo-de-miembro" /> +*------------------------------------------------------ + Lparameters toDatabase, tcLine, taCodeLines, I, tnCodeLines - #IF .F. - LOCAL toDatabase AS CL_DBC OF 'FOXBIN2PRG.PRG' - #ENDIF + #If .F. + Local toDatabase As CL_DBC Of 'FOXBIN2PRG.PRG' + #Endif - LOCAL llBloqueEncontrado + Local llBloqueEncontrado - IF UPPER(LEFT(tcLine, C_LEN_EXTERNAL_MEMBER_I)) == C_EXTERNAL_MEMBER_I - LOCAL laPropsAndValues(1,2), lnPropsAndValues_Count + If Upper(Left(tcLine, C_LEN_EXTERNAL_MEMBER_I)) == C_EXTERNAL_MEMBER_I + Local laPropsAndValues(1,2), lnPropsAndValues_Count llBloqueEncontrado = .T. - WITH THIS + With This .get_ListNamesWithValuesFrom_InLine_MetadataTag( @tcLine, @laPropsAndValues, @lnPropsAndValues_Count, C_EXTERNAL_MEMBER_I, C_EXTERNAL_MEMBER_F ) toDatabase._ExternalClasses_Count = toDatabase._ExternalClasses_Count + 1 - DIMENSION toDatabase._ExternalClasses( toDatabase._ExternalClasses_Count, 2 ) + Dimension toDatabase._ExternalClasses( toDatabase._ExternalClasses_Count, 2 ) toDatabase._ExternalClasses( toDatabase._ExternalClasses_Count, 1 ) = .get_ValueByName_FromListNamesWithValues( 'Type', 'C', @laPropsAndValues ) ; + '.' + .get_ValueByName_FromListNamesWithValues( 'Name', 'C', @laPropsAndValues ) - *toDatabase._ExternalClasses( toDatabase._ExternalClasses_Count, 2 ) = .get_ValueByName_FromListNamesWithValues( 'Type', 'C', @laPropsAndValues ) - ENDWITH && THIS - ENDIF +*toDatabase._ExternalClasses( toDatabase._ExternalClasses_Count, 2 ) = .get_ValueByName_FromListNamesWithValues( 'Type', 'C', @laPropsAndValues ) + Endwith && THIS + Endif - RETURN llBloqueEncontrado - ENDPROC + Return llBloqueEncontrado + Endproc - PROCEDURE analyzeCodeBlock_OBJECTMETADATA - LPARAMETERS toClase, tcLine + Procedure analyzeCodeBlock_OBJECTMETADATA + Lparameters toClase, tcLine - #IF .F. - LOCAL toClase AS CL_CLASE OF 'FOXBIN2PRG.PRG' - #ENDIF + #If .F. + Local toClase As CL_CLASE Of 'FOXBIN2PRG.PRG' + #Endif - LOCAL llBloqueEncontrado + Local llBloqueEncontrado - IF UPPER(LEFT(tcLine, C_LEN_OBJECTDATA_I)) == C_OBJECTDATA_I && METADATA del ADD OBJECT - *< OBJECTDATA: ObjName="txtValor" Timestamp="2013/11/19 11:51:04" Uniqueid="_3WF0VSTN1" /> - LOCAL laPropsAndValues(1,2), lnPropsAndValues_Count, loObjeto AS CL_OBJETO OF 'FOXBIN2PRG.PRG' + If Upper(Left(tcLine, C_LEN_OBJECTDATA_I)) == C_OBJECTDATA_I && METADATA del ADD OBJECT +*< OBJECTDATA: ObjName="txtValor" Timestamp="2013/11/19 11:51:04" Uniqueid="_3WF0VSTN1" /> + Local laPropsAndValues(1,2), lnPropsAndValues_Count, loObjeto As CL_OBJETO Of 'FOXBIN2PRG.PRG' llBloqueEncontrado = .T. toClase.l_ObjectMetadataInHeader = .T. - loObjeto = NULL - loObjeto = CREATEOBJECT('CL_OBJETO') + loObjeto = Null + loObjeto = Createobject('CL_OBJETO') toClase.add_Object( loObjeto ) - WITH THIS + With This .get_ListNamesWithValuesFrom_InLine_MetadataTag( @tcLine, @laPropsAndValues, @lnPropsAndValues_Count, C_OBJECTDATA_I, C_OBJECTDATA_F ) loObjeto._Nombre = .get_ValueByName_FromListNamesWithValues( 'ObjPath', 'C', @laPropsAndValues ) - loObjeto._TimeStamp = INT( .rowTimeStamp( .get_ValueByName_FromListNamesWithValues( 'TimeStamp', 'T', @laPropsAndValues ) ) ) + loObjeto._TimeStamp = Int( .rowTimeStamp( .get_ValueByName_FromListNamesWithValues( 'TimeStamp', 'T', @laPropsAndValues ) ) ) loObjeto._UniqueID = .get_ValueByName_FromListNamesWithValues( 'UniqueID', 'C', @laPropsAndValues ) - ENDWITH && THIS + Endwith && THIS - loObjeto = NULL - RELEASE toClase, tcLine, laPropsAndValues, lnPropsAndValues_Count, loObjeto - ENDIF + loObjeto = Null + Release toClase, tcLine, laPropsAndValues, lnPropsAndValues_Count, loObjeto + Endif - RETURN llBloqueEncontrado - ENDPROC + Return llBloqueEncontrado + Endproc - PROCEDURE analyzeCodeBlock_OLE_DEF - LPARAMETERS toModulo, tcLine, taCodeLines, I, tnCodeLines, tcProcedureAbierto - LOCAL llBloqueEncontrado + Procedure analyzeCodeBlock_OLE_DEF + Lparameters toModulo, tcLine, taCodeLines, I, tnCodeLines, tcProcedureAbierto + Local llBloqueEncontrado - #IF .F. - LOCAL toModulo AS CL_CLASSLIB OF 'FOXBIN2PRG.PRG' - #ENDIF + #If .F. + Local toModulo As CL_CLASSLIB Of 'FOXBIN2PRG.PRG' + #Endif - IF LEFT( tcLine + ' ', C_LEN_OLE_I + 1 ) == C_OLE_I + ' ' + If Left( tcLine + ' ', C_LEN_OLE_I + 1 ) == C_OLE_I + ' ' llBloqueEncontrado = .T. - *-- Se encontró una definición de objeto OLE - *< OLE: Nombre="frm_d.ole_ImageControl2" parent="frm_d" objname="ole_ImageControl2" checksum="4171274922" value="b64-value" /> - LOCAL laPropsAndValues(1,2), lnPropsAndValues_Count ; - , loOle AS CL_OLE OF 'FOXBIN2PRG.PRG' - loOle = NULL - loOle = CREATEOBJECT('CL_OLE') +*-- Se encontró una definición de objeto OLE +*< OLE: Nombre="frm_d.ole_ImageControl2" parent="frm_d" objname="ole_ImageControl2" checksum="4171274922" value="b64-value" /> + Local laPropsAndValues(1,2), lnPropsAndValues_Count ; + , loOle As CL_OLE Of 'FOXBIN2PRG.PRG' + loOle = Null + loOle = Createobject('CL_OLE') - WITH THIS + With This .get_ListNamesWithValuesFrom_InLine_MetadataTag( @tcLine, @laPropsAndValues, @lnPropsAndValues_Count, C_OLE_I, C_OLE_F ) loOle._Nombre = .get_ValueByName_FromListNamesWithValues( 'Nombre', 'C', @laPropsAndValues ) loOle._Parent = .get_ValueByName_FromListNamesWithValues( 'Parent', 'C', @laPropsAndValues ) loOle._ObjName = .get_ValueByName_FromListNamesWithValues( 'ObjName', 'C', @laPropsAndValues ) loOle._CheckSum = .get_ValueByName_FromListNamesWithValues( 'CheckSum', 'C', @laPropsAndValues ) - loOle._Value = STRCONV( .get_ValueByName_FromListNamesWithValues( 'Value', 'C', @laPropsAndValues ), 14 ) - ENDWITH + loOle._Value = Strconv( .get_ValueByName_FromListNamesWithValues( 'Value', 'C', @laPropsAndValues ), 14 ) + Endwith toModulo.add_OLE( loOle ) - IF EMPTY( loOle._Value ) - *-- Si el objeto OLE no tiene VALUE, es porque hay otro con el mismo contenido y no se duplicó para preservar espacio. - *-- Busco el VALUE del duplicado que se guardó y lo asigno nuevamente - FOR Z = 1 TO toModulo._Ole_Obj_count - 1 - IF toModulo._Ole_Objs(m.Z)._CheckSum == loOle._CheckSum AND NOT EMPTY( toModulo._Ole_Objs(m.Z)._Value ) + If Empty( loOle._Value ) +*-- Si el objeto OLE no tiene VALUE, es porque hay otro con el mismo contenido y no se duplicó para preservar espacio. +*-- Busco el VALUE del duplicado que se guardó y lo asigno nuevamente + For Z = 1 To toModulo._Ole_Obj_count - 1 + If toModulo._Ole_Objs(m.Z)._CheckSum == loOle._CheckSum And Not Empty( toModulo._Ole_Objs(m.Z)._Value ) loOle._Value = toModulo._Ole_Objs(m.Z)._Value - EXIT - ENDIF - ENDFOR - ENDIF + Exit + Endif + Endfor + Endif - loOle = NULL - RELEASE loOle, laPropsAndValues, lnPropsAndValues_Count - ENDIF + loOle = Null + Release loOle, laPropsAndValues, lnPropsAndValues_Count + Endif - RELEASE toModulo, tcLine, taCodeLines, I, tnCodeLines, tcProcedureAbierto - RETURN llBloqueEncontrado - ENDPROC + Release toModulo, tcLine, taCodeLines, I, tnCodeLines, tcProcedureAbierto + Return llBloqueEncontrado + Endproc - PROCEDURE analyzeCodeBlock_PROCEDURE - LPARAMETERS toModulo, toClase, toObjeto, tcLine, taCodeLines, I, tnCodeLines, tcProcedureAbierto ; + Procedure analyzeCodeBlock_PROCEDURE + Lparameters toModulo, toClase, toObjeto, tcLine, taCodeLines, I, tnCodeLines, tcProcedureAbierto ; , tc_Comentario, taLineasExclusion, tnBloquesExclusion - #IF .F. - LOCAL toModulo AS CL_CLASSLIB OF 'FOXBIN2PRG.PRG' - LOCAL toObjeto AS CL_OBJETO OF 'FOXBIN2PRG.PRG' - LOCAL toClase AS CL_CLASE OF 'FOXBIN2PRG.PRG' - #ENDIF + #If .F. + Local toModulo As CL_CLASSLIB Of 'FOXBIN2PRG.PRG' + Local toObjeto As CL_OBJETO Of 'FOXBIN2PRG.PRG' + Local toClase As CL_CLASE Of 'FOXBIN2PRG.PRG' + #Endif - LOCAL llBloqueEncontrado + Local llBloqueEncontrado - WITH THIS AS c_conversor_prg_a_bin OF 'FOXBIN2PRG.PRG' - DO CASE - CASE UPPER( LEFT( tcLine, 20 ) ) == 'PROTECTED PROCEDURE ' - *-- 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 ) + With This As c_conversor_prg_a_bin Of 'FOXBIN2PRG.PRG' + Do Case + Case Upper( Left( tcLine, 20 ) ) == 'PROTECTED PROCEDURE ' +*-- 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 ) - CASE UPPER( LEFT( tcLine, 17 ) ) == 'HIDDEN PROCEDURE ' - *-- 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, 17 ) ) == 'HIDDEN PROCEDURE ' +*-- 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, 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 ) + 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 ) - CASE UPPER( LEFT( tcLine, 16 ) ) == 'HIDDEN FUNCTION ' - *-- 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, 16 ) ) == 'HIDDEN FUNCTION ' +*-- 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 ) + 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 + Endcase - IF llBloqueEncontrado - *-- Evalúo todo el contenido del PROCEDURE + If llBloqueEncontrado +*-- Evalúo todo el contenido del PROCEDURE .updateProgressbar( 'Analyzing Procedure ' + toClase._Nombre + '.' + tcProcedureAbierto + '...', m.I, tnCodeLines, 1 ) .analyzeProcedureLines( @toClase, @toObjeto, @tcLine, @taCodeLines, @m.I, @tnCodeLines, @tcProcedureAbierto ; , @tc_Comentario, @taLineasExclusion, @tnBloquesExclusion ) - ENDIF - ENDWITH + Endif + Endwith - RELEASE toModulo, toClase, toObjeto, tcLine, taCodeLines, I, tnCodeLines, tcProcedureAbierto ; + Release toModulo, toClase, toObjeto, tcLine, taCodeLines, I, tnCodeLines, tcProcedureAbierto ; , tc_Comentario, taLineasExclusion, tnBloquesExclusion - RETURN llBloqueEncontrado - ENDPROC + Return llBloqueEncontrado + Endproc - PROCEDURE analyzeCodeBlock_PROTECTED - LPARAMETERS toClase, tcLine + Procedure analyzeCodeBlock_PROTECTED + Lparameters toClase, tcLine - #IF .F. - LOCAL toClase AS CL_CLASE OF 'FOXBIN2PRG.PRG' - #ENDIF + #If .F. + Local toClase As CL_CLASE Of 'FOXBIN2PRG.PRG' + #Endif - LOCAL llBloqueEncontrado + Local llBloqueEncontrado - IF UPPER(LEFT(tcLine, 10)) == 'PROTECTED ' + If Upper(Left(tcLine, 10)) == 'PROTECTED ' llBloqueEncontrado = .T. - toClase._ProtectedProps = LOWER( ALLTRIM( SUBSTR( tcLine, 11 ) ) ) - ENDIF + toClase._ProtectedProps = Lower( Alltrim( Substr( tcLine, 11 ) ) ) + Endif - RELEASE toClase, tcLine - RETURN llBloqueEncontrado - ENDPROC + Release toClase, tcLine + Return llBloqueEncontrado + Endproc - PROCEDURE evaluateProcedureDefinition - LPARAMETERS toClase, I, tc_Comentario, tcProcName, tcProcType, toObjeto - *-------------------------------------------------------------------------------------------------------------- - #IF .F. - LOCAL toClase AS CL_CLASE OF 'FOXBIN2PRG.PRG' ; - , toObjeto AS CL_OBJETO OF 'FOXBIN2PRG.PRG' - #ENDIF + Procedure evaluateProcedureDefinition + Lparameters toClase, I, tc_Comentario, tcProcName, tcProcType, toObjeto +*-------------------------------------------------------------------------------------------------------------- + #If .F. + Local toClase As CL_CLASE Of 'FOXBIN2PRG.PRG' ; + , toObjeto As CL_OBJETO Of 'FOXBIN2PRG.PRG' + #Endif - TRY - LOCAL lcNombreObjeto, lnObjProc ; - , loProcedure AS CL_PROCEDURE OF 'FOXBIN2PRG.PRG' + Try + Local lcNombreObjeto, lnObjProc ; + , loProcedure As CL_PROCEDURE Of 'FOXBIN2PRG.PRG' - IF EMPTY(toClase._Fin_Cab) - toClase._Fin_Cab = m.I-1 - toClase._Ini_Cuerpo = m.I - ENDIF + If Empty(toClase._Fin_Cab) + toClase._Fin_Cab = m.I-1 + toClase._Ini_Cuerpo = m.I + Endif - loProcedure = NULL - loProcedure = CREATEOBJECT("CL_PROCEDURE") - loProcedure._Nombre = tcProcName - loProcedure._ProcType = tcProcType - loProcedure._Comentario = tc_Comentario - loProcedure._Inicio = m.I + loProcedure = Null + loProcedure = Createobject("CL_PROCEDURE") + loProcedure._Nombre = tcProcName + loProcedure._ProcType = tcProcType + loProcedure._Comentario = tc_Comentario + loProcedure._Inicio = m.I - *-- Anoto en HiddenMethods y ProtectedMethods según corresponda - DO CASE - CASE loProcedure._ProcType == 'hidden' - toClase._HiddenMethods = toClase._HiddenMethods + ',' + tcProcName +*-- Anoto en HiddenMethods y ProtectedMethods según corresponda + Do Case + Case loProcedure._ProcType == 'hidden' + toClase._HiddenMethods = toClase._HiddenMethods + ',' + tcProcName - CASE loProcedure._ProcType == 'protected' - toClase._ProtectedMethods = toClase._ProtectedMethods + ',' + tcProcName + Case loProcedure._ProcType == 'protected' + toClase._ProtectedMethods = toClase._ProtectedMethods + ',' + tcProcName - ENDCASE + Endcase - *-- Agrego el objeto Procedimiento a la clase, o a un objeto de la clase. - IF '.' $ tcProcName - *-- Procedimiento de objeto - lcNombreObjeto = LOWER( JUSTSTEM( tcProcName ) ) +*-- Agrego el objeto Procedimiento a la clase, o a un objeto de la clase. + If '.' $ tcProcName +*-- Procedimiento de objeto + lcNombreObjeto = Lower( Juststem( tcProcName ) ) - *-- Busco el objeto al que corresponde el método - lnObjProc = THIS.findMethodsObjectByName( lcNombreObjeto, toClase ) +*-- Busco el objeto al que corresponde el método + lnObjProc = This.findMethodsObjectByName( lcNombreObjeto, toClase ) - IF lnObjProc = 0 - *-- Procedimiento de clase + If lnObjProc = 0 +*-- Procedimiento de clase + toClase.add_Procedure( loProcedure ) + toObjeto = Null + Else +*-- Procedimiento de objeto + toObjeto = toClase._AddObjects( lnObjProc ) + toObjeto.add_Procedure( loProcedure ) + +*-- Paso el log de errores + If Not Empty(toObjeto.c_TextErr) Then + toClase.writeErrorLog(toObjeto.c_TextErr) + toObjeto.c_TextErr = '' + Endif + Endif + Else +*-- Procedimiento de clase toClase.add_Procedure( loProcedure ) - toObjeto = NULL - ELSE - *-- Procedimiento de objeto - toObjeto = toClase._AddObjects( lnObjProc ) - toObjeto.add_Procedure( loProcedure ) + Endif - *-- Paso el log de errores - IF NOT EMPTY(toObjeto.c_TextErr) THEN - toClase.writeErrorLog(toObjeto.c_TextErr) - toObjeto.c_TextErr = '' - ENDIF - ENDIF - ELSE - *-- Procedimiento de clase - toClase.add_Procedure( loProcedure ) - ENDIF + Catch To loEx + If This.n_Debug > 0 And _vfp.StartMode = 0 + Set Step On + Endif - CATCH TO loEx - IF THIS.n_Debug > 0 AND _VFP.STARTMODE = 0 - SET STEP ON - ENDIF + Throw - THROW + Finally + Store Null To loProcedure + Release loProcedure, I, lcNombreObjeto, lnObjProc ; + , toClase, tc_Comentario, tcProcName, tcProcType, toObjeto + Endtry - FINALLY - STORE NULL TO loProcedure - RELEASE loProcedure, I, lcNombreObjeto, lnObjProc ; - , toClase, tc_Comentario, tcProcName, tcProcType, toObjeto - ENDTRY - - RETURN - ENDPROC + Return + Endproc - PROCEDURE identifyCodeBlocks - *-------------------------------------------------------------------------------------------------------------- - * PARÁMETROS: (v=Pasar por valor | @=Pasar por referencia) (!=Obligatorio | ?=Opcional) (IN/OUT) - * taCodeLines (@! IN ) El array con las líneas del código donde buscar - * tnCodeLines (@! IN ) Cantidad de líneas de código - * taLineasExclusion (@! IN ) Array unidimensional con un .T. o .F. según la línea sea de exclusión o no - * tnBloquesExclusion (@! IN ) Cantidad de bloques de exclusión - * toModulo (@? OUT) Objeto con toda la información del módulo analizado - * toFoxBin2Prg (@? IN ) Referencia al objeto principal - * - * NOTA: - * Como identificador se usa el nombre de clase o de procedimiento, según corresponda. - *-------------------------------------------------------------------------------------------------------------- - LPARAMETERS taCodeLines, tnCodeLines, taLineasExclusion, tnBloquesExclusion, toModulo, toFoxBin2Prg + Procedure identifyCodeBlocks +*-------------------------------------------------------------------------------------------------------------- +* PARÁMETROS: (v=Pasar por valor | @=Pasar por referencia) (!=Obligatorio | ?=Opcional) (IN/OUT) +* taCodeLines (@! IN ) El array con las líneas del código donde buscar +* tnCodeLines (@! IN ) Cantidad de líneas de código +* taLineasExclusion (@! IN ) Array unidimensional con un .T. o .F. según la línea sea de exclusión o no +* tnBloquesExclusion (@! IN ) Cantidad de bloques de exclusión +* toModulo (@? OUT) Objeto con toda la información del módulo analizado +* toFoxBin2Prg (@? IN ) Referencia al objeto principal +* +* NOTA: +* Como identificador se usa el nombre de clase o de procedimiento, según corresponda. +*-------------------------------------------------------------------------------------------------------------- + Lparameters taCodeLines, tnCodeLines, taLineasExclusion, tnBloquesExclusion, toModulo, toFoxBin2Prg - EXTERNAL ARRAY taCodeLines, taLineasExclusion + External Array taCodeLines, taLineasExclusion - #IF .F. - LOCAL toModulo AS CL_CLASSLIB OF 'FOXBIN2PRG.PRG' - LOCAL toFoxBin2Prg AS c_foxbin2prg OF 'FOXBIN2PRG.PRG' - #ENDIF + #If .F. + Local toModulo As CL_CLASSLIB Of 'FOXBIN2PRG.PRG' + Local toFoxBin2Prg As c_foxbin2prg Of 'FOXBIN2PRG.PRG' + #Endif - TRY - LOCAL I, loEx AS EXCEPTION ; - , llFoxBin2Prg_Completed, llOLE_DEF_Completed, llINCLUDE_SCX_Completed, llLIBCOMMENT_Completed, llEXTERNAL_CLASS_Completed ; - , lc_Comentario, lcProcedureAbierto, lcLine ; - , loClase AS CL_CLASE OF 'FOXBIN2PRG.PRG' + Try + Local I, loEx As Exception ; + , llFoxBin2Prg_Completed, llOLE_DEF_Completed, llINCLUDE_SCX_Completed, llLIBCOMMENT_Completed, llEXTERNAL_CLASS_Completed ; + , lc_Comentario, lcProcedureAbierto, lcLine ; + , loClase As CL_CLASE Of 'FOXBIN2PRG.PRG' - WITH THIS AS c_conversor_prg_a_bin OF 'FOXBIN2PRG.PRG' - STORE '' TO lcProcedureAbierto + With This As c_conversor_prg_a_bin Of 'FOXBIN2PRG.PRG' + Store '' To lcProcedureAbierto - .c_Type = UPPER(JUSTEXT(.c_OutputFile)) + .c_Type = Upper(Justext(.c_OutputFile)) - IF tnCodeLines > 1 + If tnCodeLines > 1 - *-- Búsqueda del ID de inicio de bloque (DEFINE CLASS / PROCEDURE) - FOR I = 1 TO tnCodeLines - STORE '' TO lc_Comentario - .set_Line( @lcLine, @taCodeLines, m.I ) +*-- Búsqueda del ID de inicio de bloque (DEFINE CLASS / PROCEDURE) + For I = 1 To tnCodeLines + Store '' To lc_Comentario + .set_Line( @lcLine, @taCodeLines, m.I ) - DO CASE - CASE .excludedLine( m.I, tnBloquesExclusion, @taLineasExclusion ) ; - OR .lineIsOnlyCommentAndNoMetadata( @lcLine, @lc_Comentario ) && Excluida, vacía o solo Comentarios + Do Case + Case .excludedLine( m.I, tnBloquesExclusion, @taLineasExclusion ) ; + OR .lineIsOnlyCommentAndNoMetadata( @lcLine, @lc_Comentario ) && Excluida, vacía o solo Comentarios - CASE .analyzeCodeBlock_DEFINE_CLASS( @toModulo, @loClase, @lcLine, @taCodeLines, @m.I, tnCodeLines ; - , @lcProcedureAbierto, @taLineasExclusion, @tnBloquesExclusion, @lc_Comentario, @toFoxBin2Prg ) - *-- Puede haber varias clases definidas - * llEXTERNAL_CLASS_Completed = .T. + Case .analyzeCodeBlock_DEFINE_CLASS( @toModulo, @loClase, @lcLine, @taCodeLines, @m.I, tnCodeLines ; + , @lcProcedureAbierto, @taLineasExclusion, @tnBloquesExclusion, @lc_Comentario, @toFoxBin2Prg ) +*-- Puede haber varias clases definidas +* llEXTERNAL_CLASS_Completed = .T. - *-- Logueo los errores - IF NOT EMPTY(loClase.c_TextErr) THEN - .writeErrorLog( loClase.c_TextErr ) - ENDIF - ENDCASE +*-- Logueo los errores + If Not Empty(loClase.c_TextErr) Then + .writeErrorLog( loClase.c_TextErr ) + Endif + Endcase - ENDFOR + Endfor - .verify_EXTERNAL_CLASSES( @toModulo, @toFoxBin2Prg ) + .verify_EXTERNAL_CLASSES( @toModulo, @toFoxBin2Prg ) - ENDIF - ENDWITH && THIS + Endif + Endwith && THIS - CATCH TO loEx - IF THIS.n_Debug > 0 AND _VFP.STARTMODE = 0 - SET STEP ON - ENDIF + Catch To loEx + If This.n_Debug > 0 And _vfp.StartMode = 0 + Set Step On + Endif - THROW + Throw - FINALLY - STORE NULL TO loClase - RELEASE loClase, I ; - , llFoxBin2Prg_Completed, llOLE_DEF_Completed, llINCLUDE_SCX_Completed, llLIBCOMMENT_Completed ; - , lc_Comentario, lcProcedureAbierto, lcLine - ENDTRY + Finally + Store Null To loClase + Release loClase, I ; + , llFoxBin2Prg_Completed, llOLE_DEF_Completed, llINCLUDE_SCX_Completed, llLIBCOMMENT_Completed ; + , lc_Comentario, lcProcedureAbierto, lcLine + Endtry - RETURN - ENDPROC + Return + Endproc - PROCEDURE identifyHeaderBlocks - *-------------------------------------------------------------------------------------------------------------- - * PARÁMETROS: (v=Pasar por valor | @=Pasar por referencia) (!=Obligatorio | ?=Opcional) (IN/OUT) - * taCodeLines (@! IN ) El array con las líneas del código donde buscar - * tnCodeLines (@! IN ) Cantidad de líneas de código - * taLineasExclusion (@! IN ) Array unidimensional con un .T. o .F. según la línea sea de exclusión o no - * tnBloquesExclusion (@! IN ) Cantidad de bloques de exclusión - * toModulo (@? OUT) Objeto con toda la información del módulo analizado - * toFoxBin2Prg (@? IN ) Referencia al objeto principal - * - * NOTA: - * Como identificador se usa el nombre de clase o de procedimiento, según corresponda. - *-------------------------------------------------------------------------------------------------------------- - LPARAMETERS taCodeLines, tnCodeLines, taLineasExclusion, tnBloquesExclusion, toModulo, toFoxBin2Prg + Procedure identifyHeaderBlocks +*-------------------------------------------------------------------------------------------------------------- +* PARÁMETROS: (v=Pasar por valor | @=Pasar por referencia) (!=Obligatorio | ?=Opcional) (IN/OUT) +* taCodeLines (@! IN ) El array con las líneas del código donde buscar +* tnCodeLines (@! IN ) Cantidad de líneas de código +* taLineasExclusion (@! IN ) Array unidimensional con un .T. o .F. según la línea sea de exclusión o no +* tnBloquesExclusion (@! IN ) Cantidad de bloques de exclusión +* toModulo (@? OUT) Objeto con toda la información del módulo analizado +* toFoxBin2Prg (@? IN ) Referencia al objeto principal +* +* NOTA: +* Como identificador se usa el nombre de clase o de procedimiento, según corresponda. +*-------------------------------------------------------------------------------------------------------------- + Lparameters taCodeLines, tnCodeLines, taLineasExclusion, tnBloquesExclusion, toModulo, toFoxBin2Prg - EXTERNAL ARRAY taCodeLines, taLineasExclusion + External Array taCodeLines, taLineasExclusion - #IF .F. - LOCAL toModulo AS CL_CLASSLIB OF 'FOXBIN2PRG.PRG' - LOCAL toFoxBin2Prg AS c_foxbin2prg OF 'FOXBIN2PRG.PRG' - #ENDIF + #If .F. + Local toModulo As CL_CLASSLIB Of 'FOXBIN2PRG.PRG' + Local toFoxBin2Prg As c_foxbin2prg Of 'FOXBIN2PRG.PRG' + #Endif - TRY - LOCAL I, loEx AS EXCEPTION ; - , llFoxBin2Prg_Completed, llOLE_DEF_Completed, llINCLUDE_SCX_Completed, llLIBCOMMENT_Completed, llEXTERNAL_CLASS_Completed ; - , lc_Comentario, lcProcedureAbierto, lcLine ; - , loClase AS CL_CLASE OF 'FOXBIN2PRG.PRG' + Try + Local I, loEx As Exception ; + , llFoxBin2Prg_Completed, llOLE_DEF_Completed, llINCLUDE_SCX_Completed, llLIBCOMMENT_Completed, llEXTERNAL_CLASS_Completed ; + , lc_Comentario, lcProcedureAbierto, lcLine ; + , loClase As CL_CLASE Of 'FOXBIN2PRG.PRG' - WITH THIS AS c_conversor_prg_a_bin OF 'FOXBIN2PRG.PRG' - STORE '' TO lcProcedureAbierto + With This As c_conversor_prg_a_bin Of 'FOXBIN2PRG.PRG' + Store '' To lcProcedureAbierto - .c_Type = UPPER(JUSTEXT(.c_OutputFile)) + .c_Type = Upper(Justext(.c_OutputFile)) - IF tnCodeLines > 1 + If tnCodeLines > 1 - IF toFoxBin2Prg.n_UseClassPerFile > 0 AND toFoxBin2Prg.l_RedirectClassPerFileToMain - ELSE - llEXTERNAL_CLASS_Completed = .T. - ENDIF - - *-- Búsqueda del ID de inicio de bloque (DEFINE CLASS / PROCEDURE) - FOR I = 1 TO tnCodeLines - STORE '' TO lc_Comentario - .set_Line( @lcLine, @taCodeLines, m.I ) - - DO CASE - CASE .lineIsOnlyCommentAndNoMetadata( @lcLine, @lc_Comentario ) && Excluida, vacía o solo Comentarios - - CASE NOT llFoxBin2Prg_Completed AND .analyzeCodeBlock_FoxBin2Prg( @toModulo, @lcLine, @taCodeLines, @m.I, tnCodeLines ) - llFoxBin2Prg_Completed = .T. - - CASE NOT llEXTERNAL_CLASS_Completed AND .analyzeCodeBlock_EXTERNAL_CLASS( @toModulo, @lcLine, @taCodeLines, @m.I, tnCodeLines ) - *-- Puede haber varias clases externas - - CASE NOT llLIBCOMMENT_Completed AND .analyzeCodeBlock_LIBCOMMENT( @toModulo, @lcLine, @taCodeLines, @m.I, tnCodeLines ) - llLIBCOMMENT_Completed = .T. + If toFoxBin2Prg.n_UseClassPerFile > 0 And toFoxBin2Prg.l_RedirectClassPerFileToMain + Else llEXTERNAL_CLASS_Completed = .T. + Endif - CASE NOT llOLE_DEF_Completed AND .analyzeCodeBlock_OLE_DEF( @toModulo, @lcLine, @taCodeLines ; - , @m.I, tnCodeLines, @lcProcedureAbierto ) - *-- Puede haber varios objetos OLE +*-- Búsqueda del ID de inicio de bloque (DEFINE CLASS / PROCEDURE) + For I = 1 To tnCodeLines + Store '' To lc_Comentario + .set_Line( @lcLine, @taCodeLines, m.I ) - CASE NOT llINCLUDE_SCX_Completed AND .c_Type = 'SCX' AND .analyzeCodeBlock_INCLUDE( @toModulo, @loClase, @lcLine ; - , @taCodeLines, @m.I, tnCodeLines, @lcProcedureAbierto ) - * Específico para SCX que lo tiene al inicio - llINCLUDE_SCX_Completed = .T. - llEXTERNAL_CLASS_Completed = .T. + Do Case + Case .lineIsOnlyCommentAndNoMetadata( @lcLine, @lc_Comentario ) && Excluida, vacía o solo Comentarios - ENDCASE + Case Not llFoxBin2Prg_Completed And .analyzeCodeBlock_FoxBin2Prg( @toModulo, @lcLine, @taCodeLines, @m.I, tnCodeLines ) + llFoxBin2Prg_Completed = .T. - ENDFOR + Case Not llEXTERNAL_CLASS_Completed And .analyzeCodeBlock_EXTERNAL_CLASS( @toModulo, @lcLine, @taCodeLines, @m.I, tnCodeLines ) +*-- Puede haber varias clases externas - ENDIF - ENDWITH && THIS + Case Not llLIBCOMMENT_Completed And .analyzeCodeBlock_LIBCOMMENT( @toModulo, @lcLine, @taCodeLines, @m.I, tnCodeLines ) + llLIBCOMMENT_Completed = .T. + llEXTERNAL_CLASS_Completed = .T. - CATCH TO loEx - IF THIS.n_Debug > 0 AND _VFP.STARTMODE = 0 - SET STEP ON - ENDIF + Case Not llOLE_DEF_Completed And .analyzeCodeBlock_OLE_DEF( @toModulo, @lcLine, @taCodeLines ; + , @m.I, tnCodeLines, @lcProcedureAbierto ) +*-- Puede haber varios objetos OLE - THROW + Case Not llINCLUDE_SCX_Completed And .c_Type = 'SCX' And .analyzeCodeBlock_INCLUDE( @toModulo, @loClase, @lcLine ; + , @taCodeLines, @m.I, tnCodeLines, @lcProcedureAbierto ) +* Específico para SCX que lo tiene al inicio + llINCLUDE_SCX_Completed = .T. + llEXTERNAL_CLASS_Completed = .T. - FINALLY - STORE NULL TO loClase - RELEASE taCodeLines, tnCodeLines, taLineasExclusion, tnBloquesExclusion, toModulo, loClase, I ; - , llFoxBin2Prg_Completed, llOLE_DEF_Completed, llINCLUDE_SCX_Completed, llLIBCOMMENT_Completed ; - , lc_Comentario, lcProcedureAbierto, lcLine - ENDTRY + Endcase - RETURN - ENDPROC + Endfor + + Endif + Endwith && THIS + + Catch To loEx + If This.n_Debug > 0 And _vfp.StartMode = 0 + Set Step On + Endif + + Throw + + Finally + Store Null To loClase + Release taCodeLines, tnCodeLines, taLineasExclusion, tnBloquesExclusion, toModulo, loClase, I ; + , llFoxBin2Prg_Completed, llOLE_DEF_Completed, llINCLUDE_SCX_Completed, llLIBCOMMENT_Completed ; + , lc_Comentario, lcProcedureAbierto, lcLine + Endtry + + Return + Endproc - PROCEDURE verify_EXTERNAL_CLASSES - *-------------------------------------------------------------------------------- - *-- Compara las clases definidas en la cabecera con las clases encontradas luego - *-------------------------------------------------------------------------------------------------------------- - * PARÁMETROS: (v=Pasar por valor | @=Pasar por referencia) (!=Obligatorio | ?=Opcional) (IN/OUT) - * toModulo (@? OUT) Objeto con toda la información del módulo analizado - * toFoxBin2Prg (@? IN ) Referencia al objeto principal - *-------------------------------------------------------------------------------------------------------------- - LPARAMETERS toModulo, toFoxBin2Prg + Procedure verify_EXTERNAL_CLASSES +*-------------------------------------------------------------------------------- +*-- Compara las clases definidas en la cabecera con las clases encontradas luego +*-------------------------------------------------------------------------------------------------------------- +* PARÁMETROS: (v=Pasar por valor | @=Pasar por referencia) (!=Obligatorio | ?=Opcional) (IN/OUT) +* toModulo (@? OUT) Objeto con toda la información del módulo analizado +* toFoxBin2Prg (@? IN ) Referencia al objeto principal +*-------------------------------------------------------------------------------------------------------------- + Lparameters toModulo, toFoxBin2Prg - #IF .F. - LOCAL toModulo AS CL_CLASSLIB OF 'FOXBIN2PRG.PRG' - LOCAL toFoxBin2Prg AS c_foxbin2prg OF 'FOXBIN2PRG.PRG' - #ENDIF + #If .F. + Local toModulo As CL_CLASSLIB Of 'FOXBIN2PRG.PRG' + Local toFoxBin2Prg As c_foxbin2prg Of 'FOXBIN2PRG.PRG' + #Endif - LOCAL lnItem, I, X, lcClaseExterna - LOCAL loLang as CL_LANG OF 'FOXBIN2PRG.PRG' - loLang = _SCREEN.o_FoxBin2Prg_Lang + Local lnItem, I, X, lcClaseExterna + Local loLang As CL_LANG Of 'FOXBIN2PRG.PRG' + loLang = _Screen.o_FoxBin2Prg_Lang - *-- Verificación de las Clases, si son Externas y se indicó chequearlas - DO CASE - CASE toFoxBin2Prg.n_UseClassPerFile = 1 AND toFoxBin2Prg.l_ClassPerFileCheck AND EMPTY(toFoxBin2Prg.c_ClassOperationType) - *-- El ClassPerFile original, con nomenclatura 'Libreria.NombreClase.vc2' - FOR I = 1 TO toModulo._ExternalClasses_Count - lnItem = 0 +*-- Verificación de las Clases, si son Externas y se indicó chequearlas + Do Case + Case toFoxBin2Prg.n_UseClassPerFile = 1 And toFoxBin2Prg.l_ClassPerFileCheck And Empty(toFoxBin2Prg.c_ClassOperationType) +*-- El ClassPerFile original, con nomenclatura 'Libreria.NombreClase.vc2' + For I = 1 To toModulo._ExternalClasses_Count + lnItem = 0 - FOR X = 1 TO toModulo._Clases_Count - IF LOWER( toModulo._Clases(m.X)._ObjName ) == LOWER( toModulo._ExternalClasses(m.I,1) ) - lnItem = m.X - EXIT - ENDIF - ENDFOR + For X = 1 To toModulo._Clases_Count + If Lower( toModulo._Clases(m.X)._ObjName ) == Lower( toModulo._ExternalClasses(m.I,1) ) + lnItem = m.X + Exit + Endif + Endfor - IF lnItem = 0 THEN - lcClaseExterna = FORCEPATH( JUSTSTEM(toFoxBin2Prg.c_InputFile) + '.' + toModulo._ExternalClasses(m.I,1) + '.' + JUSTEXT(toFoxBin2Prg.c_InputFile), JUSTPATH(toFoxBin2Prg.c_InputFile) ) - *ERROR 'No se ha encontrado la clase externa [' + toModulo._ExternalClasses(m.I,1) + '] en el archivo [' + toFoxBin2Prg.c_InputFile + ']' - ERROR ( loLang.C_EXTERNAL_CLASS_NAME_WAS_NOT_FOUND_LOC + ' [' + lcClaseExterna + ']' ) - ENDIF + If lnItem = 0 Then + lcClaseExterna = Forcepath( Juststem(toFoxBin2Prg.c_InputFile) + '.' + toModulo._ExternalClasses(m.I,1) + '.' + Justext(toFoxBin2Prg.c_InputFile), Justpath(toFoxBin2Prg.c_InputFile) ) +*ERROR 'No se ha encontrado la clase externa [' + toModulo._ExternalClasses(m.I,1) + '] en el archivo [' + toFoxBin2Prg.c_InputFile + ']' + Error ( loLang.C_EXTERNAL_CLASS_NAME_WAS_NOT_FOUND_LOC + ' [' + lcClaseExterna + ']' ) + Endif - toModulo._Clases(lnItem)._Checked = .T. - ENDFOR + toModulo._Clases(lnItem)._Checked = .T. + Endfor - CASE toFoxBin2Prg.n_UseClassPerFile = 2 AND toFoxBin2Prg.l_ClassPerFileCheck AND EMPTY(toFoxBin2Prg.c_ClassOperationType) - *-- El nuevo ClassPerFile, con nomenclatura 'Libreria.ClaseBase.NombreClase.vc2' - FOR I = 1 TO toModulo._ExternalClasses_Count - lnItem = 0 + Case toFoxBin2Prg.n_UseClassPerFile = 2 And toFoxBin2Prg.l_ClassPerFileCheck And Empty(toFoxBin2Prg.c_ClassOperationType) +*-- El nuevo ClassPerFile, con nomenclatura 'Libreria.ClaseBase.NombreClase.vc2' + For I = 1 To toModulo._ExternalClasses_Count + lnItem = 0 - FOR X = 1 TO toModulo._Clases_Count - IF LOWER( toModulo._Clases(m.X)._BaseClass + '.' + toModulo._Clases(m.X)._ObjName ) == LOWER( toModulo._ExternalClasses(m.I,2) ) - lnItem = m.X - EXIT - ENDIF - ENDFOR + For X = 1 To toModulo._Clases_Count + If Lower( toModulo._Clases(m.X)._BaseClass + '.' + toModulo._Clases(m.X)._ObjName ) == Lower( toModulo._ExternalClasses(m.I,2) ) + lnItem = m.X + Exit + Endif + Endfor - IF lnItem = 0 THEN - lcClaseExterna = FORCEPATH( JUSTSTEM(toFoxBin2Prg.c_InputFile) + '.' + toModulo._ExternalClasses(m.I,1) + '.' + JUSTEXT(toFoxBin2Prg.c_InputFile), JUSTPATH(toFoxBin2Prg.c_InputFile) ) - *ERROR 'No se ha encontrado la clase externa [' + toModulo._ExternalClasses(m.I,1) + '] en el archivo [' + toFoxBin2Prg.c_InputFile + ']' - ERROR ( loLang.C_EXTERNAL_CLASS_NAME_WAS_NOT_FOUND_LOC + ' [' + lcClaseExterna + ']' ) - ENDIF + If lnItem = 0 Then + lcClaseExterna = Forcepath( Juststem(toFoxBin2Prg.c_InputFile) + '.' + toModulo._ExternalClasses(m.I,1) + '.' + Justext(toFoxBin2Prg.c_InputFile), Justpath(toFoxBin2Prg.c_InputFile) ) +*ERROR 'No se ha encontrado la clase externa [' + toModulo._ExternalClasses(m.I,1) + '] en el archivo [' + toFoxBin2Prg.c_InputFile + ']' + Error ( loLang.C_EXTERNAL_CLASS_NAME_WAS_NOT_FOUND_LOC + ' [' + lcClaseExterna + ']' ) + Endif - toModulo._Clases(lnItem)._Checked = .T. - ENDFOR + toModulo._Clases(lnItem)._Checked = .T. + Endfor - ENDCASE - ENDPROC + Endcase + Endproc -ENDDEFINE +Enddefine -DEFINE CLASS c_conversor_prg_a_vcx AS c_conversor_prg_a_bin - #IF .F. - LOCAL THIS AS c_conversor_prg_a_vcx OF 'FOXBIN2PRG.PRG' - #ENDIF - *_MEMBERDATA = [] ; - + [] ; - + [] +Define Class c_conversor_prg_a_vcx As c_conversor_prg_a_bin + #If .F. + Local This As c_conversor_prg_a_vcx Of 'FOXBIN2PRG.PRG' + #Endif +*_MEMBERDATA = [] ; ++ [] ; ++ [] c_Type = 'VC2' - PROCEDURE convert - *--------------------------------------------------------------------------------------------------- - * PARÁMETROS: (v=Pasar por valor | @=Pasar por referencia) (!=Obligatorio | ?=Opcional) (IN/OUT) - * toModulo (@! OUT) Objeto generado de clase CL_CLASSLIB con la información leida del texto - * toEx (@! OUT) Objeto con información del error - * toFoxBin2Prg (@? IN ) Referencia al objeto principal - *--------------------------------------------------------------------------------------------------- - LPARAMETERS toModulo, toEx AS EXCEPTION, toFoxBin2Prg - #IF .F. - LOCAL toModulo AS CL_CLASSLIB OF 'FOXBIN2PRG.PRG' - LOCAL toFoxBin2Prg AS c_foxbin2prg OF 'FOXBIN2PRG.PRG' - #ENDIF - DODEFAULT( @toModulo, @toEx, @toFoxBin2Prg ) + Procedure convert +*--------------------------------------------------------------------------------------------------- +* PARÁMETROS: (v=Pasar por valor | @=Pasar por referencia) (!=Obligatorio | ?=Opcional) (IN/OUT) +* toModulo (@! OUT) Objeto generado de clase CL_CLASSLIB con la información leida del texto +* toEx (@! OUT) Objeto con información del error +* toFoxBin2Prg (@? IN ) Referencia al objeto principal +*--------------------------------------------------------------------------------------------------- + Lparameters toModulo, toEx As Exception, toFoxBin2Prg + #If .F. + Local toModulo As CL_CLASSLIB Of 'FOXBIN2PRG.PRG' + Local toFoxBin2Prg As c_foxbin2prg Of 'FOXBIN2PRG.PRG' + #Endif + DoDefault( @toModulo, @toEx, @toFoxBin2Prg ) - TRY - LOCAL lnCodError, laCodeLines(1), lnCodeLines, lcInputFile, lcInputFile_Class, lnFileCount, laFiles(1,5) ; - , laLineasExclusion(1), lnBloquesExclusion, I, lcClassName, lnIDInputFile, llReplaceClass, lnRow ; - , loClase AS CL_CLASE OF 'FOXBIN2PRG.PRG' ; - , loLang as CL_LANG OF 'FOXBIN2PRG.PRG' - - LOCAL; - lnDots AS NUMBER + Try + Local lnCodError, laCodeLines(1), lnCodeLines, lcInputFile, lcInputFile_Class, lnFileCount, laFiles(1,5) ; + , laLineasExclusion(1), lnBloquesExclusion, I, lcClassName, lnIDInputFile, llReplaceClass, lnRow ; + , loClase As CL_CLASE Of 'FOXBIN2PRG.PRG' ; + , loLang As CL_LANG Of 'FOXBIN2PRG.PRG' - WITH THIS AS c_conversor_prg_a_vcx OF 'FOXBIN2PRG.PRG' - STORE 0 TO lnCodError, lnCodeLines - STORE '' TO C_FB2PRG_CODE, lcClassName - STORE NULL TO toModulo + Local; + lnDots As Number - loLang = _SCREEN.o_FoxBin2Prg_Lang - toModulo = CREATEOBJECT('CL_CLASSLIB') - lnIDInputFile = toFoxBin2Prg.n_ProcessedFiles + With This As c_conversor_prg_a_vcx Of 'FOXBIN2PRG.PRG' + Store 0 To lnCodError, lnCodeLines + Store '' To C_FB2PRG_CODE, lcClassName + Store Null To toModulo - IF toFoxBin2Prg.n_UseClassPerFile > 0 AND toFoxBin2Prg.l_RedirectClassPerFileToMain ; - AND EMPTY(toFoxBin2Prg.c_ClassToConvert) + loLang = _Screen.o_FoxBin2Prg_Lang + toModulo = Createobject('CL_CLASSLIB') + lnIDInputFile = toFoxBin2Prg.n_ProcessedFiles - IF toFoxBin2Prg.n_RedirectClassType = 0 && Redireccionar todas las clases - C_FB2PRG_CODE = FILETOSTR( .c_InputFile ) + If toFoxBin2Prg.n_UseClassPerFile > 0 And toFoxBin2Prg.l_RedirectClassPerFileToMain ; + AND Empty(toFoxBin2Prg.c_ClassToConvert) - lnCodeLines = ALINES( laCodeLines, C_FB2PRG_CODE ) + If toFoxBin2Prg.n_RedirectClassType = 0 && Redireccionar todas las clases + C_FB2PRG_CODE = Filetostr( .c_InputFile ) - .updateProgressbar( 'Identifying Header Blocks...', 1, lnCodeLines, 1 ) - .identifyHeaderBlocks( @laCodeLines, lnCodeLines, @laLineasExclusion, lnBloquesExclusion, @toModulo, @toFoxBin2Prg ) + lnCodeLines = Alines( laCodeLines, C_FB2PRG_CODE ) - .updateProgressbar( 'Loading Code...', 2, lnCodeLines, 1 ) - ENDIF + .updateProgressbar( 'Identifying Header Blocks...', 1, lnCodeLines, 1 ) + .identifyHeaderBlocks( @laCodeLines, lnCodeLines, @laLineasExclusion, lnBloquesExclusion, @toModulo, @toFoxBin2Prg ) - *-- MÁSCARA DE BÚSQUEDA - IF toFoxBin2Prg.n_UseClassPerFile = 1 THEN - *-- Esto crea la máscara de búsqueda "filename.*.ext" para encontrar las partes - *-- con la sintaxis "Classlib.Classname.ext" o "Database.MemberName.ext" - lcBaseFilename = JUSTSTEM( JUSTSTEM(.c_InputFile) ) - lcInputFile = ADDBS( JUSTPATH(.c_InputFile) ) + lcBaseFilename + '.*.' + JUSTEXT(.c_InputFile) - ELSE && toFoxBin2Prg.n_UseClassPerFile = 2 - *-- Esto crea la máscara de búsqueda "filename.*.*.ext" para encontrar las partes - *-- con la sintaxis "Classlib.ClassType.Classname.ext" o "Database.MemberType.MemberName.ext" - lcBaseFilename = JUSTSTEM( JUSTSTEM( JUSTSTEM(.c_InputFile) ) ) - lcInputFile = ADDBS( JUSTPATH(.c_InputFile) ) + lcBaseFilename + '.*.*.' + JUSTEXT(.c_InputFile) - ENDIF + .updateProgressbar( 'Loading Code...', 2, lnCodeLines, 1 ) + Endif - IF toFoxBin2Prg.n_RedirectClassType = 1 && Redireccionar solo esta clase - lcInputFile = .c_InputFile - ENDIF +*-- MÁSCARA DE BÚSQUEDA + If toFoxBin2Prg.n_UseClassPerFile = 1 Then +*-- Esto crea la máscara de búsqueda "filename.*.ext" para encontrar las partes +*-- con la sintaxis "Classlib.Classname.ext" o "Database.MemberName.ext" + lcBaseFilename = Juststem( Juststem(.c_InputFile) ) + lcInputFile = Addbs( Justpath(.c_InputFile) ) + lcBaseFilename + '.*.' + Justext(.c_InputFile) + Else && toFoxBin2Prg.n_UseClassPerFile = 2 +*-- Esto crea la máscara de búsqueda "filename.*.*.ext" para encontrar las partes +*-- con la sintaxis "Classlib.ClassType.Classname.ext" o "Database.MemberType.MemberName.ext" + lcBaseFilename = Juststem( Juststem( Juststem(.c_InputFile) ) ) + lcInputFile = Addbs( Justpath(.c_InputFile) ) + lcBaseFilename + '.*.*.' + Justext(.c_InputFile) + Endif + + If toFoxBin2Prg.n_RedirectClassType = 1 && Redireccionar solo esta clase + lcInputFile = .c_InputFile + Endif *!* Changed by: Lutz Scheffler 15.2.2021 *!* change date="{^2021-02-15,16:09:00}" @@ -10437,336 +10449,753 @@ DEFINE CLASS c_conversor_prg_a_vcx AS c_conversor_prg_a_bin * creates multiple classes in VCX * the problem is ADIR(laFiles,Name+".*.ext") will return files with AT LEAST 2 dots * so we simply remove files with to many dots - lnDots = OCCURS('.',m.lcInputFile) + lnDots = Occurs('.',m.lcInputFile) - lnFileCount = ADIR( laFiles, lcInputFile, "", 1 ) + lnFileCount = Adir( laFiles, lcInputFile, "", 1 ) - IF lnFileCount > 1 - FOR i = m.lnFileCount TO 1 STEP -1 - IF OCCURS('.',laFiles(i,1))>m.lnDots THEN - ADEL(laFiles,i) - lnFileCount = m.lnFileCount-1 - ENDIF &&OCCURS('.',laFiles(i,1))>m.lnDots - NEXT - DIMENSION; - laFiles(EVL(lnFileCount,1),ALEN(laFiles,2)) + If lnFileCount > 1 + For I = m.lnFileCount To 1 Step -1 + If Occurs('.',laFiles(I,1))>m.lnDots Then + Adel(laFiles,I) + lnFileCount = m.lnFileCount-1 + Endif &&OCCURS('.',laFiles(i,1))>m.lnDots + Next + Dimension; + laFiles(Evl(lnFileCount,1),Alen(laFiles,2)) *!* /Changed by: Lutz Scheffler 15.2.2021 - ASORT( laFiles, 1, 0, 0, 1) - ENDIF + Asort( laFiles, 1, 0, 0, 1) + Endif - FOR I = 1 TO lnFileCount - IF toFoxBin2Prg.n_UseClassPerFile = 1 THEN - lcInputFile_Class = FORCEPATH( JUSTSTEM( laFiles(m.I,1) ), JUSTPATH( .c_InputFile ) ) + '.' + JUSTEXT( .c_InputFile ) - lcClassName = LOWER( GETWORDNUM( JUSTFNAME( lcInputFile_Class ), 2, '.' ) ) + For I = 1 To lnFileCount + If toFoxBin2Prg.n_UseClassPerFile = 1 Then + lcInputFile_Class = Forcepath( Juststem( laFiles(m.I,1) ), Justpath( .c_InputFile ) ) + '.' + Justext( .c_InputFile ) + lcClassName = Lower( Getwordnum( Justfname( lcInputFile_Class ), 2, '.' ) ) - *-- Verificación de las Clases, si son Externas y se indicó chequearlas - IF toFoxBin2Prg.l_ClassPerFileCheck AND EMPTY(toFoxBin2Prg.c_ClassOperationType) ; - AND ASCAN( toModulo._ExternalClasses , lcClassName, 1, 0, 1, 1+2+4 ) = 0 - .writeLog( C_TAB + '- ' + loLang.C_OUTER_CLASS_DOES_NOT_MATCH_INNER_CLASSES_LOC + ' [' + lcInputFile_Class + ']' ) - .writeErrorLog( C_TAB + '- ' + loLang.C_WARNING_LOC + ' ' + loLang.C_OUTER_CLASS_DOES_NOT_MATCH_INNER_CLASSES_LOC + ' [' + lcInputFile_Class + ']' ) - LOOP && Salteo esta clase porque se indicó chequear y no concuerda con las anotadas - ENDIF - ELSE && toFoxBin2Prg.n_UseClassPerFile = 2 - lcInputFile_Class = FORCEPATH( JUSTSTEM( laFiles(m.I,1) ), JUSTPATH( .c_InputFile ) ) + '.' + JUSTEXT( .c_InputFile ) - lcClassName = LOWER( GETWORDNUM( JUSTFNAME( lcInputFile_Class ), 2, '.' ) + '.' + GETWORDNUM( JUSTFNAME( lcInputFile_Class ), 3, '.' ) ) +*-- Verificación de las Clases, si son Externas y se indicó chequearlas + If toFoxBin2Prg.l_ClassPerFileCheck And Empty(toFoxBin2Prg.c_ClassOperationType) ; + AND Ascan( toModulo._ExternalClasses , lcClassName, 1, 0, 1, 1+2+4 ) = 0 + .writeLog( C_TAB + '- ' + loLang.C_OUTER_CLASS_DOES_NOT_MATCH_INNER_CLASSES_LOC + ' [' + lcInputFile_Class + ']' ) + .writeErrorLog( C_TAB + '- ' + loLang.C_WARNING_LOC + ' ' + loLang.C_OUTER_CLASS_DOES_NOT_MATCH_INNER_CLASSES_LOC + ' [' + lcInputFile_Class + ']' ) + Loop && Salteo esta clase porque se indicó chequear y no concuerda con las anotadas + Endif + Else && toFoxBin2Prg.n_UseClassPerFile = 2 + lcInputFile_Class = Forcepath( Juststem( laFiles(m.I,1) ), Justpath( .c_InputFile ) ) + '.' + Justext( .c_InputFile ) + lcClassName = Lower( Getwordnum( Justfname( lcInputFile_Class ), 2, '.' ) + '.' + Getwordnum( Justfname( lcInputFile_Class ), 3, '.' ) ) - *-- Verificación de las Clases, si son Externas y se indicó chequearlas - IF toFoxBin2Prg.l_ClassPerFileCheck AND EMPTY(toFoxBin2Prg.c_ClassOperationType) ; - AND ASCAN( toModulo._ExternalClasses , lcClassName, 1, 0, 2, 1+2+4 ) = 0 - .writeLog( C_TAB + '- ' + loLang.C_OUTER_CLASS_DOES_NOT_MATCH_INNER_CLASSES_LOC + ' [' + lcInputFile_Class + ']' ) - .writeErrorLog( C_TAB + '- ' + loLang.C_WARNING_LOC + ' ' + loLang.C_OUTER_CLASS_DOES_NOT_MATCH_INNER_CLASSES_LOC + ' [' + lcInputFile_Class + ']' ) - LOOP && Salteo esta clase porque se indicó chequear y no concuerda con las anotadas - ENDIF - ENDIF +*-- Verificación de las Clases, si son Externas y se indicó chequearlas + If toFoxBin2Prg.l_ClassPerFileCheck And Empty(toFoxBin2Prg.c_ClassOperationType) ; + AND Ascan( toModulo._ExternalClasses , lcClassName, 1, 0, 2, 1+2+4 ) = 0 + .writeLog( C_TAB + '- ' + loLang.C_OUTER_CLASS_DOES_NOT_MATCH_INNER_CLASSES_LOC + ' [' + lcInputFile_Class + ']' ) + .writeErrorLog( C_TAB + '- ' + loLang.C_WARNING_LOC + ' ' + loLang.C_OUTER_CLASS_DOES_NOT_MATCH_INNER_CLASSES_LOC + ' [' + lcInputFile_Class + ']' ) + Loop && Salteo esta clase porque se indicó chequear y no concuerda con las anotadas + Endif + Endif - .writeLog( C_TAB + C_TAB + '+ ' + loLang.C_INCLUDING_CLASS_LOC + ' ' + JUSTFNAME( lcInputFile_Class ) ) + .writeLog( C_TAB + C_TAB + '+ ' + loLang.C_INCLUDING_CLASS_LOC + ' ' + Justfname( lcInputFile_Class ) ) - *-- addProcessedFile( tcFile, tcInOutType, tcProcessed, tcHasErrors, tcSupported, tcExpanded ) - IF toFoxBin2Prg.addProcessedFile( lcInputFile_Class, 'I', 'P1', 'E0', 'S1', 'X1' ) THEN +*-- addProcessedFile( tcFile, tcInOutType, tcProcessed, tcHasErrors, tcSupported, tcExpanded ) + If toFoxBin2Prg.addProcessedFile( lcInputFile_Class, 'I', 'P1', 'E0', 'S1', 'X1' ) Then + toFoxBin2Prg.updateProcessedFile() + Endif + + If toFoxBin2Prg.l_ProcessFiles Then + toFoxBin2Prg.normalizeFileCapitalization( .T., lcInputFile_Class ) + C_FB2PRG_CODE = C_FB2PRG_CODE + CR_LF + Filetostr( lcInputFile_Class ) + Endif + Endfor + + lnCodeLines = Alines( laCodeLines, C_FB2PRG_CODE ) + Else +*-- No es clase por archivo, o no se quiere redireccionar a Main, o se usó +*-- la sintaxis "classlib.vcx::classname::import" + If toFoxBin2Prg.l_ProcessFiles Then + C_FB2PRG_CODE = Filetostr( .c_InputFile ) + lnCodeLines = Alines( laCodeLines, C_FB2PRG_CODE ) + + .updateProgressbar( 'Identifying Header Blocks...', 1, lnCodeLines, 1 ) + .identifyHeaderBlocks( @laCodeLines, lnCodeLines, @laLineasExclusion, lnBloquesExclusion, @toModulo, @toFoxBin2Prg ) + Endif + + Endif + + If Not toFoxBin2Prg.l_ProcessFiles Then +*-- addProcessedFile( tcFile, tcInOutType, tcProcessed, tcHasErrors, tcSupported, tcExpanded ) + If toFoxBin2Prg.addProcessedFile( .c_OutputFile, 'O', 'P1', 'E0', 'S1', 'X0' ) Then toFoxBin2Prg.updateProcessedFile() - ENDIF + Endif - IF toFoxBin2Prg.l_ProcessFiles THEN - toFoxBin2Prg.normalizeFileCapitalization( .T., lcInputFile_Class ) - C_FB2PRG_CODE = C_FB2PRG_CODE + CR_LF + FILETOSTR( lcInputFile_Class ) - ENDIF - ENDFOR + Exit && Si se indicó no procesar, se sale aquí. (Modo de simulación) + Endif - lnCodeLines = ALINES( laCodeLines, C_FB2PRG_CODE ) - ELSE - *-- No es clase por archivo, o no se quiere redireccionar a Main, o se usó - *-- la sintaxis "classlib.vcx::classname::import" - IF toFoxBin2Prg.l_ProcessFiles THEN - C_FB2PRG_CODE = FILETOSTR( .c_InputFile ) - lnCodeLines = ALINES( laCodeLines, C_FB2PRG_CODE ) +*-- Identifico los TEXT/ENDTEXT, #IF .F./#ENDIF + .updateProgressbar( 'Identifying Excluded Blocks...', 3, lnCodeLines, 1 ) + .identifyExclusionBlocks( @laCodeLines, lnCodeLines, .F., @laLineasExclusion, @lnBloquesExclusion ) + +*-- Identifico el inicio/fin de bloque, definición, cabecera y cuerpo de cada clase + .identifyCodeBlocks( @laCodeLines, lnCodeLines, @laLineasExclusion, lnBloquesExclusion, @toModulo, @toFoxBin2Prg ) + + Do Case + Case toFoxBin2Prg.c_SimulateError = 'SIMERR_I1' + Error 'InputFile Error Simulation' + Case toFoxBin2Prg.c_SimulateError = 'SIMERR_I0' + .writeErrorLog( '*** SIMULATED ERROR' ) + Endcase + + If .l_Error + .writeLog( '*** ERRORS found - Generation Cancelled' ) + Exit + Endif + + toFoxBin2Prg.updateProcessedFile( lnIDInputFile ) + .updateProgressbar( loLang.C_GENERATING_BINARY_LOC + '...', 0, lnCodeLines, 1 ) + + If toFoxBin2Prg.n_RedirectClassType = 1 Or Not Empty(toFoxBin2Prg.c_ClassToConvert) && Redireccionar solo esta clase a main + llReplaceClass = .T. + + If Empty(toFoxBin2Prg.c_ClassToConvert) + toFoxBin2Prg.c_OutputFile = Fullpath( Forceext( lcBaseFilename, 'VCX' ), .c_InputFile) + Else + loClase = toModulo._Clases(1) +* Ajusto el nombre interno de la clase al indicado en el nombre del archivo + loClase._Nombre = toFoxBin2Prg.c_ClassToConvert + loClase._ObjName = toFoxBin2Prg.c_ClassToConvert +* Reemplazo la propiedad Name + lnRow = Ascan(loClase._Props, 'Name', 1, -1, 1, 2+4+8) + If lnRow > 0 + loClase._Props(lnRow,2) = ["] + toFoxBin2Prg.c_ClassToConvert + ["] + Endif +* Y finalmente actualizo el memo + loClase._PROPERTIES = .classProps2Memo( @loClase, @toFoxBin2Prg ) + Endif + + toFoxBin2Prg.doBackup( .F., .T., '', '', '' ) + + If Adir( laFiles, toFoxBin2Prg.c_OutputFile, "", 1 ) = 1 + Use (toFoxBin2Prg.c_OutputFile) Alias TABLABIN Again Shared + Else + .createClasslib() + Endif + Else + toFoxBin2Prg.doBackup( .F., .T., '', '', '' ) + .createClasslib() + Endif + + .writeBinaryFile( @toModulo, @toFoxBin2Prg, llReplaceClass ) + Endwith && THIS + + + Catch To toEx + If This.n_Debug > 0 And _vfp.StartMode = 0 + Set Step On + Endif + + Throw + + Finally + Use In (Select("TABLABIN")) + Store Null To loClase + Release lnCodError, laCodeLines, lnCodeLines, lcInputFile, lcInputFile_Class, lnFileCount, laFiles ; + , laLineasExclusion, lnBloquesExclusion, I + Endtry + + Return + Endproc + + + + + Procedure writeBinaryFile + Lparameters toModulo, toFoxBin2Prg, tlReplaceClass +*-- Estructura del objeto toModulo generado: +*-- ----------------------------------------------------------------------------------------------------------- +*-- Version Versión usada para generar la versión PRG analizada +*-- SourceFile Nombre original del archivo fuente de la conversión +*-- Ole_Obj_Count Cantidad de objetos definidos en el array ole_objs[] +*-- Ole_Objs[1] Array de objetos OLE definidos como clases +*-- ObjName Nombre del objeto OLE (OLE2) +*-- Parent Nombre del objeto Padre +*-- CheckSum Suma de verificación +*-- Value Valor del campo OLE +*-- Clases_Count Array con las posiciones de los addobjects, definicion y propiedades +*-- Clases[1] Array con los datos de las clases, definicion, propiedades y métodos +*-- Nombre El nombre de la clase (ej: "miClase") +*-- ObjName Nombre del objeto +*-- Parent Nombre del objeto Padre +*-- Class Clase de la que hereda la definición +*-- Classloc Librería donde está la definición de la clase +*-- Ole Información campo ole +*-- Ole2 Información campo ole2 +*-- OlePublic Indica si la clase es OLEPublic o no (.T. / .F.) +*-- Uniqueid ID único +*-- Comentario El comentario de la clase (ej: "&& Mis comentarios") +*-- MetaData Información de metadata de la clase (baseclass, timestamp, scale) +*-- BaseClass Clase de base de la clase +*-- TimeStamp Timestamp de la clase +*-- Scale Scale de la clase (pixels, foxels) +*-- Definicion La definición de la clase (ej: "AS Custom OF LIBRERIA.VCX") +*-- Inicio/Fin Línea de inicio/fin de la clase (DEFINE CLASS/ENDDEFINE) +*-- Ini_Cab/Fin_Cab Línea de inicio/fin de la cabecera (def.propiedades, Hidden, Protected, #Include, CLASSDATA, DEFINED_PAM) +*-- Ini_Cuerpo/Fin_Cuerpo Línea de inicio/fin del cuerpo (ADD OBJECTs y PROCEDURES) +*-- HiddenProps Propiedades definidas como HIDDEN (ocultas) +*-- ProtectedProps Propiedades definidas como PROTECTED (protegidas) +*-- Defined_PAM Propiedades, eventos o métodos definidos por el usuario +*-- IncludeFile Nombre del archivo de inclusión +*-- Props_Count Cantidad de propiedades de la clase definicas en el array props[] +*-- Props[1,2] Array con todas las propiedades de la clase y sus valores. (col.1=Nombre, col.2=Comentario) +*-- AddObject_Count Cantidad de objetos definidos en el array addobjects[] +*-- AddObjects[1] Array con las posiciones de los addobjects, definicion y propiedades +*-- Nombre Nombre del objeto +*-- ObjName Nombre del objeto +*-- Parent Nombre del objeto Padre +*-- Clase Clase del objeto +*-- ClassLib Librería de clases de la que deriva la clase +*-- Baseclass Clase de base del objeto +*-- Uniqueid ID único +*-- Ole Información campo ole +*-- Ole2 Información campo ole2 +*-- ZOrder Orden Z del objeto +*-- Props_Count Cantidad de propiedades del objeto +*-- Props[1] Array con todas las propiedades del objeto y sus valores +*-- Procedure_count Cantidad de procedimientos definidos en el array procedures[] +*-- Procedures[1] Array con las posiciones de los procedures, definicion y comentarios +*-- Nombre Nombre del procedure +*-- ProcType Tipo de procedimiento (normal, hidden, protected) +*-- Comentario Comentario el procedure +*-- ProcLine_Count Cantidad de líneas del procedimiento +*-- ProcLines[1] Líneas del procedimiento +*-- Procedure_count Cantidad de procedimientos definidos en el array procedures[] +*-- Procedures[1] Array con las posiciones de los procedures, definicion y comentarios +*-- Nombre Nombre del procedure +*-- ProcType Tipo de procedimiento (normal, hidden, protected) +*-- Comentario Comentario el procedure +*-- ProcLine_Count Cantidad de líneas del procedimiento +*-- ProcLines[1] Líneas del procedimiento +*-- ----------------------------------------------------------------------------------------------------------- + #If .F. + Local toModulo As CL_CLASSLIB Of 'FOXBIN2PRG.PRG' + Local toFoxBin2Prg As c_foxbin2prg Of 'FOXBIN2PRG.PRG' + #Endif + + Try + Local lcObjName, lnCodError, I, X, llReplace, laUniqueID(1,1), loEx As Exception ; + , loClase As CL_CLASE Of 'FOXBIN2PRG.PRG' ; + , loFSO As Scripting.FileSystemObject + + With This As c_conversor_prg_a_vcx Of 'FOXBIN2PRG.PRG' + Store Null To loFSO, loClase + loFSO = .oFSO + +*-- addProcessedFile( tcFile, tcInOutType, tcProcessed, tcHasErrors, tcSupported, tcExpanded ) + toFoxBin2Prg.addProcessedFile( .c_OutputFile, 'O', 'P1', 'E0', 'S1', 'X0' ) + + + Do Case + Case toFoxBin2Prg.c_SimulateError = 'SIMERR_O1' + Error 'OutputFile Error Simulation' + Endcase + + If tlReplaceClass + I = 1 + loClase = toModulo._Clases(m.I) + Locate For PLATFORM == Padr('WINDOWS', Fsize('PLATFORM')) And Lower(OBJNAME) == loClase._ObjName + llReplace = Found() + Endif + + If llReplace +*-- Reemplazar los campos del registro actual + If Empty(loClase._TimeStamp) + loClase._TimeStamp = .rowTimeStamp( {^2013/11/04 20:00:00} ) + Endif + If Empty(loClase._UniqueID) + loClase._UniqueID = toFoxBin2Prg.unique_ID() + Endif + + Replace ; + PLATFORM With 'WINDOWS' ; + , Timestamp With loClase._TimeStamp ; + , Class With loClase._Class ; + , CLASSLOC With loClase._ClassLoc ; + , BaseClass With loClase._BaseClass ; + , OBJNAME With loClase._ObjName ; + , Parent With loClase._Parent ; + , PROPERTIES With loClase._PROPERTIES ; + , Protected With loClase._PROTECTED ; + , METHODS With loClase._METHODS ; + , OLE With loClase._Ole ; + , OLE2 With loClase._Ole2 ; + , RESERVED1 With loClase._RESERVED1 ; + , RESERVED2 With loClase._RESERVED2 ; + , RESERVED3 With loClase._RESERVED3 ; + , RESERVED4 With loClase._RESERVED4 ; + , RESERVED5 With loClase._RESERVED5 ; + , RESERVED6 With loClase._RESERVED6 ; + , RESERVED7 With loClase._RESERVED7 ; + , RESERVED8 With loClase._RESERVED8 ; + , User With loClase._User + +* Si tiene objetos asociados, antes debo eliminar los existentes para no duplicarlos + Delete All For PLATFORM == Padr('WINDOWS', Fsize('PLATFORM')) And Lower(Parent) == loClase._ObjName + + .insert_AllObjects( @loClase, @toFoxBin2Prg ) + + Else +*-- Creo el registro de cabecera + If tlReplaceClass And Reccount() > 0 + Select Max(Val(Substr(UNIQUEID,2))) From TABLABIN Into Array laUniqueID + toFoxBin2Prg.n_ID = laUniqueID(1) + Else + .createClasslib_RecordHeader( toModulo ) + Endif + +*-- Recorro las CLASES + For X = 1 To 2 + For I = 1 To toModulo._Clases_Count + loClase = Null + loClase = toModulo._Clases(m.I) + +*-- El dataenvironment debe estar primero, luego lo demás. + If m.X = 1 And Not loClase._BaseClass == 'dataenvironment' ; + OR m.X = 2 And loClase._BaseClass == 'dataenvironment' + Loop + Endif + + If Empty(loClase._TimeStamp) + loClase._TimeStamp = .rowTimeStamp( {^2013/11/04 20:00:00} ) + Endif + If Empty(loClase._UniqueID) + loClase._UniqueID = toFoxBin2Prg.unique_ID() + Endif + +*-- Inserto la clase + Insert Into TABLABIN ; + ( PLATFORM ; + , UNIQUEID ; + , Timestamp ; + , Class ; + , CLASSLOC ; + , BaseClass ; + , OBJNAME ; + , Parent ; + , PROPERTIES ; + , Protected ; + , METHODS ; + , OLE ; + , OLE2 ; + , RESERVED1 ; + , RESERVED2 ; + , RESERVED3 ; + , RESERVED4 ; + , RESERVED5 ; + , RESERVED6 ; + , RESERVED7 ; + , RESERVED8 ; + , User) ; + VALUES ; + ( 'WINDOWS' ; + , loClase._UniqueID ; + , loClase._TimeStamp ; + , loClase._Class ; + , loClase._ClassLoc ; + , loClase._BaseClass ; + , loClase._ObjName ; + , loClase._Parent ; + , loClase._PROPERTIES ; + , loClase._PROTECTED ; + , loClase._METHODS ; + , loClase._Ole ; + , loClase._Ole2 ; + , loClase._RESERVED1 ; + , loClase._RESERVED2 ; + , loClase._RESERVED3 ; + , loClase._ClassIcon ; + , loClase._ProjectClassIcon ; + , loClase._Scale ; + , loClase._Comentario ; + , loClase._includeFile ; + , loClase._User ) + + + .insert_AllObjects( @loClase, @toFoxBin2Prg ) + + +*-- Inserto el COMMENT + Insert Into TABLABIN ; + ( PLATFORM ; + , UNIQUEID ; + , Timestamp ; + , Class ; + , CLASSLOC ; + , BaseClass ; + , OBJNAME ; + , Parent ; + , PROPERTIES ; + , Protected ; + , METHODS ; + , OLE ; + , OLE2 ; + , RESERVED1 ; + , RESERVED2 ; + , RESERVED3 ; + , RESERVED4 ; + , RESERVED5 ; + , RESERVED6 ; + , RESERVED7 ; + , RESERVED8 ; + , User) ; + VALUES ; + ( 'COMMENT' ; + , 'RESERVED' ; + , 0 ; + , '' ; + , '' ; + , '' ; + , loClase._ObjName ; + , '' ; + , '' ; + , '' ; + , '' ; + , '' ; + , '' ; + , '' ; + , Iif(loClase._OlePublic, 'OLEPublic', '') ; + , '' ; + , '' ; + , '' ; + , '' ; + , '' ; + , '' ; + , '' ) + + Endfor && I = 1 TO toModulo._Clases_Count + Endfor && X = 1 TO 2 + Endif + + Use In (Select("TABLABIN")) + + If toFoxBin2Prg.l_Recompile + toFoxBin2Prg.compileFoxProBinary() + Endif + + toFoxBin2Prg.updateProcessedFile() + Endwith && THIS + + + Catch To loEx + lnCodError = loEx.ErrorNo + toFoxBin2Prg.updateProcessedFile( 0, '', '', 'E1' ) + + If This.n_Debug > 0 And _vfp.StartMode = 0 + Set Step On + Endif + + Throw + + Finally + Use In (Select("TABLABIN")) + Store Null To loFSO, loClase + Release lcObjName, I, X, loClase, loFSO + + Endtry + + Return lnCodError + + Endproc +Enddefine + + + + +Define Class c_conversor_prg_a_scx As c_conversor_prg_a_bin + #If .F. + Local This As c_conversor_prg_a_scx Of 'FOXBIN2PRG.PRG' + #Endif +*_MEMBERDATA = [] ; ++ [] ; ++ [] + c_Type = 'SC2' + + + Procedure convert +*--------------------------------------------------------------------------------------------------- +* PARÁMETROS: (v=Pasar por valor | @=Pasar por referencia) (!=Obligatorio | ?=Opcional) (IN/OUT) +* toModulo (@! OUT) Objeto generado de clase CL_CLASSLIB con la información leida del texto +* toEx (@! OUT) Objeto con información del error +* toFoxBin2Prg (@! IN ) Referencia al objeto principal +*--------------------------------------------------------------------------------------------------- + Lparameters toModulo, toEx As Exception, toFoxBin2Prg + #If .F. + Local toModulo As CL_CLASSLIB Of 'FOXBIN2PRG.PRG' + Local toFoxBin2Prg As c_foxbin2prg Of 'FOXBIN2PRG.PRG' + #Endif + DoDefault( @toModulo, @toEx, @toFoxBin2Prg ) + + Try + Local lnCodError, laCodeLines(1), lnCodeLines, lcInputFile, lcInputFile_Class, lnFileCount, laFiles(1,5) ; + , laLineasExclusion(1), lnBloquesExclusion, I, lnIDInputFile ; + , loLang As CL_LANG Of 'FOXBIN2PRG.PRG' + + With This As c_conversor_prg_a_vcx Of 'FOXBIN2PRG.PRG' + Store 0 To lnCodError, lnCodeLines + Store '' To C_FB2PRG_CODE + Store Null To toModulo + + loLang = _Screen.o_FoxBin2Prg_Lang + toModulo = Createobject('CL_CLASSLIB') + lnIDInputFile = toFoxBin2Prg.n_ProcessedFiles + + If toFoxBin2Prg.n_UseClassPerFile > 0 And toFoxBin2Prg.l_RedirectClassPerFileToMain + C_FB2PRG_CODE = Filetostr( .c_InputFile ) + + lnCodeLines = Alines( laCodeLines, C_FB2PRG_CODE ) .updateProgressbar( 'Identifying Header Blocks...', 1, lnCodeLines, 1 ) .identifyHeaderBlocks( @laCodeLines, lnCodeLines, @laLineasExclusion, lnBloquesExclusion, @toModulo, @toFoxBin2Prg ) - ENDIF - ENDIF + .updateProgressbar( 'Loading Code...', 2, lnCodeLines, 1 ) - IF NOT toFoxBin2Prg.l_ProcessFiles THEN - *-- addProcessedFile( tcFile, tcInOutType, tcProcessed, tcHasErrors, tcSupported, tcExpanded ) - IF toFoxBin2Prg.addProcessedFile( .c_OutputFile, 'O', 'P1', 'E0', 'S1', 'X0' ) THEN - toFoxBin2Prg.updateProcessedFile() - ENDIF +*-- MÁSCARA DE BÚSQUEDA + If toFoxBin2Prg.n_UseClassPerFile = 1 Then +*-- Esto crea la máscara de búsqueda "filename.*.ext" para encontrar las partes + lcBaseFilename = Juststem( Juststem(.c_InputFile) ) + lcInputFile = Addbs( Justpath(.c_InputFile) ) + lcBaseFilename + '.*.' + Justext(.c_InputFile) + Else && toFoxBin2Prg.n_UseClassPerFile = 2 +*-- Esto crea la máscara de búsqueda "Database.*.*.ext" para encontrar las partes +*-- con la sintaxis "Database.MemberType.MemberName.ext" + lcBaseFilename = Juststem( Juststem( Juststem(.c_InputFile) ) ) + lcInputFile = Addbs( Justpath(.c_InputFile) ) + lcBaseFilename + '.*.*.' + Justext(.c_InputFile) + Endif - EXIT && Si se indicó no procesar, se sale aquí. (Modo de simulación) - ENDIF + lnFileCount = Adir( laFiles, lcInputFile, "", 1 ) + Asort( laFiles, 1, 0, 0, 1) - *-- Identifico los TEXT/ENDTEXT, #IF .F./#ENDIF - .updateProgressbar( 'Identifying Excluded Blocks...', 3, lnCodeLines, 1 ) - .identifyExclusionBlocks( @laCodeLines, lnCodeLines, .F., @laLineasExclusion, @lnBloquesExclusion ) + For I = 1 To lnFileCount + If toFoxBin2Prg.n_UseClassPerFile = 1 Then + lcInputFile_Class = Forcepath( Juststem( laFiles(m.I,1) ), Justpath( .c_InputFile ) ) + '.' + Justext( .c_InputFile ) + lcClassName = Lower( Getwordnum( Justfname( lcInputFile_Class ), 2, '.' ) ) - *-- Identifico el inicio/fin de bloque, definición, cabecera y cuerpo de cada clase - .identifyCodeBlocks( @laCodeLines, lnCodeLines, @laLineasExclusion, lnBloquesExclusion, @toModulo, @toFoxBin2Prg ) +*-- Verificación de las Clases, si son Externas y se indicó chequearlas + If toFoxBin2Prg.l_ClassPerFileCheck And Empty(toFoxBin2Prg.c_ClassOperationType) ; + AND Ascan( toModulo._ExternalClasses , lcClassName, 1, 0, 1, 1+2+4 ) = 0 + .writeLog( C_TAB + '- ' + loLang.C_OUTER_CLASS_DOES_NOT_MATCH_INNER_CLASSES_LOC + ' [' + lcInputFile_Class + ']' ) + .writeErrorLog( C_TAB + '- ' + loLang.C_WARNING_LOC + ' ' + loLang.C_OUTER_CLASS_DOES_NOT_MATCH_INNER_CLASSES_LOC + ' [' + lcInputFile_Class + ']' ) + Loop && Salteo esta clase + Endif + Else && toFoxBin2Prg.n_UseClassPerFile = 2 + lcInputFile_Class = Forcepath( Juststem( laFiles(m.I,1) ), Justpath( .c_InputFile ) ) + '.' + Justext( .c_InputFile ) + lcClassName = Lower( Getwordnum( Justfname( lcInputFile_Class ), 2, '.' ) + '.' + Getwordnum( Justfname( lcInputFile_Class ), 3, '.' ) ) - DO CASE - CASE toFoxBin2Prg.c_SimulateError = 'SIMERR_I1' - ERROR 'InputFile Error Simulation' - CASE toFoxBin2Prg.c_SimulateError = 'SIMERR_I0' - .writeErrorLog( '*** SIMULATED ERROR' ) - ENDCASE +*-- Verificación de las Clases, si son Externas y se indicó chequearlas + If toFoxBin2Prg.l_ClassPerFileCheck And Empty(toFoxBin2Prg.c_ClassOperationType) ; + AND Ascan( toModulo._ExternalClasses , lcClassName, 1, 0, 2, 1+2+4 ) = 0 + .writeLog( C_TAB + '- ' + loLang.C_OUTER_CLASS_DOES_NOT_MATCH_INNER_CLASSES_LOC + ' [' + lcInputFile_Class + ']' ) + .writeErrorLog( C_TAB + '- ' + loLang.C_WARNING_LOC + ' ' + loLang.C_OUTER_CLASS_DOES_NOT_MATCH_INNER_CLASSES_LOC + ' [' + lcInputFile_Class + ']' ) + Loop && Salteo esta clase + Endif + Endif - IF .l_Error - .writeLog( '*** ERRORS found - Generation Cancelled' ) - EXIT - ENDIF + .writeLog( C_TAB + C_TAB + '+ ' + loLang.C_INCLUDING_CLASS_LOC + ' ' + Justfname( lcInputFile_Class ) ) - toFoxBin2Prg.updateProcessedFile( lnIDInputFile ) - .updateProgressbar( loLang.C_GENERATING_BINARY_LOC + '...', 0, lnCodeLines, 1 ) +*-- addProcessedFile( tcFile, tcInOutType, tcProcessed, tcHasErrors, tcSupported, tcExpanded ) + If toFoxBin2Prg.addProcessedFile( lcInputFile_Class, 'I', 'P1', 'E0', 'S1', 'X1' ) Then + toFoxBin2Prg.updateProcessedFile() + Endif - IF toFoxBin2Prg.n_RedirectClassType = 1 OR NOT EMPTY(toFoxBin2Prg.c_ClassToConvert) && Redireccionar solo esta clase a main - llReplaceClass = .T. + toFoxBin2Prg.normalizeFileCapitalization( .T., lcInputFile_Class ) + C_FB2PRG_CODE = C_FB2PRG_CODE + CR_LF + Filetostr( lcInputFile_Class ) + Endfor - IF EMPTY(toFoxBin2Prg.c_ClassToConvert) - toFoxBin2Prg.c_OutputFile = FULLPATH( FORCEEXT( lcBaseFilename, 'VCX' ), .c_InputFile) - ELSE - loClase = toModulo._Clases(1) - * Ajusto el nombre interno de la clase al indicado en el nombre del archivo - loClase._Nombre = toFoxBin2Prg.c_ClassToConvert - loClase._ObjName = toFoxBin2Prg.c_ClassToConvert - * Reemplazo la propiedad Name - lnRow = ASCAN(loClase._Props, 'Name', 1, -1, 1, 2+4+8) - IF lnRow > 0 - loClase._Props(lnRow,2) = ["] + toFoxBin2Prg.c_ClassToConvert + ["] - ENDIF - * Y finalmente actualizo el memo - loClase._PROPERTIES = .classProps2Memo( @loClase, @toFoxBin2Prg ) - ENDIF + lnCodeLines = Alines( laCodeLines, C_FB2PRG_CODE ) + Else +*-- No es clase por archivo, o no se quiere redireccionar a Main. + C_FB2PRG_CODE = Filetostr( .c_InputFile ) + lnCodeLines = Alines( laCodeLines, C_FB2PRG_CODE ) + .updateProgressbar( 'Identifying Header Blocks...', 1, lnCodeLines, 1 ) + .identifyHeaderBlocks( @laCodeLines, lnCodeLines, @laLineasExclusion, lnBloquesExclusion, @toModulo, @toFoxBin2Prg ) + + Endif + + If Not toFoxBin2Prg.l_ProcessFiles Then +*-- addProcessedFile( tcFile, tcInOutType, tcProcessed, tcHasErrors, tcSupported, tcExpanded ) + If toFoxBin2Prg.addProcessedFile( .c_OutputFile, 'O', 'P1', 'E0', 'S1', 'X0' ) Then + toFoxBin2Prg.updateProcessedFile() + Endif + + Exit && Si se indicó no procesar, se sale aquí. (Modo de simulación) + Endif + +*-- Identifico los TEXT/ENDTEXT, #IF .F./#ENDIF + .updateProgressbar( 'Identifying Excluded Blocks...', 3, lnCodeLines, 1 ) + .identifyExclusionBlocks( @laCodeLines, lnCodeLines, .F., @laLineasExclusion, @lnBloquesExclusion ) + +*-- Identifico el inicio/fin de bloque, definición, cabecera y cuerpo de cada clase + .identifyCodeBlocks( @laCodeLines, lnCodeLines, @laLineasExclusion, lnBloquesExclusion, @toModulo, @toFoxBin2Prg ) + + Do Case + Case toFoxBin2Prg.c_SimulateError = 'SIMERR_I1' + Error 'InputFile Error Simulation' + Case toFoxBin2Prg.c_SimulateError = 'SIMERR_I0' + .writeErrorLog( '*** SIMULATED ERROR' ) + Endcase + + If .l_Error + .writeLog( '*** ERRORS found - Generation Cancelled' ) + Exit + Endif + + toFoxBin2Prg.updateProcessedFile( lnIDInputFile ) + .updateProgressbar( 'Generating Binary...', 0, lnCodeLines, 1 ) toFoxBin2Prg.doBackup( .F., .T., '', '', '' ) - - IF ADIR( laFiles, toFoxBin2Prg.c_OutputFile, "", 1 ) = 1 - USE (toFoxBin2Prg.c_OutputFile) ALIAS TABLABIN AGAIN SHARED - ELSE - .createClasslib() - ENDIF - ELSE - toFoxBin2Prg.doBackup( .F., .T., '', '', '' ) - .createClasslib() - ENDIF - - .writeBinaryFile( @toModulo, @toFoxBin2Prg, llReplaceClass ) - ENDWITH && THIS + .createForm() + .writeBinaryFile( @toModulo, @toFoxBin2Prg ) + Endwith && THIS - CATCH TO toEx - IF THIS.n_Debug > 0 AND _VFP.STARTMODE = 0 - SET STEP ON - ENDIF + Catch To toEx + If This.n_Debug > 0 And _vfp.StartMode = 0 + Set Step On + Endif - THROW + Throw - FINALLY - USE IN (SELECT("TABLABIN")) - STORE NULL TO loClase - RELEASE lnCodError, laCodeLines, lnCodeLines, lcInputFile, lcInputFile_Class, lnFileCount, laFiles ; - , laLineasExclusion, lnBloquesExclusion, I - ENDTRY + Finally + Use In (Select("TABLABIN")) + Release lnCodError, laCodeLines, lnCodeLines, lcInputFile, lcInputFile_Class, lnFileCount, laFiles ; + , laLineasExclusion, lnBloquesExclusion, I + Endtry - RETURN - ENDPROC + Return + Endproc - PROCEDURE writeBinaryFile - LPARAMETERS toModulo, toFoxBin2Prg, tlReplaceClass - *-- Estructura del objeto toModulo generado: - *-- ----------------------------------------------------------------------------------------------------------- - *-- Version Versión usada para generar la versión PRG analizada - *-- SourceFile Nombre original del archivo fuente de la conversión - *-- Ole_Obj_Count Cantidad de objetos definidos en el array ole_objs[] - *-- Ole_Objs[1] Array de objetos OLE definidos como clases - *-- ObjName Nombre del objeto OLE (OLE2) - *-- Parent Nombre del objeto Padre - *-- CheckSum Suma de verificación - *-- Value Valor del campo OLE - *-- Clases_Count Array con las posiciones de los addobjects, definicion y propiedades - *-- Clases[1] Array con los datos de las clases, definicion, propiedades y métodos - *-- Nombre El nombre de la clase (ej: "miClase") - *-- ObjName Nombre del objeto - *-- Parent Nombre del objeto Padre - *-- Class Clase de la que hereda la definición - *-- Classloc Librería donde está la definición de la clase - *-- Ole Información campo ole - *-- Ole2 Información campo ole2 - *-- OlePublic Indica si la clase es OLEPublic o no (.T. / .F.) - *-- Uniqueid ID único - *-- Comentario El comentario de la clase (ej: "&& Mis comentarios") - *-- MetaData Información de metadata de la clase (baseclass, timestamp, scale) - *-- BaseClass Clase de base de la clase - *-- TimeStamp Timestamp de la clase - *-- Scale Scale de la clase (pixels, foxels) - *-- Definicion La definición de la clase (ej: "AS Custom OF LIBRERIA.VCX") - *-- Inicio/Fin Línea de inicio/fin de la clase (DEFINE CLASS/ENDDEFINE) - *-- Ini_Cab/Fin_Cab Línea de inicio/fin de la cabecera (def.propiedades, Hidden, Protected, #Include, CLASSDATA, DEFINED_PAM) - *-- Ini_Cuerpo/Fin_Cuerpo Línea de inicio/fin del cuerpo (ADD OBJECTs y PROCEDURES) - *-- HiddenProps Propiedades definidas como HIDDEN (ocultas) - *-- ProtectedProps Propiedades definidas como PROTECTED (protegidas) - *-- Defined_PAM Propiedades, eventos o métodos definidos por el usuario - *-- IncludeFile Nombre del archivo de inclusión - *-- Props_Count Cantidad de propiedades de la clase definicas en el array props[] - *-- Props[1,2] Array con todas las propiedades de la clase y sus valores. (col.1=Nombre, col.2=Comentario) - *-- AddObject_Count Cantidad de objetos definidos en el array addobjects[] - *-- AddObjects[1] Array con las posiciones de los addobjects, definicion y propiedades - *-- Nombre Nombre del objeto - *-- ObjName Nombre del objeto - *-- Parent Nombre del objeto Padre - *-- Clase Clase del objeto - *-- ClassLib Librería de clases de la que deriva la clase - *-- Baseclass Clase de base del objeto - *-- Uniqueid ID único - *-- Ole Información campo ole - *-- Ole2 Información campo ole2 - *-- ZOrder Orden Z del objeto - *-- Props_Count Cantidad de propiedades del objeto - *-- Props[1] Array con todas las propiedades del objeto y sus valores - *-- Procedure_count Cantidad de procedimientos definidos en el array procedures[] - *-- Procedures[1] Array con las posiciones de los procedures, definicion y comentarios - *-- Nombre Nombre del procedure - *-- ProcType Tipo de procedimiento (normal, hidden, protected) - *-- Comentario Comentario el procedure - *-- ProcLine_Count Cantidad de líneas del procedimiento - *-- ProcLines[1] Líneas del procedimiento - *-- Procedure_count Cantidad de procedimientos definidos en el array procedures[] - *-- Procedures[1] Array con las posiciones de los procedures, definicion y comentarios - *-- Nombre Nombre del procedure - *-- ProcType Tipo de procedimiento (normal, hidden, protected) - *-- Comentario Comentario el procedure - *-- ProcLine_Count Cantidad de líneas del procedimiento - *-- ProcLines[1] Líneas del procedimiento - *-- ----------------------------------------------------------------------------------------------------------- - #IF .F. - LOCAL toModulo AS CL_CLASSLIB OF 'FOXBIN2PRG.PRG' - LOCAL toFoxBin2Prg AS c_foxbin2prg OF 'FOXBIN2PRG.PRG' - #ENDIF + Procedure writeBinaryFile + Lparameters toModulo, toFoxBin2Prg +*-- Estructura del objeto toModulo generado: +*-- ----------------------------------------------------------------------------------------------------------- +*-- Version Versión usada para generar la versión PRG analizada +*-- SourceFile Nombre original del archivo fuente de la conversión +*-- Ole_Obj_Count Cantidad de objetos definidos en el array ole_objs[] +*-- Ole_Objs[1] Array de objetos OLE definidos como clases +*-- ObjName Nombre del objeto OLE (OLE2) +*-- Parent Nombre del objeto Padre +*-- CheckSum Suma de verificación +*-- Value Valor del campo OLE +*-- Clases_Count Array con las posiciones de los addobjects, definicion y propiedades +*-- Clases[1] Array con los datos de las clases, definicion, propiedades y métodos +*-- Nombre El nombre de la clase (ej: "miClase") +*-- ObjName Nombre del objeto +*-- Parent Nombre del objeto Padre +*-- Class Clase de la que hereda la definición +*-- Classloc Librería donde está la definición de la clase +*-- Ole Información campo ole +*-- Ole2 Información campo ole2 +*-- OlePublic Indica si la clase es OLEPublic o no (.T. / .F.) +*-- Uniqueid ID único +*-- Comentario El comentario de la clase (ej: "&& Mis comentarios") +*-- MetaData Información de metadata de la clase (baseclass, timestamp, scale) +*-- BaseClass Clase de base de la clase +*-- TimeStamp Timestamp de la clase +*-- Scale Scale de la clase (pixels, foxels) +*-- Definicion La definición de la clase (ej: "AS Custom OF LIBRERIA.VCX") +*-- Inicio/Fin Línea de inicio/fin de la clase (DEFINE CLASS/ENDDEFINE) +*-- Ini_Cab/Fin_Cab Línea de inicio/fin de la cabecera (def.propiedades, Hidden, Protected, #Include, CLASSDATA, DEFINED_PAM) +*-- Ini_Cuerpo/Fin_Cuerpo Línea de inicio/fin del cuerpo (ADD OBJECTs y PROCEDURES) +*-- HiddenProps Propiedades definidas como HIDDEN (ocultas) +*-- ProtectedProps Propiedades definidas como PROTECTED (protegidas) +*-- Defined_PAM Propiedades, eventos o métodos definidos por el usuario +*-- IncludeFile Nombre del archivo de inclusión +*-- Props_Count Cantidad de propiedades de la clase definicas en el array props[] +*-- Props[1,2] Array con todas las propiedades de la clase y sus valores. (col.1=Nombre, col.2=Comentario) +*-- AddObject_Count Cantidad de objetos definidos en el array addobjects[] +*-- AddObjects[1] Array con las posiciones de los addobjects, definicion y propiedades +*-- Nombre Nombre del objeto +*-- ObjName Nombre del objeto +*-- Parent Nombre del objeto Padre +*-- Clase Clase del objeto +*-- ClassLib Librería de clases de la que deriva la clase +*-- Baseclass Clase de base del objeto +*-- Uniqueid ID único +*-- Ole Información campo ole +*-- Ole2 Información campo ole2 +*-- ZOrder Orden Z del objeto +*-- Props_Count Cantidad de propiedades del objeto +*-- Props[1] Array con todas las propiedades del objeto y sus valores +*-- Procedure_count Cantidad de procedimientos definidos en el array procedures[] +*-- Procedures[1] Array con las posiciones de los procedures, definicion y comentarios +*-- Nombre Nombre del procedure +*-- ProcType Tipo de procedimiento (normal, hidden, protected) +*-- Comentario Comentario el procedure +*-- ProcLine_Count Cantidad de líneas del procedimiento +*-- ProcLines[1] Líneas del procedimiento +*-- Procedure_count Cantidad de procedimientos definidos en el array procedures[] +*-- Procedures[1] Array con las posiciones de los procedures, definicion y comentarios +*-- Nombre Nombre del procedure +*-- ProcType Tipo de procedimiento (normal, hidden, protected) +*-- Comentario Comentario el procedure +*-- ProcLine_Count Cantidad de líneas del procedimiento +*-- ProcLines[1] Líneas del procedimiento +*-- ----------------------------------------------------------------------------------------------------------- + #If .F. + Local toModulo As CL_CLASSLIB Of 'FOXBIN2PRG.PRG' + Local toFoxBin2Prg As c_foxbin2prg Of 'FOXBIN2PRG.PRG' + #Endif - TRY - LOCAL lcObjName, lnCodError, I, X, llReplace, laUniqueID(1,1), loEx AS EXCEPTION ; - , loClase AS CL_CLASE OF 'FOXBIN2PRG.PRG' ; - , loFSO AS Scripting.FileSystemObject + Try + Local lcObjName, lnCodError, I, X, loEx As Exception ; + , loClase As CL_CLASE Of 'FOXBIN2PRG.PRG' - WITH THIS AS c_conversor_prg_a_vcx OF 'FOXBIN2PRG.PRG' - STORE NULL TO loFSO, loClase - loFSO = .oFSO + With This As c_conversor_prg_a_scx Of 'FOXBIN2PRG.PRG' +*-- addProcessedFile( tcFile, tcInOutType, tcProcessed, tcHasErrors, tcSupported, tcExpanded ) + toFoxBin2Prg.addProcessedFile( .c_OutputFile, 'O', 'P1', 'E0', 'S1', 'X0' ) - *-- addProcessedFile( tcFile, tcInOutType, tcProcessed, tcHasErrors, tcSupported, tcExpanded ) - toFoxBin2Prg.addProcessedFile( .c_OutputFile, 'O', 'P1', 'E0', 'S1', 'X0' ) + Do Case + Case toFoxBin2Prg.c_SimulateError = 'SIMERR_O1' + Error 'OutputFile Error Simulation' + Endcase + +*-- Creo el registro de cabecera + .createForm_RecordHeader( toModulo ) + +*-- El SCX tiene el INCLUDE en el primer registro + If Not Empty(toModulo._includeFile) + Replace RESERVED8 With toModulo._includeFile + Endif - DO CASE - CASE toFoxBin2Prg.c_SimulateError = 'SIMERR_O1' - ERROR 'OutputFile Error Simulation' - ENDCASE - - IF tlReplaceClass - I = 1 - loClase = toModulo._Clases(m.I) - LOCATE FOR PLATFORM == PADR('WINDOWS', FSIZE('PLATFORM')) AND LOWER(OBJNAME) == loClase._ObjName - llReplace = FOUND() - ENDIF - - IF llReplace - *-- Reemplazar los campos del registro actual - IF EMPTY(loClase._TimeStamp) - loClase._TimeStamp = .rowTimeStamp( {^2013/11/04 20:00:00} ) - ENDIF - IF EMPTY(loClase._UniqueID) - loClase._UniqueID = toFoxBin2Prg.unique_ID() - ENDIF - - REPLACE ; - PLATFORM WITH 'WINDOWS' ; - , TIMESTAMP WITH loClase._TimeStamp ; - , CLASS WITH loClase._Class ; - , CLASSLOC WITH loClase._ClassLoc ; - , BASECLASS WITH loClase._BaseClass ; - , OBJNAME WITH loClase._ObjName ; - , PARENT WITH loClase._Parent ; - , PROPERTIES WITH loClase._PROPERTIES ; - , PROTECTED WITH loClase._PROTECTED ; - , METHODS WITH loClase._METHODS ; - , OLE WITH loClase._Ole ; - , OLE2 WITH loClase._Ole2 ; - , RESERVED1 WITH loClase._RESERVED1 ; - , RESERVED2 WITH loClase._RESERVED2 ; - , RESERVED3 WITH loClase._RESERVED3 ; - , RESERVED4 WITH loClase._RESERVED4 ; - , RESERVED5 WITH loClase._RESERVED5 ; - , RESERVED6 WITH loClase._RESERVED6 ; - , RESERVED7 WITH loClase._RESERVED7 ; - , RESERVED8 WITH loClase._RESERVED8 ; - , USER WITH loClase._User - - * Si tiene objetos asociados, antes debo eliminar los existentes para no duplicarlos - DELETE ALL FOR PLATFORM == PADR('WINDOWS', FSIZE('PLATFORM')) AND LOWER(PARENT) == loClase._ObjName - - .insert_AllObjects( @loClase, @toFoxBin2Prg ) - - ELSE - *-- Creo el registro de cabecera - IF tlReplaceClass AND RECCOUNT() > 0 - SELECT MAX(VAL(SUBSTR(UNIQUEID,2))) FROM TABLABIN INTO ARRAY laUniqueID - toFoxBin2Prg.n_ID = laUniqueID(1) - ELSE - .createClasslib_RecordHeader( toModulo ) - ENDIF - - *-- Recorro las CLASES - FOR X = 1 TO 2 - FOR I = 1 TO toModulo._Clases_Count - loClase = NULL +*-- Recorro las CLASES + For X = 1 To 2 + For I = 1 To toModulo._Clases_Count + loClase = Null loClase = toModulo._Clases(m.I) - *-- El dataenvironment debe estar primero, luego lo demás. - IF m.X = 1 AND NOT loClase._BaseClass == 'dataenvironment' ; - OR m.X = 2 AND loClase._BaseClass == 'dataenvironment' - LOOP - ENDIF +*-- El dataenvironment debe estar primero, luego lo demás. + If m.X = 1 And Not loClase._BaseClass == 'dataenvironment' ; + OR m.X = 2 And loClase._BaseClass == 'dataenvironment' + Loop + Endif - IF EMPTY(loClase._TimeStamp) + If Empty(loClase._TimeStamp) loClase._TimeStamp = .rowTimeStamp( {^2013/11/04 20:00:00} ) - ENDIF - IF EMPTY(loClase._UniqueID) + Endif + If Empty(loClase._UniqueID) loClase._UniqueID = toFoxBin2Prg.unique_ID() - ENDIF + Endif - *-- Inserto la clase - INSERT INTO TABLABIN ; +*-- Inserto la clase + Insert Into TABLABIN ; ( PLATFORM ; , UNIQUEID ; - , TIMESTAMP ; - , CLASS ; + , Timestamp ; + , Class ; , CLASSLOC ; - , BASECLASS ; + , BaseClass ; , OBJNAME ; - , PARENT ; + , Parent ; , PROPERTIES ; - , PROTECTED ; + , Protected ; , METHODS ; , OLE ; , OLE2 ; @@ -10778,7 +11207,7 @@ DEFINE CLASS c_conversor_prg_a_vcx AS c_conversor_prg_a_bin , RESERVED6 ; , RESERVED7 ; , RESERVED8 ; - , USER) ; + , User) ; VALUES ; ( 'WINDOWS' ; , loClase._UniqueID ; @@ -10806,512 +11235,95 @@ DEFINE CLASS c_conversor_prg_a_vcx AS c_conversor_prg_a_bin .insert_AllObjects( @loClase, @toFoxBin2Prg ) - - *-- Inserto el COMMENT - INSERT INTO TABLABIN ; - ( PLATFORM ; - , UNIQUEID ; - , TIMESTAMP ; - , CLASS ; - , CLASSLOC ; - , BASECLASS ; - , OBJNAME ; - , PARENT ; - , PROPERTIES ; - , PROTECTED ; - , METHODS ; - , OLE ; - , OLE2 ; - , RESERVED1 ; - , RESERVED2 ; - , RESERVED3 ; - , RESERVED4 ; - , RESERVED5 ; - , RESERVED6 ; - , RESERVED7 ; - , RESERVED8 ; - , USER) ; - VALUES ; - ( 'COMMENT' ; - , 'RESERVED' ; - , 0 ; - , '' ; - , '' ; - , '' ; - , loClase._ObjName ; - , '' ; - , '' ; - , '' ; - , '' ; - , '' ; - , '' ; - , '' ; - , IIF(loClase._OlePublic, 'OLEPublic', '') ; - , '' ; - , '' ; - , '' ; - , '' ; - , '' ; - , '' ; - , '' ) - - ENDFOR && I = 1 TO toModulo._Clases_Count - ENDFOR && X = 1 TO 2 - ENDIF - - USE IN (SELECT("TABLABIN")) - - IF toFoxBin2Prg.l_Recompile - toFoxBin2Prg.compileFoxProBinary() - ENDIF - - toFoxBin2Prg.updateProcessedFile() - ENDWITH && THIS - - - CATCH TO loEx - lnCodError = loEx.ERRORNO - toFoxBin2Prg.updateProcessedFile( 0, '', '', 'E1' ) - - IF THIS.n_Debug > 0 AND _VFP.STARTMODE = 0 - SET STEP ON - ENDIF - - THROW - - FINALLY - USE IN (SELECT("TABLABIN")) - STORE NULL TO loFSO, loClase - RELEASE lcObjName, I, X, loClase, loFSO - - ENDTRY - - RETURN lnCodError - - ENDPROC -ENDDEFINE - - - - -DEFINE CLASS c_conversor_prg_a_scx AS c_conversor_prg_a_bin - #IF .F. - LOCAL THIS AS c_conversor_prg_a_scx OF 'FOXBIN2PRG.PRG' - #ENDIF - *_MEMBERDATA = [] ; - + [] ; - + [] - c_Type = 'SC2' - - - PROCEDURE convert - *--------------------------------------------------------------------------------------------------- - * PARÁMETROS: (v=Pasar por valor | @=Pasar por referencia) (!=Obligatorio | ?=Opcional) (IN/OUT) - * toModulo (@! OUT) Objeto generado de clase CL_CLASSLIB con la información leida del texto - * toEx (@! OUT) Objeto con información del error - * toFoxBin2Prg (@! IN ) Referencia al objeto principal - *--------------------------------------------------------------------------------------------------- - LPARAMETERS toModulo, toEx AS EXCEPTION, toFoxBin2Prg - #IF .F. - LOCAL toModulo AS CL_CLASSLIB OF 'FOXBIN2PRG.PRG' - LOCAL toFoxBin2Prg AS c_foxbin2prg OF 'FOXBIN2PRG.PRG' - #ENDIF - DODEFAULT( @toModulo, @toEx, @toFoxBin2Prg ) - - TRY - LOCAL lnCodError, laCodeLines(1), lnCodeLines, lcInputFile, lcInputFile_Class, lnFileCount, laFiles(1,5) ; - , laLineasExclusion(1), lnBloquesExclusion, I, lnIDInputFile ; - , loLang as CL_LANG OF 'FOXBIN2PRG.PRG' - - WITH THIS AS c_conversor_prg_a_vcx OF 'FOXBIN2PRG.PRG' - STORE 0 TO lnCodError, lnCodeLines - STORE '' TO C_FB2PRG_CODE - STORE NULL TO toModulo - - loLang = _SCREEN.o_FoxBin2Prg_Lang - toModulo = CREATEOBJECT('CL_CLASSLIB') - lnIDInputFile = toFoxBin2Prg.n_ProcessedFiles - - IF toFoxBin2Prg.n_UseClassPerFile > 0 AND toFoxBin2Prg.l_RedirectClassPerFileToMain - C_FB2PRG_CODE = FILETOSTR( .c_InputFile ) - - lnCodeLines = ALINES( laCodeLines, C_FB2PRG_CODE ) - - .updateProgressbar( 'Identifying Header Blocks...', 1, lnCodeLines, 1 ) - .identifyHeaderBlocks( @laCodeLines, lnCodeLines, @laLineasExclusion, lnBloquesExclusion, @toModulo, @toFoxBin2Prg ) - - .updateProgressbar( 'Loading Code...', 2, lnCodeLines, 1 ) - - *-- MÁSCARA DE BÚSQUEDA - IF toFoxBin2Prg.n_UseClassPerFile = 1 THEN - *-- Esto crea la máscara de búsqueda "filename.*.ext" para encontrar las partes - lcBaseFilename = JUSTSTEM( JUSTSTEM(.c_InputFile) ) - lcInputFile = ADDBS( JUSTPATH(.c_InputFile) ) + lcBaseFilename + '.*.' + JUSTEXT(.c_InputFile) - ELSE && toFoxBin2Prg.n_UseClassPerFile = 2 - *-- Esto crea la máscara de búsqueda "Database.*.*.ext" para encontrar las partes - *-- con la sintaxis "Database.MemberType.MemberName.ext" - lcBaseFilename = JUSTSTEM( JUSTSTEM( JUSTSTEM(.c_InputFile) ) ) - lcInputFile = ADDBS( JUSTPATH(.c_InputFile) ) + lcBaseFilename + '.*.*.' + JUSTEXT(.c_InputFile) - ENDIF - - lnFileCount = ADIR( laFiles, lcInputFile, "", 1 ) - ASORT( laFiles, 1, 0, 0, 1) - - FOR I = 1 TO lnFileCount - IF toFoxBin2Prg.n_UseClassPerFile = 1 THEN - lcInputFile_Class = FORCEPATH( JUSTSTEM( laFiles(m.I,1) ), JUSTPATH( .c_InputFile ) ) + '.' + JUSTEXT( .c_InputFile ) - lcClassName = LOWER( GETWORDNUM( JUSTFNAME( lcInputFile_Class ), 2, '.' ) ) - - *-- Verificación de las Clases, si son Externas y se indicó chequearlas - IF toFoxBin2Prg.l_ClassPerFileCheck AND EMPTY(toFoxBin2Prg.c_ClassOperationType) ; - AND ASCAN( toModulo._ExternalClasses , lcClassName, 1, 0, 1, 1+2+4 ) = 0 - .writeLog( C_TAB + '- ' + loLang.C_OUTER_CLASS_DOES_NOT_MATCH_INNER_CLASSES_LOC + ' [' + lcInputFile_Class + ']' ) - .writeErrorLog( C_TAB + '- ' + loLang.C_WARNING_LOC + ' ' + loLang.C_OUTER_CLASS_DOES_NOT_MATCH_INNER_CLASSES_LOC + ' [' + lcInputFile_Class + ']' ) - LOOP && Salteo esta clase - ENDIF - ELSE && toFoxBin2Prg.n_UseClassPerFile = 2 - lcInputFile_Class = FORCEPATH( JUSTSTEM( laFiles(m.I,1) ), JUSTPATH( .c_InputFile ) ) + '.' + JUSTEXT( .c_InputFile ) - lcClassName = LOWER( GETWORDNUM( JUSTFNAME( lcInputFile_Class ), 2, '.' ) + '.' + GETWORDNUM( JUSTFNAME( lcInputFile_Class ), 3, '.' ) ) - - *-- Verificación de las Clases, si son Externas y se indicó chequearlas - IF toFoxBin2Prg.l_ClassPerFileCheck AND EMPTY(toFoxBin2Prg.c_ClassOperationType) ; - AND ASCAN( toModulo._ExternalClasses , lcClassName, 1, 0, 2, 1+2+4 ) = 0 - .writeLog( C_TAB + '- ' + loLang.C_OUTER_CLASS_DOES_NOT_MATCH_INNER_CLASSES_LOC + ' [' + lcInputFile_Class + ']' ) - .writeErrorLog( C_TAB + '- ' + loLang.C_WARNING_LOC + ' ' + loLang.C_OUTER_CLASS_DOES_NOT_MATCH_INNER_CLASSES_LOC + ' [' + lcInputFile_Class + ']' ) - LOOP && Salteo esta clase - ENDIF - ENDIF - - .writeLog( C_TAB + C_TAB + '+ ' + loLang.C_INCLUDING_CLASS_LOC + ' ' + JUSTFNAME( lcInputFile_Class ) ) - - *-- addProcessedFile( tcFile, tcInOutType, tcProcessed, tcHasErrors, tcSupported, tcExpanded ) - IF toFoxBin2Prg.addProcessedFile( lcInputFile_Class, 'I', 'P1', 'E0', 'S1', 'X1' ) THEN - toFoxBin2Prg.updateProcessedFile() - ENDIF - - toFoxBin2Prg.normalizeFileCapitalization( .T., lcInputFile_Class ) - C_FB2PRG_CODE = C_FB2PRG_CODE + CR_LF + FILETOSTR( lcInputFile_Class ) - ENDFOR - - lnCodeLines = ALINES( laCodeLines, C_FB2PRG_CODE ) - ELSE - *-- No es clase por archivo, o no se quiere redireccionar a Main. - C_FB2PRG_CODE = FILETOSTR( .c_InputFile ) - lnCodeLines = ALINES( laCodeLines, C_FB2PRG_CODE ) - - .updateProgressbar( 'Identifying Header Blocks...', 1, lnCodeLines, 1 ) - .identifyHeaderBlocks( @laCodeLines, lnCodeLines, @laLineasExclusion, lnBloquesExclusion, @toModulo, @toFoxBin2Prg ) - - ENDIF - - IF NOT toFoxBin2Prg.l_ProcessFiles THEN - *-- addProcessedFile( tcFile, tcInOutType, tcProcessed, tcHasErrors, tcSupported, tcExpanded ) - IF toFoxBin2Prg.addProcessedFile( .c_OutputFile, 'O', 'P1', 'E0', 'S1', 'X0' ) THEN - toFoxBin2Prg.updateProcessedFile() - ENDIF - - EXIT && Si se indicó no procesar, se sale aquí. (Modo de simulación) - ENDIF - - *-- Identifico los TEXT/ENDTEXT, #IF .F./#ENDIF - .updateProgressbar( 'Identifying Excluded Blocks...', 3, lnCodeLines, 1 ) - .identifyExclusionBlocks( @laCodeLines, lnCodeLines, .F., @laLineasExclusion, @lnBloquesExclusion ) - - *-- Identifico el inicio/fin de bloque, definición, cabecera y cuerpo de cada clase - .identifyCodeBlocks( @laCodeLines, lnCodeLines, @laLineasExclusion, lnBloquesExclusion, @toModulo, @toFoxBin2Prg ) - - DO CASE - CASE toFoxBin2Prg.c_SimulateError = 'SIMERR_I1' - ERROR 'InputFile Error Simulation' - CASE toFoxBin2Prg.c_SimulateError = 'SIMERR_I0' - .writeErrorLog( '*** SIMULATED ERROR' ) - ENDCASE - - IF .l_Error - .writeLog( '*** ERRORS found - Generation Cancelled' ) - EXIT - ENDIF - - toFoxBin2Prg.updateProcessedFile( lnIDInputFile ) - .updateProgressbar( 'Generating Binary...', 0, lnCodeLines, 1 ) - toFoxBin2Prg.doBackup( .F., .T., '', '', '' ) - .createForm() - .writeBinaryFile( @toModulo, @toFoxBin2Prg ) - ENDWITH && THIS - - - CATCH TO toEx - IF THIS.n_Debug > 0 AND _VFP.STARTMODE = 0 - SET STEP ON - ENDIF - - THROW - - FINALLY - USE IN (SELECT("TABLABIN")) - RELEASE lnCodError, laCodeLines, lnCodeLines, lcInputFile, lcInputFile_Class, lnFileCount, laFiles ; - , laLineasExclusion, lnBloquesExclusion, I - ENDTRY - - RETURN - ENDPROC - - - - - PROCEDURE writeBinaryFile - LPARAMETERS toModulo, toFoxBin2Prg - *-- Estructura del objeto toModulo generado: - *-- ----------------------------------------------------------------------------------------------------------- - *-- Version Versión usada para generar la versión PRG analizada - *-- SourceFile Nombre original del archivo fuente de la conversión - *-- Ole_Obj_Count Cantidad de objetos definidos en el array ole_objs[] - *-- Ole_Objs[1] Array de objetos OLE definidos como clases - *-- ObjName Nombre del objeto OLE (OLE2) - *-- Parent Nombre del objeto Padre - *-- CheckSum Suma de verificación - *-- Value Valor del campo OLE - *-- Clases_Count Array con las posiciones de los addobjects, definicion y propiedades - *-- Clases[1] Array con los datos de las clases, definicion, propiedades y métodos - *-- Nombre El nombre de la clase (ej: "miClase") - *-- ObjName Nombre del objeto - *-- Parent Nombre del objeto Padre - *-- Class Clase de la que hereda la definición - *-- Classloc Librería donde está la definición de la clase - *-- Ole Información campo ole - *-- Ole2 Información campo ole2 - *-- OlePublic Indica si la clase es OLEPublic o no (.T. / .F.) - *-- Uniqueid ID único - *-- Comentario El comentario de la clase (ej: "&& Mis comentarios") - *-- MetaData Información de metadata de la clase (baseclass, timestamp, scale) - *-- BaseClass Clase de base de la clase - *-- TimeStamp Timestamp de la clase - *-- Scale Scale de la clase (pixels, foxels) - *-- Definicion La definición de la clase (ej: "AS Custom OF LIBRERIA.VCX") - *-- Inicio/Fin Línea de inicio/fin de la clase (DEFINE CLASS/ENDDEFINE) - *-- Ini_Cab/Fin_Cab Línea de inicio/fin de la cabecera (def.propiedades, Hidden, Protected, #Include, CLASSDATA, DEFINED_PAM) - *-- Ini_Cuerpo/Fin_Cuerpo Línea de inicio/fin del cuerpo (ADD OBJECTs y PROCEDURES) - *-- HiddenProps Propiedades definidas como HIDDEN (ocultas) - *-- ProtectedProps Propiedades definidas como PROTECTED (protegidas) - *-- Defined_PAM Propiedades, eventos o métodos definidos por el usuario - *-- IncludeFile Nombre del archivo de inclusión - *-- Props_Count Cantidad de propiedades de la clase definicas en el array props[] - *-- Props[1,2] Array con todas las propiedades de la clase y sus valores. (col.1=Nombre, col.2=Comentario) - *-- AddObject_Count Cantidad de objetos definidos en el array addobjects[] - *-- AddObjects[1] Array con las posiciones de los addobjects, definicion y propiedades - *-- Nombre Nombre del objeto - *-- ObjName Nombre del objeto - *-- Parent Nombre del objeto Padre - *-- Clase Clase del objeto - *-- ClassLib Librería de clases de la que deriva la clase - *-- Baseclass Clase de base del objeto - *-- Uniqueid ID único - *-- Ole Información campo ole - *-- Ole2 Información campo ole2 - *-- ZOrder Orden Z del objeto - *-- Props_Count Cantidad de propiedades del objeto - *-- Props[1] Array con todas las propiedades del objeto y sus valores - *-- Procedure_count Cantidad de procedimientos definidos en el array procedures[] - *-- Procedures[1] Array con las posiciones de los procedures, definicion y comentarios - *-- Nombre Nombre del procedure - *-- ProcType Tipo de procedimiento (normal, hidden, protected) - *-- Comentario Comentario el procedure - *-- ProcLine_Count Cantidad de líneas del procedimiento - *-- ProcLines[1] Líneas del procedimiento - *-- Procedure_count Cantidad de procedimientos definidos en el array procedures[] - *-- Procedures[1] Array con las posiciones de los procedures, definicion y comentarios - *-- Nombre Nombre del procedure - *-- ProcType Tipo de procedimiento (normal, hidden, protected) - *-- Comentario Comentario el procedure - *-- ProcLine_Count Cantidad de líneas del procedimiento - *-- ProcLines[1] Líneas del procedimiento - *-- ----------------------------------------------------------------------------------------------------------- - #IF .F. - LOCAL toModulo AS CL_CLASSLIB OF 'FOXBIN2PRG.PRG' - LOCAL toFoxBin2Prg AS c_foxbin2prg OF 'FOXBIN2PRG.PRG' - #ENDIF - - TRY - LOCAL lcObjName, lnCodError, I, X, loEx AS EXCEPTION ; - , loClase AS CL_CLASE OF 'FOXBIN2PRG.PRG' - - WITH THIS AS c_conversor_prg_a_scx OF 'FOXBIN2PRG.PRG' - *-- addProcessedFile( tcFile, tcInOutType, tcProcessed, tcHasErrors, tcSupported, tcExpanded ) - toFoxBin2Prg.addProcessedFile( .c_OutputFile, 'O', 'P1', 'E0', 'S1', 'X0' ) - - DO CASE - CASE toFoxBin2Prg.c_SimulateError = 'SIMERR_O1' - ERROR 'OutputFile Error Simulation' - ENDCASE - - *-- Creo el registro de cabecera - .createForm_RecordHeader( toModulo ) - - *-- El SCX tiene el INCLUDE en el primer registro - IF NOT EMPTY(toModulo._includeFile) - REPLACE RESERVED8 WITH toModulo._includeFile - ENDIF - - - *-- Recorro las CLASES - FOR X = 1 TO 2 - FOR I = 1 TO toModulo._Clases_Count - loClase = NULL - loClase = toModulo._Clases(m.I) - - *-- El dataenvironment debe estar primero, luego lo demás. - IF m.X = 1 AND NOT loClase._BaseClass == 'dataenvironment' ; - OR m.X = 2 AND loClase._BaseClass == 'dataenvironment' - LOOP - ENDIF - - IF EMPTY(loClase._TimeStamp) - loClase._TimeStamp = .rowTimeStamp( {^2013/11/04 20:00:00} ) - ENDIF - IF EMPTY(loClase._UniqueID) - loClase._UniqueID = toFoxBin2Prg.unique_ID() - ENDIF - - *-- Inserto la clase - INSERT INTO TABLABIN ; - ( PLATFORM ; - , UNIQUEID ; - , TIMESTAMP ; - , CLASS ; - , CLASSLOC ; - , BASECLASS ; - , OBJNAME ; - , PARENT ; - , PROPERTIES ; - , PROTECTED ; - , METHODS ; - , OLE ; - , OLE2 ; - , RESERVED1 ; - , RESERVED2 ; - , RESERVED3 ; - , RESERVED4 ; - , RESERVED5 ; - , RESERVED6 ; - , RESERVED7 ; - , RESERVED8 ; - , USER) ; - VALUES ; - ( 'WINDOWS' ; - , loClase._UniqueID ; - , loClase._TimeStamp ; - , loClase._Class ; - , loClase._ClassLoc ; - , loClase._BaseClass ; - , loClase._ObjName ; - , loClase._Parent ; - , loClase._PROPERTIES ; - , loClase._PROTECTED ; - , loClase._METHODS ; - , loClase._Ole ; - , loClase._Ole2 ; - , loClase._RESERVED1 ; - , loClase._RESERVED2 ; - , loClase._RESERVED3 ; - , loClase._ClassIcon ; - , loClase._ProjectClassIcon ; - , loClase._Scale ; - , loClase._Comentario ; - , loClase._includeFile ; - , loClase._User ) - - - .insert_AllObjects( @loClase, @toFoxBin2Prg ) - - ENDFOR && I = 1 TO toModulo._Clases_Count - ENDFOR && m.X = 1 TO 2 - - *-- Inserto el COMMENT final - INSERT INTO TABLABIN ; - ( PLATFORM ; - , UNIQUEID ; - , TIMESTAMP ; - , CLASS ; - , CLASSLOC ; - , BASECLASS ; - , OBJNAME ; - , PARENT ; - , PROPERTIES ; - , PROTECTED ; - , METHODS ; - , OLE ; - , OLE2 ; - , RESERVED1 ; - , RESERVED2 ; - , RESERVED3 ; - , RESERVED4 ; - , RESERVED5 ; - , RESERVED6 ; - , RESERVED7 ; - , RESERVED8 ; - , USER) ; - VALUES ; - ( 'COMMENT' ; - , 'RESERVED' ; - , 0 ; - , '' ; - , '' ; - , '' ; - , '' ; - , '' ; - , '' ; - , '' ; - , '' ; - , '' ; - , '' ; - , '' ; - , '' ; - , '' ; - , '' ; - , '' ; - , '' ; - , '' ; - , '' ; - , '' ) - - USE IN (SELECT("TABLABIN")) - - IF toFoxBin2Prg.l_Recompile - toFoxBin2Prg.compileFoxProBinary() - ENDIF - - toFoxBin2Prg.updateProcessedFile() - ENDWITH && THIS - - - CATCH TO loEx - toFoxBin2Prg.updateProcessedFile( 0, '', '', 'E1' ) - - IF THIS.n_Debug > 0 AND _VFP.STARTMODE = 0 - SET STEP ON - ENDIF - - THROW - - FINALLY - USE IN (SELECT("TABLABIN")) - STORE NULL TO loClase, loEx - RELEASE lcObjName, lnCodError, I, X, loClase - ENDTRY - - RETURN - - ENDPROC -ENDDEFINE - - - - -DEFINE CLASS c_conversor_prg_a_pjx AS c_conversor_prg_a_bin - #IF .F. - LOCAL THIS AS c_conversor_prg_a_pjx OF 'FOXBIN2PRG.PRG' - #ENDIF - _MEMBERDATA = [] ; + Endfor && I = 1 TO toModulo._Clases_Count + Endfor && m.X = 1 TO 2 + +*-- Inserto el COMMENT final + Insert Into TABLABIN ; + ( PLATFORM ; + , UNIQUEID ; + , Timestamp ; + , Class ; + , CLASSLOC ; + , BaseClass ; + , OBJNAME ; + , Parent ; + , PROPERTIES ; + , Protected ; + , METHODS ; + , OLE ; + , OLE2 ; + , RESERVED1 ; + , RESERVED2 ; + , RESERVED3 ; + , RESERVED4 ; + , RESERVED5 ; + , RESERVED6 ; + , RESERVED7 ; + , RESERVED8 ; + , User) ; + VALUES ; + ( 'COMMENT' ; + , 'RESERVED' ; + , 0 ; + , '' ; + , '' ; + , '' ; + , '' ; + , '' ; + , '' ; + , '' ; + , '' ; + , '' ; + , '' ; + , '' ; + , '' ; + , '' ; + , '' ; + , '' ; + , '' ; + , '' ; + , '' ; + , '' ) + + Use In (Select("TABLABIN")) + + If toFoxBin2Prg.l_Recompile + toFoxBin2Prg.compileFoxProBinary() + Endif + + toFoxBin2Prg.updateProcessedFile() + Endwith && THIS + + + Catch To loEx + toFoxBin2Prg.updateProcessedFile( 0, '', '', 'E1' ) + + If This.n_Debug > 0 And _vfp.StartMode = 0 + Set Step On + Endif + + Throw + + Finally + Use In (Select("TABLABIN")) + Store Null To loClase, loEx + Release lcObjName, lnCodError, I, X, loClase + Endtry + + Return + + Endproc +Enddefine + + + + +Define Class c_conversor_prg_a_pjx As c_conversor_prg_a_bin + #If .F. + Local This As c_conversor_prg_a_pjx Of 'FOXBIN2PRG.PRG' + #Endif + _MemberData = [] ; + [] ; + [] ; + [] ; @@ -11325,844 +11337,844 @@ DEFINE CLASS c_conversor_prg_a_pjx AS c_conversor_prg_a_bin - PROCEDURE convert - *--------------------------------------------------------------------------------------------------- - * PARÁMETROS: (v=Pasar por valor | @=Pasar por referencia) (!=Obligatorio | ?=Opcional) (IN/OUT) - * toProject (!@ OUT) Objeto generado de clase CL_PROJECT con la información leida del texto - * toEx (!@ OUT) Objeto con información del error - * toFoxBin2Prg (v! IN ) Referencia al objeto principal - *--------------------------------------------------------------------------------------------------- - LPARAMETERS toProject, toEx AS EXCEPTION, toFoxBin2Prg - DODEFAULT( @toProject, @toEx, @toFoxBin2Prg ) - - #IF .F. - LOCAL toProject AS CL_PROJECT OF 'FOXBIN2PRG.PRG' - LOCAL toFoxBin2Prg AS c_foxbin2prg OF 'FOXBIN2PRG.PRG' - #ENDIF - - TRY - LOCAL laCodeLines(1), lnCodeLines, laLineasExclusion(1), lnBloquesExclusion, I, lnIDInputFile - - WITH THIS AS c_conversor_prg_a_pjx OF 'FOXBIN2PRG.PRG' - STORE 0 TO lnCodeLines - STORE NULL TO toModulo - lnIDInputFile = toFoxBin2Prg.n_ProcessedFiles - - IF NOT toFoxBin2Prg.l_ProcessFiles THEN - *-- addProcessedFile( tcFile, tcInOutType, tcProcessed, tcHasErrors, tcSupported, tcExpanded ) - IF toFoxBin2Prg.addProcessedFile( .c_OutputFile, 'O', 'P1', 'E0', 'S1', 'X0' ) THEN - toFoxBin2Prg.updateProcessedFile() - ENDIF - - EXIT && Si se indicó no procesar, se sale aquí. (Modo de simulación) - ENDIF - - C_FB2PRG_CODE = FILETOSTR( .c_InputFile ) - lnCodeLines = ALINES( laCodeLines, C_FB2PRG_CODE ) - - *-- Identifico los TEXT/ENDTEXT, #IF .F./#ENDIF - *.identifyExclusionBlocks( @laCodeLines, .F., @laLineasExclusion, @lnBloquesExclusion ) - - *-- Identifico el inicio/fin de bloque, definición, cabecera y cuerpo de cada clase - .updateProgressbar( 'Identifying Code Blocks...', 1, 2, 1 ) - .identifyCodeBlocks( @laCodeLines, lnCodeLines, @laLineasExclusion, lnBloquesExclusion, @toProject, @toFoxBin2Prg ) - - DO CASE - CASE toFoxBin2Prg.c_SimulateError = 'SIMERR_I1' - ERROR 'InputFile Error Simulation' - CASE toFoxBin2Prg.c_SimulateError = 'SIMERR_I0' - .writeErrorLog( '*** SIMULATED ERROR' ) - ENDCASE - - IF .l_Error - .writeLog( '*** ERRORS found - Generation Cancelled' ) - EXIT - ENDIF - - toFoxBin2Prg.updateProcessedFile( lnIDInputFile ) - .updateProgressbar( 'Generating Binary...', 2, 2, 1 ) - toFoxBin2Prg.doBackup( .F., .T., '', '', '' ) - .createProject() - .writeBinaryFile( @toProject, @toFoxBin2Prg ) - ENDWITH && THIS - - - CATCH TO toEx - IF THIS.n_Debug > 0 AND _VFP.STARTMODE = 0 - SET STEP ON - ENDIF - - THROW - - FINALLY - USE IN (SELECT("TABLABIN")) - RELEASE laCodeLines, lnCodeLines, laLineasExclusion, lnBloquesExclusion, I - ENDTRY - - RETURN - ENDPROC - - - - PROCEDURE writeBinaryFile - LPARAMETERS toProject, toFoxBin2Prg - *-- ----------------------------------------------------------------------------------------------------------- - #IF .F. - LOCAL toProject AS CL_PROJECT OF 'FOXBIN2PRG.PRG' - LOCAL toFoxBin2Prg AS c_foxbin2prg OF 'FOXBIN2PRG.PRG' - #ENDIF - - TRY - LOCAL lnCodError, lcMainProg, loEx AS EXCEPTION ; - , loServerHead AS CL_PROJ_SRV_HEAD OF 'FOXBIN2PRG.PRG' ; - , loFile AS CL_PROJ_FILE OF 'FOXBIN2PRG.PRG' - - WITH THIS AS c_conversor_prg_a_pjx OF 'FOXBIN2PRG.PRG' - STORE NULL TO loFile, loServerHead - toProject._HomeDir = CHRTRAN( toProject._HomeDir, ['], [] ) - toProject._SccData = CHR(3) + CHR(0) + CHR(1) + REPLICATE( CHR(0), 651 ) - - *-- addProcessedFile( tcFile, tcInOutType, tcProcessed, tcHasErrors, tcSupported, tcExpanded ) - toFoxBin2Prg.addProcessedFile( .c_OutputFile, 'O', 'P1', 'E0', 'S1', 'X0' ) - - DO CASE - CASE toFoxBin2Prg.c_SimulateError = 'SIMERR_O1' - ERROR 'OutputFile Error Simulation' - ENDCASE - - *-- Creo solo el registro de cabecera del proyecto - .createProject_RecordHeader( toProject ) - - lcMainProg = '' - - IF NOT EMPTY(toProject._MainProg) - lcMainProg = LOWER( SYS(2014, toProject._MainProg, ADDBS(toProject._HomeDir) ) ) - ENDIF - - IF EMPTY(toProject._TimeStamp) - toProject._TimeStamp = .rowTimeStamp( {^2013/11/04 20:00:00} ) - ENDIF - IF EMPTY(toProject._ID) - toProject._ID = toFoxBin2Prg.unique_ID('N') - ENDIF - - *-- Si hay ProjectHook de proyecto, lo inserto - IF NOT EMPTY(toProject._ProjectHookLibrary) - INSERT INTO TABLABIN ; - ( NAME ; - , TYPE ; - , EXCLUDE ; - , KEY ; - , RESERVED1 ) ; - VALUES ; - ( toProject._ProjectHookLibrary + CHR(0) ; - , 'W' ; - , .T. ; - , UPPER(JUSTSTEM(toProject._ProjectHookLibrary)) ; - , toProject._ProjectHookClass + CHR(0) ) - ENDIF - - *-- Si hay ICONO de proyecto, lo inserto - IF NOT EMPTY(toProject._Icon) - INSERT INTO TABLABIN ; - ( NAME ; - , TYPE ; - , LOCAL ; - , KEY ) ; - VALUES ; - ( SYS(2014, toProject._Icon, ADDBS(JUSTPATH(ADDBS(toProject._HomeDir)))) + CHR(0) ; - , 'i' ; - , .T. ; - , UPPER(JUSTSTEM(toProject._Icon)) ) - ENDIF - - *-- Agrego los ARCHIVOS - FOR EACH loFile IN toProject FOXOBJECT - - IF EMPTY(loFile._TimeStamp) - loFile._TimeStamp = .rowTimeStamp( {^2013/11/04 20:00:00} ) - ENDIF - IF EMPTY(loFile._ID) - loFile._ID = toFoxBin2Prg.unique_ID('N') - ENDIF - - INSERT INTO TABLABIN ; - ( NAME ; - , TYPE ; - , EXCLUDE ; - , MAINPROG ; - , COMMENTS ; - , LOCAL ; - , CPID ; - , ID ; - , TIMESTAMP ; - , OBJREV ; - , USER ; - , DEVINFO ; - , KEY ) ; - VALUES ; - ( loFile._Name + CHR(0) ; - , .fileTypeCode(JUSTEXT(loFile._Name), loFile._Type) ; - , loFile._Exclude ; - , (loFile._Name == lcMainProg) ; - , loFile._Comments ; - , .T. ; - , loFile._CPID ; - , loFile._ID ; - , loFile._TimeStamp ; - , loFile._ObjRev ; - , STRCONV(loFile._User,14) ; - , STRCONV(loFile._DevInfo,14) ; - , UPPER(JUSTSTEM(loFile._Name)) ) - ENDFOR - - USE IN (SELECT("TABLABIN")) - toFoxBin2Prg.updateProcessedFile() - ENDWITH && THIS - - - CATCH TO loEx - lnCodError = loEx.ERRORNO - toFoxBin2Prg.updateProcessedFile( 0, '', '', 'E1' ) - - IF THIS.n_Debug > 0 AND _VFP.STARTMODE = 0 - SET STEP ON - ENDIF - - THROW - - FINALLY - USE IN (SELECT("TABLABIN")) - STORE NULL TO loFile, loServerHead - RELEASE loFile, loServerHead - - ENDTRY - - RETURN lnCodError - ENDPROC - - - - PROCEDURE identifyCodeBlocks - LPARAMETERS taCodeLines, tnCodeLines, taLineasExclusion, tnBloquesExclusion, toProject, toFoxBin2Prg - *-------------------------------------------------------------------------------------------------------------- - * PARÁMETROS: (v=Pasar por valor | @=Pasar por referencia) (!=Obligatorio | ?=Opcional) (IN/OUT) - * taCodeLines (@! IN ) El array con las líneas del código donde buscar - * tnCodeLines (@! IN ) Cantidad de líneas de código - * taLineasExclusion (@! IN ) Array unidimensional con un .T. o .F. según la línea sea de exclusión o no - * tnBloquesExclusion (@! IN ) Cantidad de bloques de exclusión - * toProject (@? OUT) Objeto con toda la información del proyecto analizado - * toFoxBin2Prg (v! IN ) Referencia al objeto principal - * - * NOTA: - * Como identificador se usa el nombre de clase o de procedimiento, según corresponda. - *-------------------------------------------------------------------------------------------------------------- - EXTERNAL ARRAY taCodeLines, taLineasExclusion - - #IF .F. - LOCAL toProject AS CL_PROJECT OF 'FOXBIN2PRG.PRG' - LOCAL toFoxBin2Prg AS c_foxbin2prg OF 'FOXBIN2PRG.PRG' - #ENDIF - - TRY - LOCAL I, lc_Comentario, lcLine, llBuildProj_Completed, llDevInfo_Completed ; - , llServerHead_Completed, llFileComments_Completed, llFoxBin2Prg_Completed ; - , llExcludedFiles_Completed, llTextFiles_Completed, llProjectProperties_Completed - - WITH THIS AS c_conversor_prg_a_pjx OF 'FOXBIN2PRG.PRG' - STORE 0 TO I - .c_Type = UPPER(JUSTEXT(.c_OutputFile)) - - IF tnCodeLines > 1 - toProject = CREATEOBJECT('CL_PROJECT') - *toProject._HomeDir = ADDBS(JUSTPATH(.c_OutputFile)) - - FOR I = 1 TO tnCodeLines - .set_Line( @lcLine, @taCodeLines, m.I ) - - DO CASE - CASE .lineIsOnlyCommentAndNoMetadata( @lcLine, @lc_Comentario ) && Vacía o solo Comentarios - LOOP - - CASE NOT llFoxBin2Prg_Completed AND .analyzeCodeBlock_FoxBin2Prg( toProject, @lcLine, @taCodeLines, @m.I, tnCodeLines ) - llFoxBin2Prg_Completed = .T. - - CASE NOT llDevInfo_Completed AND .analyzeCodeBlock_DevInfo( toProject, @lcLine, @taCodeLines, @m.I, tnCodeLines ) - llDevInfo_Completed = .T. - - CASE NOT llServerHead_Completed AND .analyzeCodeBlock_ServerHead( toProject, @lcLine, @taCodeLines, @m.I, tnCodeLines ) - llServerHead_Completed = .T. - - CASE .analyzeCodeBlock_ServerData( toProject, @lcLine, @taCodeLines, @m.I, tnCodeLines ) - *-- Puede haber varios servidores, por eso se siguen valuando - - CASE NOT llBuildProj_Completed AND .analyzeCodeBlock_BuildProj( toProject, @lcLine, @taCodeLines, @m.I, tnCodeLines, @toFoxBin2Prg ) - llBuildProj_Completed = .T. - - CASE NOT llFileComments_Completed AND .analyzeCodeBlock_FileComments( toProject, @lcLine, @taCodeLines, @m.I, tnCodeLines ) - llFileComments_Completed = .T. - - CASE NOT llExcludedFiles_Completed AND .analyzeCodeBlock_ExcludedFiles( toProject, @lcLine, @taCodeLines, @m.I, tnCodeLines ) - llExcludedFiles_Completed = .T. - - CASE NOT llTextFiles_Completed AND .analyzeCodeBlock_TextFiles( toProject, @lcLine, @taCodeLines, @m.I, tnCodeLines ) - llTextFiles_Completed = .T. - - CASE NOT llProjectProperties_Completed AND .analyzeCodeBlock_ProjectProperties( toProject, @lcLine, @taCodeLines, @m.I, tnCodeLines ) - llProjectProperties_Completed = .T. + Procedure convert +*--------------------------------------------------------------------------------------------------- +* PARÁMETROS: (v=Pasar por valor | @=Pasar por referencia) (!=Obligatorio | ?=Opcional) (IN/OUT) +* toProject (!@ OUT) Objeto generado de clase CL_PROJECT con la información leida del texto +* toEx (!@ OUT) Objeto con información del error +* toFoxBin2Prg (v! IN ) Referencia al objeto principal +*--------------------------------------------------------------------------------------------------- + Lparameters toProject, toEx As Exception, toFoxBin2Prg + DoDefault( @toProject, @toEx, @toFoxBin2Prg ) + + #If .F. + Local toProject As CL_PROJECT Of 'FOXBIN2PRG.PRG' + Local toFoxBin2Prg As c_foxbin2prg Of 'FOXBIN2PRG.PRG' + #Endif + + Try + Local laCodeLines(1), lnCodeLines, laLineasExclusion(1), lnBloquesExclusion, I, lnIDInputFile + + With This As c_conversor_prg_a_pjx Of 'FOXBIN2PRG.PRG' + Store 0 To lnCodeLines + Store Null To toModulo + lnIDInputFile = toFoxBin2Prg.n_ProcessedFiles + + If Not toFoxBin2Prg.l_ProcessFiles Then +*-- addProcessedFile( tcFile, tcInOutType, tcProcessed, tcHasErrors, tcSupported, tcExpanded ) + If toFoxBin2Prg.addProcessedFile( .c_OutputFile, 'O', 'P1', 'E0', 'S1', 'X0' ) Then + toFoxBin2Prg.updateProcessedFile() + Endif + + Exit && Si se indicó no procesar, se sale aquí. (Modo de simulación) + Endif + + C_FB2PRG_CODE = Filetostr( .c_InputFile ) + lnCodeLines = Alines( laCodeLines, C_FB2PRG_CODE ) + +*-- Identifico los TEXT/ENDTEXT, #IF .F./#ENDIF +*.identifyExclusionBlocks( @laCodeLines, .F., @laLineasExclusion, @lnBloquesExclusion ) + +*-- Identifico el inicio/fin de bloque, definición, cabecera y cuerpo de cada clase + .updateProgressbar( 'Identifying Code Blocks...', 1, 2, 1 ) + .identifyCodeBlocks( @laCodeLines, lnCodeLines, @laLineasExclusion, lnBloquesExclusion, @toProject, @toFoxBin2Prg ) + + Do Case + Case toFoxBin2Prg.c_SimulateError = 'SIMERR_I1' + Error 'InputFile Error Simulation' + Case toFoxBin2Prg.c_SimulateError = 'SIMERR_I0' + .writeErrorLog( '*** SIMULATED ERROR' ) + Endcase + + If .l_Error + .writeLog( '*** ERRORS found - Generation Cancelled' ) + Exit + Endif + + toFoxBin2Prg.updateProcessedFile( lnIDInputFile ) + .updateProgressbar( 'Generating Binary...', 2, 2, 1 ) + toFoxBin2Prg.doBackup( .F., .T., '', '', '' ) + .createProject() + .writeBinaryFile( @toProject, @toFoxBin2Prg ) + Endwith && THIS + + + Catch To toEx + If This.n_Debug > 0 And _vfp.StartMode = 0 + Set Step On + Endif + + Throw + + Finally + Use In (Select("TABLABIN")) + Release laCodeLines, lnCodeLines, laLineasExclusion, lnBloquesExclusion, I + Endtry + + Return + Endproc + + + + Procedure writeBinaryFile + Lparameters toProject, toFoxBin2Prg +*-- ----------------------------------------------------------------------------------------------------------- + #If .F. + Local toProject As CL_PROJECT Of 'FOXBIN2PRG.PRG' + Local toFoxBin2Prg As c_foxbin2prg Of 'FOXBIN2PRG.PRG' + #Endif + + Try + Local lnCodError, lcMainProg, loEx As Exception ; + , loServerHead As CL_PROJ_SRV_HEAD Of 'FOXBIN2PRG.PRG' ; + , loFile As CL_PROJ_FILE Of 'FOXBIN2PRG.PRG' + + With This As c_conversor_prg_a_pjx Of 'FOXBIN2PRG.PRG' + Store Null To loFile, loServerHead + toProject._HomeDir = Chrtran( toProject._HomeDir, ['], [] ) + toProject._SccData = Chr(3) + Chr(0) + Chr(1) + Replicate( Chr(0), 651 ) + +*-- addProcessedFile( tcFile, tcInOutType, tcProcessed, tcHasErrors, tcSupported, tcExpanded ) + toFoxBin2Prg.addProcessedFile( .c_OutputFile, 'O', 'P1', 'E0', 'S1', 'X0' ) + + Do Case + Case toFoxBin2Prg.c_SimulateError = 'SIMERR_O1' + Error 'OutputFile Error Simulation' + Endcase + +*-- Creo solo el registro de cabecera del proyecto + .createProject_RecordHeader( toProject ) + + lcMainProg = '' + + If Not Empty(toProject._MainProg) + lcMainProg = Lower( Sys(2014, toProject._MainProg, Addbs(toProject._HomeDir) ) ) + Endif + + If Empty(toProject._TimeStamp) + toProject._TimeStamp = .rowTimeStamp( {^2013/11/04 20:00:00} ) + Endif + If Empty(toProject._ID) + toProject._ID = toFoxBin2Prg.unique_ID('N') + Endif + +*-- Si hay ProjectHook de proyecto, lo inserto + If Not Empty(toProject._ProjectHookLibrary) + Insert Into TABLABIN ; + ( Name ; + , Type ; + , EXCLUDE ; + , Key ; + , RESERVED1 ) ; + VALUES ; + ( toProject._ProjectHookLibrary + Chr(0) ; + , 'W' ; + , .T. ; + , Upper(Juststem(toProject._ProjectHookLibrary)) ; + , toProject._ProjectHookClass + Chr(0) ) + Endif + +*-- Si hay ICONO de proyecto, lo inserto + If Not Empty(toProject._Icon) + Insert Into TABLABIN ; + ( Name ; + , Type ; + , Local ; + , Key ) ; + VALUES ; + ( Sys(2014, toProject._Icon, Addbs(Justpath(Addbs(toProject._HomeDir)))) + Chr(0) ; + , 'i' ; + , .T. ; + , Upper(Juststem(toProject._Icon)) ) + Endif + +*-- Agrego los ARCHIVOS + For Each loFile In toProject FoxObject + + If Empty(loFile._TimeStamp) + loFile._TimeStamp = .rowTimeStamp( {^2013/11/04 20:00:00} ) + Endif + If Empty(loFile._ID) + loFile._ID = toFoxBin2Prg.unique_ID('N') + Endif + + Insert Into TABLABIN ; + ( Name ; + , Type ; + , EXCLUDE ; + , MAINPROG ; + , COMMENTS ; + , Local ; + , CPID ; + , Id ; + , Timestamp ; + , OBJREV ; + , User ; + , DEVINFO ; + , Key ) ; + VALUES ; + ( loFile._Name + Chr(0) ; + , .fileTypeCode(Justext(loFile._Name), loFile._Type) ; + , loFile._Exclude ; + , (loFile._Name == lcMainProg) ; + , loFile._Comments ; + , .T. ; + , loFile._CPID ; + , loFile._ID ; + , loFile._TimeStamp ; + , loFile._ObjRev ; + , Strconv(loFile._User,14) ; + , Strconv(loFile._DevInfo,14) ; + , Upper(Juststem(loFile._Name)) ) + Endfor + + Use In (Select("TABLABIN")) + toFoxBin2Prg.updateProcessedFile() + Endwith && THIS + + + Catch To loEx + lnCodError = loEx.ErrorNo + toFoxBin2Prg.updateProcessedFile( 0, '', '', 'E1' ) + + If This.n_Debug > 0 And _vfp.StartMode = 0 + Set Step On + Endif + + Throw + + Finally + Use In (Select("TABLABIN")) + Store Null To loFile, loServerHead + Release loFile, loServerHead + + Endtry + + Return lnCodError + Endproc + + + + Procedure identifyCodeBlocks + Lparameters taCodeLines, tnCodeLines, taLineasExclusion, tnBloquesExclusion, toProject, toFoxBin2Prg +*-------------------------------------------------------------------------------------------------------------- +* PARÁMETROS: (v=Pasar por valor | @=Pasar por referencia) (!=Obligatorio | ?=Opcional) (IN/OUT) +* taCodeLines (@! IN ) El array con las líneas del código donde buscar +* tnCodeLines (@! IN ) Cantidad de líneas de código +* taLineasExclusion (@! IN ) Array unidimensional con un .T. o .F. según la línea sea de exclusión o no +* tnBloquesExclusion (@! IN ) Cantidad de bloques de exclusión +* toProject (@? OUT) Objeto con toda la información del proyecto analizado +* toFoxBin2Prg (v! IN ) Referencia al objeto principal +* +* NOTA: +* Como identificador se usa el nombre de clase o de procedimiento, según corresponda. +*-------------------------------------------------------------------------------------------------------------- + External Array taCodeLines, taLineasExclusion + + #If .F. + Local toProject As CL_PROJECT Of 'FOXBIN2PRG.PRG' + Local toFoxBin2Prg As c_foxbin2prg Of 'FOXBIN2PRG.PRG' + #Endif + + Try + Local I, lc_Comentario, lcLine, llBuildProj_Completed, llDevInfo_Completed ; + , llServerHead_Completed, llFileComments_Completed, llFoxBin2Prg_Completed ; + , llExcludedFiles_Completed, llTextFiles_Completed, llProjectProperties_Completed + + With This As c_conversor_prg_a_pjx Of 'FOXBIN2PRG.PRG' + Store 0 To I + .c_Type = Upper(Justext(.c_OutputFile)) + + If tnCodeLines > 1 + toProject = Createobject('CL_PROJECT') +*toProject._HomeDir = ADDBS(JUSTPATH(.c_OutputFile)) + + For I = 1 To tnCodeLines + .set_Line( @lcLine, @taCodeLines, m.I ) + + Do Case + Case .lineIsOnlyCommentAndNoMetadata( @lcLine, @lc_Comentario ) && Vacía o solo Comentarios + Loop + + Case Not llFoxBin2Prg_Completed And .analyzeCodeBlock_FoxBin2Prg( toProject, @lcLine, @taCodeLines, @m.I, tnCodeLines ) + llFoxBin2Prg_Completed = .T. + + Case Not llDevInfo_Completed And .analyzeCodeBlock_DevInfo( toProject, @lcLine, @taCodeLines, @m.I, tnCodeLines ) + llDevInfo_Completed = .T. + + Case Not llServerHead_Completed And .analyzeCodeBlock_ServerHead( toProject, @lcLine, @taCodeLines, @m.I, tnCodeLines ) + llServerHead_Completed = .T. + + Case .analyzeCodeBlock_ServerData( toProject, @lcLine, @taCodeLines, @m.I, tnCodeLines ) +*-- Puede haber varios servidores, por eso se siguen valuando + + Case Not llBuildProj_Completed And .analyzeCodeBlock_BuildProj( toProject, @lcLine, @taCodeLines, @m.I, tnCodeLines, @toFoxBin2Prg ) + llBuildProj_Completed = .T. + + Case Not llFileComments_Completed And .analyzeCodeBlock_FileComments( toProject, @lcLine, @taCodeLines, @m.I, tnCodeLines ) + llFileComments_Completed = .T. + + Case Not llExcludedFiles_Completed And .analyzeCodeBlock_ExcludedFiles( toProject, @lcLine, @taCodeLines, @m.I, tnCodeLines ) + llExcludedFiles_Completed = .T. + + Case Not llTextFiles_Completed And .analyzeCodeBlock_TextFiles( toProject, @lcLine, @taCodeLines, @m.I, tnCodeLines ) + llTextFiles_Completed = .T. + + Case Not llProjectProperties_Completed And .analyzeCodeBlock_ProjectProperties( toProject, @lcLine, @taCodeLines, @m.I, tnCodeLines ) + llProjectProperties_Completed = .T. - ENDCASE + Endcase - ENDFOR - ENDIF - ENDWITH && THIS + Endfor + Endif + Endwith && THIS - CATCH TO loEx - IF THIS.n_Debug > 0 AND _VFP.STARTMODE = 0 - SET STEP ON - ENDIF + Catch To loEx + If This.n_Debug > 0 And _vfp.StartMode = 0 + Set Step On + Endif - THROW + Throw - FINALLY - RELEASE taCodeLines, tnCodeLines, taLineasExclusion, tnBloquesExclusion, toProject ; - , I, lc_Comentario, lcLine, llBuildProj_Completed, llDevInfo_Completed ; - , llServerHead_Completed, llFileComments_Completed, llFoxBin2Prg_Completed ; - , llExcludedFiles_Completed, llTextFiles_Completed, llProjectProperties_Completed - ENDTRY + Finally + Release taCodeLines, tnCodeLines, taLineasExclusion, tnBloquesExclusion, toProject ; + , I, lc_Comentario, lcLine, llBuildProj_Completed, llDevInfo_Completed ; + , llServerHead_Completed, llFileComments_Completed, llFoxBin2Prg_Completed ; + , llExcludedFiles_Completed, llTextFiles_Completed, llProjectProperties_Completed + Endtry - RETURN - ENDPROC + Return + Endproc - PROCEDURE analyzeCodeBlock_BuildProj - *-------------------------------------------------------------------------------------------------------------- - * Analiza el bloque - *-------------------------------------------------------------------------------------------------------------- - * PARÁMETROS: (v=Pasar por valor | @=Pasar por referencia) (!=Obligatorio | ?=Opcional) (IN/OUT) - * toProject (@? OUT) Objeto con toda la información del proyecto analizado - * tcLine (@! IN ) Línea de datos en evaluación - * taCodeLines (@! IN ) El array con las líneas del código donde buscar - * tnCodeLines (@! IN ) Cantidad de líneas de código - * toFoxBin2Prg (v! IN ) Referencia al objeto principal - *-------------------------------------------------------------------------------------------------------------- - LPARAMETERS toProject, tcLine, taCodeLines, I, tnCodeLines, toFoxBin2Prg + Procedure analyzeCodeBlock_BuildProj +*-------------------------------------------------------------------------------------------------------------- +* Analiza el bloque +*-------------------------------------------------------------------------------------------------------------- +* PARÁMETROS: (v=Pasar por valor | @=Pasar por referencia) (!=Obligatorio | ?=Opcional) (IN/OUT) +* toProject (@? OUT) Objeto con toda la información del proyecto analizado +* tcLine (@! IN ) Línea de datos en evaluación +* taCodeLines (@! IN ) El array con las líneas del código donde buscar +* tnCodeLines (@! IN ) Cantidad de líneas de código +* toFoxBin2Prg (v! IN ) Referencia al objeto principal +*-------------------------------------------------------------------------------------------------------------- + Lparameters toProject, tcLine, taCodeLines, I, tnCodeLines, toFoxBin2Prg - #IF .F. - LOCAL toProject AS CL_PROJECT OF 'FOXBIN2PRG.PRG' - LOCAL toFoxBin2Prg AS c_foxbin2prg OF 'FOXBIN2PRG.PRG' - #ENDIF + #If .F. + Local toProject As CL_PROJECT Of 'FOXBIN2PRG.PRG' + Local toFoxBin2Prg As c_foxbin2prg Of 'FOXBIN2PRG.PRG' + #Endif - TRY - LOCAL llBloqueEncontrado, lcComment, lcMetadatos, luValor ; - , laPropsAndValues(1,2), lnPropsAndValues_Count ; - , loFile AS CL_PROJ_FILE OF 'FOXBIN2PRG.PRG' + Try + Local llBloqueEncontrado, lcComment, lcMetadatos, luValor ; + , laPropsAndValues(1,2), lnPropsAndValues_Count ; + , loFile As CL_PROJ_FILE Of 'FOXBIN2PRG.PRG' - IF LEFT( tcLine, LEN(C_BUILDPROJ_I) ) == C_BUILDPROJ_I - llBloqueEncontrado = .T. + If Left( tcLine, Len(C_BUILDPROJ_I) ) == C_BUILDPROJ_I + llBloqueEncontrado = .T. - WITH THIS - FOR I = m.I + 1 TO tnCodeLines - lcComment = '' - .set_Line( @tcLine, @taCodeLines, m.I ) + With This + For I = m.I + 1 To tnCodeLines + lcComment = '' + .set_Line( @tcLine, @taCodeLines, m.I ) - DO CASE - CASE LEFT( tcLine, LEN(C_BUILDPROJ_F) ) == C_BUILDPROJ_F - I = m.I + 1 - EXIT + Do Case + Case Left( tcLine, Len(C_BUILDPROJ_F) ) == C_BUILDPROJ_F + I = m.I + 1 + Exit - CASE .lineIsOnlyCommentAndNoMetadata( @tcLine, @lcComment ) - LOOP && Saltear comentarios + Case .lineIsOnlyCommentAndNoMetadata( @tcLine, @lcComment ) + Loop && Saltear comentarios - CASE UPPER( LEFT( tcLine, 14 ) ) == 'BUILD PROJECT ' - LOOP + Case Upper( Left( tcLine, 14 ) ) == 'BUILD PROJECT ' + Loop - CASE UPPER( LEFT( tcLine, 5 ) ) == '.ADD(' - * loFile: NAME,TYPE,EXCLUDE,COMMENTS - tcLine = CHRTRAN( tcLine, ["] + '[]', "'''" ) && Convierto "[] en ' - STORE NULL TO loFile - loFile = CREATEOBJECT('CL_PROJ_FILE') - loFile._Name = ALLTRIM( STREXTRACT( tcLine, ['], ['] ) ) + Case Upper( Left( tcLine, 5 ) ) == '.ADD(' +* loFile: NAME,TYPE,EXCLUDE,COMMENTS + tcLine = Chrtran( tcLine, ["] + '[]', "'''" ) && Convierto "[] en ' + Store Null To loFile + loFile = Createobject('CL_PROJ_FILE') + loFile._Name = Alltrim( Strextract( tcLine, ['], ['] ) ) - *-- Obtengo metadatos de los comentarios de FileMetadata: - *< FileMetadata: Type="V" Cpid="1252" Timestamp="1131901580" ID="1129207528" ObjRev="544" /> - .get_ListNamesWithValuesFrom_InLine_MetadataTag( @lcComment, @laPropsAndValues ; - , @lnPropsAndValues_Count, C_FILE_META_I, C_FILE_META_F ) +*-- Obtengo metadatos de los comentarios de FileMetadata: +*< FileMetadata: Type="V" Cpid="1252" Timestamp="1131901580" ID="1129207528" ObjRev="544" /> + .get_ListNamesWithValuesFrom_InLine_MetadataTag( @lcComment, @laPropsAndValues ; + , @lnPropsAndValues_Count, C_FILE_META_I, C_FILE_META_F ) - loFile._Type = .get_ValueByName_FromListNamesWithValues( 'Type', 'C', @laPropsAndValues ) - loFile._CPID = .get_ValueByName_FromListNamesWithValues( 'CPID', 'I', @laPropsAndValues ) - loFile._TimeStamp = .get_ValueByName_FromListNamesWithValues( 'Timestamp', 'I', @laPropsAndValues ) - loFile._ID = .get_ValueByName_FromListNamesWithValues( 'ID', 'I', @laPropsAndValues ) - loFile._ObjRev = .get_ValueByName_FromListNamesWithValues( 'ObjRev', 'I', @laPropsAndValues ) - loFile._User = .get_ValueByName_FromListNamesWithValues( 'User', 'C', @laPropsAndValues ) + loFile._Type = .get_ValueByName_FromListNamesWithValues( 'Type', 'C', @laPropsAndValues ) + loFile._CPID = .get_ValueByName_FromListNamesWithValues( 'CPID', 'I', @laPropsAndValues ) + loFile._TimeStamp = .get_ValueByName_FromListNamesWithValues( 'Timestamp', 'I', @laPropsAndValues ) + loFile._ID = .get_ValueByName_FromListNamesWithValues( 'ID', 'I', @laPropsAndValues ) + loFile._ObjRev = .get_ValueByName_FromListNamesWithValues( 'ObjRev', 'I', @laPropsAndValues ) + loFile._User = .get_ValueByName_FromListNamesWithValues( 'User', 'C', @laPropsAndValues ) - IF toFoxBin2Prg.n_BodyDevInfo = 1 - loFile._DevInfo = .get_ValueByName_FromListNamesWithValues( 'DevInfo', 'C', @laPropsAndValues ) - ENDIF + If toFoxBin2Prg.n_BodyDevInfo = 1 + loFile._DevInfo = .get_ValueByName_FromListNamesWithValues( 'DevInfo', 'C', @laPropsAndValues ) + Endif - toProject.ADD( loFile, loFile._Name ) + toProject.Add( loFile, loFile._Name ) - CASE UPPER( LEFT( tcLine, 10 ) ) == UPPER( '*<.HomeDir' ) - toProject._HomeDir = STREXTRACT( tcLine, "'", "'" ) + Case Upper( Left( tcLine, 10 ) ) == Upper( '*<.HomeDir' ) + toProject._HomeDir = Strextract( tcLine, "'", "'" ) - ENDCASE - ENDFOR - ENDWITH && THIS + Endcase + Endfor + Endwith && THIS - I = m.I - 1 - ENDIF + I = m.I - 1 + Endif - CATCH TO loEx - IF THIS.n_Debug > 0 AND _VFP.STARTMODE = 0 - SET STEP ON - ENDIF + Catch To loEx + If This.n_Debug > 0 And _vfp.StartMode = 0 + Set Step On + Endif - THROW + Throw - FINALLY - STORE NULL TO loFile - RELEASE toProject, tcLine, taCodeLines, I, tnCodeLines ; - , lcComment, lcMetadatos, luValor, laPropsAndValues, lnPropsAndValues_Count, loFile - ENDTRY + Finally + Store Null To loFile + Release toProject, tcLine, taCodeLines, I, tnCodeLines ; + , lcComment, lcMetadatos, luValor, laPropsAndValues, lnPropsAndValues_Count, loFile + Endtry - RETURN llBloqueEncontrado - ENDPROC + Return llBloqueEncontrado + Endproc - PROCEDURE analyzeCodeBlock_DevInfo - *------------------------------------------------------ - *-- Analiza el bloque - *------------------------------------------------------ - LPARAMETERS toProject, tcLine, taCodeLines, I, tnCodeLines + Procedure analyzeCodeBlock_DevInfo +*------------------------------------------------------ +*-- Analiza el bloque +*------------------------------------------------------ + Lparameters toProject, tcLine, taCodeLines, I, tnCodeLines - #IF .F. - LOCAL toProject AS CL_PROJECT OF 'FOXBIN2PRG.PRG' - #ENDIF + #If .F. + Local toProject As CL_PROJECT Of 'FOXBIN2PRG.PRG' + #Endif - TRY - LOCAL llBloqueEncontrado + Try + Local llBloqueEncontrado - IF LEFT( tcLine, LEN(C_DEVINFO_I) ) == C_DEVINFO_I - llBloqueEncontrado = .T. + If Left( tcLine, Len(C_DEVINFO_I) ) == C_DEVINFO_I + llBloqueEncontrado = .T. - WITH THIS AS c_conversor_prg_a_pjx OF 'FOXBIN2PRG.PRG' - FOR I = m.I + 1 TO tnCodeLines - .set_Line( @tcLine, @taCodeLines, m.I ) + With This As c_conversor_prg_a_pjx Of 'FOXBIN2PRG.PRG' + For I = m.I + 1 To tnCodeLines + .set_Line( @tcLine, @taCodeLines, m.I ) - DO CASE - CASE LEFT( tcLine, LEN(C_DEVINFO_F) ) == C_DEVINFO_F - I = m.I + 1 - EXIT + Do Case + Case Left( tcLine, Len(C_DEVINFO_F) ) == C_DEVINFO_F + I = m.I + 1 + Exit - CASE .lineIsOnlyCommentAndNoMetadata( @tcLine ) - LOOP && Saltear comentarios + Case .lineIsOnlyCommentAndNoMetadata( @tcLine ) + Loop && Saltear comentarios - OTHERWISE - toProject.setParsedProjInfoLine( @tcLine ) - ENDCASE - ENDFOR - ENDWITH && THIS + Otherwise + toProject.setParsedProjInfoLine( @tcLine ) + Endcase + Endfor + Endwith && THIS - I = m.I - 1 - ENDIF + I = m.I - 1 + Endif - CATCH TO loEx - IF THIS.n_Debug > 0 AND _VFP.STARTMODE = 0 - SET STEP ON - ENDIF + Catch To loEx + If This.n_Debug > 0 And _vfp.StartMode = 0 + Set Step On + Endif - THROW + Throw - ENDTRY + Endtry - RETURN llBloqueEncontrado - ENDPROC + Return llBloqueEncontrado + Endproc - PROCEDURE analyzeCodeBlock_ServerHead - *------------------------------------------------------ - *-- Analiza el bloque - *------------------------------------------------------ - LPARAMETERS toProject, tcLine, taCodeLines, I, tnCodeLines + Procedure analyzeCodeBlock_ServerHead +*------------------------------------------------------ +*-- Analiza el bloque +*------------------------------------------------------ + Lparameters toProject, tcLine, taCodeLines, I, tnCodeLines - #IF .F. - LOCAL toProject AS CL_PROJECT OF 'FOXBIN2PRG.PRG' - #ENDIF + #If .F. + Local toProject As CL_PROJECT Of 'FOXBIN2PRG.PRG' + #Endif - TRY - LOCAL llBloqueEncontrado ; - , loServerHead AS CL_PROJ_SRV_HEAD OF 'FOXBIN2PRG.PRG' + Try + Local llBloqueEncontrado ; + , loServerHead As CL_PROJ_SRV_HEAD Of 'FOXBIN2PRG.PRG' - IF LEFT( tcLine, LEN(C_SRV_HEAD_I) ) == C_SRV_HEAD_I - llBloqueEncontrado = .T. + If Left( tcLine, Len(C_SRV_HEAD_I) ) == C_SRV_HEAD_I + llBloqueEncontrado = .T. - STORE NULL TO loServerHead - loServerHead = toProject._ServerHead + Store Null To loServerHead + loServerHead = toProject._ServerHead - WITH THIS AS c_conversor_prg_a_pjx OF 'FOXBIN2PRG.PRG' - FOR I = m.I + 1 TO tnCodeLines - .set_Line( @tcLine, @taCodeLines, m.I ) + With This As c_conversor_prg_a_pjx Of 'FOXBIN2PRG.PRG' + For I = m.I + 1 To tnCodeLines + .set_Line( @tcLine, @taCodeLines, m.I ) - DO CASE - CASE .lineIsOnlyCommentAndNoMetadata( @tcLine ) - LOOP && Saltear comentarios + Do Case + Case .lineIsOnlyCommentAndNoMetadata( @tcLine ) + Loop && Saltear comentarios - CASE LEFT( tcLine, LEN(C_SRV_HEAD_F) ) == C_SRV_HEAD_F - I = m.I + 1 - EXIT + Case Left( tcLine, Len(C_SRV_HEAD_F) ) == C_SRV_HEAD_F + I = m.I + 1 + Exit - OTHERWISE - loServerHead.setParsedHeadInfoLine( @tcLine ) - ENDCASE - ENDFOR - ENDWITH && THIS + Otherwise + loServerHead.setParsedHeadInfoLine( @tcLine ) + Endcase + Endfor + Endwith && THIS - I = m.I - 1 - ENDIF + I = m.I - 1 + Endif - CATCH TO loEx - IF THIS.n_Debug > 0 AND _VFP.STARTMODE = 0 - SET STEP ON - ENDIF + Catch To loEx + If This.n_Debug > 0 And _vfp.StartMode = 0 + Set Step On + Endif - THROW + Throw - FINALLY - STORE NULL TO loServerHead - RELEASE loServerHead + Finally + Store Null To loServerHead + Release loServerHead - ENDTRY + Endtry - RETURN llBloqueEncontrado - ENDPROC + Return llBloqueEncontrado + Endproc - PROCEDURE analyzeCodeBlock_ServerData - *------------------------------------------------------ - *-- Analiza el bloque - *------------------------------------------------------ - LPARAMETERS toProject, tcLine, taCodeLines, I, tnCodeLines + Procedure analyzeCodeBlock_ServerData +*------------------------------------------------------ +*-- Analiza el bloque +*------------------------------------------------------ + Lparameters toProject, tcLine, taCodeLines, I, tnCodeLines - #IF .F. - LOCAL toProject AS CL_PROJECT OF 'FOXBIN2PRG.PRG' - #ENDIF + #If .F. + Local toProject As CL_PROJECT Of 'FOXBIN2PRG.PRG' + #Endif - TRY - LOCAL llBloqueEncontrado ; - , loServerHead AS CL_PROJ_SRV_HEAD OF 'FOXBIN2PRG.PRG' ; - , loServerData AS CL_PROJ_SRV_DATA OF 'FOXBIN2PRG.PRG' + Try + Local llBloqueEncontrado ; + , loServerHead As CL_PROJ_SRV_HEAD Of 'FOXBIN2PRG.PRG' ; + , loServerData As CL_PROJ_SRV_DATA Of 'FOXBIN2PRG.PRG' - IF LEFT( tcLine, LEN(C_SRV_DATA_I) ) == C_SRV_DATA_I - llBloqueEncontrado = .T. + If Left( tcLine, Len(C_SRV_DATA_I) ) == C_SRV_DATA_I + llBloqueEncontrado = .T. - STORE NULL TO loServerData, loServerHead - loServerHead = toProject._ServerHead - loServerData = loServerHead.getServerDataObject() + Store Null To loServerData, loServerHead + loServerHead = toProject._ServerHead + loServerData = loServerHead.getServerDataObject() - WITH THIS AS c_conversor_prg_a_pjx OF 'FOXBIN2PRG.PRG' - FOR I = m.I + 1 TO tnCodeLines - .set_Line( @tcLine, @taCodeLines, m.I ) + With This As c_conversor_prg_a_pjx Of 'FOXBIN2PRG.PRG' + For I = m.I + 1 To tnCodeLines + .set_Line( @tcLine, @taCodeLines, m.I ) - DO CASE - CASE .lineIsOnlyCommentAndNoMetadata( @tcLine ) - LOOP && Saltear comentarios + Do Case + Case .lineIsOnlyCommentAndNoMetadata( @tcLine ) + Loop && Saltear comentarios - CASE LEFT( tcLine, LEN(C_SRV_DATA_F) ) == C_SRV_DATA_F - I = m.I + 1 - EXIT + Case Left( tcLine, Len(C_SRV_DATA_F) ) == C_SRV_DATA_F + I = m.I + 1 + Exit - OTHERWISE - loServerHead.setParsedInfoLine( loServerData, @tcLine ) - ENDCASE - ENDFOR - ENDWITH && THIS + Otherwise + loServerHead.setParsedInfoLine( loServerData, @tcLine ) + Endcase + Endfor + Endwith && THIS - loServerHead.add_Server( loServerData ) - I = m.I - 1 - ENDIF + loServerHead.add_Server( loServerData ) + I = m.I - 1 + Endif - CATCH TO loEx - IF THIS.n_Debug > 0 AND _VFP.STARTMODE = 0 - SET STEP ON - ENDIF + Catch To loEx + If This.n_Debug > 0 And _vfp.StartMode = 0 + Set Step On + Endif - THROW + Throw - FINALLY - STORE NULL TO loServerData, loServerHead - RELEASE loServerHead, loServerData + Finally + Store Null To loServerData, loServerHead + Release loServerHead, loServerData - ENDTRY + Endtry - RETURN llBloqueEncontrado - ENDPROC + Return llBloqueEncontrado + Endproc - PROCEDURE analyzeCodeBlock_FileComments - *------------------------------------------------------ - *-- Analiza el bloque - *------------------------------------------------------ - LPARAMETERS toProject, tcLine, taCodeLines, I, tnCodeLines + Procedure analyzeCodeBlock_FileComments +*------------------------------------------------------ +*-- Analiza el bloque +*------------------------------------------------------ + Lparameters toProject, tcLine, taCodeLines, I, tnCodeLines - EXTERNAL ARRAY toProject + External Array toProject - #IF .F. - LOCAL toProject AS CL_PROJECT OF 'FOXBIN2PRG.PRG' - #ENDIF + #If .F. + Local toProject As CL_PROJECT Of 'FOXBIN2PRG.PRG' + #Endif - TRY - LOCAL llBloqueEncontrado, lcFile, lcComment ; - , loFile AS CL_PROJ_FILE OF 'FOXBIN2PRG.PRG' + Try + Local llBloqueEncontrado, lcFile, lcComment ; + , loFile As CL_PROJ_FILE Of 'FOXBIN2PRG.PRG' - IF LEFT( tcLine, LEN(C_FILE_CMTS_I) ) == C_FILE_CMTS_I - llBloqueEncontrado = .T. - loFile = NULL + If Left( tcLine, Len(C_FILE_CMTS_I) ) == C_FILE_CMTS_I + llBloqueEncontrado = .T. + loFile = Null - WITH THIS AS c_conversor_prg_a_pjx OF 'FOXBIN2PRG.PRG' - FOR I = m.I + 1 TO tnCodeLines - .set_Line( @tcLine, @taCodeLines, m.I ) + With This As c_conversor_prg_a_pjx Of 'FOXBIN2PRG.PRG' + For I = m.I + 1 To tnCodeLines + .set_Line( @tcLine, @taCodeLines, m.I ) - DO CASE - CASE .lineIsOnlyCommentAndNoMetadata( @tcLine ) - LOOP && Saltear comentarios + Do Case + Case .lineIsOnlyCommentAndNoMetadata( @tcLine ) + Loop && Saltear comentarios - CASE LEFT( tcLine, LEN(C_FILE_CMTS_F) ) == C_FILE_CMTS_F - I = m.I + 1 - EXIT + Case Left( tcLine, Len(C_FILE_CMTS_F) ) == C_FILE_CMTS_F + I = m.I + 1 + Exit - OTHERWISE - lcFile = LOWER( ALLTRIM( STRTRAN( CHRTRAN( NORMALIZE( STREXTRACT( tcLine, ".ITEM(", ").Description", 1, 1 ) ), ["], [] ), 'lcCurDir+', '', 1, 1, 1) ) ) - lcComment = ALLTRIM( CHRTRAN( STREXTRACT( tcLine, "=", "", 1, 2 ), ['], [] ) ) - loFile = toProject( lcFile ) - loFile._Comments = lcComment - loFile = NULL - ENDCASE - ENDFOR - ENDWITH && THIS + Otherwise + lcFile = Lower( Alltrim( Strtran( Chrtran( Normalize( Strextract( tcLine, ".ITEM(", ").Description", 1, 1 ) ), ["], [] ), 'lcCurDir+', '', 1, 1, 1) ) ) + lcComment = Alltrim( Chrtran( Strextract( tcLine, "=", "", 1, 2 ), ['], [] ) ) + loFile = toProject( lcFile ) + loFile._Comments = lcComment + loFile = Null + Endcase + Endfor + Endwith && THIS - I = m.I - 1 - ENDIF + I = m.I - 1 + Endif - CATCH TO loEx - IF THIS.n_Debug > 0 AND _VFP.STARTMODE = 0 - SET STEP ON - ENDIF + Catch To loEx + If This.n_Debug > 0 And _vfp.StartMode = 0 + Set Step On + Endif - THROW + Throw - FINALLY - loFile = NULL - RELEASE lcFile, lcComment, loFile + Finally + loFile = Null + Release lcFile, lcComment, loFile - ENDTRY + Endtry - RETURN llBloqueEncontrado - ENDPROC + Return llBloqueEncontrado + Endproc - PROCEDURE analyzeCodeBlock_ExcludedFiles - *------------------------------------------------------ - *-- Analiza el bloque - *------------------------------------------------------ - LPARAMETERS toProject, tcLine, taCodeLines, I, tnCodeLines + Procedure analyzeCodeBlock_ExcludedFiles +*------------------------------------------------------ +*-- Analiza el bloque +*------------------------------------------------------ + Lparameters toProject, tcLine, taCodeLines, I, tnCodeLines - EXTERNAL ARRAY toProject + External Array toProject - #IF .F. - LOCAL toProject AS CL_PROJECT OF 'FOXBIN2PRG.PRG' - #ENDIF + #If .F. + Local toProject As CL_PROJECT Of 'FOXBIN2PRG.PRG' + #Endif - TRY - LOCAL llBloqueEncontrado, lcFile, llExclude ; - , loFile AS CL_PROJ_FILE OF 'FOXBIN2PRG.PRG' + Try + Local llBloqueEncontrado, lcFile, llExclude ; + , loFile As CL_PROJ_FILE Of 'FOXBIN2PRG.PRG' - IF LEFT( tcLine, LEN(C_FILE_EXCL_I) ) == C_FILE_EXCL_I - llBloqueEncontrado = .T. - loFile = NULL + If Left( tcLine, Len(C_FILE_EXCL_I) ) == C_FILE_EXCL_I + llBloqueEncontrado = .T. + loFile = Null - WITH THIS AS c_conversor_prg_a_pjx OF 'FOXBIN2PRG.PRG' - FOR I = m.I + 1 TO tnCodeLines - .set_Line( @tcLine, @taCodeLines, m.I ) + With This As c_conversor_prg_a_pjx Of 'FOXBIN2PRG.PRG' + For I = m.I + 1 To tnCodeLines + .set_Line( @tcLine, @taCodeLines, m.I ) - DO CASE - CASE .lineIsOnlyCommentAndNoMetadata( @tcLine ) - LOOP && Saltear comentarios + Do Case + Case .lineIsOnlyCommentAndNoMetadata( @tcLine ) + Loop && Saltear comentarios - CASE LEFT( tcLine, LEN(C_FILE_EXCL_F) ) == C_FILE_EXCL_F - I = m.I + 1 - EXIT + Case Left( tcLine, Len(C_FILE_EXCL_F) ) == C_FILE_EXCL_F + I = m.I + 1 + Exit - OTHERWISE - lcFile = LOWER( ALLTRIM( STRTRAN( CHRTRAN( NORMALIZE( STREXTRACT( tcLine, ".ITEM(", ").Exclude", 1, 1 ) ), ["], [] ), 'lcCurDir+', '', 1, 1, 1) ) ) - llExclude = EVALUATE( ALLTRIM( CHRTRAN( STREXTRACT( tcLine, "=", "", 1, 2 ), ['], [] ) ) ) - loFile = toProject( lcFile ) - loFile._Exclude = llExclude - loFile = NULL - ENDCASE - ENDFOR - ENDWITH && THIS + Otherwise + lcFile = Lower( Alltrim( Strtran( Chrtran( Normalize( Strextract( tcLine, ".ITEM(", ").Exclude", 1, 1 ) ), ["], [] ), 'lcCurDir+', '', 1, 1, 1) ) ) + llExclude = Evaluate( Alltrim( Chrtran( Strextract( tcLine, "=", "", 1, 2 ), ['], [] ) ) ) + loFile = toProject( lcFile ) + loFile._Exclude = llExclude + loFile = Null + Endcase + Endfor + Endwith && THIS - I = m.I - 1 - ENDIF + I = m.I - 1 + Endif - CATCH TO loEx - IF THIS.n_Debug > 0 AND _VFP.STARTMODE = 0 - SET STEP ON - ENDIF + Catch To loEx + If This.n_Debug > 0 And _vfp.StartMode = 0 + Set Step On + Endif - THROW + Throw - FINALLY - loFile = NULL - RELEASE lcFile, llExclude, loFile + Finally + loFile = Null + Release lcFile, llExclude, loFile - ENDTRY + Endtry - RETURN llBloqueEncontrado - ENDPROC + Return llBloqueEncontrado + Endproc - PROCEDURE analyzeCodeBlock_TextFiles - *------------------------------------------------------ - *-- Analiza el bloque - *------------------------------------------------------ - LPARAMETERS toProject, tcLine, taCodeLines, I, tnCodeLines + Procedure analyzeCodeBlock_TextFiles +*------------------------------------------------------ +*-- Analiza el bloque +*------------------------------------------------------ + Lparameters toProject, tcLine, taCodeLines, I, tnCodeLines - EXTERNAL ARRAY toProject + External Array toProject - #IF .F. - LOCAL toProject AS CL_PROJECT OF 'FOXBIN2PRG.PRG' - #ENDIF + #If .F. + Local toProject As CL_PROJECT Of 'FOXBIN2PRG.PRG' + #Endif - TRY - LOCAL llBloqueEncontrado, lcFile, lcType ; - , loFile AS CL_PROJ_FILE OF 'FOXBIN2PRG.PRG' + Try + Local llBloqueEncontrado, lcFile, lcType ; + , loFile As CL_PROJ_FILE Of 'FOXBIN2PRG.PRG' - IF LEFT( tcLine, LEN(C_FILE_TXT_I) ) == C_FILE_TXT_I - llBloqueEncontrado = .T. - loFile = NULL + If Left( tcLine, Len(C_FILE_TXT_I) ) == C_FILE_TXT_I + llBloqueEncontrado = .T. + loFile = Null - WITH THIS AS c_conversor_prg_a_pjx OF 'FOXBIN2PRG.PRG' - FOR I = m.I + 1 TO tnCodeLines - .set_Line( @tcLine, @taCodeLines, m.I ) + With This As c_conversor_prg_a_pjx Of 'FOXBIN2PRG.PRG' + For I = m.I + 1 To tnCodeLines + .set_Line( @tcLine, @taCodeLines, m.I ) - DO CASE - CASE .lineIsOnlyCommentAndNoMetadata( @tcLine ) - LOOP && Saltear comentarios + Do Case + Case .lineIsOnlyCommentAndNoMetadata( @tcLine ) + Loop && Saltear comentarios - CASE LEFT( tcLine, LEN(C_FILE_TXT_F) ) == C_FILE_TXT_F - I = m.I + 1 - EXIT + Case Left( tcLine, Len(C_FILE_TXT_F) ) == C_FILE_TXT_F + I = m.I + 1 + Exit - OTHERWISE - lcFile = LOWER( ALLTRIM( STRTRAN( CHRTRAN( NORMALIZE( STREXTRACT( tcLine, ".ITEM(", ").Type", 1, 1 ) ), ["], [] ), 'lcCurDir+', '', 1, 1, 1) ) ) - lcType = ALLTRIM( CHRTRAN( STREXTRACT( tcLine, "=", "", 1, 2 ), ['], [] ) ) - loFile = toProject( lcFile ) - loFile._Type = lcType - loFile = NULL - ENDCASE - ENDFOR - ENDWITH && THIS + Otherwise + lcFile = Lower( Alltrim( Strtran( Chrtran( Normalize( Strextract( tcLine, ".ITEM(", ").Type", 1, 1 ) ), ["], [] ), 'lcCurDir+', '', 1, 1, 1) ) ) + lcType = Alltrim( Chrtran( Strextract( tcLine, "=", "", 1, 2 ), ['], [] ) ) + loFile = toProject( lcFile ) + loFile._Type = lcType + loFile = Null + Endcase + Endfor + Endwith && THIS - I = m.I - 1 - ENDIF + I = m.I - 1 + Endif - CATCH TO loEx - IF THIS.n_Debug > 0 AND _VFP.STARTMODE = 0 - SET STEP ON - ENDIF + Catch To loEx + If This.n_Debug > 0 And _vfp.StartMode = 0 + Set Step On + Endif - THROW + Throw - FINALLY - loFile = NULL - RELEASE lcFile, lcType, loFile + Finally + loFile = Null + Release lcFile, lcType, loFile - ENDTRY + Endtry - RETURN llBloqueEncontrado - ENDPROC + Return llBloqueEncontrado + Endproc - PROCEDURE analyzeCodeBlock_ProjectProperties - *------------------------------------------------------ - *-- Analiza el bloque - *------------------------------------------------------ - LPARAMETERS toProject, tcLine, taCodeLines, I, tnCodeLines + Procedure analyzeCodeBlock_ProjectProperties +*------------------------------------------------------ +*-- Analiza el bloque +*------------------------------------------------------ + Lparameters toProject, tcLine, taCodeLines, I, tnCodeLines - #IF .F. - LOCAL toProject AS CL_PROJECT OF 'FOXBIN2PRG.PRG' - #ENDIF + #If .F. + Local toProject As CL_PROJECT Of 'FOXBIN2PRG.PRG' + #Endif - TRY - LOCAL llBloqueEncontrado, lcLine + Try + Local llBloqueEncontrado, lcLine - IF LEFT( tcLine, LEN(C_PROJPROPS_I) ) == C_PROJPROPS_I - llBloqueEncontrado = .T. + If Left( tcLine, Len(C_PROJPROPS_I) ) == C_PROJPROPS_I + llBloqueEncontrado = .T. - WITH THIS AS c_conversor_prg_a_pjx OF 'FOXBIN2PRG.PRG' - FOR I = m.I + 1 TO tnCodeLines - .set_Line( @tcLine, @taCodeLines, m.I ) + With This As c_conversor_prg_a_pjx Of 'FOXBIN2PRG.PRG' + For I = m.I + 1 To tnCodeLines + .set_Line( @tcLine, @taCodeLines, m.I ) - DO CASE - CASE .lineIsOnlyCommentAndNoMetadata( @tcLine ) - LOOP && Saltear comentarios + Do Case + Case .lineIsOnlyCommentAndNoMetadata( @tcLine ) + Loop && Saltear comentarios - CASE LEFT( tcLine, LEN(C_PROJPROPS_F) ) == C_PROJPROPS_F - I = m.I + 1 - EXIT + Case Left( tcLine, Len(C_PROJPROPS_F) ) == C_PROJPROPS_F + I = m.I + 1 + Exit - CASE LEFT( tcLine ,2 ) == '*<' - *--- Se asigna con EVALUATE() tal cual está en el PJ2, pero quitando el marcador *< /> - lcLine = STUFF( ALLTRIM( STREXTRACT( tcLine, '*<', '/>' ) ), 2, 0, '_' ) - toProject.setParsedProjInfoLine( lcLine ) + Case Left( tcLine ,2 ) == '*<' +*--- Se asigna con EVALUATE() tal cual está en el PJ2, pero quitando el marcador *< /> + lcLine = Stuff( Alltrim( Strextract( tcLine, '*<', '/>' ) ), 2, 0, '_' ) + toProject.setParsedProjInfoLine( lcLine ) - CASE UPPER( LEFT( tcLine, 9 ) ) == '.SETMAIN(' - *-- Cambio "SetMain()" por "_MainProg =" - lcLine = '._MainProg = ' + LOWER( STREXTRACT( ALLTRIM( tcLine), '.SetMain(', ')', 1, 1 ) ) - toProject.setParsedProjInfoLine( lcLine ) + Case Upper( Left( tcLine, 9 ) ) == '.SETMAIN(' +*-- Cambio "SetMain()" por "_MainProg =" + lcLine = '._MainProg = ' + Lower( Strextract( Alltrim( tcLine), '.SetMain(', ')', 1, 1 ) ) + toProject.setParsedProjInfoLine( lcLine ) - OTHERWISE - *--- Se asigna con EVALUATE() tal cual está en el PJ2 - lcLine = STUFF( ALLTRIM( tcLine), 2, 0, '_' ) - toProject.setParsedProjInfoLine( lcLine ) - ENDCASE - ENDFOR - ENDWITH && THIS + Otherwise +*--- Se asigna con EVALUATE() tal cual está en el PJ2 + lcLine = Stuff( Alltrim( tcLine), 2, 0, '_' ) + toProject.setParsedProjInfoLine( lcLine ) + Endcase + Endfor + Endwith && THIS - I = m.I - 1 - ENDIF + I = m.I - 1 + Endif - CATCH TO loEx - IF THIS.n_Debug > 0 AND _VFP.STARTMODE = 0 - SET STEP ON - ENDIF + Catch To loEx + If This.n_Debug > 0 And _vfp.StartMode = 0 + Set Step On + Endif - THROW + Throw - ENDTRY + Endtry - RETURN llBloqueEncontrado - ENDPROC + Return llBloqueEncontrado + Endproc -ENDDEFINE +Enddefine -DEFINE CLASS c_conversor_prg_a_frx AS c_conversor_prg_a_bin - #IF .F. - LOCAL THIS AS c_conversor_prg_a_frx OF 'FOXBIN2PRG.PRG' - #ENDIF - _MEMBERDATA = [] ; +Define Class c_conversor_prg_a_frx As c_conversor_prg_a_bin + #If .F. + Local This As c_conversor_prg_a_frx Of 'FOXBIN2PRG.PRG' + #Endif + _MemberData = [] ; + [] ; + [] ; + [] ; @@ -12170,477 +12182,477 @@ DEFINE CLASS c_conversor_prg_a_frx AS c_conversor_prg_a_bin c_Type = 'FR2' - PROCEDURE convert - *--------------------------------------------------------------------------------------------------- - * PARÁMETROS: (v=Pasar por valor | @=Pasar por referencia) (!=Obligatorio | ?=Opcional) (IN/OUT) - * toReport (!@ OUT) Objeto generado de clase CL_REPORT con la información leida del texto - * toEx (!@ OUT) Objeto con información del error - * toFoxBin2Prg (v! IN ) Referencia al objeto principal - *--------------------------------------------------------------------------------------------------- - LPARAMETERS toReport, toEx AS EXCEPTION, toFoxBin2Prg - DODEFAULT( @toReport, @toEx, @toFoxBin2Prg ) - - #IF .F. - LOCAL toReport AS CL_REPORT OF 'FOXBIN2PRG.PRG' - LOCAL toFoxBin2Prg AS c_foxbin2prg OF 'FOXBIN2PRG.PRG' - #ENDIF - - TRY - LOCAL lnCodError, loEx AS EXCEPTION, laCodeLines(1), lnCodeLines ; - , laLineasExclusion(1), lnBloquesExclusion, I, lnIDInputFile - - WITH THIS AS c_conversor_prg_a_frx OF 'FOXBIN2PRG.PRG' - STORE 0 TO lnCodError, lnCodeLines - STORE NULL TO toReport - lnIDInputFile = toFoxBin2Prg.n_ProcessedFiles - - IF NOT toFoxBin2Prg.l_ProcessFiles THEN - *-- addProcessedFile( tcFile, tcInOutType, tcProcessed, tcHasErrors, tcSupported, tcExpanded ) - IF toFoxBin2Prg.addProcessedFile( .c_OutputFile, 'O', 'P1', 'E0', 'S1', 'X0' ) THEN - toFoxBin2Prg.updateProcessedFile() - ENDIF - - EXIT && Si se indicó no procesar, se sale aquí. (Modo de simulación) - ENDIF - - C_FB2PRG_CODE = FILETOSTR( .c_InputFile ) - lnCodeLines = ALINES( laCodeLines, C_FB2PRG_CODE ) - - .createReport('CURSOR') - - *-- Identifico el inicio/fin de bloque, definición, cabecera y cuerpo del reporte - .updateProgressbar( 'Identifying Code Blocks...', 1, 2, 1 ) - .identifyCodeBlocks( @laCodeLines, lnCodeLines, @laLineasExclusion, lnBloquesExclusion, @toReport ) - USE IN (SELECT('TABLABIN')) - - DO CASE - CASE toFoxBin2Prg.c_SimulateError = 'SIMERR_I1' - ERROR 'InputFile Error Simulation' - CASE toFoxBin2Prg.c_SimulateError = 'SIMERR_I0' - .writeErrorLog( '*** SIMULATED ERROR' ) - ENDCASE - - IF .l_Error - .writeLog( '*** ERRORS found - Generation Cancelled' ) - EXIT - ENDIF - - toFoxBin2Prg.updateProcessedFile( lnIDInputFile ) - .updateProgressbar( 'Generating Binary...', 2, 2, 1 ) - toFoxBin2Prg.doBackup( .F., .T., '', '', '' ) - .createReport() - .writeBinaryFile( @toReport, @toFoxBin2Prg ) - ENDWITH && THIS - - - CATCH TO loEx - lnCodError = loEx.ERRORNO - - IF THIS.n_Debug > 0 AND _VFP.STARTMODE = 0 - SET STEP ON - ENDIF - - THROW - - FINALLY - USE IN (SELECT("TABLABIN")) - ENDTRY - - RETURN lnCodError - ENDPROC + Procedure convert +*--------------------------------------------------------------------------------------------------- +* PARÁMETROS: (v=Pasar por valor | @=Pasar por referencia) (!=Obligatorio | ?=Opcional) (IN/OUT) +* toReport (!@ OUT) Objeto generado de clase CL_REPORT con la información leida del texto +* toEx (!@ OUT) Objeto con información del error +* toFoxBin2Prg (v! IN ) Referencia al objeto principal +*--------------------------------------------------------------------------------------------------- + Lparameters toReport, toEx As Exception, toFoxBin2Prg + DoDefault( @toReport, @toEx, @toFoxBin2Prg ) + + #If .F. + Local toReport As CL_REPORT Of 'FOXBIN2PRG.PRG' + Local toFoxBin2Prg As c_foxbin2prg Of 'FOXBIN2PRG.PRG' + #Endif + + Try + Local lnCodError, loEx As Exception, laCodeLines(1), lnCodeLines ; + , laLineasExclusion(1), lnBloquesExclusion, I, lnIDInputFile + + With This As c_conversor_prg_a_frx Of 'FOXBIN2PRG.PRG' + Store 0 To lnCodError, lnCodeLines + Store Null To toReport + lnIDInputFile = toFoxBin2Prg.n_ProcessedFiles + + If Not toFoxBin2Prg.l_ProcessFiles Then +*-- addProcessedFile( tcFile, tcInOutType, tcProcessed, tcHasErrors, tcSupported, tcExpanded ) + If toFoxBin2Prg.addProcessedFile( .c_OutputFile, 'O', 'P1', 'E0', 'S1', 'X0' ) Then + toFoxBin2Prg.updateProcessedFile() + Endif + + Exit && Si se indicó no procesar, se sale aquí. (Modo de simulación) + Endif + + C_FB2PRG_CODE = Filetostr( .c_InputFile ) + lnCodeLines = Alines( laCodeLines, C_FB2PRG_CODE ) + + .createReport('CURSOR') + +*-- Identifico el inicio/fin de bloque, definición, cabecera y cuerpo del reporte + .updateProgressbar( 'Identifying Code Blocks...', 1, 2, 1 ) + .identifyCodeBlocks( @laCodeLines, lnCodeLines, @laLineasExclusion, lnBloquesExclusion, @toReport ) + Use In (Select('TABLABIN')) + + Do Case + Case toFoxBin2Prg.c_SimulateError = 'SIMERR_I1' + Error 'InputFile Error Simulation' + Case toFoxBin2Prg.c_SimulateError = 'SIMERR_I0' + .writeErrorLog( '*** SIMULATED ERROR' ) + Endcase + + If .l_Error + .writeLog( '*** ERRORS found - Generation Cancelled' ) + Exit + Endif + + toFoxBin2Prg.updateProcessedFile( lnIDInputFile ) + .updateProgressbar( 'Generating Binary...', 2, 2, 1 ) + toFoxBin2Prg.doBackup( .F., .T., '', '', '' ) + .createReport() + .writeBinaryFile( @toReport, @toFoxBin2Prg ) + Endwith && THIS + + + Catch To loEx + lnCodError = loEx.ErrorNo + + If This.n_Debug > 0 And _vfp.StartMode = 0 + Set Step On + Endif + + Throw + + Finally + Use In (Select("TABLABIN")) + Endtry + + Return lnCodError + Endproc - PROCEDURE writeBinaryFile - LPARAMETERS toReport, toFoxBin2Prg - *-- ----------------------------------------------------------------------------------------------------------- - #IF .F. - LOCAL toReport AS CL_REPORT OF 'FOXBIN2PRG.PRG' - LOCAL toFoxBin2Prg AS c_foxbin2prg OF 'FOXBIN2PRG.PRG' - #ENDIF - - TRY - LOCAL loReg, I, lcFieldType, lnFieldLen, lnFieldDec, lnNumCampo, laFieldTypes(1,18) ; - , luValor, lnCodError, loEx AS EXCEPTION ; - , loLang as CL_LANG OF 'FOXBIN2PRG.PRG' - - loLang = _SCREEN.o_FoxBin2Prg_Lang - SELECT TABLABIN - AFIELDS( laFieldTypes ) - loReg = NULL + Procedure writeBinaryFile + Lparameters toReport, toFoxBin2Prg +*-- ----------------------------------------------------------------------------------------------------------- + #If .F. + Local toReport As CL_REPORT Of 'FOXBIN2PRG.PRG' + Local toFoxBin2Prg As c_foxbin2prg Of 'FOXBIN2PRG.PRG' + #Endif + + Try + Local loReg, I, lcFieldType, lnFieldLen, lnFieldDec, lnNumCampo, laFieldTypes(1,18) ; + , luValor, lnCodError, loEx As Exception ; + , loLang As CL_LANG Of 'FOXBIN2PRG.PRG' + + loLang = _Screen.o_FoxBin2Prg_Lang + Select TABLABIN + Afields( laFieldTypes ) + loReg = Null - *-- addProcessedFile( tcFile, tcInOutType, tcProcessed, tcHasErrors, tcSupported, tcExpanded ) - toFoxBin2Prg.addProcessedFile( THIS.c_OutputFile, 'O', 'P1', 'E0', 'S1', 'X0' ) - - DO CASE - CASE toFoxBin2Prg.c_SimulateError = 'SIMERR_O1' - ERROR 'OutputFile Error Simulation' - ENDCASE +*-- addProcessedFile( tcFile, tcInOutType, tcProcessed, tcHasErrors, tcSupported, tcExpanded ) + toFoxBin2Prg.addProcessedFile( This.c_OutputFile, 'O', 'P1', 'E0', 'S1', 'X0' ) + + Do Case + Case toFoxBin2Prg.c_SimulateError = 'SIMERR_O1' + Error 'OutputFile Error Simulation' + Endcase - *-- Agrego los registros - FOR EACH loReg IN toReport FOXOBJECT +*-- Agrego los registros + For Each loReg In toReport FoxObject - *IF toFoxBin2Prg.l_NoTimestamps - * loReg.TIMESTAMP = 0 - *ENDIF - *IF toFoxBin2Prg.l_ClearUniqueID - * loReg.UNIQUEID = '' - *ENDIF - IF EMPTY(loReg.TIMESTAMP) - loReg.TIMESTAMP = .rowTimeStamp( {^2013/11/04 20:00:00} ) - ENDIF - IF EMPTY(loReg.UNIQUEID) OR ALLTRIM(loReg.UNIQUEID) = '0' - loReg.UNIQUEID = toFoxBin2Prg.unique_ID() - ENDIF +*IF toFoxBin2Prg.l_NoTimestamps +* loReg.TIMESTAMP = 0 +*ENDIF +*IF toFoxBin2Prg.l_ClearUniqueID +* loReg.UNIQUEID = '' +*ENDIF + If Empty(loReg.Timestamp) + loReg.Timestamp = .rowTimeStamp( {^2013/11/04 20:00:00} ) + Endif + If Empty(loReg.UNIQUEID) Or Alltrim(loReg.UNIQUEID) = '0' + loReg.UNIQUEID = toFoxBin2Prg.unique_ID() + Endif - *-- Ajuste de los tipos de dato - FOR I = 1 TO AMEMBERS(laProps, loReg, 0) - lnNumCampo = ASCAN( laFieldTypes, laProps(m.I), 1, -1, 1, 1+2+4+8 ) +*-- Ajuste de los tipos de dato + For I = 1 To Amembers(laProps, loReg, 0) + lnNumCampo = Ascan( laFieldTypes, laProps(m.I), 1, -1, 1, 1+2+4+8 ) - IF lnNumCampo = 0 - *ERROR 'No se encontró el campo [' + laProps(m.I) + '] en la estructura del archivo ' + DBF("TABLABIN") - ERROR (TEXTMERGE(loLang.C_FIELD_NOT_FOUND_ON_FILE_STRUCTURE_LOC)) - ENDIF + If lnNumCampo = 0 +*ERROR 'No se encontró el campo [' + laProps(m.I) + '] en la estructura del archivo ' + DBF("TABLABIN") + Error (Textmerge(loLang.C_FIELD_NOT_FOUND_ON_FILE_STRUCTURE_LOC)) + Endif - lcFieldType = laFieldTypes(lnNumCampo,2) - lnFieldLen = laFieldTypes(lnNumCampo,3) - lnFieldDec = laFieldTypes(lnNumCampo,4) - luValor = EVALUATE('loReg.' + laProps(m.I)) + lcFieldType = laFieldTypes(lnNumCampo,2) + lnFieldLen = laFieldTypes(lnNumCampo,3) + lnFieldDec = laFieldTypes(lnNumCampo,4) + luValor = Evaluate('loReg.' + laProps(m.I)) - DO CASE - CASE INLIST(lcFieldType, 'B') && Double - ADDPROPERTY( loReg, laProps(m.I), CAST( luValor AS &lcFieldType. (lnFieldPrec) ) ) + Do Case + Case Inlist(lcFieldType, 'B') && Double + AddProperty( loReg, laProps(m.I), Cast( luValor As &lcFieldType. (lnFieldPrec) ) ) - CASE INLIST(lcFieldType, 'F', 'N', 'Y') && Float, Numeric, Currency - ADDPROPERTY( loReg, laProps(m.I), CAST( luValor AS &lcFieldType. (lnFieldLen, lnFieldDec) ) ) + Case Inlist(lcFieldType, 'F', 'N', 'Y') && Float, Numeric, Currency + AddProperty( loReg, laProps(m.I), Cast( luValor As &lcFieldType. (lnFieldLen, lnFieldDec) ) ) - CASE INLIST(lcFieldType, 'W', 'G', 'M', 'Q', 'V', 'C') && Blob, General, Memo, Varbinary, Varchar, Character - ADDPROPERTY( loReg, laProps(m.I), luValor ) + Case Inlist(lcFieldType, 'W', 'G', 'M', 'Q', 'V', 'C') && Blob, General, Memo, Varbinary, Varchar, Character + AddProperty( loReg, laProps(m.I), luValor ) - OTHERWISE && Demás tipos - ADDPROPERTY( loReg, laProps(m.I), CAST( luValor AS &lcFieldType. (lnFieldLen) ) ) + Otherwise && Demás tipos + AddProperty( loReg, laProps(m.I), Cast( luValor As &lcFieldType. (lnFieldLen) ) ) - ENDCASE + Endcase - ENDFOR + Endfor - INSERT INTO TABLABIN FROM NAME loReg - loReg = NULL - ENDFOR + Insert Into TABLABIN From Name loReg + loReg = Null + Endfor - USE IN (SELECT("TABLABIN")) + Use In (Select("TABLABIN")) - IF toFoxBin2Prg.l_Recompile - toFoxBin2Prg.compileFoxProBinary() - ENDIF + If toFoxBin2Prg.l_Recompile + toFoxBin2Prg.compileFoxProBinary() + Endif - toFoxBin2Prg.updateProcessedFile() + toFoxBin2Prg.updateProcessedFile() - CATCH TO loEx - lnCodError = loEx.ERRORNO - toFoxBin2Prg.updateProcessedFile( 0, '', '', 'E1' ) + Catch To loEx + lnCodError = loEx.ErrorNo + toFoxBin2Prg.updateProcessedFile( 0, '', '', 'E1' ) - IF THIS.n_Debug > 0 AND _VFP.STARTMODE = 0 - SET STEP ON - ENDIF + If This.n_Debug > 0 And _vfp.StartMode = 0 + Set Step On + Endif - THROW + Throw - FINALLY - USE IN (SELECT("TABLABIN")) - loReg = NULL - RELEASE loReg, I, lcFieldType, lnFieldLen, lnFieldDec, lnNumCampo, laFieldTypes, luValor + Finally + Use In (Select("TABLABIN")) + loReg = Null + Release loReg, I, lcFieldType, lnFieldLen, lnFieldDec, lnNumCampo, laFieldTypes, luValor - ENDTRY + Endtry - RETURN lnCodError - ENDPROC + Return lnCodError + Endproc - PROCEDURE identifyCodeBlocks - LPARAMETERS taCodeLines, tnCodeLines, taLineasExclusion, tnBloquesExclusion, toReport - *-------------------------------------------------------------------------------------------------------------- - * PARÁMETROS: (v=Pasar por valor | @=Pasar por referencia) (!=Obligatorio | ?=Opcional) (IN/OUT) - * taCodeLines (!@ IN ) El array con las líneas del código donde buscar - * tnCodeLines (!@ IN ) Cantidad de líneas de código - * taLineasExclusion (@! IN ) Array unidimensional con un .T. o .F. según la línea sea de exclusión o no - * tnBloquesExclusion (@? IN ) Cantidad de bloques de exclusion - * toReport (@? OUT) Objeto con toda la información del reporte analizado - * - * NOTA: - * Como identificador se usa el nombre de clase o de procedimiento, según corresponda. - *-------------------------------------------------------------------------------------------------------------- - EXTERNAL ARRAY taCodeLines, taLineasExclusion + Procedure identifyCodeBlocks + Lparameters taCodeLines, tnCodeLines, taLineasExclusion, tnBloquesExclusion, toReport +*-------------------------------------------------------------------------------------------------------------- +* PARÁMETROS: (v=Pasar por valor | @=Pasar por referencia) (!=Obligatorio | ?=Opcional) (IN/OUT) +* taCodeLines (!@ IN ) El array con las líneas del código donde buscar +* tnCodeLines (!@ IN ) Cantidad de líneas de código +* taLineasExclusion (@! IN ) Array unidimensional con un .T. o .F. según la línea sea de exclusión o no +* tnBloquesExclusion (@? IN ) Cantidad de bloques de exclusion +* toReport (@? OUT) Objeto con toda la información del reporte analizado +* +* NOTA: +* Como identificador se usa el nombre de clase o de procedimiento, según corresponda. +*-------------------------------------------------------------------------------------------------------------- + External Array taCodeLines, taLineasExclusion - #IF .F. - LOCAL toReport AS CL_REPORT OF 'FOXBIN2PRG.PRG' - #ENDIF + #If .F. + Local toReport As CL_REPORT Of 'FOXBIN2PRG.PRG' + #Endif - TRY - LOCAL I, lc_Comentario, lcLine, llFoxBin2Prg_Completed - STORE 0 TO I + Try + Local I, lc_Comentario, lcLine, llFoxBin2Prg_Completed + Store 0 To I - WITH THIS AS c_conversor_prg_a_frx OF 'FOXBIN2PRG.PRG' - .c_Type = UPPER(JUSTEXT(.c_OutputFile)) + With This As c_conversor_prg_a_frx Of 'FOXBIN2PRG.PRG' + .c_Type = Upper(Justext(.c_OutputFile)) - IF tnCodeLines > 1 - toReport = NULL - toReport = CREATEOBJECT('CL_REPORT') + If tnCodeLines > 1 + toReport = Null + toReport = Createobject('CL_REPORT') - FOR I = 1 TO tnCodeLines - .set_Line( @lcLine, @taCodeLines, m.I ) + For I = 1 To tnCodeLines + .set_Line( @lcLine, @taCodeLines, m.I ) - DO CASE - CASE .lineIsOnlyCommentAndNoMetadata( @lcLine, @lc_Comentario ) && Vacía o solo Comentarios - LOOP + Do Case + Case .lineIsOnlyCommentAndNoMetadata( @lcLine, @lc_Comentario ) && Vacía o solo Comentarios + Loop - CASE NOT llFoxBin2Prg_Completed AND .analyzeCodeBlock_FoxBin2Prg( toReport, @lcLine, @taCodeLines, @m.I, tnCodeLines ) - llFoxBin2Prg_Completed = .T. + Case Not llFoxBin2Prg_Completed And .analyzeCodeBlock_FoxBin2Prg( toReport, @lcLine, @taCodeLines, @m.I, tnCodeLines ) + llFoxBin2Prg_Completed = .T. - CASE .analyzeCodeBlock_Reportes( toReport, @lcLine, @taCodeLines, @m.I, tnCodeLines ) + Case .analyzeCodeBlock_Reportes( toReport, @lcLine, @taCodeLines, @m.I, tnCodeLines ) - ENDCASE - ENDFOR - ENDIF - ENDWITH && THIS + Endcase + Endfor + Endif + Endwith && THIS - CATCH TO loEx - IF THIS.n_Debug > 0 AND _VFP.STARTMODE = 0 - SET STEP ON - ENDIF + Catch To loEx + If This.n_Debug > 0 And _vfp.StartMode = 0 + Set Step On + Endif - THROW + Throw - ENDTRY + Endtry - RETURN - ENDPROC + Return + Endproc - PROCEDURE analyzeCodeBlock_CDATA_inline - *------------------------------------------------------ - *-- Analiza el bloque - *------------------------------------------------------ - LPARAMETERS toReport, tcLine, taCodeLines, I, tnCodeLines, toReg, tcPropName + Procedure analyzeCodeBlock_CDATA_inline +*------------------------------------------------------ +*-- Analiza el bloque +*------------------------------------------------------ + Lparameters toReport, tcLine, taCodeLines, I, tnCodeLines, toReg, tcPropName - #IF .F. - LOCAL toReport AS CL_REPORT OF 'FOXBIN2PRG.PRG' - #ENDIF + #If .F. + Local toReport As CL_REPORT Of 'FOXBIN2PRG.PRG' + #Endif - TRY - LOCAL llBloqueEncontrado, lcValue, loEx AS EXCEPTION + Try + Local llBloqueEncontrado, lcValue, loEx As Exception - IF LEFT(tcLine, 1 + LEN(tcPropName) + 1 + 9) == '<' + tcPropName + '>' + C_DATA_I - llBloqueEncontrado = .T. + If Left(tcLine, 1 + Len(tcPropName) + 1 + 9) == '<' + tcPropName + '>' + C_DATA_I + llBloqueEncontrado = .T. - IF C_DATA_F $ tcLine - lcValue = STREXTRACT( tcLine, C_DATA_I, C_DATA_F ) - ADDPROPERTY( toReg, tcPropName, lcValue ) - EXIT - ENDIF + If C_DATA_F $ tcLine + lcValue = Strextract( tcLine, C_DATA_I, C_DATA_F ) + AddProperty( toReg, tcPropName, lcValue ) + Exit + Endif - *-- Tomo la primera parte del valor - lcValue = STREXTRACT( tcLine, C_DATA_I ) +*-- Tomo la primera parte del valor + lcValue = Strextract( tcLine, C_DATA_I ) - *-- Recorro las fracciones del valor - FOR I = m.I + 1 TO tnCodeLines - tcLine = taCodeLines(m.I) +*-- Recorro las fracciones del valor + For I = m.I + 1 To tnCodeLines + tcLine = taCodeLines(m.I) - IF C_DATA_F $ tcLine && Fin del valor - lcValue = lcValue + CR_LF + STREXTRACT( tcLine, '', C_DATA_F ) + If C_DATA_F $ tcLine && Fin del valor + lcValue = lcValue + CR_LF + Strextract( tcLine, '', C_DATA_F ) - *-- Ajustes: En los labels, no se usa CR+LF, sino que se usa solo CR - IF toReg.ObjType = "5" THEN - lcValue = STRTRAN(lcValue, CR_LF, C_CR) - ENDIF +*-- Ajustes: En los labels, no se usa CR+LF, sino que se usa solo CR + If toReg.ObjType = "5" Then + lcValue = Strtran(lcValue, CR_LF, C_CR) + Endif - ADDPROPERTY( toReg, tcPropName, lcValue ) - EXIT + AddProperty( toReg, tcPropName, lcValue ) + Exit - ELSE && Otra fracción del valor - lcValue = lcValue + CR_LF + tcLine - ENDIF - ENDFOR + Else && Otra fracción del valor + lcValue = lcValue + CR_LF + tcLine + Endif + Endfor - ENDIF + Endif - CATCH TO loEx - IF loEx.ERRORNO = 1470 && Incorrect property name. - loEx.USERVALUE = 'PropName=[' + TRANSFORM(tcPropName) + '], Value=[' + TRANSFORM(lcValue) + ']' - ENDIF + Catch To loEx + If loEx.ErrorNo = 1470 && Incorrect property name. + loEx.UserValue = 'PropName=[' + Transform(tcPropName) + '], Value=[' + Transform(lcValue) + ']' + Endif - IF THIS.n_Debug > 0 AND _VFP.STARTMODE = 0 - SET STEP ON - ENDIF + If This.n_Debug > 0 And _vfp.StartMode = 0 + Set Step On + Endif - THROW + Throw - FINALLY - RELEASE toReport, tcLine, taCodeLines, I, tnCodeLines, toReg, tcPropName ; - , lcValue, loEx - ENDTRY + Finally + Release toReport, tcLine, taCodeLines, I, tnCodeLines, toReg, tcPropName ; + , lcValue, loEx + Endtry - RETURN llBloqueEncontrado - ENDPROC + Return llBloqueEncontrado + Endproc - PROCEDURE analyzeCodeBlock_platform - *------------------------------------------------------ - *-- Analiza el bloque - *------------------------------------------------------ - LPARAMETERS toReport, tcLine, taCodeLines, I, tnCodeLines, toReg + Procedure analyzeCodeBlock_platform +*------------------------------------------------------ +*-- Analiza el bloque +*------------------------------------------------------ + Lparameters toReport, tcLine, taCodeLines, I, tnCodeLines, toReg - #IF .F. - LOCAL toReport AS CL_REPORT OF 'FOXBIN2PRG.PRG' - #ENDIF + #If .F. + Local toReport As CL_REPORT Of 'FOXBIN2PRG.PRG' + #Endif - TRY - LOCAL llBloqueEncontrado, X, lnPos, lnPos2, lcValue, lnLenPropName, laProps(1) + Try + Local llBloqueEncontrado, X, lnPos, lnPos2, lcValue, lnLenPropName, laProps(1) - IF LOWER( LEFT(tcLine, 10) ) == 'platform="' - llBloqueEncontrado = .T. - lnLastPos = 1 - tcLine = ' ' + tcLine + If Lower( Left(tcLine, 10) ) == 'platform="' + llBloqueEncontrado = .T. + lnLastPos = 1 + tcLine = ' ' + tcLine - FOR X = 1 TO AMEMBERS( laProps, toReg, 0 ) - laProps(m.X) = ' ' + laProps(m.X) - lnPos = AT( LOWER(laProps(m.X)) + '="', tcLine ) + For X = 1 To Amembers( laProps, toReg, 0 ) + laProps(m.X) = ' ' + laProps(m.X) + lnPos = At( Lower(laProps(m.X)) + '="', tcLine ) - IF lnPos > 0 - lnLenPropName = LEN(laProps(m.X)) - lnPos2 = AT( '"', SUBSTR( tcLine, lnPos + lnLenPropName + 2 ) ) - lcValue = SUBSTR( tcLine, lnPos + lnLenPropName + 2, lnPos2 - 1 ) + If lnPos > 0 + lnLenPropName = Len(laProps(m.X)) + lnPos2 = At( '"', Substr( tcLine, lnPos + lnLenPropName + 2 ) ) + lcValue = Substr( tcLine, lnPos + lnLenPropName + 2, lnPos2 - 1 ) - IF laProps(m.X) == ' NAME' AND NOT EMPTY(lcValue) - lcValue = THIS.denormalizeXMLValue(lcValue) - ENDIF + If laProps(m.X) == ' NAME' And Not Empty(lcValue) + lcValue = This.denormalizeXMLValue(lcValue) + Endif - ADDPROPERTY( toReg, laProps(m.X), lcValue ) - ENDIF - ENDFOR + AddProperty( toReg, laProps(m.X), lcValue ) + Endif + Endfor - ENDIF + Endif - CATCH TO loEx - IF THIS.n_Debug > 0 AND _VFP.STARTMODE = 0 - SET STEP ON - ENDIF + Catch To loEx + If This.n_Debug > 0 And _vfp.StartMode = 0 + Set Step On + Endif - THROW + Throw - FINALLY - RELEASE toReport, tcLine, taCodeLines, I, tnCodeLines, toReg ; - , X, lnPos, lnPos2, lcValue, lnLenPropName, laProps - ENDTRY + Finally + Release toReport, tcLine, taCodeLines, I, tnCodeLines, toReg ; + , X, lnPos, lnPos2, lcValue, lnLenPropName, laProps + Endtry - RETURN llBloqueEncontrado - ENDPROC + Return llBloqueEncontrado + Endproc - PROCEDURE analyzeCodeBlock_Reportes - *------------------------------------------------------ - *-- Analiza el bloque - *------------------------------------------------------ - LPARAMETERS toReport, tcLine, taCodeLines, I, tnCodeLines + Procedure analyzeCodeBlock_Reportes +*------------------------------------------------------ +*-- Analiza el bloque +*------------------------------------------------------ + Lparameters toReport, tcLine, taCodeLines, I, tnCodeLines - #IF .F. - LOCAL toReport AS CL_REPORT OF 'FOXBIN2PRG.PRG' - #ENDIF + #If .F. + Local toReport As CL_REPORT Of 'FOXBIN2PRG.PRG' + #Endif - TRY - LOCAL llBloqueEncontrado, lcComment, lcMetadatos, luValor ; - , laPropsAndValues(1,2), lnPropsAndValues_Count ; - , loReg + Try + Local llBloqueEncontrado, lcComment, lcMetadatos, luValor ; + , laPropsAndValues(1,2), lnPropsAndValues_Count ; + , loReg - IF LEFT( tcLine, LEN(C_TAG_REPORTE) + 1 ) == '<' + C_TAG_REPORTE + '' - llBloqueEncontrado = .T. - loReg = NULL + If Left( tcLine, Len(C_TAG_REPORTE) + 1 ) == '<' + C_TAG_REPORTE + '' + llBloqueEncontrado = .T. + loReg = Null - WITH THIS AS c_conversor_prg_a_frx OF 'FOXBIN2PRG.PRG' - SCATTER MEMO BLANK NAME loReg + With This As c_conversor_prg_a_frx Of 'FOXBIN2PRG.PRG' + Scatter Memo Blank Name loReg - FOR I = m.I + 1 TO tnCodeLines - lcComment = '' - .set_Line( @tcLine, @taCodeLines, m.I ) + For I = m.I + 1 To tnCodeLines + lcComment = '' + .set_Line( @tcLine, @taCodeLines, m.I ) - DO CASE - CASE LEFT( tcLine, LEN(C_TAG_REPORTE_F) ) == C_TAG_REPORTE_F - I = m.I + 1 - EXIT + Do Case + Case Left( tcLine, Len(C_TAG_REPORTE_F) ) == C_TAG_REPORTE_F + I = m.I + 1 + Exit - CASE .analyzeCodeBlock_platform( toReport, @tcLine, @taCodeLines, @m.I, @tnCodeLines, @loReg ) + Case .analyzeCodeBlock_platform( toReport, @tcLine, @taCodeLines, @m.I, @tnCodeLines, @loReg ) - CASE .analyzeCodeBlock_CDATA_inline( toReport, @tcLine, @taCodeLines, @m.I, tnCodeLines, @loReg, 'picture' ) + Case .analyzeCodeBlock_CDATA_inline( toReport, @tcLine, @taCodeLines, @m.I, tnCodeLines, @loReg, 'picture' ) - CASE .analyzeCodeBlock_CDATA_inline( toReport, @tcLine, @taCodeLines, @m.I, tnCodeLines, @loReg, 'tag' ) - *-- ARREGLO ALGUNOS VALORES CAMBIADOS AL TEXTUALIZAR - DO CASE - CASE loReg.ObjType == "1" - loReg.TAG = .decode_SpecialCodes_1_31( loReg.TAG ) - CASE INLIST(loReg.ObjType, "25", "26") && Dataenvironment, cursors and relations - loReg.TAG = IIF( EMPTY( CHRTRAN( loReg.TAG, CR_LF+C_TAB, '') ), '', SUBSTR(loReg.TAG,3) ) && Quito el ENTER agregado antes - OTHERWISE - loReg.TAG = .decode_SpecialCodes_1_31( loReg.TAG ) - ENDCASE + Case .analyzeCodeBlock_CDATA_inline( toReport, @tcLine, @taCodeLines, @m.I, tnCodeLines, @loReg, 'tag' ) +*-- ARREGLO ALGUNOS VALORES CAMBIADOS AL TEXTUALIZAR + Do Case + Case loReg.ObjType == "1" + loReg.Tag = .decode_SpecialCodes_1_31( loReg.Tag ) + Case Inlist(loReg.ObjType, "25", "26") && Dataenvironment, cursors and relations + loReg.Tag = Iif( Empty( Chrtran( loReg.Tag, CR_LF+C_TAB, '') ), '', Substr(loReg.Tag,3) ) && Quito el ENTER agregado antes + Otherwise + loReg.Tag = .decode_SpecialCodes_1_31( loReg.Tag ) + Endcase - CASE .analyzeCodeBlock_CDATA_inline( toReport, @tcLine, @taCodeLines, @m.I, tnCodeLines, @loReg, 'tag2' ) - *-- ARREGLO ALGUNOS VALORES CAMBIADOS AL TEXTUALIZAR - IF NOT INLIST(loReg.ObjType,"5","6","8") - loReg.TAG2 = STRCONV( loReg.TAG2,14 ) - ENDIF + Case .analyzeCodeBlock_CDATA_inline( toReport, @tcLine, @taCodeLines, @m.I, tnCodeLines, @loReg, 'tag2' ) +*-- ARREGLO ALGUNOS VALORES CAMBIADOS AL TEXTUALIZAR + If Not Inlist(loReg.ObjType,"5","6","8") + loReg.TAG2 = Strconv( loReg.TAG2,14 ) + Endif - CASE .analyzeCodeBlock_CDATA_inline( toReport, @tcLine, @taCodeLines, @m.I, tnCodeLines, @loReg, 'penred' ) + Case .analyzeCodeBlock_CDATA_inline( toReport, @tcLine, @taCodeLines, @m.I, tnCodeLines, @loReg, 'penred' ) - CASE .analyzeCodeBlock_CDATA_inline( toReport, @tcLine, @taCodeLines, @m.I, tnCodeLines, @loReg, 'style' ) + Case .analyzeCodeBlock_CDATA_inline( toReport, @tcLine, @taCodeLines, @m.I, tnCodeLines, @loReg, 'style' ) - CASE .analyzeCodeBlock_CDATA_inline( toReport, @tcLine, @taCodeLines, @m.I, tnCodeLines, @loReg, 'expr' ) + Case .analyzeCodeBlock_CDATA_inline( toReport, @tcLine, @taCodeLines, @m.I, tnCodeLines, @loReg, 'expr' ) - CASE .analyzeCodeBlock_CDATA_inline( toReport, @tcLine, @taCodeLines, @m.I, tnCodeLines, @loReg, 'supexpr' ) + Case .analyzeCodeBlock_CDATA_inline( toReport, @tcLine, @taCodeLines, @m.I, tnCodeLines, @loReg, 'supexpr' ) - CASE .analyzeCodeBlock_CDATA_inline( toReport, @tcLine, @taCodeLines, @m.I, tnCodeLines, @loReg, 'comment' ) + Case .analyzeCodeBlock_CDATA_inline( toReport, @tcLine, @taCodeLines, @m.I, tnCodeLines, @loReg, 'comment' ) - CASE .analyzeCodeBlock_CDATA_inline( toReport, @tcLine, @taCodeLines, @m.I, tnCodeLines, @loReg, 'user' ) + Case .analyzeCodeBlock_CDATA_inline( toReport, @tcLine, @taCodeLines, @m.I, tnCodeLines, @loReg, 'user' ) - ENDCASE + Endcase - ENDFOR - ENDWITH && THIS + Endfor + Endwith && THIS - I = m.I - 1 - toReport.ADD( loReg ) - ENDIF + I = m.I - 1 + toReport.Add( loReg ) + Endif - CATCH TO loEx - IF THIS.n_Debug > 0 AND _VFP.STARTMODE = 0 - SET STEP ON - ENDIF + Catch To loEx + If This.n_Debug > 0 And _vfp.StartMode = 0 + Set Step On + Endif - THROW + Throw - FINALLY - loReg = NULL - RELEASE lcComment, lcMetadatos, luValor, laPropsAndValues, lnPropsAndValues_Count, loReg + Finally + loReg = Null + Release lcComment, lcMetadatos, luValor, laPropsAndValues, lnPropsAndValues_Count, loReg - ENDTRY + Endtry - RETURN llBloqueEncontrado - ENDPROC + Return llBloqueEncontrado + Endproc -ENDDEFINE && CLASS c_conversor_prg_a_frx AS c_conversor_prg_a_bin +Enddefine && CLASS c_conversor_prg_a_frx AS c_conversor_prg_a_bin -DEFINE CLASS c_conversor_prg_a_dbf AS c_conversor_prg_a_bin - #IF .F. - LOCAL THIS AS c_conversor_prg_a_dbf OF 'FOXBIN2PRG.PRG' - #ENDIF - _MEMBERDATA = [] ; +Define Class c_conversor_prg_a_dbf As c_conversor_prg_a_bin + #If .F. + Local This As c_conversor_prg_a_dbf Of 'FOXBIN2PRG.PRG' + #Endif + _MemberData = [] ; + [] ; + [] ; + [] ; @@ -12650,429 +12662,432 @@ DEFINE CLASS c_conversor_prg_a_dbf AS c_conversor_prg_a_bin c_Type = 'DB2' - PROCEDURE convert - *--------------------------------------------------------------------------------------------------- - * PARÁMETROS: (v=Pasar por valor | @=Pasar por referencia) (!=Obligatorio | ?=Opcional) (IN/OUT) - * toTable (!@ OUT) Objeto generado de clase CL_TABLE con la información leida del texto - * toEx (!@ OUT) Objeto con información del error - * toFoxBin2Prg (v! IN ) Referencia al objeto principal - *--------------------------------------------------------------------------------------------------- - LPARAMETERS toTable, toEx AS EXCEPTION, toFoxBin2Prg - DODEFAULT( @toTable, @toEx, @toFoxBin2Prg ) + Procedure convert +*--------------------------------------------------------------------------------------------------- +* PARÁMETROS: (v=Pasar por valor | @=Pasar por referencia) (!=Obligatorio | ?=Opcional) (IN/OUT) +* toTable (!@ OUT) Objeto generado de clase CL_TABLE con la información leida del texto +* toEx (!@ OUT) Objeto con información del error +* toFoxBin2Prg (v! IN ) Referencia al objeto principal +*--------------------------------------------------------------------------------------------------- + Lparameters toTable, toEx As Exception, toFoxBin2Prg + DoDefault( @toTable, @toEx, @toFoxBin2Prg ) - #IF .F. - LOCAL toTable AS CL_DBF_TABLE OF 'FOXBIN2PRG.PRG' - LOCAL toFoxBin2Prg AS c_foxbin2prg OF 'FOXBIN2PRG.PRG' - #ENDIF + #If .F. + Local toTable As CL_DBF_TABLE Of 'FOXBIN2PRG.PRG' + Local toFoxBin2Prg As c_foxbin2prg Of 'FOXBIN2PRG.PRG' + #Endif - TRY - LOCAL lnCodError, loEx AS EXCEPTION, laCodeLines(1), lnCodeLines, laLineasExclusion(1), lnBloquesExclusion, I ; - , lnIDInputFile, lnFileCount, laConfig(1), lcConfigItem, lc_DBF_Conversion_Support, lcAlterTable ; - , loLang as CL_LANG OF 'FOXBIN2PRG.PRG' ; - , lcTempDBC, llImportData ; - , loDBF_CFG AS CL_DBF_CFG OF 'FOXBIN2PRG.PRG' - STORE 0 TO lnCodError, lnCodeLines + Try + Local lnCodError, loEx As Exception, laCodeLines(1), lnCodeLines, laLineasExclusion(1), lnBloquesExclusion, I ; + , lnIDInputFile, lnFileCount, laConfig(1), lcConfigItem, lc_DBF_Conversion_Support, lcAlterTable ; + , loLang As CL_LANG Of 'FOXBIN2PRG.PRG' ; + , lcTempDBC, llImportData ; + , loDBF_CFG As CL_DBF_CFG Of 'FOXBIN2PRG.PRG' + Store 0 To lnCodError, lnCodeLines - WITH THIS AS c_conversor_prg_a_dbf OF 'FOXBIN2PRG.PRG' - lnIDInputFile = toFoxBin2Prg.n_ProcessedFiles - loLang = _SCREEN.o_FoxBin2Prg_Lang + With This As c_conversor_prg_a_dbf Of 'FOXBIN2PRG.PRG' + lnIDInputFile = toFoxBin2Prg.n_ProcessedFiles + loLang = _Screen.o_FoxBin2Prg_Lang - *-- If table CFG exists, use it for DBF-specific configuration. FDBOZZO. 2014/06/15 - lnFileCount = toFoxBin2Prg.get_DBF_Configuration( FORCEEXT(.c_InputFile, 'DBF'), @loDBF_CFG, .T. ) - lcTempDBC = FORCEPATH( '_FB2P', JUSTPATH(.c_OutputFile) ) +*-- If table CFG exists, use it for DBF-specific configuration. FDBOZZO. 2014/06/15 + lnFileCount = toFoxBin2Prg.get_DBF_Configuration( Forceext(.c_InputFile, 'DBF'), @loDBF_CFG, .T. ) + lcTempDBC = Forcepath( '_FB2P', Justpath(.c_OutputFile) ) - DO CASE - CASE lnFileCount = 1 AND loDBF_CFG.DBF_Conversion_Support > 0 AND NOT INLIST(loDBF_CFG.DBF_Conversion_Support, 2, 8) - WITH toFoxBin2Prg - ERROR (TEXTMERGE(loLang.C_FILE_NAME_IS_NOT_SUPPORTED_LOC)) - ENDWITH + Do Case + Case lnFileCount = 1 And loDBF_CFG.DBF_Conversion_Support > 0 And Not Inlist(loDBF_CFG.DBF_Conversion_Support, 2, 8) + With toFoxBin2Prg + Error (Textmerge(loLang.C_FILE_NAME_IS_NOT_SUPPORTED_LOC)) + Endwith - CASE lnFileCount = 1 AND loDBF_CFG.DBF_Conversion_Support > 0 && Implica 2 u 8 - llImportData = (loDBF_CFG.DBF_Conversion_Support = 8) + Case lnFileCount = 1 And loDBF_CFG.DBF_Conversion_Support > 0 && Implica 2 u 8 + llImportData = (loDBF_CFG.DBF_Conversion_Support = 8) - CASE toFoxBin2Prg.DBF_Conversion_Support = 8 && TXT2BIN (DATA IMPORT) - llImportData = .T. + Case toFoxBin2Prg.DBF_Conversion_Support = 8 && TXT2BIN (DATA IMPORT) + llImportData = .T. - CASE toFoxBin2Prg.DBF_Conversion_Support <> 2 - WITH toFoxBin2Prg - ERROR (TEXTMERGE(loLang.C_FILE_NAME_IS_NOT_SUPPORTED_LOC)) - ENDWITH + Case toFoxBin2Prg.DBF_Conversion_Support <> 2 + With toFoxBin2Prg + Error (Textmerge(loLang.C_FILE_NAME_IS_NOT_SUPPORTED_LOC)) + Endwith - OTHERWISE - * Asume llImportData = .F. + Otherwise +* Asume llImportData = .F. - ENDCASE + Endcase - IF NOT toFoxBin2Prg.l_ProcessFiles THEN - *-- addProcessedFile( tcFile, tcInOutType, tcProcessed, tcHasErrors, tcSupported, tcExpanded ) - IF toFoxBin2Prg.addProcessedFile( .c_OutputFile, 'O', 'P1', 'E0', 'S1', 'X0' ) THEN - toFoxBin2Prg.updateProcessedFile() - ENDIF + If Not toFoxBin2Prg.l_ProcessFiles Then +*-- addProcessedFile( tcFile, tcInOutType, tcProcessed, tcHasErrors, tcSupported, tcExpanded ) + If toFoxBin2Prg.addProcessedFile( .c_OutputFile, 'O', 'P1', 'E0', 'S1', 'X0' ) Then + toFoxBin2Prg.updateProcessedFile() + Endif - EXIT && Si se indicó no procesar, se sale aquí. (Modo de simulación) - ENDIF + Exit && Si se indicó no procesar, se sale aquí. (Modo de simulación) + Endif - C_FB2PRG_CODE = FILETOSTR( .c_InputFile ) - lnCodeLines = ALINES( laCodeLines, C_FB2PRG_CODE ) + C_FB2PRG_CODE = Filetostr( .c_InputFile ) + lnCodeLines = Alines( laCodeLines, C_FB2PRG_CODE ) - toFoxBin2Prg.doBackup( .F., .T., '', '', '' ) + toFoxBin2Prg.doBackup( .F., .T., '', '', '' ) - *-- Identifico el inicio/fin de bloque, campos e índices de la tabla - .identifyCodeBlocks( @laCodeLines, lnCodeLines, @laLineasExclusion, lnBloquesExclusion, @toTable ) - - DO CASE - CASE toFoxBin2Prg.c_SimulateError = 'SIMERR_I1' - ERROR 'InputFile Error Simulation' - CASE toFoxBin2Prg.c_SimulateError = 'SIMERR_I0' - .writeErrorLog( '*** SIMULATED ERROR' ) - ENDCASE - - IF .l_Error - .writeLog( '*** ERRORS found - Generation Cancelled' ) - EXIT - ENDIF +*-- Identifico el inicio/fin de bloque, campos e índices de la tabla + .identifyCodeBlocks( @laCodeLines, lnCodeLines, @laLineasExclusion, lnBloquesExclusion, @toTable ) - toFoxBin2Prg.updateProcessedFile( lnIDInputFile ) - .writeBinaryFile_STRUCTURE( @toTable, @toFoxBin2Prg, @lcAlterTable ) + Do Case + Case toFoxBin2Prg.c_SimulateError = 'SIMERR_I1' + Error 'InputFile Error Simulation' + Case toFoxBin2Prg.c_SimulateError = 'SIMERR_I0' + .writeErrorLog( '*** SIMULATED ERROR' ) + Endcase - IF llImportData AND lnCodeLines > 1 AND toTable._I > 1 THEN - *-- Identifico los registros de la tabla y los agrego - I = toTable._I - 1 - toTable.analyzeCodeBlock( C_TABLE_I, @laCodeLines, @m.I, lnCodeLines, @toFoxBin2Prg ) - ENDIF + If .l_Error + .writeLog( '*** ERRORS found - Generation Cancelled' ) + Exit + Endif - IF NOT EMPTY(lcAlterTable) - EXECSCRIPT(lcAlterTable) - ENDIF - - .writeBinaryFile_INDEXES( @toTable, @toFoxBin2Prg ) - - ENDWITH && THIS - - - CATCH TO loEx - lnCodError = loEx.ERRORNO - - IF THIS.n_Debug > 0 AND _VFP.STARTMODE = 0 - SET STEP ON - ENDIF + toFoxBin2Prg.updateProcessedFile( lnIDInputFile ) + .writeBinaryFile_STRUCTURE( @toTable, @toFoxBin2Prg, @lcAlterTable ) - THROW + If llImportData And lnCodeLines > 1 And toTable._I > 1 Then +*-- Identifico los registros de la tabla y los agrego + I = toTable._I - 1 + toTable.analyzeCodeBlock( C_TABLE_I, @laCodeLines, @m.I, lnCodeLines, @toFoxBin2Prg ) - FINALLY - USE IN (SELECT("TABLABIN")) - USE IN (SELECT(JUSTSTEM(THIS.c_OutputFile))) + Endif - IF NOT EMPTY(lcTempDBC) - CLOSE DATABASES - ERASE (FORCEEXT(lcTempDBC,'DBC')) - ERASE (FORCEEXT(lcTempDBC,'DCT')) - ERASE (FORCEEXT(lcTempDBC,'DCX')) - ENDIF + If Not Empty(lcAlterTable) + Execscript(lcAlterTable) + Endif + + .writeBinaryFile_INDEXES( @toTable, @toFoxBin2Prg ) + + Endwith && THIS + + + Catch To loEx + lnCodError = loEx.ErrorNo + + If This.n_Debug > 0 And _vfp.StartMode = 0 + Set Step On + Endif - STORE NULL TO loDBF_CFG - RELEASE loDBF_CFG + Throw - ENDTRY + Finally + Use In (Select("TABLABIN")) + Use In (Select(Juststem(This.c_OutputFile))) - RETURN lnCodError - ENDPROC + If Not Empty(lcTempDBC) + Close Databases + Erase (Forceext(lcTempDBC,'DBC')) + Erase (Forceext(lcTempDBC,'DCT')) + Erase (Forceext(lcTempDBC,'DCX')) + Endif + Store Null To loDBF_CFG + Release loDBF_CFG + Endtry - PROCEDURE writeBinaryFile_STRUCTURE - LPARAMETERS toTable, toFoxBin2Prg, tcAlterTable - *-- ----------------------------------------------------------------------------------------------------------- - #IF .F. - LOCAL toTable AS CL_DBF_TABLE OF 'FOXBIN2PRG.PRG' - LOCAL toFoxBin2Prg AS c_foxbin2prg OF 'FOXBIN2PRG.PRG' - #ENDIF + Return lnCodError + Endproc - TRY - LOCAL I, lnCodError, loEx AS EXCEPTION ; - , loField AS CL_DBF_FIELD OF 'FOXBIN2PRG.PRG' ; - , loDBFUtils AS CL_DBF_UTILS OF 'FOXBIN2PRG.PRG' ; - , lcCreateTable, lcLongDec, lcFieldDef, lcIndex, lcTempDBC, lnDataSessionID, lnSelect - - WITH THIS AS c_conversor_prg_a_dbf OF 'FOXBIN2PRG.PRG' - STORE NULL TO loField, loIndex, loDBFUtils - loDBFUtils = CREATEOBJECT('CL_DBF_UTILS') - STORE 0 TO lnCodError - STORE '' TO lcIndex, lcFieldDef, tcAlterTable - lnDataSessionID = toFoxBin2Prg.DATASESSIONID - *-- addProcessedFile( tcFile, tcInOutType, tcProcessed, tcHasErrors, tcSupported, tcExpanded ) - toFoxBin2Prg.addProcessedFile( .c_OutputFile, 'O', 'P1', 'E0', 'S1', 'X0' ) - - DO CASE - CASE toFoxBin2Prg.c_SimulateError = 'SIMERR_O1' - ERROR 'OutputFile Error Simulation' - ENDCASE + Procedure writeBinaryFile_STRUCTURE + Lparameters toTable, toFoxBin2Prg, tcAlterTable +*-- ----------------------------------------------------------------------------------------------------------- + #If .F. + Local toTable As CL_DBF_TABLE Of 'FOXBIN2PRG.PRG' + Local toFoxBin2Prg As c_foxbin2prg Of 'FOXBIN2PRG.PRG' + #Endif - ERASE (FORCEEXT(.c_OutputFile, 'DBF')) - ERASE (FORCEEXT(.c_OutputFile, 'FPT')) - ERASE (FORCEEXT(.c_OutputFile, 'CDX')) + Try + Local I, lnCodError, loEx As Exception ; + , loField As CL_DBF_FIELD Of 'FOXBIN2PRG.PRG' ; + , loDBFUtils As CL_DBF_UTILS Of 'FOXBIN2PRG.PRG' ; + , lcCreateTable, lcLongDec, lcFieldDef, lcIndex, lcTempDBC, lnDataSessionID, lnSelect - IF EMPTY(toTable._Database) - lcCreateTable = 'CREATE TABLE "' + .c_OutputFile + '" FREE CodePage=' + toTable._CodePage + ' ;' + CR_LF + ' (' - ELSE - lcTempDBC = FORCEPATH( '_FB2P', JUSTPATH(.c_OutputFile) ) - CREATE DATABASE ( lcTempDBC ) - lcCreateTable = 'CREATE TABLE "' + .c_OutputFile + '" CodePage=' + toTable._CodePage + ' ;' + CR_LF + ' (' - ENDIF + With This As c_conversor_prg_a_dbf Of 'FOXBIN2PRG.PRG' + Store Null To loField, loIndex, loDBFUtils + loDBFUtils = Createobject('CL_DBF_UTILS') - toTable._TableName = .c_OutputFile + Store 0 To lnCodError + Store '' To lcIndex, lcFieldDef, tcAlterTable + lnDataSessionID = toFoxBin2Prg.DataSessionId - *-- Conformo los campos - FOR EACH loField IN toTable._Fields FOXOBJECT - lcLongDec = '' +*-- addProcessedFile( tcFile, tcInOutType, tcProcessed, tcHasErrors, tcSupported, tcExpanded ) + toFoxBin2Prg.addProcessedFile( .c_OutputFile, 'O', 'P1', 'E0', 'S1', 'X0' ) - IF NOT EMPTY(lcFieldDef) - lcFieldDef = lcFieldDef + ';' + CR_LF + ', ' - ENDIF + Do Case + Case toFoxBin2Prg.c_SimulateError = 'SIMERR_O1' + Error 'OutputFile Error Simulation' + Endcase - *-- Nombre, Tipo - lcFieldDef = lcFieldDef + '"' + loField._Name + '" ' + loField._Type + Erase (Forceext(.c_OutputFile, 'DBF')) + Erase (Forceext(.c_OutputFile, 'FPT')) + Erase (Forceext(.c_OutputFile, 'CDX')) - *-- Longitud - IF INLIST( loField._Type, 'C', 'N', 'F', 'Q', 'V' ) - lcLongDec = lcLongDec + '(' + loField._Width - ENDIF + If Empty(toTable._Database) + lcCreateTable = 'CREATE TABLE "' + .c_OutputFile + '" FREE CodePage=' + toTable._CodePage + ' ;' + CR_LF + ' (' + Else + lcTempDBC = Forcepath( '_FB2P', Justpath(.c_OutputFile) ) + Create Database ( lcTempDBC ) + lcCreateTable = 'CREATE TABLE "' + .c_OutputFile + '" CodePage=' + toTable._CodePage + ' ;' + CR_LF + ' (' + Endif - *-- Decimales - IF INLIST( loField._Type, 'N', 'F' ) AND loField._Decimals > '0' OR loField._Type = 'B' - IF EMPTY(lcLongDec) - lcLongDec = lcLongDec + '(' - ELSE - lcLongDec = lcLongDec + ',' - ENDIF - lcLongDec = lcLongDec + loField._Decimals - ENDIF - - IF NOT EMPTY(lcLongDec) - lcLongDec = lcLongDec + ')' - ENDIF - - lcFieldDef = lcFieldDef + lcLongDec - - *-- Null - lcFieldDef = lcFieldDef + IIF( loField._Null = '.T.', ' NULL', ' NOT NULL' ) - - *-- NoCPTran - IF loField._NoCPTran = '.T.' - lcFieldDef = lcFieldDef + ' NOCPTRANS' - ENDIF - - *-- AutoInc - IF loField._AutoInc_NextVal <> '0' - IF toFoxBin2Prg.n_ExcludeDBFAutoincNextval = 1 - *-- If AutoIncNextVal is excluded from text, then assign 1 for allowing regeneration - *-- of DBF with this field. - tcAlterTable = tcAlterTable + ' ;' + CR_LF + ' ALTER ' + loField._Name + ' ' + loField._Type + ' AUTOINC NEXTVAL 1 STEP ' + loField._AutoInc_Step - ELSE - tcAlterTable = tcAlterTable + ' ;' + CR_LF + ' ALTER ' + loField._Name + ' ' + loField._Type + ' AUTOINC NEXTVAL ' + loField._AutoInc_NextVal + ' STEP ' + loField._AutoInc_Step - ENDIF - ENDIF - - loField = NULL - ENDFOR - - lcCreateTable = lcCreateTable + lcFieldDef + ')' - EXECSCRIPT(lcCreateTable) - - IF NOT EMPTY(tcAlterTable) - tcAlterTable = 'ALTER TABLE "' + .c_OutputFile + '" ' + tcAlterTable - ENDIF - - *-- Hook para permitir ejecución externa (por ejemplo, para rellenar la tabla con datos) - IF NOT EMPTY(toFoxBin2Prg.run_AfterCreateTable) - lnSelect = SELECT() - DO (toFoxBin2Prg.run_AfterCreateTable) WITH (lnDataSessionID), (.c_OutputFile), (toTable) - SET DATASESSION TO (lnDataSessionID) && Por las dudas externamente se cambie - SELECT (lnSelect) - ENDIF + toTable._TableName = .c_OutputFile - ENDWITH && THIS +*-- Conformo los campos + For Each loField In toTable._Fields FoxObject + lcLongDec = '' + If Not Empty(lcFieldDef) + lcFieldDef = lcFieldDef + ';' + CR_LF + ', ' + Endif - CATCH TO loEx - lnCodError = loEx.ERRORNO - toFoxBin2Prg.updateProcessedFile( 0, '', '', 'E1' ) - loEx.USERVALUE = 'lcFieldDef="' + TRANSFORM(lcFieldDef) + '"' + CR_LF ; - + 'lcCreateTable="' + TRANSFORM(lcCreateTable) + '"' +*-- Nombre, Tipo + lcFieldDef = lcFieldDef + '"' + loField._Name + '" ' + loField._Type - IF THIS.n_Debug > 0 AND _VFP.STARTMODE = 0 - SET STEP ON - ENDIF +*-- Longitud + If Inlist( loField._Type, 'C', 'N', 'F', 'Q', 'V' ) + lcLongDec = lcLongDec + '(' + loField._Width + Endif - THROW +*-- Decimales + If Inlist( loField._Type, 'N', 'F' ) And loField._Decimals > '0' Or loField._Type = 'B' + If Empty(lcLongDec) + lcLongDec = lcLongDec + '(' + Else + lcLongDec = lcLongDec + ',' + Endif + lcLongDec = lcLongDec + loField._Decimals + Endif + + If Not Empty(lcLongDec) + lcLongDec = lcLongDec + ')' + Endif + + lcFieldDef = lcFieldDef + lcLongDec + +*-- Null + lcFieldDef = lcFieldDef + Iif( loField._Null = '.T.', ' NULL', ' NOT NULL' ) + +*-- NoCPTran + If loField._NoCPTran = '.T.' + lcFieldDef = lcFieldDef + ' NOCPTRANS' + Endif + +*-- AutoInc + If loField._AutoInc_NextVal <> '0' + If toFoxBin2Prg.n_ExcludeDBFAutoincNextval = 1 +*-- If AutoIncNextVal is excluded from text, then assign 1 for allowing regeneration +*-- of DBF with this field. + tcAlterTable = tcAlterTable + ' ;' + CR_LF + ' ALTER ' + loField._Name + ' ' + loField._Type + ' AUTOINC NEXTVAL 1 STEP ' + loField._AutoInc_Step + Else + tcAlterTable = tcAlterTable + ' ;' + CR_LF + ' ALTER ' + loField._Name + ' ' + loField._Type + ' AUTOINC NEXTVAL ' + loField._AutoInc_NextVal + ' STEP ' + loField._AutoInc_Step + Endif + Endif - FINALLY - STORE NULL TO loField, loDBFUtils - RELEASE I, loField, loDBFUtils ; - , lcCreateTable, lcLongDec, lcFieldDef, lcTempDBC, lnDataSessionID, lnSelect + loField = Null + Endfor - ENDTRY + lcCreateTable = lcCreateTable + lcFieldDef + ')' + Execscript(lcCreateTable) + + If Not Empty(tcAlterTable) + tcAlterTable = 'ALTER TABLE "' + .c_OutputFile + '" ' + tcAlterTable + Endif + +*-- Hook para permitir ejecución externa (por ejemplo, para rellenar la tabla con datos) + If Not Empty(toFoxBin2Prg.run_AfterCreateTable) + lnSelect = Select() + Do (toFoxBin2Prg.run_AfterCreateTable) With (lnDataSessionID), (.c_OutputFile), (toTable) + Set DataSession To (lnDataSessionID) && Por las dudas externamente se cambie + Select (lnSelect) + Endif - RETURN lnCodError - ENDPROC + Endwith && THIS + Catch To loEx + lnCodError = loEx.ErrorNo + toFoxBin2Prg.updateProcessedFile( 0, '', '', 'E1' ) + loEx.UserValue = 'lcFieldDef="' + Transform(lcFieldDef) + '"' + CR_LF ; + + 'lcCreateTable="' + Transform(lcCreateTable) + '"' - PROCEDURE writeBinaryFile_INDEXES - LPARAMETERS toTable, toFoxBin2Prg - *-- ----------------------------------------------------------------------------------------------------------- - #IF .F. - LOCAL toTable AS CL_DBF_TABLE OF 'FOXBIN2PRG.PRG' - LOCAL toFoxBin2Prg AS c_foxbin2prg OF 'FOXBIN2PRG.PRG' - #ENDIF + If This.n_Debug > 0 And _vfp.StartMode = 0 + Set Step On + Endif - TRY - LOCAL I, lnCodError, loEx AS EXCEPTION ; - , loIndex AS CL_DBF_INDEX OF 'FOXBIN2PRG.PRG' ; - , loDBFUtils AS CL_DBF_UTILS OF 'FOXBIN2PRG.PRG' ; - , ldLastUpdate + Throw - WITH THIS AS c_conversor_prg_a_dbf OF 'FOXBIN2PRG.PRG' - STORE NULL TO loIndex - STORE 0 TO lnCodError - STORE '' TO lcIndex - loDBFUtils = CREATEOBJECT('CL_DBF_UTILS') + Finally + Store Null To loField, loDBFUtils + Release I, loField, loDBFUtils ; + , lcCreateTable, lcLongDec, lcFieldDef, lcTempDBC, lnDataSessionID, lnSelect - *-- Regenero los índices - FOR EACH loIndex IN toTable._Indexes FOXOBJECT - lcIndex = 'INDEX ON ' + loIndex._Key + ' TAG ' + loIndex._TagName + Endtry - IF loIndex._TagType = 'BINARY' - lcIndex = lcIndex + ' BINARY' - ELSE - lcIndex = lcIndex + ' COLLATE "' + loIndex._Collate + '"' + Return lnCodError + Endproc - IF NOT EMPTY(loIndex._Filter) - lcIndex = lcIndex + ' FOR ' + loIndex._Filter - ENDIF - lcIndex = lcIndex + ' ' + loIndex._Order - IF NOT INLIST(loIndex._TagType, 'NORMAL', 'REGULAR') - *-- Si es PRIMARY lo cambio a CANDIDATE y luego lo recodifico - lcIndex = lcIndex + ' ' + STRTRAN( loIndex._TagType, 'PRIMARY', 'CANDIDATE' ) - ENDIF - ENDIF + Procedure writeBinaryFile_INDEXES + Lparameters toTable, toFoxBin2Prg +*-- ----------------------------------------------------------------------------------------------------------- + #If .F. + Local toTable As CL_DBF_TABLE Of 'FOXBIN2PRG.PRG' + Local toFoxBin2Prg As c_foxbin2prg Of 'FOXBIN2PRG.PRG' + #Endif - &lcIndex. - ENDFOR + Try + Local I, lnCodError, loEx As Exception ; + , loIndex As CL_DBF_INDEX Of 'FOXBIN2PRG.PRG' ; + , loDBFUtils As CL_DBF_UTILS Of 'FOXBIN2PRG.PRG' ; + , ldLastUpdate + With This As c_conversor_prg_a_dbf Of 'FOXBIN2PRG.PRG' + Store Null To loIndex + Store 0 To lnCodError + Store '' To lcIndex + loDBFUtils = Createobject('CL_DBF_UTILS') - USE IN (SELECT(JUSTSTEM(.c_OutputFile))) +*-- Regenero los índices + For Each loIndex In toTable._Indexes FoxObject + lcIndex = 'INDEX ON ' + loIndex._Key + ' TAG ' + loIndex._TagName - *-- La actualización de la fecha sirve para evitar diferencias al regenerar el DBF - IF toFoxBin2Prg.l_ClearDBFLastUpdate THEN - ldLastUpdate = EVALUATE( '{^2013/11/04}' ) - ELSE - ldLastUpdate = EVALUATE( '{^' + toTable._LastUpdate + '}' ) - ENDIF + If loIndex._TagType = 'BINARY' + lcIndex = lcIndex + ' BINARY' + Else + lcIndex = lcIndex + ' COLLATE "' + loIndex._Collate + '"' - loDBFUtils.write_DBC_BackLink( .c_OutputFile, toTable._Database, ldLastUpdate ) + If Not Empty(loIndex._Filter) + lcIndex = lcIndex + ' FOR ' + loIndex._Filter + Endif - toFoxBin2Prg.updateProcessedFile() - ENDWITH && THIS + lcIndex = lcIndex + ' ' + loIndex._Order + If Not Inlist(loIndex._TagType, 'NORMAL', 'REGULAR') +*-- Si es PRIMARY lo cambio a CANDIDATE y luego lo recodifico + lcIndex = lcIndex + ' ' + Strtran( loIndex._TagType, 'PRIMARY', 'CANDIDATE' ) + Endif + Endif - CATCH TO loEx - lnCodError = loEx.ERRORNO - toFoxBin2Prg.updateProcessedFile( 0, '', '', 'E1' ) - loEx.USERVALUE = 'lcIndex="' + TRANSFORM(lcIndex) + '"' - IF THIS.n_Debug > 0 AND _VFP.STARTMODE = 0 - SET STEP ON - ENDIF + &lcIndex. + Endfor - THROW - FINALLY - STORE NULL TO loIndex - RELEASE I, loIndex, lcIndex, ldLastUpdate + Use In (Select(Juststem(.c_OutputFile))) - ENDTRY +*-- La actualización de la fecha sirve para evitar diferencias al regenerar el DBF + If toFoxBin2Prg.l_ClearDBFLastUpdate Then + ldLastUpdate = Evaluate( '{^2013/11/04}' ) + Else + ldLastUpdate = Evaluate( '{^' + toTable._LastUpdate + '}' ) + Endif - RETURN lnCodError - ENDPROC + loDBFUtils.write_DBC_BackLink( .c_OutputFile, toTable._Database, ldLastUpdate ) + toFoxBin2Prg.updateProcessedFile() + Endwith && THIS - PROCEDURE identifyCodeBlocks - *-------------------------------------------------------------------------------------------------------------- - * PARÁMETROS: (v=Pasar por valor | @=Pasar por referencia) (!=Obligatorio | ?=Opcional) (IN/OUT) - * taCodeLines (!@ IN ) El array con las líneas del código donde buscar - * tnCodeLines (!@ IN ) Cantidad de líneas de código - * taLineasExclusion (@! IN ) Array unidimensional con un .T. o .F. según la línea sea de exclusión o no - * tnBloquesExclusion (@? IN ) Sin uso - * toTable (@? OUT) Objeto con toda la información de la tabla analizada - *-------------------------------------------------------------------------------------------------------------- - LPARAMETERS taCodeLines, tnCodeLines, taLineasExclusion, tnBloquesExclusion, toTable + Catch To loEx + lnCodError = loEx.ErrorNo + toFoxBin2Prg.updateProcessedFile( 0, '', '', 'E1' ) + loEx.UserValue = 'lcIndex="' + Transform(lcIndex) + '"' - EXTERNAL ARRAY taCodeLines, taLineasExclusion + If This.n_Debug > 0 And _vfp.StartMode = 0 + Set Step On + Endif - #IF .F. - LOCAL toTable AS CL_DBF_TABLE OF 'FOXBIN2PRG.PRG' - #ENDIF + Throw - TRY - LOCAL I, lc_Comentario, lcLine, llFoxBin2Prg_Completed, llBloqueTable_Completed - STORE 0 TO I + Finally + Store Null To loIndex + Release I, loIndex, lcIndex, ldLastUpdate - WITH THIS AS c_conversor_prg_a_dbf OF 'FOXBIN2PRG.PRG' - .c_Type = UPPER(JUSTEXT(.c_OutputFile)) + Endtry - IF tnCodeLines > 1 - toTable = NULL - toTable = CREATEOBJECT('CL_DBF_TABLE') + Return lnCodError + Endproc - FOR I = 1 TO tnCodeLines - .set_Line( @lcLine, @taCodeLines, m.I ) - DO CASE - CASE .lineIsOnlyCommentAndNoMetadata( @lcLine, @lc_Comentario ) && Vacía o solo Comentarios - LOOP - CASE NOT llFoxBin2Prg_Completed AND .analyzeCodeBlock_FoxBin2Prg( toTable, @lcLine, @taCodeLines, @m.I, tnCodeLines ) - llFoxBin2Prg_Completed = .T. + Procedure identifyCodeBlocks +*-------------------------------------------------------------------------------------------------------------- +* PARÁMETROS: (v=Pasar por valor | @=Pasar por referencia) (!=Obligatorio | ?=Opcional) (IN/OUT) +* taCodeLines (!@ IN ) El array con las líneas del código donde buscar +* tnCodeLines (!@ IN ) Cantidad de líneas de código +* taLineasExclusion (@! IN ) Array unidimensional con un .T. o .F. según la línea sea de exclusión o no +* tnBloquesExclusion (@? IN ) Sin uso +* toTable (@? OUT) Objeto con toda la información de la tabla analizada +*-------------------------------------------------------------------------------------------------------------- + Lparameters taCodeLines, tnCodeLines, taLineasExclusion, tnBloquesExclusion, toTable - CASE NOT llBloqueTable_Completed AND toTable.analyzeCodeBlock( @lcLine, @taCodeLines, @m.I, tnCodeLines ) - llBloqueTable_Completed = .T. - EXIT + External Array taCodeLines, taLineasExclusion - ENDCASE - ENDFOR - ENDIF - ENDWITH && THIS + #If .F. + Local toTable As CL_DBF_TABLE Of 'FOXBIN2PRG.PRG' + #Endif - CATCH TO loEx - IF THIS.n_Debug > 0 AND _VFP.STARTMODE = 0 - SET STEP ON - ENDIF + Try + Local I, lc_Comentario, lcLine, llFoxBin2Prg_Completed, llBloqueTable_Completed + Store 0 To I - THROW + With This As c_conversor_prg_a_dbf Of 'FOXBIN2PRG.PRG' + .c_Type = Upper(Justext(.c_OutputFile)) - FINALLY - RELEASE taCodeLines, tnCodeLines, taLineasExclusion, tnBloquesExclusion, toTable ; - , I, lc_Comentario, lcLine, llFoxBin2Prg_Completed, llBloqueTable_Completed - ENDTRY + If tnCodeLines > 1 + toTable = Null + toTable = Createobject('CL_DBF_TABLE') - RETURN - ENDPROC + For I = 1 To tnCodeLines + .set_Line( @lcLine, @taCodeLines, m.I ) + Do Case + Case .lineIsOnlyCommentAndNoMetadata( @lcLine, @lc_Comentario ) && Vacía o solo Comentarios + Loop -ENDDEFINE && CLASS c_conversor_prg_a_dbf AS c_conversor_prg_a_bin + Case Not llFoxBin2Prg_Completed And .analyzeCodeBlock_FoxBin2Prg( toTable, @lcLine, @taCodeLines, @m.I, tnCodeLines ) + llFoxBin2Prg_Completed = .T. + Case Not llBloqueTable_Completed And toTable.analyzeCodeBlock( @lcLine, @taCodeLines, @m.I, tnCodeLines ) + llBloqueTable_Completed = .T. + Exit -DEFINE CLASS c_conversor_prg_a_dbc AS c_conversor_prg_a_bin - #IF .F. - LOCAL THIS AS c_conversor_prg_a_dbc OF 'FOXBIN2PRG.PRG' - #ENDIF - _MEMBERDATA = [] ; + Endcase + Endfor + Endif + Endwith && THIS + + Catch To loEx + If This.n_Debug > 0 And _vfp.StartMode = 0 + Set Step On + Endif + + Throw + + Finally + Release taCodeLines, tnCodeLines, taLineasExclusion, tnBloquesExclusion, toTable ; + , I, lc_Comentario, lcLine, llFoxBin2Prg_Completed, llBloqueTable_Completed + Endtry + + Return + Endproc + + +Enddefine && CLASS c_conversor_prg_a_dbf AS c_conversor_prg_a_bin + + +* SF, Analyse, just locate +Define Class c_conversor_prg_a_dbc As c_conversor_prg_a_bin + #If .F. + Local This As c_conversor_prg_a_dbc Of 'FOXBIN2PRG.PRG' + #Endif + _MemberData = [] ; + [] ; + [] ; + [] ; @@ -13085,501 +13100,501 @@ DEFINE CLASS c_conversor_prg_a_dbc AS c_conversor_prg_a_bin c_Type = 'DC2' - PROCEDURE convert - *--------------------------------------------------------------------------------------------------- - * PARÁMETROS: (v=Pasar por valor | @=Pasar por referencia) (!=Obligatorio | ?=Opcional) (IN/OUT) - * toDatabase (!@ OUT) Objeto generado de clase CL_DBC con la información leida del texto - * toEx (!@ OUT) Objeto con información del error - * toFoxBin2Prg (v! IN ) Referencia al objeto principal - *--------------------------------------------------------------------------------------------------- - LPARAMETERS toDatabase, toEx AS EXCEPTION, toFoxBin2Prg - DODEFAULT( @toDatabase, @toEx, @toFoxBin2Prg ) - - #IF .F. - LOCAL toDatabase AS CL_DBC OF 'FOXBIN2PRG.PRG' - LOCAL toFoxBin2Prg AS c_foxbin2prg OF 'FOXBIN2PRG.PRG' - #ENDIF - - TRY - LOCAL lnCodError, loEx AS EXCEPTION, loReg, lcLine, laCodeLines(1), lnCodeLines, lcBaseFilename, lcInputFile ; - , lcMemberType, lcMemberName, lcLastMemberType, lnIDInputFile ; - , laLineasExclusion(1), lnBloquesExclusion, I, X, Y, laFiles(1,5), lnFileCount, lcTempTxt, laLines(1) ; - , loLang as CL_LANG OF 'FOXBIN2PRG.PRG' - STORE 0 TO lnCodError, lnCodeLines, lnFileCount - STORE '' TO lcLine, laLines, laCodeLines, lcBaseFilename, lcMemberType, lcLastMemberType, lcMemberName, lcInputFile - STORE NULL TO loReg, toDatabase - - WITH THIS AS c_conversor_prg_a_dbc OF 'FOXBIN2PRG.PRG' - loLang = _SCREEN.o_FoxBin2Prg_Lang - toDatabase = CREATEOBJECT('CL_DBC') - lnIDInputFile = toFoxBin2Prg.n_ProcessedFiles - - IF toFoxBin2Prg.n_UseClassPerFile > 0 AND toFoxBin2Prg.l_RedirectClassPerFileToMain - C_FB2PRG_CODE = FILETOSTR( .c_InputFile ) - lnCodeLines = ALINES( laCodeLines, C_FB2PRG_CODE ) - C_FB2PRG_CODE = '' - - *-- Quito la última parte del cierre de para anexar lo intermedio - FOR X = 1 TO lnCodeLines - IF C_DATABASE_F $ laCodeLines(m.X) THEN - EXIT - ENDIF - C_FB2PRG_CODE = C_FB2PRG_CODE + laCodeLines(m.X) + CR_LF - ENDFOR - - .updateProgressbar( 'Identifying Header Blocks...', 1, lnCodeLines, 1 ) - .identifyHeaderBlocks( @laCodeLines, lnCodeLines, @laLineasExclusion, lnBloquesExclusion, @toDatabase, @toFoxBin2Prg ) - - .updateProgressbar( 'Loading Code...', 2, lnCodeLines, 1 ) - - *-- Esto crea la máscara de búsqueda "Database.*.*.ext" para encontrar las partes - *-- con la sintaxis "Database.MemberType.MemberName.ext" - lcBaseFilename = JUSTSTEM( JUSTSTEM( JUSTSTEM(.c_InputFile) ) ) - lcInputFile = ADDBS( JUSTPATH(.c_InputFile) ) + lcBaseFilename + '.*.*.' + JUSTEXT(.c_InputFile) - lnFileCount = ADIR( laFiles, lcInputFile, "", 1 ) - - *-- Busco "storedprocedures" y le pongo "z" al inicio - FOR I = 1 TO lnFileCount - IF LOWER( laFiles(m.I,1)) == lcBaseFilename + '.database.storedproceduressource.' + JUSTEXT(.c_InputFile) THEN - laFiles(m.I,1) = lcBaseFilename + '.zdatabase.storedproceduressource.' + JUSTEXT(.c_InputFile) - EXIT - ENDIF - ENDFOR - - ASORT( laFiles, 1, -1, 0, 1) && "zstoredprocedures" quedará al final - - *-- Busco "zstoredprocedures" y le quito la "z" del inicio - FOR I = 1 TO lnFileCount - IF LOWER( laFiles(m.I,1)) == lcBaseFilename + '.zdatabase.storedproceduressource.' + JUSTEXT(.c_InputFile) THEN - laFiles(m.I,1) = lcBaseFilename + '.database.storedproceduressource.' + JUSTEXT(.c_InputFile) - EXIT - ENDIF - ENDFOR - - FOR I = 1 TO lnFileCount - lcInputFile_Class = FORCEPATH( JUSTSTEM( laFiles(m.I,1) ), JUSTPATH( .c_InputFile ) ) + '.' + JUSTEXT( .c_InputFile ) - lcMemberType = LOWER( GETWORDNUM( JUSTFNAME( lcInputFile_Class ), 2, '.' ) ) - lcMemberName = LOWER( GETWORDNUM( JUSTFNAME( lcInputFile_Class ), 3, '.' ) ) - - IF toFoxBin2Prg.l_ProcessFiles THEN - IF NOT lcMemberType == lcLastMemberType THEN - IF NOT EMPTY(lcLastMemberType) THEN - *-- Cambio de tipo de miembro, fin del anterior (connection, table, view, storedprocedures) - DO CASE - CASE lcLastMemberType == 'connection' - C_FB2PRG_CODE = C_FB2PRG_CODE + C_TAB + C_CONNECTIONS_F + CR_LF - CASE lcLastMemberType == 'table' - C_FB2PRG_CODE = C_FB2PRG_CODE + C_TAB + C_TABLES_F + CR_LF - CASE lcLastMemberType == 'view' - C_FB2PRG_CODE = C_FB2PRG_CODE + C_TAB + C_VIEWS_F + CR_LF - CASE lcLastMemberType == 'database' - *C_FB2PRG_CODE = C_FB2PRG_CODE + CR_LF + CR_LF - ENDCASE - - lcLastMemberType = '' - ENDIF - - *-- Cambio de tipo de miembro, inicio del actual (connection, table, view, storedprocedures) - DO CASE - CASE lcMemberType == 'connection' - C_FB2PRG_CODE = C_FB2PRG_CODE + CR_LF + CR_LF + C_TAB + C_CONNECTIONS_I + CR_LF - CASE lcMemberType == 'table' - C_FB2PRG_CODE = C_FB2PRG_CODE + CR_LF + CR_LF + C_TAB + C_TABLES_I + CR_LF - CASE lcMemberType == 'view' - C_FB2PRG_CODE = C_FB2PRG_CODE + CR_LF + CR_LF + C_TAB + C_VIEWS_I + CR_LF - CASE lcMemberType == 'database' - C_FB2PRG_CODE = C_FB2PRG_CODE + CR_LF + CR_LF - ENDCASE - ENDIF - ENDIF - - *-- Verificación de los Miembros, si son Externos y se indicó chequearlos - IF toFoxBin2Prg.l_ClassPerFileCheck AND EMPTY(toFoxBin2Prg.c_ClassOperationType) ; - AND ASCAN( toDatabase._ExternalClasses, lcMemberType + '.' + lcMemberName, 1, 0, 1, 1+2+4 ) = 0 - .writeLog( C_TAB + '- ' + loLang.C_OUTER_MEMBER_DOES_NOT_MATCH_INNER_MEMBERS_LOC + ' [' + lcInputFile_Class + ']' ) - .writeErrorLog( C_TAB + '- ' + loLang.C_WARNING_LOC + ' ' + loLang.C_OUTER_MEMBER_DOES_NOT_MATCH_INNER_MEMBERS_LOC + ' [' + lcInputFile_Class + ']' ) - LOOP && Salteo este miembro porque no concuerda con los anotados - ENDIF - - .writeLog( C_TAB + C_TAB + '+ ' + loLang.C_INCLUDING_MEMBER_LOC + ' ' + JUSTFNAME( lcInputFile_Class ) ) - - *-- addProcessedFile( tcFile, tcInOutType, tcProcessed, tcHasErrors, tcSupported, tcExpanded ) - IF toFoxBin2Prg.addProcessedFile( lcInputFile_Class, 'I', 'P1', 'E0', 'S1', 'X1' ) THEN - toFoxBin2Prg.updateProcessedFile() - ENDIF - - IF toFoxBin2Prg.l_ProcessFiles THEN - toFoxBin2Prg.normalizeFileCapitalization( .T., lcInputFile_Class ) - lcTempTxt = FILETOSTR( lcInputFile_Class ) - - FOR Y = 7 TO ALINES( laLines, lcTempTxt ) - C_FB2PRG_CODE = C_FB2PRG_CODE + laLines(m.Y) + CR_LF - ENDFOR - - lcLastMemberType = lcMemberType - ENDIF - ENDFOR - - IF NOT toFoxBin2Prg.l_ProcessFiles THEN - *-- addProcessedFile( tcFile, tcInOutType, tcProcessed, tcHasErrors, tcSupported, tcExpanded ) - IF toFoxBin2Prg.addProcessedFile( .c_OutputFile, 'O', 'P1', 'E0', 'S1', 'X0' ) THEN - toFoxBin2Prg.updateProcessedFile() - ENDIF - - EXIT && Si se indicó no procesar, se sale aquí. (Modo de simulación) - ENDIF - - IF NOT EMPTY(lcLastMemberType) THEN - *-- Cambio de tipo de miembro, fin del anterior (connection, table, view, storedprocedures) - DO CASE - CASE lcLastMemberType == 'connection' - C_FB2PRG_CODE = C_FB2PRG_CODE + C_TAB + C_CONNECTIONS_F + CR_LF - CASE lcLastMemberType == 'table' - C_FB2PRG_CODE = C_FB2PRG_CODE + C_TAB + C_TABLES_F + CR_LF - CASE lcLastMemberType == 'view' - C_FB2PRG_CODE = C_FB2PRG_CODE + C_TAB + C_VIEWS_F + CR_LF - CASE lcLastMemberType == 'database' - *C_FB2PRG_CODE = C_FB2PRG_CODE + CR_LF + CR_LF - ENDCASE - ENDIF - - *-- Agrego la última parte con el cierre de - FOR X = m.X TO lnCodeLines - C_FB2PRG_CODE = C_FB2PRG_CODE + laCodeLines(m.X) + CR_LF - ENDFOR - - lnCodeLines = ALINES( laCodeLines, C_FB2PRG_CODE ) - ELSE - *-- No es clase por archivo, o no se quiere redireccionar a Main. - IF NOT toFoxBin2Prg.l_ProcessFiles THEN - *-- addProcessedFile( tcFile, tcInOutType, tcProcessed, tcHasErrors, tcSupported, tcExpanded ) - IF toFoxBin2Prg.addProcessedFile( .c_OutputFile, 'O', 'P1', 'E0', 'S1', 'X0' ) THEN - toFoxBin2Prg.updateProcessedFile() - ENDIF - - EXIT && Si se indicó no procesar, se sale aquí. (Modo de simulación) - ENDIF - - C_FB2PRG_CODE = FILETOSTR( .c_InputFile ) - - lnCodeLines = ALINES( laCodeLines, C_FB2PRG_CODE ) - - .updateProgressbar( 'Identifying Header Blocks...', 1, lnCodeLines, 1 ) - .identifyHeaderBlocks( @laCodeLines, lnCodeLines, @laLineasExclusion, lnBloquesExclusion, @toDatabase, @toFoxBin2Prg ) - - ENDIF - - *-- Identifico el inicio/fin de bloque, definición, cabecera y cuerpo del reporte - .updateProgressbar( 'Identifying Code Blocks...', 1, 2, 1 ) - .identifyCodeBlocks( @laCodeLines, lnCodeLines, @laLineasExclusion, lnBloquesExclusion, @toDatabase, @toFoxBin2Prg ) - - DO CASE - CASE toFoxBin2Prg.c_SimulateError = 'SIMERR_I1' - ERROR 'InputFile Error Simulation' - CASE toFoxBin2Prg.c_SimulateError = 'SIMERR_I0' - .writeErrorLog( '*** SIMULATED ERROR' ) - ENDCASE - - IF .l_Error - .writeLog( '*** ERRORS found - Generation Cancelled' ) - EXIT - ENDIF - - toFoxBin2Prg.updateProcessedFile( lnIDInputFile ) - .updateProgressbar( 'Generating Binary...', 2, 2, 1 ) - toFoxBin2Prg.doBackup( .F., .T., '', '', '' ) - *.createTable() - .writeBinaryFile( @toDatabase, @toFoxBin2Prg ) - ENDWITH && THIS - - - CATCH TO loEx - lnCodError = loEx.ERRORNO - - IF THIS.n_Debug > 0 AND _VFP.STARTMODE = 0 - SET STEP ON - ENDIF - - THROW - - FINALLY - USE IN (SELECT("TABLABIN")) - ENDTRY - - RETURN lnCodError - ENDPROC - - - - PROCEDURE writeBinaryFile - LPARAMETERS toDatabase, toFoxBin2Prg - *-- ----------------------------------------------------------------------------------------------------------- - #IF .F. - LOCAL toDatabase AS CL_DBC OF 'FOXBIN2PRG.PRG' - LOCAL toFoxBin2Prg AS c_foxbin2prg OF 'FOXBIN2PRG.PRG' - #ENDIF - - TRY - LOCAL lnCodError, lcEventsFile - lnCodError = 0 - - *-- addProcessedFile( tcFile, tcInOutType, tcProcessed, tcHasErrors, tcSupported, tcExpanded ) - toFoxBin2Prg.addProcessedFile( THIS.c_OutputFile, 'O', 'P1', 'E0', 'S1', 'X0' ) - - DO CASE - CASE toFoxBin2Prg.c_SimulateError = 'SIMERR_O1' - ERROR 'OutputFile Error Simulation' - ENDCASE - - IF NOT EMPTY(toDatabase._DBCEventFilename) - IF LEFT(toDatabase._DBCEventFilename,1) = '.' THEN - lcEventsFile = ADDBS( JUSTPATH(.c_InputFile) ) + toDatabase._DBCEventFilename - ELSE - lcEventsFile = toDatabase._DBCEventFilename - ENDIF - IF FILE(lcEventsFile) THEN - lcEventsFile = '' - ELSE - STRTOFILE( '', lcEventsFile ) - ENDIF + Procedure convert +*--------------------------------------------------------------------------------------------------- +* PARÁMETROS: (v=Pasar por valor | @=Pasar por referencia) (!=Obligatorio | ?=Opcional) (IN/OUT) +* toDatabase (!@ OUT) Objeto generado de clase CL_DBC con la información leida del texto +* toEx (!@ OUT) Objeto con información del error +* toFoxBin2Prg (v! IN ) Referencia al objeto principal +*--------------------------------------------------------------------------------------------------- + Lparameters toDatabase, toEx As Exception, toFoxBin2Prg + DoDefault( @toDatabase, @toEx, @toFoxBin2Prg ) + + #If .F. + Local toDatabase As CL_DBC Of 'FOXBIN2PRG.PRG' + Local toFoxBin2Prg As c_foxbin2prg Of 'FOXBIN2PRG.PRG' + #Endif + + Try + Local lnCodError, loEx As Exception, loReg, lcLine, laCodeLines(1), lnCodeLines, lcBaseFilename, lcInputFile ; + , lcMemberType, lcMemberName, lcLastMemberType, lnIDInputFile ; + , laLineasExclusion(1), lnBloquesExclusion, I, X, Y, laFiles(1,5), lnFileCount, lcTempTxt, laLines(1) ; + , loLang As CL_LANG Of 'FOXBIN2PRG.PRG' + Store 0 To lnCodError, lnCodeLines, lnFileCount + Store '' To lcLine, laLines, laCodeLines, lcBaseFilename, lcMemberType, lcLastMemberType, lcMemberName, lcInputFile + Store Null To loReg, toDatabase + + With This As c_conversor_prg_a_dbc Of 'FOXBIN2PRG.PRG' + loLang = _Screen.o_FoxBin2Prg_Lang + toDatabase = Createobject('CL_DBC') + lnIDInputFile = toFoxBin2Prg.n_ProcessedFiles + + If toFoxBin2Prg.n_UseClassPerFile > 0 And toFoxBin2Prg.l_RedirectClassPerFileToMain + C_FB2PRG_CODE = Filetostr( .c_InputFile ) + lnCodeLines = Alines( laCodeLines, C_FB2PRG_CODE ) + C_FB2PRG_CODE = '' + +*-- Quito la última parte del cierre de para anexar lo intermedio + For X = 1 To lnCodeLines + If C_DATABASE_F $ laCodeLines(m.X) Then + Exit + Endif + C_FB2PRG_CODE = C_FB2PRG_CODE + laCodeLines(m.X) + CR_LF + Endfor + + .updateProgressbar( 'Identifying Header Blocks...', 1, lnCodeLines, 1 ) + .identifyHeaderBlocks( @laCodeLines, lnCodeLines, @laLineasExclusion, lnBloquesExclusion, @toDatabase, @toFoxBin2Prg ) + + .updateProgressbar( 'Loading Code...', 2, lnCodeLines, 1 ) + +*-- Esto crea la máscara de búsqueda "Database.*.*.ext" para encontrar las partes +*-- con la sintaxis "Database.MemberType.MemberName.ext" + lcBaseFilename = Juststem( Juststem( Juststem(.c_InputFile) ) ) + lcInputFile = Addbs( Justpath(.c_InputFile) ) + lcBaseFilename + '.*.*.' + Justext(.c_InputFile) + lnFileCount = Adir( laFiles, lcInputFile, "", 1 ) + +*-- Busco "storedprocedures" y le pongo "z" al inicio + For I = 1 To lnFileCount + If Lower( laFiles(m.I,1)) == lcBaseFilename + '.database.storedproceduressource.' + Justext(.c_InputFile) Then + laFiles(m.I,1) = lcBaseFilename + '.zdatabase.storedproceduressource.' + Justext(.c_InputFile) + Exit + Endif + Endfor + + Asort( laFiles, 1, -1, 0, 1) && "zstoredprocedures" quedará al final + +*-- Busco "zstoredprocedures" y le quito la "z" del inicio + For I = 1 To lnFileCount + If Lower( laFiles(m.I,1)) == lcBaseFilename + '.zdatabase.storedproceduressource.' + Justext(.c_InputFile) Then + laFiles(m.I,1) = lcBaseFilename + '.database.storedproceduressource.' + Justext(.c_InputFile) + Exit + Endif + Endfor + + For I = 1 To lnFileCount + lcInputFile_Class = Forcepath( Juststem( laFiles(m.I,1) ), Justpath( .c_InputFile ) ) + '.' + Justext( .c_InputFile ) + lcMemberType = Lower( Getwordnum( Justfname( lcInputFile_Class ), 2, '.' ) ) + lcMemberName = Lower( Getwordnum( Justfname( lcInputFile_Class ), 3, '.' ) ) + + If toFoxBin2Prg.l_ProcessFiles Then + If Not lcMemberType == lcLastMemberType Then + If Not Empty(lcLastMemberType) Then +*-- Cambio de tipo de miembro, fin del anterior (connection, table, view, storedprocedures) + Do Case + Case lcLastMemberType == 'connection' + C_FB2PRG_CODE = C_FB2PRG_CODE + C_TAB + C_CONNECTIONS_F + CR_LF + Case lcLastMemberType == 'table' + C_FB2PRG_CODE = C_FB2PRG_CODE + C_TAB + C_TABLES_F + CR_LF + Case lcLastMemberType == 'view' + C_FB2PRG_CODE = C_FB2PRG_CODE + C_TAB + C_VIEWS_F + CR_LF + Case lcLastMemberType == 'database' +*C_FB2PRG_CODE = C_FB2PRG_CODE + CR_LF + CR_LF + Endcase + + lcLastMemberType = '' + Endif + +*-- Cambio de tipo de miembro, inicio del actual (connection, table, view, storedprocedures) + Do Case + Case lcMemberType == 'connection' + C_FB2PRG_CODE = C_FB2PRG_CODE + CR_LF + CR_LF + C_TAB + C_CONNECTIONS_I + CR_LF + Case lcMemberType == 'table' + C_FB2PRG_CODE = C_FB2PRG_CODE + CR_LF + CR_LF + C_TAB + C_TABLES_I + CR_LF + Case lcMemberType == 'view' + C_FB2PRG_CODE = C_FB2PRG_CODE + CR_LF + CR_LF + C_TAB + C_VIEWS_I + CR_LF + Case lcMemberType == 'database' + C_FB2PRG_CODE = C_FB2PRG_CODE + CR_LF + CR_LF + Endcase + Endif + Endif + +*-- Verificación de los Miembros, si son Externos y se indicó chequearlos + If toFoxBin2Prg.l_ClassPerFileCheck And Empty(toFoxBin2Prg.c_ClassOperationType) ; + AND Ascan( toDatabase._ExternalClasses, lcMemberType + '.' + lcMemberName, 1, 0, 1, 1+2+4 ) = 0 + .writeLog( C_TAB + '- ' + loLang.C_OUTER_MEMBER_DOES_NOT_MATCH_INNER_MEMBERS_LOC + ' [' + lcInputFile_Class + ']' ) + .writeErrorLog( C_TAB + '- ' + loLang.C_WARNING_LOC + ' ' + loLang.C_OUTER_MEMBER_DOES_NOT_MATCH_INNER_MEMBERS_LOC + ' [' + lcInputFile_Class + ']' ) + Loop && Salteo este miembro porque no concuerda con los anotados + Endif + + .writeLog( C_TAB + C_TAB + '+ ' + loLang.C_INCLUDING_MEMBER_LOC + ' ' + Justfname( lcInputFile_Class ) ) + +*-- addProcessedFile( tcFile, tcInOutType, tcProcessed, tcHasErrors, tcSupported, tcExpanded ) + If toFoxBin2Prg.addProcessedFile( lcInputFile_Class, 'I', 'P1', 'E0', 'S1', 'X1' ) Then + toFoxBin2Prg.updateProcessedFile() + Endif + + If toFoxBin2Prg.l_ProcessFiles Then + toFoxBin2Prg.normalizeFileCapitalization( .T., lcInputFile_Class ) + lcTempTxt = Filetostr( lcInputFile_Class ) + + For Y = 7 To Alines( laLines, lcTempTxt ) + C_FB2PRG_CODE = C_FB2PRG_CODE + laLines(m.Y) + CR_LF + Endfor + + lcLastMemberType = lcMemberType + Endif + Endfor + + If Not toFoxBin2Prg.l_ProcessFiles Then +*-- addProcessedFile( tcFile, tcInOutType, tcProcessed, tcHasErrors, tcSupported, tcExpanded ) + If toFoxBin2Prg.addProcessedFile( .c_OutputFile, 'O', 'P1', 'E0', 'S1', 'X0' ) Then + toFoxBin2Prg.updateProcessedFile() + Endif + + Exit && Si se indicó no procesar, se sale aquí. (Modo de simulación) + Endif + + If Not Empty(lcLastMemberType) Then +*-- Cambio de tipo de miembro, fin del anterior (connection, table, view, storedprocedures) + Do Case + Case lcLastMemberType == 'connection' + C_FB2PRG_CODE = C_FB2PRG_CODE + C_TAB + C_CONNECTIONS_F + CR_LF + Case lcLastMemberType == 'table' + C_FB2PRG_CODE = C_FB2PRG_CODE + C_TAB + C_TABLES_F + CR_LF + Case lcLastMemberType == 'view' + C_FB2PRG_CODE = C_FB2PRG_CODE + C_TAB + C_VIEWS_F + CR_LF + Case lcLastMemberType == 'database' +*C_FB2PRG_CODE = C_FB2PRG_CODE + CR_LF + CR_LF + Endcase + Endif + +*-- Agrego la última parte con el cierre de + For X = m.X To lnCodeLines + C_FB2PRG_CODE = C_FB2PRG_CODE + laCodeLines(m.X) + CR_LF + Endfor + + lnCodeLines = Alines( laCodeLines, C_FB2PRG_CODE ) + Else +*-- No es clase por archivo, o no se quiere redireccionar a Main. + If Not toFoxBin2Prg.l_ProcessFiles Then +*-- addProcessedFile( tcFile, tcInOutType, tcProcessed, tcHasErrors, tcSupported, tcExpanded ) + If toFoxBin2Prg.addProcessedFile( .c_OutputFile, 'O', 'P1', 'E0', 'S1', 'X0' ) Then + toFoxBin2Prg.updateProcessedFile() + Endif + + Exit && Si se indicó no procesar, se sale aquí. (Modo de simulación) + Endif + + C_FB2PRG_CODE = Filetostr( .c_InputFile ) + + lnCodeLines = Alines( laCodeLines, C_FB2PRG_CODE ) + + .updateProgressbar( 'Identifying Header Blocks...', 1, lnCodeLines, 1 ) + .identifyHeaderBlocks( @laCodeLines, lnCodeLines, @laLineasExclusion, lnBloquesExclusion, @toDatabase, @toFoxBin2Prg ) + + Endif + +*-- Identifico el inicio/fin de bloque, definición, cabecera y cuerpo del reporte + .updateProgressbar( 'Identifying Code Blocks...', 1, 2, 1 ) + .identifyCodeBlocks( @laCodeLines, lnCodeLines, @laLineasExclusion, lnBloquesExclusion, @toDatabase, @toFoxBin2Prg ) + + Do Case + Case toFoxBin2Prg.c_SimulateError = 'SIMERR_I1' + Error 'InputFile Error Simulation' + Case toFoxBin2Prg.c_SimulateError = 'SIMERR_I0' + .writeErrorLog( '*** SIMULATED ERROR' ) + Endcase + + If .l_Error + .writeLog( '*** ERRORS found - Generation Cancelled' ) + Exit + Endif + + toFoxBin2Prg.updateProcessedFile( lnIDInputFile ) + .updateProgressbar( 'Generating Binary...', 2, 2, 1 ) + toFoxBin2Prg.doBackup( .F., .T., '', '', '' ) +*.createTable() + .writeBinaryFile( @toDatabase, @toFoxBin2Prg ) + Endwith && THIS + + + Catch To loEx + lnCodError = loEx.ErrorNo + + If This.n_Debug > 0 And _vfp.StartMode = 0 + Set Step On + Endif + + Throw + + Finally + Use In (Select("TABLABIN")) + Endtry + + Return lnCodError + Endproc + + + + Procedure writeBinaryFile + Lparameters toDatabase, toFoxBin2Prg +*-- ----------------------------------------------------------------------------------------------------------- + #If .F. + Local toDatabase As CL_DBC Of 'FOXBIN2PRG.PRG' + Local toFoxBin2Prg As c_foxbin2prg Of 'FOXBIN2PRG.PRG' + #Endif + + Try + Local lnCodError, lcEventsFile + lnCodError = 0 + +*-- addProcessedFile( tcFile, tcInOutType, tcProcessed, tcHasErrors, tcSupported, tcExpanded ) + toFoxBin2Prg.addProcessedFile( This.c_OutputFile, 'O', 'P1', 'E0', 'S1', 'X0' ) + + Do Case + Case toFoxBin2Prg.c_SimulateError = 'SIMERR_O1' + Error 'OutputFile Error Simulation' + Endcase + + If Not Empty(toDatabase._DBCEventFilename) + If Left(toDatabase._DBCEventFilename,1) = '.' Then + lcEventsFile = Addbs( Justpath(.c_InputFile) ) + toDatabase._DBCEventFilename + Else + lcEventsFile = toDatabase._DBCEventFilename + Endif + If File(lcEventsFile) Then + lcEventsFile = '' + Else + Strtofile( '', lcEventsFile ) + Endif - *-- Si no recompilo el EventFilename.prg, el EXE dará un error (aunque el PRG no) - COMPILE ( ADDBS( JUSTPATH( THIS.c_OutputFile ) ) + toDatabase._DBCEventFilename ) - ENDIF +*-- Si no recompilo el EventFilename.prg, el EXE dará un error (aunque el PRG no) + Compile ( Addbs( Justpath( This.c_OutputFile ) ) + toDatabase._DBCEventFilename ) + Endif - toDatabase.updateDBC( THIS.c_OutputFile ) + toDatabase.updateDBC( This.c_OutputFile ) - IF toFoxBin2Prg.l_Recompile - toFoxBin2Prg.compileFoxProBinary() - ENDIF + If toFoxBin2Prg.l_Recompile + toFoxBin2Prg.compileFoxProBinary() + Endif - toFoxBin2Prg.updateProcessedFile() + toFoxBin2Prg.updateProcessedFile() - CATCH TO loEx - lnCodError = loEx.ERRORNO - toFoxBin2Prg.updateProcessedFile( 0, '', '', 'E1' ) + Catch To loEx + lnCodError = loEx.ErrorNo + toFoxBin2Prg.updateProcessedFile( 0, '', '', 'E1' ) - IF THIS.n_Debug > 0 AND _VFP.STARTMODE = 0 - SET STEP ON - ENDIF + If This.n_Debug > 0 And _vfp.StartMode = 0 + Set Step On + Endif - THROW + Throw - FINALLY - IF NOT EMPTY(lcEventsFile) THEN - ERASE (lcEventsFile) - ERASE (FORCEEXT(lcEventsFile,'FXP')) - ENDIF + Finally + If Not Empty(lcEventsFile) Then + Erase (lcEventsFile) + Erase (Forceext(lcEventsFile,'FXP')) + Endif - ENDTRY + Endtry - RETURN lnCodError - ENDPROC + Return lnCodError + Endproc - PROCEDURE identifyHeaderBlocks - *-------------------------------------------------------------------------------------------------------------- - * PARÁMETROS: (v=Pasar por valor | @=Pasar por referencia) (!=Obligatorio | ?=Opcional) (IN/OUT) - * taCodeLines (@! IN ) El array con las líneas del código donde buscar - * tnCodeLines (@! IN ) Cantidad de líneas de código - * taLineasExclusion (@! IN ) Array unidimensional con un .T. o .F. según la línea sea de exclusión o no - * tnBloquesExclusion (@! IN ) Cantidad de bloques de exclusión - * toDatabase (@? OUT) Objeto con toda la información del módulo analizado - * toFoxBin2Prg (@? IN ) Referencia al objeto principal - *-------------------------------------------------------------------------------------------------------------- - * NOTA: - * Como identificador se usa el nombre de clase o de procedimiento, según corresponda. - *-------------------------------------------------------------------------------------------------------------- - LPARAMETERS taCodeLines, tnCodeLines, taLineasExclusion, tnBloquesExclusion, toDatabase, toFoxBin2Prg + Procedure identifyHeaderBlocks +*-------------------------------------------------------------------------------------------------------------- +* PARÁMETROS: (v=Pasar por valor | @=Pasar por referencia) (!=Obligatorio | ?=Opcional) (IN/OUT) +* taCodeLines (@! IN ) El array con las líneas del código donde buscar +* tnCodeLines (@! IN ) Cantidad de líneas de código +* taLineasExclusion (@! IN ) Array unidimensional con un .T. o .F. según la línea sea de exclusión o no +* tnBloquesExclusion (@! IN ) Cantidad de bloques de exclusión +* toDatabase (@? OUT) Objeto con toda la información del módulo analizado +* toFoxBin2Prg (@? IN ) Referencia al objeto principal +*-------------------------------------------------------------------------------------------------------------- +* NOTA: +* Como identificador se usa el nombre de clase o de procedimiento, según corresponda. +*-------------------------------------------------------------------------------------------------------------- + Lparameters taCodeLines, tnCodeLines, taLineasExclusion, tnBloquesExclusion, toDatabase, toFoxBin2Prg - EXTERNAL ARRAY taCodeLines, taLineasExclusion + External Array taCodeLines, taLineasExclusion - #IF .F. - LOCAL toDatabase AS CL_DBC OF 'FOXBIN2PRG.PRG' - LOCAL toFoxBin2Prg AS c_foxbin2prg OF 'FOXBIN2PRG.PRG' - #ENDIF + #If .F. + Local toDatabase As CL_DBC Of 'FOXBIN2PRG.PRG' + Local toFoxBin2Prg As c_foxbin2prg Of 'FOXBIN2PRG.PRG' + #Endif - TRY - LOCAL I, loEx AS EXCEPTION ; - , llFoxBin2Prg_Completed, llOLE_DEF_Completed, llINCLUDE_SCX_Completed, llLIBCOMMENT_Completed, llEXTERNAL_MEMBER_Completed ; - , lc_Comentario, lcProcedureAbierto, lcLine ; - , loClase AS CL_CLASE OF 'FOXBIN2PRG.PRG' + Try + Local I, loEx As Exception ; + , llFoxBin2Prg_Completed, llOLE_DEF_Completed, llINCLUDE_SCX_Completed, llLIBCOMMENT_Completed, llEXTERNAL_MEMBER_Completed ; + , lc_Comentario, lcProcedureAbierto, lcLine ; + , loClase As CL_CLASE Of 'FOXBIN2PRG.PRG' - WITH THIS AS c_conversor_prg_a_bin OF 'FOXBIN2PRG.PRG' - STORE '' TO lcProcedureAbierto + With This As c_conversor_prg_a_bin Of 'FOXBIN2PRG.PRG' + Store '' To lcProcedureAbierto - .c_Type = UPPER(JUSTEXT(.c_OutputFile)) + .c_Type = Upper(Justext(.c_OutputFile)) - IF tnCodeLines > 1 + If tnCodeLines > 1 - IF toFoxBin2Prg.n_UseClassPerFile > 0 AND toFoxBin2Prg.l_RedirectClassPerFileToMain - ELSE - llEXTERNAL_MEMBER_Completed = .T. - ENDIF + If toFoxBin2Prg.n_UseClassPerFile > 0 And toFoxBin2Prg.l_RedirectClassPerFileToMain + Else + llEXTERNAL_MEMBER_Completed = .T. + Endif - *-- Búsqueda del ID de inicio de bloque (DEFINE CLASS / PROCEDURE) - FOR I = 1 TO tnCodeLines - STORE '' TO lc_Comentario - .set_Line( @lcLine, @taCodeLines, m.I ) +*-- Búsqueda del ID de inicio de bloque (DEFINE CLASS / PROCEDURE) + For I = 1 To tnCodeLines + Store '' To lc_Comentario + .set_Line( @lcLine, @taCodeLines, m.I ) - DO CASE - CASE .lineIsOnlyCommentAndNoMetadata( @lcLine, @lc_Comentario ) && Excluida, vacía o solo Comentarios - LOOP + Do Case + Case .lineIsOnlyCommentAndNoMetadata( @lcLine, @lc_Comentario ) && Excluida, vacía o solo Comentarios + Loop - CASE NOT llFoxBin2Prg_Completed AND .analyzeCodeBlock_FoxBin2Prg( @toDatabase, @lcLine, @taCodeLines, @m.I, tnCodeLines ) - llFoxBin2Prg_Completed = .T. + Case Not llFoxBin2Prg_Completed And .analyzeCodeBlock_FoxBin2Prg( @toDatabase, @lcLine, @taCodeLines, @m.I, tnCodeLines ) + llFoxBin2Prg_Completed = .T. - CASE NOT llEXTERNAL_MEMBER_Completed AND .analyzeCodeBlock_EXTERNAL_MEMBER( @toDatabase, @lcLine, @taCodeLines, @m.I, tnCodeLines ) - *-- Puede haber varias clases externas + Case Not llEXTERNAL_MEMBER_Completed And .analyzeCodeBlock_EXTERNAL_MEMBER( @toDatabase, @lcLine, @taCodeLines, @m.I, tnCodeLines ) +*-- Puede haber varias clases externas - ENDCASE + Endcase - ENDFOR + Endfor - ENDIF - ENDWITH && THIS + Endif + Endwith && THIS - CATCH TO loEx - IF THIS.n_Debug > 0 AND _VFP.STARTMODE = 0 - SET STEP ON - ENDIF + Catch To loEx + If This.n_Debug > 0 And _vfp.StartMode = 0 + Set Step On + Endif - THROW + Throw - FINALLY - STORE NULL TO loClase - RELEASE taCodeLines, tnCodeLines, taLineasExclusion, tnBloquesExclusion, toDatabase, loClase, I ; - , llFoxBin2Prg_Completed, llOLE_DEF_Completed, llINCLUDE_SCX_Completed, llLIBCOMMENT_Completed ; - , lc_Comentario, lcProcedureAbierto, lcLine - ENDTRY + Finally + Store Null To loClase + Release taCodeLines, tnCodeLines, taLineasExclusion, tnBloquesExclusion, toDatabase, loClase, I ; + , llFoxBin2Prg_Completed, llOLE_DEF_Completed, llINCLUDE_SCX_Completed, llLIBCOMMENT_Completed ; + , lc_Comentario, lcProcedureAbierto, lcLine + Endtry - RETURN - ENDPROC + Return + Endproc - PROCEDURE identifyCodeBlocks - *-------------------------------------------------------------------------------------------------------------- - * PARÁMETROS: (v=Pasar por valor | @=Pasar por referencia) (!=Obligatorio | ?=Opcional) (IN/OUT) - * taCodeLines (!@ IN ) El array con las líneas del código donde buscar - * tnCodeLines (!@ IN ) Cantidad de líneas de código - * taLineasExclusion (@! IN ) Array unidimensional con un .T. o .F. según la línea sea de exclusión o no - * tnBloquesExclusion (@? IN ) Sin uso - * toDatabase (@! IN ) Objeto con toda la información de la base de datos analizada - * toFoxBin2Prg (v! IN ) Referencia al objeto principal - *-------------------------------------------------------------------------------------------------------------- - * NOTA: - * Como identificador se usa el nombre de clase o de procedimiento, según corresponda. - *-------------------------------------------------------------------------------------------------------------- - LPARAMETERS taCodeLines, tnCodeLines, taLineasExclusion, tnBloquesExclusion, toDatabase, toFoxBin2Prg + Procedure identifyCodeBlocks +*-------------------------------------------------------------------------------------------------------------- +* PARÁMETROS: (v=Pasar por valor | @=Pasar por referencia) (!=Obligatorio | ?=Opcional) (IN/OUT) +* taCodeLines (!@ IN ) El array con las líneas del código donde buscar +* tnCodeLines (!@ IN ) Cantidad de líneas de código +* taLineasExclusion (@! IN ) Array unidimensional con un .T. o .F. según la línea sea de exclusión o no +* tnBloquesExclusion (@? IN ) Sin uso +* toDatabase (@! IN ) Objeto con toda la información de la base de datos analizada +* toFoxBin2Prg (v! IN ) Referencia al objeto principal +*-------------------------------------------------------------------------------------------------------------- +* NOTA: +* Como identificador se usa el nombre de clase o de procedimiento, según corresponda. +*-------------------------------------------------------------------------------------------------------------- + Lparameters taCodeLines, tnCodeLines, taLineasExclusion, tnBloquesExclusion, toDatabase, toFoxBin2Prg - EXTERNAL ARRAY taCodeLines, taLineasExclusion + External Array taCodeLines, taLineasExclusion - #IF .F. - LOCAL toDatabase AS CL_DBC OF 'FOXBIN2PRG.PRG' - LOCAL toFoxBin2Prg AS c_foxbin2prg OF 'FOXBIN2PRG.PRG' - #ENDIF + #If .F. + Local toDatabase As CL_DBC Of 'FOXBIN2PRG.PRG' + Local toFoxBin2Prg As c_foxbin2prg Of 'FOXBIN2PRG.PRG' + #Endif - TRY - LOCAL I, lc_Comentario, lcLine, llFoxBin2Prg_Completed, llBloqueDatabase_Completed - STORE 0 TO I + Try + Local I, lc_Comentario, lcLine, llFoxBin2Prg_Completed, llBloqueDatabase_Completed + Store 0 To I - WITH THIS AS c_conversor_prg_a_dbc OF 'FOXBIN2PRG.PRG' - .c_Type = UPPER(JUSTEXT(.c_OutputFile)) + With This As c_conversor_prg_a_dbc Of 'FOXBIN2PRG.PRG' + .c_Type = Upper(Justext(.c_OutputFile)) - IF tnCodeLines > 1 + If tnCodeLines > 1 - FOR I = 1 TO tnCodeLines - .set_Line( @lcLine, @taCodeLines, m.I ) + For I = 1 To tnCodeLines + .set_Line( @lcLine, @taCodeLines, m.I ) - DO CASE - CASE .lineIsOnlyCommentAndNoMetadata( @lcLine, @lc_Comentario ) && Vacía o solo Comentarios - LOOP + Do Case + Case .lineIsOnlyCommentAndNoMetadata( @lcLine, @lc_Comentario ) && Vacía o solo Comentarios + Loop - CASE NOT llFoxBin2Prg_Completed AND .analyzeCodeBlock_FoxBin2Prg( toDatabase, @lcLine, @taCodeLines, @m.I, tnCodeLines ) - llFoxBin2Prg_Completed = .T. + Case Not llFoxBin2Prg_Completed And .analyzeCodeBlock_FoxBin2Prg( toDatabase, @lcLine, @taCodeLines, @m.I, tnCodeLines ) + llFoxBin2Prg_Completed = .T. - CASE NOT llBloqueDatabase_Completed AND toDatabase.analyzeCodeBlock( @lcLine, @taCodeLines, @m.I, tnCodeLines, @toFoxBin2Prg ) - llBloqueDatabase_Completed = .T. + Case Not llBloqueDatabase_Completed And toDatabase.analyzeCodeBlock( @lcLine, @taCodeLines, @m.I, tnCodeLines, @toFoxBin2Prg ) + llBloqueDatabase_Completed = .T. - ENDCASE - ENDFOR + Endcase + Endfor - .verify_EXTERNAL_MEMBERS( @toDatabase, @toFoxBin2Prg ) - ENDIF - ENDWITH && THIS + .verify_EXTERNAL_MEMBERS( @toDatabase, @toFoxBin2Prg ) + Endif + Endwith && THIS - CATCH TO loEx - IF THIS.n_Debug > 0 AND _VFP.STARTMODE = 0 - SET STEP ON - ENDIF + Catch To loEx + If This.n_Debug > 0 And _vfp.StartMode = 0 + Set Step On + Endif - THROW + Throw - FINALLY - RELEASE taCodeLines, tnCodeLines, taLineasExclusion, tnBloquesExclusion, toDatabase ; - , I, lc_Comentario, lcLine, llFoxBin2Prg_Completed, llBloqueDatabase_Completed - ENDTRY + Finally + Release taCodeLines, tnCodeLines, taLineasExclusion, tnBloquesExclusion, toDatabase ; + , I, lc_Comentario, lcLine, llFoxBin2Prg_Completed, llBloqueDatabase_Completed + Endtry - RETURN - ENDPROC + Return + Endproc - PROCEDURE verify_EXTERNAL_MEMBERS - *-------------------------------------------------------------------------------- - * Compara los miembros definidos en la cabecera con los miembros encontrados luego - *-------------------------------------------------------------------------------------------------------------- - * PARÁMETROS: (v=Pasar por valor | @=Pasar por referencia) (!=Obligatorio | ?=Opcional) (IN/OUT) - * toDatabase (@! IN ) Objeto con toda la información del módulo analizado - * toFoxBin2Prg (@! IN ) Referencia al objeto principal - *-------------------------------------------------------------------------------------------------------------- - LPARAMETERS toDatabase, toFoxBin2Prg + Procedure verify_EXTERNAL_MEMBERS +*-------------------------------------------------------------------------------- +* Compara los miembros definidos en la cabecera con los miembros encontrados luego +*-------------------------------------------------------------------------------------------------------------- +* PARÁMETROS: (v=Pasar por valor | @=Pasar por referencia) (!=Obligatorio | ?=Opcional) (IN/OUT) +* toDatabase (@! IN ) Objeto con toda la información del módulo analizado +* toFoxBin2Prg (@! IN ) Referencia al objeto principal +*-------------------------------------------------------------------------------------------------------------- + Lparameters toDatabase, toFoxBin2Prg - #IF .F. - LOCAL toDatabase AS CL_DBC OF 'FOXBIN2PRG.PRG' - LOCAL toFoxBin2Prg AS c_foxbin2prg OF 'FOXBIN2PRG.PRG' - #ENDIF + #If .F. + Local toDatabase As CL_DBC Of 'FOXBIN2PRG.PRG' + Local toFoxBin2Prg As c_foxbin2prg Of 'FOXBIN2PRG.PRG' + #Endif - LOCAL lnItem, I, X, lcClaseExterna ; - , loLang as CL_LANG OF 'FOXBIN2PRG.PRG' + Local lnItem, I, X, lcClaseExterna ; + , loLang As CL_LANG Of 'FOXBIN2PRG.PRG' - loLang = _SCREEN.o_FoxBin2Prg_Lang + loLang = _Screen.o_FoxBin2Prg_Lang - *-- Verificación de los Miembros, si son Externos y se indicó chequearlos - IF toFoxBin2Prg.n_UseClassPerFile > 0 AND toFoxBin2Prg.l_ClassPerFileCheck AND EMPTY(toFoxBin2Prg.c_ClassOperationType) - FOR I = 1 TO toDatabase._ExternalClasses_Count +*-- Verificación de los Miembros, si son Externos y se indicó chequearlos + If toFoxBin2Prg.n_UseClassPerFile > 0 And toFoxBin2Prg.l_ClassPerFileCheck And Empty(toFoxBin2Prg.c_ClassOperationType) + For I = 1 To toDatabase._ExternalClasses_Count lnItem = 0 - FOR X = 1 TO toDatabase._Members_Count - IF LOWER( toDatabase._Members(m.X,1) ) == LOWER( toDatabase._ExternalClasses(m.I,1) ) + For X = 1 To toDatabase._Members_Count + If Lower( toDatabase._Members(m.X,1) ) == Lower( toDatabase._ExternalClasses(m.I,1) ) lnItem = m.X - EXIT - ENDIF - ENDFOR + Exit + Endif + Endfor - IF lnItem = 0 THEN - lcClaseExterna = FORCEPATH( JUSTSTEM(toFoxBin2Prg.c_InputFile) + '.' + toDatabase._ExternalClasses(m.I,1) + '.' + JUSTEXT(toFoxBin2Prg.c_InputFile), JUSTPATH(toFoxBin2Prg.c_InputFile) ) - *ERROR 'No se ha encontrado la clase externa [' + toDatabase._ExternalClasses(m.I,1) + '] en el archivo [' + toFoxBin2Prg.c_InputFile + ']' - ERROR ( loLang.C_EXTERNAL_MEMBER_NAME_WAS_NOT_FOUND_LOC + ' [' + lcClaseExterna + ']' ) - ENDIF + If lnItem = 0 Then + lcClaseExterna = Forcepath( Juststem(toFoxBin2Prg.c_InputFile) + '.' + toDatabase._ExternalClasses(m.I,1) + '.' + Justext(toFoxBin2Prg.c_InputFile), Justpath(toFoxBin2Prg.c_InputFile) ) +*ERROR 'No se ha encontrado la clase externa [' + toDatabase._ExternalClasses(m.I,1) + '] en el archivo [' + toFoxBin2Prg.c_InputFile + ']' + Error ( loLang.C_EXTERNAL_MEMBER_NAME_WAS_NOT_FOUND_LOC + ' [' + lcClaseExterna + ']' ) + Endif toDatabase._Members(lnItem,2) = .T. && Checked - ENDFOR - ENDIF - ENDPROC + Endfor + Endif + Endproc -ENDDEFINE && CLASS c_conversor_prg_a_dbc AS c_conversor_prg_a_bin +Enddefine && CLASS c_conversor_prg_a_dbc AS c_conversor_prg_a_bin -DEFINE CLASS c_conversor_prg_a_mnx AS c_conversor_prg_a_bin - #IF .F. - LOCAL THIS AS c_conversor_prg_a_mnx OF 'FOXBIN2PRG.PRG' - #ENDIF - _MEMBERDATA = [] ; +Define Class c_conversor_prg_a_mnx As c_conversor_prg_a_bin + #If .F. + Local This As c_conversor_prg_a_mnx Of 'FOXBIN2PRG.PRG' + #Endif + _MemberData = [] ; + [] ; + [] ; + [] @@ -13589,208 +13604,208 @@ DEFINE CLASS c_conversor_prg_a_mnx AS c_conversor_prg_a_bin c_MenuLocation = '' - PROCEDURE convert - *--------------------------------------------------------------------------------------------------- - * PARÁMETROS: (v=Pasar por valor | @=Pasar por referencia) (!=Obligatorio | ?=Opcional) (IN/OUT) - * toMenu (!@ OUT) Objeto generado de clase CL_DBC con la información leida del texto - * toEx (!@ OUT) Objeto con información del error - * toFoxBin2Prg (v! IN ) Referencia al objeto principal - *--------------------------------------------------------------------------------------------------- - LPARAMETERS toMenu, toEx AS EXCEPTION, toFoxBin2Prg - DODEFAULT( @toMenu, @toEx, @toFoxBin2Prg ) + Procedure convert +*--------------------------------------------------------------------------------------------------- +* PARÁMETROS: (v=Pasar por valor | @=Pasar por referencia) (!=Obligatorio | ?=Opcional) (IN/OUT) +* toMenu (!@ OUT) Objeto generado de clase CL_DBC con la información leida del texto +* toEx (!@ OUT) Objeto con información del error +* toFoxBin2Prg (v! IN ) Referencia al objeto principal +*--------------------------------------------------------------------------------------------------- + Lparameters toMenu, toEx As Exception, toFoxBin2Prg + DoDefault( @toMenu, @toEx, @toFoxBin2Prg ) - #IF .F. - LOCAL toMenu AS CL_MENU OF 'FOXBIN2PRG.PRG' - LOCAL toFoxBin2Prg AS c_foxbin2prg OF 'FOXBIN2PRG.PRG' - #ENDIF + #If .F. + Local toMenu As CL_MENU Of 'FOXBIN2PRG.PRG' + Local toFoxBin2Prg As c_foxbin2prg Of 'FOXBIN2PRG.PRG' + #Endif - TRY - LOCAL lnCodError, loEx AS EXCEPTION, loReg, lcLine, laCodeLines(1), lnCodeLines ; - , laLineasExclusion(1), lnBloquesExclusion, lnIDInputFile - STORE 0 TO lnCodError, lnCodeLines - STORE '' TO lcLine + Try + Local lnCodError, loEx As Exception, loReg, lcLine, laCodeLines(1), lnCodeLines ; + , laLineasExclusion(1), lnBloquesExclusion, lnIDInputFile + Store 0 To lnCodError, lnCodeLines + Store '' To lcLine - WITH THIS AS c_conversor_prg_a_mnx OF 'FOXBIN2PRG.PRG' - lnIDInputFile = toFoxBin2Prg.n_ProcessedFiles + With This As c_conversor_prg_a_mnx Of 'FOXBIN2PRG.PRG' + lnIDInputFile = toFoxBin2Prg.n_ProcessedFiles - IF NOT toFoxBin2Prg.l_ProcessFiles THEN - *-- addProcessedFile( tcFile, tcInOutType, tcProcessed, tcHasErrors, tcSupported, tcExpanded ) - IF toFoxBin2Prg.addProcessedFile( .c_OutputFile, 'O', 'P1', 'E0', 'S1', 'X0' ) THEN - toFoxBin2Prg.updateProcessedFile() - ENDIF + If Not toFoxBin2Prg.l_ProcessFiles Then +*-- addProcessedFile( tcFile, tcInOutType, tcProcessed, tcHasErrors, tcSupported, tcExpanded ) + If toFoxBin2Prg.addProcessedFile( .c_OutputFile, 'O', 'P1', 'E0', 'S1', 'X0' ) Then + toFoxBin2Prg.updateProcessedFile() + Endif - EXIT && Si se indicó no procesar, se sale aquí. (Modo de simulación) - ENDIF + Exit && Si se indicó no procesar, se sale aquí. (Modo de simulación) + Endif - C_FB2PRG_CODE = FILETOSTR( .c_InputFile ) - lnCodeLines = ALINES( laCodeLines, C_FB2PRG_CODE ) + C_FB2PRG_CODE = Filetostr( .c_InputFile ) + lnCodeLines = Alines( laCodeLines, C_FB2PRG_CODE ) - .createMenu('CURSOR') + .createMenu('CURSOR') - *-- Identifico el inicio/fin de bloque, definición, cabecera y cuerpo del reporte - .updateProgressbar( 'Identifying Code Blocks...', 1, 2, 1 ) - .identifyCodeBlocks( @laCodeLines, lnCodeLines, @laLineasExclusion, lnBloquesExclusion, @toMenu ) - USE IN (SELECT('TABLABIN')) +*-- Identifico el inicio/fin de bloque, definición, cabecera y cuerpo del reporte + .updateProgressbar( 'Identifying Code Blocks...', 1, 2, 1 ) + .identifyCodeBlocks( @laCodeLines, lnCodeLines, @laLineasExclusion, lnBloquesExclusion, @toMenu ) + Use In (Select('TABLABIN')) - DO CASE - CASE toFoxBin2Prg.c_SimulateError = 'SIMERR_I1' - ERROR 'InputFile Error Simulation' - CASE toFoxBin2Prg.c_SimulateError = 'SIMERR_I0' - .writeErrorLog( '*** SIMULATED ERROR' ) - ENDCASE + Do Case + Case toFoxBin2Prg.c_SimulateError = 'SIMERR_I1' + Error 'InputFile Error Simulation' + Case toFoxBin2Prg.c_SimulateError = 'SIMERR_I0' + .writeErrorLog( '*** SIMULATED ERROR' ) + Endcase - IF .l_Error - .writeLog( '*** ERRORS found - Generation Cancelled' ) - EXIT - ENDIF + If .l_Error + .writeLog( '*** ERRORS found - Generation Cancelled' ) + Exit + Endif - toFoxBin2Prg.updateProcessedFile( lnIDInputFile ) - .updateProgressbar( 'Generating Binary...', 1, 2, 1 ) - toFoxBin2Prg.doBackup( .F., .T., '', '', '' ) - .createMenu() - .writeBinaryFile( @toMenu, @toFoxBin2Prg ) - ENDWITH && THIS + toFoxBin2Prg.updateProcessedFile( lnIDInputFile ) + .updateProgressbar( 'Generating Binary...', 1, 2, 1 ) + toFoxBin2Prg.doBackup( .F., .T., '', '', '' ) + .createMenu() + .writeBinaryFile( @toMenu, @toFoxBin2Prg ) + Endwith && THIS - CATCH TO loEx - lnCodError = loEx.ERRORNO + Catch To loEx + lnCodError = loEx.ErrorNo - IF THIS.n_Debug > 0 AND _VFP.STARTMODE = 0 - SET STEP ON - ENDIF + If This.n_Debug > 0 And _vfp.StartMode = 0 + Set Step On + Endif - THROW + Throw - FINALLY - USE IN (SELECT("TABLABIN")) - ENDTRY + Finally + Use In (Select("TABLABIN")) + Endtry - RETURN lnCodError - ENDPROC + Return lnCodError + Endproc - PROCEDURE identifyCodeBlocks - *-------------------------------------------------------------------------------------------------------------- - * PARÁMETROS: (v=Pasar por valor | @=Pasar por referencia) (!=Obligatorio | ?=Opcional) (IN/OUT) - * taCodeLines (!@ IN ) El array con las líneas del código donde buscar - * tnCodeLines (!@ IN ) Cantidad de líneas de código - * taLineasExclusion (@! IN ) Array unidimensional con un .T. o .F. según la línea sea de exclusión o no - * tnBloquesExclusion (@? IN ) Sin uso - * toMenu (@? OUT) Objeto con toda la información del menú analizado - * - * NOTA: - * Como identificador se usa el nombre de clase o de procedimiento, según corresponda. - *-------------------------------------------------------------------------------------------------------------- - LPARAMETERS taCodeLines, tnCodeLines, taLineasExclusion, tnBloquesExclusion, toMenu + Procedure identifyCodeBlocks +*-------------------------------------------------------------------------------------------------------------- +* PARÁMETROS: (v=Pasar por valor | @=Pasar por referencia) (!=Obligatorio | ?=Opcional) (IN/OUT) +* taCodeLines (!@ IN ) El array con las líneas del código donde buscar +* tnCodeLines (!@ IN ) Cantidad de líneas de código +* taLineasExclusion (@! IN ) Array unidimensional con un .T. o .F. según la línea sea de exclusión o no +* tnBloquesExclusion (@? IN ) Sin uso +* toMenu (@? OUT) Objeto con toda la información del menú analizado +* +* NOTA: +* Como identificador se usa el nombre de clase o de procedimiento, según corresponda. +*-------------------------------------------------------------------------------------------------------------- + Lparameters taCodeLines, tnCodeLines, taLineasExclusion, tnBloquesExclusion, toMenu - EXTERNAL ARRAY taCodeLines, taLineasExclusion + External Array taCodeLines, taLineasExclusion - #IF .F. - LOCAL toMenu AS CL_MENU OF 'FOXBIN2PRG.PRG' - #ENDIF + #If .F. + Local toMenu As CL_MENU Of 'FOXBIN2PRG.PRG' + #Endif - TRY - LOCAL I, lc_Comentario, lcLine, llFoxBin2Prg_Completed, llBloqueMenu_Completed - STORE 0 TO I + Try + Local I, lc_Comentario, lcLine, llFoxBin2Prg_Completed, llBloqueMenu_Completed + Store 0 To I - WITH THIS AS c_conversor_prg_a_mnx OF 'FOXBIN2PRG.PRG' - .c_Type = UPPER(JUSTEXT(.c_OutputFile)) + With This As c_conversor_prg_a_mnx Of 'FOXBIN2PRG.PRG' + .c_Type = Upper(Justext(.c_OutputFile)) - IF tnCodeLines > 1 - toMenu = NULL - toMenu = CREATEOBJECT('CL_MENU') + If tnCodeLines > 1 + toMenu = Null + toMenu = Createobject('CL_MENU') - FOR I = 1 TO tnCodeLines - .set_Line( @lcLine, @taCodeLines, m.I ) + For I = 1 To tnCodeLines + .set_Line( @lcLine, @taCodeLines, m.I ) - DO CASE - CASE .lineIsOnlyCommentAndNoMetadata( @lcLine, @lc_Comentario ) && Vacía o solo Comentarios - LOOP + Do Case + Case .lineIsOnlyCommentAndNoMetadata( @lcLine, @lc_Comentario ) && Vacía o solo Comentarios + Loop - CASE NOT llFoxBin2Prg_Completed AND .analyzeCodeBlock_FoxBin2Prg( toMenu, @lcLine, @taCodeLines, @m.I, tnCodeLines ) - llFoxBin2Prg_Completed = .T. + Case Not llFoxBin2Prg_Completed And .analyzeCodeBlock_FoxBin2Prg( toMenu, @lcLine, @taCodeLines, @m.I, tnCodeLines ) + llFoxBin2Prg_Completed = .T. - CASE NOT llBloqueMenu_Completed AND toMenu.analyzeCodeBlock( @lcLine, @taCodeLines, @m.I, tnCodeLines, THIS ) - llBloqueMenu_Completed = .T. + Case Not llBloqueMenu_Completed And toMenu.analyzeCodeBlock( @lcLine, @taCodeLines, @m.I, tnCodeLines, This ) + llBloqueMenu_Completed = .T. - ENDCASE - ENDFOR - ENDIF - ENDWITH && THIS + Endcase + Endfor + Endif + Endwith && THIS - CATCH TO loEx - IF THIS.n_Debug > 0 AND _VFP.STARTMODE = 0 - SET STEP ON - ENDIF + Catch To loEx + If This.n_Debug > 0 And _vfp.StartMode = 0 + Set Step On + Endif - THROW + Throw - FINALLY - RELEASE taCodeLines, tnCodeLines, taLineasExclusion, tnBloquesExclusion, toMenu ; - , I, lc_Comentario, lcLine, llFoxBin2Prg_Completed, llBloqueMenu_Completed - ENDTRY + Finally + Release taCodeLines, tnCodeLines, taLineasExclusion, tnBloquesExclusion, toMenu ; + , I, lc_Comentario, lcLine, llFoxBin2Prg_Completed, llBloqueMenu_Completed + Endtry - RETURN - ENDPROC + Return + Endproc - PROCEDURE writeBinaryFile - *--------------------------------------------------------------------------------------------------- - * PARÁMETROS: (v=Pasar por valor | @=Pasar por referencia) (!=Obligatorio | ?=Opcional) (IN/OUT) - * toMenu (!@ OUT) Objeto generado de clase CL_DBC con la información leida del texto - *--------------------------------------------------------------------------------------------------- - LPARAMETERS toMenu, toFoxBin2Prg + Procedure writeBinaryFile +*--------------------------------------------------------------------------------------------------- +* PARÁMETROS: (v=Pasar por valor | @=Pasar por referencia) (!=Obligatorio | ?=Opcional) (IN/OUT) +* toMenu (!@ OUT) Objeto generado de clase CL_DBC con la información leida del texto +*--------------------------------------------------------------------------------------------------- + Lparameters toMenu, toFoxBin2Prg - #IF .F. - LOCAL toMenu AS CL_MENU OF 'FOXBIN2PRG.PRG' - #ENDIF + #If .F. + Local toMenu As CL_MENU Of 'FOXBIN2PRG.PRG' + #Endif - TRY - LOCAL lnCodError - lnCodError = 0 + Try + Local lnCodError + lnCodError = 0 - *-- addProcessedFile( tcFile, tcInOutType, tcProcessed, tcHasErrors, tcSupported, tcExpanded ) - toFoxBin2Prg.addProcessedFile( THIS.c_OutputFile, 'O', 'P1', 'E0', 'S1', 'X0' ) +*-- addProcessedFile( tcFile, tcInOutType, tcProcessed, tcHasErrors, tcSupported, tcExpanded ) + toFoxBin2Prg.addProcessedFile( This.c_OutputFile, 'O', 'P1', 'E0', 'S1', 'X0' ) - DO CASE - CASE toFoxBin2Prg.c_SimulateError = 'SIMERR_O1' - ERROR 'OutputFile Error Simulation' - ENDCASE + Do Case + Case toFoxBin2Prg.c_SimulateError = 'SIMERR_O1' + Error 'OutputFile Error Simulation' + Endcase - toMenu.updateMENU( THIS ) + toMenu.updateMENU( This ) - toFoxBin2Prg.updateProcessedFile() + toFoxBin2Prg.updateProcessedFile() - CATCH TO loEx - lnCodError = loEx.ERRORNO - toFoxBin2Prg.updateProcessedFile( 0, '', '', 'E1' ) + Catch To loEx + lnCodError = loEx.ErrorNo + toFoxBin2Prg.updateProcessedFile( 0, '', '', 'E1' ) - IF THIS.n_Debug > 0 AND _VFP.STARTMODE = 0 - SET STEP ON - ENDIF + If This.n_Debug > 0 And _vfp.StartMode = 0 + Set Step On + Endif - THROW + Throw - FINALLY - USE IN (SELECT(JUSTSTEM(THIS.c_OutputFile))) + Finally + Use In (Select(Juststem(This.c_OutputFile))) - ENDTRY + Endtry - RETURN lnCodError - ENDPROC + Return lnCodError + Endproc -ENDDEFINE && CLASS c_conversor_prg_a_mnx AS c_conversor_prg_a_bin +Enddefine && CLASS c_conversor_prg_a_mnx AS c_conversor_prg_a_bin -DEFINE CLASS c_conversor_bin_a_prg AS c_conversor_base - #IF .F. - LOCAL THIS AS c_conversor_bin_a_prg OF 'FOXBIN2PRG.PRG' - #ENDIF +Define Class c_conversor_bin_a_prg As c_conversor_base + #If .F. + Local This As c_conversor_bin_a_prg Of 'FOXBIN2PRG.PRG' + #Endif - _MEMBERDATA = [] ; + _MemberData = [] ; + [] ; + [] ; + [] ; @@ -13839,1316 +13854,1316 @@ DEFINE CLASS c_conversor_bin_a_prg AS c_conversor_base + [] - PROCEDURE convert - *--------------------------------------------------------------------------------------------------- - * PARÁMETROS: (v=Pasar por valor | @=Pasar por referencia) (!=Obligatorio | ?=Opcional) (IN/OUT) - * toModulo (!@ OUT) Objeto generado de clase correspondiente con la información leida del texto - * toEx (!@ OUT) Objeto con información del error - * toFoxBin2Prg (v! IN ) Referencia al objeto principal - *--------------------------------------------------------------------------------------------------- - LPARAMETERS toModulo, toEx AS EXCEPTION, toFoxBin2Prg - #IF .F. - LOCAL toFoxBin2Prg AS c_foxbin2prg OF 'FOXBIN2PRG.PRG' - #ENDIF - DODEFAULT( @toModulo, @toEx, @toFoxBin2Prg ) - ENDPROC + Procedure convert +*--------------------------------------------------------------------------------------------------- +* PARÁMETROS: (v=Pasar por valor | @=Pasar por referencia) (!=Obligatorio | ?=Opcional) (IN/OUT) +* toModulo (!@ OUT) Objeto generado de clase correspondiente con la información leida del texto +* toEx (!@ OUT) Objeto con información del error +* toFoxBin2Prg (v! IN ) Referencia al objeto principal +*--------------------------------------------------------------------------------------------------- + Lparameters toModulo, toEx As Exception, toFoxBin2Prg + #If .F. + Local toFoxBin2Prg As c_foxbin2prg Of 'FOXBIN2PRG.PRG' + #Endif + DoDefault( @toModulo, @toEx, @toFoxBin2Prg ) + Endproc - PROCEDURE classify_PAM_Hidden_Protected - *--------------------------------------------------------------------------------------------------- - * PARÁMETROS: (v=Pasar por valor | @=Pasar por referencia) (!=Obligatorio | ?=Opcional) (IN/OUT) - * tnPropsAndValues_Count (@! IN ) - * taPropsAndValues (@! IN ) - * tnProtected_Count (@! IN ) - * taProtected (@! IN ) - * tnPropsAndComments_Count (@! IN ) - * taPropsAndComments (@! IN ) - * tcHiddenProp (@! OUT) Lista de propiedades Hidden - * tcProtectedProp (@! OUT) Lista de propiedades Protected - *--------------------------------------------------------------------------------------------------- - LPARAMETERS tnPropsAndValues_Count, taPropsAndValues, tnProtected_Count, taProtected ; + Procedure classify_PAM_Hidden_Protected +*--------------------------------------------------------------------------------------------------- +* PARÁMETROS: (v=Pasar por valor | @=Pasar por referencia) (!=Obligatorio | ?=Opcional) (IN/OUT) +* tnPropsAndValues_Count (@! IN ) +* taPropsAndValues (@! IN ) +* tnProtected_Count (@! IN ) +* taProtected (@! IN ) +* tnPropsAndComments_Count (@! IN ) +* taPropsAndComments (@! IN ) +* tcHiddenProp (@! OUT) Lista de propiedades Hidden +* tcProtectedProp (@! OUT) Lista de propiedades Protected +*--------------------------------------------------------------------------------------------------- + Lparameters tnPropsAndValues_Count, taPropsAndValues, tnProtected_Count, taProtected ; , tnPropsAndComments_Count, taPropsAndComments, tcHiddenProp, tcProtectedProp - IF tnPropsAndValues_Count > 0 THEN - *-- Recorro las propiedades (campo Properties) para ir conformando - *-- las definiciones HIDDEN y PROTECTED - LOCAL lcProp, I + If tnPropsAndValues_Count > 0 Then +*-- Recorro las propiedades (campo Properties) para ir conformando +*-- las definiciones HIDDEN y PROTECTED + Local lcProp, I - STORE '' TO tcHiddenProp, tcProtectedProp + Store '' To tcHiddenProp, tcProtectedProp - FOR I = 1 TO tnProtected_Count - DO CASE - CASE EMPTY( taProtected(m.I) ) - LOOP + For I = 1 To tnProtected_Count + Do Case + Case Empty( taProtected(m.I) ) + Loop - CASE RIGHT( taProtected(m.I), 1 ) == '^' - *-- Hidden Property or method - lcProp = CHRTRAN( taProtected(m.I), '^', '' ) - IF ASCAN(taPropsAndComments, '*' + lcProp, 1, 0, 1, 1+2+4) > 0 - LOOP && method - ENDIF - tcHiddenProp = tcHiddenProp + ',' + lcProp + Case Right( taProtected(m.I), 1 ) == '^' +*-- Hidden Property or method + lcProp = Chrtran( taProtected(m.I), '^', '' ) + If Ascan(taPropsAndComments, '*' + lcProp, 1, 0, 1, 1+2+4) > 0 + Loop && method + Endif + tcHiddenProp = tcHiddenProp + ',' + lcProp - OTHERWISE - *-- Protected Property or method - IF ASCAN(taPropsAndComments, '*' + taProtected(m.I), 1, 0, 1, 1+2+4) > 0 - LOOP && method - ENDIF - tcProtectedProp = tcProtectedProp + ',' + taProtected(m.I) - ENDCASE - ENDFOR + Otherwise +*-- Protected Property or method + If Ascan(taPropsAndComments, '*' + taProtected(m.I), 1, 0, 1, 1+2+4) > 0 + Loop && method + Endif + tcProtectedProp = tcProtectedProp + ',' + taProtected(m.I) + Endcase + Endfor - ENDIF - ENDPROC + Endif + Endproc - PROCEDURE get_ADD_OBJECT_METHODS - LPARAMETERS toRegObj, toRegClass, tcMethods, taMethods, taCode, tnMethodCount ; + Procedure get_ADD_OBJECT_METHODS + Lparameters toRegObj, toRegClass, tcMethods, taMethods, taCode, tnMethodCount ; , taPropsAndComments, tnPropsAndComments_Count, taProtected, tnProtected_Count ; , toFoxBin2Prg - EXTERNAL ARRAY taPropsAndComments, taProtected + External Array taPropsAndComments, taProtected - #IF .F. - LOCAL toFoxBin2Prg AS c_foxbin2prg OF 'FOXBIN2PRG.PRG' - #ENDIF + #If .F. + Local toFoxBin2Prg As c_foxbin2prg Of 'FOXBIN2PRG.PRG' + #Endif - TRY - LOCAL lcMethodName, lnMethodCount + Try + Local lcMethodName, lnMethodCount - WITH THIS AS c_conversor_bin_a_prg OF 'FOXBIN2PRG.PRG' - lnMethodCount = tnMethodCount - .method2Array( toRegObj.METHODS, @taMethods, @taCode, '', @tnMethodCount ; - , @taPropsAndComments, tnPropsAndComments_Count, @taProtected, tnProtected_Count, @toFoxBin2Prg, @toRegObj ) + With This As c_conversor_bin_a_prg Of 'FOXBIN2PRG.PRG' + lnMethodCount = tnMethodCount + .method2Array( toRegObj.METHODS, @taMethods, @taCode, '', @tnMethodCount ; + , @taPropsAndComments, tnPropsAndComments_Count, @taProtected, tnProtected_Count, @toFoxBin2Prg, @toRegObj ) - *-- Ubico los métodos protegidos y les cambio la definición. - *-- Los métodos se deben generar con la ruta completa, porque si no es imposible saber a que objeto corresponden, - *-- o si son de la clase. - IF tnMethodCount - lnMethodCount > 0 THEN - FOR I = lnMethodCount + 1 TO tnMethodCount - IF taMethods(m.I,2) = 0 - LOOP - ENDIF +*-- Ubico los métodos protegidos y les cambio la definición. +*-- Los métodos se deben generar con la ruta completa, porque si no es imposible saber a que objeto corresponden, +*-- o si son de la clase. + If tnMethodCount - lnMethodCount > 0 Then + For I = lnMethodCount + 1 To tnMethodCount + If taMethods(m.I,2) = 0 + Loop + Endif - IF EMPTY(toRegObj.PARENT) - lcMethodName = toRegObj.OBJNAME + '.' + taMethods(m.I,1) - ELSE - DO CASE - CASE '.' $ toRegObj.PARENT - lcMethodName = SUBSTR(toRegObj.PARENT, AT('.', toRegObj.PARENT) + 1) + '.' + toRegObj.OBJNAME + '.' + taMethods(m.I,1) - - CASE LOWER( LEFT(toRegObj.PARENT + '.', LEN( toRegClass.OBJNAME + '.' ) ) ) == LOWER( toRegClass.OBJNAME + '.' ) + If Empty(toRegObj.Parent) lcMethodName = toRegObj.OBJNAME + '.' + taMethods(m.I,1) + Else + Do Case + Case '.' $ toRegObj.Parent + lcMethodName = Substr(toRegObj.Parent, At('.', toRegObj.Parent) + 1) + '.' + toRegObj.OBJNAME + '.' + taMethods(m.I,1) - OTHERWISE - lcMethodName = toRegObj.PARENT + '.' + toRegObj.OBJNAME + '.' + taMethods(m.I,1) + Case Lower( Left(toRegObj.Parent + '.', Len( toRegClass.OBJNAME + '.' ) ) ) == Lower( toRegClass.OBJNAME + '.' ) + lcMethodName = toRegObj.OBJNAME + '.' + taMethods(m.I,1) - ENDCASE - ENDIF + Otherwise + lcMethodName = toRegObj.Parent + '.' + toRegObj.OBJNAME + '.' + taMethods(m.I,1) - *-- Genero el método SIN indentar, ya que se hace luego - taCode(taMethods(m.I,2)) = 'PROCEDURE ' + lcMethodName + CR_LF + .indentMemo( taCode(taMethods(m.I,2)) ) + CR_LF + 'ENDPROC' - taMethods(m.I,1) = lcMethodName - ENDFOR - ENDIF - ENDWITH && THIS + Endcase + Endif - CATCH TO loEx - IF THIS.n_Debug > 0 AND _VFP.STARTMODE = 0 - SET STEP ON - ENDIF +*-- Genero el método SIN indentar, ya que se hace luego + taCode(taMethods(m.I,2)) = 'PROCEDURE ' + lcMethodName + CR_LF + .indentMemo( taCode(taMethods(m.I,2)) ) + CR_LF + 'ENDPROC' + taMethods(m.I,1) = lcMethodName + Endfor + Endif + Endwith && THIS - THROW + Catch To loEx + If This.n_Debug > 0 And _vfp.StartMode = 0 + Set Step On + Endif - FINALLY - RELEASE toRegObj, toRegClass, tcMethods, taMethods, taCode, tnMethodCount ; - , taPropsAndComments, tnPropsAndComments_Count, taProtected, tnProtected_Count ; - , toFoxBin2Prg, lcMethodName, lnMethodCount - ENDTRY + Throw - RETURN - ENDPROC + Finally + Release toRegObj, toRegClass, tcMethods, taMethods, taCode, tnMethodCount ; + , taPropsAndComments, tnPropsAndComments_Count, taProtected, tnProtected_Count ; + , toFoxBin2Prg, lcMethodName, lnMethodCount + Endtry + + Return + Endproc - PROCEDURE get_CLASS_METHODS - 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 + Procedure get_CLASS_METHODS + 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 + #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 + Try + Local lcMethod, lcMethodName, lnProtectedItem, lnCommentRow, lcProcDef, lcMethods, lnLen + Store '' To lcMethod, lcMethodName, lcProcDef, lcMethods - IF tnMethodCount > 0 THEN - WITH THIS AS c_conversor_bin_a_prg OF 'FOXBIN2PRG.PRG' - FOR I = 1 TO tnMethodCount - lcMethodName = CHRTRAN( taMethods(m.I,1), '^', '' ) - lnProtectedItem = ASCAN( taProtected, taMethods(m.I,1), 1, 0, 0, 1+2+4) + If tnMethodCount > 0 Then + With This As c_conversor_bin_a_prg Of 'FOXBIN2PRG.PRG' + For I = 1 To tnMethodCount + lcMethodName = Chrtran( taMethods(m.I,1), '^', '' ) + lnProtectedItem = Ascan( taProtected, taMethods(m.I,1), 1, 0, 0, 1+2+4) - IF lnProtectedItem = 0 - lnProtectedItem = ASCAN( taProtected, taMethods(m.I,1) + '^', 1, 0, 0, 1+2+4) + If lnProtectedItem = 0 + lnProtectedItem = Ascan( taProtected, taMethods(m.I,1) + '^', 1, 0, 0, 1+2+4) - IF lnProtectedItem = 0 - *-- Método común - lcProcDef = 'PROCEDURE' - ELSE - *-- Método oculto - lcProcDef = 'HIDDEN PROCEDURE' - ENDIF - ELSE - *-- Método protegido - lcProcDef = 'PROTECTED PROCEDURE' - ENDIF + If lnProtectedItem = 0 +*-- Método común + lcProcDef = 'PROCEDURE' + Else +*-- Método oculto + lcProcDef = 'HIDDEN PROCEDURE' + Endif + Else +*-- Método protegido + lcProcDef = 'PROTECTED PROCEDURE' + Endif - lnCommentRow = ASCAN( taPropsAndComments, '*' + lcMethodName, 1, 0, 1, 1+2+4+8) + lnCommentRow = Ascan( taPropsAndComments, '*' + lcMethodName, 1, 0, 1, 1+2+4+8) - *-- Nombre del método - lcMethod = lcProcDef + ' ' + taMethods(m.I,1) +*-- Nombre del método + lcMethod = lcProcDef + ' ' + taMethods(m.I,1) - *-- Comentarios del método (si tiene) - IF lnCommentRow > 0 AND NOT EMPTY(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 +*-- Comentarios del método (si tiene) + If lnCommentRow > 0 And Not Empty(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 - IF taMethods(m.I,2) > 0 THEN - taCode(taMethods(m.I,2)) = lcMethod + CR_LF + .indentMemo( taCode(taMethods(m.I,2)) ) + CR_LF + 'ENDPROC' - ELSE - lnLen = ALEN(taCode,1) + 1 - DIMENSION taCode( lnLen ) - taCode( lnLen ) = lcMethod + CR_LF + 'ENDPROC' - taMethods(m.I,2) = lnLen - ENDIF - ENDFOR - ENDWITH && THIS - ENDIF +*-- Código del método + If taMethods(m.I,2) > 0 Then + taCode(taMethods(m.I,2)) = lcMethod + CR_LF + .indentMemo( taCode(taMethods(m.I,2)) ) + CR_LF + 'ENDPROC' + Else + lnLen = Alen(taCode,1) + 1 + Dimension taCode( lnLen ) + taCode( lnLen ) = lcMethod + CR_LF + 'ENDPROC' + taMethods(m.I,2) = lnLen + Endif + Endfor + Endwith && THIS + Endif - CATCH TO loEx - IF THIS.n_Debug > 0 AND _VFP.STARTMODE = 0 - SET STEP ON - ENDIF + Catch To loEx + If This.n_Debug > 0 And _vfp.StartMode = 0 + Set Step On + Endif - THROW + Throw - FINALLY - RELEASE tnMethodCount, taMethods, taCode, taProtected, taPropsAndComments ; - , lcMethod, lcMethodName, lnProtectedItem, lnCommentRow, lcProcDef, lcMethods, lnLen - ENDTRY + Finally + Release tnMethodCount, taMethods, taCode, taProtected, taPropsAndComments ; + , lcMethod, lcMethodName, lnProtectedItem, lnCommentRow, lcProcDef, lcMethods, lnLen + Endtry - RETURN - ENDPROC + Return + Endproc - PROCEDURE get_OLEPublicObjectName - LPARAMETERS ta_NombresObjsOle - *-- Obtengo los objetos "OLEPublic" - LOCAL I + Procedure get_OLEPublicObjectName + Lparameters ta_NombresObjsOle +*-- Obtengo los objetos "OLEPublic" + Local I - SELECT PADR(OBJNAME,100) OBJNAME ; + Select Padr(OBJNAME,100) OBJNAME ; FROM TABLABIN ; - WHERE TABLABIN.PLATFORM = "COMMENT" AND TABLABIN.RESERVED2 == "OLEPublic" ; - ORDER BY 1 ; - INTO ARRAY ta_NombresObjsOle + WHERE TABLABIN.PLATFORM = "COMMENT" And TABLABIN.RESERVED2 == "OLEPublic" ; + ORDER By 1 ; + INTO Array ta_NombresObjsOle - FOR I = 1 TO _TALLY - ta_NombresObjsOle(m.I) = ALLTRIM( ta_NombresObjsOle(m.I) ) - ENDFOR + For I = 1 To _Tally + ta_NombresObjsOle(m.I) = Alltrim( ta_NombresObjsOle(m.I) ) + Endfor - RETURN - ENDPROC + Return + Endproc - PROCEDURE get_PropsAndCommentsFrom_RESERVED3 - *-- Sirve para el memo RESERVED3 - *--------------------------------------------------------------------------------------------------- - * PARÁMETROS: (v=Pasar por valor | @=Pasar por referencia) (!=Obligatorio | ?=Opcional) (IN/OUT) - * tcMemo (v! IN ) Contenido de un campo MEMO - * tlSort (v? IN ) Indica si se deben ordenar alfabéticamente los nombres - * taPropsAndComments (!@ OUT) Array con las propiedades y comentarios - * tnPropsAndComments_Count (!@ OUT) Cantidad de propiedades - * tcSortedMemo (@? OUT) Contenido del campo memo ordenado - *--------------------------------------------------------------------------------------------------- - LPARAMETERS tcMemo, tlSort, taPropsAndComments, tnPropsAndComments_Count, tcSortedMemo + Procedure get_PropsAndCommentsFrom_RESERVED3 +*-- Sirve para el memo RESERVED3 +*--------------------------------------------------------------------------------------------------- +* PARÁMETROS: (v=Pasar por valor | @=Pasar por referencia) (!=Obligatorio | ?=Opcional) (IN/OUT) +* tcMemo (v! IN ) Contenido de un campo MEMO +* tlSort (v? IN ) Indica si se deben ordenar alfabéticamente los nombres +* taPropsAndComments (!@ OUT) Array con las propiedades y comentarios +* tnPropsAndComments_Count (!@ OUT) Cantidad de propiedades +* tcSortedMemo (@? OUT) Contenido del campo memo ordenado +*--------------------------------------------------------------------------------------------------- + Lparameters tcMemo, tlSort, taPropsAndComments, tnPropsAndComments_Count, tcSortedMemo - EXTERNAL ARRAY taPropsAndComments + External Array taPropsAndComments - TRY - LOCAL laLines(1), I, lnPos, loEx AS EXCEPTION - tcSortedMemo = '' - tnPropsAndComments_Count = ALINES(laLines, tcMemo, 1+4) + Try + Local laLines(1), I, lnPos, loEx As Exception + tcSortedMemo = '' + tnPropsAndComments_Count = Alines(laLines, tcMemo, 1+4) - IF tnPropsAndComments_Count <= 1 AND EMPTY(laLines) - tnPropsAndComments_Count = 0 - EXIT - ENDIF + If tnPropsAndComments_Count <= 1 And Empty(laLines) + tnPropsAndComments_Count = 0 + Exit + Endif - DIMENSION taPropsAndComments(tnPropsAndComments_Count,2) + Dimension taPropsAndComments(tnPropsAndComments_Count,2) - FOR I = 1 TO tnPropsAndComments_Count - lnPos = AT(' ', laLines(m.I)) && Un espacio separa la propiedad de su comentario (si tiene) + For I = 1 To tnPropsAndComments_Count + lnPos = At(' ', laLines(m.I)) && Un espacio separa la propiedad de su comentario (si tiene) - IF lnPos = 0 - taPropsAndComments(m.I,1) = LOWER( laLines(m.I) ) - taPropsAndComments(m.I,2) = '' - ELSE - taPropsAndComments(m.I,1) = LOWER( LEFT( laLines(m.I), lnPos - 1 ) ) - taPropsAndComments(m.I,2) = SUBSTR( laLines(m.I), lnPos + 1 ) - ENDIF - ENDFOR + If lnPos = 0 + taPropsAndComments(m.I,1) = Lower( laLines(m.I) ) + taPropsAndComments(m.I,2) = '' + Else + taPropsAndComments(m.I,1) = Lower( Left( laLines(m.I), lnPos - 1 ) ) + taPropsAndComments(m.I,2) = Substr( laLines(m.I), lnPos + 1 ) + Endif + Endfor - IF tlSort AND THIS.l_PropSort_Enabled - ASORT( taPropsAndComments, 1, -1, 0, 1 ) - ENDIF + If tlSort And This.l_PropSort_Enabled + Asort( taPropsAndComments, 1, -1, 0, 1 ) + Endif - CATCH TO loEx - IF THIS.n_Debug > 0 AND _VFP.STARTMODE = 0 - SET STEP ON - ENDIF + Catch To loEx + If This.n_Debug > 0 And _vfp.StartMode = 0 + Set Step On + Endif - THROW + Throw - FINALLY - RELEASE tcMemo, tlSort, taPropsAndComments, tnPropsAndComments_Count, tcSortedMemo ; - , laLines, I, lnPos, loEx - ENDTRY + Finally + Release tcMemo, tlSort, taPropsAndComments, tnPropsAndComments_Count, tcSortedMemo ; + , laLines, I, lnPos, loEx + Endtry - RETURN - ENDPROC + Return + Endproc - PROCEDURE get_PropsAndValuesFrom_PROPERTIES - *-- Sirve para el memo PROPERTIES - *--------------------------------------------------------------------------------------------------- - * KNOWLEDGE BASE: - * 29/11/2013 FDBOZZO En un pageframe, si las props.nativas del mismo no están antes que las de - * los objetos contenidos, causa un error. Se deben ordenar primero las - * props.nativas (sin punto) y luego las de los objetos (con punto) - *--------------------------------------------------------------------------------------------------- - * PARÁMETROS: (v=Pasar por valor | @=Pasar por referencia) (!=Obligatorio | ?=Opcional) (IN/OUT) - * tcMemo (v! IN ) Contenido de un campo MEMO - * tnSort (v? IN ) Indica si se deben ordenar alfabéticamente los objetos y props (1), o no (0) - * taPropsAndValues (!@ OUT) Array con las propiedades y comentarios - * tnPropsAndValues_Count (!@ OUT) Cantidad de propiedades - * tcSortedMemo (?@ OUT) Contenido del campo memo ordenado - * toFoxBin2Prg (v! IN ) Referencia al objeto principal - *--------------------------------------------------------------------------------------------------- - LPARAMETERS tcMemo, tnSort, taPropsAndValues, tnPropsAndValues_Count, tcSortedMemo, toFoxBin2Prg + Procedure get_PropsAndValuesFrom_PROPERTIES +*-- Sirve para el memo PROPERTIES +*--------------------------------------------------------------------------------------------------- +* KNOWLEDGE BASE: +* 29/11/2013 FDBOZZO En un pageframe, si las props.nativas del mismo no están antes que las de +* los objetos contenidos, causa un error. Se deben ordenar primero las +* props.nativas (sin punto) y luego las de los objetos (con punto) +*--------------------------------------------------------------------------------------------------- +* PARÁMETROS: (v=Pasar por valor | @=Pasar por referencia) (!=Obligatorio | ?=Opcional) (IN/OUT) +* tcMemo (v! IN ) Contenido de un campo MEMO +* tnSort (v? IN ) Indica si se deben ordenar alfabéticamente los objetos y props (1), o no (0) +* taPropsAndValues (!@ OUT) Array con las propiedades y comentarios +* tnPropsAndValues_Count (!@ OUT) Cantidad de propiedades +* tcSortedMemo (?@ OUT) Contenido del campo memo ordenado +* toFoxBin2Prg (v! IN ) Referencia al objeto principal +*--------------------------------------------------------------------------------------------------- + Lparameters tcMemo, tnSort, taPropsAndValues, tnPropsAndValues_Count, tcSortedMemo, toFoxBin2Prg - EXTERNAL ARRAY taPropsAndValues + External Array taPropsAndValues - #IF .F. - LOCAL toFoxBin2Prg AS c_foxbin2prg OF 'FOXBIN2PRG.PRG' - #ENDIF + #If .F. + Local toFoxBin2Prg As c_foxbin2prg Of 'FOXBIN2PRG.PRG' + #Endif - TRY - LOCAL laItems(1), I, X, lnLenAcum, lnPosEQ, lcPropName, lnLenVal, lcValue, lcMethods, lcLastIncompletePropName - STORE '' TO tcSortedMemo, lcLastIncompletePropName - tnPropsAndValues_Count = 0 + Try + Local laItems(1), I, X, lnLenAcum, lnPosEQ, lcPropName, lnLenVal, lcValue, lcMethods, lcLastIncompletePropName + Store '' To tcSortedMemo, lcLastIncompletePropName + tnPropsAndValues_Count = 0 - IF NOT EMPTY(m.tcMemo) - WITH THIS AS c_conversor_bin_a_prg OF 'FOXBIN2PRG.PRG' - lnItemCount = ALINES(laItems, m.tcMemo, 0, CR_LF) && Específicamente CR+LF para que no reconozca los CR o LF por separado - X = 0 + If Not Empty(m.tcMemo) + With This As c_conversor_bin_a_prg Of 'FOXBIN2PRG.PRG' + lnItemCount = Alines(laItems, m.tcMemo, 0, CR_LF) && Específicamente CR+LF para que no reconozca los CR o LF por separado + X = 0 - IF lnItemCount <= 1 AND EMPTY(laItems) - lnItemCount = 0 - EXIT - ENDIF + If lnItemCount <= 1 And Empty(laItems) + lnItemCount = 0 + Exit + Endif - *-- 1) OBTENCIÓN Y SEPARACIÓN DE PROPIEDADES Y VALORES - *-- Crear un array con los valores especiales que pueden estar repartidos entre varias lineas - FOR I = 1 TO m.lnItemCount - IF EMPTY( laItems(m.I) ) - LOOP - ENDIF +*-- 1) OBTENCIÓN Y SEPARACIÓN DE PROPIEDADES Y VALORES +*-- Crear un array con los valores especiales que pueden estar repartidos entre varias lineas + For I = 1 To m.lnItemCount + If Empty( laItems(m.I) ) + Loop + Endif - IF C_MPROPHEADER $ laItems(m.I) - *-- Solo entrará por aquí cuando se evalúe una propiedad de PROPERTIES con un valor especial (largo) - lnLenAcum = 0 - lnPosEQ = AT( '=', laItems(m.I) ) - lcPropName = lcLastIncompletePropName + LEFT( laItems(m.I), lnPosEQ - 2 ) - lnLenVal = INT( VAL( SUBSTR( laItems(m.I), lnPosEQ + 2 + 517, 8) ) ) - lcValue = SUBSTR( laItems(m.I), lnPosEQ + 2 + 517 + 8 ) + If C_MPROPHEADER $ laItems(m.I) +*-- Solo entrará por aquí cuando se evalúe una propiedad de PROPERTIES con un valor especial (largo) + lnLenAcum = 0 + lnPosEQ = At( '=', laItems(m.I) ) + lcPropName = lcLastIncompletePropName + Left( laItems(m.I), lnPosEQ - 2 ) + lnLenVal = Int( Val( Substr( laItems(m.I), lnPosEQ + 2 + 517, 8) ) ) + lcValue = Substr( laItems(m.I), lnPosEQ + 2 + 517 + 8 ) - IF LEN( lcValue ) < lnLenVal - *-- Como el valor es multi-línea, debo agregarle los CR_LF que le quitó el ALINES() - FOR I = m.I + 1 TO m.lnItemCount - lcValue = lcValue + CR_LF + laItems(m.I) + If Len( lcValue ) < lnLenVal +*-- Como el valor es multi-línea, debo agregarle los CR_LF que le quitó el ALINES() + For I = m.I + 1 To m.lnItemCount + lcValue = lcValue + CR_LF + laItems(m.I) - IF LEN( lcValue ) >= lnLenVal - EXIT - ENDIF - ENDFOR + If Len( lcValue ) >= lnLenVal + Exit + Endif + Endfor - lcValue = C_FB2P_VALUE_I + CR_LF + lcValue + CR_LF + C_FB2P_VALUE_F - ELSE - lcValue = C_FB2P_VALUE_I + lcValue + C_FB2P_VALUE_F - ENDIF + lcValue = C_FB2P_VALUE_I + CR_LF + lcValue + CR_LF + C_FB2P_VALUE_F + Else + lcValue = C_FB2P_VALUE_I + lcValue + C_FB2P_VALUE_F + Endif - *-- Es un valor especial, por lo que se encapsula en un marcador especial - X = m.X + 1 - DIMENSION taPropsAndValues(m.X,2) - taPropsAndValues(m.X,1) = lcPropName - taPropsAndValues(m.X,2) = .normalizePropertyValue( lcPropName, lcValue, '' ) +*-- Es un valor especial, por lo que se encapsula en un marcador especial + X = m.X + 1 + Dimension taPropsAndValues(m.X,2) + taPropsAndValues(m.X,1) = lcPropName + taPropsAndValues(m.X,2) = .normalizePropertyValue( lcPropName, lcValue, '' ) - ELSE - *-- Propiedad normal - lnPosEQ = AT( '=', laItems(m.I) ) + Else +*-- Propiedad normal + lnPosEQ = At( '=', laItems(m.I) ) - IF lnPosEQ = 0 THEN - *-- AUTOFIX DE PROPIEDAD PARTIDA: - *-- Esto solo puede ocurrir cuando en el memo de Propiedades hay alguna propiedad - *-- partida debido a una edición manual con un Enter erróneo, algo como esto: - * comm - * AND2.Caption = "Command2" - * - *-- En el caso anterior, las 2 líneas son realmente una: - * command2.Caption = "Command2" - * - *-- Solución: Guardar esta parte del nombre y agregarlo a la próxima propiedad. - lcLastIncompletePropName = laItems(m.I) - LOOP - ENDIF + If lnPosEQ = 0 Then +*-- AUTOFIX DE PROPIEDAD PARTIDA: +*-- Esto solo puede ocurrir cuando en el memo de Propiedades hay alguna propiedad +*-- partida debido a una edición manual con un Enter erróneo, algo como esto: +* comm +* AND2.Caption = "Command2" +* +*-- En el caso anterior, las 2 líneas son realmente una: +* command2.Caption = "Command2" +* +*-- Solución: Guardar esta parte del nombre y agregarlo a la próxima propiedad. + lcLastIncompletePropName = laItems(m.I) + Loop + Endif - * Skip ZOrderSet property if configured to - IF toFoxBin2Prg.l_RemoveZOrderSetFromProps AND ATC( '.ZOrderSet.', '.' + lcLastIncompletePropName + LEFT( laItems(m.I), lnPosEQ - 2 ) + '.' ) > 0 THEN - lcLastIncompletePropName = '' - LOOP - ENDIF +* Skip ZOrderSet property if configured to + If toFoxBin2Prg.l_RemoveZOrderSetFromProps And Atc( '.ZOrderSet.', '.' + lcLastIncompletePropName + Left( laItems(m.I), lnPosEQ - 2 ) + '.' ) > 0 Then + lcLastIncompletePropName = '' + Loop + Endif - X = m.X + 1 - DIMENSION taPropsAndValues(m.X,2) - taPropsAndValues(m.X,1) = lcLastIncompletePropName + LEFT( laItems(m.I), lnPosEQ - 2 ) - taPropsAndValues(m.X,2) = .normalizePropertyValue( taPropsAndValues(m.X,1), LTRIM( SUBSTR( laItems(m.I), lnPosEQ + 2 ) ), '' ) - ENDIF + X = m.X + 1 + Dimension taPropsAndValues(m.X,2) + taPropsAndValues(m.X,1) = lcLastIncompletePropName + Left( laItems(m.I), lnPosEQ - 2 ) + taPropsAndValues(m.X,2) = .normalizePropertyValue( taPropsAndValues(m.X,1), Ltrim( Substr( laItems(m.I), lnPosEQ + 2 ) ), '' ) + Endif - lcLastIncompletePropName = '' - ENDFOR + lcLastIncompletePropName = '' + Endfor - tnPropsAndValues_Count = m.X - lcMethods = '' + tnPropsAndValues_Count = m.X + lcMethods = '' - *-- 2) SORT - .sortPropsAndValues( @taPropsAndValues, tnPropsAndValues_Count, tnSort ) +*-- 2) SORT + .sortPropsAndValues( @taPropsAndValues, tnPropsAndValues_Count, tnSort ) - *-- Agregar propiedades primero - FOR I = 1 TO m.tnPropsAndValues_Count - tcSortedMemo = m.tcSortedMemo + m.taPropsAndValues(m.I,1) + ' = ' + m.taPropsAndValues(m.I,2) + CR_LF - ENDFOR +*-- Agregar propiedades primero + For I = 1 To m.tnPropsAndValues_Count + tcSortedMemo = m.tcSortedMemo + m.taPropsAndValues(m.I,1) + ' = ' + m.taPropsAndValues(m.I,2) + CR_LF + Endfor - *-- Agregar métodos al final - tcSortedMemo = m.tcSortedMemo + m.lcMethods +*-- Agregar métodos al final + tcSortedMemo = m.tcSortedMemo + m.lcMethods - ENDWITH && THIS - ENDIF + Endwith && THIS + Endif - CATCH TO loEx - IF THIS.n_Debug > 0 AND _VFP.STARTMODE = 0 - SET STEP ON - ENDIF + Catch To loEx + If This.n_Debug > 0 And _vfp.StartMode = 0 + Set Step On + Endif - THROW + Throw - FINALLY - RELEASE tcMemo, tnSort, taPropsAndValues, tnPropsAndValues_Count, tcSortedMemo ; - , laItems, I, X, lnLenAcum, lnPosEQ, lcPropName, lnLenVal, lcValue, lcMethods - ENDTRY + Finally + Release tcMemo, tnSort, taPropsAndValues, tnPropsAndValues_Count, tcSortedMemo ; + , laItems, I, X, lnLenAcum, lnPosEQ, lcPropName, lnLenVal, lcValue, lcMethods + Endtry - RETURN - ENDPROC + Return + Endproc - PROCEDURE get_PropsFrom_PROTECTED - *--------------------------------------------------------------------------------------------------- - *-- Sirve para el memo PROTECTED - *--------------------------------------------------------------------------------------------------- - * PARÁMETROS: (v=Pasar por valor | @=Pasar por referencia) (!=Obligatorio | ?=Opcional) (IN/OUT) - * tcMemo (v! IN ) Contenido de un campo MEMO - * tlSort (v? IN ) Indica si se deben ordenar alfabéticamente los nombres - * taProtected (!@ OUT) Array con las propiedades y comentarios - * tnProtected_Count (!@ OUT) Cantidad de propiedades - * tcSortedMemo (@? OUT) Contenido del campo memo ordenado - *--------------------------------------------------------------------------------------------------- - LPARAMETERS tcMemo, tlSort, taProtected, tnProtected_Count, tcSortedMemo + Procedure get_PropsFrom_PROTECTED +*--------------------------------------------------------------------------------------------------- +*-- Sirve para el memo PROTECTED +*--------------------------------------------------------------------------------------------------- +* PARÁMETROS: (v=Pasar por valor | @=Pasar por referencia) (!=Obligatorio | ?=Opcional) (IN/OUT) +* tcMemo (v! IN ) Contenido de un campo MEMO +* tlSort (v? IN ) Indica si se deben ordenar alfabéticamente los nombres +* taProtected (!@ OUT) Array con las propiedades y comentarios +* tnProtected_Count (!@ OUT) Cantidad de propiedades +* tcSortedMemo (@? OUT) Contenido del campo memo ordenado +*--------------------------------------------------------------------------------------------------- + Lparameters tcMemo, tlSort, taProtected, tnProtected_Count, tcSortedMemo - EXTERNAL ARRAY taProtected + External Array taProtected - LOCAL I + Local I tcSortedMemo = '' - tnProtected_Count = ALINES(taProtected, tcMemo, 1+4) + tnProtected_Count = Alines(taProtected, tcMemo, 1+4) - IF tnProtected_Count <= 1 AND EMPTY(taProtected) + If tnProtected_Count <= 1 And Empty(taProtected) tnProtected_Count = 0 - ELSE - IF tlSort AND THIS.l_PropSort_Enabled - ASORT( taProtected, 1, -1, 0, 1 ) - ENDIF + Else + If tlSort And This.l_PropSort_Enabled + Asort( taProtected, 1, -1, 0, 1 ) + Endif - FOR I = tnProtected_Count TO 1 STEP -1 - *-- El ASCAN es para evitar valores repetidos, que se eliminarán. v1.19.29 + For I = tnProtected_Count To 1 Step -1 +*-- El ASCAN es para evitar valores repetidos, que se eliminarán. v1.19.29 taProtected(m.I) = taProtected(m.I) - IF ASCAN( taProtected, taProtected(m.I), 1, -1, 0, 1+2+4 ) = m.I + If Ascan( taProtected, taProtected(m.I), 1, -1, 0, 1+2+4 ) = m.I tcSortedMemo = tcSortedMemo + taProtected(m.I) + CR_LF - ELSE - ADEL( taProtected, m.I ) + Else + Adel( taProtected, m.I ) tnProtected_Count = tnProtected_Count - 1 - ENDIF - ENDFOR + Endif + Endfor - DIMENSION taProtected(tnProtected_Count) - ENDIF + Dimension taProtected(tnProtected_Count) + Endif - RELEASE tcMemo, tlSort, taProtected, tnProtected_Count, tcSortedMemo, I - RETURN - ENDPROC + Release tcMemo, tlSort, taProtected, tnProtected_Count, tcSortedMemo, I + Return + Endproc - PROCEDURE ignoreCorruptedObjects(lcCursor) - * Issue#17 - Error, The specified key already exists - * Para evitar este error se deben ignorar los objetos corruptos (duplicados) - * Se identifican porque la clase principal el campo Reserved1 tiene vacio en vez de "Class" - LOCAL lcParentObjName, lcSetDeleted - SELECT (lcCursor) - lcSetDeleted = SET("Deleted") - SET DELETED OFF + Procedure ignoreCorruptedObjects(lcCursor) +* Issue#17 - Error, The specified key already exists +* Para evitar este error se deben ignorar los objetos corruptos (duplicados) +* Se identifican porque la clase principal el campo Reserved1 tiene vacio en vez de "Class" + Local lcParentObjName, lcSetDeleted + Select (lcCursor) + lcSetDeleted = Set("Deleted") + Set Deleted Off - SCAN FOR PLATFORM = "WINDOWS" AND EMPTY(Parent) AND EMPTY(RESERVED1) - lcParentObjName = LOWER(OBJNAME) - DELETE - SKIP - DELETE REST WHILE GETWORDNUM(LOWER(PARENT) + '.', 1, '.') == lcParentObjName - SKIP -1 - ENDSCAN + Scan For PLATFORM = "WINDOWS" And Empty(Parent) And Empty(RESERVED1) + lcParentObjName = Lower(OBJNAME) + Delete + Skip + Delete Rest While Getwordnum(Lower(Parent) + '.', 1, '.') == lcParentObjName + Skip -1 + Endscan - SET DELETED &lcSetDeleted. - RETURN - ENDPROC + Set Deleted &lcSetDeleted. + Return + Endproc - PROCEDURE ignoreIncorrectDefinedObjects(lcCursor) - * Issue#15 - VFP Designer ignored objects should be ignored by FoxBin2Prg - LOCAL lcObjName, lcParent, lcParentObjName, loObjs as Collection - loObjs = CREATEOBJECT("Collection") - SELECT (lcCursor) + Procedure ignoreIncorrectDefinedObjects(lcCursor) +* Issue#15 - VFP Designer ignored objects should be ignored by FoxBin2Prg + Local lcObjName, lcParent, lcParentObjName, loObjs As Collection + loObjs = Createobject("Collection") + Select (lcCursor) - SCAN FOR PLATFORM = "WINDOWS" - lcObjName = LOWER(OBJNAME) - lcParent = LOWER(PARENT) + Scan For PLATFORM = "WINDOWS" + lcObjName = Lower(OBJNAME) + lcParent = Lower(Parent) - IF EMPTY(lcParent) + If Empty(lcParent) lcParentObjName = lcObjName - ELSE + Else lcParentObjName = lcParent + '.' + lcObjName - ENDIF + Endif - IF NOT EMPTY(lcParent) - * Tiene Parent, y debe existir, si no es ignorado - * NOTA: Del parent solo se puede comprobar el objeto primario. - IF loObjs.GetKey(GETWORDNUM(lcParent + '.', 1, '.')) > 0 - * Existe: se agrega al array el nuevo objeto - * NOTA: Podría estar duplicado, pero no se trata ese caso aquí - IF NOT EMPTY(lcParentObjName) AND loObjs.GetKey(lcParentObjName) = 0 + If Not Empty(lcParent) +* Tiene Parent, y debe existir, si no es ignorado +* NOTA: Del parent solo se puede comprobar el objeto primario. + If loObjs.GetKey(Getwordnum(lcParent + '.', 1, '.')) > 0 +* Existe: se agrega al array el nuevo objeto +* NOTA: Podría estar duplicado, pero no se trata ese caso aquí + If Not Empty(lcParentObjName) And loObjs.GetKey(lcParentObjName) = 0 loObjs.Add( '', lcParentObjName ) - ENDIF - ELSE - * No existe: se ignora - DELETE - ENDIF - ELSE - * No Existe: se agrega al array - IF NOT EMPTY(lcParentObjName) AND loObjs.GetKey(lcParentObjName) = 0 + Endif + Else +* No existe: se ignora + Delete + Endif + Else +* No Existe: se agrega al array + If Not Empty(lcParentObjName) And loObjs.GetKey(lcParentObjName) = 0 loObjs.Add( '', lcParentObjName ) - ENDIF + Endif - ENDIF - ENDSCAN + Endif + Endscan - RETURN - ENDPROC + Return + Endproc - PROCEDURE indentMemo - LPARAMETERS tcMethod, tcIndentation, tlKeepProcHeader - *-- INDENTA EL CÓDIGO DE UN MÉTODO DADO Y QUITA LA CABECERA DE MÉTODO (PROCEDURE/ENDPROC) SI LA ENCUENTRA - TRY - LOCAL I, X, lcMethod, llProcedure, lnInicio, lnFin, laLineas(1), lnOffset ; - , loLang as CL_LANG OF 'FOXBIN2PRG.PRG' + Procedure indentMemo + Lparameters tcMethod, tcIndentation, tlKeepProcHeader +*-- INDENTA EL CÓDIGO DE UN MÉTODO DADO Y QUITA LA CABECERA DE MÉTODO (PROCEDURE/ENDPROC) SI LA ENCUENTRA + Try + Local I, X, lcMethod, llProcedure, lnInicio, lnFin, laLineas(1), lnOffset ; + , loLang As CL_LANG Of 'FOXBIN2PRG.PRG' - loLang = _SCREEN.o_FoxBin2Prg_Lang - lcMethod = '' - lnInicio = 1 - lnOffset = 0 - lnFin = ALINES(laLineas, tcMethod) - llProcedure = ( LEFT(laLineas(1),10) == 'PROCEDURE ' ; - OR LEFT(laLineas(1),17) == 'HIDDEN PROCEDURE ' ; - OR LEFT(laLineas(1),20) == 'PROTECTED PROCEDURE ' ) + loLang = _Screen.o_FoxBin2Prg_Lang + lcMethod = '' + lnInicio = 1 + lnOffset = 0 + lnFin = Alines(laLineas, tcMethod) + llProcedure = ( Left(laLineas(1),10) == 'PROCEDURE ' ; + OR Left(laLineas(1),17) == 'HIDDEN PROCEDURE ' ; + OR Left(laLineas(1),20) == 'PROTECTED PROCEDURE ' ) - IF VARTYPE(tcIndentation) # 'C' - tcIndentation = '' - ENDIF + If Vartype(tcIndentation) # 'C' + tcIndentation = '' + Endif - *-- Quito las líneas en blanco luego del final del ENDPROC - X = 0 - FOR I = lnFin TO 1 STEP -1 - IF NOT EMPTY(laLineas(m.I)) && Última línea de código - IF llProcedure AND LEFT( CHRTRAN(laLineas(m.I), C_TAB, ' ') + ' ', 8 ) <> C_ENDPROC + ' ' THEN - *ERROR 'Procedimiento sin cerrar. La última línea de código debe ser ENDPROC. [' + laLineas(1) + ']' - ERROR (TEXTMERGE(loLang.C_PROCEDURE_NOT_CLOSED_ON_LINE_LOC)) - ENDIF - EXIT - ENDIF - X = m.X + 1 - ENDFOR +*-- Quito las líneas en blanco luego del final del ENDPROC + X = 0 + For I = lnFin To 1 Step -1 + If Not Empty(laLineas(m.I)) && Última línea de código + If llProcedure And Left( Chrtran(laLineas(m.I), C_TAB, ' ') + ' ', 8 ) <> C_ENDPROC + ' ' Then +*ERROR 'Procedimiento sin cerrar. La última línea de código debe ser ENDPROC. [' + laLineas(1) + ']' + Error (Textmerge(loLang.C_PROCEDURE_NOT_CLOSED_ON_LINE_LOC)) + Endif + Exit + Endif + X = m.X + 1 + Endfor - IF m.X > 0 - lnFin = lnFin - m.X - DIMENSION laLineas(lnFin) - ENDIF + If m.X > 0 + lnFin = lnFin - m.X + Dimension laLineas(lnFin) + Endif - *-- Si encuentra la cabecera de un PROCEDURE, la saltea - IF llProcedure - lnOffset = 1 - ENDIF +*-- Si encuentra la cabecera de un PROCEDURE, la saltea + If llProcedure + lnOffset = 1 + Endif - FOR I = lnInicio + lnOffset TO lnFin - lnOffset - *-- TEXT/ENDTEXT aquí da error 2044 de recursividad. No usar. - lcMethod = lcMethod + CR_LF + tcIndentation + laLineas(m.I) - ENDFOR + For I = lnInicio + lnOffset To lnFin - lnOffset +*-- TEXT/ENDTEXT aquí da error 2044 de recursividad. No usar. + lcMethod = lcMethod + CR_LF + tcIndentation + laLineas(m.I) + Endfor - IF llProcedure AND tlKeepProcHeader - lcMethod = CR_LF + C_TAB + laLineas(lnInicio) + lcMethod + CR_LF + C_TAB + laLineas(lnFin) - ENDIF + If llProcedure And tlKeepProcHeader + lcMethod = CR_LF + C_TAB + laLineas(lnInicio) + lcMethod + CR_LF + C_TAB + laLineas(lnFin) + Endif - lcMethod = SUBSTR(lcMethod,3) && Quito el primer ENTER (CR+LF) + lcMethod = Substr(lcMethod,3) && Quito el primer ENTER (CR+LF) - CATCH TO loEx - IF THIS.n_Debug > 0 AND _VFP.STARTMODE = 0 - SET STEP ON - ENDIF + Catch To loEx + If This.n_Debug > 0 And _vfp.StartMode = 0 + Set Step On + Endif - THROW + Throw - FINALLY - RELEASE tcMethod, tcIndentation, tlKeepProcHeader ; - , I, X, llProcedure, lnInicio, lnFin, laLineas, lnOffset - ENDTRY + Finally + Release tcMethod, tcIndentation, tlKeepProcHeader ; + , I, X, llProcedure, lnInicio, lnFin, laLineas, lnOffset + Endtry - RETURN lcMethod - ENDPROC + Return lcMethod + Endproc - PROCEDURE memoInOneLine - LPARAMETERS tcMethod + Procedure memoInOneLine + Lparameters tcMethod - TRY - LOCAL lcLine, I - lcLine = '' + Try + Local lcLine, I + lcLine = '' - IF NOT EMPTY(tcMethod) - FOR I = 1 TO ALINES(laLines, m.tcMethod, 0) - lcLine = lcLine + ', ' + laLines(m.I) - ENDFOR + If Not Empty(tcMethod) + For I = 1 To Alines(laLines, m.tcMethod, 0) + lcLine = lcLine + ', ' + laLines(m.I) + Endfor - lcLine = SUBSTR(lcLine, 3) - ENDIF + lcLine = Substr(lcLine, 3) + Endif - CATCH TO loEx - IF THIS.n_Debug > 0 AND _VFP.STARTMODE = 0 - SET STEP ON - ENDIF + Catch To loEx + If This.n_Debug > 0 And _vfp.StartMode = 0 + Set Step On + Endif - THROW + Throw - FINALLY - RELEASE tcMethod, I - ENDTRY + Finally + Release tcMethod, I + Endtry - RETURN lcLine - ENDPROC + Return lcLine + Endproc - PROCEDURE set_MultilineMemoWithAddObjectProperties - LPARAMETERS taPropsAndValues, tnPropCount, tcLeftIndentation, tlNormalizeLine + Procedure set_MultilineMemoWithAddObjectProperties + Lparameters taPropsAndValues, tnPropCount, tcLeftIndentation, tlNormalizeLine - EXTERNAL ARRAY taPropsAndValues + External Array taPropsAndValues - TRY - LOCAL lcLine, I, lcComentarios, laLines(1), lcFinDeLinea - lcLine = '' - lcFinDeLinea = ', ;' + CR_LF + Try + Local lcLine, I, lcComentarios, laLines(1), lcFinDeLinea + lcLine = '' + lcFinDeLinea = ', ;' + CR_LF - IF tnPropCount > 0 - IF VARTYPE(tcLeftIndentation) # 'C' - tcLeftIndentation = '' - ENDIF + If tnPropCount > 0 + If Vartype(tcLeftIndentation) # 'C' + tcLeftIndentation = '' + Endif - FOR I = 1 TO tnPropCount - lcLine = lcLine + tcLeftIndentation + taPropsAndValues(m.I,1) + ' = ' + taPropsAndValues(m.I,2) + lcFinDeLinea - ENDFOR + For I = 1 To tnPropCount + lcLine = lcLine + tcLeftIndentation + taPropsAndValues(m.I,1) + ' = ' + taPropsAndValues(m.I,2) + lcFinDeLinea + Endfor - *-- Quito el ", ;" final - lcLine = tcLeftIndentation + SUBSTR(lcLine, 1 + LEN(tcLeftIndentation), LEN(lcLine) - LEN(tcLeftIndentation) - LEN(lcFinDeLinea)) - ENDIF +*-- Quito el ", ;" final + lcLine = tcLeftIndentation + Substr(lcLine, 1 + Len(tcLeftIndentation), Len(lcLine) - Len(tcLeftIndentation) - Len(lcFinDeLinea)) + Endif - CATCH TO loEx - IF THIS.n_Debug > 0 AND _VFP.STARTMODE = 0 - SET STEP ON - ENDIF + Catch To loEx + If This.n_Debug > 0 And _vfp.StartMode = 0 + Set Step On + Endif - THROW + Throw - FINALLY - RELEASE taPropsAndValues, tnPropCount, tcLeftIndentation, tlNormalizeLine ; - , I, lcComentarios, laLines, lcFinDeLinea - ENDTRY + Finally + Release taPropsAndValues, tnPropCount, tcLeftIndentation, tlNormalizeLine ; + , I, lcComentarios, laLines, lcFinDeLinea + Endtry - RETURN lcLine - ENDPROC + Return lcLine + Endproc - PROCEDURE set_UserValue - *--------------------------------------------------------------------------------------------------- - * Intenta obtener información más precisa sobre el error a reportar dentro de methods - *--------------------------------------------------------------------------------------------------- - * PARÁMETROS: (v=Pasar por valor | @=Pasar por referencia) (!=Obligatorio | ?=Opcional) (IN/OUT) - * toEx (v! IN ) Objeto Exception - *--------------------------------------------------------------------------------------------------- - LPARAMETERS toEx as Exception + Procedure set_UserValue +*--------------------------------------------------------------------------------------------------- +* Intenta obtener información más precisa sobre el error a reportar dentro de methods +*--------------------------------------------------------------------------------------------------- +* PARÁMETROS: (v=Pasar por valor | @=Pasar por referencia) (!=Obligatorio | ?=Opcional) (IN/OUT) +* toEx (v! IN ) Objeto Exception +*--------------------------------------------------------------------------------------------------- + Lparameters toEx As Exception - LOCAL lcMethods, I, lcLine, laCodeLines(1), lcMethod, lcLocation, lnErrorLine - STORE '' TO lcMethods, lcLine, laCodeLines, lcMethod, lcLocation - STORE 0 TO lnErrorLine, I + Local lcMethods, I, lcLine, laCodeLines(1), lcMethod, lcLocation, lnErrorLine + Store '' To lcMethods, lcLine, laCodeLines, lcMethod, lcLocation + Store 0 To lnErrorLine, I - WITH THIS AS c_conversor_bin_a_prg OF 'FOXBIN2PRG.PRG' + With This As c_conversor_bin_a_prg Of 'FOXBIN2PRG.PRG' toEx.UserValue = toEx.UserValue + CR_LF - IF NOT EMPTY(ALIAS()) AND INLIST(.c_Type, 'SCX', 'VCX') THEN - IF TYPE("METHODS")#"U" THEN + If Not Empty(Alias()) And Inlist(.c_Type, 'SCX', 'VCX') Then + If Type("METHODS")#"U" Then lcMethods = METHODS - ENDIF + Endif toEx.UserValue = toEx.UserValue + 'Error location ' + '..............................' + CR_LF - IF TYPE("PARENT")#"U" AND NOT EMPTY(Parent) THEN + If Type("PARENT")#"U" And Not Empty(Parent) Then lcLocation = lcLocation + Parent + '.' - ENDIF + Endif - IF TYPE("OBJNAME")#"U" THEN + If Type("OBJNAME")#"U" Then lcLocation = lcLocation + OBJNAME - ENDIF + Endif - *-- Busco el Procedure si hay un n_Methods_LineNo - ALINES(laCodeLines, lcMethods) +*-- Busco el Procedure si hay un n_Methods_LineNo + Alines(laCodeLines, lcMethods) - FOR I = .n_Methods_LineNo TO 1 STEP -1 - lcLine = LTRIM( laCodeLines(m.I), 0, ' ', CHR(9) ) + For I = .n_Methods_LineNo To 1 Step -1 + lcLine = Ltrim( laCodeLines(m.I), 0, ' ', Chr(9) ) - DO CASE - CASE LEFT(lcLine, 10) == 'PROCEDURE ' - lcMethod = ALLTRIM( SUBSTR( lcLine, 11) ) - lnErrorLine = .n_Methods_LineNo - m.I - EXIT + Do Case + Case Left(lcLine, 10) == 'PROCEDURE ' + lcMethod = Alltrim( Substr( lcLine, 11) ) + lnErrorLine = .n_Methods_LineNo - m.I + Exit - CASE LEFT(lcLine, 9) == 'FUNCTION ' - lcMethod = ALLTRIM( SUBSTR( lcLine, 10) ) - lnErrorLine = .n_Methods_LineNo - m.I - EXIT + Case Left(lcLine, 9) == 'FUNCTION ' + lcMethod = Alltrim( Substr( lcLine, 10) ) + lnErrorLine = .n_Methods_LineNo - m.I + Exit - ENDCASE + Endcase - ENDFOR + Endfor - IF EMPTY(lcMethod) THEN + If Empty(lcMethod) Then lcLocation = 'Class: ' + lcLocation - ELSE + Else lcLocation = 'Method: ' + lcLocation + '.' + lcMethod - ENDIF + Endif - IF lnErrorLine > 0 THEN - lcLocation = lcLocation + ', Line ' + TRANSFORM(lnErrorLine) - ENDIF + If lnErrorLine > 0 Then + lcLocation = lcLocation + ', Line ' + Transform(lnErrorLine) + Endif toEx.UserValue = toEx.UserValue + lcLocation + CR_LF - IF .n_Methods_LineNo = 0 THEN + If .n_Methods_LineNo = 0 Then toEx.UserValue = toEx.UserValue + '> (no evaluated code yet)' + CR_LF - ELSE + Else toEx.UserValue = toEx.UserValue + '> ' + laCodeLines(.n_Methods_LineNo) + CR_LF - ENDIF - ENDIF + Endif + Endif - toEx.UserValue = toEx.UserValue + 'Recno: ' + TRANSFORM(RECNO()) + CR_LF + toEx.UserValue = toEx.UserValue + 'Recno: ' + Transform(Recno()) + CR_LF toEx.UserValue = toEx.UserValue + '.............................................' + CR_LF - ENDWITH - ENDPROC + Endwith + Endproc - PROCEDURE sortMethod - LPARAMETERS tcMethod, taMethods, taCode, tcSorted, tnMethodCount, taPropsAndComments, tnPropsAndComments_Count ; + Procedure sortMethod + Lparameters tcMethod, taMethods, taCode, tcSorted, tnMethodCount, taPropsAndComments, tnPropsAndComments_Count ; , taProtected, tnProtected_Count, toFoxBin2Prg - EXTERNAL ARRAY taMethods, taCode, taPropsAndComments, taProtected + External Array taMethods, taCode, taPropsAndComments, taProtected - #IF .F. - LOCAL toFoxBin2Prg AS c_foxbin2prg OF 'FOXBIN2PRG.PRG' - #ENDIF + #If .F. + Local toFoxBin2Prg As c_foxbin2prg Of 'FOXBIN2PRG.PRG' + #Endif - TRY - LOCAL I, I2, laMethods(1,3), lnDeleted, lcMethodName, lnMethodPos, lcMethodType, loEx AS EXCEPTION + Try + Local I, I2, laMethods(1,3), lnDeleted, lcMethodName, lnMethodPos, lcMethodType, loEx As Exception - IF tnMethodCount > 0 THEN + If tnMethodCount > 0 Then - *-- taMethods[1,3] - *-- 1.Nombre Método - *-- 2.Posición Original - *-- 3.Tipo (HIDDEN/PROTECTED/NORMAL) +*-- taMethods[1,3] +*-- 1.Nombre Método +*-- 2.Posición Original +*-- 3.Tipo (HIDDEN/PROTECTED/NORMAL) - *-- Alphabetical ordering of methods - IF THIS.l_MethodSort_Enabled - ASORT(taMethods,1,-1,0,1) - ENDIF +*-- Alphabetical ordering of methods + If This.l_MethodSort_Enabled + Asort(taMethods,1,-1,0,1) + Endif - DIMENSION laMethods(tnMethodCount,3) - lnDeleted = 0 + Dimension laMethods(tnMethodCount,3) + lnDeleted = 0 - FOR I = tnMethodCount TO 1 STEP -1 - IF taMethods(m.I,2) > 0 THEN - IF '.' $ taMethods(m.I,1) - *-- Los métodos con '.' los mando a otro array - lnDeleted = lnDeleted + 1 - laMethods(lnDeleted,1) = taMethods(m.I,1) - laMethods(lnDeleted,2) = taMethods(m.I,2) - laMethods(lnDeleted,3) = taMethods(m.I,3) - ADEL( taMethods, m.I ) - ENDIF - ENDIF - ENDFOR + For I = tnMethodCount To 1 Step -1 + If taMethods(m.I,2) > 0 Then + If '.' $ taMethods(m.I,1) +*-- Los métodos con '.' los mando a otro array + lnDeleted = lnDeleted + 1 + laMethods(lnDeleted,1) = taMethods(m.I,1) + laMethods(lnDeleted,2) = taMethods(m.I,2) + laMethods(lnDeleted,3) = taMethods(m.I,3) + Adel( taMethods, m.I ) + Endif + Endif + Endfor - FOR I = lnDeleted TO 1 STEP -1 - *-- Los métodos con '.' los paso al final - I2 = tnMethodCount - lnDeleted + (lnDeleted - m.I) + 1 - taMethods(I2,1) = laMethods(m.I,1) - taMethods(I2,2) = laMethods(m.I,2) - taMethods(I2,3) = laMethods(m.I,3) - ENDFOR + For I = lnDeleted To 1 Step -1 +*-- Los métodos con '.' los paso al final + I2 = tnMethodCount - lnDeleted + (lnDeleted - m.I) + 1 + taMethods(I2,1) = laMethods(m.I,1) + taMethods(I2,2) = laMethods(m.I,2) + taMethods(I2,3) = laMethods(m.I,3) + Endfor - ENDIF + Endif - CATCH TO loEx - IF THIS.n_Debug > 0 AND _VFP.STARTMODE = 0 - SET STEP ON - ENDIF + Catch To loEx + If This.n_Debug > 0 And _vfp.StartMode = 0 + Set Step On + Endif - THROW + Throw - FINALLY - RELEASE tcMethod, taMethods, taCode, tcSorted, tnMethodCount, taPropsAndComments, tnPropsAndComments_Count ; - , taProtected, tnProtected_Count, toFoxBin2Prg ; - , I, I2, laMethods, lnDeleted, lcMethodName, lnMethodPos, lcMethodType, loEx - ENDTRY + Finally + Release tcMethod, taMethods, taCode, tcSorted, tnMethodCount, taPropsAndComments, tnPropsAndComments_Count ; + , taProtected, tnProtected_Count, toFoxBin2Prg ; + , I, I2, laMethods, lnDeleted, lcMethodName, lnMethodPos, lcMethodType, loEx + Endtry - RETURN - ENDPROC && SordMethod + Return + Endproc && SordMethod - PROCEDURE method2Array - LPARAMETERS tcMethod, taMethods, taCode, tcSorted, tnMethodCount, taPropsAndComments, tnPropsAndComments_Count ; + Procedure method2Array + Lparameters tcMethod, taMethods, taCode, tcSorted, tnMethodCount, taPropsAndComments, tnPropsAndComments_Count ; , taProtected, tnProtected_Count, toFoxBin2Prg, toRegObj - *-- 29/10/2013 Fernando D. Bozzo - *-- Se tiene en cuenta la posibilidad de que haya un PROC/ENDPROC dentro de un TEXT/ENDTEXT - *-- cuando es usado en un generador de código o similar. - EXTERNAL ARRAY taMethods, taCode, taPropsAndComments, taProtected +*-- 29/10/2013 Fernando D. Bozzo +*-- Se tiene en cuenta la posibilidad de que haya un PROC/ENDPROC dentro de un TEXT/ENDTEXT +*-- cuando es usado en un generador de código o similar. + External Array taMethods, taCode, taPropsAndComments, taProtected - #IF .F. - LOCAL toFoxBin2Prg AS c_foxbin2prg OF 'FOXBIN2PRG.PRG' - #ENDIF + #If .F. + Local toFoxBin2Prg As c_foxbin2prg Of 'FOXBIN2PRG.PRG' + #Endif - *-- ESTRUCTURA DE LOS ARRAYS CREADOS: - *-- taMethods[1,3] - *-- 1.Nombre Método - *-- 2.Posición Original - *-- 3.Tipo (HIDDEN/PROTECTED/NORMAL) - *-- taCode[1] - *-- 1.Bloque de código del método en su posición original - TRY - LOCAL lnLineCount, laLine(1), I, lnTextNodes, tcSorted, lnProtectedLine, lcMethod, lnLine_Len, lcLine, llProcOpen ; - , laLineasExclusion(1), lnBloquesExclusion, lcLastLine ; - , loEx AS EXCEPTION +*-- ESTRUCTURA DE LOS ARRAYS CREADOS: +*-- taMethods[1,3] +*-- 1.Nombre Método +*-- 2.Posición Original +*-- 3.Tipo (HIDDEN/PROTECTED/NORMAL) +*-- taCode[1] +*-- 1.Bloque de código del método en su posición original + Try + Local lnLineCount, laLine(1), I, lnTextNodes, tcSorted, lnProtectedLine, lcMethod, lnLine_Len, lcLine, llProcOpen ; + , laLineasExclusion(1), lnBloquesExclusion, lcLastLine ; + , loEx As Exception - IF NOT EMPTY(m.tcMethod) AND LEFT(m.tcMethod,9) == "ENDPROC"+CHR(13)+CHR(10) - tcMethod = SUBSTR(m.tcMethod,10) - ENDIF + If Not Empty(m.tcMethod) And Left(m.tcMethod,9) == "ENDPROC"+Chr(13)+Chr(10) + tcMethod = Substr(m.tcMethod,10) + Endif - IF NOT EMPTY(m.tcMethod) - WITH THIS AS c_conversor_bin_a_prg OF 'FOXBIN2PRG.PRG' - DIMENSION laLine(1) - STORE '' TO laLine, lcLine, lcLastLine - STORE 0 TO lnTextNodes + If Not Empty(m.tcMethod) + With This As c_conversor_bin_a_prg Of 'FOXBIN2PRG.PRG' + Dimension laLine(1) + Store '' To laLine, lcLine, lcLastLine + Store 0 To lnTextNodes - lnLineCount = ALINES(laLine, m.tcMethod) && NO aplicar nungún formato ni limpieza, que es el CÓDIGO FUENTE + lnLineCount = Alines(laLine, m.tcMethod) && NO aplicar nungún formato ni limpieza, que es el CÓDIGO FUENTE - *-- Delete beginning empty lines before first "PROCEDURE", that is the first not empty line. - FOR I = 1 TO lnLineCount - IF EMPTY(laLine(m.I)) OR LEFT( LTRIM(laLine(m.I)),1 ) = '*' - *-- Skip empty and commented lines - ELSE - IF m.I > 1 - FOR X = m.I-1 TO 1 STEP -1 - ADEL(laLine, m.X) - ENDFOR - lnLineCount = lnLineCount - m.I + 1 - DIMENSION laLine(lnLineCount) - ENDIF - EXIT - ENDIF - ENDFOR +*-- Delete beginning empty lines before first "PROCEDURE", that is the first not empty line. + For I = 1 To lnLineCount + If Empty(laLine(m.I)) Or Left( Ltrim(laLine(m.I)),1 ) = '*' +*-- Skip empty and commented lines + Else + If m.I > 1 + For X = m.I-1 To 1 Step -1 + Adel(laLine, m.X) + Endfor + lnLineCount = lnLineCount - m.I + 1 + Dimension laLine(lnLineCount) + Endif + Exit + Endif + Endfor - *-- Delete ending empty lines after last "ENDPROC", that is the last not empty line. - FOR I = lnLineCount TO 1 STEP -1 - IF EMPTY(laLine(m.I)) OR LEFT( LTRIM(laLine(m.I)),1 ) = '*' - ADEL(laLine, m.I) - ELSE - IF m.I < lnLineCount - lnLineCount = m.I - DIMENSION laLine(lnLineCount) - ENDIF - EXIT - ENDIF - ENDFOR +*-- Delete ending empty lines after last "ENDPROC", that is the last not empty line. + For I = lnLineCount To 1 Step -1 + If Empty(laLine(m.I)) Or Left( Ltrim(laLine(m.I)),1 ) = '*' + Adel(laLine, m.I) + Else + If m.I < lnLineCount + lnLineCount = m.I + Dimension laLine(lnLineCount) + Endif + Exit + Endif + Endfor - *-- Identifico los TEXT/ENDTEXT, #IF .F./#ENDIF - .identifyExclusionBlocks( @laLine, lnLineCount, .F., @laLineasExclusion, @lnBloquesExclusion ) +*-- Identifico los TEXT/ENDTEXT, #IF .F./#ENDIF + .identifyExclusionBlocks( @laLine, lnLineCount, .F., @laLineasExclusion, @lnBloquesExclusion ) - *-- Analyze and count line methods, get method names and consolidate block code - FOR I = 1 TO lnLineCount - IF toFoxBin2Prg.l_RemoveNullCharsFromCode - laLine(m.I) = CHRTRAN( laLine(m.I), C_NULL_CHAR, '' ) - ENDIF +*-- Analyze and count line methods, get method names and consolidate block code + For I = 1 To lnLineCount + If toFoxBin2Prg.l_RemoveNullCharsFromCode + laLine(m.I) = Chrtran( laLine(m.I), C_NULL_CHAR, '' ) + Endif - lnLine_Len = LEN( laLine(m.I) ) - lcLastLine = lcLine - toFoxBin2Prg.set_Line( @lcLine, @laLine, m.I ) - .get_SeparatedLineAndComment( @lcLine ) + lnLine_Len = Len( laLine(m.I) ) + lcLastLine = lcLine + toFoxBin2Prg.set_Line( @lcLine, @laLine, m.I ) + .get_SeparatedLineAndComment( @lcLine ) - DO CASE - CASE laLineasExclusion(m.I) - IF tnMethodCount > 0 AND llProcOpen - taCode(tnMethodCount) = taCode(tnMethodCount) + laLine(m.I) + CR_LF - ELSE - *-- Invalid method code, as outer code added for tools like ReFox or others, is cleaned up - ENDIF + Do Case + Case laLineasExclusion(m.I) + If tnMethodCount > 0 And llProcOpen + taCode(tnMethodCount) = taCode(tnMethodCount) + laLine(m.I) + CR_LF + Else +*-- Invalid method code, as outer code added for tools like ReFox or others, is cleaned up + Endif - CASE RIGHT(lcLastLine,1) == ';' - *-- Saltear el análisis de esta línea, que es continuación de la anterior (lcLastLine). - taCode(tnMethodCount) = taCode(tnMethodCount) + laLine(m.I) + CR_LF - LOOP + Case Right(lcLastLine,1) == ';' +*-- Saltear el análisis de esta línea, que es continuación de la anterior (lcLastLine). + taCode(tnMethodCount) = taCode(tnMethodCount) + laLine(m.I) + CR_LF + Loop - 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), 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 - llProcOpen = .T. - - 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), 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 - llProcOpen = .T. - - 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), 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 - llProcOpen = .T. - - 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), 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 - llProcOpen = .T. - - 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), 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 - llProcOpen = .T. - - 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), 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 - llProcOpen = .T. - - CASE lnTextNodes = 0 AND LEFT(lcLine, 7) == 'ENDPROC' - IF lnLine_Len >= 7 AND LEFT( UPPER( CHRTRAN( lcLine , '&'+CHR(9)+CHR(0), ' ') ) + ' ' ,8) == 'ENDPROC ' - *-- Es el final de estructura ENDPROC - IF NOT llProcOpen - *-- Esto no es normal, porque hay más de un ENDPROC, por lo que se ignora. - LOOP - ENDIF - ELSE - *-- Es otra cosa (variable, etc) - taCode(tnMethodCount) = taCode(tnMethodCount) + lcLine + CR_LF - LOOP - ENDIF - - taCode(tnMethodCount) = taCode(tnMethodCount) + lcLine &&+ CR_LF - llProcOpen = .F. - - CASE lnTextNodes = 0 AND LEFT(laLine(m.I), 7) == 'ENDFUNC' && NOT VALID WITH VFP IDE, BUT 3rd. PARTY SOFTWARE CAN USE IT - IF lnLine_Len >= 7 AND LEFT( UPPER( CHRTRAN( laLine(m.I) , '&'+CHR(9)+CHR(0), ' ') ) + ' ' ,8) == 'ENDFUNC ' - *-- Es el final de estructura ENDPROC - IF NOT llProcOpen - *-- Esto no es normal, porque hay más de un ENDFUNC, por lo que se ignora. - LOOP - ENDIF - lcLine = STRTRAN( lcLine, 'ENDFUNC', 'ENDPROC' ) - ELSE - *-- Es otra cosa (variable, etc) - taCode(tnMethodCount) = taCode(tnMethodCount) + lcLine + CR_LF - LOOP - ENDIF - - taCode(tnMethodCount) = taCode(tnMethodCount) + lcLine &&+ CR_LF - llProcOpen = .F. - - *CASE tnMethodCount = 0 OR NOT llProcOpen AND LEFT( LTRIM(laLine(m.I)),1 ) = '*' - CASE tnMethodCount = 0 OR NOT llProcOpen - *-- Skip empty and commented lines before methods begin - *-- Aquí como condición podría poner: NOT llProcOpen AND LEFT(laLine(m.I), 7) # 'ENDPROC', pero abarcaría demasiado. - - OTHERWISE && Method Code - taCode(tnMethodCount) = taCode(tnMethodCount) + laLine(m.I) + CR_LF - - ENDCASE - ENDFOR - - *-- Agrego los métodos definidos, pero sin código (Protected/Reserved3) - FOR I = 1 TO tnPropsAndComments_Count - lcMethod = CHRTRAN( taPropsAndComments(m.I,1), '*', '' ) - IF LEFT( taPropsAndComments(m.I,1), 1 ) == '*' AND ASCAN( taMethods, lcMethod, 1, 0, 1, 1+2+4+8 ) = 0 - tnMethodCount = tnMethodCount + 1 - DIMENSION taMethods(tnMethodCount, 3) &&, taCode(tnMethodCount) - taMethods(tnMethodCount, 1) = lcMethod - taMethods(tnMethodCount, 2) = 0 - - lnProtectedLine = ASCAN( taProtected, lcMethod, 1, 0, 1, 1+2+4+8 ) - - IF lnProtectedLine = 0 THEN - IF tnProtected_Count = 0 - lnProtectedLine = 0 - ELSE - lnProtectedLine = ASCAN( taProtected, lcMethod + '^', 1, 0, 1, 1+2+4+8 ) - ENDIF - - IF lnProtectedLine = 0 THEN + 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), 0, Chr(9), Chr(0), ' ' ) + taMethods(tnMethodCount, 2) = tnMethodCount taMethods(tnMethodCount, 3) = '' - ELSE + taCode(tnMethodCount) = 'PROCEDURE ' + taMethods(tnMethodCount, 1) + CR_LF && laLine(m.I) + CR_LF + llProcOpen = .T. + + 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), 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 + llProcOpen = .T. + + 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), 0, Chr(9), Chr(0), ' ' ) + taMethods(tnMethodCount, 2) = tnMethodCount taMethods(tnMethodCount, 3) = 'HIDDEN ' - ENDIF - ELSE - taMethods(tnMethodCount, 3) = 'PROTECTED ' - ENDIF - ENDIF - ENDFOR - ENDWITH && THIS AS c_conversor_bin_a_prg OF 'FOXBIN2PRG.PRG' - ENDIF + taCode(tnMethodCount) = 'HIDDEN PROCEDURE ' + taMethods(tnMethodCount, 1) + CR_LF && laLine(m.I) + CR_LF + llProcOpen = .T. - CATCH TO loEx - IF THIS.n_Debug > 0 AND _VFP.STARTMODE = 0 - SET STEP ON - ENDIF + 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), 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 + llProcOpen = .T. - THROW + 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), 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 + llProcOpen = .T. - FINALLY - RELEASE tcMethod, taMethods, taCode, tcSorted, tnMethodCount, taPropsAndComments, tnPropsAndComments_Count ; - , taProtected, tnProtected_Count, toFoxBin2Prg ; - , lnLineCount, laLine, I, lnTextNodes, tcSorted, lnProtectedLine, lcMethod, lnLine_Len, lcLine, llProcOpen ; - , laLineasExclusion, lnBloquesExclusion ; - , loEx - ENDTRY + 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), 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 + llProcOpen = .T. - RETURN - ENDPROC && method2Array + Case lnTextNodes = 0 And Left(lcLine, 7) == 'ENDPROC' + If lnLine_Len >= 7 And Left( Upper( Chrtran( lcLine , '&'+Chr(9)+Chr(0), ' ') ) + ' ' ,8) == 'ENDPROC ' +*-- Es el final de estructura ENDPROC + If Not llProcOpen +*-- Esto no es normal, porque hay más de un ENDPROC, por lo que se ignora. + Loop + Endif + Else +*-- Es otra cosa (variable, etc) + taCode(tnMethodCount) = taCode(tnMethodCount) + lcLine + CR_LF + Loop + Endif + + taCode(tnMethodCount) = taCode(tnMethodCount) + lcLine &&+ CR_LF + llProcOpen = .F. + + Case lnTextNodes = 0 And Left(laLine(m.I), 7) == 'ENDFUNC' && NOT VALID WITH VFP IDE, BUT 3rd. PARTY SOFTWARE CAN USE IT + If lnLine_Len >= 7 And Left( Upper( Chrtran( laLine(m.I) , '&'+Chr(9)+Chr(0), ' ') ) + ' ' ,8) == 'ENDFUNC ' +*-- Es el final de estructura ENDPROC + If Not llProcOpen +*-- Esto no es normal, porque hay más de un ENDFUNC, por lo que se ignora. + Loop + Endif + lcLine = Strtran( lcLine, 'ENDFUNC', 'ENDPROC' ) + Else +*-- Es otra cosa (variable, etc) + taCode(tnMethodCount) = taCode(tnMethodCount) + lcLine + CR_LF + Loop + Endif + + taCode(tnMethodCount) = taCode(tnMethodCount) + lcLine &&+ CR_LF + llProcOpen = .F. + +*CASE tnMethodCount = 0 OR NOT llProcOpen AND LEFT( LTRIM(laLine(m.I)),1 ) = '*' + Case tnMethodCount = 0 Or Not llProcOpen +*-- Skip empty and commented lines before methods begin +*-- Aquí como condición podría poner: NOT llProcOpen AND LEFT(laLine(m.I), 7) # 'ENDPROC', pero abarcaría demasiado. + + Otherwise && Method Code + taCode(tnMethodCount) = taCode(tnMethodCount) + laLine(m.I) + CR_LF + + Endcase + Endfor + +*-- Agrego los métodos definidos, pero sin código (Protected/Reserved3) + For I = 1 To tnPropsAndComments_Count + lcMethod = Chrtran( taPropsAndComments(m.I,1), '*', '' ) + If Left( taPropsAndComments(m.I,1), 1 ) == '*' And Ascan( taMethods, lcMethod, 1, 0, 1, 1+2+4+8 ) = 0 + tnMethodCount = tnMethodCount + 1 + Dimension taMethods(tnMethodCount, 3) &&, taCode(tnMethodCount) + taMethods(tnMethodCount, 1) = lcMethod + taMethods(tnMethodCount, 2) = 0 + + lnProtectedLine = Ascan( taProtected, lcMethod, 1, 0, 1, 1+2+4+8 ) + + If lnProtectedLine = 0 Then + If tnProtected_Count = 0 + lnProtectedLine = 0 + Else + lnProtectedLine = Ascan( taProtected, lcMethod + '^', 1, 0, 1, 1+2+4+8 ) + Endif + + If lnProtectedLine = 0 Then + taMethods(tnMethodCount, 3) = '' + Else + taMethods(tnMethodCount, 3) = 'HIDDEN ' + Endif + Else + taMethods(tnMethodCount, 3) = 'PROTECTED ' + Endif + Endif + Endfor + Endwith && THIS AS c_conversor_bin_a_prg OF 'FOXBIN2PRG.PRG' + Endif + + Catch To loEx + If This.n_Debug > 0 And _vfp.StartMode = 0 + Set Step On + Endif + + Throw + + Finally + Release tcMethod, taMethods, taCode, tcSorted, tnMethodCount, taPropsAndComments, tnPropsAndComments_Count ; + , taProtected, tnProtected_Count, toFoxBin2Prg ; + , lnLineCount, laLine, I, lnTextNodes, tcSorted, lnProtectedLine, lcMethod, lnLine_Len, lcLine, llProcOpen ; + , laLineasExclusion, lnBloquesExclusion ; + , loEx + Endtry + + Return + Endproc && method2Array - PROCEDURE write_ADD_OBJECTS_WithProperties - *--------------------------------------------------------------------------------------------------- - * PARÁMETROS: (v=Pasar por valor | @=Pasar por referencia) (!=Obligatorio | ?=Opcional) (IN/OUT) - * toRegObj (v! IN ) Objeto de registro - * tcCodigo (@? OUT) Codigo generado - * toFoxBin2Prg (v! IN ) Referencia al objeto principal - *--------------------------------------------------------------------------------------------------- - LPARAMETERS toRegObj, tcCodigo, toFoxBin2Prg + Procedure write_ADD_OBJECTS_WithProperties +*--------------------------------------------------------------------------------------------------- +* PARÁMETROS: (v=Pasar por valor | @=Pasar por referencia) (!=Obligatorio | ?=Opcional) (IN/OUT) +* toRegObj (v! IN ) Objeto de registro +* tcCodigo (@? OUT) Codigo generado +* toFoxBin2Prg (v! IN ) Referencia al objeto principal +*--------------------------------------------------------------------------------------------------- + Lparameters toRegObj, tcCodigo, toFoxBin2Prg - #IF .F. - LOCAL toRegObj AS CL_OBJETO OF 'FOXBIN2PRG.PRG' - LOCAL toFoxBin2Prg AS c_foxbin2prg OF 'FOXBIN2PRG.PRG' - #ENDIF + #If .F. + Local toRegObj As CL_OBJETO Of 'FOXBIN2PRG.PRG' + Local toFoxBin2Prg As c_foxbin2prg Of 'FOXBIN2PRG.PRG' + #Endif - TRY - LOCAL lcMemo, laPropsAndValues(1,2), lnPropsAndValues_Count + Try + Local lcMemo, laPropsAndValues(1,2), lnPropsAndValues_Count - WITH THIS AS c_conversor_bin_a_prg OF 'FOXBIN2PRG.PRG' - *-- Defino los objetos a cargar - .get_PropsAndValuesFrom_PROPERTIES( toRegObj.PROPERTIES, 1, @laPropsAndValues, @lnPropsAndValues_Count, @lcMemo, @toFoxBin2Prg ) - lcMemo = .set_MultilineMemoWithAddObjectProperties( @laPropsAndValues, @lnPropsAndValues_Count, C_TAB + C_TAB, .T. ) + With This As c_conversor_bin_a_prg Of 'FOXBIN2PRG.PRG' +*-- Defino los objetos a cargar + .get_PropsAndValuesFrom_PROPERTIES( toRegObj.PROPERTIES, 1, @laPropsAndValues, @lnPropsAndValues_Count, @lcMemo, @toFoxBin2Prg ) + lcMemo = .set_MultilineMemoWithAddObjectProperties( @laPropsAndValues, @lnPropsAndValues_Count, C_TAB + C_TAB, .T. ) - IF '.' $ toRegObj.PARENT - *-- Este caso: clase.objeto.objeto ==> se quita clase - TEXT TO tcCodigo ADDITIVE TEXTMERGE NOSHOW FLAGS 1+2 PRETEXT 1+2 + If '.' $ toRegObj.Parent +*-- Este caso: clase.objeto.objeto ==> se quita clase + TEXT TO tcCodigo ADDITIVE TEXTMERGE NOSHOW FLAGS 1+2 PRETEXT 1+2 <<>> ADD OBJECT '<>.<>' AS <> <<>> - ENDTEXT - ELSE - *-- Este caso: objeto - TEXT TO tcCodigo ADDITIVE TEXTMERGE NOSHOW FLAGS 1+2 PRETEXT 1+2 + ENDTEXT + Else +*-- Este caso: objeto + TEXT TO tcCodigo ADDITIVE TEXTMERGE NOSHOW FLAGS 1+2 PRETEXT 1+2 <<>> ADD OBJECT '<>' AS <> <<>> - ENDTEXT - ENDIF + ENDTEXT + Endif - IF NOT EMPTY(lcMemo) - TEXT TO tcCodigo ADDITIVE TEXTMERGE NOSHOW FLAGS 1 PRETEXT 1+2 + If Not Empty(lcMemo) + TEXT TO tcCodigo ADDITIVE TEXTMERGE NOSHOW FLAGS 1 PRETEXT 1+2 <> ; <> - ENDTEXT - ENDIF + ENDTEXT + Endif - TEXT TO tcCodigo ADDITIVE TEXTMERGE NOSHOW FLAGS 1+2 PRETEXT 1+2 + TEXT TO tcCodigo ADDITIVE TEXTMERGE NOSHOW FLAGS 1+2 PRETEXT 1+2 <><> <<>> - ENDTEXT - - IF NOT EMPTY(toRegObj.CLASSLOC) - TEXT TO tcCodigo ADDITIVE TEXTMERGE NOSHOW FLAGS 1 PRETEXT 1+2 - ClassLib="<>" <<>> ENDTEXT - ENDIF - TEXT TO tcCodigo ADDITIVE TEXTMERGE NOSHOW FLAGS 1 PRETEXT 1+2+4+8 - BaseClass="<>" <<>> - ENDTEXT + If Not Empty(toRegObj.CLASSLOC) + TEXT TO tcCodigo ADDITIVE TEXTMERGE NOSHOW FLAGS 1 PRETEXT 1+2 + ClassLib="<>" <<>> + ENDTEXT + Endif - *-- Agrego metainformación para objetos OLE - IF toRegObj.BASECLASS == 'olecontrol' TEXT TO tcCodigo ADDITIVE TEXTMERGE NOSHOW FLAGS 1 PRETEXT 1+2+4+8 + BaseClass="<>" <<>> + ENDTEXT + +*-- Agrego metainformación para objetos OLE + If toRegObj.BaseClass == 'olecontrol' + TEXT TO tcCodigo ADDITIVE TEXTMERGE NOSHOW FLAGS 1 PRETEXT 1+2+4+8 OLEObject="< 0 Then + Store '' To lcMethods + Dimension laMethods(1,3) - WITH THIS AS c_conversor_bin_a_prg OF 'FOXBIN2PRG.PRG' + With This As c_conversor_bin_a_prg Of 'FOXBIN2PRG.PRG' .sortMethod( @tcMethods, @taMethods, @taCode, '', @tnMethodCount ; , @taPropsAndComments, tnPropsAndComments_Count, @taProtected, tnProtected_Count, @toFoxBin2Prg ) lcMethods = C_TAB - FOR I = 1 TO tnMethodCount - *-- Genero los métodos indentados - *-- Sustituyo el TEXT/ENDTEXT aquí porque a veces quita espacios de la derecha, y eso es peligroso - IF taMethods(m.I,2) = 0 - LOOP - ENDIF + For I = 1 To tnMethodCount +*-- Genero los métodos indentados +*-- Sustituyo el TEXT/ENDTEXT aquí porque a veces quita espacios de la derecha, y eso es peligroso + If taMethods(m.I,2) = 0 + Loop + Endif - lcMethods = lcMethods + CR_LF + .indentMemo( taCode(taMethods(m.I,2)), CHR(9) + CHR(9), .T. ) + CR_LF - ENDFOR - ENDWITH && THIS + lcMethods = lcMethods + CR_LF + .indentMemo( taCode(taMethods(m.I,2)), Chr(9) + Chr(9), .T. ) + CR_LF + Endfor + Endwith && THIS tcCodigo = tcCodigo + lcMethods - ENDIF + Endif - RELEASE tcMethods, taMethods, taCode, tnMethodCount, taPropsAndComments, tnPropsAndComments_Count, taProtected, tnProtected_Count, toFoxBin2Prg ; + Release tcMethods, taMethods, taCode, tnMethodCount, taPropsAndComments, tnPropsAndComments_Count, taProtected, tnProtected_Count, toFoxBin2Prg ; , laMethods, laCode, lnMethodCount, I, lcMethods - RETURN - ENDPROC + Return + Endproc - PROCEDURE write_CLASS_PROPERTIES - LPARAMETERS toRegClass, taPropsAndValues, taPropsAndComments, taProtected ; + Procedure write_CLASS_PROPERTIES + Lparameters toRegClass, taPropsAndValues, taPropsAndComments, taProtected ; , tnPropsAndValues_Count, tnPropsAndComments_Count, tnProtected_Count, tcCodigo, toFoxBin2Prg - EXTERNAL ARRAY taPropsAndValues, taPropsAndComments + External Array taPropsAndValues, taPropsAndComments - TRY - LOCAL lcHiddenProp, lcProtectedProp, lcPropsMethodsDefd, I ; - , lcPropName, lnProtectedItem, lcComentarios ; - , loEx as Exception + Try + Local lcHiddenProp, lcProtectedProp, lcPropsMethodsDefd, I ; + , lcPropName, lnProtectedItem, lcComentarios ; + , loEx As Exception - WITH THIS AS c_conversor_bin_a_prg OF 'FOXBIN2PRG.PRG' - *-- DEFINIR PROPIEDADES ( HIDDEN, PROTECTED, *DEFINED_PAM ) - DIMENSION taProtected(1) - STORE '' TO lcHiddenProp, lcProtectedProp, lcPropsMethodsDefd - STORE 0 TO tnPropsAndValues_Count, tnPropsAndComments_Count, tnProtected_Count - .get_PropsAndValuesFrom_PROPERTIES( toRegClass.PROPERTIES, 1, @taPropsAndValues, @tnPropsAndValues_Count, '', @toFoxBin2Prg ) - .get_PropsAndCommentsFrom_RESERVED3( toRegClass.RESERVED3, .T., @taPropsAndComments, @tnPropsAndComments_Count, '' ) - .get_PropsFrom_PROTECTED( toRegClass.PROTECTED, .T., @taProtected, @tnProtected_Count, '' ) + With This As c_conversor_bin_a_prg Of 'FOXBIN2PRG.PRG' +*-- DEFINIR PROPIEDADES ( HIDDEN, PROTECTED, *DEFINED_PAM ) + Dimension taProtected(1) + Store '' To lcHiddenProp, lcProtectedProp, lcPropsMethodsDefd + Store 0 To tnPropsAndValues_Count, tnPropsAndComments_Count, tnProtected_Count + .get_PropsAndValuesFrom_PROPERTIES( toRegClass.PROPERTIES, 1, @taPropsAndValues, @tnPropsAndValues_Count, '', @toFoxBin2Prg ) + .get_PropsAndCommentsFrom_RESERVED3( toRegClass.RESERVED3, .T., @taPropsAndComments, @tnPropsAndComments_Count, '' ) + .get_PropsFrom_PROTECTED( toRegClass.Protected, .T., @taProtected, @tnProtected_Count, '' ) - IF tnPropsAndValues_Count > 0 THEN - .classify_PAM_Hidden_Protected( @tnPropsAndValues_Count, @taPropsAndValues, @tnProtected_Count, @taProtected ; - , @tnPropsAndComments_Count, @taPropsAndComments, @lcHiddenProp, @lcProtectedProp ) - .write_DEFINED_PAM( @taPropsAndComments, tnPropsAndComments_Count, @tcCodigo ) - .write_HIDDEN_Properties( @lcHiddenProp, @tcCodigo ) - .write_PROTECTED_Properties( @lcProtectedProp, @tcCodigo ) + If tnPropsAndValues_Count > 0 Then + .classify_PAM_Hidden_Protected( @tnPropsAndValues_Count, @taPropsAndValues, @tnProtected_Count, @taProtected ; + , @tnPropsAndComments_Count, @taPropsAndComments, @lcHiddenProp, @lcProtectedProp ) + .write_DEFINED_PAM( @taPropsAndComments, tnPropsAndComments_Count, @tcCodigo ) + .write_HIDDEN_Properties( @lcHiddenProp, @tcCodigo ) + .write_PROTECTED_Properties( @lcProtectedProp, @tcCodigo ) - *-- Escribo las propiedades de la clase y sus comentarios (los comentarios aquí son redundantes) - FOR I = 1 TO tnPropsAndValues_Count - tcCodigo = tcCodigo + CHR(13) + CHR(10) + CHR(9) + taPropsAndValues(m.I,1) + ' = ' + taPropsAndValues(m.I,2) +*-- Escribo las propiedades de la clase y sus comentarios (los comentarios aquí son redundantes) + For I = 1 To tnPropsAndValues_Count + tcCodigo = tcCodigo + Chr(13) + Chr(10) + Chr(9) + taPropsAndValues(m.I,1) + ' = ' + taPropsAndValues(m.I,2) - IF tnPropsAndComments_Count > 0 THEN - lnComment = ASCAN( taPropsAndComments, taPropsAndValues(m.I,1), 1, 0, 1, 1+2+4+8) + If tnPropsAndComments_Count > 0 Then + lnComment = Ascan( taPropsAndComments, taPropsAndValues(m.I,1), 1, 0, 1, 1+2+4+8) - IF lnComment > 0 AND NOT EMPTY(taPropsAndComments(lnComment,2)) - tcCodigo = tcCodigo + CHR(9) + CHR(9) + '&' + '& ' + taPropsAndComments(lnComment,2) - ENDIF - ENDIF - ENDFOR + If lnComment > 0 And Not Empty(taPropsAndComments(lnComment,2)) + tcCodigo = tcCodigo + Chr(9) + Chr(9) + '&' + '& ' + taPropsAndComments(lnComment,2) + Endif + Endif + Endfor - TEXT TO tcCodigo ADDITIVE TEXTMERGE NOSHOW FLAGS 1+2 PRETEXT 1+2 + TEXT TO tcCodigo ADDITIVE TEXTMERGE NOSHOW FLAGS 1+2 PRETEXT 1+2 <<>> - ENDTEXT - ENDIF - ENDWITH && THIS + ENDTEXT + Endif + Endwith && THIS - CATCH TO loEx - IF THIS.n_Debug > 0 AND _VFP.STARTMODE = 0 - SET STEP ON - ENDIF + Catch To loEx + If This.n_Debug > 0 And _vfp.StartMode = 0 + Set Step On + Endif - THROW + Throw - FINALLY - RELEASE toRegClass, taPropsAndValues, taPropsAndComments, taProtected ; - , tnPropsAndValues_Count, tnPropsAndComments_Count, tnProtected_Count ; - , lcHiddenProp, lcProtectedProp, lcPropsMethodsDefd, I ; - , lcPropName, lnProtectedItem, lcComentarios, loEx - ENDTRY + Finally + Release toRegClass, taPropsAndValues, taPropsAndComments, taProtected ; + , tnPropsAndValues_Count, tnPropsAndComments_Count, tnProtected_Count ; + , lcHiddenProp, lcProtectedProp, lcPropsMethodsDefd, I ; + , lcPropName, lnProtectedItem, lcComentarios, loEx + Endtry - RETURN - ENDPROC + Return + Endproc - PROCEDURE write_DEFINED_PAM - *-- Escribo propiedades DEFINED (Reserved3) en este formato: - LPARAMETERS taPropsAndComments, tnPropsAndComments_Count, tcCodigo + Procedure write_DEFINED_PAM +*-- Escribo propiedades DEFINED (Reserved3) en este formato: + Lparameters taPropsAndComments, tnPropsAndComments_Count, tcCodigo - * - *m: *metodovacio_con_comentarios && Este método no tiene código, pero tiene comentarios. A ver que pasa! - *m: *mimetodo && Mi metodo - *p: prop1 && Mi prop 1 - *p: prop_especial_cr && - *a: ^array_1_d[1,0] && Array 1 dimensión (1) - *a: ^array_2_d[1,2] && Array una dimension (1,2) - *p: _memberdata && XML Metadata for customizable properties - * +* +*m: *metodovacio_con_comentarios && Este método no tiene código, pero tiene comentarios. A ver que pasa! +*m: *mimetodo && Mi metodo +*p: prop1 && Mi prop 1 +*p: prop_especial_cr && +*a: ^array_1_d[1,0] && Array 1 dimensión (1) +*a: ^array_2_d[1,2] && Array una dimension (1,2) +*p: _memberdata && XML Metadata for customizable properties +* - IF tnPropsAndComments_Count > 0 - LOCAL I, lcPropsMethodsDefd, lcType + If tnPropsAndComments_Count > 0 + Local I, lcPropsMethodsDefd, lcType lcPropsMethodsDefd = '' TEXT TO tcCodigo ADDITIVE TEXTMERGE NOSHOW FLAGS 1+2 PRETEXT 1+2 <<>> <> ENDTEXT - FOR I = 1 TO tnPropsAndComments_Count - IF EMPTY(taPropsAndComments(m.I,1)) - LOOP - ENDIF + For I = 1 To tnPropsAndComments_Count + If Empty(taPropsAndComments(m.I,1)) + Loop + Endif - lcType = LEFT( taPropsAndComments(m.I,1), 1 ) - lcType = ICASE( lcType == '*', 'm' ; + lcType = Left( taPropsAndComments(m.I,1), 1 ) + lcType = Icase( lcType == '*', 'm' ; , lcType == '^', 'a' ; , 'p' ) - IF lcType == 'p' THEN - tcCodigo = tcCodigo + CHR(13) + CHR(10) + CHR(9) + CHR(9) + '*' + lcType + ': ' + taPropsAndComments(m.I,1) - ELSE - tcCodigo = tcCodigo + CHR(13) + CHR(10) + CHR(9) + CHR(9) + '*' + lcType + ': ' + SUBSTR( taPropsAndComments(m.I,1), 2) - ENDIF + If lcType == 'p' Then + tcCodigo = tcCodigo + Chr(13) + Chr(10) + Chr(9) + Chr(9) + '*' + lcType + ': ' + taPropsAndComments(m.I,1) + Else + tcCodigo = tcCodigo + Chr(13) + Chr(10) + Chr(9) + Chr(9) + '*' + lcType + ': ' + Substr( taPropsAndComments(m.I,1), 2) + Endif - IF NOT EMPTY(taPropsAndComments(m.I,2)) - tcCodigo = tcCodigo + CHR(9) + CHR(9) + '&' + '& ' + taPropsAndComments(m.I,2) - ENDIF - ENDFOR + If Not Empty(taPropsAndComments(m.I,2)) + tcCodigo = tcCodigo + Chr(9) + Chr(9) + '&' + '& ' + taPropsAndComments(m.I,2) + Endif + Endfor TEXT TO tcCodigo ADDITIVE TEXTMERGE NOSHOW FLAGS 1+2 PRETEXT 1+2 <<>> <> @@ -15156,137 +15171,137 @@ DEFINE CLASS c_conversor_bin_a_prg AS c_conversor_base tcCodigo = tcCodigo + CR_LF - RELEASE I, lcPropsMethodsDefd, lcType - ENDIF + Release I, lcPropsMethodsDefd, lcType + Endif - RELEASE taPropsAndComments, tnPropsAndComments_Count - RETURN - ENDPROC + Release taPropsAndComments, tnPropsAndComments_Count + Return + Endproc - PROCEDURE write_DEFINE_CLASS - LPARAMETERS ta_NombresObjsOle, toRegClass, tcCodigo + Procedure write_DEFINE_CLASS + Lparameters ta_NombresObjsOle, toRegClass, tcCodigo - LOCAL lcOF_Classlib, llOleObject + Local lcOF_Classlib, llOleObject lcOF_Classlib = '' - llOleObject = ( ASCAN( ta_NombresObjsOle, toRegClass.OBJNAME, 1, 0, 1, 1+2+4+8) > 0 ) + llOleObject = ( Ascan( ta_NombresObjsOle, toRegClass.OBJNAME, 1, 0, 1, 1+2+4+8) > 0 ) - IF NOT EMPTY(toRegClass.CLASSLOC) - lcOF_Classlib = 'OF "' + LOWER(ALLTRIM(toRegClass.CLASSLOC)) + '" ' - ENDIF + If Not Empty(toRegClass.CLASSLOC) + lcOF_Classlib = 'OF "' + Lower(Alltrim(toRegClass.CLASSLOC)) + '" ' + Endif - *-- DEFINICIÓN DE LA CLASE ( DEFINE CLASS 'className' AS 'classType' [OF 'classLib'] [OLEPUBLIC] ) +*-- DEFINICIÓN DE LA CLASE ( DEFINE CLASS 'className' AS 'classType' [OF 'classLib'] [OLEPUBLIC] ) TEXT TO tcCodigo ADDITIVE TEXTMERGE NOSHOW FLAGS 1+2 PRETEXT 1+2 <<'DEFINE CLASS'>> <> AS <> <> ENDTEXT - RETURN - ENDPROC + Return + Endproc - PROCEDURE write_DEFINE_CLASS_COMMENTS - LPARAMETERS toRegClass, tcCodigo - *-- Comentario de la clase - IF NOT EMPTY(toRegClass.RESERVED7) THEN - *-- Si es multilínea, debe ir en un tag aparte - IF OCCURS( CHR(13), toRegClass.RESERVED7 ) > 0 THEN + Procedure write_DEFINE_CLASS_COMMENTS + Lparameters toRegClass, tcCodigo +*-- Comentario de la clase + If Not Empty(toRegClass.RESERVED7) Then +*-- Si es multilínea, debe ir en un tag aparte + If Occurs( Chr(13), toRegClass.RESERVED7 ) > 0 Then TEXT TO tcCodigo ADDITIVE TEXTMERGE NOSHOW FLAGS 1+2 PRETEXT 1+2 <<>> <> <> <<>> <> ENDTEXT - ELSE && Comentario in-line + Else && Comentario in-line TEXT TO tcCodigo ADDITIVE TEXTMERGE NOSHOW FLAGS 1 PRETEXT 1+2 <<>> <<'&'+'&'>> <> ENDTEXT - ENDIF - ENDIF + Endif + Endif - RETURN - ENDPROC + Return + Endproc - PROCEDURE write_ENDDEFINE_IfApplicable - LPARAMETERS tnLastClass, tcCodigo - IF tnLastClass = 1 + Procedure write_ENDDEFINE_IfApplicable + Lparameters tnLastClass, tcCodigo + If tnLastClass = 1 TEXT TO tcCodigo ADDITIVE TEXTMERGE NOSHOW FLAGS 1+2 PRETEXT 1+2 <<'ENDDEFINE'>> <<>> ENDTEXT - ENDIF + Endif - RETURN - ENDPROC + Return + Endproc - PROCEDURE write_EXTERNAL_CLASS_HEADER - LPARAMETERS toRegClass, toFoxBin2Prg, tcCodigo - *-- < EXTERNAL_CLASS Name = "class-name" Baseclass="base-class" /> - #IF .F. - LOCAL toFoxBin2Prg AS c_foxbin2prg OF 'FOXBIN2PRG.PRG' - #ENDIF + Procedure write_EXTERNAL_CLASS_HEADER + Lparameters toRegClass, toFoxBin2Prg, tcCodigo +*-- < EXTERNAL_CLASS Name = "class-name" Baseclass="base-class" /> + #If .F. + Local toFoxBin2Prg As c_foxbin2prg Of 'FOXBIN2PRG.PRG' + #Endif - IF EMPTY(tcCodigo) THEN + If Empty(tcCodigo) Then TEXT TO tcCodigo ADDITIVE TEXTMERGE NOSHOW FLAGS 1+2 PRETEXT 1+2 *-- EXTERNAL_CLASS identify external member Class names / EXTERNAL_CLASS identifica los nombres de las Clases externas ENDTEXT - ENDIF + Endif TEXT TO tcCodigo ADDITIVE TEXTMERGE NOSHOW FLAGS 1+2 PRETEXT 1+2 <> Name="<>" Baseclass="<>" <> ENDTEXT - RETURN - ENDPROC + Return + Endproc - PROCEDURE write_EXTERNAL_MEMBER_HEADER - LPARAMETERS toFoxBin2Prg, tcMemberName, tcMemberType, tcCodigo - *-- < EXTERNAL_MEMBER Name = "member-name" Type="member-type" /> - #IF .F. - LOCAL toFoxBin2Prg AS c_foxbin2prg OF 'FOXBIN2PRG.PRG' - #ENDIF + Procedure write_EXTERNAL_MEMBER_HEADER + Lparameters toFoxBin2Prg, tcMemberName, tcMemberType, tcCodigo +*-- < EXTERNAL_MEMBER Name = "member-name" Type="member-type" /> + #If .F. + Local toFoxBin2Prg As c_foxbin2prg Of 'FOXBIN2PRG.PRG' + #Endif - IF EMPTY(tcCodigo) THEN + If Empty(tcCodigo) Then TEXT TO tcCodigo ADDITIVE TEXTMERGE NOSHOW FLAGS 1+2 PRETEXT 1+2 *-- EXTERNAL_MEMBER identify external member names / EXTERNAL_MEMBER identifica los nombres de los miembros externos ENDTEXT - ENDIF + Endif - IF NOT EMPTY(tcMemberName) AND NOT EMPTY(tcMemberType) THEN + If Not Empty(tcMemberName) And Not Empty(tcMemberType) Then TEXT TO tcCodigo ADDITIVE TEXTMERGE NOSHOW FLAGS 1+2 PRETEXT 1+2 <> Name="<>" Type="<>" <> ENDTEXT - ENDIF + Endif - RETURN - ENDPROC + Return + Endproc - PROCEDURE write_INCLUDE - LPARAMETERS toReg, tcCodigo - *-- #INCLUDE - IF NOT EMPTY(toReg.RESERVED8) THEN + Procedure write_INCLUDE + Lparameters toReg, tcCodigo +*-- #INCLUDE + If Not Empty(toReg.RESERVED8) Then TEXT TO tcCodigo ADDITIVE TEXTMERGE NOSHOW FLAGS 1+2 PRETEXT 1+2 <<>> #INCLUDE "<>" ENDTEXT - ENDIF + Endif - RETURN - ENDPROC + Return + Endproc - PROCEDURE write_CLASSMETADATA - LPARAMETERS toRegClass, tcCodigo + Procedure write_CLASSMETADATA + Lparameters toRegClass, tcCodigo - *-- Agrego Metadatos de la clase (Baseclass, Timestamp, Scale, Uniqueid) +*-- Agrego Metadatos de la clase (Baseclass, Timestamp, Scale, Uniqueid) TEXT TO tcCodigo ADDITIVE TEXTMERGE NOSHOW FLAGS 1+2 PRETEXT 1+2 <<>> ENDTEXT @@ -15299,7 +15314,7 @@ DEFINE CLASS c_conversor_bin_a_prg AS c_conversor_base Uniqueid="<>" ENDTEXT - IF NOT EMPTY(toRegClass.OLE2) + If Not Empty(toRegClass.OLE2) TEXT TO tcCodigo ADDITIVE TEXTMERGE NOSHOW FLAGS 1 PRETEXT 1+2+4+8 <<>> Nombre="<>" Parent="<>" @@ -15307,19 +15322,19 @@ DEFINE CLASS c_conversor_bin_a_prg AS c_conversor_base OLEObject="< se quita clase - lcNombre = SUBSTR(toRegObj.PARENT, AT('.', toRegObj.PARENT)+1) + '.' + toRegObj.OBJNAME - ELSE - *-- Este caso: objeto + If '.' $ toRegObj.Parent +*-- Este caso: clase.objeto.objeto ==> se quita clase + lcNombre = Substr(toRegObj.Parent, At('.', toRegObj.Parent)+1) + '.' + toRegObj.OBJNAME + Else +*-- Este caso: objeto lcNombre = toRegObj.OBJNAME - ENDIF + Endif TEXT TO tcCodigo ADDITIVE TEXTMERGE NOSHOW FLAGS 1 PRETEXT 1+2+4+8 <<>> <> @@ -15360,1177 +15375,1177 @@ DEFINE CLASS c_conversor_bin_a_prg AS c_conversor_base <> ENDTEXT - RETURN - ENDPROC + Return + Endproc - PROCEDURE write_HIDDEN_Properties - *-- Escribo la definición HIDDEN de propiedades - LPARAMETERS tcHiddenProp, tcCodigo + Procedure write_HIDDEN_Properties +*-- Escribo la definición HIDDEN de propiedades + Lparameters tcHiddenProp, tcCodigo - IF NOT EMPTY(tcHiddenProp) + If Not Empty(tcHiddenProp) TEXT TO tcCodigo ADDITIVE TEXTMERGE NOSHOW FLAGS 1+2 PRETEXT 1+2 <<>> HIDDEN <> ENDTEXT - ENDIF + Endif - RETURN - ENDPROC + Return + Endproc - PROCEDURE write_PROTECTED_Properties - *-- Escribo la definición PROTECTED de propiedades - LPARAMETERS tcProtectedProp, tcCodigo + Procedure write_PROTECTED_Properties +*-- Escribo la definición PROTECTED de propiedades + Lparameters tcProtectedProp, tcCodigo - IF NOT EMPTY(tcProtectedProp) + If Not Empty(tcProtectedProp) TEXT TO tcCodigo ADDITIVE TEXTMERGE NOSHOW FLAGS 1+2 PRETEXT 1+2 <<>> PROTECTED <> ENDTEXT - ENDIF + Endif - RETURN - ENDPROC + Return + Endproc - PROCEDURE write_TXT_REPORTE - LPARAMETERS toReg + Procedure write_TXT_REPORTE + Lparameters toReg - TRY - LOCAL lc_TAG_REPORTE_I, lc_TAG_REPORTE_F, loEx AS EXCEPTION - lc_TAG_REPORTE_I = '<' + C_TAG_REPORTE + ' ' - lc_TAG_REPORTE_F = '' + Try + Local lc_TAG_REPORTE_I, lc_TAG_REPORTE_F, loEx As Exception + lc_TAG_REPORTE_I = '<' + C_TAG_REPORTE + ' ' + lc_TAG_REPORTE_F = '' - TEXT TO C_FB2PRG_CODE ADDITIVE TEXTMERGE NOSHOW FLAGS 1+2 PRETEXT 1+2 + TEXT TO C_FB2PRG_CODE ADDITIVE TEXTMERGE NOSHOW FLAGS 1+2 PRETEXT 1+2 <> - ENDTEXT + ENDTEXT - TEXT TO C_FB2PRG_CODE ADDITIVE TEXTMERGE NOSHOW FLAGS 1+2 PRETEXT 1+2 + TEXT TO C_FB2PRG_CODE ADDITIVE TEXTMERGE NOSHOW FLAGS 1+2 PRETEXT 1+2 <<>> platform="WINDOWS " uniqueid="<>" timestamp="<>" objtype="<>" <<>> - ENDTEXT + ENDTEXT - TEXT TO C_FB2PRG_CODE ADDITIVE TEXTMERGE NOSHOW FLAGS 1 PRETEXT 1+2 + TEXT TO C_FB2PRG_CODE ADDITIVE TEXTMERGE NOSHOW FLAGS 1 PRETEXT 1+2 objcode="<>" name="<>" <<>> - ENDTEXT + ENDTEXT - TEXT TO C_FB2PRG_CODE ADDITIVE TEXTMERGE NOSHOW FLAGS 1 PRETEXT 1+2 + TEXT TO C_FB2PRG_CODE ADDITIVE TEXTMERGE NOSHOW FLAGS 1 PRETEXT 1+2 vpos="<>" hpos="<>" height="<>" width="<>" <<>> - ENDTEXT + ENDTEXT - TEXT TO C_FB2PRG_CODE ADDITIVE TEXTMERGE NOSHOW FLAGS 1 PRETEXT 1+2 + TEXT TO C_FB2PRG_CODE ADDITIVE TEXTMERGE NOSHOW FLAGS 1 PRETEXT 1+2 order="<>" unique="<>" <<>> - ENDTEXT + ENDTEXT - TEXT TO C_FB2PRG_CODE ADDITIVE TEXTMERGE NOSHOW FLAGS 1 PRETEXT 1+2 + TEXT TO C_FB2PRG_CODE ADDITIVE TEXTMERGE NOSHOW FLAGS 1 PRETEXT 1+2 environ="<>" boxchar="<>" fillchar="<>" <<>> - ENDTEXT + ENDTEXT - TEXT TO C_FB2PRG_CODE ADDITIVE TEXTMERGE NOSHOW FLAGS 1 PRETEXT 1+2 + TEXT TO C_FB2PRG_CODE ADDITIVE TEXTMERGE NOSHOW FLAGS 1 PRETEXT 1+2 pengreen="<>" penblue="<>" fillred="<>" fillgreen="<>" <<>> - ENDTEXT + ENDTEXT - TEXT TO C_FB2PRG_CODE ADDITIVE TEXTMERGE NOSHOW FLAGS 1 PRETEXT 1+2 + TEXT TO C_FB2PRG_CODE ADDITIVE TEXTMERGE NOSHOW FLAGS 1 PRETEXT 1+2 fillblue="<>" pensize="<>" penpat="<>" fillpat="<>" <<>> - ENDTEXT + ENDTEXT - TEXT TO C_FB2PRG_CODE ADDITIVE TEXTMERGE NOSHOW FLAGS 1 PRETEXT 1+2 + TEXT TO C_FB2PRG_CODE ADDITIVE TEXTMERGE NOSHOW FLAGS 1 PRETEXT 1+2 fontface="<>" fontstyle="<>" fontsize="<>" mode="<>" <<>> - ENDTEXT + ENDTEXT - TEXT TO C_FB2PRG_CODE ADDITIVE TEXTMERGE NOSHOW FLAGS 1 PRETEXT 1+2 + TEXT TO C_FB2PRG_CODE ADDITIVE TEXTMERGE NOSHOW FLAGS 1 PRETEXT 1+2 ruler="<>" rulerlines="<>" grid="<>" gridv="<>" <<>> - ENDTEXT + ENDTEXT - TEXT TO C_FB2PRG_CODE ADDITIVE TEXTMERGE NOSHOW FLAGS 1 PRETEXT 1+2 + TEXT TO C_FB2PRG_CODE ADDITIVE TEXTMERGE NOSHOW FLAGS 1 PRETEXT 1+2 gridh="<>" float="<>" stretch="<>" stretchtop="<>" <<>> - ENDTEXT + ENDTEXT - TEXT TO C_FB2PRG_CODE ADDITIVE TEXTMERGE NOSHOW FLAGS 1 PRETEXT 1+2 + TEXT TO C_FB2PRG_CODE ADDITIVE TEXTMERGE NOSHOW FLAGS 1 PRETEXT 1+2 top="<>" bottom="<>" suptype="<>" suprest="<>" norepeat="<>" <<>> - ENDTEXT + ENDTEXT - TEXT TO C_FB2PRG_CODE ADDITIVE TEXTMERGE NOSHOW FLAGS 1 PRETEXT 1+2 + TEXT TO C_FB2PRG_CODE ADDITIVE TEXTMERGE NOSHOW FLAGS 1 PRETEXT 1+2 resetrpt="<>" pagebreak="<>" colbreak="<>" resetpage="<>" <<>> - ENDTEXT + ENDTEXT - TEXT TO C_FB2PRG_CODE ADDITIVE TEXTMERGE NOSHOW FLAGS 1 PRETEXT 1+2 + TEXT TO C_FB2PRG_CODE ADDITIVE TEXTMERGE NOSHOW FLAGS 1 PRETEXT 1+2 general="<>" spacing="<>" double="<>" swapheader="<>" <<>> - ENDTEXT + ENDTEXT - TEXT TO C_FB2PRG_CODE ADDITIVE TEXTMERGE NOSHOW FLAGS 1 PRETEXT 1+2 + TEXT TO C_FB2PRG_CODE ADDITIVE TEXTMERGE NOSHOW FLAGS 1 PRETEXT 1+2 swapfooter="<>" ejectbefor="<>" ejectafter="<>" plain="<>" <<>> - ENDTEXT + ENDTEXT - TEXT TO C_FB2PRG_CODE ADDITIVE TEXTMERGE NOSHOW FLAGS 1 PRETEXT 1+2 + TEXT TO C_FB2PRG_CODE ADDITIVE TEXTMERGE NOSHOW FLAGS 1 PRETEXT 1+2 summary="<>" addalias="<>" offset="<>" topmargin="<>" <<>> - ENDTEXT + ENDTEXT - TEXT TO C_FB2PRG_CODE ADDITIVE TEXTMERGE NOSHOW FLAGS 1 PRETEXT 1+2 + TEXT TO C_FB2PRG_CODE ADDITIVE TEXTMERGE NOSHOW FLAGS 1 PRETEXT 1+2 botmargin="<>" totaltype="<>" resettotal="<>" resoid="<>" <<>> - ENDTEXT + ENDTEXT - TEXT TO C_FB2PRG_CODE ADDITIVE TEXTMERGE NOSHOW FLAGS 1 PRETEXT 1+2 + TEXT TO C_FB2PRG_CODE ADDITIVE TEXTMERGE NOSHOW FLAGS 1 PRETEXT 1+2 curpos="<>" supalways="<>" supovflow="<>" suprpcol="<>" <<>> - ENDTEXT + ENDTEXT - TEXT TO C_FB2PRG_CODE ADDITIVE TEXTMERGE NOSHOW FLAGS 1 PRETEXT 1+2 + TEXT TO C_FB2PRG_CODE ADDITIVE TEXTMERGE NOSHOW FLAGS 1 PRETEXT 1+2 supgroup="<>" supvalchng="<>" <<>> - ENDTEXT + ENDTEXT - C_FB2PRG_CODE = C_FB2PRG_CODE + CR_LF + " " + C_FB2PRG_CODE = C_FB2PRG_CODE + CR_LF + " " - IF INLIST(toReg.ObjType, 25, 26) && Dataenvironment, cursors and relations - C_FB2PRG_CODE = C_FB2PRG_CODE + CR_LF + " " - C_FB2PRG_CODE = C_FB2PRG_CODE + CR_LF + " " - ELSE - C_FB2PRG_CODE = C_FB2PRG_CODE + CR_LF + " " - C_FB2PRG_CODE = C_FB2PRG_CODE + CR_LF + " " - ENDIF + If Inlist(toReg.ObjType, 25, 26) && Dataenvironment, cursors and relations + C_FB2PRG_CODE = C_FB2PRG_CODE + CR_LF + " " + C_FB2PRG_CODE = C_FB2PRG_CODE + CR_LF + " " + Else + C_FB2PRG_CODE = C_FB2PRG_CODE + CR_LF + " " + C_FB2PRG_CODE = C_FB2PRG_CODE + CR_LF + " " + Endif - C_FB2PRG_CODE = C_FB2PRG_CODE + CR_LF + " " - C_FB2PRG_CODE = C_FB2PRG_CODE + CR_LF + "