*--------------------------------------------------------------------------------------------------- * Módulo.........: FOXBIN2PRG.PRG - PARA VISUAL FOXPRO 9.0 * Autor..........: Fernando D. Bozzo (mailto:fdbozzo@gmail.com) - http://fdbozzo.blogspot.com * Project info...: https://vfpx.codeplex.com/wikipage?title=FoxBin2Prg * Fecha creación.: 04/11/2013 * * LICENCIA: * Esta obra está sujeta a la licencia Reconocimiento-CompartirIgual 4.0 Internacional de Creative Commons. * Para ver una copia de esta licencia, visite http://creativecommons.org/licenses/by-sa/4.0/deed.es_ES. * * LICENCE: * This work is licensed under the Creative Commons Attribution 4.0 International License. * To view a copy of this license, visit http://creativecommons.org/licenses/by/4.0/. * *--------------------------------------------------------------------------------------------------- * DESCRIPCIÓN....: CONVIERTE EL ARCHIVO VCX/SCX/PJX INDICADO A UN "PRG HÍBRIDO" PARA POSTERIOR RECONVERSIÓN. * * EL PRG HÍBRIDO ES UN PRG CON ALGUNAS SECCIONES BINARIAS (OLE DATA, ETC) * * EL OBJETIVO ES PODER USARLO COMO REEMPLAZO DEL SCCTEXT.PRG, PODER HACER MERGE * DEL CÓDIGO DIRECTAMENTE SOBRE ESTE NUEVO PRG Y GUARDARLO EN UNA HERRAMIENTA DE SCM * COMO CVS O SIMILAR SIN NECESIDAD DE GUARDAR LOS BINARIOS ORIGINALES. * * EXTENSIONES GENERADAS: VC2, SC2, PJ2 (...o VCA, SCA, PJA con archivo conf.) * * CONFIGURACIÓN: SI SE CREA UN ARCHIVO FOXBIN2PRG.CFG, SE PUEDEN CAMBIAR LAS EXTENSIONES * PARA PODER USARLO CON SOURCESAFE PONIENDO LAS EQUIVALENCIAS ASÍ: * * extension: VC2=VCA * extension: SC2=SCA * extension: PJ2=PJA * * USO/USE: * DO FOXBIN2PRG.PRG WITH "\FILE.VCX" && Genera "\FILE.VC2" (BIN TO PRG CONVERSION) * DO FOXBIN2PRG.PRG WITH "\FILE.VC2" && Genera "\FILE.VCX" (PRG TO BIN CONVERSION) * * DO FOXBIN2PRG.PRG WITH "\FILE.SCX" && Genera "\FILE.SC2" (BIN TO PRG CONVERSION) * DO FOXBIN2PRG.PRG WITH "\FILE.SC2" && Genera "\FILE.SCX" (PRG TO BIN CONVERSION) * * DO FOXBIN2PRG.PRG WITH "\FILE.PJX" && Genera "\FILE.PJ2" (BIN TO PRG CONVERSION) * DO FOXBIN2PRG.PRG WITH "\FILE.PJ2" && Genera "\FILE.PJX" (PRG TO BIN CONVERSION) * *--------------------------------------------------------------------------------------------------- * * 04/11/2013 FDBOZZO v1.0 Creación inicial de las clases y soporte de los archivos VCX/SCX/PJX * 22/11/2013 FDBOZZO v1.1 Corrección de bugs * 23/11/2013 FDBOZZO v1.2 Corrección de bugs, limpieza de código y refactorización * 24/11/2013 FDBOZZO v1.3 Corrección de bugs, limpieza de código y refactorización * 27/11/2013 FDBOZZO v1.4 Agregado soporte comodines *.VCX, configuración de extensiones (vca), parámetro p/log * 27/11/2013 FDBOZZO v1.5 Arreglo bug que no generaba form completo * 01/12/2013 FDBOZZO v1.6 Refactorización completa generación BIN y PRG, cambio de algoritmos, arreglo de bugs, Unit Testing con FoxUnit * 02/12/2013 FDBOZZO v1.7 Arreglo bug "Name", barra de progreso, agregado mensaje de ayuda si se llama sin parámetros, verificación y logueo de archivos READONLY con debug activa * 03/12/2013 FDBOZZO v1.8 Arreglo bug "Name" (otra vez), sort encapsulado y reutilizado para versiones TEXTO y BIN por seguridad * 06/12/2013 FDBOZZO v1.9 Arreglo bug pérdida de propiedades causado por una mejora anterior * 06/12/2013 FDBOZZO v1.10 Arreglo del bug de mezcla de métodos de una clase con la siguiente * 07/12/2013 FDBOZZO v1.11 Arreglo del bug de _amembers detectado por Edgar K.con la clase BlowFish.vcx (http://www.tortugaproductiva.galeon.com/docs/blowfish/index.html) * 07/12/2013 FDBOZZO v1.12 Agregado soporte preliminar de conversión de reportes y etiquetas (FRX/LBX) * 08/12/2013 FDBOZZO v1.13 Arreglo bug "Error 1924, TOREG is not an object" * 15/12/2013 FDBOZZO v1.14 Arreglo de bug AutoCenter y registro COMMENT en regeneración de forms * 08/12/2013 FDBOZZO v1.15 Agregado soporte preliminar de conversión de tablas, índices y bases de datos (DBF,CDX,DBC) * 18/12/2013 FDBOZZO v1.16 Agregado soporte para menús (MNX) * 03/01/2014 FDBOZZO v1.17 Agregado Unit Testing de menús y arreglo de las incidencias del menu * 05/01/2013 FDBOZZO v1.18 Agregado soporte para generar estructuras TEXTO de DBFs anteriores a VFP 9, pero los binarios a VFP 9 // Arreglado bug de datos faltantes en campos de vistas // Arreglado bug mnx * 08/01/2014 FDBOZZO v1.19 Arreglo bug SCX-VCX: Orden incorrecto en Reserved3 ocaciona que no se disparen eventos ACCESS (y probablemente ASIGN) * 08/01/2014 FDBOZZO v1.19 Arreglo bug DBF: Tipo de índice generado incorrecto en DB2 cuando es Candidate * 08/01/2014 FDBOZZO v1.19 Agregado soporte para convertir PJM a PJ2 * 08/01/2014 FDBOZZO v1.19 Agregada validación al convertir Menús con estructura anterior a VFP9 * 08/01/2014 FDBOZZO v1.19 Cambiada la propiedad "Autor" por "Author" en los archivos MN2 * 08/01/2014 FDBOZZO v1.19.1 Cambio en los headers de los archivos TX2 para quitar el timestamp "Generated" que causa diferencias innecesarias * 08/01/2014 FDBOZZO v1.19.2 Arreglo de bug PJ2: Al regenerar da un error por buscar "Autor" en vez de "Author" * 08/01/2014 FDBOZZO v1.19.3 Cambio en los timestamps de los TXT para mantener los valores vacíos que generaban muchísimas diferencias * 22/01/2014 FDBOZZO v1.19.4 Nuevo parámetro Recompile para forzar la recompilación. Ahora por defecto el binario no se recompila para ganar velocidad y evitar errores. Debe recompilar manualmente. * 22/01/2014 FDBOZZO v1.19.4 DBC: Agregado soporte para comentarios multilínea (propiedad Comment) * 26/01/2014 FDBOZZO v1.19.5 Agregado soporte multiidioma y traducción al Inglés * 01/02/2014 FDBOZZO v1.19.6 Agregada compatibilidad con SourceSafe para Diff y Merge * 02/02/2014 FDBOZZO v1.19.7 Encapsulación de objetos OLE en el propio control o clase // Blocksize ajustado * 03/02/2014 FDBOZZO v1.19.8 Arreglo bug pageframe (error activePage) * 08/02/2014 FDBOZZO v1.19.9 Nuevos items de config.en foxbin2prg.cfg / Bug en Localización / Mejora log / Parametrización Nº backups / Timestamps desactivados por defecto * 09/02/2014 FDBOZZO v1.19.10 Parametrización soporte de tipo de conversión por archivo / ClearUniqueID * 13/02/2014 FDBOZZO v1.19.11 Optimizaciones WITH/ENDWITH (16%+velocidad) / Arreglo bug #IF anidados * 21/02/2014 FDBOZZO v1.19.12 Centralizar ZOrder controles en metadata de cabecera de clase para minimizar diferencias / También mover UniqueIDs y Timestamps a metadata * 26/02/2014 FDBOZZO v1.19.13 Arreglo bug TimeStamp en archivo cfg / ExtraBackupLevels se puede desactivar / Optimizaciones / Casos FoxUnit * 01/03/2014 FDBOZZO v1.19.14 Arreglo bug regresion cuando no se define ExtraBackupLevels no hace backups / Optimización carga cfg en batch * 04/03/2014 FDBOZZO v1.19.15 Arreglo bugs: OLE TX2 legacy / NoTimestamp=0 / DBFs backlink * 07/03/2014 FDBOZZO v1.19.16 Arreglo bugs: Propiedades y métodos Hidden/Protected que no se generan /// Crash métodos vacíos * 16/03/2014 FDBOZZO v1.19.17 Arreglo bugs frx/lbx: Expresiones con comillas // comment multilínea // Mejora tag2 para Tooltips // Arreglo bugs mnx * 22/03/2014 FDBOZZO v1.19.18 Arreglo bug vcx/scx: Las imágenes no mantienen sus dimensiones programadas y asumen sus dimensiones reales // El comentario a nivel de librería se pierde * 29/03/2014 FDBOZZO v1.19.19 Nueva característica: Hooks al regenerar DBF para poder realizar procesos intermedios, como la carga de datos del DBF regenerado desde una fuente externa * 17/04/2014 FDBOZZO v1.19.20 Relativización de directorios de CDX dentro de los DB2 para minimizar diferencias * 29/04/2014 FDBOZZO v1.19.21 Agregada posibilidad de convertir un proyecto entero a tx2 // Optimizaciones en generación según timestamps // AGAIN en aperturas // Simplificación sección PAM * 08/05/2014 FDBOZZO v1.19.22 Arreglo bug vcx/scx: La propiedad Picture de una clase form se pierde y no muestra la imagen * 27/05/2014 FDBOZZO v1.19.23 Arreglo bug vcx/scx: Redimensionamiento incorrecto de imagenes en ciertas situaciones (props_image.txt y props_optiongroup.txt actualizados) * 09/06/2014 FDBOZZO v1.19.24 Arreglo bug vcx/scx: La falta de AGAIN en algunos comandos USE provoca error de "tabla en uso" si se usa el PRG desde la ventana de comandos * 14/06/2014 FDBOZZO v1.19.24 Arreglo bug vcx/scx: Un campo de tabla llamado "text" que comienza la línea puede confundirse con la estructura TEXT/ENDTEXT y reconocer mal el resto del código * 16/06/2014 FDBOZZO v1.19.25 Mejora: Agregado soporte de configuraciones (CFG) por directorio que, si existen, se usan en lugar del principal (Mario Peschke) * 17/06/2014 FDBOZZO v1.19.25 Mejora: Si durante la generación de binarios o de textos se producen errores, mostrar un mensaje avisando de ello (Pedro Gutiérrez M.) * 06/07/2014 FDBOZZO v1.19.26 Mejora: Cuando se convierten binarios a texto, los CHR(0) pasan también, pudiendo provocar falsa detección como binario. Se agrega opción para quitar los NULLs. (Matt Slay) * 27/06/2014 FDBOZZO v1.19.26 Mejora: Si el campo memo "methods" de los vcx/scx contiene asteriscos fuera de lugar (que no debería), FoxBin2Prg lo procesa igualmente. (Daniel Sánchez) * 06/07/2014 FDBOZZO v1.19.26 Bug Fix cfg: ExtraBackupLevel no se tiene en cuenta cuando se usa multi-configuración * 02/06/2014 DH/FDBOZZO v1.19.27 Mejora: Agregado soporte para exportar datos para DIFF (no para importar) * 21/07/2014 FDBOZZO v1.19.28 Mejora: Agregada funcionalidad para filtrado de tablas y datos cuando se elige DBF_Conversion_Support:4 (Edyshor) * 29/07/2014 FDBOZZO v1.19.29 Arreglo bug vcx/scx: Un campo de tabla llamado "text" que comienza la línea puede confundirse con la estructura TEXT/ENDTEXT y reconocer mal el resto del código * 07/08/2014 FDBOZZO v1.19.30 Arreglo bug vcx/scx: Cuando la línea anterior a un ENDTEXT termina en ";" o "," no se reconoce como ENDTEXT sino como continuación (Jim Nelson) * 08/08/2014 FDBOZZO v1.19.30 Arreglo bug vcx/vct v1.19.29: En ciertos casos de herencia no se mantiene el orden alfabetico de algunos metodos (Ryan Harris) * 17/08/2014 FDBOZZO v1.19.31 Agregada versión del EXE cuando se genera LOG de depuración * 20/08/2014 FDBOZZO v1.19.31 Mejora vcx/scx: Mejorado el reconocimiento de instrucciones #IF..#ENDIF cuando hay espacios entre # y el nombre de función * 20/08/2014 FDBOZZO v1.19.31 Mejora: Ajuste de capitalización de los archivos origen, así ya no hay que hacerlo manualmente * 25/08/2014 FDBOZZO v1.19.32 Arreglo bug vcx/vct v1.19.31: Una propiedad llamada "text" es confundida con la estructura text/endtext (Peter Hipp) * 27/08/2014 FDBOZZO v1.19.33 Arreglo bug mnx v1.19.32: Si se crea un menú con una opción de tipo #Bar vacía, el menú se genera mal (Peter Hipp) * 29/08/2014 FDBOZZO v1.19.33 Arreglo bug mnx v1.19.32: Si una opción tiene asociado un Procedure de 1 línea, no se mantiene como Procedure y se convierte a Command (Peter Hipp) * 19/09/2014 FDBOZZO v1.19.34 Arreglo bug: Si se ejecuta FoxBin2Prg desde ventana de comandos FoxPro para un proyecto y hay algún archivo abierto o cacheado, se produce un error al intentar capitalizar el archivo de entrada (Jim Nelson) * 26/09/2014 FDBOZZO v1.19.35 Mejora: Generar siempre el mismo Timestamp y UniqueID para los binarios minimizaría los cambios al regenerarlos (Marcio Gomez G.) * 08/10/2014 FDBOZZO v1.19.36 Arreglo bug: Al generar el mn2 el identificador queda vacío (bug introducido en v1.19.35) * * *--------------------------------------------------------------------------------------------------- * * 23/11/2013 Luis Martínez REPORTE BUG scx v1.4: En algunos forms solo se generaba el dataenvironment (arreglado en v.1.5) * 27/11/2013 Fidel Charny REPORTE BUG vcx v1.5: Error en el guardado de ciertas propiedades de array (arreglado en v.1.6) * 02/12/2013 Fidel Charny REPORTE BUG scx v1.6: Se pierden algunas propiedades y no muestra picture si "Name" no es la última (arreglado en v.1.7) * 03/12/2013 Fidel Charny REPORTE BUG scx v1.7: Se siguen perdiendo algunas propiedades por implementación defectuosa del arreglo anterior (arreglado en v.1.8) * 03/12/2013 Fidel Charny REPORTE BUG scx v1.8: Se siguen perdiendo algunas propiedades por implementación defectuosa de una mejora anterior (arreglado en v.1.9) * 06/12/2013 Fidel Charny REPORTE BUG scx v1.9: Cuando hay métodos que tienen el mismo nombre, aparecen mezclados en objetos a los que no corresponden (arreglado en v.1.10) * 07/12/2013 Edgar Kummers REPORTE BUG vcx v1.10: Cuando se parsea una clase con un _memberdata largo, se parsea mal y se corrompe el valor (arreglado en v.1.11) * 08/12/2013 Fidel Charny REPORTE BUG frx v1.12: Cuando se convierten algunos reportes da "Error 1924, TOREG is not an object" (arreglado en v.1.13) * 14/12/2013 Arturo Ramos REPORTE BUG scx v1.13: La regeneración de los forms (SCX) no respeta la propiedad AutoCenter, estando pero no funcionando. (arreglado en v.1.14) * 14/12/2013 Fidel Charny REPORTE BUG scx v1.13: La regeneración de los forms (SCX) no regenera el último registro COMMENT (arreglado en v.1.14) * 01/01/2014 Fidel Charny REPORTE BUG mnx v1.16: El menú no siempre respeta la posición original LOCATION y a veces se genera mal el MNX (se arregla en v1.17) * 05/01/2014 Fidel Charny REPORTE BUG mnx v1.17: Se genera cláusula "DO" o llamada Command cuando no Procedure ni Command que llamar // Diferencia de Case en NAME (se arregla en v1.18) * 20/02/2014 Ryan Harris PROPUESTA DE MEJORA v1.19.11: Centralizar los ZOrder de los controles en metadata de cabecera de la clase para minimizar diferencias * 23/02/2014 Ryan Harris BUG cfg v1.19.12: Si se define NoTimestamp en FoxBin2Prg.cfg, se toma el valor opuesto (solucionado en v1.19.13) * 27/02/2014 BUG REGRESION v1.19.13: Si no se define ExtraBackupLevels no se generan backups (solucionado en v1.19.14) * 06/03/2014 Ryan Harris REPORTE BUG vcx/scx v1.19.15: Algunas propiedades no mantienen su visibilidad Hidden/Protected // Orden de properties defTop,defLeft,etc * 10/03/2014 Ryan Harris REPORTE BUG frx/lbx v1.19.16: Las expresiones con comillas corrompen el fx2/lb2 // La propiedad Comment se pierde si es multilínea (solucionado en v1.19.17) * 10/03/2014 Ryan Harris REPORTE BUG mnx v1.19.16: Al usar comentarios multilínea en las opciones, se corrompe el MN2 y el MNX regenerado (solucionado en v1.19.17) * 20/03/2014 Arturo Ramos REPORTE BUG vcx/scx v1.19.17: Las imágenes no mantienen sus dimensiones programadas y asumen sus dimensiones reales (Solucionado en v1.19.18) * 24/03/2014 Ryan Harris REPORTE BUG vcx/scx v1.19.17: El comentario a nivel de librería se pierde (Solucionado en v1.19.18) * 29/04/2014 Matt Slay MEJORA v1.19.20: Posibilidad de convertir un proyecto entero a tx2 // Optimización de generación según timestamps (Agregado en v1.19.21) * 30/04/2014 Jim Nelson MEJORA v1.19.20: Agregado de AGAIN en apertura de tablas (Agregado en v1.19.21) * 07/05/2014 Fidel Charny REPORTE BUG vcx/scx v1.19.21: La propiedad Picture de una clase form se pierde y no muestra la imagen. No ocurre con la propiedad Picture de los controles (Arreglado en v1.19.22) * 09/05/2014 Miguel Durán REPORTE BUG vcx/scx v1.19.21: Algunas opciones del optiongroup pierden el width cuando se subclasan de una clase con autosize=.T. (Arreglado en v1.19.22) * 13/05/2014 Andrés Mendoza REPORTE BUG vcx/scx v1.19.21: Los métodos que contengan líneas o variables que comiencen con TEXT, provocan que los siguientes métodos queden mal indentados y se dupliquen vacíos (Arreglado en v1.19.22) * 27/05/2014 Kenny Vermassen REPORTE BUG img v1.19.22: La propiedad Stretch no estaba incluida en la lista de propiedades props_image.txt, lo que provocaba un mal redimensionamiento de las imagenes en ciertas situaciones (Arreglado en v1.19.23) * 09/06/2014 Matt Slay REPORTE BUG vcx/scx v1.19.23: La falta de AGAIN en algunos comandos USE provoca error de "tabla en uso" si se usa el PRG desde la ventana de comandos (Arreglado en v1.19.24) * 13/06/2014 Mario Peschke REPORTE BUG vcx/scx v1.19.23: Los campos de tabla con nombre "text" a veces provocan corrupción del binario generado (Arreglado en v1.19.24) * 16/06/2014 Mario Peschke MEJORA v1.19.24: Agregado soporte de configuraciones (CFG) por directorio que, si existen, se usan en lugar del CFG principal (Agregado en v1.19.25) * 17/06/2014 Pedro Gutiérrez M. MEJORA v1.19.24: Si durante la generación de binarios o de textos se producen errores, mostrar un mensaje avisando de ello (Agregado en v1.19.25) * 02/07/2014 Matt Slay MEJORA v1.19.25: Se filtran algunos CHR(0) de los binarios al tx2, provocando que a veces no sea reconocido como texto. Deberían poderse quitar los NULLs (Arreglado en v1.19.26) * 27/06/2014 Daniel Sánchez MEJORA v1.19.25: Si el campo memo "methods" de los vcx/scx contiene asteriscos fuera de lugar (que no debería), FoxBin2Prg falla. Debería poder procesarlo igual. * 02/06/2014 Doug Hennig MEJORA v1.19.22: Agregada funcionalidad para exportar los datos de las tablas al archivo db2 (Agregado en v1.19.27) * 21/07/2014 Edyshor PROPUESTA DE MEJORA db2 v1.19.27: Sería útil poder filtrar tablas y datos cuando se elige DBF_Conversion_Support:4 (Agregado en v1.19.28) * 29/07/2014 M_N_M REPORTE BUG vcx/scx v1.19.28: Los campos de tabla con nombre "text" a veces provocan corrupción del binario generado (Arreglado en v1.19.29) * 07/08/2014 Jim Nelson REPORTE BUG vcx/scx v1.19.29: Cuando la línea anterior a un ENDTEXT termina en ";" o "," no se reconoce como ENDTEXT sino como continuación (Arreglado en v1.19.30) * 08/08/2014 Ryan Harris REPORTE BUG vcx/scx v1.19.29: En ciertos casos de herencia no se mantiene el orden alfabetico de algunos metodos (solucionado en v1.19.30) * 25/08/2014 Peter Hipp REPORTE BUG vcx/scx v1.19.31: Una propiedad llamada "text" es confundida con la estructura text/endtext (solucionado en v1.19.32) * 27/08/2014 Peter Hipp REPORTE BUG mnx v1.19.32: Si se crea un menú con una opción de tipo #Bar vacía, el menú se genera mal (solucionado en v1.19.33) * 28/08/2014 Peter Hipp REPORTE BUG mnx v1.19.32: Si una opción tiene asociado un Procedure de 1 línea, no se mantiene como Procedure y se convierte a Command (solucionado en v1.19.33) * 19/09/2014 Jim Nelson REPORTE BUG v1.19.33: Si se ejecuta FoxBin2Prg desde ventana de comandos FoxPro para un proyecto y hay algún archivo abierto o cacheado, se produce un error (solucionado en v1.19.34) * 26/09/2014 Marcio Gomez G. MEJORA v1.19.34: Generar siempre el mismo Timestamp y UniqueID para los binarios minimizaría los cambios al regenerarlos (Agregado en v1.19.35) * 14/10/2014 Lutz Scheffler MEJORA v1.19.36: Permitir generar una clase por archivo (pregunta) * 21/10/2014 Ryan Harris MEJORA v1.19.36: Permitir generar una clase por archivo (sugerencia) * * *--------------------------------------------------------------------------------------------------- * TRAMIENTOS ESPECIALES DE ASIGNACIONES DE PROPIEDADES: * PROPIEDAD ARREGLO Y EJEMPLO *------------------------- -------------------------------------------------------------------------------------- * _memberdata Se separan las definiciones en lineas para evitar una sola muy larga * *--------------------------------------------------------------------------------------------------- * PARÁMETROS: (v=Pasar por valor | @=Pasar por referencia) (!=Obligatorio | ?=Opcional) (IN/OUT) * tc_InputFile (v! IN ) Nombre completo (fullpath) del archivo a convertir * tcType (v? IN ) Tipo de archivo de entrada. Compatibilidad con SCCTEXT.PRG // Si se indica "*" y tc_InputFile es un PJX, se procesa todo el proyecto * tcTextName (v? IN ) Nombre del archivo texto. Compatibilidad con SCCTEXT.PRG * tlGenText (v? IN ) .T.=Genera Texto, .F.=Genera Binario. Compatibilidad con SCCTEXT.PRG * tcDontShowErrors (v? IN ) '1' para NO mostrar errores con MESSAGEBOX * tcDebug (v? IN ) '1' para depurar en el sitio donde ocurre el error (solo modo desarrollo) * tcDontShowProgress (v? IN ) '1' para NO mostrar la ventana de progreso * 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) * * Ej: DO FOXBIN2PRG.PRG WITH "C:\DESA\INTEGRACION\LIBRERIA.VCX" *--------------------------------------------------------------------------------------------------- LPARAMETERS tc_InputFile, tcType, tcTextName, tlGenText, tcDontShowErrors, tcDebug, tcDontShowProgress, tcOriginalFileName ; , tcRecompile, tcNoTimestamps *-- 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_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_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 ) *** DH 06/02/2014: added additional constants #DEFINE C_RECORDS_I '' #DEFINE C_RECORDS_F '' #DEFINE C_RECORD_I '' && *** FDBOZZO 2014/07/15: Optimized RECORD tag adding num property to not use REGNUM field #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 *-- 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 *-- 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 *-- Menu Location constants #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 *-- Fin / End ******************************************************************************************************************* *-- INTERNACIONALIZACIÓN / INTERNATIONALIZATION ******************************************************************************************************************* #IF FILE('foxbin2prg.h') && DO NOT CHANGE THIS! Just rename the .H file #INCLUDE foxbin2prg.h && DO NOT CHANGE THIS! Just rename the .H file #ELSE *--------------------------------------------------------------------------------------------------------- *-- TRANSLACIÓN AL ESPAÑOL *--------------------------------------------------------------------------------------------------------- #DEFINE C_ASTERISK_EXT_NOT_ALLOWED_LOC "No se admiten extensiones * o ? porque es peligroso (se pueden pisar binarios con archivo xx2 vacíos)." #DEFINE C_BACKLINK_CANT_UPDATE_BL_LOC "No se pudo actualizar el backlink" #DEFINE C_BACKLINK_OF_TABLE_LOC "de la tabla" #DEFINE C_BACKUP_OF_LOC "Haciendo Backup de: " #DEFINE C_CANT_GENERATE_FILE_BECAUSE_IT_IS_READONLY_LOC "No se puede generar el archivo [<>] porque es ReadOnly" #DEFINE C_CONFIGFILE_LOC "Usando archivo de configuración:" #DEFINE C_CONVERTER_UNLOAD_LOC "Descarga del conversor" #DEFINE C_CONVERTING_FILE_LOC "Convirtiendo archivo" #DEFINE C_DATA_ERROR_CANT_PARSE_UNPAIRING_DOUBLE_QUOTES_LOC "Error de datos: No se puede parsear porque las comillas no son pares en la línea <>" #DEFINE C_DUPLICATED_FILE_LOC "Archivo duplicado" #DEFINE C_ENDDEFINE_MARKER_NOT_FOUND_LOC "No se ha encontrado el marcador de fin [ENDDEFINE] de la línea <> para el identificador [<>]" #DEFINE C_END_MARKER_NOT_FOUND_LOC "No se ha encontrado el marcador de fin [<>] que cierra al marcador de inicio [<>] de la línea <>" #DEFINE C_FIELD_NOT_FOUND_ON_FILE_STRUCTURE_LOC "No se encontró el campo [<>] en la estructura del archivo <>" #DEFINE C_FILE_DOESNT_EXIST_LOC "El archivo no existe:" #DEFINE C_FILE_NAME_IS_NOT_SUPPORTED_LOC "El archivo [<<.c_InputFile>>] no está soportado" #DEFINE C_FILE_NOT_FOUND_LOC "No se encontró el archivo" #DEFINE C_EXTENSION_RECONFIGURATION_LOC "Reconfiguración de extensión:" #DEFINE C_FOXBIN2PRG_ERROR_CAPTION_LOC "FOXBIN2PRG: ERROR!!" #DEFINE C_FOXBIN2PRG_INFO_SINTAX_LOC "FOXBIN2PRG: INFORMACIÓN DE SINTAXIS" #DEFINE C_FOXBIN2PRG_INFO_SINTAX_EXAMPLE_LOC "FOXBIN2PRG [,cType ,cTextName ,cGenText ,cNoMostrarErrores ,cDebug, cDontShowProgress, cOriginalFileName, cRecompile, cNoTimestamps]" + CR_LF + CR_LF ; + "Ejemplo para generar los TXT de todos los VCX de 'c:\desa\clases', sin mostrar ventana de error y generando archivo LOG: " + CR_LF ; + " FOXBIN2PRG 'c:\desa\clases\*.vcx' '0' '0' '0' '1' '1'" + CR_LF + CR_LF ; + "Ejemplo para generar los VCX de todos los TXT de 'c:\desa\clases', sin mostrar ventana de error y sin LOG: " + CR_LF ; + " FOXBIN2PRG 'c:\desa\clases\*.vc2' '0' '0' '0' '1' '0'" #DEFINE C_FOXBIN2PRG_JUST_VFP_9_LOC "¡FOXBIN2PRG es solo para Visual FoxPro 9.0!" #DEFINE C_FOXBIN2PRG_WARN_CAPTION_LOC "FOXBIN2PRG: ¡ATENCIÓN!" #DEFINE C_MENU_NOT_IN_VFP9_FORMAT_LOC "El Menú [<>] NO está en formato VFP 9! - Por favor convertirlo a VFP 9 con MODIFY MENU <>" #DEFINE C_LANGUAGE_LOC "ES" #DEFINE C_NAMES_CAPITALIZATION_PROGRAM_FOUND_LOC "* Se ha encontrado el programa de capitalización de nombres [<>]" #DEFINE C_NAMES_CAPITALIZATION_PROGRAM_NOT_FOUND_LOC "* No se ha encontrado el programa de capitalización de nombres [<>]" #DEFINE C_OBJECT_NAME_WITHOUT_OBJECT_OREG_LOC "Objeto [<>] no contiene el objeto oReg (nivel <>)" #DEFINE C_ONLY_SETNAME_AND_GETNAME_RECOGNIZED_LOC "Operación no reconocida. Solo re reconoce SETNAME y GETNAME." #DEFINE C_OUTPUT_FILE_IS_NOT_OVERWRITEN_LOC "Optimización: El archivo de salida [<>] no se sobreescribe por ser igual al generado." #DEFINE C_OUTPUTFILE_NEWER_THAN_INPUTFILE_LOC "Optimización: El archivo de salida [<>] no se regenera por ser más nuevo que el de entrada." #DEFINE C_PROCEDURE_NOT_CLOSED_ON_LINE_LOC "Procedimiento sin cerrar. La última línea de código debe ser ENDPROC. [<>, Recno:<>]" #DEFINE C_PROCESSING_LOC "Procesando archivo" #DEFINE C_PROCESS_PROGRESS_LOC "Avance del proceso:" #DEFINE C_PROPERTY_NAME_NOT_RECOGNIZED_LOC "Propiedad [<>] no reconocida." #DEFINE C_REQUESTING_CAPITALIZATION_OF_FILE_LOC "- Solicitado capitalizar el archivo [<>]" #DEFINE C_SOURCEFILE_LOC "Archivo origen: " #DEFINE C_STRUCTURE_NESTING_ERROR_ENDPROC_EXPECTED_LOC "Error de anidamiento de estructuras. Se esperaba ENDPROC pero se encontró ENDDEFINE en la clase <> (<>), línea <> del archivo <>" #DEFINE C_STRUCTURE_NESTING_ERROR_ENDPROC_EXPECTED_2_LOC "Error de anidamiento de estructuras. Se esperaba ENDPROC pero se encontró ENDDEFINE en la clase <> (<>.<>), línea <> del archivo <>" #DEFINE C_UNKNOWN_CLASS_NAME_LOC "Clase [<>] desconocida" #DEFINE C_WARN_TABLE_ALIAS_ON_INDEX_EXPRESSION_LOC "¡¡ATENCIÓN!!" + CR_LF+ "ASEGÚRESE DE QUE NO ESTÁ USANDO UN ALIAS DE TABLA EN LAS EXPRESIONES DE LOS ÍNDICES!! (ej: index on <>.campo tag nombreclave)" #ENDIF ******************************************************************************************************************* 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) *SYS(2335,0) *IF PCOUNT() > 1 && Saltear las querys de SourceSafe sobre soporte de archivos * SET STEP ON * MESSAGEBOX( SYS(5)+CURDIR(),64+4096,PROGRAM(),5000) *ENDIF loCnv = CREATEOBJECT("c_foxbin2prg") loEx = NULL lnResp = loCnv.ejecutar( tc_InputFile, tcType, tcTextName, tlGenText, tcDontShowErrors, tcDebug ; , '', NULL, @loEx, .F., tcOriginalFileName, tcRecompile, tcNoTimestamps ) ADDPROPERTY(_SCREEN, 'ExitCode', lnResp) *IF _VFP.STARTMODE <= 1 * RETURN lnResp *ENDIF SET COVERAGE TO IF _VFP.STARTMODE # 4 STORE NULL TO loEx, loCnv RELEASE loEx, loCnv RETURN lnResp ENDIF IF EMPTY(lnResp) OR VARTYPE(loEx) # "O" STORE NULL TO loEx, loCnv RELEASE loEx, loCnv QUIT ENDIF STORE NULL TO loEx, loCnv RELEASE loEx, loCnv *-- Muy útil para procesos batch que capturan el código de error DECLARE ExitProcess IN Win32API INTEGER ExitCode ExitProcess(1) && Esta debe ser de las últimas instrucciones QUIT ******************************************************************************************************************* DEFINE CLASS c_foxbin2prg AS CUSTOM #IF .F. LOCAL THIS AS c_foxbin2prg OF 'FOXBIN2PRG.PRG' #ENDIF _MEMBERDATA = [] ; + [] ; + [] ; + [] ; + [] ; + [] ; + [] ; + [] ; + [] ; + [] ; + [] ; + [] ; + [] ; + [] ; + [] ; + [] ; + [] ; + [] ; + [] ; + [] ; + [] ; + [] ; + [] ; + [] ; + [] ; + [] ; + [] ; + [] ; + [] ; + [] ; + [] ; + [] ; + [] ; + [] ; + [] ; + [] ; + [] ; + [] ; + [] ; + [] ; + [] ; + [] ; + [] ; + [] ; + [] ; + [] ; + [] ; + [] ; + [] ; + [] ; + [] ; + [] ; + [] ; + [] ; + [] ; + [] ; + [] ; + [] ; + [] ; + [] ; + [] ; + [] ; + [] ; + [] ; + [] ; + [] ; + [] ; + [] ; + [] ; + [] ; + [] ; + [] ; + [] ; + [] ; + [] ; + [] ; + [] ; + [] ; + [] ; + [] ; + [] ; + [] ; + [] PROTECTED l_ConfigEvaluated, n_CFG_Actual, l_Main_CFG_Loaded, o_Configuration, l_CFG_CachedAccess *-- n_FB2PRG_Version = 1.19 *-- Localized properties c_loc_processing_file = C_PROCESSING_LOC *-- c_Language = 'ES' c_FB2PRG_EXE_Version = 0 c_Foxbin2prg_FullPath = '' c_Foxbin2prg_ConfigFile = '' c_CurDir = '' c_InputFile = '' c_OriginalFileName = '' c_LogFile = '' c_TextLog = '' c_OutputFile = '' c_Type = '' t_InputFile_TimeStamp = {//::} t_OutputFile_TimeStamp = {//::} lFileMode = .F. n_ExisteCapitalizacion = -1 l_CFG_CachedAccess = .F. l_ConfigEvaluated = .F. l_Debug = .F. l_Error = .F. c_ErrorLog = '' l_Test = .F. l_ShowErrors = .T. l_ShowProgress = .T. l_AllowMultiConfig = .T. l_DropNullCharsFromCode = .T. l_Recompile = .T. l_UseClassPerFile = .F. l_NoTimestamps = .T. l_ClearUniqueID = .T. l_OptimizeByFilestamp = .F. l_MethodSort_Enabled = .T. && Para Unit Testing se puede cambiar a .F. para buscar diferencias l_PropSort_Enabled = .T. && Para Unit Testing se puede cambiar a .F. para buscar diferencias l_ReportSort_Enabled = .T. && Para Unit Testing se puede cambiar a .F. para buscar diferencias l_Main_CFG_Loaded = .F. n_ExtraBackupLevels = 1 n_ClassTimeStamp = 1130668032 && 2013/11/04 20:00:00 n_CFG_Actual = 0 n_ID = 0 o_Conversor = NULL o_Frm_Avance = NULL o_FSO = NULL o_Configuration = NULL run_AfterCreateTable = '' run_AfterCreate_DB2 = '' c_VC2 = 'VC2' && VCX c_SC2 = 'SC2' && SCX c_PJ2 = 'PJ2' && PJX c_FR2 = 'FR2' && FRX c_LB2 = 'LB2' && LBX c_DB2 = 'DB2' && DBF c_DC2 = 'DC2' && DBC c_MN2 = 'MN2' && MNX PJX_Conversion_Support = 2 VCX_Conversion_Support = 2 SCX_Conversion_Support = 2 FRX_Conversion_Support = 2 LBX_Conversion_Support = 2 MNX_Conversion_Support = 2 DBF_Conversion_Support = 1 DBC_Conversion_Support = 2 DBF_Conversion_Included = '' DBF_Conversion_Excluded = '' PROCEDURE INIT LOCAL lcSys16, lnPosProg, lc_Foxbin2prg_EXE, laValues(1,5) SET DELETED ON SET DATE YMD SET HOURS TO 24 SET CENTURY ON SET SAFETY OFF SET TABLEPROMPT OFF SET POINT TO '.' SET SEPARATOR TO ',' lcSys16 = SYS(16) IF LEFT(lcSys16,10) == 'PROCEDURE ' lnPosProg = AT(" ", lcSys16, 2) + 1 ELSE lnPosProg = 1 ENDIF THIS.c_Language = C_LANGUAGE_LOC THIS.c_Foxbin2prg_FullPath = SUBSTR( lcSys16, lnPosProg ) THIS.c_Foxbin2prg_ConfigFile = FORCEEXT( THIS.c_Foxbin2prg_FullPath, 'CFG' ) THIS.c_CurDir = SYS(5) + CURDIR() THIS.o_FSO = NEWOBJECT("Scripting.FileSystemObject") THIS.o_Configuration = CREATEOBJECT("COLLECTION") lc_Foxbin2prg_EXE = FORCEEXT( THIS.c_Foxbin2prg_FullPath, 'EXE' ) THIS.c_FB2PRG_EXE_Version = IIF( AGETFILEVERSION( laValues, lc_Foxbin2prg_EXE ) = 0, TRANSFORM(THIS.n_FB2PRG_Version), laValues(4) ) ADDPROPERTY(_SCREEN, 'ExitCode', 0) RETURN ENDPROC PROCEDURE DESTROY TRY LOCAL lcFileCDX lcFileCDX = FORCEPATH( "TABLABIN.CDX", JUSTPATH(THIS.c_InputFile) ) ERASE ( lcFileCDX ) THIS.writeLog_Flush() CATCH FINALLY THIS.o_FSO = NULL ENDTRY RETURN ENDPROC FUNCTION get_l_ConfigEvaluated RETURN THIS.l_ConfigEvaluated ENDFUNC FUNCTION get_l_CFG_CachedAccess RETURN THIS.l_CFG_CachedAccess ENDFUNC PROCEDURE l_Debug_ACCESS IF THIS.n_CFG_Actual = 0 OR ISNULL( THIS.o_Configuration( THIS.n_CFG_Actual ) ) RETURN THIS.l_Debug ELSE RETURN NVL( THIS.o_Configuration( THIS.n_CFG_Actual ).l_Debug, THIS.l_Debug ) 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 l_ShowProgress_ACCESS IF THIS.n_CFG_Actual = 0 OR ISNULL( THIS.o_Configuration( THIS.n_CFG_Actual ) ) RETURN THIS.l_ShowProgress ELSE RETURN NVL( THIS.o_Configuration( THIS.n_CFG_Actual ).l_ShowProgress, THIS.l_ShowProgress ) ENDIF ENDPROC PROCEDURE l_Recompile_ACCESS IF THIS.n_CFG_Actual = 0 OR ISNULL( THIS.o_Configuration( THIS.n_CFG_Actual ) ) RETURN THIS.l_Recompile ELSE RETURN NVL( THIS.o_Configuration( THIS.n_CFG_Actual ).l_Recompile, THIS.l_Recompile ) 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 l_UseClassPerFile_ACCESS IF THIS.n_CFG_Actual = 0 OR ISNULL( THIS.o_Configuration( THIS.n_CFG_Actual ) ) RETURN THIS.l_UseClassPerFile ELSE RETURN NVL( THIS.o_Configuration( THIS.n_CFG_Actual ).l_UseClassPerFile, THIS.l_UseClassPerFile ) 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_OptimizeByFilestamp_ACCESS IF THIS.n_CFG_Actual = 0 OR ISNULL( THIS.o_Configuration( THIS.n_CFG_Actual ) ) RETURN THIS.l_OptimizeByFilestamp ELSE RETURN NVL( THIS.o_Configuration( THIS.n_CFG_Actual ).l_OptimizeByFilestamp, THIS.l_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 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 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 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 DECLARE SHORT 'SetFileAttributes' IN kernel32 AS fb2p_SetFileAttributes STRING tcFileName, INTEGER dwFileAttributes DECLARE INTEGER 'GetFileAttributes' IN kernel32 AS fb2p_GetFileAttributes STRING tcFileName * read current attributes for this file dwFileAttributes = fb2p_GetFileAttributes(tcFileName) 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 =fb2p_SetFileAttributes(tcFileName, dwFileAttributes) ENDIF CATCH TO loEx THROW FINALLY CLEAR DLLS fb2p_SetFileAttributes, fb2p_GetFileAttributes ENDTRY RETURN ENDPROC PROCEDURE compileFoxProBinary LPARAMETERS tcFileName LOCAL lcType tcFileName = EVL(tcFileName, THIS.c_OutputFile) lcType = UPPER(JUSTEXT(tcFileName)) DO CASE CASE lcType = 'VCX' COMPILE CLASSLIB (tcFileName) CASE lcType = 'SCX' COMPILE FORM (tcFileName) CASE lcType = 'FRX' COMPILE REPORT (tcFileName) CASE lcType = 'LBX' COMPILE LABEL (tcFileName) CASE lcType = 'DBC' COMPILE DATABASE (tcFileName) ENDCASE 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 #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 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 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, '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 = 'DBC' *-- DBC lcExt_2 = 'DCT' lcExt_3 = 'DCX' tcBakFile_2 = FORCEEXT(tcOutputFile, lcExt_2 + lcNext_Bak) tcBakFile_3 = FORCEEXT(tcOutputFile, lcExt_3 + lcNext_Bak) OTHERWISE *-- PJX, VCX, SCX, FRX, LBX, MNX lcExt_2 = LEFT(lcExt_1,2) + 'T' tcBakFile_2 = FORCEEXT(tcOutputFile, lcExt_2 + lcNext_Bak) ENDCASE IF NOT EMPTY(lcExt_1) tcOutputFile_Ext1 = FORCEEXT(tcOutputFile, lcExt_1) IF FILE( tcOutputFile_Ext1 ) *-- LOG DO CASE CASE EMPTY(lcExt_2) .writeLog( C_BACKUP_OF_LOC + tcOutputFile_Ext1 ) CASE EMPTY(lcExt_3) .writeLog( C_BACKUP_OF_LOC + tcOutputFile_Ext1 + '/' + lcExt_2 ) OTHERWISE .writeLog( C_BACKUP_OF_LOC + tcOutputFile_Ext1 + '/' + lcExt_2 + '/' + lcExt_3 ) ENDCASE *-- COPIA BACKUP COPY FILE ( tcOutputFile_Ext1 ) TO ( tcBakFile_1 ) IF NOT EMPTY(lcExt_2) tcOutputFile_Ext2 = FORCEEXT(tcOutputFile, lcExt_2) IF FILE( tcOutputFile_Ext2 ) COPY FILE ( tcOutputFile_Ext2 ) TO ( tcBakFile_2 ) ENDIF ENDIF IF NOT EMPTY(lcExt_3) tcOutputFile_Ext3 = FORCEEXT(tcOutputFile, lcExt_3) IF FILE( tcOutputFile_Ext3 ) COPY FILE ( tcOutputFile_Ext3 ) TO ( tcBakFile_3 ) ENDIF ENDIF ENDIF ENDIF ENDIF ENDWITH && THIS CATCH TO toEx IF THIS.l_Debug AND _VFP.STARTMODE = 0 SET STEP ON ENDIF IF tlRelanzarError THROW ENDIF FINALLY RELEASE lcNext_Bak, lcExt_1, lcExt_2, lcExt_3, tcOutputFile_Ext1, tcOutputFile_Ext2, tcOutputFile_Ext3 ; , tcOutputFile ENDTRY RETURN ENDPROC PROCEDURE cargar_frm_avance THIS.o_Frm_Avance = CREATEOBJECT("frm_avance") ENDPROC PROCEDURE EvaluarConfiguracion LPARAMETERS tcDontShowProgress, tcDontShowErrors, tcNoTimestamps, tcDebug, tcRecompile, tcExtraBackupLevels ; , tcClearUniqueID, tcOptimizeByFilestamp, tc_InputFile LOCAL lcConfigFile, llExisteConfig, laConfig(1), I, lcConfData, lcExt, lcValue, lc_CFG_Path ; , lo_CFG AS CL_CFG OF 'FOXBIN2PRG.PRG' ; , lo_Configuration AS Collection ; , loEx as Exception TRY WITH THIS AS c_foxbin2prg OF 'FOXBIN2PRG.PRG' STORE 0 TO lnKey tcRecompile = EVL(tcRecompile,'1') lcConfigFile = .c_Foxbin2prg_ConfigFile tc_InputFile = EVL(tc_InputFile, .c_InputFile) IF .l_AllowMultiConfig AND .l_Main_CFG_Loaded IF EMPTY(tc_InputFile) ERROR C_FILE_NOT_FOUND_LOC + ': .c_InputFile = "' + tc_InputFile + '"' ENDIF lcConfigFile = FORCEPATH( 'foxbin2prg.cfg', JUSTPATH(tc_InputFile) ) ENDIF lo_Configuration = .o_Configuration .n_CFG_Actual = 0 .l_CFG_CachedAccess = .F. lc_CFG_Path = UPPER( JUSTPATH( lcConfigFile ) ) IF .l_Main_CFG_Loaded AND lo_Configuration.Count > 0 .n_CFG_Actual = lo_Configuration.GetKey( lc_CFG_Path ) .l_CFG_CachedAccess = (.n_CFG_Actual > 0) ENDIF *IF NOT .l_ConfigEvaluated lo_CFG = THIS IF .n_CFG_Actual = 0 THEN llExisteConfig = FILE( lcConfigFile ) ENDIF IF llExisteConfig AND .n_CFG_Actual = 0 .writeLog( C_CONFIGFILE_LOC + ' ' + lcConfigFile ) IF .l_AllowMultiConfig AND .l_ConfigEvaluated AND .l_Main_CFG_Loaded lo_CFG = CREATEOBJECT('CL_CFG') lo_Configuration.Add( lo_CFG, lc_CFG_Path ) ELSE lo_Configuration.Add( NULL, lc_CFG_Path ) ENDIF FOR I = 1 TO ALINES( laConfig, FILETOSTR( lcConfigFile ), 1+4 ) laConfig(I) = LOWER( laConfig(I) ) DO CASE CASE INLIST( LEFT( laConfig(I), 1 ), '*', '#', '/', "'" ) LOOP CASE LEFT( laConfig(I), 10 ) == LOWER('Extension:') lcConfData = ALLTRIM( SUBSTR( laConfig(I), 11 ) ) lcExt = 'c_' + ALLTRIM( GETWORDNUM( lcConfData, 1, '=' ) ) IF PEMSTATUS( THIS, lcExt, 5 ) .ADDPROPERTY( lcExt, UPPER( ALLTRIM( GETWORDNUM( lcConfData, 2, '=' ) ) ) ) *.writeLog( 'Reconfiguración de extensión:' + ' ' + lcExt + ' a ' + UPPER( ALLTRIM( GETWORDNUM( lcConfData, 2, '=' ) ) ) ) .writeLog( JUSTFNAME(lcConfigFile) + ' > ' + C_EXTENSION_RECONFIGURATION_LOC + ' ' + lcExt + ' a ' + UPPER( ALLTRIM( GETWORDNUM( lcConfData, 2, '=' ) ) ) ) ENDIF CASE LEFT( laConfig(I), 17 ) == LOWER('DontShowProgress:') lcValue = ALLTRIM( SUBSTR( laConfig(I), 18 ) ) IF NOT INLIST( TRANSFORM(tcDontShowProgress), '0', '1' ) AND INLIST( lcValue, '0', '1' ) THEN tcDontShowProgress = lcValue .writeLog( JUSTFNAME(lcConfigFile) + ' > tcDontShowProgress: ' + TRANSFORM(tcDontShowProgress) ) ENDIF CASE LEFT( laConfig(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(I), 16 ) ) IF NOT INLIST( TRANSFORM(tcDontShowErrors), '0', '1' ) AND INLIST( lcValue, '0', '1' ) THEN tcDontShowErrors = lcValue .writeLog( JUSTFNAME(lcConfigFile) + ' > tcDontShowErrors: ' + TRANSFORM(tcDontShowErrors) ) ENDIF CASE LEFT( laConfig(I), 13 ) == LOWER('NoTimestamps:') lcValue = ALLTRIM( SUBSTR( laConfig(I), 14 ) ) IF NOT INLIST( TRANSFORM(tcNoTimestamps), '0', '1' ) AND INLIST( lcValue, '0', '1' ) THEN tcNoTimestamps = lcValue .writeLog( JUSTFNAME(lcConfigFile) + ' > tcNoTimestamps: ' + TRANSFORM(tcNoTimestamps) ) ENDIF CASE LEFT( laConfig(I), 6 ) == LOWER('Debug:') lcValue = ALLTRIM( SUBSTR( laConfig(I), 7 ) ) IF NOT INLIST( TRANSFORM(tcDebug), '0', '1' ) AND INLIST( lcValue, '0', '1' ) THEN tcDebug = lcValue .writeLog( JUSTFNAME(lcConfigFile) + ' > tcDebug: ' + TRANSFORM(tcDebug) ) ENDIF CASE LEFT( laConfig(I), 18 ) == LOWER('ExtraBackupLevels:') lcValue = ALLTRIM( SUBSTR( laConfig(I), 19 ) ) IF NOT ISDIGIT( TRANSFORM(tcExtraBackupLevels) ) AND ISDIGIT( lcValue ) THEN tcExtraBackupLevels = lcValue .writeLog( JUSTFNAME(lcConfigFile) + ' > tcExtraBackupLevels: ' + TRANSFORM(tcExtraBackupLevels) ) ENDIF CASE LEFT( laConfig(I), 14 ) == LOWER('ClearUniqueID:') lcValue = ALLTRIM( SUBSTR( laConfig(I), 15 ) ) IF NOT INLIST( TRANSFORM(tcClearUniqueID), '0', '1' ) AND INLIST( lcValue, '0', '1' ) THEN tcClearUniqueID = lcValue .writeLog( JUSTFNAME(lcConfigFile) + ' > ClearUniqueID: ' + TRANSFORM(lcValue) ) ENDIF CASE LEFT( laConfig(I), 20 ) == LOWER('OptimizeByFilestamp:') lcValue = ALLTRIM( SUBSTR( laConfig(I), 21 ) ) IF NOT INLIST( TRANSFORM(tcOptimizeByFilestamp), '0', '1' ) AND INLIST( lcValue, '0', '1' ) THEN tcOptimizeByFilestamp = lcValue .writeLog( JUSTFNAME(lcConfigFile) + ' > OptimizeByFilestamp: ' + TRANSFORM(lcValue) ) ENDIF CASE LEFT( laConfig(I), 17 ) == LOWER('AllowMultiConfig:') lcValue = ALLTRIM( SUBSTR( laConfig(I), 18 ) ) IF INLIST( lcValue, '0', '1' ) THEN .l_AllowMultiConfig = ( TRANSFORM(lcValue) == '1' ) .writeLog( JUSTFNAME(lcConfigFile) + ' > AllowMultiConfig: ' + TRANSFORM(lcValue) ) ENDIF CASE LEFT( laConfig(I), 16 ) == LOWER('UseClassPerFile:') lcValue = ALLTRIM( SUBSTR( laConfig(I), 17 ) ) IF INLIST( lcValue, '0', '1' ) THEN .l_UseClassPerFile = ( TRANSFORM(lcValue) == '1' ) .writeLog( JUSTFNAME(lcConfigFile) + ' > UseClassPerFile: ' + TRANSFORM(lcValue) ) ENDIF CASE LEFT( laConfig(I), 22 ) == LOWER('DropNullCharsFromCode:') lcValue = ALLTRIM( SUBSTR( laConfig(I), 23 ) ) IF INLIST( lcValue, '0', '1' ) THEN .l_DropNullCharsFromCode = ( TRANSFORM(lcValue) == '1' ) .writeLog( JUSTFNAME(lcConfigFile) + ' > DropNullCharsFromCode: ' + TRANSFORM(lcValue) ) ENDIF CASE LEFT( laConfig(I), 23 ) == LOWER('PJX_Conversion_Support:') lcValue = ALLTRIM( SUBSTR( laConfig(I), 24 ) ) IF INLIST( lcValue, '0', '1', '2' ) THEN lo_CFG.PJX_Conversion_Support = INT( VAL( lcValue ) ) .writeLog( JUSTFNAME(lcConfigFile) + ' > PJX_Conversion_Support: ' + TRANSFORM(lo_CFG.PJX_Conversion_Support) ) ENDIF CASE LEFT( laConfig(I), 23 ) == LOWER('VCX_Conversion_Support:') lcValue = ALLTRIM( SUBSTR( laConfig(I), 24 ) ) IF INLIST( lcValue, '0', '1', '2' ) THEN lo_CFG.VCX_Conversion_Support = INT( VAL( lcValue ) ) .writeLog( JUSTFNAME(lcConfigFile) + ' > VCX_Conversion_Support: ' + TRANSFORM(lo_CFG.VCX_Conversion_Support) ) ENDIF CASE LEFT( laConfig(I), 23 ) == LOWER('SCX_Conversion_Support:') lcValue = ALLTRIM( SUBSTR( laConfig(I), 24 ) ) IF INLIST( lcValue, '0', '1', '2' ) THEN lo_CFG.SCX_Conversion_Support = INT( VAL( lcValue ) ) .writeLog( JUSTFNAME(lcConfigFile) + ' > SCX_Conversion_Support: ' + TRANSFORM(lo_CFG.SCX_Conversion_Support) ) ENDIF CASE LEFT( laConfig(I), 23 ) == LOWER('FRX_Conversion_Support:') lcValue = ALLTRIM( SUBSTR( laConfig(I), 24 ) ) IF INLIST( lcValue, '0', '1', '2' ) THEN lo_CFG.FRX_Conversion_Support = INT( VAL( lcValue ) ) .writeLog( JUSTFNAME(lcConfigFile) + ' > FRX_Conversion_Support: ' + TRANSFORM(lo_CFG.FRX_Conversion_Support) ) ENDIF CASE LEFT( laConfig(I), 23 ) == LOWER('LBX_Conversion_Support:') lcValue = ALLTRIM( SUBSTR( laConfig(I), 24 ) ) IF INLIST( lcValue, '0', '1', '2' ) THEN lo_CFG.LBX_Conversion_Support = INT( VAL( lcValue ) ) .writeLog( JUSTFNAME(lcConfigFile) + ' > LBX_Conversion_Support: ' + TRANSFORM(lo_CFG.LBX_Conversion_Support) ) ENDIF CASE LEFT( laConfig(I), 23 ) == LOWER('MNX_Conversion_Support:') lcValue = ALLTRIM( SUBSTR( laConfig(I), 24 ) ) IF INLIST( lcValue, '0', '1', '2' ) THEN lo_CFG.MNX_Conversion_Support = INT( VAL( lcValue ) ) .writeLog( JUSTFNAME(lcConfigFile) + ' > MNX_Conversion_Support: ' + TRANSFORM(lo_CFG.MNX_Conversion_Support) ) ENDIF CASE LEFT( laConfig(I), 23 ) == LOWER('DBF_Conversion_Support:') lcValue = ALLTRIM( SUBSTR( laConfig(I), 24 ) ) IF INLIST( lcValue, '0', '1', '2', '4' ) THEN lo_CFG.DBF_Conversion_Support = INT( VAL( lcValue ) ) .writeLog( JUSTFNAME(lcConfigFile) + ' > DBF_Conversion_Support: ' + TRANSFORM(lo_CFG.DBF_Conversion_Support) ) ENDIF CASE LEFT( laConfig(I), 24 ) == LOWER('DBF_Conversion_Included:') lcValue = ALLTRIM( SUBSTR( laConfig(I), 25 ) ) IF NOT EMPTY(lcValue) THEN lo_CFG.DBF_Conversion_Included = lcValue .writeLog( JUSTFNAME(lcConfigFile) + ' > DBF_Conversion_Included: ' + TRANSFORM(lo_CFG.DBF_Conversion_Included) ) ENDIF CASE LEFT( laConfig(I), 24 ) == LOWER('DBF_Conversion_Excluded:') lcValue = ALLTRIM( SUBSTR( laConfig(I), 25 ) ) IF NOT EMPTY(lcValue) THEN lo_CFG.DBF_Conversion_Excluded = lcValue .writeLog( JUSTFNAME(lcConfigFile) + ' > DBF_Conversion_Excluded: ' + TRANSFORM(lo_CFG.DBF_Conversion_Excluded) ) ENDIF CASE LEFT( laConfig(I), 23 ) == LOWER('DBC_Conversion_Support:') lcValue = ALLTRIM( SUBSTR( laConfig(I), 24 ) ) IF INLIST( lcValue, '0', '1', '2' ) THEN lo_CFG.DBC_Conversion_Support = INT( VAL( lcValue ) ) .writeLog( JUSTFNAME(lcConfigFile) + ' > DBC_Conversion_Support: ' + TRANSFORM(lo_CFG.DBC_Conversion_Support) ) ENDIF ENDCASE ENDFOR IF .l_AllowMultiConfig AND .l_Main_CFG_Loaded AND lo_Configuration.Count > 0 .n_CFG_Actual = lo_Configuration.Count &&lo_Configuration.GetKey( UPPER( JUSTPATH( lcConfigFile ) ) ) ENDIF ENDIF && llExisteConfig IF INLIST( TRANSFORM(tcDontShowProgress), '0', '1' ) THEN lo_CFG.l_ShowProgress = NOT (TRANSFORM(tcDontShowProgress)=='1') ENDIF IF NOT EMPTY(tcDontShowErrors) 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' ) THEN lo_CFG.l_Debug = (TRANSFORM(tcDebug)=='1') ENDIF tcExtraBackupLevels = EVL( tcExtraBackupLevels, TRANSFORM( lo_CFG.n_ExtraBackupLevels ) ) IF ISDIGIT(tcExtraBackupLevels) lo_CFG.n_ExtraBackupLevels = INT( VAL( TRANSFORM(tcExtraBackupLevels) ) ) ENDIF IF INLIST( TRANSFORM(tcOptimizeByFilestamp), '0', '1' ) THEN lo_CFG.l_OptimizeByFilestamp = NOT (TRANSFORM(tcOptimizeByFilestamp) == '0') ENDIF .writeLog( '---' ) .writeLog( '> l_ShowProgress: ' + TRANSFORM(.l_ShowProgress) ) .writeLog( '> l_ShowErrors: ' + TRANSFORM(.l_ShowErrors) ) .writeLog( '> l_Recompile: ' + TRANSFORM(.l_Recompile) + ' (' + EVL(tcRecompile,'') + ')' ) .writeLog( '> l_NoTimestamps: ' + TRANSFORM(.l_NoTimestamps) ) .writeLog( '> l_ClearUniqueID: ' + TRANSFORM(.l_ClearUniqueID) ) .writeLog( '> l_UseClassPerFile: ' + TRANSFORM(.l_UseClassPerFile) ) .writeLog( '> l_Debug: ' + TRANSFORM(.l_Debug) ) .writeLog( '> n_ExtraBackupLevels: ' + TRANSFORM(.n_ExtraBackupLevels) ) .writeLog( '> l_OptimizeByFilestamp: ' + TRANSFORM(.l_OptimizeByFilestamp) ) .writeLog( '> l_DropNullCharsFromCode: ' + TRANSFORM(.l_DropNullCharsFromCode) ) lo_CFG = NULL RELEASE lo_CFG *-- Si existe una configuración y es NULL, se usa la predeterminada *IF .l_AllowMultiConfig AND .n_CFG_Actual > 0 AND ISNULL( .o_Configuration( .n_CFG_Actual ) ) THEN IF .n_CFG_Actual > 0 AND ISNULL( .o_Configuration( .n_CFG_Actual ) ) THEN .n_CFG_Actual = 0 ENDIF .writeLog( '> l_CFG_CachedAccess: ' + TRANSFORM(.l_CFG_CachedAccess) + ' ( InputFile=' + tc_InputFile + ', CFG=' + FORCEPATH( 'foxbin2prg.cfg', lc_CFG_Path ) + ' )' ) IF NOT llExisteConfig OR .n_CFG_Actual = 0 THEN .l_CFG_CachedAccess = .T. && Es acceso cacheado porque usa config.por defecto sin archivo CFG ENDIF IF NOT .l_Main_CFG_Loaded THEN .l_Main_CFG_Loaded = .T. ENDIF .l_ConfigEvaluated = .T. *ENDIF && .l_ConfigEvaluated ENDWITH && THIS CATCH TO loEx IF THIS.l_Debug AND _VFP.STARTMODE = 0 SET STEP ON ENDIF THROW FINALLY STORE NULL TO lo_Configuration, lo_CFG RELEASE lo_Configuration, lo_CFG ENDTRY RETURN ENDPROC 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) FOR I = 1 TO ALINES( laFiltros, tcFilters + ',', 1+4, ',' ) IF LIKE( UPPER(laFiltros(I)), tcFileName ) llFound = .T. EXIT ENDIF ENDFOR RETURN llFound ENDFUNC PROCEDURE Get_Ext2FromExt LPARAMETERS tcExt LOCAL lcExt2 tcExt = UPPER(tcExt) WITH THIS AS c_foxbin2prg OF 'FOXBIN2PRG.PRG' lcExt2 = ICASE( tcExt == 'PJX', .c_PJ2 ; , tcExt == 'VCX', .c_VC2 ; , tcExt == 'SCX', .c_SC2 ; , tcExt == 'FRX', .c_FR2 ; , tcExt == 'LBX', .c_LB2 ; , tcExt == 'MNX', .c_MN2 ; , tcExt == 'DBF', .c_DB2 ; , tcExt == 'DBC', .c_DC2 ; , 'XXX' ) ENDWITH && THIS RETURN lcExt2 ENDPROC PROCEDURE TieneSoporte_Bin2Prg LPARAMETERS tcExt LOCAL llTieneSoporte WITH THIS AS c_foxbin2prg OF 'FOXBIN2PRG.PRG' llTieneSoporte = ICASE( tcExt == 'PJX', .PJX_Conversion_Support >= 1 ; , tcExt == 'VCX', .VCX_Conversion_Support >= 1 ; , tcExt == 'SCX', .SCX_Conversion_Support >= 1 ; , tcExt == 'FRX', .FRX_Conversion_Support >= 1 ; , tcExt == 'LBX', .LBX_Conversion_Support >= 1 ; , tcExt == 'MNX', .MNX_Conversion_Support >= 1 ; , tcExt == 'DBF', .DBF_Conversion_Support >= 1 ; , tcExt == 'DBC', .DBC_Conversion_Support >= 1 ; , .F. ) ENDWITH && THIS RETURN llTieneSoporte ENDPROC PROCEDURE TieneSoporte_Prg2Bin LPARAMETERS tcExt LOCAL llTieneSoporte WITH THIS AS c_foxbin2prg OF 'FOXBIN2PRG.PRG' llTieneSoporte = ICASE( tcExt == .c_PJ2, .PJX_Conversion_Support = 2 ; , tcExt == .c_VC2, .VCX_Conversion_Support = 2 ; , tcExt == .c_SC2, .SCX_Conversion_Support = 2 ; , tcExt == .c_FR2, .FRX_Conversion_Support = 2 ; , tcExt == .c_LB2, .LBX_Conversion_Support = 2 ; , tcExt == .c_MN2, .MNX_Conversion_Support = 2 ; , tcExt == .c_DB2, .DBF_Conversion_Support = 2 ; , tcExt == .c_DC2, .DBC_Conversion_Support = 2 ; , .F. ) ENDWITH && THIS RETURN llTieneSoporte ENDPROC PROCEDURE ejecutar *-------------------------------------------------------------------------------------------------------------- * PARÁMETROS: (v=Pasar por valor | @=Pasar por referencia) (!=Obligatorio | ?=Opcional) (IN/OUT) * tc_InputFile (v! IN ) Nombre del archivo de entrada * tcType (v? IN ) Tipo de archivo de entrada. SIN USO. Compatibilidad con SCCTEXT.PRG // Si se indica "*" y tc_InputFile es un PJX, se procesa todo el proyecto * tcTextName (v? IN ) Nombre del archivo texto. Compatibilidad con SCCTEXT.PRG * tlGenText (v? IN ) .T.=Genera Texto, .F.=Genera Binario. Compatibilidad con SCCTEXT.PRG * 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 ('1') o no ('0' ó vacío) *-------------------------------------------------------------------------------------------------------------- LPARAMETERS tc_InputFile, tcType, tcTextName, tlGenText, tcDontShowErrors, tcDebug, tcDontShowProgress ; , toModulo, toEx AS EXCEPTION, tlRelanzarError, tcOriginalFileName, tcRecompile, tcNoTimestamps ; , tcBackupLevels, tcClearUniqueID, tcOptimizeByFilestamp TRY LOCAL I, lcPath, lnCodError, lcFileSpec, lcFile, laFiles(1,5) ; , lnFileCount, lcErrorInfo ; , loEx AS EXCEPTION ; , loFSO AS Scripting.FileSystemObject WITH THIS AS c_foxbin2prg OF 'FOXBIN2PRG.PRG' lnCodError = 0 .writeLog( '---' ) .writeLog( .c_Foxbin2prg_FullPath + ' (EXE Version: ' + .c_FB2PRG_EXE_Version + ')' + CR_LF ; + C_TAB + 'tc_InputFile: ' + TRANSFORM(tc_InputFile) + CR_LF ; + C_TAB + 'tcType: ' + TRANSFORM(tcType) + CR_LF; + C_TAB + 'tcTextName: ' + TRANSFORM(tcTextName) + CR_LF ; + C_TAB + 'tlGenText: ' + TRANSFORM(tlGenText) + CR_LF ; + C_TAB + 'tcDontShowErrors: ' + TRANSFORM(tcDontShowErrors) + CR_LF ; + C_TAB + 'tcDebug: ' + TRANSFORM(tcDebug) + CR_LF ; + C_TAB + 'tcDontShowProgress: ' + TRANSFORM(tcDontShowProgress) + CR_LF ; + C_TAB + 'toModulo: ' + TRANSFORM(toModulo) + CR_LF ; + C_TAB + 'toEx: ' + TRANSFORM(toEx) + CR_LF ; + C_TAB + 'tlRelanzarError: ' + TRANSFORM(tlRelanzarError) + CR_LF ; + C_TAB + 'tcOriginalFileName: ' + TRANSFORM(tcOriginalFileName) + CR_LF ; + C_TAB + 'tcRecompile: ' + TRANSFORM(tcRecompile) + CR_LF ; + C_TAB + 'tcNoTimestamps: ' + TRANSFORM(tcNoTimestamps) + CR_LF ; + C_TAB + 'tcBackupLevels: ' + TRANSFORM(tcBackupLevels) + CR_LF ; + C_TAB + 'tcClearUniqueID: ' + TRANSFORM(tcClearUniqueID) + CR_LF ; + C_TAB + 'tcOptimizeByFilestamp: ' + TRANSFORM(tcOptimizeByFilestamp) + CR_LF ) IF _VFP.STARTMODE > 0 SET ESCAPE OFF ENDIF loFSO = .o_FSO tcRecompile = EVL(tcRecompile,'1') DO CASE CASE VERSION(5) < 900 *-- '¡FOXBIN2PRG es solo para Visual FoxPro 9.0!' MESSAGEBOX( C_FOXBIN2PRG_JUST_VFP_9_LOC, 0+64+4096, C_FOXBIN2PRG_WARN_CAPTION_LOC, 60000 ) lnCodError = 1 CASE EMPTY(tc_InputFile) *-- (Ejemplo de sintaxis y uso) MESSAGEBOX( C_FOXBIN2PRG_INFO_SINTAX_EXAMPLE_LOC, 0+64+4096, C_FOXBIN2PRG_INFO_SINTAX_LOC, 60000 ) lnCodError = 1 OTHERWISE *-- Ejecución normal *-- ARCHIVO DE CONFIGURACIÓN PRINCIPAL IF NOT THIS.l_ConfigEvaluated THEN .EvaluarConfiguracion( @tcDontShowProgress, @tcDontShowErrors, @tcNoTimestamps, @tcDebug, @tcRecompile, @tcBackupLevels ; , @tcClearUniqueID, @tcOptimizeByFilestamp ) ENDIF IF .l_ShowProgress .cargar_frm_avance() ENDIF *-- Evaluación de FileSpec de entrada DO CASE CASE '*' $ 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( C_ASTERISK_EXT_NOT_ALLOWED_LOC, 0+48+4096, C_FOXBIN2PRG_ERROR_CAPTION_LOC, 60000 ) ELSE ERROR C_ASTERISK_EXT_NOT_ALLOWED_LOC ENDIF CASE '*' $ JUSTSTEM( tc_InputFile ) *-- SE QUIEREN TODOS LOS ARCHIVOS DE UNA EXTENSIÓN lcFileSpec = FULLPATH( tc_InputFile ) DO CASE CASE .l_Recompile AND LEN(tcRecompile) > 3 AND DIRECTORY(tcRecompile) CD (tcRecompile) CASE tcRecompile == '1' CD (JUSTPATH(lcFileSpec)) ENDCASE .c_LogFile = ADDBS( JUSTPATH( lcFileSpec ) ) + STRTRAN( JUSTFNAME( lcFileSpec ), '*', '_ALL' ) + '.LOG' IF .l_Debug IF FILE( .c_LogFile ) ERASE ( .c_LogFile ) ENDIF ENDIF lnFileCount = ADIR( laFiles, lcFileSpec, '', 1 ) IF .l_ShowProgress .o_Frm_Avance.nMAX_VALUE = lnFileCount ENDIF FOR I = 1 TO lnFileCount lcFile = FORCEPATH( laFiles(I,1), JUSTPATH( lcFileSpec ) ) .o_Frm_Avance.lbl_TAREA.CAPTION = C_PROCESSING_LOC + ' ' + lcFile + '...' .o_Frm_Avance.nVALUE = I IF .l_ShowProgress .o_Frm_Avance.SHOW() ENDIF IF FILE( lcFile ) lnCodError = .Convertir( lcFile, toModulo, @toEx, .T., tcOriginalFileName ) ENDIF ENDFOR OTHERWISE *-- UN ARCHIVO INDIVIDUAL O CONSULTA DE SOPORTE DE ARCHIVO IF LEN(EVL(tc_InputFile,'')) = 1 *-- 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 ENDCASE ELSE DO CASE CASE UPPER( JUSTEXT( EVL(tc_InputFile,'') ) ) == 'PJX' AND EVL(tcType,'0') == '*' *-- SE QUIEREN CONVERTIR A TEXTO TODOS LOS ARCHIVOS DE UN PROYECTO lcFileSpec = FULLPATH( tc_InputFile ) DO CASE CASE .l_Recompile AND LEN(tcRecompile) > 3 AND DIRECTORY(tcRecompile) CD (tcRecompile) CASE tcRecompile == '1' CD (JUSTPATH(lcFileSpec)) ENDCASE .c_LogFile = ADDBS( JUSTPATH( lcFileSpec ) ) + STRTRAN( JUSTFNAME( lcFileSpec ), '*', '_ALL' ) + '.LOG' IF .l_Debug IF FILE( .c_LogFile ) ERASE ( .c_LogFile ) ENDIF ENDIF SELECT 0 USE (tc_InputFile) SHARED AGAIN NOUPDATE ALIAS TABLABIN lnFileCount = 0 SCAN FOR NOT DELETED() lnFileCount = lnFileCount + 1 DIMENSION laFiles(lnFileCount,1) laFiles(lnFileCount,1) = ADDBS( JUSTPATH( lcFileSpec ) ) + ALLTRIM( NAME, 0, ' ', CHR(0) ) ENDSCAN USE IN (SELECT("TABLABIN")) IF .l_ShowProgress .o_Frm_Avance.nMAX_VALUE = lnFileCount ENDIF *-- Primero convierto el proyecto *IF .TieneSoporte_Bin2Prg( UPPER(JUSTEXT(tc_InputFile)) ) * lnCodError = .Convertir( tc_InputFile, toModulo, toEx, tlRelanzarError, tcOriginalFileName ) *ENDIF *-- Luego convierto los archivos incluidos FOR I = 1 TO lnFileCount lcFile = laFiles(I,1) .o_Frm_Avance.lbl_TAREA.CAPTION = C_PROCESSING_LOC + ' ' + lcFile + '...' .o_Frm_Avance.nVALUE = I IF .l_ShowProgress .o_Frm_Avance.SHOW() ENDIF IF .TieneSoporte_Bin2Prg( UPPER(JUSTEXT(lcFile)) ) AND FILE( lcFile ) lnCodError = .Convertir( lcFile, toModulo, @toEx, .T., tcOriginalFileName ) ENDIF ENDFOR CASE UPPER( JUSTEXT( EVL(tc_InputFile,'') ) ) == 'PJ2' AND EVL(tcType,'0') == '*' *-- SE QUIEREN CONVERTIR A BINARIO TODOS LOS ARCHIVOS DE UN PROYECTO lcFileSpec = FULLPATH( tc_InputFile ) DO CASE CASE .l_Recompile AND LEN(tcRecompile) > 3 AND DIRECTORY(tcRecompile) CD (tcRecompile) CASE tcRecompile == '1' CD (JUSTPATH(lcFileSpec)) ENDCASE .c_LogFile = ADDBS( JUSTPATH( lcFileSpec ) ) + STRTRAN( JUSTFNAME( lcFileSpec ), '*', '_ALL' ) + '.LOG' IF .l_Debug IF FILE( .c_LogFile ) ERASE ( .c_LogFile ) ENDIF ENDIF 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(I) laFiles(I) = ADDBS( JUSTPATH( lcFileSpec ) ) + STREXTRACT( laFiles(I), ".ADD('", "')" ) laFiles(I) = FORCEEXT( laFiles(I), .Get_Ext2FromExt( UPPER(JUSTEXT(laFiles(I))) ) ) ELSE lnFileCount = lnFileCount - 1 ADEL( laFiles, I ) DIMENSION laFiles(lnFileCount) ENDIF ENDFOR IF .l_ShowProgress .o_Frm_Avance.nMAX_VALUE = lnFileCount ENDIF *-- Primero convierto el proyecto *IF .TieneSoporte_Prg2Bin( UPPER(JUSTEXT(tc_InputFile)) ) * lnCodError = .Convertir( tc_InputFile, toModulo, toEx, tlRelanzarError, tcOriginalFileName ) *ENDIF *-- Luego convierto los archivos incluidos FOR I = 1 TO lnFileCount lcFile = laFiles(I) .o_Frm_Avance.lbl_TAREA.CAPTION = C_PROCESSING_LOC + ' ' + lcFile + '...' .o_Frm_Avance.nVALUE = I IF .l_ShowProgress .o_Frm_Avance.SHOW() ENDIF IF .TieneSoporte_Prg2Bin( UPPER(JUSTEXT(lcFile)) ) AND FILE( lcFile ) lnCodError = .Convertir( lcFile, toModulo, @toEx, .T., tcOriginalFileName ) ENDIF ENDFOR CASE EVL(tcType,'0') <> '0' AND EVL(tcTextName,'0') <> '0' *-- Compatibilidad con SourceSafe IF NOT tlGenText *-- COMPATIBILIDAD CON SOURCESAFE. 30/01/2014 *-- 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. ENDIF ENDCASE IF FILE(tc_InputFile) ERASE ( tc_InputFile + '.ERR' ) 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' ERASE ( .c_LogFile ) lnCodError = .Convertir( tc_InputFile, toModulo, toEx, .T., tcOriginalFileName ) ENDIF ENDIF ENDCASE ENDCASE ENDWITH && THIS CATCH TO toEx lnCodError = toEx.ERRORNO THIS.l_Error = .T. lcErrorInfo = THIS.Exception2Str(toEx) + CR_LF + CR_LF + C_SOURCEFILE_LOC + THIS.c_InputFile ADDPROPERTY(_SCREEN, 'ExitCode', toEx.ERRORNO) *-- Escribo la información de error en la variable log de errores THIS.writeErrorLog( TTOC(DATETIME(),3) + ' ' + REPLICATE('-', 80) ) THIS.writeErrorLog( lcErrorInfo ) THIS.writeErrorLog( ) *-- Escribo la información de error en el archivo log de errores TRY STRTOFILE( lcErrorInfo, EVL(tc_InputFile,'foxbin2prg') + '.ERR' ) CATCH TO loEx2 ENDTRY IF THIS.l_Debug IF _VFP.STARTMODE = 0 SET STEP ON ENDIF THIS.writeLog( lcErrorInfo ) ENDIF IF THIS.l_ShowErrors MESSAGEBOX( lcErrorInfo, 0+16+4096, C_FOXBIN2PRG_ERROR_CAPTION_LOC, 60000 ) ENDIF IF tlRelanzarError THROW ENDIF FINALLY USE IN (SELECT("TABLABIN")) THIS.writeLog_Flush() IF THIS.l_ShowProgress AND VARTYPE(THIS.o_Frm_Avance) = "O" THIS.o_Frm_Avance.HIDE() THIS.o_Frm_Avance.RELEASE() STORE NULL TO THIS.o_Frm_Avance ENDIF CD (JUSTPATH(THIS.c_CurDir)) STORE NULL TO loFSO RELEASE loFSO ENDTRY RETURN lnCodError ENDPROC PROCEDURE Convertir *-------------------------------------------------------------------------------------------------------------- * 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 ; , loFSO AS Scripting.FileSystemObject lnCodError = 0 WITH THIS AS c_foxbin2prg OF 'FOXBIN2PRG.PRG' loFSO = .o_FSO .c_InputFile = FULLPATH( tc_InputFile ) IF ADIR( laDirFile, .c_InputFile, '', 1 ) = 0 *ERROR 'No se encontró el archivo [' + .c_InputFile + ']' ERROR C_FILE_NOT_FOUND_LOC + ' [' + .c_InputFile + ']' ENDIF .c_InputFile = loFSO.GetAbsolutePathName( FORCEPATH( laDirFile(1,1), JUSTPATH(.c_InputFile) ) ) *-- ARCHIVO DE CONFIGURACIÓN SECUNDARIO .EvaluarConfiguracion() IF NOT EMPTY(tcOriginalFileName) tcOriginalFileName = loFSO.GetAbsolutePathName( tcOriginalFileName ) ENDIF .c_OriginalFileName = EVL( tcOriginalFileName, .c_InputFile ) IF UPPER( JUSTEXT(.c_OriginalFileName) ) = 'PJM' .c_OriginalFileName = FORCEEXT(.c_OriginalFileName,'pjx') ENDIF .writeLog( '> c_OriginalFileName: ' + .c_OriginalFileName ) .o_Conversor = NULL IF NOT FILE(.c_InputFile) ERROR C_FILE_DOESNT_EXIST_LOC + ' [' + .c_InputFile + ']' ENDIF lcExtension = UPPER( JUSTEXT(.c_InputFile) ) .normalizarCapitalizacionArchivos( .T. ) DO CASE CASE lcExtension = 'VCX' IF NOT INLIST(.VCX_Conversion_Support, 1, 2) ERROR (TEXTMERGE(C_FILE_NAME_IS_NOT_SUPPORTED_LOC)) ENDIF .c_OutputFile = FORCEEXT( .c_InputFile, .c_VC2 ) .o_Conversor = CREATEOBJECT( 'c_conversor_vcx_a_prg' ) .ChangeFileAttribute( FORCEEXT( .c_InputFile, .c_VC2 ), '+N' ) CASE lcExtension = 'SCX' IF NOT INLIST(.SCX_Conversion_Support, 1, 2) ERROR (TEXTMERGE(C_FILE_NAME_IS_NOT_SUPPORTED_LOC)) ENDIF .c_OutputFile = FORCEEXT( .c_InputFile, .c_SC2 ) .o_Conversor = CREATEOBJECT( 'c_conversor_scx_a_prg' ) .ChangeFileAttribute( FORCEEXT( .c_InputFile, .c_SC2 ), '+N' ) CASE lcExtension = 'PJX' IF NOT INLIST(.PJX_Conversion_Support, 1, 2) ERROR (TEXTMERGE(C_FILE_NAME_IS_NOT_SUPPORTED_LOC)) ENDIF .c_OutputFile = FORCEEXT( .c_InputFile, .c_PJ2 ) .o_Conversor = CREATEOBJECT( 'c_conversor_pjx_a_prg' ) .ChangeFileAttribute( FORCEEXT( .c_InputFile, .c_PJ2 ), '+N' ) CASE lcExtension = 'PJM' IF NOT INLIST(.PJX_Conversion_Support, 1, 2) ERROR (TEXTMERGE(C_FILE_NAME_IS_NOT_SUPPORTED_LOC)) ENDIF .c_OutputFile = FORCEEXT( .c_InputFile, .c_PJ2 ) .o_Conversor = CREATEOBJECT( 'c_conversor_pjm_a_prg' ) .ChangeFileAttribute( FORCEEXT( .c_InputFile, .c_PJ2 ), '+N' ) CASE lcExtension = 'FRX' IF NOT INLIST(.FRX_Conversion_Support, 1, 2) ERROR (TEXTMERGE(C_FILE_NAME_IS_NOT_SUPPORTED_LOC)) ENDIF .c_OutputFile = FORCEEXT( .c_InputFile, .c_FR2 ) .o_Conversor = CREATEOBJECT( 'c_conversor_frx_a_prg' ) .ChangeFileAttribute( FORCEEXT( .c_InputFile, .c_FR2 ), '+N' ) CASE lcExtension = 'LBX' IF NOT INLIST(.LBX_Conversion_Support, 1, 2) ERROR (TEXTMERGE(C_FILE_NAME_IS_NOT_SUPPORTED_LOC)) ENDIF .c_OutputFile = FORCEEXT( .c_InputFile, .c_LB2 ) .o_Conversor = CREATEOBJECT( 'c_conversor_frx_a_prg' ) .ChangeFileAttribute( FORCEEXT( .c_InputFile, .c_LB2 ), '+N' ) CASE lcExtension = 'DBF' IF NOT INLIST(.DBF_Conversion_Support, 1, 2, 4) ERROR (TEXTMERGE(C_FILE_NAME_IS_NOT_SUPPORTED_LOC)) ENDIF .c_OutputFile = FORCEEXT( .c_InputFile, .c_DB2 ) .o_Conversor = CREATEOBJECT( 'c_conversor_dbf_a_prg' ) .ChangeFileAttribute( FORCEEXT( .c_InputFile, .c_DB2 ), '+N' ) CASE lcExtension = 'DBC' IF NOT INLIST(.DBC_Conversion_Support, 1, 2) ERROR (TEXTMERGE(C_FILE_NAME_IS_NOT_SUPPORTED_LOC)) ENDIF .c_OutputFile = FORCEEXT( .c_InputFile, .c_DC2 ) .o_Conversor = CREATEOBJECT( 'c_conversor_dbc_a_prg' ) .ChangeFileAttribute( FORCEEXT( .c_InputFile, .c_DC2 ), '+N' ) CASE lcExtension = 'MNX' IF NOT INLIST(.MNX_Conversion_Support, 1, 2) ERROR (TEXTMERGE(C_FILE_NAME_IS_NOT_SUPPORTED_LOC)) ENDIF .c_OutputFile = FORCEEXT( .c_InputFile, .c_MN2 ) .o_Conversor = CREATEOBJECT( 'c_conversor_mnx_a_prg' ) .ChangeFileAttribute( FORCEEXT( .c_InputFile, .c_MN2 ), '+N' ) CASE lcExtension = .c_VC2 IF .VCX_Conversion_Support <> 2 ERROR (TEXTMERGE(C_FILE_NAME_IS_NOT_SUPPORTED_LOC)) ENDIF .c_OutputFile = FORCEEXT( .c_InputFile, 'VCX' ) .o_Conversor = CREATEOBJECT( 'c_conversor_prg_a_vcx' ) .ChangeFileAttribute( FORCEEXT( .c_InputFile, 'VCX' ), '+N' ) .ChangeFileAttribute( FORCEEXT( .c_InputFile, 'VCT' ), '+N' ) CASE lcExtension = .c_SC2 IF .SCX_Conversion_Support <> 2 ERROR (TEXTMERGE(C_FILE_NAME_IS_NOT_SUPPORTED_LOC)) ENDIF .c_OutputFile = FORCEEXT( .c_InputFile, 'SCX' ) .o_Conversor = CREATEOBJECT( 'c_conversor_prg_a_scx' ) .ChangeFileAttribute( FORCEEXT( .c_InputFile, 'SCX' ), '+N' ) .ChangeFileAttribute( FORCEEXT( .c_InputFile, 'SCT' ), '+N' ) CASE lcExtension = .c_PJ2 IF .PJX_Conversion_Support <> 2 ERROR (TEXTMERGE(C_FILE_NAME_IS_NOT_SUPPORTED_LOC)) ENDIF .c_OutputFile = FORCEEXT( .c_InputFile, 'PJX' ) .o_Conversor = CREATEOBJECT( 'c_conversor_prg_a_pjx' ) .ChangeFileAttribute( FORCEEXT( .c_InputFile, 'PJX' ), '+N' ) .ChangeFileAttribute( FORCEEXT( .c_InputFile, 'PJT' ), '+N' ) CASE lcExtension = .c_FR2 IF .FRX_Conversion_Support <> 2 ERROR (TEXTMERGE(C_FILE_NAME_IS_NOT_SUPPORTED_LOC)) ENDIF .c_OutputFile = FORCEEXT( .c_InputFile, 'FRX' ) .o_Conversor = CREATEOBJECT( 'c_conversor_prg_a_frx' ) .ChangeFileAttribute( FORCEEXT( .c_InputFile, 'FRX' ), '+N' ) .ChangeFileAttribute( FORCEEXT( .c_InputFile, 'FRT' ), '+N' ) CASE lcExtension = .c_LB2 IF .LBX_Conversion_Support <> 2 ERROR (TEXTMERGE(C_FILE_NAME_IS_NOT_SUPPORTED_LOC)) ENDIF .c_OutputFile = FORCEEXT( .c_InputFile, 'LBX' ) .o_Conversor = CREATEOBJECT( 'c_conversor_prg_a_frx' ) .ChangeFileAttribute( FORCEEXT( .c_InputFile, 'LBX' ), '+N' ) .ChangeFileAttribute( FORCEEXT( .c_InputFile, 'LBT' ), '+N' ) CASE lcExtension = .c_DB2 IF .DBF_Conversion_Support <> 2 ERROR (TEXTMERGE(C_FILE_NAME_IS_NOT_SUPPORTED_LOC)) ENDIF .c_OutputFile = FORCEEXT( .c_InputFile, 'DBF' ) .o_Conversor = CREATEOBJECT( 'c_conversor_prg_a_dbf' ) .ChangeFileAttribute( FORCEEXT( .c_InputFile, 'DBF' ), '+N' ) .ChangeFileAttribute( FORCEEXT( .c_InputFile, 'FPT' ), '+N' ) .ChangeFileAttribute( FORCEEXT( .c_InputFile, 'CDX' ), '+N' ) CASE lcExtension = .c_DC2 IF .DBC_Conversion_Support <> 2 ERROR (TEXTMERGE(C_FILE_NAME_IS_NOT_SUPPORTED_LOC)) ENDIF .c_OutputFile = FORCEEXT( .c_InputFile, 'DBC' ) .o_Conversor = CREATEOBJECT( 'c_conversor_prg_a_dbc' ) .ChangeFileAttribute( FORCEEXT( .c_InputFile, 'DBC' ), '+N' ) .ChangeFileAttribute( FORCEEXT( .c_InputFile, 'DCX' ), '+N' ) .ChangeFileAttribute( FORCEEXT( .c_InputFile, 'DCT' ), '+N' ) CASE lcExtension = .c_MN2 IF .MNX_Conversion_Support <> 2 ERROR (TEXTMERGE(C_FILE_NAME_IS_NOT_SUPPORTED_LOC)) ENDIF .c_OutputFile = FORCEEXT( .c_InputFile, 'MNX' ) .o_Conversor = CREATEOBJECT( 'c_conversor_prg_a_mnx' ) .ChangeFileAttribute( FORCEEXT( .c_InputFile, 'MNX' ), '+N' ) .ChangeFileAttribute( FORCEEXT( .c_InputFile, 'MNT' ), '+N' ) OTHERWISE *ERROR 'El archivo [' + .c_InputFile + '] no está soportado' ERROR (TEXTMERGE(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 >= 1 THEN I = ASCAN( laFiles, JUSTFNAME(.c_InputFile), 1, 0, 1, 1+2+4+8 ) IF I > 0 THEN .t_InputFile_TimeStamp = DATETIME( YEAR(laFiles(I,3)), MONTH(laFiles(I,3)), DAY(laFiles(I,3)) ; , VAL(LEFT(laFiles(I,4),2)), VAL(SUBSTR(laFiles(I,4),4,2)), VAL(RIGHT(laFiles(I,4),2)) ) ENDIF IF FILE( .c_OutputFile ) I = ASCAN( laFiles, JUSTFNAME(.c_OutputFile), 1, 0, 1, 1+2+4+8 ) IF I > 0 THEN .t_OutputFile_TimeStamp = DATETIME( YEAR(laFiles(I,3)), MONTH(laFiles(I,3)), DAY(laFiles(I,3)) ; , VAL(LEFT(laFiles(I,4),2)), VAL(SUBSTR(laFiles(I,4),4,2)), VAL(RIGHT(laFiles(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 I > 0 THEN ltFilestamp = DATETIME( YEAR(laFiles(I,3)), MONTH(laFiles(I,3)), DAY(laFiles(I,3)) ; , VAL(LEFT(laFiles(I,4),2)), VAL(SUBSTR(laFiles(I,4),4,2)), VAL(RIGHT(laFiles(I,4),2)) ) ENDIF ENDCASE .t_OutputFile_TimeStamp = MAX( .t_OutputFile_TimeStamp, ltFilestamp ) ENDIF ENDIF IF NOT .l_OptimizeByFilestamp OR .t_InputFile_TimeStamp >= .t_OutputFile_TimeStamp THEN .c_Type = UPPER(JUSTEXT(.c_OutputFile)) .o_Conversor.c_InputFile = .c_InputFile .o_Conversor.c_OutputFile = .c_OutputFile .o_Conversor.c_LogFile = .c_LogFile .o_Conversor.l_Debug = .l_Debug .o_Conversor.l_Test = .l_Test .o_Conversor.n_FB2PRG_Version = .n_FB2PRG_Version .o_Conversor.l_MethodSort_Enabled = .l_MethodSort_Enabled .o_Conversor.l_PropSort_Enabled = .l_PropSort_Enabled .o_Conversor.l_ReportSort_Enabled = .l_ReportSort_Enabled .o_Conversor.c_OriginalFileName = .c_OriginalFileName .o_Conversor.c_Foxbin2prg_FullPath = .c_Foxbin2prg_FullPath *-- .o_Conversor.Convertir( @toModulo, .F., THIS ) .c_TextLog = .c_TextLog + CR_LF + .o_Conversor.c_TextLog && Recojo el LOG que haya generado el conversor ELSE *-- Optimizado: El Origen es anterior al Destino - No hace falta regenerar *.writeLog( '> El archivo de salida [<>] no se regenera por ser más nuevo que el de entrada.' ) .writeLog( TEXTMERGE(C_OUTPUTFILE_NEWER_THAN_INPUTFILE_LOC) ) ENDIF .normalizarCapitalizacionArchivos() ENDWITH && THIS AS c_foxbin2prg OF 'FOXBIN2PRG.PRG' CATCH TO toEx lnCodError = toEx.ERRORNO lcErrorInfo = THIS.Exception2Str(toEx) + CR_LF + CR_LF + C_SOURCEFILE_LOC + THIS.c_InputFile IF THIS.l_Debug IF _VFP.STARTMODE = 0 SET STEP ON ENDIF ENDIF IF tlRelanzarError && Usado en Unit Testing THROW ENDIF FINALLY loFSO = NULL THIS.o_Conversor = NULL IF lnCodError = 0 OR NOT THIS.l_ShowErrors THEN THIS.writeLog( REPLICATE('-',80) ) *THIS.writeLog_Flush() ENDIF ENDTRY RETURN lnCodError ENDPROC PROCEDURE get_PROGRAM_HEADER LOCAL lcText lcText = '' *-- 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!! * (EN) AUTOGENERATED - ATTENTION!! - NOT INTENDED FOR EXECUTION!! USE ONLY FOR MERGING CHANGES AND STORING WITH SCM TOOLS!! *-------------------------------------------------------------------------------------------------------------------------------------------------------- <> Version="<>" SourceFile="<>" <> (Solo para binarios VFP 9 / Only for VFP 9 binaries) * ENDTEXT 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 lcNext_Bak = '.BAK' FOR I = 1 TO THIS.n_ExtraBackupLevels IF I = 1 IF NOT FILE( tcOutputFileName + '.BAK' ) lcNext_Bak = '.BAK' EXIT ENDIF ELSE IF NOT FILE( tcOutputFileName + '.' + PADL(I-1,1,'0') + '.BAK' ) lcNext_Bak = '.' + PADL(I-1,1,'0') + '.BAK' EXIT ENDIF ENDIF ENDFOR RETURN lcNext_Bak ENDPROC ******************************************************************************************************************* PROCEDURE normalizarCapitalizacionArchivos LPARAMETERS tl_NormalizeInputFile, tcFileName TRY LOCAL lcPath, lcEXE_CAPS, lcOutputFile, llRelanzarError, lcType ; , loEx AS EXCEPTION ; , loFSO AS Scripting.FileSystemObject WITH THIS AS c_foxbin2prg OF 'FOXBIN2PRG.PRG' 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 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( TEXTMERGE(C_NAMES_CAPITALIZATION_PROGRAM_FOUND_LOC) ) .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( TEXTMERGE(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 OTHERWISE *-- Segunda pasada en adelante: Hay programa de capitalización ENDCASE *-- 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 ) CASE lcType = 'VCX' .RenameFile( FORCEEXT(tcFileName,'VCT'), 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 = 'LBX' .RenameFile( FORCEEXT(tcFileName,'LBT'), lcEXE_CAPS, loFSO, llRelanzarError ) CASE lcType = 'DBF' IF FILE( FORCEEXT(tcFileName,'FPT') ) .RenameFile( FORCEEXT(tcFileName,'FPT'), lcEXE_CAPS, loFSO, llRelanzarError ) ENDIF IF FILE( FORCEEXT(tcFileName,'CDX') ) .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 = 'MNX' .RenameFile( FORCEEXT(tcFileName,'MNT'), lcEXE_CAPS, loFSO, llRelanzarError ) ENDCASE ENDWITH && THIS CATCH TO loEx THROW FINALLY loFSO = NULL RELEASE lcPath, lcEXE_CAPS, lcOutputFile, llRelanzarError, lcType, loFSO ENDTRY RETURN ENDPROC ******************************************************************************************************************* PROCEDURE RenameFile LPARAMETERS tcFileName, tcEXE_CAPS, toFSO AS Scripting.FileSystemObject, tlRelanzarError LOCAL lcLog, laFile(1,5) *THIS.writeLog( '- Se ha solicitado capitalizar el archivo [' + tcFileName + ']' ) THIS.writeLog( TEXTMERGE(C_REQUESTING_CAPITALIZATION_OF_FILE_LOC) ) THIS.ChangeFileAttribute( tcFileName, '+N' ) lcLog = '' DO (tcEXE_CAPS) WITH tcFileName, '', 'F', lcLog, tlRelanzarError, '1' THIS.writeLog( lcLog ) ENDPROC ******************************************************************************************************************* PROCEDURE writeErrorLog LPARAMETERS tcText TRY THIS.c_ErrorLog = THIS.c_ErrorLog + EVL(tcText,'') + CR_LF CATCH ENDTRY ENDPROC ******************************************************************************************************************* PROCEDURE writeLog LPARAMETERS tcText TRY THIS.c_TextLog = THIS.c_TextLog + TTOC(DATETIME(),3) + ' ' + EVL(tcText,'') + CR_LF CATCH ENDTRY ENDPROC ******************************************************************************************************************* PROCEDURE writeLog_Flush IF THIS.l_Debug AND NOT EMPTY(THIS.c_TextLog) STRTOFILE( THIS.c_TextLog + CR_LF, THIS.c_LogFile, 1 ) THIS.c_TextLog = '' ENDIF 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 ; + toEx.LINECONTENTS + CR_LF + CR_LF ; + EVL(toEx.USERVALUE,'') RETURN lcError ENDPROC PROCEDURE Unique_ID LPARAMETERS tcValType 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 ENDDEFINE ******************************************************************************************************************* DEFINE CLASS frm_avance AS FORM HEIGHT = 79 WIDTH = 628 SHOWWINDOW = 2 DOCREATE = .T. AUTOCENTER = .T. BORDERSTYLE = 2 CAPTION = C_PROCESS_PROGRESS_LOC + ' ' CONTROLBOX = .F. BACKCOLOR = RGB(255,255,255) nMAX_VALUE = 100 nVALUE = 0 NAME = "FRM_AVANCE" ADD OBJECT shp_base AS SHAPE WITH ; TOP = 50, ; LEFT = 12, ; HEIGHT = 13, ; WIDTH = 601, ; CURVATURE = 15, ; NAME = "shp_base" ADD OBJECT shp_avance AS SHAPE WITH ; TOP = 50, ; LEFT = 12, ; HEIGHT = 13, ; WIDTH = 36, ; CURVATURE = 15, ; BACKCOLOR = RGB(255,255,128), ; BORDERCOLOR = RGB(255,0,0), ; NAME = "shp_Avance" ADD OBJECT lbl_TAREA AS LABEL WITH ; BACKSTYLE = 0, ; CAPTION = ".", ; HEIGHT = 17, ; LEFT = 12, ; TOP = 20, ; WIDTH = 604, ; NAME = "lbl_Tarea" PROCEDURE nvalue_assign LPARAMETERS vNewVal WITH THIS .nVALUE = m.vNewVal .shp_avance.WIDTH = m.vNewVal * .shp_base.WIDTH / .nMAX_VALUE ENDWITH ENDPROC PROCEDURE INIT THIS.nVALUE = 0 ENDPROC ENDDEFINE ******************************************************************************************************************* DEFINE CLASS c_conversor_base AS SESSION #IF .F. LOCAL THIS AS c_conversor_base OF 'FOXBIN2PRG.PRG' #ENDIF _MEMBERDATA = [] ; + [] ; + [] ; + [] ; + [] ; + [] ; + [] ; + [] ; + [] ; + [] ; + [] ; + [] ; + [] ; + [] ; + [] ; + [] ; + [] ; + [] ; + [] ; + [] ; + [] ; + [] ; + [] ; + [] ; + [] ; + [] ; + [] ; + [] ; + [] ; + [] ; + [] ; + [] ; + [] ; + [] ; + [] ; + [] ; + [] ; + [] ; + [] ; + [] ; + [] ; + [] ; + [] ; + [] ; + [] 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) ; , a_SpecialProps_Img(1), a_SpecialProps_Lbl(1), a_SpecialProps_Lin(1), a_SpecialProps_Lst(1) ; , a_SpecialProps_Ole(1), a_SpecialProps_Opg(1), a_SpecialProps_Opb(1), a_SpecialProps_Phk(1) ; , a_SpecialProps_Rel(1), a_SpecialProps_Rls(1), a_SpecialProps_Sep(1), a_SpecialProps_Shp(1) ; , a_SpecialProps_Spn(1), a_SpecialProps_Txt(1), a_SpecialProps_Tmr(1), a_SpecialProps_Tbr(1) ; , a_SpecialProps_XMLAda(1), a_SpecialProps_XMLFld(1), a_SpecialProps_XMLTbl(1) l_Debug = .F. l_Test = .F. c_InputFile = '' c_OutputFile = '' lFileMode = .F. n_ClassTimeStamp = 0 n_FB2PRG_Version = 1.0 c_Foxbin2prg_FullPath = '' c_Type = '' c_CurDir = '' c_LogFile = '' c_TextLog = '' l_MethodSort_Enabled = .T. l_PropSort_Enabled = .T. l_ReportSort_Enabled = .T. c_OriginalFileName = '' c_ClaseActual = '' oFSO = NULL ******************************************************************************************************************* PROCEDURE INIT LOCAL lcSys16, lnPosProg SET DELETED ON SET DATE YMD SET HOURS TO 24 SET CENTURY ON SET SAFETY OFF SET TABLEPROMPT OFF SET BLOCKSIZE TO 0 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) IF LEFT(lcSys16,10) == 'PROCEDURE ' lnPosProg = AT(" ", lcSys16, 2) + 1 ELSE lnPosProg = 1 ENDIF THIS.c_Foxbin2prg_FullPath = SUBSTR( lcSys16, lnPosProg ) THIS.SortSpecialProps() ENDPROC ******************************************************************************************************************* PROCEDURE DESTROY C_FB2PRG_CODE = '' USE IN (SELECT("TABLABIN")) THIS.writeLog( C_CONVERTER_UNLOAD_LOC ) THIS.oFSO = NULL ENDPROC ******************************************************************************************************************* PROCEDURE analizarAsignacion_TAG_Indicado *-- 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 LOCAL llBloqueEncontrado, loEx AS EXCEPTION TRY IF LEFT( tcValue, tnLEN_TAG_I) == tcTAG_I llBloqueEncontrado = .T. LOCAL lcLine, lnArrayCols WITH THIS AS c_foxbin2prg OF 'FOXBIN2PRG.PRG' *-- Propiedad especial IF tcTAG_F $ tcValue && El fin de tag está "inline" .desnormalizarValorPropiedad( @tcPropName, @tcValue, '' ) EXIT ENDIF tcValue = '' lnArrayCols = ALEN(taProps,2) FOR I = I + 1 TO tnProp_Count IF lnArrayCols = 0 lcLine = LTRIM( taProps(I), 0, ' ', CHR(9) ) && Quito espacios y TABS de la izquierda ELSE lcLine = LTRIM( taProps(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 .desnormalizarValorPropiedad( @tcPropName, @tcValue, '' ) I = I + 1 EXIT CASE tcTAG_F $ lcLine *-- Data-Data-Data- tcValue = tcTAG_I + SUBSTR( tcValue, 3 ) + LEFT( lcLine, AT( tcTAG_F, lcLine )-1 ) + tcTAG_F .desnormalizarValorPropiedad( @tcPropName, @tcValue, '' ) I = I + 1 EXIT OTHERWISE *-- Data tcValue = tcValue + CR_LF + lcLine ENDCASE ENDFOR ENDWITH && THIS I = I - 1 ENDIF CATCH TO loEx IF THIS.l_Debug AND _VFP.STARTMODE = 0 SET STEP ON ENDIF THROW ENDTRY RETURN llBloqueEncontrado ENDPROC ******************************************************************************************************************* PROCEDURE buscarObjetoDelMetodoPorNombre LPARAMETERS tcNombreObjeto, toClase *-- Caso 1: Un método de un objeto de la clase *-- buscarObjetoDelMetodoPorNombre( 'command1', loClase ) *-- Caso 2: Un método de un objeto heredado que no está definido en esta librería *-- buscarObjetoDelMetodoPorNombre( '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 *-- 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(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 = I EXIT ENDIF loObjeto = NULL ENDFOR IF lnObjeto > 0 EXIT ENDIF ENDFOR CATCH TO loEx lnCodError = loEx.ERRORNO IF THIS.l_Debug AND _VFP.STARTMODE = 0 SET STEP ON ENDIF THROW ENDTRY RETURN lnObjeto ENDPROC ******************************************************************************************************************* FUNCTION comprobarExpresionValida LPARAMETERS tcAsignacion, tnCodError, tcExpNormalizada LOCAL llError, loEx AS EXCEPTION TRY tcExpNormalizada = NORMALIZE( tcAsignacion ) CATCH TO loEx llError = .T. tnCodError = loEx.ERRORNO ENDTRY RETURN NOT llError ENDFUNC PROCEDURE Convertir *--------------------------------------------------------------------------------------------------- * 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 THIS.writeLog( '' ) THIS.writeLog( C_CONVERTING_FILE_LOC + ' ' + THIS.c_OutputFile + '...' ) ENDPROC PROCEDURE currentLineIsPreviousLineContinuation LPARAMETERS taCodeLines, I LOCAL lcPrevLine, llIsContinuation *-- Analizo la línea anterior para saber si termina con ";" o "," y la actual es continuación IF I > 1 lcPrevLine = taCodeLines(I-1) ELSE lcPrevLine = '' ENDIF .get_SeparatedLineAndComment( @lcPrevLine ) IF INLIST( RIGHT( lcPrevLine,1 ), ';', ',' ) && Esta línea es continuación de la anterior llIsContinuation = .T. ENDIF RETURN llIsContinuation ENDPROC PROCEDURE elTextoEvaluadoEsElTokenIndicado LPARAMETERS tcLine, ta_ID_Bloques, tnLen_IDFinBQ, X, tnIniFin LOCAL llEncontrado, lcWord TRY *-- Pre-normalización lcLine = tcLine IF LEFT(lcLine,1) == '#' lcLine = CHRTRAN( lcLine, ' ', '' ) && Quito los espacios a lo que comience con # ENDIF IF tnIniFin = 1 *-- TOKENS DE INICIO IF UPPER( LEFT( lcLine, LEN(ta_ID_Bloques(X,1)) ) ) == ta_ID_Bloques(X,1) *-- Evaluar casos especiales lcWord = UPPER( ALLTRIM(GETWORDNUM(lcLine,1) ) ) IF ta_ID_Bloques(X,1) == 'TEXT' THEN lcLine = UPPER( lcLine ) + ' ' DO CASE CASE NOT lcWord == 'TEXT' EXIT CASE UPPER( LEFT( CHRTRAN( lcLine, ' ', '' ), 5 ) ) == 'TEXT=' EXIT ENDCASE ENDIF llEncontrado = .T. ENDIF ELSE *-- TOKENS DE FIN IF LEFT( UPPER( lcLine ), tnLen_IDFinBQ ) == ta_ID_Bloques(X,2) && Fin de bloque encontrado (#ENDI, ENDTEXT, etc) *-- Evaluar casos especiales lcWord = UPPER( ALLTRIM(GETWORDNUM(lcLine,1) ) ) IF ta_ID_Bloques(X,2) == 'ENDT' AND NOT lcWord == LEFT( 'ENDTEXT', LEN(lcWord) ) EXIT ENDIF llEncontrado = .T. ENDIF ENDIF ENDTRY 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(I) + '}', CHR(I) ) ENDFOR RETURN tcText ENDPROC ******************************************************************************************************************* PROCEDURE desnormalizarAsignacion LPARAMETERS tcAsignacion LOCAL lcPropName, lcValor, lnCodError, lcExpNormalizada, lnPos, lcComentario THIS.get_SeparatedPropAndValue( @tcAsignacion, @lcPropName, @lcValor ) lcComentario = '' THIS.desnormalizarValorPropiedad( @lcPropName, @lcValor, @lcComentario ) tcAsignacion = lcPropName + ' = ' + lcValor RETURN tcAsignacion ENDPROC ******************************************************************************************************************* PROCEDURE desnormalizarValorPropiedad *-- Este método se ejecuta cuando se regenera el binario desde el tx2 LPARAMETERS tcProp, tcValue, tcComentario LOCAL lnCodError, lnPos, lcValue tcComentario = '' *-- 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' *-- 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 ) TEXT TO lcValue TEXTMERGE ADDITIVE NOSHOW FLAGS 1+2 PRETEXT 1+2 <', I, 1+4 ), CR_LF, ' ' )>> ENDTEXT ENDFOR TEXT TO tcValue TEXTMERGE NOSHOW FLAGS 1 PRETEXT 1+2 <> ENDTEXT 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 ENDCASE RETURN tcValue ENDPROC ******************************************************************************************************************* PROCEDURE desnormalizarValorXML 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 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 RETURN tcValor ENDPROC ******************************************************************************************************************* PROCEDURE encode_SpecialCodes_1_31 LPARAMETERS tcText LOCAL I FOR I = 0 TO 31 tcText = STRTRAN( tcText, CHR(I), '{' + TRANSFORM(I) + '}' ) ENDFOR 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 RETURN lcError ENDPROC ******************************************************************************************************************* PROCEDURE fileTypeCode LPARAMETERS tcExtension tcExtension = UPPER(tcExtension) RETURN ICASE( tcExtension = 'DBC', 'd' ; , tcExtension = 'DBF', 'D' ; , tcExtension = 'QPR', 'Q' ; , tcExtension = 'SCX', 'K' ; , tcExtension = 'FRX', 'R' ; , tcExtension = 'LBX', 'B' ; , tcExtension = 'VCX', 'V' ; , tcExtension = 'PRG', 'P' ; , tcExtension = 'FLL', 'L' ; , tcExtension = 'APP', 'Z' ; , tcExtension = 'EXE', 'Z' ; , tcExtension = 'MNX', 'M' ; , tcExtension = 'TXT', 'T' ; , tcExtension = 'FPW', 'T' ; , tcExtension = 'H', 'T' ; , '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, laDir[1,5], loEx AS EXCEPTION lcTimeStamp_Ret = '' IF EMPTY(tnTimeStamp) IF THIS.lFileMode IF ADIR(laDir,THIS.c_InputFile)=0 EXIT ENDIF ltTimeStamp = EVALUATE( '{^' + DTOC(laDir(1,3)) + ' ' + TRANSFORM(laDir(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 lcTimeStamp_Ret = TTOC( ltTimeStamp ) EXIT ENDIF tnTimeStamp = THIS.n_ClassTimeStamp 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 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 + "}" ) lcTimeStamp_Ret = TTOC( ltTimeStamp ) CATCH TO loEx IF THIS.l_Debug AND _VFP.STARTMODE = 0 SET STEP ON ENDIF THROW ENDTRY 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 EXTERNAL ARRAY taPropsAndValues LOCAL lcMetadatos, I, lnEqualSigns, lcNextVar, lcStr, lcVirtualMeta, lnPos1, lnPos2, lnLastPos, lnCantComillas STORE '' TO lcVirtualMeta STORE 0 TO lnPos1, lnPos2, lnLastPos, tnPropsAndValues_Count, I lcMetadatos = ALLTRIM( STREXTRACT( tcLineWithMetadata, tcLeftTag, tcRightTag, 1, 1) ) 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(C_DATA_ERROR_CANT_PARSE_UNPAIRING_DOUBLE_QUOTES_LOC)) ENDIF 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 * Type="V" Cpid="1252" * ^ ^ => Posiciones del par de comillas dobles lnPos1 = AT( '"', lcMetadatos, I ) lnPos2 = AT( '"', lcMetadatos, 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 ) lnLastPos = lnPos2 + 1 ENDFOR 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 *--------------------------------------------------------------------------------------------------- LPARAMETERS tcLine, tcComment LOCAL ln_AT_Cmt tcComment = '' ln_AT_Cmt = AT( '&'+'&', tcLine) 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 ENDIF 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 *-- 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 .analizarAsignacion_TAG_Indicado( @tcPropName, @tcValue, @taCodeLines, tnCodeLines, @I ; , C_FB2P_VALUE_I, C_FB2P_VALUE_F, C_LEN_FB2P_VALUE_I, C_LEN_FB2P_VALUE_F ) *-- FB2P_VALUE CASE .analizarAsignacion_TAG_Indicado( @tcPropName, @tcValue, @taCodeLines, tnCodeLines, @I ; , C_MEMBERDATA_I, C_MEMBERDATA_F, C_LEN_MEMBERDATA_I, C_LEN_MEMBERDATA_F ) *-- MEMBERDATA OTHERWISE *-- Propiedad normal .desnormalizarValorPropiedad( @tcPropName, @tcValue, '' ) ENDCASE ENDWITH && THIS ENDIF ENDIF 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 RETURN lcValue ENDPROC ******************************************************************************************************************* PROCEDURE identificarBloquesDeCodigo LPARAMETERS taCodeLines, tnCodeLines, taLineasExclusion, tnBloquesExclusion, toModulo ENDPROC PROCEDURE identificarBloquesDeExclusion 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 DIMENSION taLineasExclusion(tnCodeLines), taBloquesExclusion(1,2) STORE 0 TO tnBloquesExclusion, lnPrimerID, I, X, lnLen_IDFinBQ IF tnCodeLines > 1 IF EMPTY(ta_ID_Bloques) DIMENSION ta_ID_Bloques(2,2) ta_ID_Bloques(1,1) = '#IF' ta_ID_Bloques(1,2) = '#ENDI' ta_ID_Bloques(2,1) = 'TEXT' ta_ID_Bloques(2,2) = 'ENDT' lnID_Bloques_Count = ALEN( ta_ID_Bloques, 1 ) ENDIF *-- Búsqueda del ID de inicio de bloque WITH THIS AS c_conversor_prg_a_bin OF 'FOXBIN2PRG.PRG' FOR I = 1 TO tnCodeLines * Reduzco los espacios. Ej: '#IF .F. && cmt' ==> '#IF .F.&&cmt' lcLine = LTRIM( STRTRAN( STRTRAN( CHRTRAN( taCodeLines(I), CHR(9), ' ' ), ' ', ' ' ), ' ', ' ' ) ) IF .lineIsOnlyCommentAndNoMetadata( @lcLine ) LOOP ENDIF lnPrimerID = 0 FOR X = 1 TO lnID_Bloques_Count lnLen_IDFinBQ = LEN( ta_ID_Bloques(X,2) ) IF .elTextoEvaluadoEsElTokenIndicado( @lcLine, @ta_ID_Bloques, lnLen_IDFinBQ, X, 1 ) ; AND NOT THIS.currentLineIsPreviousLineContinuation( @taCodeLines, I ) lnPrimerID = X lnAnidamientos = 1 EXIT ENDIF ENDFOR IF lnPrimerID > 0 && Se ha identificado un ID de bloque excluyente tnBloquesExclusion = tnBloquesExclusion + 1 lnLen_IDFinBQ = LEN( ta_ID_Bloques(lnPrimerID,2) ) DIMENSION taBloquesExclusion(tnBloquesExclusion,2) taBloquesExclusion(tnBloquesExclusion,1) = I taLineasExclusion(I) = .T. * Búsqueda del ID de fin de bloque FOR I = I + 1 TO tnCodeLines * Reduzco los espacios. Ej: '#IF .F. && cmt' ==> '#IF .F.&&cmt' lcLine = LTRIM( STRTRAN( STRTRAN( CHRTRAN( taCodeLines(I), CHR(9), ' ' ), ' ', ' ' ), ' ', ' ' ) ) taLineasExclusion(I) = .T. IF .lineIsOnlyCommentAndNoMetadata( @lcLine ) LOOP ENDIF DO CASE CASE .elTextoEvaluadoEsElTokenIndicado( @lcLine, @ta_ID_Bloques, lnLen_IDFinBQ, X, 1 ) ; AND NOT THIS.currentLineIsPreviousLineContinuation( @taCodeLines, I ) *-- Busca el primer marcador (#IF o TEXT) lnAnidamientos = lnAnidamientos + 1 CASE .elTextoEvaluadoEsElTokenIndicado( @lcLine, @ta_ID_Bloques, lnLen_IDFinBQ, X, 2 ) *-- Busca el segundo marcador (#ENDIF o ENDTEXT) lnAnidamientos = lnAnidamientos - 1 IF lnAnidamientos = 0 taBloquesExclusion(tnBloquesExclusion,2) = I EXIT ENDIF ENDCASE ENDFOR *-- 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)) ERROR (TEXTMERGE(C_END_MARKER_NOT_FOUND_LOC)) ENDIF ENDIF ENDFOR ENDWITH && THIS ENDIF CATCH TO loEx IF THIS.l_Debug AND _VFP.STARTMODE = 0 SET STEP ON ENDIF THROW ENDTRY RETURN ENDPROC ******************************************************************************************************************* PROCEDURE lineaExcluida LPARAMETERS tn_Linea, tnBloquesExclusion, taLineasExclusion EXTERNAL ARRAY taLineasExclusion *LOCAL X, llExcluida *FOR X = 1 TO tnBloquesExclusion * IF BETWEEN( tn_Linea, taBloquesExclusion(X,1), taBloquesExclusion(X,2) ) * llExcluida = .T. * EXIT * ENDIF *ENDFOR *RETURN llExcluida RETURN taLineasExclusion(tn_Linea) ENDPROC ******************************************************************************************************************* PROCEDURE lineIsOnlyCommentAndNoMetadata LPARAMETERS tcLine, tcComment LOCAL lllineIsOnlyCommentAndNoMetadata, ln_AT_Cmt THIS.get_SeparatedLineAndComment( @tcLine, @tcComment ) DO CASE CASE LEFT(tcLine,2) == '*<' tcComment = tcLine CASE EMPTY(tcLine) OR LEFT(tcLine, 1) == '*' OR LEFT(tcLine + ' ', 5) == 'NOTE ' && Vacía o Comentarios lllineIsOnlyCommentAndNoMetadata = .T. ENDCASE RETURN lllineIsOnlyCommentAndNoMetadata ENDPROC ******************************************************************************************************************* PROCEDURE normalizarAsignacion LPARAMETERS tcAsignacion, tcComentario LOCAL lcPropName, lcValor, lnCodError, lcExpNormalizada, lnPos THIS.get_SeparatedPropAndValue( @tcAsignacion, @lcPropName, @lcValor ) tcComentario = '' THIS.normalizarValorPropiedad( @lcPropName, @lcValor, @tcComentario ) tcAsignacion = lcPropName + ' = ' + lcValor RETURN tcAsignacion ENDPROC ******************************************************************************************************************* PROCEDURE normalizarValorPropiedad *-- 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 *-- 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 <<>> <', I, 1+4 ), CR_LF, ' ' )>> ENDTEXT ENDFOR 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 RETURN tcValue ENDPROC ******************************************************************************************************************* PROCEDURE normalizarValorXML 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 ******************************************************************************************************************* 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 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 RETURN INT(tnTimeStamp) ENDFUNC ******************************************************************************************************************* 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, lnPos, loEx AS EXCEPTION lcPropName = tcPropName tcOperation = UPPER(EVL(tcOperation,'')) DO CASE CASE tcOperation == 'GETNAME' lcPropName = SUBSTR(tcPropName,5) CASE NOT tcOperation == 'SETNAME' ERROR C_ONLY_SETNAME_AND_GETNAME_RECOGNIZED_LOC CASE lcPropName == 'Name' && System "Name" property lcPropName = 'A999' + lcPropName OTHERWISE *-- Soporte de evaluación de propiedades por clase evaluada WITH THIS 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 == '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 == '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 == '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 == '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 ) *-- 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 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 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 == '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 == '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 == '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 == '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 == '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 == '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 == '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 == '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 == '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 ) 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 == '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 lcPropName = 'A' + PADL( EVL(lnPos,998), 3, '0' ) + lcPropName ENDWITH && THIS ENDCASE CATCH TO loEx IF THIS.l_Debug AND _VFP.STARTMODE = 0 SET STEP ON ENDIF THROW 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 lnArrayCols = ALEN( taPropsAndValues, 2 ) DIMENSION laPropsAndValues( tnPropsAndValues_Count, lnArrayCols ) ACOPY( taPropsAndValues, laPropsAndValues ) WITH THIS AS c_conversor_base OF 'FOXBIN2PRG.PRG' IF m.tnSortType >= 1 * CON SORT: * - A las que no tienen '.' les pongo 'A' por delante, y al resto 'B' por delante para que queden al final FOR I = 1 TO m.tnPropsAndValues_Count IF '.' $ laPropsAndValues(I,1) IF m.tnSortType = 2 laPropsAndValues(I,1) = 'B' + JUSTSTEM(laPropsAndValues(I,1)) + '.' ; + .sortPropsAndValues_SetAndGetSCXPropNames( 'SETNAME', JUSTEXT(laPropsAndValues(I,1)) ) ELSE laPropsAndValues(I,1) = 'B' + laPropsAndValues(I,1) ENDIF ELSE IF m.tnSortType = 2 laPropsAndValues(I,1) = .sortPropsAndValues_SetAndGetSCXPropNames( 'SETNAME', laPropsAndValues(I,1) ) ELSE laPropsAndValues(I,1) = 'A' + laPropsAndValues(I,1) ENDIF ENDIF ENDFOR IF .l_PropSort_Enabled ASORT( laPropsAndValues, 1, -1, 0, 1) ENDIF FOR I = 1 TO m.tnPropsAndValues_Count *-- Quitar caracteres agregados antes del SORT IF '.' $ laPropsAndValues(I,1) IF m.tnSortType = 2 taPropsAndValues(I,1) = JUSTSTEM( SUBSTR( laPropsAndValues(I,1), 2 ) ) + '.' ; + .sortPropsAndValues_SetAndGetSCXPropNames( 'GETNAME', JUSTEXT(laPropsAndValues(I,1)) ) ELSE taPropsAndValues(I,1) = SUBSTR( laPropsAndValues(I,1), 2 ) ENDIF ELSE IF m.tnSortType = 2 taPropsAndValues(I,1) = .sortPropsAndValues_SetAndGetSCXPropNames( 'GETNAME', laPropsAndValues(I,1) ) ELSE taPropsAndValues(I,1) = SUBSTR( laPropsAndValues(I,1), 2 ) ENDIF ENDIF taPropsAndValues(I,2) = laPropsAndValues(I,2) IF lnArrayCols >= 3 taPropsAndValues(I,3) = laPropsAndValues(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(I,1) ) LOOP ENDIF IF NOT '.' $ laPropsAndValues(I,1) X = X + 1 taPropsAndValues(X,1) = laPropsAndValues(I,1) taPropsAndValues(X,2) = laPropsAndValues(I,2) IF lnArrayCols >= 3 taPropsAndValues(X,3) = laPropsAndValues(I,3) ENDIF ENDIF ENDFOR *-- LUEGO las demás props. FOR I = 1 TO m.tnPropsAndValues_Count IF EMPTY( laPropsAndValues(I,1) ) LOOP ENDIF IF '.' $ laPropsAndValues(I,1) X = X + 1 taPropsAndValues(X,1) = laPropsAndValues(I,1) taPropsAndValues(X,2) = laPropsAndValues(I,2) IF lnArrayCols >= 3 taPropsAndValues(X,3) = laPropsAndValues(I,3) ENDIF ENDIF ENDFOR ENDIF ENDWITH && THIS AS C_CONVERSOR_BASE OF 'FOXBIN2PRG.PRG' CATCH TO loEx IF THIS.l_Debug AND _VFP.STARTMODE = 0 SET STEP ON ENDIF THROW 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 I = 0 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_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_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_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_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_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_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_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_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_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_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_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_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_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_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_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_xmltable.txt", JUSTPATH( .c_Foxbin2prg_FullPath ) ) I = ALINES( .a_SpecialProps_XMLTbl, FILETOSTR( lcPropsFile ), 1+4 ) ENDWITH CATCH TO loEx loEx.USERVALUE = 'lcPropsFile = ' + lcPropsFile IF THIS.l_Debug AND _VFP.STARTMODE = 0 SET STEP ON ENDIF THROW ENDTRY RETURN ENDPROC ******************************************************************************************************************* PROCEDURE writeLog LPARAMETERS tcText TRY THIS.c_TextLog = THIS.c_TextLog + TTOC(DATETIME(),3) + ' ' + EVL(tcText,'') + CR_LF CATCH ENDTRY ENDPROC 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 _MEMBERDATA = [] ; + [] ; + [] ; + [] ; + [] ; + [] ; + [] ; + [] ; + [] ; + [] ; + [] ; + [] ; + [] ; + [] ; + [] ; + [] ; + [] ; + [] ; + [] ; + [] ; + [] ; + [] ; + [] ; + [] ; + [] ; + [] ; + [] ; + [] ; + [] ; + [] ; + [] ; + [] ; + [] ; + [] ; + [] ; + [] ; + [] ; + [] ; + [] ; + [] ; + [] ******************************************************************************************************************* PROCEDURE Convertir *--------------------------------------------------------------------------------------------------- * 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 ) 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 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 luPropValue = '' ELSE luPropValue = taPropsAndValues( lnPos, 2 ) ENDIF DO CASE CASE tcValueType = 'I' luPropValue = CAST( luPropValue AS INTEGER ) CASE tcValueType = 'N' luPropValue = CAST( luPropValue AS DOUBLE ) CASE tcValueType = 'T' luPropValue = CAST( luPropValue AS DATETIME ) CASE tcValueType = 'D' luPropValue = CAST( luPropValue AS DATE ) CASE tcValueType = 'E' luPropValue = EVALUATE( luPropValue ) OTHERWISE && Asumo 'C' para lo demás luPropValue = luPropValue ENDCASE RETURN luPropValue ENDFUNC ******************************************************************************************************************* PROCEDURE analizarBloque_FoxBin2Prg *------------------------------------------------------ *-- Analiza el bloque *------------------------------------------------------ LPARAMETERS toModulo, tcLine, taCodeLines, I, tnCodeLines LOCAL llBloqueEncontrado, laPropsAndValues(1,2), lnPropsAndValues_Count IF LEFT( tcLine + ' ', LEN(C_FB2PRG_META_I) + 1 ) == C_FB2PRG_META_I + ' ' llBloqueEncontrado = .T. *-- Metadatos del módulo THIS.get_ListNamesWithValuesFrom_InLine_MetadataTag( @tcLine, @laPropsAndValues, @lnPropsAndValues_Count, C_FB2PRG_META_I, C_FB2PRG_META_F ) toModulo._Version = THIS.get_ValueByName_FromListNamesWithValues( 'Version', 'N', @laPropsAndValues ) toModulo._SourceFile = THIS.get_ValueByName_FromListNamesWithValues( 'SourceFile', 'C', @laPropsAndValues ) ENDIF RETURN llBloqueEncontrado ENDPROC PROCEDURE analizarBloque_LIBCOMMENT *------------------------------------------------------ *-- Analiza el bloque * *------------------------------------------------------ LPARAMETERS toModulo, tcLine, taCodeLines, I, tnCodeLines LOCAL llBloqueEncontrado, laPropsAndValues(1,2), lnPropsAndValues_Count IF 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 RETURN llBloqueEncontrado ENDPROC ******************************************************************************************************************* PROCEDURE createProject CREATE TABLE (THIS.c_OutputFile) ; ( NAME M ; , TYPE C(1) ; , ID N(10) ; , TIMESTAMP N(10) ; , OUTFILE M ; , HOMEDIR M ; , EXCLUDE L ; , MAINPROG L ; , SAVECODE L ; , DEBUG L ; , ENCRYPT L ; , NOLOGO L ; , CMNTSTYLE N(1) ; , OBJREV N(5) ; , DEVINFO M ; , SYMBOLS M ; , OBJECT M ; , CKVAL N(6) ; , CPID N(5) ; , OSTYPE C(4) ; , OSCREATOR C(4) ; , COMMENTS M ; , RESERVED1 M ; , RESERVED2 M ; , SCCDATA M ; , LOCAL L ; , KEY C(32) ; , USER M ) USE (THIS.c_OutputFile) ALIAS TABLABIN AGAIN SHARED ENDPROC ******************************************************************************************************************* PROCEDURE createProject_RecordHeader LPARAMETERS toProject #IF .F. LOCAL toProject AS CL_PROJECT OF 'FOXBIN2PRG.PRG' #ENDIF INSERT INTO TABLABIN ; ( NAME ; , TYPE ; , TIMESTAMP ; , OUTFILE ; , HOMEDIR ; , SAVECODE ; , DEBUG ; , ENCRYPT ; , NOLOGO ; , CMNTSTYLE ; , OBJREV ; , DEVINFO ; , OBJECT ; , RESERVED1 ; , RESERVED2 ; , SCCDATA ; , LOCAL ; , KEY ) ; VALUES ; ( UPPER(EVL(THIS.c_OriginalFileName,THIS.c_OutputFile)) ; , 'H' ; , 0 ; , '' + CHR(0) ; , toProject._HomeDir + CHR(0) ; , toProject._SaveCode ; , toProject._Debug ; , toProject._Encrypted ; , toProject._NoLogo ; , toProject._CmntStyle ; , 260 ; , toProject.getRowDeviceInfo() ; , toProject._HomeDir + CHR(0) ; , UPPER(THIS.c_OutputFile) ; , toProject._ServerHead.getRowServerInfo() ; , toProject._SccData ; , .T. ; , UPPER( JUSTSTEM( THIS.c_OutputFile) ) ) ENDPROC ******************************************************************************************************************* PROCEDURE createClasslib CREATE TABLE (THIS.c_OutputFile) ; ( PLATFORM C(8) ; , UNIQUEID C(10) ; , TIMESTAMP N(10) ; , CLASS M ; , CLASSLOC M ; , BASECLASS M ; , OBJNAME M ; , PARENT M ; , PROPERTIES M ; , PROTECTED M ; , METHODS M ; , OBJCODE M NOCPTRANS ; , OLE M ; , OLE2 M ; , RESERVED1 M ; , RESERVED2 M ; , RESERVED3 M ; , RESERVED4 M ; , RESERVED5 M ; , RESERVED6 M ; , RESERVED7 M ; , RESERVED8 M ; , USER M ) USE (THIS.c_OutputFile) ALIAS TABLABIN AGAIN SHARED ENDPROC ******************************************************************************************************************* PROCEDURE createClasslib_RecordHeader LPARAMETERS toModulo #IF .F. LOCAL toModulo AS CL_MODULO OF 'FOXBIN2PRG.PRG' #ENDIF INSERT INTO TABLABIN ; ( PLATFORM ; , UNIQUEID ; , RESERVED1 ; , RESERVED7 ) ; VALUES ; ( 'COMMENT' ; , 'Class' ; , 'VERSION = 3.00' ; , toModulo._Comment ) ENDPROC ******************************************************************************************************************* PROCEDURE createForm CREATE TABLE (THIS.c_OutputFile) ; ( PLATFORM C(8) ; , UNIQUEID C(10) ; , TIMESTAMP N(10) ; , CLASS M ; , CLASSLOC M ; , BASECLASS M ; , OBJNAME M ; , PARENT M ; , PROPERTIES M ; , PROTECTED M ; , METHODS M ; , OBJCODE M NOCPTRANS ; , OLE M ; , OLE2 M ; , RESERVED1 M ; , RESERVED2 M ; , RESERVED3 M ; , RESERVED4 M ; , RESERVED5 M ; , RESERVED6 M ; , RESERVED7 M ; , RESERVED8 M ; , USER M ) USE (THIS.c_OutputFile) ALIAS TABLABIN AGAIN SHARED ENDPROC ******************************************************************************************************************* PROCEDURE createForm_RecordHeader LPARAMETERS toModulo #IF .F. LOCAL toModulo AS CL_MODULO OF 'FOXBIN2PRG.PRG' #ENDIF INSERT INTO TABLABIN ; ( PLATFORM ; , UNIQUEID ; , RESERVED1 ; , RESERVED7 ) ; VALUES ; ( 'COMMENT' ; , 'Screen' ; , 'VERSION = 3.00' ; , toModulo._Comment ) ENDPROC ******************************************************************************************************************* PROCEDURE createReport CREATE TABLE (THIS.c_OutputFile) ; ( 'PLATFORM' C(8) ; , 'UNIQUEID' C(10) ; , 'TIMESTAMP' N(10) ; , 'OBJTYPE' N(2) ; , 'OBJCODE' N(3) ; , 'NAME' M ; , 'EXPR' M ; , 'VPOS' N(9,3) ; , 'HPOS' N(9,3) ; , 'HEIGHT' N(9,3) ; , 'WIDTH' N(9,3) ; , 'STYLE' M ; , 'PICTURE' M ; , 'ORDER' M NOCPTRANS ; , 'UNIQUE' L ; , 'COMMENT' M ; , 'ENVIRON' L ; , 'BOXCHAR' C(1) ; , 'FILLCHAR' C(1) ; , 'TAG' M ; , 'TAG2' M NOCPTRANS ; , 'PENRED' N(5) ; , 'PENGREEN' N(5) ; , 'PENBLUE' N(5) ; , 'FILLRED' N(5) ; , 'FILLGREEN' N(5) ; , 'FILLBLUE' N(5) ; , 'PENSIZE' N(5) ; , 'PENPAT' N(5) ; , 'FILLPAT' N(5) ; , 'FONTFACE' M ; , 'FONTSTYLE' N(3) ; , 'FONTSIZE' N(3) ; , 'MODE' N(3) ; , 'RULER' N(1) ; , 'RULERLINES' N(1) ; , 'GRID' L ; , 'GRIDV' N(2) ; , 'GRIDH' N(2) ; , 'FLOAT' L ; , 'STRETCH' L ; , 'STRETCHTOP' L ; , 'TOP' L ; , 'BOTTOM' L ; , 'SUPTYPE' N(1) ; , 'SUPREST' N(1) ; , 'NOREPEAT' L ; , 'RESETRPT' N(2) ; , 'PAGEBREAK' L ; , 'COLBREAK' L ; , 'RESETPAGE' L ; , 'GENERAL' N(3) ; , 'SPACING' N(3) ; , 'DOUBLE' L ; , 'SWAPHEADER' L ; , 'SWAPFOOTER' L ; , 'EJECTBEFOR' L ; , 'EJECTAFTER' L ; , 'PLAIN' L ; , 'SUMMARY' L ; , 'ADDALIAS' L ; , 'OFFSET' N(3) ; , 'TOPMARGIN' N(3) ; , 'BOTMARGIN' N(3) ; , 'TOTALTYPE' N(2) ; , 'RESETTOTAL' N(2) ; , 'RESOID' N(3) ; , 'CURPOS' L ; , 'SUPALWAYS' L ; , 'SUPOVFLOW' L ; , 'SUPRPCOL' N(1) ; , 'SUPGROUP' N(2) ; , 'SUPVALCHNG' L ; , 'SUPEXPR' M ; , 'USER' M ) USE (THIS.c_OutputFile) ALIAS TABLABIN AGAIN SHARED ENDPROC ******************************************************************************************************************* PROCEDURE createMenu CREATE TABLE (THIS.c_OutputFile) ; ( 'OBJTYPE' Numeric(2) ; , 'OBJCODE' Numeric(2) ; , 'NAME' MEMO ; , 'PROMPT' MEMO ; , 'COMMAND' MEMO ; , 'MESSAGE' MEMO ; , 'PROCTYPE' Numeric(1) ; , 'PROCEDURE' MEMO ; , 'SETUPTYPE' Numeric(1) ; , 'SETUP' MEMO ; , 'CLEANTYPE' Numeric(1) ; , '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) ; , 'LOCATION' Numeric(2) ; , 'SCHEME' Numeric(2) ; , 'SYSRES' Numeric(1) ; , 'RESNAME' MEMORY(4) ) USE (THIS.c_OutputFile) ALIAS TABLABIN AGAIN SHARED ENDPROC ******************************************************************************************************************* PROCEDURE emptyRecord LOCAL loReg SCATTER MEMO BLANK NAME loReg RETURN loReg ENDPROC ******************************************************************************************************************* PROCEDURE escribirArchivoBin LPARAMETERS toModulo ENDPROC ******************************************************************************************************************* PROCEDURE classProps2Memo *-- ARMA EL MEMO DE PROPERTIES CON LAS PROPIEDADES Y SUS VALORES LPARAMETERS toClase #IF .F. LOCAL toClase AS CL_CLASE 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: TRY LOCAL lcDefinedPAM, lnPos, lnPos2, laProps(1,2), lcLine, lcPropName, lcValue, I, lcAsignacion, lcMemo ; , laPropsAndValues(1,2), lnPropsAndValues_Count lcMemo = '' IF toClase._Prop_Count > 0 THIS.c_ClaseActual = LOWER(toClase._BaseClass) DIMENSION laPropsAndValues( toClase._Prop_Count, 3 ) ACOPY( toClase._Props, laPropsAndValues ) lnPropsAndValues_Count = toClase._Prop_Count *-- REORDENO LAS PROPIEDADES THIS.sortPropsAndValues( @laPropsAndValues, lnPropsAndValues_Count, 2 ) *-- ARMO EL MEMO A DEVOLVER FOR I = 1 TO lnPropsAndValues_Count lcMemo = lcMemo + laPropsAndValues(I,1) + ' = ' + laPropsAndValues(I,2) + CR_LF ENDFOR ENDIF && laProps > 0 CATCH TO loEx IF THIS.l_Debug AND _VFP.STARTMODE = 0 SET STEP ON ENDIF THROW ENDTRY RETURN lcMemo ENDPROC ******************************************************************************************************************* 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 LOCAL lcMemo, I, laPropsAndValues(1,2), lcPropName, lcValue lcMemo = '' IF toObjeto._Prop_Count > 0 THIS.c_ClaseActual = LOWER(toObjeto._BaseClass) DIMENSION laPropsAndValues( toObjeto._Prop_Count, 2 ) ACOPY( toObjeto._Props, laPropsAndValues ) *-- REORDENO LAS PROPIEDADES THIS.sortPropsAndValues( @laPropsAndValues, toObjeto._Prop_Count, 2 ) *-- ARMO EL MEMO A DEVOLVER FOR I = 1 TO toObjeto._Prop_Count lcMemo = lcMemo + laPropsAndValues(I,1) + ' = ' + laPropsAndValues(I,2) + CR_LF ENDFOR ENDIF RETURN lcMemo ENDPROC ******************************************************************************************************************* PROCEDURE classMethods2Memo LPARAMETERS toClase #IF .F. LOCAL toClase AS CL_CLASE OF 'FOXBIN2PRG.PRG' #ENDIF LOCAL lcMemo, I, X, lcNombreObjeto ; , loProcedure AS CL_PROCEDURE OF 'FOXBIN2PRG.PRG' lcMemo = '' *-- Recorrer los métodos FOR I = 1 TO toClase._Procedure_Count loProcedure = NULL loProcedure = toClase._Procedures(I) IF loProcedure._ProcLine_Count > 0 THEN 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 THIS.buscarObjetoDelMetodoPorNombre( lcNombreObjeto, toClase ) = 0 TEXT TO lcMemo ADDITIVE TEXTMERGE NOSHOW FLAGS 1 PRETEXT 1+2 <> <> ENDTEXT ELSE TEXT TO lcMemo ADDITIVE TEXTMERGE NOSHOW FLAGS 1 PRETEXT 1+2 <> <> ENDTEXT ENDIF ELSE TEXT TO lcMemo ADDITIVE TEXTMERGE NOSHOW FLAGS 1 PRETEXT 1+2 <> <> ENDTEXT ENDIF *-- Incluir las líneas del método FOR X = 1 TO loProcedure._ProcLine_Count TEXT TO lcMemo ADDITIVE TEXTMERGE NOSHOW FLAGS 1+2 PRETEXT 1+2 <> ENDTEXT ENDFOR TEXT TO lcMemo ADDITIVE TEXTMERGE NOSHOW FLAGS 1+2 PRETEXT 1+2 <> <<>> ENDTEXT ENDIF ENDFOR loProcedure = NULL RELEASE loProcedure RETURN lcMemo ENDPROC ******************************************************************************************************************* PROCEDURE objectMethods2Memo LPARAMETERS toObjeto, toClase #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' lcMemo = '' *-- Recorrer los métodos FOR I = 1 TO toObjeto._Procedure_Count loProcedure = NULL loProcedure = toObjeto._Procedures(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 TEXT TO lcMemo ADDITIVE TEXTMERGE NOSHOW FLAGS 1+2 PRETEXT 1+2 <> ENDTEXT ENDFOR TEXT TO lcMemo ADDITIVE TEXTMERGE NOSHOW FLAGS 1+2 PRETEXT 1+2 <> <<>> ENDTEXT ENDFOR loProcedure = NULL RELEASE 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 #IF .F. LOCAL toClase AS CL_CLASE OF 'FOXBIN2PRG.PRG' #ENDIF LOCAL I, lcComentario lcComentario = '' FOR I = 1 TO toClase._Prop_Count IF RTRIM( GETWORDNUM( toClase._Props(I,1), 1, '=' ) ) == tcPropName lcComentario = toClase._Props( I, 2 ) EXIT ENDIF ENDFOR RETURN lcComentario ENDPROC ******************************************************************************************************************* PROCEDURE getClassMethodComment LPARAMETERS tcMethodName AS STRING, toClase #IF .F. LOCAL toClase AS CL_CLASE OF 'FOXBIN2PRG.PRG' #ENDIF LOCAL I, lcComentario ; , loProcedure AS CL_PROCEDURE OF 'FOXBIN2PRG.PRG' lcComentario = '' FOR I = 1 TO toClase._Procedure_Count loProcedure = NULL loProcedure = toClase._Procedures(I) IF loProcedure._Nombre == tcMethodName lcComentario = loProcedure._Comentario EXIT ENDIF ENDFOR loProcedure = NULL RELEASE loProcedure RETURN lcComentario 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( SYS(2023) ) ) ) **** CONTINUAR SI ES NECESARIO - SIN USO POR AHORA CATCH TO loEx THROW FINALLY USE IN (SELECT("_TABLABIN")) SELECT (lnSelect) ENDTRY 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 strip_Dimensions LPARAMETERS tcSeparatedCommaVars LOCAL lnPos1, lnPos2, I FOR I = OCCURS( '[', tcSeparatedCommaVars ) TO 1 STEP -1 lnPos1 = AT( '[', tcSeparatedCommaVars, I ) lnPos2 = AT( ']', tcSeparatedCommaVars, I ) tcSeparatedCommaVars = STUFF( tcSeparatedCommaVars, lnPos1, lnPos2 - lnPos1 + 1, '' ) ENDFOR ENDPROC ******************************************************************************************************************* PROCEDURE hiddenAndProtected_PAM LPARAMETERS toClase #IF .F. LOCAL toClase AS CL_CLASE OF 'FOXBIN2PRG.PRG' #ENDIF LOCAL lcMemo, I, lcPAM, lcComentario lcMemo = '' 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 RETURN lcMemo ENDPROC ******************************************************************************************************************* PROCEDURE Evaluate_PAM LPARAMETERS tcMemo AS STRING, tcPAM AS STRING, tcPAM_Type AS STRING, tcPAM_Visibility AS STRING LOCAL lcPAM, I FOR I = 1 TO OCCURS( ',', tcPAM + ',' ) lcPAM = ALLTRIM( GETWORDNUM( tcPAM, I, ',' ) ) IF NOT EMPTY(lcPAM) IF EVL(tcPAM_Visibility, 'normal') == 'hidden' lcPAM = lcPAM + '^' ENDIF TEXT TO tcMemo ADDITIVE TEXTMERGE NOSHOW FLAGS 1 PRETEXT 1+2 <> <<>> ENDTEXT ENDIF ENDFOR ENDPROC ******************************************************************************************************************* 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 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) toObjeto._TimeStamp = THIS.RowTimeStamp( {^2013/11/04 20:00:00} ) ENDIF IF EMPTY(toObjeto._UniqueID) toObjeto._UniqueID = toFoxBin2Prg.Unique_ID() ENDIF *-- Inserto el objeto 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' ; , toObjeto._UniqueID ; , toObjeto._TimeStamp ; , toObjeto._Class ; , toObjeto._ClassLib ; , toObjeto._BaseClass ; , toObjeto._ObjName ; , toObjeto._Parent ; , lcPropsMemo ; , '' ; , lcMethodsMemo ; , toObjeto._Ole ; , toObjeto._Ole2 ; , '' ; , '' ; , '' ; , '' ; , '' ; , '' ; , '' ; , '' ; , toObjeto._User ) ENDIF ENDWITH && THIS 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 #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 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 ) FOR X = 1 TO toClase._AddObject_Count loObjeto = toClase._AddObjects( X ) IF EMPTY(loObjeto._TimeStamp) loObjeto._TimeStamp = THIS.RowTimeStamp( {^2013/11/04 20:00:00} ) ENDIF IF EMPTY(loObjeto._UniqueID) loObjeto._UniqueID = toFoxBin2Prg.Unique_ID() ENDIF laObjNames( X, 1 ) = loObjeto._Nombre laObjNames( X, 2 ) = loObjeto._ZOrder loObjeto = NULL ENDFOR ASORT( laObjNames, 2, -1, 0, 1 ) *-- Escribo los objetos en el orden Z FOR X = 1 TO toClase._AddObject_Count lcObjName = laObjNames( X, 1 ) FOR EACH loObjeto IN toClase._AddObjects FOXOBJECT *-- Verifico que sea el objeto que corresponde IF loObjeto._WriteOrder = 0 AND loObjeto._Nombre == 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 ) ENDIF ENDFOR ENDIF && toClase._AddObject_Count > 0 ENDWITH && THIS CATCH TO loEx IF THIS.l_Debug AND _VFP.STARTMODE = 0 SET STEP ON ENDIF THROW FINALLY loObjeto = NULL RELEASE loObjeto ENDTRY RETURN ENDPROC ******************************************************************************************************************* PROCEDURE set_Line LPARAMETERS tcLine, taCodeLines, I tcLine = LTRIM( taCodeLines(I), 0, ' ', CHR(9) ) ENDPROC ******************************************************************************************************************* PROCEDURE analizarLineasDeProcedure LPARAMETERS toClase, toObjeto, tcLine, taCodeLines, I, tnCodeLines, tcProcedureAbierto, tc_Comentario ; , taLineasExclusion, tnBloquesExclusion EXTERNAL ARRAY taCodeLines #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' 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 WITH THIS AS c_conversor_prg_a_bin OF 'FOXBIN2PRG.PRG' FOR I = I + 1 TO tnCodeLines .set_Line( @tcLine, @taCodeLines, I ) IF NOT .lineaExcluida( I, tnBloquesExclusion, @taLineasExclusion ) ; AND NOT .lineIsOnlyCommentAndNoMetadata( @tcLine, @tc_Comentario ) DO CASE CASE LEFT( tcLine, 8 ) + ' ' == C_ENDPROC + ' ' && Fin del PROCEDURE tcProcedureAbierto = '' EXIT CASE LEFT( tcLine + ' ', 10 ) == C_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(I) + ' del archivo ' + .c_InputFile ERROR (TEXTMERGE(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(I) + ' del archivo ' + .c_InputFile ERROR (TEXTMERGE(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(I),2 ) = C_TAB + C_TAB loProcedure.add_Line( SUBSTR(taCodeLines(I), 3) ) CASE LEFT( taCodeLines(I),1 ) = C_TAB loProcedure.add_Line( SUBSTR(taCodeLines(I), 2) ) OTHERWISE loProcedure.add_Line( taCodeLines(I) ) ENDCASE ENDFOR ENDWITH && THIS CATCH TO loEx IF THIS.l_Debug AND _VFP.STARTMODE = 0 SET STEP ON ENDIF THROW FINALLY loProcedure = NULL RELEASE loProcedure ENDTRY RETURN ENDPROC ******************************************************************************************************************* PROCEDURE analizarBloque_ADD_OBJECT LPARAMETERS toModulo, toClase, tcLine, I, taCodeLines, tnCodeLines EXTERNAL ARRAY taCodeLines #IF .F. LOCAL toModulo AS CL_MODULO OF 'FOXBIN2PRG.PRG' LOCAL toClase AS CL_CLASE OF 'FOXBIN2PRG.PRG' LOCAL toObjeto AS CL_OBJETO OF 'FOXBIN2PRG.PRG' #ENDIF TRY LOCAL llBloqueEncontrado IF LEFT( tcLine, 11 ) == 'ADD OBJECT ' *-- Estructura a reconocer: ADD OBJECT 'frm_a.Check1' AS check [WITH] llBloqueEncontrado = .T. LOCAL laPropsAndValues(1,2), lnPropsAndValues_Count, Z, lcProp, lcValue, lcNombre, lcObjName tcLine = CHRTRAN( tcLine, ['], ["] ) IF EMPTY(toClase._Fin_Cab) toClase._Fin_Cab = I-1 toClase._Ini_Cuerpo = I ENDIF toObjeto = NULL lcNombre = ALLTRIM( CHRTRAN( STREXTRACT(tcLine, 'ADD OBJECT ', ' AS ', 1, 1), ['"], [] ) ) lcObjName = JUSTEXT( '.' + lcNombre ) IF toClase.l_ObjectMetadataInHeader FOR Z = 1 TO toClase._AddObject_Count IF LOWER(toClase._AddObjects(Z)._Nombre) == LOWER(lcNombre) THEN toObjeto = toClase._AddObjects(Z) EXIT ENDIF ENDFOR ENDIF IF ISNULL(toObjeto) 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) ) IF NOT toClase.l_ObjectMetadataInHeader toClase.add_Object( toObjeto ) ENDIF *-- Propiedades del ADD OBJECT WITH THIS FOR I = I + 1 TO tnCodeLines .set_Line( @tcLine, @taCodeLines, I ) IF 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, @Z ) toObjeto._Ole = toModulo._Ole_Objs(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, @I ) toObjeto.add_Property( @lcProp, @lcValue ) ELSE && VALOR FINAL SIN ", ;" (JUSTO ANTES DEL ) .get_SeparatedPropAndValue( tcLine, @lcProp, @lcValue, toClase, @taCodeLines, @tnCodeLines, @I ) toObjeto.add_Property( @lcProp, @lcValue ) ENDIF ENDFOR ENDWITH && THIS ENDIF CATCH TO loEx IF THIS.l_Debug AND _VFP.STARTMODE = 0 SET STEP ON ENDIF THROW ENDTRY RETURN llBloqueEncontrado ENDPROC ******************************************************************************************************************* PROCEDURE analizarBloque_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 FOR I = I + 1 TO tnCodeLines .set_Line( @tcLine, @taCodeLines, I ) DO CASE CASE LEFT( tcLine, C_LEN_DEFINED_PAM_F ) == C_DEFINED_PAM_F I = 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 = I - 1 ENDIF CATCH TO loEx lnCodError = loEx.ERRORNO IF THIS.l_Debug AND _VFP.STARTMODE = 0 SET STEP ON ENDIF THROW ENDTRY RETURN llBloqueEncontrado ENDPROC ******************************************************************************************************************* PROCEDURE analizarBloque_DEFINE_CLASS LPARAMETERS toModulo, toClase, tcLine, taCodeLines, I, tnCodeLines, tcProcedureAbierto ; , taLineasExclusion, tnBloquesExclusion, tc_Comentario EXTERNAL ARRAY taCodeLines, tnBloquesExclusion, taLineasExclusion #IF .F. LOCAL toModulo AS CL_MODULO OF 'FOXBIN2PRG.PRG' LOCAL toClase AS CL_CLASE OF 'FOXBIN2PRG.PRG' #ENDIF LOCAL llBloqueEncontrado IF 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' STORE '' TO tcProcedureAbierto toClase = CREATEOBJECT('CL_CLASE') toClase._Nombre = ALLTRIM( STREXTRACT( tcLine, 'DEFINE CLASS ', ' AS ', 1, 1 ) ) toClase._ObjName = 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 = I toClase._Ini_Cab = I + 1 toModulo.add_Class( toClase ) *-- Ubico el objeto ole por su nombre (parent+objname), que no se repite. IF toModulo.existeObjetoOLE( toClase._Nombre, @Z ) toClase._Ole = toModulo._Ole_Objs(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, I ) DO CASE CASE .lineIsOnlyCommentAndNoMetadata( @tcLine, @tc_Comentario ) LOOP CASE .analizarBloque_PROCEDURE( @toModulo, @toClase, @loObjeto, @tcLine, @taCodeLines, @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 .analizarBloque_PROTECTED( @toClase, @tcLine ) llPROTECTED_Completed = .T. CASE NOT llHIDDEN_Completed AND .analizarBloque_HIDDEN( @toClase, @tcLine ) llHIDDEN_Completed = .T. CASE NOT llINCLUDE_Completed AND .c_Type <> "SCX" AND .analizarBloque_INCLUDE( @toModulo, @toClase, @tcLine, @taCodeLines ; , @I, @tnCodeLines, @tcProcedureAbierto ) llINCLUDE_Completed = .T. CASE NOT llCLASSCOMMENTS_Completed AND .analizarBloque_CLASSCOMMENTS( @toClase, @tcLine ,@taCodeLines, tnCodeLines, @I ) llCLASSCOMMENTS_Completed = .T. CASE NOT llCLASSMETADATA_Completed AND .analizarBloque_CLASSMETADATA( @toClase, @tcLine ) llCLASSMETADATA_Completed = .T. CASE NOT llOBJECTMETADATA_Completed AND .analizarBloque_OBJECTMETADATA( @toClase, @tcLine ) * No se usa flag porque puede haber múltiples ObjectMetadata. CASE NOT llDEFINED_PAM_Completed AND .analizarBloque_DEFINED_PAM( @toClase, @tcLine, @taCodeLines, tnCodeLines, @I ) llDEFINED_PAM_Completed = .T. CASE .analizarBloque_ADD_OBJECT( @toModulo, @toClase, @tcLine, @I, @taCodeLines, @tnCodeLines ) STORE .T. TO llCLASSCOMMENTS_Completed ; , llCLASS_PROPERTY_Completed ; , llPROTECTED_Completed ; , llHIDDEN_Completed ; , llINCLUDE_Completed ; , llCLASSMETADATA_Completed ; , llOBJECTMETADATA_Completed ; , llDEFINED_PAM_Completed CASE .analizarBloque_ENDDEFINE( @toClase, @tcLine, @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, @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 ENDCASE 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(C_ENDDEFINE_MARKER_NOT_FOUND_LOC)) ENDIF toClase._PROPERTIES = .classProps2Memo( toClase ) 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._Nombre) == '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.l_Debug AND _VFP.STARTMODE = 0 SET STEP ON ENDIF THROW ENDTRY ENDIF RETURN llBloqueEncontrado ENDPROC ******************************************************************************************************************* PROCEDURE analizarBloque_ENDDEFINE LPARAMETERS toClase, tcLine, I, tcProcedureAbierto #IF .F. LOCAL toClase AS CL_CLASE OF 'FOXBIN2PRG.PRG' #ENDIF LOCAL llBloqueEncontrado IF LEFT( tcLine + ' ', 10 ) == C_ENDDEFINE + ' ' && Fin de bloque (ENDDEF / ENDPROC) encontrado llBloqueEncontrado = .T. toClase._Fin = I IF EMPTY( toClase._Ini_Cuerpo ) toClase._Ini_Cuerpo = I-1 ENDIF toClase._Fin_Cuerpo = I-1 IF EMPTY( toClase._Fin_Cab ) toClase._Fin_Cab = I-1 ENDIF STORE '' TO tcProcedureAbierto ENDIF RETURN llBloqueEncontrado ENDPROC ******************************************************************************************************************* PROCEDURE analizarBloque_HIDDEN LPARAMETERS toClase, tcLine #IF .F. LOCAL toClase AS CL_CLASE OF 'FOXBIN2PRG.PRG' #ENDIF LOCAL llBloqueEncontrado IF LEFT(tcLine, 7) == 'HIDDEN ' llBloqueEncontrado = .T. toClase._HiddenProps = LOWER( ALLTRIM( SUBSTR( tcLine, 8 ) ) ) ENDIF RETURN llBloqueEncontrado ENDPROC ******************************************************************************************************************* PROCEDURE analizarBloque_INCLUDE LPARAMETERS toModulo, toClase, tcLine, taCodeLines, I, tnCodeLines, tcProcedureAbierto LOCAL llBloqueEncontrado #IF .F. LOCAL toModulo AS CL_MODULO OF 'FOXBIN2PRG.PRG' LOCAL toClase AS CL_CLASE OF 'FOXBIN2PRG.PRG' #ENDIF IF 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 RETURN llBloqueEncontrado ENDPROC PROCEDURE analizarBloque_CLASSCOMMENTS LPARAMETERS toClase, tcLine ,taCodeLines, tnCodeLines, I EXTERNAL ARRAY taCodeLines #IF .F. LOCAL toClase AS CL_CLASE OF 'FOXBIN2PRG.PRG' #ENDIF TRY LOCAL llBloqueEncontrado 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 = I + 1 TO tnCodeLines .set_Line( @tcLine, @taCodeLines, I ) DO CASE CASE LEFT( tcLine, C_LEN_CLASSCOMMENTS_F ) == C_CLASSCOMMENTS_F I = I + 1 EXIT OTHERWISE toClase._Comentario = toClase._Comentario + CR_LF + SUBSTR( tcLine, 2 ) && Le quito el '*' inicial ENDCASE ENDFOR ENDWITH && THIS I = I - 1 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.l_Debug AND _VFP.STARTMODE = 0 SET STEP ON ENDIF THROW ENDTRY RETURN llBloqueEncontrado ENDPROC PROCEDURE analizarBloque_CLASSMETADATA LPARAMETERS toClase, tcLine #IF .F. LOCAL toClase AS CL_CLASE OF 'FOXBIN2PRG.PRG' #ENDIF LOCAL llBloqueEncontrado IF 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 .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._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 NOT EMPTY( toClase._Ole2 ) && Le agrego "OLEObject = " delante toClase._Ole2 = 'OLEObject = ' + toClase._Ole2 + CR_LF ENDIF ENDIF RETURN llBloqueEncontrado ENDPROC PROCEDURE analizarBloque_OBJECTMETADATA LPARAMETERS toClase, tcLine #IF .F. LOCAL toClase AS CL_CLASE OF 'FOXBIN2PRG.PRG' #ENDIF LOCAL llBloqueEncontrado IF 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') toClase.add_Object( loObjeto ) 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._UniqueID = .get_ValueByName_FromListNamesWithValues( 'UniqueID', 'C', @laPropsAndValues ) ENDWITH && THIS loObjeto = NULL RELEASE laPropsAndValues, lnPropsAndValues_Count, loObjeto ENDIF RETURN llBloqueEncontrado ENDPROC ******************************************************************************************************************* PROCEDURE analizarBloque_OLE_DEF LPARAMETERS toModulo, tcLine, taCodeLines, I, tnCodeLines, tcProcedureAbierto LOCAL llBloqueEncontrado #IF .F. LOCAL toModulo AS CL_MODULO OF 'FOXBIN2PRG.PRG' #ENDIF 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') 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 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(Z)._CheckSum == loOle._CheckSum AND NOT EMPTY( toModulo._Ole_Objs(Z)._Value ) loOle._Value = toModulo._Ole_Objs(Z)._Value EXIT ENDIF ENDFOR ENDIF loOle = NULL RELEASE loOle, laPropsAndValues, lnPropsAndValues_Count ENDIF RETURN llBloqueEncontrado ENDPROC ******************************************************************************************************************* PROCEDURE analizarBloque_PROCEDURE LPARAMETERS toModulo, toClase, toObjeto, tcLine, taCodeLines, I, tnCodeLines, tcProcedureAbierto ; , tc_Comentario, taLineasExclusion, tnBloquesExclusion #IF .F. LOCAL toModulo AS CL_MODULO OF 'FOXBIN2PRG.PRG' LOCAL toObjeto AS CL_OBJETO OF 'FOXBIN2PRG.PRG' LOCAL toClase AS CL_CLASE OF 'FOXBIN2PRG.PRG' #ENDIF LOCAL llBloqueEncontrado DO CASE CASE LEFT( tcLine, 20 ) == 'PROTECTED PROCEDURE ' *-- Estructura a reconocer: PROTECTED PROCEDURE nombre_del_procedimiento llBloqueEncontrado = .T. tcProcedureAbierto = ALLTRIM( SUBSTR( tcLine, 21 ) ) THIS.evaluarDefinicionDeProcedure( @toClase, I, @tc_Comentario, tcProcedureAbierto, 'protected', @toObjeto ) CASE LEFT( tcLine, 17 ) == 'HIDDEN PROCEDURE ' *-- Estructura a reconocer: HIDDEN PROCEDURE nombre_del_procedimiento llBloqueEncontrado = .T. tcProcedureAbierto = ALLTRIM( SUBSTR( tcLine, 18 ) ) THIS.evaluarDefinicionDeProcedure( @toClase, I, @tc_Comentario, tcProcedureAbierto, 'hidden', @toObjeto ) CASE LEFT( tcLine, 10 ) == 'PROCEDURE ' *-- Estructura a reconocer: PROCEDURE [objeto.]nombre_del_procedimiento llBloqueEncontrado = .T. tcProcedureAbierto = ALLTRIM( SUBSTR( tcLine, 11 ) ) THIS.evaluarDefinicionDeProcedure( @toClase, I, @tc_Comentario, tcProcedureAbierto, 'normal', @toObjeto ) ENDCASE IF llBloqueEncontrado *-- Evalúo todo el contenido del PROCEDURE THIS.analizarLineasDeProcedure( @toClase, @toObjeto, @tcLine, @taCodeLines, @I, @tnCodeLines, @tcProcedureAbierto ; , @tc_Comentario, @taLineasExclusion, @tnBloquesExclusion ) ENDIF RETURN llBloqueEncontrado ENDPROC ******************************************************************************************************************* PROCEDURE analizarBloque_PROTECTED LPARAMETERS toClase, tcLine #IF .F. LOCAL toClase AS CL_CLASE OF 'FOXBIN2PRG.PRG' #ENDIF LOCAL llBloqueEncontrado IF LEFT(tcLine, 10) == 'PROTECTED ' llBloqueEncontrado = .T. toClase._ProtectedProps = LOWER( ALLTRIM( SUBSTR( tcLine, 11 ) ) ) ENDIF RETURN llBloqueEncontrado ENDPROC ******************************************************************************************************************* PROCEDURE evaluarDefinicionDeProcedure LPARAMETERS toClase, tnX, 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 I, lcNombreObjeto, lnObjProc ; , loProcedure AS CL_PROCEDURE OF 'FOXBIN2PRG.PRG' IF EMPTY(toClase._Fin_Cab) toClase._Fin_Cab = tnX-1 toClase._Ini_Cuerpo = tnX ENDIF loProcedure = NULL loProcedure = CREATEOBJECT("CL_PROCEDURE") loProcedure._Nombre = tcProcName loProcedure._ProcType = tcProcType loProcedure._Comentario = tc_Comentario *-- 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 ENDCASE *-- 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.buscarObjetoDelMetodoPorNombre( lcNombreObjeto, toClase ) IF lnObjProc = 0 *-- Procedimiento de clase toClase.add_Procedure( loProcedure ) toObjeto = NULL ELSE *-- Procedimiento de objeto toObjeto = toClase._AddObjects( lnObjProc ) toObjeto.add_Procedure( loProcedure ) ENDIF ELSE *-- Procedimiento de clase toClase.add_Procedure( loProcedure ) ENDIF CATCH TO loEx IF THIS.l_Debug AND _VFP.STARTMODE = 0 SET STEP ON ENDIF THROW FINALLY STORE NULL TO loProcedure RELEASE loProcedure, I, lcNombreObjeto, lnObjProc ENDTRY RETURN ENDPROC ******************************************************************************************************************* PROCEDURE identificarBloquesDeCodigo *-------------------------------------------------------------------------------------------------------------- * 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 * * NOTA: * Como identificador se usa el nombre de clase o de procedimiento, según corresponda. *-------------------------------------------------------------------------------------------------------------- LPARAMETERS taCodeLines, tnCodeLines, taLineasExclusion, tnBloquesExclusion, toModulo EXTERNAL ARRAY taCodeLines, taLineasExclusion #IF .F. LOCAL toModulo AS CL_MODULO OF 'FOXBIN2PRG.PRG' #ENDIF TRY LOCAL I, loEx AS EXCEPTION ; , llFoxBin2Prg_Completed, llOLE_DEF_Completed, llINCLUDE_SCX_Completed, llLIBCOMMENT_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 .c_Type = UPPER(JUSTEXT(.c_OutputFile)) IF tnCodeLines > 1 *-- Defino el objeto de módulo y sus propiedades toModulo = NULL toModulo = CREATEOBJECT('CL_MODULO') *-- Búsqueda del ID de inicio de bloque (DEFINE CLASS / PROCEDURE) FOR I = 1 TO tnCodeLines STORE '' TO lc_Comentario .set_Line( @lcLine, @taCodeLines, I ) DO CASE CASE .lineaExcluida( I, tnBloquesExclusion, @taLineasExclusion ) ; OR .lineIsOnlyCommentAndNoMetadata( @lcLine, @lc_Comentario ) && Excluida, vacía o solo Comentarios CASE NOT llFoxBin2Prg_Completed AND .analizarBloque_FoxBin2Prg( toModulo, @lcLine, @taCodeLines, @I, tnCodeLines ) llFoxBin2Prg_Completed = .T. CASE NOT llLIBCOMMENT_Completed AND .analizarBloque_LIBCOMMENT( toModulo, @lcLine, @taCodeLines, @I, tnCodeLines ) llLIBCOMMENT_Completed = .T. CASE NOT llOLE_DEF_Completed AND .analizarBloque_OLE_DEF( @toModulo, @lcLine, @taCodeLines ; , @I, tnCodeLines, @lcProcedureAbierto ) *-- Puede haber varios CASE NOT llINCLUDE_SCX_Completed AND .c_Type = 'SCX' AND .analizarBloque_INCLUDE( @toModulo, @loClase, @lcLine ; , @taCodeLines, @I, tnCodeLines, @lcProcedureAbierto ) * Específico para SCX que lo tiene al inicio llINCLUDE_SCX_Completed = .T. CASE .analizarBloque_DEFINE_CLASS( @toModulo, @loClase, @lcLine, @taCodeLines, @I, tnCodeLines ; , @lcProcedureAbierto, @taLineasExclusion, @tnBloquesExclusion, @lc_Comentario ) *-- Puede haber varias ENDCASE ENDFOR ENDIF ENDWITH && THIS CATCH TO loEx IF THIS.l_Debug AND _VFP.STARTMODE = 0 SET STEP ON ENDIF THROW 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 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 = [] ; + [] ; + [] PROCEDURE Convertir *--------------------------------------------------------------------------------------------------- * PARÁMETROS: (v=Pasar por valor | @=Pasar por referencia) (!=Obligatorio | ?=Opcional) (IN/OUT) * toModulo (!@ OUT) Objeto generado de clase CL_MODULO 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 ) TRY LOCAL lnCodError, laCodeLines(1), lnCodeLines, lcInputFile, lnFileCount, laFiles(1,5) ; , laLineasExclusion(1), lnBloquesExclusion, I 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 C_FB2PRG_CODE = FILETOSTR( .c_InputFile ) IF toFoxBin2Prg.l_UseClassPerFile *-- Esto crea la máscara de búsqueda "filename.*.ext" para encontrar las partes lcInputFile = FORCEPATH( JUSTSTEM( .c_InputFile ), JUSTPATH( .c_InputFile ) ) + '.*.' + JUSTEXT( .c_InputFile ) lnFileCount = ADIR( laFiles, lcInputFile ) ASORT( laFiles, 1, 0, 0, 1) FOR I = 1 TO lnFileCount C_FB2PRG_CODE = C_FB2PRG_CODE + FILETOSTR( FORCEPATH( JUSTSTEM( laFiles(I,1) ), JUSTPATH( .c_InputFile ) ) + '.' + JUSTEXT( .c_InputFile ) ) ENDFOR ENDIF lnCodeLines = ALINES( laCodeLines, C_FB2PRG_CODE ) toFoxBin2Prg.doBackup( .F., .T., '', '', '' ) *-- Creo la librería .createClasslib() *-- Identifico los TEXT/ENDTEXT, #IF .F./#ENDIF .identificarBloquesDeExclusion( @laCodeLines, lnCodeLines, .F., @laLineasExclusion, @lnBloquesExclusion ) *-- Identifico el inicio/fin de bloque, definición, cabecera y cuerpo de cada clase .identificarBloquesDeCodigo( @laCodeLines, lnCodeLines, @laLineasExclusion, lnBloquesExclusion, @toModulo ) .escribirArchivoBin( @toModulo, @toFoxBin2Prg ) ENDWITH && THIS CATCH TO toEx IF THIS.l_Debug AND _VFP.STARTMODE = 0 SET STEP ON ENDIF THROW FINALLY USE IN (SELECT("TABLABIN")) RELEASE lnCodError, laCodeLines, lnCodeLines, laLineasExclusion, lnBloquesExclusion, I ; , lcInputFile, lnFileCount, laFiles ENDTRY RETURN ENDPROC ******************************************************************************************************************* PROCEDURE escribirArchivoBin 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_MODULO 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' ; , loFSO AS Scripting.FileSystemObject WITH THIS AS c_conversor_prg_a_vcx OF 'FOXBIN2PRG.PRG' STORE NULL TO loFSO, loClase loFSO = .oFSO *-- Creo el registro de cabecera .createClasslib_RecordHeader( toModulo ) *-- Recorro las CLASES FOR X = 1 TO 2 FOR I = 1 TO toModulo._Clases_Count loClase = NULL loClase = toModulo._Clases(I) *-- El dataenvironment debe estar primero, luego lo demás. IF X = 1 AND NOT loClase._BaseClass == 'dataenvironment' ; OR X = 2 AND loClase._BaseClass == 'dataenvironment' LOOP ENDIF IF EMPTY(loClase._TimeStamp) loClase._TimeStamp = THIS.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 USE IN (SELECT("TABLABIN")) IF toFoxBin2Prg.l_Recompile toFoxBin2Prg.compileFoxProBinary() ENDIF ENDWITH && THIS CATCH TO loEx lnCodError = loEx.ERRORNO IF THIS.l_Debug 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 = [] ; + [] ; + [] PROCEDURE Convertir *--------------------------------------------------------------------------------------------------- * PARÁMETROS: (v=Pasar por valor | @=Pasar por referencia) (!=Obligatorio | ?=Opcional) (IN/OUT) * toModulo (!@ OUT) Objeto generado de clase CL_MODULO 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 ) TRY LOCAL lnCodError, laCodeLines(1), lnCodeLines, lcInputFile, lnFileCount, laFiles(1,5) ; , laLineasExclusion(1), lnBloquesExclusion, I WITH THIS AS c_conversor_prg_a_scx OF 'FOXBIN2PRG.PRG' STORE 0 TO lnCodError, lnCodeLines STORE '' TO C_FB2PRG_CODE STORE NULL TO toModulo C_FB2PRG_CODE = FILETOSTR( .c_InputFile ) IF toFoxBin2Prg.l_UseClassPerFile *-- Esto crea la máscara de búsqueda "filename.*.ext" para encontrar las partes lcInputFile = FORCEPATH( JUSTSTEM( .c_InputFile ), JUSTPATH( .c_InputFile ) ) + '.*.' + JUSTEXT( .c_InputFile ) lnFileCount = ADIR( laFiles, lcInputFile ) ASORT( laFiles, 1, 0, 0, 1) FOR I = 1 TO lnFileCount C_FB2PRG_CODE = C_FB2PRG_CODE + FILETOSTR( FORCEPATH( JUSTSTEM( laFiles(I,1) ), JUSTPATH( .c_InputFile ) ) + '.' + JUSTEXT( .c_InputFile ) ) ENDFOR ENDIF lnCodeLines = ALINES( laCodeLines, C_FB2PRG_CODE ) toFoxBin2Prg.doBackup( .F., .T., '', '', '' ) *-- Creo el form .createForm() *-- Identifico los TEXT/ENDTEXT, #IF .F./#ENDIF .identificarBloquesDeExclusion( @laCodeLines, lnCodeLines, .F., @laLineasExclusion, @lnBloquesExclusion ) *-- Identifico el inicio/fin de bloque, definición, cabecera y cuerpo de cada clase .identificarBloquesDeCodigo( @laCodeLines, lnCodeLines, @laLineasExclusion, lnBloquesExclusion, @toModulo ) .escribirArchivoBin( @toModulo, @toFoxBin2Prg ) ENDWITH && THIS CATCH TO toEx IF THIS.l_Debug AND _VFP.STARTMODE = 0 SET STEP ON ENDIF THROW FINALLY USE IN (SELECT("TABLABIN")) RELEASE lnCodError, laCodeLines, lnCodeLines, laLineasExclusion, lnBloquesExclusion, I ; , lcInputFile, lnFileCount, laFiles ENDTRY RETURN ENDPROC ******************************************************************************************************************* PROCEDURE escribirArchivoBin 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_MODULO 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' *-- 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(I) *-- El dataenvironment debe estar primero, luego lo demás. IF X = 1 AND NOT loClase._BaseClass == 'dataenvironment' ; OR X = 2 AND loClase._BaseClass == 'dataenvironment' LOOP ENDIF IF EMPTY(loClase._TimeStamp) loClase._TimeStamp = THIS.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 && 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 ENDWITH && THIS CATCH TO loEx IF THIS.l_Debug 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 = [] ; + [] ; + [] ; + [] ; + [] ; + [] ; + [] ; + [] ; + [] ; + [] ; + [] ******************************************************************************************************************* PROCEDURE Convertir *--------------------------------------------------------------------------------------------------- * 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 ) #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 WITH THIS AS c_conversor_prg_a_pjx OF 'FOXBIN2PRG.PRG' STORE 0 TO lnCodeLines STORE NULL TO toModulo C_FB2PRG_CODE = FILETOSTR( .c_InputFile ) lnCodeLines = ALINES( laCodeLines, C_FB2PRG_CODE ) toFoxBin2Prg.doBackup( .F., .T., '', '', '' ) *-- Creo solo la cabecera del proyecto .createProject() *-- Identifico los TEXT/ENDTEXT, #IF .F./#ENDIF *.identificarBloquesDeExclusion( @laCodeLines, .F., @laLineasExclusion, @lnBloquesExclusion ) *-- Identifico el inicio/fin de bloque, definición, cabecera y cuerpo de cada clase .identificarBloquesDeCodigo( @laCodeLines, lnCodeLines, @laLineasExclusion, lnBloquesExclusion, @toProject ) .escribirArchivoBin( @toProject, toFoxBin2Prg ) ENDWITH && THIS CATCH TO toEx IF THIS.l_Debug AND _VFP.STARTMODE = 0 SET STEP ON ENDIF THROW FINALLY USE IN (SELECT("TABLABIN")) RELEASE laCodeLines, lnCodeLines, laLineasExclusion, lnBloquesExclusion, I ENDTRY RETURN ENDPROC ******************************************************************************************************************* PROCEDURE escribirArchivoBin 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 ) *-- 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 = THIS.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 = THIS.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 ; , KEY ) ; VALUES ; ( loFile._Name + CHR(0) ; , .fileTypeCode(JUSTEXT(loFile._Name)) ; , loFile._Exclude ; , (loFile._Name == lcMainProg) ; , loFile._Comments ; , .T. ; , loFile._CPID ; , loFile._ID ; , loFile._TimeStamp ; , loFile._ObjRev ; , UPPER(JUSTSTEM(loFile._Name)) ) ENDFOR USE IN (SELECT("TABLABIN")) ENDWITH && THIS CATCH TO loEx lnCodError = loEx.ERRORNO IF THIS.l_Debug 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 identificarBloquesDeCodigo LPARAMETERS taCodeLines, tnCodeLines, taLineasExclusion, tnBloquesExclusion, toProject *-------------------------------------------------------------------------------------------------------------- * 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 * * 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' #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, I ) IF .lineIsOnlyCommentAndNoMetadata( @lcLine, @lc_Comentario ) && Vacía o solo Comentarios LOOP ENDIF DO CASE CASE NOT llFoxBin2Prg_Completed AND .analizarBloque_FoxBin2Prg( toProject, @lcLine, @taCodeLines, @I, tnCodeLines ) llFoxBin2Prg_Completed = .T. CASE NOT llDevInfo_Completed AND .analizarBloque_DevInfo( toProject, @lcLine, @taCodeLines, @I, tnCodeLines ) llDevInfo_Completed = .T. CASE NOT llServerHead_Completed AND .analizarBloque_ServerHead( toProject, @lcLine, @taCodeLines, @I, tnCodeLines ) llServerHead_Completed = .T. CASE .analizarBloque_ServerData( toProject, @lcLine, @taCodeLines, @I, tnCodeLines ) *-- Puede haber varios servidores, por eso se siguen valuando CASE NOT llBuildProj_Completed AND .analizarBloque_BuildProj( toProject, @lcLine, @taCodeLines, @I, tnCodeLines ) llBuildProj_Completed = .T. CASE NOT llFileComments_Completed AND .analizarBloque_FileComments( toProject, @lcLine, @taCodeLines, @I, tnCodeLines ) llFileComments_Completed = .T. CASE NOT llExcludedFiles_Completed AND .analizarBloque_ExcludedFiles( toProject, @lcLine, @taCodeLines, @I, tnCodeLines ) llExcludedFiles_Completed = .T. CASE NOT llTextFiles_Completed AND .analizarBloque_TextFiles( toProject, @lcLine, @taCodeLines, @I, tnCodeLines ) llTextFiles_Completed = .T. CASE NOT llProjectProperties_Completed AND .analizarBloque_ProjectProperties( toProject, @lcLine, @taCodeLines, @I, tnCodeLines ) llProjectProperties_Completed = .T. ENDCASE ENDFOR ENDIF ENDWITH && THIS CATCH TO loEx IF THIS.l_Debug AND _VFP.STARTMODE = 0 SET STEP ON ENDIF THROW ENDTRY RETURN ENDPROC ******************************************************************************************************************* PROCEDURE analizarBloque_BuildProj *------------------------------------------------------ *-- Analiza el bloque *------------------------------------------------------ LPARAMETERS toProject, tcLine, taCodeLines, I, tnCodeLines #IF .F. LOCAL toProject AS CL_PROJECT OF 'FOXBIN2PRG.PRG' #ENDIF 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. WITH THIS FOR I = I + 1 TO tnCodeLines lcComment = '' .set_Line( @tcLine, @taCodeLines, I ) DO CASE CASE LEFT( tcLine, LEN(C_BUILDPROJ_F) ) == C_BUILDPROJ_F I = I + 1 EXIT CASE .lineIsOnlyCommentAndNoMetadata( @tcLine, @lcComment ) LOOP && Saltear comentarios 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, ['], ['] ) ) *-- 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 ) toProject.ADD( loFile, loFile._Name ) CASE UPPER( LEFT( tcLine, 10 ) ) == UPPER( '*<.HomeDir' ) toProject._HomeDir = STREXTRACT( tcLine, "'", "'" ) ENDCASE ENDFOR ENDWITH && THIS I = I - 1 ENDIF CATCH TO loEx IF THIS.l_Debug AND _VFP.STARTMODE = 0 SET STEP ON ENDIF THROW FINALLY STORE NULL TO loFile RELEASE lcComment, lcMetadatos, luValor, laPropsAndValues, lnPropsAndValues_Count, loFile ENDTRY RETURN llBloqueEncontrado ENDPROC ******************************************************************************************************************* PROCEDURE analizarBloque_DevInfo *------------------------------------------------------ *-- Analiza el bloque *------------------------------------------------------ LPARAMETERS toProject, tcLine, taCodeLines, I, tnCodeLines #IF .F. LOCAL toProject AS CL_PROJECT OF 'FOXBIN2PRG.PRG' #ENDIF TRY LOCAL llBloqueEncontrado 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 = I + 1 TO tnCodeLines .set_Line( @tcLine, @taCodeLines, I ) DO CASE CASE LEFT( tcLine, LEN(C_DEVINFO_F) ) == C_DEVINFO_F I = I + 1 EXIT CASE .lineIsOnlyCommentAndNoMetadata( @tcLine ) LOOP && Saltear comentarios OTHERWISE toProject.setParsedProjInfoLine( @tcLine ) ENDCASE ENDFOR ENDWITH && THIS I = I - 1 ENDIF CATCH TO loEx IF THIS.l_Debug AND _VFP.STARTMODE = 0 SET STEP ON ENDIF THROW ENDTRY RETURN llBloqueEncontrado ENDPROC ******************************************************************************************************************* PROCEDURE analizarBloque_ServerHead *------------------------------------------------------ *-- Analiza el bloque *------------------------------------------------------ LPARAMETERS toProject, tcLine, taCodeLines, I, tnCodeLines #IF .F. LOCAL toProject AS CL_PROJECT OF 'FOXBIN2PRG.PRG' #ENDIF 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. STORE NULL TO loServerHead loServerHead = toProject._ServerHead WITH THIS AS c_conversor_prg_a_pjx OF 'FOXBIN2PRG.PRG' FOR I = I + 1 TO tnCodeLines .set_Line( @tcLine, @taCodeLines, I ) DO CASE CASE LEFT( tcLine, LEN(C_SRV_HEAD_F) ) == C_SRV_HEAD_F I = I + 1 EXIT CASE .lineIsOnlyCommentAndNoMetadata( @tcLine ) LOOP && Saltear comentarios OTHERWISE loServerHead.setParsedHeadInfoLine( @tcLine ) ENDCASE ENDFOR ENDWITH && THIS I = I - 1 ENDIF CATCH TO loEx IF THIS.l_Debug AND _VFP.STARTMODE = 0 SET STEP ON ENDIF THROW FINALLY STORE NULL TO loServerHead RELEASE loServerHead ENDTRY RETURN llBloqueEncontrado ENDPROC ******************************************************************************************************************* PROCEDURE analizarBloque_ServerData *------------------------------------------------------ *-- Analiza el bloque *------------------------------------------------------ LPARAMETERS toProject, tcLine, taCodeLines, I, tnCodeLines #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' 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() WITH THIS AS c_conversor_prg_a_pjx OF 'FOXBIN2PRG.PRG' FOR I = I + 1 TO tnCodeLines .set_Line( @tcLine, @taCodeLines, I ) DO CASE CASE LEFT( tcLine, LEN(C_SRV_DATA_F) ) == C_SRV_DATA_F I = I + 1 EXIT CASE .lineIsOnlyCommentAndNoMetadata( @tcLine ) LOOP && Saltear comentarios OTHERWISE loServerHead.setParsedInfoLine( loServerData, @tcLine ) ENDCASE ENDFOR ENDWITH && THIS loServerHead.add_Server( loServerData ) I = I - 1 ENDIF CATCH TO loEx IF THIS.l_Debug AND _VFP.STARTMODE = 0 SET STEP ON ENDIF THROW FINALLY STORE NULL TO loServerData, loServerHead RELEASE loServerHead, loServerData ENDTRY RETURN llBloqueEncontrado ENDPROC ******************************************************************************************************************* PROCEDURE analizarBloque_FileComments *------------------------------------------------------ *-- Analiza el bloque *------------------------------------------------------ LPARAMETERS toProject, tcLine, taCodeLines, I, tnCodeLines EXTERNAL ARRAY toProject #IF .F. LOCAL toProject AS CL_PROJECT OF 'FOXBIN2PRG.PRG' #ENDIF 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 WITH THIS AS c_conversor_prg_a_pjx OF 'FOXBIN2PRG.PRG' FOR I = I + 1 TO tnCodeLines .set_Line( @tcLine, @taCodeLines, I ) DO CASE CASE LEFT( tcLine, LEN(C_FILE_CMTS_F) ) == C_FILE_CMTS_F I = I + 1 EXIT CASE .lineIsOnlyCommentAndNoMetadata( @tcLine ) LOOP && Saltear comentarios OTHERWISE lcFile = LOWER( ALLTRIM( STRTRAN( CHRTRAN( NORMALIZE( STREXTRACT( tcLine, ".ITEM(", ")", 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 = I - 1 ENDIF CATCH TO loEx IF THIS.l_Debug AND _VFP.STARTMODE = 0 SET STEP ON ENDIF THROW FINALLY loFile = NULL RELEASE lcFile, lcComment, loFile ENDTRY RETURN llBloqueEncontrado ENDPROC ******************************************************************************************************************* PROCEDURE analizarBloque_ExcludedFiles *------------------------------------------------------ *-- Analiza el bloque *------------------------------------------------------ LPARAMETERS toProject, tcLine, taCodeLines, I, tnCodeLines EXTERNAL ARRAY toProject #IF .F. LOCAL toProject AS CL_PROJECT OF 'FOXBIN2PRG.PRG' #ENDIF 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 WITH THIS AS c_conversor_prg_a_pjx OF 'FOXBIN2PRG.PRG' FOR I = I + 1 TO tnCodeLines .set_Line( @tcLine, @taCodeLines, I ) DO CASE CASE LEFT( tcLine, LEN(C_FILE_EXCL_F) ) == C_FILE_EXCL_F I = I + 1 EXIT CASE .lineIsOnlyCommentAndNoMetadata( @tcLine ) LOOP && Saltear comentarios OTHERWISE lcFile = LOWER( ALLTRIM( STRTRAN( CHRTRAN( NORMALIZE( STREXTRACT( tcLine, ".ITEM(", ")", 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 = I - 1 ENDIF CATCH TO loEx IF THIS.l_Debug AND _VFP.STARTMODE = 0 SET STEP ON ENDIF THROW FINALLY loFile = NULL RELEASE lcFile, llExclude, loFile ENDTRY RETURN llBloqueEncontrado ENDPROC ******************************************************************************************************************* PROCEDURE analizarBloque_TextFiles *------------------------------------------------------ *-- Analiza el bloque *------------------------------------------------------ LPARAMETERS toProject, tcLine, taCodeLines, I, tnCodeLines EXTERNAL ARRAY toProject #IF .F. LOCAL toProject AS CL_PROJECT OF 'FOXBIN2PRG.PRG' #ENDIF 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 WITH THIS AS c_conversor_prg_a_pjx OF 'FOXBIN2PRG.PRG' FOR I = I + 1 TO tnCodeLines .set_Line( @tcLine, @taCodeLines, I ) DO CASE CASE LEFT( tcLine, LEN(C_FILE_TXT_F) ) == C_FILE_TXT_F I = I + 1 EXIT CASE .lineIsOnlyCommentAndNoMetadata( @tcLine ) LOOP && Saltear comentarios OTHERWISE lcFile = LOWER( ALLTRIM( STRTRAN( CHRTRAN( NORMALIZE( STREXTRACT( tcLine, ".ITEM(", ")", 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 = I - 1 ENDIF CATCH TO loEx IF THIS.l_Debug AND _VFP.STARTMODE = 0 SET STEP ON ENDIF THROW FINALLY loFile = NULL RELEASE lcFile, lcType, loFile ENDTRY RETURN llBloqueEncontrado ENDPROC ******************************************************************************************************************* PROCEDURE analizarBloque_ProjectProperties *------------------------------------------------------ *-- Analiza el bloque *------------------------------------------------------ LPARAMETERS toProject, tcLine, taCodeLines, I, tnCodeLines #IF .F. LOCAL toProject AS CL_PROJECT OF 'FOXBIN2PRG.PRG' #ENDIF TRY LOCAL llBloqueEncontrado, lcLine 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 = I + 1 TO tnCodeLines .set_Line( @tcLine, @taCodeLines, I ) DO CASE CASE LEFT( tcLine, LEN(C_PROJPROPS_F) ) == C_PROJPROPS_F I = I + 1 EXIT CASE .lineIsOnlyCommentAndNoMetadata( @tcLine ) LOOP && Saltear comentarios 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 ) 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 = I - 1 ENDIF CATCH TO loEx IF THIS.l_Debug AND _VFP.STARTMODE = 0 SET STEP ON ENDIF THROW ENDTRY RETURN llBloqueEncontrado ENDPROC 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 = [] ; + [] ; + [] ; + [] ; + [] ; + [] PROCEDURE Convertir *--------------------------------------------------------------------------------------------------- * 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 ) #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 WITH THIS AS c_conversor_prg_a_frx OF 'FOXBIN2PRG.PRG' STORE 0 TO lnCodError, lnCodeLines STORE NULL TO toReport C_FB2PRG_CODE = FILETOSTR( .c_InputFile ) lnCodeLines = ALINES( laCodeLines, C_FB2PRG_CODE ) toFoxBin2Prg.doBackup( .F., .T., '', '', '' ) *-- Creo el reporte .createReport() *-- Identifico el inicio/fin de bloque, definición, cabecera y cuerpo del reporte .identificarBloquesDeCodigo( @laCodeLines, lnCodeLines, @laLineasExclusion, lnBloquesExclusion, @toReport ) .escribirArchivoBin( @toReport, toFoxBin2Prg ) ENDWITH && THIS CATCH TO loEx lnCodError = loEx.ERRORNO IF THIS.l_Debug AND _VFP.STARTMODE = 0 SET STEP ON ENDIF THROW FINALLY USE IN (SELECT("TABLABIN")) ENDTRY RETURN lnCodError ENDPROC ******************************************************************************************************************* PROCEDURE escribirArchivoBin 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 SELECT TABLABIN AFIELDS( laFieldTypes ) loReg = NULL *-- 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 = THIS.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(I), 1, -1, 1, 1+2+4+8 ) IF lnNumCampo = 0 *ERROR 'No se encontró el campo [' + laProps(I) + '] en la estructura del archivo ' + DBF("TABLABIN") ERROR (TEXTMERGE(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(I)) DO CASE CASE INLIST(lcFieldType, 'B') && Double ADDPROPERTY( loReg, laProps(I), CAST( luValor AS &lcFieldType. (lnFieldPrec) ) ) CASE INLIST(lcFieldType, 'F', 'N', 'Y') && Float, Numeric, Currency ADDPROPERTY( loReg, laProps(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(I), luValor ) OTHERWISE && Demás tipos ADDPROPERTY( loReg, laProps(I), CAST( luValor AS &lcFieldType. (lnFieldLen) ) ) ENDCASE ENDFOR INSERT INTO TABLABIN FROM NAME loReg loReg = NULL ENDFOR USE IN (SELECT("TABLABIN")) IF toFoxBin2Prg.l_Recompile toFoxBin2Prg.compileFoxProBinary() ENDIF CATCH TO loEx lnCodError = loEx.ERRORNO IF THIS.l_Debug AND _VFP.STARTMODE = 0 SET STEP ON ENDIF THROW FINALLY USE IN (SELECT("TABLABIN")) loReg = NULL RELEASE loReg, I, lcFieldType, lnFieldLen, lnFieldDec, lnNumCampo, laFieldTypes, luValor ENDTRY RETURN lnCodError ENDPROC ******************************************************************************************************************* PROCEDURE identificarBloquesDeCodigo 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 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)) IF tnCodeLines > 1 toReport = NULL toReport = CREATEOBJECT('CL_REPORT') FOR I = 1 TO tnCodeLines .set_Line( @lcLine, @taCodeLines, I ) IF .lineIsOnlyCommentAndNoMetadata( @lcLine, @lc_Comentario ) && Vacía o solo Comentarios LOOP ENDIF DO CASE CASE NOT llFoxBin2Prg_Completed AND .analizarBloque_FoxBin2Prg( toReport, @lcLine, @taCodeLines, @I, tnCodeLines ) llFoxBin2Prg_Completed = .T. CASE .analizarBloque_Reportes( toReport, @lcLine, @taCodeLines, @I, tnCodeLines ) ENDCASE ENDFOR ENDIF ENDWITH && THIS CATCH TO loEx IF THIS.l_Debug AND _VFP.STARTMODE = 0 SET STEP ON ENDIF THROW ENDTRY RETURN ENDPROC ******************************************************************************************************************* PROCEDURE analizarBloque_CDATA_inline *------------------------------------------------------ *-- Analiza el bloque *------------------------------------------------------ LPARAMETERS toReport, tcLine, taCodeLines, I, tnCodeLines, toReg, tcPropName #IF .F. LOCAL toReport AS CL_REPORT OF 'FOXBIN2PRG.PRG' #ENDIF TRY LOCAL llBloqueEncontrado, lcValue, loEx AS EXCEPTION 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 *-- Tomo la primera parte del valor lcValue = STREXTRACT( tcLine, C_DATA_I ) *-- Recorro las fracciones del valor FOR I = I + 1 TO tnCodeLines tcLine = taCodeLines(I) IF C_DATA_F $ tcLine && Fin del valor lcValue = lcValue + CR_LF + STREXTRACT( tcLine, '', C_DATA_F ) ADDPROPERTY( toReg, tcPropName, lcValue ) EXIT ELSE && Otra fracción del valor lcValue = lcValue + CR_LF + tcLine ENDIF ENDFOR ENDIF CATCH TO loEx IF loEx.ERRORNO = 1470 && Incorrect property name. loEx.USERVALUE = 'PropName=[' + TRANSFORM(tcPropName) + '], Value=[' + TRANSFORM(lcValue) + ']' ENDIF IF THIS.l_Debug AND _VFP.STARTMODE = 0 SET STEP ON ENDIF THROW ENDTRY RETURN llBloqueEncontrado ENDPROC ******************************************************************************************************************* PROCEDURE analizarBloque_platform *------------------------------------------------------ *-- Analiza el bloque *------------------------------------------------------ LPARAMETERS toReport, tcLine, taCodeLines, I, tnCodeLines, toReg #IF .F. LOCAL toReport AS CL_REPORT OF 'FOXBIN2PRG.PRG' #ENDIF TRY LOCAL llBloqueEncontrado, X, lnPos, lnPos2, lcValue, lnLenPropName, laProps(1) ; , lcComment, lcMetadatos, luValor ; , laPropsAndValues(1,2), lnPropsAndValues_Count IF LOWER( LEFT(tcLine, 10) ) == 'platform="' llBloqueEncontrado = .T. lnLastPos = 1 tcLine = ' ' + tcLine FOR X = 1 TO AMEMBERS( laProps, toReg, 0 ) laProps(X) = ' ' + laProps(X) lnPos = AT( LOWER(laProps(X)) + '="', tcLine ) IF lnPos > 0 lnLenPropName = LEN(laProps(X)) lnPos2 = AT( '"', SUBSTR( tcLine, lnPos + lnLenPropName + 2 ) ) lcValue = SUBSTR( tcLine, lnPos + lnLenPropName + 2, lnPos2 - 1 ) ADDPROPERTY( toReg, laProps(X), lcValue ) ENDIF ENDFOR ENDIF CATCH TO loEx IF THIS.l_Debug AND _VFP.STARTMODE = 0 SET STEP ON ENDIF THROW ENDTRY RETURN llBloqueEncontrado ENDPROC ******************************************************************************************************************* PROCEDURE analizarBloque_Reportes *------------------------------------------------------ *-- Analiza el bloque *------------------------------------------------------ LPARAMETERS toReport, tcLine, taCodeLines, I, tnCodeLines #IF .F. LOCAL toReport AS CL_REPORT OF 'FOXBIN2PRG.PRG' #ENDIF 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 WITH THIS AS c_conversor_prg_a_frx OF 'FOXBIN2PRG.PRG' loReg = .emptyRecord() FOR I = I + 1 TO tnCodeLines lcComment = '' .set_Line( @tcLine, @taCodeLines, I ) DO CASE CASE LEFT( tcLine, LEN(C_TAG_REPORTE_F) ) == C_TAG_REPORTE_F I = I + 1 EXIT CASE .lineIsOnlyCommentAndNoMetadata( @tcLine, @lcComment ) LOOP && Saltear comentarios CASE .analizarBloque_platform( toReport, @tcLine, @taCodeLines, @I, @tnCodeLines, @loReg ) CASE .analizarBloque_CDATA_inline( toReport, @tcLine, @taCodeLines, @I, tnCodeLines, @loReg, 'picture' ) CASE .analizarBloque_CDATA_inline( toReport, @tcLine, @taCodeLines, @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 loReg.ObjType == "25" loReg.TAG = SUBSTR(loReg.TAG,3) && Quito el ENTER agregado antes OTHERWISE loReg.TAG = .decode_SpecialCodes_1_31( loReg.TAG ) ENDCASE CASE .analizarBloque_CDATA_inline( toReport, @tcLine, @taCodeLines, @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 .analizarBloque_CDATA_inline( toReport, @tcLine, @taCodeLines, @I, tnCodeLines, @loReg, 'penred' ) CASE .analizarBloque_CDATA_inline( toReport, @tcLine, @taCodeLines, @I, tnCodeLines, @loReg, 'style' ) CASE .analizarBloque_CDATA_inline( toReport, @tcLine, @taCodeLines, @I, tnCodeLines, @loReg, 'expr' ) CASE .analizarBloque_CDATA_inline( toReport, @tcLine, @taCodeLines, @I, tnCodeLines, @loReg, 'supexpr' ) CASE .analizarBloque_CDATA_inline( toReport, @tcLine, @taCodeLines, @I, tnCodeLines, @loReg, 'comment' ) CASE .analizarBloque_CDATA_inline( toReport, @tcLine, @taCodeLines, @I, tnCodeLines, @loReg, 'user' ) ENDCASE ENDFOR ENDWITH && THIS I = I - 1 toReport.ADD( loReg ) ENDIF CATCH TO loEx IF THIS.l_Debug AND _VFP.STARTMODE = 0 SET STEP ON ENDIF THROW FINALLY loReg = NULL RELEASE lcComment, lcMetadatos, luValor, laPropsAndValues, lnPropsAndValues_Count, loReg ENDTRY RETURN llBloqueEncontrado ENDPROC 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 = [] ; + [] ; + [] ; + [] ; + [] PROCEDURE Convertir *--------------------------------------------------------------------------------------------------- * 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 ) #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 STORE 0 TO lnCodError, lnCodeLines WITH THIS AS c_conversor_prg_a_dbf OF 'FOXBIN2PRG.PRG' C_FB2PRG_CODE = FILETOSTR( .c_InputFile ) lnCodeLines = ALINES( laCodeLines, C_FB2PRG_CODE ) toFoxBin2Prg.doBackup( .F., .T., '', '', '' ) *-- Identifico el inicio/fin de bloque, definición, cabecera y cuerpo del reporte .identificarBloquesDeCodigo( @laCodeLines, lnCodeLines, @laLineasExclusion, lnBloquesExclusion, @toTable ) .escribirArchivoBin( @toTable, @toFoxBin2Prg ) ENDWITH && THIS CATCH TO loEx lnCodError = loEx.ERRORNO IF THIS.l_Debug AND _VFP.STARTMODE = 0 SET STEP ON ENDIF THROW FINALLY USE IN (SELECT("TABLABIN")) ENDTRY RETURN lnCodError ENDPROC ******************************************************************************************************************* PROCEDURE escribirArchivoBin LPARAMETERS toTable, toFoxBin2Prg *-- ----------------------------------------------------------------------------------------------------------- #IF .F. LOCAL toTable AS CL_DBF_TABLE OF 'FOXBIN2PRG.PRG' LOCAL toFoxBin2Prg AS c_foxbin2prg OF 'FOXBIN2PRG.PRG' #ENDIF TRY LOCAL I, lnCodError, loEx AS EXCEPTION ; , loField AS CL_DBF_FIELD OF 'FOXBIN2PRG.PRG' ; , loIndex AS CL_DBF_INDEX OF 'FOXBIN2PRG.PRG' ; , loDBFUtils AS CL_DBF_UTILS OF 'FOXBIN2PRG.PRG' ; , lcCreateTable, lcLongDec, lcFieldDef, lcIndex, ldLastUpdate, 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 lnDataSessionID = .DATASESSIONID ERASE (FORCEEXT(.c_OutputFile, 'DBF')) ERASE (FORCEEXT(.c_OutputFile, 'FPT')) ERASE (FORCEEXT(.c_OutputFile, 'CDX')) IF EMPTY(toTable._Database) lcCreateTable = 'CREATE TABLE "' + .c_OutputFile + '" FREE CodePage=' + toTable._CodePage + ' (' ELSE lcTempDBC = FORCEPATH( '_FB2P', JUSTPATH(.c_OutputFile) ) CREATE DATABASE ( lcTempDBC ) lcCreateTable = 'CREATE TABLE "' + .c_OutputFile + '" CodePage=' + toTable._CodePage + ' (' ENDIF *-- Conformo los campos FOR EACH loField IN toTable._Fields FOXOBJECT lcLongDec = '' *-- Nombre, Tipo lcFieldDef = lcFieldDef + ', ' + loField._Name + ' ' + loField._Type *-- Longitud IF INLIST( loField._Type, 'C', 'N', 'F', 'Q', 'V' ) lcLongDec = lcLongDec + '(' + loField._Width ENDIF *-- Decimales IF INLIST( loField._Type, 'B', 'N', 'F' ) AND loField._Decimals > '0' 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' lcFieldDef = lcFieldDef + ' AUTOINC NEXTVAL ' + loField._AutoInc_NextVal + ' STEP ' + loField._AutoInc_Step ENDIF loField = NULL ENDFOR lcCreateTable = lcCreateTable + SUBSTR(lcFieldDef,3) + ')' &lcCreateTable. *-- 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 *-- Regenero los índices FOR EACH loIndex IN toTable._Indexes FOXOBJECT lcIndex = 'INDEX ON ' + loIndex._Key + ' TAG ' + loIndex._TagName IF loIndex._TagType = 'BINARY' lcIndex = lcIndex + ' BINARY' ELSE lcIndex = lcIndex + ' COLLATE "' + loIndex._Collate + '"' 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 &lcIndex. ENDFOR USE IN (SELECT(JUSTSTEM(.c_OutputFile))) *-- La actualización de la fecha sirve para evitar diferencias al regenerar el DBF ldLastUpdate = EVALUATE( '{^' + toTable._LastUpdate + '}' ) loDBFUtils.write_DBC_BackLink( .c_OutputFile, toTable._Database, ldLastUpdate ) ENDWITH && THIS CATCH TO loEx lnCodError = loEx.ERRORNO loEx.USERVALUE = 'lcIndex="' + TRANSFORM(lcIndex) + '"' + CR_LF ; + 'lcFieldDef="' + TRANSFORM(lcFieldDef) + '"' + CR_LF ; + 'lcCreateTable="' + TRANSFORM(lcCreateTable) + '"' IF THIS.l_Debug AND _VFP.STARTMODE = 0 SET STEP ON ENDIF THROW FINALLY USE IN (SELECT(JUSTSTEM(THIS.c_OutputFile))) STORE NULL TO loField, loIndex, loDBFUtils IF NOT EMPTY(lcTempDBC) CLOSE DATABASES ERASE (FORCEEXT(lcTempDBC,'DBC')) ERASE (FORCEEXT(lcTempDBC,'DCT')) ERASE (FORCEEXT(lcTempDBC,'DCX')) ENDIF RELEASE I, loField, loIndex, loDBFUtils ; , lcCreateTable, lcLongDec, lcFieldDef, lcIndex, ldLastUpdate, lcTempDBC, lnDataSessionID, lnSelect ENDTRY RETURN lnCodError ENDPROC ******************************************************************************************************************* PROCEDURE identificarBloquesDeCodigo *-------------------------------------------------------------------------------------------------------------- * 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 EXTERNAL ARRAY taCodeLines, taLineasExclusion #IF .F. LOCAL toTable AS CL_DBF_TABLE OF 'FOXBIN2PRG.PRG' #ENDIF TRY LOCAL I, lc_Comentario, lcLine, llFoxBin2Prg_Completed, llBloqueTable_Completed STORE 0 TO I WITH THIS AS c_conversor_prg_a_dbf OF 'FOXBIN2PRG.PRG' .c_Type = UPPER(JUSTEXT(.c_OutputFile)) IF tnCodeLines > 1 toTable = NULL toTable = CREATEOBJECT('CL_DBF_TABLE') FOR I = 1 TO tnCodeLines .set_Line( @lcLine, @taCodeLines, I ) IF .lineIsOnlyCommentAndNoMetadata( @lcLine, @lc_Comentario ) && Vacía o solo Comentarios LOOP ENDIF DO CASE CASE NOT llFoxBin2Prg_Completed AND .analizarBloque_FoxBin2Prg( toTable, @lcLine, @taCodeLines, @I, tnCodeLines ) llFoxBin2Prg_Completed = .T. CASE NOT llBloqueTable_Completed AND toTable.analizarBloque( @lcLine, @taCodeLines, @I, tnCodeLines ) llBloqueTable_Completed = .T. ENDCASE ENDFOR ENDIF ENDWITH && THIS CATCH TO loEx IF THIS.l_Debug AND _VFP.STARTMODE = 0 SET STEP ON ENDIF THROW ENDTRY RETURN ENDPROC ENDDEFINE && CLASS c_conversor_prg_a_dbf AS c_conversor_prg_a_bin ******************************************************************************************************************* 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 = [] ; + [] ; + [] ; + [] ; + [] ; + [] ; + [] ; + [] ; + [] PROCEDURE Convertir *--------------------------------------------------------------------------------------------------- * 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 ) #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 ; , laLineasExclusion(1), lnBloquesExclusion, I STORE 0 TO lnCodError, lnCodeLines STORE '' TO lcLine STORE NULL TO loReg, toModulo WITH THIS AS c_conversor_prg_a_dbc OF 'FOXBIN2PRG.PRG' C_FB2PRG_CODE = FILETOSTR( .c_InputFile ) lnCodeLines = ALINES( laCodeLines, C_FB2PRG_CODE ) toFoxBin2Prg.doBackup( .F., .T., '', '', '' ) *-- Creo la tabla *.createTable() *-- Identifico el inicio/fin de bloque, definición, cabecera y cuerpo del reporte .identificarBloquesDeCodigo( @laCodeLines, lnCodeLines, @laLineasExclusion, lnBloquesExclusion, @toDatabase ) .escribirArchivoBin( @toDatabase, toFoxBin2Prg ) ENDWITH && THIS CATCH TO loEx lnCodError = loEx.ERRORNO IF THIS.l_Debug AND _VFP.STARTMODE = 0 SET STEP ON ENDIF THROW FINALLY USE IN (SELECT("TABLABIN")) ENDTRY RETURN lnCodError ENDPROC ******************************************************************************************************************* PROCEDURE escribirArchivoBin 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 lnCodError = 0 IF NOT EMPTY(toDatabase._DBCEventFilename) AND FILE(toDatabase._DBCEventFilename) *-- 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 ) IF toFoxBin2Prg.l_Recompile toFoxBin2Prg.compileFoxProBinary() ENDIF CATCH TO loEx lnCodError = loEx.ERRORNO IF THIS.l_Debug AND _VFP.STARTMODE = 0 SET STEP ON ENDIF THROW ENDTRY RETURN lnCodError ENDPROC ******************************************************************************************************************* PROCEDURE identificarBloquesDeCodigo *-------------------------------------------------------------------------------------------------------------- * 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 (@? OUT) Objeto con toda la información de la base de datos analizada * * NOTA: * Como identificador se usa el nombre de clase o de procedimiento, según corresponda. *-------------------------------------------------------------------------------------------------------------- LPARAMETERS taCodeLines, tnCodeLines, taLineasExclusion, tnBloquesExclusion, toDatabase EXTERNAL ARRAY taCodeLines, taLineasExclusion #IF .F. LOCAL toDatabase AS CL_DBC OF 'FOXBIN2PRG.PRG' #ENDIF 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)) IF tnCodeLines > 1 toDatabase = NULL toDatabase = CREATEOBJECT('CL_DBC') FOR I = 1 TO tnCodeLines .set_Line( @lcLine, @taCodeLines, I ) IF .lineIsOnlyCommentAndNoMetadata( @lcLine, @lc_Comentario ) && Vacía o solo Comentarios LOOP ENDIF DO CASE CASE NOT llFoxBin2Prg_Completed AND .analizarBloque_FoxBin2Prg( toDatabase, @lcLine, @taCodeLines, @I, tnCodeLines ) llFoxBin2Prg_Completed = .T. CASE NOT llBloqueDatabase_Completed AND toDatabase.analizarBloque( @lcLine, @taCodeLines, @I, tnCodeLines ) llBloqueDatabase_Completed = .T. ENDCASE ENDFOR ENDIF ENDWITH && THIS CATCH TO loEx IF THIS.l_Debug AND _VFP.STARTMODE = 0 SET STEP ON ENDIF THROW ENDTRY RETURN ENDPROC 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 = [] ; + [] ; + [] ; + [] n_MenuType = 0 c_MenuLocation = '' ******************************************************************************************************************* PROCEDURE Convertir *--------------------------------------------------------------------------------------------------- * 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 ) #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 STORE 0 TO lnCodError, lnCodeLines STORE '' TO lcLine WITH THIS AS c_conversor_prg_a_mnx OF 'FOXBIN2PRG.PRG' C_FB2PRG_CODE = FILETOSTR( .c_InputFile ) lnCodeLines = ALINES( laCodeLines, C_FB2PRG_CODE ) toFoxBin2Prg.doBackup( .F., .T., '', '', '' ) *-- Creo la tabla .createMenu() *-- Identifico el inicio/fin de bloque, definición, cabecera y cuerpo del reporte .identificarBloquesDeCodigo( @laCodeLines, lnCodeLines, @laLineasExclusion, lnBloquesExclusion, @toMenu ) .escribirArchivoBin( @toMenu ) ENDWITH && THIS CATCH TO loEx lnCodError = loEx.ERRORNO IF THIS.l_Debug AND _VFP.STARTMODE = 0 SET STEP ON ENDIF THROW FINALLY USE IN (SELECT("TABLABIN")) ENDTRY RETURN lnCodError ENDPROC PROCEDURE identificarBloquesDeCodigo *-------------------------------------------------------------------------------------------------------------- * 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 #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 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') FOR I = 1 TO tnCodeLines .set_Line( @lcLine, @taCodeLines, I ) IF .lineIsOnlyCommentAndNoMetadata( @lcLine, @lc_Comentario ) && Vacía o solo Comentarios LOOP ENDIF DO CASE CASE NOT llFoxBin2Prg_Completed AND .analizarBloque_FoxBin2Prg( toMenu, @lcLine, @taCodeLines, @I, tnCodeLines ) llFoxBin2Prg_Completed = .T. CASE NOT llBloqueMenu_Completed AND toMenu.analizarBloque( @lcLine, @taCodeLines, @I, tnCodeLines, THIS ) llBloqueMenu_Completed = .T. ENDCASE ENDFOR ENDIF ENDWITH && THIS CATCH TO loEx IF THIS.l_Debug AND _VFP.STARTMODE = 0 SET STEP ON ENDIF THROW ENDTRY RETURN ENDPROC PROCEDURE escribirArchivoBin *--------------------------------------------------------------------------------------------------- * 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 #IF .F. LOCAL toMenu AS CL_MENU OF 'FOXBIN2PRG.PRG' #ENDIF TRY LOCAL lnCodError lnCodError = 0 toMenu.updateMENU( THIS ) CATCH TO loEx lnCodError = loEx.ERRORNO IF THIS.l_Debug AND _VFP.STARTMODE = 0 SET STEP ON ENDIF THROW FINALLY USE IN (SELECT(JUSTSTEM(THIS.c_OutputFile))) ENDTRY RETURN lnCodError ENDPROC 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 _MEMBERDATA = [] ; + [] ; + [] ; + [] ; + [] ; + [] ; + [] ; + [] ; + [] ; + [] ; + [] ; + [] ; + [] ; + [] ; + [] ; + [] ; + [] ; + [] ; + [] ; + [] ; + [] ; + [] ; + [] ; + [] ; + [] ; + [] ; + [] ; + [] ; + [] ; + [] ; + [] ; + [] ; + [] ; + [] ; + [] ; + [] ; + [] ; + [] ; + [] ; + [] ; + [] ; + [] ; + [] ; + [] ; + [] ******************************************************************************************************************* PROCEDURE Convertir *--------------------------------------------------------------------------------------------------- * 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 ) ENDPROC ******************************************************************************************************************* PROCEDURE get_ADD_OBJECT_METHODS LPARAMETERS toRegObj, toRegClass, tcMethods, taMethods, taCode, tnMethodCount ; , taPropsAndComments, tnPropsAndComments_Count, taProtected, tnProtected_Count ; , toFoxBin2Prg EXTERNAL ARRAY taPropsAndComments, taProtected #IF .F. LOCAL toFoxBin2Prg AS c_foxbin2prg OF 'FOXBIN2PRG.PRG' #ENDIF 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 ) *-- 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(I,2) = 0 LOOP ENDIF IF EMPTY(toRegObj.PARENT) lcMethodName = toRegObj.OBJNAME + '.' + taMethods(I,1) ELSE DO CASE CASE '.' $ toRegObj.PARENT lcMethodName = SUBSTR(toRegObj.PARENT, AT('.', toRegObj.PARENT) + 1) + '.' + toRegObj.OBJNAME + '.' + taMethods(I,1) CASE LEFT(toRegObj.PARENT + '.', LEN( toRegClass.OBJNAME + '.' ) ) == toRegClass.OBJNAME + '.' lcMethodName = toRegObj.OBJNAME + '.' + taMethods(I,1) OTHERWISE lcMethodName = toRegObj.PARENT + '.' + toRegObj.OBJNAME + '.' + taMethods(I,1) ENDCASE ENDIF *-- Genero el método SIN indentar, ya que se hace luego taCode(taMethods(I,2)) = 'PROCEDURE ' + lcMethodName + CR_LF + .IndentarMemo( taCode(taMethods(I,2)) ) + CR_LF + 'ENDPROC' taMethods(I,1) = lcMethodName ENDFOR ENDIF ENDWITH && THIS CATCH TO loEx IF THIS.l_Debug AND _VFP.STARTMODE = 0 SET STEP ON ENDIF THROW ENDTRY RETURN ENDPROC ******************************************************************************************************************* PROCEDURE get_CLASS_METHODS LPARAMETERS tnMethodCount, taMethods, taCode, taProtected, taPropsAndComments *-- DEFINIR MÉTODOS DE LA CLASE *-- Ubico los métodos protegidos y les cambio la definición EXTERNAL ARRAY taMethods, taCode, taProtected, taPropsAndComments 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(I,1), '^', '' ) lnProtectedItem = ASCAN( taProtected, taMethods(I,1), 1, 0, 0, 1+2+4) IF lnProtectedItem = 0 lnProtectedItem = ASCAN( taProtected, taMethods(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 lnCommentRow = ASCAN( taPropsAndComments, '*' + lcMethodName, 1, 0, 1, 1+2+4+8) *-- Nombre del método lcMethod = lcProcDef + ' ' + taMethods(I,1) *-- Comentarios del método (si tiene) IF lnCommentRow > 0 AND NOT EMPTY(taPropsAndComments(lnCommentRow,2)) lcMethod = lcMethod + C_TAB + C_TAB + '&' + '& ' + taPropsAndComments(lnCommentRow,2) ENDIF *-- Código del método IF taMethods(I,2) > 0 THEN taCode(taMethods(I,2)) = lcMethod + CR_LF + .IndentarMemo( taCode(taMethods(I,2)) ) + CR_LF + 'ENDPROC' ELSE lnLen = ALEN(taCode,1) + 1 DIMENSION taCode( lnLen ) taCode( lnLen ) = lcMethod + CR_LF + 'ENDPROC' taMethods(I,2) = lnLen ENDIF ENDFOR ENDWITH && THIS ENDIF CATCH TO loEx IF THIS.l_Debug AND _VFP.STARTMODE = 0 SET STEP ON ENDIF THROW ENDTRY RETURN ENDPROC ******************************************************************************************************************* PROCEDURE get_NombresObjetosOLEPublic LPARAMETERS ta_NombresObjsOle *-- Obtengo los objetos "OLEPublic" SELECT PADR(OBJNAME,100) OBJNAME ; FROM TABLABIN ; WHERE TABLABIN.PLATFORM = "COMMENT" AND TABLABIN.RESERVED2 == "OLEPublic" ; ORDER BY 1 ; INTO ARRAY ta_NombresObjsOle 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 EXTERNAL ARRAY taPropsAndComments 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 DIMENSION taPropsAndComments(tnPropsAndComments_Count,2) FOR I = 1 TO tnPropsAndComments_Count lnPos = AT(' ', laLines(I)) && Un espacio separa la propiedad de su comentario (si tiene) IF lnPos = 0 taPropsAndComments(I,1) = laLines(I) taPropsAndComments(I,2) = '' ELSE taPropsAndComments(I,1) = LEFT( laLines(I), lnPos - 1 ) taPropsAndComments(I,2) = SUBSTR( laLines(I), lnPos + 1 ) ENDIF ENDFOR IF tlSort AND THIS.l_PropSort_Enabled ASORT( taPropsAndComments, 1, -1, 0, 1 ) ENDIF CATCH TO loEx IF THIS.l_Debug AND _VFP.STARTMODE = 0 SET STEP ON ENDIF THROW ENDTRY 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 *--------------------------------------------------------------------------------------------------- LPARAMETERS tcMemo, tnSort, taPropsAndValues, tnPropsAndValues_Count, tcSortedMemo EXTERNAL ARRAY taPropsAndValues TRY LOCAL laItems(1), I, X, lnLenAcum, lnPosEQ, lcPropName, lnLenVal, lcValue, lcMethods tcSortedMemo = '' 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 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(I) ) LOOP ENDIF X = X + 1 DIMENSION taPropsAndValues(X,2) IF C_MPROPHEADER $ laItems(I) *-- Solo entrará por aquí cuando se evalúe una propiedad de PROPERTIES con un valor especial (largo) lnLenAcum = 0 lnPosEQ = AT( '=', laItems(I) ) lcPropName = LEFT( laItems(I), lnPosEQ - 2 ) lnLenVal = INT( VAL( SUBSTR( laItems(I), lnPosEQ + 2 + 517, 8) ) ) lcValue = SUBSTR( laItems(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 = I + 1 TO m.lnItemCount lcValue = lcValue + CR_LF + laItems(I) 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 *-- Es un valor especial, por lo que se encapsula en un marcador especial taPropsAndValues(X,1) = lcPropName taPropsAndValues(X,2) = .normalizarValorPropiedad( lcPropName, lcValue, '' ) ELSE *-- Propiedad normal lnPosEQ = AT( '=', laItems(I) ) taPropsAndValues(X,1) = LEFT( laItems(I), lnPosEQ - 2 ) taPropsAndValues(X,2) = .normalizarValorPropiedad( taPropsAndValues(X,1), LTRIM( SUBSTR( laItems(I), lnPosEQ + 2 ) ), '' ) ENDIF ENDFOR tnPropsAndValues_Count = X lcMethods = '' *-- 2) SORT .sortPropsAndValues( @taPropsAndValues, tnPropsAndValues_Count, tnSort ) *-- Agregar propiedades primero FOR I = 1 TO m.tnPropsAndValues_Count tcSortedMemo = m.tcSortedMemo + m.taPropsAndValues(I,1) + ' = ' + m.taPropsAndValues(I,2) + CR_LF ENDFOR *-- Agregar métodos al final tcSortedMemo = m.tcSortedMemo + m.lcMethods ENDWITH && THIS ENDIF CATCH TO loEx IF THIS.l_Debug AND _VFP.STARTMODE = 0 SET STEP ON ENDIF THROW ENDTRY 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 EXTERNAL ARRAY taProtected tcSortedMemo = '' tnProtected_Count = ALINES(taProtected, tcMemo, 1+4) 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 FOR I = tnProtected_Count TO 1 STEP -1 *-- El ASCAN es para evitar valores repetidos, que se eliminarán. v1.19.29 IF ASCAN( taProtected, taProtected(I), 1, -1, 0,1+2+4 ) = I tcSortedMemo = tcSortedMemo + LOWER(taProtected(I)) + CR_LF ELSE ADEL( taProtected, I ) tnProtected_Count = tnProtected_Count - 1 ENDIF ENDFOR DIMENSION taProtected(tnProtected_Count) ENDIF RETURN ENDPROC ******************************************************************************************************************* PROCEDURE IndentarMemo 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 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 *-- Quito las líneas en blanco luego del final del ENDPROC X = 0 FOR I = lnFin TO 1 STEP -1 IF NOT EMPTY(laLineas(I)) && Última línea de código IF llProcedure AND LEFT( laLineas(I), 10 ) <> C_ENDPROC *ERROR 'Procedimiento sin cerrar. La última línea de código debe ser ENDPROC. [' + laLineas(1) + ']' ERROR (TEXTMERGE(C_PROCEDURE_NOT_CLOSED_ON_LINE_LOC)) ENDIF EXIT ENDIF X = X + 1 ENDFOR IF X > 0 lnFin = lnFin - X DIMENSION laLineas(lnFin) 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(I) ENDFOR IF llProcedure AND tlKeepProcHeader laLineas(lnInicio) = C_TAB + laLineas(lnInicio) laLineas(lnFin) = C_TAB + laLineas(lnFin) lcMethod = CR_LF + laLineas(lnInicio) + lcMethod + CR_LF + laLineas(lnFin) ENDIF lcMethod = SUBSTR(lcMethod,3) && Quito el primer ENTER (CR+LF) CATCH TO loEx IF THIS.l_Debug AND _VFP.STARTMODE = 0 SET STEP ON ENDIF THROW ENDTRY RETURN lcMethod ENDPROC ******************************************************************************************************************* PROCEDURE MemoInOneLine( tcMethod ) TRY LOCAL lcLine, I lcLine = '' IF NOT EMPTY(tcMethod) FOR I = 1 TO ALINES(laLines, m.tcMethod, 0) lcLine = lcLine + ', ' + laLines(I) ENDFOR lcLine = SUBSTR(lcLine, 3) ENDIF CATCH TO loEx IF THIS.l_Debug AND _VFP.STARTMODE = 0 SET STEP ON ENDIF THROW ENDTRY RETURN lcLine ENDPROC ******************************************************************************************************************* PROCEDURE set_MultilineMemoWithAddObjectProperties LPARAMETERS taPropsAndValues, tnPropCount, tcLeftIndentation, tlNormalizeLine EXTERNAL ARRAY taPropsAndValues TRY LOCAL lcLine, I, lcComentarios, laLines(1), lcFinDeLinea lcLine = '' lcFinDeLinea = ', ;' + CR_LF IF tnPropCount > 0 IF VARTYPE(tcLeftIndentation) # 'C' tcLeftIndentation = '' ENDIF FOR I = 1 TO tnPropCount lcLine = lcLine + tcLeftIndentation + taPropsAndValues(I,1) + ' = ' + taPropsAndValues(I,2) + lcFinDeLinea ENDFOR *-- Quito el ", ;" final lcLine = tcLeftIndentation + SUBSTR(lcLine, 1 + LEN(tcLeftIndentation), LEN(lcLine) - LEN(tcLeftIndentation) - LEN(lcFinDeLinea)) ENDIF CATCH TO loEx IF THIS.l_Debug AND _VFP.STARTMODE = 0 SET STEP ON ENDIF THROW ENDTRY RETURN lcLine ENDPROC ******************************************************************************************************************* PROCEDURE SortMethod LPARAMETERS tcMethod, taMethods, taCode, tcSorted, tnMethodCount, taPropsAndComments, tnPropsAndComments_Count ; , taProtected, tnProtected_Count, toFoxBin2Prg EXTERNAL ARRAY taMethods, taCode, taPropsAndComments, taProtected #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 IF tnMethodCount > 0 THEN *-- 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 DIMENSION laMethods(tnMethodCount,3) lnDeleted = 0 FOR I = tnMethodCount TO 1 STEP -1 IF taMethods(I,2) > 0 THEN IF '.' $ taMethods(I,1) *-- Los métodos con '.' los mando a otro array lnDeleted = lnDeleted + 1 laMethods(lnDeleted,1) = taMethods(I,1) laMethods(lnDeleted,2) = taMethods(I,2) laMethods(lnDeleted,3) = taMethods(I,3) ADEL( taMethods, I ) ENDIF ENDIF ENDFOR FOR I = lnDeleted TO 1 STEP -1 *-- Los métodos con '.' los paso al final I2 = tnMethodCount - lnDeleted + (lnDeleted - I) + 1 taMethods(I2,1) = laMethods(I,1) taMethods(I2,2) = laMethods(I,2) taMethods(I2,3) = laMethods(I,3) ENDFOR ENDIF CATCH TO loEx IF THIS.l_Debug AND _VFP.STARTMODE = 0 SET STEP ON ENDIF THROW ENDTRY RETURN ENDPROC && SordMethod ******************************************************************************************************************* PROCEDURE Method2Array LPARAMETERS tcMethod, taMethods, taCode, tcSorted, tnMethodCount, taPropsAndComments, tnPropsAndComments_Count ; , taProtected, tnProtected_Count, toFoxBin2Prg *-- 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 *-- 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 ; , 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) DIMENSION laLine(1) STORE '' TO laLine STORE 0 TO lnTextNodes 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(I)) OR LEFT( LTRIM(laLine(I)),1 ) = '*' *-- Skip empty and commented lines ELSE IF I > 1 FOR X = I-1 TO 1 STEP -1 ADEL(laLine, X) ENDFOR lnLineCount = lnLineCount - 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(I)) OR LEFT( LTRIM(laLine(I)),1 ) = '*' ADEL(laLine, I) ELSE IF I < lnLineCount lnLineCount = I DIMENSION laLine(lnLineCount) ENDIF EXIT ENDIF ENDFOR *-- Identifico los TEXT/ENDTEXT, #IF .F./#ENDIF THIS.identificarBloquesDeExclusion( @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_DropNullCharsFromCode laLine(I) = CHRTRAN( laLine(I), C_NULL_CHAR, '' ) ENDIF lnLine_Len = LEN( laLine(I) ) DO CASE CASE laLineasExclusion(I) IF tnMethodCount > 0 AND llProcOpen taCode(tnMethodCount) = taCode(tnMethodCount) + laLine(I) + CR_LF ELSE *-- Invalid method code, as outer code added for tools like ReFox or others, is cleaned up ENDIF CASE lnTextNodes = 0 AND UPPER( LEFT(laLine(I), 10) ) == 'PROCEDURE ' tnMethodCount = tnMethodCount + 1 DIMENSION taMethods(tnMethodCount, 3), taCode(tnMethodCount) taMethods(tnMethodCount, 1) = RTRIM( SUBSTR(laLine(I), 11) ) taMethods(tnMethodCount, 2) = tnMethodCount taMethods(tnMethodCount, 3) = '' taCode(tnMethodCount) = 'PROCEDURE ' + taMethods(tnMethodCount, 1) + CR_LF && laLine(I) + CR_LF llProcOpen = .T. CASE lnTextNodes = 0 AND UPPER( LEFT(laLine(I), 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(laLine(I), 10) ) taMethods(tnMethodCount, 2) = tnMethodCount taMethods(tnMethodCount, 3) = '' taCode(tnMethodCount) = 'PROCEDURE ' + taMethods(tnMethodCount, 1) + CR_LF && laLine(I) + CR_LF llProcOpen = .T. CASE lnTextNodes = 0 AND UPPER( LEFT(laLine(I), 17) ) == 'HIDDEN PROCEDURE ' tnMethodCount = tnMethodCount + 1 DIMENSION taMethods(tnMethodCount, 3), taCode(tnMethodCount) taMethods(tnMethodCount, 1) = RTRIM( SUBSTR(laLine(I), 18) ) taMethods(tnMethodCount, 2) = tnMethodCount taMethods(tnMethodCount, 3) = 'HIDDEN ' taCode(tnMethodCount) = 'HIDDEN PROCEDURE ' + taMethods(tnMethodCount, 1) + CR_LF && laLine(I) + CR_LF llProcOpen = .T. CASE lnTextNodes = 0 AND UPPER( LEFT(laLine(I), 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(laLine(I), 17) ) taMethods(tnMethodCount, 2) = tnMethodCount taMethods(tnMethodCount, 3) = 'HIDDEN ' taCode(tnMethodCount) = 'HIDDEN PROCEDURE ' + taMethods(tnMethodCount, 1) + CR_LF && laLine(I) + CR_LF llProcOpen = .T. CASE lnTextNodes = 0 AND UPPER( LEFT(laLine(I), 20) ) == 'PROTECTED PROCEDURE ' tnMethodCount = tnMethodCount + 1 DIMENSION taMethods(tnMethodCount, 3), taCode(tnMethodCount) taMethods(tnMethodCount, 1) = RTRIM( SUBSTR(laLine(I), 21) ) taMethods(tnMethodCount, 2) = tnMethodCount taMethods(tnMethodCount, 3) = 'PROTECTED ' taCode(tnMethodCount) = 'PROTECTED PROCEDURE ' + taMethods(tnMethodCount, 1) + CR_LF && laLine(I) + CR_LF llProcOpen = .T. CASE lnTextNodes = 0 AND UPPER( LEFT(laLine(I), 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(laLine(I), 20) ) taMethods(tnMethodCount, 2) = tnMethodCount taMethods(tnMethodCount, 3) = 'PROTECTED ' taCode(tnMethodCount) = 'PROTECTED PROCEDURE ' + taMethods(tnMethodCount, 1) + CR_LF && laLine(I) + CR_LF llProcOpen = .T. CASE lnTextNodes = 0 AND LEFT(laLine(I), 7) == 'ENDPROC' lcLine = UPPER( CHRTRAN( laLine(I) , '&'+CHR(9)+CHR(0), ' ') ) + ' ' IF lnLine_Len >= 7 AND LEFT(lcLine,8) == 'ENDPROC ' *-- Es el final de estructura ENDPROC ELSE *-- Es otra cosa (variable, etc) taCode(tnMethodCount) = taCode(tnMethodCount) + laLine(I) + CR_LF LOOP ENDIF taCode(tnMethodCount) = taCode(tnMethodCount) + laLine(I) &&+ CR_LF llProcOpen = .F. CASE lnTextNodes = 0 AND LEFT(laLine(I), 7) == 'ENDFUNC' && NOT VALID WITH VFP IDE, BUT 3rd. PARTY SOFTWARE CAN USE IT lcLine = UPPER( CHRTRAN( laLine(I) , '&'+CHR(9)+CHR(0), ' ') ) + ' ' IF lnLine_Len >= 7 AND LEFT(lcLine,8) == 'ENDFUNC ' *-- Es el final de estructura ENDPROC laLine(I) = STRTRAN( laLine(I), 'ENDFUNC', 'ENDPROC' ) ELSE *-- Es otra cosa (variable, etc) taCode(tnMethodCount) = taCode(tnMethodCount) + laLine(I) + CR_LF LOOP ENDIF taCode(tnMethodCount) = taCode(tnMethodCount) + laLine(I) &&+ CR_LF llProcOpen = .F. *CASE tnMethodCount = 0 OR NOT llProcOpen AND LEFT( LTRIM(laLine(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(I), 7) # 'ENDPROC', pero abarcaría demasiado. OTHERWISE && Method Code taCode(tnMethodCount) = taCode(tnMethodCount) + laLine(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(I,1), '*', '' ) IF LEFT( taPropsAndComments(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 ENDIF CATCH TO loEx IF THIS.l_Debug AND _VFP.STARTMODE = 0 SET STEP ON ENDIF THROW ENDTRY RETURN ENDPROC && Method2Array ******************************************************************************************************************* PROCEDURE write_ADD_OBJECTS_WithProperties LPARAMETERS toRegObj, tcCodigo #IF .F. LOCAL toRegObj AS CL_OBJETO OF 'FOXBIN2PRG.PRG' #ENDIF TRY LOCAL lcMemo, laPropsAndValues(1,2), lnPropsAndValues_Count *-- Defino los objetos a cargar THIS.get_PropsAndValuesFrom_PROPERTIES( toRegObj.PROPERTIES, 1, @laPropsAndValues, @lnPropsAndValues_Count, @lcMemo ) lcMemo = THIS.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 <<>> ADD OBJECT '<>.<>' AS <> <<>> ENDTEXT ELSE *-- Este caso: objeto TEXT TO tcCodigo ADDITIVE TEXTMERGE NOSHOW FLAGS 1+2 PRETEXT 1+2 <<>> ADD OBJECT '<>' AS <> <<>> ENDTEXT ENDIF IF NOT EMPTY(lcMemo) TEXT TO tcCodigo ADDITIVE TEXTMERGE NOSHOW FLAGS 1 PRETEXT 1+2 <> ; <> ENDTEXT ENDIF 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 *-- Agrego metainformación para objetos OLE IF toRegObj.BASECLASS == 'olecontrol' TEXT TO tcCodigo ADDITIVE TEXTMERGE NOSHOW FLAGS 1 PRETEXT 1+2+4+8 <<>> Nombre="<>" Parent="<>" ObjName="<>" OLEObject="< 0 THEN *-- Recorro las propiedades (campo Properties) para ir conformando *-- las definiciones HIDDEN y PROTECTED FOR I = 1 TO tnPropsAndValues_Count IF EMPTY(taPropsAndValues(I,1)) LOOP ENDIF IF tnProtected_Count = 0 lnProtectedItem = 0 ELSE lnProtectedItem = ASCAN(taProtected, taPropsAndValues(I,1), 1, 0, 0, 1) ENDIF DO CASE CASE lnProtectedItem = 0 *-- Propiedad común CASE LOWER( taProtected(lnProtectedItem) ) == LOWER( taPropsAndValues(I,1) ) *-- Propiedad protegida lcProtectedProp = lcProtectedProp + ',' + taPropsAndValues(I,1) CASE LOWER( taProtected(lnProtectedItem) ) == LOWER( taPropsAndValues(I,1) + '^' ) *-- Propiedad oculta lcHiddenProp = lcHiddenProp + ',' + taPropsAndValues(I,1) ENDCASE ENDFOR *-- Segunda barrida para las propiedades Hidden/Protected que no estén definidas en Properties FOR I = 1 TO tnProtected_Count *-- La propiedad evaluada no debe ser vacía, debe estar en la lista de PROPERTIES y no debe ser un *Método IF EMPTY(taProtected(I,1)) ; OR ASCAN(taPropsAndValues, CHRTRAN( taProtected(I), '^', '' ), 1, 0, 1, 1) > 0 ; OR ASCAN(taPropsAndComments, '*' + CHRTRAN( taProtected(I), '^', '' ), 1, 0, 1, 1) > 0 LOOP ENDIF IF RIGHT( taProtected(I), 1 ) == '^' *-- Propiedad oculta lcHiddenProp = lcHiddenProp + ',' + CHRTRAN( taProtected(I), '^', '' ) ELSE *-- Propiedad protegida lcProtectedProp = lcProtectedProp + ',' + taProtected(I) ENDIF ENDFOR .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 ALEN(taPropsAndValues, 1) TEXT TO tcCodigo ADDITIVE TEXTMERGE NOSHOW FLAGS 1+2 PRETEXT 1+2 <<>> <> = <> ENDTEXT lnComment = ASCAN( taPropsAndComments, taPropsAndValues(I,1), 1, 0, 1, 1+8) IF lnComment > 0 AND NOT EMPTY(taPropsAndComments(lnComment,2)) TEXT TO tcCodigo ADDITIVE TEXTMERGE NOSHOW FLAGS 1 PRETEXT 1+2 <<>> && <> ENDTEXT ENDIF ENDFOR TEXT TO tcCodigo ADDITIVE TEXTMERGE NOSHOW FLAGS 1+2 PRETEXT 1+2 <<>> ENDTEXT ENDIF ENDWITH && THIS CATCH TO loEx IF THIS.l_Debug AND _VFP.STARTMODE = 0 SET STEP ON ENDIF THROW ENDTRY RETURN ENDPROC ******************************************************************************************************************* 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 * 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(I,1)) LOOP ENDIF lcType = LEFT( taPropsAndComments(I,1), 1 ) lcType = ICASE( lcType == '*', 'm' ; , lcType == '^', 'a' ; , 'p' ) IF lcType == 'p' THEN TEXT TO tcCodigo ADDITIVE TEXTMERGE NOSHOW FLAGS 1+2 PRETEXT 1+2 <<>> *<>: <> ENDTEXT ELSE TEXT TO tcCodigo ADDITIVE TEXTMERGE NOSHOW FLAGS 1+2 PRETEXT 1+2 <<>> *<>: <> ENDTEXT ENDIF IF NOT EMPTY(taPropsAndComments(I,2)) TEXT TO tcCodigo ADDITIVE TEXTMERGE NOSHOW FLAGS 1 PRETEXT 1+2 <<>> <<'&'>><<'&'>> <> ENDTEXT ENDIF ENDFOR TEXT TO tcCodigo ADDITIVE TEXTMERGE NOSHOW FLAGS 1+2 PRETEXT 1+2 <<>> <> ENDTEXT tcCodigo = tcCodigo + CR_LF ENDIF RETURN ENDPROC ******************************************************************************************************************* PROCEDURE write_DEFINE_CLASS LPARAMETERS ta_NombresObjsOle, toRegClass, tcCodigo LOCAL lcOF_Classlib, llOleObject lcOF_Classlib = '' llOleObject = ( ASCAN( ta_NombresObjsOle, toRegClass.OBJNAME, 1, 0, 1, 1+8) > 0 ) 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] ) TEXT TO tcCodigo ADDITIVE TEXTMERGE NOSHOW FLAGS 1+2 PRETEXT 1+2 <<'DEFINE CLASS'>> <> AS <> <> ENDTEXT 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 TEXT TO tcCodigo ADDITIVE TEXTMERGE NOSHOW FLAGS 1+2 PRETEXT 1+2 <<>> <> <> <<>> <> ENDTEXT ELSE && Comentario in-line TEXT TO tcCodigo ADDITIVE TEXTMERGE NOSHOW FLAGS 1 PRETEXT 1+2 <<>> <<'&'+'&'>> <> ENDTEXT ENDIF ENDIF RETURN ENDPROC ******************************************************************************************************************* PROCEDURE write_ENDDEFINE_SiCorresponde LPARAMETERS tnLastClass, tcCodigo IF tnLastClass = 1 TEXT TO tcCodigo ADDITIVE TEXTMERGE NOSHOW FLAGS 1+2 PRETEXT 1+2 <<'ENDDEFINE'>> <<>> ENDTEXT ENDIF RETURN ENDPROC ******************************************************************************************************************* 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 RETURN ENDPROC ******************************************************************************************************************* PROCEDURE write_CLASSMETADATA LPARAMETERS toRegClass, tcCodigo *-- Agrego Metadatos de la clase (Baseclass, Timestamp, Scale, Uniqueid) TEXT TO tcCodigo ADDITIVE TEXTMERGE NOSHOW FLAGS 1+2 PRETEXT 1+2 <<>> ENDTEXT TEXT TO tcCodigo ADDITIVE TEXTMERGE NOSHOW FLAGS 1+2 PRETEXT 1+2+4+8 <<>> <> Baseclass="<>" Timestamp="<>" Scale="<>" Uniqueid="<>" ENDTEXT IF NOT EMPTY(toRegClass.OLE2) TEXT TO tcCodigo ADDITIVE TEXTMERGE NOSHOW FLAGS 1 PRETEXT 1+2+4+8 <<>> Nombre="<>" Parent="<>" ObjName="<>" OLEObject="< se quita clase lcNombre = SUBSTR(toRegObj.PARENT, AT('.', toRegObj.PARENT)+1) + '.' + toRegObj.OBJNAME ELSE *-- Este caso: objeto lcNombre = toRegObj.OBJNAME ENDIF TEXT TO tcCodigo ADDITIVE TEXTMERGE NOSHOW FLAGS 1 PRETEXT 1+2+4+8 <<>> <> ObjPath="<>" UniqueID="<>" Timestamp="<>" ENDTEXT TEXT TO tcCodigo ADDITIVE TEXTMERGE NOSHOW FLAGS 1+2 PRETEXT 1+2+4+8 <> ENDTEXT RETURN ENDPROC ******************************************************************************************************************* PROCEDURE write_HIDDEN_Properties *-- Escribo la definición HIDDEN de propiedades LPARAMETERS tcHiddenProp, tcCodigo IF NOT EMPTY(tcHiddenProp) TEXT TO tcCodigo ADDITIVE TEXTMERGE NOSHOW FLAGS 1+2 PRETEXT 1+2 <<>> HIDDEN <> ENDTEXT ENDIF RETURN ENDPROC ******************************************************************************************************************* PROCEDURE write_PROTECTED_Properties *-- Escribo la definición PROTECTED de propiedades LPARAMETERS tcProtectedProp, tcCodigo IF NOT EMPTY(tcProtectedProp) TEXT TO tcCodigo ADDITIVE TEXTMERGE NOSHOW FLAGS 1+2 PRETEXT 1+2 <<>> PROTECTED <> ENDTEXT ENDIF RETURN ENDPROC ******************************************************************************************************************* PROCEDURE write_CABECERA_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 = '' TEXT TO C_FB2PRG_CODE ADDITIVE TEXTMERGE NOSHOW FLAGS 1+2 PRETEXT 1+2 <> ENDTEXT TEXT TO C_FB2PRG_CODE ADDITIVE TEXTMERGE NOSHOW FLAGS 1+2 PRETEXT 1+2 <<>> platform="WINDOWS " uniqueid="<>" timestamp="<>" objtype="<>" <<>> ENDTEXT TEXT TO C_FB2PRG_CODE ADDITIVE TEXTMERGE NOSHOW FLAGS 1 PRETEXT 1+2 objcode="<>" name="<>" <<>> ENDTEXT TEXT TO C_FB2PRG_CODE ADDITIVE TEXTMERGE NOSHOW FLAGS 1 PRETEXT 1+2 vpos="<>" hpos="<>" height="<>" width="<>" <<>> ENDTEXT TEXT TO C_FB2PRG_CODE ADDITIVE TEXTMERGE NOSHOW FLAGS 1 PRETEXT 1+2 order="<>" unique="<>" <<>> ENDTEXT TEXT TO C_FB2PRG_CODE ADDITIVE TEXTMERGE NOSHOW FLAGS 1 PRETEXT 1+2 environ="<>" boxchar="<>" fillchar="<>" <<>> ENDTEXT TEXT TO C_FB2PRG_CODE ADDITIVE TEXTMERGE NOSHOW FLAGS 1 PRETEXT 1+2 pengreen="<>" penblue="<>" fillred="<>" fillgreen="<>" <<>> ENDTEXT TEXT TO C_FB2PRG_CODE ADDITIVE TEXTMERGE NOSHOW FLAGS 1 PRETEXT 1+2 fillblue="<>" pensize="<>" penpat="<>" fillpat="<>" <<>> ENDTEXT TEXT TO C_FB2PRG_CODE ADDITIVE TEXTMERGE NOSHOW FLAGS 1 PRETEXT 1+2 fontface="<>" fontstyle="<>" fontsize="<>" mode="<>" <<>> ENDTEXT TEXT TO C_FB2PRG_CODE ADDITIVE TEXTMERGE NOSHOW FLAGS 1 PRETEXT 1+2 ruler="<>" rulerlines="<>" grid="<>" gridv="<>" <<>> ENDTEXT TEXT TO C_FB2PRG_CODE ADDITIVE TEXTMERGE NOSHOW FLAGS 1 PRETEXT 1+2 gridh="<>" float="<>" stretch="<>" stretchtop="<>" <<>> ENDTEXT TEXT TO C_FB2PRG_CODE ADDITIVE TEXTMERGE NOSHOW FLAGS 1 PRETEXT 1+2 top="<>" bottom="<>" suptype="<>" suprest="<>" norepeat="<>" <<>> ENDTEXT TEXT TO C_FB2PRG_CODE ADDITIVE TEXTMERGE NOSHOW FLAGS 1 PRETEXT 1+2 resetrpt="<>" pagebreak="<>" colbreak="<>" resetpage="<>" <<>> ENDTEXT TEXT TO C_FB2PRG_CODE ADDITIVE TEXTMERGE NOSHOW FLAGS 1 PRETEXT 1+2 general="<>" spacing="<>" double="<>" swapheader="<>" <<>> ENDTEXT TEXT TO C_FB2PRG_CODE ADDITIVE TEXTMERGE NOSHOW FLAGS 1 PRETEXT 1+2 swapfooter="<>" ejectbefor="<>" ejectafter="<>" plain="<>" <<>> ENDTEXT TEXT TO C_FB2PRG_CODE ADDITIVE TEXTMERGE NOSHOW FLAGS 1 PRETEXT 1+2 summary="<>" addalias="<>" offset="<>" topmargin="<>" <<>> ENDTEXT TEXT TO C_FB2PRG_CODE ADDITIVE TEXTMERGE NOSHOW FLAGS 1 PRETEXT 1+2 botmargin="<>" totaltype="<>" resettotal="<>" resoid="<>" <<>> ENDTEXT TEXT TO C_FB2PRG_CODE ADDITIVE TEXTMERGE NOSHOW FLAGS 1 PRETEXT 1+2 curpos="<>" supalways="<>" supovflow="<>" suprpcol="<>" <<>> ENDTEXT TEXT TO C_FB2PRG_CODE ADDITIVE TEXTMERGE NOSHOW FLAGS 1 PRETEXT 1+2 supgroup="<>" supvalchng="<>" <<>> ENDTEXT C_FB2PRG_CODE = C_FB2PRG_CODE + CR_LF + " " C_FB2PRG_CODE = C_FB2PRG_CODE + CR_LF + " " C_FB2PRG_CODE = C_FB2PRG_CODE + CR_LF + " " C_FB2PRG_CODE = C_FB2PRG_CODE + CR_LF + " " C_FB2PRG_CODE = C_FB2PRG_CODE + CR_LF + "