*--------------------------------------------------------------------------------------------------- * 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 * * 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/. * * 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. * *--------------------------------------------------------------------------------------------------- * 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) * 19/11/2014 FDBOZZO v1.19.37 Mejora: Las configuraciones de foxbin2prg.cfg no permiten comentarios && al final (edyshor) * 19/11/2014 FDBOZZO v1.19.37 Arreglo bug: "String is too long to fit" cuando se procesa un DBF grande con DBF_Conversion_Support = 4 (edyshor) * 19/11/2014 FDBOZZO v1.19.37 Mejora dbf: Nuevo parámetro ClearDBFLastUpdate para evitar diferencias por este dato (edyshor) * 21/10/2014 FDBOZZO v1.19.37 Mejora: Permitir generar una clase por archivo (Ryan Harris/Lutz Scheffler) * 29/11/2014 FDBOZZO v1.19.37 Arreglo bug scx/vcx: Algunas propiedades a veces tomaban la descripción de otras propiedades similares * 29/11/2014 FDBOZZO v1.19.37 Arreglo bug scx/vcx: Las propiedades "Protected" y "Hidden" no siempre estaban ordenadas alfabéticamente * 30/10/2014 FDBOZZO v1.19.37 Mejora: Optimizaciones en velocidad de proceso para scx/vcx/dbf * 30/11/2014 FDBOZZO v1.19.37 Mejora: Indicador de avance de proceso más informativo * 30/11/2014 FDBOZZO v1.19.37 Mejora: Se puede cancelar el proceso con la tecla Esc * 30/11/2014 FDBOZZO v1.19.37 Mejora: Agregado control para detectar reportes no compatibles con VFP 9 * 04/12/2014 FDBOZZO v1.19.38 Mejora: Permitir hacer conversiones masivas bin2prg y prg2bin sin los scripts vbs (Francisco Prieto) * 06/12/2014 FDBOZZO v1.19.38 Mejora: Rediseño de la Internacionalización. Ahora la selección es automática al cargar y no requiere recompilar. * 12/12/2014 FDBOZZO v1.19.38 Mejora: Detección de métodos duplicados para notificar casos de corrupción (Álvaro Castrillón) * 18/12/2014 FDBOZZO v1.19.39 Mejora: Cuando se usan las claves BIN2PRG o PRG2BIN permitir procesar un archivo solo (Mike Potjer) * 18/12/2014 FDBOZZO v1.19.39 Mejora: Agregar la clave SHOWMSG y dejar INTERACTIVE para un diálogo interactivo (Mike Potjer) * 18/12/2014 FDBOZZO v1.19.39 Mejora: Cuando se procesa un directorio con foxbin2prg.exe solo y la clave INTERACTIVE, mostrar un diálogo para preguntar qué procesar (Mike Potjer) * 18/12/2014 FDBOZZO v1.19.39 Bug fix vbs: Los scripts vbs no muestren los errores del proceso de FoxBin2Prg * 30/12/2014 FDBOZZO v1.19.39 Bug fix dc2: Los datos de DisplayClass y DisplayClassLibrary tenían el valor de "Default" en vez del propio (Christopher Kurth/Ryan Harris) * 04/01/2015 FDBOZZO v1.19.40 Bug fix frx/lbx: Cuando se usa el entorno de datos, solo se está guardando un cursor, y si hay más se pierden * 06/01/2015 FDBOZZO v1.19.40 Mejora: Permitir configurar la barra de progreso para que solamente aparezca cuando se procesan múltiples archivos y no cuando se procesa solo 1 (Jim Nelson) * 07/01/2015 FDBOZZO v1.19.40 Bug fix db2: [Error 12, Variable "TCOUTPUTFILE" is not found] cuando DBF_Conversion_Support=4 y el archivo de salida es igual al generado (Mike Potjer) * 07/01/2015 FDBOZZO v1.19.40 Mejora scx/vcx: Detección de nombres de objeto duplicados para notificar casos de corrupción * 13/01/2015 FDBOZZO v1.19.41 Bug Fix scx/vcx: Detección errónea de estructuras PROCEDURE/ENDPROC cuando se usan como parámetros en LPARAMETERS (Ryan Harris) * 13/01/2015 FDBOZZO v1.19.41 Bug Fix db2: Detección errónea de tabla inválida cuando el tamaño es inferior a 328 bytes. Límite mínimo cambiado a 65 bytes. * 20/01/2015 FDBOZZO v1.19.42 Mejora: Validación de versión de Visual FoxPro SP1, para evitar problemas ajenos a FoxBin2Prg * 04/02/2015 FDBOZZO v1.19.42 Mejora dc2: Permitir ordenar los campos de vistas y tablas alfabéticamente y mantener en una lista aparte el orden real, para facilitar el diff y el merge (Ryan Harris) * 22/01/2015 FDBOZZO v1.19.42 Bug Fix: Compatibilidad con SourceSafe rota porque se genera un error al realizar la consulta para soporte de archivo (Tuvia Vinitsky) * 25/02/2015 FDBOZZO v1.19.42 Bug Fix scx/vcx: Procesar solo un nivel de text/endtext, ya que no se admiten más niveles (Lutz Scheffler) * 25/02/2015 FDBOZZO v1.19.42 Mejora: Hacer algunos mensajes de error más descriptivos (Lutz Scheffler) * 03/03/2015 FDBOZZO v1.19.42 Mejora: Mejoras en la traducción al alemán (Lutz Scheffler) * 03/03/2015 FDBOZZO v1.19.42 Mejora: Permitir definir el archivo de entrada con un path relativo (Lutz Scheffler) * 03/03/2015 FDBOZZO v1.19.42 Bug Fix scx: Metadato del Dataenvironment no se genera bien cuando el Dataenvironment es renombrado * 03/03/2015 FDBOZZO v1.19.42 Bug Fix scx: Agregada la generación del PJX/PJ2 cuando se indica "file.pjx", "*" (Lutz Scheffler) * 03/03/2015 FDBOZZO v1.19.42 Mejora: Agregado soporte multi-proyecto (*.PJX, *.PJ2) cuando se especifica "file.pjx", "*" (Lutz Scheffler) * 05/03/2015 FDBOZZO v1.19.42 Mejora: Cambiada la clase de base de FoxBin2Prg de custom a session (Lutz Scheffler) * 05/03/2015 FDBOZZO v1.19.42 Mejora: Permitir procesar los archivos de un proyecto sin convertir el PJX/2, usando *- (Lutz Scheffler) * 06/03/2015 FDBOZZO v1.19.42 Bug Fix pjx: Permitir usar fin de linea (CR/LF) en los atributos de versión del PJX * 10/03/2015 FDBOZZO v1.19.42 Mejora API: Agregado soporte de errOut e implementado en writeErrorLog * 10/03/2015 FDBOZZO v1.19.42 Mejora: Agregado soporte total de comodines *? en nombres de archivo para procesar múltiples archivos de la misma extensión (Lutz Scheffler) * 10/03/2015 FDBOZZO v1.19.42 Mejora API: Nuevo parámetro para permitir un CFG alternativo (Lutz Scheffler) * 10/03/2015 FDBOZZO v1.19.42 Mejora API: Nuevo método get_Processed() para obtener información de los archivos procesados (Lutz Scheffler) * 10/03/2015 FDBOZZO v1.19.42 Mejora: Nueva salida de archivos procesados a stdOut (Lutz Scheffler) * 10/03/2015 FDBOZZO v1.19.42 Bug Fix: Arreglada la cancelación del procesamiento con tecla Esc * 22/03/2015 FDBOZZO v1.19.42 Mejora: Ordenar los campos de vistas y tablas alfabéticamente y mantener en una lista aparte el orden real, para facilitar el diff y el merge (Ryan Harris) * 22/03/2015 FDBOZZO v1.19.42 Mejora: Aplicar ClassPerFile a las conexiones, tablas, vistas y stored procedures de los DBC (Ryan Harris) * 23/03/2015 FDBOZZO v1.19.42 Bug Fix mnx: No se mantiene el Pad vacío al regenerar el menú cuando se define un menu con un Pad sin nombre (Lutz Scheffler) * 25/03/2015 FDBOZZO v1.19.42 Mejora API: Nueva propiedad l_ProcessFiles que permite obtener la lista de archivos a procesar sin procesarlos realmente usando el valor .F. * 25/03/2015 FDBOZZO v1.19.42 Bug Fix frx/lbx: Arreglo de CR,LF,TAB sobrantes en algunos archivos FR2/LB2 agregados en versiones anteriores (Ryan Harris) * 02/04/2015 FDBOZZO v1.19.42 Mejora: Herencia de CFGs entre directorios * 12/04/2015 FDBOZZO v1.19.42 Mejora API: Crear un método API get_DirSettings() para obtener información de seteos del directorio indicado (Lutz Scheffler) * 13/04/2015 FDBOZZO v1.19.42 Mejora: Permitir generar texto de una clase de una librería (Lutz Scheffler) * 16/04/2015 FDBOZZO v1.19.42 Mejora API: Renombrados los nombres de los métodos al Inglés para facilitar su entendimiento internacional (Mike Potjer) * 23/04/2015 FDBOZZO v1.19.43 Mejora: Nueva configuración "RemoveZOrderSetFromProps" para quitar la propiedad ZOrderSet de los objetos que cambian constantemente, provocan diferencias y a veces dan problemas de objeto encima/debajo (Ryan Harris) * 23/04/2015 FDBOZZO v1.19.43 Mejora: Hacer que la progressbar no se convierta en la ventana de salida por defecto de los ? (Lutz Scheffler) * 28/04/2015 FDBOZZO v1.19.43 Bug Fix: FoxBin2Prg no retorna códigos de error cuando se llama como programa externo (Ralf Wagner) * 29/04/2015 FDBOZZO v1.19.42 Bug Fix: FoxBin2Prg a veces genera errores OLE cuando se ejecuta más de una vez en modo objeto sobre un archivo con errores (Fidel Charny) * * *--------------------------------------------------------------------------------------------------- * * 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) * 19/11/2014 edyshor MEJORA cfg v1.19.36: DBF_Conversion_Excluded no permite comentarios && al final (Agregado en v1.19.37) * 19/11/2014 edyshor REPORTE BUG dbf v1.19.36: "String is too long to fit" cuando se procesa un DBF grande con DBF_Conversion_Support = 4 (Agregado en v1.19.37) * 19/11/2014 edyshor MEJORA dbf v1.19.36: Nuevo parámetro ClearDBFLastUpdate para evitar diferencias por este dato (Agregado en v1.19.37) * 14/10/2014 Lutz Scheffler MEJORA v1.19.36: Permitir generar una clase por archivo (pregunta) (Agregado en v1.19.37) * 21/10/2014 Ryan Harris MEJORA v1.19.36: Permitir generar una clase por archivo (sugerencia) (Agregado en v1.19.37) * 04/12/2014 Francisco Prieto MEJORA v1.19.36: Permitir hacer conversiones masivas bin2prg y prg2bin sin los scripts vbs (Agregado en v1.19.38) * 12/12/2014 Álvaro Castrillón MEJORA v1.19.36: Detección de métodos duplicados para notificar casos de corrupción (Agregado en v1.19.38) * 16/12/2014 Mike Potjer Mejora v1.19.38: Cuando se usan las claves BIN2PRG o PRG2BIN permitir procesar un archivo solo (Agregado en v1.19.39) * 16/12/2014 Mike Potjer Mejora v1.19.38: Agregar la clave SHOWMSG y dejar INTERACTIVE para un diálogo interactivo (Agregado en v1.19.39) * 16/12/2014 Mike Potjer Mejora v1.19.38: Cuando se procesa un directorio con foxbin2prg.exe solo y la clave INTERACTIVE, mostrar un diálogo para preguntar qué procesar (Agregado en v1.19.39) * 30/12/2014 Ryan Harris Reporte bug dbc v1.19.38: Los datos de DisplayClass y DisplayClassLibrary tenían el valor de "Default" en vez del propio (Agregado en v1.19.39) * 06/01/2015 Jim Nelson Mejora v1.19.39: Permitir configurar la barra de progreso para que solamente aparezca cuando se procesan múltiples archivos y no cuando se procesa solo 1 (Agregado en v1.19.40) * 06/01/2015 Mike Potjer Reporte bug db2: [Error 12, Variable "TCOUTPUTFILE" is not found] cuando DBF_Conversion_Support=4 y el archivo de salida es igual al generado (Agregado en v1.19.40) * 13/01/2015 Ryan Harris Reporte bug vcx/scx v1.19.40: Detección errónea de estructuras PROCEDURE/ENDPROC cuando se usan como parámetros LPARAMETERS en línea aparte (Arreglado en v1.19.41) * 24/01/2015 Ryan Harris Mejora dc2 v1.19.41: Permitir ordenar los campos de vistas y tablas alfabéticamente y mantener en una lista aparte el orden real, para facilitar el diff y el merge (Agregado en v1.19.42) * 24/01/2015 Ryan Harris Mejora dc2 v1.19.41: Aplicar ClassPerFile a las conexiones, tablas, vistas y stored procedures de los DBC (Agregado en v1.19.42) * 22/01/2015 Tuvia Vinitsky Reporte bug v1.19.41: Compatibilidad con SourceSafe rota porque se genera un error al realizar la consulta para soporte de archivo (Arreglado en v1.19.42) * 25/02/2015 Lutz Scheffler Reporte de Bug scx/vcx v1.19.41: Procesar solo un nivel de text/endtext, ya que no se admiten más niveles (Arreglado en v1.19.42) * 25/02/2015 Lutz Scheffler Mejora v1.19.41: Hacer algunos mensajes de error más descriptivos (Agregado en v1.19.42) * 03/03/2015 Lutz Scheffler Mejora v1.19.41: Mejoras en la traducción al alemán (Agregado en v1.19.42) * 03/03/2015 Lutz Scheffler Mejora v1.19.41: Permitir definir el archivo de entrada con un path relativo (Agregado en v1.19.42) * 03/03/2015 Lutz Scheffler Reporte bug scx v1.19.41: Agregada la generación del PJX/PJ2 cuando se indica "file.pjx", "*" (Agregado en v1.19.42) * 03/03/2015 Lutz Scheffler Mejora v1.19.41: Permitir proceso multi-proyecto (*.PJX, *.PJ2) cuando se especifica "file.pjx", "*" (Agregado en v1.19.42) * 05/03/2015 Lutz Scheffler Mejora v1.19.41: Cambiar clase de base de FoxBin2Prg de custom a session (Agregado en v1.19.42) * 05/03/2015 Lutz Scheffler Mejora v1.19.41: Permitir procesar los archivos de un proyecto sin convertir el PJX/2 (Agregado en v1.19.42) * 10/03/2015 Lutz Scheffler Mejora v1.19.41: Permitir configurar un CFG alternativo (Agregado en v1.19.42) * 10/03/2015 Lutz Scheffler Mejora v1.19.41: Crear un método API get_Processed() para obtener información de los archivos procesados (Agregado en v1.19.42) * 10/03/2015 Lutz Scheffler Mejora v1.19.41: Permitir salida de archivos procesados a stdOut (Agregado en v1.19.42) * 23/03/2015 Lutz Scheffler Reporte bug mnx v1.19.41: No se mantiene el Pad vacío al regenerar el menú cuando se define un menu con un Pad sin nombre (Arreglado en v1.19.42) * 24/03/2015 Ryan Harris Reporte bug frx/lbx v1.19.41: Hay algunos CR,LF,TAB sobrantes en las etiquetas tag de algunos archivos FR2/LB2 (Arreglado en v1.19.42) * 24/03/2015 Ryan Harris Mejora v1.19.41: Borrar archivos ERR al procesar, cuando se usa UseClassPerFile (Agregado en v1.19.42) * 10/04/2015 Lutz Scheffler Mejora v1.19.41: Crear un método API get_DirSettings() para obtener información de seteos del directorio indicado (Agregado en v1.19.42) * 12/04/2015 Lutz Scheffler Mejora v1.19.41: Permitir generar texto de una clase de una librería (Agregado en v1.19.42) * 15/04/2015 Mike Potjer Sugerencia v1.19.41: Los nombres de los métodos en Inglés facilitarían su entendimiento a más personas (Agregado en v1.19.42) * 22/04/2015 Ryan Harris Mejora v1.19.42: Permitir que FoxBin quite los ZOrderProps de los objetos que cambian constantemente, provocan diferencias y a veces dan problemas de objeto encima/debajo (Agregado en v1.19.43) * 23/04/2015 Lutz Scheffler Mejora v1.19.42: Hacer que la progressbar no se convierta en la ventana de salida por defecto de los ? (Agregado en v1.19.43) * 28/04/2015 Ralf Wagner Reporte Bug v1.19.42: FoxBin2Prg no retorna códigos de error cuando se llama como programa externo (Arreglado en v1.19.43) * 29/04/2015 Fidel Charny Reporte Bug v1.19.42: FoxBin2Prg a veces genera errores OLE cuando se ejecuta más de una vez en modo objeto sobre un archivo con errores (Arreglado en v1.19.43) * * *--------------------------------------------------------------------------------------------------- * 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 o nombre del directorio a procesar * - En modo compatibilidad con Visual SourceSafe, se usa para preguntar el tipo de soporte de conversión para el tipo de archivo indicado * tcType (v? IN ) Tipo de archivo de entrada * - Si se indica "BIN2PRG", se procesa el directorio indicado para generar los TX2 * - Si se indica "PRG2BIN", se procesa el directorio indicado para generar los BIN * - Si se indica "SIMERR_I0", se simula un error de validación en el archivo de entrada * - Si se indica "SIMERR_I1", se simula un error de programa en el archivo de entrada * - Si se indica "SIMERR_O1", se simula un error de programa en el archivo de salida * - Si se indica "*" y tc_InputFile es un PJX, se procesa todo el proyecto * - En modo compatibilidad con Visual SourceSafe, indica el tipo de archivo a convertir * tcTextName (v? IN ) Nombre del archivo texto. (Solo para compatibilidad con Visual SourceSafe) * tlGenText (v? IN ) .T.=Genera Texto, .F.=Genera Binario. (Solo para compatibilidad con Visual SourceSafe) * tcDontShowErrors (v? IN ) '1' para NO mostrar 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) * tcCFG_File (v? IN ) Indica si se debe usar un archivo de configuración distinto al predeterminado *--------------------------------------------------------------------------------------------------- * Ej: DO FOXBIN2PRG.PRG WITH "C:\DESA\INTEGRACION\LIBRERIA.VCX" *--------------------------------------------------------------------------------------------------- LPARAMETERS tc_InputFile, tcType, tcTextName, tlGenText, tcDontShowErrors, tcDebug, tcDontShowProgress, tcOriginalFileName ; , tcRecompile, tcNoTimestamps, tcCFG_File *-- NO modificar! / Do NOT change! #DEFINE C_CMT_I '*--' #DEFINE C_CMT_F '--*' #DEFINE C_CLASSCOMMENTS_I '*' #DEFINE C_CLASSCOMMENTS_F '*' #DEFINE C_LEN_CLASSCOMMENTS_I LEN(C_CLASSCOMMENTS_I) #DEFINE C_LEN_CLASSCOMMENTS_F LEN(C_CLASSCOMMENTS_F) #DEFINE C_CLASSDATA_I '*< CLASSDATA:' #DEFINE C_CLASSDATA_F '/>' #DEFINE C_LEN_CLASSDATA_I LEN(C_CLASSDATA_I) #DEFINE C_EXTERNAL_CLASS_I '*< EXTERNAL_CLASS:' #DEFINE C_EXTERNAL_CLASS_F '/>' #DEFINE C_LEN_EXTERNAL_CLASS_I LEN(C_EXTERNAL_CLASS_I) #DEFINE C_EXTERNAL_MEMBER_I '*< EXTERNAL_MEMBER:' #DEFINE C_EXTERNAL_MEMBER_F '/>' #DEFINE C_LEN_EXTERNAL_MEMBER_I LEN(C_EXTERNAL_MEMBER_I) #DEFINE C_OBJECTDATA_I '*< OBJECTDATA:' #DEFINE C_OBJECTDATA_F '/>' #DEFINE C_LEN_OBJECTDATA_I LEN(C_OBJECTDATA_I) #DEFINE C_OLE_I '*< OLE:' #DEFINE C_OLE_F '/>' #DEFINE C_LEN_OLE_I LEN(C_OLE_I) #DEFINE C_DEFINED_PAM_I '*' #DEFINE C_DEFINED_PAM_F '*' #DEFINE C_LEN_DEFINED_PAM_I LEN(C_DEFINED_PAM_I) #DEFINE C_LEN_DEFINED_PAM_F LEN(C_DEFINED_PAM_F) #DEFINE C_END_OBJECT_I '*< END OBJECT:' #DEFINE C_END_OBJECT_F '/>' #DEFINE C_LEN_END_OBJECT_I LEN(C_END_OBJECT_I) #DEFINE C_FB2PRG_META_I '*< FOXBIN2PRG:' #DEFINE C_FB2PRG_META_F '/>' #DEFINE C_LIBCOMMENT_I '*< LIBCOMMENT:' #DEFINE C_LIBCOMMENT_F '/>' #DEFINE C_DEFINE_CLASS 'DEFINE CLASS' #DEFINE C_ENDDEFINE 'ENDDEFINE' #DEFINE C_TEXT 'TEXT' #DEFINE C_ENDTEXT 'ENDTEXT' #DEFINE C_PROCEDURE 'PROCEDURE' #DEFINE C_ENDPROC 'ENDPROC' #DEFINE C_WITH 'WITH' #DEFINE C_ENDWITH 'ENDWITH' #DEFINE C_SRV_HEAD_I '*' #DEFINE C_SRV_HEAD_F '*' #DEFINE C_SRV_DATA_I '*' #DEFINE C_SRV_DATA_F '*' #DEFINE C_DEVINFO_I '*' #DEFINE C_DEVINFO_F '*' #DEFINE C_BUILDPROJ_I '*' #DEFINE C_BUILDPROJ_F '*' #DEFINE C_PROJPROPS_I '*' #DEFINE C_PROJPROPS_F '*' #DEFINE C_FILE_META_I '*< FileMetadata:' #DEFINE C_FILE_META_F '/>' #DEFINE C_FILE_CMTS_I '*' #DEFINE C_FILE_CMTS_F '*' #DEFINE C_FILE_EXCL_I '*' #DEFINE C_FILE_EXCL_F '*' #DEFINE C_FILE_TXT_I '*' #DEFINE C_FILE_TXT_F '*' #DEFINE C_FB2P_VALUE_I '' #DEFINE C_FB2P_VALUE_F '' #DEFINE C_LEN_FB2P_VALUE_I LEN(C_FB2P_VALUE_I) #DEFINE C_LEN_FB2P_VALUE_F LEN(C_FB2P_VALUE_F) #DEFINE C_VFPDATA_I '' #DEFINE C_VFPDATA_F '' #DEFINE C_MEMBERDATA_I C_VFPDATA_I #DEFINE C_MEMBERDATA_F C_VFPDATA_F #DEFINE C_LEN_MEMBERDATA_I LEN(C_MEMBERDATA_I) #DEFINE C_LEN_MEMBERDATA_F LEN(C_MEMBERDATA_F) #DEFINE C_DATA_I '' #DEFINE C_TAG_REPORTE 'Reportes' #DEFINE C_TAG_REPORTE_I '<' + C_TAG_REPORTE + '>' #DEFINE C_TAG_REPORTE_F '' #DEFINE C_DBF_HEAD_I '' #DEFINE C_LEN_DBF_HEAD_I LEN(C_DBF_HEAD_I) #DEFINE C_LEN_DBF_HEAD_F LEN(C_DBF_HEAD_F) #DEFINE C_CDX_I '' #DEFINE C_CDX_F '' #DEFINE C_LEN_CDX_I LEN(C_CDX_I) #DEFINE C_LEN_CDX_F LEN(C_CDX_F) #DEFINE C_LEN_INDEX_I LEN(C_INDEX_I) #DEFINE C_LEN_INDEX_F LEN(C_INDEX_F) #DEFINE C_DATABASE_I '' #DEFINE C_DATABASE_F '' #DEFINE C_STORED_PROC_I '' #DEFINE C_TABLE_I '' #DEFINE C_TABLE_F '
' #DEFINE C_TABLES_I '' #DEFINE C_TABLES_F '' #DEFINE C_VIEW_I '' #DEFINE C_VIEW_F '' #DEFINE C_VIEWS_I '' #DEFINE C_VIEWS_F '' #DEFINE C_FIELD_ORDER_I '' #DEFINE C_FIELD_ORDER_F '' #DEFINE C_FIELD_I '' #DEFINE C_FIELD_F '' #DEFINE C_FIELDS_I '' #DEFINE C_FIELDS_F '' #DEFINE C_CONNECTION_I '' #DEFINE C_CONNECTION_F '' #DEFINE C_CONNECTIONS_I '' #DEFINE C_CONNECTIONS_F '' #DEFINE C_RELATION_I '' #DEFINE C_RELATION_F '' #DEFINE C_RELATIONS_I '' #DEFINE C_RELATIONS_F '' #DEFINE C_INDEX_I '' #DEFINE C_INDEX_F '' #DEFINE C_INDEXES_I '' #DEFINE C_INDEXES_F '' #DEFINE C_PROC_CODE_I '*' #DEFINE C_PROC_CODE_F '*' #DEFINE C_SETUPCODE_I '*' #DEFINE C_SETUPCODE_F '*' #DEFINE C_CLEANUPCODE_I '*' #DEFINE C_CLEANUPCODE_F '*' #DEFINE C_MENUCODE_I '*' #DEFINE C_MENUCODE_F '*' #DEFINE C_MENUTYPE_I '*' #DEFINE C_MENUTYPE_F '' #DEFINE C_MENULOCATION_I '*' #DEFINE C_MENULOCATION_F '' *-- #DEFINE C_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 *-- FileTypes for ADIR() #DEFINE C_FILETYPE_DIRECTORY "D" #DEFINE C_FILETYPE_FILE "F" #DEFINE C_FILETYPE_QUERYSUPPORT "Q" *-- Fin / End LOCAL loCnv AS c_foxbin2prg OF 'FOXBIN2PRG.PRG' LOCAL lnResp, loEx AS EXCEPTION *SET COVERAGE TO c:\desa\foxbin2prg\foxbin2prg_coverage.log *SYS(2030,1) && Enable system component debugging *SYS(2335,0) && Unnatended server mode *IF PCOUNT() > 1 && Saltear las querys de SourceSafe sobre soporte de archivos * SET STEP ON * MESSAGEBOX( SYS(5)+CURDIR(),64+4096,PROGRAM(),5000) *ENDIF *MESSAGEBOX( 'tc_InputFile = ' + TRANSFORM(tc_InputFile) + C_CR ; + 'tcType = ' + TRANSFORM(tcType) ) *-- En el caso de recibir "BIN2PRG" o "PRG2BIN" en el primer parámetro, los invierto. tc_InputFile = EVL(tc_InputFile,'') tcType = EVL(tcType,'') IF ATC('-BIN2PRG','-'+tc_InputFile) > 0 OR ATC('-PRG2BIN','-'+tc_InputFile) > 0 ; OR ATC('-SHOWMSG','-'+tc_InputFile) > 0 OR ATC('-INTERACTIVE','-'+tc_InputFile) > 0 ; OR ATC('-SIMERR_I0','-'+tc_InputFile) > 0 OR ATC('-SIMERR_I1','-'+tc_InputFile) > 0 ; OR ATC('-SIMERR_O1','-'+tc_InputFile) > 0 THEN pcParamX = tc_InputFile tc_InputFile = tcType tcType = pcParamX RELEASE pcParamX ENDIF loCnv = CREATEOBJECT("c_foxbin2prg") loEx = NULL lnResp = loCnv.execute( tc_InputFile, tcType, tcTextName, tlGenText, tcDontShowErrors, tcDebug ; , tcDontShowProgress, NULL, @loEx, .F., tcOriginalFileName, tcRecompile, tcNoTimestamps ; , .F., .F., .F., tcCFG_File ) ADDPROPERTY(_SCREEN, 'ExitCode', lnResp) *SET COVERAGE TO IF _VFP.STARTMODE <> 4 && 4 = Visual FoxPro was started as a distributable .app or .exe file. STORE NULL TO loEx, loCnv RELEASE loEx, loCnv RETURN lnResp && lnResp contiene un código de error, pero invocado desde SourceSafe puede contener el tipo de soporte de archivo (0,1,2). ENDIF IF EMPTY(lnResp) STORE NULL TO loEx, loCnv RELEASE loEx, loCnv QUIT ENDIF 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 && To read returned error code with ERRORLEVEL from Windows ExitProcess(1) && Esta debe ser de las últimas instrucciones QUIT DEFINE CLASS c_foxbin2prg AS Session _MEMBERDATA = [] ; + [] ; + [] ; + [] ; + [] ; + [] ; + [] ; + [] ; + [] ; + [] ; + [] ; + [] ; + [] ; + [] ; + [] ; + [] ; + [] ; + [] ; + [] ; + [] ; + [] ; + [] ; + [] ; + [] ; + [] ; + [] ; + [] ; + [] ; + [] ; + [] ; + [] ; + [] ; + [] ; + [] ; + [] ; + [] ; + [] ; + [] ; + [] ; + [] ; + [] ; + [] ; + [] ; + [] ; + [] ; + [] ; + [] ; + [] ; + [] ; + [] ; + [] ; + [] ; + [] ; + [] ; + [] ; + [] ; + [] ; + [] ; + [] ; + [] ; + [] ; + [] ; + [] ; + [] ; + [] ; + [] ; + [] ; + [] ; + [] ; + [] ; + [] ; + [] ; + [] ; + [] ; + [] ; + [] ; + [] ; + [] ; + [] ; + [] ; + [] ; + [] ; + [] ; + [] ; + [] ; + [] ; + [] ; + [] ; + [] ; + [] ; + [] ; + [] ; + [] ; + [] ; + [] ; + [] ; + [] ; + [] ; + [] ; + [] ; + [] ; + [] ; + [] ; + [] ; + [] ; + [] ; + [] ; + [] ; + [] ; + [] ; + [] ; + [] ; + [] ; + [] ; + [] ; + [] ; + [] DIMENSION a_ProcessedFiles(1, 6) PROTECTED n_CFG_Actual, l_Main_CFG_Loaded, o_Configuration, l_CFG_CachedAccess *-- n_FB2PRG_Version = 1.19 *-- c_Language = '' && EN, FR, ES, DE c_SimulateError = '' && SIMERR_I0, SIMERR_I1, SIMERR_O1 c_loc_processing_file = '' c_loc_process_progress = '' c_FB2PRG_EXE_Version = '' c_Foxbin2prg_FullPath = '' c_Foxbin2prg_ConfigFile = '' c_CurDir = '' c_InputFile = '' c_ClassToConvert = '' && Guarda el nombre de la clase a convertir, indicada en tcInputFile como "archivo.vcx::clase" c_OriginalFileName = '' c_LogFile = ADDBS( SYS(2023) ) + 'FoxBin2Prg_Debug.LOG' c_ErrorLogFile = ADDBS( SYS(2023) ) + 'FoxBin2Prg_Error.LOG' c_TextLog = '' c_OutputFile = '' c_Recompile = '1' c_Type = '' t_InputFile_TimeStamp = {//::} t_OutputFile_TimeStamp = {//::} lFileMode = .F. n_ExisteCapitalizacion = -1 l_CFG_CachedAccess = .F. n_Debug = 0 l_Error = .F. c_TextErr = '' l_Test = .F. l_ShowErrors = .T. n_ShowProgressbar = 1 n_ForceWriteIfReadOnly = 0 l_AutoClearProcessedFiles = .T. && Por defecto limpia archivos procesados entre ejecución y ejecución l_ProcessFiles = .T. && Por defecto procesa los archivos. En .F. sirve para obtener sus nombres sin reescribirlos. l_CancelWithEscKey = .T. l_RemoveNullCharsFromCode = .T. l_RemoveZOrderSetFromProps = .F. l_Recompile = .T. n_UseClassPerFile = 0 l_ClassPerFileCheck = .F. l_RedirectClassPerFileToMain = .F. l_NoTimestamps = .T. c_BackgroundImage = '' l_ClearUniqueID = .T. l_ClearDBFLastUpdate = .T. n_OptimizeByFilestamp = 0 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_StdOutHabilitado = .T. l_Main_CFG_Loaded = .F. n_ExtraBackupLevels = 1 n_ClassTimeStamp = 1130668032 && 2013/11/04 20:00:00 n_CFG_Actual = 0 n_ID = 0 n_FileHandle = 0 n_Order_View_Fields = 1 n_ProcessedFiles = 0 && Contador usado para los archivos file.class.ext n_ProcessedFilesCount = 0 && Contador genérico de procesados o_Conversor = NULL o_Frm_Avance = NULL o_WSH = NULL o_FSO = NULL o_FNC = NULL && Filename_caps object 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 LPARAMETERS tcCFG_File, tcCancelWithEscKey #IF .F. LOCAL THIS AS c_foxbin2prg OF 'FOXBIN2PRG.PRG' #ENDIF LOCAL lcSys16, lnPosProg, lc_Foxbin2prg_EXE, laValues(1,5), lcPicturePath SET DELETED ON SET DATE YMD SET HOURS TO 24 SET CENTURY ON SET SAFETY OFF SET MULTILOCKS ON SET TABLEPROMPT OFF SET POINT TO '.' SET SEPARATOR TO ',' tcCancelWithEscKey = EVL(tcCancelWithEscKey, '') IF NOT EMPTY(tcCancelWithEscKey) THIS.l_CancelWithEscKey = ( tcCancelWithEscKey == '1' ) ENDIF THIS.declareDLL() IF FILE(THIS.c_ErrorLogFile) THEN ERASE (THIS.c_ErrorLogFile + '.BAK') RENAME (THIS.c_ErrorLogFile) TO (THIS.c_ErrorLogFile + '.BAK') ENDIF IF FILE(THIS.c_LogFile) THEN ERASE (THIS.c_LogFile + '.BAK') RENAME (THIS.c_LogFile) TO (THIS.c_LogFile + '.BAK') ENDIF lcSys16 = SYS(16) IF LEFT(lcSys16,10) == 'PROCEDURE ' lnPosProg = AT(" ", lcSys16, 2) + 1 ELSE lnPosProg = 1 ENDIF THIS.c_CurDir = SYS(5) + CURDIR() && Directorio actual, que no necesariamente es donde está FoxBin2Prg THIS.c_Foxbin2prg_FullPath = SUBSTR( lcSys16, lnPosProg ) THIS.c_Foxbin2prg_ConfigFile = EVL( tcCFG_File, FORCEEXT( THIS.c_Foxbin2prg_FullPath, 'CFG' ) ) THIS.c_BackgroundImage = THIS.get_AbsolutePath( ADDBS(JUSTPATH(THIS.c_Foxbin2prg_FullPath)) + 'foxbin2prg.jpg' ) lc_Foxbin2prg_EXE = FORCEEXT( THIS.c_Foxbin2prg_FullPath, 'EXE' ) THIS.c_FB2PRG_EXE_Version = 'v' + IIF( AGETFILEVERSION( laValues, lc_Foxbin2prg_EXE ) = 0, TRANSFORM(THIS.n_FB2PRG_Version), laValues(11) ) ADDPROPERTY(_SCREEN, 'c_FB2PRG_EXE_Version', THIS.c_FB2PRG_EXE_Version) ADDPROPERTY(_SCREEN, 'ExitCode', 0) THIS.writeLog( REPLICATE( '*', 100 ) ) THIS.writeLog( 'FoxBin2Prg INIT -', 2 ) THIS.writeLog( REPLICATE( '*', 100 ) ) THIS.writeLog( 'FoxBin2Prg: [' + THIS.c_Foxbin2prg_FullPath + '] (EXE Version: ' + THIS.c_FB2PRG_EXE_Version + ', FoxPro Version: ' + VERSION(4) + ')' ) THIS.changeLanguage() THIS.o_FSO = CREATEOBJECT("Scripting.FileSystemObject") THIS.o_WSH = CREATEOBJECT("WScript.Shell") THIS.o_Configuration = CREATEOBJECT("COLLECTION") THIS.evaluateConfiguration() RELEASE lcSys16, lnPosProg, lc_Foxbin2prg_EXE, laValues RETURN ENDPROC PROCEDURE DESTROY TRY LOCAL lcFileCDX lcFileCDX = FORCEPATH( "TABLABIN.CDX", JUSTPATH(THIS.c_InputFile) ) ERASE ( lcFileCDX ) THIS.writeLog( 'FoxBin2Prg UNLOAD -', 2 ) THIS.writeLog( REPLICATE( '*', 100 ) ) THIS.writeLog( ) THIS.writeLog_Flush() THIS.unloadProgressbarForm() CATCH FINALLY THIS.o_FSO = NULL THIS.o_WSH = NULL THIS.o_FNC = NULL *-- Funciones para changeFileAttributes CLEAR DLLS fb2p_SetFileAttributes, fb2p_GetFileAttributes *-- Funciones para escribir en StdOut CLEAR DLLS fb2p_GetStdHandle, fb2p_WriteFile *-- Funciones para changeFileTime CLEAR DLLS fb2p_SetFileTime, fb2p_GetFileAttributesEx, fb2p_LocalFileTimeToFileTime ; , fb2p_FileTimeToSystemTime, fb2p_SystemTimeToFileTime, fb2p_lopen, fb2p_lclose ENDTRY RETURN ENDPROC PROCEDURE addProcessedFile *--------------------------------------------------------------------------------------------------- * PARÁMETROS: (v=Pasar por valor | @=Pasar por referencia) (!=Obligatorio | ?=Opcional) (IN/OUT) * tcFile (v? IN ) Path del archivo (ej: 'C:\DESA\pruebas varias\lib.vcx') * tcInOutType (v? IN ) Archivo de entrada o de salida ("I"=Input file, "O"=Output file) * tcProcessed (v? IN ) Procesado ("P0"=Not Processed, "P1"=Processed) * tcHasErrors (v? IN ) Tuvo Errores ("E0"=No Errors, "E1"=Has Errors) * tcSupported (v? IN ) Archivo soportado ("S0"=Unsupported, "S1"=Supported) * tcExpanded (v? IN ) Tipo de archivo ("X0"=Normal file, "X1"=Expanded multipart file) *--------------------------------------------------------------------------------------------------- LPARAMETERS tcFile, tcInOutType, tcProcessed, tcHasErrors, tcSupported, tcExpanded LOCAL llAdded IF NOT EMPTY(tcFile) THEN WITH THIS AS c_foxbin2prg OF 'FOXBIN2PRG.PRG' *-- Buscar si fue procesado antes IF NOT .wasProcessed(tcFile) THEN .n_ProcessedFiles = .n_ProcessedFiles + 1 DIMENSION .a_ProcessedFiles(.n_ProcessedFiles, 6) .a_ProcessedFiles(.n_ProcessedFiles, 1) = tcFile .a_ProcessedFiles(.n_ProcessedFiles, 2) = EVL(tcInOutType, '') .a_ProcessedFiles(.n_ProcessedFiles, 3) = EVL(tcProcessed, '') .a_ProcessedFiles(.n_ProcessedFiles, 4) = EVL(tcHasErrors, '') .a_ProcessedFiles(.n_ProcessedFiles, 5) = EVL(tcSupported, '') .a_ProcessedFiles(.n_ProcessedFiles, 6) = EVL(tcExpanded, '') llAdded = .T. ENDIF ENDWITH ENDIF RETURN llAdded ENDPROC PROCEDURE wasProcessed *--------------------------------------------------------------------------------------------------- * PARÁMETROS: (v=Pasar por valor | @=Pasar por referencia) (!=Obligatorio | ?=Opcional) (IN/OUT) * tcFileMask (v! IN ) Fullpath del archivo del que se desea saber si se procesó *--------------------------------------------------------------------------------------------------- LPARAMETERS tcFile, tnID tnID = 0 IF THIS.n_ProcessedFiles = 0 RETURN .F. ENDIF tnID = ASCAN( THIS.a_ProcessedFiles, tcFile, 1, 0, 1, 1+2+4 ) RETURN (tnID > 0) ENDPROC PROCEDURE updateProgressbar LPARAMETERS tcTexto, tnValor, tnTotal, tnTipo TRY *-- Si o_Frm_Avance se habilitó de forma externa, n_ShowProgressbar podría ser 0 para controlarlo desde fuera. WITH THIS AS c_foxbin2prg OF 'FOXBIN2PRG.PRG' IF VARTYPE(.o_Frm_Avance) = "O" THEN *-- Cuando esta rutina se invoca desde el script, este método es el #1 y no puede cancelarse todavía IF .o_Frm_Avance.l_Cancelled AND PROGRAM(-1) > 1 THEN ERROR 1799 ENDIF .o_Frm_Avance.updateProgressbar( tcTexto, tnValor, tnTotal, tnTipo ) ENDIF ENDWITH CATCH THROW ENDTRY ENDPROC PROCEDURE changeLanguage LPARAMETERS tcLanguageId _SCREEN.AddProperty( "o_FoxBin2Prg_Lang", CREATEOBJECT("CL_LANG", tcLanguageId) ) *-- Localized properties THIS.c_Language = _SCREEN.o_FoxBin2Prg_Lang.C_LANGUAGE_LOC THIS.c_loc_processing_file = _SCREEN.o_FoxBin2Prg_Lang.C_PROCESSING_LOC THIS.c_loc_process_progress = _SCREEN.o_FoxBin2Prg_Lang.C_PROCESS_PROGRESS_LOC ENDPROC PROCEDURE clearProcessedFiles *-- Limpia las estadísticas de archivos procesados que se usan para optimizar *-- el procesamiento y evitar el reproceso de los mismos archivos, por ejemplo, *-- de un mismo VCX compartido por 2 ó más proyectos. WITH THIS AS c_foxbin2prg OF 'FOXBIN2PRG.PRG' .n_ProcessedFilesCount = 0 .n_ProcessedFiles = 0 DIMENSION .a_ProcessedFiles(1, 6) .a_ProcessedFiles = '' ENDWITH ENDPROC PROCEDURE declareDLL *-- Funciones para escribir en StdOut DECLARE INTEGER 'GetStdHandle' IN WIN32API AS fb2p_GetStdHandle INTEGER nHandleType DECLARE INTEGER 'WriteFile' IN WIN32API AS fb2p_WriteFile INTEGER hFile, STRING @ cBuffer, INTEGER nBytes, INTEGER @ nBytes2, INTEGER @ nBytes3 *-- Funciones para changeFileTime DECLARE INTEGER 'SetFileTime' IN WIN32API AS fb2p_SetFileTime INTEGER hFile, STRING lpCreationTime, STRING lpLastAccessTime, STRING lpLastWriteTime DECLARE INTEGER 'GetFileAttributesEx' IN Win32API AS fb2p_GetFileAttributesEx STRING lpFileName, INTEGER fInfoLevelId, STRING @ lpFileInformation DECLARE INTEGER 'LocalFileTimeToFileTime' IN Win32API AS fb2p_LocalFileTimeToFileTime STRING LOCALFILETIME, STRING @ FILETIME DECLARE INTEGER 'FileTimeToSystemTime' IN Win32API AS fb2p_FileTimeToSystemTime STRING FILETIME, STRING @ SYSTEMTIME DECLARE INTEGER 'SystemTimeToFileTime' IN Win32API AS fb2p_SystemTimeToFileTime STRING lpSYSTEMTIME, STRING @ FILETIME DECLARE INTEGER '_lopen' IN Win32API AS fb2p_lopen STRING lpFileName, INTEGER iReadWrite DECLARE INTEGER '_lclose' IN Win32API AS fb2p_lclose INTEGER hFile *-- Funciones para changeFileAttributes DECLARE SHORT 'SetFileAttributes' IN Win32API AS fb2p_SetFileAttributes STRING tcFileName, INTEGER dwFileAttributes DECLARE INTEGER 'GetFileAttributes' IN Win32API AS fb2p_GetFileAttributes STRING tcFileName *-- ENDPROC PROCEDURE get_AbsolutePath LPARAMETERS tc_InputFile, tc_FullPath *-- Ajusto la ruta si no es absoluta tc_InputFile = EVL(tc_InputFile,'') tc_FullPath = EVL(tc_FullPath, THIS.c_Foxbin2prg_FullPath) IF NOT EMPTY( JUSTEXT(tc_FullPath) ) THEN *-- Se indicó PATH+archivo.ext tc_FullPath = JUSTPATH(tc_FullPath) ENDIF tc_FullPath = ADDBS( tc_FullPath ) IF LEN(tc_InputFile) > 1 ; AND LEFT(LTRIM(tc_InputFile),2) <> '\\' ; AND SUBSTR(LTRIM(tc_InputFile),2,1) <> ':' THEN tc_InputFile = FULLPATH(tc_InputFile, tc_FullPath) ENDIF RETURN tc_InputFile ENDPROC FUNCTION get_l_ConfigEvaluated RETURN THIS.l_Main_CFG_Loaded ENDFUNC FUNCTION get_l_CFG_CachedAccess RETURN THIS.l_CFG_CachedAccess ENDFUNC FUNCTION get_Processed *--------------------------------------------------------------------------------------------------- * PARÁMETROS: (v=Pasar por valor | @=Pasar por referencia) (!=Obligatorio | ?=Opcional) (IN/OUT) * taProcessed (@! OUT) Array donde se devolverá la información de los archivos de la máscara indicada * tcFileMask (v? IN ) Máscara de archivo a buscar (nombre, "*", "?") *--------------------------------------------------------------------------------------------------- * ESTRUCTURA DEL ARRAY DEVUELTO: * col(1) tcFile - Path del archivo (ej: 'C:\DESA\pruebas varias\lib.vcx') * col(2) tcInOutType - Archivo de entrada o de salida ("I"=Input file, "O"=Output file) * col(3) tcProcessed - Procesado ("P0"=Not Processed, "P1"=Processed) * col(4) tcHasErrors - Tuvo Errores ("E0"=No Errors, "E1"=Has Errors) * col(5) tcSupported - Archivo soportado ("S0"=Unsupported, "S1"=Supported) * col(6) tcExpanded - Tipo de archivo ("X0"=Normal file, "X1"=Expanded multipart file) *--------------------------------------------------------------------------------------------------- LPARAMETERS taProcessed, tcFileMask EXTERNAL ARRAY taProcessed LOCAL lnCount, I lnCount = 0 WITH THIS AS c_foxbin2prg OF 'FOXBIN2PRG.PRG' tcFileMask = EVL(tcFileMask, '*') FOR I = 1 TO .n_ProcessedFiles IF LIKE( tcFileMask, JUSTFNAME(.a_ProcessedFiles(I,1)) ) THEN lnCount = lnCount + 1 DIMENSION taProcessed(lnCount,6) taProcessed(lnCount,1) = .a_ProcessedFiles(I,1) taProcessed(lnCount,2) = .a_ProcessedFiles(I,2) taProcessed(lnCount,3) = .a_ProcessedFiles(I,3) taProcessed(lnCount,4) = .a_ProcessedFiles(I,4) taProcessed(lnCount,5) = .a_ProcessedFiles(I,5) taProcessed(lnCount,6) = .a_ProcessedFiles(I,6) ENDIF ENDFOR ENDWITH RETURN lnCount ENDFUNC PROCEDURE n_Debug_ACCESS IF THIS.n_CFG_Actual = 0 OR ISNULL( THIS.o_Configuration( THIS.n_CFG_Actual ) ) RETURN THIS.n_Debug ELSE RETURN NVL( THIS.o_Configuration( THIS.n_CFG_Actual ).n_Debug, THIS.n_Debug ) ENDIF ENDPROC PROCEDURE l_ShowErrors_ACCESS IF THIS.n_CFG_Actual = 0 OR ISNULL( THIS.o_Configuration( THIS.n_CFG_Actual ) ) RETURN THIS.l_ShowErrors ELSE RETURN NVL( THIS.o_Configuration( THIS.n_CFG_Actual ).l_ShowErrors, THIS.l_ShowErrors ) ENDIF ENDPROC PROCEDURE n_ShowProgressbar_ACCESS IF THIS.n_CFG_Actual = 0 OR ISNULL( THIS.o_Configuration( THIS.n_CFG_Actual ) ) RETURN THIS.n_ShowProgressbar ELSE RETURN NVL( THIS.o_Configuration( THIS.n_CFG_Actual ).n_ShowProgressbar, THIS.n_ShowProgressbar ) ENDIF ENDPROC PROCEDURE l_NoTimestamps_ACCESS IF THIS.n_CFG_Actual = 0 OR ISNULL( THIS.o_Configuration( THIS.n_CFG_Actual ) ) RETURN THIS.l_NoTimestamps ELSE RETURN NVL( THIS.o_Configuration( THIS.n_CFG_Actual ).l_NoTimestamps, THIS.l_NoTimestamps ) ENDIF ENDPROC PROCEDURE n_UseClassPerFile_ACCESS IF THIS.n_CFG_Actual = 0 OR ISNULL( THIS.o_Configuration( THIS.n_CFG_Actual ) ) RETURN THIS.n_UseClassPerFile ELSE RETURN NVL( THIS.o_Configuration( THIS.n_CFG_Actual ).n_UseClassPerFile, THIS.n_UseClassPerFile ) ENDIF ENDPROC PROCEDURE l_RedirectClassPerFileToMain_ACCESS IF THIS.n_CFG_Actual = 0 OR ISNULL( THIS.o_Configuration( THIS.n_CFG_Actual ) ) RETURN THIS.l_RedirectClassPerFileToMain ELSE RETURN NVL( THIS.o_Configuration( THIS.n_CFG_Actual ).l_RedirectClassPerFileToMain, THIS.l_RedirectClassPerFileToMain ) ENDIF ENDPROC PROCEDURE l_RemoveNullCharsFromCode_ACCESS IF THIS.n_CFG_Actual = 0 OR ISNULL( THIS.o_Configuration( THIS.n_CFG_Actual ) ) RETURN THIS.l_RemoveNullCharsFromCode ELSE RETURN NVL( THIS.o_Configuration( THIS.n_CFG_Actual ).l_RemoveNullCharsFromCode, THIS.l_RemoveNullCharsFromCode ) ENDIF ENDPROC PROCEDURE l_RemoveZOrderSetFromProps_ACCESS IF THIS.n_CFG_Actual = 0 OR ISNULL( THIS.o_Configuration( THIS.n_CFG_Actual ) ) RETURN THIS.l_RemoveZOrderSetFromProps ELSE RETURN NVL( THIS.o_Configuration( THIS.n_CFG_Actual ).l_RemoveZOrderSetFromProps, THIS.l_RemoveZOrderSetFromProps ) ENDIF ENDPROC PROCEDURE l_ClassPerFileCheck_ACCESS IF THIS.n_CFG_Actual = 0 OR ISNULL( THIS.o_Configuration( THIS.n_CFG_Actual ) ) RETURN THIS.l_ClassPerFileCheck ELSE RETURN NVL( THIS.o_Configuration( THIS.n_CFG_Actual ).l_ClassPerFileCheck, THIS.l_ClassPerFileCheck ) ENDIF ENDPROC PROCEDURE l_ClearUniqueID_ACCESS IF THIS.n_CFG_Actual = 0 OR ISNULL( THIS.o_Configuration( THIS.n_CFG_Actual ) ) RETURN THIS.l_ClearUniqueID ELSE RETURN NVL( THIS.o_Configuration( THIS.n_CFG_Actual ).l_ClearUniqueID, THIS.l_ClearUniqueID ) ENDIF ENDPROC PROCEDURE l_ClearDBFLastUpdate_ACCESS IF THIS.n_CFG_Actual = 0 OR ISNULL( THIS.o_Configuration( THIS.n_CFG_Actual ) ) RETURN THIS.l_ClearDBFLastUpdate ELSE RETURN NVL( THIS.o_Configuration( THIS.n_CFG_Actual ).l_ClearDBFLastUpdate, THIS.l_ClearDBFLastUpdate ) ENDIF ENDPROC PROCEDURE n_OptimizeByFilestamp_ACCESS IF THIS.n_CFG_Actual = 0 OR ISNULL( THIS.o_Configuration( THIS.n_CFG_Actual ) ) RETURN THIS.n_OptimizeByFilestamp ELSE RETURN NVL( THIS.o_Configuration( THIS.n_CFG_Actual ).n_OptimizeByFilestamp, THIS.n_OptimizeByFilestamp ) ENDIF ENDPROC PROCEDURE n_ExtraBackupLevels_ACCESS IF THIS.n_CFG_Actual = 0 OR ISNULL( THIS.o_Configuration( THIS.n_CFG_Actual ) ) RETURN THIS.n_ExtraBackupLevels ELSE RETURN NVL( THIS.o_Configuration( THIS.n_CFG_Actual ).n_ExtraBackupLevels, THIS.n_ExtraBackupLevels ) ENDIF ENDPROC PROCEDURE c_VC2_ACCESS IF THIS.n_CFG_Actual = 0 OR ISNULL( THIS.o_Configuration( THIS.n_CFG_Actual ) ) RETURN THIS.c_VC2 ELSE RETURN NVL( THIS.o_Configuration( THIS.n_CFG_Actual ).c_VC2, THIS.c_VC2 ) ENDIF ENDPROC PROCEDURE c_SC2_ACCESS IF THIS.n_CFG_Actual = 0 OR ISNULL( THIS.o_Configuration( THIS.n_CFG_Actual ) ) RETURN THIS.c_SC2 ELSE RETURN NVL( THIS.o_Configuration( THIS.n_CFG_Actual ).c_SC2, THIS.c_SC2 ) ENDIF ENDPROC PROCEDURE c_PJ2_ACCESS IF THIS.n_CFG_Actual = 0 OR ISNULL( THIS.o_Configuration( THIS.n_CFG_Actual ) ) RETURN THIS.c_PJ2 ELSE RETURN NVL( THIS.o_Configuration( THIS.n_CFG_Actual ).c_PJ2, THIS.c_PJ2 ) ENDIF ENDPROC PROCEDURE c_FR2_ACCESS IF THIS.n_CFG_Actual = 0 OR ISNULL( THIS.o_Configuration( THIS.n_CFG_Actual ) ) RETURN THIS.c_FR2 ELSE RETURN NVL( THIS.o_Configuration( THIS.n_CFG_Actual ).c_FR2, THIS.c_FR2 ) ENDIF ENDPROC PROCEDURE c_LB2_ACCESS IF THIS.n_CFG_Actual = 0 OR ISNULL( THIS.o_Configuration( THIS.n_CFG_Actual ) ) RETURN THIS.c_LB2 ELSE RETURN NVL( THIS.o_Configuration( THIS.n_CFG_Actual ).c_LB2, THIS.c_LB2 ) ENDIF ENDPROC PROCEDURE c_DB2_ACCESS IF THIS.n_CFG_Actual = 0 OR ISNULL( THIS.o_Configuration( THIS.n_CFG_Actual ) ) RETURN THIS.c_DB2 ELSE RETURN NVL( THIS.o_Configuration( THIS.n_CFG_Actual ).c_DB2, THIS.c_DB2 ) ENDIF ENDPROC PROCEDURE c_DC2_ACCESS IF THIS.n_CFG_Actual = 0 OR ISNULL( THIS.o_Configuration( THIS.n_CFG_Actual ) ) RETURN THIS.c_DC2 ELSE RETURN NVL( THIS.o_Configuration( THIS.n_CFG_Actual ).c_DC2, THIS.c_DC2 ) ENDIF ENDPROC PROCEDURE c_MN2_ACCESS IF THIS.n_CFG_Actual = 0 OR ISNULL( THIS.o_Configuration( THIS.n_CFG_Actual ) ) RETURN THIS.c_MN2 ELSE RETURN NVL( THIS.o_Configuration( THIS.n_CFG_Actual ).c_MN2, THIS.c_MN2 ) ENDIF ENDPROC PROCEDURE 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 c_BackgroundImage_ACCESS IF THIS.n_CFG_Actual = 0 OR ISNULL( THIS.o_Configuration( THIS.n_CFG_Actual ) ) RETURN THIS.c_BackgroundImage ELSE RETURN NVL( THIS.o_Configuration( THIS.n_CFG_Actual ).c_BackgroundImage, THIS.c_BackgroundImage ) ENDIF ENDPROC PROCEDURE changeFileAttribute * Using Win32 Functions in Visual FoxPro * example=103 * Changing file attributes LPARAMETERS tcFileName, tcAttrib tcAttrib = UPPER(tcAttrib) #DEFINE FILE_ATTRIBUTE_READONLY 1 #DEFINE FILE_ATTRIBUTE_HIDDEN 2 #DEFINE FILE_ATTRIBUTE_SYSTEM 4 #DEFINE FILE_ATTRIBUTE_DIRECTORY 16 #DEFINE FILE_ATTRIBUTE_ARCHIVE 32 #DEFINE FILE_ATTRIBUTE_NORMAL 128 #DEFINE FILE_ATTRIBUTE_TEMPORARY 512 #DEFINE FILE_ATTRIBUTE_COMPRESSED 2048 TRY LOCAL loEx AS EXCEPTION, dwFileAttributes, dwFileAttributes_Orig, lnRet lnRet = 0 * read current attributes for this file dwFileAttributes = fb2p_GetFileAttributes(tcFileName) dwFileAttributes_Orig = dwFileAttributes IF dwFileAttributes = -1 * the file does not exist EXIT ENDIF IF dwFileAttributes > 0 IF '+R' $ tcAttrib dwFileAttributes = BITOR(dwFileAttributes, FILE_ATTRIBUTE_READONLY) ENDIF IF '+A' $ tcAttrib dwFileAttributes = BITOR(dwFileAttributes, FILE_ATTRIBUTE_ARCHIVE) ENDIF IF '+S' $ tcAttrib dwFileAttributes = BITOR(dwFileAttributes, FILE_ATTRIBUTE_SYSTEM) ENDIF IF '+H' $ tcAttrib dwFileAttributes = BITOR(dwFileAttributes, FILE_ATTRIBUTE_HIDDEN) ENDIF IF '+D' $ tcAttrib dwFileAttributes = BITOR(dwFileAttributes, FILE_ATTRIBUTE_DIRECTORY) ENDIF IF '+N' $ tcAttrib dwFileAttributes = BITOR(dwFileAttributes, FILE_ATTRIBUTE_NORMAL) ENDIF IF '+T' $ tcAttrib dwFileAttributes = BITOR(dwFileAttributes, FILE_ATTRIBUTE_TEMPORARY) ENDIF IF '+C' $ tcAttrib dwFileAttributes = BITOR(dwFileAttributes, FILE_ATTRIBUTE_COMPRESSED) ENDIF IF '-R' $ tcAttrib AND BITAND(dwFileAttributes, FILE_ATTRIBUTE_READONLY) = FILE_ATTRIBUTE_READONLY dwFileAttributes = dwFileAttributes - FILE_ATTRIBUTE_READONLY ENDIF IF '-A' $ tcAttrib AND BITAND(dwFileAttributes, FILE_ATTRIBUTE_ARCHIVE) = FILE_ATTRIBUTE_ARCHIVE dwFileAttributes = dwFileAttributes - FILE_ATTRIBUTE_ARCHIVE ENDIF IF '-S' $ tcAttrib AND BITAND(dwFileAttributes, FILE_ATTRIBUTE_SYSTEM) = FILE_ATTRIBUTE_SYSTEM dwFileAttributes = dwFileAttributes - FILE_ATTRIBUTE_SYSTEM ENDIF IF '-H' $ tcAttrib AND BITAND(dwFileAttributes, FILE_ATTRIBUTE_HIDDEN) = FILE_ATTRIBUTE_HIDDEN dwFileAttributes = dwFileAttributes - FILE_ATTRIBUTE_HIDDEN ENDIF IF '-D' $ tcAttrib AND BITAND(dwFileAttributes, FILE_ATTRIBUTE_DIRECTORY) = FILE_ATTRIBUTE_DIRECTORY dwFileAttributes = dwFileAttributes - FILE_ATTRIBUTE_DIRECTORY ENDIF IF '-N' $ tcAttrib AND BITAND(dwFileAttributes, FILE_ATTRIBUTE_NORMAL) = FILE_ATTRIBUTE_NORMAL dwFileAttributes = dwFileAttributes - FILE_ATTRIBUTE_NORMAL ENDIF IF '-T' $ tcAttrib AND BITAND(dwFileAttributes, FILE_ATTRIBUTE_TEMPORARY) = FILE_ATTRIBUTE_TEMPORARY dwFileAttributes = dwFileAttributes - FILE_ATTRIBUTE_TEMPORARY ENDIF IF '-C' $ tcAttrib AND BITAND(dwFileAttributes, FILE_ATTRIBUTE_COMPRESSED) = FILE_ATTRIBUTE_COMPRESSED dwFileAttributes = dwFileAttributes - FILE_ATTRIBUTE_COMPRESSED ENDIF * setting selected attributes lnRet = fb2p_SetFileAttributes(tcFileName, dwFileAttributes) ENDIF CATCH TO loEx THROW FINALLY THIS.writeLog( C_TAB + LOWER(PROGRAM()) + ' >> [' + tcFileName + '] lnRet = ' + TRANSFORM(lnRet) + ', dwFileAttributes_Orig = ' + TRANSFORM(dwFileAttributes_Orig) ) RELEASE tcFileName, tcAttrib, dwFileAttributes ENDTRY RETURN lnRet ENDPROC PROCEDURE changeFileTime *--------------------------------------------------------------------------------------------------- * CAMBIAR LA FECHA/HORA DE UN ARCHIVO *--------------------------------------------------------------------------------------------------- * PARÁMETROS: (v=Pasar por valor | @=Pasar por referencia) (!=Obligatorio | ?=Opcional) (IN/OUT) * tcFileName (v! IN ) Nombre del archivo * tcTimeType (v? IN ) C=Creation time, W=Last Write, A=Last Access * tnYear (v? IN ) Año (>=1800) * tnMonth (v? IN ) Mes (1-12) * tnDay (v? IN ) Día (1-31) * tnHour (v? IN ) Hora (0-23) * tnMinute (v? IN ) Minuto (0-59) * tnSec (v? IN ) Segundo (0-59) * tnThou (v? IN ) ¿? (0-999) *--------------------------------------------------------------------------------------------------- LPARAMETERS m.tcFileName, m.tcTimeType, m.tnYear, m.tnMonth, m.tnDay, m.tnHour, m.tnMinute, m.tnSec, m.tnThou #DEFINE OF_READWRITE 2 LOCAL m.lpFileInformation, m.cS, m.nPar, m.fh, M.lpFileInformation, m.lpSysTime, m.cCreation ; , M.cLastAccess, m.cLastWrite, m.cBuffTime, m.cBuffTime1, M.cTT,m.nYear1, m.nMonth1, m.nDay1, m.nHour1 ; , M.nMinute1, m.nSec1, m.nThou1, llRetorno TRY m.nPar = PCOUNT() IF m.nPar < 1 EXIT ENDIF m.cTT = IIF( m.nPar >= 2 AND VARTYPE(m.tcTimeType) = "C" AND NOT EMPTY(m.tcTimeType), LOWER(SUBSTR(m.tcTimeType,1,1)), "c" ) m.nYear1 = IIF( m.nPar >= 3 AND VARTYPE(m.tnYear) $ "FIN" AND m.tnYear >= 1800, ROUND(m.tnYear,0), -1 ) m.nMonth1 = IIF( m.nPar >= 4 AND VARTYPE(m.tnMonth) $ "FIN" AND BETWEEN(m.tnMonth,1,12), ROUND(m.tnMonth,0), -1 ) m.nDay1 = IIF( m.nPar >= 5 AND VARTYPE(m.tnDay) $ "FIN" AND BETWEEN(m.tnDay,1,31), ROUND(m.tnDay,0), -1 ) m.nHour1 = IIF( m.nPar >= 6 AND VARTYPE(m.tnHour) $ "FIN" AND BETWEEN(m.tnHour,0,23), ROUND(m.tnHour,0), -1 ) m.nMinute1 = IIF( m.nPar >= 7 AND VARTYPE(m.tnMinute) $ "FIN" AND BETWEEN(m.tnMinute,0,59), ROUND(m.tnMinute,0), -1 ) m.nSec1 = IIF( m.nPar >= 8 AND VARTYPE(m.tnSec) $ "FIN" AND BETWEEN(m.tnSec,0,59), ROUND(m.tnSec,0), -1 ) m.nThou1 = IIF( m.nPar >= 9 AND VARTYPE(m.tnThou) $ "FIN" AND BETWEEN(m.tnThou,0,999), ROUND(m.tnThou,0), -1 ) m.lpFileInformation = REPLICATE( CHR(0), 53 ) && just a buffer m.lpSysTime = REPLICATE( CHR(0), 16 ) && just a buffer IF fb2p_GetFileAttributesEx(m.tcFileName, 0, @lpFileInformation) = 0 EXIT ENDIF m.cCreation = SUBSTR(m.lpFileInformation,5,8) m.cLastAccess = SUBSTR(m.lpFileInformation,13,8) m.cLastWrite = SUBSTR(m.lpFileInformation,21,8) m.cBuffTime = IIF(m.cTT="w",m.cLastWrite, IIF(m.cTT="a",m.cLastAccess,m.cCreation)) fb2p_FileTimeToSystemTime(m.cBuffTime, @lpSysTime) m.lpSysTime = ; IIF( m.nYear1 >= 0, BINTOC(m.nYear1,"2RS"), SUBSTR(m.lpSysTime,1,2) ) ; + IIF( m.nMonth1 >= 0, BINTOC(m.nMonth1,"2RS"), SUBSTR(m.lpSysTime,3,2) ) ; + SUBSTR(m.lpSysTime,5,2) ; + IIF( m.nDay1 >= 0, BINTOC(m.nDay1,"2RS"), SUBSTR(m.lpSysTime,7,2) ) ; + IIF( m.nHour1 >= 0, BINTOC(m.nHour1,"2RS"), SUBSTR(m.lpSysTime,9,2) ) ; + IIF( m.nMinute1 >= 0, BINTOC(m.nMinute1,"2RS"), SUBSTR(m.lpSysTime,11,2) ) ; + IIF( m.nSec1 >= 0, BINTOC(m.nSec1,"2RS"), SUBSTR(m.lpSysTime,13,2) ) ; + IIF( m.nThou1 >= 0, BINTOC(m.nThou1,"2RS"), SUBSTR(m.lpSysTime,15,2) ) fb2p_SystemTimeToFileTime(m.lpSysTime,@cBuffTime) m.cBuffTime1 = m.cBuffTime fb2p_LocalFileTimeToFileTime(m.cBuffTime1,@cBuffTime) DO CASE CASE m.cTT = "w" m.cLastWrite=m.cBuffTime CASE m.cTT = "a" m.cLastAccess=m.cBuffTime OTHERWISE && "c" m.cCreation=m.cBuffTime ENDCASE m.fh = fb2p_lopen (m.tcFileName, OF_READWRITE) IF m.fh < 0 EXIT ENDIF fb2p_SetFileTime (m.fh,m.cCreation, m.cLastAccess, m.cLastWrite) fb2p_lclose(m.fh) llRetorno = .T. ENDTRY RETURN llRetorno 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 RELEASE tcFileName, lcType RETURN ENDPROC PROCEDURE doBackup *--------------------------------------------------------------------------------------------------- * PARÁMETROS: (v=Pasar por valor | @=Pasar por referencia) (!=Obligatorio | ?=Opcional) (IN/OUT) * toEx (@? IN ) Objeto Exception con información del error * tlRelanzarError (v? IN ) Indica si se debe relanzar el error * tcBakFile_1 (@? OUT) Nombre del archivo backup 1 (vcx,scx,pjx,frx,lbx,dbf,dbc,mnx,vc2,sc2,pj2,etc) * tcBakFile_2 (@? OUT) Nombre del archivo backup 2 (vct,sct,pjt,frt,lbt,fpt,dct,mnt,etc) * tcBakFile_3 (@? OUT) Nombre del archivo backup 3 (cdx,dcx,etc) * tcOutputFile (v? IN ) Nombre del archivo de salida. Si no se indica se asume .c_OutputFile *--------------------------------------------------------------------------------------------------- LPARAMETERS toEx, tlRelanzarError, tcBakFile_1, tcBakFile_2, tcBakFile_3, tcOutputFile #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 ; , loLang as CL_LANG OF 'FOXBIN2PRG.PRG' STORE '' TO tcBakFile_1, tcBakFile_2, tcBakFile_3, lcExt_1, lcExt_2, lcExt_3 ; , tcOutputFile_Ext1, tcOutputFile_Ext2, tcOutputFile_Ext3 WITH THIS AS c_foxbin2prg OF 'FOXBIN2PRG.PRG' IF .n_ExtraBackupLevels > 0 THEN loLang = _SCREEN.o_FoxBin2Prg_Lang tcOutputFile = EVL( tcOutputFile, .c_OutputFile ) lcNext_Bak = .getNext_BAK( tcOutputFile ) lcExt_1 = JUSTEXT( tcOutputFile ) tcBakFile_1 = FORCEEXT(tcOutputFile, lcExt_1 + lcNext_Bak) 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_TAB + loLang.C_BACKUP_OF_LOC + tcOutputFile_Ext1 ) CASE EMPTY(lcExt_3) .writeLog( C_TAB + loLang.C_BACKUP_OF_LOC + tcOutputFile_Ext1 + '/' + lcExt_2 ) OTHERWISE .writeLog( C_TAB + loLang.C_BACKUP_OF_LOC + tcOutputFile_Ext1 + '/' + lcExt_2 + '/' + lcExt_3 ) ENDCASE *-- COPIA BACKUP COPY FILE ( tcOutputFile_Ext1 ) TO ( tcBakFile_1 ) 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.n_Debug > 0 AND _VFP.STARTMODE = 0 SET STEP ON ENDIF IF tlRelanzarError THROW ENDIF FINALLY RELEASE toEx, tlRelanzarError, tcBakFile_1, tcBakFile_2, tcBakFile_3 ; , lcNext_Bak, lcExt_1, lcExt_2, lcExt_3, tcOutputFile_Ext1, tcOutputFile_Ext2, tcOutputFile_Ext3 ; , tcOutputFile ENDTRY RETURN ENDPROC PROCEDURE loadProgressbarForm IF VARTYPE(THIS.o_Frm_Avance) <> "O" THEN THIS.o_Frm_Avance = CREATEOBJECT("frm_avance", THIS) THIS.o_Frm_Avance.Show() ENDIF ENDPROC PROCEDURE unloadProgressbarForm LPARAMETERS tlForceUnload IF (tlForceUnload OR THIS.n_ShowProgressbar <> 0) AND VARTYPE(THIS.o_Frm_Avance) = "O" THEN THIS.o_Frm_Avance.Hide() THIS.o_Frm_Avance.Release() THIS.o_Frm_Avance = NULL ENDIF ENDPROC PROCEDURE evaluateConfiguration *-------------------------------------------------------------------------------------------------------------- * PARÁMETROS: (v=Pasar por valor | @=Pasar por referencia) (!=Obligatorio | ?=Opcional) (IN/OUT) * tcDontShowProgress (v? IN ) '1' para inhabilitar la barra de progreso * tcDontShowErrors (v? IN ) '1' para no mostrar mensajes de error (MESSAGEBOX) * tcNoTimestamps (v? IN ) Indica si se debe anular el timestamp ('1') o no ('0' ó vacío) * tcDebug (v? IN ) '1' para habilitar modo debug (SOLO DESARROLLO) * tcRecompile (v? IN ) Indica recompilar ('1') el binario una vez regenerado. [Cambio de funcionamiento por defecto] * Este cambio es para ganar tiempo, velocidad y seguridad. Además la recompilación que hace FoxBin2Prg * se hace desde el directorio del archivo, con lo que las referencias relativas pueden * generar errores de compilación, típicamente los #include. * NOTA: Si en vez de '1' se indica un Path (p.ej, el del proyecto, se usará como base para recompilar * tcExtraBackupLevels (v? IN ) Indica la cantidad de niveles de backup a realizar (por defecto '1') * tcClearUniqueID (v? IN ) Indica si se debe limpiar el UniqueID ('1') o no ('0' ó vacío) * tcOptimizeByFilestamp (v? IN ) Indica si se debe optimizar por filestamp mayor o igual ('1'), solo igual ('2') o no optimizar ('0' ó vacío) * tc_InputFile (v! IN ) Nombre completo (fullpath) del archivo a convertir o nombre del directorio a procesar * tc_InputFile_Type (@? IN ) Tipo de archivo de entrada: (D)irectory, (F)ile, (Q)uerySupport * toParentCFG (@? IN ) (Uso interno) Si se pasa un valor, el nuevo CFG copiará primero sus valores de aquí para heredarlos *-------------------------------------------------------------------------------------------------------------- LPARAMETERS tcDontShowProgress, tcDontShowErrors, tcNoTimestamps, tcDebug, tcRecompile, tcExtraBackupLevels ; , tcClearUniqueID, tcOptimizeByFilestamp, tc_InputFile, tcInputFile_Type, toParentCFG #IF .F. LOCAL toParentCFG AS CL_CFG OF 'FOXBIN2PRG.PRG' #ENDIF LOCAL lcConfigFile, llExiste_CFG_EnDisco, laConfig(1), I, lcConfData, lcExt, lcValue, lc_CFG_Path, lcConfigLine, laDirInfo(1,5) ; , lnDirs, laDirs(1), llMasterEval ; , lo_CFG AS CL_CFG OF 'FOXBIN2PRG.PRG' ; , lo_Configuration AS Collection ; , loLang as CL_LANG OF 'FOXBIN2PRG.PRG' ; , loEx as Exception TRY WITH THIS AS c_foxbin2prg OF 'FOXBIN2PRG.PRG' STORE 0 TO lnKey loLang = _SCREEN.o_FoxBin2Prg_Lang tcRecompile = EVL(tcRecompile, .c_Recompile) lcConfigFile = .c_Foxbin2prg_ConfigFile tc_InputFile = EVL(tc_InputFile, .c_InputFile) tcInputFile_Type = EVL(tcInputFile_Type,'') lo_Configuration = .o_Configuration IF VARTYPE(toParentCFG) <> 'O' THEN toParentCFG = NULL ENDIF IF ISNULL(toParentCFG) THEN .c_InputFile = tc_InputFile ENDIF *-- Determino el tipo de InputFile (Archivo o Directorio) IF EMPTY(tcInputFile_Type) AND NOT EMPTY(tc_InputFile) DO CASE CASE LEN(tc_InputFile) = 1 tcInputFile_Type = C_FILETYPE_QUERYSUPPORT CASE ADIR(laDirInfo, tc_InputFile, "D") = 1 AND SUBSTR( laDirInfo(1,5), 5, 1 ) = "D" tcInputFile_Type = C_FILETYPE_DIRECTORY OTHERWISE tcInputFile_Type = C_FILETYPE_FILE ENDCASE ENDIF IF .l_Main_CFG_Loaded AND NOT EMPTY(tc_InputFile) AND NOT tcInputFile_Type == C_FILETYPE_QUERYSUPPORT THEN IF tcInputFile_Type == C_FILETYPE_DIRECTORY THEN lcConfigFile = FULLPATH( 'foxbin2prg.cfg', ADDBS(tc_InputFile) ) ELSE lcConfigFile = FULLPATH( 'foxbin2prg.cfg', tc_InputFile ) ENDIF ENDIF lo_Configuration = .o_Configuration .n_CFG_Actual = 0 .l_CFG_CachedAccess = .F. lc_CFG_Path = UPPER( JUSTPATH( lcConfigFile ) ) lo_CFG = THIS *-- Búsqueda del CFG del PATH indicado en la caché IF .l_Main_CFG_Loaded IF lo_Configuration.Count > 0 THEN .n_CFG_Actual = lo_Configuration.GetKey( lc_CFG_Path ) && 0 = No hay CFG cacheada, >0 = Hay CFG cacheada IF .n_CFG_Actual > 0 THEN lo_CFG = lo_Configuration.Item(.n_CFG_Actual) .l_CFG_CachedAccess = .T. ENDIF ENDIF *-- Si no se pasó un CFG padre y no hay CFGs o no encuentra el del PATH indicado, analizo la jararquía IF ISNULL(toParentCFG) AND (lo_Configuration.Count = 0 OR .n_CFG_Actual = 0) THEN llMasterEval = .T. toParentCFG = THIS IF LEFT( lc_CFG_Path, 2 ) == '\\' THEN lnDirs = OCCURS( '\', lc_CFG_Path ) - 3 ELSE lnDirs = OCCURS( '\', lc_CFG_Path ) ENDIF IF lnDirs > 0 THEN DIMENSION laDirs(lnDirs) *-- Creo el array con los PATH intermedios FOR I = lnDirs TO 1 STEP -1 IF I = lnDirs THEN laDirs(I) = JUSTPATH(lc_CFG_Path) ELSE laDirs(I) = JUSTPATH(laDirs(I+1)) ENDIF ENDFOR *-- Ahora evalúo las configuraciones de los PATH intermedios desde la raíz en adelante *-- y mantengo la última configuración CFG Padre en toParentCFG para usarla como base. FOR I = 1 TO lnDirs .evaluateConfiguration( '', '', '', '', '', '', '', '', laDirs(I), C_FILETYPE_DIRECTORY, @toParentCFG) ENDFOR .l_CFG_CachedAccess = .F. .n_CFG_Actual = 0 ENDIF ENDIF ENDIF DO CASE CASE .n_CFG_Actual = 0 *-- Si no se encontró un CFG cacheado, se busca si existe un archivo CFG en disco llExiste_CFG_EnDisco = ( ADIR( laDirInfo, lcConfigFile ) = 1 ) IF NOT llExiste_CFG_EnDisco .l_CFG_CachedAccess = .T. && Es cacheado porque sin archivo CFG usa config.interna ENDIF CASE ISNULL( .o_Configuration( .n_CFG_Actual ) ) *-- Si existe una configuración y es NULL, es la predeterminada. *-- Este es el primer objeto CFG en cargarse cuando se inicializa FoxBin2Prg, *-- y corresponde a la ruta de instalación del EXE (ej: c:\desa\foxbin2prg\foxbin2prg.cfg) lo_CFG = THIS ENDCASE IF .l_Main_CFG_Loaded IF .l_CFG_CachedAccess AND .n_CFG_Actual > 0 THEN toParentCFG = lo_CFG .writeLog( '> ' + UPPER(loLang.C_USING_THIS_SETTINGS_LOC) + ': ' + lo_CFG.c_Foxbin2prg_ConfigFile + ' => ' + tc_InputFile + '' ) ELSE .writeLog( '> ' + UPPER(loLang.C_CACHING_CONFIG_FOR_DIRECTORY_LOC) + ': ' + lc_CFG_Path ) lo_CFG = CREATEOBJECT('CL_CFG') lo_Configuration.Add( lo_CFG, lc_CFG_Path ) .n_CFG_Actual = lo_Configuration.Count IF NOT ISNULL(toParentCFG) lo_CFG.CopyFrom(@toParentCFG) toParentCFG = lo_CFG .writeLog( C_TAB + '- ' + loLang.C_INHERITING_FROM_LOC + ': ' + lo_CFG.c_Foxbin2prg_ConfigFile ) ENDIF ENDIF ELSE lo_Configuration.Add( NULL, lc_CFG_Path ) && La NULL se carga solo cuando no hay Main_CFG_loaded todavía. .n_CFG_Actual = lo_Configuration.Count ENDIF *-- NOTA: SOLO LOS QUE NO VENGAN DE PARÁMETROS EXTERNOS DEBEN ASIGNARSE A lo_CFG AQUÍ. IF llExiste_CFG_EnDisco AND NOT .l_CFG_CachedAccess THEN .writeLog() .writeLog( '> ' + loLang.C_READING_CFG_VALUES_FROM_DISK_LOC + ':' ) .writeLog( C_TAB + loLang.C_CONFIGFILE_LOC + ' ' + lcConfigFile ) lo_CFG.c_Foxbin2prg_ConfigFile = lcConfigFile FOR I = 1 TO ALINES( laConfig, FILETOSTR( lcConfigFile ), 1+4 ) .set_Line( @lcConfigLine, @laConfig, I ) .get_SeparatedLineAndComment( @lcConfigLine ) laConfig(I) = LOWER( lcConfigLine ) DO CASE CASE EMPTY( laConfig(I) ) OR 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( lo_CFG, lcExt, 5 ) lo_CFG.ADDPROPERTY( lcExt, UPPER( ALLTRIM( GETWORDNUM( lcConfData, 2, '=' ) ) ) ) *.writeLog( 'Reconfiguración de extensión:' + ' ' + lcExt + ' a ' + UPPER( ALLTRIM( GETWORDNUM( lcConfData, 2, '=' ) ) ) ) .writeLog( C_TAB + JUSTFNAME(lcConfigFile) + ' > ' + loLang.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', '2' ) AND INLIST( lcValue, '0', '1', '2' ) THEN tcDontShowProgress = lcValue lo_CFG.n_ShowProgressbar = ICASE(lcValue=='0',1, lcValue=='1',0, 2) .writeLog( C_TAB + JUSTFNAME(lcConfigFile) + ' > tcDontShowProgress: ' + TRANSFORM(tcDontShowProgress) ) ENDIF CASE LEFT( laConfig(I), 16 ) == LOWER('ShowProgressbar:') lcValue = ALLTRIM( SUBSTR( laConfig(I), 17 ) ) IF INLIST( lcValue, '0', '1', '2' ) THEN lo_CFG.n_ShowProgressbar = INT( VAL(lcValue) ) tcDontShowProgress = '' .writeLog( C_TAB + JUSTFNAME(lcConfigFile) + ' > ShowProgressbar: ' + lcValue ) ENDIF CASE LEFT( laConfig(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( C_TAB + 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( C_TAB + 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( C_TAB + 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( C_TAB + 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( C_TAB + JUSTFNAME(lcConfigFile) + ' > ClearUniqueID: ' + TRANSFORM(lcValue) ) ENDIF CASE LEFT( laConfig(I), 19 ) == LOWER('ClearDBFLastUpdate:') lcValue = ALLTRIM( SUBSTR( laConfig(I), 20 ) ) IF INLIST( lcValue, '0', '1' ) THEN lo_CFG.l_ClearDBFLastUpdate = ( TRANSFORM(lcValue) == '1' ) .writeLog( C_TAB + JUSTFNAME(lcConfigFile) + ' > ClearDBFLastUpdate: ' + TRANSFORM(lcValue) ) ENDIF CASE LEFT( laConfig(I), 20 ) == LOWER('OptimizeByFilestamp:') lcValue = ALLTRIM( SUBSTR( laConfig(I), 21 ) ) IF NOT INLIST( TRANSFORM(tcOptimizeByFilestamp), '0', '1', '2' ) AND INLIST( lcValue, '0', '1', '2' ) THEN tcOptimizeByFilestamp = lcValue .writeLog( C_TAB + JUSTFNAME(lcConfigFile) + ' > OptimizeByFilestamp: ' + TRANSFORM(lcValue) ) ENDIF CASE LEFT( laConfig(I), 16 ) == LOWER('UseClassPerFile:') lcValue = ALLTRIM( SUBSTR( laConfig(I), 17 ) ) IF INLIST( lcValue, '0', '1', '2' ) THEN lo_CFG.n_UseClassPerFile = INT( VAL(lcValue) ) .writeLog( C_TAB + JUSTFNAME(lcConfigFile) + ' > UseClassPerFile: ' + TRANSFORM(lcValue) ) ENDIF CASE LEFT( laConfig(I), 18 ) == LOWER('ClassPerFileCheck:') lcValue = ALLTRIM( SUBSTR( laConfig(I), 19 ) ) IF INLIST( lcValue, '0', '1' ) THEN lo_CFG.l_ClassPerFileCheck = ( TRANSFORM(lcValue) == '1' ) .writeLog( C_TAB + JUSTFNAME(lcConfigFile) + ' > ClassPerFileCheck: ' + TRANSFORM(lcValue) ) ENDIF CASE LEFT( laConfig(I), 27 ) == LOWER('RedirectClassPerFileToMain:') lcValue = ALLTRIM( SUBSTR( laConfig(I), 28 ) ) IF INLIST( lcValue, '0', '1' ) THEN lo_CFG.l_RedirectClassPerFileToMain = ( TRANSFORM(lcValue) == '1' ) .writeLog( C_TAB + JUSTFNAME(lcConfigFile) + ' > RedirectClassPerFileToMain: ' + TRANSFORM(lcValue) ) ENDIF CASE LEFT( laConfig(I), 24 ) == LOWER('RemoveNullCharsFromCode:') lcValue = ALLTRIM( SUBSTR( laConfig(I), 25 ) ) IF INLIST( lcValue, '0', '1' ) THEN lo_CFG.l_RemoveNullCharsFromCode = ( TRANSFORM(lcValue) == '1' ) .writeLog( C_TAB + JUSTFNAME(lcConfigFile) + ' > RemoveNullCharsFromCode: ' + TRANSFORM(lcValue) ) ENDIF CASE LEFT( laConfig(I), 25 ) == LOWER('RemoveZOrderSetFromProps:') lcValue = ALLTRIM( SUBSTR( laConfig(I), 26 ) ) IF INLIST( lcValue, '0', '1' ) THEN lo_CFG.l_RemoveZOrderSetFromProps = ( TRANSFORM(lcValue) == '1' ) .writeLog( C_TAB + JUSTFNAME(lcConfigFile) + ' > RemoveZOrderSetFromProps: ' + TRANSFORM(lcValue) ) ENDIF CASE LEFT( laConfig(I), 9 ) == LOWER('Language:') *-- CASO ESPECIAL: El lenguaje no se guarda en lo_CFG, porque es un seteo Global. lcValue = ALLTRIM( SUBSTR( laConfig(I), 10 ) ) .changeLanguage(lcValue) .writeLog( C_TAB + JUSTFNAME(lcConfigFile) + ' > Language: ' + TRANSFORM(lcValue) + ' (' + .c_Language + ')' ) 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( C_TAB + 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( C_TAB + 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( C_TAB + 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( C_TAB + 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( C_TAB + 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( C_TAB + 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( C_TAB + 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( C_TAB + 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( C_TAB + 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( C_TAB + JUSTFNAME(lcConfigFile) + ' > DBC_Conversion_Support: ' + TRANSFORM(lo_CFG.DBC_Conversion_Support) ) ENDIF CASE LEFT( laConfig(I), 16 ) == LOWER('BackgroundImage:') lcValue = ALLTRIM( SUBSTR( laConfig(I), 17 ) ) IF EMPTY(lcValue) OR FILE( lcValue ) THEN lo_CFG.c_BackgroundImage = lcValue .writeLog( C_TAB + JUSTFNAME(lcConfigFile) + ' > BackgroundImage: ' + TRANSFORM(lo_CFG.c_BackgroundImage) ) ENDIF ENDCASE ENDFOR .writeLog( ) ENDIF && llExiste_CFG_EnDisco *-- ESTOS SE EVALÚAN FUERA DEL IF PORQUE NO DEPENDEN DEL CFG *-- Y PUEDEN VENIR TAMBIÉN DE PARÁMETROS EXTERNOS. IF INLIST( TRANSFORM(tcDontShowProgress), '0', '1', '2' ) THEN lo_CFG.n_ShowProgressbar = ICASE(tcDontShowProgress=='0',1, tcDontShowProgress=='1',0, 2) ENDIF IF 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', '2' ) THEN lo_CFG.n_Debug = INT(VAL(tcDebug)) ENDIF tcExtraBackupLevels = EVL( tcExtraBackupLevels, TRANSFORM( .n_ExtraBackupLevels ) ) IF ISDIGIT(tcExtraBackupLevels) lo_CFG.n_ExtraBackupLevels = INT( VAL( TRANSFORM(tcExtraBackupLevels) ) ) ENDIF IF INLIST( TRANSFORM(tcOptimizeByFilestamp), '0', '1', '2' ) THEN lo_CFG.n_OptimizeByFilestamp = INT(VAL(tcOptimizeByFilestamp)) ENDIF .l_Main_CFG_Loaded = .T. IF NOT llMasterEval *-- Si no es llMasterEval, es porque esta llamada es cíclica desde este mismo método, *-- y no hay parámetros para evaluar, ya que se mandan todos vacíos desde el inicial. EXIT ENDIF .writeLog( '> ' + UPPER(loLang.C_USING_THIS_SETTINGS_LOC) + ':' ) .writeLog( C_TAB + 'n_CFG_Actual: ' + TRANSFORM(.n_CFG_Actual) + ICASE(.n_CFG_Actual=1, ' [MASTER]', ' [SECONDARY]') ) .writeLog( C_TAB + 'l_CFG_CachedAccess: ' + TRANSFORM(.l_CFG_CachedAccess) ) .writeLog( C_TAB + 'tc_InputFile: ' + TRANSFORM(EVL(tc_InputFile,'') ) ) .writeLog( C_TAB + 'c_Foxbin2prg_ConfigFile: ' + TRANSFORM(EVL(lo_CFG.c_Foxbin2prg_ConfigFile, '(Internal defaults)') ) ) .writeLog( C_TAB + 'n_ShowProgressbar: ' + TRANSFORM(.n_ShowProgressbar) ) .writeLog( C_TAB + 'l_ShowErrors: ' + TRANSFORM(.l_ShowErrors) ) .writeLog( C_TAB + 'l_Recompile: ' + TRANSFORM(.l_Recompile) + ' (' + tcRecompile + ')' ) .writeLog( C_TAB + 'l_NoTimestamps: ' + TRANSFORM(.l_NoTimestamps) ) .writeLog( C_TAB + 'l_ClearUniqueID: ' + TRANSFORM(.l_ClearUniqueID) ) .writeLog( C_TAB + 'n_UseClassPerFile: ' + TRANSFORM(.n_UseClassPerFile) ) .writeLog( C_TAB + 'l_ClassPerFileCheck: ' + TRANSFORM(.l_ClassPerFileCheck) ) .writeLog( C_TAB + 'l_RedirectClassPerFileToMain: ' + TRANSFORM(.l_RedirectClassPerFileToMain) ) .writeLog( C_TAB + 'n_Debug: ' + TRANSFORM(.n_Debug) ) .writeLog( C_TAB + 'n_ExtraBackupLevels: ' + TRANSFORM(.n_ExtraBackupLevels) ) .writeLog( C_TAB + 'c_BackgroundImage: ' + TRANSFORM(.c_BackgroundImage) ) .writeLog( C_TAB + 'n_OptimizeByFilestamp: ' + TRANSFORM(.n_OptimizeByFilestamp) ) .writeLog( C_TAB + 'l_RemoveNullCharsFromCode: ' + TRANSFORM(.l_RemoveNullCharsFromCode) ) .writeLog( C_TAB + 'l_RemoveZOrderSetFromProps: ' + TRANSFORM(.l_RemoveZOrderSetFromProps) ) .writeLog( C_TAB + 'l_ClearDBFLastUpdate: ' + TRANSFORM(.l_ClearDBFLastUpdate) ) .writeLog( C_TAB + 'c_Language: ' + TRANSFORM(.c_Language) ) .writeLog( ) ENDWITH && THIS CATCH TO loEx loEx.UserValue = loEx.UserValue + 'lcConfigFile = [' + TRANSFORM(lcConfigFile) + ']' + CR_LF loEx.UserValue = loEx.UserValue + 'lc_CFG_Path = [' + TRANSFORM(lc_CFG_Path) + ']' + CR_LF loEx.UserValue = loEx.UserValue + 'lcValue = [' + TRANSFORM(lcValue) + ']' + CR_LF IF THIS.n_Debug > 0 AND _VFP.STARTMODE = 0 SET STEP ON ENDIF THROW FINALLY STORE NULL TO lo_Configuration, lo_CFG, loEx RELEASE tcDontShowProgress, tcDontShowErrors, tcNoTimestamps, tcDebug, tcRecompile, tcExtraBackupLevels ; , tcClearUniqueID, tcOptimizeByFilestamp, tc_InputFile ; , lcConfigFile, llExiste_CFG_EnDisco, laConfig, I, lcConfData, lcExt, lcValue, lc_CFG_Path ; , lo_CFG, lo_Configuration, loEx ENDTRY RETURN ENDPROC FUNCTION comparedFilesAreEqual *--------------------------------------------------------------------------------------------------- * PARÁMETROS: (v=Pasar por valor | @=Pasar por referencia) (!=Obligatorio | ?=Opcional) (IN/OUT) * tcFilename1 (v! IN ) Nombre del archivo1 a comparar * tcFilename2 (v! IN ) Nombre del archivo2 a comparar * tcStrFileName2 (v! IN ) ***NO IMPLEMENTADO*** Contenido del archivo2 a comparar *--------------------------------------------------------------------------------------------------- LPARAMETERS tcFilename1, tcFilename2, tcStrFileName2 LOCAL lnComparacion, lnLen1, lnLen2, lnHandle1, lnHandle2, lnTipoComp, lnChunkSize ; , loEx as Exception TRY STORE -1 TO lnComparacion, lnHandle1, lnHandle2 lnTipoComp = 0 lnChunkSize = 65535 DO CASE CASE NOT EMPTY(tcFilename1) AND NOT EMPTY(tcFilename2) lnTipoComp = 1 lnHandle1 = FOPEN( tcFilename1 ) IF lnHandle1 = -1 EXIT ENDIF lnHandle2 = FOPEN( tcFilename2 ) IF lnHandle2 = -1 EXIT ENDIF lnLen1 = FSEEK( lnHandle1, 0, 2 ) lnLen2 = FSEEK( lnHandle2, 0, 2 ) *-- Comparación de tamaño IF lnLen1 <> lnLen2 THEN lnComparacion = 0 && Son distintos EXIT ENDIF *-- Comparación de contenido FSEEK( lnHandle1, 0, 0 ) FSEEK( lnHandle2, 0, 0 ) DO WHILE NOT ( FEOF(lnHandle1) OR FEOF(lnHandle2) ) *IF NOT SYS( 2007, FREAD( lnHandle1, lnChunkSize ), -1, 1 ) == SYS( 2007, FREAD( lnHandle2, lnChunkSize ), -1, 1 ) THEN IF NOT FREAD( lnHandle1, lnChunkSize ) == FREAD( lnHandle2, lnChunkSize ) THEN lnComparacion = 0 && Son distintos EXIT ENDIF ENDDO IF lnComparacion = 0 THEN EXIT ENDIF lnComparacion = 1 && Son iguales ENDCASE CATCH TO loEx lnComparacion = -1 && Error THROW FINALLY DO CASE CASE lnTipoComp = 1 FCLOSE( lnHandle1 ) FCLOSE( lnHandle2 ) ENDCASE ENDTRY RETURN lnComparacion ENDFUNC FUNCTION filenameFoundInFilter *--------------------------------------------------------------------------------------------------- * PARÁMETROS: (v=Pasar por valor | @=Pasar por referencia) (!=Obligatorio | ?=Opcional) (IN/OUT) * tcFilename (v! IN ) Nombre del archivo a evaluar * tcFilters (v! IN ) Filtros a evaluar (*,??E.*,R*.*) *--------------------------------------------------------------------------------------------------- LPARAMETERS tcFileName, tcFilters 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 RELEASE tcFileName, tcFilters, laFiltros 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 ; , tcExt ) ENDWITH && THIS RELEASE tcExt RETURN lcExt2 ENDPROC PROCEDURE hasSupport_Bin2Prg LPARAMETERS tcExt LOCAL llhasSupport tcExt = UPPER(JUSTEXT('.' + tcExt)) WITH THIS AS c_foxbin2prg OF 'FOXBIN2PRG.PRG' llhasSupport = ICASE( tcExt == 'PJX', .PJX_Conversion_Support > 0 ; , tcExt == 'VCX', .VCX_Conversion_Support > 0 ; , tcExt == 'SCX', .SCX_Conversion_Support > 0 ; , tcExt == 'FRX', .FRX_Conversion_Support > 0 ; , tcExt == 'LBX', .LBX_Conversion_Support > 0 ; , tcExt == 'MNX', .MNX_Conversion_Support > 0 ; , tcExt == 'DBF', .DBF_Conversion_Support > 0 ; , tcExt == 'DBC', .DBC_Conversion_Support > 0 ; , .F. ) ENDWITH && THIS RELEASE tcExt RETURN llhasSupport ENDPROC PROCEDURE hasSupport_Prg2Bin LPARAMETERS tcExt LOCAL llhasSupport tcExt = UPPER(JUSTEXT('.' + tcExt)) WITH THIS AS c_foxbin2prg OF 'FOXBIN2PRG.PRG' llhasSupport = 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 RELEASE tcExt RETURN llhasSupport ENDPROC PROCEDURE execute *-------------------------------------------------------------------------------------------------------------- * PARÁMETROS: (v=Pasar por valor | @=Pasar por referencia) (!=Obligatorio | ?=Opcional) (IN/OUT) * tc_InputFile (v! IN ) Nombre completo (fullpath) del archivo a convertir o nombre del directorio a procesar * - En modo compatibilidad con Visual SourceSafe, se usa para preguntar el tipo de soporte de conversión para el tipo de archivo indicado * tcType (v? IN ) Tipo de archivo de entrada. Compatibilidad con SCCTEXT.PRG * - Si se indica "*" y tc_InputFile es un PJX, se procesan todos los archivos del proyecto y el PJX/2 * - Si se indica "*-" y tc_InputFile es un PJX, se procesan todos los archivos del proyecto sin el PJX/2 * - Si se indica "BIN2PRG", se procesa el directorio indicado en tc_InputFile para generar los TX2 * - Si se indica "PRG2BIN", se procesa el directorio indicado en tc_InputFile para generar los BIN * - En modo compatibilidad con Visual SourceSafe, indica el tipo de archivo a convertir * tcTextName (v? IN ) Nombre del archivo texto. (Solo para compatibilidad con Visual SourceSafe) * tlGenText (v? IN ) .T.=Genera Texto, .F.=Genera Binario. (Solo para compatibilidad con Visual SourceSafe) * tcDontShowErrors (v? IN ) '1' para no mostrar mensajes de error (MESSAGEBOX) * tcDebug (v? IN ) '1' para habilitar modo debug (SOLO DESARROLLO) * tcDontShowProgress (v? IN ) '1' para inhabilitar la barra de progreso * toModulo (@? OUT) Referencia de objeto del módulo generado (para Unit Testing) * toEx (@? OUT) Objeto con información del error * tlRelanzarError (v? IN ) Indica si el error debe relanzarse o no * tcOriginalFileName (v? IN ) Sirve para los casos en los que inputFile es un nombre temporal y se quiere generar * el nombre correcto dentro de la versión texto (por ej: en los PJ2 y las cabeceras) * tcRecompile (v? IN ) Indica recompilar ('1') el binario una vez regenerado. [Cambio de funcionamiento por defecto] * Este cambio es para ganar tiempo, velocidad y seguridad. Además la recompilación que hace FoxBin2Prg * se hace desde el directorio del archivo, con lo que las referencias relativas pueden * generar errores de compilación, típicamente los #include. * NOTA: Si en vez de '1' se indica un Path (p.ej, el del proyecto, se usará como base para recompilar * tcNoTimestamps (v? IN ) Indica si se debe anular el timestamp ('1') o no ('0' ó vacío) * tcBackupLevels (v? IN ) Indica la cantidad de niveles de backup a realizar (por defecto '1') * tcClearUniqueID (v? IN ) Indica si se debe limpiar el UniqueID ('1') o no ('0' ó vacío) * tcOptimizeByFilestamp (v? IN ) Indica si se debe optimizar por filestamp mayor o igual ('1'), solo igual ('2') o no optimizar ('0' ó vacío) * tcCFG_File (v? IN ) Indica si se debe usar un archivo de configuración distinto al predeterminado *-------------------------------------------------------------------------------------------------------------- LPARAMETERS tc_InputFile, tcType, tcTextName, tlGenText, tcDontShowErrors, tcDebug, tcDontShowProgress ; , toModulo, toEx AS EXCEPTION, tlRelanzarError, tcOriginalFileName, tcRecompile, tcNoTimestamps ; , tcBackupLevels, tcClearUniqueID, tcOptimizeByFilestamp, tcCFG_File TRY LOCAL I, lcPath, lnCodError, lcFileSpec, lcFile, laFiles(1,5), laDirInfo(1,5), lcInputFile_Type, lc_OldSetNotify ; , lnFileCount, lcErrorInfo, lcErrorFile, lnPCount, laParams(1), lnConversionOption, lnErrorIcon, llError ; , lcOldSetEscape, lcOldOnEscape, llEscKeyRestored ; , loEx AS EXCEPTION ; , loFSO AS Scripting.FileSystemObject ; , loLang AS CL_LANG OF 'FOXBIN2PRG.PRG' ; , loFrm_Interactive AS frm_interactive OF 'FOXBIN2PRG.PRG' ; , loFrm_Main AS frm_main OF 'FOXBIN2PRG.PRG' ; , loWSH AS WScript.Shell WITH THIS AS c_foxbin2prg OF 'FOXBIN2PRG.PRG' lc_OldSetNotify = SET("Notify") SET NOTIFY OFF lnCodError = 0 loLang = _SCREEN.o_FoxBin2Prg_Lang loFSO = .o_FSO loWSH = .o_WSH lnPCount = 0 lcInputFile_Type = '' .l_Error = .F. tcType = UPPER( EVL(tcType,'') ) .declareDLL() IF THIS.l_CancelWithEscKey THEN lcOldSetEscape = SET("Escape") lcOldOnEscape = ON("Escape") ON ESCAPE ERROR 1799 SET ESCAPE ON ENDIF DO CASE CASE VERSION(5) < 900 OR INT( VAL( SUBSTR( VERSION(4), RAT('.', VERSION(4)) + 1 ) ) ) < 3504 ERROR loLang.C_INCORRECT_VFP9_VERSION__MISSING_SP1_LOC CASE '\' $ tcType ERROR loLang.C_INVALID_PARAMETER_LOC + ':' + CR_LF ; + 'tcType = "' + tcType + '"' + CR_LF ; + CR_LF ; + loLang.C_ALLOWED_VALUES_ARE_LOC + ': ' + CR_LF ; + '*, *-, -BIN2PRG, -PRG2BIN, -SHOWMSG, -SIMERR_I0, -SIMERR_I1, -SIMERR_O1' ENDCASE DO CASE CASE ATC('-SIMERR_I0','-'+tcType) > 0 .c_SimulateError = 'SIMERR_I0' CASE ATC('-SIMERR_I1','-'+tcType) > 0 .c_SimulateError = 'SIMERR_I1' CASE ATC('-SIMERR_O1','-'+tcType) > 0 .c_SimulateError = 'SIMERR_O1' ENDCASE IF .l_AutoClearProcessedFiles THEN .clearProcessedFiles() && Para evitar acumular procesos anteriores ENDIF *-- Funciona y lee los parámetros, pero no le veo un caso de uso claro, ya que si se eligen *-- varios directorios de proyecto, la compilación será errónea. 12/12/2014 *.readInputVFPParams( @laParams, @lnPCount ) *IF lnPCount > 0 THEN * .writeLog( 'Params.Externos: ' + TRANSFORM(lnPCount,'@L ##') ) * FOR I = 1 TO lnPCount * .writeLog( 'Param.' + TRANSFORM(I,'@L ##') + ' [' + laParams(I) + ']' ) * ENDFOR * EXIT *ENDIF *-- Reconocimiento de la clase indicada IF '::' $ tc_InputFile THEN .c_ClassToConvert = LOWER( ALLTRIM( GETWORDNUM( tc_InputFile, 2, '::' ) ) ) tc_InputFile = LOWER( ALLTRIM( GETWORDNUM( tc_InputFile, 1, '::' ) ) ) ENDIF .c_Foxbin2prg_ConfigFile = EVL( tcCFG_File, .c_Foxbin2prg_ConfigFile ) *-- Ajusto la ruta si no es absoluta tc_InputFile = .get_AbsolutePath( tc_InputFile, .c_CurDir ) *-- Determino el tipo de InputFile (Archivo o Directorio) IF EMPTY(lcInputFile_Type) AND NOT EMPTY(tc_InputFile) DO CASE CASE LEN(tc_InputFile) = 1 lcInputFile_Type = C_FILETYPE_QUERYSUPPORT CASE ADIR(laDirInfo, tc_InputFile, "D") = 1 AND SUBSTR( laDirInfo(1,5), 5, 1 ) = "D" *-- Ejemplo: "c:\desa\" lcInputFile_Type = C_FILETYPE_DIRECTORY OTHERWISE *-- Ejemplo: "c:\desa\*.scx", "c:\desa\file.ext", (lista de archivos) lcInputFile_Type = C_FILETYPE_FILE ENDCASE ENDIF IF EMPTY(tcRecompile) AND NOT EMPTY(lcInputFile_Type) AND NOT lcInputFile_Type == C_FILETYPE_QUERYSUPPORT THEN IF lcInputFile_Type == C_FILETYPE_DIRECTORY THEN tcRecompile = tc_InputFile ELSE tcRecompile = JUSTPATH( tc_InputFile ) ENDIF ENDIF tcRecompile = EVL(tcRecompile,'1') .c_Recompile = tcRecompile .writeLog( REPLICATE( '*', 100 ) ) .writeLog( loLang.C_MAIN_EXECUTION_LOC, 2 ) .writeLog( REPLICATE( '*', 100 ) ) .writeLog( '> ' + loLang.C_EXTERNAL_PARAMETERS_LOC + ':' ) .writeLog( C_TAB + 'tc_InputFile: ' + TRANSFORM( EVL(tc_InputFile, '(empty) -> Will use Default [' + .c_InputFile + ']' ) ) ) .writeLog( C_TAB + 'tcType: ' + TRANSFORM( EVL(tcType, '(empty)' ) ) ) .writeLog( C_TAB + 'tcTextName: ' + TRANSFORM( EVL(tcTextName, '(empty)' ) ) ) .writeLog( C_TAB + 'tlGenText: ' + TRANSFORM( EVL(tlGenText, '(empty)' ) ) ) .writeLog( C_TAB + 'tcDontShowErrors: ' + TRANSFORM( EVL(tcDontShowErrors, '(empty) -> Will use Default [' + TRANSFORM(.l_ShowErrors) + ']' ) ) ) .writeLog( C_TAB + 'tcDebug: ' + TRANSFORM( EVL(tcDebug, '(empty) -> Will use Default [' + TRANSFORM(.n_Debug) + ']' ) ) ) .writeLog( C_TAB + 'tcDontShowProgress: ' + TRANSFORM( EVL(tcDontShowProgress, '(empty) -> Will use Default [' + TRANSFORM(.n_ShowProgressbar) + ']' ) ) ) .writeLog( C_TAB + 'tlRelanzarError: ' + TRANSFORM( EVL(tlRelanzarError, '(empty)' ) ) ) .writeLog( C_TAB + 'tcOriginalFileName: ' + TRANSFORM( EVL(tcOriginalFileName, '(empty) -> Will use Default [' + .c_OriginalFileName + ']' ) ) ) .writeLog( C_TAB + 'tcRecompile: ' + TRANSFORM( EVL(tcRecompile, '(empty) -> Will use Default [' + .c_Recompile + ']' ) ) ) .writeLog( C_TAB + 'tcNoTimestamps: ' + TRANSFORM( EVL(tcNoTimestamps, '(empty) -> Will use Default [' + TRANSFORM(.l_NoTimestamps) + ']' ) ) ) .writeLog( C_TAB + 'tcBackupLevels: ' + TRANSFORM( EVL(tcBackupLevels, '(empty) -> Will use Default [' + TRANSFORM(.n_ExtraBackupLevels) + ']' ) ) ) .writeLog( C_TAB + 'tcClearUniqueID: ' + TRANSFORM( EVL(tcClearUniqueID, '(empty) -> Will use Default [' + TRANSFORM(.l_ClearUniqueID) + ']' ) ) ) .writeLog( C_TAB + 'tcOptimizeByFilestamp: ' + TRANSFORM( EVL(tcOptimizeByFilestamp, '(empty) -> Will use Default [' + TRANSFORM(.n_OptimizeByFilestamp) + ']' ) ) ) .writeLog( ) *-- ARCHIVO DE CONFIGURACIÓN PRINCIPAL .evaluateConfiguration( @tcDontShowProgress, @tcDontShowErrors, @tcNoTimestamps, @tcDebug, @tcRecompile, @tcBackupLevels ; , @tcClearUniqueID, @tcOptimizeByFilestamp, @tc_InputFile, @lcInputFile_Type ) loLang = _SCREEN.o_FoxBin2Prg_Lang DO CASE CASE VERSION(5) < 900 *-- '¡FOXBIN2PRG es solo para Visual FoxPro 9.0!' MESSAGEBOX( loLang.C_FOXBIN2PRG_JUST_VFP_9_LOC, 0+64+4096, 'FoxBin2Prg ' + THIS.c_FB2PRG_EXE_Version + ': ' + loLang.C_FOXBIN2PRG_WARN_CAPTION_LOC + ' (' + .c_Language + ')', 60000 ) lnCodError = 1 CASE EMPTY(tc_InputFile) *-- (Ejemplo de sintaxis y uso) *MESSAGEBOX( loLang.C_FOXBIN2PRG_SYNTAX_INFO_EXAMPLE_LOC, 0+64+4096, 'FoxBin2Prg ' + THIS.c_FB2PRG_EXE_Version + ': ' + loLang.C_FOXBIN2PRG_SYNTAX_INFO_LOC + ' (' + .c_Language + ')', 60000 ) loFrm_Main = CREATEOBJECT('frm_main', THIS) loFrm_Main.Show() READ EVENTS lnCodError = 0 OTHERWISE *-- EJECUCIÓN NORMAL IF ATC('-INTERACTIVE', ('-' + tcType)) > 0 ; AND ATC('-BIN2PRG', ('-' + tcType)) = 0 AND ATC('-PRG2BIN', ('-' + tcType)) = 0 ; AND lcInputFile_Type == C_FILETYPE_DIRECTORY THEN *-- Se seleccionó un directorio y se puede elegir: Bin2Txt, Txt2Bin y Nada .writeLog( loLang.C_INTERACTIVE_DIRECTORY_SELECTION_LOC ) loFrm_Interactive = CREATEOBJECT('frm_interactive', THIS) loFrm_Interactive.Show() READ EVENTS lnConversionOption = loFrm_Interactive.n_ConversionType IF loFrm_Interactive.l_FileTimeStampOptimization IF .n_OptimizeByFilestamp = 0 THEN .n_OptimizeByFilestamp = 2 ENDIF ELSE .n_OptimizeByFilestamp = 0 ENDIF loFrm_Interactive.Release() loFrm_Interactive = NULL DO CASE CASE lnConversionOption = 1 && Bin2Txt tcType = tcType + '-BIN2PRG' CASE lnConversionOption = 2 && Txt2Bin tcType = tcType + '-PRG2BIN' OTHERWISE && None ERROR 1799 && Conversion Cancelled ENDCASE ENDIF *-- Evaluación de FileSpec de entrada DO CASE CASE ATC('-BIN2PRG', ('-' + tcType)) = 0 AND ATC('-PRG2BIN', ('-' + tcType)) = 0 ; AND lcInputFile_Type == C_FILETYPE_FILE ; AND ( '*' $ JUSTEXT( tc_InputFile ) OR '?' $ JUSTEXT( tc_InputFile ) ) IF .l_ShowErrors *MESSAGEBOX( 'No se admiten extensiones * o ? porque es peligroso (se pueden pisar binarios con archivo xx2 vacíos).', 0+48+4096, 'FOXBIN2PRG: ERROR!!', 60000 ) MESSAGEBOX( loLang.C_ASTERISK_EXT_NOT_ALLOWED_LOC, 0+48+4096, 'FoxBin2Prg ' + THIS.c_FB2PRG_EXE_Version + ': ' + loLang.C_FOXBIN2PRG_ERROR_CAPTION_LOC, 60000 ) EXIT ELSE ERROR loLang.C_ASTERISK_EXT_NOT_ALLOWED_LOC ENDIF CASE lcInputFile_Type == C_FILETYPE_FILE AND ( '*' $ JUSTSTEM( tc_InputFile ) OR '?' $ JUSTSTEM( tc_InputFile ) ) *-- SE QUIEREN TODOS LOS ARCHIVOS DE UNA EXTENSIÓN lcFileSpec = FULLPATH( tc_InputFile ) .c_LogFile = ADDBS( JUSTPATH( lcFileSpec ) ) + STRTRAN( JUSTFNAME( lcFileSpec ), '*', '_ALL' ) + '.LOG' IF .n_Debug > 0 THEN ERASE ( .c_LogFile ) ENDIF IF EVL(tcType,'0') <> '*' THEN IF .n_ShowProgressbar <> 0 AND .l_ProcessFiles THEN .loadProgressbarForm() ENDIF DO CASE CASE .l_Recompile AND LEN(tcRecompile) > 3 AND DIRECTORY(tcRecompile) CD (tcRecompile) CASE tcRecompile == '1' CD (JUSTPATH(lcFileSpec)) ENDCASE ENDIF lnFileCount = ADIR( laFiles, lcFileSpec, '', 1 ) FOR I = 1 TO lnFileCount lcFile = FORCEPATH( laFiles(I,1), JUSTPATH( lcFileSpec ) ) DO CASE CASE UPPER( JUSTEXT( EVL(tc_InputFile,'') ) ) == 'PJX' AND LEFT(EVL(tcType,'0'),1) == '*' *-- SE QUIEREN CONVERTIR A TEXTO TODOS LOS ARCHIVOS DE UNO O MÁS PROYECTOS PJX *-- Filespec: "*.PJX", "*" .evaluate_Full_PJX(lcFile, tcRecompile, @toModulo, @toEx, tcOriginalFileName, .c_LogFile, tcType) CASE UPPER( JUSTEXT( EVL(tc_InputFile,'') ) ) == 'PJ2' AND LEFT(EVL(tcType,'0'),1) == '*' *-- SE QUIEREN CONVERTIR A BINARIO TODOS LOS ARCHIVOS DE UNO O MÁS PROYECTOS PJ2 *-- Filespec: "*.PJ2", "*" .evaluate_Full_PJ2(lcFile, tcRecompile, @toModulo, @toEx, tcOriginalFileName, .c_LogFile, tcType) CASE ATC('-BIN2PRG', ('-' + tcType)) > 0 *-- SE QUIEREN CONVERTIR A TEXTO TODOS LOS ARCHIVOS DE UN DIRECTORIO *-- Filespec: "*.*" IF .hasSupport_Bin2Prg(lcFile) THEN .updateProgressbar( loLang.C_PROCESSING_LOC + ' ' + lcFile + '...', I, lnFileCount, 0 ) lnCodError = .convert( lcFile, @toModulo, @toEx, .F., tcOriginalFileName ) .writeLog_Flush() DO CASE CASE lnCodError = 1799 && Conversion Cancelled ERROR 1799 CASE lnCodError > 0 .doWriteErrorLog( @toEx ) llError = .T. .l_Error = .F. ENDCASE ENDIF CASE ATC('-PRG2BIN', ('-' + tcType)) > 0 *-- SE QUIEREN CONVERTIR A BINARIO TODOS LOS ARCHIVOS DE UN DIRECTORIO *-- Filespec: "*.*" IF .hasSupport_Prg2Bin(lcFile) THEN .updateProgressbar( loLang.C_PROCESSING_LOC + ' ' + lcFile + '...', I, lnFileCount, 0 ) lnCodError = .convert( lcFile, @toModulo, @toEx, .F., tcOriginalFileName ) .writeLog_Flush() DO CASE CASE lnCodError = 1799 && Conversion Cancelled ERROR 1799 CASE lnCodError > 0 .doWriteErrorLog( @toEx ) llError = .T. .l_Error = .F. ENDCASE ENDIF OTHERWISE *-- DEMÁS ARCHIVOS *-- Filespec: "*.EXT" .updateProgressbar( loLang.C_PROCESSING_LOC + ' ' + lcFile + '...', I, lnFileCount, 0 ) lnCodError = .convert( lcFile, @toModulo, @toEx, .T., tcOriginalFileName ) .writeLog_Flush() DO CASE CASE lnCodError = 1799 && Conversion Cancelled ERROR 1799 CASE lnCodError > 0 .doWriteErrorLog( @toEx ) ENDCASE ENDCASE ENDFOR IF llError .l_Error = .T. ENDIF EXIT CASE ATC('-BIN2PRG', ('-' + tcType)) > 0 .writeLog( '> ' + loLang.C_OPTION_LOC + ': BIN2PRG' ) IF .n_ShowProgressbar <> 0 AND .l_ProcessFiles THEN .loadProgressbarForm() .o_Frm_Avance.Caption = STRTRAN( .o_Frm_Avance.Caption, '> -', '(Bin>Txt) -' ) ENDIF DO CASE CASE lcInputFile_Type == C_FILETYPE_DIRECTORY *-- CONVERSION BIN2PRG DE UN DIRECTORIO Y SUBDIRECTORIOS .writeLog( '> InputFile ' + loLang.C_IS_A_DIRECTORY_LOC ) .writeLog() DO CASE CASE .l_Recompile AND LEN(tcRecompile) > 3 AND DIRECTORY(tcRecompile) CD (tcRecompile) CASE .l_Recompile CD (tc_InputFile) ENDCASE .c_LogFile = ADDBS(tc_InputFile) + tcType + '.LOG' IF .n_Debug > 0 THEN ERASE ( .c_LogFile ) ENDIF .get_FilesFromDirectory( tc_InputFile, @laFiles, @lnFileCount ) FOR I = 1 TO lnFileCount lcFile = laFiles(I) IF NOT .hasSupport_Bin2Prg( JUSTEXT(lcFile) ) OR NOT FILE(lcFile) THEN LOOP ENDIF .updateProgressbar( loLang.C_PROCESSING_LOC + ' ' + lcFile + '...', I, lnFileCount, 0 ) lnCodError = .convert( lcFile, @toModulo, @toEx, .F., tcOriginalFileName ) .writeLog_Flush() DO CASE CASE lnCodError = 1799 && Conversion Cancelled ERROR 1799 CASE lnCodError > 0 .doWriteErrorLog( @toEx ) ENDCASE ENDFOR .updateProgressbar( loLang.C_END_OF_PROCESS_LOC, lnFileCount, lnFileCount, 0 ) EXIT CASE NOT .hasSupport_Bin2Prg( JUSTEXT(tc_InputFile) ) OR NOT FILE(tc_InputFile) .writeLog( '> InputFile ' + loLang.C_IS_UNSUPPORTED_LOC ) .writeLog() EXIT ENDCASE CASE ATC('-PRG2BIN', ('-' + tcType)) > 0 .writeLog( '> ' + loLang.C_OPTION_LOC + ': PRG2BIN' ) IF .n_ShowProgressbar <> 0 AND .l_ProcessFiles THEN .loadProgressbarForm() .o_Frm_Avance.Caption = STRTRAN( .o_Frm_Avance.Caption, '> -', '(Txt>Bin) -' ) ENDIF DO CASE CASE lcInputFile_Type == C_FILETYPE_DIRECTORY *-- CONVERSION PRG2BIN DE UN DIRECTORIO Y SUBDIRECTORIOS .writeLog( '> InputFile ' + loLang.C_IS_A_DIRECTORY_LOC ) .writeLog() DO CASE CASE .l_Recompile AND LEN(tcRecompile) > 3 AND DIRECTORY(tcRecompile) CD (tcRecompile) CASE .l_Recompile CD (tc_InputFile) ENDCASE .c_LogFile = ADDBS(tc_InputFile) + tcType + '.LOG' IF .n_Debug > 0 THEN ERASE ( .c_LogFile ) ENDIF .get_FilesFromDirectory( tc_InputFile, @laFiles, @lnFileCount ) FOR I = 1 TO lnFileCount lcFile = laFiles(I) IF NOT .hasSupport_Prg2Bin( JUSTEXT(lcFile) ) OR NOT FILE(lcFile) THEN LOOP ENDIF .updateProgressbar( loLang.C_PROCESSING_LOC + ' ' + lcFile + '...', I, lnFileCount, 0 ) lnCodError = .convert( lcFile, @toModulo, @toEx, .F., tcOriginalFileName ) .writeLog_Flush() DO CASE CASE lnCodError = 1799 && Conversion Cancelled ERROR 1799 CASE lnCodError > 0 .doWriteErrorLog( @toEx ) ENDCASE ENDFOR .updateProgressbar( loLang.C_END_OF_PROCESS_LOC, lnFileCount, lnFileCount, 0 ) EXIT CASE NOT .hasSupport_Prg2Bin( JUSTEXT(tc_InputFile) ) OR NOT FILE(tc_InputFile) .writeLog( '> InputFile ' + loLang.C_IS_UNSUPPORTED_LOC ) .writeLog() EXIT ENDCASE ENDCASE *-- UN ARCHIVO INDIVIDUAL O CONSULTA DE SOPORTE DE ARCHIVO *IF LEN(EVL(tc_InputFile,'')) = 1 IF lcInputFile_Type = C_FILETYPE_QUERYSUPPORT *-- Consulta de soporte de conversión (compatibilidad con SourceSafe) *-- SourceSafe consulta el tipo de soporte de cada archivo antes del Checkin/Checkout *-- para saber si se puede hacer Diff y Merge. *-- Para los códigos de tipo de archivo ver ayuda de "Type Property" DO CASE CASE tc_InputFile == FILETYPE_DATABASE lnCodError = .DBC_Conversion_Support CASE tc_InputFile == FILETYPE_FREETABLE lnCodError = .DBF_Conversion_Support CASE tc_InputFile == FILETYPE_FORM lnCodError = .SCX_Conversion_Support CASE tc_InputFile == FILETYPE_LABEL lnCodError = .LBX_Conversion_Support CASE tc_InputFile == FILETYPE_MENU lnCodError = .MNX_Conversion_Support CASE tc_InputFile == FILETYPE_REPORT lnCodError = .FRX_Conversion_Support CASE tc_InputFile == FILETYPE_CLASSLIB lnCodError = .VCX_Conversion_Support CASE tc_InputFile $ FILETYPE_PROJECT && PJX (J no exite en FoxPro, es un valor inventado para evitar conflicto con los tipos existentes) lnCodError = .PJX_Conversion_Support OTHERWISE lnCodError = -1 && No support. ENDCASE ELSE DO CASE CASE UPPER( JUSTEXT( EVL(tc_InputFile,'') ) ) == 'PJX' AND LEFT(EVL(tcType,'0'),1) == '*' *-- SE QUIEREN CONVERTIR A TEXTO TODOS LOS ARCHIVOS DE UN PROYECTO PJX .evaluate_Full_PJX(tc_InputFile, tcRecompile, @toModulo, @toEx, @tcOriginalFileName, '', tcType) EXIT CASE UPPER( JUSTEXT( EVL(tc_InputFile,'') ) ) == 'PJ2' AND LEFT(EVL(tcType,'0'),1) == '*' *-- SE QUIEREN CONVERTIR A BINARIO TODOS LOS ARCHIVOS DE UN PROYECTO PJ2 .evaluate_Full_PJ2(tc_InputFile, tcRecompile, @toModulo, @toEx, @tcOriginalFileName, '', tcType) EXIT CASE EVL(tcType,'0') <> '0' AND EVL(tcTextName,'0') <> '0' *-- COMPATIBILIDAD CON SOURCESAFE. 30/01/2014 IF tlGenText .writeLog( '> ' + loLang.C_SOURCESAFE_COMPATIBILITY_MODE_LOC + ': ' + loLang.C_BINARY_TO_TEXT_LOC ) ELSE *-- Create BINARIO desde versión TEXTO *-- Como el archivo de entrada siempre es el binario cuando se usa SCCAPI, *-- para regenerar el binario (tlGenText=.F.) se debe usar como *-- archivo de entrada tcTextName en su lugar. Aquí los intercambio. tc_InputFile = tcTextName .l_Recompile = .T. .writeLog( '> ' + loLang.C_SOURCESAFE_COMPATIBILITY_MODE_LOC + ': ' + loLang.C_TEXT_TO_BINARY_LOC ) ENDIF ENDCASE IF FILE(tc_InputFile) IF .n_ShowProgressbar <> 0 AND .l_ProcessFiles THEN .loadProgressbarForm() ENDIF .writeLog( '> InputFile ' + loLang.C_IS_A_FILE_LOC ) .writeLog() tc_InputFile = LOCFILE(tc_InputFile) DO CASE CASE .l_Recompile AND LEN(tcRecompile) > 3 AND DIRECTORY(tcRecompile) CD (tcRecompile) CASE tcRecompile == '1' CD (JUSTPATH(tc_InputFile)) ENDCASE .c_LogFile = tc_InputFile + '.LOG' IF .n_Debug > 0 THEN ERASE ( .c_LogFile ) ENDIF lnCodError = .convert( tc_InputFile, toModulo, toEx, .T., tcOriginalFileName ) *.updateProgressbar( loLang.C_END_OF_PROCESS_LOC, 1, 1, 0 ) ENDIF ENDIF ENDCASE ENDWITH && THIS CATCH TO toEx IF THIS.l_CancelWithEscKey THEN IF EMPTY(lcOldOnEscape) ON ESCAPE ELSE ON ESCAPE &lcOldOnEscape. ENDIF IF EMPTY(lcOldSetEscape) SET ESCAPE OFF ELSE SET ESCAPE &lcOldSetEscape. ENDIF llEscKeyRestored = .T. ENDIF lnCodError = toEx.ERRORNO lnErrorIcon = 64 IF VARTYPE(loLang) <> 'O' THEN loLang = CREATEOBJECT("CL_LANG","EN") ENDIF IF lnCodError <> 1799 THEN && Conversion Cancelled toEx.UserValue = toEx.UserValue + 'FoxBin2Prg: [' + THIS.c_Foxbin2prg_FullPath + '] (EXE Version: ' + THIS.c_FB2PRG_EXE_Version + ')' + CR_LF lnErrorIcon = 16 ENDIF IF ATC('-SHOWMSG', ('-' + tcType)) > 0 THEN IF lnCodError <> 1799 THEN && Conversion Cancelled toEx.UserValue = toEx.UserValue + 'lcInputFile_Type = [' + TRANSFORM(lcInputFile_Type) + ']' + CR_LF ENDIF THIS.l_ShowErrors = .F. && La opción "SHOWMSG" muestra su propio mensaje ENDIF IF lnCodError <> 1799 THEN && Conversion Cancelled toEx.USERVALUE = toEx.USERVALUE + 'tc_InputFile = [' + TRANSFORM(tc_InputFile) + ']' + CR_LF ENDIF THIS.doWriteErrorLog( @toEx, @lcErrorInfo ) IF THIS.n_Debug > 0 THEN IF _VFP.STARTMODE = 0 SET STEP ON ENDIF ENDIF IF tlRelanzarError THROW ENDIF FINALLY IF NOT llEscKeyRestored AND THIS.l_CancelWithEscKey THEN IF EMPTY(lcOldOnEscape) ON ESCAPE ELSE ON ESCAPE &lcOldOnEscape. ENDIF IF EMPTY(lcOldSetEscape) SET ESCAPE OFF ELSE SET ESCAPE &lcOldSetEscape. ENDIF ENDIF IF VARTYPE(loLang) <> 'O' THEN loLang = CREATEOBJECT("CL_LANG","EN") ENDIF USE IN (SELECT("TABLABIN")) THIS.writeLog_Flush() THIS.unloadProgressbarForm() CD (JUSTPATH(THIS.c_CurDir)) DO CASE CASE EVL( lcInputFile_Type, C_FILETYPE_QUERYSUPPORT ) <> C_FILETYPE_QUERYSUPPORT ; AND ATC('-SHOWMSG', ('-' + tcType)) > 0 ; OR THIS.l_ShowErrors AND lnCodError > 0 AND NOT ISNULL(toEx) THIS.writeErrorLog_Flush() DO CASE CASE lnCodError = 1098 && User Error MESSAGEBOX( toEx.Message, 0+64+4096, 'FoxBin2Prg ' + THIS.c_FB2PRG_EXE_Version, 60000 ) loWSH.Run( THIS.c_ErrorLogFile, 3 ) CASE lnCodError = 1799 && Conversion Cancelled MESSAGEBOX( loLang.C_CONVERSION_CANCELLED_BY_USER_LOC + '!', 0+64+4096, 'FoxBin2Prg ' + THIS.c_FB2PRG_EXE_Version, 60000 ) CASE THIS.l_Error IF ADIR(laDirInfo, THIS.c_ErrorLogFile) > 0 THEN MESSAGEBOX( loLang.C_END_OF_PROCESS_LOC + '! (' + loLang.C_WITH_ERRORS_LOC + ')', 0+48+4096, 'FoxBin2Prg ' + THIS.c_FB2PRG_EXE_Version, 60000 ) loWSH.Run( THIS.c_ErrorLogFile, 3 ) ELSE MESSAGEBOX( loLang.C_END_OF_PROCESS_LOC + '! (' + loLang.C_WITH_ERRORS_LOC + ')' + CR_LF + "[Warning: Can't show Error LOG file because does not exist!]", 0+48+4096, 'FoxBin2Prg ' + THIS.c_FB2PRG_EXE_Version, 60000 ) ENDIF OTHERWISE MESSAGEBOX( loLang.C_END_OF_PROCESS_LOC + '', 0+64+4096, 'FoxBin2Prg ' + THIS.c_FB2PRG_EXE_Version, 60000 ) ENDCASE ENDCASE IF EMPTY(lnCodError) AND THIS.l_Error lnCodError = 1098 ENDIF SET NOTIFY &lc_OldSetNotify. STORE NULL TO loFSO, loWSH RELEASE tc_InputFile, tcType, tcTextName, tlGenText, tcDontShowErrors, tcDebug, tcDontShowProgress ; , toModulo, toEx, tlRelanzarError, tcOriginalFileName, tcRecompile, tcNoTimestamps ; , tcBackupLevels, tcClearUniqueID, tcOptimizeByFilestamp ; , I, lcPath, lcFileSpec, lcFile, laFiles, lnFileCount, lcErrorInfo, lcErrorFile, loEx, loFSO ENDTRY RETURN lnCodError ENDPROC PROCEDURE evaluate_Full_PJX *-------------------------------------------------------------------------------------------------------------- * SE QUIEREN CONVERTIR A TEXTO TODOS LOS ARCHIVOS DE UN PROYECTO PJX *-------------------------------------------------------------------------------------------------------------- * PARÁMETROS: (v=Pasar por valor | @=Pasar por referencia) (!=Obligatorio | ?=Opcional) (IN/OUT) * tc_InputFile (v! IN ) Nombre del archivo de entrada * tcRecompile (v? IN ) Indica recompilar ('1') el binario una vez regenerado. [Cambio de funcionamiento por defecto] * Este cambio es para ganar tiempo, velocidad y seguridad. Además la recompilación que hace FoxBin2Prg * se hace desde el directorio del archivo, con lo que las referencias relativas pueden * generar errores de compilación, típicamente los #include. * NOTA: Si en vez de '1' se indica un Path (p.ej, el del proyecto, se usará como base para recompilar * toModulo (@? OUT) Referencia de objeto del módulo generado (para Unit Testing) * toEx (@? OUT) Objeto con información del error * tcOriginalFileName (v? IN ) Sirve para los casos en los que inputFile es un nombre temporal y se quiere generar * el nombre correcto dentro de la versión texto (por ej: en los PJ2 y las cabeceras) * tcLogFile (v? IN ) Nombre del log a usar * tcType (v? IN ) Tipo de archivo de entrada. Compatibilidad con SCCTEXT.PRG * - Si se indica "*" y tc_InputFile es un PJX, se procesan todos los archivos del proyecto y el PJX/2 * - Si se indica "*-" y tc_InputFile es un PJX, se procesan todos los archivos del proyecto sin el PJX/2 *-------------------------------------------------------------------------------------------------------------- LPARAMETERS tc_InputFile, tcRecompile, toModulo, toEx, tcOriginalFileName, tcLogFile, tcType LOCAL lcFileSpec, lnFileCount, laFiles(1,1), lcFile, lnCodError, I, lnFileCount, llError ; , loLang AS CL_LANG OF 'FOXBIN2PRG.PRG' TRY WITH THIS AS c_foxbin2prg OF 'FOXBIN2PRG.PRG' loLang = _SCREEN.o_FoxBin2Prg_Lang lcFileSpec = FULLPATH( tc_InputFile ) IF .n_ShowProgressbar <> 0 AND .l_ProcessFiles THEN .loadProgressbarForm() .o_Frm_Avance.Caption = STRTRAN( .o_Frm_Avance.Caption, '> -', '(Bin>Txt) -' ) ENDIF IF EMPTY(tcLogFile) .c_LogFile = ADDBS( JUSTPATH( lcFileSpec ) ) + STRTRAN( JUSTFNAME( lcFileSpec ), '*', '_ALL' ) + '.LOG' IF .n_Debug > 0 THEN ERASE ( .c_LogFile ) ENDIF ENDIF .writeLog( '> ' + loLang.C_CONVERT_ALL_FILES_IN_A_PROJECT_LOC + ': ' + loLang.C_BINARY_TO_TEXT_LOC ) DO CASE CASE .l_Recompile AND LEN(tcRecompile) > 3 AND DIRECTORY(tcRecompile) CD (tcRecompile) CASE tcRecompile == '1' CD (JUSTPATH(lcFileSpec)) ENDCASE SELECT 0 USE (tc_InputFile) SHARED AGAIN NOUPDATE ALIAS TABLABIN lnFileCount = 0 SCAN FOR NOT DELETED() AND Type <> 'H' lnFileCount = lnFileCount + 1 DIMENSION laFiles(lnFileCount,1) laFiles(lnFileCount,1) = ADDBS( JUSTPATH( lcFileSpec ) ) + ALLTRIM( NAME, 0, ' ', CHR(0) ) ENDSCAN USE IN (SELECT("TABLABIN")) *-- Convierto primero el proyecto IF tcType <> '*-' THEN lcFile = tc_InputFile lnCodError = .convert( lcFile, toModulo, @toEx, .T., tcOriginalFileName ) .writeLog_Flush() ENDIF *-- Luego convierto los archivos incluidos FOR I = 1 TO lnFileCount lcFile = laFiles(I,1) .updateProgressbar( loLang.C_PROCESSING_LOC + ' ' + lcFile + '...', I, lnFileCount, 0 ) IF .hasSupport_Bin2Prg( UPPER(JUSTEXT(lcFile)) ) AND FILE( lcFile ) lnCodError = .convert( lcFile, toModulo, @toEx, .F., tcOriginalFileName ) .writeLog_Flush() DO CASE CASE lnCodError = 1799 && Conversion Cancelled ERROR 1799 CASE lnCodError > 0 .doWriteErrorLog( @toEx ) llError = .T. .l_Error = .F. ENDCASE ELSE *-- addProcessedFile( tcFile, tcInOutType, tcProcessed, tcHasErrors, tcSupported, tcExpanded ) IF .addProcessedFile( lcFile, 'I', 'P0', 'E0', 'S0', 'X0' ) .updateProcessedFile() ENDIF ENDIF .writeLog_Flush() IF llError .l_Error = .T. ENDIF ENDFOR ENDWITH ENDTRY ENDPROC PROCEDURE evaluate_Full_PJ2 *-------------------------------------------------------------------------------------------------------------- * SE QUIEREN CONVERTIR A BINARIO TODOS LOS ARCHIVOS DE UN PROYECTO PJ2 *-------------------------------------------------------------------------------------------------------------- * PARÁMETROS: (v=Pasar por valor | @=Pasar por referencia) (!=Obligatorio | ?=Opcional) (IN/OUT) * tc_InputFile (v! IN ) Nombre del archivo de entrada * tcRecompile (v? IN ) Indica recompilar ('1') el binario una vez regenerado. [Cambio de funcionamiento por defecto] * Este cambio es para ganar tiempo, velocidad y seguridad. Además la recompilación que hace FoxBin2Prg * se hace desde el directorio del archivo, con lo que las referencias relativas pueden * generar errores de compilación, típicamente los #include. * NOTA: Si en vez de '1' se indica un Path (p.ej, el del proyecto, se usará como base para recompilar * toModulo (@? OUT) Referencia de objeto del módulo generado (para Unit Testing) * toEx (@? OUT) Objeto con información del error * tcOriginalFileName (v? IN ) Sirve para los casos en los que inputFile es un nombre temporal y se quiere generar * el nombre correcto dentro de la versión texto (por ej: en los PJ2 y las cabeceras) * tcLogFile (v? IN ) Nombre del log a usar * tcType (v? IN ) Tipo de archivo de entrada. Compatibilidad con SCCTEXT.PRG * - Si se indica "*" y tc_InputFile es un PJX, se procesan todos los archivos del proyecto y el PJX/2 * - Si se indica "*-" y tc_InputFile es un PJX, se procesan todos los archivos del proyecto sin el PJX/2 *-------------------------------------------------------------------------------------------------------------- LPARAMETERS tc_InputFile, tcRecompile, toModulo, toEx, tcOriginalFileName, tcLogFile, tcType LOCAL lcFileSpec, lnFileCount, laFiles(1,1), lcFile, lnCodError, I, lnFileCount ; , loLang AS CL_LANG OF 'FOXBIN2PRG.PRG' TRY WITH THIS AS c_foxbin2prg OF 'FOXBIN2PRG.PRG' loLang = _SCREEN.o_FoxBin2Prg_Lang lcFileSpec = FULLPATH( tc_InputFile ) IF .n_ShowProgressbar <> 0 AND .l_ProcessFiles THEN .loadProgressbarForm() .o_Frm_Avance.Caption = STRTRAN( .o_Frm_Avance.Caption, '> -', '(Txt>Bin) -' ) ENDIF IF EMPTY(tcLogFile) .c_LogFile = ADDBS( JUSTPATH( lcFileSpec ) ) + STRTRAN( JUSTFNAME( lcFileSpec ), '*', '_ALL' ) + '.LOG' IF .n_Debug > 0 THEN ERASE ( .c_LogFile ) ENDIF ENDIF .writeLog( '> ' + loLang.C_CONVERT_ALL_FILES_IN_A_PROJECT_LOC + ': ' + loLang.C_TEXT_TO_BINARY_LOC ) DO CASE CASE .l_Recompile AND LEN(tcRecompile) > 3 AND DIRECTORY(tcRecompile) CD (tcRecompile) CASE tcRecompile == '1' CD (JUSTPATH(lcFileSpec)) ENDCASE lnFileCount = ALINES( laFiles, STREXTRACT( FILETOSTR(tc_InputFile), C_BUILDPROJ_I, C_BUILDPROJ_F ), 1+4 ) FOR I = lnFileCount TO 1 STEP -1 IF '.ADD(' $ laFiles(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 *-- Convierto primero el proyecto IF tcType <> '*-' THEN lcFile = tc_InputFile lnCodError = .convert( lcFile, toModulo, @toEx, .T., tcOriginalFileName ) .writeLog_Flush() ENDIF *-- Luego convierto los archivos incluidos FOR I = 1 TO lnFileCount lcFile = laFiles(I) .updateProgressbar( loLang.C_PROCESSING_LOC + ' ' + lcFile + '...', I, lnFileCount, 0 ) IF .hasSupport_Prg2Bin( UPPER(JUSTEXT(lcFile)) ) AND FILE( lcFile ) lnCodError = .convert( lcFile, toModulo, @toEx, .F., tcOriginalFileName ) .writeLog_Flush() DO CASE CASE lnCodError = 1799 && Conversion Cancelled ERROR 1799 CASE lnCodError > 0 .doWriteErrorLog( @toEx ) llError = .T. .l_Error = .F. ENDCASE ELSE *-- addProcessedFile( tcFile, tcInOutType, tcProcessed, tcHasErrors, tcSupported, tcExpanded ) IF .addProcessedFile( lcFile, 'I', 'P0', 'E0', 'S0', 'X0' ) .updateProcessedFile() ENDIF ENDIF .writeLog_Flush() IF llError .l_Error = .T. ENDIF ENDFOR ENDWITH ENDTRY ENDPROC HIDDEN PROCEDURE doWriteErrorLog LPARAMETERS toEx as Exception, tcErrorInfo LOCAL loLang as CL_LANG OF 'FOXBIN2PRG.PRG' loLang = _SCREEN.o_FoxBin2Prg_Lang WITH THIS AS c_foxbin2prg OF 'FOXBIN2PRG.PRG' IF toEx.ErrorNo = 1799 THEN && Conversion Cancelled tcErrorInfo = loLang.C_CONVERSION_CANCELLED_BY_USER_LOC ELSE tcErrorInfo = .exception2Str(@toEx) + CR_LF + loLang.C_SOURCEFILE_LOC + TRANSFORM(.c_InputFile) + CR_LF ENDIF ADDPROPERTY(_SCREEN, 'ExitCode', toEx.ERRORNO) *-- Escribo la información de error en la variable log de errores .writeErrorLog( REPLICATE('-', 100), 1 ) .writeLog( tcErrorInfo ) .writeErrorLog( tcErrorInfo ) .writeErrorLog( ) *-- Escribo la información de error en el archivo log de errores TRY STRTOFILE( tcErrorInfo, EVL( .c_InputFile, 'foxbin2prg_errorlog' ) + '.ERR' ) CATCH ENDTRY ENDWITH RETURN ENDPROC PROTECTED PROCEDURE convert *-------------------------------------------------------------------------------------------------------------- * PARÁMETROS: (v=Pasar por valor | @=Pasar por referencia) (!=Obligatorio | ?=Opcional) (IN/OUT) * tc_InputFile (v! IN ) Nombre del archivo de entrada * toModulo (@? OUT) Referencia de objeto del módulo generado (para Unit Testing) * toEx (@? OUT) Objeto con información del error * tlRelanzarError (v? IN ) Indica si el error debe relanzarse o no * tcOriginalFileName (v? IN ) Sirve para los casos en los que inputFile es un nombre temporal y se quiere generar * el nombre correcto dentro de la versión texto (por ej: en los PJ2 y las cabeceras) *-------------------------------------------------------------------------------------------------------------- LPARAMETERS tc_InputFile, toModulo, toEx AS EXCEPTION, tlRelanzarError, tcOriginalFileName TRY LOCAL lnCodError, lcErrorInfo, laDirFile(1,5), lcExtension, lnFileCount, laFiles(1,1), I ; , ltFilestamp, lcExtA, lcExtB, laEvents(1,1), lcForceAttribs, lnIDInputFile ; , loLang as CL_LANG OF 'FOXBIN2PRG.PRG' ; , loConversor as c_conversor_base OF 'FOXBIN2PRG.PRG' ; , loFSO AS Scripting.FileSystemObject lnCodError = 0 WITH THIS AS c_foxbin2prg OF 'FOXBIN2PRG.PRG' loFSO = .o_FSO loLang = _SCREEN.o_FoxBin2Prg_Lang lcForceAttribs = '+N' .c_InputFile = FULLPATH( tc_InputFile ) .l_Error = .F. lcExtension = UPPER( JUSTEXT(.c_InputFile) ) .writeLog( REPLICATE( '*', 100 ) ) .writeLog( 'CONVERSION PROCESS', 2 ) .writeLog( REPLICATE( '*', 100 ) ) IF ADIR( laDirFile, .c_InputFile, '', 1 ) = 0 *ERROR 'No se encontró el archivo [' + .c_InputFile + ']' ERROR loLang.C_FILE_NOT_FOUND_LOC + ' [' + .c_InputFile + ']' ENDIF .c_InputFile = loFSO.GetAbsolutePathName( FORCEPATH( laDirFile(1,1), JUSTPATH(.c_InputFile) ) ) *-- VERIFICO SI HAY ARCHIVO DE CONFIGURACIÓN SECUNDARIO .evaluateConfiguration() IF .n_ForceWriteIfReadOnly = 1 THEN lcForceAttribs = lcForceAttribs + '-R' ENDIF *-- OPTIMIZACIÓN VC2/SC2/DC2: VERIFICO SI EL ARCHIVO BASE FUE PROCESADO PARA DESCARTAR REPROCESOS IF .n_UseClassPerFile > 0 AND .l_RedirectClassPerFileToMain THEN DO CASE CASE .n_UseClassPerFile = 1 AND INLIST(lcExtension,.c_VC2,.c_SC2) IF OCCURS('.', JUSTSTEM(.c_InputFile)) = 0 THEN lc_BaseFile = .c_InputFile ELSE lc_BaseFile = FORCEPATH( FORCEEXT( JUSTSTEM( JUSTSTEM(.c_InputFile) ), JUSTEXT(.c_InputFile)) , JUSTPATH(.c_InputFile) ) ENDIF *-- Verifico si se debe forzar la redirección al archivo principal IF '.' $ JUSTSTEM(.c_InputFile) .c_InputFile = lc_BaseFile ENDIF CASE .n_UseClassPerFile = 2 AND INLIST(lcExtension,.c_VC2,.c_SC2) OR lcExtension = .c_DC2 IF OCCURS('.', JUSTSTEM(.c_InputFile)) = 0 THEN lc_BaseFile = .c_InputFile ELSE lc_BaseFile = FORCEPATH( FORCEEXT( JUSTSTEM( JUSTSTEM( JUSTSTEM(.c_InputFile) ) ), JUSTEXT(.c_InputFile)) , JUSTPATH(.c_InputFile) ) ENDIF *-- Verifico si se debe forzar la redirección al archivo principal IF '.' $ JUSTSTEM(.c_InputFile) .c_InputFile = lc_BaseFile ENDIF ENDCASE ENDIF ERASE ( .c_InputFile + '.ERR' ) IF NOT EMPTY(tcOriginalFileName) tcOriginalFileName = loFSO.GetAbsolutePathName( tcOriginalFileName ) ENDIF .c_OriginalFileName = EVL( tcOriginalFileName, .c_InputFile ) IF UPPER( JUSTEXT(.c_OriginalFileName) ) = 'PJM' .c_OriginalFileName = FORCEEXT(.c_OriginalFileName,'pjx') ENDIF *-- addProcessedFile( tcFile, tcInOutType, tcProcessed, tcHasErrors, tcSupported, tcExpanded ) IF NOT .addProcessedFile( .c_InputFile, 'I', 'P1', 'E0', 'S1', 'X0' ) THEN *.writeLog( 'OPTIMIZACIÓN: El archivo Base [' + JUSTFNAME(lc_BaseFile) + '] ya fue procesado, por lo que no se procesará [' + JUSTFNAME(.c_InputFile) + ']' ) .writeLog( C_TAB + C_TAB + '* ' + TEXTMERGE( loLang.C_CLASSPERFILE_OPTIMIZATION_BASE_ALREADY_PROCESSED_LOC ) ) EXIT ENDIF *.updateProcessedFile() lnIDInputFile = .n_ProcessedFiles .writeLog( C_TAB + 'c_OriginalFileName: ' + .c_OriginalFileName ) .writeLog( ) IF NOT FILE(.c_InputFile) ERROR loLang.C_FILE_DOESNT_EXIST_LOC + ' [' + .c_InputFile + ']' ENDIF .normalizeFileCapitalization( .T. ) DO CASE CASE lcExtension = 'VCX' IF NOT INLIST(.VCX_Conversion_Support, 1, 2) ERROR (TEXTMERGE(loLang.C_FILE_NAME_IS_NOT_SUPPORTED_LOC)) ENDIF .c_OutputFile = FORCEEXT( .c_InputFile, .c_VC2 ) loConversor = CREATEOBJECT( 'c_conversor_vcx_a_prg' ) .changeFileAttribute( FORCEEXT( .c_InputFile, .c_VC2 ), lcForceAttribs ) CASE lcExtension = 'SCX' IF NOT INLIST(.SCX_Conversion_Support, 1, 2) ERROR (TEXTMERGE(loLang.C_FILE_NAME_IS_NOT_SUPPORTED_LOC)) ENDIF .c_OutputFile = FORCEEXT( .c_InputFile, .c_SC2 ) loConversor = CREATEOBJECT( 'c_conversor_scx_a_prg' ) .changeFileAttribute( FORCEEXT( .c_InputFile, .c_SC2 ), lcForceAttribs ) CASE lcExtension = 'PJX' IF NOT INLIST(.PJX_Conversion_Support, 1, 2) ERROR (TEXTMERGE(loLang.C_FILE_NAME_IS_NOT_SUPPORTED_LOC)) ENDIF .c_OutputFile = FORCEEXT( .c_InputFile, .c_PJ2 ) loConversor = CREATEOBJECT( 'c_conversor_pjx_a_prg' ) .changeFileAttribute( FORCEEXT( .c_InputFile, .c_PJ2 ), lcForceAttribs ) CASE lcExtension = 'PJM' IF NOT INLIST(.PJX_Conversion_Support, 1, 2) ERROR (TEXTMERGE(loLang.C_FILE_NAME_IS_NOT_SUPPORTED_LOC)) ENDIF .c_OutputFile = FORCEEXT( .c_InputFile, .c_PJ2 ) loConversor = CREATEOBJECT( 'c_conversor_pjm_a_prg' ) .changeFileAttribute( FORCEEXT( .c_InputFile, .c_PJ2 ), lcForceAttribs ) CASE lcExtension = 'FRX' IF NOT INLIST(.FRX_Conversion_Support, 1, 2) ERROR (TEXTMERGE(loLang.C_FILE_NAME_IS_NOT_SUPPORTED_LOC)) ENDIF .c_OutputFile = FORCEEXT( .c_InputFile, .c_FR2 ) loConversor = CREATEOBJECT( 'c_conversor_frx_a_prg' ) .changeFileAttribute( FORCEEXT( .c_InputFile, .c_FR2 ), lcForceAttribs ) CASE lcExtension = 'LBX' IF NOT INLIST(.LBX_Conversion_Support, 1, 2) ERROR (TEXTMERGE(loLang.C_FILE_NAME_IS_NOT_SUPPORTED_LOC)) ENDIF .c_OutputFile = FORCEEXT( .c_InputFile, .c_LB2 ) loConversor = CREATEOBJECT( 'c_conversor_frx_a_prg' ) .changeFileAttribute( FORCEEXT( .c_InputFile, .c_LB2 ), lcForceAttribs ) CASE lcExtension = 'DBF' IF NOT INLIST(.DBF_Conversion_Support, 1, 2, 4) ERROR (TEXTMERGE(loLang.C_FILE_NAME_IS_NOT_SUPPORTED_LOC)) ENDIF .c_OutputFile = FORCEEXT( .c_InputFile, .c_DB2 ) loConversor = CREATEOBJECT( 'c_conversor_dbf_a_prg' ) .changeFileAttribute( FORCEEXT( .c_InputFile, .c_DB2 ), lcForceAttribs ) CASE lcExtension = 'DBC' IF NOT INLIST(.DBC_Conversion_Support, 1, 2) ERROR (TEXTMERGE(loLang.C_FILE_NAME_IS_NOT_SUPPORTED_LOC)) ENDIF .c_OutputFile = FORCEEXT( .c_InputFile, .c_DC2 ) loConversor = CREATEOBJECT( 'c_conversor_dbc_a_prg' ) .changeFileAttribute( FORCEEXT( .c_InputFile, .c_DC2 ), lcForceAttribs ) CASE lcExtension = 'MNX' IF NOT INLIST(.MNX_Conversion_Support, 1, 2) ERROR (TEXTMERGE(loLang.C_FILE_NAME_IS_NOT_SUPPORTED_LOC)) ENDIF .c_OutputFile = FORCEEXT( .c_InputFile, .c_MN2 ) loConversor = CREATEOBJECT( 'c_conversor_mnx_a_prg' ) .changeFileAttribute( FORCEEXT( .c_InputFile, .c_MN2 ), lcForceAttribs ) CASE lcExtension = .c_VC2 IF .VCX_Conversion_Support <> 2 ERROR (TEXTMERGE(loLang.C_FILE_NAME_IS_NOT_SUPPORTED_LOC)) ENDIF .c_OutputFile = FORCEEXT( .c_InputFile, 'VCX' ) loConversor = CREATEOBJECT( 'c_conversor_prg_a_vcx' ) .changeFileAttribute( FORCEEXT( .c_InputFile, 'VCX' ), lcForceAttribs ) .changeFileAttribute( FORCEEXT( .c_InputFile, 'VCT' ), lcForceAttribs ) CASE lcExtension = .c_SC2 IF .SCX_Conversion_Support <> 2 ERROR (TEXTMERGE(loLang.C_FILE_NAME_IS_NOT_SUPPORTED_LOC)) ENDIF .c_OutputFile = FORCEEXT( .c_InputFile, 'SCX' ) loConversor = CREATEOBJECT( 'c_conversor_prg_a_scx' ) .changeFileAttribute( FORCEEXT( .c_InputFile, 'SCX' ), lcForceAttribs ) .changeFileAttribute( FORCEEXT( .c_InputFile, 'SCT' ), lcForceAttribs ) CASE lcExtension = .c_PJ2 IF .PJX_Conversion_Support <> 2 ERROR (TEXTMERGE(loLang.C_FILE_NAME_IS_NOT_SUPPORTED_LOC)) ENDIF .c_OutputFile = FORCEEXT( .c_InputFile, 'PJX' ) loConversor = CREATEOBJECT( 'c_conversor_prg_a_pjx' ) .changeFileAttribute( FORCEEXT( .c_InputFile, 'PJX' ), lcForceAttribs ) .changeFileAttribute( FORCEEXT( .c_InputFile, 'PJT' ), lcForceAttribs ) CASE lcExtension = .c_FR2 IF .FRX_Conversion_Support <> 2 ERROR (TEXTMERGE(loLang.C_FILE_NAME_IS_NOT_SUPPORTED_LOC)) ENDIF .c_OutputFile = FORCEEXT( .c_InputFile, 'FRX' ) loConversor = CREATEOBJECT( 'c_conversor_prg_a_frx' ) .changeFileAttribute( FORCEEXT( .c_InputFile, 'FRX' ), lcForceAttribs ) .changeFileAttribute( FORCEEXT( .c_InputFile, 'FRT' ), lcForceAttribs ) CASE lcExtension = .c_LB2 IF .LBX_Conversion_Support <> 2 ERROR (TEXTMERGE(loLang.C_FILE_NAME_IS_NOT_SUPPORTED_LOC)) ENDIF .c_OutputFile = FORCEEXT( .c_InputFile, 'LBX' ) loConversor = CREATEOBJECT( 'c_conversor_prg_a_frx' ) .changeFileAttribute( FORCEEXT( .c_InputFile, 'LBX' ), lcForceAttribs ) .changeFileAttribute( FORCEEXT( .c_InputFile, 'LBT' ), lcForceAttribs ) CASE lcExtension = .c_DB2 IF .DBF_Conversion_Support <> 2 ERROR (TEXTMERGE(loLang.C_FILE_NAME_IS_NOT_SUPPORTED_LOC)) ENDIF .c_OutputFile = FORCEEXT( .c_InputFile, 'DBF' ) loConversor = CREATEOBJECT( 'c_conversor_prg_a_dbf' ) .changeFileAttribute( FORCEEXT( .c_InputFile, 'DBF' ), lcForceAttribs ) .changeFileAttribute( FORCEEXT( .c_InputFile, 'FPT' ), lcForceAttribs ) .changeFileAttribute( FORCEEXT( .c_InputFile, 'CDX' ), lcForceAttribs ) CASE lcExtension = .c_DC2 IF .DBC_Conversion_Support <> 2 ERROR (TEXTMERGE(loLang.C_FILE_NAME_IS_NOT_SUPPORTED_LOC)) ENDIF .c_OutputFile = FORCEEXT( .c_InputFile, 'DBC' ) loConversor = CREATEOBJECT( 'c_conversor_prg_a_dbc' ) .changeFileAttribute( FORCEEXT( .c_InputFile, 'DBC' ), lcForceAttribs ) .changeFileAttribute( FORCEEXT( .c_InputFile, 'DCX' ), lcForceAttribs ) .changeFileAttribute( FORCEEXT( .c_InputFile, 'DCT' ), lcForceAttribs ) CASE lcExtension = .c_MN2 IF .MNX_Conversion_Support <> 2 ERROR (TEXTMERGE(loLang.C_FILE_NAME_IS_NOT_SUPPORTED_LOC)) ENDIF .c_OutputFile = FORCEEXT( .c_InputFile, 'MNX' ) loConversor = CREATEOBJECT( 'c_conversor_prg_a_mnx' ) .changeFileAttribute( FORCEEXT( .c_InputFile, 'MNX' ), lcForceAttribs ) .changeFileAttribute( FORCEEXT( .c_InputFile, 'MNT' ), lcForceAttribs ) OTHERWISE *ERROR 'El archivo [' + .c_InputFile + '] no está soportado' ERROR (TEXTMERGE(loLang.C_FILE_NAME_IS_NOT_SUPPORTED_LOC)) ENDCASE *-- Optimización: Comparación de los timestamps de InputFile y OutputFile para saber *-- si el OutputFile se debe regenerar o no. lnFileCount = ADIR( laFiles, FORCEEXT( .c_InputFile, '*' ), '', 1 ) STORE {//::} TO .t_InputFile_TimeStamp, .t_OutputFile_TimeStamp, ltFilestamp IF lnFileCount > 0 THEN *-- Busca el archivo de entrada original I = ASCAN( laFiles, JUSTFNAME(.c_InputFile), 1, 0, 1, 1+2+4+8 ) IF 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 *-- Tomo el máximo timestamp de los archivos de salida (??X/??T) .t_OutputFile_TimeStamp = MAX( .t_OutputFile_TimeStamp, ltFilestamp ) ENDIF ENDIF DO CASE CASE .n_UseClassPerFile = 0 AND .n_OptimizeByFilestamp = 1 AND .t_InputFile_TimeStamp < .t_OutputFile_TimeStamp *-- Optimizado: El Origen es anterior al Destino - No hace falta regenerar *.writeLog( '> El archivo de salida [<>] no se regenera porque su timestamp es más nuevo que el de entrada.' ) .writeLog( C_TAB + C_TAB + '* ' + TEXTMERGE(loLang.C_OUTPUTFILE_TIMESTAMP_NEWER_THAN_INPUTFILE_TIMESTAMP_LOC) ) CASE .n_UseClassPerFile = 0 AND .n_OptimizeByFilestamp = 2 AND .t_InputFile_TimeStamp = .t_OutputFile_TimeStamp *-- Optimizado: El Origen es igual al Destino - No hace falta regenerar *.writeLog( '> El archivo de salida [<>] no se regenera porque su timestamp es igual que el de entrada.' ) .writeLog( C_TAB + C_TAB + '* ' + TEXTMERGE(loLang.C_OUTPUTFILE_TIMESTAMP_EQUAL_THAN_INPUTFILE_TIMESTAMP_LOC) ) OTHERWISE .c_Type = UPPER(JUSTEXT(.c_OutputFile)) loConversor.c_InputFile = .c_InputFile loConversor.c_OutputFile = .c_OutputFile loConversor.c_LogFile = .c_LogFile loConversor.n_Debug = .n_Debug loConversor.l_Test = .l_Test loConversor.n_FB2PRG_Version = .n_FB2PRG_Version loConversor.l_MethodSort_Enabled = .l_MethodSort_Enabled loConversor.l_PropSort_Enabled = .l_PropSort_Enabled loConversor.l_ReportSort_Enabled = .l_ReportSort_Enabled loConversor.c_OriginalFileName = .c_OriginalFileName loConversor.c_Foxbin2prg_FullPath = .c_Foxbin2prg_FullPath *-- .updateProgressbar( loLang.C_PROCESSING_LOC + ' ' + .c_InputFile + '...', 0, 0, 0 ) IF AEVENTS( laEvents, loConversor ) = 0 THEN BINDEVENT( loConversor, 'updateProgressbar', THIS, 'updateProgressbar' ) ENDIF loConversor.convert( @toModulo, .F., THIS ) IF loConversor.l_Error THEN .l_Error = .T. ENDIF .n_ProcessedFilesCount = .n_ProcessedFilesCount + 1 .writeLog() .writeLog(loConversor.c_TextLog) && Recojo el LOG que haya generado el conversor *-- Logueo los errores IF NOT EMPTY(loConversor.c_TextErr) THEN .writeErrorLog( REPLICATE( '-', 100 ), 1 ) .writeErrorLog( loLang.C_ERRORS_FOUND_IN_FILE_LOC + ' [' + .c_InputFile + '] ' ) .writeErrorLog( loConversor.c_TextErr ) .writeErrorLog( ) ENDIF ENDCASE .normalizeFileCapitalization() ENDWITH && THIS AS c_foxbin2prg OF 'FOXBIN2PRG.PRG' CATCH TO toEx lnCodError = toEx.ERRORNO *lcErrorInfo = THIS.exception2Str(toEx) + CR_LF + CR_LF + loLang.C_SOURCEFILE_LOC + THIS.c_InputFile *-- updateProcessedFile( tcProcessed, tcHasErrors, tcSupported, tcReserved ) THIS.updateProcessedFile( lnIDInputFile, '', '', 'E1' ) IF THIS.n_Debug > 0 THEN IF _VFP.STARTMODE = 0 SET STEP ON ENDIF ENDIF IF tlRelanzarError && Usado en Unit Testing THROW ENDIF FINALLY IF AEVENTS( laEvents, loConversor ) > 0 THEN UNBINDEVENTS( loConversor ) ENDIF STORE NULL TO loConversor, loFSO IF lnCodError = 0 AND THIS.l_Error THEN THIS.updateProcessedFile( lnIDInputFile, '', '', 'E1' ) ELSE *THIS.updateProcessedFile( lnIDInputFile ) ENDIF RELEASE tc_InputFile, toModulo, toEx, tlRelanzarError, tcOriginalFileName ; , lcErrorInfo, laDirFile, lcExtension, lnFileCount, laFiles, I ; , ltFilestamp, lcExtA, lcExtB ; , loConversor, loFSO ENDTRY RETURN lnCodError ENDPROC PROCEDURE get_DirSettings *--------------------------------------------------------------------------------------------------- * PARÁMETROS: (v=Pasar por valor | @=Pasar por referencia) (!=Obligatorio | ?=Opcional) (IN/OUT) * tcDir (@? IN ) Directorio del que devolver su configuración * RETORNO (@? OUT) Objeto CFG *--------------------------------------------------------------------------------------------------- LPARAMETERS tcDir IF NOT EMPTY(tcDir) THIS.evaluateConfiguration( '', '', '', '', '', '', '', '', tcDir, 'D' ) ENDIF IF THIS.n_CFG_Actual = 0 THEN loCFG = NULL ELSE loCFG = THIS.o_Configuration(THIS.n_CFG_Actual) ENDIF IF ISNULL(loCFG) THEN lo_CFG = CREATEOBJECT('CL_CFG') lo_CFG.CopyFrom(THIS) ENDIF RETURN loCFG 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 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 y espacios ENDIF RETURN (ln_AT_Cmt > 0) ENDPROC PROCEDURE normalizeFileCapitalization LPARAMETERS tl_NormalizeInputFile, tcFileName TRY LOCAL lcPath, lcEXE_CAPS, lcOutputFile, llRelanzarError, lcType ; , loEx AS EXCEPTION ; , loLang as CL_LANG OF 'FOXBIN2PRG.PRG' ; , loFSO AS Scripting.FileSystemObject WITH THIS AS c_foxbin2prg OF 'FOXBIN2PRG.PRG' loLang = _SCREEN.o_FoxBin2Prg_Lang lcPath = JUSTPATH(.c_Foxbin2prg_FullPath) lcEXE_CAPS = FORCEPATH( 'filename_caps.exe', lcPath ) loFSO = .o_FSO llRelanzarError = NOT tl_NormalizeInputFile IF tl_NormalizeInputFile tcFileName = EVL( tcFileName, .c_InputFile ) lcType = UPPER( JUSTEXT( tcFileName ) ) ELSE tcFileName = EVL( tcFileName, .c_OutputFile ) lcType = .c_Type ENDIF DO CASE CASE .n_ExisteCapitalizacion = -1 *-- La primera vez vale -1, hace la verificación por única vez y cachea la respuesta IF FILE(lcEXE_CAPS) *.writeLog( '* Se ha encontrado el programa de capitalización de nombres [' + lcEXE_CAPS + ']' ) .writeLog( C_TAB + TEXTMERGE(loLang.C_NAMES_CAPITALIZATION_PROGRAM_FOUND_LOC) ) SET PROCEDURE TO (lcEXE_CAPS) ADDITIVE .o_FNC = CREATEOBJECT( 'cl_FileName_Caps' ) RELEASE PROCEDURE (lcEXE_CAPS) .n_ExisteCapitalizacion = 1 ELSE *-- No existe el programa de capitalización, así que no se capitalizan los nombres. *.writeLog( '* No se ha encontrado el programa de capitalización de nombres [' + lcEXE_CAPS + ']' ) .writeLog( C_TAB + TEXTMERGE(loLang.C_NAMES_CAPITALIZATION_PROGRAM_NOT_FOUND_LOC) ) .n_ExisteCapitalizacion = 0 EXIT ENDIF 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 get_FilesFromDirectory LPARAMETERS tcDir, taFiles, lnFileCount EXTERNAL ARRAY taFiles LOCAL laFiles(1), I, lnFiles ; , loLang as CL_LANG OF 'FOXBIN2PRG.PRG' IF TYPE("ALEN(laFiles)") # "N" OR EMPTY(lnFileCount) lnFileCount = 0 DIMENSION taFiles(1) ENDIF tcDir = ADDBS(tcDir) IF DIRECTORY(tcDir) WITH THIS AS c_foxbin2prg OF 'FOXBIN2PRG.PRG' loLang = _SCREEN.o_FoxBin2Prg_Lang .updateProgressbar( loLang.C_SCANNING_FILE_AND_DIR_INFO_LOC + ' ' + tcDir + '...', 0, 0, 0 ) lnFiles = ADIR( laFiles, tcDir + '*.*', 'D', 1) *-- Busco los archivos FOR I = 1 TO lnFiles IF SUBSTR( laFiles(I,5), 5, 1 ) == 'D' LOOP ENDIF lnFileCount = lnFileCount + 1 DIMENSION taFiles(lnFileCount) taFiles(lnFileCount) = tcDir + laFiles(I,1) ENDFOR *-- Busco los subdirectorios FOR I = 1 TO lnFiles IF NOT SUBSTR( laFiles(I,5), 5, 1 ) == 'D' OR LEFT(laFiles(I,1), 1) == '.' LOOP ENDIF .get_FilesFromDirectory( tcDir + laFiles(I,1), @taFiles, @lnFileCount ) ENDFOR ENDWITH ENDIF ENDPROC PROCEDURE readInputVFPParams LPARAMETERS taParams, tnPCount EXTERNAL ARRAY taParams *----------------------------------------------------------------------------- * Obtengo la linea completa de comandos * Adaptado de http://www.news2news.com/vfp/?example=51&function=78 * Facilitado por Mario Lopez en el foro FoxPro de Google Español - 23/12/2013 * https://groups.google.com/d/msg/publicesvfoxpro/llS-kTNrG9M/LA4D3fd152IJ *----------------------------------------------------------------------------- DECLARE INTEGER GetCommandLine IN kernel32 DECLARE INTEGER GlobalSize IN kernel32 INTEGER HMEM DECLARE RtlMoveMemory IN kernel32 AS CopyMemory STRING @Destination, INTEGER SOURCE, INTEGER nLength LOCAL lnAddress, lnBufsize, lsBuffer lnAddress = GetCommandLine() && returns an address in memory lnBufsize = GlobalSize(lnAddress) * allocating and filling a buffer IF lnBufsize <> 0 lsBuffer = REPLICATE(CHR(0), lnBufsize) = CopyMemory(@lsBuffer, lnAddress, lnBufsize) ENDIF lsBuffer = STRTRAN(lsBuffer, '"'+CHR(0), '"'+CHR(13)+CHR(10)) lsBuffer = STRTRAN(lsBuffer, '" ', '"'+CHR(13)+CHR(10), 1, 1) lsBuffer = STRTRAN(lsBuffer, CHR(0), ' ') tnPCount = ALINES( taParams, lsBuffer, 4 ) IF tnPCount > 1 THEN ADEL( taParams, 1 ) tnPCount = tnPCount - 1 DIMENSION taParams(tnPCount) ENDIF RETURN ENDPROC PROCEDURE renameFile LPARAMETERS tcFileName, tcEXE_CAPS, toFSO AS Scripting.FileSystemObject, tlRelanzarError LOCAL lcLog, laFile(1,5) ; , loLang as CL_LANG OF 'FOXBIN2PRG.PRG' loLang = _SCREEN.o_FoxBin2Prg_Lang WITH THIS AS c_foxbin2prg OF 'FOXBIN2PRG.PRG' lcLog = '' .o_FNC.Capitalize( tcFileName, '', 'F', @lcLog, tlRelanzarError, '1' ) IF .n_Debug >= 2 THEN lcLog = SUBSTR(lcLog,3) .writeLog() .writeLog( C_TAB + TEXTMERGE(loLang.C_REQUESTING_CAPITALIZATION_OF_FILE_LOC) ) .writeLog( lcLog ) ENDIF ENDWITH ENDPROC PROCEDURE renameTmpFile2Tx2File LPARAMETERS tcFileName LOCAL lcTmpFile, loFSO AS Scripting.FileSystemObject, loEx as Exception TRY *loFSO = THIS.o_FSO lcTmpFile = tcFileName + '.TMP' THIS.changeFileAttribute( tcFileName, '+N' ) ERASE (tcFileName) RENAME (lcTmpFile) TO (tcFileName) CATCH TO loEx THROW FINALLY *loFSO = NULL ENDTRY RETURN ENDPROC PROCEDURE set_Line LPARAMETERS tcLine, taCodeLines, I tcLine = LTRIM( taCodeLines(I), 0, CHR(9), ' ' ) ENDPROC PROCEDURE errOut *-- DEVOLUCIÓN DE SALIDA A ERROUT (-12) LPARAMETERS tcTexto TRY IF THIS.l_StdOutHabilitado LOCAL loException as Exception, lcOutput, lnOutHandle, lnBytesWritten, lnOverlappedIO lcOutput = EVL(tcTexto,'') + CR_LF lnOutHandle = fb2p_GetStdHandle(-12) && CAPTURAR ERROR DESDE CONSOLA: FOXBIN2PRG.EXE PARAMS 2>&1 | FIND /V "" lnBytesWritten = 0 lnOverlappedIO = 0 fb2p_WriteFile(lnOutHandle, @lcOutput, LEN(lcOutput), @lnBytesWritten, @lnOverlappedIO) ENDIF CATCH TO loException THIS.l_StdOutHabilitado = .F. ENDTRY RETURN ENDPROC PROCEDURE stdOut *-- DEVOLUCIÓN DE SALIDA A STDOUT (-11) LPARAMETERS tcTexto TRY IF THIS.l_StdOutHabilitado LOCAL loException as Exception, lcOutput, lnOutHandle, lnBytesWritten, lnOverlappedIO lcOutput = EVL(tcTexto,'') + CR_LF lnOutHandle = fb2p_GetStdHandle(-11) && CAPTURAR STDOUT DESDE CONSOLA: FOXBIN2PRG.EXE PARAMS | FIND /V "" lnBytesWritten = 0 lnOverlappedIO = 0 fb2p_WriteFile(lnOutHandle, @lcOutput, LEN(lcOutput), @lnBytesWritten, @lnOverlappedIO) ENDIF CATCH TO loException THIS.l_StdOutHabilitado = .F. ENDTRY RETURN ENDPROC PROCEDURE updateProcessedFile *--------------------------------------------------------------------------------------------------- * ACTUALIZA ALGUNOS DATOS DEL ARCHIVO PROCESADO ACTUAL *--------------------------------------------------------------------------------------------------- * PARÁMETROS: (v=Pasar por valor | @=Pasar por referencia) (!=Obligatorio | ?=Opcional) (IN/OUT) * tnID (v? IN ) ID del archivo a actualizar. Si no se indica se asume el actual. * tcInOutType (v? IN ) Archivo de entrada o de salida ("I"=Input file, "O"=Output file) * tcProcessed (v? IN ) Procesado ("P0"=Not Processed, "P1"=Processed) * tcHasErrors (v? IN ) Tuvo Errores ("E0"=No Errors, "E1"=Has Errors) * tcSupported (v? IN ) Archivo soportado ("S0"=Unsupported, "S1"=Supported) * tcExpanded (v? IN ) Tipo de archivo ("X0"=Normal file, "X1"=Expanded multipart file) *--------------------------------------------------------------------------------------------------- LPARAMETERS tnID, tcInOutType, tcProcessed, tcHasErrors, tcSupported, tcExpanded TRY LOCAL loEx as Exception WITH THIS AS c_foxbin2prg OF 'FOXBIN2PRG.PRG' IF .n_ProcessedFiles = 0 THEN EXIT ENDIF tnID = EVL(tnID, .n_ProcessedFiles) IF NOT EMPTY(tcInOutType) .a_ProcessedFiles(tnID, 2) = EVL(tcProcessed, '') ENDIF IF NOT EMPTY(tcProcessed) .a_ProcessedFiles(tnID, 3) = EVL(tcProcessed, '') ENDIF IF NOT EMPTY(tcHasErrors) .a_ProcessedFiles(tnID, 4) = EVL(tcHasErrors, '') ENDIF IF NOT EMPTY(tcSupported) .a_ProcessedFiles(tnID, 5) = EVL(tcSupported, '') ENDIF .stdOut( .a_ProcessedFiles(tnID,2) ; + ',' + .a_ProcessedFiles(tnID,3) ; + ',' + .a_ProcessedFiles(tnID,4) ; + ',' + .a_ProcessedFiles(tnID,5) ; + ',' + .a_ProcessedFiles(tnID,6) ; + ',' + LOWER(.a_ProcessedFiles(tnID,1)) ) ENDWITH CATCH TO loEx IF THIS.n_Debug > 0 THEN IF _VFP.STARTMODE = 0 SET STEP ON ENDIF ENDIF THROW ENDTRY ENDPROC PROCEDURE writeErrorLog LPARAMETERS tcText, tnTimeStamp TRY WITH THIS AS c_foxbin2prg OF 'FOXBIN2PRG.PRG' *-- Según el valor de nTimestamp: *-- 0 = Sin timestamp *-- 1 = Timestamp por delante *-- 2 = Timestamp por detrás .c_TextErr = .c_TextErr ; + IIF( EVL(tnTimeStamp,0) = 1, TTOC(DATETIME(),3) + ' ', '' ) ; + EVL(tcText,'') ; + IIF( EVL(tnTimeStamp,0) = 2, ' ' + TTOC(DATETIME(),3), '' ) ; + CR_LF .errOut(tcText) .l_Error = .T. ENDWITH CATCH ENDTRY ENDPROC PROCEDURE writeErrorLog_Flush WITH THIS AS c_foxbin2prg OF 'FOXBIN2PRG.PRG' IF NOT EMPTY(.c_TextErr) STRTOFILE( .c_TextErr + CR_LF, .c_ErrorLogFile, 1 ) ENDIF .c_TextErr = '' ENDWITH ENDPROC PROCEDURE writeLog LPARAMETERS tcText, tnTimeStamp TRY WITH THIS AS c_foxbin2prg OF 'FOXBIN2PRG.PRG' *-- Según el valor de nTimestamp: *-- 0 = Sin timestamp *-- 1 = Timestamp por delante *-- 2 = Timestamp por detrás .c_TextLog = .c_TextLog ; + IIF( EVL(tnTimeStamp,0) = 1, TTOC(DATETIME(),3) + ' ', '' ) ; + EVL(tcText,'') ; + IIF( EVL(tnTimeStamp,0) = 2, ' ' + TTOC(DATETIME(),3), '' ) ; + CR_LF ENDWITH CATCH ENDTRY ENDPROC PROCEDURE writeLog_Flush WITH THIS AS c_foxbin2prg OF 'FOXBIN2PRG.PRG' IF .n_Debug > 0 AND NOT EMPTY(.c_TextLog) STRTOFILE( .c_TextLog + CR_LF, .c_LogFile, 1 ) ENDIF .c_TextLog = '' ENDWITH ENDPROC HIDDEN PROCEDURE exception2Str LPARAMETERS toEx AS EXCEPTION LOCAL lcError lcError = 'Error ' + TRANSFORM(toEx.ERRORNO) + ', ' + toEx.MESSAGE + CR_LF ; + toEx.PROCEDURE + ', ' + TRANSFORM(toEx.LINENO) + CR_LF IF NOT EMPTY(toEx.LINECONTENTS) AND toEx.ErrorNo <> 1098 lcError = lcError + toEx.LINECONTENTS + CR_LF ENDIF IF NOT EMPTY(toEx.USERVALUE) lcError = lcError + EVL(toEx.USERVALUE,'') ENDIF 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 = 110 Width = 628 ShowWindow = 2 DoCreate = .T. AllowOutput = .F. AutoCenter = .T. BorderStyle = 2 ControlBox = .F. BackColor = RGB(255,255,255) nMax_value = 100 nMax_value2 = 100 nSecsAtStart = (SECONDS()) nLastSecCount = 0 nValue = 0 nValue2 = 0 l_Cancelled = .F. Name = "frm_avance" _memberdata = [] ; + [] ; + [] ; + [] ; + [] ; + [] ; + [] ; + [] ; + [] ; + [] ; + [] ; + [] ; + [] ; + [] ADD OBJECT shp_base AS shape WITH ; Top = 28, ; Left = 12, ; Height = 13, ; Width = 604, ; Curvature = 8, ; BorderWidth = 8, ; BackColor = 14215910, ; BorderColor = 14215910, ; Name = "shp_base" ADD OBJECT shp_avance AS shape WITH ; Top = 28, ; Left = 12, ; Height = 13, ; Width = 36, ; Curvature = 8, ; BackColor = 6734335, ; BorderColor = 10476031, ; BorderWidth = 1, ; Name = "shp_Avance" ADD OBJECT shp_base2 AS shape WITH ; Top = 64, ; Left = 12, ; Height = 13, ; Width = 604, ; Curvature = 8, ; BorderWidth = 0, ; BackColor = 14215910, ; BorderColor = 14215910, ; Name = "shp_base2" ADD OBJECT shp_avance2 AS shape WITH ; Top = 64, ; Left = 12, ; Height = 13, ; Width = 36, ; Curvature = 8, ; BackColor = 6734335, ; BorderColor = 10476031, ; BorderWidth = 1, ; Name = "shp_Avance2" ADD OBJECT cmdCancel AS commandbutton WITH ; Top = 84, ; Left = 252, ; Height = 21, ; Width = 100, ; Caption = "Cancel", ; Enabled = .F., ; Name = "cmdCancel" ADD OBJECT lin_1 AS shape WITH ; Top = 28, ; Left = 32, ; Height = 53, ; Width = 0, ; BorderColor = 16777215, ; Name = "lin_1" ADD OBJECT lin_2 AS shape WITH ; Top = 28, ; Left = 52, ; Height = 53, ; Width = 0, ; BorderColor = 16777215, ; Name = "lin_2" ADD OBJECT lin_3 AS shape WITH ; Top = 28, ; Left = 72, ; Height = 53, ; Width = 0, ; BorderColor = 16777215, ; Name = "lin_3" ADD OBJECT lin_4 AS shape WITH ; Top = 28, ; Left = 92, ; Height = 53, ; Width = 0, ; BorderColor = 16777215, ; Name = "lin_4" ADD OBJECT lin_5 AS shape WITH ; Top = 28, ; Left = 112, ; Height = 53, ; Width = 0, ; BorderColor = 16777215, ; Name = "lin_5" ADD OBJECT lin_6 AS shape WITH ; Top = 28, ; Left = 132, ; Height = 53, ; Width = 0, ; BorderColor = 16777215, ; Name = "lin_6" ADD OBJECT lin_7 AS shape WITH ; Top = 28, ; Left = 152, ; Height = 53, ; Width = 0, ; BorderColor = 16777215, ; Name = "lin_7" ADD OBJECT lin_8 AS shape WITH ; Top = 28, ; Left = 172, ; Height = 53, ; Width = 0, ; BorderColor = 16777215, ; Name = "lin_8" ADD OBJECT lin_9 AS shape WITH ; Top = 28, ; Left = 192, ; Height = 53, ; Width = 0, ; BorderColor = 16777215, ; Name = "lin_9" ADD OBJECT lin_10 AS shape WITH ; Top = 28, ; Left = 212, ; Height = 53, ; Width = 0, ; BorderColor = 16777215, ; Name = "lin_10" ADD OBJECT lin_11 AS shape WITH ; Top = 28, ; Left = 232, ; Height = 53, ; Width = 0, ; BorderColor = 16777215, ; Name = "lin_11" ADD OBJECT lin_12 AS shape WITH ; Top = 28, ; Left = 252, ; Height = 53, ; Width = 0, ; BorderColor = 16777215, ; Name = "lin_12" ADD OBJECT lin_13 AS shape WITH ; Top = 28, ; Left = 272, ; Height = 53, ; Width = 0, ; BorderColor = 16777215, ; Name = "lin_13" ADD OBJECT lin_14 AS shape WITH ; Top = 28, ; Left = 292, ; Height = 53, ; Width = 0, ; BorderColor = 16777215, ; Name = "lin_14" ADD OBJECT lin_15 AS shape WITH ; Top = 28, ; Left = 312, ; Height = 53, ; Width = 0, ; BorderColor = 16777215, ; Name = "lin_15" ADD OBJECT lin_16 AS shape WITH ; Top = 28, ; Left = 332, ; Height = 53, ; Width = 0, ; BorderColor = 16777215, ; Name = "lin_16" ADD OBJECT lin_17 AS shape WITH ; Top = 28, ; Left = 352, ; Height = 53, ; Width = 0, ; BorderColor = 16777215, ; Name = "lin_17" ADD OBJECT lin_18 AS shape WITH ; Top = 28, ; Left = 372, ; Height = 53, ; Width = 0, ; BorderColor = 16777215, ; Name = "lin_18" ADD OBJECT lin_19 AS shape WITH ; Top = 28, ; Left = 392, ; Height = 53, ; Width = 0, ; BorderColor = 16777215, ; Name = "lin_19" ADD OBJECT lin_20 AS shape WITH ; Top = 28, ; Left = 412, ; Height = 53, ; Width = 0, ; BorderColor = 16777215, ; Name = "lin_20" ADD OBJECT lin_21 AS shape WITH ; Top = 28, ; Left = 432, ; Height = 53, ; Width = 0, ; BorderColor = 16777215, ; Name = "lin_21" ADD OBJECT lin_22 AS shape WITH ; Top = 28, ; Left = 452, ; Height = 53, ; Width = 0, ; BorderColor = 16777215, ; Name = "lin_22" ADD OBJECT lin_23 AS shape WITH ; Top = 28, ; Left = 472, ; Height = 53, ; Width = 0, ; BorderColor = 16777215, ; Name = "lin_23" ADD OBJECT lin_24 AS shape WITH ; Top = 28, ; Left = 492, ; Height = 53, ; Width = 0, ; BorderColor = 16777215, ; Name = "lin_24" ADD OBJECT lin_25 AS shape WITH ; Top = 28, ; Left = 512, ; Height = 53, ; Width = 0, ; BorderColor = 16777215, ; Name = "lin_25" ADD OBJECT lin_26 AS shape WITH ; Top = 28, ; Left = 532, ; Height = 53, ; Width = 0, ; BorderColor = 16777215, ; Name = "lin_26" ADD OBJECT lin_27 AS shape WITH ; Top = 28, ; Left = 552, ; Height = 53, ; Width = 0, ; BorderColor = 16777215, ; Name = "lin_27" ADD OBJECT lin_28 AS shape WITH ; Top = 28, ; Left = 572, ; Height = 53, ; Width = 0, ; BorderColor = 16777215, ; Name = "lin_28" ADD OBJECT lin_29 AS shape WITH ; Top = 28, ; Left = 592, ; Height = 53, ; Width = 0, ; BorderColor = 16777215, ; Name = "lin_29" ADD OBJECT lbl_tarea AS label WITH ; BackStyle = 0, ; Caption = ".", ; Height = 17, ; Left = 12, ; Top = 8, ; Width = 604, ; Name = "lbl_Tarea" ADD OBJECT lbl_tarea2 AS label WITH ; BackStyle = 0, ; Caption = ".", ; Height = 17, ; Left = 12, ; Top = 44, ; Width = 604, ; Name = "lbl_Tarea2" ADD OBJECT 'lblStartTime' AS label WITH ; BackStyle = 0, ; Caption = "Start time: __/__/____ __:__:__", ; Height = 17, ; Left = 12, ; Name = "lblStartTime", ; Top = 88, ; Width = 176 ADD OBJECT 'lblElapsedTime' AS label WITH ; BackStyle = 0, ; Caption = "Elapsed Time: __:__:__", ; Height = 17, ; Left = 480, ; Name = "lblElapsedTime", ; Top = 88, ; Width = 136 PROCEDURE updateProgressbar LPARAMETERS tcTexto, tnValor, tnTotal, tnTipo WITH THISFORM AS frm_avance OF foxbin2prg.prg LOCAL lnSecs lnSecs = SECONDS() IF lnSecs - .nLastSecCount > 0 THEN .lblElapsedTime.Caption = 'Elapsed Time: ' + TTOC( {^2000-1-1,00:00:00} + lnSecs - .nSecsAtStart, 2 ) .nLastSecCount = lnSecs ENDIF *-- Habilita el botón de cancelar una vez que se comienzan a pasar valores IF NOT EMPTY(tnValor) THEN IF NOT .cmdCancel.Enabled THEN .cmdCancel.Enabled = .T. ENDIF DOEVENTS ENDIF DO CASE CASE tnTipo = 0 IF NOT EMPTY(tcTexto) THEN .lbl_tarea.Caption = tcTexto ENDIF IF tnTotal > 0 THEN .nMax_value = tnTotal .nValue = tnValor ENDIF CASE tnTipo = 1 IF NOT EMPTY(tcTexto) THEN .lbl_tarea2.Caption = tcTexto ENDIF IF tnTotal > 0 THEN .nMax_value2 = tnTotal .nValue2 = tnValor ENDIF CASE tnTipo = 2 IF NOT EMPTY(tcTexto) THEN .lbl_tarea2.Caption = tcTexto ENDIF IF tnTotal > 0 THEN .nMax_value2 = tnTotal .nValue2 = tnValor ENDIF ENDCASE ENDWITH && THIS RETURN ENDPROC PROCEDURE nValue_assign LPARAMETERS vNewVal WITH THIS .nValue = m.vNewVal .shp_avance.WIDTH = m.vNewVal * .shp_base.WIDTH / .nMax_value ENDWITH ENDPROC PROCEDURE INIT LPARAMETERS toFoxBin2Prg #IF .F. LOCAL toFoxBin2Prg AS c_foxbin2prg OF 'FOXBIN2PRG.PRG' LOCAL THISFORM AS frm_avance OF foxbin2prg.prg #ENDIF LOCAL loLang as CL_LANG OF 'FOXBIN2PRG.PRG' IF VARTYPE(toFoxBin2Prg) = "O" THEN IF TYPE("_SCREEN.o_FoxBin2Prg_Lang") = "O" THEN loLang = _SCREEN.o_FoxBin2Prg_Lang THISFORM.CAPTION = 'FoxBin2Prg ' + _SCREEN.c_FB2PRG_EXE_Version + ' > - ' + loLang.C_PROCESS_PROGRESS_LOC + ' (' + loLang.C_PRESS_ESC_TO_CANCEL + ')' ENDIF IF FILE( FORCEEXT( toFoxBin2Prg.c_Foxbin2prg_FullPath, 'ICO' ) ) THEN THISFORM.Icon = FORCEEXT( toFoxBin2Prg.c_Foxbin2prg_FullPath, 'ICO' ) ENDIF IF FILE( toFoxBin2Prg.c_BackgroundImage ) THEN CLEAR RESOURCES THISFORM.Picture = toFoxBin2Prg.c_BackgroundImage ENDIF ENDIF THISFORM.nValue = 0 THISFORM.nValue2 = 0 THISFORM.nLastSecCount = SECONDS() ENDPROC PROCEDURE nValue2_assign LPARAMETERS vNewVal WITH THIS .nValue2 = m.vNewVal .shp_avance2.WIDTH = m.vNewVal * .shp_base2.WIDTH / .nMax_value2 ENDWITH ENDPROC PROCEDURE cmdCancel.Click THISFORM.l_Cancelled = .T. ENDPROC PROCEDURE lblStartTime.Init THIS.Caption = "Start Time: " + TTOC(DATETIME()) ENDPROC ENDDEFINE DEFINE CLASS frm_interactive AS Form Height = 114 Width = 380 ShowWindow = 2 DoCreate = .T. AllowOutput = .F. AutoCenter = .T. BorderStyle = 2 Caption = "FoxBin2Prg" Closable = .T. ControlBox = .T. AlwaysOnTop = .T. MaxButton = .F. MinButton = .F. BackColor = RGB(255,255,255) n_ConversionType = 3 l_FileTimeStampOptimization = .F. Name = "frm_interactive" _memberdata = [] ; + [] ; + [] ; + [] ADD OBJECT chk_FileTimeStampOptimization AS checkbox WITH ; Alignment = 0, ; BackStyle = 0, ; Caption = "chk_FileTimeStampOptimization", ; ControlSource = "THISFORM.l_FileTimeStampOptimization", ; Enabled = .T., ; Height = 17, ; Left = 40, ; Name = "chk_FileTimeStampOptimization", ; Top = 92, ; Width = 300, ; Visible = .F. ADD OBJECT lbl_title AS label WITH ; WordWrap = .T., ; Alignment = 2, ; BackStyle = 0, ; Caption = "lbl_title", ; Height = 36, ; Left = 12, ; Top = 16, ; Width = 356, ; KeyPreview = .T., ; Name = "lbl_Title" ADD OBJECT cmd_Bin2Prg AS commandbutton WITH ; Top = 58, ; Left = 40, ; Height = 27, ; Width = 92, ; Caption = "cmd_Bin2Prg", ; Name = "cmd_Bin2Prg" ADD OBJECT cmd_Prg2Bin AS commandbutton WITH ; Top = 58, ; Left = 144, ; Height = 27, ; Width = 92, ; Caption = "cmd_Prg2Bin", ; Name = "cmd_Prg2Bin" ADD OBJECT cmd_None AS commandbutton WITH ; Top = 58, ; Left = 248, ; Height = 27, ; Width = 92, ; Caption = "cmd_None", ; Cancel = .T., ; Name = "cmd_None" PROCEDURE INIT LPARAMETERS toFoxBin2Prg #IF .F. LOCAL toFoxBin2Prg AS c_foxbin2prg OF 'FOXBIN2PRG.PRG' #ENDIF LOCAL loLang as CL_LANG OF 'FOXBIN2PRG.PRG' IF VARTYPE(toFoxBin2Prg) = "O" THEN IF VARTYPE(_SCREEN.o_FoxBin2Prg_Lang) = "O" THEN loLang = _SCREEN.o_FoxBin2Prg_Lang IF PEMSTATUS(_SCREEN, 'c_FB2PRG_EXE_Version', 5) THEN THISFORM.Caption = 'FoxBin2Prg ' + _SCREEN.c_FB2PRG_EXE_Version + ' - ' + loLang.C_CONVERT_FOLDER_LOC ENDIF THISFORM.chk_FileTimeStampOptimization.Caption = loLang.C_USE_FILE_TIMESTAMP_OPTIMIZATION_LOC THISFORM.lbl_title.Caption = loLang.C_CONVERT_FOLDER_QUESTION_LOC THISFORM.cmd_Bin2Prg.Caption = loLang.C_BINARY_TO_TEXT_LOC THISFORM.cmd_Prg2Bin.Caption = loLang.C_TEXT_TO_BINARY_LOC THISFORM.cmd_None.Caption = loLang.C_CONVERT_FOLDER_NONE_LOC ENDIF THISFORM.l_FileTimeStampOptimization = (toFoxBin2Prg.n_OptimizeByFilestamp <> 0) IF FILE( FORCEEXT( toFoxBin2Prg.c_Foxbin2prg_FullPath, 'ICO' ) ) THEN THISFORM.Icon = FORCEEXT( toFoxBin2Prg.c_Foxbin2prg_FullPath, 'ICO' ) ENDIF ENDIF ENDPROC PROCEDURE QueryUnload THISFORM.n_ConversionType = 3 NODEFAULT THISFORM.do_selection() ENDPROC PROCEDURE do_selection THISFORM.Hide() CLEAR EVENTS ENDPROC PROCEDURE cmd_Bin2Prg.Click *-- Selección THISFORM.n_ConversionType = 1 THISFORM.do_selection() ENDPROC PROCEDURE cmd_Prg2Bin.Click *-- Selección THISFORM.n_ConversionType = 2 THISFORM.do_selection() ENDPROC PROCEDURE cmd_None.Click *-- Selección THISFORM.n_ConversionType = 3 THISFORM.do_selection() ENDPROC ENDDEFINE DEFINE CLASS frm_main AS form AllowOutput = .F. AlwaysOnTop = .T. AutoCenter = .T. BackColor = (RGB(255,255,255)) BorderStyle = 2 Caption = "FoxBin2Prg " Closable = .T. ControlBox = .T. DoCreate = .T. Height = 380 KeyPreview = .T. MaxButton = .F. MinButton = .F. Name = "FRM_MAIN" ShowWindow = 2 Width = 756 ADD OBJECT 'cmd_Close' AS commandbutton WITH ; Cancel = .T., ; Caption = "Cerrar", ; Height = 27, ; Left = 656, ; Name = "cmd_Close", ; Top = 344, ; Width = 84 ADD OBJECT 'edt_Help' AS editbox WITH ; BackStyle = 0, ; BorderStyle = 0, ; DisabledForeColor = (RGB(0,0,0)), ; Enabled = .F., ; Height = 324, ; Left = 12, ; Name = "edt_Help", ; ScrollBars = 0, ; Top = 12, ; Width = 728 PROCEDURE Init LPARAMETERS toFoxBin2Prg #IF .F. LOCAL toFoxBin2Prg AS c_foxbin2prg OF 'FOXBIN2PRG.PRG' #ENDIF LOCAL loLang as CL_LANG OF 'FOXBIN2PRG.PRG' IF VARTYPE(toFoxBin2Prg) = "O" THEN IF VARTYPE(_SCREEN.o_FoxBin2Prg_Lang) = "O" THEN loLang = _SCREEN.o_FoxBin2Prg_Lang IF PEMSTATUS(_SCREEN, 'c_FB2PRG_EXE_Version', 5) THEN THISFORM.Caption = 'FoxBin2Prg ' + _SCREEN.c_FB2PRG_EXE_Version + ' - ' + loLang.C_FOXBIN2PRG_SYNTAX_INFO_LOC ENDIF THISFORM.edt_help.Value = loLang.C_FOXBIN2PRG_SYNTAX_INFO_EXAMPLE_LOC ENDIF IF FILE( FORCEEXT( toFoxBin2Prg.c_Foxbin2prg_FullPath, 'ICO' ) ) THEN THISFORM.Icon = FORCEEXT( toFoxBin2Prg.c_Foxbin2prg_FullPath, 'ICO' ) ENDIF ENDIF ENDPROC PROCEDURE QueryUnload CLEAR EVENTS NODEFAULT ENDPROC PROCEDURE cmd_Close.Click THISFORM.Hide() CLEAR EVENTS ENDPROC ENDDEFINE DEFINE CLASS c_conversor_base AS Custom #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) n_Debug = 0 l_Error = .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 = '' c_TextErr = '' l_MethodSort_Enabled = .T. l_PropSort_Enabled = .T. l_ReportSort_Enabled = .T. c_OriginalFileName = '' c_ClaseActual = '' oFSO = NULL n_Methods_LineNo = 0 && Número de línea del error dentro de "Methods" PROCEDURE INIT LOCAL lcSys16, lnPosProg SET DELETED ON SET DATE YMD SET HOURS TO 24 SET CENTURY ON SET SAFETY OFF SET MULTILOCKS ON SET TABLEPROMPT OFF SET BLOCKSIZE TO 0 SET EXACT ON IF NOT EMPTY( ON("ESCAPE") ) THEN SET ESCAPE ON ENDIF 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() RELEASE lcSys16, lnPosProg RETURN ENDPROC PROCEDURE DESTROY LOCAL loLang as CL_LANG OF 'FOXBIN2PRG.PRG' C_FB2PRG_CODE = '' USE IN (SELECT("TABLABIN")) USE IN (SELECT("foxbin2prg_keywords")) *-- Esta comprobación es por los TESTS, que a veces no cargan o_FoxBin2Prg_Lang IF VARTYPE(_SCREEN.o_FoxBin2Prg_Lang) = "O" THEN loLang = _SCREEN.o_FoxBin2Prg_Lang THIS.writeLog( loLang.C_CONVERTER_UNLOAD_LOC ) ENDIF THIS.oFSO = NULL ENDPROC PROCEDURE analyzeAssignmentOf_TAG *-- DETALLES: Este método está pensado para leer los tags FB2P_VALUE y MEMBERDATA, que tienen esta sintaxis: * * _memberdata = * * && XML Metadata for customizable properties * * Este es un valor especial * *-------------------------------------------------------------------------------------------------------------- * PARÁMETROS: (v=Pasar por valor | @=Pasar por referencia) (!=Obligatorio | ?=Opcional) (IN/OUT) * tcPropName (v! IN ) Nombre de la propiedad * tcValue (v! IN ) Valor (o inicio del valor) de la propiedad * taProps (!@ IN ) El array con las líneas del código donde buscar * tnProp_Count (!@ IN ) Cantidad de líneas de código * I (!@ IN ) Línea actualmente evaluada * tcTAG_I (v! IN ) TAG de inicio * tcTAG_F (v! IN ) TAG de fin * tnLEN_TAG_I (v! IN ) Longitud del tag de inicio * tnLEN_TAG_F (v! IN ) Longitud del tag de fin *-------------------------------------------------------------------------------------------------------------- LPARAMETERS tcPropName, tcValue, taProps, tnProp_Count, I, tcTAG_I, tcTAG_F, tnLEN_TAG_I, tnLEN_TAG_F 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_conversor_base OF 'FOXBIN2PRG.PRG' *-- Propiedad especial IF tcTAG_F $ tcValue && El fin de tag está "inline" .denormalizePropertyValue( @tcPropName, @tcValue, '' ) EXIT ENDIF tcValue = '' lnArrayCols = ALEN(taProps,2) FOR I = 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 .denormalizePropertyValue( @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 .denormalizePropertyValue( @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.n_Debug > 0 AND _VFP.STARTMODE = 0 SET STEP ON ENDIF THROW FINALLY RELEASE tcPropName, tcValue, taProps, tnProp_Count, I, tcTAG_I, tcTAG_F, tnLEN_TAG_I, tnLEN_TAG_F, loEx ENDTRY RETURN llBloqueEncontrado ENDPROC PROCEDURE updateProgressbar LPARAMETERS tcTexto, tnValor, tnTotal, tnTipo ENDPROC PROCEDURE findMethodsObjectByName LPARAMETERS tcNombreObjeto, toClase *-- Caso 1: Un método de un objeto de la clase *-- findMethodsObjectByName( 'command1', loClase ) *-- Caso 2: Un método de un objeto heredado que no está definido en esta librería *-- findMethodsObjectByName( 'cnt_descripcion.Cntlista.cmgAceptarCancelar.cmdCancelar', loClase ) #IF .F. LOCAL toClase AS CL_CLASE OF 'FOXBIN2PRG.PRG' #ENDIF TRY LOCAL lnObjeto, I, X, N, lcRutaDelNombre ; , loObjeto AS CL_OBJETO OF 'FOXBIN2PRG.PRG' STORE 0 TO N, lnObjeto *-- 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.n_Debug > 0 AND _VFP.STARTMODE = 0 SET STEP ON ENDIF THROW FINALLY RELEASE tcNombreObjeto, toClase, I, X, N, lcRutaDelNombre, loObjeto ENDTRY RETURN lnObjeto ENDPROC FUNCTION verifyValidExpression LPARAMETERS tcAsignacion, tnCodError, tcExpNormalizada LOCAL llError, loEx AS EXCEPTION TRY tcExpNormalizada = NORMALIZE( tcAsignacion ) CATCH TO loEx llError = .T. tnCodError = loEx.ERRORNO FINALLY RELEASE tcAsignacion, tnCodError, tcExpNormalizada, loEx ENDTRY RETURN NOT llError ENDFUNC PROCEDURE convert *--------------------------------------------------------------------------------------------------- * PARÁMETROS: (v=Pasar por valor | @=Pasar por referencia) (!=Obligatorio | ?=Opcional) (IN/OUT) * toModulo (!@ OUT) Objeto generado de clase correspondiente con la información leida del texto * toEx (!@ OUT) Objeto con información del error * toFoxBin2Prg (!@ IN ) Referencia al objeto principal *--------------------------------------------------------------------------------------------------- LPARAMETERS toModulo, toEx AS EXCEPTION, toFoxBin2Prg #IF .F. LOCAL toFoxBin2Prg AS c_foxbin2prg OF 'FOXBIN2PRG.PRG' #ENDIF LOCAL loLang as CL_LANG OF 'FOXBIN2PRG.PRG' loLang = _SCREEN.o_FoxBin2Prg_Lang *THIS.writeLog( '' ) THIS.writeLog( C_TAB + loLang.C_CONVERTING_FILE_LOC + ' ' + THIS.c_OutputFile + '...' ) RELEASE toModulo, toEx, toFoxBin2Prg, loLang RETURN ENDPROC PROCEDURE 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 THIS.get_SeparatedLineAndComment( @lcPrevLine ) IF INLIST( RIGHT( lcPrevLine,1 ), ';', ',' ) && Esta línea es continuación de la anterior llIsContinuation = .T. ENDIF RELEASE taCodeLines, I, lcPrevLine RETURN llIsContinuation ENDPROC PROCEDURE isIndicatedToken LPARAMETERS tcLine, ta_ID_Bloques, tnLen_IDFinBQ, X, tnIniFin LOCAL llEncontrado, lcWord, lcLine 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, ta_ID_Bloques(X,3) ) ) == 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 UPPER( LEFT( lcLine, ta_ID_Bloques(X,4) ) ) == 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 FINALLY RELEASE tcLine, ta_ID_Bloques, tnLen_IDFinBQ, X, tnIniFin, lcLine 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 RELEASE I RETURN tcText ENDPROC PROCEDURE decode_SpecialCodes_CR_LF *--------------------------------------------------------------------------------------------------- * PARÁMETROS: (v=Pasar por valor | @=Pasar por referencia) (!=Obligatorio | ?=Opcional) (IN/OUT) * tcText (!@ IN ) Decodifica los caracteres ASCII 10 y 13 de {nCode} a CHR(nCode) *--------------------------------------------------------------------------------------------------- LPARAMETERS tcText tcText = STRTRAN( STRTRAN( tcText, '{10}', CHR(10) ), '{13}', CHR(13) ) RETURN tcText ENDPROC PROCEDURE denormalizeAssignment LPARAMETERS tcAsignacion LOCAL lcPropName, lcValor, lnCodError, lcExpNormalizada, lnPos, lcComentario WITH THIS AS c_conversor_base OF 'FOXBIN2PRG.PRG' .get_SeparatedPropAndValue( @tcAsignacion, @lcPropName, @lcValor ) lcComentario = '' .denormalizePropertyValue( @lcPropName, @lcValor, @lcComentario ) tcAsignacion = lcPropName + ' = ' + lcValor ENDWITH RELEASE lcPropName, lcValor, lnCodError, lcExpNormalizada, lnPos, lcComentario RETURN tcAsignacion ENDPROC PROCEDURE denormalizePropertyValue *-- Este método se ejecuta cuando se regenera el binario desde el tx2 LPARAMETERS tcProp, tcValue, tcComentario LOCAL lnCodError, lnPos, lcValue 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 lcValue = lcValue + CHR(13) + CHR(10) + CHRTRAN( STREXTRACT( tcValue, '', I, 1+4 ), CR_LF, ' ' ) 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 RELEASE tcProp, tcComentario, lnCodError, lnPos, lcValue RETURN tcValue ENDPROC PROCEDURE denormalizeXMLValue LPARAMETERS tcValor *-- DESNORMALIZA EL TEXTO INDICADO, EXPANDIENDO LOS SÍMBOLOS XML ESPECIALES. LOCAL lnPos, lnPos2, lnAscii tcValor = STRTRAN(tcValor, CHR(38)+'gt;', '>') && > tcValor = STRTRAN(tcValor, CHR(38)+'lt;', '<') && < tcValor = STRTRAN(tcValor, CHR(38)+'quot;', CHR(34)) && " tcValor = STRTRAN(tcValor, CHR(38)+'apos;', CHR(39)) && ' tcValor = STRTRAN(tcValor, CHR(38)+'amp;', CHR(38)) && & *-- 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 RELEASE lnPos, lnPos2, lnAscii RETURN tcValor ENDPROC PROCEDURE encode_SpecialCodes_1_31 *--------------------------------------------------------------------------------------------------- * PARÁMETROS: (v=Pasar por valor | @=Pasar por referencia) (!=Obligatorio | ?=Opcional) (IN/OUT) * tcText (!@ IN ) Decodifica los primeros 31 caracteres ASCII de CHR(nCode) a {nCode} *--------------------------------------------------------------------------------------------------- LPARAMETERS tcText LOCAL I FOR I = 0 TO 31 tcText = STRTRAN( tcText, CHR(I), '{' + TRANSFORM(I) + '}' ) ENDFOR RELEASE I RETURN tcText ENDPROC PROCEDURE encode_SpecialCodes_CR_LF *--------------------------------------------------------------------------------------------------- * PARÁMETROS: (v=Pasar por valor | @=Pasar por referencia) (!=Obligatorio | ?=Opcional) (IN/OUT) * tcText (!@ IN ) Codifica los caracteres ASCII 10 y 13 de CHR(nCode) a {nCode} *--------------------------------------------------------------------------------------------------- LPARAMETERS tcText tcText = STRTRAN( STRTRAN( tcText, CHR(10), '{10}' ), CHR(13), '{13}' ) RETURN tcText ENDPROC HIDDEN PROCEDURE exception2Str LPARAMETERS toEx AS EXCEPTION LOCAL lcError lcError = 'Error ' + TRANSFORM(toEx.ERRORNO) + ', ' + toEx.MESSAGE + CHR(13) + CHR(13) ; + toEx.PROCEDURE + ', ' + TRANSFORM(toEx.LINENO) + CHR(13) + CHR(13) ; + toEx.LINECONTENTS RELEASE toEx RETURN lcError ENDPROC PROCEDURE fileTypeCode LPARAMETERS tcExtension 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, laDirInfo[1,5], loEx AS EXCEPTION WITH THIS AS c_conversor_base OF 'FOXBIN2PRG.PRG' lcTimeStamp_Ret = '' IF EMPTY(tnTimeStamp) IF .lFileMode IF ADIR(laDirInfo,.c_InputFile)=0 EXIT ENDIF ltTimeStamp = EVALUATE( '{^' + DTOC(laDirInfo(1,3)) + ' ' + TRANSFORM(laDirInfo(1,4)) + '}' ) *-- En mi arreglo, si la hora pasada tiene 32 segundos o más, redondeo al siguiente minuto, ya que *-- la descodificación posterior de getTimeStamp tiene ese margen de error. IF SEC(m.ltTimeStamp) >= 32 ltTimeStamp = m.ltTimeStamp + 28 ENDIF lcTimeStamp_Ret = TTOC( ltTimeStamp ) EXIT ENDIF tnTimeStamp = .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 ) ENDWITH CATCH TO loEx IF THIS.n_Debug > 0 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, lcVirtualMeta, lnPos1, lnPos2, lnLastPos, lnCantComillas ; , loLang as CL_LANG OF 'FOXBIN2PRG.PRG' loLang = _SCREEN.o_FoxBin2Prg_Lang STORE '' TO lcVirtualMeta STORE 0 TO lnPos1, lnPos2, lnLastPos, tnPropsAndValues_Count, I lcMetadatos = ALLTRIM( STREXTRACT( tcLineWithMetadata, tcLeftTag, tcRightTag, 1, 1) ) lnCantComillas = OCCURS( '"', lcMetadatos ) IF lnCantComillas % 2 <> 0 && Valido que las comillas "" sean pares *ERROR "Error de datos: No se puede parsear porque las comillas no son pares en la línea [" + lcMetadatos + "]" ERROR (TEXTMERGE(loLang.C_DATA_ERROR_CANT_PARSE_UNPAIRING_DOUBLE_QUOTES_LOC)) ENDIF 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 RELEASE tcLineWithMetadata, taPropsAndValues, tnPropsAndValues_Count, tcLeftTag, tcRightTag ; , lcMetadatos, I, lcVirtualMeta, lnPos1, lnPos2, lnLastPos, lnCantComillas 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 *--------------------------------------------------------------------------------------------------- * NOTA: Recordar que esta función suele usarse junto a Set_Line(), que quita TABS y espacios a la izquierda. *--------------------------------------------------------------------------------------------------- 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 y espacios de la derecha de la línea de código ENDIF RELEASE tcLine, tcComment 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 .analyzeAssignmentOf_TAG( @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 .analyzeAssignmentOf_TAG( @tcPropName, @tcValue, @taCodeLines, tnCodeLines, @I ; , C_MEMBERDATA_I, C_MEMBERDATA_F, C_LEN_MEMBERDATA_I, C_LEN_MEMBERDATA_F ) *-- MEMBERDATA OTHERWISE *-- Propiedad normal .denormalizePropertyValue( @tcPropName, @tcValue, '' ) ENDCASE ENDWITH && THIS ENDIF ENDIF RELEASE tcAsignacion, tcPropName, tcValue, toClase, taCodeLines, tnCodeLines, I, ln_AT_Cmt RETURN ENDPROC PROCEDURE get_ValueFromNullTerminatedValue LPARAMETERS tcNullTerminatedValue LOCAL lcValue, lnNullPos lnNullPos = AT(CHR(0), tcNullTerminatedValue ) IF lnNullPos = 0 lcValue = CHRTRAN( tcNullTerminatedValue, ['], ["] ) ELSE lcValue = CHRTRAN( LEFT( tcNullTerminatedValue, lnNullPos - 1 ), ['], ["] ) ENDIF lcValue = THIS.encode_SpecialCodes_CR_LF(lcValue) RELEASE tcNullTerminatedValue, lnNullPos RETURN lcValue ENDPROC PROCEDURE identifyCodeBlocks LPARAMETERS taCodeLines, tnCodeLines, taLineasExclusion, tnBloquesExclusion, toModulo ENDPROC PROCEDURE identifyExclusionBlocks LPARAMETERS taCodeLines, tnCodeLines, ta_ID_Bloques, taLineasExclusion, tnBloquesExclusion, taBloquesExclusion * LOS BLOQUES DE EXCLUSIÓN SON AQUELLOS QUE TIENEN TEXT/ENDTEXT OF #IF/#ENDIF Y SE USAN PARA NO BUSCAR * INSTRUCCIONES COMO "DEFINE CLASS" O "PROCEDURE" EN LOS MISMOS. *-------------------------------------------------------------------------------------------------------------- * PARÁMETROS: (v=Pasar por valor | @=Pasar por referencia) (!=Obligatorio | ?=Opcional) (IN/OUT) * taCodeLines (!@ IN ) El array con las líneas del código de texto donde buscar * tnCodeLines (@? IN ) Cantidad de líneas de código * ta_ID_Bloques (@? IN ) Array de pares de identificadores (2 cols). Ej: '#IF .F.','#ENDI' ; 'TEXT','ENDTEXT' ; etc * taLineasExclusion (@? OUT) Array unidimensional con un .T. o .F. según la línea sea de exclusión o no * tnBloquesExclusion (@? OUT) Cantidad de bloques de exclusión *-------------------------------------------------------------------------------------------------------------- EXTERNAL ARRAY ta_ID_Bloques, taLineasExclusion TRY LOCAL lnBloques, I, X, lnPrimerID, lnLen_IDFinBQ, lnID_Bloques_Count, lcWord, lnAnidamientos, lcLine, lcPrevLine ; , loLang as CL_LANG OF 'FOXBIN2PRG.PRG' loLang = _SCREEN.o_FoxBin2Prg_Lang DIMENSION taLineasExclusion(tnCodeLines), taBloquesExclusion(1,2) STORE 0 TO tnBloquesExclusion, lnPrimerID, I, X IF tnCodeLines > 1 IF EMPTY(ta_ID_Bloques) DIMENSION ta_ID_Bloques(2,4) ta_ID_Bloques(1,1) = '#IF' ta_ID_Bloques(1,2) = '#ENDI' ta_ID_Bloques(1,3) = LEN( ta_ID_Bloques(1,1) ) ta_ID_Bloques(1,4) = LEN( ta_ID_Bloques(1,2) ) ta_ID_Bloques(2,1) = 'TEXT' ta_ID_Bloques(2,2) = 'ENDT' ta_ID_Bloques(2,3) = LEN( ta_ID_Bloques(2,1) ) ta_ID_Bloques(2,4) = LEN( ta_ID_Bloques(2,2) ) lnID_Bloques_Count = ALEN( ta_ID_Bloques, 1 ) ENDIF *-- Búsqueda del ID de inicio de bloque WITH THIS AS c_conversor_base OF 'FOXBIN2PRG.PRG' FOR I = 1 TO tnCodeLines * Reduzco los espacios. Ej: '#IF .F. && cmt' ==> '#IF .F.&&cmt' *lcLine = LTRIM( STRTRAN( STRTRAN( CHRTRAN( taCodeLines(I), CHR(9), ' ' ), ' ', ' ' ), ' ', ' ' ) ) lcLine = LTRIM( taCodeLines(I), 0, CHR(9), ' ' ) IF .lineIsOnlyCommentAndNoMetadata( @lcLine ) *-- Optimización: Excluyo las líneas que solo son comentarios taLineasExclusion(I) = .T. *-- LOOP ENDIF lcLine = UPPER( LEFT( lcLine,1 ) ) + UPPER( LTRIM( SUBSTR( lcLine, 2 ) ) ) lnPrimerID = 0 FOR X = 1 TO lnID_Bloques_Count lnLen_IDFinBQ = LEN( ta_ID_Bloques(X,2) ) IF .isIndicatedToken( @lcLine, @ta_ID_Bloques, lnLen_IDFinBQ, X, 1 ) ; AND NOT .currentLineIsPreviousLineContinuation( @taCodeLines, I ) lnPrimerID = X lnAnidamientos = 1 EXIT ENDIF ENDFOR IF lnPrimerID > 0 && Se ha identificado un ID de bloque excluyente tnBloquesExclusion = tnBloquesExclusion + 1 DIMENSION taBloquesExclusion(tnBloquesExclusion,2) taBloquesExclusion(tnBloquesExclusion,1) = 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), ' ' ), ' ', ' ' ), ' ', ' ' ) ) *lcLine = LTRIM( CHRTRAN( taCodeLines(I), CHR(9), ' ' ) ) lcLine = LTRIM( taCodeLines(I), 0, CHR(9), ' ' ) taLineasExclusion(I) = .T. IF .lineIsOnlyCommentAndNoMetadata( @lcLine ) LOOP ENDIF lcLine = UPPER( LEFT( lcLine,1 ) ) + UPPER( LTRIM( SUBSTR( lcLine, 2 ) ) ) DO CASE CASE lnPrimerID = 1 AND .isIndicatedToken( @lcLine, @ta_ID_Bloques, 0, X, 1 ) ; AND NOT .currentLineIsPreviousLineContinuation( @taCodeLines, I ) *-- Busca el primer marcador (#IF) NOTA: No busco [TEXT] porque no se pueden anidar. lnAnidamientos = lnAnidamientos + 1 CASE .isIndicatedToken( @lcLine, @ta_ID_Bloques, 0, 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)) .n_Methods_LineNo = taBloquesExclusion(tnBloquesExclusion,1) ERROR (TEXTMERGE(loLang.C_END_MARKER_NOT_FOUND_LOC)) ENDIF ENDIF ENDFOR ENDWITH && THIS ENDIF CATCH TO loEx IF THIS.n_Debug > 0 AND _VFP.STARTMODE = 0 SET STEP ON ENDIF THROW FINALLY RELEASE taCodeLines, tnCodeLines, ta_ID_Bloques, taLineasExclusion, tnBloquesExclusion, taBloquesExclusion, loLang ; , lnBloques, I, X, lnPrimerID, lnID_Bloques_Count, lcWord, lnAnidamientos, lcLine, lcPrevLine ENDTRY RETURN ENDPROC PROCEDURE excludedLine LPARAMETERS tn_Linea, tnBloquesExclusion, taLineasExclusion RETURN taLineasExclusion(tn_Linea) ENDPROC PROCEDURE lineIsOnlyCommentAndNoMetadata *--------------------------------------------------------------------------------------------------- * PARÁMETROS: (v=Pasar por valor | @=Pasar por referencia) (!=Obligatorio | ?=Opcional) (IN/OUT) * tcLine (!@ IN/OUT) Línea a separar del comentario * tcComment (@? OUT) Comentario *--------------------------------------------------------------------------------------------------- * NOTA: Recordar que esta función suele usarse junto a Set_Line(), que quita TABS y espacios a la izquierda. *--------------------------------------------------------------------------------------------------- LPARAMETERS tcLine, tcComment LOCAL lllineIsOnlyCommentAndNoMetadata, ln_AT_Cmt WITH THIS AS c_conversor_base OF 'FOXBIN2PRG.PRG' .get_SeparatedLineAndComment( @tcLine, @tcComment ) DO CASE CASE LEFT(tcLine,2) == '*<' tcComment = tcLine CASE EMPTY(tcLine) OR LEFT(tcLine, 1) == '*' OR UPPER(LEFT(tcLine + ' ', 5)) == 'NOTE ' && Vacía o Comentarios lllineIsOnlyCommentAndNoMetadata = .T. ENDCASE ENDWITH RELEASE tcLine, tcComment, ln_AT_Cmt RETURN lllineIsOnlyCommentAndNoMetadata ENDPROC PROCEDURE normalizeAssignment LPARAMETERS tcAsignacion, tcComentario LOCAL lcPropName, lcValor, lnCodError, lcExpNormalizada, lnPos WITH THIS AS c_conversor_base OF 'FOXBIN2PRG.PRG' .get_SeparatedPropAndValue( @tcAsignacion, @lcPropName, @lcValor ) tcComentario = '' .normalizePropertyValue( @lcPropName, @lcValor, @tcComentario ) tcAsignacion = lcPropName + ' = ' + lcValor ENDWITH RELEASE tcComentario, lcPropName, lcValor, lnCodError, lcExpNormalizada, lnPos RETURN tcAsignacion ENDPROC PROCEDURE normalizePropertyValue *-- Este método se ejecuta cuando se genera el tx2 desde el binario LPARAMETERS tcProp, tcValue, tcComentario LOCAL lcValue, I 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 lcValue = lcValue + CHR(13) + CHR(10) + CHR(9) + CHR(9) + CHRTRAN( STREXTRACT( tcValue, '', I, 1+4 ), CR_LF, ' ' ) 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 RELEASE tcProp, lcValue, I, tcComentario RETURN tcValue ENDPROC PROCEDURE normalizeXMLValue LPARAMETERS tcValor *-- NORMALIZA EL TEXTO INDICADO, COMPRIMIENDO LOS SÍMBOLOS XML ESPECIALES. tcValor = STRTRAN(tcValor, CHR(38), CHR(38) + 'amp;') && reemplaza & por & && tcValor = STRTRAN(tcValor, CHR(39), CHR(38) + 'apos;') && reemplaza ' por ' && tcValor = STRTRAN(tcValor, CHR(34), CHR(38) + 'quot;') && reemplaza " por " && tcValor = STRTRAN(tcValor, '<', CHR(38) + 'lt;') && reemplaza < por < && tcValor = STRTRAN(tcValor, '>', CHR(38) + 'gt;') && reemplaza > por > && tcValor = STRTRAN(tcValor, CHR(13)+CHR(10), CHR(10)) && reeemplaza CR+LF por LF tcValor = CHRTRAN(tcValor, CHR(13), CHR(10)) && reemplaza CR por LF 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 set_UserValue LPARAMETERS toEx as Exception ENDPROC PROCEDURE sortPropsAndValues_SetAndGetSCXPropNames *-------------------------------------------------------------------------------------------------------------- * PARÁMETROS: (v=Pasar por valor | @=Pasar por referencia) (!=Obligatorio | ?=Opcional) (IN/OUT) * tcOperation (v! IN ) Operación a realizar ("SETNAME" o "GETNAME") * tcPropName (v! IN ) Nombre de la propiedad *-------------------------------------------------------------------------------------------------------------- LPARAMETERS tcOperation, tcPropName TRY LOCAL lcPropName, lcClass, lnPos ; , loEx AS EXCEPTION ; , loLang as CL_LANG OF 'FOXBIN2PRG.PRG' loLang = _SCREEN.o_FoxBin2Prg_Lang lcPropName = tcPropName tcOperation = UPPER(EVL(tcOperation,'')) DO CASE CASE tcOperation == 'GETNAME' lcPropName = SUBSTR(tcPropName,5) CASE NOT tcOperation == 'SETNAME' ERROR loLang.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 #IF .F. &&USED("foxbin2prg_keywords") THEN lcClass = ICASE( .c_ClaseActual == 'grid', 'all' ; , .c_ClaseActual == 'form', 'all' ; , .c_ClaseActual == 'pageframe', 'all' ; , .c_ClaseActual == 'control', 'all' ; , .c_ClaseActual == 'container', 'all' ; , .c_ClaseActual == 'toolbar', 'all' ; , .c_ClaseActual ) lnPos = IIF( SEEK( PADR(lcClass,15) + PADR(lcPropName,30), 'foxbin2prg_keywords' ), foxbin2prg_keywords.i_order, 0 ) #ELSE DO CASE CASE .c_ClaseActual == 'checkbox' lnPos = ASCAN( .a_SpecialProps_Chk, lcPropName, 1, 0, 1, 1+2+4 ) CASE .c_ClaseActual == 'collection' lnPos = ASCAN( .a_SpecialProps_Coll, lcPropName, 1, 0, 1, 1+2+4 ) CASE .c_ClaseActual == '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 #ENDIF *IF lnPos2 <> lnPos * ERROR 'lnPos y lnPos2 no coinciden para "' + .c_ClaseActual + '.' + lcPropName + '"! lnPos=' + TRANSFORM(lnPos) + ', lnPos2=' + TRANSFORM(lnPos2) *ENDIF *-- Genera una propiedad con el formato "A nnn Propiedad", donde los valores más altos quedan al final, *-- de modo que primero van las props nativas, luego las del usuario y al final "name", que es especial. *-- Ej: "A004ScaleMode", ..., "A998UserProp", "A999Name" lcPropName = 'A' + PADL( EVL(lnPos,998), 3, '0' ) + lcPropName ENDWITH && THIS ENDCASE CATCH TO loEx IF THIS.n_Debug > 0 AND _VFP.STARTMODE = 0 SET STEP ON ENDIF THROW FINALLY RELEASE tcOperation, tcPropName, lnPos, loEx ENDTRY RETURN lcPropName ENDPROC PROCEDURE sortPropsAndValues * KNOWLEDGE BASE: * 02/12/2013 FDBOZZO Fidel Charny me pasó un ejemplo donde se pierden propiedades físicamente * si se ordenan alfabéticamente en un ADD OBJECT. Pierde "picture" y otras más. * Pareciera que la última debe ser "Name". *-------------------------------------------------------------------------------------------------------------- * PARÁMETROS: (v=Pasar por valor | @=Pasar por referencia) (!=Obligatorio | ?=Opcional) (IN/OUT) * taPropsAndValues (!@ IN ) El array con las propiedades y valores del objeto o clase * tnPropsAndValues_Count (v! IN ) Cantidad de propiedades * tnSortType (v! IN ) Tipo de sort: * 0=Solo separar propiedades de clase y de objetos (.) * 1=Sort completo de propiedades (para la versión TEXTO) * 2=Sort completo de propiedades con "Name" al final (para la versión BIN) *-------------------------------------------------------------------------------------------------------------- LPARAMETERS taPropsAndValues, tnPropsAndValues_Count, tnSortType EXTERNAL ARRAY taPropsAndValues TRY LOCAL I, X, lnArrayCols, laPropsAndValues(1,2), lcPropName, lcSortedMemo, lcMethods lnArrayCols = ALEN( taPropsAndValues, 2 ) DIMENSION laPropsAndValues( tnPropsAndValues_Count, lnArrayCols ) ACOPY( taPropsAndValues, laPropsAndValues ) WITH THIS AS c_conversor_base OF 'FOXBIN2PRG.PRG' IF m.tnSortType > 0 * CON SORT: * - A las que no tienen '.' les pongo 'A' por delante, y al resto 'B' por delante para que queden al final 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.n_Debug > 0 AND _VFP.STARTMODE = 0 SET STEP ON ENDIF THROW FINALLY RELEASE taPropsAndValues, tnPropsAndValues_Count, tnSortType ; , I, X, lnArrayCols, laPropsAndValues, lcPropName, lcSortedMemo, lcMethods ENDTRY RETURN ENDPROC PROCEDURE sortSpecialProps TRY LOCAL I, loEx AS EXCEPTION, lcPropsFile lcPropsFile = '' WITH THIS AS conversor_base OF "FOXBIN2PRG.PRG" *-- (TODAS) => Antes era solo FORM #IF .F. *-- 03/04/2015 FDBOZZO *-- Quise comparar la velocidad de los ASCAN(array) contra un SEEK a una tabla de propiedades con índice, y resulta que para *-- unas 1500 propiedades casi no hay diferencias (10 segundos en unos 1600 archivos) :( USE (FULLPATH( 'foxbin2prg_keywords', .c_Foxbin2prg_FullPath )) SHARED NOUPDATE AGAIN IN 0 ORDER PK && C_CLASS+C_KEYWORD #ELSE I = 0 lcPropsFile = FORCEPATH( "props_all.txt", JUSTPATH( .c_Foxbin2prg_FullPath ) ) I = ALINES( .a_SpecialProps, FILETOSTR( lcPropsFile ), 1+4 ) *FOR X = 1 TO I * INSERT INTO foxbin2prg_keywords (c_class, c_keyword, i_order) VALUES ('all', .a_SpecialProps(X), X) *ENDFOR lcPropsFile = FORCEPATH( "props_checkbox.txt", JUSTPATH( .c_Foxbin2prg_FullPath ) ) I = ALINES( .a_SpecialProps_Chk, FILETOSTR( lcPropsFile ), 1+4 ) *FOR X = 1 TO I * INSERT INTO foxbin2prg_keywords (c_class, c_keyword, i_order) VALUES ('checkbox', .a_SpecialProps_Chk(X), X) *ENDFOR lcPropsFile = FORCEPATH( "props_collection.txt", JUSTPATH( .c_Foxbin2prg_FullPath ) ) I = ALINES( .a_SpecialProps_Coll, FILETOSTR( lcPropsFile ), 1+4 ) *FOR X = 1 TO I * INSERT INTO foxbin2prg_keywords (c_class, c_keyword, i_order) VALUES ('collection', .a_SpecialProps_Coll(X), X) *ENDFOR lcPropsFile = FORCEPATH( "props_combobox.txt", JUSTPATH( .c_Foxbin2prg_FullPath ) ) I = ALINES( .a_SpecialProps_Cbo, FILETOSTR( lcPropsFile ), 1+4 ) *FOR X = 1 TO I * INSERT INTO foxbin2prg_keywords (c_class, c_keyword, i_order) VALUES ('combobox', .a_SpecialProps_Cbo(X), X) *ENDFOR lcPropsFile = FORCEPATH( "props_commandgroup.txt", JUSTPATH( .c_Foxbin2prg_FullPath ) ) I = ALINES( .a_SpecialProps_Cmg, FILETOSTR( lcPropsFile ), 1+4 ) *FOR X = 1 TO I * INSERT INTO foxbin2prg_keywords (c_class, c_keyword, i_order) VALUES ('commandgroup', .a_SpecialProps_Cmg(X), X) *ENDFOR lcPropsFile = FORCEPATH( "props_commandbutton.txt", JUSTPATH( .c_Foxbin2prg_FullPath ) ) I = ALINES( .a_SpecialProps_Cmd, FILETOSTR( lcPropsFile ), 1+4 ) *FOR X = 1 TO I * INSERT INTO foxbin2prg_keywords (c_class, c_keyword, i_order) VALUES ('commandbutton', .a_SpecialProps_Cmd(X), X) *ENDFOR lcPropsFile = FORCEPATH( "props_cursor.txt", JUSTPATH( .c_Foxbin2prg_FullPath ) ) I = ALINES( .a_SpecialProps_Cur, FILETOSTR( lcPropsFile ), 1+4 ) *FOR X = 1 TO I * INSERT INTO foxbin2prg_keywords (c_class, c_keyword, i_order) VALUES ('cursor', .a_SpecialProps_Cur(X), X) *ENDFOR lcPropsFile = FORCEPATH( "props_cursoradapter.txt", JUSTPATH( .c_Foxbin2prg_FullPath ) ) I = ALINES( .a_SpecialProps_CA, FILETOSTR( lcPropsFile ), 1+4 ) *FOR X = 1 TO I * INSERT INTO foxbin2prg_keywords (c_class, c_keyword, i_order) VALUES ('cursoradapter', .a_SpecialProps_CA(X), X) *ENDFOR lcPropsFile = FORCEPATH( "props_dataenvironment.txt", JUSTPATH( .c_Foxbin2prg_FullPath ) ) I = ALINES( .a_SpecialProps_DE, FILETOSTR( lcPropsFile ), 1+4 ) *FOR X = 1 TO I * INSERT INTO foxbin2prg_keywords (c_class, c_keyword, i_order) VALUES ('dataenvironment', .a_SpecialProps_DE(X), X) *ENDFOR lcPropsFile = FORCEPATH( "props_editbox.txt", JUSTPATH( .c_Foxbin2prg_FullPath ) ) I = ALINES( .a_SpecialProps_Edt, FILETOSTR( lcPropsFile ), 1+4 ) *FOR X = 1 TO I * INSERT INTO foxbin2prg_keywords (c_class, c_keyword, i_order) VALUES ('editbox', .a_SpecialProps_Edt(X), X) *ENDFOR lcPropsFile = FORCEPATH( "props_formset.txt", JUSTPATH( .c_Foxbin2prg_FullPath ) ) I = ALINES( .a_SpecialProps_Frs, FILETOSTR( lcPropsFile ), 1+4 ) *FOR X = 1 TO I * INSERT INTO foxbin2prg_keywords (c_class, c_keyword, i_order) VALUES ('formset', .a_SpecialProps_Frs(X), X) *ENDFOR *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 ) *FOR X = 1 TO I * INSERT INTO foxbin2prg_keywords (c_class, c_keyword, i_order) VALUES ('column', .a_SpecialProps_Grc(X), X) *ENDFOR lcPropsFile = FORCEPATH( "props_grid_header.txt", JUSTPATH( .c_Foxbin2prg_FullPath ) ) I = ALINES( .a_SpecialProps_Grh, FILETOSTR( lcPropsFile ), 1+4 ) *FOR X = 1 TO I * INSERT INTO foxbin2prg_keywords (c_class, c_keyword, i_order) VALUES ('header', .a_SpecialProps_Grh(X), X) *ENDFOR lcPropsFile = FORCEPATH( "props_hyperlink.txt", JUSTPATH( .c_Foxbin2prg_FullPath ) ) I = ALINES( .a_SpecialProps_Hlk, FILETOSTR( lcPropsFile ), 1+4 ) *FOR X = 1 TO I * INSERT INTO foxbin2prg_keywords (c_class, c_keyword, i_order) VALUES ('hyperlink', .a_SpecialProps_Hlk(X), X) *ENDFOR lcPropsFile = FORCEPATH( "props_image.txt", JUSTPATH( .c_Foxbin2prg_FullPath ) ) I = ALINES( .a_SpecialProps_Img, FILETOSTR( lcPropsFile ), 1+4 ) *FOR X = 1 TO I * INSERT INTO foxbin2prg_keywords (c_class, c_keyword, i_order) VALUES ('image', .a_SpecialProps_Img(X), X) *ENDFOR lcPropsFile = FORCEPATH( "props_label.txt", JUSTPATH( .c_Foxbin2prg_FullPath ) ) I = ALINES( .a_SpecialProps_Lbl, FILETOSTR( lcPropsFile ), 1+4 ) *FOR X = 1 TO I * INSERT INTO foxbin2prg_keywords (c_class, c_keyword, i_order) VALUES ('label', .a_SpecialProps_Lbl(X), X) *ENDFOR lcPropsFile = FORCEPATH( "props_line.txt", JUSTPATH( .c_Foxbin2prg_FullPath ) ) I = ALINES( .a_SpecialProps_Lin, FILETOSTR( lcPropsFile ), 1+4 ) *FOR X = 1 TO I * INSERT INTO foxbin2prg_keywords (c_class, c_keyword, i_order) VALUES ('line', .a_SpecialProps_Lin(X), X) *ENDFOR lcPropsFile = FORCEPATH( "props_listbox.txt", JUSTPATH( .c_Foxbin2prg_FullPath ) ) I = ALINES( .a_SpecialProps_Lst, FILETOSTR( lcPropsFile ), 1+4 ) *FOR X = 1 TO I * INSERT INTO foxbin2prg_keywords (c_class, c_keyword, i_order) VALUES ('listbox', .a_SpecialProps_Lst(X), X) *ENDFOR lcPropsFile = FORCEPATH( "props_olebound.txt", JUSTPATH( .c_Foxbin2prg_FullPath ) ) I = ALINES( .a_SpecialProps_Ole, FILETOSTR( lcPropsFile ), 1+4 ) *FOR X = 1 TO I * INSERT INTO foxbin2prg_keywords (c_class, c_keyword, i_order) VALUES ('olebound', .a_SpecialProps_Ole(X), X) *ENDFOR lcPropsFile = FORCEPATH( "props_optiongroup.txt", JUSTPATH( .c_Foxbin2prg_FullPath ) ) I = ALINES( .a_SpecialProps_Opg, FILETOSTR( lcPropsFile ), 1+4 ) *FOR X = 1 TO I * INSERT INTO foxbin2prg_keywords (c_class, c_keyword, i_order) VALUES ('optiongroup', .a_SpecialProps_Opg(X), X) *ENDFOR lcPropsFile = FORCEPATH( "props_optiongroup_option.txt", JUSTPATH( .c_Foxbin2prg_FullPath ) ) I = ALINES( .a_SpecialProps_Opb, FILETOSTR( lcPropsFile ), 1+4 ) *FOR X = 1 TO I * INSERT INTO foxbin2prg_keywords (c_class, c_keyword, i_order) VALUES ('option', .a_SpecialProps_Opb(X), X) *ENDFOR lcPropsFile = FORCEPATH( "props_projecthook.txt", JUSTPATH( .c_Foxbin2prg_FullPath ) ) I = ALINES( .a_SpecialProps_Phk, FILETOSTR( lcPropsFile ), 1+4 ) *FOR X = 1 TO I * INSERT INTO foxbin2prg_keywords (c_class, c_keyword, i_order) VALUES ('projecthook', .a_SpecialProps_Phk(X), X) *ENDFOR lcPropsFile = FORCEPATH( "props_relation.txt", JUSTPATH( .c_Foxbin2prg_FullPath ) ) I = ALINES( .a_SpecialProps_Rel, FILETOSTR( lcPropsFile ), 1+4 ) *FOR X = 1 TO I * INSERT INTO foxbin2prg_keywords (c_class, c_keyword, i_order) VALUES ('relation', .a_SpecialProps_Rel(X), X) *ENDFOR lcPropsFile = FORCEPATH( "props_reportlistener.txt", JUSTPATH( .c_Foxbin2prg_FullPath ) ) I = ALINES( .a_SpecialProps_Rls, FILETOSTR( lcPropsFile ), 1+4 ) *FOR X = 1 TO I * INSERT INTO foxbin2prg_keywords (c_class, c_keyword, i_order) VALUES ('reportlistener', .a_SpecialProps_Rls(X), X) *ENDFOR lcPropsFile = FORCEPATH( "props_separator.txt", JUSTPATH( .c_Foxbin2prg_FullPath ) ) I = ALINES( .a_SpecialProps_Sep, FILETOSTR( lcPropsFile ), 1+4 ) *FOR X = 1 TO I * INSERT INTO foxbin2prg_keywords (c_class, c_keyword, i_order) VALUES ('separator', .a_SpecialProps_Sep(X), X) *ENDFOR lcPropsFile = FORCEPATH( "props_shape.txt", JUSTPATH( .c_Foxbin2prg_FullPath ) ) I = ALINES( .a_SpecialProps_Shp, FILETOSTR( lcPropsFile ), 1+4 ) *FOR X = 1 TO I * INSERT INTO foxbin2prg_keywords (c_class, c_keyword, i_order) VALUES ('shape', .a_SpecialProps_Shp(X), X) *ENDFOR lcPropsFile = FORCEPATH( "props_spinner.txt", JUSTPATH( .c_Foxbin2prg_FullPath ) ) I = ALINES( .a_SpecialProps_Spn, FILETOSTR( lcPropsFile ), 1+4 ) *FOR X = 1 TO I * INSERT INTO foxbin2prg_keywords (c_class, c_keyword, i_order) VALUES ('spinner', .a_SpecialProps_Spn(X), X) *ENDFOR lcPropsFile = FORCEPATH( "props_textbox.txt", JUSTPATH( .c_Foxbin2prg_FullPath ) ) I = ALINES( .a_SpecialProps_Txt, FILETOSTR( lcPropsFile ), 1+4 ) *FOR X = 1 TO I * INSERT INTO foxbin2prg_keywords (c_class, c_keyword, i_order) VALUES ('textbox', .a_SpecialProps_Txt(X), X) *ENDFOR lcPropsFile = FORCEPATH( "props_timer.txt", JUSTPATH( .c_Foxbin2prg_FullPath ) ) I = ALINES( .a_SpecialProps_Tmr, FILETOSTR( lcPropsFile ), 1+4 ) *FOR X = 1 TO I * INSERT INTO foxbin2prg_keywords (c_class, c_keyword, i_order) VALUES ('timer', .a_SpecialProps_Tmr(X), X) *ENDFOR *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 ) *FOR X = 1 TO I * INSERT INTO foxbin2prg_keywords (c_class, c_keyword, i_order) VALUES ('xmladapter', .a_SpecialProps_XMLAda(X), X) *ENDFOR lcPropsFile = FORCEPATH( "props_xmlfield.txt", JUSTPATH( .c_Foxbin2prg_FullPath ) ) I = ALINES( .a_SpecialProps_XMLFld, FILETOSTR( lcPropsFile ), 1+4 ) *FOR X = 1 TO I * INSERT INTO foxbin2prg_keywords (c_class, c_keyword, i_order) VALUES ('xmlfield', .a_SpecialProps_XMLFld(X), X) *ENDFOR lcPropsFile = FORCEPATH( "props_xmltable.txt", JUSTPATH( .c_Foxbin2prg_FullPath ) ) I = ALINES( .a_SpecialProps_XMLTbl, FILETOSTR( lcPropsFile ), 1+4 ) *FOR X = 1 TO I * INSERT INTO foxbin2prg_keywords (c_class, c_keyword, i_order) VALUES ('xmltable', .a_SpecialProps_XMLTbl(X), X) *ENDFOR #ENDIF ENDWITH CATCH TO loEx loEx.USERVALUE = 'lcPropsFile = ' + lcPropsFile IF THIS.n_Debug > 0 AND _VFP.STARTMODE = 0 SET STEP ON ENDIF THROW ENDTRY RETURN ENDPROC PROCEDURE writeLog LPARAMETERS tcText, tnTimeStamp TRY WITH THIS AS c_conversor_base OF 'FOXBIN2PRG.PRG' *-- Según el valor de nTimestamp: *-- 0 = Sin timestamp *-- 1 = Timestamp por delante *-- 2 = Timestamp por detrás .c_TextLog = .c_TextLog ; + IIF( EVL(tnTimeStamp,0) = 1, TTOC(DATETIME(),3) + ' ', '' ) ; + EVL(tcText,'') ; + IIF( EVL(tnTimeStamp,0) = 2, ' ' + TTOC(DATETIME(),3), '' ) ; + CR_LF ENDWITH CATCH ENDTRY ENDPROC PROCEDURE writeErrorLog LPARAMETERS tcText TRY WITH THIS AS conversor_base OF "FOXBIN2PRG.PRG" .c_TextErr = .c_TextErr + EVL(tcText,'') + CR_LF .l_Error = .T. ENDWITH CATCH ENDTRY ENDPROC 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 convert *--------------------------------------------------------------------------------------------------- * PARÁMETROS: (v=Pasar por valor | @=Pasar por referencia) (!=Obligatorio | ?=Opcional) (IN/OUT) * toModulo (!@ OUT) Objeto generado de clase correspondiente con la información leida del texto * toEx (!@ OUT) Objeto con información del error * toFoxBin2Prg (!@ IN ) Referencia al objeto principal *--------------------------------------------------------------------------------------------------- LPARAMETERS toModulo, toEx AS EXCEPTION, toFoxBin2Prg #IF .F. LOCAL toFoxBin2Prg AS c_foxbin2prg OF 'FOXBIN2PRG.PRG' #ENDIF DODEFAULT( @toModulo, @toEx, @toFoxBin2Prg ) ENDPROC FUNCTION get_ValueByName_FromListNamesWithValues *-- ASIGNO EL VALOR DEL ARRAY DE DATOS Y VALORES PARA LA PROPIEDAD INDICADA LPARAMETERS tcPropName, tcValueType, taPropsAndValues LOCAL lnPos, luPropValue 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 RELEASE tcPropName, tcValueType, taPropsAndValues, lnPos RETURN luPropValue ENDFUNC PROCEDURE analyzeCodeBlock_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 + ' ' WITH THIS AS c_conversor_prg_a_bin OF foxbin2prg.prg llBloqueEncontrado = .T. *-- Metadatos del módulo .get_ListNamesWithValuesFrom_InLine_MetadataTag( @tcLine, @laPropsAndValues, @lnPropsAndValues_Count, C_FB2PRG_META_I, C_FB2PRG_META_F ) toModulo._Version = .get_ValueByName_FromListNamesWithValues( 'Version', 'N', @laPropsAndValues ) toModulo._SourceFile = .get_ValueByName_FromListNamesWithValues( 'SourceFile', 'C', @laPropsAndValues ) ENDWITH ENDIF RELEASE toModulo, tcLine, taCodeLines, I, tnCodeLines RETURN llBloqueEncontrado ENDPROC PROCEDURE analyzeCodeBlock_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 RELEASE toModulo, tcLine, taCodeLines, I, tnCodeLines, laPropsAndValues, lnPropsAndValues_Count RETURN llBloqueEncontrado ENDPROC PROCEDURE createProject LPARAMETERS tcTableOrCursor && 'TABLE' or 'CURSOR' LOCAL lcCursorName tcTableOrCursor = EVL( tcTableOrCursor, 'TABLE' ) lcCursorName = ICASE( tcTableOrCursor = 'TABLE', THIS.c_OutputFile, 'TABLABIN' ) CREATE &tcTableOrCursor. (lcCursorName) ; ( NAME M ; , TYPE C(1) ; , ID N(10) ; , TIMESTAMP N(10) ; , 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 ) IF tcTableOrCursor = 'TABLE' THEN USE (THIS.c_OutputFile) ALIAS TABLABIN AGAIN SHARED ENDIF 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 LPARAMETERS tcTableOrCursor && 'TABLE' or 'CURSOR' LOCAL lcCursorName tcTableOrCursor = EVL( tcTableOrCursor, 'TABLE' ) lcCursorName = ICASE( tcTableOrCursor = 'TABLE', THIS.c_OutputFile, 'TABLABIN' ) CREATE &tcTableOrCursor. (lcCursorName) ; ( 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 ) IF tcTableOrCursor = 'TABLE' THEN USE (THIS.c_OutputFile) ALIAS TABLABIN AGAIN SHARED ENDIF ENDPROC PROCEDURE createClasslib_RecordHeader LPARAMETERS toModulo #IF .F. LOCAL toModulo AS CL_CLASSLIB OF 'FOXBIN2PRG.PRG' #ENDIF INSERT INTO TABLABIN ; ( PLATFORM ; , UNIQUEID ; , RESERVED1 ; , RESERVED7 ) ; VALUES ; ( 'COMMENT' ; , 'Class' ; , 'VERSION = 3.00' ; , toModulo._Comment ) ENDPROC PROCEDURE createForm LPARAMETERS tcTableOrCursor && 'TABLE' or 'CURSOR' LOCAL lcCursorName tcTableOrCursor = EVL( tcTableOrCursor, 'TABLE' ) lcCursorName = ICASE( tcTableOrCursor = 'TABLE', THIS.c_OutputFile, 'TABLABIN' ) CREATE &tcTableOrCursor. (lcCursorName) ; ( 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 ) IF tcTableOrCursor = 'TABLE' THEN USE (THIS.c_OutputFile) ALIAS TABLABIN AGAIN SHARED ENDIF ENDPROC PROCEDURE createForm_RecordHeader LPARAMETERS toModulo #IF .F. LOCAL toModulo AS CL_CLASSLIB OF 'FOXBIN2PRG.PRG' #ENDIF INSERT INTO TABLABIN ; ( PLATFORM ; , UNIQUEID ; , RESERVED1 ; , RESERVED7 ) ; VALUES ; ( 'COMMENT' ; , 'Screen' ; , 'VERSION = 3.00' ; , toModulo._Comment ) ENDPROC PROCEDURE createReport LPARAMETERS tcTableOrCursor && 'TABLE' or 'CURSOR' LOCAL lcCursorName tcTableOrCursor = EVL( tcTableOrCursor, 'TABLE' ) lcCursorName = ICASE( tcTableOrCursor = 'TABLE', THIS.c_OutputFile, 'TABLABIN' ) CREATE &tcTableOrCursor. (lcCursorName) ; ( '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 ) IF tcTableOrCursor = 'TABLE' THEN USE (THIS.c_OutputFile) ALIAS TABLABIN AGAIN SHARED ENDIF ENDPROC PROCEDURE createMenu LPARAMETERS tcTableOrCursor && 'TABLE' or 'CURSOR' LOCAL lcCursorName tcTableOrCursor = EVL( tcTableOrCursor, 'TABLE' ) lcCursorName = ICASE( tcTableOrCursor = 'TABLE', THIS.c_OutputFile, 'TABLABIN' ) CREATE &tcTableOrCursor. (lcCursorName) ; ( '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) ) IF tcTableOrCursor = 'TABLE' THEN USE (THIS.c_OutputFile) ALIAS TABLABIN AGAIN SHARED ENDIF ENDPROC PROCEDURE writeBinaryFile LPARAMETERS toModulo ENDPROC PROCEDURE classProps2Memo *-------------------------------------------------------------------------------------------------------------- * ARMA EL MEMO DE PROPERTIES CON LAS PROPIEDADES Y SUS VALORES *-------------------------------------------------------------------------------------------------------------- * PARÁMETROS: (v=Pasar por valor | @=Pasar por referencia) (!=Obligatorio | ?=Opcional) (IN/OUT) * toClase (!@ IN ) Objeto de la Clase * toFoxBin2Prg (@? IN ) Referencia al objeto principal *-------------------------------------------------------------------------------------------------------------- LPARAMETERS toClase, toFoxBin2Prg #IF .F. LOCAL toClase AS CL_CLASE OF 'FOXBIN2PRG.PRG' LOCAL toFoxBin2Prg AS c_foxbin2prg OF 'FOXBIN2PRG.PRG' #ENDIF *-- ESTRUCTURA A ANALIZAR: Propiedades normales, con CR codificado () y con CR+LF () * HEIGHT = 2.73 * NAME = "c1" * prop1 = .F. && Mi prop 1 * prop_especial_cr = Este es el valor 1 Este el 2 Y Este bajo Shift_Enter el 3 * prop_especial_crlf = * Este es el valor 1 * Este el 2 * Y Este bajo Shift_Enter el 3 * * WIDTH = 27.40 * _MEMBERDATA = * * * && XML Metadata for customizable properties *-- Fin: ESTRUCTURA A ANALIZAR: TRY LOCAL I, lcMemo, laPropsAndValues(1,2), lnPropsAndValues_Count lcMemo = '' IF toClase._Prop_Count > 0 WITH THIS AS c_conversor_prg_a_bin OF foxbin2prg.prg .updateProgressbar( 'Generating Props for Class ' + toClase._Nombre + '...', 0, 1, 2 ) .c_ClaseActual = LOWER(toClase._BaseClass) DIMENSION laPropsAndValues( toClase._Prop_Count, 3 ) ACOPY( toClase._Props, laPropsAndValues ) lnPropsAndValues_Count = toClase._Prop_Count *-- REORDENO LAS PROPIEDADES .sortPropsAndValues( @laPropsAndValues, lnPropsAndValues_Count, 2 ) *-- ARMO EL MEMO A DEVOLVER FOR I = 1 TO lnPropsAndValues_Count * * Skip ZOrderSet if configured to * IF toFoxBin2Prg.l_RemoveZOrderSetFromProps AND ATC( '.ZOrderSet.', '.' + laPropsAndValues(I, 1) + '.' ) > 0 THEN LOOP ENDIF lcMemo = lcMemo + laPropsAndValues(I,1) + ' = ' + laPropsAndValues(I,2) + CR_LF ENDFOR ENDWITH ENDIF && toClase._Prop_Count > 0 CATCH TO loEx IF THIS.n_Debug > 0 AND _VFP.STARTMODE = 0 SET STEP ON ENDIF THROW FINALLY RELEASE toClase, I, laPropsAndValues, lnPropsAndValues_Count 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) lcMemo = '' IF toObjeto._Prop_Count > 0 WITH THIS AS c_conversor_prg_a_bin OF foxbin2prg.prg .c_ClaseActual = LOWER(toObjeto._BaseClass) DIMENSION laPropsAndValues( toObjeto._Prop_Count, 2 ) ACOPY( toObjeto._Props, laPropsAndValues ) *-- REORDENO LAS PROPIEDADES .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 ENDWITH ENDIF RELEASE toObjeto, toClase, I, laPropsAndValues 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 WITH THIS AS c_conversor_prg_a_bin OF foxbin2prg.prg FOR I = 1 TO toClase._Procedure_Count loProcedure = NULL loProcedure = toClase._Procedures(I) IF loProcedure._ProcLine_Count > 0 THEN .updateProgressbar( 'Generating Procedure ' + toClase._Nombre + '.' + loProcedure._Nombre + '...', I, toClase._Procedure_Count, 2 ) IF '.' $ loProcedure._Nombre *-- cboNombre.InteractiveChange ==> No debe acortarse por ser método modificado de combobox heredado de la clase *-- cntDatos.txtEdad.Valid ==> Debe acortarse si cntDatos es un objeto existente lcNombreObjeto = LEFT( loProcedure._Nombre, AT('.', loProcedure._Nombre) - 1 ) IF .findMethodsObjectByName( lcNombreObjeto, toClase ) = 0 TEXT TO lcMemo ADDITIVE TEXTMERGE NOSHOW FLAGS 1 PRETEXT 1+2 <> <> ENDTEXT *lcMemo = lcMemo + C_PROCEDURE + ' ' + loProcedure._Nombre ELSE TEXT TO lcMemo ADDITIVE TEXTMERGE NOSHOW FLAGS 1 PRETEXT 1+2 <> <> ENDTEXT *lcMemo = lcMemo + C_PROCEDURE + ' ' + SUBSTR( loProcedure._Nombre, AT('.', loProcedure._Nombre) + 1 ) ENDIF ELSE TEXT TO lcMemo ADDITIVE TEXTMERGE NOSHOW FLAGS 1 PRETEXT 1+2 <> <> ENDTEXT *lcMemo = lcMemo + C_PROCEDURE + ' ' + loProcedure._Nombre ENDIF *-- Incluir las líneas del método *.updateProgressbar( 'Generating Lines of Procedure ' + toClase._Nombre + '.' + loProcedure._Nombre + '...', I, toClase._Procedure_Count, 2 ) FOR X = 1 TO loProcedure._ProcLine_Count *TEXT TO lcMemo ADDITIVE TEXTMERGE NOSHOW FLAGS 1+2 PRETEXT 1+2 * <> *ENDTEXT lcMemo = lcMemo + CHR(13) + CHR(10) + loProcedure._ProcLines(X) ENDFOR TEXT TO lcMemo ADDITIVE TEXTMERGE NOSHOW FLAGS 1+2 PRETEXT 1+2 <> <<>> ENDTEXT ENDIF ENDFOR ENDWITH loProcedure = NULL RELEASE toClase, I, X, lcNombreObjeto, 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 THIS.updateProgressbar( 'Generating Object Methods for ' + toClase._Nombre + '.' + toObjeto._ObjName + '...', 0, 1, 2 ) FOR I = 1 TO toObjeto._Procedure_Count loProcedure = NULL loProcedure = toObjeto._Procedures(I) TEXT TO lcMemo ADDITIVE TEXTMERGE NOSHOW FLAGS 1 PRETEXT 1+2 <> <> ENDTEXT *-- Incluir las líneas del método FOR X = 1 TO loProcedure._ProcLine_Count lcMemo = lcMemo + CHR(13) + CHR(10) + loProcedure._ProcLines(X) ENDFOR TEXT TO lcMemo ADDITIVE TEXTMERGE NOSHOW FLAGS 1+2 PRETEXT 1+2 <> <<>> ENDTEXT ENDFOR loProcedure = NULL RELEASE toObjeto, toClase, I, X, lcNombreObjeto, loProcedure RETURN lcMemo ENDPROC PROCEDURE getClassPropertyComment *-- Devuelve el comentario (columna 2 del array toClase._Props) de la propiedad indicada, *-- buscándola en la columna 2 por su nombre. LPARAMETERS tcPropName AS STRING, toClase #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 RELEASE tcPropName, toClase, I 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 tcMethodName, toClase, loProcedure, I 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 /// DO NOT USE - NOT IMPLEMENTED! 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 RELEASE tcSeparatedCommaVars, lnPos1, lnPos2, I RETURN 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 RELEASE toClase, I, lcPAM, lcComentario RETURN lcMemo ENDPROC PROCEDURE evaluate_PAM LPARAMETERS tcMemo AS STRING, tcPAM AS STRING, tcPAM_Type AS STRING, tcPAM_Visibility AS STRING 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 tcMemo = tcMemo + lcPAM + CR_LF ENDIF ENDFOR RELEASE tcMemo, tcPAM, tcPAM_Type, tcPAM_Visibility, lcPAM, I RETURN 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 = .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 RELEASE toClase, toObjeto, toFoxBin2Prg, lcPropsMemo, lcMethodsMemo RETURN ENDPROC PROCEDURE insert_AllObjects *-- Recorro primero los objetos con ZOrder definido, y luego los demás *-- NOTA: Como consecuencia de una integración de código, puede que se hayan agregado objetos nuevos (desconocidos), *-- pero todo lo demás tiene un ZOrder definido, que es el número de registro original * 100. LPARAMETERS toClase, toFoxBin2Prg #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 = .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 LOWER(loObjeto._Nombre) == LOWER(lcObjName) N = N + 1 loObjeto._WriteOrder = N .insert_Object( @toClase, @loObjeto, @toFoxBin2Prg ) EXIT ENDIF ENDFOR ENDFOR *-- Recorro los objetos Desconocidos FOR EACH loObjeto IN toClase._AddObjects FOXOBJECT IF loObjeto._WriteOrder = 0 .insert_Object( @toClase, @loObjeto, @toFoxBin2Prg ) ENDIF ENDFOR ENDIF && toClase._AddObject_Count > 0 ENDWITH && THIS CATCH TO loEx IF THIS.n_Debug > 0 AND _VFP.STARTMODE = 0 SET STEP ON ENDIF THROW FINALLY loObjeto = NULL RELEASE toClase, toFoxBin2Prg, N, X, lcObjName, loObjeto ENDTRY RETURN ENDPROC PROCEDURE set_Line LPARAMETERS tcLine, taCodeLines, I tcLine = LTRIM( taCodeLines(I), 0, CHR(9), ' ' ) ENDPROC PROCEDURE analyzeProcedureLines 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' ; , loLang as CL_LANG OF 'FOXBIN2PRG.PRG' loLang = _SCREEN.o_FoxBin2Prg_Lang loProcedure = NULL IF '.' $ tcProcedureAbierto AND VARTYPE(toObjeto) = 'O' AND toObjeto._Procedure_Count > 0 loProcedure = toObjeto._Procedures(toObjeto._Procedure_Count) ELSE llEsProcedureDeClase = .T. loProcedure = toClase._Procedures(toClase._Procedure_Count) ENDIF WITH THIS AS c_conversor_prg_a_bin OF 'FOXBIN2PRG.PRG' FOR I = I + 1 TO tnCodeLines .set_Line( @tcLine, @taCodeLines, I ) IF NOT .excludedLine( 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(loLang.C_STRUCTURE_NESTING_ERROR_ENDPROC_EXPECTED_LOC)) ELSE *ERROR 'Error de anidamiento de estructuras. Se esperaba ENDPROC y se encontró ENDDEFINE en la clase ' ; + toClase._Nombre + ' (' + toObjeto._Nombre + '.' + loProcedure._Nombre + ')' ; + ', línea ' + TRANSFORM(I) + ' del archivo ' + .c_InputFile ERROR (TEXTMERGE(loLang.C_STRUCTURE_NESTING_ERROR_ENDPROC_EXPECTED_2_LOC)) ENDIF ENDCASE ENDIF *-- Quito 2 TABS de la izquierda (si se puede y si el integrador/desarrollador no la lió quitándolos) DO CASE CASE LEFT( taCodeLines(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.n_Debug > 0 AND _VFP.STARTMODE = 0 SET STEP ON ENDIF THROW FINALLY loProcedure = NULL RELEASE toClase, toObjeto, tcLine, taCodeLines, I, tnCodeLines, tcProcedureAbierto, tc_Comentario ; , taLineasExclusion, tnBloquesExclusion, llEsProcedureDeClase, loProcedure ENDTRY RETURN ENDPROC PROCEDURE analyzeCodeBlock_ADD_OBJECT *-------------------------------------------------------------------------------------------------------------- * PARÁMETROS: (v=Pasar por valor | @=Pasar por referencia) (!=Obligatorio | ?=Opcional) (IN/OUT) * toModulo (!@ IN ) Objeto del Modulo * toClase (!@ IN ) Objeto de la Clase * tcLine (!@ IN ) Línea de datos en evaluación * taCodeLines (!@ IN ) El array con las líneas del código de texto donde buscar * I (!@ IN ) Número de línea en evaluación * tnCodeLines (!@ IN ) Cantidad de líneas de código * toFoxBin2Prg (?@ IN ) Referencia al objeto principal *-------------------------------------------------------------------------------------------------------------- LPARAMETERS toModulo, toClase, tcLine, I, taCodeLines, tnCodeLines, toFoxBin2Prg EXTERNAL ARRAY taCodeLines #IF .F. LOCAL toModulo AS CL_CLASSLIB OF 'FOXBIN2PRG.PRG' LOCAL toClase AS CL_CLASE OF 'FOXBIN2PRG.PRG' LOCAL toObjeto AS CL_OBJETO OF 'FOXBIN2PRG.PRG' LOCAL toFoxBin2Prg AS c_foxbin2prg OF 'FOXBIN2PRG.PRG' #ENDIF TRY LOCAL llBloqueEncontrado IF LEFT( tcLine, 11 ) == 'ADD OBJECT ' *-- Estructura a reconocer: ADD OBJECT 'frm_a.Check1' AS check [WITH] WITH THIS AS c_conversor_prg_a_bin OF foxbin2prg.prg LOCAL laPropsAndValues(1,2), lnPropsAndValues_Count, Z, lcProp, lcValue, lcNombre, lcObjName, lnPos ; , loLang as CL_LANG OF 'FOXBIN2PRG.PRG' llBloqueEncontrado = .T. loLang = _SCREEN.o_FoxBin2Prg_Lang tcLine = CHRTRAN( tcLine, ['], ["] ) IF EMPTY(toClase._Fin_Cab) toClase._Fin_Cab = I-1 toClase._Ini_Cuerpo = I ENDIF toObjeto = NULL lcNombre = ALLTRIM( CHRTRAN( STREXTRACT(tcLine, 'ADD OBJECT ', ' AS ', 1, 1), ['"], [] ) ) lcObjName = JUSTEXT( '.' + lcNombre ) .updateProgressbar( 'Analyzing Block Add Object ' + toClase._Nombre + '.' + lcObjName + '...', I, tnCodeLines, 1 ) 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) Z = 0 toObjeto = CREATEOBJECT('CL_OBJETO') *-- Luego se reasigna el ZOrder, pero si no lo hace, se pone último como si se acabara de agregar. *-- Puede pasar si se agrega manualmente al TX2 y se olvida agregar la metadata OBJECTDATA. toObjeto._ZOrder = 9999 toObjeto._Nombre = lcNombre ENDIF toObjeto._ObjName = lcObjName IF '.' $ toObjeto._Nombre toObjeto._Parent = toClase._ObjName + '.' + JUSTSTEM( toObjeto._Nombre ) ELSE toObjeto._Parent = toClase._ObjName ENDIF toObjeto._Nombre = toObjeto._Parent + '.' + toObjeto._ObjName toObjeto._Class = ALLTRIM( STREXTRACT(tcLine + ' WITH', ' AS ', ' WITH', 1, 1) ) *-- Chequeo de nombre de objeto repetido para el mismo contenedor IF toClase._aPathObjName_Count > 0 lnPos = ASCAN( toClase._aPathObjNames, toObjeto._Nombre, 1, 0, 1, 1+2+4+8 ) IF lnPos > 0 THEN *-- ERROR: Objeto Duplicado .writeErrorLog( '* ' + loLang.C_DUPLICATED_OBJECT_LOC + ' "' + toClase._Class + '.' + toObjeto._Nombre ; + '" @line ' + TRANSFORM(I) + ', (1st.Line:' + TRANSFORM(toClase._aPathObjNames(lnPos,2)) + ')' ) ENDIF ENDIF IF NOT toClase.l_ObjectMetadataInHeader OR Z=0 toClase.add_Object( toObjeto ) ENDIF toClase.add_PathObjName(toObjeto._Nombre, I) *-- Propiedades del ADD OBJECT 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 ) * * Skip ZOrderSet if configured to * IF toFoxBin2Prg.l_RemoveZOrderSetFromProps AND ATC( '.ZOrderSet.', '.' + lcProp + '.' ) > 0 THEN LOOP ENDIF toObjeto.add_Property( @lcProp, @lcValue ) ELSE && VALOR FINAL SIN ", ;" (JUSTO ANTES DEL ) .get_SeparatedPropAndValue( tcLine, @lcProp, @lcValue, toClase, @taCodeLines, @tnCodeLines, @I ) * * Skip ZOrderSet if configured to * IF toFoxBin2Prg.l_RemoveZOrderSetFromProps AND ATC( '.ZOrderSet.', '.' + lcProp + '.' ) > 0 THEN LOOP ENDIF toObjeto.add_Property( @lcProp, @lcValue ) ENDIF ENDFOR ENDWITH && THIS ENDIF CATCH TO loEx IF THIS.n_Debug > 0 AND _VFP.STARTMODE = 0 SET STEP ON ENDIF THROW FINALLY RELEASE toModulo, toClase, tcLine, I, taCodeLines, tnCodeLines ; , laPropsAndValues, lnPropsAndValues_Count, Z, lcProp, lcValue, lcNombre, lcObjName ENDTRY RETURN llBloqueEncontrado ENDPROC PROCEDURE analyzeCodeBlock_DEFINED_PAM *-------------------------------------------------------------------------------------------------------------- * 07/01/2014 FDBOZZO Los *métodos deben ir siempre al final, si no los eventos ACCESS no se ejecutan! *-------------------------------------------------------------------------------------------------------------- * PARÁMETROS: (v=Pasar por valor | @=Pasar por referencia) (!=Obligatorio | ?=Opcional) (IN/OUT) * toClase (!@ IN ) Objeto de la Clase * tcLine (!@ IN ) Línea de datos en evaluación * taCodeLines (!@ IN ) El array con las líneas del código de texto donde buscar * tnCodeLines (!@ IN ) Cantidad de líneas de código * I (!@ IN ) Número de línea en evaluación *-------------------------------------------------------------------------------------------------------------- LPARAMETERS toClase, tcLine, taCodeLines, tnCodeLines, I *-- ESTRUCTURA A ANALIZAR (también se admite sin los símbolos ^ y *): * *m: *metodovacio_con_comentarios && Este método no tiene código, pero tiene comentarios. A ver que pasa! *m: *mimetodo && Mi metodo *p: prop1 && Mi prop 1 *p: prop_especial_cr && *a: ^array_1_d[1,0] && Array 1 dimensión (1) *a: ^array_2_d[1,2] && Array una dimension (1,2) *p: _memberdata && XML Metadata for customizable properties * #IF .F. LOCAL toClase AS CL_CLASE OF 'FOXBIN2PRG.PRG' #ENDIF TRY LOCAL llBloqueEncontrado, lcDefinedPAM, lnPos, lnPos2, lcPAM_Name, lcItem, lcMethods, lcPAM_Type IF LEFT( tcLine, C_LEN_DEFINED_PAM_I) == C_DEFINED_PAM_I llBloqueEncontrado = .T. STORE '' TO lcDefinedPAM, lcItem, lcMethods 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_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.n_Debug > 0 AND _VFP.STARTMODE = 0 SET STEP ON ENDIF THROW FINALLY RELEASE toClase, tcLine, taCodeLines, tnCodeLines, I ; , lcDefinedPAM, lnPos, lnPos2, lcPAM_Name, lcItem, lcMethods, lcPAM_Type ENDTRY RETURN llBloqueEncontrado ENDPROC PROCEDURE analyzeCodeBlock_DEFINE_CLASS *-------------------------------------------------------------------------------------------------------------- * PARÁMETROS: (v=Pasar por valor | @=Pasar por referencia) (!=Obligatorio | ?=Opcional) (IN/OUT) * toModulo (!@ IN ) Objeto del Modulo * toClase (!@ IN ) Objeto de la Clase * tcLine (!@ IN ) Línea de datos en evaluación * taCodeLines (!@ IN ) El array con las líneas del código de texto donde buscar * I (!@ IN ) Número de línea en evaluación * tnCodeLines (!@ IN ) Cantidad de líneas de código * tcProcedureAbierto (!v IN ) Nombre del Procedure abierto * taLineasExclusion (!@ IN ) Array de líneas de exclusión * tnBloquesExclusion (!@ IN ) Cantidad de líneas de exclusión * tc_Comentario (!v IN ) Comentario * toFoxBin2Prg (@? IN ) Referencia al objeto principal *-------------------------------------------------------------------------------------------------------------- LPARAMETERS toModulo, toClase, tcLine, taCodeLines, I, tnCodeLines, tcProcedureAbierto ; , taLineasExclusion, tnBloquesExclusion, tc_Comentario, toFoxBin2Prg EXTERNAL ARRAY taCodeLines, tnBloquesExclusion, taLineasExclusion #IF .F. LOCAL toModulo AS CL_CLASSLIB OF 'FOXBIN2PRG.PRG' LOCAL toClase AS CL_CLASE OF 'FOXBIN2PRG.PRG' LOCAL toFoxBin2Prg AS c_foxbin2prg OF 'FOXBIN2PRG.PRG' #ENDIF 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' LOCAL loLang as CL_LANG OF 'FOXBIN2PRG.PRG' loLang = _SCREEN.o_FoxBin2Prg_Lang STORE '' TO tcProcedureAbierto toClase = CREATEOBJECT('CL_CLASE') toClase._Nombre = LOWER( ALLTRIM( STREXTRACT( tcLine, 'DEFINE CLASS ', ' AS ', 1, 1 ) ) ) toClase._ObjName = LOWER( toClase._Nombre ) toClase._Definicion = ALLTRIM( tcLine ) IF NOT ' OF ' $ UPPER(tcLine) && Puede no tener "OF libreria.vcx" toClase._Class = ALLTRIM( CHRTRAN( STREXTRACT( tcLine + ' OLEPUBLIC', ' AS ', ' OLEPUBLIC', 1, 1 ), ["'], [] ) ) ELSE toClase._Class = ALLTRIM( CHRTRAN( STREXTRACT( tcLine + ' OF ', ' AS ', ' OF ', 1, 1 ), ["'], [] ) ) ENDIF toClase._ClassLoc = LOWER( ALLTRIM( CHRTRAN( STREXTRACT( tcLine + ' OLEPUBLIC', ' OF ', ' OLEPUBLIC', 1, 1 ), ["'], [] ) ) ) toClase._OlePublic = ' OLEPUBLIC' $ UPPER(tcLine) toClase._Comentario = tc_Comentario toClase._Inicio = 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 .analyzeCodeBlock_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 .analyzeCodeBlock_PROTECTED( @toClase, @tcLine ) llPROTECTED_Completed = .T. CASE NOT llHIDDEN_Completed AND .analyzeCodeBlock_HIDDEN( @toClase, @tcLine ) llHIDDEN_Completed = .T. CASE NOT llINCLUDE_Completed AND .c_Type <> "SCX" AND .analyzeCodeBlock_INCLUDE( @toModulo, @toClase, @tcLine, @taCodeLines ; , @I, @tnCodeLines, @tcProcedureAbierto ) llINCLUDE_Completed = .T. CASE NOT llCLASSCOMMENTS_Completed AND .analyzeCodeBlock_CLASSCOMMENTS( @toClase, @tcLine ,@taCodeLines, tnCodeLines, @I ) llCLASSCOMMENTS_Completed = .T. CASE NOT llCLASSMETADATA_Completed AND .analyzeCodeBlock_CLASSMETADATA( @toClase, @tcLine ) llCLASSMETADATA_Completed = .T. CASE NOT llOBJECTMETADATA_Completed AND .analyzeCodeBlock_OBJECTMETADATA( @toClase, @tcLine ) * No se usa flag porque puede haber múltiples ObjectMetadata. CASE NOT llDEFINED_PAM_Completed AND .analyzeCodeBlock_DEFINED_PAM( @toClase, @tcLine, @taCodeLines, tnCodeLines, @I ) llDEFINED_PAM_Completed = .T. CASE .analyzeCodeBlock_ADD_OBJECT( @toModulo, @toClase, @tcLine, @I, @taCodeLines, @tnCodeLines, @toFoxBin2Prg ) STORE .T. TO llCLASSCOMMENTS_Completed ; , llCLASS_PROPERTY_Completed ; , llPROTECTED_Completed ; , llHIDDEN_Completed ; , llINCLUDE_Completed ; , llCLASSMETADATA_Completed ; , llOBJECTMETADATA_Completed ; , llDEFINED_PAM_Completed CASE .analyzeCodeBlock_ENDDEFINE( @toClase, @tcLine, @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(loLang.C_ENDDEFINE_MARKER_NOT_FOUND_LOC)) ENDIF toClase._PROPERTIES = .classProps2Memo( @toClase, @toFoxBin2Prg ) toClase._PROTECTED = .hiddenAndProtected_PAM( @toClase ) toClase._METHODS = .classMethods2Memo( @toClase ) toClase._RESERVED1 = IIF( .c_Type = 'SCX', '', 'Class' ) toClase._RESERVED2 = IIF( .c_Type = 'VCX' OR PROPER(toClase._Class) == 'Dataenvironment', TRANSFORM( toClase._AddObject_Count + 1 ), '' ) toClase._RESERVED3 = .defined_PAM2Memo( @toClase ) toClase._RESERVED4 = toClase._ClassIcon toClase._RESERVED5 = toClase._ProjectClassIcon toClase._RESERVED6 = toClase._Scale toClase._RESERVED7 = toClase._Comentario toClase._RESERVED8 = toClase._includeFile ENDWITH && THIS CATCH TO loEx IF THIS.n_Debug > 0 AND _VFP.STARTMODE = 0 SET STEP ON ENDIF THROW FINALLY RELEASE toModulo, toClase, tcLine, taCodeLines, I, tnCodeLines, tcProcedureAbierto ; , taLineasExclusion, tnBloquesExclusion, tc_Comentario, Z, lcProp, lcValue, loEx ; , llCLASSMETADATA_Completed, llPROTECTED_Completed, llHIDDEN_Completed, llDEFINED_PAM_Completed ; , llINCLUDE_Completed, llCLASS_PROPERTY_Completed, llOBJECTMETADATA_Completed ; , llCLASSCOMMENTS_Completed, loObjeto ENDTRY ENDIF RETURN llBloqueEncontrado ENDPROC PROCEDURE analyzeCodeBlock_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 RELEASE toClase, tcLine, I, tcProcedureAbierto RETURN llBloqueEncontrado ENDPROC PROCEDURE analyzeCodeBlock_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 RELEASE toClase, tcLine RETURN llBloqueEncontrado ENDPROC PROCEDURE analyzeCodeBlock_INCLUDE LPARAMETERS toModulo, toClase, tcLine, taCodeLines, I, tnCodeLines, tcProcedureAbierto LOCAL llBloqueEncontrado #IF .F. LOCAL toModulo AS CL_CLASSLIB OF 'FOXBIN2PRG.PRG' LOCAL toClase AS CL_CLASE OF 'FOXBIN2PRG.PRG' #ENDIF IF 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 RELEASE toModulo, toClase, tcLine, taCodeLines, I, tnCodeLines, tcProcedureAbierto RETURN llBloqueEncontrado ENDPROC PROCEDURE analyzeCodeBlock_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.n_Debug > 0 AND _VFP.STARTMODE = 0 SET STEP ON ENDIF THROW FINALLY RELEASE toClase, tcLine ,taCodeLines, tnCodeLines, I ENDTRY RETURN llBloqueEncontrado ENDPROC PROCEDURE analyzeCodeBlock_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 RELEASE toClase, tcLine, laPropsAndValues, lnPropsAndValues_Count RETURN llBloqueEncontrado ENDPROC PROCEDURE analyzeCodeBlock_EXTERNAL_CLASS *------------------------------------------------------ *-- Analiza el bloque *< EXTERNAL_CLASS: Name="nombre-clase" Baseclass="clase-base" /> *------------------------------------------------------ LPARAMETERS toModulo, tcLine, taCodeLines, I, tnCodeLines #IF .F. LOCAL toModulo AS CL_CLASSLIB OF 'FOXBIN2PRG.PRG' #ENDIF LOCAL llBloqueEncontrado IF LEFT(tcLine, C_LEN_EXTERNAL_CLASS_I) == C_EXTERNAL_CLASS_I LOCAL laPropsAndValues(1,2), lnPropsAndValues_Count llBloqueEncontrado = .T. WITH THIS AS c_conversor_prg_a_bin OF 'FOXBIN2PRG.PRG' .get_ListNamesWithValuesFrom_InLine_MetadataTag( @tcLine, @laPropsAndValues, @lnPropsAndValues_Count, C_EXTERNAL_CLASS_I, C_EXTERNAL_CLASS_F ) toModulo._ExternalClasses_Count = toModulo._ExternalClasses_Count + 1 DIMENSION toModulo._ExternalClasses( toModulo._ExternalClasses_Count, 2 ) toModulo._ExternalClasses( toModulo._ExternalClasses_Count, 1 ) = .get_ValueByName_FromListNamesWithValues( 'Name', 'C', @laPropsAndValues ) toModulo._ExternalClasses( toModulo._ExternalClasses_Count, 2 ) = .get_ValueByName_FromListNamesWithValues( 'Baseclass', 'C', @laPropsAndValues ) ; + '.' + toModulo._ExternalClasses( toModulo._ExternalClasses_Count, 1 ) ENDWITH && THIS ENDIF RETURN llBloqueEncontrado ENDPROC PROCEDURE analyzeCodeBlock_EXTERNAL_MEMBER *------------------------------------------------------ *-- Analiza el bloque *< EXTERNAL_MEMBER: Name="nombre-miembro" Type="tipo-de-miembro" /> *------------------------------------------------------ LPARAMETERS toDatabase, tcLine, taCodeLines, I, tnCodeLines #IF .F. LOCAL toDatabase AS CL_DBC OF 'FOXBIN2PRG.PRG' #ENDIF LOCAL llBloqueEncontrado IF LEFT(tcLine, C_LEN_EXTERNAL_MEMBER_I) == C_EXTERNAL_MEMBER_I LOCAL laPropsAndValues(1,2), lnPropsAndValues_Count llBloqueEncontrado = .T. WITH THIS .get_ListNamesWithValuesFrom_InLine_MetadataTag( @tcLine, @laPropsAndValues, @lnPropsAndValues_Count, C_EXTERNAL_MEMBER_I, C_EXTERNAL_MEMBER_F ) toDatabase._ExternalClasses_Count = toDatabase._ExternalClasses_Count + 1 DIMENSION toDatabase._ExternalClasses( toDatabase._ExternalClasses_Count, 2 ) toDatabase._ExternalClasses( toDatabase._ExternalClasses_Count, 1 ) = .get_ValueByName_FromListNamesWithValues( 'Type', 'C', @laPropsAndValues ) ; + '.' + .get_ValueByName_FromListNamesWithValues( 'Name', 'C', @laPropsAndValues ) *toDatabase._ExternalClasses( toDatabase._ExternalClasses_Count, 2 ) = .get_ValueByName_FromListNamesWithValues( 'Type', 'C', @laPropsAndValues ) ENDWITH && THIS ENDIF RETURN llBloqueEncontrado ENDPROC PROCEDURE analyzeCodeBlock_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 toClase, tcLine, laPropsAndValues, lnPropsAndValues_Count, loObjeto ENDIF RETURN llBloqueEncontrado ENDPROC PROCEDURE analyzeCodeBlock_OLE_DEF LPARAMETERS toModulo, tcLine, taCodeLines, I, tnCodeLines, tcProcedureAbierto LOCAL llBloqueEncontrado #IF .F. LOCAL toModulo AS CL_CLASSLIB OF 'FOXBIN2PRG.PRG' #ENDIF IF 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 RELEASE toModulo, tcLine, taCodeLines, I, tnCodeLines, tcProcedureAbierto RETURN llBloqueEncontrado ENDPROC PROCEDURE analyzeCodeBlock_PROCEDURE LPARAMETERS toModulo, toClase, toObjeto, tcLine, taCodeLines, I, tnCodeLines, tcProcedureAbierto ; , tc_Comentario, taLineasExclusion, tnBloquesExclusion #IF .F. LOCAL toModulo AS CL_CLASSLIB OF 'FOXBIN2PRG.PRG' LOCAL toObjeto AS CL_OBJETO OF 'FOXBIN2PRG.PRG' LOCAL toClase AS CL_CLASE OF 'FOXBIN2PRG.PRG' #ENDIF LOCAL llBloqueEncontrado WITH THIS AS c_conversor_prg_a_bin OF 'FOXBIN2PRG.PRG' DO CASE CASE LEFT( tcLine, 20 ) == 'PROTECTED PROCEDURE ' *-- Estructura a reconocer: PROTECTED PROCEDURE nombre_del_procedimiento llBloqueEncontrado = .T. tcProcedureAbierto = ALLTRIM( SUBSTR( tcLine, 21 ) ) .evaluateProcedureDefinition( @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 ) ) .evaluateProcedureDefinition( @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 ) ) .evaluateProcedureDefinition( @toClase, I, @tc_Comentario, tcProcedureAbierto, 'normal', @toObjeto ) ENDCASE IF llBloqueEncontrado *-- Evalúo todo el contenido del PROCEDURE .updateProgressbar( 'Analyzing Procedure ' + toClase._Nombre + '.' + tcProcedureAbierto + '...', I, tnCodeLines, 1 ) .analyzeProcedureLines( @toClase, @toObjeto, @tcLine, @taCodeLines, @I, @tnCodeLines, @tcProcedureAbierto ; , @tc_Comentario, @taLineasExclusion, @tnBloquesExclusion ) ENDIF ENDWITH RELEASE toModulo, toClase, toObjeto, tcLine, taCodeLines, I, tnCodeLines, tcProcedureAbierto ; , tc_Comentario, taLineasExclusion, tnBloquesExclusion RETURN llBloqueEncontrado ENDPROC PROCEDURE analyzeCodeBlock_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 RELEASE toClase, tcLine RETURN llBloqueEncontrado ENDPROC PROCEDURE evaluateProcedureDefinition LPARAMETERS toClase, I, tc_Comentario, tcProcName, tcProcType, toObjeto *-------------------------------------------------------------------------------------------------------------- #IF .F. LOCAL toClase AS CL_CLASE OF 'FOXBIN2PRG.PRG' ; , toObjeto AS CL_OBJETO OF 'FOXBIN2PRG.PRG' #ENDIF TRY LOCAL lcNombreObjeto, lnObjProc ; , loProcedure AS CL_PROCEDURE OF 'FOXBIN2PRG.PRG' IF EMPTY(toClase._Fin_Cab) toClase._Fin_Cab = I-1 toClase._Ini_Cuerpo = I ENDIF loProcedure = NULL loProcedure = CREATEOBJECT("CL_PROCEDURE") loProcedure._Nombre = tcProcName loProcedure._ProcType = tcProcType loProcedure._Comentario = tc_Comentario loProcedure._Inicio = I *-- 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.findMethodsObjectByName( 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 ) *-- Paso el log de errores IF NOT EMPTY(toObjeto.c_TextErr) THEN toClase.writeErrorLog(toObjeto.c_TextErr) toObjeto.c_TextErr = '' ENDIF ENDIF ELSE *-- Procedimiento de clase toClase.add_Procedure( loProcedure ) ENDIF CATCH TO loEx IF THIS.n_Debug > 0 AND _VFP.STARTMODE = 0 SET STEP ON ENDIF THROW FINALLY STORE NULL TO loProcedure RELEASE loProcedure, I, lcNombreObjeto, lnObjProc ; , toClase, tc_Comentario, tcProcName, tcProcType, toObjeto ENDTRY RETURN ENDPROC PROCEDURE identifyCodeBlocks *-------------------------------------------------------------------------------------------------------------- * PARÁMETROS: (v=Pasar por valor | @=Pasar por referencia) (!=Obligatorio | ?=Opcional) (IN/OUT) * taCodeLines (@! IN ) El array con las líneas del código donde buscar * tnCodeLines (@! IN ) Cantidad de líneas de código * taLineasExclusion (@! IN ) Array unidimensional con un .T. o .F. según la línea sea de exclusión o no * tnBloquesExclusion (@! IN ) Cantidad de bloques de exclusión * toModulo (@? OUT) Objeto con toda la información del módulo analizado * toFoxBin2Prg (@? IN ) Referencia al objeto principal * * NOTA: * Como identificador se usa el nombre de clase o de procedimiento, según corresponda. *-------------------------------------------------------------------------------------------------------------- LPARAMETERS taCodeLines, tnCodeLines, taLineasExclusion, tnBloquesExclusion, toModulo, toFoxBin2Prg EXTERNAL ARRAY taCodeLines, taLineasExclusion #IF .F. LOCAL toModulo AS CL_CLASSLIB OF 'FOXBIN2PRG.PRG' LOCAL toFoxBin2Prg AS c_foxbin2prg OF 'FOXBIN2PRG.PRG' #ENDIF TRY LOCAL I, loEx AS EXCEPTION ; , llFoxBin2Prg_Completed, llOLE_DEF_Completed, llINCLUDE_SCX_Completed, llLIBCOMMENT_Completed, llEXTERNAL_CLASS_Completed ; , lc_Comentario, lcProcedureAbierto, lcLine ; , loClase AS CL_CLASE OF 'FOXBIN2PRG.PRG' WITH THIS AS c_conversor_prg_a_bin OF 'FOXBIN2PRG.PRG' STORE '' TO lcProcedureAbierto .c_Type = UPPER(JUSTEXT(.c_OutputFile)) IF tnCodeLines > 1 *-- Búsqueda del ID de inicio de bloque (DEFINE CLASS / PROCEDURE) FOR I = 1 TO tnCodeLines STORE '' TO lc_Comentario .set_Line( @lcLine, @taCodeLines, I ) DO CASE CASE .excludedLine( I, tnBloquesExclusion, @taLineasExclusion ) ; OR .lineIsOnlyCommentAndNoMetadata( @lcLine, @lc_Comentario ) && Excluida, vacía o solo Comentarios CASE .analyzeCodeBlock_DEFINE_CLASS( @toModulo, @loClase, @lcLine, @taCodeLines, @I, tnCodeLines ; , @lcProcedureAbierto, @taLineasExclusion, @tnBloquesExclusion, @lc_Comentario, @toFoxBin2Prg ) *-- Puede haber varias clases definidas * llEXTERNAL_CLASS_Completed = .T. *-- Logueo los errores IF NOT EMPTY(loClase.c_TextErr) THEN .writeErrorLog( loClase.c_TextErr ) ENDIF ENDCASE ENDFOR .verify_EXTERNAL_CLASSES( @toModulo, @toFoxBin2Prg ) ENDIF ENDWITH && THIS CATCH TO loEx IF THIS.n_Debug > 0 AND _VFP.STARTMODE = 0 SET STEP ON ENDIF THROW FINALLY STORE NULL TO loClase RELEASE loClase, I ; , llFoxBin2Prg_Completed, llOLE_DEF_Completed, llINCLUDE_SCX_Completed, llLIBCOMMENT_Completed ; , lc_Comentario, lcProcedureAbierto, lcLine ENDTRY RETURN ENDPROC PROCEDURE identifyHeaderBlocks *-------------------------------------------------------------------------------------------------------------- * PARÁMETROS: (v=Pasar por valor | @=Pasar por referencia) (!=Obligatorio | ?=Opcional) (IN/OUT) * taCodeLines (@! IN ) El array con las líneas del código donde buscar * tnCodeLines (@! IN ) Cantidad de líneas de código * taLineasExclusion (@! IN ) Array unidimensional con un .T. o .F. según la línea sea de exclusión o no * tnBloquesExclusion (@! IN ) Cantidad de bloques de exclusión * toModulo (@? OUT) Objeto con toda la información del módulo analizado * toFoxBin2Prg (@? IN ) Referencia al objeto principal * * NOTA: * Como identificador se usa el nombre de clase o de procedimiento, según corresponda. *-------------------------------------------------------------------------------------------------------------- LPARAMETERS taCodeLines, tnCodeLines, taLineasExclusion, tnBloquesExclusion, toModulo, toFoxBin2Prg EXTERNAL ARRAY taCodeLines, taLineasExclusion #IF .F. LOCAL toModulo AS CL_CLASSLIB OF 'FOXBIN2PRG.PRG' LOCAL toFoxBin2Prg AS c_foxbin2prg OF 'FOXBIN2PRG.PRG' #ENDIF TRY LOCAL I, loEx AS EXCEPTION ; , llFoxBin2Prg_Completed, llOLE_DEF_Completed, llINCLUDE_SCX_Completed, llLIBCOMMENT_Completed, llEXTERNAL_CLASS_Completed ; , lc_Comentario, lcProcedureAbierto, lcLine ; , loClase AS CL_CLASE OF 'FOXBIN2PRG.PRG' WITH THIS AS c_conversor_prg_a_bin OF 'FOXBIN2PRG.PRG' STORE '' TO lcProcedureAbierto .c_Type = UPPER(JUSTEXT(.c_OutputFile)) IF tnCodeLines > 1 IF toFoxBin2Prg.n_UseClassPerFile > 0 AND toFoxBin2Prg.l_RedirectClassPerFileToMain ELSE llEXTERNAL_CLASS_Completed = .T. ENDIF *-- Búsqueda del ID de inicio de bloque (DEFINE CLASS / PROCEDURE) FOR I = 1 TO tnCodeLines STORE '' TO lc_Comentario .set_Line( @lcLine, @taCodeLines, I ) DO CASE CASE .lineIsOnlyCommentAndNoMetadata( @lcLine, @lc_Comentario ) && Excluida, vacía o solo Comentarios CASE NOT llFoxBin2Prg_Completed AND .analyzeCodeBlock_FoxBin2Prg( @toModulo, @lcLine, @taCodeLines, @I, tnCodeLines ) llFoxBin2Prg_Completed = .T. CASE NOT llEXTERNAL_CLASS_Completed AND .analyzeCodeBlock_EXTERNAL_CLASS( @toModulo, @lcLine, @taCodeLines, @I, tnCodeLines ) *-- Puede haber varias clases externas CASE NOT llLIBCOMMENT_Completed AND .analyzeCodeBlock_LIBCOMMENT( @toModulo, @lcLine, @taCodeLines, @I, tnCodeLines ) llLIBCOMMENT_Completed = .T. llEXTERNAL_CLASS_Completed = .T. CASE NOT llOLE_DEF_Completed AND .analyzeCodeBlock_OLE_DEF( @toModulo, @lcLine, @taCodeLines ; , @I, tnCodeLines, @lcProcedureAbierto ) *-- Puede haber varios objetos OLE CASE NOT llINCLUDE_SCX_Completed AND .c_Type = 'SCX' AND .analyzeCodeBlock_INCLUDE( @toModulo, @loClase, @lcLine ; , @taCodeLines, @I, tnCodeLines, @lcProcedureAbierto ) * Específico para SCX que lo tiene al inicio llINCLUDE_SCX_Completed = .T. llEXTERNAL_CLASS_Completed = .T. ENDCASE ENDFOR ENDIF ENDWITH && THIS CATCH TO loEx IF THIS.n_Debug > 0 AND _VFP.STARTMODE = 0 SET STEP ON ENDIF THROW FINALLY STORE NULL TO loClase RELEASE taCodeLines, tnCodeLines, taLineasExclusion, tnBloquesExclusion, toModulo, loClase, I ; , llFoxBin2Prg_Completed, llOLE_DEF_Completed, llINCLUDE_SCX_Completed, llLIBCOMMENT_Completed ; , lc_Comentario, lcProcedureAbierto, lcLine ENDTRY RETURN ENDPROC PROCEDURE verify_EXTERNAL_CLASSES *-------------------------------------------------------------------------------- *-- Compara las clases definidas en la cabecera con las clases encontradas luego *-------------------------------------------------------------------------------------------------------------- * PARÁMETROS: (v=Pasar por valor | @=Pasar por referencia) (!=Obligatorio | ?=Opcional) (IN/OUT) * toModulo (@? OUT) Objeto con toda la información del módulo analizado * toFoxBin2Prg (@? IN ) Referencia al objeto principal *-------------------------------------------------------------------------------------------------------------- LPARAMETERS toModulo, toFoxBin2Prg #IF .F. LOCAL toModulo AS CL_CLASSLIB OF 'FOXBIN2PRG.PRG' LOCAL toFoxBin2Prg AS c_foxbin2prg OF 'FOXBIN2PRG.PRG' #ENDIF LOCAL lnItem, I, X, lcClaseExterna LOCAL loLang as CL_LANG OF 'FOXBIN2PRG.PRG' loLang = _SCREEN.o_FoxBin2Prg_Lang *-- Verificación de las Clases, si son Externas y se indicó chequearlas DO CASE CASE toFoxBin2Prg.n_UseClassPerFile = 1 AND toFoxBin2Prg.l_ClassPerFileCheck *-- El ClassPerFile original, con nomenclatura 'Libreria.NombreClase.vc2' FOR I = 1 TO toModulo._ExternalClasses_Count lnItem = 0 FOR X = 1 TO toModulo._Clases_Count IF LOWER( toModulo._Clases(X)._ObjName ) == LOWER( toModulo._ExternalClasses(I,1) ) lnItem = X EXIT ENDIF ENDFOR IF lnItem = 0 THEN lcClaseExterna = FORCEPATH( JUSTSTEM(toFoxBin2Prg.c_InputFile) + '.' + toModulo._ExternalClasses(I,1) + '.' + JUSTEXT(toFoxBin2Prg.c_InputFile), JUSTPATH(toFoxBin2Prg.c_InputFile) ) *ERROR 'No se ha encontrado la clase externa [' + toModulo._ExternalClasses(I,1) + '] en el archivo [' + toFoxBin2Prg.c_InputFile + ']' ERROR ( loLang.C_EXTERNAL_CLASS_NAME_WAS_NOT_FOUND_LOC + ' [' + lcClaseExterna + ']' ) ENDIF toModulo._Clases(lnItem)._Checked = .T. ENDFOR CASE toFoxBin2Prg.n_UseClassPerFile = 2 AND toFoxBin2Prg.l_ClassPerFileCheck *-- El nuevo ClassPerFile, con nomenclatura 'Libreria.ClaseBase.NombreClase.vc2' FOR I = 1 TO toModulo._ExternalClasses_Count lnItem = 0 FOR X = 1 TO toModulo._Clases_Count IF LOWER( toModulo._Clases(X)._BaseClass + '.' + toModulo._Clases(X)._ObjName ) == LOWER( toModulo._ExternalClasses(I,2) ) lnItem = X EXIT ENDIF ENDFOR IF lnItem = 0 THEN lcClaseExterna = FORCEPATH( JUSTSTEM(toFoxBin2Prg.c_InputFile) + '.' + toModulo._ExternalClasses(I,1) + '.' + JUSTEXT(toFoxBin2Prg.c_InputFile), JUSTPATH(toFoxBin2Prg.c_InputFile) ) *ERROR 'No se ha encontrado la clase externa [' + toModulo._ExternalClasses(I,1) + '] en el archivo [' + toFoxBin2Prg.c_InputFile + ']' ERROR ( loLang.C_EXTERNAL_CLASS_NAME_WAS_NOT_FOUND_LOC + ' [' + lcClaseExterna + ']' ) ENDIF toModulo._Clases(lnItem)._Checked = .T. ENDFOR ENDCASE 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 = [] ; + [] ; + [] c_Type = 'VC2' PROCEDURE convert *--------------------------------------------------------------------------------------------------- * PARÁMETROS: (v=Pasar por valor | @=Pasar por referencia) (!=Obligatorio | ?=Opcional) (IN/OUT) * toModulo (@! OUT) Objeto generado de clase CL_CLASSLIB con la información leida del texto * toEx (@! OUT) Objeto con información del error * toFoxBin2Prg (@? IN ) Referencia al objeto principal *--------------------------------------------------------------------------------------------------- LPARAMETERS toModulo, toEx AS EXCEPTION, toFoxBin2Prg #IF .F. LOCAL toModulo AS CL_CLASSLIB OF 'FOXBIN2PRG.PRG' LOCAL toFoxBin2Prg AS c_foxbin2prg OF 'FOXBIN2PRG.PRG' #ENDIF DODEFAULT( @toModulo, @toEx, @toFoxBin2Prg ) TRY LOCAL lnCodError, laCodeLines(1), lnCodeLines, lcInputFile, lcInputFile_Class, lnFileCount, laFiles(1,5) ; , laLineasExclusion(1), lnBloquesExclusion, I, lcClassName, lnIDInputFile ; , loLang as CL_LANG OF 'FOXBIN2PRG.PRG' WITH THIS AS c_conversor_prg_a_vcx OF 'FOXBIN2PRG.PRG' STORE 0 TO lnCodError, lnCodeLines STORE '' TO C_FB2PRG_CODE, lcClassName STORE NULL TO toModulo loLang = _SCREEN.o_FoxBin2Prg_Lang toModulo = CREATEOBJECT('CL_CLASSLIB') lnIDInputFile = toFoxBin2Prg.n_ProcessedFiles IF toFoxBin2Prg.n_UseClassPerFile > 0 AND toFoxBin2Prg.l_RedirectClassPerFileToMain C_FB2PRG_CODE = FILETOSTR( .c_InputFile ) lnCodeLines = ALINES( laCodeLines, C_FB2PRG_CODE ) .updateProgressbar( 'Identifying Header Blocks...', 1, lnCodeLines, 1 ) .identifyHeaderBlocks( @laCodeLines, lnCodeLines, @laLineasExclusion, lnBloquesExclusion, @toModulo, @toFoxBin2Prg ) .updateProgressbar( 'Loading Code...', 2, lnCodeLines, 1 ) *-- MÁSCARA DE BÚSQUEDA IF toFoxBin2Prg.n_UseClassPerFile = 1 THEN *-- Esto crea la máscara de búsqueda "filename.*.ext" para encontrar las partes lcBaseFilename = JUSTSTEM( JUSTSTEM(.c_InputFile) ) lcInputFile = ADDBS( JUSTPATH(.c_InputFile) ) + lcBaseFilename + '.*.' + JUSTEXT(.c_InputFile) ELSE && toFoxBin2Prg.n_UseClassPerFile = 2 *-- Esto crea la máscara de búsqueda "Database.*.*.ext" para encontrar las partes *-- con la sintaxis "Database.MemberType.MemberName.ext" lcBaseFilename = JUSTSTEM( JUSTSTEM( JUSTSTEM(.c_InputFile) ) ) lcInputFile = ADDBS( JUSTPATH(.c_InputFile) ) + lcBaseFilename + '.*.*.' + JUSTEXT(.c_InputFile) ENDIF lnFileCount = ADIR( laFiles, lcInputFile, "", 1 ) ASORT( laFiles, 1, 0, 0, 1) FOR I = 1 TO lnFileCount IF toFoxBin2Prg.n_UseClassPerFile = 1 THEN lcInputFile_Class = FORCEPATH( JUSTSTEM( laFiles(I,1) ), JUSTPATH( .c_InputFile ) ) + '.' + JUSTEXT( .c_InputFile ) lcClassName = LOWER( GETWORDNUM( JUSTFNAME( lcInputFile_Class ), 2, '.' ) ) *-- Verificación de las Clases, si son Externas y se indicó chequearlas IF toFoxBin2Prg.l_ClassPerFileCheck AND ASCAN( toModulo._ExternalClasses , lcClassName, 1, 0, 1, 1+2+4 ) = 0 .writeLog( C_TAB + '- ' + loLang.C_OUTER_CLASS_DOES_NOT_MATCH_INNER_CLASSES_LOC + ' [' + lcInputFile_Class + ']' ) .writeErrorLog( C_TAB + '- ' + loLang.C_WARNING_LOC + ' ' + loLang.C_OUTER_CLASS_DOES_NOT_MATCH_INNER_CLASSES_LOC + ' [' + lcInputFile_Class + ']' ) LOOP && Salteo esta clase ENDIF ELSE && toFoxBin2Prg.n_UseClassPerFile = 2 lcInputFile_Class = FORCEPATH( JUSTSTEM( laFiles(I,1) ), JUSTPATH( .c_InputFile ) ) + '.' + JUSTEXT( .c_InputFile ) lcClassName = LOWER( GETWORDNUM( JUSTFNAME( lcInputFile_Class ), 2, '.' ) + '.' + GETWORDNUM( JUSTFNAME( lcInputFile_Class ), 3, '.' ) ) *-- Verificación de las Clases, si son Externas y se indicó chequearlas IF toFoxBin2Prg.l_ClassPerFileCheck AND ASCAN( toModulo._ExternalClasses , lcClassName, 1, 0, 2, 1+2+4 ) = 0 .writeLog( C_TAB + '- ' + loLang.C_OUTER_CLASS_DOES_NOT_MATCH_INNER_CLASSES_LOC + ' [' + lcInputFile_Class + ']' ) .writeErrorLog( C_TAB + '- ' + loLang.C_WARNING_LOC + ' ' + loLang.C_OUTER_CLASS_DOES_NOT_MATCH_INNER_CLASSES_LOC + ' [' + lcInputFile_Class + ']' ) LOOP && Salteo esta clase porque no concuerda con las anotadas ENDIF ENDIF .writeLog( C_TAB + C_TAB + '+ ' + loLang.C_INCLUDING_CLASS_LOC + ' ' + JUSTFNAME( lcInputFile_Class ) ) *-- addProcessedFile( tcFile, tcInOutType, tcProcessed, tcHasErrors, tcSupported, tcExpanded ) IF toFoxBin2Prg.addProcessedFile( lcInputFile_Class, 'I', 'P1', 'E0', 'S1', 'X1' ) THEN toFoxBin2Prg.updateProcessedFile() ENDIF IF toFoxBin2Prg.l_ProcessFiles THEN toFoxBin2Prg.normalizeFileCapitalization( .T., lcInputFile_Class ) C_FB2PRG_CODE = C_FB2PRG_CODE + FILETOSTR( lcInputFile_Class ) ENDIF ENDFOR lnCodeLines = ALINES( laCodeLines, C_FB2PRG_CODE ) ELSE *-- No es clase por archivo, o no se quiere redireccionar a Main. IF toFoxBin2Prg.l_ProcessFiles THEN C_FB2PRG_CODE = FILETOSTR( .c_InputFile ) lnCodeLines = ALINES( laCodeLines, C_FB2PRG_CODE ) .updateProgressbar( 'Identifying Header Blocks...', 1, lnCodeLines, 1 ) .identifyHeaderBlocks( @laCodeLines, lnCodeLines, @laLineasExclusion, lnBloquesExclusion, @toModulo, @toFoxBin2Prg ) ENDIF ENDIF IF NOT toFoxBin2Prg.l_ProcessFiles THEN *-- addProcessedFile( tcFile, tcInOutType, tcProcessed, tcHasErrors, tcSupported, tcExpanded ) IF toFoxBin2Prg.addProcessedFile( .c_OutputFile, 'O', 'P1', 'E0', 'S1', 'X0' ) THEN toFoxBin2Prg.updateProcessedFile() ENDIF EXIT && Si se indicó no procesar, se sale aquí. (Modo de simulación) ENDIF *-- Identifico los TEXT/ENDTEXT, #IF .F./#ENDIF .updateProgressbar( 'Identifying Excluded Blocks...', 3, lnCodeLines, 1 ) .identifyExclusionBlocks( @laCodeLines, lnCodeLines, .F., @laLineasExclusion, @lnBloquesExclusion ) *-- Identifico el inicio/fin de bloque, definición, cabecera y cuerpo de cada clase .identifyCodeBlocks( @laCodeLines, lnCodeLines, @laLineasExclusion, lnBloquesExclusion, @toModulo, @toFoxBin2Prg ) DO CASE CASE toFoxBin2Prg.c_SimulateError = 'SIMERR_I1' ERROR 'InputFile Error Simulation' CASE toFoxBin2Prg.c_SimulateError = 'SIMERR_I0' .writeErrorLog( '*** SIMULATED ERROR' ) ENDCASE IF .l_Error .writeLog( '*** ERRORS found - Generation Cancelled' ) EXIT ENDIF toFoxBin2Prg.updateProcessedFile( lnIDInputFile ) .updateProgressbar( loLang.C_GENERATING_BINARY_LOC + '...', 0, lnCodeLines, 1 ) toFoxBin2Prg.doBackup( .F., .T., '', '', '' ) .createClasslib() .writeBinaryFile( @toModulo, @toFoxBin2Prg ) ENDWITH && THIS CATCH TO toEx IF THIS.n_Debug > 0 AND _VFP.STARTMODE = 0 SET STEP ON ENDIF THROW FINALLY USE IN (SELECT("TABLABIN")) RELEASE lnCodError, laCodeLines, lnCodeLines, lcInputFile, lcInputFile_Class, lnFileCount, laFiles ; , laLineasExclusion, lnBloquesExclusion, I ENDTRY RETURN ENDPROC PROCEDURE writeBinaryFile LPARAMETERS toModulo, toFoxBin2Prg *-- Estructura del objeto toModulo generado: *-- ----------------------------------------------------------------------------------------------------------- *-- Version Versión usada para generar la versión PRG analizada *-- SourceFile Nombre original del archivo fuente de la conversión *-- Ole_Obj_Count Cantidad de objetos definidos en el array ole_objs[] *-- Ole_Objs[1] Array de objetos OLE definidos como clases *-- ObjName Nombre del objeto OLE (OLE2) *-- Parent Nombre del objeto Padre *-- CheckSum Suma de verificación *-- Value Valor del campo OLE *-- Clases_Count Array con las posiciones de los addobjects, definicion y propiedades *-- Clases[1] Array con los datos de las clases, definicion, propiedades y métodos *-- Nombre El nombre de la clase (ej: "miClase") *-- ObjName Nombre del objeto *-- Parent Nombre del objeto Padre *-- Class Clase de la que hereda la definición *-- Classloc Librería donde está la definición de la clase *-- Ole Información campo ole *-- Ole2 Información campo ole2 *-- OlePublic Indica si la clase es OLEPublic o no (.T. / .F.) *-- Uniqueid ID único *-- Comentario El comentario de la clase (ej: "&& Mis comentarios") *-- MetaData Información de metadata de la clase (baseclass, timestamp, scale) *-- BaseClass Clase de base de la clase *-- TimeStamp Timestamp de la clase *-- Scale Scale de la clase (pixels, foxels) *-- Definicion La definición de la clase (ej: "AS Custom OF LIBRERIA.VCX") *-- Inicio/Fin Línea de inicio/fin de la clase (DEFINE CLASS/ENDDEFINE) *-- Ini_Cab/Fin_Cab Línea de inicio/fin de la cabecera (def.propiedades, Hidden, Protected, #Include, CLASSDATA, DEFINED_PAM) *-- Ini_Cuerpo/Fin_Cuerpo Línea de inicio/fin del cuerpo (ADD OBJECTs y PROCEDURES) *-- HiddenProps Propiedades definidas como HIDDEN (ocultas) *-- ProtectedProps Propiedades definidas como PROTECTED (protegidas) *-- Defined_PAM Propiedades, eventos o métodos definidos por el usuario *-- IncludeFile Nombre del archivo de inclusión *-- Props_Count Cantidad de propiedades de la clase definicas en el array props[] *-- Props[1,2] Array con todas las propiedades de la clase y sus valores. (col.1=Nombre, col.2=Comentario) *-- AddObject_Count Cantidad de objetos definidos en el array addobjects[] *-- AddObjects[1] Array con las posiciones de los addobjects, definicion y propiedades *-- Nombre Nombre del objeto *-- ObjName Nombre del objeto *-- Parent Nombre del objeto Padre *-- Clase Clase del objeto *-- ClassLib Librería de clases de la que deriva la clase *-- Baseclass Clase de base del objeto *-- Uniqueid ID único *-- Ole Información campo ole *-- Ole2 Información campo ole2 *-- ZOrder Orden Z del objeto *-- Props_Count Cantidad de propiedades del objeto *-- Props[1] Array con todas las propiedades del objeto y sus valores *-- Procedure_count Cantidad de procedimientos definidos en el array procedures[] *-- Procedures[1] Array con las posiciones de los procedures, definicion y comentarios *-- Nombre Nombre del procedure *-- ProcType Tipo de procedimiento (normal, hidden, protected) *-- Comentario Comentario el procedure *-- ProcLine_Count Cantidad de líneas del procedimiento *-- ProcLines[1] Líneas del procedimiento *-- Procedure_count Cantidad de procedimientos definidos en el array procedures[] *-- Procedures[1] Array con las posiciones de los procedures, definicion y comentarios *-- Nombre Nombre del procedure *-- ProcType Tipo de procedimiento (normal, hidden, protected) *-- Comentario Comentario el procedure *-- ProcLine_Count Cantidad de líneas del procedimiento *-- ProcLines[1] Líneas del procedimiento *-- ----------------------------------------------------------------------------------------------------------- #IF .F. LOCAL toModulo AS CL_CLASSLIB OF 'FOXBIN2PRG.PRG' LOCAL toFoxBin2Prg AS c_foxbin2prg OF 'FOXBIN2PRG.PRG' #ENDIF TRY LOCAL lcObjName, lnCodError, I, X, loEx AS EXCEPTION ; , loClase AS CL_CLASE OF 'FOXBIN2PRG.PRG' ; , loFSO AS Scripting.FileSystemObject WITH THIS AS c_conversor_prg_a_vcx OF 'FOXBIN2PRG.PRG' STORE NULL TO loFSO, loClase loFSO = .oFSO *-- addProcessedFile( tcFile, tcInOutType, tcProcessed, tcHasErrors, tcSupported, tcExpanded ) toFoxBin2Prg.addProcessedFile( .c_OutputFile, 'O', 'P1', 'E0', 'S1', 'X0' ) DO CASE CASE toFoxBin2Prg.c_SimulateError = 'SIMERR_O1' ERROR 'OutputFile Error Simulation' ENDCASE *-- 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 = .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 toFoxBin2Prg.updateProcessedFile() ENDWITH && THIS CATCH TO loEx lnCodError = loEx.ERRORNO toFoxBin2Prg.updateProcessedFile( 0, '', '', 'E1' ) IF THIS.n_Debug > 0 AND _VFP.STARTMODE = 0 SET STEP ON ENDIF THROW FINALLY USE IN (SELECT("TABLABIN")) STORE NULL TO loFSO, loClase RELEASE lcObjName, I, X, loClase, loFSO ENDTRY RETURN lnCodError ENDPROC ENDDEFINE DEFINE CLASS c_conversor_prg_a_scx AS c_conversor_prg_a_bin #IF .F. LOCAL THIS AS c_conversor_prg_a_scx OF 'FOXBIN2PRG.PRG' #ENDIF *_MEMBERDATA = [] ; + [] ; + [] c_Type = 'SC2' PROCEDURE convert *--------------------------------------------------------------------------------------------------- * PARÁMETROS: (v=Pasar por valor | @=Pasar por referencia) (!=Obligatorio | ?=Opcional) (IN/OUT) * toModulo (@! OUT) Objeto generado de clase CL_CLASSLIB con la información leida del texto * toEx (@! OUT) Objeto con información del error * toFoxBin2Prg (@! IN ) Referencia al objeto principal *--------------------------------------------------------------------------------------------------- LPARAMETERS toModulo, toEx AS EXCEPTION, toFoxBin2Prg #IF .F. LOCAL toModulo AS CL_CLASSLIB OF 'FOXBIN2PRG.PRG' LOCAL toFoxBin2Prg AS c_foxbin2prg OF 'FOXBIN2PRG.PRG' #ENDIF DODEFAULT( @toModulo, @toEx, @toFoxBin2Prg ) TRY LOCAL lnCodError, laCodeLines(1), lnCodeLines, lcInputFile, lcInputFile_Class, lnFileCount, laFiles(1,5) ; , laLineasExclusion(1), lnBloquesExclusion, I, lnIDInputFile ; , loLang as CL_LANG OF 'FOXBIN2PRG.PRG' WITH THIS AS c_conversor_prg_a_vcx OF 'FOXBIN2PRG.PRG' STORE 0 TO lnCodError, lnCodeLines STORE '' TO C_FB2PRG_CODE STORE NULL TO toModulo loLang = _SCREEN.o_FoxBin2Prg_Lang toModulo = CREATEOBJECT('CL_CLASSLIB') lnIDInputFile = toFoxBin2Prg.n_ProcessedFiles IF toFoxBin2Prg.n_UseClassPerFile > 0 AND toFoxBin2Prg.l_RedirectClassPerFileToMain C_FB2PRG_CODE = FILETOSTR( .c_InputFile ) lnCodeLines = ALINES( laCodeLines, C_FB2PRG_CODE ) .updateProgressbar( 'Identifying Header Blocks...', 1, lnCodeLines, 1 ) .identifyHeaderBlocks( @laCodeLines, lnCodeLines, @laLineasExclusion, lnBloquesExclusion, @toModulo, @toFoxBin2Prg ) .updateProgressbar( 'Loading Code...', 2, lnCodeLines, 1 ) *-- MÁSCARA DE BÚSQUEDA IF toFoxBin2Prg.n_UseClassPerFile = 1 THEN *-- Esto crea la máscara de búsqueda "filename.*.ext" para encontrar las partes lcBaseFilename = JUSTSTEM( JUSTSTEM(.c_InputFile) ) lcInputFile = ADDBS( JUSTPATH(.c_InputFile) ) + lcBaseFilename + '.*.' + JUSTEXT(.c_InputFile) ELSE && toFoxBin2Prg.n_UseClassPerFile = 2 *-- Esto crea la máscara de búsqueda "Database.*.*.ext" para encontrar las partes *-- con la sintaxis "Database.MemberType.MemberName.ext" lcBaseFilename = JUSTSTEM( JUSTSTEM( JUSTSTEM(.c_InputFile) ) ) lcInputFile = ADDBS( JUSTPATH(.c_InputFile) ) + lcBaseFilename + '.*.*.' + JUSTEXT(.c_InputFile) ENDIF lnFileCount = ADIR( laFiles, lcInputFile, "", 1 ) ASORT( laFiles, 1, 0, 0, 1) FOR I = 1 TO lnFileCount IF toFoxBin2Prg.n_UseClassPerFile = 1 THEN lcInputFile_Class = FORCEPATH( JUSTSTEM( laFiles(I,1) ), JUSTPATH( .c_InputFile ) ) + '.' + JUSTEXT( .c_InputFile ) lcClassName = LOWER( GETWORDNUM( JUSTFNAME( lcInputFile_Class ), 2, '.' ) ) *-- Verificación de las Clases, si son Externas y se indicó chequearlas IF toFoxBin2Prg.l_ClassPerFileCheck AND ASCAN( toModulo._ExternalClasses , lcClassName, 1, 0, 1, 1+2+4 ) = 0 .writeLog( C_TAB + '- ' + loLang.C_OUTER_CLASS_DOES_NOT_MATCH_INNER_CLASSES_LOC + ' [' + lcInputFile_Class + ']' ) .writeErrorLog( C_TAB + '- ' + loLang.C_WARNING_LOC + ' ' + loLang.C_OUTER_CLASS_DOES_NOT_MATCH_INNER_CLASSES_LOC + ' [' + lcInputFile_Class + ']' ) LOOP && Salteo esta clase ENDIF ELSE && toFoxBin2Prg.n_UseClassPerFile = 2 lcInputFile_Class = FORCEPATH( JUSTSTEM( laFiles(I,1) ), JUSTPATH( .c_InputFile ) ) + '.' + JUSTEXT( .c_InputFile ) lcClassName = LOWER( GETWORDNUM( JUSTFNAME( lcInputFile_Class ), 2, '.' ) + '.' + GETWORDNUM( JUSTFNAME( lcInputFile_Class ), 3, '.' ) ) *-- Verificación de las Clases, si son Externas y se indicó chequearlas IF toFoxBin2Prg.l_ClassPerFileCheck AND ASCAN( toModulo._ExternalClasses , lcClassName, 1, 0, 2, 1+2+4 ) = 0 .writeLog( C_TAB + '- ' + loLang.C_OUTER_CLASS_DOES_NOT_MATCH_INNER_CLASSES_LOC + ' [' + lcInputFile_Class + ']' ) .writeErrorLog( C_TAB + '- ' + loLang.C_WARNING_LOC + ' ' + loLang.C_OUTER_CLASS_DOES_NOT_MATCH_INNER_CLASSES_LOC + ' [' + lcInputFile_Class + ']' ) LOOP && Salteo esta clase ENDIF ENDIF .writeLog( C_TAB + C_TAB + '+ ' + loLang.C_INCLUDING_CLASS_LOC + ' ' + JUSTFNAME( lcInputFile_Class ) ) *-- addProcessedFile( tcFile, tcInOutType, tcProcessed, tcHasErrors, tcSupported, tcExpanded ) IF toFoxBin2Prg.addProcessedFile( lcInputFile_Class, 'I', 'P1', 'E0', 'S1', 'X1' ) THEN toFoxBin2Prg.updateProcessedFile() ENDIF toFoxBin2Prg.normalizeFileCapitalization( .T., lcInputFile_Class ) C_FB2PRG_CODE = C_FB2PRG_CODE + FILETOSTR( lcInputFile_Class ) ENDFOR lnCodeLines = ALINES( laCodeLines, C_FB2PRG_CODE ) ELSE *-- No es clase por archivo, o no se quiere redireccionar a Main. C_FB2PRG_CODE = FILETOSTR( .c_InputFile ) lnCodeLines = ALINES( laCodeLines, C_FB2PRG_CODE ) .updateProgressbar( 'Identifying Header Blocks...', 1, lnCodeLines, 1 ) .identifyHeaderBlocks( @laCodeLines, lnCodeLines, @laLineasExclusion, lnBloquesExclusion, @toModulo, @toFoxBin2Prg ) ENDIF IF NOT toFoxBin2Prg.l_ProcessFiles THEN *-- addProcessedFile( tcFile, tcInOutType, tcProcessed, tcHasErrors, tcSupported, tcExpanded ) IF toFoxBin2Prg.addProcessedFile( .c_OutputFile, 'O', 'P1', 'E0', 'S1', 'X0' ) THEN toFoxBin2Prg.updateProcessedFile() ENDIF EXIT && Si se indicó no procesar, se sale aquí. (Modo de simulación) ENDIF *-- Identifico los TEXT/ENDTEXT, #IF .F./#ENDIF .updateProgressbar( 'Identifying Excluded Blocks...', 3, lnCodeLines, 1 ) .identifyExclusionBlocks( @laCodeLines, lnCodeLines, .F., @laLineasExclusion, @lnBloquesExclusion ) *-- Identifico el inicio/fin de bloque, definición, cabecera y cuerpo de cada clase .identifyCodeBlocks( @laCodeLines, lnCodeLines, @laLineasExclusion, lnBloquesExclusion, @toModulo, @toFoxBin2Prg ) DO CASE CASE toFoxBin2Prg.c_SimulateError = 'SIMERR_I1' ERROR 'InputFile Error Simulation' CASE toFoxBin2Prg.c_SimulateError = 'SIMERR_I0' .writeErrorLog( '*** SIMULATED ERROR' ) ENDCASE IF .l_Error .writeLog( '*** ERRORS found - Generation Cancelled' ) EXIT ENDIF toFoxBin2Prg.updateProcessedFile( lnIDInputFile ) .updateProgressbar( 'Generating Binary...', 0, lnCodeLines, 1 ) toFoxBin2Prg.doBackup( .F., .T., '', '', '' ) .createForm() .writeBinaryFile( @toModulo, @toFoxBin2Prg ) ENDWITH && THIS CATCH TO toEx IF THIS.n_Debug > 0 AND _VFP.STARTMODE = 0 SET STEP ON ENDIF THROW FINALLY USE IN (SELECT("TABLABIN")) RELEASE lnCodError, laCodeLines, lnCodeLines, lcInputFile, lcInputFile_Class, lnFileCount, laFiles ; , laLineasExclusion, lnBloquesExclusion, I ENDTRY RETURN ENDPROC PROCEDURE writeBinaryFile LPARAMETERS toModulo, toFoxBin2Prg *-- Estructura del objeto toModulo generado: *-- ----------------------------------------------------------------------------------------------------------- *-- Version Versión usada para generar la versión PRG analizada *-- SourceFile Nombre original del archivo fuente de la conversión *-- Ole_Obj_Count Cantidad de objetos definidos en el array ole_objs[] *-- Ole_Objs[1] Array de objetos OLE definidos como clases *-- ObjName Nombre del objeto OLE (OLE2) *-- Parent Nombre del objeto Padre *-- CheckSum Suma de verificación *-- Value Valor del campo OLE *-- Clases_Count Array con las posiciones de los addobjects, definicion y propiedades *-- Clases[1] Array con los datos de las clases, definicion, propiedades y métodos *-- Nombre El nombre de la clase (ej: "miClase") *-- ObjName Nombre del objeto *-- Parent Nombre del objeto Padre *-- Class Clase de la que hereda la definición *-- Classloc Librería donde está la definición de la clase *-- Ole Información campo ole *-- Ole2 Información campo ole2 *-- OlePublic Indica si la clase es OLEPublic o no (.T. / .F.) *-- Uniqueid ID único *-- Comentario El comentario de la clase (ej: "&& Mis comentarios") *-- MetaData Información de metadata de la clase (baseclass, timestamp, scale) *-- BaseClass Clase de base de la clase *-- TimeStamp Timestamp de la clase *-- Scale Scale de la clase (pixels, foxels) *-- Definicion La definición de la clase (ej: "AS Custom OF LIBRERIA.VCX") *-- Inicio/Fin Línea de inicio/fin de la clase (DEFINE CLASS/ENDDEFINE) *-- Ini_Cab/Fin_Cab Línea de inicio/fin de la cabecera (def.propiedades, Hidden, Protected, #Include, CLASSDATA, DEFINED_PAM) *-- Ini_Cuerpo/Fin_Cuerpo Línea de inicio/fin del cuerpo (ADD OBJECTs y PROCEDURES) *-- HiddenProps Propiedades definidas como HIDDEN (ocultas) *-- ProtectedProps Propiedades definidas como PROTECTED (protegidas) *-- Defined_PAM Propiedades, eventos o métodos definidos por el usuario *-- IncludeFile Nombre del archivo de inclusión *-- Props_Count Cantidad de propiedades de la clase definicas en el array props[] *-- Props[1,2] Array con todas las propiedades de la clase y sus valores. (col.1=Nombre, col.2=Comentario) *-- AddObject_Count Cantidad de objetos definidos en el array addobjects[] *-- AddObjects[1] Array con las posiciones de los addobjects, definicion y propiedades *-- Nombre Nombre del objeto *-- ObjName Nombre del objeto *-- Parent Nombre del objeto Padre *-- Clase Clase del objeto *-- ClassLib Librería de clases de la que deriva la clase *-- Baseclass Clase de base del objeto *-- Uniqueid ID único *-- Ole Información campo ole *-- Ole2 Información campo ole2 *-- ZOrder Orden Z del objeto *-- Props_Count Cantidad de propiedades del objeto *-- Props[1] Array con todas las propiedades del objeto y sus valores *-- Procedure_count Cantidad de procedimientos definidos en el array procedures[] *-- Procedures[1] Array con las posiciones de los procedures, definicion y comentarios *-- Nombre Nombre del procedure *-- ProcType Tipo de procedimiento (normal, hidden, protected) *-- Comentario Comentario el procedure *-- ProcLine_Count Cantidad de líneas del procedimiento *-- ProcLines[1] Líneas del procedimiento *-- Procedure_count Cantidad de procedimientos definidos en el array procedures[] *-- Procedures[1] Array con las posiciones de los procedures, definicion y comentarios *-- Nombre Nombre del procedure *-- ProcType Tipo de procedimiento (normal, hidden, protected) *-- Comentario Comentario el procedure *-- ProcLine_Count Cantidad de líneas del procedimiento *-- ProcLines[1] Líneas del procedimiento *-- ----------------------------------------------------------------------------------------------------------- #IF .F. LOCAL toModulo AS CL_CLASSLIB OF 'FOXBIN2PRG.PRG' LOCAL toFoxBin2Prg AS c_foxbin2prg OF 'FOXBIN2PRG.PRG' #ENDIF TRY LOCAL lcObjName, lnCodError, I, X, loEx AS EXCEPTION ; , loClase AS CL_CLASE OF 'FOXBIN2PRG.PRG' WITH THIS AS c_conversor_prg_a_scx OF 'FOXBIN2PRG.PRG' *-- addProcessedFile( tcFile, tcInOutType, tcProcessed, tcHasErrors, tcSupported, tcExpanded ) toFoxBin2Prg.addProcessedFile( .c_OutputFile, 'O', 'P1', 'E0', 'S1', 'X0' ) DO CASE CASE toFoxBin2Prg.c_SimulateError = 'SIMERR_O1' ERROR 'OutputFile Error Simulation' ENDCASE *-- Creo el registro de cabecera .createForm_RecordHeader( toModulo ) *-- El SCX tiene el INCLUDE en el primer registro IF NOT EMPTY(toModulo._includeFile) REPLACE RESERVED8 WITH toModulo._includeFile ENDIF *-- Recorro las CLASES FOR X = 1 TO 2 FOR I = 1 TO toModulo._Clases_Count loClase = NULL loClase = toModulo._Clases(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 = .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 toFoxBin2Prg.updateProcessedFile() ENDWITH && THIS CATCH TO loEx toFoxBin2Prg.updateProcessedFile( 0, '', '', 'E1' ) IF THIS.n_Debug > 0 AND _VFP.STARTMODE = 0 SET STEP ON ENDIF THROW FINALLY USE IN (SELECT("TABLABIN")) STORE NULL TO loClase, loEx RELEASE lcObjName, lnCodError, I, X, loClase ENDTRY RETURN ENDPROC ENDDEFINE DEFINE CLASS c_conversor_prg_a_pjx AS c_conversor_prg_a_bin #IF .F. LOCAL THIS AS c_conversor_prg_a_pjx OF 'FOXBIN2PRG.PRG' #ENDIF _MEMBERDATA = [] ; + [] ; + [] ; + [] ; + [] ; + [] ; + [] ; + [] ; + [] ; + [] c_Type = 'PJ2' PROCEDURE convert *--------------------------------------------------------------------------------------------------- * PARÁMETROS: (v=Pasar por valor | @=Pasar por referencia) (!=Obligatorio | ?=Opcional) (IN/OUT) * toProject (!@ OUT) Objeto generado de clase CL_PROJECT con la información leida del texto * toEx (!@ OUT) Objeto con información del error * toFoxBin2Prg (v! IN ) Referencia al objeto principal *--------------------------------------------------------------------------------------------------- LPARAMETERS toProject, toEx AS EXCEPTION, toFoxBin2Prg DODEFAULT( @toProject, @toEx, @toFoxBin2Prg ) #IF .F. LOCAL toProject AS CL_PROJECT OF 'FOXBIN2PRG.PRG' LOCAL toFoxBin2Prg AS c_foxbin2prg OF 'FOXBIN2PRG.PRG' #ENDIF TRY LOCAL laCodeLines(1), lnCodeLines, laLineasExclusion(1), lnBloquesExclusion, I, lnIDInputFile WITH THIS AS c_conversor_prg_a_pjx OF 'FOXBIN2PRG.PRG' STORE 0 TO lnCodeLines STORE NULL TO toModulo lnIDInputFile = toFoxBin2Prg.n_ProcessedFiles IF NOT toFoxBin2Prg.l_ProcessFiles THEN *-- addProcessedFile( tcFile, tcInOutType, tcProcessed, tcHasErrors, tcSupported, tcExpanded ) IF toFoxBin2Prg.addProcessedFile( .c_OutputFile, 'O', 'P1', 'E0', 'S1', 'X0' ) THEN toFoxBin2Prg.updateProcessedFile() ENDIF EXIT && Si se indicó no procesar, se sale aquí. (Modo de simulación) ENDIF C_FB2PRG_CODE = FILETOSTR( .c_InputFile ) lnCodeLines = ALINES( laCodeLines, C_FB2PRG_CODE ) *-- Identifico los TEXT/ENDTEXT, #IF .F./#ENDIF *.identifyExclusionBlocks( @laCodeLines, .F., @laLineasExclusion, @lnBloquesExclusion ) *-- Identifico el inicio/fin de bloque, definición, cabecera y cuerpo de cada clase .updateProgressbar( 'Identifying Code Blocks...', 1, 2, 1 ) .identifyCodeBlocks( @laCodeLines, lnCodeLines, @laLineasExclusion, lnBloquesExclusion, @toProject ) DO CASE CASE toFoxBin2Prg.c_SimulateError = 'SIMERR_I1' ERROR 'InputFile Error Simulation' CASE toFoxBin2Prg.c_SimulateError = 'SIMERR_I0' .writeErrorLog( '*** SIMULATED ERROR' ) ENDCASE IF .l_Error .writeLog( '*** ERRORS found - Generation Cancelled' ) EXIT ENDIF toFoxBin2Prg.updateProcessedFile( lnIDInputFile ) .updateProgressbar( 'Generating Binary...', 2, 2, 1 ) toFoxBin2Prg.doBackup( .F., .T., '', '', '' ) .createProject() .writeBinaryFile( @toProject, @toFoxBin2Prg ) ENDWITH && THIS CATCH TO toEx IF THIS.n_Debug > 0 AND _VFP.STARTMODE = 0 SET STEP ON ENDIF THROW FINALLY USE IN (SELECT("TABLABIN")) RELEASE laCodeLines, lnCodeLines, laLineasExclusion, lnBloquesExclusion, I ENDTRY RETURN ENDPROC PROCEDURE writeBinaryFile LPARAMETERS toProject, toFoxBin2Prg *-- ----------------------------------------------------------------------------------------------------------- #IF .F. LOCAL toProject AS CL_PROJECT OF 'FOXBIN2PRG.PRG' LOCAL toFoxBin2Prg AS c_foxbin2prg OF 'FOXBIN2PRG.PRG' #ENDIF TRY LOCAL lnCodError, lcMainProg, loEx AS EXCEPTION ; , loServerHead AS CL_PROJ_SRV_HEAD OF 'FOXBIN2PRG.PRG' ; , loFile AS CL_PROJ_FILE OF 'FOXBIN2PRG.PRG' WITH THIS AS c_conversor_prg_a_pjx OF 'FOXBIN2PRG.PRG' STORE NULL TO loFile, loServerHead toProject._HomeDir = CHRTRAN( toProject._HomeDir, ['], [] ) toProject._SccData = CHR(3) + CHR(0) + CHR(1) + REPLICATE( CHR(0), 651 ) *-- addProcessedFile( tcFile, tcInOutType, tcProcessed, tcHasErrors, tcSupported, tcExpanded ) toFoxBin2Prg.addProcessedFile( .c_OutputFile, 'O', 'P1', 'E0', 'S1', 'X0' ) DO CASE CASE toFoxBin2Prg.c_SimulateError = 'SIMERR_O1' ERROR 'OutputFile Error Simulation' ENDCASE *-- Creo solo el registro de cabecera del proyecto .createProject_RecordHeader( toProject ) lcMainProg = '' IF NOT EMPTY(toProject._MainProg) lcMainProg = LOWER( SYS(2014, toProject._MainProg, ADDBS(toProject._HomeDir) ) ) ENDIF IF EMPTY(toProject._TimeStamp) toProject._TimeStamp = .rowTimeStamp( {^2013/11/04 20:00:00} ) ENDIF IF EMPTY(toProject._ID) toProject._ID = toFoxBin2Prg.unique_ID('N') ENDIF *-- Si hay ProjectHook de proyecto, lo inserto IF NOT EMPTY(toProject._ProjectHookLibrary) INSERT INTO TABLABIN ; ( NAME ; , TYPE ; , EXCLUDE ; , KEY ; , RESERVED1 ) ; VALUES ; ( toProject._ProjectHookLibrary + CHR(0) ; , 'W' ; , .T. ; , UPPER(JUSTSTEM(toProject._ProjectHookLibrary)) ; , toProject._ProjectHookClass + CHR(0) ) ENDIF *-- Si hay ICONO de proyecto, lo inserto IF NOT EMPTY(toProject._Icon) INSERT INTO TABLABIN ; ( NAME ; , TYPE ; , LOCAL ; , KEY ) ; VALUES ; ( SYS(2014, toProject._Icon, ADDBS(JUSTPATH(ADDBS(toProject._HomeDir)))) + CHR(0) ; , 'i' ; , .T. ; , UPPER(JUSTSTEM(toProject._Icon)) ) ENDIF *-- Agrego los ARCHIVOS FOR EACH loFile IN toProject FOXOBJECT IF EMPTY(loFile._TimeStamp) loFile._TimeStamp = .rowTimeStamp( {^2013/11/04 20:00:00} ) ENDIF IF EMPTY(loFile._ID) loFile._ID = toFoxBin2Prg.unique_ID('N') ENDIF INSERT INTO TABLABIN ; ( NAME ; , TYPE ; , EXCLUDE ; , MAINPROG ; , COMMENTS ; , LOCAL ; , CPID ; , ID ; , TIMESTAMP ; , OBJREV ; , 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")) toFoxBin2Prg.updateProcessedFile() ENDWITH && THIS CATCH TO loEx lnCodError = loEx.ERRORNO toFoxBin2Prg.updateProcessedFile( 0, '', '', 'E1' ) IF THIS.n_Debug > 0 AND _VFP.STARTMODE = 0 SET STEP ON ENDIF THROW FINALLY USE IN (SELECT("TABLABIN")) STORE NULL TO loFile, loServerHead RELEASE loFile, loServerHead ENDTRY RETURN lnCodError ENDPROC PROCEDURE identifyCodeBlocks LPARAMETERS taCodeLines, tnCodeLines, taLineasExclusion, tnBloquesExclusion, toProject *-------------------------------------------------------------------------------------------------------------- * 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 ) DO CASE CASE .lineIsOnlyCommentAndNoMetadata( @lcLine, @lc_Comentario ) && Vacía o solo Comentarios LOOP CASE NOT llFoxBin2Prg_Completed AND .analyzeCodeBlock_FoxBin2Prg( toProject, @lcLine, @taCodeLines, @I, tnCodeLines ) llFoxBin2Prg_Completed = .T. CASE NOT llDevInfo_Completed AND .analyzeCodeBlock_DevInfo( toProject, @lcLine, @taCodeLines, @I, tnCodeLines ) llDevInfo_Completed = .T. CASE NOT llServerHead_Completed AND .analyzeCodeBlock_ServerHead( toProject, @lcLine, @taCodeLines, @I, tnCodeLines ) llServerHead_Completed = .T. CASE .analyzeCodeBlock_ServerData( toProject, @lcLine, @taCodeLines, @I, tnCodeLines ) *-- Puede haber varios servidores, por eso se siguen valuando CASE NOT llBuildProj_Completed AND .analyzeCodeBlock_BuildProj( toProject, @lcLine, @taCodeLines, @I, tnCodeLines ) llBuildProj_Completed = .T. CASE NOT llFileComments_Completed AND .analyzeCodeBlock_FileComments( toProject, @lcLine, @taCodeLines, @I, tnCodeLines ) llFileComments_Completed = .T. CASE NOT llExcludedFiles_Completed AND .analyzeCodeBlock_ExcludedFiles( toProject, @lcLine, @taCodeLines, @I, tnCodeLines ) llExcludedFiles_Completed = .T. CASE NOT llTextFiles_Completed AND .analyzeCodeBlock_TextFiles( toProject, @lcLine, @taCodeLines, @I, tnCodeLines ) llTextFiles_Completed = .T. CASE NOT llProjectProperties_Completed AND .analyzeCodeBlock_ProjectProperties( toProject, @lcLine, @taCodeLines, @I, tnCodeLines ) llProjectProperties_Completed = .T. ENDCASE ENDFOR ENDIF ENDWITH && THIS CATCH TO loEx IF THIS.n_Debug > 0 AND _VFP.STARTMODE = 0 SET STEP ON ENDIF THROW FINALLY RELEASE taCodeLines, tnCodeLines, taLineasExclusion, tnBloquesExclusion, toProject ; , I, lc_Comentario, lcLine, llBuildProj_Completed, llDevInfo_Completed ; , llServerHead_Completed, llFileComments_Completed, llFoxBin2Prg_Completed ; , llExcludedFiles_Completed, llTextFiles_Completed, llProjectProperties_Completed ENDTRY RETURN ENDPROC PROCEDURE analyzeCodeBlock_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.n_Debug > 0 AND _VFP.STARTMODE = 0 SET STEP ON ENDIF THROW FINALLY STORE NULL TO loFile RELEASE toProject, tcLine, taCodeLines, I, tnCodeLines ; , lcComment, lcMetadatos, luValor, laPropsAndValues, lnPropsAndValues_Count, loFile ENDTRY RETURN llBloqueEncontrado ENDPROC PROCEDURE analyzeCodeBlock_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.n_Debug > 0 AND _VFP.STARTMODE = 0 SET STEP ON ENDIF THROW ENDTRY RETURN llBloqueEncontrado ENDPROC PROCEDURE analyzeCodeBlock_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 .lineIsOnlyCommentAndNoMetadata( @tcLine ) LOOP && Saltear comentarios CASE LEFT( tcLine, LEN(C_SRV_HEAD_F) ) == C_SRV_HEAD_F I = I + 1 EXIT OTHERWISE loServerHead.setParsedHeadInfoLine( @tcLine ) ENDCASE ENDFOR ENDWITH && THIS I = I - 1 ENDIF CATCH TO loEx IF THIS.n_Debug > 0 AND _VFP.STARTMODE = 0 SET STEP ON ENDIF THROW FINALLY STORE NULL TO loServerHead RELEASE loServerHead ENDTRY RETURN llBloqueEncontrado ENDPROC PROCEDURE analyzeCodeBlock_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 .lineIsOnlyCommentAndNoMetadata( @tcLine ) LOOP && Saltear comentarios CASE LEFT( tcLine, LEN(C_SRV_DATA_F) ) == C_SRV_DATA_F I = I + 1 EXIT OTHERWISE loServerHead.setParsedInfoLine( loServerData, @tcLine ) ENDCASE ENDFOR ENDWITH && THIS loServerHead.add_Server( loServerData ) I = I - 1 ENDIF CATCH TO loEx IF THIS.n_Debug > 0 AND _VFP.STARTMODE = 0 SET STEP ON ENDIF THROW FINALLY STORE NULL TO loServerData, loServerHead RELEASE loServerHead, loServerData ENDTRY RETURN llBloqueEncontrado ENDPROC PROCEDURE analyzeCodeBlock_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 .lineIsOnlyCommentAndNoMetadata( @tcLine ) LOOP && Saltear comentarios CASE LEFT( tcLine, LEN(C_FILE_CMTS_F) ) == C_FILE_CMTS_F I = I + 1 EXIT 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.n_Debug > 0 AND _VFP.STARTMODE = 0 SET STEP ON ENDIF THROW FINALLY loFile = NULL RELEASE lcFile, lcComment, loFile ENDTRY RETURN llBloqueEncontrado ENDPROC PROCEDURE analyzeCodeBlock_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 .lineIsOnlyCommentAndNoMetadata( @tcLine ) LOOP && Saltear comentarios CASE LEFT( tcLine, LEN(C_FILE_EXCL_F) ) == C_FILE_EXCL_F I = I + 1 EXIT 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.n_Debug > 0 AND _VFP.STARTMODE = 0 SET STEP ON ENDIF THROW FINALLY loFile = NULL RELEASE lcFile, llExclude, loFile ENDTRY RETURN llBloqueEncontrado ENDPROC PROCEDURE analyzeCodeBlock_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 .lineIsOnlyCommentAndNoMetadata( @tcLine ) LOOP && Saltear comentarios CASE LEFT( tcLine, LEN(C_FILE_TXT_F) ) == C_FILE_TXT_F I = I + 1 EXIT 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.n_Debug > 0 AND _VFP.STARTMODE = 0 SET STEP ON ENDIF THROW FINALLY loFile = NULL RELEASE lcFile, lcType, loFile ENDTRY RETURN llBloqueEncontrado ENDPROC PROCEDURE analyzeCodeBlock_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 .lineIsOnlyCommentAndNoMetadata( @tcLine ) LOOP && Saltear comentarios CASE LEFT( tcLine, LEN(C_PROJPROPS_F) ) == C_PROJPROPS_F I = I + 1 EXIT CASE LEFT( tcLine ,2 ) == '*<' *--- Se asigna con EVALUATE() tal cual está en el PJ2, pero quitando el marcador *< /> lcLine = STUFF( ALLTRIM( STREXTRACT( tcLine, '*<', '/>' ) ), 2, 0, '_' ) toProject.setParsedProjInfoLine( lcLine ) CASE 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.n_Debug > 0 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 = [] ; + [] ; + [] ; + [] ; + [] c_Type = 'FR2' PROCEDURE convert *--------------------------------------------------------------------------------------------------- * PARÁMETROS: (v=Pasar por valor | @=Pasar por referencia) (!=Obligatorio | ?=Opcional) (IN/OUT) * toReport (!@ OUT) Objeto generado de clase CL_REPORT con la información leida del texto * toEx (!@ OUT) Objeto con información del error * toFoxBin2Prg (v! IN ) Referencia al objeto principal *--------------------------------------------------------------------------------------------------- LPARAMETERS toReport, toEx AS EXCEPTION, toFoxBin2Prg DODEFAULT( @toReport, @toEx, @toFoxBin2Prg ) #IF .F. LOCAL toReport AS CL_REPORT OF 'FOXBIN2PRG.PRG' LOCAL toFoxBin2Prg AS c_foxbin2prg OF 'FOXBIN2PRG.PRG' #ENDIF TRY LOCAL lnCodError, loEx AS EXCEPTION, laCodeLines(1), lnCodeLines ; , laLineasExclusion(1), lnBloquesExclusion, I, lnIDInputFile WITH THIS AS c_conversor_prg_a_frx OF 'FOXBIN2PRG.PRG' STORE 0 TO lnCodError, lnCodeLines STORE NULL TO toReport lnIDInputFile = toFoxBin2Prg.n_ProcessedFiles IF NOT toFoxBin2Prg.l_ProcessFiles THEN *-- addProcessedFile( tcFile, tcInOutType, tcProcessed, tcHasErrors, tcSupported, tcExpanded ) IF toFoxBin2Prg.addProcessedFile( .c_OutputFile, 'O', 'P1', 'E0', 'S1', 'X0' ) THEN toFoxBin2Prg.updateProcessedFile() ENDIF EXIT && Si se indicó no procesar, se sale aquí. (Modo de simulación) ENDIF C_FB2PRG_CODE = FILETOSTR( .c_InputFile ) lnCodeLines = ALINES( laCodeLines, C_FB2PRG_CODE ) .createReport('CURSOR') *-- Identifico el inicio/fin de bloque, definición, cabecera y cuerpo del reporte .updateProgressbar( 'Identifying Code Blocks...', 1, 2, 1 ) .identifyCodeBlocks( @laCodeLines, lnCodeLines, @laLineasExclusion, lnBloquesExclusion, @toReport ) USE IN (SELECT('TABLABIN')) DO CASE CASE toFoxBin2Prg.c_SimulateError = 'SIMERR_I1' ERROR 'InputFile Error Simulation' CASE toFoxBin2Prg.c_SimulateError = 'SIMERR_I0' .writeErrorLog( '*** SIMULATED ERROR' ) ENDCASE IF .l_Error .writeLog( '*** ERRORS found - Generation Cancelled' ) EXIT ENDIF toFoxBin2Prg.updateProcessedFile( lnIDInputFile ) .updateProgressbar( 'Generating Binary...', 2, 2, 1 ) toFoxBin2Prg.doBackup( .F., .T., '', '', '' ) .createReport() .writeBinaryFile( @toReport, @toFoxBin2Prg ) ENDWITH && THIS CATCH TO loEx lnCodError = loEx.ERRORNO IF THIS.n_Debug > 0 AND _VFP.STARTMODE = 0 SET STEP ON ENDIF THROW FINALLY USE IN (SELECT("TABLABIN")) ENDTRY RETURN lnCodError ENDPROC PROCEDURE writeBinaryFile LPARAMETERS toReport, toFoxBin2Prg *-- ----------------------------------------------------------------------------------------------------------- #IF .F. LOCAL toReport AS CL_REPORT OF 'FOXBIN2PRG.PRG' LOCAL toFoxBin2Prg AS c_foxbin2prg OF 'FOXBIN2PRG.PRG' #ENDIF TRY LOCAL loReg, I, lcFieldType, lnFieldLen, lnFieldDec, lnNumCampo, laFieldTypes(1,18) ; , luValor, lnCodError, loEx AS EXCEPTION LOCAL loLang as CL_LANG OF 'FOXBIN2PRG.PRG' loLang = _SCREEN.o_FoxBin2Prg_Lang SELECT TABLABIN AFIELDS( laFieldTypes ) loReg = NULL *-- addProcessedFile( tcFile, tcInOutType, tcProcessed, tcHasErrors, tcSupported, tcExpanded ) toFoxBin2Prg.addProcessedFile( THIS.c_OutputFile, 'O', 'P1', 'E0', 'S1', 'X0' ) DO CASE CASE toFoxBin2Prg.c_SimulateError = 'SIMERR_O1' ERROR 'OutputFile Error Simulation' ENDCASE *-- Agrego los registros FOR EACH loReg IN toReport FOXOBJECT *IF toFoxBin2Prg.l_NoTimestamps * loReg.TIMESTAMP = 0 *ENDIF *IF toFoxBin2Prg.l_ClearUniqueID * loReg.UNIQUEID = '' *ENDIF IF EMPTY(loReg.TIMESTAMP) loReg.TIMESTAMP = .rowTimeStamp( {^2013/11/04 20:00:00} ) ENDIF IF EMPTY(loReg.UNIQUEID) OR ALLTRIM(loReg.UNIQUEID) = '0' loReg.UNIQUEID = toFoxBin2Prg.unique_ID() ENDIF *-- 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(loLang.C_FIELD_NOT_FOUND_ON_FILE_STRUCTURE_LOC)) ENDIF lcFieldType = laFieldTypes(lnNumCampo,2) lnFieldLen = laFieldTypes(lnNumCampo,3) lnFieldDec = laFieldTypes(lnNumCampo,4) luValor = EVALUATE('loReg.' + laProps(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 toFoxBin2Prg.updateProcessedFile() CATCH TO loEx lnCodError = loEx.ERRORNO toFoxBin2Prg.updateProcessedFile( 0, '', '', 'E1' ) IF THIS.n_Debug > 0 AND _VFP.STARTMODE = 0 SET STEP ON ENDIF THROW FINALLY USE IN (SELECT("TABLABIN")) loReg = NULL RELEASE loReg, I, lcFieldType, lnFieldLen, lnFieldDec, lnNumCampo, laFieldTypes, luValor ENDTRY RETURN lnCodError ENDPROC PROCEDURE identifyCodeBlocks LPARAMETERS taCodeLines, tnCodeLines, taLineasExclusion, tnBloquesExclusion, toReport *-------------------------------------------------------------------------------------------------------------- * PARÁMETROS: (v=Pasar por valor | @=Pasar por referencia) (!=Obligatorio | ?=Opcional) (IN/OUT) * taCodeLines (!@ IN ) El array con las líneas del código donde buscar * tnCodeLines (!@ IN ) Cantidad de líneas de código * taLineasExclusion (@! IN ) Array unidimensional con un .T. o .F. según la línea sea de exclusión o no * tnBloquesExclusion (@? IN ) Cantidad de bloques de exclusion * toReport (@? OUT) Objeto con toda la información del reporte analizado * * NOTA: * Como identificador se usa el nombre de clase o de procedimiento, según corresponda. *-------------------------------------------------------------------------------------------------------------- EXTERNAL ARRAY taCodeLines, taLineasExclusion #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 ) DO CASE CASE .lineIsOnlyCommentAndNoMetadata( @lcLine, @lc_Comentario ) && Vacía o solo Comentarios LOOP CASE NOT llFoxBin2Prg_Completed AND .analyzeCodeBlock_FoxBin2Prg( toReport, @lcLine, @taCodeLines, @I, tnCodeLines ) llFoxBin2Prg_Completed = .T. CASE .analyzeCodeBlock_Reportes( toReport, @lcLine, @taCodeLines, @I, tnCodeLines ) ENDCASE ENDFOR ENDIF ENDWITH && THIS CATCH TO loEx IF THIS.n_Debug > 0 AND _VFP.STARTMODE = 0 SET STEP ON ENDIF THROW ENDTRY RETURN ENDPROC PROCEDURE analyzeCodeBlock_CDATA_inline *------------------------------------------------------ *-- Analiza el bloque *------------------------------------------------------ LPARAMETERS toReport, tcLine, taCodeLines, I, tnCodeLines, toReg, tcPropName #IF .F. LOCAL toReport AS CL_REPORT OF 'FOXBIN2PRG.PRG' #ENDIF 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.n_Debug > 0 AND _VFP.STARTMODE = 0 SET STEP ON ENDIF THROW FINALLY RELEASE toReport, tcLine, taCodeLines, I, tnCodeLines, toReg, tcPropName ; , lcValue, loEx ENDTRY RETURN llBloqueEncontrado ENDPROC PROCEDURE analyzeCodeBlock_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) 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.n_Debug > 0 AND _VFP.STARTMODE = 0 SET STEP ON ENDIF THROW FINALLY RELEASE toReport, tcLine, taCodeLines, I, tnCodeLines, toReg ; , X, lnPos, lnPos2, lcValue, lnLenPropName, laProps ENDTRY RETURN llBloqueEncontrado ENDPROC PROCEDURE analyzeCodeBlock_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' SCATTER MEMO BLANK NAME loReg 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 .analyzeCodeBlock_platform( toReport, @tcLine, @taCodeLines, @I, @tnCodeLines, @loReg ) CASE .analyzeCodeBlock_CDATA_inline( toReport, @tcLine, @taCodeLines, @I, tnCodeLines, @loReg, 'picture' ) CASE .analyzeCodeBlock_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 INLIST(loReg.ObjType, "25", "26") && Dataenvironment, cursors and relations loReg.TAG = IIF( EMPTY( CHRTRAN( loReg.TAG, CR_LF+C_TAB, '') ), '', SUBSTR(loReg.TAG,3) ) && Quito el ENTER agregado antes OTHERWISE loReg.TAG = .decode_SpecialCodes_1_31( loReg.TAG ) ENDCASE CASE .analyzeCodeBlock_CDATA_inline( toReport, @tcLine, @taCodeLines, @I, tnCodeLines, @loReg, 'tag2' ) *-- ARREGLO ALGUNOS VALORES CAMBIADOS AL TEXTUALIZAR IF NOT INLIST(loReg.ObjType,"5","6","8") loReg.TAG2 = STRCONV( loReg.TAG2,14 ) ENDIF CASE .analyzeCodeBlock_CDATA_inline( toReport, @tcLine, @taCodeLines, @I, tnCodeLines, @loReg, 'penred' ) CASE .analyzeCodeBlock_CDATA_inline( toReport, @tcLine, @taCodeLines, @I, tnCodeLines, @loReg, 'style' ) CASE .analyzeCodeBlock_CDATA_inline( toReport, @tcLine, @taCodeLines, @I, tnCodeLines, @loReg, 'expr' ) CASE .analyzeCodeBlock_CDATA_inline( toReport, @tcLine, @taCodeLines, @I, tnCodeLines, @loReg, 'supexpr' ) CASE .analyzeCodeBlock_CDATA_inline( toReport, @tcLine, @taCodeLines, @I, tnCodeLines, @loReg, 'comment' ) CASE .analyzeCodeBlock_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.n_Debug > 0 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 = [] ; + [] ; + [] ; + [] ; + [] c_Type = 'DB2' PROCEDURE convert *--------------------------------------------------------------------------------------------------- * PARÁMETROS: (v=Pasar por valor | @=Pasar por referencia) (!=Obligatorio | ?=Opcional) (IN/OUT) * toTable (!@ OUT) Objeto generado de clase CL_TABLE con la información leida del texto * toEx (!@ OUT) Objeto con información del error * toFoxBin2Prg (v! IN ) Referencia al objeto principal *--------------------------------------------------------------------------------------------------- LPARAMETERS toTable, toEx AS EXCEPTION, toFoxBin2Prg DODEFAULT( @toTable, @toEx, @toFoxBin2Prg ) #IF .F. LOCAL toTable AS CL_DBF_TABLE OF 'FOXBIN2PRG.PRG' LOCAL toFoxBin2Prg AS c_foxbin2prg OF 'FOXBIN2PRG.PRG' #ENDIF TRY LOCAL lnCodError, loEx AS EXCEPTION, laCodeLines(1), lnCodeLines, laLineasExclusion(1), lnBloquesExclusion, I ; , lnIDInputFile STORE 0 TO lnCodError, lnCodeLines WITH THIS AS c_conversor_prg_a_dbf OF 'FOXBIN2PRG.PRG' lnIDInputFile = toFoxBin2Prg.n_ProcessedFiles IF NOT toFoxBin2Prg.l_ProcessFiles THEN *-- addProcessedFile( tcFile, tcInOutType, tcProcessed, tcHasErrors, tcSupported, tcExpanded ) IF toFoxBin2Prg.addProcessedFile( .c_OutputFile, 'O', 'P1', 'E0', 'S1', 'X0' ) THEN toFoxBin2Prg.updateProcessedFile() ENDIF EXIT && Si se indicó no procesar, se sale aquí. (Modo de simulación) ENDIF C_FB2PRG_CODE = FILETOSTR( .c_InputFile ) lnCodeLines = ALINES( laCodeLines, C_FB2PRG_CODE ) toFoxBin2Prg.doBackup( .F., .T., '', '', '' ) *-- Identifico el inicio/fin de bloque, definición, cabecera y cuerpo del reporte .identifyCodeBlocks( @laCodeLines, lnCodeLines, @laLineasExclusion, lnBloquesExclusion, @toTable ) DO CASE CASE toFoxBin2Prg.c_SimulateError = 'SIMERR_I1' ERROR 'InputFile Error Simulation' CASE toFoxBin2Prg.c_SimulateError = 'SIMERR_I0' .writeErrorLog( '*** SIMULATED ERROR' ) ENDCASE IF .l_Error .writeLog( '*** ERRORS found - Generation Cancelled' ) EXIT ENDIF toFoxBin2Prg.updateProcessedFile( lnIDInputFile ) .writeBinaryFile( @toTable, @toFoxBin2Prg ) ENDWITH && THIS CATCH TO loEx lnCodError = loEx.ERRORNO IF THIS.n_Debug > 0 AND _VFP.STARTMODE = 0 SET STEP ON ENDIF THROW FINALLY USE IN (SELECT("TABLABIN")) ENDTRY RETURN lnCodError ENDPROC PROCEDURE writeBinaryFile LPARAMETERS 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 *-- addProcessedFile( tcFile, tcInOutType, tcProcessed, tcHasErrors, tcSupported, tcExpanded ) toFoxBin2Prg.addProcessedFile( .c_OutputFile, 'O', 'P1', 'E0', 'S1', 'X0' ) DO CASE CASE toFoxBin2Prg.c_SimulateError = 'SIMERR_O1' ERROR 'OutputFile Error Simulation' ENDCASE 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 IF toFoxBin2Prg.l_ClearDBFLastUpdate THEN ldLastUpdate = EVALUATE( '{^2013/11/04}' ) ELSE ldLastUpdate = EVALUATE( '{^' + toTable._LastUpdate + '}' ) ENDIF loDBFUtils.write_DBC_BackLink( .c_OutputFile, toTable._Database, ldLastUpdate ) toFoxBin2Prg.updateProcessedFile() ENDWITH && THIS CATCH TO loEx lnCodError = loEx.ERRORNO toFoxBin2Prg.updateProcessedFile( 0, '', '', 'E1' ) loEx.USERVALUE = 'lcIndex="' + TRANSFORM(lcIndex) + '"' + CR_LF ; + 'lcFieldDef="' + TRANSFORM(lcFieldDef) + '"' + CR_LF ; + 'lcCreateTable="' + TRANSFORM(lcCreateTable) + '"' IF THIS.n_Debug > 0 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 identifyCodeBlocks *-------------------------------------------------------------------------------------------------------------- * PARÁMETROS: (v=Pasar por valor | @=Pasar por referencia) (!=Obligatorio | ?=Opcional) (IN/OUT) * taCodeLines (!@ IN ) El array con las líneas del código donde buscar * tnCodeLines (!@ IN ) Cantidad de líneas de código * taLineasExclusion (@! IN ) Array unidimensional con un .T. o .F. según la línea sea de exclusión o no * tnBloquesExclusion (@? IN ) Sin uso * toTable (@? OUT) Objeto con toda la información de la tabla analizada *-------------------------------------------------------------------------------------------------------------- LPARAMETERS taCodeLines, tnCodeLines, taLineasExclusion, tnBloquesExclusion, toTable 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 ) DO CASE CASE .lineIsOnlyCommentAndNoMetadata( @lcLine, @lc_Comentario ) && Vacía o solo Comentarios LOOP CASE NOT llFoxBin2Prg_Completed AND .analyzeCodeBlock_FoxBin2Prg( toTable, @lcLine, @taCodeLines, @I, tnCodeLines ) llFoxBin2Prg_Completed = .T. CASE NOT llBloqueTable_Completed AND toTable.analyzeCodeBlock( @lcLine, @taCodeLines, @I, tnCodeLines ) llBloqueTable_Completed = .T. ENDCASE ENDFOR ENDIF ENDWITH && THIS CATCH TO loEx IF THIS.n_Debug > 0 AND _VFP.STARTMODE = 0 SET STEP ON ENDIF THROW FINALLY RELEASE taCodeLines, tnCodeLines, taLineasExclusion, tnBloquesExclusion, toTable ; , I, lc_Comentario, lcLine, llFoxBin2Prg_Completed, llBloqueTable_Completed ENDTRY RETURN ENDPROC ENDDEFINE && CLASS c_conversor_prg_a_dbf AS c_conversor_prg_a_bin 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 = [] ; + [] ; + [] ; + [] ; + [] ; + [] ; + [] ; + [] ; + [] ; + [] c_Type = 'DC2' PROCEDURE convert *--------------------------------------------------------------------------------------------------- * PARÁMETROS: (v=Pasar por valor | @=Pasar por referencia) (!=Obligatorio | ?=Opcional) (IN/OUT) * toDatabase (!@ OUT) Objeto generado de clase CL_DBC con la información leida del texto * toEx (!@ OUT) Objeto con información del error * toFoxBin2Prg (v! IN ) Referencia al objeto principal *--------------------------------------------------------------------------------------------------- LPARAMETERS toDatabase, toEx AS EXCEPTION, toFoxBin2Prg DODEFAULT( @toDatabase, @toEx, @toFoxBin2Prg ) #IF .F. LOCAL toDatabase AS CL_DBC OF 'FOXBIN2PRG.PRG' LOCAL toFoxBin2Prg AS c_foxbin2prg OF 'FOXBIN2PRG.PRG' #ENDIF TRY LOCAL lnCodError, loEx AS EXCEPTION, loReg, lcLine, laCodeLines(1), lnCodeLines, lcBaseFilename, lcInputFile ; , lcMemberType, lcMemberName, lcLastMemberType, lnIDInputFile ; , laLineasExclusion(1), lnBloquesExclusion, I, X, Y, laFiles(1,5), lnFileCount, lcTempTxt, laLines(1) ; , loLang as CL_LANG OF 'FOXBIN2PRG.PRG' STORE 0 TO lnCodError, lnCodeLines, lnFileCount STORE '' TO lcLine, laLines, laCodeLines, lcBaseFilename, lcMemberType, lcLastMemberType, lcMemberName, lcInputFile STORE NULL TO loReg, toDatabase WITH THIS AS c_conversor_prg_a_dbc OF 'FOXBIN2PRG.PRG' loLang = _SCREEN.o_FoxBin2Prg_Lang toDatabase = CREATEOBJECT('CL_DBC') lnIDInputFile = toFoxBin2Prg.n_ProcessedFiles IF toFoxBin2Prg.n_UseClassPerFile > 0 AND toFoxBin2Prg.l_RedirectClassPerFileToMain C_FB2PRG_CODE = FILETOSTR( .c_InputFile ) lnCodeLines = ALINES( laCodeLines, C_FB2PRG_CODE ) C_FB2PRG_CODE = '' *-- Quito la última parte del cierre de para anexar lo intermedio FOR X = 1 TO lnCodeLines IF C_DATABASE_F $ laCodeLines(X) THEN EXIT ENDIF C_FB2PRG_CODE = C_FB2PRG_CODE + laCodeLines(X) + CR_LF ENDFOR .updateProgressbar( 'Identifying Header Blocks...', 1, lnCodeLines, 1 ) .identifyHeaderBlocks( @laCodeLines, lnCodeLines, @laLineasExclusion, lnBloquesExclusion, @toDatabase, @toFoxBin2Prg ) .updateProgressbar( 'Loading Code...', 2, lnCodeLines, 1 ) *-- Esto crea la máscara de búsqueda "Database.*.*.ext" para encontrar las partes *-- con la sintaxis "Database.MemberType.MemberName.ext" lcBaseFilename = JUSTSTEM( JUSTSTEM( JUSTSTEM(.c_InputFile) ) ) lcInputFile = ADDBS( JUSTPATH(.c_InputFile) ) + lcBaseFilename + '.*.*.' + JUSTEXT(.c_InputFile) lnFileCount = ADIR( laFiles, lcInputFile, "", 1 ) *-- Busco "storedprocedures" y le pongo "z" al inicio FOR I = 1 TO lnFileCount IF LOWER( laFiles(I,1)) == lcBaseFilename + '.database.storedproceduressource.' + JUSTEXT(.c_InputFile) THEN laFiles(I,1) = lcBaseFilename + '.zdatabase.storedproceduressource.' + JUSTEXT(.c_InputFile) EXIT ENDIF ENDFOR ASORT( laFiles, 1, -1, 0, 1) && "zstoredprocedures" quedará al final *-- Busco "zstoredprocedures" y le quito la "z" del inicio FOR I = 1 TO lnFileCount IF LOWER( laFiles(I,1)) == lcBaseFilename + '.zdatabase.storedproceduressource.' + JUSTEXT(.c_InputFile) THEN laFiles(I,1) = lcBaseFilename + '.database.storedproceduressource.' + JUSTEXT(.c_InputFile) EXIT ENDIF ENDFOR FOR I = 1 TO lnFileCount lcInputFile_Class = FORCEPATH( JUSTSTEM( laFiles(I,1) ), JUSTPATH( .c_InputFile ) ) + '.' + JUSTEXT( .c_InputFile ) lcMemberType = LOWER( GETWORDNUM( JUSTFNAME( lcInputFile_Class ), 2, '.' ) ) lcMemberName = LOWER( GETWORDNUM( JUSTFNAME( lcInputFile_Class ), 3, '.' ) ) IF toFoxBin2Prg.l_ProcessFiles THEN IF NOT lcMemberType == lcLastMemberType THEN IF NOT EMPTY(lcLastMemberType) THEN *-- Cambio de tipo de miembro, fin del anterior (connection, table, view, storedprocedures) DO CASE CASE lcLastMemberType == 'connection' C_FB2PRG_CODE = C_FB2PRG_CODE + C_TAB + C_CONNECTIONS_F + CR_LF CASE lcLastMemberType == 'table' C_FB2PRG_CODE = C_FB2PRG_CODE + C_TAB + C_TABLES_F + CR_LF CASE lcLastMemberType == 'view' C_FB2PRG_CODE = C_FB2PRG_CODE + C_TAB + C_VIEWS_F + CR_LF CASE lcLastMemberType == 'database' *C_FB2PRG_CODE = C_FB2PRG_CODE + CR_LF + CR_LF ENDCASE lcLastMemberType = '' ENDIF *-- Cambio de tipo de miembro, inicio del actual (connection, table, view, storedprocedures) DO CASE CASE lcMemberType == 'connection' C_FB2PRG_CODE = C_FB2PRG_CODE + CR_LF + CR_LF + C_TAB + C_CONNECTIONS_I + CR_LF CASE lcMemberType == 'table' C_FB2PRG_CODE = C_FB2PRG_CODE + CR_LF + CR_LF + C_TAB + C_TABLES_I + CR_LF CASE lcMemberType == 'view' C_FB2PRG_CODE = C_FB2PRG_CODE + CR_LF + CR_LF + C_TAB + C_VIEWS_I + CR_LF CASE lcMemberType == 'database' C_FB2PRG_CODE = C_FB2PRG_CODE + CR_LF + CR_LF ENDCASE ENDIF ENDIF *-- Verificación de los Miembros, si son Externos y se indicó chequearlos IF toFoxBin2Prg.l_ClassPerFileCheck AND ASCAN( toDatabase._ExternalClasses, lcMemberType + '.' + lcMemberName, 1, 0, 1, 1+2+4 ) = 0 .writeLog( C_TAB + '- ' + loLang.C_OUTER_MEMBER_DOES_NOT_MATCH_INNER_MEMBERS_LOC + ' [' + lcInputFile_Class + ']' ) .writeErrorLog( C_TAB + '- ' + loLang.C_WARNING_LOC + ' ' + loLang.C_OUTER_MEMBER_DOES_NOT_MATCH_INNER_MEMBERS_LOC + ' [' + lcInputFile_Class + ']' ) LOOP && Salteo este miembro porque no concuerda con los anotados ENDIF .writeLog( C_TAB + C_TAB + '+ ' + loLang.C_INCLUDING_MEMBER_LOC + ' ' + JUSTFNAME( lcInputFile_Class ) ) *-- addProcessedFile( tcFile, tcInOutType, tcProcessed, tcHasErrors, tcSupported, tcExpanded ) IF toFoxBin2Prg.addProcessedFile( lcInputFile_Class, 'I', 'P1', 'E0', 'S1', 'X1' ) THEN toFoxBin2Prg.updateProcessedFile() ENDIF IF toFoxBin2Prg.l_ProcessFiles THEN toFoxBin2Prg.normalizeFileCapitalization( .T., lcInputFile_Class ) lcTempTxt = FILETOSTR( lcInputFile_Class ) FOR Y = 7 TO ALINES( laLines, lcTempTxt ) C_FB2PRG_CODE = C_FB2PRG_CODE + laLines(Y) + CR_LF ENDFOR lcLastMemberType = lcMemberType ENDIF ENDFOR IF NOT toFoxBin2Prg.l_ProcessFiles THEN *-- addProcessedFile( tcFile, tcInOutType, tcProcessed, tcHasErrors, tcSupported, tcExpanded ) IF toFoxBin2Prg.addProcessedFile( .c_OutputFile, 'O', 'P1', 'E0', 'S1', 'X0' ) THEN toFoxBin2Prg.updateProcessedFile() ENDIF EXIT && Si se indicó no procesar, se sale aquí. (Modo de simulación) ENDIF IF NOT EMPTY(lcLastMemberType) THEN *-- Cambio de tipo de miembro, fin del anterior (connection, table, view, storedprocedures) DO CASE CASE lcLastMemberType == 'connection' C_FB2PRG_CODE = C_FB2PRG_CODE + C_TAB + C_CONNECTIONS_F + CR_LF CASE lcLastMemberType == 'table' C_FB2PRG_CODE = C_FB2PRG_CODE + C_TAB + C_TABLES_F + CR_LF CASE lcLastMemberType == 'view' C_FB2PRG_CODE = C_FB2PRG_CODE + C_TAB + C_VIEWS_F + CR_LF CASE lcLastMemberType == 'database' *C_FB2PRG_CODE = C_FB2PRG_CODE + CR_LF + CR_LF ENDCASE ENDIF *-- Agrego la última parte con el cierre de FOR X = X TO lnCodeLines C_FB2PRG_CODE = C_FB2PRG_CODE + laCodeLines(X) + CR_LF ENDFOR lnCodeLines = ALINES( laCodeLines, C_FB2PRG_CODE ) ELSE *-- No es clase por archivo, o no se quiere redireccionar a Main. IF NOT toFoxBin2Prg.l_ProcessFiles THEN *-- addProcessedFile( tcFile, tcInOutType, tcProcessed, tcHasErrors, tcSupported, tcExpanded ) IF toFoxBin2Prg.addProcessedFile( .c_OutputFile, 'O', 'P1', 'E0', 'S1', 'X0' ) THEN toFoxBin2Prg.updateProcessedFile() ENDIF EXIT && Si se indicó no procesar, se sale aquí. (Modo de simulación) ENDIF C_FB2PRG_CODE = FILETOSTR( .c_InputFile ) lnCodeLines = ALINES( laCodeLines, C_FB2PRG_CODE ) .updateProgressbar( 'Identifying Header Blocks...', 1, lnCodeLines, 1 ) .identifyHeaderBlocks( @laCodeLines, lnCodeLines, @laLineasExclusion, lnBloquesExclusion, @toDatabase, @toFoxBin2Prg ) ENDIF *-- Identifico el inicio/fin de bloque, definición, cabecera y cuerpo del reporte .updateProgressbar( 'Identifying Code Blocks...', 1, 2, 1 ) .identifyCodeBlocks( @laCodeLines, lnCodeLines, @laLineasExclusion, lnBloquesExclusion, @toDatabase, @toFoxBin2Prg ) DO CASE CASE toFoxBin2Prg.c_SimulateError = 'SIMERR_I1' ERROR 'InputFile Error Simulation' CASE toFoxBin2Prg.c_SimulateError = 'SIMERR_I0' .writeErrorLog( '*** SIMULATED ERROR' ) ENDCASE IF .l_Error .writeLog( '*** ERRORS found - Generation Cancelled' ) EXIT ENDIF toFoxBin2Prg.updateProcessedFile( lnIDInputFile ) .updateProgressbar( 'Generating Binary...', 2, 2, 1 ) toFoxBin2Prg.doBackup( .F., .T., '', '', '' ) *.createTable() .writeBinaryFile( @toDatabase, @toFoxBin2Prg ) ENDWITH && THIS CATCH TO loEx lnCodError = loEx.ERRORNO IF THIS.n_Debug > 0 AND _VFP.STARTMODE = 0 SET STEP ON ENDIF THROW FINALLY USE IN (SELECT("TABLABIN")) ENDTRY RETURN lnCodError ENDPROC PROCEDURE writeBinaryFile LPARAMETERS toDatabase, toFoxBin2Prg *-- ----------------------------------------------------------------------------------------------------------- #IF .F. LOCAL toDatabase AS CL_DBC OF 'FOXBIN2PRG.PRG' LOCAL toFoxBin2Prg AS c_foxbin2prg OF 'FOXBIN2PRG.PRG' #ENDIF TRY LOCAL lnCodError, lcEventsFile lnCodError = 0 *-- addProcessedFile( tcFile, tcInOutType, tcProcessed, tcHasErrors, tcSupported, tcExpanded ) toFoxBin2Prg.addProcessedFile( THIS.c_OutputFile, 'O', 'P1', 'E0', 'S1', 'X0' ) DO CASE CASE toFoxBin2Prg.c_SimulateError = 'SIMERR_O1' ERROR 'OutputFile Error Simulation' ENDCASE IF NOT EMPTY(toDatabase._DBCEventFilename) IF LEFT(toDatabase._DBCEventFilename,1) = '.' THEN lcEventsFile = ADDBS( JUSTPATH(.c_InputFile) ) + toDatabase._DBCEventFilename ELSE lcEventsFile = toDatabase._DBCEventFilename ENDIF IF FILE(lcEventsFile) THEN lcEventsFile = '' ELSE STRTOFILE( '', lcEventsFile ) ENDIF *-- Si no recompilo el EventFilename.prg, el EXE dará un error (aunque el PRG no) COMPILE ( ADDBS( JUSTPATH( THIS.c_OutputFile ) ) + toDatabase._DBCEventFilename ) ENDIF toDatabase.updateDBC( THIS.c_OutputFile ) IF toFoxBin2Prg.l_Recompile toFoxBin2Prg.compileFoxProBinary() ENDIF toFoxBin2Prg.updateProcessedFile() CATCH TO loEx lnCodError = loEx.ERRORNO toFoxBin2Prg.updateProcessedFile( 0, '', '', 'E1' ) IF THIS.n_Debug > 0 AND _VFP.STARTMODE = 0 SET STEP ON ENDIF THROW FINALLY IF NOT EMPTY(lcEventsFile) THEN ERASE (lcEventsFile) ERASE (FORCEEXT(lcEventsFile,'FXP')) ENDIF ENDTRY RETURN lnCodError ENDPROC PROCEDURE identifyHeaderBlocks *-------------------------------------------------------------------------------------------------------------- * PARÁMETROS: (v=Pasar por valor | @=Pasar por referencia) (!=Obligatorio | ?=Opcional) (IN/OUT) * taCodeLines (@! IN ) El array con las líneas del código donde buscar * tnCodeLines (@! IN ) Cantidad de líneas de código * taLineasExclusion (@! IN ) Array unidimensional con un .T. o .F. según la línea sea de exclusión o no * tnBloquesExclusion (@! IN ) Cantidad de bloques de exclusión * toDatabase (@? OUT) Objeto con toda la información del módulo analizado * toFoxBin2Prg (@? IN ) Referencia al objeto principal *-------------------------------------------------------------------------------------------------------------- * NOTA: * Como identificador se usa el nombre de clase o de procedimiento, según corresponda. *-------------------------------------------------------------------------------------------------------------- LPARAMETERS taCodeLines, tnCodeLines, taLineasExclusion, tnBloquesExclusion, toDatabase, toFoxBin2Prg EXTERNAL ARRAY taCodeLines, taLineasExclusion #IF .F. LOCAL toDatabase AS CL_DBC OF 'FOXBIN2PRG.PRG' LOCAL toFoxBin2Prg AS c_foxbin2prg OF 'FOXBIN2PRG.PRG' #ENDIF TRY LOCAL I, loEx AS EXCEPTION ; , llFoxBin2Prg_Completed, llOLE_DEF_Completed, llINCLUDE_SCX_Completed, llLIBCOMMENT_Completed, llEXTERNAL_MEMBER_Completed ; , lc_Comentario, lcProcedureAbierto, lcLine ; , loClase AS CL_CLASE OF 'FOXBIN2PRG.PRG' WITH THIS AS c_conversor_prg_a_bin OF 'FOXBIN2PRG.PRG' STORE '' TO lcProcedureAbierto .c_Type = UPPER(JUSTEXT(.c_OutputFile)) IF tnCodeLines > 1 IF toFoxBin2Prg.n_UseClassPerFile > 0 AND toFoxBin2Prg.l_RedirectClassPerFileToMain ELSE llEXTERNAL_MEMBER_Completed = .T. ENDIF *-- Búsqueda del ID de inicio de bloque (DEFINE CLASS / PROCEDURE) FOR I = 1 TO tnCodeLines STORE '' TO lc_Comentario .set_Line( @lcLine, @taCodeLines, I ) DO CASE CASE .lineIsOnlyCommentAndNoMetadata( @lcLine, @lc_Comentario ) && Excluida, vacía o solo Comentarios LOOP CASE NOT llFoxBin2Prg_Completed AND .analyzeCodeBlock_FoxBin2Prg( @toDatabase, @lcLine, @taCodeLines, @I, tnCodeLines ) llFoxBin2Prg_Completed = .T. CASE NOT llEXTERNAL_MEMBER_Completed AND .analyzeCodeBlock_EXTERNAL_MEMBER( @toDatabase, @lcLine, @taCodeLines, @I, tnCodeLines ) *-- Puede haber varias clases externas ENDCASE ENDFOR ENDIF ENDWITH && THIS CATCH TO loEx IF THIS.n_Debug > 0 AND _VFP.STARTMODE = 0 SET STEP ON ENDIF THROW FINALLY STORE NULL TO loClase RELEASE taCodeLines, tnCodeLines, taLineasExclusion, tnBloquesExclusion, toDatabase, loClase, I ; , llFoxBin2Prg_Completed, llOLE_DEF_Completed, llINCLUDE_SCX_Completed, llLIBCOMMENT_Completed ; , lc_Comentario, lcProcedureAbierto, lcLine ENDTRY RETURN ENDPROC PROCEDURE identifyCodeBlocks *-------------------------------------------------------------------------------------------------------------- * PARÁMETROS: (v=Pasar por valor | @=Pasar por referencia) (!=Obligatorio | ?=Opcional) (IN/OUT) * taCodeLines (!@ IN ) El array con las líneas del código donde buscar * tnCodeLines (!@ IN ) Cantidad de líneas de código * taLineasExclusion (@! IN ) Array unidimensional con un .T. o .F. según la línea sea de exclusión o no * tnBloquesExclusion (@? IN ) Sin uso * toDatabase (@! IN ) Objeto con toda la información de la base de datos analizada * toFoxBin2Prg (v! IN ) Referencia al objeto principal *-------------------------------------------------------------------------------------------------------------- * NOTA: * Como identificador se usa el nombre de clase o de procedimiento, según corresponda. *-------------------------------------------------------------------------------------------------------------- LPARAMETERS taCodeLines, tnCodeLines, taLineasExclusion, tnBloquesExclusion, toDatabase, toFoxBin2Prg EXTERNAL ARRAY taCodeLines, taLineasExclusion #IF .F. LOCAL toDatabase AS CL_DBC OF 'FOXBIN2PRG.PRG' LOCAL toFoxBin2Prg AS c_foxbin2prg OF 'FOXBIN2PRG.PRG' #ENDIF TRY LOCAL I, lc_Comentario, lcLine, llFoxBin2Prg_Completed, llBloqueDatabase_Completed STORE 0 TO I WITH THIS AS c_conversor_prg_a_dbc OF 'FOXBIN2PRG.PRG' .c_Type = UPPER(JUSTEXT(.c_OutputFile)) IF tnCodeLines > 1 FOR I = 1 TO tnCodeLines .set_Line( @lcLine, @taCodeLines, I ) DO CASE CASE .lineIsOnlyCommentAndNoMetadata( @lcLine, @lc_Comentario ) && Vacía o solo Comentarios LOOP CASE NOT llFoxBin2Prg_Completed AND .analyzeCodeBlock_FoxBin2Prg( toDatabase, @lcLine, @taCodeLines, @I, tnCodeLines ) llFoxBin2Prg_Completed = .T. CASE NOT llBloqueDatabase_Completed AND toDatabase.analyzeCodeBlock( @lcLine, @taCodeLines, @I, tnCodeLines, @toFoxBin2Prg ) llBloqueDatabase_Completed = .T. ENDCASE ENDFOR .verify_EXTERNAL_MEMBERS( @toDatabase, @toFoxBin2Prg ) ENDIF ENDWITH && THIS CATCH TO loEx IF THIS.n_Debug > 0 AND _VFP.STARTMODE = 0 SET STEP ON ENDIF THROW FINALLY RELEASE taCodeLines, tnCodeLines, taLineasExclusion, tnBloquesExclusion, toDatabase ; , I, lc_Comentario, lcLine, llFoxBin2Prg_Completed, llBloqueDatabase_Completed ENDTRY RETURN ENDPROC PROCEDURE verify_EXTERNAL_MEMBERS *-------------------------------------------------------------------------------- * Compara los miembros definidos en la cabecera con los miembros encontrados luego *-------------------------------------------------------------------------------------------------------------- * PARÁMETROS: (v=Pasar por valor | @=Pasar por referencia) (!=Obligatorio | ?=Opcional) (IN/OUT) * toDatabase (@! IN ) Objeto con toda la información del módulo analizado * toFoxBin2Prg (@! IN ) Referencia al objeto principal *-------------------------------------------------------------------------------------------------------------- LPARAMETERS toDatabase, toFoxBin2Prg #IF .F. LOCAL toDatabase AS CL_DBC OF 'FOXBIN2PRG.PRG' LOCAL toFoxBin2Prg AS c_foxbin2prg OF 'FOXBIN2PRG.PRG' #ENDIF LOCAL lnItem, I, X, lcClaseExterna LOCAL loLang as CL_LANG OF 'FOXBIN2PRG.PRG' loLang = _SCREEN.o_FoxBin2Prg_Lang *-- Verificación de los Miembros, si son Externos y se indicó chequearlos IF toFoxBin2Prg.n_UseClassPerFile > 0 AND toFoxBin2Prg.l_ClassPerFileCheck FOR I = 1 TO toDatabase._ExternalClasses_Count lnItem = 0 FOR X = 1 TO toDatabase._Members_Count IF LOWER( toDatabase._Members(X,1) ) == LOWER( toDatabase._ExternalClasses(I,1) ) lnItem = X EXIT ENDIF ENDFOR IF lnItem = 0 THEN lcClaseExterna = FORCEPATH( JUSTSTEM(toFoxBin2Prg.c_InputFile) + '.' + toDatabase._ExternalClasses(I,1) + '.' + JUSTEXT(toFoxBin2Prg.c_InputFile), JUSTPATH(toFoxBin2Prg.c_InputFile) ) *ERROR 'No se ha encontrado la clase externa [' + toDatabase._ExternalClasses(I,1) + '] en el archivo [' + toFoxBin2Prg.c_InputFile + ']' ERROR ( loLang.C_EXTERNAL_MEMBER_NAME_WAS_NOT_FOUND_LOC + ' [' + lcClaseExterna + ']' ) ENDIF toDatabase._Members(lnItem,2) = .T. && Checked ENDFOR ENDIF ENDPROC 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 = [] ; + [] ; + [] ; + [] c_Type = 'MN2' n_MenuType = 0 c_MenuLocation = '' PROCEDURE convert *--------------------------------------------------------------------------------------------------- * PARÁMETROS: (v=Pasar por valor | @=Pasar por referencia) (!=Obligatorio | ?=Opcional) (IN/OUT) * toMenu (!@ OUT) Objeto generado de clase CL_DBC con la información leida del texto * toEx (!@ OUT) Objeto con información del error * toFoxBin2Prg (v! IN ) Referencia al objeto principal *--------------------------------------------------------------------------------------------------- LPARAMETERS toMenu, toEx AS EXCEPTION, toFoxBin2Prg DODEFAULT( @toMenu, @toEx, @toFoxBin2Prg ) #IF .F. LOCAL toMenu AS CL_MENU OF 'FOXBIN2PRG.PRG' LOCAL toFoxBin2Prg AS c_foxbin2prg OF 'FOXBIN2PRG.PRG' #ENDIF TRY LOCAL lnCodError, loEx AS EXCEPTION, loReg, lcLine, laCodeLines(1), lnCodeLines ; , laLineasExclusion(1), lnBloquesExclusion, lnIDInputFile STORE 0 TO lnCodError, lnCodeLines STORE '' TO lcLine WITH THIS AS c_conversor_prg_a_mnx OF 'FOXBIN2PRG.PRG' lnIDInputFile = toFoxBin2Prg.n_ProcessedFiles IF NOT toFoxBin2Prg.l_ProcessFiles THEN *-- addProcessedFile( tcFile, tcInOutType, tcProcessed, tcHasErrors, tcSupported, tcExpanded ) IF toFoxBin2Prg.addProcessedFile( .c_OutputFile, 'O', 'P1', 'E0', 'S1', 'X0' ) THEN toFoxBin2Prg.updateProcessedFile() ENDIF EXIT && Si se indicó no procesar, se sale aquí. (Modo de simulación) ENDIF C_FB2PRG_CODE = FILETOSTR( .c_InputFile ) lnCodeLines = ALINES( laCodeLines, C_FB2PRG_CODE ) .createMenu('CURSOR') *-- Identifico el inicio/fin de bloque, definición, cabecera y cuerpo del reporte .updateProgressbar( 'Identifying Code Blocks...', 1, 2, 1 ) .identifyCodeBlocks( @laCodeLines, lnCodeLines, @laLineasExclusion, lnBloquesExclusion, @toMenu ) USE IN (SELECT('TABLABIN')) DO CASE CASE toFoxBin2Prg.c_SimulateError = 'SIMERR_I1' ERROR 'InputFile Error Simulation' CASE toFoxBin2Prg.c_SimulateError = 'SIMERR_I0' .writeErrorLog( '*** SIMULATED ERROR' ) ENDCASE IF .l_Error .writeLog( '*** ERRORS found - Generation Cancelled' ) EXIT ENDIF toFoxBin2Prg.updateProcessedFile( lnIDInputFile ) .updateProgressbar( 'Generating Binary...', 1, 2, 1 ) toFoxBin2Prg.doBackup( .F., .T., '', '', '' ) .createMenu() .writeBinaryFile( @toMenu, @toFoxBin2Prg ) ENDWITH && THIS CATCH TO loEx lnCodError = loEx.ERRORNO IF THIS.n_Debug > 0 AND _VFP.STARTMODE = 0 SET STEP ON ENDIF THROW FINALLY USE IN (SELECT("TABLABIN")) ENDTRY RETURN lnCodError ENDPROC PROCEDURE identifyCodeBlocks *-------------------------------------------------------------------------------------------------------------- * PARÁMETROS: (v=Pasar por valor | @=Pasar por referencia) (!=Obligatorio | ?=Opcional) (IN/OUT) * taCodeLines (!@ IN ) El array con las líneas del código donde buscar * tnCodeLines (!@ IN ) Cantidad de líneas de código * taLineasExclusion (@! IN ) Array unidimensional con un .T. o .F. según la línea sea de exclusión o no * tnBloquesExclusion (@? IN ) Sin uso * toMenu (@? OUT) Objeto con toda la información del menú analizado * * NOTA: * Como identificador se usa el nombre de clase o de procedimiento, según corresponda. *-------------------------------------------------------------------------------------------------------------- LPARAMETERS taCodeLines, tnCodeLines, taLineasExclusion, tnBloquesExclusion, toMenu EXTERNAL ARRAY taCodeLines, taLineasExclusion #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 ) DO CASE CASE .lineIsOnlyCommentAndNoMetadata( @lcLine, @lc_Comentario ) && Vacía o solo Comentarios LOOP CASE NOT llFoxBin2Prg_Completed AND .analyzeCodeBlock_FoxBin2Prg( toMenu, @lcLine, @taCodeLines, @I, tnCodeLines ) llFoxBin2Prg_Completed = .T. CASE NOT llBloqueMenu_Completed AND toMenu.analyzeCodeBlock( @lcLine, @taCodeLines, @I, tnCodeLines, THIS ) llBloqueMenu_Completed = .T. ENDCASE ENDFOR ENDIF ENDWITH && THIS CATCH TO loEx IF THIS.n_Debug > 0 AND _VFP.STARTMODE = 0 SET STEP ON ENDIF THROW FINALLY RELEASE taCodeLines, tnCodeLines, taLineasExclusion, tnBloquesExclusion, toMenu ; , I, lc_Comentario, lcLine, llFoxBin2Prg_Completed, llBloqueMenu_Completed ENDTRY RETURN ENDPROC PROCEDURE writeBinaryFile *--------------------------------------------------------------------------------------------------- * PARÁMETROS: (v=Pasar por valor | @=Pasar por referencia) (!=Obligatorio | ?=Opcional) (IN/OUT) * toMenu (!@ OUT) Objeto generado de clase CL_DBC con la información leida del texto *--------------------------------------------------------------------------------------------------- LPARAMETERS toMenu, toFoxBin2Prg #IF .F. LOCAL toMenu AS CL_MENU OF 'FOXBIN2PRG.PRG' #ENDIF TRY LOCAL lnCodError lnCodError = 0 *-- addProcessedFile( tcFile, tcInOutType, tcProcessed, tcHasErrors, tcSupported, tcExpanded ) toFoxBin2Prg.addProcessedFile( THIS.c_OutputFile, 'O', 'P1', 'E0', 'S1', 'X0' ) DO CASE CASE toFoxBin2Prg.c_SimulateError = 'SIMERR_O1' ERROR 'OutputFile Error Simulation' ENDCASE toMenu.updateMENU( THIS ) toFoxBin2Prg.updateProcessedFile() CATCH TO loEx lnCodError = loEx.ERRORNO toFoxBin2Prg.updateProcessedFile( 0, '', '', 'E1' ) IF THIS.n_Debug > 0 AND _VFP.STARTMODE = 0 SET STEP ON ENDIF THROW FINALLY USE IN (SELECT(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 convert *--------------------------------------------------------------------------------------------------- * PARÁMETROS: (v=Pasar por valor | @=Pasar por referencia) (!=Obligatorio | ?=Opcional) (IN/OUT) * toModulo (!@ OUT) Objeto generado de clase correspondiente con la información leida del texto * toEx (!@ OUT) Objeto con información del error * toFoxBin2Prg (v! IN ) Referencia al objeto principal *--------------------------------------------------------------------------------------------------- LPARAMETERS toModulo, toEx AS EXCEPTION, toFoxBin2Prg #IF .F. LOCAL toFoxBin2Prg AS c_foxbin2prg OF 'FOXBIN2PRG.PRG' #ENDIF DODEFAULT( @toModulo, @toEx, @toFoxBin2Prg ) ENDPROC PROCEDURE classify_PAM_Hidden_Protected *--------------------------------------------------------------------------------------------------- * PARÁMETROS: (v=Pasar por valor | @=Pasar por referencia) (!=Obligatorio | ?=Opcional) (IN/OUT) * tnPropsAndValues_Count (@! IN ) * taPropsAndValues (@! IN ) * tnProtected_Count (@! IN ) * taProtected (@! IN ) * tnPropsAndComments_Count (@! IN ) * taPropsAndComments (@! IN ) * tcHiddenProp (@! OUT) Lista de propiedades Hidden * tcProtectedProp (@! OUT) Lista de propiedades Protected *--------------------------------------------------------------------------------------------------- LPARAMETERS tnPropsAndValues_Count, taPropsAndValues, tnProtected_Count, taProtected ; , tnPropsAndComments_Count, taPropsAndComments, tcHiddenProp, tcProtectedProp IF tnPropsAndValues_Count > 0 THEN *-- Recorro las propiedades (campo Properties) para ir conformando *-- las definiciones HIDDEN y PROTECTED LOCAL lcProp, I STORE '' TO tcHiddenProp, tcProtectedProp FOR I = 1 TO tnProtected_Count DO CASE CASE EMPTY( taProtected(I) ) LOOP CASE RIGHT( taProtected(I), 1 ) == '^' *-- Hidden Property or method lcProp = CHRTRAN( taProtected(I), '^', '' ) IF ASCAN(taPropsAndComments, '*' + lcProp, 1, 0, 1, 1+2+4) > 0 LOOP && method ENDIF tcHiddenProp = tcHiddenProp + ',' + lcProp OTHERWISE *-- Protected Property or method IF ASCAN(taPropsAndComments, '*' + taProtected(I), 1, 0, 1, 1+2+4) > 0 LOOP && method ENDIF tcProtectedProp = tcProtectedProp + ',' + taProtected(I) ENDCASE ENDFOR ENDIF 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, @toRegObj ) *-- Ubico los métodos protegidos y les cambio la definición. *-- Los métodos se deben generar con la ruta completa, porque si no es imposible saber a que objeto corresponden, *-- o si son de la clase. IF tnMethodCount - lnMethodCount > 0 THEN FOR I = lnMethodCount + 1 TO tnMethodCount IF taMethods(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 LOWER( LEFT(toRegObj.PARENT + '.', LEN( toRegClass.OBJNAME + '.' ) ) ) == LOWER( 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 + .indentMemo( taCode(taMethods(I,2)) ) + CR_LF + 'ENDPROC' taMethods(I,1) = lcMethodName ENDFOR ENDIF ENDWITH && THIS CATCH TO loEx IF THIS.n_Debug > 0 AND _VFP.STARTMODE = 0 SET STEP ON ENDIF THROW FINALLY RELEASE toRegObj, toRegClass, tcMethods, taMethods, taCode, tnMethodCount ; , taPropsAndComments, tnPropsAndComments_Count, taProtected, tnProtected_Count ; , toFoxBin2Prg, lcMethodName, lnMethodCount ENDTRY RETURN ENDPROC PROCEDURE get_CLASS_METHODS LPARAMETERS tnMethodCount, taMethods, taCode, taProtected, taPropsAndComments *-- 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 + .indentMemo( 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.n_Debug > 0 AND _VFP.STARTMODE = 0 SET STEP ON ENDIF THROW FINALLY RELEASE tnMethodCount, taMethods, taCode, taProtected, taPropsAndComments ; , lcMethod, lcMethodName, lnProtectedItem, lnCommentRow, lcProcDef, lcMethods, lnLen ENDTRY RETURN ENDPROC PROCEDURE get_OLEPublicObjectName LPARAMETERS ta_NombresObjsOle *-- Obtengo los objetos "OLEPublic" LOCAL I SELECT PADR(OBJNAME,100) OBJNAME ; FROM TABLABIN ; WHERE TABLABIN.PLATFORM = "COMMENT" AND TABLABIN.RESERVED2 == "OLEPublic" ; ORDER BY 1 ; INTO ARRAY ta_NombresObjsOle FOR I = 1 TO _TALLY ta_NombresObjsOle(I) = ALLTRIM( ta_NombresObjsOle(I) ) ENDFOR RETURN ENDPROC PROCEDURE get_PropsAndCommentsFrom_RESERVED3 *-- Sirve para el memo RESERVED3 *--------------------------------------------------------------------------------------------------- * PARÁMETROS: (v=Pasar por valor | @=Pasar por referencia) (!=Obligatorio | ?=Opcional) (IN/OUT) * tcMemo (v! IN ) Contenido de un campo MEMO * tlSort (v? IN ) Indica si se deben ordenar alfabéticamente los nombres * taPropsAndComments (!@ OUT) Array con las propiedades y comentarios * tnPropsAndComments_Count (!@ OUT) Cantidad de propiedades * tcSortedMemo (@? OUT) Contenido del campo memo ordenado *--------------------------------------------------------------------------------------------------- LPARAMETERS tcMemo, tlSort, taPropsAndComments, tnPropsAndComments_Count, tcSortedMemo 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) = LOWER( laLines(I) ) taPropsAndComments(I,2) = '' ELSE taPropsAndComments(I,1) = LOWER( 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.n_Debug > 0 AND _VFP.STARTMODE = 0 SET STEP ON ENDIF THROW FINALLY RELEASE tcMemo, tlSort, taPropsAndComments, tnPropsAndComments_Count, tcSortedMemo ; , laLines, I, lnPos, loEx 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 * toFoxBin2Prg (v! IN ) Referencia al objeto principal *--------------------------------------------------------------------------------------------------- LPARAMETERS tcMemo, tnSort, taPropsAndValues, tnPropsAndValues_Count, tcSortedMemo, toFoxBin2Prg EXTERNAL ARRAY taPropsAndValues #IF .F. LOCAL toFoxBin2Prg AS c_foxbin2prg OF 'FOXBIN2PRG.PRG' #ENDIF TRY LOCAL laItems(1), I, X, lnLenAcum, lnPosEQ, lcPropName, lnLenVal, lcValue, lcMethods, lcLastIncompletePropName STORE '' TO tcSortedMemo, lcLastIncompletePropName tnPropsAndValues_Count = 0 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 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 = lcLastIncompletePropName + 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 X = X + 1 DIMENSION taPropsAndValues(X,2) taPropsAndValues(X,1) = lcPropName taPropsAndValues(X,2) = .normalizePropertyValue( lcPropName, lcValue, '' ) ELSE *-- Propiedad normal lnPosEQ = AT( '=', laItems(I) ) IF lnPosEQ = 0 THEN *-- AUTOFIX DE PROPIEDAD PARTIDA: *-- Esto solo puede ocurrir cuando en el memo de Propiedades hay alguna propiedad *-- partida debido a una edición manual con un Enter erróneo, algo como esto: * comm * AND2.Caption = "Command2" * *-- En el caso anterior, las 2 líneas son realmente una: * command2.Caption = "Command2" * *-- Solución: Guardar esta parte del nombre y agregarlo a la próxima propiedad. lcLastIncompletePropName = laItems(I) LOOP ENDIF * Skip ZOrderSet property if configured to IF toFoxBin2Prg.l_RemoveZOrderSetFromProps AND ATC( '.ZOrderSet.', '.' + lcLastIncompletePropName + LEFT( laItems(I), lnPosEQ - 2 ) + '.' ) > 0 THEN lcLastIncompletePropName = '' LOOP ENDIF X = X + 1 DIMENSION taPropsAndValues(X,2) taPropsAndValues(X,1) = lcLastIncompletePropName + LEFT( laItems(I), lnPosEQ - 2 ) taPropsAndValues(X,2) = .normalizePropertyValue( taPropsAndValues(X,1), LTRIM( SUBSTR( laItems(I), lnPosEQ + 2 ) ), '' ) ENDIF lcLastIncompletePropName = '' 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.n_Debug > 0 AND _VFP.STARTMODE = 0 SET STEP ON ENDIF THROW FINALLY RELEASE tcMemo, tnSort, taPropsAndValues, tnPropsAndValues_Count, tcSortedMemo ; , laItems, I, X, lnLenAcum, lnPosEQ, lcPropName, lnLenVal, lcValue, lcMethods 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 LOCAL I 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 taProtected(I) = taProtected(I) IF ASCAN( taProtected, taProtected(I), 1, -1, 0, 1+2+4 ) = I tcSortedMemo = tcSortedMemo + taProtected(I) + CR_LF ELSE ADEL( taProtected, I ) tnProtected_Count = tnProtected_Count - 1 ENDIF ENDFOR DIMENSION taProtected(tnProtected_Count) ENDIF RELEASE tcMemo, tlSort, taProtected, tnProtected_Count, tcSortedMemo, I RETURN ENDPROC PROCEDURE indentMemo LPARAMETERS tcMethod, tcIndentation, tlKeepProcHeader *-- INDENTA EL CÓDIGO DE UN MÉTODO DADO Y QUITA LA CABECERA DE MÉTODO (PROCEDURE/ENDPROC) SI LA ENCUENTRA TRY LOCAL I, X, lcMethod, llProcedure, lnInicio, lnFin, laLineas(1), lnOffset LOCAL loLang as CL_LANG OF 'FOXBIN2PRG.PRG' loLang = _SCREEN.o_FoxBin2Prg_Lang lcMethod = '' lnInicio = 1 lnOffset = 0 lnFin = ALINES(laLineas, tcMethod) llProcedure = ( LEFT(laLineas(1),10) == 'PROCEDURE ' ; OR LEFT(laLineas(1),17) == 'HIDDEN PROCEDURE ' ; OR LEFT(laLineas(1),20) == 'PROTECTED PROCEDURE ' ) 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(loLang.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 lcMethod = CR_LF + C_TAB + laLineas(lnInicio) + lcMethod + CR_LF + C_TAB + laLineas(lnFin) ENDIF lcMethod = SUBSTR(lcMethod,3) && Quito el primer ENTER (CR+LF) CATCH TO loEx IF THIS.n_Debug > 0 AND _VFP.STARTMODE = 0 SET STEP ON ENDIF THROW FINALLY RELEASE tcMethod, tcIndentation, tlKeepProcHeader ; , I, X, llProcedure, lnInicio, lnFin, laLineas, lnOffset ENDTRY RETURN lcMethod ENDPROC PROCEDURE memoInOneLine LPARAMETERS 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.n_Debug > 0 AND _VFP.STARTMODE = 0 SET STEP ON ENDIF THROW FINALLY RELEASE tcMethod, I 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.n_Debug > 0 AND _VFP.STARTMODE = 0 SET STEP ON ENDIF THROW FINALLY RELEASE taPropsAndValues, tnPropCount, tcLeftIndentation, tlNormalizeLine ; , I, lcComentarios, laLines, lcFinDeLinea ENDTRY RETURN lcLine ENDPROC PROCEDURE set_UserValue *--------------------------------------------------------------------------------------------------- * Intenta obtener información más precisa sobre el error a reportar dentro de methods *--------------------------------------------------------------------------------------------------- * PARÁMETROS: (v=Pasar por valor | @=Pasar por referencia) (!=Obligatorio | ?=Opcional) (IN/OUT) * toEx (v! IN ) Objeto Exception *--------------------------------------------------------------------------------------------------- LPARAMETERS toEx as Exception LOCAL lcMethods, I, lcLine, laCodeLines(1), lcMethod, lcLocation, lnErrorLine STORE '' TO lcMethods, lcLine, laCodeLines, lcMethod, lcLocation STORE 0 TO lnErrorLine, I WITH THIS AS c_conversor_bin_a_prg OF 'FOXBIN2PRG.PRG' toEx.UserValue = toEx.UserValue + CR_LF IF INLIST(.c_Type, 'SCX', 'VCX') THEN lcMethods = METHODS toEx.UserValue = toEx.UserValue + 'Error location ' + '..............................' + CR_LF IF NOT EMPTY(Parent) lcLocation = lcLocation + Parent + '.' ENDIF lcLocation = lcLocation + OBJNAME *-- Busco el Procedure si hay un n_Methods_LineNo ALINES(laCodeLines, lcMethods) FOR I = .n_Methods_LineNo TO 1 STEP -1 lcLine = LTRIM( laCodeLines(I), 0, ' ', CHR(9) ) DO CASE CASE LEFT(lcLine, 10) == 'PROCEDURE ' lcMethod = ALLTRIM( SUBSTR( lcLine, 11) ) lnErrorLine = .n_Methods_LineNo - I EXIT CASE LEFT(lcLine, 9) == 'FUNCTION ' lcMethod = ALLTRIM( SUBSTR( lcLine, 10) ) lnErrorLine = .n_Methods_LineNo - I EXIT ENDCASE ENDFOR IF EMPTY(lcMethod) THEN lcLocation = 'Class: ' + lcLocation ELSE lcLocation = 'Method: ' + lcLocation + '.' + lcMethod ENDIF IF lnErrorLine > 0 THEN lcLocation = lcLocation + ', Line ' + TRANSFORM(lnErrorLine) ENDIF toEx.UserValue = toEx.UserValue + lcLocation + CR_LF IF .n_Methods_LineNo = 0 THEN toEx.UserValue = toEx.UserValue + '> (no evaluated code yet)' + CR_LF ELSE toEx.UserValue = toEx.UserValue + '> ' + laCodeLines(.n_Methods_LineNo) + CR_LF ENDIF ENDIF toEx.UserValue = toEx.UserValue + 'Recno: ' + TRANSFORM(RECNO()) + CR_LF toEx.UserValue = toEx.UserValue + '.............................................' + CR_LF ENDWITH 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.n_Debug > 0 AND _VFP.STARTMODE = 0 SET STEP ON ENDIF THROW FINALLY RELEASE tcMethod, taMethods, taCode, tcSorted, tnMethodCount, taPropsAndComments, tnPropsAndComments_Count ; , taProtected, tnProtected_Count, toFoxBin2Prg ; , I, I2, laMethods, lnDeleted, lcMethodName, lnMethodPos, lcMethodType, loEx ENDTRY RETURN ENDPROC && SordMethod PROCEDURE method2Array LPARAMETERS tcMethod, taMethods, taCode, tcSorted, tnMethodCount, taPropsAndComments, tnPropsAndComments_Count ; , taProtected, tnProtected_Count, toFoxBin2Prg, toRegObj *-- 29/10/2013 Fernando D. Bozzo *-- Se tiene en cuenta la posibilidad de que haya un PROC/ENDPROC dentro de un TEXT/ENDTEXT *-- cuando es usado en un generador de código o similar. EXTERNAL ARRAY taMethods, taCode, taPropsAndComments, taProtected #IF .F. LOCAL toFoxBin2Prg AS c_foxbin2prg OF 'FOXBIN2PRG.PRG' #ENDIF *-- ESTRUCTURA DE LOS ARRAYS CREADOS: *-- taMethods[1,3] *-- 1.Nombre Método *-- 2.Posición Original *-- 3.Tipo (HIDDEN/PROTECTED/NORMAL) *-- taCode[1] *-- 1.Bloque de código del método en su posición original TRY LOCAL lnLineCount, laLine(1), I, lnTextNodes, tcSorted, lnProtectedLine, lcMethod, lnLine_Len, lcLine, llProcOpen ; , laLineasExclusion(1), lnBloquesExclusion, lcLastLine ; , loEx AS EXCEPTION IF NOT EMPTY(m.tcMethod) AND LEFT(m.tcMethod,9) == "ENDPROC"+CHR(13)+CHR(10) tcMethod = SUBSTR(m.tcMethod,10) ENDIF IF NOT EMPTY(m.tcMethod) WITH THIS AS c_conversor_bin_a_prg OF 'FOXBIN2PRG.PRG' DIMENSION laLine(1) STORE '' TO laLine, lcLine, lcLastLine STORE 0 TO lnTextNodes 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 .identifyExclusionBlocks( @laLine, lnLineCount, .F., @laLineasExclusion, @lnBloquesExclusion ) *-- Analyze and count line methods, get method names and consolidate block code FOR I = 1 TO lnLineCount IF toFoxBin2Prg.l_RemoveNullCharsFromCode laLine(I) = CHRTRAN( laLine(I), C_NULL_CHAR, '' ) ENDIF lnLine_Len = LEN( laLine(I) ) lcLastLine = lcLine toFoxBin2Prg.set_Line( @lcLine, @laLine, I ) .get_SeparatedLineAndComment( @lcLine ) 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 RIGHT(lcLastLine,1) == ';' *-- Saltear el análisis de esta línea, que es continuación de la anterior (lcLastLine). taCode(tnMethodCount) = taCode(tnMethodCount) + laLine(I) + CR_LF LOOP CASE lnTextNodes = 0 AND UPPER( LEFT(lcLine, 10) ) == 'PROCEDURE ' tnMethodCount = tnMethodCount + 1 DIMENSION taMethods(tnMethodCount, 3), taCode(tnMethodCount) taMethods(tnMethodCount, 1) = RTRIM( SUBSTR(lcLine, 11) ) 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(lcLine, 9) ) == 'FUNCTION ' && NOT VALID WITH VFP IDE, BUT 3rd. PARTY SOFTWARE CAN USE IT tnMethodCount = tnMethodCount + 1 DIMENSION taMethods(tnMethodCount, 3), taCode(tnMethodCount) taMethods(tnMethodCount, 1) = RTRIM( SUBSTR(lcLine, 10) ) taMethods(tnMethodCount, 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(lcLine, 17) ) == 'HIDDEN PROCEDURE ' tnMethodCount = tnMethodCount + 1 DIMENSION taMethods(tnMethodCount, 3), taCode(tnMethodCount) taMethods(tnMethodCount, 1) = RTRIM( SUBSTR(lcLine, 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(lcLine, 16) ) == 'HIDDEN FUNCTION ' && NOT VALID WITH VFP IDE, BUT 3rd. PARTY SOFTWARE CAN USE IT tnMethodCount = tnMethodCount + 1 DIMENSION taMethods(tnMethodCount, 3), taCode(tnMethodCount) taMethods(tnMethodCount, 1) = RTRIM( SUBSTR(lcLine, 17) ) taMethods(tnMethodCount, 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(lcLine, 20) ) == 'PROTECTED PROCEDURE ' tnMethodCount = tnMethodCount + 1 DIMENSION taMethods(tnMethodCount, 3), taCode(tnMethodCount) taMethods(tnMethodCount, 1) = RTRIM( SUBSTR(lcLine, 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(lcLine, 19) ) == 'PROTECTED FUNCTION ' && NOT VALID WITH VFP IDE, BUT 3rd. PARTY SOFTWARE CAN USE IT tnMethodCount = tnMethodCount + 1 DIMENSION taMethods(tnMethodCount, 3), taCode(tnMethodCount) taMethods(tnMethodCount, 1) = RTRIM( SUBSTR(lcLine, 20) ) taMethods(tnMethodCount, 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(lcLine, 7) == 'ENDPROC' IF lnLine_Len >= 7 AND LEFT( UPPER( CHRTRAN( lcLine , '&'+CHR(9)+CHR(0), ' ') ) + ' ' ,8) == 'ENDPROC ' *-- Es el final de estructura ENDPROC IF NOT llProcOpen *-- Esto no es normal, porque hay más de un ENDPROC, por lo que se ignora. LOOP ENDIF ELSE *-- Es otra cosa (variable, etc) taCode(tnMethodCount) = taCode(tnMethodCount) + lcLine + CR_LF LOOP ENDIF taCode(tnMethodCount) = taCode(tnMethodCount) + lcLine &&+ CR_LF llProcOpen = .F. CASE lnTextNodes = 0 AND LEFT(laLine(I), 7) == 'ENDFUNC' && NOT VALID WITH VFP IDE, BUT 3rd. PARTY SOFTWARE CAN USE IT IF lnLine_Len >= 7 AND LEFT( UPPER( CHRTRAN( laLine(I) , '&'+CHR(9)+CHR(0), ' ') ) + ' ' ,8) == 'ENDFUNC ' *-- Es el final de estructura ENDPROC IF NOT llProcOpen *-- Esto no es normal, porque hay más de un ENDFUNC, por lo que se ignora. LOOP ENDIF lcLine = STRTRAN( lcLine, 'ENDFUNC', 'ENDPROC' ) ELSE *-- Es otra cosa (variable, etc) taCode(tnMethodCount) = taCode(tnMethodCount) + lcLine + CR_LF LOOP ENDIF taCode(tnMethodCount) = taCode(tnMethodCount) + lcLine &&+ CR_LF llProcOpen = .F. *CASE tnMethodCount = 0 OR NOT llProcOpen AND LEFT( LTRIM(laLine(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 ENDWITH && THIS AS c_conversor_bin_a_prg OF 'FOXBIN2PRG.PRG' ENDIF CATCH TO loEx IF THIS.n_Debug > 0 AND _VFP.STARTMODE = 0 SET STEP ON ENDIF THROW FINALLY RELEASE tcMethod, taMethods, taCode, tcSorted, tnMethodCount, taPropsAndComments, tnPropsAndComments_Count ; , taProtected, tnProtected_Count, toFoxBin2Prg ; , lnLineCount, laLine, I, lnTextNodes, tcSorted, lnProtectedLine, lcMethod, lnLine_Len, lcLine, llProcOpen ; , laLineasExclusion, lnBloquesExclusion ; , loEx ENDTRY RETURN ENDPROC && method2Array PROCEDURE write_ADD_OBJECTS_WithProperties *--------------------------------------------------------------------------------------------------- * PARÁMETROS: (v=Pasar por valor | @=Pasar por referencia) (!=Obligatorio | ?=Opcional) (IN/OUT) * toRegObj (v! IN ) Objeto de registro * tcCodigo (@? OUT) Codigo generado * toFoxBin2Prg (v! IN ) Referencia al objeto principal *--------------------------------------------------------------------------------------------------- LPARAMETERS toRegObj, tcCodigo, toFoxBin2Prg #IF .F. LOCAL toRegObj AS CL_OBJETO OF 'FOXBIN2PRG.PRG' LOCAL toFoxBin2Prg AS c_foxbin2prg OF 'FOXBIN2PRG.PRG' #ENDIF TRY LOCAL lcMemo, laPropsAndValues(1,2), lnPropsAndValues_Count WITH THIS AS c_conversor_bin_a_prg OF 'FOXBIN2PRG.PRG' *-- Defino los objetos a cargar .get_PropsAndValuesFrom_PROPERTIES( toRegObj.PROPERTIES, 1, @laPropsAndValues, @lnPropsAndValues_Count, @lcMemo, @toFoxBin2Prg ) lcMemo = .set_MultilineMemoWithAddObjectProperties( @laPropsAndValues, @lnPropsAndValues_Count, C_TAB + C_TAB, .T. ) IF '.' $ toRegObj.PARENT *-- Este caso: clase.objeto.objeto ==> se quita clase TEXT TO tcCodigo ADDITIVE TEXTMERGE NOSHOW FLAGS 1+2 PRETEXT 1+2 <<>> 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 OLEObject="< 0 THEN .classify_PAM_Hidden_Protected( @tnPropsAndValues_Count, @taPropsAndValues, @tnProtected_Count, @taProtected ; , @tnPropsAndComments_Count, @taPropsAndComments, @lcHiddenProp, @lcProtectedProp ) .write_DEFINED_PAM( @taPropsAndComments, tnPropsAndComments_Count, @tcCodigo ) .write_HIDDEN_Properties( @lcHiddenProp, @tcCodigo ) .write_PROTECTED_Properties( @lcProtectedProp, @tcCodigo ) *-- Escribo las propiedades de la clase y sus comentarios (los comentarios aquí son redundantes) FOR I = 1 TO tnPropsAndValues_Count tcCodigo = tcCodigo + CHR(13) + CHR(10) + CHR(9) + taPropsAndValues(I,1) + ' = ' + taPropsAndValues(I,2) IF tnPropsAndComments_Count > 0 THEN lnComment = ASCAN( taPropsAndComments, taPropsAndValues(I,1), 1, 0, 1, 1+2+4+8) IF lnComment > 0 AND NOT EMPTY(taPropsAndComments(lnComment,2)) tcCodigo = tcCodigo + CHR(9) + CHR(9) + '&' + '& ' + taPropsAndComments(lnComment,2) ENDIF ENDIF ENDFOR TEXT TO tcCodigo ADDITIVE TEXTMERGE NOSHOW FLAGS 1+2 PRETEXT 1+2 <<>> ENDTEXT ENDIF ENDWITH && THIS CATCH TO loEx IF THIS.n_Debug > 0 AND _VFP.STARTMODE = 0 SET STEP ON ENDIF THROW FINALLY RELEASE toRegClass, taPropsAndValues, taPropsAndComments, taProtected ; , tnPropsAndValues_Count, tnPropsAndComments_Count, tnProtected_Count ; , lcHiddenProp, lcProtectedProp, lcPropsMethodsDefd, I ; , lcPropName, lnProtectedItem, lcComentarios, loEx 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 tcCodigo = tcCodigo + CHR(13) + CHR(10) + CHR(9) + CHR(9) + '*' + lcType + ': ' + taPropsAndComments(I,1) ELSE tcCodigo = tcCodigo + CHR(13) + CHR(10) + CHR(9) + CHR(9) + '*' + lcType + ': ' + SUBSTR( taPropsAndComments(I,1), 2) ENDIF IF NOT EMPTY(taPropsAndComments(I,2)) tcCodigo = tcCodigo + CHR(9) + CHR(9) + '&' + '& ' + taPropsAndComments(I,2) ENDIF ENDFOR TEXT TO tcCodigo ADDITIVE TEXTMERGE NOSHOW FLAGS 1+2 PRETEXT 1+2 <<>> <> ENDTEXT tcCodigo = tcCodigo + CR_LF RELEASE I, lcPropsMethodsDefd, lcType ENDIF RELEASE taPropsAndComments, tnPropsAndComments_Count 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+2+4+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_IfApplicable 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_EXTERNAL_CLASS_HEADER LPARAMETERS toRegClass, toFoxBin2Prg, tcCodigo *-- < EXTERNAL_CLASS Name = "class-name" Baseclass="base-class" /> #IF .F. LOCAL toFoxBin2Prg AS c_foxbin2prg OF 'FOXBIN2PRG.PRG' #ENDIF IF EMPTY(tcCodigo) THEN TEXT TO tcCodigo ADDITIVE TEXTMERGE NOSHOW FLAGS 1+2 PRETEXT 1+2 *-- EXTERNAL_CLASS identify external member Class names / EXTERNAL_CLASS identifica los nombres de las Clases externas ENDTEXT ENDIF TEXT TO tcCodigo ADDITIVE TEXTMERGE NOSHOW FLAGS 1+2 PRETEXT 1+2 <> Name="<>" Baseclass="<>" <> ENDTEXT RETURN ENDPROC PROCEDURE write_EXTERNAL_MEMBER_HEADER LPARAMETERS toFoxBin2Prg, tcMemberName, tcMemberType, tcCodigo *-- < EXTERNAL_MEMBER Name = "member-name" Type="member-type" /> #IF .F. LOCAL toFoxBin2Prg AS c_foxbin2prg OF 'FOXBIN2PRG.PRG' #ENDIF IF EMPTY(tcCodigo) THEN TEXT TO tcCodigo ADDITIVE TEXTMERGE NOSHOW FLAGS 1+2 PRETEXT 1+2 *-- EXTERNAL_MEMBER identify external member names / EXTERNAL_MEMBER identifica los nombres de los miembros externos ENDTEXT ENDIF IF NOT EMPTY(tcMemberName) AND NOT EMPTY(tcMemberType) THEN TEXT TO tcCodigo ADDITIVE TEXTMERGE NOSHOW FLAGS 1+2 PRETEXT 1+2 <> Name="<>" Type="<>" <> ENDTEXT ENDIF 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_TXT_REPORTE LPARAMETERS toReg TRY LOCAL lc_TAG_REPORTE_I, lc_TAG_REPORTE_F, loEx AS EXCEPTION lc_TAG_REPORTE_I = '<' + C_TAG_REPORTE + ' ' lc_TAG_REPORTE_F = '' 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 + " " IF INLIST(toReg.ObjType, 25, 26) && Dataenvironment, cursors and relations C_FB2PRG_CODE = C_FB2PRG_CODE + CR_LF + " " C_FB2PRG_CODE = C_FB2PRG_CODE + CR_LF + " " ELSE C_FB2PRG_CODE = C_FB2PRG_CODE + CR_LF + " " C_FB2PRG_CODE = C_FB2PRG_CODE + CR_LF + " " ENDIF C_FB2PRG_CODE = C_FB2PRG_CODE + CR_LF + " " C_FB2PRG_CODE = C_FB2PRG_CODE + CR_LF + "