31713 lines
1.2 MiB
31713 lines
1.2 MiB
*---------------------------------------------------------------------------------------------------
|
|
* Module.........: FOXBIN2PRG.PRG - FOR VISUAL FOXPRO 9.0
|
|
* Author.........: Fernando D. Bozzo (mailto:fdbozzo@gmail.com) - http://fdbozzo.blogspot.com
|
|
* Project info...: https://vfpx.codeplex.com/wikipage?title=FoxBin2Prg
|
|
* Creation Date..: 2013/11/04
|
|
*
|
|
* 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 "<path>\FILE.VCX" && Genera "<path>\FILE.VC2" (BIN TO PRG CONVERSION)
|
|
* DO FOXBIN2PRG.PRG WITH "<path>\FILE.VC2" && Genera "<path>\FILE.VCX" (PRG TO BIN CONVERSION)
|
|
*
|
|
* DO FOXBIN2PRG.PRG WITH "<path>\FILE.SCX" && Genera "<path>\FILE.SC2" (BIN TO PRG CONVERSION)
|
|
* DO FOXBIN2PRG.PRG WITH "<path>\FILE.SC2" && Genera "<path>\FILE.SCX" (PRG TO BIN CONVERSION)
|
|
*
|
|
* DO FOXBIN2PRG.PRG WITH "<path>\FILE.PJX" && Genera "<path>\FILE.PJ2" (BIN TO PRG CONVERSION)
|
|
* DO FOXBIN2PRG.PRG WITH "<path>\FILE.PJ2" && Genera "<path>\FILE.PJX" (PRG TO BIN CONVERSION)
|
|
*
|
|
* DO FOXBIN2PRG.PRG WITH "-c", cOutputFile && Generate a configuration (FoxBin2Prg.cfg) template
|
|
*
|
|
*---------------------------------------------------------------------------------------------------
|
|
* <HISTORIAL DE CAMBIOS Y NOTAS IMPORTANTES>
|
|
* 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.43 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)
|
|
* 10/05/2015 FDBOZZO v1.19.43 Bug Fix: Cuando un form tiene AutoCenter=.T., hay veces en que al regenerar el binario y ejecutarlo no se muestra centrado (Esteban H)
|
|
* 14/05/2015 FDBOZZO v1.19.44 Bug Fix: En ciertos PCs FoxBin2Prg no retorna códigos de error cuando se llama como programa externo (Ralf Wagner)
|
|
* 18/05/2015 FDBOZZO v1.19.44 Mejora: Permitir la exportación de datos de DBFs cuando se usa DBF_Conversion_Support:1 y CFG individual opcional
|
|
* 31/05/2015 FDBOZZO v1.19.44 Bug Fix: Un arreglo previo en el manejo de errores en cascada provocó un reseteo del último estado de error de proceso, haciendo que a veces los errores no se reporten.
|
|
* 01/06/2015 FDBOZZO v1.19.45 Bug Fix: Cuando se exporta a texto un menu que usa comillas simples o una expresión en el mensaje de las opciones, al regenerar el binario se recortan partes del mensaje de esas opciones (Mike Potjer)
|
|
* 09/06/2015 FDBOZZO v1.19.45 Bug Fix: Cuando se procesan múltiples archivos PJ2, puede ocurrir un error de "variable llError no definida" (Lutz Scheffler)
|
|
* 15/06/2015 FDBOZZO v1.19.45 Bug Fix pjx,*/pj2,*: Los proyectos PJX/PJ2 que referencian archivos de otras unidades de disco causan errores ne esos archivos al procesar con las opciones "*" o "*-" (Matt Slay)
|
|
* 22/06/2015 FDBOZZO v1.19.46 Bug Fix: Arreglo de bug en método set_UserValue() cuando se intenta obtener información de un error que no puede abrir la tabla (por ej, porque el memo está corrupto)
|
|
* 22/06/2015 FDBOZZO v1.19.46 Mejora: Agregado soporte interno para consulta de información de cfg de directorio, mediante nuevo parámetro opcional, para los métodos API que lo requieren (por ej: get_Ext2FromExt, hasSupport*)
|
|
* 29/07/2015 FDBOZZO v1.19.46 Bug Fix: Cuando se procesa un directorio o un proyecto con todos los archivos, a veces puede ocurrir el error "Alias already in use" (Dave Crozier)
|
|
* 01/09/2015 FDBOZZO v1.19.46 Bug Fix mnx: Cuando se usa '&&' en los textos de las opciones, se corrompe el binario del menú al regenerarlo (Walter Nichols)
|
|
* 14/09/2015 FDBOZZO v1.19.46 Mejora: El objeto WSscript.Shell da problemas en algunos entornos o bajo ciertas condiciones, por lo que se reemplaza por llamadas Win32 nativas (Aurélien Dellieux)
|
|
* 15/09/2015 FDBOZZO v1.19.46 Bug Fix Frx/Lbx : El ordenamiento de registros de los reportes cambia el orden Z de los objetos próximos que se solapan, pudiendo causar que se visualicen mal (Ryan Harris)
|
|
* 18/09/2015 FDBOZZO v1.19.46 Bug Frx/Lbx: Cuando se regeneran reportes o etiquetas con textos multilinea alineados al centro o a la derecha, la alineación no es completamente correcta (Ryan Harris)
|
|
* 29/10/2015 FDBOZZO v1.19.46 Bug Frx/Lbx: Cuando se agrupan controles en diseño y se convierte a texto, al regenerar se pierden las agrupaciones (Lutz Scheffler)
|
|
* 04/11/2015 RALFXWAGNER v1.19.46 Bug Fix Pjx: Los archivos SPR y MPR no estan bien representados en la información del proyecto (Ralf Wagner)
|
|
* 25/11/2015 FDBOZZO v1.19.46 Bug Fix Pj2: Se genera un error al regenerar un PJX desde un PJ2 donde algún archivo contiene paréntesis (EddieC)
|
|
* 25/11/2015 FDBOZZO v1.19.46 Mejora dbf: Nuevo parámetro ExcludeDBFAutoincNextval para evitar diferencias por este dato (edyshor)
|
|
* 04/02/2016 FDBOZZO v1.19.46 Bug Fix: Cuando se procesa un archivo en el directorio raiz, se genera un error 2062 (Aurélien Dellieux)
|
|
* 10/02/2016 FDBOZZO v1.19.47 Bug Fix: Cuando se indica como nombre de archivo "*" y como tipo "*", se regeneran automáticamente todos los archivos binarios desde los archivos de texto (Alejandro Sosa)
|
|
* 25/05/2016 FDBOZZO v1.19.47 Mejora DBF-Data: Permitir importar datos de los DB2 a los DBF con el nuevo valor DBF_Conversion_Support=8. Todos los tipos de datos excepto General. (Walter Nicholls)
|
|
* 24/06/2016 AndyGK63 v1.19.48 Bug Fix: Error en variable usada en una de las traducciones al Alemán (Andy Kasper)
|
|
* 24/06/2016 AndyGK63 v1.19.48 Bug Fix: Posición de menú BEFORE siempre cambiada a AFTER al convertir (Andy Kasper)
|
|
* 30/06/2016 FDBOZZO v1.19.48 Bug Fix: No se respetan algunas restricciones de conversión para DBFs cuando se usan CFGs particulares por tabla (Nathan Brown)
|
|
* 09/07/2016 FDBOZZO v1.19.48 Bug Fix db2: Cuando se lee un memo multilínea de un db2 con datos antiguo, se produce un error de índice fuera de rango
|
|
* 10/07/2016 FDBOZZO v1.19.48 Bug Fix db2: Cuando se usa ExcludeDBFAutoincNextval: 1 en FoxBin2Prg.cfg y a la vez la importación de datos de una tabla con campo AutoInc, se produce el error "Error 2088, Field <FIELD> is read-only" (Nathan Brown)
|
|
* 10/07/2016 FDBOZZO v1.19.48 Fix defecto db2: Cuando se arregló el bug del memo multi-línea, se introdujo un nuevo defecto por el cual un memo de linea-simple se decodifica mal (Nathan Brown)
|
|
* 11/07/2016 FDBOZZO v1.19.48 Bug Fix pj2: Cuando se regenera el binario de un PJ2 con archivos en una ruta con paréntesis y espacios, se genera un error "Error 36, Command contains unrecognized phrase/keyword" (Nathan Brown)
|
|
* 11/07/2016 FDBOZZO v1.19.48 Bug Fix frx: Los ControlSource de objetos OLE que contienen comillas se generan mal (Nathan Brown)
|
|
* 23/03/2017 FDBOZZO v1.19.49 Bug Fix vcx: No funciona la generación de una clase individual con "classlib.vcx::classname" (Lutz Scheffler)
|
|
* 25/03/2017 FDBOZZO v1.19.49 Mejora vcx: Poder importar una clase (VC2 generado con ClassPerFile) en un VCX existente (Lutz Scheffler)
|
|
* 26/03/2017 FDBOZZO v1.19.49 Mejora cfg: Se permite indicar un archivo CFG por parámetro de cualquier directorio para anular los CFG predeterminados de los subdirectorios, para casos especiales donde sea necesario
|
|
* 28/03/2017 FDBOZZO v1.19.49 Mejora vcx: Implementada sintaxis para importar o exportar clases individuales usando "classlibrary.vcx::classname::import" y "classlibrary.vcx::classname::export"
|
|
* 11/04/2017 FDBOZZO v1.19.49 Bug Fix frx: Cuando dentro de una expresión se usa "&&", se corrompe el registro del FRX generado (Alejandro A Sosa)
|
|
* 11/04/2017 FDBOZZO v1.19.49 Mejora cfg : En modo objeto permitir indicar un objeto CFG en lugar de un archivo CFG (Lutz Scheffler)
|
|
* 12/04/2017 DH&FDBOZZO v1.19.49 Bug Fix & Report pjx: No se estaba guardando el campo User en los archivos PJX (Doug Hennig)
|
|
* 25/06/2017 FDBOZZO v1.19.49.1 Bug Fix tx2 v1.19.49: El campo DEVINFO usado en los PJX se estaba usando en los demás binarios, dando errores
|
|
* 02/12/2017 FDBOZZO v1.19.49.2 Bug Fix tx2 v1.19.49: No exporta los objetos a TX2 cuando se usa ClassPerFile (Lutz Scheffler)
|
|
* 03/12/2017 JS&FDBOZZO v1.19.49.3 Bug Fix db2: Los campos "Double" asumen 2 decimales cuando se definen con 0 decimales (Jerry Stager)
|
|
* 04/12/2017 FDBOZZO v1.19.49.4 Cuando se usa ClassPerFile an Modo API y se importan clases simples, a veces sus nombres se toman sin comillas, provocando errores (Lutz Scheffler)
|
|
* 20/12/2017 DH&FDBOZZO v1.19.49.5 Bug Fix dbf: Cuando se importan datos de un DB2 a DBF (con DBF_Conversion_Support = 8), los tabs al inicio de los memo se pierden (Doug Hennig)
|
|
* 04/01/2018 FDBOZZO v1.19.49.6 Bug Fix vcx/scx: FoxBin2Prg debería ignorar los registros que el diseñador de FoxPro ignora (Doug Hennig)
|
|
* 04/01/2018 FDBOZZO v1.19.49.6 Bug Fix vcx/scx: Cuando se regenera la propiedad _MemberData se agregan CR/LF por cada miembro, pudiendo provocar un error de "valor muy largo" (Doug Hennnig)
|
|
* 11/01/2018 FDBOZZO v1.19.49.7 Bug Fix: Cuando se convierte la estructura de un DBF puede dar error si existe un campo llamado I o X (Francisco Prieto)
|
|
* 30/01/2018 FDBOZZO v1.19.49.8 Bug Fix: Cuando se convierte a texto una libreria corrupta con registros duplicados, se genera el error "The specified key already exists" (Kirides)
|
|
* 03/03/2018 FDBOZZO v1.19.50 Mejora: La información DevInfo de los PJX estará inhabilitada por defecto y se podrá activar con el nuevo switch BodyDevInfo
|
|
* 03/03/2018 FDBOZZO v1.19.50 Mejora: Nueva opción de configuración "PRG_Compat_Level": 0=Legacy, 1=Usar HELPSTRING para comentarios de métodos de clase en vez de "&&"
|
|
* 03/03/2018 FDBOZZO v1.19.50 Mejora: Permitir exportar a texto la información de DBFs cuya apertura está protegida por eventos del DBC
|
|
* 12/03/2018 FDBOZZO v1.19.50.1 Bug Fix: Cuando se usa la equivalencia "extension: pj2=pjm" se debe manejar el pjm como un pj2 y no como un pjm de SourceSafe (Darko Kezic)
|
|
* 15/03/2018 FDBOZZO v1.19.50.3 Bug Fix: Cuando se agregan archivos de texto no-VFP, como html,css,etc, en la sección de Text del proyecto, FoxBin2Prg no mantiene esta selección al regenerar el PJX, dejándolos en la sección Files (Darko Kezic)
|
|
* 16/03/2018 FDBOZZO v1.19.51 Mejora: Agregado soporte para archivos de macros (.FKY)
|
|
* 25/03/2018 FDBOZZO v1.19.51 Mejora: Agregado soporte para archivos de memoria (.MEM)
|
|
* 05/05/2018 SSF1&FDB v1.19.51.1 Bug Fix: Si se usa capitalización en la información de las vistas, entonces la información relacionada no se exporta correctamente o completamente y puede perderse (SkySurfer1)
|
|
* 20/06/2018 FDBOZZO v1.19.51.2 Bug Fix: Cuando se exporta un DBF que pertenece a un DBC sin eventos, falla (Jairo Argüelles/Juan C.Perdomo)
|
|
* 09/07/2018 FDBOZZO v1.19.51.3 Bug Fix: Error 1098, Cannot find ... [ENDT] that closes ... [TEXT] Issue#26 when there is a field named TEXT as first line-word (KIRIDES)
|
|
* 10/07/2018 FDBOZZO v1.19.51.4 Bug Fix: El ordenamiento alfabético de los objetos de los ADD OBJECT puede causar que algunos objetos se creen en el orden erróneo, provocando comportamientos inesperados (Jochen Kauz)
|
|
* 14/02/2019 TRACY_P v1.19.51.5 Enhancement: Make FoxBin2Prg more COM friendly when using ESC key (Tracy Pearson)
|
|
* 01/04/2020 RHARRIS v1.19.51.6 Bug Fix: Si alguno de los archivos-por-clase no tiene CR_LF al final, al ensamblar la clase se pueden superponer instrucciones de forma inválida (Ryan Harris)
|
|
* 01/04/2020 FDBOZZO v1.19.51.6 Bug Fix: Incompatible with VFPA (#36) (Eric Selje)
|
|
* 01/04/2020 DH v1.19.51 Bug Fix: Manejo de AutoIncrement incompatible con Project Explorer (Dan Lauer)
|
|
* 01/04/2020 FDBOZZO v1.19.51 Bug Fix: La conversión de tablas falla si algún campo contiene una palabra reservada como UNIQUE (DAJU78)
|
|
* 01/04/2020 FDBOZZO v1.19.51 Bug Fix: No se respetan las propiedades de VCX/SCX con nombre "note" (Tracy Pearson)
|
|
* 14/02/2021 LScheffler v1.19.52 Bug Fix: conversion dbf -> prg, error if only test mode (toFoxBin2Prg.l_ProcessFiles is false)
|
|
* 14/02/2021 LScheffler v1.19.52 Bug Fix: conversion prg -> dbf, fields with .NULL. value are incorectly recreated
|
|
* 15/02/2021 LScheffler v1.19.53 Bug Fix: processing directory, flush log file after loop instead of file
|
|
* 16/02/2021 LScheffler v1.19.53 Bug Fix: conversion prg -> vcx, files per class could create one class multiple times
|
|
* 03/03/2021 LScheffler v1.19.54 Bug Fix: DBF_Conversion_Condition, problem with macro expansion
|
|
* 14/02/2021 LScheffler v1.19.55 Enhancement: inserted option UseFilesPerDBC to split DBC processing from vcx / scx
|
|
* 15/02/2021 LScheffler v1.19.55 Enhancement: inserted option RedirectFilePerDBCToMain to split DBC processing from vcx / scx
|
|
* 15/02/2021 LScheffler v1.19.55 Enhancement: inserted option ItemPerDBCCheck to split DBC processing from vcx / scx
|
|
* the three above are straight forward, so no extra comment are within the code
|
|
* 19/02/2021 LScheffler v1.19.55 Enhancement: inserted option DBF_BinChar_Base64 to allow processing of NoCPTrans fields in non base64 way
|
|
* 20/02/2021 LScheffler v1.19.55 Enhancement: inserted option DBF_IncludeDeleted to allow including deleted records of DBF
|
|
* 21/02/2021 LScheffler v1.19.55 Enhancement: German translation improved
|
|
* 21/02/2021 LScheffler v1.19.55 Enhancement: Info screen-doc improved
|
|
* 21/02/2021 LScheffler v1.19.55 Enhancement: added option to create config file template
|
|
* 23/02/2021 LScheffler v1.19.55 Enhancement: inserted option OldFilesPerDBC to define the use splitting of DBC like version pre 1.20.0
|
|
* 04/03/2021 LScheffler v1.19.56 Bug Fix: Inputfile in form classlib.class.vc2 AND RedirectClassType = 1 and Execute param tcRecompile = 1
|
|
* generates classlib.class.vcx and tries to recompile classlib.vcx
|
|
* fails silent if classlib.vcx exists (compiles wrong lib), with message if not.
|
|
* 04/03/2021 LScheffler v1.19.56 Enhancement: New value for RedirectClassType = 2, just process the single class of classlib.class.vc2
|
|
|
|
|
|
* </HISTORIAL DE CAMBIOS Y NOTAS IMPORTANTES>
|
|
*
|
|
*---------------------------------------------------------------------------------------------------
|
|
* <TESTEO, REPORTE DE BUGS Y MEJORAS (AGRADECIMIENTOS)>
|
|
* 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)
|
|
* 10/05/2015 Esteban Herrero Reporte bug v1.19.42: Cuando un form tiene AutoCenter=.T., hay veces en que al regenerar el binario y ejecutarlo no se muestra centrado (Arreglado en v1.19.43)
|
|
* 29/04/2015 Ralf Wagner Reporte bug v1.19.43: En ciertos PCs FoxBin2Prg no retorna códigos de error cuando se llama como programa externo (Arreglado en v1.19.44)
|
|
* 01/06/2015 Mike Potjer Reporte bug v1.19.44: Cuando se exporta a texto un menu que usa comillas simples o una expresión en el mensaje de las opciones, al regenerar el binario se recortan partes del mensaje de esas opciones (Arreglado en v1.19.45)
|
|
* 09/06/2015 Lutz Scheffler Reporte bug v1.19.44: Cuando se procesan múltiples archivos PJ2, puede ocurrir un error de "variable llError no definida" (Arreglado en v1.19.45)
|
|
* 13/06/2015 Matt Slay Reporte bug v1.19.44: Los proyectos PJX/PJ2 que referencian archivos de otras unidades de disco causan errores ne esos archivos al procesar con las opciones "*" o "*-" (Arreglado en v1.19.45)
|
|
* 29/07/2015 Dave Crozier Reporte bug v1.19.45: Cuando se procesa un directorio o un proyecto con todos los archivos, a veces puede ocurrir el error "Alias already in use" (Arreglado en v1.19.46)
|
|
* 29/07/2015 Walter Nicholls Mejora DBF-Data v1.19.45: Permitir exportar e importar datos de los DBF
|
|
* 28/08/2015 Walter Nicholls Reporte bug: Cuando se usa '&&' en los textos de las opciones, se corrompe el binario del menú al regenerarlo (Arreglado en v1.19.46)
|
|
* 09/09/2015 Aurélien Dellieux Mejora v1.19.45: El objeto WSscript.Shell da problemas en algunos entornos o bajo ciertas condiciones (Cambiado en v1.19.46)
|
|
* 11/09/2015 Ryan Harris Reporte bug Frx/Lbx v1.19.45: El ordenamiento de registros de los reportes cambia el orden Z de los objetos próximos que se solapan, pudiendo causar que se visualicen mal (Arreglado en v1.19.46)
|
|
* 17/09/2015 Ryan Harris Reporte bug Frx/Lbx v1.19.45: Cuando se regeneran reportes o etiquetas con textos multilinea alineados al centro o a la derecha, la alineación no es completamente correcta (Arreglado en v1.19.46)
|
|
* 11/10/2015 Lutz Scheffler Reporte bug Frx/Lbx v1.19.45: Cuando se agrupan controles en diseño y se convierte a texto, al regenerar se pierden las agrupaciones (Arreglado en v1.19.46 Preview-7)
|
|
* 04/11/2015 Ralf Wagner Reporte bug Pjx v1.19.45: Los archivos SPR y MPR no estan bien representados en la información del proyecto (Arreglado en v1.19.46 Preview-8)
|
|
* 20/11/2015 EddieC Reporte bug Pjx v1.19.45: Se genera un error al regenerar un PJX desde un PJ2 donde algún archivo contiene paréntesis (Arreglado en v1.19.46 Preview-9)
|
|
* 24/11/2015 edyshor Mejora dbf v1.19.45: Nuevo parámetro ExcludeDBFAutoincNextval para evitar diferencias por este dato (Agregado en v1.19.46 Preview-9)
|
|
* 01/02/2016 Aurélien Dellieux Reporte bug v1.19.45: Cuando se procesa un archivo en el directorio raiz, se genera un error 2062 (Arreglado en v1.19.46 Preview-10)
|
|
* 10/02/2016 Alejandro Sosa Reporte bug v1.19.46: Cuando se indica como nombre de archivo "*" y como tipo "*", se regeneran automáticamente todos los archivos binarios desde los archivos de texto (Arreglado en v1.19.47 Preview-1)
|
|
* 24/06/2016 Andy Kasper Reporte bug v1.19.47: Error en variable usada en una de las traducciones al Alemán (Arreglado en v1.19.48 Preview-1)
|
|
* 24/06/2016 Andy Kasper Reporte bug v1.19.47: Posición de menú BEFORE siempre cambiada a AFTER al convertir (Arreglado en v1.19.48 Preview-1)
|
|
* 30/06/2016 Nathan Brown Reporte bug v1.19.47: No se respetan algunas restricciones de conversión para DBFs cuando se usan CFGs particulares por tabla (Arreglado en v1.19.48 Preview-2)
|
|
* 30/06/2016 Nathan Brown Reporte bug v1.19.47: Cuando se usa ExcludeDBFAutoincNextval: 1 en FoxBin2Prg.cfg y a la vez la importación de datos de una tabla con campo AutoInc, se produce el error "Error 2088, Field <FIELD> is read-only" (Arreglado en v1.19.48 Preview-3)
|
|
* 10/07/2016 Nathan Brown Reporte defecto v1.19.48-Preview3: Cuando se arregló el bug del memo multi-línea, se introdujo un nuevo defecto por el cual un memo de linea-simple se decodifica mal (Arreglado en v1.19.48 Preview-4)
|
|
* 11/07/2016 Nathan Brown Reporte bug pj2 v1.19.48-Preview4: Cuando se regenera el binario de un PJ2 con archivos en una ruta con paréntesis y espacios, se genera un error "Error 36, Command contains unrecognized phrase/keyword" (Arreglado en v1.19.48 Preview-5)
|
|
* 11/07/2016 Nathan Brown Reporte bug frx v1.19.48-Preview5: Los ControlSource de objetos OLE que contienen comillas se generan mal (Arreglado en v1.19.48 Preview-6)
|
|
* 23/03/2017 Lutz Scheffler Reporte bug vcx v1.19.48: No funciona la generación de una clase individual con "classlib.vcx::classname" (Arreglado en v1.19.49)
|
|
* 23/03/2017 Lutz Scheffler Mejora vcx v1.19.48: Poder importar una clase (VC2 generado con ClassPerFile) en un VCX existente (Agragado en v1.19.49)
|
|
* 30/03/2017 Alejandro A Sosa Reporte bug frx v1.19.48: Cuando dentro de una expresión se usa "&&", se corrompe el registro del FRX generado (Arreglado en v1.19.49)
|
|
* 28/03/2017 Lutz Scheffler Mejora cfg v1.19.48: En modo objeto permitir indicar un objeto CFG en lugar de un archivo CFG (Agragado en v1.19.49)
|
|
* 06/04/2017 Doug Hennig Reporte Bug y arreglo parcial PJX v1.19.48: No se estaba guardando el campo User en los archivos PJX (Agregado en v1.19.49)
|
|
* 28/11/2017 Lutz Scheffler Reporte Bug vx2 v1.19.49: No exporta los objetos a VX2 cuando se usa ClassPerFile (Arreglado en v1.19.49.2)
|
|
* 31/08/2017 Jerry Stager Reporte bug db2 v1.19.48: Los campos "Double" asumen 2 decimales cuando se definen con 0 decimales (Agregado en v1.19.49.3)
|
|
* 03/12/2017 Lutz Scheffler Reporte Bug vx2 v1.19.49: Cuando se usa ClassPerFile an Modo API y se importan clases simples, a veces sus nombres se toman sin comillas, provocando errores (Arreglado en v1.19.49.4)
|
|
* 18/12/2017 Doug Hennnig Reporte Bug dbf v1.19.49: Cuando se importan datos de un DB2 a DBF (con DBF_Conversion_Support = 8), los tabs al inicio de los memo se pierden (Arreglado en v1.19.49.5)
|
|
* 04/01/2018 Doug Hennnig Reporte Bug vcx/scx v1.19.49: FoxBin2Prg debería ignorar los registros que el diseñador de FoxPro ignora (Arreglado en v1.19.49.6)
|
|
* 04/01/2018 Doug Hennnig Reporte Bug vcx/scx v1.19.49: Cuando se regenera la propiedad _MemberData se agregan CR/LF por cada miembro, pudiendo provocar un error de "valor muy largo" (Arreglado en v1.19.49.6)
|
|
* 11/01/2018 Francisco Prieto Reporte Bug v1.19.49: Cuando se convierte la estructura de un DBF puede dar error si existe un campo llamado I o X (Arreglado en v1.19.49.7)
|
|
* 30/01/2018 Kirides Reporte Bug v1.19.49: Cuando se convierte a texto una libreria corrupta con registros duplicados, se genera el error "The specified key already exists" (Arreglado en v1.19.49.9)
|
|
* 12/03/2018 Darko Kezic Reporte Bug v1.19.50: Cuando se usa la equivalencia "extension: pj2=pjm" se debe manejar el pjm como un pj2 y no como un pjm de SourceSafe (Arreglado en v1.19.50.1)
|
|
* 15/03/2018 Darko Kezic Reporte Bug v1.19.50: Cuando se agregan archivos de texto no-VFP, como html,css,etc, en la sección de Text del proyecto, FoxBin2Prg no mantiene esta selección al regenerar el PJX, dejándolos en la sección Files (Arreglado en v1.19.50.3)
|
|
* 05/05/2018 SkySurfer1 Reporte Bug v1.19.51: Si se usa capitalización en la información de las vistas, entonces la información relacionada no se exporta correctamente o completamente y puede perderse (Arreglado en v1.19.51.1)
|
|
* 20/06/2018 Jairo A/Juan CP Reporte Bug v1.19.51: Cuando se exporta un DBF que pertenece a un DBC sin eventos, falla (Arreglado en v1.19.51.2)
|
|
* 09/07/2018 KIRIDES Reporte Bug v1.19.51: Error 1098, Cannot find ... [ENDT] that closes ... [TEXT] Issue#26 when there is a field named TEXT as first line-word (Se arregla en v1.19.51.3)
|
|
* 10/07/2018 Jochen Kauz Reporte Bug v1.19.51: El ordenamiento alfabético de los objetos de los ADD OBJECT puede causar que algunos objetos se creen en el orden erróneo, provocando comportamientos inesperados (Se arregla en v1.19.51.3)
|
|
* 14/03/2019 Tracy Pearson Reporte Bug v1.19.51: No se respetan las propiedades de VCX/SCX con nombre "note" (Se arregla en v1.19.51.6)
|
|
* 18/04/2019 DAJU78 Reporte Bug v1.19.51: La conversión de tablas falla si algún campo contiene una palabra reservada como UNIQUE (Se arregla en v1.19.51.6)
|
|
* 19/07/2019 Dan Lauer Reporte Bug v1.19.51: Manejo de AutoIncrement incompatible con Project Explorer (Arreglado en v1.19.49.6, con solución de Doug Hennnig)
|
|
* 13/11/2019 Eric Selje Reporte Bug v1.19.51: Incompatible with VFPA (#36) (Se arregla en v1.19.51.6)
|
|
* 31/03/2020 Ryan Harris Reporte Bug v1.19.51: Si alguno de los archivos-por-clase no tiene CR_LF al final, al ensamblar la clase se pueden superponer instrucciones de forma inválida (Se arregla en v1.19.51.6)
|
|
* </TESTEO Y REPORTE DE BUGS (AGRADECIMIENTOS)>
|
|
*
|
|
*---------------------------------------------------------------------------------------------------
|
|
* 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 '*<ClassComment>'
|
|
#Define C_CLASSCOMMENTS_F '*</ClassComment>'
|
|
#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 '*<DefinedPropArrayMethod>'
|
|
#Define C_DEFINED_PAM_F '*</DefinedPropArrayMethod>'
|
|
#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 '*<ServerHead>'
|
|
#Define C_SRV_HEAD_F '*</ServerHead>'
|
|
#Define C_SRV_DATA_I '*<ServerData>'
|
|
#Define C_SRV_DATA_F '*</ServerData>'
|
|
#Define C_DEVINFO_I '*<DevInfo>'
|
|
#Define C_DEVINFO_F '*</DevInfo>'
|
|
#Define C_BUILDPROJ_I '*<BuildProj>'
|
|
#Define C_BUILDPROJ_F '*</BuildProj>'
|
|
#Define C_PROJPROPS_I '*<ProjectProperties>'
|
|
#Define C_PROJPROPS_F '*</ProjectProperties>'
|
|
#Define C_FILE_META_I '*< FileMetadata:'
|
|
#Define C_FILE_META_F '/>'
|
|
#Define C_FILE_CMTS_I '*<FileComments>'
|
|
#Define C_FILE_CMTS_F '*</FileComments>'
|
|
#Define C_FILE_EXCL_I '*<ExcludedFiles>'
|
|
#Define C_FILE_EXCL_F '*</ExcludedFiles>'
|
|
#Define C_FILE_TXT_I '*<TextFiles>'
|
|
#Define C_FILE_TXT_F '*</TextFiles>'
|
|
#Define C_FB2P_VALUE_I '<fb2p_value>'
|
|
#Define C_FB2P_VALUE_F '</fb2p_value>'
|
|
#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 '<VFPData>'
|
|
#Define C_VFPDATA_F '</VFPData>'
|
|
#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 '<![CDATA['
|
|
#Define C_DATA_F ']]>'
|
|
#Define C_TAG_REPORTE 'Reportes'
|
|
#Define C_TAG_REPORTE_I '<' + C_TAG_REPORTE + '>'
|
|
#Define C_TAG_REPORTE_F '</' + C_TAG_REPORTE + '>'
|
|
#Define C_DBF_HEAD_I '<DBF'
|
|
#Define C_DBF_HEAD_F '/>'
|
|
#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 '<indexFile>'
|
|
#Define C_CDX_F '</indexFile>'
|
|
#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 '<DATABASE>'
|
|
#Define C_DATABASE_F '</DATABASE>'
|
|
#Define C_STORED_PROC_I '<STOREDPROCEDURES><![CDATA['
|
|
#Define C_STORED_PROC_F ']]></STOREDPROCEDURES>'
|
|
#Define C_TABLE_I '<TABLE>'
|
|
#Define C_TABLE_F '</TABLE>'
|
|
#Define C_TABLES_I '<TABLES>'
|
|
#Define C_TABLES_F '</TABLES>'
|
|
#Define C_VIEW_I '<VIEW>'
|
|
#Define C_VIEW_F '</VIEW>'
|
|
#Define C_VIEWS_I '<VIEWS>'
|
|
#Define C_VIEWS_F '</VIEWS>'
|
|
#Define C_FIELD_ORDER_I '<FIELD_ORDER>'
|
|
#Define C_FIELD_ORDER_F '</FIELD_ORDER>'
|
|
#Define C_FIELD_I '<FIELD>'
|
|
#Define C_FIELD_F '</FIELD>'
|
|
#Define C_FIELDS_I '<FIELDS>'
|
|
#Define C_FIELDS_F '</FIELDS>'
|
|
#Define C_CONNECTION_I '<CONNECTION>'
|
|
#Define C_CONNECTION_F '</CONNECTION>'
|
|
#Define C_CONNECTIONS_I '<CONNECTIONS>'
|
|
#Define C_CONNECTIONS_F '</CONNECTIONS>'
|
|
#Define C_RELATION_I '<RELATION>'
|
|
#Define C_RELATION_F '</RELATION>'
|
|
#Define C_RELATIONS_I '<RELATIONS>'
|
|
#Define C_RELATIONS_F '</RELATIONS>'
|
|
#Define C_INDEX_I '<INDEX>'
|
|
#Define C_INDEX_F '</INDEX>'
|
|
#Define C_INDEXES_I '<INDEXES>'
|
|
#Define C_INDEXES_F '</INDEXES>'
|
|
#Define C_PROC_CODE_I '*<Procedures>'
|
|
#Define C_PROC_CODE_F '*</Procedures>'
|
|
#Define C_SETUPCODE_I '*<SetupCode>'
|
|
#Define C_SETUPCODE_F '*</SetupCode>'
|
|
#Define C_CLEANUPCODE_I '*<CleanupCode>'
|
|
#Define C_CLEANUPCODE_F '*</CleanupCode>'
|
|
#Define C_MENUCODE_I '*<MenuCode>'
|
|
#Define C_MENUCODE_F '*</MenuCode>'
|
|
#Define C_MENUTYPE_I '*<MenuType>'
|
|
#Define C_MENUTYPE_F '</MenuType>'
|
|
#Define C_MENULOCATION_I '*<MenuLocation>'
|
|
#Define C_MENULOCATION_F '</MenuLocation>'
|
|
*--
|
|
#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 '<RECORDS>'
|
|
#Define C_RECORDS_F '</RECORDS>'
|
|
#Define C_RECORD_I '<RECORD>' && *** FDBOZZO 2016/06/06: Quitado el REGNUM para evitar diferencias innecesarias
|
|
#Define C_RECORD_F '</RECORD>'
|
|
#Define C_DEL_RECORD_I '<DELRECORD>' && *** Lutz Scheffler 2021/02/20: Deleted Record, just mark like this, no fuzz with field name
|
|
#Define C_DEL_RECORD_F '</DELRECORD>'
|
|
#Define C_RECNO_I '<RECNO>'
|
|
#Define C_RECNO_F '</RECNO>'
|
|
|
|
*-- 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
|
|
|
|
*-- Predefine 64MB of RAM
|
|
Sys(3050,1,64*1024*1024)
|
|
Sys(3050,2,64*1024*1024)
|
|
|
|
If _vfp.StartMode > 0 Then
|
|
Sys(2450,1) && Set Application Search Path Order to APP/EXE 1st when not in Dev-Mode
|
|
Endif
|
|
|
|
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,'')
|
|
|
|
*!* Changed by: Lutz Scheffler 15.2.2021
|
|
*!* change date="{^2021-02-15,18:44:00}"
|
|
* added option to create config files
|
|
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;
|
|
OR UPPER(tc_InputFile)=='-C' OR UPPER(tc_InputFile)=='-T' Then
|
|
pcParamX = tc_InputFile
|
|
tc_InputFile = tcType
|
|
tcType = pcParamX
|
|
Release pcParamX
|
|
Endif
|
|
*!* /Changed by: Lutz Scheffler 15.2.2021
|
|
|
|
Try
|
|
loEx = Null
|
|
loCnv = Createobject("c_foxbin2prg")
|
|
lnResp = loCnv.execute( tc_InputFile, tcType, tcTextName, tlGenText, tcDontShowErrors, tcDebug ;
|
|
, tcDontShowProgress, Null, @loEx, .F., tcOriginalFileName, tcRecompile, tcNoTimestamps ;
|
|
, .F., .F., .F., tcCFG_File )
|
|
Catch To loEx
|
|
*-- Esto solo es para errores en el INIT, ya que los demás se deben capturar y tratar antes.
|
|
lnResp = loEx.ErrorNo
|
|
Messagebox( 'Error ' + Transform(loEx.ErrorNo) + ', ' + loEx.Message + C_CR ;
|
|
+ loEx.Procedure + ', Line ' + Transform(loEx.Lineno) + C_CR ;
|
|
+ loEx.Details ;
|
|
, 0+16+4096 ;
|
|
, '' ;
|
|
, 60000 )
|
|
Endtry
|
|
|
|
AddProperty(_Screen, 'ExitCode', lnResp)
|
|
*SET COVERAGE TO
|
|
|
|
If _vfp.StartMode <> 4 Or Not Sys(16) == Sys(16,0) && 4 = Visual FoxPro was started as a distributable .app or .exe file.
|
|
Store Null To loEx, loCnv
|
|
Release loEx, loCnv
|
|
Return lnResp && lnResp contiene un código de error, pero invocado desde SourceSafe puede contener el tipo de soporte de archivo (0,1,2).
|
|
Endif
|
|
|
|
If 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
|
|
*KillMode 1
|
|
*DECLARE ExitProcess IN Win32API INTEGER ExitCode && To read returned error code with ERRORLEVEL from Windows
|
|
*ExitProcess(1) && Esta debe ser de las últimas instrucciones
|
|
|
|
*KillMode 2 - This one works better.
|
|
Declare Integer OpenProcess In Win32API Integer dwDesiredAccess, Integer bInheritHandle, Integer dwProcessID
|
|
lnHandle = OpenProcess(1, 1, _vfp.ProcessID)
|
|
Declare Integer TerminateProcess In Win32API Integer hProcess, Integer uExitCode
|
|
=TerminateProcess(lnHandle,1)
|
|
|
|
*KillMode 3
|
|
*lcComputer = [.]
|
|
*loCIMV2 = GETOBJECT( [winmgmts:{impersonationLevel=impersonate}!\\] + lcComputer + [\root\cimv2] )
|
|
*loProcCols = loCIMV2.ExecQuery( [select * from Win32_Process where processid=] + TRANSFORM(_VFP.PROCESSID) + [] )
|
|
*loCIMV2 = NULL
|
|
*loProcCols.ItemIndex(0).TERMINATE(1)
|
|
|
|
|
|
|
|
|
|
Define Class c_foxbin2prg As Session
|
|
_MemberData = [<VFPData>] ;
|
|
+ [<memberdata name="updateprogressbar" display="updateProgressbar"/>] ;
|
|
+ [<memberdata name="a_processedfiles" display="a_ProcessedFiles"/>] ;
|
|
+ [<memberdata name="clearprocessedfiles" display="clearProcessedFiles"/>] ;
|
|
+ [<memberdata name="convert" display="convert"/>] ;
|
|
+ [<memberdata name="c_fb2prg_exe_version" display="c_FB2PRG_EXE_Version"/>] ;
|
|
+ [<memberdata name="c_curdir" display="c_CurDir"/>] ;
|
|
+ [<memberdata name="c_texterr" display="c_TextErr"/>] ;
|
|
+ [<memberdata name="c_foxbin2prg_fullpath" display="c_Foxbin2prg_FullPath"/>] ;
|
|
+ [<memberdata name="c_foxbin2prg_configfile" display="c_Foxbin2prg_ConfigFile"/>] ;
|
|
+ [<memberdata name="c_inputfile" display="c_InputFile"/>] ;
|
|
+ [<memberdata name="c_language" display="c_Language"/>] ;
|
|
+ [<memberdata name="c_originalfilename" display="c_OriginalFileName"/>] ;
|
|
+ [<memberdata name="c_outputfile" display="c_OutputFile"/>] ;
|
|
+ [<memberdata name="c_type" display="c_Type"/>] ;
|
|
+ [<memberdata name="c_errorlogfile" display="c_ErrorLogFile"/>] ;
|
|
+ [<memberdata name="c_logfile" display="c_LogFile"/>] ;
|
|
+ [<memberdata name="c_recompile" display="c_Recompile"/>] ;
|
|
+ [<memberdata name="c_textlog" display="c_TextLog"/>] ;
|
|
+ [<memberdata name="c_db2" display="c_DB2"/>] ;
|
|
+ [<memberdata name="c_dc2" display="c_DC2"/>] ;
|
|
+ [<memberdata name="c_fr2" display="c_FR2"/>] ;
|
|
+ [<memberdata name="c_lb2" display="c_LB2"/>] ;
|
|
+ [<memberdata name="c_mn2" display="c_MN2"/>] ;
|
|
+ [<memberdata name="c_pj2" display="c_PJ2"/>] ;
|
|
+ [<memberdata name="c_sc2" display="c_SC2"/>] ;
|
|
+ [<memberdata name="c_vc2" display="c_VC2"/>] ;
|
|
+ [<memberdata name="c_fk2" display="c_FK2"/>] ;
|
|
+ [<memberdata name="c_me2" display="c_ME2"/>] ;
|
|
+ [<memberdata name="changefileattribute" display="changeFileAttribute"/>] ;
|
|
+ [<memberdata name="changefiletime" display="changeFileTime"/>] ;
|
|
+ [<memberdata name="compilefoxprobinary" display="compileFoxProBinary"/>] ;
|
|
+ [<memberdata name="dobackup" display="doBackup"/>] ;
|
|
+ [<memberdata name="execute" display="execute"/>] ;
|
|
+ [<memberdata name="evaluate_full_pjx" display="evaluate_Full_PJX"/>] ;
|
|
+ [<memberdata name="evaluate_full_pj2" display="evaluate_Full_PJ2"/>] ;
|
|
+ [<memberdata name="dowriteerrorlog" display="doWriteErrorLog"/>] ;
|
|
+ [<memberdata name="evaluateconfiguration" display="evaluateConfiguration"/>] ;
|
|
+ [<memberdata name="exception2str" display="exception2Str"/>] ;
|
|
+ [<memberdata name="filenamefoundinfilter" display="filenameFoundInFilter"/>] ;
|
|
+ [<memberdata name="comparedfilesareequal" display="comparedFilesAreEqual"/>] ;
|
|
+ [<memberdata name="changelanguage" display="changeLanguage"/>] ;
|
|
+ [<memberdata name="get_dirsettings" display="get_DirSettings"/>] ;
|
|
+ [<memberdata name="get_l_cfg_cachedaccess" display="get_l_CFG_CachedAccess"/>] ;
|
|
+ [<memberdata name="get_l_configevaluated" display="get_l_ConfigEvaluated"/>] ;
|
|
+ [<memberdata name="get_textfilenames" display="get_TextFileNames"/>] ;
|
|
+ [<memberdata name="get_ext2fromext" display="get_Ext2FromExt"/>] ;
|
|
+ [<memberdata name="get_program_header" display="get_PROGRAM_HEADER"/>] ;
|
|
+ [<memberdata name="get_separatedlineandcomment" display="get_SeparatedLineAndComment"/>] ;
|
|
+ [<memberdata name="get_processed" display="get_Processed"/>] ;
|
|
+ [<memberdata name="loadprogressbarform" display="loadProgressbarForm"/>] ;
|
|
+ [<memberdata name="unloadprogressbarform" display="unloadProgressbarForm"/>] ;
|
|
+ [<memberdata name="run_aftercreatetable" display="run_AfterCreateTable"/>] ;
|
|
+ [<memberdata name="run_aftercreate_db2" display="run_AfterCreate_DB2"/>] ;
|
|
+ [<memberdata name="l_autoclearprocessedfiles" display="l_AutoClearProcessedFiles"/>] ;
|
|
+ [<memberdata name="l_cancelwithesckey" display="l_CancelWithEscKey"/>] ;
|
|
+ [<memberdata name="l_cfg_cachedaccess" display="l_CFG_CachedAccess"/>] ;
|
|
+ [<memberdata name="l_classperfilecheck" display="l_ClassPerFileCheck"/>] ;
|
|
+ [<memberdata name="l_clearuniqueid" display="l_ClearUniqueID"/>] ;
|
|
+ [<memberdata name="l_cleardbflastupdate" display="l_ClearDBFLastUpdate"/>] ;
|
|
+ [<memberdata name="n_debug" display="n_Debug"/>] ;
|
|
+ [<memberdata name="l_removenullcharsfromcode" display="l_RemoveNullCharsFromCode"/>] ;
|
|
+ [<memberdata name="l_removezordersetfromprops" display="l_RemoveZOrderSetFromProps"/>] ;
|
|
+ [<memberdata name="l_error" display="l_Error"/>] ;
|
|
+ [<memberdata name="l_errors" display="l_Errors"/>] ;
|
|
+ [<memberdata name="l_main_cfg_loaded" display="l_Main_CFG_Loaded"/>] ;
|
|
+ [<memberdata name="l_methodsort_enabled" display="l_MethodSort_Enabled"/>] ;
|
|
+ [<memberdata name="c_backgroundimage" display="c_BackgroundImage"/>] ;
|
|
+ [<memberdata name="n_optimizebyfilestamp" display="n_OptimizeByFilestamp"/>] ;
|
|
+ [<memberdata name="l_processfiles" display="l_ProcessFiles"/>] ;
|
|
+ [<memberdata name="l_propsort_enabled" display="l_PropSort_Enabled"/>] ;
|
|
+ [<memberdata name="l_recompile" display="l_Recompile"/>] ;
|
|
+ [<memberdata name="l_redirectclassperfiletomain" display="l_RedirectClassPerFileToMain"/>] ;
|
|
+ [<memberdata name="l_reportsort_enabled" display="l_ReportSort_Enabled"/>] ;
|
|
+ [<memberdata name="l_showerrors" display="l_ShowErrors"/>] ;
|
|
+ [<memberdata name="n_showprogressbar" display="n_ShowProgressbar"/>] ;
|
|
+ [<memberdata name="l_stdouthabilitado" display="l_StdOutHabilitado"/>] ;
|
|
+ [<memberdata name="l_test" display="l_Test"/>] ;
|
|
+ [<memberdata name="n_useclassperfile" display="n_UseClassPerFile"/>] ;
|
|
+ [<memberdata name="n_cfg_actual" display="n_CFG_Actual"/>] ;
|
|
+ [<memberdata name="n_existecapitalizacion" display="n_ExisteCapitalizacion"/>] ;
|
|
+ [<memberdata name="n_fb2prg_version" display="n_FB2PRG_Version"/>] ;
|
|
+ [<memberdata name="n_filehandle" display="n_FileHandle"/>] ;
|
|
+ [<memberdata name="n_forcewriteifreadonly" display="n_ForceWriteIfReadOnly"/>] ;
|
|
+ [<memberdata name="n_order_view_fields" display="n_Order_View_Fields"/>] ;
|
|
+ [<memberdata name="n_processedfiles" display="n_ProcessedFiles"/>] ;
|
|
+ [<memberdata name="n_processedfilescount" display="n_ProcessedFilesCount"/>] ;
|
|
+ [<memberdata name="normalizefilecapitalization" display="normalizeFileCapitalization"/>] ;
|
|
+ [<memberdata name="o_conversor" display="o_Conversor"/>] ;
|
|
+ [<memberdata name="o_frm_avance" display="o_Frm_Avance"/>] ;
|
|
+ [<memberdata name="o_fso" display="o_FSO"/>] ;
|
|
+ [<memberdata name="o_wsh" display="o_WSH"/>] ;
|
|
+ [<memberdata name="o_configuration" display="o_Configuration"/>] ;
|
|
+ [<memberdata name="pjx_conversion_support" display="PJX_Conversion_Support"/>] ;
|
|
+ [<memberdata name="vcx_conversion_support" display="VCX_Conversion_Support"/>] ;
|
|
+ [<memberdata name="scx_conversion_support" display="SCX_Conversion_Support"/>] ;
|
|
+ [<memberdata name="frx_conversion_support" display="FRX_Conversion_Support"/>] ;
|
|
+ [<memberdata name="lbx_conversion_support" display="LBX_Conversion_Support"/>] ;
|
|
+ [<memberdata name="mnx_conversion_support" display="MNX_Conversion_Support"/>] ;
|
|
+ [<memberdata name="dbf_conversion_support" display="DBF_Conversion_Support"/>] ;
|
|
+ [<memberdata name="dbf_conversion_included" display="DBF_Conversion_Included"/>] ;
|
|
+ [<memberdata name="dbf_conversion_excluded" display="DBF_Conversion_Excluded"/>] ;
|
|
+ [<memberdata name="dbc_conversion_support" display="DBC_Conversion_Support"/>] ;
|
|
+ [<memberdata name="get_filesfromdirectory" display="get_FilesFromDirectory"/>] ;
|
|
+ [<memberdata name="readinputvfpparams" display="readInputVFPParams"/>] ;
|
|
+ [<memberdata name="renamefile" display="renameFile"/>] ;
|
|
+ [<memberdata name="renametmpfile2tx2file" display="renameTmpFile2Tx2File"/>] ;
|
|
+ [<memberdata name="set_line" display="set_Line"/>] ;
|
|
+ [<memberdata name="errout" display="errOut"/>] ;
|
|
+ [<memberdata name="stdout" display="stdOut"/>] ;
|
|
+ [<memberdata name="hassupport_bin2prg" display="hasSupport_Bin2Prg"/>] ;
|
|
+ [<memberdata name="hassupport_prg2bin" display="hasSupport_Prg2Bin"/>] ;
|
|
+ [<memberdata name="t_inputfile_timestamp" display="t_InputFile_TimeStamp"/>] ;
|
|
+ [<memberdata name="t_outputfile_timestamp" display="t_OutputFile_TimeStamp"/>] ;
|
|
+ [<memberdata name="updateprocessedfile" display="updateProcessedFile"/>] ;
|
|
+ [<memberdata name="writeerrorlog" display="writeErrorLog"/>] ;
|
|
+ [<memberdata name="writeerrorlog_flush" display="writeErrorLog_Flush"/>] ;
|
|
+ [<memberdata name="writelog" display="writeLog"/>] ;
|
|
+ [<memberdata name="writelog_flush" display="writeLog_Flush"/>] ;
|
|
+ [</VFPData>]
|
|
|
|
|
|
*!* ;&& SF -> String to long
|
|
*!* + [<memberdata name="l_oldfilesperdbc" display="l_OldFilesPerDBC"/>] ;
|
|
*!* + [<memberdata name="n_usefilesperdbc" display="n_UseFilesPerDBC"/>] ;
|
|
*!* + [<memberdata name="l_redirectfileperdbctomain" display="l_RedirectFilePerDBCToMain"/>] ;
|
|
*!* + [<memberdata name="l_itemperdbccheck" display="l_ItemPerDBCCheck"/>] ;
|
|
*!* + [<memberdata name="l_dbf_binchar_base64" display="l_DBF_BinChar_Base64"/>] ;
|
|
*!* + [<memberdata name="l_dbf_includedeleted" display="l_DBF_IncludeDeleted"/>] ;
|
|
*!* ;&& /SF
|
|
|
|
Dimension a_ProcessedFiles(1, 6)
|
|
Protected n_CFG_Actual, l_Main_CFG_Loaded, o_Configuration, l_CFG_CachedAccess
|
|
*--
|
|
n_FB2PRG_Version = 1.19
|
|
c_FB2PRG_Version_Real = '1.19.56'
|
|
*--
|
|
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_TempDir = Sys(2023)
|
|
c_InputFile = ''
|
|
c_ClassToConvert = '' && Guarda el nombre de la clase a convertir, indicada en tcInputFile como "archivo.vcx::clase"
|
|
c_ClassOperationType = '' && (I)mport o (E)xport. Se usa solo para manejar clases individuales.
|
|
c_OriginalFileName = ''
|
|
c_LogFile = ''
|
|
c_ErrorLogFile = ''
|
|
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_CFG_EvaluateFromParam = 0
|
|
n_Debug = 0
|
|
n_BodyDevInfo = 0 && Indica si se debe incluir el campo DevInfo en el cuerpo de los pjx/pj2
|
|
l_Error = .F. && Indicador de errores del proceso actual
|
|
l_Errors = .F. && Indicador de error de la sesión actual, acumulativo de todos los procesos
|
|
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
|
|
*!* Changed by: Lutz Scheffler 21.02.2021
|
|
*!* change date="{^2021-02-21,10:57:00}"
|
|
* additional options controlling
|
|
* - splitt of DBC separated from VCX/SCX
|
|
* - new operations of DBF
|
|
l_OldFilesPerDBC = .T.
|
|
n_UseFilesPerDBC = 0
|
|
l_RedirectFilePerDBCToMain = .F.
|
|
l_ItemPerDBCCheck = .F.
|
|
l_DBF_BinChar_Base64 = .T.
|
|
l_DBF_IncludeDeleted = .F.
|
|
*!* /Changed by: Lutz Scheffler 21.02.2021
|
|
n_PRG_Compat_Level = 0 && 0=COMPATIBLE WITH FoxBin2Prg v1.19.49 and earlier, 1=Include HELPSTRING
|
|
n_ExcludeDBFAutoincNextval = 0
|
|
l_ClassPerFileCheck = .F.
|
|
l_RedirectClassPerFileToMain = .F.
|
|
n_RedirectClassType = 0 && 0=Redireccionar Todas las clases, 1=Redireccionar solo la clase indicada
|
|
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 = .F. && Para Unit Testing. 11/09/2015 - Cambiad a .F. porque cambia el ZOrder de los objetos (Ryan Harris)
|
|
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 && Scripting.FileSystemObject
|
|
o_TextStream = Null && Scripting.TextStream
|
|
o_FNC = Null && Filename_caps object
|
|
o_Configuration = Null
|
|
run_AfterCreateTable = ''
|
|
run_AfterCreate_DB2 = ''
|
|
c_VC2 = 'VC2' && VCX
|
|
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
|
|
c_FK2 = 'FK2' && FKY
|
|
c_ME2 = 'ME2' && MEM
|
|
PJX_Conversion_Support = 2
|
|
VCX_Conversion_Support = 2
|
|
SCX_Conversion_Support = 2
|
|
FRX_Conversion_Support = 2
|
|
LBX_Conversion_Support = 2
|
|
MNX_Conversion_Support = 2
|
|
FKY_Conversion_Support = 1
|
|
MEM_Conversion_Support = 1
|
|
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, laDir(1,5) ;
|
|
, lcLang
|
|
Set Deleted On
|
|
Set Date YMD
|
|
Set Hours To 24
|
|
Set Century On
|
|
Set Safety Off
|
|
Set Multilocks On
|
|
Set TablePrompt Off
|
|
Set Point To '.'
|
|
Set Separator To ','
|
|
tcCancelWithEscKey = Evl(tcCancelWithEscKey, '')
|
|
|
|
If Not Empty(tcCancelWithEscKey)
|
|
This.l_CancelWithEscKey = ( tcCancelWithEscKey == '1' )
|
|
Endif
|
|
|
|
This.declareDLL()
|
|
|
|
* Check if SYS(2023) point to "Program Files"
|
|
If Atc("\PROGRAM FILES", This.c_TempDir) > 0 Or Atc("\ARCHIVOS DE PROGRAMA", This.c_TempDir) > 0
|
|
This.c_TempDir = Getenv("TEMP")
|
|
Endif
|
|
|
|
This.c_LogFile = Addbs( This.c_TempDir ) + 'FoxBin2Prg_Debug.LOG'
|
|
This.c_ErrorLogFile = Addbs( This.c_TempDir ) + 'FoxBin2Prg_Error.LOG'
|
|
|
|
If Adir(laDir, This.c_ErrorLogFile) > 0 Then
|
|
If Adir(laDir, This.c_ErrorLogFile + '.BAK') > 0 Then
|
|
This.changeFileAttribute( This.c_ErrorLogFile + '.BAK', '-R-S-H' )
|
|
Erase (This.c_ErrorLogFile + '.BAK')
|
|
Endif
|
|
|
|
This.changeFileAttribute( This.c_ErrorLogFile, '-R-S-H' )
|
|
Rename (This.c_ErrorLogFile) To (This.c_ErrorLogFile + '.BAK')
|
|
Endif
|
|
|
|
If Adir(laDir, This.c_LogFile) > 0 Then
|
|
Erase (This.c_LogFile + '.BAK')
|
|
Rename (This.c_LogFile) To (This.c_LogFile + '.BAK')
|
|
Endif
|
|
|
|
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.c_FB2PRG_Version_Real), laValues(11) )
|
|
AddProperty(_Screen, 'c_FB2PRG_EXE_Version', This.c_FB2PRG_EXE_Version)
|
|
AddProperty(_Screen, 'ExitCode', 0)
|
|
|
|
This.writeLog( Replicate( '*', 100 ) )
|
|
This.writeLog( 'FoxBin2Prg INIT -', 2 )
|
|
This.writeLog( Replicate( '*', 100 ) )
|
|
This.writeLog( 'FoxBin2Prg: [' + This.c_Foxbin2prg_FullPath + '] (EXE Version: ' + This.c_FB2PRG_EXE_Version + ', FoxPro Version: ' + Version(4) + ')' )
|
|
This.writeLog( Textmerge( '- Internal CFG: <<SYS(2019,2)>> / External CFG: <<SYS(2019,1)>> / CodePage Used: <<CPCURRENT()>>)' ) )
|
|
|
|
* Get default language info
|
|
* ISO 639-2 Language Codes: https://www.loc.gov/standards/iso639-2/php/code_list.php
|
|
lcLang = This.getLocaleInfo(0x00000067) && ie: spa
|
|
|
|
Do Case
|
|
Case lcLang = 'spa'
|
|
lcLang = 'ES'
|
|
Case Inlist(lcLang, 'den', 'deu', 'ger', 'gmh', 'goh', 'gsw', 'nds')
|
|
lcLang = 'DE'
|
|
Case Inlist(lcLang, 'cpf', 'fra', 'fre', 'frm', 'fro')
|
|
lcLang = 'FR'
|
|
Otherwise && Default: EN
|
|
lcLang = 'EN'
|
|
Endcase
|
|
|
|
This.changeLanguage(lcLang)
|
|
|
|
This.o_FSO = Createobject("Scripting.FileSystemObject")
|
|
*THIS.o_WSH = CREATEOBJECT("WScript.Shell")
|
|
This.o_Configuration = Createobject("COLLECTION")
|
|
This.evaluateConfiguration()
|
|
Release lcSys16, lnPosProg, lc_Foxbin2prg_EXE, laValues
|
|
Return
|
|
Endproc
|
|
|
|
|
|
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()
|
|
This.o_Configuration = Null
|
|
This.o_WSH = Null
|
|
This.o_FSO = Null
|
|
If Vartype(_Screen.o_FoxBin2Prg_Lang) = "O" Then
|
|
_Screen.o_FoxBin2Prg_Lang = Null
|
|
Endif
|
|
Catch
|
|
|
|
Finally
|
|
This.o_FSO = Null
|
|
This.o_WSH = Null
|
|
This.o_FNC = Null
|
|
*-- Funciones para changeFileAttributes
|
|
Clear Dlls fb2p_SetFileAttributes, fb2p_GetFileAttributes
|
|
*-- Funciones para escribir en StdOut
|
|
Clear Dlls fb2p_GetStdHandle, fb2p_WriteFile
|
|
*-- Funciones para changeFileTime
|
|
Clear Dlls fb2p_SetFileTime, fb2p_GetFileAttributesEx, fb2p_LocalFileTimeToFileTime ;
|
|
, fb2p_FileTimeToSystemTime, fb2p_SystemTimeToFileTime, fb2p_lopen, fb2p_lclose
|
|
Endtry
|
|
|
|
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 = ''
|
|
*-- Los errores previos también se limpian.
|
|
.l_Error = .F.
|
|
.l_Errors = .F.
|
|
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(m.I,1)) ) Then
|
|
lnCount = lnCount + 1
|
|
Dimension taProcessed(lnCount,6)
|
|
taProcessed(lnCount,1) = .a_ProcessedFiles(m.I,1)
|
|
taProcessed(lnCount,2) = .a_ProcessedFiles(m.I,2)
|
|
taProcessed(lnCount,3) = .a_ProcessedFiles(m.I,3)
|
|
taProcessed(lnCount,4) = .a_ProcessedFiles(m.I,4)
|
|
taProcessed(lnCount,5) = .a_ProcessedFiles(m.I,5)
|
|
taProcessed(lnCount,6) = .a_ProcessedFiles(m.I,6)
|
|
Endif
|
|
Endfor
|
|
Endwith
|
|
|
|
Return lnCount
|
|
Endfunc
|
|
|
|
|
|
Procedure n_Debug_ACCESS
|
|
If This.n_CFG_Actual = 0 Or Isnull( This.o_Configuration( This.n_CFG_Actual ) )
|
|
Return This.n_Debug
|
|
Else
|
|
Return Nvl( This.o_Configuration( This.n_CFG_Actual ).n_Debug, This.n_Debug )
|
|
Endif
|
|
Endproc
|
|
|
|
|
|
Procedure n_BodyDevInfo_ACCESS
|
|
If This.n_CFG_Actual = 0 Or Isnull( This.o_Configuration( This.n_CFG_Actual ) )
|
|
Return This.n_BodyDevInfo
|
|
Else
|
|
Return Nvl( This.o_Configuration( This.n_CFG_Actual ).n_BodyDevInfo, This.n_BodyDevInfo )
|
|
Endif
|
|
Endproc
|
|
|
|
|
|
Procedure l_ShowErrors_ACCESS
|
|
If This.n_CFG_Actual = 0 Or Isnull( This.o_Configuration( This.n_CFG_Actual ) )
|
|
Return This.l_ShowErrors
|
|
Else
|
|
Return Nvl( This.o_Configuration( This.n_CFG_Actual ).l_ShowErrors, This.l_ShowErrors )
|
|
Endif
|
|
Endproc
|
|
|
|
|
|
Procedure n_ShowProgressbar_ACCESS
|
|
If This.n_CFG_Actual = 0 Or Isnull( This.o_Configuration( This.n_CFG_Actual ) )
|
|
Return This.n_ShowProgressbar
|
|
Else
|
|
Return Nvl( This.o_Configuration( This.n_CFG_Actual ).n_ShowProgressbar, This.n_ShowProgressbar )
|
|
Endif
|
|
Endproc
|
|
|
|
|
|
Procedure l_NoTimestamps_ACCESS
|
|
If This.n_CFG_Actual = 0 Or Isnull( This.o_Configuration( This.n_CFG_Actual ) )
|
|
Return This.l_NoTimestamps
|
|
Else
|
|
Return Nvl( This.o_Configuration( This.n_CFG_Actual ).l_NoTimestamps, This.l_NoTimestamps )
|
|
Endif
|
|
Endproc
|
|
|
|
|
|
Procedure n_UseClassPerFile_ACCESS
|
|
If This.n_CFG_Actual = 0 Or Isnull( This.o_Configuration( This.n_CFG_Actual ) )
|
|
Return This.n_UseClassPerFile
|
|
Else
|
|
Return Nvl( This.o_Configuration( This.n_CFG_Actual ).n_UseClassPerFile, This.n_UseClassPerFile )
|
|
Endif
|
|
Endproc
|
|
|
|
|
|
*!* Changed by: Lutz Scheffler 21.02.2021
|
|
*!* change date="{^2021-02-21,10:57:00}"
|
|
* additional options controlling
|
|
* - splitt of DBC separated from VCX/SCX
|
|
* - new operations of DBF
|
|
Procedure l_OldFilesPerDBC_ACCESS
|
|
If This.n_CFG_Actual = 0 Or Isnull( This.o_Configuration( This.n_CFG_Actual ) )
|
|
Return This.l_OldFilesPerDBC
|
|
Else
|
|
Return Nvl( This.o_Configuration( This.n_CFG_Actual ).l_OldFilesPerDBC, This.l_OldFilesPerDBC )
|
|
Endif
|
|
Endproc
|
|
|
|
|
|
Procedure n_UseFilesPerDBC_ACCESS
|
|
If This.n_CFG_Actual = 0 Or Isnull( This.o_Configuration( This.n_CFG_Actual ) )
|
|
Return This.n_UseFilesPerDBC
|
|
Else
|
|
Return Nvl( This.o_Configuration( This.n_CFG_Actual ).n_UseFilesPerDBC, This.n_UseFilesPerDBC )
|
|
Endif
|
|
Endproc
|
|
|
|
|
|
Procedure l_RedirectFilePerDBCToMain_ACCESS
|
|
If This.n_CFG_Actual = 0 Or Isnull( This.o_Configuration( This.n_CFG_Actual ) )
|
|
Return This.l_RedirectFilePerDBCToMain
|
|
Else
|
|
Return Nvl( This.o_Configuration( This.n_CFG_Actual ).l_RedirectFilePerDBCToMain, This.l_RedirectFilePerDBCToMain )
|
|
Endif
|
|
Endproc
|
|
|
|
|
|
Procedure l_ItemPerDBCCheck_ACCESS
|
|
If This.n_CFG_Actual = 0 Or Isnull( This.o_Configuration( This.n_CFG_Actual ) )
|
|
Return This.l_ItemPerDBCCheck
|
|
Else
|
|
Return Nvl( This.o_Configuration( This.n_CFG_Actual ).l_ItemPerDBCCheck, This.l_ItemPerDBCCheck )
|
|
Endif
|
|
Endproc
|
|
|
|
|
|
Procedure l_DBF_BinChar_Base64_ACCESS
|
|
If This.n_CFG_Actual = 0 Or Isnull( This.o_Configuration( This.n_CFG_Actual ) )
|
|
Return This.l_DBF_BinChar_Base64
|
|
Else
|
|
Return Nvl( This.o_Configuration( This.n_CFG_Actual ).l_DBF_BinChar_Base64, This.l_DBF_BinChar_Base64 )
|
|
Endif
|
|
Endproc
|
|
|
|
|
|
Procedure l_DBF_IncludeDeleted_ACCESS
|
|
If This.n_CFG_Actual = 0 Or Isnull( This.o_Configuration( This.n_CFG_Actual ) )
|
|
Return This.l_DBF_IncludeDeleted
|
|
Else
|
|
Return Nvl( This.o_Configuration( This.n_CFG_Actual ).l_DBF_IncludeDeleted, This.l_DBF_IncludeDeleted )
|
|
Endif
|
|
Endproc
|
|
*!* /Changed by: Lutz Scheffler 21.02.2021
|
|
|
|
|
|
Procedure l_RedirectClassPerFileToMain_ACCESS
|
|
If This.n_CFG_Actual = 0 Or Isnull( This.o_Configuration( This.n_CFG_Actual ) )
|
|
Return This.l_RedirectClassPerFileToMain
|
|
Else
|
|
Return Nvl( This.o_Configuration( This.n_CFG_Actual ).l_RedirectClassPerFileToMain, This.l_RedirectClassPerFileToMain )
|
|
Endif
|
|
Endproc
|
|
|
|
|
|
Procedure n_RedirectClassType_ACCESS
|
|
If This.n_CFG_Actual = 0 Or Isnull( This.o_Configuration( This.n_CFG_Actual ) )
|
|
Return This.n_RedirectClassType
|
|
Else
|
|
Return Nvl( This.o_Configuration( This.n_CFG_Actual ).n_RedirectClassType, This.n_RedirectClassType )
|
|
Endif
|
|
Endproc
|
|
|
|
|
|
Procedure l_RemoveNullCharsFromCode_ACCESS
|
|
If This.n_CFG_Actual = 0 Or Isnull( This.o_Configuration( This.n_CFG_Actual ) )
|
|
Return This.l_RemoveNullCharsFromCode
|
|
Else
|
|
Return Nvl( This.o_Configuration( This.n_CFG_Actual ).l_RemoveNullCharsFromCode, This.l_RemoveNullCharsFromCode )
|
|
Endif
|
|
Endproc
|
|
|
|
|
|
Procedure l_RemoveZOrderSetFromProps_ACCESS
|
|
If This.n_CFG_Actual = 0 Or Isnull( This.o_Configuration( This.n_CFG_Actual ) )
|
|
Return This.l_RemoveZOrderSetFromProps
|
|
Else
|
|
Return Nvl( This.o_Configuration( This.n_CFG_Actual ).l_RemoveZOrderSetFromProps, This.l_RemoveZOrderSetFromProps )
|
|
Endif
|
|
Endproc
|
|
|
|
|
|
Procedure l_ClassPerFileCheck_ACCESS
|
|
If This.n_CFG_Actual = 0 Or Isnull( This.o_Configuration( This.n_CFG_Actual ) )
|
|
Return This.l_ClassPerFileCheck
|
|
Else
|
|
Return Nvl( This.o_Configuration( This.n_CFG_Actual ).l_ClassPerFileCheck, This.l_ClassPerFileCheck )
|
|
Endif
|
|
Endproc
|
|
|
|
|
|
Procedure l_ClearUniqueID_ACCESS
|
|
If This.n_CFG_Actual = 0 Or Isnull( This.o_Configuration( This.n_CFG_Actual ) )
|
|
Return This.l_ClearUniqueID
|
|
Else
|
|
Return Nvl( This.o_Configuration( This.n_CFG_Actual ).l_ClearUniqueID, This.l_ClearUniqueID )
|
|
Endif
|
|
Endproc
|
|
|
|
|
|
Procedure l_ClearDBFLastUpdate_ACCESS
|
|
If This.n_CFG_Actual = 0 Or Isnull( This.o_Configuration( This.n_CFG_Actual ) )
|
|
Return This.l_ClearDBFLastUpdate
|
|
Else
|
|
Return Nvl( This.o_Configuration( This.n_CFG_Actual ).l_ClearDBFLastUpdate, This.l_ClearDBFLastUpdate )
|
|
Endif
|
|
Endproc
|
|
|
|
|
|
Procedure n_OptimizeByFilestamp_ACCESS
|
|
If This.n_CFG_Actual = 0 Or Isnull( This.o_Configuration( This.n_CFG_Actual ) )
|
|
Return This.n_OptimizeByFilestamp
|
|
Else
|
|
Return Nvl( This.o_Configuration( This.n_CFG_Actual ).n_OptimizeByFilestamp, This.n_OptimizeByFilestamp )
|
|
Endif
|
|
Endproc
|
|
|
|
|
|
Procedure n_ExtraBackupLevels_ACCESS
|
|
If This.n_CFG_Actual = 0 Or Isnull( This.o_Configuration( This.n_CFG_Actual ) )
|
|
Return This.n_ExtraBackupLevels
|
|
Else
|
|
Return Nvl( This.o_Configuration( This.n_CFG_Actual ).n_ExtraBackupLevels, This.n_ExtraBackupLevels )
|
|
Endif
|
|
Endproc
|
|
|
|
|
|
Procedure c_VC2_ACCESS
|
|
If This.n_CFG_Actual = 0 Or Isnull( This.o_Configuration( This.n_CFG_Actual ) )
|
|
Return This.c_VC2
|
|
Else
|
|
Return Nvl( This.o_Configuration( This.n_CFG_Actual ).c_VC2, This.c_VC2 )
|
|
Endif
|
|
Endproc
|
|
|
|
|
|
Procedure c_SC2_ACCESS
|
|
If This.n_CFG_Actual = 0 Or Isnull( This.o_Configuration( This.n_CFG_Actual ) )
|
|
Return This.c_SC2
|
|
Else
|
|
Return Nvl( This.o_Configuration( This.n_CFG_Actual ).c_SC2, This.c_SC2 )
|
|
Endif
|
|
Endproc
|
|
|
|
|
|
Procedure c_PJ2_ACCESS
|
|
If This.n_CFG_Actual = 0 Or Isnull( This.o_Configuration( This.n_CFG_Actual ) )
|
|
Return This.c_PJ2
|
|
Else
|
|
Return Nvl( This.o_Configuration( This.n_CFG_Actual ).c_PJ2, This.c_PJ2 )
|
|
Endif
|
|
Endproc
|
|
|
|
|
|
Procedure c_FR2_ACCESS
|
|
If This.n_CFG_Actual = 0 Or Isnull( This.o_Configuration( This.n_CFG_Actual ) )
|
|
Return This.c_FR2
|
|
Else
|
|
Return Nvl( This.o_Configuration( This.n_CFG_Actual ).c_FR2, This.c_FR2 )
|
|
Endif
|
|
Endproc
|
|
|
|
|
|
Procedure c_LB2_ACCESS
|
|
If This.n_CFG_Actual = 0 Or Isnull( This.o_Configuration( This.n_CFG_Actual ) )
|
|
Return This.c_LB2
|
|
Else
|
|
Return Nvl( This.o_Configuration( This.n_CFG_Actual ).c_LB2, This.c_LB2 )
|
|
Endif
|
|
Endproc
|
|
|
|
|
|
Procedure c_DB2_ACCESS
|
|
If This.n_CFG_Actual = 0 Or Isnull( This.o_Configuration( This.n_CFG_Actual ) )
|
|
Return This.c_DB2
|
|
Else
|
|
Return Nvl( This.o_Configuration( This.n_CFG_Actual ).c_DB2, This.c_DB2 )
|
|
Endif
|
|
Endproc
|
|
|
|
|
|
Procedure c_DC2_ACCESS
|
|
If This.n_CFG_Actual = 0 Or Isnull( This.o_Configuration( This.n_CFG_Actual ) )
|
|
Return This.c_DC2
|
|
Else
|
|
Return Nvl( This.o_Configuration( This.n_CFG_Actual ).c_DC2, This.c_DC2 )
|
|
Endif
|
|
Endproc
|
|
|
|
|
|
Procedure c_MN2_ACCESS
|
|
If This.n_CFG_Actual = 0 Or Isnull( This.o_Configuration( This.n_CFG_Actual ) )
|
|
Return This.c_MN2
|
|
Else
|
|
Return Nvl( This.o_Configuration( This.n_CFG_Actual ).c_MN2, This.c_MN2 )
|
|
Endif
|
|
Endproc
|
|
|
|
|
|
Procedure c_FK2_ACCESS
|
|
If This.n_CFG_Actual = 0 Or Isnull( This.o_Configuration( This.n_CFG_Actual ) )
|
|
Return This.c_FK2
|
|
Else
|
|
Return Nvl( This.o_Configuration( This.n_CFG_Actual ).c_FK2, This.c_FK2 )
|
|
Endif
|
|
Endproc
|
|
|
|
|
|
Procedure c_ME2_ACCESS
|
|
If This.n_CFG_Actual = 0 Or Isnull( This.o_Configuration( This.n_CFG_Actual ) )
|
|
Return This.c_ME2
|
|
Else
|
|
Return Nvl( This.o_Configuration( This.n_CFG_Actual ).c_ME2, This.c_ME2 )
|
|
Endif
|
|
Endproc
|
|
|
|
|
|
Procedure PJX_Conversion_Support_ACCESS
|
|
If This.n_CFG_Actual = 0 Or Isnull( This.o_Configuration( This.n_CFG_Actual ) )
|
|
Return This.PJX_Conversion_Support
|
|
Else
|
|
Return Nvl( This.o_Configuration( This.n_CFG_Actual ).PJX_Conversion_Support, This.PJX_Conversion_Support )
|
|
Endif
|
|
Endproc
|
|
|
|
|
|
Procedure VCX_Conversion_Support_ACCESS
|
|
If This.n_CFG_Actual = 0 Or Isnull( This.o_Configuration( This.n_CFG_Actual ) )
|
|
Return This.VCX_Conversion_Support
|
|
Else
|
|
Return Nvl( This.o_Configuration( This.n_CFG_Actual ).VCX_Conversion_Support, This.VCX_Conversion_Support )
|
|
Endif
|
|
Endproc
|
|
|
|
|
|
Procedure SCX_Conversion_Support_ACCESS
|
|
If This.n_CFG_Actual = 0 Or Isnull( This.o_Configuration( This.n_CFG_Actual ) )
|
|
Return This.SCX_Conversion_Support
|
|
Else
|
|
Return Nvl( This.o_Configuration( This.n_CFG_Actual ).SCX_Conversion_Support, This.SCX_Conversion_Support )
|
|
Endif
|
|
Endproc
|
|
|
|
|
|
Procedure FRX_Conversion_Support_ACCESS
|
|
If This.n_CFG_Actual = 0 Or Isnull( This.o_Configuration( This.n_CFG_Actual ) )
|
|
Return This.FRX_Conversion_Support
|
|
Else
|
|
Return Nvl( This.o_Configuration( This.n_CFG_Actual ).FRX_Conversion_Support, This.FRX_Conversion_Support )
|
|
Endif
|
|
Endproc
|
|
|
|
|
|
Procedure LBX_Conversion_Support_ACCESS
|
|
If This.n_CFG_Actual = 0 Or Isnull( This.o_Configuration( This.n_CFG_Actual ) )
|
|
Return This.LBX_Conversion_Support
|
|
Else
|
|
Return Nvl( This.o_Configuration( This.n_CFG_Actual ).LBX_Conversion_Support, This.LBX_Conversion_Support )
|
|
Endif
|
|
Endproc
|
|
|
|
|
|
Procedure MNX_Conversion_Support_ACCESS
|
|
If This.n_CFG_Actual = 0 Or Isnull( This.o_Configuration( This.n_CFG_Actual ) )
|
|
Return This.MNX_Conversion_Support
|
|
Else
|
|
Return Nvl( This.o_Configuration( This.n_CFG_Actual ).MNX_Conversion_Support, This.MNX_Conversion_Support )
|
|
Endif
|
|
Endproc
|
|
|
|
|
|
Procedure FKY_Conversion_Support_ACCESS
|
|
If This.n_CFG_Actual = 0 Or Isnull( This.o_Configuration( This.n_CFG_Actual ) )
|
|
Return This.FKY_Conversion_Support
|
|
Else
|
|
Return Nvl( This.o_Configuration( This.n_CFG_Actual ).FKY_Conversion_Support, This.FKY_Conversion_Support )
|
|
Endif
|
|
Endproc
|
|
|
|
|
|
Procedure MEM_Conversion_Support_ACCESS
|
|
If This.n_CFG_Actual = 0 Or Isnull( This.o_Configuration( This.n_CFG_Actual ) )
|
|
Return This.MEM_Conversion_Support
|
|
Else
|
|
Return Nvl( This.o_Configuration( This.n_CFG_Actual ).MEM_Conversion_Support, This.MEM_Conversion_Support )
|
|
Endif
|
|
Endproc
|
|
|
|
|
|
Procedure DBF_Conversion_Support_ACCESS
|
|
If This.n_CFG_Actual = 0 Or Isnull( This.o_Configuration( This.n_CFG_Actual ) )
|
|
Return This.DBF_Conversion_Support
|
|
Else
|
|
Return Nvl( This.o_Configuration( This.n_CFG_Actual ).DBF_Conversion_Support, This.DBF_Conversion_Support )
|
|
Endif
|
|
Endproc
|
|
|
|
|
|
Procedure DBF_Conversion_Included_ACCESS
|
|
If This.n_CFG_Actual = 0 Or Isnull( This.o_Configuration( This.n_CFG_Actual ) )
|
|
Return This.DBF_Conversion_Included
|
|
Else
|
|
Return Nvl( This.o_Configuration( This.n_CFG_Actual ).DBF_Conversion_Included, This.DBF_Conversion_Included )
|
|
Endif
|
|
Endproc
|
|
|
|
|
|
Procedure DBF_Conversion_Excluded_ACCESS
|
|
If This.n_CFG_Actual = 0 Or Isnull( This.o_Configuration( This.n_CFG_Actual ) )
|
|
Return This.DBF_Conversion_Excluded
|
|
Else
|
|
Return Nvl( This.o_Configuration( This.n_CFG_Actual ).DBF_Conversion_Excluded, This.DBF_Conversion_Excluded )
|
|
Endif
|
|
Endproc
|
|
|
|
|
|
Procedure DBC_Conversion_Support_ACCESS
|
|
If This.n_CFG_Actual = 0 Or Isnull( This.o_Configuration( This.n_CFG_Actual ) )
|
|
Return This.DBC_Conversion_Support
|
|
Else
|
|
Return Nvl( This.o_Configuration( This.n_CFG_Actual ).DBC_Conversion_Support, This.DBC_Conversion_Support )
|
|
Endif
|
|
Endproc
|
|
|
|
|
|
Procedure c_BackgroundImage_ACCESS
|
|
If This.n_CFG_Actual = 0 Or Isnull( This.o_Configuration( This.n_CFG_Actual ) )
|
|
Return This.c_BackgroundImage
|
|
Else
|
|
Return Nvl( This.o_Configuration( This.n_CFG_Actual ).c_BackgroundImage, This.c_BackgroundImage )
|
|
Endif
|
|
Endproc
|
|
|
|
|
|
Procedure n_ExcludeDBFAutoincNextval_ACCESS
|
|
If This.n_CFG_Actual = 0 Or Isnull( This.o_Configuration( This.n_CFG_Actual ) )
|
|
Return This.n_ExcludeDBFAutoincNextval
|
|
Else
|
|
Return Nvl( This.o_Configuration( This.n_CFG_Actual ).n_ExcludeDBFAutoincNextval, This.n_ExcludeDBFAutoincNextval )
|
|
Endif
|
|
Endproc
|
|
|
|
|
|
Procedure n_PRG_Compat_Level_ACCESS
|
|
If This.n_CFG_Actual = 0 Or Isnull( This.o_Configuration( This.n_CFG_Actual ) )
|
|
Return This.n_PRG_Compat_Level
|
|
Else
|
|
Return Nvl( This.o_Configuration( This.n_CFG_Actual ).n_PRG_Compat_Level, This.n_PRG_Compat_Level )
|
|
Endif
|
|
Endproc
|
|
|
|
|
|
Procedure changeFileAttribute
|
|
* Using Win32 Functions in Visual FoxPro
|
|
* example=103
|
|
* Changing file attributes
|
|
Lparameters tcFileName, tcAttrib
|
|
tcAttrib = Upper(tcAttrib)
|
|
|
|
#Define FILE_ATTRIBUTE_READONLY 1
|
|
#Define FILE_ATTRIBUTE_HIDDEN 2
|
|
#Define FILE_ATTRIBUTE_SYSTEM 4
|
|
#Define FILE_ATTRIBUTE_DIRECTORY 16
|
|
#Define FILE_ATTRIBUTE_ARCHIVE 32
|
|
#Define FILE_ATTRIBUTE_NORMAL 128
|
|
#Define FILE_ATTRIBUTE_TEMPORARY 512
|
|
#Define FILE_ATTRIBUTE_COMPRESSED 2048
|
|
|
|
Try
|
|
Local loEx As Exception, dwFileAttributes, dwFileAttributes_Orig, lnRet
|
|
lnRet = 0
|
|
|
|
* read current attributes for this file
|
|
dwFileAttributes = fb2p_GetFileAttributes(tcFileName)
|
|
dwFileAttributes_Orig = dwFileAttributes
|
|
|
|
If dwFileAttributes = -1
|
|
* the file does not exist
|
|
Exit
|
|
Endif
|
|
|
|
If dwFileAttributes > 0
|
|
If '+R' $ tcAttrib
|
|
dwFileAttributes = Bitor(dwFileAttributes, FILE_ATTRIBUTE_READONLY)
|
|
Endif
|
|
If '+A' $ tcAttrib
|
|
dwFileAttributes = Bitor(dwFileAttributes, FILE_ATTRIBUTE_ARCHIVE)
|
|
Endif
|
|
If '+S' $ tcAttrib
|
|
dwFileAttributes = Bitor(dwFileAttributes, FILE_ATTRIBUTE_SYSTEM)
|
|
Endif
|
|
If '+H' $ tcAttrib
|
|
dwFileAttributes = Bitor(dwFileAttributes, FILE_ATTRIBUTE_HIDDEN)
|
|
Endif
|
|
If '+D' $ tcAttrib
|
|
dwFileAttributes = Bitor(dwFileAttributes, FILE_ATTRIBUTE_DIRECTORY)
|
|
Endif
|
|
If '+N' $ tcAttrib
|
|
dwFileAttributes = Bitor(dwFileAttributes, FILE_ATTRIBUTE_NORMAL)
|
|
Endif
|
|
If '+T' $ tcAttrib
|
|
dwFileAttributes = Bitor(dwFileAttributes, FILE_ATTRIBUTE_TEMPORARY)
|
|
Endif
|
|
If '+C' $ tcAttrib
|
|
dwFileAttributes = Bitor(dwFileAttributes, FILE_ATTRIBUTE_COMPRESSED)
|
|
Endif
|
|
|
|
If '-R' $ tcAttrib And Bitand(dwFileAttributes, FILE_ATTRIBUTE_READONLY) = FILE_ATTRIBUTE_READONLY
|
|
dwFileAttributes = dwFileAttributes - FILE_ATTRIBUTE_READONLY
|
|
Endif
|
|
If '-A' $ tcAttrib And Bitand(dwFileAttributes, FILE_ATTRIBUTE_ARCHIVE) = FILE_ATTRIBUTE_ARCHIVE
|
|
dwFileAttributes = dwFileAttributes - FILE_ATTRIBUTE_ARCHIVE
|
|
Endif
|
|
If '-S' $ tcAttrib And Bitand(dwFileAttributes, FILE_ATTRIBUTE_SYSTEM) = FILE_ATTRIBUTE_SYSTEM
|
|
dwFileAttributes = dwFileAttributes - FILE_ATTRIBUTE_SYSTEM
|
|
Endif
|
|
If '-H' $ tcAttrib And Bitand(dwFileAttributes, FILE_ATTRIBUTE_HIDDEN) = FILE_ATTRIBUTE_HIDDEN
|
|
dwFileAttributes = dwFileAttributes - FILE_ATTRIBUTE_HIDDEN
|
|
Endif
|
|
If '-D' $ tcAttrib And Bitand(dwFileAttributes, FILE_ATTRIBUTE_DIRECTORY) = FILE_ATTRIBUTE_DIRECTORY
|
|
dwFileAttributes = dwFileAttributes - FILE_ATTRIBUTE_DIRECTORY
|
|
Endif
|
|
If '-N' $ tcAttrib And Bitand(dwFileAttributes, FILE_ATTRIBUTE_NORMAL) = FILE_ATTRIBUTE_NORMAL
|
|
dwFileAttributes = dwFileAttributes - FILE_ATTRIBUTE_NORMAL
|
|
Endif
|
|
If '-T' $ tcAttrib And Bitand(dwFileAttributes, FILE_ATTRIBUTE_TEMPORARY) = FILE_ATTRIBUTE_TEMPORARY
|
|
dwFileAttributes = dwFileAttributes - FILE_ATTRIBUTE_TEMPORARY
|
|
Endif
|
|
If '-C' $ tcAttrib And Bitand(dwFileAttributes, FILE_ATTRIBUTE_COMPRESSED) = FILE_ATTRIBUTE_COMPRESSED
|
|
dwFileAttributes = dwFileAttributes - FILE_ATTRIBUTE_COMPRESSED
|
|
Endif
|
|
|
|
* setting selected attributes
|
|
lnRet = fb2p_SetFileAttributes(tcFileName, dwFileAttributes)
|
|
Endif
|
|
|
|
Catch To loEx
|
|
Throw
|
|
|
|
Finally
|
|
This.writeLog( C_TAB + Lower(Program()) + ' >> [' + tcFileName + '] lnRet = ' + Transform(lnRet) + ', dwFileAttributes_Orig = ' + Transform(dwFileAttributes_Orig) )
|
|
Release tcFileName, tcAttrib, dwFileAttributes
|
|
Endtry
|
|
|
|
Return lnRet
|
|
Endproc
|
|
|
|
|
|
Procedure changeFileTime
|
|
*---------------------------------------------------------------------------------------------------
|
|
* CAMBIAR LA FECHA/HORA DE UN ARCHIVO
|
|
*---------------------------------------------------------------------------------------------------
|
|
* PARÁMETROS: (v=Pasar por valor | @=Pasar por referencia) (!=Obligatorio | ?=Opcional) (IN/OUT)
|
|
* tcFileName (v! IN ) Nombre del archivo
|
|
* tcTimeType (v? IN ) C=Creation time, W=Last Write, A=Last Access
|
|
* tnYear (v? IN ) Año (>=1800)
|
|
* tnMonth (v? IN ) Mes (1-12)
|
|
* tnDay (v? IN ) Día (1-31)
|
|
* tnHour (v? IN ) Hora (0-23)
|
|
* tnMinute (v? IN ) Minuto (0-59)
|
|
* tnSec (v? IN ) Segundo (0-59)
|
|
* tnThou (v? IN ) ¿? (0-999)
|
|
*---------------------------------------------------------------------------------------------------
|
|
Lparameters m.tcFileName, m.tcTimeType, m.tnYear, m.tnMonth, m.tnDay, m.tnHour, m.tnMinute, m.tnSec, m.tnThou
|
|
|
|
#Define OF_READWRITE 2
|
|
|
|
Local m.lpFileInformation, m.cS, m.nPar, m.fh, M.lpFileInformation, m.lpSysTime, m.cCreation ;
|
|
, M.cLastAccess, m.cLastWrite, m.cBuffTime, m.cBuffTime1, M.cTT,m.nYear1, m.nMonth1, m.nDay1, m.nHour1 ;
|
|
, M.nMinute1, m.nSec1, m.nThou1, llRetorno
|
|
|
|
Try
|
|
m.nPar = Pcount()
|
|
|
|
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, laDir(1,5) ;
|
|
, loLang As CL_LANG Of 'FOXBIN2PRG.PRG'
|
|
Store '' To tcBakFile_1, tcBakFile_2, tcBakFile_3, lcExt_1, lcExt_2, lcExt_3 ;
|
|
, tcOutputFile_Ext1, tcOutputFile_Ext2, tcOutputFile_Ext3
|
|
|
|
With This As c_foxbin2prg Of 'FOXBIN2PRG.PRG'
|
|
If .n_ExtraBackupLevels > 0 Then
|
|
loLang = _Screen.o_FoxBin2Prg_Lang
|
|
tcOutputFile = Evl( tcOutputFile, .c_OutputFile )
|
|
lcNext_Bak = .getNext_BAK( tcOutputFile )
|
|
lcExt_1 = Justext( tcOutputFile )
|
|
tcBakFile_1 = Forceext(tcOutputFile, lcExt_1 + lcNext_Bak)
|
|
|
|
Do Case
|
|
Case Inlist( lcExt_1, .c_PJ2, .c_VC2, .c_SC2, .c_FR2, .c_LB2, .c_DB2, .c_DC2, .c_MN2, .c_FK2, .c_ME2, 'PJM' )
|
|
*-- Extensiones TEXTO
|
|
|
|
Case lcExt_1 = 'DBF'
|
|
*-- DBF
|
|
lcExt_2 = 'FPT'
|
|
lcExt_3 = 'CDX'
|
|
tcBakFile_2 = Forceext(tcOutputFile, lcExt_2 + lcNext_Bak)
|
|
tcBakFile_3 = Forceext(tcOutputFile, lcExt_3 + lcNext_Bak)
|
|
|
|
Case lcExt_1 = 'DBC'
|
|
*-- DBC
|
|
lcExt_2 = 'DCT'
|
|
lcExt_3 = 'DCX'
|
|
tcBakFile_2 = Forceext(tcOutputFile, lcExt_2 + lcNext_Bak)
|
|
tcBakFile_3 = Forceext(tcOutputFile, lcExt_3 + lcNext_Bak)
|
|
|
|
Case Inlist( lcExt_1, 'PJX', 'VCX', 'SCX', 'FRX', 'LBX', 'MNX' )
|
|
*-- PJX, VCX, SCX, FRX, LBX, MNX
|
|
lcExt_2 = Left(lcExt_1,2) + 'T'
|
|
tcBakFile_2 = Forceext(tcOutputFile, lcExt_2 + lcNext_Bak)
|
|
|
|
Otherwise
|
|
*-- PKY, MEM
|
|
|
|
Endcase
|
|
|
|
If Not Empty(lcExt_1)
|
|
tcOutputFile_Ext1 = Forceext(tcOutputFile, lcExt_1)
|
|
|
|
If Adir( laDir, tcOutputFile_Ext1 ) > 0 Then
|
|
*-- LOG
|
|
Do Case
|
|
Case Empty(lcExt_2)
|
|
.writeLog( C_TAB + loLang.C_BACKUP_OF_LOC + tcOutputFile_Ext1 )
|
|
Case Empty(lcExt_3)
|
|
.writeLog( C_TAB + loLang.C_BACKUP_OF_LOC + tcOutputFile_Ext1 + '/' + lcExt_2 )
|
|
Otherwise
|
|
.writeLog( C_TAB + loLang.C_BACKUP_OF_LOC + tcOutputFile_Ext1 + '/' + lcExt_2 + '/' + lcExt_3 )
|
|
Endcase
|
|
|
|
*-- COPIA BACKUP
|
|
Copy File ( tcOutputFile_Ext1 ) To ( tcBakFile_1 )
|
|
|
|
If Not Empty(lcExt_2)
|
|
tcOutputFile_Ext2 = Forceext(tcOutputFile, lcExt_2)
|
|
|
|
If Adir( laDir, tcOutputFile_Ext2 ) > 0 Then
|
|
Copy File ( tcOutputFile_Ext2 ) To ( tcBakFile_2 )
|
|
Endif
|
|
Endif
|
|
|
|
If Not Empty(lcExt_3)
|
|
tcOutputFile_Ext3 = Forceext(tcOutputFile, lcExt_3)
|
|
|
|
If Adir( laDir, tcOutputFile_Ext3 ) > 0 Then
|
|
Copy File ( tcOutputFile_Ext3 ) To ( tcBakFile_3 )
|
|
Endif
|
|
Endif
|
|
Endif
|
|
Endif
|
|
Endif
|
|
Endwith && THIS
|
|
|
|
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, lcProp ;
|
|
, lo_CFG As CL_CFG Of 'FOXBIN2PRG.PRG' ;
|
|
, loCFG_Manual As CL_CFG Of 'FOXBIN2PRG.PRG' ;
|
|
, lo_Configuration As Collection ;
|
|
, loLang As CL_LANG Of 'FOXBIN2PRG.PRG' ;
|
|
, loEx As Exception
|
|
|
|
Try
|
|
With This As c_foxbin2prg Of 'FOXBIN2PRG.PRG'
|
|
Store 0 To lnKey
|
|
loLang = _Screen.o_FoxBin2Prg_Lang
|
|
tcRecompile = Evl(tcRecompile, .c_Recompile)
|
|
lcConfigFile = .c_Foxbin2prg_ConfigFile
|
|
tc_InputFile = Evl(tc_InputFile, .c_InputFile)
|
|
tcInputFile_Type = Evl(tcInputFile_Type,'')
|
|
lo_Configuration = .o_Configuration
|
|
|
|
If Vartype(lcConfigFile) = "O"
|
|
loCFG_Manual = lcConfigFile && lcConfigFile is an object CFG generated by get_DirSettings()
|
|
toParentCFG = loCFG_Manual
|
|
lcConfigFile = Fullpath('Personalized-CFG-Object', tc_InputFile)
|
|
loCFG_Manual.c_Foxbin2prg_ConfigFile = 'Personalized-CFG-Object'
|
|
Else
|
|
loCFG_Manual = Null
|
|
Endif
|
|
|
|
If Vartype(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 .n_CFG_EvaluateFromParam = 1
|
|
* Si se indicó por parámetro (modo objeto), usarlo como Maestro
|
|
* Se saltea solo esta evaluación, y luego se usa la variable para determinar el Nº de CFG a usar.
|
|
.n_CFG_EvaluateFromParam = -1 && Luego se cambia por el Nº de CFG que corresponda.
|
|
Else
|
|
If tcInputFile_Type == C_FILETYPE_DIRECTORY Then
|
|
* INDICÓ DIRECTORIO
|
|
If Isnull(loCFG_Manual)
|
|
*lcConfigFile = FULLPATH( 'foxbin2prg.cfg', ADDBS(tc_InputFile) )
|
|
lcConfigFile = Fullpath( Justfname(lcConfigFile), Addbs(tc_InputFile) )
|
|
Endif
|
|
Else
|
|
* INDICÓ ARCHIVO
|
|
If Isnull(loCFG_Manual)
|
|
*lcConfigFile = FULLPATH( 'foxbin2prg.cfg', tc_InputFile )
|
|
lcConfigFile = Fullpath( Justfname(lcConfigFile), tc_InputFile )
|
|
Endif
|
|
Endif
|
|
Endif
|
|
Endif
|
|
|
|
lo_Configuration = .o_Configuration
|
|
.n_CFG_Actual = 0
|
|
.l_CFG_CachedAccess = .F.
|
|
lc_CFG_Path = Upper( Justpath( lcConfigFile ) )
|
|
lo_CFG = This
|
|
|
|
*-- Búsqueda del CFG del PATH indicado en la caché
|
|
If .l_Main_CFG_Loaded
|
|
|
|
If lo_Configuration.Count > 0 Then
|
|
If .n_CFG_EvaluateFromParam > 1
|
|
* Especial: Si hay una configuración de bloqueo (CFG Manual), se usa
|
|
.n_CFG_Actual = .n_CFG_EvaluateFromParam
|
|
Else
|
|
* Normalmente se buscará el CFG del directorio analizado
|
|
.n_CFG_Actual = lo_Configuration.GetKey( lc_CFG_Path ) && 0 = No hay CFG cacheada, >0 = Hay CFG cacheada
|
|
Endif
|
|
|
|
If .n_CFG_Actual > 0 Then
|
|
lo_CFG = lo_Configuration.Item(.n_CFG_Actual)
|
|
.l_CFG_CachedAccess = .T.
|
|
|
|
If Not Isnull(loCFG_Manual)
|
|
* Si le paso un objeto CFG, prevalece sobre el guardado
|
|
lo_CFG.CopyFrom(@loCFG_Manual)
|
|
Endif
|
|
Endif
|
|
Endif
|
|
|
|
*-- Si no se pasó un CFG padre y no hay CFGs o no encuentra el del PATH indicado, analizo la jararquía
|
|
If Isnull(toParentCFG) And (lo_Configuration.Count = 0 Or .n_CFG_Actual = 0) Then
|
|
llMasterEval = .T.
|
|
toParentCFG = This
|
|
|
|
If Left( lc_CFG_Path, 2 ) == '\\' Then
|
|
*lnDirs = OCCURS( '\', lc_CFG_Path ) - 3
|
|
lnDirs = Occurs( '\', lc_CFG_Path ) - 2
|
|
Else
|
|
lnDirs = Occurs( '\', lc_CFG_Path )
|
|
Endif
|
|
|
|
If lnDirs > 0 Then
|
|
Dimension laDirs(lnDirs)
|
|
|
|
*-- Creo el array con los PATH intermedios
|
|
For I = lnDirs To 1 Step -1
|
|
If m.I = lnDirs Then
|
|
laDirs(m.I) = Justpath(lc_CFG_Path)
|
|
Else
|
|
laDirs(m.I) = Justpath(laDirs(m.I+1))
|
|
Endif
|
|
Endfor
|
|
|
|
If lnDirs = 1 And laDirs(1) = lc_CFG_Path
|
|
*-- Cuando no hay PATH intermedios, salteo esta parte para que más abajo lo agregue. 04/02/2016. FDBOZZO
|
|
*-- Ejemplo: Puede pasar cuando se convierte un archivo en C:\ u otro disco RAIZ.
|
|
Else
|
|
*-- Ahora evalúo las configuraciones de los PATH intermedios desde la raíz en adelante
|
|
*-- y mantengo la última configuración CFG Padre en toParentCFG para usarla como base.
|
|
For I = 1 To lnDirs
|
|
.evaluateConfiguration( '', '', '', '', '', '', '', '', laDirs(m.I), C_FILETYPE_DIRECTORY, @toParentCFG)
|
|
Endfor
|
|
Endif
|
|
|
|
.l_CFG_CachedAccess = .F.
|
|
.n_CFG_Actual = 0
|
|
Endif
|
|
Endif
|
|
Endif
|
|
|
|
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, m.I )
|
|
.get_SeparatedLineAndComment( @lcConfigLine )
|
|
laConfig(m.I) = Lower( lcConfigLine )
|
|
|
|
Do Case
|
|
Case Empty( laConfig(m.I) ) Or Inlist( Left( laConfig(m.I), 1 ), '*', '#', '/', "'" )
|
|
Loop
|
|
|
|
Case Left( laConfig(m.I), 10 ) == Lower('Extension:')
|
|
lcConfData = Alltrim( Substr( laConfig(m.I), 11 ) )
|
|
lcExt = Alltrim( Getwordnum( lcConfData, 1, '=' ) )
|
|
lcProp = 'c_' + lcExt
|
|
If Pemstatus( lo_CFG, lcProp, 5 )
|
|
lcValue = Upper( Alltrim( Getwordnum( lcConfData, 2, '=' ) ) )
|
|
lo_CFG.AddProperty( lcProp, lcValue )
|
|
*.writeLog( 'Reconfiguración de extensión:' + ' ' + lcExt + ' a ' + lcValue )
|
|
.writeLog( C_TAB + Justfname(lcConfigFile) + ' > ' + loLang.C_EXTENSION_RECONFIGURATION_LOC + ' ' + lcExt + ' -> ' + lcValue )
|
|
Endif
|
|
|
|
Case Left( laConfig(m.I), 17 ) == Lower('DontShowProgress:')
|
|
lcValue = Alltrim( Substr( laConfig(m.I), 18 ) )
|
|
If Not Inlist( Transform(tcDontShowProgress), '0', '1', '2' ) And Inlist( lcValue, '0', '1', '2' ) Then
|
|
tcDontShowProgress = lcValue
|
|
lo_CFG.n_ShowProgressbar = Icase(lcValue=='0',1, lcValue=='1',0, 2)
|
|
.writeLog( C_TAB + Justfname(lcConfigFile) + ' > tcDontShowProgress: ' + Transform(tcDontShowProgress) )
|
|
Endif
|
|
|
|
Case Left( laConfig(m.I), 16 ) == Lower('ShowProgressbar:')
|
|
lcValue = Alltrim( Substr( laConfig(m.I), 17 ) )
|
|
If Inlist( lcValue, '0', '1', '2' ) Then
|
|
lo_CFG.n_ShowProgressbar = Int( Val(lcValue) )
|
|
tcDontShowProgress = ''
|
|
.writeLog( C_TAB + Justfname(lcConfigFile) + ' > ShowProgressbar: ' + lcValue )
|
|
Endif
|
|
|
|
Case Left( laConfig(m.I), 15 ) == Lower('DontShowErrors:')
|
|
*-- Priorizo si tcDontShowErrors NO viene con "0" como parámetro, ya que los scripts vbs
|
|
*-- los utilizan para sobreescribir la configuración por defecto de foxbin2prg.cfg
|
|
lcValue = Alltrim( Substr( laConfig(m.I), 16 ) )
|
|
If Not Inlist( Transform(tcDontShowErrors), '0', '1' ) And Inlist( lcValue, '0', '1' ) Then
|
|
tcDontShowErrors = lcValue
|
|
.writeLog( C_TAB + Justfname(lcConfigFile) + ' > tcDontShowErrors: ' + Transform(tcDontShowErrors) )
|
|
Endif
|
|
|
|
Case Left( laConfig(m.I), 13 ) == Lower('NoTimestamps:')
|
|
lcValue = Alltrim( Substr( laConfig(m.I), 14 ) )
|
|
If Not Inlist( Transform(tcNoTimestamps), '0', '1' ) And Inlist( lcValue, '0', '1' ) Then
|
|
tcNoTimestamps = lcValue
|
|
.writeLog( C_TAB + Justfname(lcConfigFile) + ' > tcNoTimestamps: ' + Transform(tcNoTimestamps) )
|
|
Endif
|
|
|
|
Case Left( laConfig(m.I), 6 ) == Lower('Debug:')
|
|
lcValue = Alltrim( Substr( laConfig(m.I), 7 ) )
|
|
If Not Inlist( Transform(tcDebug), '0', '1' ) And Inlist( lcValue, '0', '1' ) Then
|
|
tcDebug = lcValue
|
|
.writeLog( C_TAB + Justfname(lcConfigFile) + ' > tcDebug: ' + Transform(tcDebug) )
|
|
Endif
|
|
|
|
Case Left( laConfig(m.I), 18 ) == Lower('ExtraBackupLevels:')
|
|
lcValue = Alltrim( Substr( laConfig(m.I), 19 ) )
|
|
If Not Isdigit( Transform(tcExtraBackupLevels) ) And Isdigit( lcValue ) Then
|
|
tcExtraBackupLevels = lcValue
|
|
.writeLog( C_TAB + Justfname(lcConfigFile) + ' > tcExtraBackupLevels: ' + Transform(tcExtraBackupLevels) )
|
|
Endif
|
|
|
|
Case Left( laConfig(m.I), 14 ) == Lower('ClearUniqueID:')
|
|
lcValue = Alltrim( Substr( laConfig(m.I), 15 ) )
|
|
If Not Inlist( Transform(tcClearUniqueID), '0', '1' ) And Inlist( lcValue, '0', '1' ) Then
|
|
tcClearUniqueID = lcValue
|
|
.writeLog( C_TAB + Justfname(lcConfigFile) + ' > ClearUniqueID: ' + Transform(lcValue) )
|
|
Endif
|
|
|
|
Case Left( laConfig(m.I), 19 ) == Lower('ClearDBFLastUpdate:')
|
|
lcValue = Alltrim( Substr( laConfig(m.I), 20 ) )
|
|
If Inlist( lcValue, '0', '1' ) Then
|
|
lo_CFG.l_ClearDBFLastUpdate = ( Transform(lcValue) == '1' )
|
|
.writeLog( C_TAB + Justfname(lcConfigFile) + ' > ClearDBFLastUpdate: ' + Transform(lcValue) )
|
|
Endif
|
|
|
|
Case Left( laConfig(m.I), 20 ) == Lower('OptimizeByFilestamp:')
|
|
lcValue = Alltrim( Substr( laConfig(m.I), 21 ) )
|
|
If Not Inlist( Transform(tcOptimizeByFilestamp), '0', '1', '2' ) And Inlist( lcValue, '0', '1', '2' ) Then
|
|
tcOptimizeByFilestamp = lcValue
|
|
.writeLog( C_TAB + Justfname(lcConfigFile) + ' > OptimizeByFilestamp: ' + Transform(lcValue) )
|
|
Endif
|
|
|
|
*!* Changed by: Lutz Scheffler 21.02.2021
|
|
*!* change date="{^2021-02-21,10:57:00}"
|
|
* additional options controlling
|
|
* - splitt of DBC separated from VCX/SCX
|
|
* - new operations of DBF
|
|
Case Left( laConfig(m.I), 16 ) == Lower('UseClassPerFile:')
|
|
lcValue = Alltrim( Substr( laConfig(m.I), 17 ) )
|
|
If Inlist( lcValue, '0', '1', '2' ) Then
|
|
lo_CFG.n_UseClassPerFile = Int( Val(lcValue) )
|
|
.writeLog( C_TAB + Justfname(lcConfigFile) + ' > UseClassPerFile: ' + Transform(lcValue) )
|
|
IF !lo_CFG.l_OldFilesPerDBC THEN
|
|
lo_CFG.n_UseFilesPerDBC = lo_CFG.n_UseClassPerFile
|
|
.writeLog( C_TAB + Justfname(lcConfigFile) + ' => UseFilesPerDBC: ' + Transform(lcValue) )
|
|
endif
|
|
Endif
|
|
|
|
Case Left( laConfig(m.I), 15 ) == Lower('OldFilesPerDBC:')
|
|
lcValue = Alltrim( Substr( laConfig(m.I), 16 ) )
|
|
If Inlist( lcValue, '0', '1' ) Then
|
|
lo_CFG.l_OldFilesPerDBC = ( Transform(lcValue) == '1' )
|
|
.writeLog( C_TAB + Justfname(lcConfigFile) + ' > OldFilesPerDBC: ' + Transform(lcValue) )
|
|
IF !lo_CFG.l_OldFilesPerDBC THEN
|
|
lo_CFG.n_UseFilesPerDBC = lo_CFG.n_UseClassPerFile
|
|
lo_CFG.l_RedirectFilePerDBCToMain = lo_CFG.l_RedirectClassPerFileToMain
|
|
lo_CFG.l_ItemPerDBCCheck = lo_CFG.l_ClassPerFileCheck
|
|
.writeLog( C_TAB + Justfname(lcConfigFile) + ' ==> UseFilesPerDBC: ' + Transform(lcValue) )
|
|
.writeLog( C_TAB + Justfname(lcConfigFile) + ' ==> RedirectFilePerDBCToMain: ' + Transform(lcValue) )
|
|
.writeLog( C_TAB + Justfname(lcConfigFile) + ' ==> ItemPerDBCCheck: ' + Transform(lcValue) )
|
|
endif
|
|
Endif
|
|
|
|
Case Left( laConfig(m.I), 15 ) == Lower('UseFilesPerDBC:')
|
|
lcValue = Alltrim( Substr( laConfig(m.I), 16 ) )
|
|
If lo_CFG.l_OldFilesPerDBC AND Inlist( lcValue, '0', '1' ) Then
|
|
lo_CFG.n_UseFilesPerDBC = Int( Val(lcValue) )
|
|
.writeLog( C_TAB + Justfname(lcConfigFile) + ' > UseFilesPerDBC: ' + Transform(lcValue) )
|
|
Endif
|
|
|
|
Case Left( laConfig(m.I), 25 ) == Lower('RedirectFilePerDBCToMain:')
|
|
lcValue = Alltrim( Substr( laConfig(m.I), 26 ) )
|
|
If lo_CFG.l_OldFilesPerDBC AND Inlist( lcValue, '0', '1' ) Then
|
|
lo_CFG.l_RedirectFilePerDBCToMain = ( Transform(lcValue) == '1' )
|
|
.writeLog( C_TAB + Justfname(lcConfigFile) + ' > RedirectFilePerDBCToMain: ' + Transform(lcValue) )
|
|
Endif
|
|
|
|
Case Left( laConfig(m.I), 16 ) == Lower('ItemPerDBCCheck:')
|
|
lcValue = Alltrim( Substr( laConfig(m.I), 17 ) )
|
|
If lo_CFG.l_OldFilesPerDBC AND Inlist( lcValue, '0', '1' ) Then
|
|
lo_CFG.l_ItemPerDBCCheck = ( Transform(lcValue) == '1' )
|
|
.writeLog( C_TAB + Justfname(lcConfigFile) + ' > ItemPerDBCCheck: ' + Transform(lcValue) )
|
|
Endif
|
|
|
|
Case Left( laConfig(m.I), 19 ) == Lower('DBF_BinChar_Base64:')
|
|
lcValue = Alltrim( Substr( laConfig(m.I), 20 ) )
|
|
If Inlist( lcValue, '0', '1' ) Then
|
|
lo_CFG.l_DBF_BinChar_Base64 = ( Transform(lcValue) == '1' )
|
|
.writeLog( C_TAB + Justfname(lcConfigFile) + ' > DBF_BinChar_Base64: ' + Transform(lcValue) )
|
|
Endif
|
|
|
|
Case Left( laConfig(m.I), 19 ) == Lower('DBF_IncludeDeleted:')
|
|
lcValue = Alltrim( Substr( laConfig(m.I), 20 ) )
|
|
If Inlist( lcValue, '0', '1' ) Then
|
|
lo_CFG.l_DBF_IncludeDeleted = ( Transform(lcValue) == '1' )
|
|
.writeLog( C_TAB + Justfname(lcConfigFile) + ' > DBF_IncludeDeleted: ' + Transform(lcValue) )
|
|
Endif
|
|
|
|
Case Left( laConfig(m.I), 18 ) == Lower('ClassPerFileCheck:')
|
|
lcValue = Alltrim( Substr( laConfig(m.I), 19 ) )
|
|
If Inlist( lcValue, '0', '1' ) Then
|
|
lo_CFG.l_ClassPerFileCheck = ( Transform(lcValue) == '1' )
|
|
.writeLog( C_TAB + Justfname(lcConfigFile) + ' > ClassPerFileCheck: ' + Transform(lcValue) )
|
|
IF !lo_CFG.l_OldFilesPerDBC THEN
|
|
lo_CFG.l_ItemPerDBCCheck = lo_CFG.l_ClassPerFileCheck
|
|
.writeLog( C_TAB + Justfname(lcConfigFile) + ' => ItemPerDBCCheck: ' + Transform(lcValue) )
|
|
endif
|
|
Endif
|
|
|
|
Case Left( laConfig(m.I), 27 ) == Lower('RedirectClassPerFileToMain:')
|
|
lcValue = Alltrim( Substr( laConfig(m.I), 28 ) )
|
|
If Inlist( lcValue, '0', '1' ) Then
|
|
lo_CFG.l_RedirectClassPerFileToMain = ( Transform(lcValue) == '1' )
|
|
.writeLog( C_TAB + Justfname(lcConfigFile) + ' > RedirectClassPerFileToMain: ' + Transform(lcValue) )
|
|
IF !lo_CFG.l_OldFilesPerDBC THEN
|
|
lo_CFG.l_RedirectFilePerDBCToMain = lo_CFG.l_RedirectClassPerFileToMain
|
|
.writeLog( C_TAB + Justfname(lcConfigFile) + ' => RedirectFilePerDBCToMain: ' + Transform(lcValue) )
|
|
endif
|
|
Endif
|
|
*!* /Changed by: Lutz Scheffler 21.02.2021
|
|
|
|
*!* Changed by: Lutz Scheffler 04.3.2021
|
|
*!* change date="{^2021-03-04,13:12:00}"
|
|
* new value 2, just add one class
|
|
Case Left( laConfig(m.I), 18 ) == Lower('RedirectClassType:')
|
|
lcValue = Alltrim( Substr( laConfig(m.I), 19 ) )
|
|
If Inlist( lcValue, '0', '1', '2' ) Then
|
|
lo_CFG.n_RedirectClassType = Int( Val( lcValue ) )
|
|
.writeLog( C_TAB + Justfname(lcConfigFile) + ' > RedirectClassType: ' + Transform(lcValue) )
|
|
Endif
|
|
*!* /Changed by: Lutz Scheffler 04.3.2021
|
|
|
|
Case Left( laConfig(m.I), 24 ) == Lower('RemoveNullCharsFromCode:')
|
|
lcValue = Alltrim( Substr( laConfig(m.I), 25 ) )
|
|
If Inlist( lcValue, '0', '1' ) Then
|
|
lo_CFG.l_RemoveNullCharsFromCode = ( Transform(lcValue) == '1' )
|
|
.writeLog( C_TAB + Justfname(lcConfigFile) + ' > RemoveNullCharsFromCode: ' + Transform(lcValue) )
|
|
Endif
|
|
|
|
Case Left( laConfig(m.I), 25 ) == Lower('RemoveZOrderSetFromProps:')
|
|
lcValue = Alltrim( Substr( laConfig(m.I), 26 ) )
|
|
If Inlist( lcValue, '0', '1' ) Then
|
|
lo_CFG.l_RemoveZOrderSetFromProps = ( Transform(lcValue) == '1' )
|
|
.writeLog( C_TAB + Justfname(lcConfigFile) + ' > RemoveZOrderSetFromProps: ' + Transform(lcValue) )
|
|
Endif
|
|
|
|
Case Left( laConfig(m.I), 9 ) == Lower('Language:')
|
|
*-- CASO ESPECIAL: El lenguaje no se guarda en lo_CFG, porque es un seteo Global.
|
|
lcValue = Alltrim( Substr( laConfig(m.I), 10 ) )
|
|
.changeLanguage(lcValue)
|
|
.writeLog( C_TAB + Justfname(lcConfigFile) + ' > Language: ' + Transform(lcValue) + ' (' + .c_Language + ')' )
|
|
|
|
Case Left( laConfig(m.I), 23 ) == Lower('PJX_Conversion_Support:')
|
|
lcValue = Alltrim( Substr( laConfig(m.I), 24 ) )
|
|
If Inlist( lcValue, '0', '1', '2' ) Then
|
|
lo_CFG.PJX_Conversion_Support = Int( Val( lcValue ) )
|
|
.writeLog( C_TAB + Justfname(lcConfigFile) + ' > PJX_Conversion_Support: ' + Transform(lo_CFG.PJX_Conversion_Support) )
|
|
Endif
|
|
|
|
Case Left( laConfig(m.I), 23 ) == Lower('VCX_Conversion_Support:')
|
|
lcValue = Alltrim( Substr( laConfig(m.I), 24 ) )
|
|
If Inlist( lcValue, '0', '1', '2' ) Then
|
|
lo_CFG.VCX_Conversion_Support = Int( Val( lcValue ) )
|
|
.writeLog( C_TAB + Justfname(lcConfigFile) + ' > VCX_Conversion_Support: ' + Transform(lo_CFG.VCX_Conversion_Support) )
|
|
Endif
|
|
|
|
Case Left( laConfig(m.I), 23 ) == Lower('SCX_Conversion_Support:')
|
|
lcValue = Alltrim( Substr( laConfig(m.I), 24 ) )
|
|
If Inlist( lcValue, '0', '1', '2' ) Then
|
|
lo_CFG.SCX_Conversion_Support = Int( Val( lcValue ) )
|
|
.writeLog( C_TAB + Justfname(lcConfigFile) + ' > SCX_Conversion_Support: ' + Transform(lo_CFG.SCX_Conversion_Support) )
|
|
Endif
|
|
|
|
Case Left( laConfig(m.I), 23 ) == Lower('FRX_Conversion_Support:')
|
|
lcValue = Alltrim( Substr( laConfig(m.I), 24 ) )
|
|
If Inlist( lcValue, '0', '1', '2' ) Then
|
|
lo_CFG.FRX_Conversion_Support = Int( Val( lcValue ) )
|
|
.writeLog( C_TAB + Justfname(lcConfigFile) + ' > FRX_Conversion_Support: ' + Transform(lo_CFG.FRX_Conversion_Support) )
|
|
Endif
|
|
|
|
Case Left( laConfig(m.I), 23 ) == Lower('LBX_Conversion_Support:')
|
|
lcValue = Alltrim( Substr( laConfig(m.I), 24 ) )
|
|
If Inlist( lcValue, '0', '1', '2' ) Then
|
|
lo_CFG.LBX_Conversion_Support = Int( Val( lcValue ) )
|
|
.writeLog( C_TAB + Justfname(lcConfigFile) + ' > LBX_Conversion_Support: ' + Transform(lo_CFG.LBX_Conversion_Support) )
|
|
Endif
|
|
|
|
Case Left( laConfig(m.I), 23 ) == Lower('MNX_Conversion_Support:')
|
|
lcValue = Alltrim( Substr( laConfig(m.I), 24 ) )
|
|
If Inlist( lcValue, '0', '1', '2' ) Then
|
|
lo_CFG.MNX_Conversion_Support = Int( Val( lcValue ) )
|
|
.writeLog( C_TAB + Justfname(lcConfigFile) + ' > MNX_Conversion_Support: ' + Transform(lo_CFG.MNX_Conversion_Support) )
|
|
Endif
|
|
|
|
Case Left( laConfig(m.I), 23 ) == Lower('FKY_Conversion_Support:')
|
|
lcValue = Alltrim( Substr( laConfig(m.I), 24 ) )
|
|
If Inlist( lcValue, '0', '1' ) Then
|
|
lo_CFG.FKY_Conversion_Support = Int( Val( lcValue ) )
|
|
.writeLog( C_TAB + Justfname(lcConfigFile) + ' > FKY_Conversion_Support: ' + Transform(lo_CFG.FKY_Conversion_Support) )
|
|
Endif
|
|
|
|
Case Left( laConfig(m.I), 23 ) == Lower('MEM_Conversion_Support:')
|
|
lcValue = Alltrim( Substr( laConfig(m.I), 24 ) )
|
|
If Inlist( lcValue, '0', '1' ) Then
|
|
lo_CFG.MEM_Conversion_Support = Int( Val( lcValue ) )
|
|
.writeLog( C_TAB + Justfname(lcConfigFile) + ' > MEM_Conversion_Support: ' + Transform(lo_CFG.MEM_Conversion_Support) )
|
|
Endif
|
|
|
|
Case Left( laConfig(m.I), 23 ) == Lower('DBF_Conversion_Support:')
|
|
lcValue = Alltrim( Substr( laConfig(m.I), 24 ) )
|
|
If Inlist( lcValue, '0', '1', '2', '4', '8' ) Then
|
|
lo_CFG.DBF_Conversion_Support = Int( Val( lcValue ) )
|
|
.writeLog( C_TAB + Justfname(lcConfigFile) + ' > DBF_Conversion_Support: ' + Transform(lo_CFG.DBF_Conversion_Support) )
|
|
Endif
|
|
|
|
Case Left( laConfig(m.I), 24 ) == Lower('DBF_Conversion_Included:')
|
|
lcValue = Alltrim( Substr( laConfig(m.I), 25 ) )
|
|
If Not Empty(lcValue) Then
|
|
lo_CFG.DBF_Conversion_Included = lcValue
|
|
.writeLog( C_TAB + Justfname(lcConfigFile) + ' > DBF_Conversion_Included: ' + Transform(lo_CFG.DBF_Conversion_Included) )
|
|
Endif
|
|
|
|
Case Left( laConfig(m.I), 24 ) == Lower('DBF_Conversion_Excluded:')
|
|
lcValue = Alltrim( Substr( laConfig(m.I), 25 ) )
|
|
If Not Empty(lcValue) Then
|
|
lo_CFG.DBF_Conversion_Excluded = lcValue
|
|
.writeLog( C_TAB + Justfname(lcConfigFile) + ' > DBF_Conversion_Excluded: ' + Transform(lo_CFG.DBF_Conversion_Excluded) )
|
|
Endif
|
|
|
|
Case Left( laConfig(m.I), 23 ) == Lower('DBC_Conversion_Support:')
|
|
lcValue = Alltrim( Substr( laConfig(m.I), 24 ) )
|
|
If Inlist( lcValue, '0', '1', '2' ) Then
|
|
lo_CFG.DBC_Conversion_Support = Int( Val( lcValue ) )
|
|
.writeLog( C_TAB + Justfname(lcConfigFile) + ' > DBC_Conversion_Support: ' + Transform(lo_CFG.DBC_Conversion_Support) )
|
|
Endif
|
|
|
|
Case Left( laConfig(m.I), 16 ) == Lower('BackgroundImage:')
|
|
lcValue = Alltrim( Substr( laConfig(m.I), 17 ) )
|
|
If Empty(lcValue) Or Adir( laDirInfo, lcValue ) > 0 Then
|
|
lo_CFG.c_BackgroundImage = lcValue
|
|
.writeLog( C_TAB + Justfname(lcConfigFile) + ' > BackgroundImage: ' + Transform(lo_CFG.c_BackgroundImage) )
|
|
Endif
|
|
|
|
Case Left( laConfig(m.I), 25 ) == Lower('ExcludeDBFAutoincNextval:')
|
|
lcValue = Alltrim( Substr( laConfig(m.I), 26 ) )
|
|
If Inlist( lcValue, '0', '1' ) Then
|
|
lo_CFG.n_ExcludeDBFAutoincNextval = Int( Val( lcValue ) )
|
|
.writeLog( C_TAB + Justfname(lcConfigFile) + ' > ExcludeDBFAutoincNextval: ' + Transform(lo_CFG.n_ExcludeDBFAutoincNextval) )
|
|
Endif
|
|
|
|
Case Left( laConfig(m.I), 12 ) == Lower('BodyDevInfo:')
|
|
lcValue = Alltrim( Substr( laConfig(m.I), 13 ) )
|
|
If Inlist( lcValue, '0', '1' ) Then
|
|
lo_CFG.n_BodyDevInfo = Int( Val( lcValue ) )
|
|
.writeLog( C_TAB + Justfname(lcConfigFile) + ' > BodyDevInfo: ' + Transform(lo_CFG.n_BodyDevInfo) )
|
|
Endif
|
|
|
|
Case Left( laConfig(I), 17 ) == Lower('PRG_Compat_Level:')
|
|
lcValue = Alltrim( Substr( laConfig(I), 18 ) )
|
|
lo_CFG.n_PRG_Compat_Level = Int( Val( lcValue ) )
|
|
.writeLog( C_TAB + Justfname(lcConfigFile) + ' > PRG_Compat_Level: ' + Transform(lo_CFG.n_PRG_Compat_Level) )
|
|
|
|
Endcase
|
|
Endfor
|
|
|
|
.writeLog( )
|
|
|
|
Endif && llExiste_CFG_EnDisco
|
|
|
|
*-- ESTOS SE EVALÚAN FUERA DEL IF PORQUE NO DEPENDEN DEL CFG
|
|
*-- Y PUEDEN VENIR TAMBIÉN DE PARÁMETROS EXTERNOS.
|
|
If Inlist( Transform(tcDontShowProgress), '0', '1', '2' ) Then
|
|
lo_CFG.n_ShowProgressbar = Icase(tcDontShowProgress=='0',1, tcDontShowProgress=='1',0, 2)
|
|
Endif
|
|
If Inlist( Transform(tcDontShowErrors), '0', '1' ) Then
|
|
lo_CFG.l_ShowErrors = Not (Transform(tcDontShowErrors) == '1')
|
|
Endif
|
|
*IF NOT .l_Main_CFG_Loaded
|
|
lo_CFG.l_Recompile = (Empty(tcRecompile) Or Transform(tcRecompile) == '1' Or Directory(tcRecompile))
|
|
*ENDIF
|
|
If Inlist( Transform(tcNoTimestamps), '0', '1' ) Then
|
|
lo_CFG.l_NoTimestamps = Not (Transform(tcNoTimestamps) == '0')
|
|
Endif
|
|
If Inlist( Transform(tcClearUniqueID), '0', '1' ) Then
|
|
lo_CFG.l_ClearUniqueID = Not (Transform(tcClearUniqueID) == '0')
|
|
Endif
|
|
If Inlist( Transform(tcDebug), '0', '1', '2' ) Then
|
|
lo_CFG.n_Debug = Int(Val(tcDebug))
|
|
Endif
|
|
tcExtraBackupLevels = Evl( tcExtraBackupLevels, Transform( .n_ExtraBackupLevels ) )
|
|
If Isdigit(tcExtraBackupLevels)
|
|
lo_CFG.n_ExtraBackupLevels = Int( Val( Transform(tcExtraBackupLevels) ) )
|
|
Endif
|
|
If Inlist( Transform(tcOptimizeByFilestamp), '0', '1', '2' ) Then
|
|
lo_CFG.n_OptimizeByFilestamp = Int(Val(tcOptimizeByFilestamp))
|
|
Endif
|
|
|
|
.l_Main_CFG_Loaded = .T.
|
|
|
|
If llMasterEval
|
|
* Si se inidicó un archivo CFG por parámetro (modo objeto), aqui se bloquea
|
|
* al Nº de configuración correspondiente.
|
|
If .n_CFG_EvaluateFromParam = -1
|
|
.n_CFG_EvaluateFromParam = .n_CFG_Actual
|
|
Endif
|
|
Else
|
|
*-- Si no es llMasterEval, es porque esta llamada es cíclica desde este mismo método,
|
|
*-- y no hay parámetros para evaluar, ya que se mandan todos vacíos desde el inicial.
|
|
Exit
|
|
Endif
|
|
|
|
.writeLog( '> ' + Upper(loLang.C_USING_THIS_SETTINGS_LOC) + ':' )
|
|
.writeLog( C_TAB + 'n_CFG_Actual: ' + Transform(.n_CFG_Actual) + Icase(.n_CFG_Actual=1, ' [MASTER]', ' [SECONDARY]') )
|
|
.writeLog( C_TAB + 'l_CFG_CachedAccess: ' + Transform(.l_CFG_CachedAccess) )
|
|
.writeLog( C_TAB + 'tc_InputFile: ' + Transform(Evl(tc_InputFile,'') ) )
|
|
.writeLog( C_TAB + 'c_Foxbin2prg_ConfigFile: ' + Transform(Evl(lo_CFG.c_Foxbin2prg_ConfigFile, '(Internal defaults)') ) )
|
|
.writeLog( C_TAB + 'n_ShowProgressbar: ' + Transform(.n_ShowProgressbar) )
|
|
.writeLog( C_TAB + 'l_ShowErrors: ' + Transform(.l_ShowErrors) )
|
|
.writeLog( C_TAB + 'l_Recompile: ' + Transform(.l_Recompile) + ' (' + tcRecompile + ')' )
|
|
.writeLog( C_TAB + 'l_NoTimestamps: ' + Transform(.l_NoTimestamps) )
|
|
.writeLog( C_TAB + 'l_ClearUniqueID: ' + Transform(.l_ClearUniqueID) )
|
|
.writeLog( C_TAB + 'n_UseClassPerFile: ' + Transform(.n_UseClassPerFile) )
|
|
*!* Changed by: Lutz Scheffler 21.02.2021
|
|
*!* change date="{^2021-02-21,10:57:00}"
|
|
* additional options controlling
|
|
* - splitt of DBC separated from VCX/SCX
|
|
* - new operations of DBF
|
|
.writeLog( C_TAB + 'l_OldFilesPerDBC: ' + Transform(.l_OldFilesPerDBC) )
|
|
.writeLog( C_TAB + 'n_UseFilesPerDBC: ' + Transform(.n_UseFilesPerDBC) )
|
|
.writeLog( C_TAB + 'l_RedirectFilePerDBCToMain: ' + Transform(.l_RedirectFilePerDBCToMain) )
|
|
.writeLog( C_TAB + 'l_ItemPerDBCCheck: ' + Transform(.l_ItemPerDBCCheck) )
|
|
.writeLog( C_TAB + 'l_DBF_BinChar_Base64: ' + Transform(.l_DBF_BinChar_Base64) )
|
|
.writeLog( C_TAB + 'l_DBF_IncludeDeleted: ' + Transform(.l_DBF_IncludeDeleted) )
|
|
*!* /Changed by: Lutz Scheffler 21.02.2021
|
|
.writeLog( C_TAB + 'l_ClassPerFileCheck: ' + Transform(.l_ClassPerFileCheck) )
|
|
.writeLog( C_TAB + 'l_RedirectClassPerFileToMain: ' + Transform(.l_RedirectClassPerFileToMain) )
|
|
.writeLog( C_TAB + 'n_RedirectClassType: ' + Transform(.n_RedirectClassType) )
|
|
.writeLog( C_TAB + 'n_Debug: ' + Transform(.n_Debug) )
|
|
.writeLog( C_TAB + 'n_ExtraBackupLevels: ' + Transform(.n_ExtraBackupLevels) )
|
|
.writeLog( C_TAB + 'c_BackgroundImage: ' + Transform(.c_BackgroundImage) )
|
|
.writeLog( C_TAB + 'n_OptimizeByFilestamp: ' + Transform(.n_OptimizeByFilestamp) )
|
|
.writeLog( C_TAB + 'n_ExcludeDBFAutoincNextval: ' + Transform(.n_ExcludeDBFAutoincNextval) )
|
|
.writeLog( C_TAB + 'l_RemoveNullCharsFromCode: ' + Transform(.l_RemoveNullCharsFromCode) )
|
|
.writeLog( C_TAB + 'l_RemoveZOrderSetFromProps: ' + Transform(.l_RemoveZOrderSetFromProps) )
|
|
.writeLog( C_TAB + 'l_ClearDBFLastUpdate: ' + Transform(.l_ClearDBFLastUpdate) )
|
|
.writeLog( C_TAB + 'c_Language: ' + Transform(.c_Language) )
|
|
|
|
.writeLog( )
|
|
Endwith && THIS
|
|
|
|
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(m.I)), tcFileName )
|
|
llFound = .T.
|
|
Exit
|
|
Endif
|
|
Endfor
|
|
|
|
Release tcFileName, tcFilters, laFiltros
|
|
Return llFound
|
|
Endfunc
|
|
|
|
|
|
Procedure get_DBF_Configuration(tc_InputFile As String, to_out_DBF_CFG As Object, tlGenerateLog As Boolean) As Integer
|
|
*---------------------------------------------------------------------------------------------------
|
|
* PARÁMETROS: (v=Pasar por valor | @=Pasar por referencia) (!=Obligatorio | ?=Opcional) (IN/OUT)
|
|
* tc_InputFile (@! IN ) Ruta al archivo con Extensión para comprobar si tiene soporte de conversión
|
|
* to_out_DBF_CFG (@? OUT) Objeto CFG del DBF indicado, con las propiedades que contenga el CFG y sus valores
|
|
* RETORNO (v? OUT) Devuelve 0 si no existe el archivo CFG y 1 si lo encuentra
|
|
*---------------------------------------------------------------------------------------------------
|
|
#If .F.
|
|
Local to_out_DBF_CFG As CL_DBF_CFG Of 'FOXBIN2PRG.PRG'
|
|
#Endif
|
|
|
|
Local lcTableCFG, lnFileCount, laDirFile(1,5), I, lcConfigItem
|
|
lcTableCFG = tc_InputFile + '.CFG'
|
|
lnFileCount = Adir(laDirFile, lcTableCFG)
|
|
|
|
If lnFileCount = 1
|
|
to_out_DBF_CFG = Createobject("CL_DBF_CFG")
|
|
|
|
If tlGenerateLog Then
|
|
This.writeLog()
|
|
This.writeLog(' > Found DBF configuration file: ' + lcTableCFG)
|
|
Endif
|
|
|
|
For I = 1 To Alines( laConfig, Filetostr( lcTableCFG ), 1+4 )
|
|
lcConfigItem = Lower( laConfig(m.I) )
|
|
|
|
Do Case
|
|
Case Inlist( Left( lcConfigItem, 1 ), '*', '#', '/', "'" )
|
|
Loop
|
|
|
|
Case Left( lcConfigItem, 21 ) == Lower('DBF_Conversion_Order:')
|
|
to_out_DBF_CFG.DBF_Conversion_Order = Alltrim( Substr( laConfig(m.I), 22 ) )
|
|
If tlGenerateLog Then
|
|
This.writeLog(' ' + Justfname(lcTableCFG) + ' > DBF_Conversion_Order: ' + to_out_DBF_CFG.DBF_Conversion_Order )
|
|
Endif
|
|
|
|
Case Left( lcConfigItem, 25 ) == Lower('DBF_Conversion_Condition:')
|
|
to_out_DBF_CFG.DBF_Conversion_Condition = Alltrim( Substr( laConfig(m.I), 26 ) )
|
|
If tlGenerateLog Then
|
|
This.writeLog(' ' + Justfname(lcTableCFG) + ' > DBF_Conversion_Condition: ' + to_out_DBF_CFG.DBF_Conversion_Condition )
|
|
Endif
|
|
|
|
Case Left( lcConfigItem, 23 ) == Lower('DBF_Conversion_Support:')
|
|
to_out_DBF_CFG.DBF_Conversion_Support = Int( Val( Substr( laConfig(m.I), 24 ) ) )
|
|
If tlGenerateLog Then
|
|
This.writeLog(' ' + Justfname(lcTableCFG) + ' > DBF_Conversion_Support: ' + Transform(to_out_DBF_CFG.DBF_Conversion_Support) )
|
|
Endif
|
|
|
|
*!* Changed by: Lutz Scheffler 21.02.2021
|
|
*!* change date="{^2021-02-21,10:57:00}"
|
|
* additional options controlling
|
|
* - new operations of DBF
|
|
*!* /Changed by: Lutz Scheffler 21.02.2021
|
|
Case Left( lcConfigItem, 20 ) == Lower('DBF_BinChar_Base64:')
|
|
If Inlist( laConfig(m.I), '0', '1' ) Then
|
|
to_out_DBF_CFG.l_DBF_BinChar_Base64 = ( Transform(laConfig(m.I)) == '1' )
|
|
If tlGenerateLog Then
|
|
This.writeLog(' ' + Justfname(lcTableCFG) + ' > DBF_BinChar_Base64: ' + Transform(to_out_DBF_CFG.l_DBF_BinChar_Base64) )
|
|
Endif
|
|
Endif
|
|
|
|
Case Left( lcConfigItem, 20 ) == Lower('DBF_IncludeDeleted:')
|
|
If Inlist( laConfig(m.I), '0', '1' ) Then
|
|
to_out_DBF_CFG.l_DBF_IncludeDeleted = ( Transform(laConfig(m.I)) == '1' )
|
|
If tlGenerateLog Then
|
|
This.writeLog(' ' + Justfname(lcTableCFG) + ' > DBF_IncludeDeleted: ' + Transform(to_out_DBF_CFG.l_DBF_IncludeDeleted) )
|
|
Endif
|
|
Endif
|
|
*!* /Changed by: Lutz Scheffler 21.02.2021
|
|
Endcase
|
|
Endfor
|
|
|
|
If tlGenerateLog Then
|
|
This.writeLog()
|
|
Endif
|
|
|
|
Endif
|
|
|
|
Return lnFileCount
|
|
Endproc
|
|
|
|
|
|
Procedure get_Ext2FromExt
|
|
*---------------------------------------------------------------------------------------------------
|
|
* PARÁMETROS: (v=Pasar por valor | @=Pasar por referencia) (!=Obligatorio | ?=Opcional) (IN/OUT)
|
|
* tcExt (@! IN ) Extensión para comprobar si tiene soporte de conversión
|
|
* tcDir (@? IN ) Directorio del que devolver su configuración
|
|
* RETORNO (v? OUT) .T. si tiene soporte de conversión, .F. si no lo tiene
|
|
*---------------------------------------------------------------------------------------------------
|
|
Lparameters tcExt, tcDir
|
|
|
|
Local lcExt2
|
|
tcExt = Upper(tcExt)
|
|
|
|
With This As c_foxbin2prg Of 'FOXBIN2PRG.PRG'
|
|
If Not Empty(tcDir)
|
|
.evaluateConfiguration( '', '', '', '', '', '', '', '', tcDir, 'D' )
|
|
Endif
|
|
|
|
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(tcFileName As String, tcDir As String) As Boolean
|
|
*---------------------------------------------------------------------------------------------------
|
|
* PARÁMETROS: (v=Pasar por valor | @=Pasar por referencia) (!=Obligatorio | ?=Opcional) (IN/OUT)
|
|
* tcFilename (@! IN ) Extensión para comprobar si el archivo tiene soporte de conversión
|
|
* tcDir (@? IN ) Directorio del que devolver su configuración
|
|
* RETORNO (v? OUT) .T. si tiene soporte de conversión, .F. si no lo tiene
|
|
*---------------------------------------------------------------------------------------------------
|
|
Local llhasSupport, lcExt, lcDir ;
|
|
, loDBF_CFG As CL_DBF_CFG Of 'FOXBIN2PRG.PRG'
|
|
|
|
With This As c_foxbin2prg Of 'FOXBIN2PRG.PRG'
|
|
loDBF_CFG = Null
|
|
lcExt = Upper(Justext('.' + tcFileName))
|
|
|
|
If '\' $ tcFileName And lcExt == 'DBF' Then
|
|
lcDir = Justpath(tcFileName)
|
|
.get_DBF_Configuration(tcFileName, @loDBF_CFG)
|
|
Else
|
|
lcDir = tcDir
|
|
Endif
|
|
|
|
If Not Empty(lcDir)
|
|
.evaluateConfiguration( '', '', '', '', '', '', '', '', lcDir, 'D' )
|
|
Endif
|
|
|
|
llhasSupport = Icase( lcExt == 'PJX', .PJX_Conversion_Support > 0 ;
|
|
, lcExt == 'VCX', .VCX_Conversion_Support > 0 ;
|
|
, lcExt == 'SCX', .SCX_Conversion_Support > 0 ;
|
|
, lcExt == 'FRX', .FRX_Conversion_Support > 0 ;
|
|
, lcExt == 'LBX', .LBX_Conversion_Support > 0 ;
|
|
, lcExt == 'MNX', .MNX_Conversion_Support > 0 ;
|
|
, lcExt == 'FKY', .FKY_Conversion_Support > 0 ;
|
|
, lcExt == 'MEM', .MEM_Conversion_Support > 0 ;
|
|
, lcExt == 'DBF', Not Isnull(loDBF_CFG) And loDBF_CFG.DBF_Conversion_Support > 0 Or .DBF_Conversion_Support > 0 ;
|
|
, lcExt == 'DBC', .DBC_Conversion_Support > 0 ;
|
|
, .F. )
|
|
Endwith && THIS
|
|
|
|
Return llhasSupport
|
|
Endproc
|
|
|
|
|
|
Procedure hasSupport_Prg2Bin(tcFileName As String, tcDir As String) As Boolean
|
|
*---------------------------------------------------------------------------------------------------
|
|
* PARÁMETROS: (v=Pasar por valor | @=Pasar por referencia) (!=Obligatorio | ?=Opcional) (IN/OUT)
|
|
* tcFilename (@! IN ) Extensión para comprobar si el archivo tiene soporte de conversión
|
|
* tcDir (@? IN ) Directorio del que devolver su configuración
|
|
* RETORNO (v? OUT) .T. si tiene soporte de conversión, .F. si no lo tiene
|
|
*---------------------------------------------------------------------------------------------------
|
|
Local llhasSupport, lcExt, lcDir ;
|
|
, loDBF_CFG As CL_DBF_CFG Of 'FOXBIN2PRG.PRG'
|
|
|
|
With This As c_foxbin2prg Of 'FOXBIN2PRG.PRG'
|
|
loDBF_CFG = Null
|
|
lcExt = Upper(Justext('.' + tcFileName))
|
|
|
|
If '\' $ tcFileName And lcExt == .c_DB2 Then
|
|
lcDir = Justpath(tcFileName)
|
|
.get_DBF_Configuration(tcFileName, @loDBF_CFG)
|
|
Else
|
|
lcDir = tcDir
|
|
Endif
|
|
|
|
If Not Empty(lcDir)
|
|
.evaluateConfiguration( '', '', '', '', '', '', '', '', lcDir, 'D' )
|
|
Endif
|
|
|
|
llhasSupport = Icase( lcExt == .c_PJ2, .PJX_Conversion_Support = 2 ;
|
|
, lcExt == .c_VC2, .VCX_Conversion_Support = 2 ;
|
|
, lcExt == .c_SC2, .SCX_Conversion_Support = 2 ;
|
|
, lcExt == .c_FR2, .FRX_Conversion_Support = 2 ;
|
|
, lcExt == .c_LB2, .LBX_Conversion_Support = 2 ;
|
|
, lcExt == .c_MN2, .MNX_Conversion_Support = 2 ;
|
|
, lcExt == .c_FK2, .FKY_Conversion_Support = 2 ;
|
|
, lcExt == .c_ME2, .MEM_Conversion_Support = 2 ;
|
|
, lcExt == .c_DB2, Not Isnull(loDBF_CFG) And Inlist(loDBF_CFG.DBF_Conversion_Support, 2, 8) ;
|
|
OR (Inlist(.DBF_Conversion_Support, 2, 8) ;
|
|
AND (Isnull(loDBF_CFG) Or Not Inlist(loDBF_CFG.DBF_Conversion_Support, 1, 4))) ;
|
|
, lcExt == .c_DC2, .DBC_Conversion_Support = 2 ;
|
|
, .F. )
|
|
Endwith && THIS
|
|
|
|
Return llhasSupport
|
|
Endproc
|
|
|
|
|
|
Procedure conversionSupportType(tcFileName As String, tlGenerarLog As Boolean) As Integer
|
|
*---------------------------------------------------------------------------------------------------
|
|
* PARÁMETROS: (v=Pasar por valor | @=Pasar por referencia) (!=Obligatorio | ?=Opcional) (IN/OUT)
|
|
* tcFilename (@! IN ) Extensión para comprobar si el archivo tiene soporte de conversión
|
|
* RETORNO (v? OUT) Devuelve el código de soporte
|
|
*---------------------------------------------------------------------------------------------------
|
|
Local lnSupportType, lcExt, lcDir, lcFilename ;
|
|
, loDBF_CFG As CL_DBF_CFG Of 'FOXBIN2PRG.PRG'
|
|
|
|
Try
|
|
With This As c_foxbin2prg Of 'FOXBIN2PRG.PRG'
|
|
loDBF_CFG = Null
|
|
lcExt = Upper(Justext('.' + tcFileName))
|
|
|
|
If '\' $ tcFileName And Inlist(lcExt, .c_DB2, 'DBF') Then
|
|
lcFilename = Forceext(tcFileName, 'DBF')
|
|
lcDir = Justpath(lcFilename)
|
|
.get_DBF_Configuration(lcFilename, @loDBF_CFG, tlGenerarLog)
|
|
Else
|
|
lcDir = Sys(5) + Curdir()
|
|
Endif
|
|
|
|
If Not Empty(lcDir)
|
|
.evaluateConfiguration( '', '', '', '', '', '', '', '', lcDir, 'D' )
|
|
Endif
|
|
|
|
lnSupportType = Icase( ;
|
|
INLIST(lcExt, .c_PJ2, 'PJX'), .PJX_Conversion_Support ;
|
|
, Inlist(lcExt, .c_VC2, 'VCX'), .VCX_Conversion_Support ;
|
|
, Inlist(lcExt, .c_SC2, 'SCX'), .SCX_Conversion_Support ;
|
|
, Inlist(lcExt, .c_FR2, 'FRX'), .FRX_Conversion_Support ;
|
|
, Inlist(lcExt, .c_LB2, 'LBX'), .LBX_Conversion_Support ;
|
|
, Inlist(lcExt, .c_MN2, 'MNX'), .MNX_Conversion_Support ;
|
|
, Inlist(lcExt, .c_FK2, 'FKY'), .FKY_Conversion_Support ;
|
|
, Inlist(lcExt, .c_ME2, 'MEM'), .MEM_Conversion_Support ;
|
|
, Inlist(lcExt, .c_DB2, 'DBF'), Icase( Isnull(loDBF_CFG) Or loDBF_CFG.DBF_Conversion_Support = 0, .DBF_Conversion_Support, loDBF_CFG.DBF_Conversion_Support ) ;
|
|
, Inlist(lcExt, .c_DC2, 'DBC'), .DBC_Conversion_Support ;
|
|
, 0 )
|
|
|
|
lnSupportType = Int(lnSupportType)
|
|
Endwith && THIS
|
|
|
|
Finally
|
|
Store Null To loDBF_CFG
|
|
Release loDBF_CFG
|
|
Endtry
|
|
|
|
Return lnSupportType
|
|
Endproc
|
|
|
|
|
|
Procedure execute
|
|
*--------------------------------------------------------------------------------------------------------------
|
|
* PARÁMETROS: (v=Pasar por valor | @=Pasar por referencia) (!=Obligatorio | ?=Opcional) (IN/OUT)
|
|
* tc_InputFile (v! IN ) Nombre completo (fullpath) del archivo a convertir o nombre del directorio a procesar
|
|
* - En modo compatibilidad con Visual SourceSafe, se usa para preguntar el tipo de soporte de conversión para el tipo de archivo indicado
|
|
* tcType (v? IN ) Tipo de archivo de entrada. Compatibilidad con SCCTEXT.PRG
|
|
* - Si se indica "*" y tc_InputFile es un PJX, se procesan todos los archivos del proyecto y el PJX/2
|
|
* - Si se indica "*-" y tc_InputFile es un PJX, se procesan todos los archivos del proyecto sin el PJX/2
|
|
* - Si se indica "BIN2PRG", se procesa el directorio indicado en tc_InputFile para generar los TX2
|
|
* - Si se indica "PRG2BIN", se procesa el directorio indicado en tc_InputFile para generar los BIN
|
|
* - En modo compatibilidad con Visual SourceSafe, indica el tipo de archivo a convertir
|
|
* tcTextName (v? IN ) Nombre del archivo texto. (Solo para compatibilidad con Visual SourceSafe)
|
|
* tlGenText (v? IN ) .T.=Genera Texto, .F.=Genera Binario. (Solo para compatibilidad con Visual SourceSafe)
|
|
* tcDontShowErrors (v? IN ) '1' para no mostrar mensajes de error (MESSAGEBOX)
|
|
* tcDebug (v? IN ) '1' para habilitar modo debug (SOLO DESARROLLO)
|
|
* tcDontShowProgress (v? IN ) '1' para inhabilitar la barra de progreso
|
|
* toModulo (@? OUT) Referencia de objeto del módulo generado (para Unit Testing)
|
|
* toEx (@? OUT) Objeto con información del error
|
|
* tlRelanzarError (v? IN ) Indica si el error debe relanzarse o no
|
|
* tcOriginalFileName (v? IN ) Sirve para los casos en los que inputFile es un nombre temporal y se quiere generar
|
|
* el nombre correcto dentro de la versión texto (por ej: en los PJ2 y las cabeceras)
|
|
* tcRecompile (v? IN ) Indica recompilar ('1') el binario una vez regenerado. [Cambio de funcionamiento por defecto]
|
|
* Este cambio es para ganar tiempo, velocidad y seguridad. Además la recompilación que hace FoxBin2Prg
|
|
* se hace desde el directorio del archivo, con lo que las referencias relativas pueden
|
|
* generar errores de compilación, típicamente los #include.
|
|
* NOTA: Si en vez de '1' se indica un Path (p.ej, el del proyecto, se usará como base para recompilar
|
|
* tcNoTimestamps (v? IN ) Indica si se debe anular el timestamp ('1') o no ('0' ó vacío)
|
|
* tcBackupLevels (v? IN ) Indica la cantidad de niveles de backup a realizar (por defecto '1')
|
|
* tcClearUniqueID (v? IN ) Indica si se debe limpiar el UniqueID ('1') o no ('0' ó vacío)
|
|
* tcOptimizeByFilestamp (v? IN ) Indica si se debe optimizar por filestamp mayor o igual ('1'), solo igual ('2') o no optimizar ('0' ó vacío)
|
|
* tcCFG_File (v? IN ) Indica si se debe usar un archivo de configuración distinto al predeterminado
|
|
*--------------------------------------------------------------------------------------------------------------
|
|
Lparameters tc_InputFile, tcType, tcTextName, tlGenText, tcDontShowErrors, tcDebug, tcDontShowProgress ;
|
|
, toModulo, toEx As Exception, tlRelanzarError, tcOriginalFileName, tcRecompile, tcNoTimestamps ;
|
|
, tcBackupLevels, tcClearUniqueID, tcOptimizeByFilestamp, tcCFG_File
|
|
|
|
Try
|
|
Local I, lcPath, lnCodError, lcFileSpec, lcFile, laFiles(1,5), laDirInfo(1,5), lcInputFile_Type, lc_OldSetNotify ;
|
|
, lnFileCount, lcErrorInfo, lcErrorFile, lnPCount, laParams(1), lnConversionOption, lnErrorIcon, llError ;
|
|
, lcOldSetEscape, lcOldOnEscape, llEscKeyRestored ;
|
|
, loEx As Exception ;
|
|
, loCFG As CL_CFG Of 'FOXBIN2PRG.PRG' ;
|
|
, loFSO As Scripting.FileSystemObject ;
|
|
, loLang As CL_LANG Of 'FOXBIN2PRG.PRG' ;
|
|
, loFrm_Interactive As frm_interactive Of 'FOXBIN2PRG.PRG' ;
|
|
, loFrm_Main As frm_main Of 'FOXBIN2PRG.PRG' ;
|
|
, loDBF_CFG As CL_DBF_CFG Of 'FOXBIN2PRG.PRG' ;
|
|
, loWSH As WScript.Shell ;
|
|
, lnVFPVersion
|
|
|
|
With This As c_foxbin2prg Of 'FOXBIN2PRG.PRG'
|
|
lc_OldSetNotify = Set("Notify")
|
|
Set Notify Off
|
|
lnCodError = 0
|
|
loLang = _Screen.o_FoxBin2Prg_Lang
|
|
loFSO = .o_FSO
|
|
loWSH = .o_WSH
|
|
loCFG = Null
|
|
lnPCount = 0
|
|
lcInputFile_Type = ''
|
|
.l_Error = .F.
|
|
tcType = Upper( Evl(tcType,'') )
|
|
llEscKeyRestored = .T.
|
|
lnVFPVersion = Version(5)
|
|
.declareDLL()
|
|
|
|
If This.l_CancelWithEscKey Then
|
|
lcOldSetEscape = Set("Escape")
|
|
lcOldOnEscape = On("Escape")
|
|
On Escape Error 1799
|
|
Set Escape On
|
|
llEscKeyRestored = .F.
|
|
Endif
|
|
|
|
Do Case
|
|
Case lnVFPVersion = 900 And Int( Val( Substr( Version(4), Rat('.', Version(4)) + 1 ) ) ) < 3504
|
|
Error loLang.C_INCORRECT_VFP9_VERSION__MISSING_SP1_LOC
|
|
|
|
Case lnVFPVersion < 900
|
|
Error loLang.C_INCORRECT_VFP9_VERSION__MISSING_SP1_LOC
|
|
|
|
Case '\' $ tcType
|
|
Error loLang.C_INVALID_PARAMETER_LOC + ':' + CR_LF ;
|
|
+ 'tcType = "' + tcType + '"' + CR_LF ;
|
|
+ CR_LF ;
|
|
+ loLang.C_ALLOWED_VALUES_ARE_LOC + ': ' + CR_LF ;
|
|
+ '*, *-, -BIN2PRG, -PRG2BIN, -SHOWMSG, -SIMERR_I0, -SIMERR_I1, -SIMERR_O1'
|
|
|
|
Otherwise
|
|
* OK all versions from 900(3504) and up. For VFPA Guys :)
|
|
Endcase
|
|
|
|
Do Case
|
|
Case Atc('-SIMERR_I0','-'+tcType) > 0
|
|
.c_SimulateError = 'SIMERR_I0'
|
|
Case Atc('-SIMERR_I1','-'+tcType) > 0
|
|
.c_SimulateError = 'SIMERR_I1'
|
|
Case Atc('-SIMERR_O1','-'+tcType) > 0
|
|
.c_SimulateError = 'SIMERR_O1'
|
|
Endcase
|
|
|
|
If .l_AutoClearProcessedFiles Then
|
|
.clearProcessedFiles() && Para evitar acumular procesos anteriores
|
|
Endif
|
|
|
|
*-- Funciona y lee los parámetros, pero no le veo un caso de uso claro, ya que si se eligen
|
|
*-- varios directorios de proyecto, la compilación será errónea. 12/12/2014
|
|
*.readInputVFPParams( @laParams, @lnPCount )
|
|
|
|
*IF lnPCount > 0 THEN
|
|
* .writeLog( 'Params.Externos: ' + TRANSFORM(lnPCount,'@L ##') )
|
|
* FOR I = 1 TO lnPCount
|
|
* .writeLog( 'Param.' + TRANSFORM(m.I,'@L ##') + ' [' + laParams(m.I) + ']' )
|
|
* ENDFOR
|
|
* EXIT
|
|
*ENDIF
|
|
|
|
*-- Reconocimiento de la clase indicada
|
|
*-- Ej: [c:\desa\test\library.vcx::classname]
|
|
If '::' $ tc_InputFile Then
|
|
tc_InputFile = Strtran(tc_InputFile, '::', '|')
|
|
.c_ClassOperationType = Evl( Upper( Left( Alltrim( Getwordnum( tc_InputFile, 3, '|' ) ), 1) ), 'E')
|
|
.c_ClassToConvert = Lower( Alltrim( Getwordnum( tc_InputFile, 2, '|' ) ) )
|
|
* CUIDADO!, evaluar esta última, que si no las anteriores no evalúan.
|
|
tc_InputFile = Lower( Alltrim( Getwordnum( tc_InputFile, 1, '|' ) ) )
|
|
Else
|
|
.c_ClassOperationType = ''
|
|
Endif
|
|
|
|
If Vartype(tcCFG_File) = "O"
|
|
* Validar el objeto
|
|
loCFG = tcCFG_File
|
|
If Not (loCFG.Class == Proper('CL_CFG'))
|
|
Error 'CFG object: Invalid class. Please, generate it with get_DirSettings()'
|
|
Endif
|
|
|
|
.c_Foxbin2prg_ConfigFile = loCFG
|
|
.n_CFG_EvaluateFromParam = 1
|
|
|
|
Else
|
|
.c_Foxbin2prg_ConfigFile = Evl( tcCFG_File, .c_Foxbin2prg_ConfigFile )
|
|
.n_CFG_EvaluateFromParam = (Iif(Empty(tcCFG_File), 0, 1))
|
|
Endif
|
|
|
|
*-- Ajusto la ruta si no es absoluta
|
|
tc_InputFile = .get_AbsolutePath( tc_InputFile, .c_CurDir )
|
|
|
|
*-- Determino el tipo de InputFile (Archivo o Directorio)
|
|
If Empty(lcInputFile_Type) And Not Empty(tc_InputFile)
|
|
Do Case
|
|
Case Len(tc_InputFile) = 1
|
|
lcInputFile_Type = C_FILETYPE_QUERYSUPPORT
|
|
|
|
Case Adir(laDirInfo, tc_InputFile, "D") = 1 And Substr( laDirInfo(1,5), 5, 1 ) = "D"
|
|
*-- Ejemplo: "c:\desa\"
|
|
lcInputFile_Type = C_FILETYPE_DIRECTORY
|
|
|
|
Otherwise
|
|
*-- Ejemplo: "c:\desa\*.scx", "c:\desa\file.ext", (lista de archivos)
|
|
lcInputFile_Type = C_FILETYPE_FILE
|
|
Endcase
|
|
Endif
|
|
|
|
If Empty(tcRecompile) And Not Empty(lcInputFile_Type) And Not lcInputFile_Type == C_FILETYPE_QUERYSUPPORT Then
|
|
If lcInputFile_Type == C_FILETYPE_DIRECTORY Then
|
|
tcRecompile = tc_InputFile
|
|
Else
|
|
tcRecompile = Justpath( tc_InputFile )
|
|
Endif
|
|
Endif
|
|
|
|
tcRecompile = Evl(tcRecompile,'1')
|
|
.c_Recompile = tcRecompile
|
|
|
|
.writeLog( Replicate( '*', 100 ) )
|
|
.writeLog( loLang.C_MAIN_EXECUTION_LOC, 2 )
|
|
.writeLog( Replicate( '*', 100 ) )
|
|
.writeLog( '> ' + loLang.C_EXTERNAL_PARAMETERS_LOC + ':' )
|
|
.writeLog( C_TAB + 'tc_InputFile: ' + Transform( Evl(tc_InputFile, '(empty) -> Will use Default [' + .c_InputFile + ']' ) ) )
|
|
.writeLog( C_TAB + 'tcType: ' + Transform( Evl(tcType, '(empty)' ) ) )
|
|
.writeLog( C_TAB + 'tcTextName: ' + Transform( Evl(tcTextName, '(empty)' ) ) )
|
|
.writeLog( C_TAB + 'tlGenText: ' + Transform( Evl(tlGenText, '(empty)' ) ) )
|
|
.writeLog( C_TAB + 'tcDontShowErrors: ' + Transform( Evl(tcDontShowErrors, '(empty) -> Will use Default [' + Transform(.l_ShowErrors) + ']' ) ) )
|
|
.writeLog( C_TAB + 'tcDebug: ' + Transform( Evl(tcDebug, '(empty) -> Will use Default [' + Transform(.n_Debug) + ']' ) ) )
|
|
.writeLog( C_TAB + 'tcDontShowProgress: ' + Transform( Evl(tcDontShowProgress, '(empty) -> Will use Default [' + Transform(.n_ShowProgressbar) + ']' ) ) )
|
|
.writeLog( C_TAB + 'tlRelanzarError: ' + Transform( Evl(tlRelanzarError, '(empty)' ) ) )
|
|
.writeLog( C_TAB + 'tcOriginalFileName: ' + Transform( Evl(tcOriginalFileName, '(empty) -> Will use Default [' + .c_OriginalFileName + ']' ) ) )
|
|
.writeLog( C_TAB + 'tcRecompile: ' + Transform( Evl(tcRecompile, '(empty) -> Will use Default [' + .c_Recompile + ']' ) ) )
|
|
.writeLog( C_TAB + 'tcNoTimestamps: ' + Transform( Evl(tcNoTimestamps, '(empty) -> Will use Default [' + Transform(.l_NoTimestamps) + ']' ) ) )
|
|
.writeLog( C_TAB + 'tcBackupLevels: ' + Transform( Evl(tcBackupLevels, '(empty) -> Will use Default [' + Transform(.n_ExtraBackupLevels) + ']' ) ) )
|
|
.writeLog( C_TAB + 'tcClearUniqueID: ' + Transform( Evl(tcClearUniqueID, '(empty) -> Will use Default [' + Transform(.l_ClearUniqueID) + ']' ) ) )
|
|
.writeLog( C_TAB + 'tcOptimizeByFilestamp: ' + Transform( Evl(tcOptimizeByFilestamp, '(empty) -> Will use Default [' + Transform(.n_OptimizeByFilestamp) + ']' ) ) )
|
|
.writeLog( )
|
|
|
|
*-- ARCHIVO DE CONFIGURACIÓN PRINCIPAL
|
|
.evaluateConfiguration( @tcDontShowProgress, @tcDontShowErrors, @tcNoTimestamps, @tcDebug, @tcRecompile, @tcBackupLevels ;
|
|
, @tcClearUniqueID, @tcOptimizeByFilestamp, @tc_InputFile, @lcInputFile_Type )
|
|
|
|
*!* Changed by: Lutz Scheffler 04.3.2021
|
|
*!* change date="{^2021-03-04,13:25:00}"
|
|
* for Input file in the form file[.baseclass].class.vc2 (normaly sc2 too, but no support in old code)
|
|
* allow to import only the class to file.VCX with n_RedirectClassType = 2
|
|
* n_RedirectClassType = 0 will import all classes of file.VCX (as just handing file.vc2)
|
|
* n_RedirectClassType = 1 will import the class to single lib file[.baseclass].class.VCX
|
|
Do Case
|
|
Case .n_RedirectClassType # 2
|
|
* not handled
|
|
Case !Empty(.c_ClassToConvert)
|
|
* not otherwise
|
|
Case .n_UseClassPerFile = 0
|
|
* not handled
|
|
Case Occurs('.',m.tc_InputFile) > .n_UseClassPerFile
|
|
* we must have more dots then UseClassPerFile, because there is an extension
|
|
|
|
*class
|
|
.c_ClassToConvert = Lower( Justext( Juststem( m.tc_InputFile ) ) )
|
|
*remove class
|
|
tc_InputFile = Lower( Juststem( Juststem( m.tc_InputFile ) ) + '.' + Justext( m.tc_InputFile ) )
|
|
*remove baseclass
|
|
If .n_UseClassPerFile = 0
|
|
*remove baseclass
|
|
tc_InputFile = Lower( Juststem( Juststem( m.tc_InputFile ) ) + '.' + Justext( m.tc_InputFile ) )
|
|
Endif
|
|
* count anything then -BIN2PRG as import
|
|
.c_ClassOperationType = Iif( Atc('-BIN2PRG','-'+tcType) > 0 , 'E', 'I')
|
|
|
|
Otherwise
|
|
* not handled
|
|
Endcase
|
|
*!* /Changed by: Lutz Scheffler 04.3.2021
|
|
|
|
* Redefinir nombre archivo de entrada según el tipo de conversión (IMPORT/EXPORT)
|
|
If .c_ClassOperationType = 'I'
|
|
* En el caso de importar, debo cambiar la sintaxis de tc_InputFile para poder usar
|
|
* la conversión existente de clase vc2.
|
|
* Esto deja un archivo con sintaxis "classlib.vcx::classname::import" en "classlib.classname.vc2"
|
|
If .n_UseClassPerFile = 2
|
|
tc_InputFile = Forceext(tc_InputFile, '') + '.*.' + .c_ClassToConvert + '.' + .c_VC2
|
|
|
|
If Adir(laFiles, tc_InputFile) = 1
|
|
tc_InputFile = Fullpath( laFiles(1,1), tc_InputFile )
|
|
Endif
|
|
|
|
Else && Asumo .n_UseClassPerFile = 1
|
|
tc_InputFile = Forceext(tc_InputFile, '') + '.' + .c_ClassToConvert + '.' + .c_VC2
|
|
|
|
Endif
|
|
Endif
|
|
|
|
loLang = _Screen.o_FoxBin2Prg_Lang
|
|
|
|
Do Case
|
|
Case Version(5) < 900
|
|
*-- '¡FOXBIN2PRG es solo para Visual FoxPro 9.0!'
|
|
Messagebox( loLang.C_FOXBIN2PRG_JUST_VFP_9_LOC, 0+64+4096, 'FoxBin2Prg ' + This.c_FB2PRG_EXE_Version + ': ' + loLang.C_FOXBIN2PRG_WARN_CAPTION_LOC + ' (' + .c_Language + ')', 60000 )
|
|
lnCodError = 1
|
|
|
|
Case Empty(tc_InputFile)
|
|
*-- (Ejemplo de sintaxis y uso)
|
|
*MESSAGEBOX( loLang.C_FOXBIN2PRG_SYNTAX_INFO_EXAMPLE_LOC, 0+64+4096, 'FoxBin2Prg ' + THIS.c_FB2PRG_EXE_Version + ': ' + loLang.C_FOXBIN2PRG_SYNTAX_INFO_LOC + ' (' + .c_Language + ')', 60000 )
|
|
loFrm_Main = Createobject('frm_main', This)
|
|
loFrm_Main.Show()
|
|
Read Events
|
|
lnCodError = 0
|
|
*!* Changed by: Lutz Scheffler 15.2.2021
|
|
*!* change date="{^2021-02-15,18:44:00}"
|
|
* added option to create config files
|
|
Case UPPER( tcType )=='-C' AND VARTYPE( tc_InputFile )='C'
|
|
loLang = _Screen.o_FoxBin2Prg_Lang
|
|
STRTOFILE( STRTRAN( '*' + STRTRAN( loLang.C_FOXBIN2PRG_SYNTAX_INFO_EXAMPLE_LOC_cfg, 0h0D0A, 0h0D0A + '*'), 0h0D0A + '*' + 0h0D0A, 0h0D0A0D0A), tc_InputFile )
|
|
|
|
Case UPPER( tcType )=='-T' AND VARTYPE( tc_InputFile )='C'
|
|
loLang = _Screen.o_FoxBin2Prg_Lang
|
|
STRTOFILE( STRTRAN( STRTRAN( '*' + loLang.C_FOXBIN2PRG_SYNTAX_INFO_EXAMPLE_LOC_tab_cfg, 0h0D0A, 0h0D0A + '*'), 0h0D0A + '*' + 0h0D0A, 0h0D0A0D0A), tc_InputFile )
|
|
*!* /Changed by: Lutz Scheffler 15.2.2021
|
|
|
|
Otherwise
|
|
*-- EJECUCIÓN NORMAL
|
|
|
|
|
|
If Atc('-INTERACTIVE', ('-' + tcType)) > 0 ;
|
|
AND Atc('-BIN2PRG', ('-' + tcType)) = 0 And Atc('-PRG2BIN', ('-' + tcType)) = 0 ;
|
|
AND lcInputFile_Type == C_FILETYPE_DIRECTORY Then
|
|
*-- Se seleccionó un directorio y se puede elegir: Bin2Txt, Txt2Bin y Nada
|
|
.writeLog( loLang.C_INTERACTIVE_DIRECTORY_SELECTION_LOC )
|
|
loFrm_Interactive = Createobject('frm_interactive', This)
|
|
loFrm_Interactive.Show()
|
|
Read Events
|
|
lnConversionOption = loFrm_Interactive.n_ConversionType
|
|
|
|
If loFrm_Interactive.l_FileTimeStampOptimization
|
|
If .n_OptimizeByFilestamp = 0 Then
|
|
.n_OptimizeByFilestamp = 2
|
|
Endif
|
|
Else
|
|
.n_OptimizeByFilestamp = 0
|
|
Endif
|
|
|
|
loFrm_Interactive.Release()
|
|
loFrm_Interactive = Null
|
|
|
|
Do Case
|
|
Case lnConversionOption = 1 && Bin2Txt
|
|
tcType = tcType + '-BIN2PRG'
|
|
|
|
Case lnConversionOption = 2 && Txt2Bin
|
|
tcType = tcType + '-PRG2BIN'
|
|
|
|
Otherwise && None
|
|
Error 1799 && Conversion Cancelled
|
|
Endcase
|
|
Endif
|
|
|
|
|
|
*-- Evaluación de FileSpec de entrada
|
|
Do Case
|
|
Case Atc('-BIN2PRG', ('-' + tcType)) = 0 And Atc('-PRG2BIN', ('-' + tcType)) = 0 ;
|
|
AND lcInputFile_Type == C_FILETYPE_FILE ;
|
|
AND ( '*' $ Justext( tc_InputFile ) Or '?' $ Justext( tc_InputFile ) )
|
|
|
|
If .l_ShowErrors
|
|
*MESSAGEBOX( 'No se admiten extensiones * o ? porque es peligroso (se pueden pisar binarios con archivo xx2 vacíos).', 0+48+4096, 'FOXBIN2PRG: ERROR!!', 60000 )
|
|
Messagebox( loLang.C_ASTERISK_EXT_NOT_ALLOWED_LOC, 0+48+4096, 'FoxBin2Prg ' + This.c_FB2PRG_EXE_Version + ': ' + loLang.C_FOXBIN2PRG_ERROR_CAPTION_LOC, 60000 )
|
|
Exit
|
|
Else
|
|
Error loLang.C_ASTERISK_EXT_NOT_ALLOWED_LOC
|
|
Endif
|
|
|
|
|
|
Case lcInputFile_Type == C_FILETYPE_FILE And ( '*' $ Juststem( tc_InputFile ) Or '?' $ Juststem( tc_InputFile ) )
|
|
*-- SE QUIEREN TODOS LOS ARCHIVOS DE UNA EXTENSIÓN
|
|
lcFileSpec = Fullpath( tc_InputFile )
|
|
.c_LogFile = Addbs( Justpath( lcFileSpec ) ) + Strtran( Justfname( lcFileSpec ), '*', '_ALL' ) + '.LOG'
|
|
|
|
If .n_Debug > 0 Then
|
|
Erase ( .c_LogFile )
|
|
Endif
|
|
|
|
If Evl(tcType,'0') <> '*' Then
|
|
If .n_ShowProgressbar <> 0 And .l_ProcessFiles Then
|
|
.loadProgressbarForm()
|
|
Endif
|
|
|
|
Do Case
|
|
Case .l_Recompile And Len(tcRecompile) > 3 And Directory(tcRecompile)
|
|
Cd (tcRecompile)
|
|
Case tcRecompile == '1'
|
|
Cd (Justpath(lcFileSpec))
|
|
Endcase
|
|
Endif
|
|
|
|
lnFileCount = Adir( laFiles, lcFileSpec, '', 1 )
|
|
|
|
For I = 1 To lnFileCount
|
|
toModulo = Null
|
|
lcFile = Forcepath( laFiles(m.I,1), Justpath( lcFileSpec ) )
|
|
|
|
Do Case
|
|
Case Upper( Justext( Evl(tc_InputFile,'') ) ) == 'PJX' And Left(Evl(tcType,'0'),1) == '*'
|
|
*-- SE QUIEREN CONVERTIR A TEXTO TODOS LOS ARCHIVOS DE UNO O MÁS PROYECTOS PJX
|
|
*-- Filespec: "*.PJX", "*"
|
|
.evaluate_Full_PJX(lcFile, tcRecompile, @toModulo, @toEx, tcOriginalFileName, .c_LogFile, tcType)
|
|
|
|
Case Upper( Justext( Evl(tc_InputFile,'') ) ) == .c_PJ2 And Left(Evl(tcType,'0'),1) == '*'
|
|
*-- SE QUIEREN CONVERTIR A BINARIO TODOS LOS ARCHIVOS DE UNO O MÁS PROYECTOS PJ2
|
|
*-- Filespec: "*.PJ2", "*"
|
|
.evaluate_Full_PJ2(lcFile, tcRecompile, @toModulo, @toEx, tcOriginalFileName, .c_LogFile, tcType)
|
|
|
|
Case Atc('-BIN2PRG', ('-' + tcType)) > 0
|
|
*-- SE QUIEREN CONVERTIR A TEXTO TODOS LOS ARCHIVOS DE UN DIRECTORIO
|
|
*-- Filespec: "*.*"
|
|
If .hasSupport_Bin2Prg(lcFile) Then
|
|
.updateProgressbar( loLang.C_PROCESSING_LOC + ' ' + lcFile + '...', m.I, lnFileCount, 0 )
|
|
lnCodError = .convert( lcFile, @toModulo, @toEx, .F., tcOriginalFileName )
|
|
.writeLog_Flush()
|
|
|
|
Do Case
|
|
Case lnCodError = 1799 && Conversion Cancelled
|
|
Error 1799
|
|
|
|
Case lnCodError > 0
|
|
.doWriteErrorLog( @toEx )
|
|
llError = .T.
|
|
.l_Error = .F.
|
|
Endcase
|
|
Endif
|
|
|
|
Case Atc('-PRG2BIN', ('-' + tcType)) > 0
|
|
*-- SE QUIEREN CONVERTIR A BINARIO TODOS LOS ARCHIVOS DE UN DIRECTORIO
|
|
*-- Filespec: "*.*"
|
|
If .hasSupport_Prg2Bin(lcFile) Then
|
|
.updateProgressbar( loLang.C_PROCESSING_LOC + ' ' + lcFile + '...', m.I, lnFileCount, 0 )
|
|
lnCodError = .convert( lcFile, @toModulo, @toEx, .F., tcOriginalFileName )
|
|
.writeLog_Flush()
|
|
|
|
Do Case
|
|
Case lnCodError = 1799 && Conversion Cancelled
|
|
Error 1799
|
|
|
|
Case lnCodError > 0
|
|
.doWriteErrorLog( @toEx )
|
|
llError = .T.
|
|
.l_Error = .F.
|
|
Endcase
|
|
Endif
|
|
|
|
Case Empty( Justext( Evl(tc_InputFile,'') ) )
|
|
*-- NO SE INDICÓ NINGUNA EXTENSIÓN
|
|
Error loLang.C_INVALID_PARAMETER_LOC + ': cInputFile = "' + tc_InputFile + '"'
|
|
|
|
Otherwise
|
|
*-- DEMÁS ARCHIVOS
|
|
*-- Filespec: "*.EXT"
|
|
.updateProgressbar( loLang.C_PROCESSING_LOC + ' ' + lcFile + '...', m.I, lnFileCount, 0 )
|
|
lnCodError = .convert( lcFile, @toModulo, @toEx, .T., tcOriginalFileName )
|
|
.writeLog_Flush()
|
|
|
|
Do Case
|
|
Case lnCodError = 1799 && Conversion Cancelled
|
|
Error 1799
|
|
|
|
Case lnCodError > 0
|
|
.doWriteErrorLog( @toEx )
|
|
Endcase
|
|
Endcase
|
|
Endfor && I = 1 TO lnFileCount
|
|
|
|
If llError
|
|
.l_Error = .T.
|
|
Endif
|
|
|
|
Exit
|
|
|
|
|
|
Case Atc('-BIN2PRG', ('-' + tcType)) > 0
|
|
.writeLog( '> ' + loLang.C_OPTION_LOC + ': BIN2PRG' )
|
|
|
|
If .n_ShowProgressbar <> 0 And .l_ProcessFiles Then
|
|
.loadProgressbarForm()
|
|
.o_Frm_Avance.Caption = Strtran( .o_Frm_Avance.Caption, '> -', '(Bin>Txt) -' )
|
|
Endif
|
|
|
|
Do Case
|
|
Case lcInputFile_Type == C_FILETYPE_DIRECTORY
|
|
*-- CONVERSION BIN2PRG DE UN DIRECTORIO Y SUBDIRECTORIOS
|
|
.writeLog( '> InputFile ' + loLang.C_IS_A_DIRECTORY_LOC )
|
|
.writeLog()
|
|
|
|
Do Case
|
|
Case .l_Recompile And Len(tcRecompile) > 3 And Directory(tcRecompile)
|
|
Cd (tcRecompile)
|
|
Case .l_Recompile
|
|
Cd (tc_InputFile)
|
|
Endcase
|
|
|
|
.c_LogFile = Addbs(tc_InputFile) + tcType + '.LOG'
|
|
|
|
If .n_Debug > 0 Then
|
|
Erase ( .c_LogFile )
|
|
Endif
|
|
|
|
.get_FilesFromDirectory( tc_InputFile, @laFiles, @lnFileCount )
|
|
|
|
For I = 1 To lnFileCount
|
|
toModulo = Null
|
|
lcFile = laFiles(m.I)
|
|
|
|
If Not .hasSupport_Bin2Prg( lcFile ) Or Not Adir(laDirInfo, lcFile) > 0 Then
|
|
Loop
|
|
Endif
|
|
|
|
.updateProgressbar( loLang.C_PROCESSING_LOC + ' ' + lcFile + '...', m.I, lnFileCount, 0 )
|
|
lnCodError = .convert( lcFile, @toModulo, @toEx, .F., tcOriginalFileName )
|
|
*!* Changed by: Lutz Scheffler 15.2.2021
|
|
*!* change date="{^2021-02-15,06:57:00}"
|
|
* flushing the log after each file let us only see last file
|
|
* why ever, it should be appended, but we simply move
|
|
* .writeLog_Flush() after ENDFOR
|
|
|
|
* .writeLog_Flush()
|
|
|
|
Do Case
|
|
Case lnCodError = 1799 && Conversion Cancelled
|
|
Error 1799
|
|
|
|
Case lnCodError > 0
|
|
.doWriteErrorLog( @toEx )
|
|
Endcase
|
|
Endfor && I = 1 TO lnFileCount
|
|
.writeLog_Flush()
|
|
*!* /Changed by: Lutz Scheffler 15.2.2021
|
|
|
|
.updateProgressbar( loLang.C_END_OF_PROCESS_LOC, lnFileCount, lnFileCount, 0 )
|
|
Exit
|
|
|
|
Case Not .hasSupport_Bin2Prg( tc_InputFile ) Or Not Adir(laDirInfo, tc_InputFile) > 0
|
|
.writeLog( '> InputFile ' + loLang.C_IS_UNSUPPORTED_LOC )
|
|
.writeLog()
|
|
Exit
|
|
|
|
Endcase
|
|
|
|
|
|
Case Atc('-PRG2BIN', ('-' + tcType)) > 0
|
|
.writeLog( '> ' + loLang.C_OPTION_LOC + ': PRG2BIN' )
|
|
|
|
If .n_ShowProgressbar <> 0 And .l_ProcessFiles Then
|
|
.loadProgressbarForm()
|
|
.o_Frm_Avance.Caption = Strtran( .o_Frm_Avance.Caption, '> -', '(Txt>Bin) -' )
|
|
Endif
|
|
|
|
Do Case
|
|
Case lcInputFile_Type == C_FILETYPE_DIRECTORY
|
|
*-- CONVERSION PRG2BIN DE UN DIRECTORIO Y SUBDIRECTORIOS
|
|
.writeLog( '> InputFile ' + loLang.C_IS_A_DIRECTORY_LOC )
|
|
.writeLog()
|
|
|
|
Do Case
|
|
Case .l_Recompile And Len(tcRecompile) > 3 And Directory(tcRecompile)
|
|
Cd (tcRecompile)
|
|
Case .l_Recompile
|
|
Cd (tc_InputFile)
|
|
Endcase
|
|
|
|
.c_LogFile = Addbs(tc_InputFile) + tcType + '.LOG'
|
|
|
|
If .n_Debug > 0 Then
|
|
Erase ( .c_LogFile )
|
|
Endif
|
|
|
|
.get_FilesFromDirectory( tc_InputFile, @laFiles, @lnFileCount )
|
|
|
|
|
|
For I = 1 To lnFileCount
|
|
toModulo = Null
|
|
lcFile = laFiles(m.I)
|
|
|
|
If Not .hasSupport_Prg2Bin( lcFile ) Or Not Adir(laDirInfo, lcFile) > 0 Then
|
|
Loop
|
|
Endif
|
|
|
|
.updateProgressbar( loLang.C_PROCESSING_LOC + ' ' + lcFile + '...', m.I, lnFileCount, 0 )
|
|
lnCodError = .convert( lcFile, @toModulo, @toEx, .F., tcOriginalFileName )
|
|
*!* Changed by: Lutz Scheffler 15.2.2021
|
|
*!* change date="{^2021-02-15,06:57:00}"
|
|
* flushing the log after each file let us only see last file
|
|
* why ever, it should be appended, but we simply move
|
|
* .writeLog_Flush() after ENDFOR
|
|
|
|
* .writeLog_Flush()
|
|
|
|
Do Case
|
|
Case lnCodError = 1799 && Conversion Cancelled
|
|
Error 1799
|
|
|
|
Case lnCodError > 0
|
|
.doWriteErrorLog( @toEx )
|
|
Endcase
|
|
Endfor && I = 1 TO lnFileCount
|
|
.writeLog_Flush()
|
|
*!* /Changed by: Lutz Scheffler 15.2.2021
|
|
|
|
.updateProgressbar( loLang.C_END_OF_PROCESS_LOC, lnFileCount, lnFileCount, 0 )
|
|
Exit
|
|
|
|
Case Not .hasSupport_Prg2Bin( tc_InputFile ) Or Not Adir(laDirInfo, tc_InputFile) > 0
|
|
.writeLog( '> InputFile ' + loLang.C_IS_UNSUPPORTED_LOC )
|
|
.writeLog()
|
|
Exit
|
|
|
|
Endcase
|
|
|
|
|
|
Endcase
|
|
|
|
*-- UN ARCHIVO INDIVIDUAL O CONSULTA DE SOPORTE DE ARCHIVO
|
|
If lcInputFile_Type = C_FILETYPE_QUERYSUPPORT
|
|
*-- Consulta de soporte de conversión (compatibilidad con SourceSafe)
|
|
*-- SourceSafe consulta el tipo de soporte de cada archivo antes del Checkin/Checkout
|
|
*-- para saber si se puede hacer Diff y Merge.
|
|
*-- Para los códigos de tipo de archivo ver ayuda de "Type Property"
|
|
Do Case
|
|
Case tc_InputFile == FILETYPE_DATABASE
|
|
lnCodError = .DBC_Conversion_Support
|
|
|
|
Case tc_InputFile == FILETYPE_FREETABLE
|
|
lnCodError = .DBF_Conversion_Support
|
|
|
|
Case tc_InputFile == FILETYPE_FORM
|
|
lnCodError = .SCX_Conversion_Support
|
|
|
|
Case tc_InputFile == FILETYPE_LABEL
|
|
lnCodError = .LBX_Conversion_Support
|
|
|
|
Case tc_InputFile == FILETYPE_MENU
|
|
lnCodError = .MNX_Conversion_Support
|
|
|
|
Case tc_InputFile == FILETYPE_REPORT
|
|
lnCodError = .FRX_Conversion_Support
|
|
|
|
Case tc_InputFile == FILETYPE_CLASSLIB
|
|
lnCodError = .VCX_Conversion_Support
|
|
|
|
Case tc_InputFile $ FILETYPE_PROJECT && PJX (J no exite en FoxPro, es un valor inventado para evitar conflicto con los tipos existentes)
|
|
lnCodError = .PJX_Conversion_Support
|
|
|
|
Otherwise
|
|
lnCodError = -1 && No support.
|
|
Endcase
|
|
|
|
Else
|
|
|
|
Do Case
|
|
Case Upper( Justext( Evl(tc_InputFile,'') ) ) == 'PJX' And Left(Evl(tcType,'0'),1) == '*'
|
|
*-- SE QUIEREN CONVERTIR A TEXTO TODOS LOS ARCHIVOS DE UN PROYECTO PJX
|
|
.evaluate_Full_PJX(tc_InputFile, tcRecompile, @toModulo, @toEx, @tcOriginalFileName, '', tcType)
|
|
Exit
|
|
|
|
Case Upper( Justext( Evl(tc_InputFile,'') ) ) == .c_PJ2 And Left(Evl(tcType,'0'),1) == '*'
|
|
*-- SE QUIEREN CONVERTIR A BINARIO TODOS LOS ARCHIVOS DE UN PROYECTO PJ2
|
|
.evaluate_Full_PJ2(tc_InputFile, tcRecompile, @toModulo, @toEx, @tcOriginalFileName, '', tcType)
|
|
Exit
|
|
|
|
Case Inlist( Evl(tcType,'0') ;
|
|
, FILETYPE_DATABASE ;
|
|
, FILETYPE_FREETABLE ;
|
|
, FILETYPE_QUERY ;
|
|
, FILETYPE_FORM ;
|
|
, FILETYPE_REPORT ;
|
|
, FILETYPE_LABEL ;
|
|
, FILETYPE_CLASSLIB ;
|
|
, FILETYPE_PROGRAM ;
|
|
, FILETYPE_PROJECT ;
|
|
, FILETYPE_APILIB ;
|
|
, FILETYPE_APPLICATION ;
|
|
, FILETYPE_MENU ;
|
|
, FILETYPE_TEXT ;
|
|
, FILETYPE_OTHER ) ;
|
|
AND Evl(tcTextName,'0') <> '0'
|
|
*-- COMPATIBILIDAD CON SOURCESAFE. 30/01/2014
|
|
If tlGenText
|
|
.writeLog( '> ' + loLang.C_SOURCESAFE_COMPATIBILITY_MODE_LOC + ': ' + loLang.C_BINARY_TO_TEXT_LOC )
|
|
Else
|
|
*-- Create BINARIO desde versión TEXTO
|
|
*-- Como el archivo de entrada siempre es el binario cuando se usa SCCAPI,
|
|
*-- para regenerar el binario (tlGenText=.F.) se debe usar como
|
|
*-- archivo de entrada tcTextName en su lugar. Aquí los intercambio.
|
|
tc_InputFile = tcTextName
|
|
.l_Recompile = .T.
|
|
.writeLog( '> ' + loLang.C_SOURCESAFE_COMPATIBILITY_MODE_LOC + ': ' + loLang.C_TEXT_TO_BINARY_LOC )
|
|
Endif
|
|
Endcase
|
|
|
|
If Adir(laDirInfo, tc_InputFile) > 0
|
|
If .n_ShowProgressbar <> 0 And .l_ProcessFiles Then
|
|
.loadProgressbarForm()
|
|
Endif
|
|
|
|
.writeLog( '> InputFile ' + loLang.C_IS_A_FILE_LOC )
|
|
.writeLog()
|
|
tc_InputFile = Locfile(tc_InputFile)
|
|
|
|
Do Case
|
|
Case .l_Recompile And Len(tcRecompile) > 3 And Directory(tcRecompile)
|
|
Cd (tcRecompile)
|
|
Case tcRecompile == '1'
|
|
Cd (Justpath(tc_InputFile))
|
|
Endcase
|
|
|
|
.c_LogFile = tc_InputFile + '.LOG'
|
|
|
|
If .n_Debug > 0 Then
|
|
Erase ( .c_LogFile )
|
|
Endif
|
|
|
|
lnCodError = .convert( tc_InputFile, @toModulo, @toEx, .T., tcOriginalFileName )
|
|
*.updateProgressbar( loLang.C_END_OF_PROCESS_LOC, 1, 1, 0 )
|
|
Endif
|
|
Endif
|
|
|
|
Endcase
|
|
Endwith && THIS
|
|
|
|
Catch To toEx
|
|
If Not llEscKeyRestored And This.l_CancelWithEscKey Then
|
|
If Empty(lcOldOnEscape)
|
|
On Escape
|
|
Else
|
|
On Escape &lcOldOnEscape.
|
|
Endif
|
|
|
|
If Empty(lcOldSetEscape)
|
|
Set Escape Off
|
|
Else
|
|
Set Escape &lcOldSetEscape.
|
|
Endif
|
|
llEscKeyRestored = .T.
|
|
Endif
|
|
|
|
lnCodError = toEx.ErrorNo
|
|
lnErrorIcon = 64
|
|
|
|
If Vartype(loLang) <> 'O' Then
|
|
loLang = Createobject("CL_LANG","EN")
|
|
Endif
|
|
|
|
If lnCodError <> 1799 Then && Conversion Cancelled
|
|
toEx.UserValue = toEx.UserValue + 'FoxBin2Prg: [' + This.c_Foxbin2prg_FullPath + '] (EXE Version: ' + This.c_FB2PRG_EXE_Version + ')' + CR_LF
|
|
lnErrorIcon = 16
|
|
Endif
|
|
|
|
If Atc('-SHOWMSG', ('-' + tcType)) > 0 Then
|
|
If lnCodError <> 1799 Then && Conversion Cancelled
|
|
toEx.UserValue = toEx.UserValue + 'lcInputFile_Type = [' + Transform(lcInputFile_Type) + ']' + CR_LF
|
|
Endif
|
|
This.l_ShowErrors = .F. && La opción "SHOWMSG" muestra su propio mensaje
|
|
Endif
|
|
|
|
If lnCodError <> 1799 Then && Conversion Cancelled
|
|
toEx.UserValue = toEx.UserValue + 'tc_InputFile = [' + Transform(tc_InputFile) + ']' + CR_LF
|
|
Endif
|
|
|
|
This.doWriteErrorLog( @toEx, @lcErrorInfo )
|
|
|
|
If This.n_Debug > 0 Then
|
|
If _vfp.StartMode = 0
|
|
Set Step On
|
|
Endif
|
|
Endif
|
|
|
|
If tlRelanzarError
|
|
Throw
|
|
Endif
|
|
|
|
Finally
|
|
If Not llEscKeyRestored And This.l_CancelWithEscKey Then
|
|
If Empty(lcOldOnEscape)
|
|
On Escape
|
|
Else
|
|
On Escape &lcOldOnEscape.
|
|
Endif
|
|
|
|
If Empty(lcOldSetEscape)
|
|
Set Escape Off
|
|
Else
|
|
Set Escape &lcOldSetEscape.
|
|
Endif
|
|
llEscKeyRestored = .T.
|
|
Endif
|
|
|
|
If Vartype(loLang) <> 'O' Then
|
|
loLang = Createobject("CL_LANG","EN")
|
|
Endif
|
|
|
|
Use In (Select("TABLABIN"))
|
|
This.writeLog_Flush()
|
|
This.unloadProgressbarForm()
|
|
Cd (Justpath(This.c_CurDir))
|
|
|
|
Do Case
|
|
Case Evl( lcInputFile_Type, C_FILETYPE_QUERYSUPPORT ) <> C_FILETYPE_QUERYSUPPORT ;
|
|
AND Atc('-SHOWMSG', ('-' + tcType)) > 0 ;
|
|
OR This.l_ShowErrors And lnCodError > 0 And Not Isnull(toEx)
|
|
This.writeErrorLog_Flush()
|
|
|
|
Do Case
|
|
Case lnCodError = 1098 && User Error
|
|
Messagebox( toEx.Message, 0+64+4096, 'FoxBin2Prg ' + This.c_FB2PRG_EXE_Version, 60000 )
|
|
*loWSH.Run( THIS.c_ErrorLogFile, 3 )
|
|
This.wscriptshell_run( This.c_ErrorLogFile, 3 )
|
|
|
|
Case lnCodError = 1799 && Conversion Cancelled
|
|
Messagebox( loLang.C_CONVERSION_CANCELLED_BY_USER_LOC + '!', 0+64+4096, 'FoxBin2Prg ' + This.c_FB2PRG_EXE_Version, 60000 )
|
|
|
|
Case This.l_Errors
|
|
If Adir(laDirInfo, This.c_ErrorLogFile) > 0 Then
|
|
Messagebox( loLang.C_END_OF_PROCESS_LOC + '! (' + loLang.C_WITH_ERRORS_LOC + ')', 0+48+4096, 'FoxBin2Prg ' + This.c_FB2PRG_EXE_Version, 60000 )
|
|
*loWSH.Run( THIS.c_ErrorLogFile, 3 )
|
|
This.wscriptshell_run( This.c_ErrorLogFile, 3 )
|
|
Else
|
|
Messagebox( loLang.C_END_OF_PROCESS_LOC + '! (' + loLang.C_WITH_ERRORS_LOC + ')' + CR_LF + "[Warning: Can't show Error LOG file because does not exist!]", 0+48+4096, 'FoxBin2Prg ' + This.c_FB2PRG_EXE_Version, 60000 )
|
|
Endif
|
|
|
|
Otherwise
|
|
Messagebox( loLang.C_END_OF_PROCESS_LOC + '', 0+64+4096, 'FoxBin2Prg ' + This.c_FB2PRG_EXE_Version, 60000 )
|
|
|
|
Endcase
|
|
|
|
Endcase
|
|
|
|
If Empty(lnCodError) And This.l_Errors
|
|
lnCodError = 1098
|
|
Endif
|
|
|
|
Set Notify &lc_OldSetNotify.
|
|
Store Null To loFSO, loWSH, loDBF_CFG
|
|
Release I, lcPath, lcFileSpec, lcFile, laFiles, lnFileCount, lcErrorInfo, lcErrorFile, loEx, loFSO
|
|
Endtry
|
|
|
|
Return lnCodError
|
|
Endproc
|
|
|
|
|
|
Procedure evaluate_Full_PJX
|
|
*--------------------------------------------------------------------------------------------------------------
|
|
* SE QUIEREN CONVERTIR A TEXTO TODOS LOS ARCHIVOS DE UN PROYECTO PJX
|
|
*--------------------------------------------------------------------------------------------------------------
|
|
* PARÁMETROS: (v=Pasar por valor | @=Pasar por referencia) (!=Obligatorio | ?=Opcional) (IN/OUT)
|
|
* tc_InputFile (v! IN ) Nombre del archivo de entrada
|
|
* tcRecompile (v? IN ) Indica recompilar ('1') el binario una vez regenerado. [Cambio de funcionamiento por defecto]
|
|
* Este cambio es para ganar tiempo, velocidad y seguridad. Además la recompilación que hace FoxBin2Prg
|
|
* se hace desde el directorio del archivo, con lo que las referencias relativas pueden
|
|
* generar errores de compilación, típicamente los #include.
|
|
* NOTA: Si en vez de '1' se indica un Path (p.ej, el del proyecto, se usará como base para recompilar
|
|
* toModulo (@? OUT) Referencia de objeto del módulo generado (para Unit Testing)
|
|
* toEx (@? OUT) Objeto con información del error
|
|
* tcOriginalFileName (v? IN ) Sirve para los casos en los que inputFile es un nombre temporal y se quiere generar
|
|
* el nombre correcto dentro de la versión texto (por ej: en los PJ2 y las cabeceras)
|
|
* tcLogFile (v? IN ) Nombre del log a usar
|
|
* tcType (v? IN ) Tipo de archivo de entrada. Compatibilidad con SCCTEXT.PRG
|
|
* - Si se indica "*" y tc_InputFile es un PJX, se procesan todos los archivos del proyecto y el PJX/2
|
|
* - Si se indica "*-" y tc_InputFile es un PJX, se procesan todos los archivos del proyecto sin el PJX/2
|
|
*--------------------------------------------------------------------------------------------------------------
|
|
Lparameters tc_InputFile, tcRecompile, toModulo, toEx, tcOriginalFileName, tcLogFile, tcType
|
|
|
|
Local lcFileSpec, lnFileCount, laFiles(1,1), lcFile, lnCodError, I, lnFileCount, llError, laDirInfo(1,5) ;
|
|
, loLang As CL_LANG Of 'FOXBIN2PRG.PRG' ;
|
|
, loEx As Exception
|
|
|
|
Try
|
|
With This As c_foxbin2prg Of 'FOXBIN2PRG.PRG'
|
|
loLang = _Screen.o_FoxBin2Prg_Lang
|
|
lcFileSpec = Fullpath( tc_InputFile )
|
|
|
|
If .n_ShowProgressbar <> 0 And .l_ProcessFiles Then
|
|
.loadProgressbarForm()
|
|
.o_Frm_Avance.Caption = Strtran( .o_Frm_Avance.Caption, '> -', '(Bin>Txt) -' )
|
|
Endif
|
|
|
|
If Empty(tcLogFile)
|
|
.c_LogFile = Addbs( Justpath( lcFileSpec ) ) + Strtran( Justfname( lcFileSpec ), '*', '_ALL' ) + '.LOG'
|
|
|
|
If .n_Debug > 0 Then
|
|
Erase ( .c_LogFile )
|
|
Endif
|
|
Endif
|
|
|
|
.writeLog( '> ' + loLang.C_CONVERT_ALL_FILES_IN_A_PROJECT_LOC + ': ' + loLang.C_BINARY_TO_TEXT_LOC )
|
|
|
|
Do Case
|
|
Case .l_Recompile And Len(tcRecompile) > 3 And Directory(tcRecompile)
|
|
Cd (tcRecompile)
|
|
Case tcRecompile == '1'
|
|
Cd (Justpath(lcFileSpec))
|
|
Endcase
|
|
|
|
Select 0
|
|
Use (tc_InputFile) Shared Again Noupdate Alias TABLABIN
|
|
lnFileCount = 0
|
|
|
|
Scan For Not Deleted() And Type <> 'H'
|
|
lnFileCount = lnFileCount + 1
|
|
Dimension laFiles(lnFileCount,1)
|
|
laFiles(lnFileCount,1) = .get_AbsolutePath( Alltrim( Name, 0, ' ', Chr(0) ), Addbs( Justpath( lcFileSpec ) ) )
|
|
Endscan
|
|
|
|
Use In (Select("TABLABIN"))
|
|
|
|
*-- Convierto primero el proyecto
|
|
If tcType <> '*-' Then
|
|
lcFile = tc_InputFile
|
|
lnCodError = .convert( lcFile, toModulo, @toEx, .T., tcOriginalFileName )
|
|
.writeLog_Flush()
|
|
Endif
|
|
|
|
*-- Luego convierto los archivos incluidos
|
|
For I = 1 To lnFileCount
|
|
lcFile = laFiles(m.I,1)
|
|
.updateProgressbar( loLang.C_PROCESSING_LOC + ' ' + lcFile + '...', m.I, lnFileCount, 0 )
|
|
|
|
If .hasSupport_Bin2Prg( Upper(Justext(lcFile)) ) And Adir( laDirInfo, lcFile ) > 0 Then
|
|
lnCodError = .convert( lcFile, toModulo, @toEx, .F., tcOriginalFileName )
|
|
.writeLog_Flush()
|
|
|
|
Do Case
|
|
Case lnCodError = 1799 && Conversion Cancelled
|
|
Error 1799
|
|
|
|
Case lnCodError > 0
|
|
.doWriteErrorLog( @toEx )
|
|
llError = .T.
|
|
.l_Error = .F.
|
|
Endcase
|
|
Else
|
|
*-- addProcessedFile( tcFile, tcInOutType, tcProcessed, tcHasErrors, tcSupported, tcExpanded )
|
|
If .addProcessedFile( lcFile, 'I', 'P0', 'E0', 'S0', 'X0' )
|
|
.updateProcessedFile()
|
|
Endif
|
|
Endif
|
|
|
|
.writeLog_Flush()
|
|
|
|
If llError
|
|
.l_Error = .T.
|
|
Endif
|
|
Endfor
|
|
Endwith
|
|
|
|
Catch To loEx
|
|
Throw
|
|
|
|
Finally
|
|
Store Null To loLang
|
|
Release loLang
|
|
Endtry
|
|
Endproc
|
|
|
|
|
|
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, llError, laDirInfo(1,5) ;
|
|
, loLang As CL_LANG Of 'FOXBIN2PRG.PRG' ;
|
|
, loEx As Exception
|
|
|
|
Try
|
|
With This As c_foxbin2prg Of 'FOXBIN2PRG.PRG'
|
|
loLang = _Screen.o_FoxBin2Prg_Lang
|
|
lcFileSpec = Fullpath( tc_InputFile )
|
|
|
|
If .n_ShowProgressbar <> 0 And .l_ProcessFiles Then
|
|
.loadProgressbarForm()
|
|
.o_Frm_Avance.Caption = Strtran( .o_Frm_Avance.Caption, '> -', '(Txt>Bin) -' )
|
|
Endif
|
|
|
|
If Empty(tcLogFile)
|
|
.c_LogFile = Addbs( Justpath( lcFileSpec ) ) + Strtran( Justfname( lcFileSpec ), '*', '_ALL' ) + '.LOG'
|
|
|
|
If .n_Debug > 0 Then
|
|
Erase ( .c_LogFile )
|
|
Endif
|
|
Endif
|
|
|
|
.writeLog( '> ' + loLang.C_CONVERT_ALL_FILES_IN_A_PROJECT_LOC + ': ' + loLang.C_TEXT_TO_BINARY_LOC )
|
|
|
|
Do Case
|
|
Case .l_Recompile And Len(tcRecompile) > 3 And Directory(tcRecompile)
|
|
Cd (tcRecompile)
|
|
Case tcRecompile == '1'
|
|
Cd (Justpath(lcFileSpec))
|
|
Endcase
|
|
|
|
lnFileCount = Alines( laFiles, Strextract( Filetostr(tc_InputFile), C_BUILDPROJ_I, C_BUILDPROJ_F ), 1+4 )
|
|
|
|
For I = lnFileCount To 1 Step -1
|
|
If '.ADD(' $ laFiles(m.I)
|
|
lcFile = .get_AbsolutePath( Strextract( laFiles(m.I), ".ADD('", "')" ), Addbs( Justpath( lcFileSpec ) ) )
|
|
laFiles(m.I) = Forceext( lcFile, .get_Ext2FromExt( Upper(Justext(lcFile)) ) )
|
|
Else
|
|
lnFileCount = lnFileCount - 1
|
|
Adel( laFiles, m.I )
|
|
Dimension laFiles(lnFileCount)
|
|
Endif
|
|
Endfor
|
|
|
|
*-- Convierto primero el proyecto
|
|
If tcType <> '*-' Then
|
|
lcFile = tc_InputFile
|
|
lnCodError = .convert( lcFile, toModulo, @toEx, .T., tcOriginalFileName )
|
|
.writeLog_Flush()
|
|
Endif
|
|
|
|
*-- Luego convierto los archivos incluidos
|
|
For I = 1 To lnFileCount
|
|
lcFile = laFiles(m.I)
|
|
.updateProgressbar( loLang.C_PROCESSING_LOC + ' ' + lcFile + '...', m.I, lnFileCount, 0 )
|
|
|
|
If .hasSupport_Prg2Bin( Upper(Justext(lcFile)) ) And Adir( laDirInfo, lcFile ) > 0 Then
|
|
lnCodError = .convert( lcFile, toModulo, @toEx, .F., tcOriginalFileName )
|
|
.writeLog_Flush()
|
|
|
|
Do Case
|
|
Case lnCodError = 1799 && Conversion Cancelled
|
|
Error 1799
|
|
|
|
Case lnCodError > 0
|
|
.doWriteErrorLog( @toEx )
|
|
llError = .T.
|
|
.l_Error = .F.
|
|
Endcase
|
|
Else
|
|
*-- addProcessedFile( tcFile, tcInOutType, tcProcessed, tcHasErrors, tcSupported, tcExpanded )
|
|
If .addProcessedFile( lcFile, 'I', 'P0', 'E0', 'S0', 'X0' )
|
|
.updateProcessedFile()
|
|
Endif
|
|
Endif
|
|
|
|
.writeLog_Flush()
|
|
|
|
If llError
|
|
.l_Error = .T.
|
|
Endif
|
|
Endfor
|
|
Endwith
|
|
|
|
Catch To loEx
|
|
Throw
|
|
|
|
Finally
|
|
Store Null To loLang
|
|
Release loLang
|
|
Endtry
|
|
Endproc
|
|
|
|
|
|
Hidden Procedure doWriteErrorLog
|
|
Lparameters toEx As Exception, tcErrorInfo
|
|
|
|
Local loLang As CL_LANG Of 'FOXBIN2PRG.PRG'
|
|
loLang = _Screen.o_FoxBin2Prg_Lang
|
|
|
|
With This As c_foxbin2prg Of 'FOXBIN2PRG.PRG'
|
|
If toEx.ErrorNo = 1799 Then && Conversion Cancelled
|
|
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 ;
|
|
, loDBF_CFG As CL_DBF_CFG Of 'FOXBIN2PRG.PRG'
|
|
lnCodError = 0
|
|
|
|
With This As c_foxbin2prg Of 'FOXBIN2PRG.PRG'
|
|
loFSO = .o_FSO
|
|
loLang = _Screen.o_FoxBin2Prg_Lang
|
|
lcForceAttribs = '+N'
|
|
.c_InputFile = Fullpath( tc_InputFile )
|
|
.l_Error = .F.
|
|
lcExtension = Upper( Justext(.c_InputFile) )
|
|
|
|
.writeLog( Replicate( '*', 100 ) )
|
|
.writeLog( 'CONVERSION PROCESS', 2 )
|
|
.writeLog( Replicate( '*', 100 ) )
|
|
|
|
If Adir( laDirFile, .c_InputFile, '', 1 ) = 0
|
|
*ERROR 'No se encontró el archivo [' + .c_InputFile + ']'
|
|
Error loLang.C_FILE_NOT_FOUND_LOC + ' [' + .c_InputFile + ']'
|
|
Endif
|
|
|
|
.c_InputFile = loFSO.GetAbsolutePathName( Forcepath( laDirFile(1,1), Justpath(.c_InputFile) ) )
|
|
|
|
*-- VERIFICO SI HAY ARCHIVO DE CONFIGURACIÓN SECUNDARIO
|
|
.evaluateConfiguration()
|
|
|
|
If .n_ForceWriteIfReadOnly = 1 Then
|
|
lcForceAttribs = lcForceAttribs + '-R'
|
|
Endif
|
|
|
|
*!* Changed by: Lutz Scheffler 03.03.2021
|
|
*!* change date="{^2021-03-03,11:38:00}"
|
|
* Added option for DBC split
|
|
|
|
*-- OPTIMIZACIÓN VC2/SC2: VERIFICO SI EL ARCHIVO BASE FUE PROCESADO PARA DESCARTAR REPROCESOS
|
|
If Inlist(lcExtension,"SCX","VCX",.c_VC2,.c_SC2);
|
|
AND (.n_UseClassPerFile > 0 And .l_RedirectClassPerFileToMain ;
|
|
OR Not Empty(.c_ClassToConvert))
|
|
|
|
Do Case
|
|
|
|
Case .n_RedirectClassType = 1 Or Not Empty(.c_ClassToConvert) && Redireccionar solo esta clase
|
|
If Occurs('.', Juststem(.c_InputFile)) = 0 Then
|
|
lc_BaseFile = .c_InputFile
|
|
Else
|
|
lc_BaseFile = Forcepath( Forceext( Juststem( Juststem(.c_InputFile) ), Justext(.c_InputFile)) , Justpath(.c_InputFile) )
|
|
Endif
|
|
|
|
Case .n_UseClassPerFile = 1 And Inlist(lcExtension,.c_VC2,.c_SC2)
|
|
If Occurs('.', Juststem(.c_InputFile)) = 0 Then
|
|
lc_BaseFile = .c_InputFile
|
|
Else
|
|
lc_BaseFile = Forcepath( Forceext( Juststem( Juststem(.c_InputFile) ), Justext(.c_InputFile)) , Justpath(.c_InputFile) )
|
|
Endif
|
|
|
|
*-- Verifico si se debe forzar la redirección al archivo principal
|
|
If '.' $ Juststem(.c_InputFile)
|
|
.c_InputFile = lc_BaseFile
|
|
Endif
|
|
** SF, Problem, Fehler: DC2 hier nicht, das muss anders mit UseFilesPerDBC
|
|
Case .n_UseClassPerFile = 2 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( 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
|
|
|
|
*****************************
|
|
|
|
*-- OPTIMIZACIÓN DC2: VERIFICO SI EL ARCHIVO BASE FUE PROCESADO PARA DESCARTAR REPROCESOS
|
|
If Inlist(lcExtension,"DBC",.c_DC2);
|
|
AND .n_UseFilesPerDBC > 0 And .l_RedirectFilePerDBCToMain;
|
|
AND .n_UseFilesPerDBC = 1
|
|
|
|
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
|
|
|
|
Endif
|
|
|
|
*!* /Changed by: Lutz Scheffler 03.03.2021
|
|
|
|
Erase ( .c_InputFile + '.ERR' )
|
|
|
|
If Not Empty(tcOriginalFileName)
|
|
tcOriginalFileName = loFSO.GetAbsolutePathName( tcOriginalFileName )
|
|
Endif
|
|
|
|
.c_OriginalFileName = Evl( tcOriginalFileName, .c_InputFile )
|
|
|
|
If Upper( Justext(.c_OriginalFileName) ) = 'PJM' And .c_PJ2 <> 'PJM'
|
|
.c_OriginalFileName = Forceext(.c_OriginalFileName,'pjx')
|
|
Endif
|
|
|
|
*-- addProcessedFile( tcFile, tcInOutType, tcProcessed, tcHasErrors, tcSupported, tcExpanded )
|
|
If Not .addProcessedFile( .c_InputFile, 'I', 'P1', 'E0', 'S1', 'X0' ) Then
|
|
*.writeLog( 'OPTIMIZACIÓN: El archivo Base [' + JUSTFNAME(lc_BaseFile) + '] ya fue procesado, por lo que no se procesará [' + JUSTFNAME(.c_InputFile) + ']' )
|
|
.writeLog( C_TAB + C_TAB + '* ' + Textmerge( loLang.C_CLASSPERFILE_OPTIMIZATION_BASE_ALREADY_PROCESSED_LOC ) )
|
|
Exit
|
|
Endif
|
|
|
|
*.updateProcessedFile()
|
|
lnIDInputFile = .n_ProcessedFiles
|
|
|
|
.writeLog( C_TAB + 'c_OriginalFileName: ' + .c_OriginalFileName )
|
|
.writeLog( )
|
|
|
|
If Not Adir(laDirFile, .c_InputFile) > 0 Then
|
|
Error loLang.C_FILE_DOESNT_EXIST_LOC + ' [' + .c_InputFile + ']'
|
|
Endif
|
|
|
|
.normalizeFileCapitalization( .T. )
|
|
|
|
Do Case
|
|
Case lcExtension = 'VCX'
|
|
If Not Inlist(.VCX_Conversion_Support, 1, 2)
|
|
Error (Textmerge(loLang.C_FILE_NAME_IS_NOT_SUPPORTED_LOC))
|
|
Endif
|
|
.c_OutputFile = Forceext( .c_InputFile, .c_VC2 )
|
|
loConversor = Createobject( 'c_conversor_vcx_a_prg' )
|
|
.changeFileAttribute( Forceext( .c_InputFile, .c_VC2 ), lcForceAttribs )
|
|
|
|
Case lcExtension = 'SCX'
|
|
If Not Inlist(.SCX_Conversion_Support, 1, 2)
|
|
Error (Textmerge(loLang.C_FILE_NAME_IS_NOT_SUPPORTED_LOC))
|
|
Endif
|
|
.c_OutputFile = Forceext( .c_InputFile, .c_SC2 )
|
|
loConversor = Createobject( 'c_conversor_scx_a_prg' )
|
|
.changeFileAttribute( Forceext( .c_InputFile, .c_SC2 ), lcForceAttribs )
|
|
|
|
Case lcExtension = 'PJX'
|
|
If Not Inlist(.PJX_Conversion_Support, 1, 2)
|
|
Error (Textmerge(loLang.C_FILE_NAME_IS_NOT_SUPPORTED_LOC))
|
|
Endif
|
|
.c_OutputFile = Forceext( .c_InputFile, .c_PJ2 )
|
|
loConversor = Createobject( 'c_conversor_pjx_a_prg' )
|
|
.changeFileAttribute( Forceext( .c_InputFile, .c_PJ2 ), lcForceAttribs )
|
|
|
|
Case lcExtension = 'PJM' And .c_PJ2 <> 'PJM'
|
|
If Not Inlist(.PJX_Conversion_Support, 1, 2)
|
|
Error (Textmerge(loLang.C_FILE_NAME_IS_NOT_SUPPORTED_LOC))
|
|
Endif
|
|
.c_OutputFile = Forceext( .c_InputFile, .c_PJ2 )
|
|
loConversor = Createobject( 'c_conversor_pjm_a_prg' )
|
|
.changeFileAttribute( Forceext( .c_InputFile, .c_PJ2 ), lcForceAttribs )
|
|
|
|
Case lcExtension = 'FRX'
|
|
If Not Inlist(.FRX_Conversion_Support, 1, 2)
|
|
Error (Textmerge(loLang.C_FILE_NAME_IS_NOT_SUPPORTED_LOC))
|
|
Endif
|
|
.c_OutputFile = Forceext( .c_InputFile, .c_FR2 )
|
|
loConversor = Createobject( 'c_conversor_frx_a_prg' )
|
|
.changeFileAttribute( Forceext( .c_InputFile, .c_FR2 ), lcForceAttribs )
|
|
|
|
Case lcExtension = 'LBX'
|
|
If Not Inlist(.LBX_Conversion_Support, 1, 2)
|
|
Error (Textmerge(loLang.C_FILE_NAME_IS_NOT_SUPPORTED_LOC))
|
|
Endif
|
|
.c_OutputFile = Forceext( .c_InputFile, .c_LB2 )
|
|
loConversor = Createobject( 'c_conversor_frx_a_prg' )
|
|
.changeFileAttribute( Forceext( .c_InputFile, .c_LB2 ), lcForceAttribs )
|
|
|
|
Case lcExtension = 'DBF'
|
|
lnFileCount = .get_DBF_Configuration( Forceext(.c_InputFile, 'DBF'), @loDBF_CFG )
|
|
If Not Inlist(.DBF_Conversion_Support, 1, 2, 4, 8)
|
|
Error (Textmerge(loLang.C_FILE_NAME_IS_NOT_SUPPORTED_LOC))
|
|
Endif
|
|
.c_OutputFile = Forceext( .c_InputFile, .c_DB2 )
|
|
loConversor = Createobject( 'c_conversor_dbf_a_prg' )
|
|
.changeFileAttribute( Forceext( .c_InputFile, .c_DB2 ), lcForceAttribs )
|
|
|
|
Case lcExtension = 'DBC'
|
|
If Not Inlist(.DBC_Conversion_Support, 1, 2)
|
|
Error (Textmerge(loLang.C_FILE_NAME_IS_NOT_SUPPORTED_LOC))
|
|
Endif
|
|
.c_OutputFile = Forceext( .c_InputFile, .c_DC2 )
|
|
loConversor = Createobject( 'c_conversor_dbc_a_prg' )
|
|
.changeFileAttribute( Forceext( .c_InputFile, .c_DC2 ), lcForceAttribs )
|
|
|
|
Case lcExtension = 'MNX'
|
|
If Not Inlist(.MNX_Conversion_Support, 1, 2)
|
|
Error (Textmerge(loLang.C_FILE_NAME_IS_NOT_SUPPORTED_LOC))
|
|
Endif
|
|
.c_OutputFile = Forceext( .c_InputFile, .c_MN2 )
|
|
loConversor = Createobject( 'c_conversor_mnx_a_prg' )
|
|
.changeFileAttribute( Forceext( .c_InputFile, .c_MN2 ), lcForceAttribs )
|
|
|
|
Case lcExtension = 'FKY'
|
|
If Not Inlist(.FKY_Conversion_Support, 1, 2)
|
|
Error (Textmerge(loLang.C_FILE_NAME_IS_NOT_SUPPORTED_LOC))
|
|
Endif
|
|
.c_OutputFile = Forceext( .c_InputFile, .c_FK2 )
|
|
loConversor = Createobject( 'c_conversor_fky_a_prg' )
|
|
.changeFileAttribute( Forceext( .c_InputFile, .c_FK2 ), lcForceAttribs )
|
|
|
|
Case lcExtension = 'MEM'
|
|
If Not Inlist(.MEM_Conversion_Support, 1, 2)
|
|
Error (Textmerge(loLang.C_FILE_NAME_IS_NOT_SUPPORTED_LOC))
|
|
Endif
|
|
.c_OutputFile = Forceext( .c_InputFile, .c_ME2 )
|
|
loConversor = Createobject( 'c_conversor_mem_a_prg' )
|
|
.changeFileAttribute( Forceext( .c_InputFile, .c_ME2 ), lcForceAttribs )
|
|
|
|
Case lcExtension = .c_VC2
|
|
If .VCX_Conversion_Support <> 2
|
|
Error (Textmerge(loLang.C_FILE_NAME_IS_NOT_SUPPORTED_LOC))
|
|
Endif
|
|
If Empty(.c_ClassToConvert)
|
|
.c_OutputFile = Forceext( .c_InputFile, 'VCX' )
|
|
Else
|
|
* Si se usó la sintaxis "classlib.vcx::clase::import", se define el OutputFile
|
|
* con la Base "classlib.vcx" y no con el archivo entero.
|
|
.c_OutputFile = Forceext( lc_BaseFile, 'VCX' )
|
|
Endif
|
|
loConversor = Createobject( 'c_conversor_prg_a_vcx' )
|
|
.changeFileAttribute( Forceext( .c_InputFile, 'VCX' ), lcForceAttribs )
|
|
.changeFileAttribute( Forceext( .c_InputFile, 'VCT' ), lcForceAttribs )
|
|
|
|
Case lcExtension = .c_SC2
|
|
If .SCX_Conversion_Support <> 2
|
|
Error (Textmerge(loLang.C_FILE_NAME_IS_NOT_SUPPORTED_LOC))
|
|
Endif
|
|
.c_OutputFile = Forceext( .c_InputFile, 'SCX' )
|
|
loConversor = Createobject( 'c_conversor_prg_a_scx' )
|
|
.changeFileAttribute( Forceext( .c_InputFile, 'SCX' ), lcForceAttribs )
|
|
.changeFileAttribute( Forceext( .c_InputFile, 'SCT' ), lcForceAttribs )
|
|
|
|
Case lcExtension = .c_PJ2
|
|
If .PJX_Conversion_Support <> 2
|
|
Error (Textmerge(loLang.C_FILE_NAME_IS_NOT_SUPPORTED_LOC))
|
|
Endif
|
|
.c_OutputFile = Forceext( .c_InputFile, 'PJX' )
|
|
loConversor = Createobject( 'c_conversor_prg_a_pjx' )
|
|
.changeFileAttribute( Forceext( .c_InputFile, 'PJX' ), lcForceAttribs )
|
|
.changeFileAttribute( Forceext( .c_InputFile, 'PJT' ), lcForceAttribs )
|
|
|
|
Case lcExtension = .c_FR2
|
|
If .FRX_Conversion_Support <> 2
|
|
Error (Textmerge(loLang.C_FILE_NAME_IS_NOT_SUPPORTED_LOC))
|
|
Endif
|
|
.c_OutputFile = Forceext( .c_InputFile, 'FRX' )
|
|
loConversor = Createobject( 'c_conversor_prg_a_frx' )
|
|
.changeFileAttribute( Forceext( .c_InputFile, 'FRX' ), lcForceAttribs )
|
|
.changeFileAttribute( Forceext( .c_InputFile, 'FRT' ), lcForceAttribs )
|
|
|
|
Case lcExtension = .c_LB2
|
|
If .LBX_Conversion_Support <> 2
|
|
Error (Textmerge(loLang.C_FILE_NAME_IS_NOT_SUPPORTED_LOC))
|
|
Endif
|
|
.c_OutputFile = Forceext( .c_InputFile, 'LBX' )
|
|
loConversor = Createobject( 'c_conversor_prg_a_frx' )
|
|
.changeFileAttribute( Forceext( .c_InputFile, 'LBX' ), lcForceAttribs )
|
|
.changeFileAttribute( Forceext( .c_InputFile, 'LBT' ), lcForceAttribs )
|
|
|
|
Case lcExtension = .c_DB2
|
|
If Inlist(.DBF_Conversion_Support, 2, 8) Or Adir(laDirFile, Forceext(.c_InputFile, 'DBF') + '.CFG') = 1 Then
|
|
*-- Soporte txt-2-bin habilitado
|
|
Else
|
|
Error (Textmerge(loLang.C_FILE_NAME_IS_NOT_SUPPORTED_LOC))
|
|
Endif
|
|
.c_OutputFile = Forceext( .c_InputFile, 'DBF' )
|
|
loConversor = Createobject( 'c_conversor_prg_a_dbf' )
|
|
.changeFileAttribute( Forceext( .c_InputFile, 'DBF' ), lcForceAttribs )
|
|
.changeFileAttribute( Forceext( .c_InputFile, 'FPT' ), lcForceAttribs )
|
|
.changeFileAttribute( Forceext( .c_InputFile, 'CDX' ), lcForceAttribs )
|
|
|
|
Case lcExtension = .c_DC2
|
|
If .DBC_Conversion_Support <> 2
|
|
Error (Textmerge(loLang.C_FILE_NAME_IS_NOT_SUPPORTED_LOC))
|
|
Endif
|
|
.c_OutputFile = Forceext( .c_InputFile, 'DBC' )
|
|
loConversor = Createobject( 'c_conversor_prg_a_dbc' )
|
|
.changeFileAttribute( Forceext( .c_InputFile, 'DBC' ), lcForceAttribs )
|
|
.changeFileAttribute( Forceext( .c_InputFile, 'DCX' ), lcForceAttribs )
|
|
.changeFileAttribute( Forceext( .c_InputFile, 'DCT' ), lcForceAttribs )
|
|
|
|
Case lcExtension = .c_MN2
|
|
If .MNX_Conversion_Support <> 2
|
|
Error (Textmerge(loLang.C_FILE_NAME_IS_NOT_SUPPORTED_LOC))
|
|
Endif
|
|
.c_OutputFile = Forceext( .c_InputFile, 'MNX' )
|
|
loConversor = Createobject( 'c_conversor_prg_a_mnx' )
|
|
.changeFileAttribute( Forceext( .c_InputFile, 'MNX' ), lcForceAttribs )
|
|
.changeFileAttribute( Forceext( .c_InputFile, 'MNT' ), lcForceAttribs )
|
|
|
|
Case lcExtension = .c_FK2
|
|
If .FKY_Conversion_Support <> 2
|
|
Error (Textmerge(loLang.C_FILE_NAME_IS_NOT_SUPPORTED_LOC))
|
|
Endif
|
|
.c_OutputFile = Forceext( .c_InputFile, 'FKY' )
|
|
loConversor = Createobject( 'c_conversor_prg_a_fky' )
|
|
.changeFileAttribute( Forceext( .c_InputFile, 'FKY' ), lcForceAttribs )
|
|
|
|
Case lcExtension = .c_ME2
|
|
If .MEM_Conversion_Support <> 2
|
|
Error (Textmerge(loLang.C_FILE_NAME_IS_NOT_SUPPORTED_LOC))
|
|
Endif
|
|
.c_OutputFile = Forceext( .c_InputFile, 'MEM' )
|
|
loConversor = Createobject( 'c_conversor_prg_a_mem' )
|
|
.changeFileAttribute( Forceext( .c_InputFile, 'MEM' ), lcForceAttribs )
|
|
|
|
Otherwise
|
|
*ERROR 'El archivo [' + .c_InputFile + '] no está soportado'
|
|
Error (Textmerge(loLang.C_FILE_NAME_IS_NOT_SUPPORTED_LOC))
|
|
|
|
Endcase
|
|
|
|
*-- Optimización: Comparación de los timestamps de InputFile y OutputFile para saber
|
|
*-- si el OutputFile se debe regenerar o no.
|
|
lnFileCount = Adir( laFiles, Forceext( .c_InputFile, '*' ), '', 1 )
|
|
Store {//::} To .t_InputFile_TimeStamp, .t_OutputFile_TimeStamp, ltFilestamp
|
|
|
|
If lnFileCount > 0 Then
|
|
*-- Busca el archivo de entrada original
|
|
I = Ascan( laFiles, Justfname(.c_InputFile), 1, 0, 1, 1+2+4+8 )
|
|
If m.I > 0 Then
|
|
.t_InputFile_TimeStamp = Datetime( Year(laFiles(m.I,3)), Month(laFiles(m.I,3)), Day(laFiles(m.I,3)) ;
|
|
, Val(Left(laFiles(m.I,4),2)), Val(Substr(laFiles(m.I,4),4,2)), Val(Right(laFiles(m.I,4),2)) )
|
|
Endif
|
|
|
|
If Adir( laDirFile, .c_OutputFile ) > 0 Then
|
|
I = Ascan( laFiles, Justfname(.c_OutputFile), 1, 0, 1, 1+2+4+8 )
|
|
If m.I > 0 Then
|
|
.t_OutputFile_TimeStamp = Datetime( Year(laFiles(m.I,3)), Month(laFiles(m.I,3)), Day(laFiles(m.I,3)) ;
|
|
, Val(Left(laFiles(m.I,4),2)), Val(Substr(laFiles(m.I,4),4,2)), Val(Right(laFiles(m.I,4),2)) )
|
|
Endif
|
|
|
|
lcExtA = Upper(Justext(.c_OutputFile))
|
|
|
|
Do Case
|
|
Case Inlist(lcExtA, 'SCX', 'VCX', 'MNX', 'FRX', 'LBX')
|
|
lcExtB = Icase(lcExtA = 'SCX', 'SCT' ;
|
|
, lcExtA = 'VCX', 'VCT' ;
|
|
, lcExtA = 'MNX', 'MNT' ;
|
|
, lcExtA = 'FRX', 'FRT' ;
|
|
, lcExtA = 'LBX', 'LBT')
|
|
I = Ascan( laFiles, Justfname( Forceext(.c_OutputFile, lcExtB) ), 1, 0, 1, 1+2+4+8 )
|
|
If m.I > 0 Then
|
|
ltFilestamp = Datetime( Year(laFiles(m.I,3)), Month(laFiles(m.I,3)), Day(laFiles(m.I,3)) ;
|
|
, Val(Left(laFiles(m.I,4),2)), Val(Substr(laFiles(m.I,4),4,2)), Val(Right(laFiles(m.I,4),2)) )
|
|
Endif
|
|
|
|
Endcase
|
|
|
|
*-- Tomo el máximo timestamp de los archivos de salida (??X/??T)
|
|
.t_OutputFile_TimeStamp = Max( .t_OutputFile_TimeStamp, ltFilestamp )
|
|
Endif
|
|
Endif
|
|
|
|
Do Case
|
|
Case .n_UseClassPerFile = 0 And .n_OptimizeByFilestamp = 1 And .t_InputFile_TimeStamp < .t_OutputFile_TimeStamp
|
|
*-- Optimizado: El Origen es anterior al Destino - No hace falta regenerar
|
|
*.writeLog( '> El archivo de salida [<<THIS.c_OutputFile>>] 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 [<<THIS.c_OutputFile>>] no se regenera porque su timestamp es igual que el de entrada.' )
|
|
.writeLog( C_TAB + C_TAB + '* ' + Textmerge(loLang.C_OUTPUTFILE_TIMESTAMP_EQUAL_THAN_INPUTFILE_TIMESTAMP_LOC) )
|
|
|
|
Otherwise
|
|
.c_Type = Upper(Justext(.c_OutputFile))
|
|
loConversor.c_InputFile = .c_InputFile
|
|
loConversor.c_OutputFile = .c_OutputFile
|
|
loConversor.c_LogFile = .c_LogFile
|
|
loConversor.n_Debug = .n_Debug
|
|
loConversor.l_Test = .l_Test
|
|
loConversor.n_FB2PRG_Version = .n_FB2PRG_Version
|
|
loConversor.l_MethodSort_Enabled = .l_MethodSort_Enabled
|
|
loConversor.l_PropSort_Enabled = .l_PropSort_Enabled
|
|
loConversor.l_ReportSort_Enabled = .l_ReportSort_Enabled
|
|
loConversor.c_OriginalFileName = .c_OriginalFileName
|
|
loConversor.c_Foxbin2prg_FullPath = .c_Foxbin2prg_FullPath
|
|
*--
|
|
.updateProgressbar( loLang.C_PROCESSING_LOC + ' ' + .c_InputFile + '...', 0, 0, 0 )
|
|
|
|
If Aevents( laEvents, loConversor ) = 0 Then
|
|
Bindevent( loConversor, 'updateProgressbar', This, 'updateProgressbar' )
|
|
Endif
|
|
|
|
loConversor.convert( @toModulo, .F., This )
|
|
|
|
If loConversor.l_Error Then
|
|
.l_Error = .T.
|
|
Endif
|
|
|
|
.n_ProcessedFilesCount = .n_ProcessedFilesCount + 1
|
|
.writeLog()
|
|
.writeLog(loConversor.c_TextLog) && Recojo el LOG que haya generado el conversor
|
|
|
|
*-- Logueo los errores
|
|
If Not Empty(loConversor.c_TextErr) Then
|
|
.writeErrorLog( Replicate( '-', 100 ), 1 )
|
|
.writeErrorLog( loLang.C_ERRORS_FOUND_IN_FILE_LOC + ' [' + .c_InputFile + '] ' )
|
|
.writeErrorLog( loConversor.c_TextErr )
|
|
.writeErrorLog( )
|
|
Endif
|
|
Endcase
|
|
|
|
.normalizeFileCapitalization()
|
|
Endwith && THIS AS c_foxbin2prg OF 'FOXBIN2PRG.PRG'
|
|
|
|
Catch To toEx
|
|
lnCodError = toEx.ErrorNo
|
|
*lcErrorInfo = THIS.exception2Str(toEx) + CR_LF + CR_LF + loLang.C_SOURCEFILE_LOC + THIS.c_InputFile
|
|
|
|
*-- updateProcessedFile( tcProcessed, tcHasErrors, tcSupported, tcReserved )
|
|
This.updateProcessedFile( lnIDInputFile, '', '', 'E1' )
|
|
|
|
If This.n_Debug > 0 Then
|
|
If _vfp.StartMode = 0
|
|
Set Step On
|
|
Endif
|
|
Endif
|
|
If tlRelanzarError && Usado en Unit Testing
|
|
Throw
|
|
Endif
|
|
|
|
Finally
|
|
If Aevents( laEvents, loConversor ) > 0 Then
|
|
Unbindevents( loConversor )
|
|
Endif
|
|
|
|
Store Null To loConversor, loFSO
|
|
|
|
If lnCodError = 0 And This.l_Error Then
|
|
This.updateProcessedFile( lnIDInputFile, '', '', 'E1' )
|
|
Else
|
|
*THIS.updateProcessedFile( lnIDInputFile )
|
|
Endif
|
|
|
|
Release lcErrorInfo, laDirFile, lcExtension, lnFileCount, laFiles, I ;
|
|
, ltFilestamp, lcExtA, lcExtB ;
|
|
, loConversor, loFSO
|
|
Endtry
|
|
|
|
Return lnCodError
|
|
Endproc
|
|
|
|
|
|
Procedure get_DirSettings
|
|
*---------------------------------------------------------------------------------------------------
|
|
* PARÁMETROS: (v=Pasar por valor | @=Pasar por referencia) (!=Obligatorio | ?=Opcional) (IN/OUT)
|
|
* tcDir (@? IN ) Directorio del que devolver su configuración
|
|
* RETORNO (@? OUT) Objeto CFG
|
|
*---------------------------------------------------------------------------------------------------
|
|
Lparameters tcDir
|
|
|
|
If Not Empty(tcDir)
|
|
This.evaluateConfiguration( '', '', '', '', '', '', '', '', tcDir, 'D' )
|
|
Endif
|
|
|
|
If This.n_CFG_Actual = 0 Then
|
|
loCFG = Null
|
|
Else
|
|
loCFG = This.o_Configuration(This.n_CFG_Actual)
|
|
Endif
|
|
|
|
If Isnull(loCFG) Then
|
|
loCFG = Createobject('CL_CFG')
|
|
loCFG.CopyFrom(This)
|
|
Endif
|
|
|
|
Return loCFG
|
|
Endproc
|
|
|
|
|
|
Procedure get_PROGRAM_HEADER
|
|
Local lcText
|
|
lcText = ''
|
|
|
|
*-- Cabecera del PRG e inicio de DEF_CLASS
|
|
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!!
|
|
*--------------------------------------------------------------------------------------------------------------------------------------------------------
|
|
<<C_FB2PRG_META_I>> Version="<<TRANSFORM(THIS.n_FB2PRG_Version)>>" SourceFile="<<LOWER( JUSTFNAME( EVL( THIS.c_OriginalFileName, THIS.c_InputFile ) ) )>>" <<C_FB2PRG_META_F>> (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, laDirInfo(1,5)
|
|
lcNext_Bak = '.BAK'
|
|
|
|
For I = 1 To This.n_ExtraBackupLevels
|
|
If m.I = 1
|
|
If Not Adir( laDirInfo, tcOutputFileName + '.BAK' ) > 0 Then
|
|
lcNext_Bak = '.BAK'
|
|
Exit
|
|
Endif
|
|
Else
|
|
If Not Adir( laDirInfo, tcOutputFileName + '.' + Padl(m.I-1,1,'0') + '.BAK' ) > 0 Then
|
|
lcNext_Bak = '.' + Padl(m.I-1,1,'0') + '.BAK'
|
|
Exit
|
|
Endif
|
|
Endif
|
|
Endfor
|
|
|
|
Return lcNext_Bak
|
|
Endproc
|
|
|
|
|
|
Procedure get_SeparatedLineAndComment
|
|
*---------------------------------------------------------------------------------------------------
|
|
* PARÁMETROS: (v=Pasar por valor | @=Pasar por referencia) (!=Obligatorio | ?=Opcional) (IN/OUT)
|
|
* tcLine (!@ IN/OUT) Línea a separar del comentario
|
|
* tcComment (@? OUT) Comentario
|
|
* tlDeepCommentAnalysis (v? IN ) Indica realizar un análisis profundo de comentarios (para detectar casos complejos de código con '&&' embebido)
|
|
*---------------------------------------------------------------------------------------------------
|
|
Lparameters tcLine As String, tcComment As String, tlDeepCommentAnalysis As Boolean
|
|
Local ln_AT_Cmt
|
|
tcComment = ''
|
|
ln_AT_Cmt = At( '&'+'&', tcLine)
|
|
|
|
If ln_AT_Cmt > 0
|
|
If tlDeepCommentAnalysis Then
|
|
Local laSeparador(3,3), lcSeparadoresIzq, lcSeparadoresDer, lcStr, lnAT_Amp, lnAT1, lnAT2, lnLen, I, X
|
|
|
|
lcStr = tcLine &&EVL(tcStr, [DEFINE BAR 2 OF OpciónAsub PROMPT "Opción A&]+[&2" &]+[& Comentario Opción A-2])
|
|
laSeparador(1,1) = '"'
|
|
laSeparador(1,2) = '"'
|
|
laSeparador(1,3) = 2
|
|
laSeparador(2,1) = "'"
|
|
laSeparador(2,2) = "'"
|
|
laSeparador(2,3) = 2
|
|
laSeparador(3,1) = '['
|
|
laSeparador(3,2) = ']'
|
|
laSeparador(3,3) = 1
|
|
lcSeparadoresIzq = laSeparador(1,1) + laSeparador(2,1) + laSeparador(3,1)
|
|
lcSeparadoresDer = laSeparador(1,2) + laSeparador(2,2) + laSeparador(3,2)
|
|
lnLen = Len(lcStr)
|
|
|
|
*-- Anular subcadenas para luego encontrar comentarios '&&' (y analizar solo si existe al menos un '&&')
|
|
X = 1
|
|
lnAT1 = At(laSeparador(m.X,1), lcStr)
|
|
|
|
*-- Funcionamiento:
|
|
*-- La anulación de subcadenas se hace comenzando desde la primer comilla doble ["], y luego se va
|
|
*-- cancelando hasta la siguiente. A partir de ahi, se busca carácter a carácter el siguiente separador
|
|
*-- izquierdo de cadena ( '"[ ), se busca su pareja derecha y se cancela el texto entre ambos.
|
|
*-- La anulación de subcadenas es temporal, solo para determinar la verdadera posición del comentario,
|
|
*-- por ejemplo, esto:
|
|
*-- DEFINE BAR 2 OF OpciónAsub PROMPT ""+var+'aa'+["bb]+"Opción A&&2" && Comentario Opción A-2
|
|
*-- se convierte temporalmente en esto:
|
|
*-- DEFINE BAR 2 OF OpciónAsub PROMPT XX+var+XXXX+XXXXX+XXXXXXXXXXXXX && Comentario Opción A-2
|
|
*-- lo que facilita encontrar el comentario '&&' real.
|
|
*-- Si se encuentra algún separador de cadena que no cierre, se genera un error 10 (Syntax Error).
|
|
If lnAT1 > 0 Then
|
|
For I = lnAT1+1 To lnLen
|
|
If m.X > 0 Then
|
|
lnAT2 = At(laSeparador(m.X,2), lcStr, laSeparador(m.X,3))
|
|
|
|
If lnAT2 > 0 Then
|
|
lcStr = Stuff(lcStr, lnAT1, lnAT2-lnAT1+1, Replicate('X',lnAT2-lnAT1+1))
|
|
Else
|
|
ln_AT_Cmt = At( '&'+'&', lcStr)
|
|
|
|
If ln_AT_Cmt = 0 Or ln_AT_Cmt < lnAT1
|
|
*-- No tiene comentario '&&' real, o sí lo tiene y además contiene un delimitador de cadena como parte del comentario
|
|
Exit
|
|
Else
|
|
Error 'Closing string delimiter <' + laSeparador(m.X,2) + '> not found: ' + tcLine
|
|
Endif
|
|
Endif
|
|
Endif
|
|
|
|
*-- Verifico si el carácter es un separador de cadenas: '"[
|
|
X = At( Substr(lcStr, m.I, 1), lcSeparadoresIzq)
|
|
|
|
If m.X > 0 Then
|
|
lnAT1 = At(laSeparador(m.X,1), lcStr)
|
|
Endif
|
|
Endfor
|
|
Endif
|
|
|
|
ln_AT_Cmt = At( '&'+'&', lcStr)
|
|
Endif && tlDeepCommentAnalysis
|
|
|
|
If ln_AT_Cmt > 0
|
|
tcComment = Ltrim( Substr( tcLine, ln_AT_Cmt + 2 ) )
|
|
tcLine = Rtrim( Left( tcLine, ln_AT_Cmt - 1 ), 0, Chr(9), ' ' ) && Quito TABS y espacios
|
|
Endif
|
|
|
|
Endif
|
|
|
|
Return (ln_AT_Cmt > 0)
|
|
Endproc
|
|
|
|
|
|
Procedure normalizeFileCapitalization
|
|
Lparameters tl_NormalizeInputFile, tcFileName
|
|
|
|
Try
|
|
Local lcPath, lcEXE_CAPS, lcOutputFile, llRelanzarError, lcType, laDirInfo(1,5) ;
|
|
, loEx As Exception ;
|
|
, loLang As CL_LANG Of 'FOXBIN2PRG.PRG' ;
|
|
, loFSO As Scripting.FileSystemObject
|
|
|
|
With This As c_foxbin2prg Of 'FOXBIN2PRG.PRG'
|
|
If Not .l_ProcessFiles
|
|
Exit
|
|
Endif
|
|
|
|
loLang = _Screen.o_FoxBin2Prg_Lang
|
|
lcPath = Justpath(.c_Foxbin2prg_FullPath)
|
|
lcEXE_CAPS = Forcepath( 'filename_caps.exe', lcPath )
|
|
loFSO = .o_FSO
|
|
llRelanzarError = Not tl_NormalizeInputFile
|
|
|
|
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 Adir( laDirInfo, Forceext(tcFileName,'FPT') ) > 0 Then
|
|
.renameFile( Forceext(tcFileName,'FPT'), lcEXE_CAPS, loFSO, llRelanzarError )
|
|
Endif
|
|
If Adir( laDirInfo, Forceext(tcFileName,'CDX') ) > 0 Then
|
|
.renameFile( Forceext(tcFileName,'CDX'), lcEXE_CAPS, loFSO, llRelanzarError )
|
|
Endif
|
|
|
|
Case lcType = 'DBC'
|
|
.renameFile( Forceext(tcFileName,'DCX'), lcEXE_CAPS, loFSO, llRelanzarError )
|
|
.renameFile( Forceext(tcFileName,'DCT'), lcEXE_CAPS, loFSO, llRelanzarError )
|
|
|
|
Case lcType = '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, tnFileCount
|
|
External Array taFiles
|
|
|
|
Local laFiles(1), I, lnFiles ;
|
|
, loLang As CL_LANG Of 'FOXBIN2PRG.PRG'
|
|
|
|
If Type("ALEN(laFiles)") # "N" Or Empty(tnFileCount)
|
|
tnFileCount = 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(m.I,5), 5, 1 ) == 'D'
|
|
Loop
|
|
Endif
|
|
|
|
tnFileCount = tnFileCount + 1
|
|
Dimension taFiles(tnFileCount)
|
|
taFiles(tnFileCount) = tcDir + laFiles(m.I,1)
|
|
Endfor
|
|
|
|
*-- Busco los subdirectorios
|
|
For I = 1 To lnFiles
|
|
If Not Substr( laFiles(m.I,5), 5, 1 ) == 'D' Or Left(laFiles(m.I,1), 1) == '.'
|
|
Loop
|
|
Endif
|
|
.get_FilesFromDirectory( tcDir + laFiles(m.I,1), @taFiles, @lnFileCount )
|
|
Endfor
|
|
Endwith
|
|
Endif
|
|
Endproc
|
|
|
|
|
|
Procedure loadModule
|
|
*--------------------------------------------------------------------------------------------------------------
|
|
* CARGA EL MÓDULO INDICADO EN tc_InputFile Y DEVUELVE SU REFERENCIA DE OBJETO EN toModulo
|
|
*--------------------------------------------------------------------------------------------------------------
|
|
* PARÁMETROS: (v=Pasar por valor | @=Pasar por referencia) (!=Obligatorio | ?=Opcional) (IN/OUT)
|
|
* tc_InputFile (v! IN ) Nombre del archivo de entrada
|
|
* toModulo (@? OUT) Referencia de objeto del módulo generado (para Unit Testing)
|
|
* toEx (@? OUT) Objeto con información del error
|
|
* tlRelanzarError (v? IN ) Indica si el error debe relanzarse o no
|
|
* tcOriginalFileName (v? IN ) Sirve para los casos en los que inputFile es un nombre temporal y se quiere generar
|
|
* el nombre correcto dentro de la versión texto (por ej: en los PJ2 y las cabeceras)
|
|
*--------------------------------------------------------------------------------------------------------------
|
|
Lparameters tc_InputFile, toModulo, toEx As Exception, tlRelanzarError, tcOriginalFileName
|
|
|
|
Try
|
|
Local lnCodError, lcErrorInfo, laDirFile(1,5), lcExtension, lnFileCount, laFiles(1,1), I ;
|
|
, ltFilestamp, lcExtA, lcExtB, laEvents(1,1), lnIDInputFile ;
|
|
, loLang As CL_LANG Of 'FOXBIN2PRG.PRG' ;
|
|
, loConversor As c_conversor_base Of 'FOXBIN2PRG.PRG' ;
|
|
, loFSO As Scripting.FileSystemObject
|
|
lnCodError = 0
|
|
|
|
With This As c_foxbin2prg Of 'FOXBIN2PRG.PRG'
|
|
Store Null To toModulo
|
|
lc_OldSetNotify = Set("Notify")
|
|
Set Notify Off
|
|
loFSO = .o_FSO
|
|
loLang = _Screen.o_FoxBin2Prg_Lang
|
|
.c_InputFile = Fullpath( tc_InputFile )
|
|
.l_Error = .F.
|
|
lcExtension = Upper( Justext(.c_InputFile) )
|
|
|
|
.writeLog( Replicate( '*', 100 ) )
|
|
.writeLog( 'LOAD MODULE', 2 )
|
|
.writeLog( Replicate( '*', 100 ) )
|
|
|
|
If Adir( laDirFile, .c_InputFile, '', 1 ) = 0
|
|
*ERROR 'No se encontró el archivo [' + .c_InputFile + ']'
|
|
Error loLang.C_FILE_NOT_FOUND_LOC + ' [' + .c_InputFile + ']'
|
|
Endif
|
|
|
|
.c_InputFile = loFSO.GetAbsolutePathName( Forcepath( laDirFile(1,1), Justpath(.c_InputFile) ) )
|
|
|
|
*-- VERIFICO SI HAY ARCHIVO DE CONFIGURACIÓN SECUNDARIO
|
|
.evaluateConfiguration()
|
|
|
|
|
|
If Not Empty(tcOriginalFileName)
|
|
tcOriginalFileName = loFSO.GetAbsolutePathName( tcOriginalFileName )
|
|
Endif
|
|
|
|
.c_OriginalFileName = Evl( tcOriginalFileName, .c_InputFile )
|
|
|
|
If Upper( Justext(.c_OriginalFileName) ) = 'PJM' And .c_PJ2 <> 'PJM'
|
|
.c_OriginalFileName = Forceext(.c_OriginalFileName,'pjx')
|
|
Endif
|
|
|
|
lnIDInputFile = .n_ProcessedFiles
|
|
|
|
.writeLog( C_TAB + 'c_OriginalFileName: ' + .c_OriginalFileName )
|
|
.writeLog( )
|
|
|
|
If Not Adir(laDirFile, .c_InputFile) > 0 Then
|
|
Error loLang.C_FILE_DOESNT_EXIST_LOC + ' [' + .c_InputFile + ']'
|
|
Endif
|
|
|
|
Do Case
|
|
Case lcExtension = 'VCX'
|
|
loConversor = Createobject( 'c_conversor_vcx_a_prg' )
|
|
|
|
Case lcExtension = 'SCX'
|
|
loConversor = Createobject( 'c_conversor_scx_a_prg' )
|
|
|
|
Case lcExtension = 'PJX'
|
|
loConversor = Createobject( 'c_conversor_pjx_a_prg' )
|
|
|
|
Case lcExtension = 'PJM' And .c_PJ2 <> 'PJM'
|
|
loConversor = Createobject( 'c_conversor_pjm_a_prg' )
|
|
|
|
Case lcExtension = 'FRX'
|
|
loConversor = Createobject( 'c_conversor_frx_a_prg' )
|
|
|
|
Case lcExtension = 'LBX'
|
|
loConversor = Createobject( 'c_conversor_frx_a_prg' )
|
|
|
|
Case lcExtension = 'DBF'
|
|
loConversor = Createobject( 'c_conversor_dbf_a_prg' )
|
|
|
|
Case lcExtension = 'DBC'
|
|
loConversor = Createobject( 'c_conversor_dbc_a_prg' )
|
|
|
|
Case lcExtension = 'MNX'
|
|
loConversor = Createobject( 'c_conversor_mnx_a_prg' )
|
|
|
|
Case lcExtension = .c_VC2
|
|
loConversor = Createobject( 'c_conversor_prg_a_vcx' )
|
|
|
|
Case lcExtension = .c_SC2
|
|
loConversor = Createobject( 'c_conversor_prg_a_scx' )
|
|
|
|
Case lcExtension = .c_PJ2
|
|
loConversor = Createobject( 'c_conversor_prg_a_pjx' )
|
|
|
|
Case lcExtension = .c_FR2
|
|
loConversor = Createobject( 'c_conversor_prg_a_frx' )
|
|
|
|
Case lcExtension = .c_LB2
|
|
loConversor = Createobject( 'c_conversor_prg_a_frx' )
|
|
|
|
Case lcExtension = .c_DB2
|
|
loConversor = Createobject( 'c_conversor_prg_a_dbf' )
|
|
|
|
Case lcExtension = .c_DC2
|
|
loConversor = Createobject( 'c_conversor_prg_a_dbc' )
|
|
|
|
Case lcExtension = .c_MN2
|
|
loConversor = Createobject( 'c_conversor_prg_a_mnx' )
|
|
|
|
Otherwise
|
|
*ERROR 'El archivo [' + .c_InputFile + '] no está soportado'
|
|
Error (Textmerge(loLang.C_FILE_NAME_IS_NOT_SUPPORTED_LOC))
|
|
|
|
Endcase
|
|
|
|
.c_Type = Upper(Justext(.c_OutputFile))
|
|
loConversor.c_InputFile = .c_InputFile
|
|
loConversor.c_OutputFile = .c_OutputFile
|
|
loConversor.c_LogFile = .c_LogFile
|
|
loConversor.n_Debug = .n_Debug
|
|
loConversor.l_Test = .l_Test
|
|
loConversor.n_FB2PRG_Version = .n_FB2PRG_Version
|
|
loConversor.l_MethodSort_Enabled = .l_MethodSort_Enabled
|
|
loConversor.l_PropSort_Enabled = .l_PropSort_Enabled
|
|
loConversor.l_ReportSort_Enabled = .l_ReportSort_Enabled
|
|
loConversor.c_OriginalFileName = .c_OriginalFileName
|
|
loConversor.c_Foxbin2prg_FullPath = .c_Foxbin2prg_FullPath
|
|
*--
|
|
*.updateProgressbar( loLang.C_PROCESSING_LOC + ' ' + .c_InputFile + '...', 0, 0, 0 )
|
|
|
|
*IF AEVENTS( laEvents, loConversor ) = 0 THEN
|
|
* BINDEVENT( loConversor, 'updateProgressbar', THIS, 'updateProgressbar' )
|
|
*ENDIF
|
|
|
|
loConversor.loadModule( @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
|
|
|
|
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
|
|
Set Notify &lc_OldSetNotify.
|
|
|
|
*IF AEVENTS( laEvents, loConversor ) > 0 THEN
|
|
* UNBINDEVENTS( loConversor )
|
|
*ENDIF
|
|
|
|
Store Null To loConversor, loFSO
|
|
|
|
*IF lnCodError = 0 AND THIS.l_Error THEN
|
|
* THIS.updateProcessedFile( lnIDInputFile, '', '', 'E1' )
|
|
*ELSE
|
|
* *THIS.updateProcessedFile( lnIDInputFile )
|
|
*ENDIF
|
|
|
|
Release lcErrorInfo, laDirFile, lcExtension, lnFileCount, laFiles, I ;
|
|
, ltFilestamp, lcExtA, lcExtB ;
|
|
, loConversor, loFSO
|
|
Endtry
|
|
|
|
Return lnCodError
|
|
Endproc
|
|
|
|
|
|
Procedure 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(m.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 errOut
|
|
*-- DEVOLUCIÓN DE SALIDA A ERROUT (-12)
|
|
Lparameters tcTexto
|
|
|
|
Procedure stdOut
|
|
*-- DEVOLUCIÓN DE SALIDA A STDOUT (-11)
|
|
Lparameters tcTexto
|
|
|
|
Try
|
|
If This.l_StdOutHabilitado
|
|
Local loException As Exception, lcOutput, lnOutHandle, lnBytesWritten, lnOverlappedIO
|
|
lcOutput = Evl(tcTexto,'') + CR_LF
|
|
lnOutHandle = fb2p_GetStdHandle(-11) && CAPTURAR STDOUT DESDE CONSOLA: FOXBIN2PRG.EXE PARAMS | FIND /V ""
|
|
lnBytesWritten = 0
|
|
lnOverlappedIO = 0
|
|
fb2p_WriteFile(lnOutHandle, @lcOutput, Len(lcOutput), @lnBytesWritten, @lnOverlappedIO)
|
|
Endif
|
|
|
|
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.
|
|
.l_Errors = .T.
|
|
Endwith
|
|
Catch
|
|
Endtry
|
|
Endproc
|
|
|
|
|
|
Procedure writeErrorLog_Flush
|
|
With This As c_foxbin2prg Of 'FOXBIN2PRG.PRG'
|
|
If Not Empty(.c_TextErr)
|
|
Strtofile( .c_TextErr + CR_LF, .c_ErrorLogFile, 1 )
|
|
Endif
|
|
.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
|
|
|
|
|
|
Function wscriptshell_run
|
|
* Modificación basada en la rutina RunExitCode.prg de William GC Steinford (nov 2002)
|
|
* pero compatible con el método Run de WScript.Shell para su reemplazo cuando no es posible usarlo.
|
|
* http://fox.wikis.com/wc.dll?Wiki~ProcessExitCode
|
|
*-----------------------------------------------------------------------------------------------
|
|
* 'Run' Parameter Documentation at: https://msdn.microsoft.com/en-us/library/d5fk67ky%28v=vs.84%29.aspx
|
|
*-----------------------------------------------------------------------------------------------
|
|
Lparameters tcCmdLine, tnWindowStyle, tbWaitOnReturn, tlDebug
|
|
* ? WScriptShell_Run("c:\windows\system32\cmd.exe /c dir c:\*.* > \temp\dir.txt")
|
|
|
|
Local lnWfSO, ln_dwFlags, ln_wShowWindow, lcStartInfo, lcProcessInfo, ln_hProcess, ln_hThread ;
|
|
, lnExitCode, ln_dwProcessId, ln_dwThreadId, tcProgFile, laDirFile(1,5)
|
|
|
|
Try
|
|
Declare SHORT CreateProcess In WIN32API ;
|
|
STRING lpszModuleName, ;
|
|
STRING @lpszCommandLine, ;
|
|
STRING lpSecurityAttributesProcess, ;
|
|
STRING lpSecurityAttributesThread, ;
|
|
SHORT bInheritHandles, ;
|
|
INTEGER dwCreateFlags, ;
|
|
STRING lpvEnvironment, ;
|
|
STRING lpszStartupDir, ;
|
|
STRING @lpStartInfo, ;
|
|
STRING @lpProcessInfo
|
|
|
|
Declare Long WaitForSingleObject In WIN32API Integer hHandle, Long dwMilliseconds
|
|
Declare Integer GetExitCodeProcess In WIN32API Integer ln_hProcess, Integer @ lnExitCode
|
|
Declare Integer CloseHandle In kernel32.Dll Integer hObject
|
|
*DECLARE INTEGER ShellExecuteEx IN Shell32 STRING @lpExecInfo
|
|
Declare Long ShellExecuteEx In shell32.Dll String @
|
|
Declare Long HeapAlloc In WIN32API Long, Long, Long
|
|
Declare Long HeapFree In WIN32API Long, Long, Long
|
|
Declare Long GetProcessHeap In WIN32API
|
|
*DECLARE LONG WaitForSingleObject IN WIN32API LONG, LONG
|
|
Declare Long TerminateProcess In WIN32API Long, Long
|
|
|
|
* NOTA: Las constantes para VFP se pueden consultar en http://www.news2news.com/vfp/w32constants.php
|
|
|
|
#Define SEE_MASK_NOCLOSEPROCESS 0x00000040
|
|
#Define WAIT_MILLISECOND 3000
|
|
|
|
#Define SW_SHOW 5
|
|
#Define STILL_ACTIVE 0x103
|
|
#Define cnINFINITE 0xFFFFFFFF
|
|
#Define cnHalfASecond 500 && milliseconds
|
|
#Define cnTimedOut 0x0102
|
|
|
|
*-- Constantes para WaitForSingleObject
|
|
#Define WAIT_ABANDONED 0x00000080
|
|
#Define WAIT_OBJECT_0 0x00000000
|
|
#Define WAIT_TIMEOUT 0x00000102
|
|
#Define WAIT_FAILED 0xFFFFFFFF
|
|
|
|
tcProgFile = Evl(tcProgFile, Null)
|
|
tcCmdLine = Evl(tcCmdLine, Null)
|
|
|
|
Do Case
|
|
Case Vartype(tbWaitOnReturn) = "L"
|
|
Case Vartype(tbWaitOnReturn) = "N"
|
|
tbWaitOnReturn = (tbWaitOnReturn=1)
|
|
Otherwise
|
|
Error 'Invalid value for tbWaitOnReturn parameter'
|
|
Endcase
|
|
|
|
If Vartype(tnWindowStyle) # "N" Or Not Between(tnWindowStyle, 0, 10) Then
|
|
tnWindowStyle = 10
|
|
Endif
|
|
|
|
ln_dwFlags = 1
|
|
ln_wShowWindow = tnWindowStyle
|
|
|
|
* DOCUMENTACIÓN estructura _STARTUPINFO:
|
|
* creates the STARTUP structure to specify main window
|
|
* properties if a new window is created for a new process
|
|
|
|
*| typedef struct _STARTUPINFO {
|
|
*| DWORD cb; 4
|
|
*| LPTSTR lpReserved; 4
|
|
*| LPTSTR lpDesktop; 4
|
|
*| LPTSTR lpTitle; 4
|
|
*| DWORD dwX; 4
|
|
*| DWORD dwY; 4
|
|
*| DWORD dwXSize; 4
|
|
*| DWORD dwYSize; 4
|
|
*| DWORD dwXCountChars; 4
|
|
*| DWORD dwYCountChars; 4
|
|
*| DWORD dwFillAttribute; 4
|
|
*| DWORD dwFlags; 4
|
|
*| WORD wShowWindow; 2
|
|
*| WORD cbReserved2; 2
|
|
*| LPBYTE lpReserved2; 4
|
|
*| HANDLE hStdInput; 4
|
|
*| HANDLE hStdOutput; 4
|
|
*| HANDLE hStdError; 4
|
|
*| } STARTUPINFO, *LPSTARTUPINFO; total: 68 bytes
|
|
lcStartInfo = BinToC(68,'4RS') ;
|
|
+ BinToC(0,'4RS') + BinToC(0,'4RS') + BinToC(0,'4RS') ;
|
|
+ BinToC(0,'4RS') + BinToC(0,'4RS') + BinToC(0,'4RS') + BinToC(0,'4RS') ;
|
|
+ BinToC(0,'4RS') + BinToC(0,'4RS') + BinToC(0,'4RS') ;
|
|
+ BinToC(ln_dwFlags,'4RS') ;
|
|
+ BinToC(ln_wShowWindow,'2RS') ;
|
|
+ BinToC(0,'2RS') + BinToC(0,'4RS') ;
|
|
+ BinToC(0,'4RS') + BinToC(0,'4RS') + BinToC(0,'4RS')
|
|
|
|
lcProcessInfo = Replicate( Chr(0), 16 )
|
|
|
|
* DOCUMENTACIÓN estructura _PROCESS_INFORMATION:
|
|
* https://msdn.microsoft.com/en-us/library/windows/desktop/ms684873%28v=vs.85%29.aspx
|
|
* typedef struct _PROCESS_INFORMATION {
|
|
* HANDLE hProcess;
|
|
* HANDLE hThread;
|
|
* DWORD dwProcessId;
|
|
* DWORD dwThreadId;
|
|
* } PROCESS_INFORMATION;
|
|
*
|
|
|
|
If CreateProcess( tcProgFile, tcCmdLine,0,0,0,0,0,0, lcStartInfo, @lcProcessInfo ) = 0
|
|
|
|
*-- Segundo intento: Si se definió un archivo (ej: un TXT,LOG,etc) intento lanzarlo
|
|
*-- con la aplicación predeterminada
|
|
If Adir(laDirFile, tcCmdLine) = 1 Then
|
|
Local lcInfo, lnHeap, lnLen, lnPtr
|
|
|
|
*-- Ejemplo adaptado de: http://www.foxite.com/archives/0000316611.htm
|
|
lnLen = Len(tcCmdLine) + 1
|
|
lnHeap = GetProcessHeap()
|
|
lnPtr = HeapAlloc(lnHeap, 0x8, 5 + lnLen)
|
|
Sys(2600, lnPtr, 5, [open] + Chr(0))
|
|
Sys(2600, lnPtr+5, lnLen, tcCmdLine + Chr(0))
|
|
|
|
* DOCUMENTACIÓN estructura _SHELLEXECUTEINFO:
|
|
* https://msdn.microsoft.com/en-us/library/windows/desktop/bb759784%28v=vs.85%29.aspx
|
|
*typedef struct _SHELLEXECUTEINFO {
|
|
* DWORD cbSize; 4
|
|
* ULONG fMask; 4
|
|
* HWND hwnd; 4
|
|
* LPCTSTR lpVerb; 4
|
|
* LPCTSTR lpFile; 4
|
|
* LPCTSTR lpParameters; 4
|
|
* LPCTSTR lpDirectory; 4
|
|
* int nShow; 4
|
|
* HINSTANCE hInstApp; 4
|
|
* LPVOID lpIDList; 4
|
|
* LPCTSTR lpClass; 4
|
|
* HKEY hkeyClass; 4
|
|
* DWORD dwHotKey; 4
|
|
* union {
|
|
* HANDLE hIcon;
|
|
* HANDLE hMonitor;
|
|
* } DUMMYUNIONNAME; 4
|
|
* HANDLE hProcess; 4
|
|
*} SHELLEXECUTEINFO, *LPSHELLEXECUTEINFO;
|
|
*
|
|
|
|
lcInfo = ;
|
|
BINTOC(60, [4RS]) + ;
|
|
BINTOC(SEE_MASK_NOCLOSEPROCESS, [4RS]) + ;
|
|
BINTOC(0, [4RS]) + ;
|
|
BINTOC(lnPtr, [4RS]) + ;
|
|
BINTOC(lnPtr+5, [4RS]) + ;
|
|
BINTOC(0, [4RS]) + ;
|
|
BINTOC(0, [4RS]) + ;
|
|
BINTOC(1, [4RS]) + ;
|
|
REPLICATE(Chr(0), 28)
|
|
|
|
If ShellExecuteEx(@lcInfo) = 0
|
|
If tlDebug
|
|
? "Could not call process"
|
|
Endif
|
|
lnExitCode = -1
|
|
Exit
|
|
Else
|
|
HeapFree(lnHeap, 0, lnPtr)
|
|
ln_hProcess = CToBin(Right(lcInfo, 4), [4RS])
|
|
ln_hThread = 0
|
|
|
|
If tlDebug
|
|
? "Process handle = "+Transform(ln_hProcess)
|
|
? "Thread handle = "+Transform(ln_hThread)
|
|
Endif
|
|
|
|
*IF lnProcess != 0
|
|
* WaitForSingleObject(ln_hProcess, WAIT_MILLISECOND)
|
|
* IF tlDebug
|
|
* ? "Terminating process!"
|
|
* ENDIF
|
|
* TerminateProcess(ln_hProcess, 0)
|
|
*ENDIF
|
|
Endif
|
|
|
|
Else
|
|
If tlDebug
|
|
? "Could not create process"
|
|
Endif
|
|
lnExitCode = -1
|
|
Exit
|
|
Endif
|
|
Else
|
|
|
|
* Process and thread handles returned in ProcInfo structure
|
|
ln_hProcess = CToBin( Left( lcProcessInfo, 4 ), '4RS' )
|
|
ln_hThread = CToBin( Substr( lcProcessInfo, 5, 4 ), '4RS' )
|
|
ln_dwProcessId = CToBin( Substr( lcProcessInfo, 9, 4 ), '4RS' )
|
|
ln_dwThreadId = CToBin( Substr( lcProcessInfo, 13, 4 ), '4RS' )
|
|
|
|
If tlDebug
|
|
? "Process handle = "+Transform(ln_hProcess)
|
|
? "Thread handle = "+Transform(ln_hThread)
|
|
? "Process handle id = "+Transform(ln_dwProcessId)
|
|
? "Thread handle id = "+Transform(ln_dwThreadId)
|
|
Endif
|
|
Endif
|
|
|
|
If tbWaitOnReturn Then
|
|
* // Give the process time to execute and finish
|
|
lnExitCode = STILL_ACTIVE
|
|
|
|
Do While lnExitCode = STILL_ACTIVE
|
|
*lnWfSO = WaitForSingleObject(ln_hProcess, cnHalfASecond)
|
|
lnWfSO = WaitForSingleObject(ln_hProcess, cnINFINITE)
|
|
|
|
If tlDebug
|
|
? 'lnWfSO = ' + Transform(lnWfSO)
|
|
Endif
|
|
|
|
If GetExitCodeProcess(ln_hProcess, @lnExitCode) <> 0
|
|
Do Case
|
|
Case lnExitCode = STILL_ACTIVE
|
|
If tlDebug
|
|
? "Process is still active"
|
|
Endif
|
|
Otherwise
|
|
If tlDebug
|
|
? "Exit code = "+ Transform( lnExitCode )
|
|
Endif
|
|
Endcase
|
|
Else
|
|
If tlDebug
|
|
? "GetExitCodeProcess() failed"
|
|
Endif
|
|
lnExitCode = -2
|
|
Endif
|
|
|
|
DoEvents
|
|
Enddo
|
|
Else
|
|
lnExitCode = 0
|
|
Endif
|
|
|
|
*-- DOCUMENTACIÓN sobre cierre procesos/threads:
|
|
*-- https://msdn.microsoft.com/en-us/library/windows/desktop/ms682512%28v=vs.85%29.aspx
|
|
=CloseHandle(ln_hProcess)
|
|
=CloseHandle(ln_hThread)
|
|
|
|
If tlDebug
|
|
? '> FUNCTION RETURN VALUE = '
|
|
Endif
|
|
Endtry
|
|
|
|
Return lnExitCode
|
|
Endfunc
|
|
|
|
|
|
Function FERROR_Message(tcFileName As String)
|
|
Local lcMsg, lnError
|
|
tcFileName = Evl(tcFileName,'')
|
|
lnError = Ferror()
|
|
|
|
Do Case
|
|
Case lnError = 2
|
|
lcMsg = 'File not found'
|
|
Case lnError = 4
|
|
lcMsg = 'Too many files open (out of file handles)'
|
|
Case lnError = 5
|
|
lcMsg = 'Access denied'
|
|
Case lnError = 6
|
|
lcMsg = 'Invalid file handle given'
|
|
Case lnError = 8
|
|
lcMsg = 'Out of memory'
|
|
Case lnError = 25
|
|
lcMsg = [Seek error (can't seek before the start of a file)]
|
|
Case lnError = 29
|
|
lcMsg = 'Disk full'
|
|
Case lnError = 31
|
|
lcMsg = 'Error opening file'
|
|
Otherwise
|
|
lcMsg = 'Unrecognized error trying to open the file ' + tcFileName
|
|
Endcase
|
|
|
|
Return lcMsg
|
|
Endfunc
|
|
|
|
|
|
Function getLocaleInfo
|
|
Lparameters tnSetting, tcLocale
|
|
#Define C_NULL Chr(0)
|
|
Local lcLocale, lnLen, lcBuffer, lnReturn, lcReturn
|
|
|
|
If Vartype(tcLocale) = 'C' And Not Empty(tcLocale)
|
|
lcLocale = Strconv(tcLocale, 5) + C_NULL
|
|
Else
|
|
lcLocale = .Null.
|
|
Endif
|
|
|
|
Declare Integer GetLocaleInfoEx In Win32API ;
|
|
string locale, Long Type, String @Buffer, Integer Len
|
|
lnLen = 255
|
|
lcBuffer = Space(lnLen)
|
|
lnReturn = GetLocaleInfoEx(lcLocale, tnSetting, @lcBuffer, lnLen)
|
|
lcReturn = Strconv(Left(lcBuffer, 2 * (lnReturn - 1)), 6)
|
|
Return lcReturn
|
|
Endfunc
|
|
|
|
|
|
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 = [<VFPData>] ;
|
|
+ [<memberdata name="updateprogressbar" display="updateProgressbar"/>] ;
|
|
+ [<memberdata name="width" display="Width"/>] ;
|
|
+ [<memberdata name="height" display="Height"/>] ;
|
|
+ [<memberdata name="nlastseccount" display="nLastSecCount"/>] ;
|
|
+ [<memberdata name="nsecsatstart" display="nSecsAtStart"/>] ;
|
|
+ [<memberdata name="nvalue2" display="nValue2"/>] ;
|
|
+ [<memberdata name="nvalue2_assign" display="nValue2_Assign"/>] ;
|
|
+ [<memberdata name="nvalue" display="nValue"/>] ;
|
|
+ [<memberdata name="nvalue_assign" display="nValue_assign"/>] ;
|
|
+ [<memberdata name="nmax_value" display="nMax_Value"/>] ;
|
|
+ [<memberdata name="nmax_value2" display="nMax_Value2"/>] ;
|
|
+ [<memberdata name="l_cancelled" display="l_Cancelled"/>] ;
|
|
+ [</VFPData>]
|
|
|
|
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
|
|
|
|
.nValue2 = 0
|
|
|
|
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 laDirInfo(1,5), loLang As CL_LANG Of 'FOXBIN2PRG.PRG'
|
|
|
|
If Vartype(toFoxBin2Prg) = "O" Then
|
|
If Type("_SCREEN.o_FoxBin2Prg_Lang") = "O" Then
|
|
loLang = _Screen.o_FoxBin2Prg_Lang
|
|
Thisform.Caption = 'FoxBin2Prg ' + _Screen.c_FB2PRG_EXE_Version + ' > - ' + loLang.C_PROCESS_PROGRESS_LOC + ' (' + loLang.C_PRESS_ESC_TO_CANCEL + ')'
|
|
Endif
|
|
|
|
*IF ADIR( laDirInfo, FORCEEXT( toFoxBin2Prg.c_Foxbin2prg_FullPath, 'ICO' ) ) > 0 THEN
|
|
If File( Forceext( toFoxBin2Prg.c_Foxbin2prg_FullPath, 'ICO' ) ) Then
|
|
Thisform.Icon = Forceext( toFoxBin2Prg.c_Foxbin2prg_FullPath, 'ICO' )
|
|
Endif
|
|
|
|
*IF ADIR( laDirInfo, toFoxBin2Prg.c_BackgroundImage ) > 0 THEN
|
|
If File( toFoxBin2Prg.c_BackgroundImage ) Then
|
|
Clear Resources
|
|
Thisform.Picture = toFoxBin2Prg.c_BackgroundImage
|
|
Endif
|
|
Endif
|
|
|
|
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 = [<VFPData>] ;
|
|
+ [<memberdata name="n_conversiontype" display="n_ConversionType"/>] ;
|
|
+ [<memberdata name="l_filetimestampoptimization" display="l_FileTimeStampOptimization"/>] ;
|
|
+ [</VFPData>]
|
|
|
|
|
|
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 laDirInfo(1,5), loLang As CL_LANG Of 'FOXBIN2PRG.PRG'
|
|
|
|
If Vartype(toFoxBin2Prg) = "O" Then
|
|
If Vartype(_Screen.o_FoxBin2Prg_Lang) = "O" Then
|
|
loLang = _Screen.o_FoxBin2Prg_Lang
|
|
|
|
If 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 Adir( laDirInfo, Forceext( toFoxBin2Prg.c_Foxbin2prg_FullPath, 'ICO' ) ) > 0 Then
|
|
Thisform.Icon = Forceext( toFoxBin2Prg.c_Foxbin2prg_FullPath, 'ICO' )
|
|
Endif
|
|
Endif
|
|
Endproc
|
|
|
|
|
|
Procedure QueryUnload
|
|
Thisform.n_ConversionType = 3
|
|
Nodefault
|
|
Thisform.do_selection()
|
|
|
|
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 = 3
|
|
Caption = "FoxBin2Prg <x>"
|
|
Closable = .T.
|
|
ControlBox = .T.
|
|
DoCreate = .T.
|
|
Height = 380
|
|
KeyPreview = .T.
|
|
MaxButton = .T.
|
|
MinButton = .F.
|
|
MinHeight = 380
|
|
MinWidth = 756
|
|
Name = "FRM_MAIN"
|
|
ShowWindow = 2
|
|
Width = 756
|
|
|
|
Add Object 'edt_Help' As EditBox With ;
|
|
Anchor = 1+2+4+8, ;
|
|
BackStyle = 0, ;
|
|
BorderStyle = 0, ;
|
|
DisabledForeColor = (Rgb(0,0,0)), ;
|
|
Enabled = .T., ;
|
|
FontName = "Courier New", ;
|
|
FontSize = 9, ;
|
|
Height = 324, ;
|
|
Left = 12, ;
|
|
Name = "edt_Help", ;
|
|
ReadOnly = .T., ;
|
|
ScrollBars = 2, ;
|
|
Top = 12, ;
|
|
Width = 728
|
|
|
|
Add Object 'cmd_Close' As CommandButton With ;
|
|
Anchor = 4+8, ;
|
|
Cancel = .T., ;
|
|
Caption = "Close", ;
|
|
Height = 27, ;
|
|
Left = 656, ;
|
|
Name = "cmd_Close", ;
|
|
Top = 344, ;
|
|
Width = 84
|
|
|
|
Procedure Init
|
|
Lparameters toFoxBin2Prg
|
|
|
|
#If .F.
|
|
Local toFoxBin2Prg As c_foxbin2prg Of 'FOXBIN2PRG.PRG'
|
|
#Endif
|
|
|
|
Local laDirInfo(1,5), loLang As CL_LANG Of 'FOXBIN2PRG.PRG'
|
|
|
|
If Vartype(toFoxBin2Prg) = "O" Then
|
|
If Vartype(_Screen.o_FoxBin2Prg_Lang) = "O" Then
|
|
loLang = _Screen.o_FoxBin2Prg_Lang
|
|
|
|
If 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+;
|
|
STRTRAN(loLang.C_FOXBIN2PRG_SYNTAX_INFO_EXAMPLE_LOC_cfg,'&'+'&','')+;
|
|
loLang.C_FOXBIN2PRG_SYNTAX_INFO_EXAMPLE_LOC_tab_cfg
|
|
|
|
Endif
|
|
|
|
If Adir( laDirInfo, Forceext( toFoxBin2Prg.c_Foxbin2prg_FullPath, 'ICO' ) ) > 0 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
|
|
|
|
Enddefine
|
|
|
|
|
|
Define Class c_conversor_base As Custom
|
|
#If .F.
|
|
Local This As c_conversor_base Of 'FOXBIN2PRG.PRG'
|
|
#Endif
|
|
_MemberData = [<VFPData>] ;
|
|
+ [<memberdata name="analyzeassignmentof_tag" display="analyzeAssignmentOf_TAG"/>] ;
|
|
+ [<memberdata name="updateprogressbar" display="updateProgressbar"/>] ;
|
|
+ [<memberdata name="a_specialprops" display="a_SpecialProps"/>] ;
|
|
+ [<memberdata name="findmethodsobjectbyname" display="findMethodsObjectByName"/>] ;
|
|
+ [<memberdata name="verifyvalidexpression" display="verifyValidExpression"/>] ;
|
|
+ [<memberdata name="convert" display="convert"/>] ;
|
|
+ [<memberdata name="currentlineispreviouslinecontinuation" display="currentLineIsPreviousLineContinuation"/>] ;
|
|
+ [<memberdata name="decode_specialcodes_1_31" display="decode_SpecialCodes_1_31"/>] ;
|
|
+ [<memberdata name="decode_specialcodes_cr_lf" display="decode_SpecialCodes_CR_LF"/>] ;
|
|
+ [<memberdata name="denormalizeassignment" display="denormalizeAssignment"/>] ;
|
|
+ [<memberdata name="denormalizepropertyvalue" display="denormalizePropertyValue"/>] ;
|
|
+ [<memberdata name="denormalizexmlvalue" display="denormalizeXMLValue"/>] ;
|
|
+ [<memberdata name="isindicatedtoken" display="isIndicatedToken"/>] ;
|
|
+ [<memberdata name="encode_specialcodes_1_31" display="encode_SpecialCodes_1_31"/>] ;
|
|
+ [<memberdata name="encode_specialcodes_cr_lf" display="encode_SpecialCodes_CR_LF"/>] ;
|
|
+ [<memberdata name="exception2str" display="exception2Str"/>] ;
|
|
+ [<memberdata name="filetypecode" display="fileTypeCode"/>] ;
|
|
+ [<memberdata name="get_listnameswithvaluesfrom_inline_metadatatag" display="get_ListNamesWithValuesFrom_InLine_MetadataTag"/>] ;
|
|
+ [<memberdata name="get_separatedlineandcomment" display="get_SeparatedLineAndComment"/>] ;
|
|
+ [<memberdata name="get_separatedpropandvalue" display="get_SeparatedPropAndValue"/>] ;
|
|
+ [<memberdata name="get_textfilenames" display="get_TextFileNames"/>] ;
|
|
+ [<memberdata name="get_valuefromnullterminatedvalue" display="get_ValueFromNullTerminatedValue"/>] ;
|
|
+ [<memberdata name="identifyexclusionblocks" display="identifyExclusionBlocks"/>] ;
|
|
+ [<memberdata name="lineisonlycommentandnometadata" display="lineIsOnlyCommentAndNoMetadata"/>] ;
|
|
+ [<memberdata name="loadmodule" display="loadModule"/>] ;
|
|
+ [<memberdata name="normalizeassignment" display="normalizeAssignment"/>] ;
|
|
+ [<memberdata name="normalizepropertyvalue" display="normalizePropertyValue"/>] ;
|
|
+ [<memberdata name="normalizexmlvalue" display="normalizeXMLValue"/>] ;
|
|
+ [<memberdata name="set_uservalue" display="set_UserValue"/>] ;
|
|
+ [<memberdata name="sortpropsandvalues" display="sortPropsAndValues"/>] ;
|
|
+ [<memberdata name="sortspecialprops" display="sortSpecialProps"/>] ;
|
|
+ [<memberdata name="sortpropsandvalues_setandgetscxpropnames" type="method" display="sortPropsAndValues_SetAndGetSCXPropNames"/>] ;
|
|
+ [<memberdata name="writelog" display="writeLog"/>] ;
|
|
+ [<memberdata name="writeerrorlog" display="writeErrorLog"/>] ;
|
|
+ [<memberdata name="c_claseactual" display="c_ClaseActual"/>] ;
|
|
+ [<memberdata name="c_curdir" display="c_CurDir"/>] ;
|
|
+ [<memberdata name="c_foxbin2prg_fullpath" display="c_Foxbin2prg_FullPath"/>] ;
|
|
+ [<memberdata name="c_inputfile" display="c_InputFile"/>] ;
|
|
+ [<memberdata name="c_logfile" display="c_LogFile"/>] ;
|
|
+ [<memberdata name="c_originalfilename" display="c_OriginalFileName"/>] ;
|
|
+ [<memberdata name="c_outputfile" display="c_OutputFile"/>] ;
|
|
+ [<memberdata name="c_textlog" display="c_TextLog"/>] ;
|
|
+ [<memberdata name="c_texterr" display="c_TextErr"/>] ;
|
|
+ [<memberdata name="c_type" display="c_Type"/>] ;
|
|
+ [<memberdata name="n_debug" display="n_Debug"/>] ;
|
|
+ [<memberdata name="l_error" display="l_Error"/>] ;
|
|
+ [<memberdata name="l_test" display="l_Test"/>] ;
|
|
+ [<memberdata name="l_methodsort_enabled" display="l_MethodSort_Enabled"/>] ;
|
|
+ [<memberdata name="l_propsort_enabled" display="l_PropSort_Enabled"/>] ;
|
|
+ [<memberdata name="l_reportsort_enabled" display="l_ReportSort_Enabled"/>] ;
|
|
+ [<memberdata name="n_fb2prg_version" display="n_FB2PRG_Version"/>] ;
|
|
+ [<memberdata name="n_methods_lineno" display="n_Methods_LineNo"/>] ;
|
|
+ [<memberdata name="ofso" display="oFSO"/>] ;
|
|
+ [</VFPData>]
|
|
|
|
|
|
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
|
|
*!* Changed by: Lutz Scheffler 21.02.2021
|
|
*!* change date="{^2021-02-21,10:57:00}"
|
|
* Operation set to standard value
|
|
* anywhere else it will respect this to,
|
|
* so it's in the general settings or not
|
|
|
|
* SET BLOCKSIZE TO 0
|
|
|
|
*!* /Changed by: Lutz Scheffler 21.02.2021
|
|
|
|
Set Exact On
|
|
If Not Empty( On("ESCAPE") ) Then
|
|
Set Escape On
|
|
Endif
|
|
|
|
Public C_FB2PRG_CODE
|
|
C_FB2PRG_CODE = '' && Contendrá todo el código generado
|
|
This.c_CurDir = Sys(5) + Curdir()
|
|
This.oFSO = Createobject( "Scripting.FileSystemObject")
|
|
lcSys16 = Sys(16)
|
|
|
|
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 = <VFPData>
|
|
* <memberdata name="mimetodo" display="miMetodo"/>
|
|
* </VFPData> && XML Metadata for customizable properties
|
|
*
|
|
* <fb2p_value>Este es un valor especial</fb2p_value>
|
|
*
|
|
*--------------------------------------------------------------------------------------------------------------
|
|
* 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 <tag>
|
|
* tcTAG_F (v! IN ) TAG de fin </tag>
|
|
* 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 = m.I + 1 To tnProp_Count
|
|
If lnArrayCols = 0
|
|
lcLine = Ltrim( taProps(m.I), 0, ' ', Chr(9) ) && Quito espacios y TABS de la izquierda
|
|
Else
|
|
lcLine = Ltrim( taProps(m.I,1), 0, ' ', Chr(9) ) && Quito espacios y TABS de la izquierda
|
|
Endif
|
|
|
|
Do Case
|
|
Case Left( lcLine, tnLEN_TAG_F ) == tcTAG_F
|
|
*-- <EndTag>
|
|
tcValue = tcTAG_I + Substr( tcValue, 3 ) + tcTAG_F
|
|
.denormalizePropertyValue( @tcPropName, @tcValue, '' )
|
|
I = m.I + 1
|
|
Exit
|
|
|
|
Case tcTAG_F $ lcLine
|
|
*-- Data-Data-Data-<EndTag>
|
|
tcValue = tcTAG_I + Substr( tcValue, 3 ) + Left( lcLine, At( tcTAG_F, lcLine )-1 ) + tcTAG_F
|
|
.denormalizePropertyValue( @tcPropName, @tcValue, '' )
|
|
I = m.I + 1
|
|
Exit
|
|
|
|
Otherwise
|
|
*-- Data
|
|
tcValue = tcValue + CR_LF + lcLine
|
|
Endcase
|
|
Endfor
|
|
|
|
Endwith && THIS
|
|
|
|
I = m.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(m.I)
|
|
|
|
*-- Busco tanto el [nombre] del método como [class.nombre]+[nombre] del método
|
|
If Lower(loObjeto._Nombre) == Lower(toClase._ObjName) + '.' + lcRutaDelNombre ;
|
|
OR Lower(loObjeto._Nombre) == lcRutaDelNombre
|
|
lnObjeto = m.I
|
|
Exit
|
|
Endif
|
|
|
|
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 m.I > 1
|
|
lcPrevLine = taCodeLines(m.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, lcWord2, lcLine, lnWordCount
|
|
|
|
Try
|
|
*-- Pre-normalización
|
|
lcLine = tcLine
|
|
|
|
If tnIniFin = 1
|
|
*-- TOKENS DE INICIO
|
|
If Upper( Left( lcLine, ta_ID_Bloques(m.X,3) ) ) == ta_ID_Bloques(m.X,1)
|
|
*-- Evaluar casos especiales
|
|
lcWord = Upper( Alltrim(Getwordnum(lcLine,1) ) )
|
|
|
|
If ta_ID_Bloques(m.X,1) == 'TEXT' Then
|
|
lcLine = Upper( lcLine ) + ' '
|
|
lnWordCount = Getwordcount(lcLine)
|
|
|
|
If lnWordCount >= 2
|
|
lcWord2 = Alltrim(Getwordnum(lcLine,2) )
|
|
Endif
|
|
|
|
Do Case
|
|
Case Not lcWord == 'TEXT'
|
|
Exit
|
|
|
|
*CASE UPPER( LEFT( CHRTRAN( lcLine, ' ', '' ), 5 ) ) == 'TEXT='
|
|
* EXIT
|
|
Case lnWordCount >= 2
|
|
If lcWord2 == "TO"
|
|
* OK, es TEXT TO...
|
|
Else
|
|
* Luego de TEXT sigue cualquier otra cosa, así que puede ser
|
|
* un campo, variable, etc, que lo han llamado TEXT.
|
|
Exit
|
|
Endif
|
|
|
|
Otherwise
|
|
* OK, es TEXT sin más.
|
|
Endcase
|
|
Endif
|
|
|
|
llEncontrado = .T.
|
|
Endif
|
|
Else
|
|
*-- TOKENS DE FIN
|
|
If Upper( Left( lcLine, ta_ID_Bloques(m.X,4) ) ) == ta_ID_Bloques(m.X,2) && Fin de bloque encontrado (#ENDI, ENDTEXT, etc)
|
|
*-- Evaluar casos especiales
|
|
lcWord = Upper( Alltrim(Getwordnum(lcLine,1) ) )
|
|
|
|
If ta_ID_Bloques(m.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(m.I) + '}', Chr(m.I) )
|
|
Endfor
|
|
Release I
|
|
Return tcText
|
|
Endproc
|
|
|
|
|
|
|
|
Procedure decode_SpecialCodes_CR_LF
|
|
*---------------------------------------------------------------------------------------------------
|
|
* PARÁMETROS: (v=Pasar por valor | @=Pasar por referencia) (!=Obligatorio | ?=Opcional) (IN/OUT)
|
|
* tcText (!@ IN ) Decodifica los caracteres ASCII 10 y 13 de {nCode} a CHR(nCode)
|
|
*---------------------------------------------------------------------------------------------------
|
|
Lparameters tcText
|
|
tcText = Strtran( Strtran( tcText, '{10}', Chr(10) ), '{13}', Chr(13) )
|
|
Return tcText
|
|
Endproc
|
|
|
|
|
|
|
|
Procedure 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 = ''
|
|
|
|
*-- Ajustes de algunos casos especiales
|
|
Do Case
|
|
Case tcProp == '_memberdata'
|
|
*-- Me quedo con lo importante y quito los CHR(0) y longitud que a veces agrega al inicio
|
|
lcValue = ''
|
|
|
|
For I = 1 To Occurs( '/>', tcValue )
|
|
* issue#16: memberdata property should be saved in compressed format
|
|
lcValue = lcValue + Chrtran( Strextract( tcValue, '<memberdata ', '/>', m.I, 1+4 ), CR_LF, ' ' )
|
|
Endfor
|
|
|
|
* issue#16: memberdata property should be saved in compressed format
|
|
TEXT TO tcValue TEXTMERGE NOSHOW FLAGS 1 PRETEXT 1+2
|
|
<VFPData><<SUBSTR( lcValue, 1)>></VFPData>
|
|
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(m.I), '{' + Transform(m.I) + '}' )
|
|
Endfor
|
|
Release I
|
|
Return tcText
|
|
Endproc
|
|
|
|
|
|
|
|
Procedure encode_SpecialCodes_CR_LF
|
|
*---------------------------------------------------------------------------------------------------
|
|
* PARÁMETROS: (v=Pasar por valor | @=Pasar por referencia) (!=Obligatorio | ?=Opcional) (IN/OUT)
|
|
* tcText (!@ IN ) Codifica los caracteres ASCII 10 y 13 de CHR(nCode) a {nCode}
|
|
*---------------------------------------------------------------------------------------------------
|
|
Lparameters tcText
|
|
tcText = Strtran( Strtran( tcText, Chr(10), '{10}' ), Chr(13), '{13}' )
|
|
Return tcText
|
|
Endproc
|
|
|
|
|
|
|
|
Hidden Procedure exception2Str
|
|
Lparameters toEx As Exception
|
|
Local lcError
|
|
lcError = 'Error ' + Transform(toEx.ErrorNo) + ', ' + toEx.Message + Chr(13) + Chr(13) ;
|
|
+ toEx.Procedure + ', ' + Transform(toEx.Lineno) + Chr(13) + Chr(13) ;
|
|
+ toEx.LineContents
|
|
Release toEx
|
|
Return lcError
|
|
Endproc
|
|
|
|
|
|
|
|
Procedure fileTypeCode
|
|
Lparameters tcExtension, tcOriginalType
|
|
tcExtension = Upper(tcExtension)
|
|
Return Icase( tcExtension = 'DBC', 'd' ;
|
|
, tcExtension = 'DBF', Evl(tcOriginalType, 'D') ;
|
|
, 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' ;
|
|
, tcExtension = 'SPR', 'E' ;
|
|
, tcExtension = 'MPR', 'P' ;
|
|
, Evl(tcOriginalType, 'x') )
|
|
Endproc
|
|
|
|
|
|
Function getTimeStamp
|
|
*---------------------------------------------------------------------------------------------------
|
|
* PARÁMETROS: (v=Pasar por valor | @=Pasar por referencia) (!=Obligatorio | ?=Opcional) (IN/OUT)
|
|
* tnTimeStamp (v! IN ) Timestamp en formato numérico
|
|
*---------------------------------------------------------------------------------------------------
|
|
Lparameters tnTimeStamp
|
|
*-- CONVIERTE UN DATO TIMESTAMP NUMERICO USADO POR LOS ARCHIVOS SCX/VCX/etc. EN TIPO DATETIME
|
|
Try
|
|
Local lcTimeStamp,lnYear,lnMonth,lnDay,lnHour,lnMinutes,lnSeconds,lcTime,lnHour,ltTimeStamp,lnResto ;
|
|
,lcTimeStamp_Ret, laDirInfo[1,5], loEx As Exception
|
|
|
|
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' ;
|
|
, loEx As Exception
|
|
|
|
Try
|
|
loLang = _Screen.o_FoxBin2Prg_Lang
|
|
Store '' To lcVirtualMeta
|
|
Store 0 To lnPos1, lnPos2, lnLastPos, tnPropsAndValues_Count, I
|
|
|
|
lcMetadatos = Alltrim( Strextract( tcLineWithMetadata, tcLeftTag, tcRightTag, 1, 1) )
|
|
|
|
If Empty(lcMetadatos)
|
|
* Puede que la línea esté separada con un CR erróneo. El usuario debe revisarlo
|
|
Error (Textmerge("Can't identify Metadata TAG '<<tcRightTag>>'. May be the Source line have an extra CR/LF?"))
|
|
Endif
|
|
|
|
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, m.I )
|
|
lnPos2 = At( '"', lcMetadatos, m.I + 1 )
|
|
|
|
* Type="V" Cpid="1252"
|
|
* ^ ^ ^ => LastPos, lnPos1 y lnPos2
|
|
taPropsAndValues(tnPropsAndValues_Count,1) = Alltrim( Getwordnum( Substr( lcMetadatos, lnLastPos, lnPos1 - lnLastPos ), 1, '=' ) )
|
|
taPropsAndValues(tnPropsAndValues_Count,2) = Substr( lcMetadatos, lnPos1 + 1, lnPos2 - lnPos1 - 1 )
|
|
|
|
lnLastPos = lnPos2 + 1
|
|
Endfor
|
|
|
|
Catch To loEx
|
|
loEx.UserValue = loEx.UserValue + Textmerge('I=<<I>>, lcMetadatos="<<lcMetadatos>>", tcLineWithMetadata="<<tcLineWithMetadata>>"') + CR_LF
|
|
If This.n_Debug > 0 And _vfp.StartMode = 0
|
|
Set Step On
|
|
Endif
|
|
|
|
Throw
|
|
|
|
Finally
|
|
Release tcLineWithMetadata, taPropsAndValues, tnPropsAndValues_Count, tcLeftTag, tcRightTag ;
|
|
, lcMetadatos, I, lcVirtualMeta, lnPos1, lnPos2, lnLastPos, lnCantComillas
|
|
|
|
Endtry
|
|
|
|
Return
|
|
Endproc
|
|
|
|
|
|
Procedure get_SeparatedLineAndComment
|
|
*---------------------------------------------------------------------------------------------------
|
|
* PARÁMETROS: (v=Pasar por valor | @=Pasar por referencia) (!=Obligatorio | ?=Opcional) (IN/OUT)
|
|
* tcLine (!@ IN/OUT) Línea a separar del comentario
|
|
* tcComment (@? OUT) Comentario
|
|
* tlDeepCommentAnalysis (v? IN ) Indica realizar un análisis profundo de comentarios (para detectar casos complejos de código con '&&' embebido)
|
|
*---------------------------------------------------------------------------------------------------
|
|
Lparameters tcLine As String, tcComment As String, tlDeepCommentAnalysis As Boolean
|
|
Local ln_AT_Cmt
|
|
tcComment = ''
|
|
ln_AT_Cmt = At( '&'+'&', tcLine)
|
|
|
|
If ln_AT_Cmt > 0
|
|
If tlDeepCommentAnalysis Then
|
|
Local laSeparador(3,3), lcSeparadoresIzq, lcSeparadoresDer, lcStr, lnAT_Amp, lnAT1, lnAT2, lnLen, I, X
|
|
|
|
lcStr = tcLine &&EVL(tcStr, [DEFINE BAR 2 OF OpciónAsub PROMPT "Opción A&]+[&2" &]+[& Comentario Opción A-2])
|
|
laSeparador(1,1) = '"'
|
|
laSeparador(1,2) = '"'
|
|
laSeparador(1,3) = 2
|
|
laSeparador(2,1) = "'"
|
|
laSeparador(2,2) = "'"
|
|
laSeparador(2,3) = 2
|
|
laSeparador(3,1) = '['
|
|
laSeparador(3,2) = ']'
|
|
laSeparador(3,3) = 1
|
|
lcSeparadoresIzq = laSeparador(1,1) + laSeparador(2,1) + laSeparador(3,1)
|
|
lcSeparadoresDer = laSeparador(1,2) + laSeparador(2,2) + laSeparador(3,2)
|
|
lnLen = Len(lcStr)
|
|
|
|
*-- Anular subcadenas para luego encontrar comentarios '&&' (y analizar solo si existe al menos un '&&')
|
|
X = 1
|
|
lnAT1 = At(laSeparador(m.X,1), lcStr)
|
|
|
|
*-- Funcionamiento:
|
|
*-- La anulación de subcadenas se hace comenzando desde la primer comilla doble ["], y luego se va
|
|
*-- cancelando hasta la siguiente. A partir de ahi, se busca carácter a carácter el siguiente separador
|
|
*-- izquierdo de cadena ( '"[ ), se busca su pareja derecha y se cancela el texto entre ambos.
|
|
*-- La anulación de subcadenas es temporal, solo para determinar la verdadera posición del comentario,
|
|
*-- por ejemplo, esto:
|
|
*-- DEFINE BAR 2 OF OpciónAsub PROMPT ""+var+'aa'+["bb]+"Opción A&&2" && Comentario Opción A-2
|
|
*-- se convierte temporalmente en esto:
|
|
*-- DEFINE BAR 2 OF OpciónAsub PROMPT XX+var+XXXX+XXXXX+XXXXXXXXXXXXX && Comentario Opción A-2
|
|
*-- lo que facilita encontrar el comentario '&&' real.
|
|
*-- Si se encuentra algún separador de cadena que no cierre, se genera un error 10 (Syntax Error).
|
|
If lnAT1 > 0 Then
|
|
For I = lnAT1+1 To lnLen
|
|
If m.X > 0 Then
|
|
lnAT2 = At(laSeparador(m.X,2), lcStr, laSeparador(m.X,3))
|
|
|
|
If lnAT2 > 0 Then
|
|
lcStr = Stuff(lcStr, lnAT1, lnAT2-lnAT1+1, Replicate('X',lnAT2-lnAT1+1))
|
|
Else
|
|
ln_AT_Cmt = At( '&'+'&', lcStr)
|
|
|
|
If ln_AT_Cmt = 0 Or ln_AT_Cmt < lnAT1
|
|
*-- No tiene comentario '&&' real, o sí lo tiene y además contiene un delimitador de cadena como parte del comentario
|
|
Exit
|
|
Else
|
|
Error 'Closing string delimiter <' + laSeparador(m.X,2) + '> not found: ' + tcLine
|
|
Endif
|
|
Endif
|
|
Endif
|
|
|
|
*-- Verifico si el carácter es un separador de cadenas: '"[
|
|
X = At( Substr(lcStr, m.I, 1), lcSeparadoresIzq)
|
|
|
|
If m.X > 0 Then
|
|
lnAT1 = At(laSeparador(m.X,1), lcStr)
|
|
Endif
|
|
Endfor
|
|
Endif
|
|
|
|
ln_AT_Cmt = At( '&'+'&', lcStr)
|
|
Endif && tlDeepCommentAnalysis
|
|
|
|
If ln_AT_Cmt > 0
|
|
tcComment = Ltrim( Substr( tcLine, ln_AT_Cmt + 2 ) )
|
|
tcLine = Rtrim( Left( tcLine, ln_AT_Cmt - 1 ), 0, Chr(9), ' ' ) && Quito TABS y espacios
|
|
Endif
|
|
|
|
Endif
|
|
|
|
Return (ln_AT_Cmt > 0)
|
|
Endproc
|
|
|
|
|
|
Procedure get_SeparatedPropAndValue
|
|
*-- Devuelve el valor separado de la propiedad.
|
|
*-- Si se indican más de 3 parámetros, evalúa el valor completo a través de las líneas de código (valores multi-línea)
|
|
*--------------------------------------------------------------------------------------------------------------
|
|
* PARÁMETROS: (v=Pasar por valor | @=Pasar por referencia) (!=Obligatorio | ?=Opcional) (IN/OUT)
|
|
* tcAsignacion (v! IN ) Asignación completa con variable, igualdad y valor
|
|
* tcPropName (@! OUT) Nombre de la variable
|
|
* tcValue (@? OUT) Valor
|
|
* toClase (v! IN )
|
|
* taCodeLines (@! IN ) Líneas de código a analizar
|
|
* tnCodeLines (v! IN ) Cantidad de líneas de código
|
|
* I (@! IN/OUT) Línea actual
|
|
*--------------------------------------------------------------------------------------------------------------
|
|
Lparameters tcAsignacion, tcPropName, tcValue, toClase, taCodeLines, tnCodeLines, I
|
|
Local ln_AT_Cmt
|
|
Store '' To tcPropName, tcValue
|
|
|
|
*-- EVALUAR UNA ASIGNACIÓN ESPECÍFICA INLINE
|
|
If '=' $ tcAsignacion
|
|
ln_AT_Cmt = At( '=', tcAsignacion)
|
|
tcPropName = Alltrim( Left( tcAsignacion, ln_AT_Cmt - 2 ), 0, ' ', Chr(9) ) && Quito espacios y TABS
|
|
tcValue = Ltrim( Substr( tcAsignacion, ln_AT_Cmt + 2 ) )
|
|
|
|
If Pcount() > 3
|
|
*-- EVALUAR UNA ASIGNACIÓN QUE PUEDE SER MULTILÍNEA (memberdata, fb2p_value, etc)
|
|
With This As c_conversor_base Of 'FOXBIN2PRG.PRG'
|
|
Do Case
|
|
Case .analyzeAssignmentOf_TAG( @tcPropName, @tcValue, @taCodeLines, tnCodeLines, @m.I ;
|
|
, C_FB2P_VALUE_I, C_FB2P_VALUE_F, C_LEN_FB2P_VALUE_I, C_LEN_FB2P_VALUE_F )
|
|
*-- FB2P_VALUE
|
|
|
|
Case .analyzeAssignmentOf_TAG( @tcPropName, @tcValue, @taCodeLines, tnCodeLines, @m.I ;
|
|
, C_MEMBERDATA_I, C_MEMBERDATA_F, C_LEN_MEMBERDATA_I, C_LEN_MEMBERDATA_F )
|
|
*-- MEMBERDATA
|
|
|
|
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(m.I), CHR(9), ' ' ), ' ', ' ' ), ' ', ' ' ) )
|
|
lcLine = Ltrim( taCodeLines(m.I), 0, Chr(9), ' ' )
|
|
|
|
If .lineIsOnlyCommentAndNoMetadata( @lcLine )
|
|
*-- Optimización: Excluyo las líneas que solo son comentarios
|
|
taLineasExclusion(m.I) = .T.
|
|
*--
|
|
Loop
|
|
Endif
|
|
|
|
lcLine = Upper( Left( lcLine,1 ) ) + Upper( Ltrim( Substr( lcLine, 2 ) ) )
|
|
lnPrimerID = 0
|
|
|
|
For X = 1 To lnID_Bloques_Count
|
|
lnLen_IDFinBQ = Len( ta_ID_Bloques(m.X,2) )
|
|
If .isIndicatedToken( @lcLine, @ta_ID_Bloques, lnLen_IDFinBQ, m.X, 1 ) ;
|
|
AND Not .currentLineIsPreviousLineContinuation( @taCodeLines, m.I )
|
|
lnPrimerID = m.X
|
|
lnAnidamientos = 1
|
|
Exit
|
|
Endif
|
|
Endfor
|
|
|
|
If lnPrimerID > 0 && Se ha identificado un ID de bloque excluyente
|
|
tnBloquesExclusion = tnBloquesExclusion + 1
|
|
Dimension taBloquesExclusion(tnBloquesExclusion,2)
|
|
taBloquesExclusion(tnBloquesExclusion,1) = m.I
|
|
taLineasExclusion(m.I) = .T.
|
|
*--
|
|
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(m.X,2) )
|
|
If .isIndicatedToken( @lcLine, @ta_ID_Bloques, lnLen_IDFinBQ, m.X, 1 ) ;
|
|
AND Not .currentLineIsPreviousLineContinuation( @taCodeLines, m.I )
|
|
lnPrimerID = m.X
|
|
lnAnidamientos = 1
|
|
Exit
|
|
Endif
|
|
Endfor
|
|
|
|
If lnPrimerID > 0 && Se ha identificado un ID de bloque excluyente
|
|
tnBloquesExclusion = tnBloquesExclusion + 1
|
|
Dimension taBloquesExclusion(tnBloquesExclusion,2)
|
|
taBloquesExclusion(tnBloquesExclusion,1) = m.I
|
|
taLineasExclusion(m.I) = .T.
|
|
|
|
* Búsqueda del ID de fin de bloque
|
|
For I = m.I + 1 To tnCodeLines
|
|
* Reduzco los espacios. Ej: '#IF .F. && cmt' ==> '#IF .F.&&cmt'
|
|
*lcLine = LTRIM( STRTRAN( STRTRAN( CHRTRAN( taCodeLines(m.I), CHR(9), ' ' ), ' ', ' ' ), ' ', ' ' ) )
|
|
*lcLine = LTRIM( CHRTRAN( taCodeLines(m.I), CHR(9), ' ' ) )
|
|
lcLine = Ltrim( taCodeLines(m.I), 0, Chr(9), ' ' )
|
|
taLineasExclusion(m.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, m.X, 1 ) ;
|
|
AND Not .currentLineIsPreviousLineContinuation( @taCodeLines, m.I )
|
|
*-- Busca el primer marcador (#IF) NOTA: No busco [TEXT] porque no se pueden anidar.
|
|
lnAnidamientos = lnAnidamientos + 1
|
|
|
|
Case .isIndicatedToken( @lcLine, @ta_ID_Bloques, 0, m.X, 2 )
|
|
*-- Busca el segundo marcador (#ENDIF o ENDTEXT)
|
|
lnAnidamientos = lnAnidamientos - 1
|
|
|
|
If lnAnidamientos = 0
|
|
taBloquesExclusion(tnBloquesExclusion,2) = m.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
|
|
* tlDoNotSeparateLineAndComment (v? IN ) Indica o separar la línea de código del comentario
|
|
* tlDeepCommentAnalysis (v? IN ) Indica realizar un análisis profundo de comentarios (para detectar casos complejos de código con '&&' embebido)
|
|
*---------------------------------------------------------------------------------------------------
|
|
* NOTA: Recordar que esta función suele usarse junto a Set_Line(), que quita TABS y espacios a la izquierda.
|
|
*---------------------------------------------------------------------------------------------------
|
|
Lparameters tcLine As String, tcComment As String, tlDoNotSeparateLineAndComment As Boolean, tlDeepCommentAnalysis As Boolean
|
|
Local lllineIsOnlyCommentAndNoMetadata, ln_AT_Cmt
|
|
|
|
* Búsqueda del ID de fin de bloque
|
|
For I = m.I + 1 To tnCodeLines
|
|
* Reduzco los espacios. Ej: '#IF .F. && cmt' ==> '#IF .F.&&cmt'
|
|
*lcLine = LTRIM( STRTRAN( STRTRAN( CHRTRAN( taCodeLines(m.I), CHR(9), ' ' ), ' ', ' ' ), ' ', ' ' ) )
|
|
*lcLine = LTRIM( CHRTRAN( taCodeLines(m.I), CHR(9), ' ' ) )
|
|
lcLine = Ltrim( taCodeLines(m.I), 0, Chr(9), ' ' )
|
|
taLineasExclusion(m.I) = .T.
|
|
|
|
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, m.X, 1 ) ;
|
|
AND Not .currentLineIsPreviousLineContinuation( @taCodeLines, m.I )
|
|
*-- Busca el primer marcador (#IF) NOTA: No busco [TEXT] porque no se pueden anidar.
|
|
lnAnidamientos = lnAnidamientos + 1
|
|
|
|
Case .isIndicatedToken( @lcLine, @ta_ID_Bloques, 0, m.X, 2 )
|
|
*-- Busca el segundo marcador (#ENDIF o ENDTEXT)
|
|
lnAnidamientos = lnAnidamientos - 1
|
|
|
|
If lnAnidamientos = 0
|
|
taBloquesExclusion(tnBloquesExclusion,2) = m.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
|
|
* tlDoNotSeparateLineAndComment (v? IN ) Indica o separar la línea de código del comentario
|
|
* tlDeepCommentAnalysis (v? IN ) Indica realizar un análisis profundo de comentarios (para detectar casos complejos de código con '&&' embebido)
|
|
*---------------------------------------------------------------------------------------------------
|
|
* NOTA: Recordar que esta función suele usarse junto a Set_Line(), que quita TABS y espacios a la izquierda.
|
|
*---------------------------------------------------------------------------------------------------
|
|
Lparameters tcLine As String, tcComment As String, tlDoNotSeparateLineAndComment As Boolean, tlDeepCommentAnalysis As Boolean
|
|
Local lllineIsOnlyCommentAndNoMetadata, ln_AT_Cmt
|
|
|
|
With This As c_conversor_base Of 'FOXBIN2PRG.PRG'
|
|
If tlDoNotSeparateLineAndComment
|
|
tcComment = ''
|
|
Else
|
|
.get_SeparatedLineAndComment( @tcLine, @tcComment, tlDeepCommentAnalysis )
|
|
Endif
|
|
|
|
Do Case
|
|
Case Left(tcLine,2) == '*<'
|
|
tcComment = tcLine
|
|
|
|
Case Empty(tcLine) Or Left(tcLine, 1) == '*' ;
|
|
OR Upper(Left(tcLine + ' ', 5)) == 'NOTE ' ; && Vacía o Comentarios
|
|
And Not Upper(Left(tcLine + ' ', 6)) == 'NOTE =' && Excluir asignaciones
|
|
*
|
|
lllineIsOnlyCommentAndNoMetadata = .T.
|
|
|
|
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
|
|
|
|
Procedure loadModule
|
|
*---------------------------------------------------------------------------------------------------
|
|
* PARÁMETROS: (v=Pasar por valor | @=Pasar por referencia) (!=Obligatorio | ?=Opcional) (IN/OUT)
|
|
* toModulo (!@ OUT) Objeto generado de clase correspondiente con la información leida del texto
|
|
* toEx (!@ OUT) Objeto con información del error
|
|
* toFoxBin2Prg (!@ IN ) Referencia al objeto principal
|
|
*---------------------------------------------------------------------------------------------------
|
|
Lparameters toModulo, toEx As Exception, toFoxBin2Prg
|
|
#If .F.
|
|
Local toFoxBin2Prg As c_foxbin2prg Of 'FOXBIN2PRG.PRG'
|
|
#Endif
|
|
*LOCAL loLang as CL_LANG OF 'FOXBIN2PRG.PRG'
|
|
*loLang = _SCREEN.o_FoxBin2Prg_Lang
|
|
*THIS.writeLog( C_TAB + loLang.C_CONVERTING_FILE_LOC + ' ' + THIS.c_OutputFile + '...' )
|
|
*RELEASE loLang
|
|
Return
|
|
Endproc
|
|
|
|
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
|
|
|
|
|
|
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 normalizeXMLValue
|
|
Lparameters tcValor
|
|
*-- NORMALIZA EL TEXTO INDICADO, COMPRIMIENDO LOS SÍMBOLOS XML ESPECIALES.
|
|
tcValor = Strtran(tcValor, Chr(38), Chr(38) + 'amp;') && reemplaza & por & &&
|
|
tcValor = Strtran(tcValor, Chr(39), Chr(38) + 'apos;') && reemplaza ' por ' &&
|
|
tcValor = Strtran(tcValor, Chr(34), Chr(38) + 'quot;') && reemplaza " por " &&
|
|
tcValor = Strtran(tcValor, '<', Chr(38) + 'lt;') && reemplaza < por < &&
|
|
tcValor = Strtran(tcValor, '>', Chr(38) + 'gt;') && reemplaza > por > &&
|
|
tcValor = Strtran(tcValor, Chr(13)+Chr(10), Chr(10)) && reeemplaza CR+LF por LF
|
|
tcValor = Chrtran(tcValor, Chr(13), Chr(10)) && reemplaza CR por LF
|
|
|
|
Procedure 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
|
|
* <<>> <<CHRTRAN( STREXTRACT( tcValue, '<memberdata ', '/>', m.I, 1+4 ), CR_LF, ' ' )>>
|
|
*ENDTEXT
|
|
lcValue = lcValue + Chr(13) + Chr(10) + Chr(9) + Chr(9) + Chrtran( Strextract( tcValue, '<memberdata ', '/>', m.I, 1+4 ), CR_LF, ' ' )
|
|
Endfor
|
|
|
|
TEXT TO tcValue TEXTMERGE NOSHOW FLAGS 1 PRETEXT 1+2
|
|
<VFPData>
|
|
<<SUBSTR( lcValue, 3)>>
|
|
<<>> </VFPData>
|
|
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
|
|
|
|
#Else
|
|
Do Case
|
|
Case .c_ClaseActual == 'checkbox'
|
|
lnPos = Ascan( .a_SpecialProps_Chk, lcPropName, 1, 0, 1, 1+2+4 )
|
|
|
|
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 ;
|
|
, lnSelect, lcObjName
|
|
lnArrayCols = Alen( taPropsAndValues, 2 )
|
|
lnSelect = Select()
|
|
Dimension laPropsAndValues( tnPropsAndValues_Count, lnArrayCols )
|
|
Acopy( taPropsAndValues, laPropsAndValues )
|
|
|
|
With This As c_conversor_base Of 'FOXBIN2PRG.PRG'
|
|
If m.tnSortType > 0
|
|
* CON SORT:
|
|
* - A las que no tienen '.' les pongo 'A' por delante, y al resto 'B' por delante para que queden al final
|
|
|
|
* ATENCIÓN: 10/07/2018
|
|
* Cuando hay ADD OBJECT multicontenedor (obj.obj.obj...), el reordenamiento
|
|
* puede producir daños colaterales, como objetos mal colocados.
|
|
* (Era de esperar: No todo se puede ordenar alfabéticamente)
|
|
* Un solución de compromiso podría ser al menos mantener juntos los objetos de mismo nombre,
|
|
* que en la práctica pueden estar todos mezclados. Al menos eso no rompería nada.
|
|
* VER: https://github.com/fdbozzo/foxbin2prg/issues/28
|
|
*
|
|
* PASO 1: Obtener los nombres únicos y asignarles un código de orden
|
|
Create Cursor C_OBJ (OBJNAME C(50), IORDER I Autoinc)
|
|
Index On OBJNAME Tag OBJNAME
|
|
|
|
* PASO 2: Configurar las prioridades de ordenamiento (primero props, luego objs)
|
|
For I = 1 To m.tnPropsAndValues_Count
|
|
If '.' $ laPropsAndValues(m.I,1)
|
|
If m.tnSortType = 2
|
|
* Genera obj+props para BIN
|
|
lcObjName = Getwordnum(laPropsAndValues(m.I,1), 1, '.')
|
|
|
|
If Not Seek(Lower(lcObjName), "C_OBJ")
|
|
Insert Into C_OBJ (OBJNAME) Values (Lower(lcObjName))
|
|
Endif
|
|
|
|
laPropsAndValues(m.I,1) = 'B' + Padl(C_OBJ.IORDER,3,'0') ;
|
|
+ Juststem(laPropsAndValues(m.I,1)) + '.' ;
|
|
+ .sortPropsAndValues_SetAndGetSCXPropNames( 'SETNAME', Justext(laPropsAndValues(m.I,1)) )
|
|
|
|
*laPropsAndValues(m.I,1) = 'B000' + lcObjName + '.' ;
|
|
+ .sortPropsAndValues_SetAndGetSCXPropNames( 'SETNAME', JUSTEXT(laPropsAndValues(m.I,1)) )
|
|
Else
|
|
* Genera obj+props para TX2
|
|
lcObjName = Getwordnum(laPropsAndValues(m.I,1), 1, '.')
|
|
|
|
If Not Seek(Lower(lcObjName), "C_OBJ")
|
|
Insert Into C_OBJ (OBJNAME) Values (Lower(lcObjName))
|
|
Endif
|
|
|
|
laPropsAndValues(m.I,1) = 'B' + Padl(C_OBJ.IORDER,3,'0') ;
|
|
+ Juststem(laPropsAndValues(m.I,1)) + '.' ;
|
|
+ Justext(laPropsAndValues(m.I,1))
|
|
|
|
*laPropsAndValues(m.I,1) = 'B' + PADL(I,3,'0') + laPropsAndValues(m.I,1)
|
|
Endif
|
|
Else
|
|
If m.tnSortType = 2
|
|
* Genera obj+props para BIN
|
|
laPropsAndValues(m.I,1) = .sortPropsAndValues_SetAndGetSCXPropNames( 'SETNAME', laPropsAndValues(m.I,1) )
|
|
Else
|
|
* Genera obj+props para TX2
|
|
laPropsAndValues(m.I,1) = 'A000' + laPropsAndValues(m.I,1)
|
|
Endif
|
|
Endif
|
|
Endfor
|
|
|
|
* Paso 3: Ordenar según la prioridad previa
|
|
If .l_PropSort_Enabled
|
|
Asort( laPropsAndValues, 1, -1, 0, 1)
|
|
Endif
|
|
|
|
|
|
* Paso 4: Quitar metadatos y rearmar array
|
|
For I = 1 To m.tnPropsAndValues_Count
|
|
*-- Quitar caracteres agregados antes del SORT
|
|
If '.' $ laPropsAndValues(m.I,1)
|
|
If m.tnSortType = 2
|
|
* Genera obj+props para BIN
|
|
taPropsAndValues(m.I,1) = Juststem( Substr( laPropsAndValues(m.I,1), 2+3 ) ) + '.' ;
|
|
+ .sortPropsAndValues_SetAndGetSCXPropNames( 'GETNAME', Justext(laPropsAndValues(m.I,1)) )
|
|
Else
|
|
* Genera obj+props para TX2
|
|
taPropsAndValues(m.I,1) = Substr( laPropsAndValues(m.I,1), 2+3 )
|
|
Endif
|
|
Else
|
|
If m.tnSortType = 2
|
|
* Genera obj+props para BIN
|
|
taPropsAndValues(m.I,1) = .sortPropsAndValues_SetAndGetSCXPropNames( 'GETNAME', laPropsAndValues(m.I,1) )
|
|
Else
|
|
* Genera obj+props para TX2
|
|
taPropsAndValues(m.I,1) = Substr( laPropsAndValues(m.I,1), 2+3 )
|
|
Endif
|
|
Endif
|
|
|
|
taPropsAndValues(m.I,2) = laPropsAndValues(m.I,2)
|
|
|
|
If lnArrayCols >= 3
|
|
taPropsAndValues(m.I,3) = laPropsAndValues(m.I,3)
|
|
Endif
|
|
Endfor
|
|
|
|
Else && m.tnSortType = 0
|
|
*-- SIN SORT: Creo 2 arrays, el bueno y el temporal, y al terminar agrego el temporal al bueno.
|
|
*-- Debo separar las props.normales de las de los objetos (ocurre cuando es un ADD OBJECT)
|
|
X = 0
|
|
|
|
*-- PRIMERO las que no tienen punto
|
|
For I = 1 To m.tnPropsAndValues_Count
|
|
If Empty( laPropsAndValues(m.I,1) )
|
|
Loop
|
|
Endif
|
|
|
|
If Not '.' $ laPropsAndValues(m.I,1)
|
|
X = m.X + 1
|
|
taPropsAndValues(m.X,1) = laPropsAndValues(m.I,1)
|
|
taPropsAndValues(m.X,2) = laPropsAndValues(m.I,2)
|
|
If lnArrayCols >= 3
|
|
taPropsAndValues(m.X,3) = laPropsAndValues(m.I,3)
|
|
Endif
|
|
Endif
|
|
Endfor
|
|
|
|
*-- LUEGO las demás props.
|
|
For I = 1 To m.tnPropsAndValues_Count
|
|
If Empty( laPropsAndValues(m.I,1) )
|
|
Loop
|
|
Endif
|
|
|
|
If '.' $ laPropsAndValues(m.I,1)
|
|
X = m.X + 1
|
|
taPropsAndValues(m.X,1) = laPropsAndValues(m.I,1)
|
|
taPropsAndValues(m.X,2) = laPropsAndValues(m.I,2)
|
|
If lnArrayCols >= 3
|
|
taPropsAndValues(m.X,3) = laPropsAndValues(m.I,3)
|
|
Endif
|
|
Endif
|
|
Endfor
|
|
Endif
|
|
Endwith && THIS AS C_CONVERSOR_BASE OF 'FOXBIN2PRG.PRG'
|
|
|
|
|
|
Catch To loEx
|
|
If This.n_Debug > 0 And _vfp.StartMode = 0
|
|
Set Step On
|
|
Endif
|
|
|
|
Throw
|
|
|
|
Finally
|
|
Release taPropsAndValues, tnPropsAndValues_Count, tnSortType ;
|
|
, I, X, lnArrayCols, laPropsAndValues, lcPropName, lcSortedMemo, lcMethods
|
|
Use In (Select("C_OBJ"))
|
|
Select (lnSelect)
|
|
Endtry
|
|
|
|
Return
|
|
Endproc
|
|
|
|
|
|
|
|
Procedure sortSpecialProps
|
|
Try
|
|
Local I, loEx As Exception, lcPropsFile
|
|
lcPropsFile = ''
|
|
|
|
With This As conversor_base Of "FOXBIN2PRG.PRG"
|
|
*-- (TODAS) => Antes era solo FORM
|
|
#If .F.
|
|
*-- 03/04/2015 FDBOZZO
|
|
*-- Quise comparar la velocidad de los ASCAN(array) contra un SEEK a una tabla de propiedades con índice, y resulta que para
|
|
*-- unas 1500 propiedades casi no hay diferencias (10 segundos en unos 1600 archivos) :(
|
|
Use (Fullpath( 'foxbin2prg_keywords', .c_Foxbin2prg_FullPath )) Shared Noupdate Again In 0 Order PK && C_CLASS+C_KEYWORD
|
|
#Else
|
|
I = 0
|
|
|
|
lcPropsFile = Forcepath( "props_all.txt", Justpath( .c_Foxbin2prg_FullPath ) )
|
|
I = Alines( .a_SpecialProps, Filetostr( lcPropsFile ), 1+4 )
|
|
|
|
lcPropsFile = Forcepath( "props_checkbox.txt", Justpath( .c_Foxbin2prg_FullPath ) )
|
|
I = Alines( .a_SpecialProps_Chk, Filetostr( lcPropsFile ), 1+4 )
|
|
|
|
lcPropsFile = Forcepath( "props_collection.txt", Justpath( .c_Foxbin2prg_FullPath ) )
|
|
I = Alines( .a_SpecialProps_Coll, Filetostr( lcPropsFile ), 1+4 )
|
|
|
|
lcPropsFile = Forcepath( "props_combobox.txt", Justpath( .c_Foxbin2prg_FullPath ) )
|
|
I = Alines( .a_SpecialProps_Cbo, Filetostr( lcPropsFile ), 1+4 )
|
|
|
|
lcPropsFile = Forcepath( "props_commandgroup.txt", Justpath( .c_Foxbin2prg_FullPath ) )
|
|
I = Alines( .a_SpecialProps_Cmg, Filetostr( lcPropsFile ), 1+4 )
|
|
|
|
lcPropsFile = Forcepath( "props_commandbutton.txt", Justpath( .c_Foxbin2prg_FullPath ) )
|
|
I = Alines( .a_SpecialProps_Cmd, Filetostr( lcPropsFile ), 1+4 )
|
|
|
|
lcPropsFile = Forcepath( "props_cursor.txt", Justpath( .c_Foxbin2prg_FullPath ) )
|
|
I = Alines( .a_SpecialProps_Cur, Filetostr( lcPropsFile ), 1+4 )
|
|
|
|
lcPropsFile = Forcepath( "props_cursoradapter.txt", Justpath( .c_Foxbin2prg_FullPath ) )
|
|
I = Alines( .a_SpecialProps_CA, Filetostr( lcPropsFile ), 1+4 )
|
|
|
|
lcPropsFile = Forcepath( "props_dataenvironment.txt", Justpath( .c_Foxbin2prg_FullPath ) )
|
|
I = Alines( .a_SpecialProps_DE, Filetostr( lcPropsFile ), 1+4 )
|
|
|
|
lcPropsFile = Forcepath( "props_editbox.txt", Justpath( .c_Foxbin2prg_FullPath ) )
|
|
I = Alines( .a_SpecialProps_Edt, Filetostr( lcPropsFile ), 1+4 )
|
|
|
|
lcPropsFile = Forcepath( "props_formset.txt", Justpath( .c_Foxbin2prg_FullPath ) )
|
|
I = Alines( .a_SpecialProps_Frs, Filetostr( lcPropsFile ), 1+4 )
|
|
|
|
*lcPropsFile = FORCEPATH( "props_grid.txt", JUSTPATH( .c_Foxbin2prg_FullPath ) )
|
|
*I = ALINES( .a_SpecialProps_Grd, FILETOSTR( lcPropsFile ), 1+4 )
|
|
|
|
lcPropsFile = Forcepath( "props_grid_column.txt", Justpath( .c_Foxbin2prg_FullPath ) )
|
|
I = Alines( .a_SpecialProps_Grc, Filetostr( lcPropsFile ), 1+4 )
|
|
|
|
lcPropsFile = Forcepath( "props_grid_header.txt", Justpath( .c_Foxbin2prg_FullPath ) )
|
|
I = Alines( .a_SpecialProps_Grh, Filetostr( lcPropsFile ), 1+4 )
|
|
|
|
lcPropsFile = Forcepath( "props_hyperlink.txt", Justpath( .c_Foxbin2prg_FullPath ) )
|
|
I = Alines( .a_SpecialProps_Hlk, Filetostr( lcPropsFile ), 1+4 )
|
|
|
|
lcPropsFile = Forcepath( "props_image.txt", Justpath( .c_Foxbin2prg_FullPath ) )
|
|
I = Alines( .a_SpecialProps_Img, Filetostr( lcPropsFile ), 1+4 )
|
|
|
|
lcPropsFile = Forcepath( "props_label.txt", Justpath( .c_Foxbin2prg_FullPath ) )
|
|
I = Alines( .a_SpecialProps_Lbl, Filetostr( lcPropsFile ), 1+4 )
|
|
|
|
lcPropsFile = Forcepath( "props_line.txt", Justpath( .c_Foxbin2prg_FullPath ) )
|
|
I = Alines( .a_SpecialProps_Lin, Filetostr( lcPropsFile ), 1+4 )
|
|
|
|
lcPropsFile = Forcepath( "props_listbox.txt", Justpath( .c_Foxbin2prg_FullPath ) )
|
|
I = Alines( .a_SpecialProps_Lst, Filetostr( lcPropsFile ), 1+4 )
|
|
|
|
lcPropsFile = Forcepath( "props_olebound.txt", Justpath( .c_Foxbin2prg_FullPath ) )
|
|
I = Alines( .a_SpecialProps_Ole, Filetostr( lcPropsFile ), 1+4 )
|
|
|
|
lcPropsFile = Forcepath( "props_optiongroup.txt", Justpath( .c_Foxbin2prg_FullPath ) )
|
|
I = Alines( .a_SpecialProps_Opg, Filetostr( lcPropsFile ), 1+4 )
|
|
|
|
lcPropsFile = Forcepath( "props_optiongroup_option.txt", Justpath( .c_Foxbin2prg_FullPath ) )
|
|
I = Alines( .a_SpecialProps_Opb, Filetostr( lcPropsFile ), 1+4 )
|
|
|
|
lcPropsFile = Forcepath( "props_projecthook.txt", Justpath( .c_Foxbin2prg_FullPath ) )
|
|
I = Alines( .a_SpecialProps_Phk, Filetostr( lcPropsFile ), 1+4 )
|
|
|
|
lcPropsFile = Forcepath( "props_relation.txt", Justpath( .c_Foxbin2prg_FullPath ) )
|
|
I = Alines( .a_SpecialProps_Rel, Filetostr( lcPropsFile ), 1+4 )
|
|
|
|
lcPropsFile = Forcepath( "props_reportlistener.txt", Justpath( .c_Foxbin2prg_FullPath ) )
|
|
I = Alines( .a_SpecialProps_Rls, Filetostr( lcPropsFile ), 1+4 )
|
|
|
|
lcPropsFile = Forcepath( "props_separator.txt", Justpath( .c_Foxbin2prg_FullPath ) )
|
|
I = Alines( .a_SpecialProps_Sep, Filetostr( lcPropsFile ), 1+4 )
|
|
|
|
lcPropsFile = Forcepath( "props_shape.txt", Justpath( .c_Foxbin2prg_FullPath ) )
|
|
I = Alines( .a_SpecialProps_Shp, Filetostr( lcPropsFile ), 1+4 )
|
|
|
|
lcPropsFile = Forcepath( "props_spinner.txt", Justpath( .c_Foxbin2prg_FullPath ) )
|
|
I = Alines( .a_SpecialProps_Spn, Filetostr( lcPropsFile ), 1+4 )
|
|
|
|
lcPropsFile = Forcepath( "props_textbox.txt", Justpath( .c_Foxbin2prg_FullPath ) )
|
|
I = Alines( .a_SpecialProps_Txt, Filetostr( lcPropsFile ), 1+4 )
|
|
|
|
lcPropsFile = Forcepath( "props_timer.txt", Justpath( .c_Foxbin2prg_FullPath ) )
|
|
I = Alines( .a_SpecialProps_Tmr, Filetostr( lcPropsFile ), 1+4 )
|
|
|
|
*lcPropsFile = FORCEPATH( "props_toolbar.txt", JUSTPATH( .c_Foxbin2prg_FullPath ) )
|
|
*I = ALINES( .a_SpecialProps_Tbr, FILETOSTR( lcPropsFile ), 1+4 )
|
|
|
|
lcPropsFile = Forcepath( "props_xmladapter.txt", Justpath( .c_Foxbin2prg_FullPath ) )
|
|
I = Alines( .a_SpecialProps_XMLAda, Filetostr( lcPropsFile ), 1+4 )
|
|
|
|
lcPropsFile = Forcepath( "props_xmlfield.txt", Justpath( .c_Foxbin2prg_FullPath ) )
|
|
I = Alines( .a_SpecialProps_XMLFld, Filetostr( lcPropsFile ), 1+4 )
|
|
|
|
lcPropsFile = Forcepath( "props_xmltable.txt", Justpath( .c_Foxbin2prg_FullPath ) )
|
|
I = Alines( .a_SpecialProps_XMLTbl, Filetostr( lcPropsFile ), 1+4 )
|
|
#Endif
|
|
|
|
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 = [<VFPData>] ;
|
|
+ [<memberdata name="analyzecodeblock_add_object" display="analyzeCodeBlock_ADD_OBJECT"/>] ;
|
|
+ [<memberdata name="analyzecodeblock_defined_pam" display="analyzeCodeBlock_DEFINED_PAM"/>] ;
|
|
+ [<memberdata name="analyzecodeblock_define_class" display="analyzeCodeBlock_DEFINE_CLASS"/>] ;
|
|
+ [<memberdata name="analyzecodeblock_enddefine" display="analyzeCodeBlock_ENDDEFINE"/>] ;
|
|
+ [<memberdata name="analyzecodeblock_foxbin2prg" display="analyzeCodeBlock_FoxBin2Prg"/>] ;
|
|
+ [<memberdata name="analyzecodeblock_libcomment" display="analyzeCodeBlock_LIBCOMMENT"/>] ;
|
|
+ [<memberdata name="analyzecodeblock_hidden" display="analyzeCodeBlock_HIDDEN"/>] ;
|
|
+ [<memberdata name="analyzecodeblock_include" display="analyzeCodeBlock_INCLUDE"/>] ;
|
|
+ [<memberdata name="analyzecodeblock_classcomments" display="analyzeCodeBlock_CLASSCOMMENTS"/>] ;
|
|
+ [<memberdata name="analyzecodeblock_classmetadata" display="analyzeCodeBlock_CLASSMETADATA"/>] ;
|
|
+ [<memberdata name="analyzecodeblock_external_class" display="analyzeCodeBlock_EXTERNAL_CLASS"/>] ;
|
|
+ [<memberdata name="analyzecodeblock_external_member" display="analyzeCodeBlock_EXTERNAL_MEMBER"/>] ;
|
|
+ [<memberdata name="analyzecodeblock_objectmetadata" display="analyzeCodeBlock_OBJECTMETADATA"/>] ;
|
|
+ [<memberdata name="analyzecodeblock_ole_def" display="analyzeCodeBlock_OLE_DEF"/>] ;
|
|
+ [<memberdata name="analyzecodeblock_procedure" display="analyzeCodeBlock_PROCEDURE"/>] ;
|
|
+ [<memberdata name="analyzecodeblock_protected" display="analyzeCodeBlock_PROTECTED"/>] ;
|
|
+ [<memberdata name="analyzeprocedurelines" display="analyzeProcedureLines"/>] ;
|
|
+ [<memberdata name="classmethods2memo" display="classMethods2Memo"/>] ;
|
|
+ [<memberdata name="classprops2memo" display="classProps2Memo"/>] ;
|
|
+ [<memberdata name="createclasslib" display="createClasslib"/>] ;
|
|
+ [<memberdata name="createclasslib_recordheader" display="createClasslib_RecordHeader"/>] ;
|
|
+ [<memberdata name="createform" display="createForm"/>] ;
|
|
+ [<memberdata name="createform_recordheader" display="createForm_RecordHeader"/>] ;
|
|
+ [<memberdata name="createproject" display="createProject"/>] ;
|
|
+ [<memberdata name="createproject_recordheader" display="createProject_RecordHeader"/>] ;
|
|
+ [<memberdata name="createreport" display="createReport"/>] ;
|
|
+ [<memberdata name="createmenu" display="createMenu"/>] ;
|
|
+ [<memberdata name="defined_pam2memo" display="defined_PAM2Memo"/>] ;
|
|
+ [<memberdata name="writebinaryfile" display="writeBinaryFile"/>] ;
|
|
+ [<memberdata name="evaluate_pam" display="evaluate_PAM"/>] ;
|
|
+ [<memberdata name="evaluateproceduredefinition" display="evaluateProcedureDefinition"/>] ;
|
|
+ [<memberdata name="getclassmethodcomment" display="getClassMethodComment"/>] ;
|
|
+ [<memberdata name="getclasspropertycomment" display="getClassPropertyComment"/>] ;
|
|
+ [<memberdata name="get_valuebyname_fromlistnameswithvalues" display="get_ValueByName_FromListNamesWithValues"/>] ;
|
|
+ [<memberdata name="hiddenandprotected_pam" display="hiddenAndProtected_PAM"/>] ;
|
|
+ [<memberdata name="insert_allobjects" display="insert_AllObjects"/>] ;
|
|
+ [<memberdata name="insert_object" display="insert_Object"/>] ;
|
|
+ [<memberdata name="objectmethods2memo" display="objectMethods2Memo"/>] ;
|
|
+ [<memberdata name="set_line" display="set_Line"/>] ;
|
|
+ [<memberdata name="strip_dimensions" display="strip_Dimensions"/>] ;
|
|
+ [<memberdata name="verify_external_classes" display="verify_EXTERNAL_CLASSES"/>] ;
|
|
+ [</VFPData>]
|
|
|
|
|
|
|
|
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 <FOXBIN2PRG>
|
|
*------------------------------------------------------
|
|
Lparameters toModulo, tcLine, taCodeLines, I, tnCodeLines
|
|
|
|
Local llBloqueEncontrado, laPropsAndValues(1,2), lnPropsAndValues_Count
|
|
|
|
If Upper( Left( tcLine + ' ', Len(C_FB2PRG_META_I) + 1 ) ) == C_FB2PRG_META_I + ' '
|
|
With This As c_conversor_prg_a_bin Of foxbin2prg.prg
|
|
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 *<LIBCOMMENT: Comentarios />
|
|
*------------------------------------------------------
|
|
Lparameters toModulo, tcLine, taCodeLines, I, tnCodeLines
|
|
|
|
Local llBloqueEncontrado, laPropsAndValues(1,2), lnPropsAndValues_Count
|
|
|
|
If Upper( Left( tcLine, Len(C_LIBCOMMENT_I) ) ) == C_LIBCOMMENT_I
|
|
llBloqueEncontrado = .T.
|
|
|
|
*-- Metadatos del módulo
|
|
toModulo._Comment = Alltrim( Strextract( tcLine, C_LIBCOMMENT_I, C_LIBCOMMENT_F ) )
|
|
Endif
|
|
|
|
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 ;
|
|
, User ;
|
|
, Key ) ;
|
|
VALUES ;
|
|
( Upper( Forcepath( Evl(This.c_OriginalFileName,This.c_OutputFile), toProject._HomeDir) ) + Chr(0) ;
|
|
, 'H' ;
|
|
, 0 ;
|
|
, '<Source>' + Chr(0) ;
|
|
, Lower(toProject._HomeDir) + Chr(0) ;
|
|
, toProject._SaveCode ;
|
|
, toProject._Debug ;
|
|
, toProject._Encrypted ;
|
|
, toProject._NoLogo ;
|
|
, toProject._CmntStyle ;
|
|
, 260 ;
|
|
, toProject.getRowDeviceInfo() ;
|
|
, Lower(toProject._HomeDir) + Chr(0) ;
|
|
, Upper( Forcepath( Evl(This.c_OriginalFileName,This.c_OutputFile), toProject._HomeDir) ) + Chr(0) ;
|
|
, toProject._ServerHead.getRowServerInfo() ;
|
|
, toProject._SccData ;
|
|
, .T. ;
|
|
, Strconv(toProject._User,14) ;
|
|
, Upper( Juststem( This.c_OutputFile) ) )
|
|
|
|
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 (<fb2p_value>) y con CR+LF (<fb2p_value>)
|
|
* HEIGHT = 2.73
|
|
* NAME = "c1"
|
|
* prop1 = .F. && Mi prop 1
|
|
* prop_especial_cr = <fb2p_value>Este es el valor 1 Este el 2 Y Este bajo Shift_Enter el 3</fb2p_value>
|
|
* prop_especial_crlf = <fb2p_value>
|
|
* Este es el valor 1
|
|
* Este el 2
|
|
* Y Este bajo Shift_Enter el 3
|
|
* </fb2p_value>
|
|
* WIDTH = 27.40
|
|
* _MEMBERDATA = <VFPData>
|
|
* <memberdata NAME="mimetodo" DISPLAY="miMetodo"/>
|
|
* <memberdata NAME="mimetodo2" DISPLAY="miMetodo2"/>
|
|
* </VFPData> && 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(m.I, 1) + '.' ) > 0 Then
|
|
Loop
|
|
Endif
|
|
lcMemo = lcMemo + laPropsAndValues(m.I,1) + ' = ' + laPropsAndValues(m.I,2) + CR_LF
|
|
Endfor
|
|
Endwith
|
|
Endif && toClase._Prop_Count > 0
|
|
|
|
Catch To loEx
|
|
If This.n_Debug > 0 And _vfp.StartMode = 0
|
|
Set Step On
|
|
Endif
|
|
|
|
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(m.I,1) + ' = ' + laPropsAndValues(m.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(m.I)
|
|
|
|
If loProcedure._ProcLine_Count > 0 Then
|
|
.updateProgressbar( 'Generating Procedure ' + toClase._Nombre + '.' + loProcedure._Nombre + '...', m.I, toClase._Procedure_Count, 2 )
|
|
|
|
If '.' $ loProcedure._Nombre
|
|
*-- cboNombre.InteractiveChange ==> No debe acortarse por ser método modificado de combobox heredado de la clase
|
|
*-- cntDatos.txtEdad.Valid ==> Debe acortarse si cntDatos es un objeto existente
|
|
lcNombreObjeto = Left( loProcedure._Nombre, At('.', loProcedure._Nombre) - 1 )
|
|
|
|
If .findMethodsObjectByName( lcNombreObjeto, toClase ) = 0
|
|
TEXT TO lcMemo ADDITIVE TEXTMERGE NOSHOW FLAGS 1 PRETEXT 1+2
|
|
<<C_PROCEDURE>> <<loProcedure._Nombre>>
|
|
ENDTEXT
|
|
*lcMemo = lcMemo + C_PROCEDURE + ' ' + loProcedure._Nombre
|
|
Else
|
|
TEXT TO lcMemo ADDITIVE TEXTMERGE NOSHOW FLAGS 1 PRETEXT 1+2
|
|
<<C_PROCEDURE>> <<SUBSTR( loProcedure._Nombre, AT('.', loProcedure._Nombre) + 1 )>>
|
|
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
|
|
<<C_PROCEDURE>> <<loProcedure._Nombre>>
|
|
ENDTEXT
|
|
*lcMemo = lcMemo + C_PROCEDURE + ' ' + loProcedure._Nombre
|
|
Endif
|
|
|
|
*-- Incluir las líneas del método
|
|
*.updateProgressbar( 'Generating Lines of Procedure ' + toClase._Nombre + '.' + loProcedure._Nombre + '...', m.I, toClase._Procedure_Count, 2 )
|
|
For X = 1 To loProcedure._ProcLine_Count
|
|
*TEXT TO lcMemo ADDITIVE TEXTMERGE NOSHOW FLAGS 1+2 PRETEXT 1+2
|
|
* <<loProcedure._ProcLines(m.X)>>
|
|
*ENDTEXT
|
|
lcMemo = lcMemo + Chr(13) + Chr(10) + loProcedure._ProcLines(m.X)
|
|
Endfor
|
|
|
|
TEXT TO lcMemo ADDITIVE TEXTMERGE NOSHOW FLAGS 1+2 PRETEXT 1+2
|
|
<<C_ENDPROC>>
|
|
<<>>
|
|
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(m.I)
|
|
|
|
TEXT TO lcMemo ADDITIVE TEXTMERGE NOSHOW FLAGS 1 PRETEXT 1+2
|
|
<<C_PROCEDURE>> <<loProcedure._Nombre>>
|
|
ENDTEXT
|
|
|
|
*-- Incluir las líneas del método
|
|
For X = 1 To loProcedure._ProcLine_Count
|
|
lcMemo = lcMemo + Chr(13) + Chr(10) + loProcedure._ProcLines(m.X)
|
|
Endfor
|
|
|
|
TEXT TO lcMemo ADDITIVE TEXTMERGE NOSHOW FLAGS 1+2 PRETEXT 1+2
|
|
<<C_ENDPROC>>
|
|
<<>>
|
|
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(m.I,1), 1, '=' ) ) == tcPropName
|
|
lcComentario = toClase._Props( m.I, 2 )
|
|
Exit
|
|
Endif
|
|
Endfor
|
|
|
|
Release tcPropName, toClase, I
|
|
Return lcComentario
|
|
Endproc
|
|
|
|
|
|
|
|
Procedure getClassMethodComment
|
|
*---------------------------------------------------------------------------------------------------
|
|
* PARÁMETROS: (v=Pasar por valor | @=Pasar por referencia) (!=Obligatorio | ?=Opcional) (IN/OUT)
|
|
* tcLine (@! IN/OUT) Línea a separar del comentario (En este punto, el único comentario puede ser un HELPSTRING)
|
|
* tcComment (@? OUT) Comentario
|
|
*---------------------------------------------------------------------------------------------------
|
|
Lparameters tcLine As String, tcComment As String
|
|
|
|
#If .F.
|
|
Local toClase As CL_CLASE Of 'FOXBIN2PRG.PRG'
|
|
#Endif
|
|
|
|
Local lnATC
|
|
tcComment = ''
|
|
lnATC = Atc("HELPSTRING", tcLine)
|
|
|
|
If lnATC > 0
|
|
tcComment = Alltrim(Substr(tcLine, lnATC + 10 ))
|
|
|
|
* Quitar comillas
|
|
tcComment = Substr(tcComment, 2, Len(tcComment) - 2)
|
|
|
|
tcLine = Rtrim(Left(tcLine, lnATC - 1 ), 0, Chr(9), Chr(0), ' ')
|
|
Endif
|
|
|
|
Return tcComment
|
|
Endproc
|
|
|
|
|
|
|
|
Procedure getTextFrom_BIN_FileStructure
|
|
Try
|
|
Local lcStructure, lnSelect
|
|
lnSelect = Select()
|
|
Select 0
|
|
Use (This.c_InputFile) Shared Again Alias _TABLABIN
|
|
Copy Structure Extended To ( Forcepath( '_FRX_STRUC.DBF', Addbs( This.c_TempDir ) ) )
|
|
**** CONTINUAR SI ES NECESARIO - SIN USO POR AHORA /// DO NOT USE - NOT IMPLEMENTED!
|
|
|
|
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, m.I )
|
|
lnPos2 = At( ']', tcSeparatedCommaVars, m.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, m.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
|
|
If Justext(toFoxBin2Prg.c_InputFile) = toFoxBin2Prg.c_PJ2
|
|
* Solo los PJX/PJ2 tienen el campo DEVINFO
|
|
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 ;
|
|
, DEVINFO ) ;
|
|
VALUES ;
|
|
( 'WINDOWS' ;
|
|
, toObjeto._UniqueID ;
|
|
, toObjeto._TimeStamp ;
|
|
, toObjeto._Class ;
|
|
, toObjeto._ClassLib ;
|
|
, toObjeto._BaseClass ;
|
|
, toObjeto._ObjName ;
|
|
, toObjeto._Parent ;
|
|
, lcPropsMemo ;
|
|
, '' ;
|
|
, lcMethodsMemo ;
|
|
, toObjeto._Ole ;
|
|
, toObjeto._Ole2 ;
|
|
, '' ;
|
|
, '' ;
|
|
, '' ;
|
|
, '' ;
|
|
, '' ;
|
|
, '' ;
|
|
, '' ;
|
|
, '' ;
|
|
, Strconv(toObjeto._User,14) ;
|
|
, Strconv(toObjeto._DevInfo,14) )
|
|
Else
|
|
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 ;
|
|
, '' ;
|
|
, '' ;
|
|
, '' ;
|
|
, '' ;
|
|
, '' ;
|
|
, '' ;
|
|
, '' ;
|
|
, '' ;
|
|
, Strconv(toObjeto._User,14) )
|
|
Endif
|
|
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( m.X )
|
|
|
|
If Empty(loObjeto._TimeStamp)
|
|
loObjeto._TimeStamp = .rowTimeStamp( {^2013/11/04 20:00:00} )
|
|
Endif
|
|
If Empty(loObjeto._UniqueID)
|
|
loObjeto._UniqueID = toFoxBin2Prg.unique_ID()
|
|
Endif
|
|
|
|
laObjNames( m.X, 1 ) = loObjeto._Nombre
|
|
laObjNames( m.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( m.X, 1 )
|
|
|
|
For Each loObjeto In toClase._AddObjects FoxObject
|
|
*-- Verifico que sea el objeto que corresponde
|
|
If loObjeto._WriteOrder = 0 And Lower(loObjeto._Nombre) == Lower(lcObjName)
|
|
N = N + 1
|
|
loObjeto._WriteOrder = N
|
|
.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(m.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 = m.I + 1 To tnCodeLines
|
|
.set_Line( @tcLine, @taCodeLines, m.I )
|
|
|
|
If Not .excludedLine( m.I, tnBloquesExclusion, @taLineasExclusion ) ;
|
|
AND Not .lineIsOnlyCommentAndNoMetadata( @tcLine, @tc_Comentario )
|
|
|
|
Do Case
|
|
Case Upper( Left( tcLine + ' ', 8 ) ) == 'ENDPROC ' ; && Fin del PROCEDURE
|
|
Or Upper( Left( tcLine + ' ', 8 ) ) == 'ENDFUNC ' && Fin de la FUNCTION
|
|
|
|
tcProcedureAbierto = ''
|
|
Exit
|
|
|
|
Case Upper( Left( tcLine + ' ', 10 ) ) == 'ENDDEFINE ' && Fin de bloque (ENDDEFINE) encontrado
|
|
If llEsProcedureDeClase
|
|
*ERROR 'Error de anidamiento de estructuras. Se esperaba ENDPROC y se encontró ENDDEFINE en la clase ' ;
|
|
+ toClase._Nombre + ' (' + loProcedure._Nombre + ')' ;
|
|
+ ', línea ' + TRANSFORM(m.I) + ' del archivo ' + .c_InputFile
|
|
Error (Textmerge(loLang.C_STRUCTURE_NESTING_ERROR_ENDPROC_EXPECTED_LOC))
|
|
Else
|
|
*ERROR 'Error de anidamiento de estructuras. Se esperaba ENDPROC y se encontró ENDDEFINE en la clase ' ;
|
|
+ toClase._Nombre + ' (' + toObjeto._Nombre + '.' + loProcedure._Nombre + ')' ;
|
|
+ ', línea ' + TRANSFORM(m.I) + ' del archivo ' + .c_InputFile
|
|
Error (Textmerge(loLang.C_STRUCTURE_NESTING_ERROR_ENDPROC_EXPECTED_2_LOC))
|
|
Endif
|
|
Endcase
|
|
Endif
|
|
|
|
*-- Quito 2 TABS de la izquierda (si se puede y si el integrador/desarrollador no la lió quitándolos)
|
|
Do Case
|
|
Case Left( taCodeLines(m.I),2 ) = C_TAB + C_TAB
|
|
loProcedure.add_Line( Substr(taCodeLines(m.I), 3) )
|
|
Case Left( taCodeLines(m.I),1 ) = C_TAB
|
|
loProcedure.add_Line( Substr(taCodeLines(m.I), 2) )
|
|
Otherwise
|
|
loProcedure.add_Line( taCodeLines(m.I) )
|
|
Endcase
|
|
Endfor
|
|
Endwith && THIS
|
|
|
|
Catch To loEx
|
|
If This.n_Debug > 0 And _vfp.StartMode = 0
|
|
Set Step On
|
|
Endif
|
|
|
|
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 Upper( Left( tcLine, 11 ) ) == 'ADD OBJECT '
|
|
*-- Estructura a reconocer: ADD OBJECT 'frm_a.Check1' AS check [WITH]
|
|
With This As c_conversor_prg_a_bin Of foxbin2prg.prg
|
|
Local laPropsAndValues(1,2), lnPropsAndValues_Count, Z, lcProp, lcValue, lcNombre, lcObjName, lnPos ;
|
|
, loLang As CL_LANG Of 'FOXBIN2PRG.PRG'
|
|
|
|
llBloqueEncontrado = .T.
|
|
loLang = _Screen.o_FoxBin2Prg_Lang
|
|
tcLine = Chrtran( tcLine, ['], ["] )
|
|
|
|
If Empty(toClase._Fin_Cab)
|
|
toClase._Fin_Cab = m.I-1
|
|
toClase._Ini_Cuerpo = m.I
|
|
Endif
|
|
|
|
toObjeto = Null
|
|
lcNombre = Alltrim( Chrtran( Strextract(tcLine, 'ADD OBJECT ', ' AS ', 1, 1), ['"], [] ) )
|
|
lcObjName = Justext( '.' + lcNombre )
|
|
.updateProgressbar( 'Analyzing Block Add Object ' + toClase._Nombre + '.' + lcObjName + '...', m.I, tnCodeLines, 1 )
|
|
|
|
If toClase.l_ObjectMetadataInHeader
|
|
For Z = 1 To toClase._AddObject_Count
|
|
If Lower(toClase._AddObjects(m.Z)._Nombre) == Lower(lcNombre) Then
|
|
toObjeto = toClase._AddObjects(m.Z)
|
|
Exit
|
|
Endif
|
|
Endfor
|
|
Endif
|
|
|
|
If Isnull(toObjeto)
|
|
Z = 0
|
|
toObjeto = Createobject('CL_OBJETO')
|
|
*-- Luego se reasigna el ZOrder, pero si no lo hace, se pone último como si se acabara de agregar.
|
|
*-- Puede pasar si se agrega manualmente al TX2 y se olvida agregar la metadata OBJECTDATA.
|
|
toObjeto._ZOrder = 9999
|
|
toObjeto._Nombre = lcNombre
|
|
Endif
|
|
|
|
toObjeto._ObjName = lcObjName
|
|
|
|
If '.' $ toObjeto._Nombre
|
|
toObjeto._Parent = toClase._ObjName + '.' + Juststem( toObjeto._Nombre )
|
|
Else
|
|
toObjeto._Parent = toClase._ObjName
|
|
Endif
|
|
|
|
toObjeto._Nombre = toObjeto._Parent + '.' + toObjeto._ObjName
|
|
toObjeto._Class = Alltrim( Strextract(tcLine + ' WITH', ' AS ', ' WITH', 1, 1) )
|
|
|
|
*-- Chequeo de nombre de objeto repetido para el mismo contenedor
|
|
If toClase._aPathObjName_Count > 0
|
|
lnPos = Ascan( toClase._aPathObjNames, toObjeto._Nombre, 1, 0, 1, 1+2+4+8 )
|
|
|
|
If lnPos > 0 Then
|
|
*-- ERROR: Objeto Duplicado
|
|
.writeErrorLog( '* ' + loLang.C_DUPLICATED_OBJECT_LOC + ' "' + toClase._Class + '.' + toObjeto._Nombre ;
|
|
+ '" @line ' + Transform(m.I) + ', (1st.Line:' + Transform(toClase._aPathObjNames(lnPos,2)) + ')' )
|
|
Endif
|
|
Endif
|
|
|
|
If Not toClase.l_ObjectMetadataInHeader Or m.Z=0
|
|
toClase.add_Object( toObjeto )
|
|
Endif
|
|
|
|
toClase.add_PathObjName(toObjeto._Nombre, m.I)
|
|
|
|
*-- Propiedades del ADD OBJECT
|
|
For I = m.I + 1 To tnCodeLines
|
|
.set_Line( @tcLine, @taCodeLines, m.I )
|
|
|
|
If Upper( Left( tcLine, C_LEN_END_OBJECT_I) ) == C_END_OBJECT_I && Fin del ADD OBJECT y METADATOS
|
|
*< END OBJECT: baseclass = "olecontrol" Uniqueid = "_3X50L3I7V" OLEObject = "C:\WINDOWS\system32\FOXTLIB.OCX" checksum = "4101493921" />
|
|
|
|
.get_ListNamesWithValuesFrom_InLine_MetadataTag( @tcLine, @laPropsAndValues, @lnPropsAndValues_Count ;
|
|
, C_END_OBJECT_I, C_END_OBJECT_F )
|
|
|
|
toObjeto._ClassLib = .get_ValueByName_FromListNamesWithValues( 'ClassLib', 'C', @laPropsAndValues )
|
|
toObjeto._BaseClass = .get_ValueByName_FromListNamesWithValues( 'BaseClass', 'C', @laPropsAndValues )
|
|
|
|
If Not toClase.l_ObjectMetadataInHeader
|
|
toObjeto._UniqueID = .get_ValueByName_FromListNamesWithValues( 'UniqueID', 'C', @laPropsAndValues )
|
|
toObjeto._TimeStamp = Int( .rowTimeStamp( .get_ValueByName_FromListNamesWithValues( 'TimeStamp', 'T', @laPropsAndValues ) ) )
|
|
toObjeto._ZOrder = .get_ValueByName_FromListNamesWithValues( 'ZOrder', 'I', @laPropsAndValues )
|
|
Endif
|
|
|
|
toObjeto._Ole2 = .get_ValueByName_FromListNamesWithValues( 'OLEObject', 'C', @laPropsAndValues )
|
|
toObjeto._Ole = Strconv( .get_ValueByName_FromListNamesWithValues( 'Value', 'C', @laPropsAndValues ), 14 )
|
|
|
|
If Not Empty( toObjeto._Ole2 ) && Le agrego "OLEObject = " delante
|
|
toObjeto._Ole2 = 'OLEObject = ' + toObjeto._Ole2 + CR_LF
|
|
Endif
|
|
|
|
*-- Ubico el objeto ole por su nombre (parent+objname), que no se repite.
|
|
If Empty(toObjeto._Ole) && Si _Ole está vacío es porque el propio control no tiene la info y está en la cabecera (antiguo guardado)
|
|
If toModulo.existeObjetoOLE( toObjeto._Nombre, @m.Z )
|
|
toObjeto._Ole = toModulo._Ole_Objs(m.Z)._Value
|
|
Endif
|
|
Endif
|
|
|
|
Exit
|
|
Endif
|
|
|
|
If Right(tcLine, 3) == ', ;' && VALOR INTERMEDIO CON ", ;"
|
|
.get_SeparatedPropAndValue( Left(tcLine, Len(tcLine) - 3), @lcProp, @lcValue, toClase, @taCodeLines, @tnCodeLines, @m.I )
|
|
|
|
*
|
|
* Skip ZOrderSet if configured to
|
|
*
|
|
If toFoxBin2Prg.l_RemoveZOrderSetFromProps And Atc( '.ZOrderSet.', '.' + lcProp + '.' ) > 0 Then
|
|
Loop
|
|
Endif
|
|
toObjeto.add_Property( @lcProp, @lcValue )
|
|
Else && VALOR FINAL SIN ", ;" (JUSTO ANTES DEL <END OBJECT>)
|
|
.get_SeparatedPropAndValue( tcLine, @lcProp, @lcValue, toClase, @taCodeLines, @tnCodeLines, @m.I )
|
|
|
|
*
|
|
* Skip ZOrderSet if configured to
|
|
*
|
|
If toFoxBin2Prg.l_RemoveZOrderSetFromProps And Atc( '.ZOrderSet.', '.' + lcProp + '.' ) > 0 Then
|
|
Loop
|
|
Endif
|
|
toObjeto.add_Property( @lcProp, @lcValue )
|
|
Endif
|
|
|
|
Endfor
|
|
Endwith && THIS
|
|
Endif
|
|
|
|
Catch To loEx
|
|
loEx.UserValue = loEx.UserValue + Textmerge('Source line=<<I>>') + CR_LF
|
|
If This.n_Debug > 0 And _vfp.StartMode = 0
|
|
Set Step On
|
|
Endif
|
|
|
|
Throw
|
|
|
|
Finally
|
|
Release toModulo, toClase, tcLine, I, taCodeLines, tnCodeLines ;
|
|
, laPropsAndValues, lnPropsAndValues_Count, Z, lcProp, lcValue, lcNombre, lcObjName
|
|
Endtry
|
|
|
|
Return llBloqueEncontrado
|
|
Endproc
|
|
|
|
|
|
|
|
|
|
Procedure analyzeCodeBlock_DEFINED_PAM
|
|
*--------------------------------------------------------------------------------------------------------------
|
|
* 07/01/2014 FDBOZZO Los *métodos deben ir siempre al final, si no los eventos ACCESS no se ejecutan!
|
|
*--------------------------------------------------------------------------------------------------------------
|
|
* PARÁMETROS: (v=Pasar por valor | @=Pasar por referencia) (!=Obligatorio | ?=Opcional) (IN/OUT)
|
|
* toClase (!@ IN ) Objeto de la Clase
|
|
* tcLine (!@ IN ) Línea de datos en evaluación
|
|
* taCodeLines (!@ IN ) El array con las líneas del código de texto donde buscar
|
|
* tnCodeLines (!@ IN ) Cantidad de líneas de código
|
|
* I (!@ IN ) Número de línea en evaluación
|
|
*--------------------------------------------------------------------------------------------------------------
|
|
Lparameters toClase, tcLine, taCodeLines, tnCodeLines, I
|
|
|
|
*-- ESTRUCTURA A ANALIZAR (también se admite sin los símbolos ^ y *):
|
|
*<DefinedPropArrayMethod>
|
|
*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
|
|
*</DefinedPropArrayMethod>
|
|
|
|
#If .F.
|
|
Local toClase As CL_CLASE Of 'FOXBIN2PRG.PRG'
|
|
#Endif
|
|
|
|
Try
|
|
Local llBloqueEncontrado, lcDefinedPAM, lnPos, lnPos2, lcPAM_Name, lcItem, lcMethods, lcPAM_Type
|
|
|
|
If Left( tcLine, C_LEN_DEFINED_PAM_I) == C_DEFINED_PAM_I
|
|
llBloqueEncontrado = .T.
|
|
Store '' To lcDefinedPAM, lcItem, lcMethods
|
|
|
|
With This As c_conversor_prg_a_bin Of foxbin2prg.prg
|
|
For I = m.I + 1 To tnCodeLines
|
|
.set_Line( @tcLine, @taCodeLines, m.I )
|
|
|
|
Do Case
|
|
Case Left( tcLine, C_LEN_DEFINED_PAM_F ) == C_DEFINED_PAM_F
|
|
I = m.I + 1
|
|
Exit
|
|
|
|
Otherwise
|
|
lnPos = At( ':', tcLine, 1 )
|
|
lnPos2 = At( '&'+'&', tcLine )
|
|
lcPAM_Type = Left(tcLine,3) && *p:, *a:, *m:
|
|
|
|
If lnPos2 > 0
|
|
*-- Con comentarios
|
|
lcPAM_Name = Lower( Alltrim( Substr( tcLine, lnPos+1, lnPos2 - lnPos - 1 ), 0, ' ', Chr(9) ) )
|
|
lcItem = lcPAM_Name + ' ' + Substr( tcLine, lnPos2 + 3 ) + CR_LF
|
|
|
|
Else
|
|
*-- Sin comentarios
|
|
lcPAM_Name = Lower( Alltrim( Substr( tcLine, lnPos+1 ), 0, ' ', Chr(9) ) )
|
|
lcItem = lcPAM_Name + Iif( lcPAM_Type == '*p:' , '', ' ') + CR_LF
|
|
|
|
Endif
|
|
|
|
*-- Separo propiedades y métodos
|
|
If lcPAM_Type == '*m:'
|
|
If Left(lcItem,1) == '*'
|
|
lcMethods = lcMethods + lcItem
|
|
Else
|
|
lcMethods = lcMethods + '*' + lcItem
|
|
Endif
|
|
Else
|
|
If lcPAM_Type == '*a:' And Left(lcItem,1) <> '^'
|
|
lcDefinedPAM = lcDefinedPAM + '^' + lcItem
|
|
Else
|
|
lcDefinedPAM = lcDefinedPAM + lcItem
|
|
Endif
|
|
Endif
|
|
Endcase
|
|
Endfor
|
|
Endwith && THIS
|
|
|
|
*-- Junto propiedades y los métodos al final.
|
|
toClase._Defined_PAM = lcDefinedPAM + lcMethods
|
|
I = m.I - 1
|
|
Endif
|
|
|
|
Catch To loEx
|
|
lnCodError = loEx.ErrorNo
|
|
|
|
If This.n_Debug > 0 And _vfp.StartMode = 0
|
|
Set Step On
|
|
Endif
|
|
|
|
Throw
|
|
|
|
Finally
|
|
Release toClase, tcLine, taCodeLines, tnCodeLines, I ;
|
|
, lcDefinedPAM, lnPos, lnPos2, lcPAM_Name, lcItem, lcMethods, lcPAM_Type
|
|
Endtry
|
|
|
|
Return llBloqueEncontrado
|
|
Endproc
|
|
|
|
|
|
|
|
|
|
Procedure analyzeCodeBlock_DEFINE_CLASS
|
|
*--------------------------------------------------------------------------------------------------------------
|
|
* PARÁMETROS: (v=Pasar por valor | @=Pasar por referencia) (!=Obligatorio | ?=Opcional) (IN/OUT)
|
|
* toModulo (!@ IN ) Objeto del Modulo
|
|
* toClase (!@ IN ) Objeto de la Clase
|
|
* tcLine (!@ IN ) Línea de datos en evaluación
|
|
* taCodeLines (!@ IN ) El array con las líneas del código de texto donde buscar
|
|
* I (!@ IN ) Número de línea en evaluación
|
|
* tnCodeLines (!@ IN ) Cantidad de líneas de código
|
|
* tcProcedureAbierto (!v IN ) Nombre del Procedure abierto
|
|
* taLineasExclusion (!@ IN ) Array de líneas de exclusión
|
|
* tnBloquesExclusion (!@ IN ) Cantidad de líneas de exclusión
|
|
* tc_Comentario (!v IN ) Comentario
|
|
* toFoxBin2Prg (@? IN ) Referencia al objeto principal
|
|
*--------------------------------------------------------------------------------------------------------------
|
|
Lparameters toModulo, toClase, tcLine, taCodeLines, I, tnCodeLines, tcProcedureAbierto ;
|
|
, 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 Upper(Left(tcLine + ' ', 13)) == C_DEFINE_CLASS + ' '
|
|
Try
|
|
llBloqueEncontrado = .T.
|
|
Local Z, lcProp, lcValue, loEx As Exception ;
|
|
, llCLASSMETADATA_Completed, llPROTECTED_Completed, llHIDDEN_Completed, llDEFINED_PAM_Completed ;
|
|
, llINCLUDE_Completed, llCLASS_PROPERTY_Completed, llOBJECTMETADATA_Completed ;
|
|
, llCLASSCOMMENTS_Completed ;
|
|
, loObjeto As CL_OBJETO Of 'FOXBIN2PRG.PRG' ;
|
|
, loLang As CL_LANG Of 'FOXBIN2PRG.PRG'
|
|
|
|
loLang = _Screen.o_FoxBin2Prg_Lang
|
|
Store '' To tcProcedureAbierto
|
|
toClase = Createobject('CL_CLASE')
|
|
toClase._Nombre = Lower( Alltrim( Strextract( tcLine, 'DEFINE CLASS ', ' AS ', 1, 1 ) ) )
|
|
toClase._ObjName = Lower( toClase._Nombre )
|
|
toClase._Definicion = Alltrim( tcLine )
|
|
If Not ' OF ' $ Upper(tcLine) && Puede no tener "OF libreria.vcx"
|
|
toClase._Class = Alltrim( Chrtran( Strextract( tcLine + ' OLEPUBLIC', ' AS ', ' OLEPUBLIC', 1, 1 ), ["'], [] ) )
|
|
Else
|
|
toClase._Class = Alltrim( Chrtran( Strextract( tcLine + ' OF ', ' AS ', ' OF ', 1, 1 ), ["'], [] ) )
|
|
Endif
|
|
toClase._ClassLoc = Lower( Alltrim( Chrtran( Strextract( tcLine + ' OLEPUBLIC', ' OF ', ' OLEPUBLIC', 1, 1 ), ["'], [] ) ) )
|
|
toClase._OlePublic = ' OLEPUBLIC' $ Upper(tcLine)
|
|
toClase._Comentario = tc_Comentario
|
|
toClase._Inicio = m.I
|
|
toClase._Ini_Cab = m.I + 1
|
|
|
|
toModulo.add_Class( toClase )
|
|
|
|
*-- Ubico el objeto ole por su nombre (parent+objname), que no se repite.
|
|
If toModulo.existeObjetoOLE( toClase._Nombre, @m.Z )
|
|
toClase._Ole = toModulo._Ole_Objs(m.Z)._Value
|
|
Endif
|
|
|
|
* Búsqueda del ID de fin de bloque (ENDDEFINE)
|
|
With This As c_conversor_prg_a_bin Of 'FOXBIN2PRG.PRG'
|
|
For I = toClase._Ini_Cab To tnCodeLines
|
|
tc_Comentario = ''
|
|
.set_Line( @tcLine, @taCodeLines, m.I )
|
|
|
|
Do Case
|
|
Case .lineIsOnlyCommentAndNoMetadata( @tcLine, @tc_Comentario )
|
|
Loop
|
|
|
|
Case .analyzeCodeBlock_PROCEDURE( @toModulo, @toClase, @loObjeto, @tcLine, @taCodeLines, @m.I, @tnCodeLines ;
|
|
, @tcProcedureAbierto, @tc_Comentario, @taLineasExclusion, @tnBloquesExclusion )
|
|
*-- OJO: Esta se analiza primero a propósito, solo porque no puede estar detrás de PROTECTED y HIDDEN
|
|
Store .T. To llCLASSCOMMENTS_Completed ;
|
|
, llCLASS_PROPERTY_Completed ;
|
|
, llPROTECTED_Completed ;
|
|
, llHIDDEN_Completed ;
|
|
, llINCLUDE_Completed ;
|
|
, llCLASSMETADATA_Completed ;
|
|
, llOBJECTMETADATA_Completed ;
|
|
, llDEFINED_PAM_Completed
|
|
|
|
|
|
Case Not llPROTECTED_Completed And .analyzeCodeBlock_PROTECTED( @toClase, @tcLine )
|
|
llPROTECTED_Completed = .T.
|
|
|
|
|
|
Case Not llHIDDEN_Completed And .analyzeCodeBlock_HIDDEN( @toClase, @tcLine )
|
|
llHIDDEN_Completed = .T.
|
|
|
|
|
|
Case Not llINCLUDE_Completed And .c_Type <> "SCX" And .analyzeCodeBlock_INCLUDE( @toModulo, @toClase, @tcLine, @taCodeLines ;
|
|
, @m.I, @tnCodeLines, @tcProcedureAbierto )
|
|
llINCLUDE_Completed = .T.
|
|
|
|
|
|
Case Not llCLASSCOMMENTS_Completed And .analyzeCodeBlock_CLASSCOMMENTS( @toClase, @tcLine ,@taCodeLines, tnCodeLines, @m.I )
|
|
llCLASSCOMMENTS_Completed = .T.
|
|
|
|
|
|
Case Not llCLASSMETADATA_Completed And .analyzeCodeBlock_CLASSMETADATA( @toClase, @tcLine )
|
|
llCLASSMETADATA_Completed = .T.
|
|
|
|
|
|
Case Not llOBJECTMETADATA_Completed And .analyzeCodeBlock_OBJECTMETADATA( @toClase, @tcLine )
|
|
* No se usa flag porque puede haber múltiples ObjectMetadata.
|
|
|
|
|
|
Case Not llDEFINED_PAM_Completed And .analyzeCodeBlock_DEFINED_PAM( @toClase, @tcLine, @taCodeLines, tnCodeLines, @m.I )
|
|
llDEFINED_PAM_Completed = .T.
|
|
|
|
|
|
Case .analyzeCodeBlock_ADD_OBJECT( @toModulo, @toClase, @tcLine, @m.I, @taCodeLines, @tnCodeLines, @toFoxBin2Prg )
|
|
Store .T. To llCLASSCOMMENTS_Completed ;
|
|
, llCLASS_PROPERTY_Completed ;
|
|
, llPROTECTED_Completed ;
|
|
, llHIDDEN_Completed ;
|
|
, llINCLUDE_Completed ;
|
|
, llCLASSMETADATA_Completed ;
|
|
, llOBJECTMETADATA_Completed ;
|
|
, llDEFINED_PAM_Completed
|
|
|
|
|
|
Case .analyzeCodeBlock_ENDDEFINE( @toClase, @tcLine, @m.I, @tcProcedureAbierto )
|
|
Exit
|
|
|
|
|
|
Case Not llCLASS_PROPERTY_Completed And Empty( toClase._Fin_Cab )
|
|
*-- Propiedades de la CLASE
|
|
*--
|
|
*-- NOTA: Las propiedades se agregan tal cual, incluso aunque estén separadas en
|
|
*-- varias líneas (memberdata y fb2p_value), ya que luego se ensamblan en classProps2Memo().
|
|
*
|
|
.get_SeparatedPropAndValue( tcLine, @lcProp, @lcValue, @toClase, @taCodeLines, tnCodeLines, @m.I )
|
|
toClase.add_Property( @lcProp, @lcValue, Rtrim(tc_Comentario) )
|
|
|
|
|
|
Otherwise
|
|
*-- Las líneas que pasan por aquí deberían estar vacías y ser de relleno del embellecimiento
|
|
|
|
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 Upper( Left( tcLine + ' ', 10 ) ) == C_ENDDEFINE + ' ' && Fin de bloque (ENDDEF / ENDPROC) encontrado
|
|
llBloqueEncontrado = .T.
|
|
toClase._Fin = m.I
|
|
|
|
If Empty( toClase._Ini_Cuerpo )
|
|
toClase._Ini_Cuerpo = m.I-1
|
|
Endif
|
|
|
|
toClase._Fin_Cuerpo = m.I-1
|
|
|
|
If Empty( toClase._Fin_Cab )
|
|
toClase._Fin_Cab = m.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 Upper(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 Upper(Left(tcLine, 9)) == '#INCLUDE '
|
|
llBloqueEncontrado = .T.
|
|
If This.c_Type = 'SCX'
|
|
toModulo._includeFile = Lower( Alltrim( Chrtran( Substr( tcLine, 10 ), ["'], [] ) ) )
|
|
Else
|
|
toClase._includeFile = Lower( Alltrim( Chrtran( Substr( tcLine, 10 ), ["'], [] ) ) )
|
|
Endif
|
|
Endif
|
|
|
|
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 = m.I + 1 To tnCodeLines
|
|
.set_Line( @tcLine, @taCodeLines, m.I )
|
|
|
|
Do Case
|
|
Case Left( tcLine, C_LEN_CLASSCOMMENTS_F ) == C_CLASSCOMMENTS_F
|
|
I = m.I + 1
|
|
Exit
|
|
|
|
Otherwise
|
|
toClase._Comentario = toClase._Comentario + CR_LF + Substr( tcLine, 2 ) && Le quito el '*' inicial
|
|
Endcase
|
|
Endfor
|
|
Endwith && THIS
|
|
|
|
I = m.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 Upper(Left(tcLine, C_LEN_CLASSDATA_I)) == C_CLASSDATA_I && METADATA de la CLASE
|
|
*< CLASSDATA: Baseclass="custom" Timestamp="2013/11/19 11:51:04" Scale="Foxels" Uniqueid="_3WF0VSTN1" ProjectClassIcon="container.ico" ClassIcon="toolbar.ico" />
|
|
Local laPropsAndValues(1,2), lnPropsAndValues_Count
|
|
llBloqueEncontrado = .T.
|
|
With This
|
|
.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 Upper(Left(tcLine, C_LEN_EXTERNAL_CLASS_I)) == C_EXTERNAL_CLASS_I
|
|
Local laPropsAndValues(1,2), lnPropsAndValues_Count
|
|
llBloqueEncontrado = .T.
|
|
|
|
With This As c_conversor_prg_a_bin Of 'FOXBIN2PRG.PRG'
|
|
.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 Upper(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 Upper(Left(tcLine, C_LEN_OBJECTDATA_I)) == C_OBJECTDATA_I && METADATA del ADD OBJECT
|
|
*< OBJECTDATA: ObjName="txtValor" Timestamp="2013/11/19 11:51:04" Uniqueid="_3WF0VSTN1" />
|
|
Local laPropsAndValues(1,2), lnPropsAndValues_Count, loObjeto As CL_OBJETO Of 'FOXBIN2PRG.PRG'
|
|
llBloqueEncontrado = .T.
|
|
toClase.l_ObjectMetadataInHeader = .T.
|
|
|
|
loObjeto = Null
|
|
loObjeto = Createobject('CL_OBJETO')
|
|
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(m.Z)._CheckSum == loOle._CheckSum And Not Empty( toModulo._Ole_Objs(m.Z)._Value )
|
|
loOle._Value = toModulo._Ole_Objs(m.Z)._Value
|
|
Exit
|
|
Endif
|
|
Endfor
|
|
Endif
|
|
|
|
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 Upper( Left( tcLine, 20 ) ) == 'PROTECTED PROCEDURE '
|
|
*-- Estructura a reconocer: PROTECTED PROCEDURE nombre_del_procedimiento
|
|
llBloqueEncontrado = .T.
|
|
tcProcedureAbierto = Alltrim( Substr( tcLine, 21 ) )
|
|
.getClassMethodComment( @tcProcedureAbierto, @tc_Comentario )
|
|
.evaluateProcedureDefinition( @toClase, m.I, @tc_Comentario, tcProcedureAbierto, 'protected', @toObjeto )
|
|
|
|
|
|
Case Upper( Left( tcLine, 17 ) ) == 'HIDDEN PROCEDURE '
|
|
*-- Estructura a reconocer: HIDDEN PROCEDURE nombre_del_procedimiento
|
|
llBloqueEncontrado = .T.
|
|
tcProcedureAbierto = Alltrim( Substr( tcLine, 18 ) )
|
|
.getClassMethodComment( @tcProcedureAbierto, @tc_Comentario )
|
|
.evaluateProcedureDefinition( @toClase, m.I, @tc_Comentario, tcProcedureAbierto, 'hidden', @toObjeto )
|
|
|
|
Case Upper( Left( tcLine, 10 ) ) == 'PROCEDURE '
|
|
*-- Estructura a reconocer: PROCEDURE [objeto.]nombre_del_procedimiento
|
|
llBloqueEncontrado = .T.
|
|
tcProcedureAbierto = Alltrim( Substr( tcLine, 11 ) )
|
|
.getClassMethodComment( @tcProcedureAbierto, @tc_Comentario )
|
|
.evaluateProcedureDefinition( @toClase, m.I, @tc_Comentario, tcProcedureAbierto, 'normal', @toObjeto )
|
|
|
|
Case Upper( Left( tcLine, 19 ) ) == 'PROTECTED FUNCTION '
|
|
*-- Estructura a reconocer: PROTECTED PROCEDURE nombre_del_procedimiento
|
|
llBloqueEncontrado = .T.
|
|
tcProcedureAbierto = Alltrim( Substr( tcLine, 20 ) )
|
|
.getClassMethodComment( @tcProcedureAbierto, @tc_Comentario )
|
|
.evaluateProcedureDefinition( @toClase, m.I, @tc_Comentario, tcProcedureAbierto, 'protected', @toObjeto )
|
|
|
|
|
|
Case Upper( Left( tcLine, 16 ) ) == 'HIDDEN FUNCTION '
|
|
*-- Estructura a reconocer: HIDDEN FUNCTION nombre_del_procedimiento
|
|
llBloqueEncontrado = .T.
|
|
tcProcedureAbierto = Alltrim( Substr( tcLine, 17 ) )
|
|
.getClassMethodComment( @tcProcedureAbierto, @tc_Comentario )
|
|
.evaluateProcedureDefinition( @toClase, m.I, @tc_Comentario, tcProcedureAbierto, 'hidden', @toObjeto )
|
|
|
|
Case Upper( Left( tcLine, 9 ) ) == 'FUNCTION '
|
|
*-- Estructura a reconocer: FUNCTION [objeto.]nombre_del_procedimiento
|
|
llBloqueEncontrado = .T.
|
|
tcProcedureAbierto = Alltrim( Substr( tcLine, 10 ) )
|
|
.getClassMethodComment( @tcProcedureAbierto, @tc_Comentario )
|
|
.evaluateProcedureDefinition( @toClase, m.I, @tc_Comentario, tcProcedureAbierto, 'normal', @toObjeto )
|
|
|
|
Endcase
|
|
|
|
If llBloqueEncontrado
|
|
*-- Evalúo todo el contenido del PROCEDURE
|
|
.updateProgressbar( 'Analyzing Procedure ' + toClase._Nombre + '.' + tcProcedureAbierto + '...', m.I, tnCodeLines, 1 )
|
|
.analyzeProcedureLines( @toClase, @toObjeto, @tcLine, @taCodeLines, @m.I, @tnCodeLines, @tcProcedureAbierto ;
|
|
, @tc_Comentario, @taLineasExclusion, @tnBloquesExclusion )
|
|
Endif
|
|
Endwith
|
|
|
|
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 Upper(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 = m.I-1
|
|
toClase._Ini_Cuerpo = m.I
|
|
Endif
|
|
|
|
loProcedure = Null
|
|
loProcedure = Createobject("CL_PROCEDURE")
|
|
loProcedure._Nombre = tcProcName
|
|
loProcedure._ProcType = tcProcType
|
|
loProcedure._Comentario = tc_Comentario
|
|
loProcedure._Inicio = m.I
|
|
|
|
*-- 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, m.I )
|
|
|
|
Do Case
|
|
Case .excludedLine( m.I, tnBloquesExclusion, @taLineasExclusion ) ;
|
|
OR .lineIsOnlyCommentAndNoMetadata( @lcLine, @lc_Comentario ) && Excluida, vacía o solo Comentarios
|
|
|
|
Case .analyzeCodeBlock_DEFINE_CLASS( @toModulo, @loClase, @lcLine, @taCodeLines, @m.I, tnCodeLines ;
|
|
, @lcProcedureAbierto, @taLineasExclusion, @tnBloquesExclusion, @lc_Comentario, @toFoxBin2Prg )
|
|
*-- Puede haber varias clases definidas
|
|
* llEXTERNAL_CLASS_Completed = .T.
|
|
|
|
*-- 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, m.I )
|
|
|
|
Do Case
|
|
Case .lineIsOnlyCommentAndNoMetadata( @lcLine, @lc_Comentario ) && Excluida, vacía o solo Comentarios
|
|
|
|
Case Not llFoxBin2Prg_Completed And .analyzeCodeBlock_FoxBin2Prg( @toModulo, @lcLine, @taCodeLines, @m.I, tnCodeLines )
|
|
llFoxBin2Prg_Completed = .T.
|
|
|
|
Case Not llEXTERNAL_CLASS_Completed And .analyzeCodeBlock_EXTERNAL_CLASS( @toModulo, @lcLine, @taCodeLines, @m.I, tnCodeLines )
|
|
*-- Puede haber varias clases externas
|
|
|
|
Case Not llLIBCOMMENT_Completed And .analyzeCodeBlock_LIBCOMMENT( @toModulo, @lcLine, @taCodeLines, @m.I, tnCodeLines )
|
|
llLIBCOMMENT_Completed = .T.
|
|
llEXTERNAL_CLASS_Completed = .T.
|
|
|
|
Case Not llOLE_DEF_Completed And .analyzeCodeBlock_OLE_DEF( @toModulo, @lcLine, @taCodeLines ;
|
|
, @m.I, tnCodeLines, @lcProcedureAbierto )
|
|
*-- Puede haber varios objetos OLE
|
|
|
|
Case Not llINCLUDE_SCX_Completed And .c_Type = 'SCX' And .analyzeCodeBlock_INCLUDE( @toModulo, @loClase, @lcLine ;
|
|
, @taCodeLines, @m.I, tnCodeLines, @lcProcedureAbierto )
|
|
* Específico para SCX que lo tiene al inicio
|
|
llINCLUDE_SCX_Completed = .T.
|
|
llEXTERNAL_CLASS_Completed = .T.
|
|
|
|
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 And Empty(toFoxBin2Prg.c_ClassOperationType)
|
|
*-- El ClassPerFile original, con nomenclatura 'Libreria.NombreClase.vc2'
|
|
For I = 1 To toModulo._ExternalClasses_Count
|
|
lnItem = 0
|
|
|
|
For X = 1 To toModulo._Clases_Count
|
|
If Lower( toModulo._Clases(m.X)._ObjName ) == Lower( toModulo._ExternalClasses(m.I,1) )
|
|
lnItem = m.X
|
|
Exit
|
|
Endif
|
|
Endfor
|
|
|
|
If lnItem = 0 Then
|
|
lcClaseExterna = Forcepath( Juststem(toFoxBin2Prg.c_InputFile) + '.' + toModulo._ExternalClasses(m.I,1) + '.' + Justext(toFoxBin2Prg.c_InputFile), Justpath(toFoxBin2Prg.c_InputFile) )
|
|
*ERROR 'No se ha encontrado la clase externa [' + toModulo._ExternalClasses(m.I,1) + '] en el archivo [' + toFoxBin2Prg.c_InputFile + ']'
|
|
Error ( loLang.C_EXTERNAL_CLASS_NAME_WAS_NOT_FOUND_LOC + ' [' + lcClaseExterna + ']' )
|
|
Endif
|
|
|
|
toModulo._Clases(lnItem)._Checked = .T.
|
|
Endfor
|
|
|
|
Case toFoxBin2Prg.n_UseClassPerFile = 2 And toFoxBin2Prg.l_ClassPerFileCheck And Empty(toFoxBin2Prg.c_ClassOperationType)
|
|
*-- El nuevo ClassPerFile, con nomenclatura 'Libreria.ClaseBase.NombreClase.vc2'
|
|
For I = 1 To toModulo._ExternalClasses_Count
|
|
lnItem = 0
|
|
|
|
For X = 1 To toModulo._Clases_Count
|
|
If Lower( toModulo._Clases(m.X)._BaseClass + '.' + toModulo._Clases(m.X)._ObjName ) == Lower( toModulo._ExternalClasses(m.I,2) )
|
|
lnItem = m.X
|
|
Exit
|
|
Endif
|
|
Endfor
|
|
|
|
If lnItem = 0 Then
|
|
lcClaseExterna = Forcepath( Juststem(toFoxBin2Prg.c_InputFile) + '.' + toModulo._ExternalClasses(m.I,1) + '.' + Justext(toFoxBin2Prg.c_InputFile), Justpath(toFoxBin2Prg.c_InputFile) )
|
|
*ERROR 'No se ha encontrado la clase externa [' + toModulo._ExternalClasses(m.I,1) + '] en el archivo [' + toFoxBin2Prg.c_InputFile + ']'
|
|
Error ( loLang.C_EXTERNAL_CLASS_NAME_WAS_NOT_FOUND_LOC + ' [' + lcClaseExterna + ']' )
|
|
Endif
|
|
|
|
toModulo._Clases(lnItem)._Checked = .T.
|
|
Endfor
|
|
|
|
Endcase
|
|
Endproc
|
|
|
|
toModulo._Clases(lnItem)._Checked = .T.
|
|
Endfor
|
|
|
|
Case toFoxBin2Prg.n_UseClassPerFile = 2 And toFoxBin2Prg.l_ClassPerFileCheck And Empty(toFoxBin2Prg.c_ClassOperationType)
|
|
*-- El nuevo ClassPerFile, con nomenclatura 'Libreria.ClaseBase.NombreClase.vc2'
|
|
For I = 1 To toModulo._ExternalClasses_Count
|
|
lnItem = 0
|
|
|
|
Enddefine
|
|
|
|
If lnItem = 0 Then
|
|
lcClaseExterna = Forcepath( Juststem(toFoxBin2Prg.c_InputFile) + '.' + toModulo._ExternalClasses(m.I,1) + '.' + Justext(toFoxBin2Prg.c_InputFile), Justpath(toFoxBin2Prg.c_InputFile) )
|
|
*ERROR 'No se ha encontrado la clase externa [' + toModulo._ExternalClasses(m.I,1) + '] en el archivo [' + toFoxBin2Prg.c_InputFile + ']'
|
|
Error ( loLang.C_EXTERNAL_CLASS_NAME_WAS_NOT_FOUND_LOC + ' [' + lcClaseExterna + ']' )
|
|
Endif
|
|
|
|
toModulo._Clases(lnItem)._Checked = .T.
|
|
Endfor
|
|
|
|
Endcase
|
|
Endproc
|
|
|
|
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 = [<VFPData>] ;
|
|
+ [<memberdata name="escribirarchivobin" display="escribirArchivoBin"/>] ;
|
|
+ [</VFPData>]
|
|
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, llReplaceClass, lnRow ;
|
|
, loClase As CL_CLASE Of 'FOXBIN2PRG.PRG' ;
|
|
, loLang As CL_LANG Of 'FOXBIN2PRG.PRG'
|
|
|
|
Local;
|
|
lnDots As Number
|
|
|
|
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 ;
|
|
AND Empty(toFoxBin2Prg.c_ClassToConvert)
|
|
|
|
If toFoxBin2Prg.n_RedirectClassType = 0 && Redireccionar todas las clases
|
|
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 )
|
|
Endif
|
|
|
|
*-- MÁSCARA DE BÚSQUEDA
|
|
If toFoxBin2Prg.n_UseClassPerFile = 1 Then
|
|
*-- Esto crea la máscara de búsqueda "filename.*.ext" para encontrar las partes
|
|
*-- con la sintaxis "<path>Classlib.Classname.ext" o "<path>Database.MemberName.ext"
|
|
lcBaseFilename = Juststem( Juststem(.c_InputFile) )
|
|
lcInputFile = Addbs( Justpath(.c_InputFile) ) + lcBaseFilename + '.*.' + Justext(.c_InputFile)
|
|
Else && toFoxBin2Prg.n_UseClassPerFile = 2
|
|
*-- Esto crea la máscara de búsqueda "<path>filename.*.*.ext" para encontrar las partes
|
|
*-- con la sintaxis "<path>Classlib.ClassType.Classname.ext" o "<path>Database.MemberType.MemberName.ext"
|
|
lcBaseFilename = Juststem( Juststem( Juststem(.c_InputFile) ) )
|
|
lcInputFile = Addbs( Justpath(.c_InputFile) ) + lcBaseFilename + '.*.*.' + Justext(.c_InputFile)
|
|
Endif
|
|
|
|
If toFoxBin2Prg.n_RedirectClassType = 1 && Redireccionar solo esta clase
|
|
lcInputFile = .c_InputFile
|
|
Endif
|
|
|
|
*!* Changed by: Lutz Scheffler 15.2.2021
|
|
*!* change date="{^2021-02-15,16:09:00}"
|
|
* problem with classes declared in multiple files, looks like merge problem of git
|
|
* creates multiple classes in VCX
|
|
* the problem is ADIR(laFiles,Name+".*.ext") will return files with AT LEAST 2 dots
|
|
* so we simply remove files with to many dots
|
|
lnDots = Occurs('.',m.lcInputFile)
|
|
|
|
lnFileCount = Adir( laFiles, lcInputFile, "", 1 )
|
|
|
|
If lnFileCount > 1
|
|
For I = m.lnFileCount To 1 Step -1
|
|
If Occurs('.',laFiles(I,1))>m.lnDots Then
|
|
Adel(laFiles,I)
|
|
lnFileCount = m.lnFileCount-1
|
|
Endif &&OCCURS('.',laFiles(i,1))>m.lnDots
|
|
Next
|
|
Dimension;
|
|
laFiles(Evl(lnFileCount,1),Alen(laFiles,2))
|
|
*!* /Changed by: Lutz Scheffler 15.2.2021
|
|
|
|
Asort( laFiles, 1, 0, 0, 1)
|
|
Endif
|
|
|
|
For I = 1 To lnFileCount
|
|
If toFoxBin2Prg.n_UseClassPerFile = 1 Then
|
|
lcInputFile_Class = Forcepath( Juststem( laFiles(m.I,1) ), Justpath( .c_InputFile ) ) + '.' + Justext( .c_InputFile )
|
|
lcClassName = Lower( Getwordnum( Justfname( lcInputFile_Class ), 2, '.' ) )
|
|
|
|
*-- Verificación de las Clases, si son Externas y se indicó chequearlas
|
|
If toFoxBin2Prg.l_ClassPerFileCheck And Empty(toFoxBin2Prg.c_ClassOperationType) ;
|
|
AND Ascan( toModulo._ExternalClasses , lcClassName, 1, 0, 1, 1+2+4 ) = 0
|
|
.writeLog( C_TAB + '- ' + loLang.C_OUTER_CLASS_DOES_NOT_MATCH_INNER_CLASSES_LOC + ' [' + lcInputFile_Class + ']' )
|
|
.writeErrorLog( C_TAB + '- ' + loLang.C_WARNING_LOC + ' ' + loLang.C_OUTER_CLASS_DOES_NOT_MATCH_INNER_CLASSES_LOC + ' [' + lcInputFile_Class + ']' )
|
|
Loop && Salteo esta clase porque se indicó chequear y no concuerda con las anotadas
|
|
Endif
|
|
Else && toFoxBin2Prg.n_UseClassPerFile = 2
|
|
lcInputFile_Class = Forcepath( Juststem( laFiles(m.I,1) ), Justpath( .c_InputFile ) ) + '.' + Justext( .c_InputFile )
|
|
lcClassName = Lower( Getwordnum( Justfname( lcInputFile_Class ), 2, '.' ) + '.' + Getwordnum( Justfname( lcInputFile_Class ), 3, '.' ) )
|
|
|
|
*-- Verificación de las Clases, si son Externas y se indicó chequearlas
|
|
If toFoxBin2Prg.l_ClassPerFileCheck And Empty(toFoxBin2Prg.c_ClassOperationType) ;
|
|
AND Ascan( toModulo._ExternalClasses , lcClassName, 1, 0, 2, 1+2+4 ) = 0
|
|
.writeLog( C_TAB + '- ' + loLang.C_OUTER_CLASS_DOES_NOT_MATCH_INNER_CLASSES_LOC + ' [' + lcInputFile_Class + ']' )
|
|
.writeErrorLog( C_TAB + '- ' + loLang.C_WARNING_LOC + ' ' + loLang.C_OUTER_CLASS_DOES_NOT_MATCH_INNER_CLASSES_LOC + ' [' + lcInputFile_Class + ']' )
|
|
Loop && Salteo esta clase porque se indicó chequear y no concuerda con las anotadas
|
|
Endif
|
|
Endif
|
|
|
|
.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 + CR_LF + Filetostr( lcInputFile_Class )
|
|
Endif
|
|
Endfor
|
|
|
|
lnCodeLines = Alines( laCodeLines, C_FB2PRG_CODE )
|
|
Else
|
|
*-- No es clase por archivo, o no se quiere redireccionar a Main, o se usó
|
|
*-- la sintaxis "classlib.vcx::classname::import"
|
|
If toFoxBin2Prg.l_ProcessFiles Then
|
|
C_FB2PRG_CODE = Filetostr( .c_InputFile )
|
|
lnCodeLines = Alines( laCodeLines, C_FB2PRG_CODE )
|
|
|
|
.updateProgressbar( 'Identifying Header Blocks...', 1, lnCodeLines, 1 )
|
|
.identifyHeaderBlocks( @laCodeLines, lnCodeLines, @laLineasExclusion, lnBloquesExclusion, @toModulo, @toFoxBin2Prg )
|
|
Endif
|
|
|
|
Endif
|
|
|
|
If Not toFoxBin2Prg.l_ProcessFiles Then
|
|
*-- addProcessedFile( tcFile, tcInOutType, tcProcessed, tcHasErrors, tcSupported, tcExpanded )
|
|
If toFoxBin2Prg.addProcessedFile( .c_OutputFile, 'O', 'P1', 'E0', 'S1', 'X0' ) Then
|
|
toFoxBin2Prg.updateProcessedFile()
|
|
Endif
|
|
|
|
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 )
|
|
|
|
If toFoxBin2Prg.n_RedirectClassType = 1 Or Not Empty(toFoxBin2Prg.c_ClassToConvert) && Redireccionar solo esta clase a main
|
|
llReplaceClass = .T.
|
|
|
|
* - new operations of DBF
|
|
If Empty(toFoxBin2Prg.c_ClassToConvert)
|
|
*!* Changed by: Lutz Scheffler 04.03.2021
|
|
*!* change date="{^2021-03-04,10:03:00}"
|
|
* If inputfile in the form classlib.class.vc2 AND toFoxBin2Prg.n_RedirectClassType = 1 and Execute parameter tcRecompile = 1
|
|
* the change of outputfile might generate an error
|
|
* toFoxBin2Prg.c_OutputFile is renamed to classlib.vcx, while this.c_OutputFile is classlib.class.vcx
|
|
* this will generate classlib.class.vcx, tries to recompile and toFoxBin2Prg recompiles classlib.vcx
|
|
* if classlib.vcx is not existing, it errors out, els it compiles the wrong file.
|
|
* So we do not rename if toFoxBin2Prg.n_RedirectClassType = 1
|
|
If toFoxBin2Prg.n_RedirectClassType = 0
|
|
toFoxBin2Prg.c_OutputFile = Fullpath( Forceext( lcBaseFilename, 'VCX' ), .c_InputFile)
|
|
Endif
|
|
*!* /Changed by: Lutz Scheffler 04.03.2021
|
|
Else
|
|
loClase = toModulo._Clases(1)
|
|
* Ajusto el nombre interno de la clase al indicado en el nombre del archivo
|
|
loClase._Nombre = toFoxBin2Prg.c_ClassToConvert
|
|
loClase._ObjName = toFoxBin2Prg.c_ClassToConvert
|
|
* Reemplazo la propiedad Name
|
|
lnRow = Ascan(loClase._Props, 'Name', 1, -1, 1, 2+4+8)
|
|
If lnRow > 0
|
|
loClase._Props(lnRow,2) = ["] + toFoxBin2Prg.c_ClassToConvert + ["]
|
|
Endif
|
|
* Y finalmente actualizo el memo
|
|
loClase._PROPERTIES = .classProps2Memo( @loClase, @toFoxBin2Prg )
|
|
Endif
|
|
|
|
toFoxBin2Prg.doBackup( .F., .T., '', '', '' )
|
|
|
|
If Adir( laFiles, toFoxBin2Prg.c_OutputFile, "", 1 ) = 1
|
|
Use (toFoxBin2Prg.c_OutputFile) Alias TABLABIN Again Shared
|
|
Else
|
|
.createClasslib()
|
|
Endif
|
|
Else
|
|
toFoxBin2Prg.doBackup( .F., .T., '', '', '' )
|
|
.createClasslib()
|
|
Endif
|
|
|
|
.writeBinaryFile( @toModulo, @toFoxBin2Prg, llReplaceClass )
|
|
Endwith && THIS
|
|
|
|
|
|
Catch To toEx
|
|
If This.n_Debug > 0 And _vfp.StartMode = 0
|
|
Set Step On
|
|
Endif
|
|
|
|
Throw
|
|
|
|
Finally
|
|
Use In (Select("TABLABIN"))
|
|
Store Null To loClase
|
|
Release lnCodError, laCodeLines, lnCodeLines, lcInputFile, lcInputFile_Class, lnFileCount, laFiles ;
|
|
, laLineasExclusion, lnBloquesExclusion, I
|
|
Endtry
|
|
|
|
Return
|
|
Endproc
|
|
|
|
|
|
|
|
|
|
Procedure writeBinaryFile
|
|
Lparameters toModulo, toFoxBin2Prg, tlReplaceClass
|
|
*-- Estructura del objeto toModulo generado:
|
|
*-- -----------------------------------------------------------------------------------------------------------
|
|
*-- Version Versión usada para generar la versión PRG analizada
|
|
*-- SourceFile Nombre original del archivo fuente de la conversión
|
|
*-- Ole_Obj_Count Cantidad de objetos definidos en el array ole_objs[]
|
|
*-- Ole_Objs[1] Array de objetos OLE definidos como clases
|
|
*-- ObjName Nombre del objeto OLE (OLE2)
|
|
*-- Parent Nombre del objeto Padre
|
|
*-- CheckSum Suma de verificación
|
|
*-- Value Valor del campo OLE
|
|
*-- Clases_Count Array con las posiciones de los addobjects, definicion y propiedades
|
|
*-- Clases[1] Array con los datos de las clases, definicion, propiedades y métodos
|
|
*-- Nombre El nombre de la clase (ej: "miClase")
|
|
*-- ObjName Nombre del objeto
|
|
*-- Parent Nombre del objeto Padre
|
|
*-- Class Clase de la que hereda la definición
|
|
*-- Classloc Librería donde está la definición de la clase
|
|
*-- Ole Información campo ole
|
|
*-- Ole2 Información campo ole2
|
|
*-- OlePublic Indica si la clase es OLEPublic o no (.T. / .F.)
|
|
*-- Uniqueid ID único
|
|
*-- Comentario El comentario de la clase (ej: "&& Mis comentarios")
|
|
*-- MetaData Información de metadata de la clase (baseclass, timestamp, scale)
|
|
*-- BaseClass Clase de base de la clase
|
|
*-- TimeStamp Timestamp de la clase
|
|
*-- Scale Scale de la clase (pixels, foxels)
|
|
*-- Definicion La definición de la clase (ej: "AS Custom OF LIBRERIA.VCX")
|
|
*-- Inicio/Fin Línea de inicio/fin de la clase (DEFINE CLASS/ENDDEFINE)
|
|
*-- Ini_Cab/Fin_Cab Línea de inicio/fin de la cabecera (def.propiedades, Hidden, Protected, #Include, CLASSDATA, DEFINED_PAM)
|
|
*-- Ini_Cuerpo/Fin_Cuerpo Línea de inicio/fin del cuerpo (ADD OBJECTs y PROCEDURES)
|
|
*-- HiddenProps Propiedades definidas como HIDDEN (ocultas)
|
|
*-- ProtectedProps Propiedades definidas como PROTECTED (protegidas)
|
|
*-- Defined_PAM Propiedades, eventos o métodos definidos por el usuario
|
|
*-- IncludeFile Nombre del archivo de inclusión
|
|
*-- Props_Count Cantidad de propiedades de la clase definicas en el array props[]
|
|
*-- Props[1,2] Array con todas las propiedades de la clase y sus valores. (col.1=Nombre, col.2=Comentario)
|
|
*-- AddObject_Count Cantidad de objetos definidos en el array addobjects[]
|
|
*-- AddObjects[1] Array con las posiciones de los addobjects, definicion y propiedades
|
|
*-- Nombre Nombre del objeto
|
|
*-- ObjName Nombre del objeto
|
|
*-- Parent Nombre del objeto Padre
|
|
*-- Clase Clase del objeto
|
|
*-- ClassLib Librería de clases de la que deriva la clase
|
|
*-- Baseclass Clase de base del objeto
|
|
*-- Uniqueid ID único
|
|
*-- Ole Información campo ole
|
|
*-- Ole2 Información campo ole2
|
|
*-- ZOrder Orden Z del objeto
|
|
*-- Props_Count Cantidad de propiedades del objeto
|
|
*-- Props[1] Array con todas las propiedades del objeto y sus valores
|
|
*-- Procedure_count Cantidad de procedimientos definidos en el array procedures[]
|
|
*-- Procedures[1] Array con las posiciones de los procedures, definicion y comentarios
|
|
*-- Nombre Nombre del procedure
|
|
*-- ProcType Tipo de procedimiento (normal, hidden, protected)
|
|
*-- Comentario Comentario el procedure
|
|
*-- ProcLine_Count Cantidad de líneas del procedimiento
|
|
*-- ProcLines[1] Líneas del procedimiento
|
|
*-- Procedure_count Cantidad de procedimientos definidos en el array procedures[]
|
|
*-- Procedures[1] Array con las posiciones de los procedures, definicion y comentarios
|
|
*-- Nombre Nombre del procedure
|
|
*-- ProcType Tipo de procedimiento (normal, hidden, protected)
|
|
*-- Comentario Comentario el procedure
|
|
*-- ProcLine_Count Cantidad de líneas del procedimiento
|
|
*-- ProcLines[1] Líneas del procedimiento
|
|
*-- -----------------------------------------------------------------------------------------------------------
|
|
#If .F.
|
|
Local toModulo As CL_CLASSLIB Of 'FOXBIN2PRG.PRG'
|
|
Local toFoxBin2Prg As c_foxbin2prg Of 'FOXBIN2PRG.PRG'
|
|
#Endif
|
|
|
|
Try
|
|
Local lcObjName, lnCodError, I, X, llReplace, laUniqueID(1,1), loEx As Exception ;
|
|
, loClase As CL_CLASE Of 'FOXBIN2PRG.PRG' ;
|
|
, loFSO As Scripting.FileSystemObject
|
|
|
|
With This As c_conversor_prg_a_vcx Of 'FOXBIN2PRG.PRG'
|
|
Store Null To loFSO, loClase
|
|
loFSO = .oFSO
|
|
|
|
*-- addProcessedFile( tcFile, tcInOutType, tcProcessed, tcHasErrors, tcSupported, tcExpanded )
|
|
toFoxBin2Prg.addProcessedFile( .c_OutputFile, 'O', 'P1', 'E0', 'S1', 'X0' )
|
|
|
|
|
|
Do Case
|
|
Case toFoxBin2Prg.c_SimulateError = 'SIMERR_O1'
|
|
Error 'OutputFile Error Simulation'
|
|
Endcase
|
|
|
|
If tlReplaceClass
|
|
I = 1
|
|
loClase = toModulo._Clases(m.I)
|
|
Locate For PLATFORM == Padr('WINDOWS', Fsize('PLATFORM')) And Lower(OBJNAME) == loClase._ObjName
|
|
llReplace = Found()
|
|
Endif
|
|
|
|
If llReplace
|
|
*-- Reemplazar los campos del registro actual
|
|
If Empty(loClase._TimeStamp)
|
|
loClase._TimeStamp = .rowTimeStamp( {^2013/11/04 20:00:00} )
|
|
Endif
|
|
If Empty(loClase._UniqueID)
|
|
loClase._UniqueID = toFoxBin2Prg.unique_ID()
|
|
Endif
|
|
|
|
Replace ;
|
|
PLATFORM With 'WINDOWS' ;
|
|
, Timestamp With loClase._TimeStamp ;
|
|
, Class With loClase._Class ;
|
|
, CLASSLOC With loClase._ClassLoc ;
|
|
, BaseClass With loClase._BaseClass ;
|
|
, OBJNAME With loClase._ObjName ;
|
|
, Parent With loClase._Parent ;
|
|
, PROPERTIES With loClase._PROPERTIES ;
|
|
, Protected With loClase._PROTECTED ;
|
|
, METHODS With loClase._METHODS ;
|
|
, OLE With loClase._Ole ;
|
|
, OLE2 With loClase._Ole2 ;
|
|
, RESERVED1 With loClase._RESERVED1 ;
|
|
, RESERVED2 With loClase._RESERVED2 ;
|
|
, RESERVED3 With loClase._RESERVED3 ;
|
|
, RESERVED4 With loClase._RESERVED4 ;
|
|
, RESERVED5 With loClase._RESERVED5 ;
|
|
, RESERVED6 With loClase._RESERVED6 ;
|
|
, RESERVED7 With loClase._RESERVED7 ;
|
|
, RESERVED8 With loClase._RESERVED8 ;
|
|
, User With loClase._User
|
|
|
|
* Si tiene objetos asociados, antes debo eliminar los existentes para no duplicarlos
|
|
Delete All For PLATFORM == Padr('WINDOWS', Fsize('PLATFORM')) And Lower(Parent) == loClase._ObjName
|
|
|
|
.insert_AllObjects( @loClase, @toFoxBin2Prg )
|
|
|
|
Else
|
|
*-- Creo el registro de cabecera
|
|
If tlReplaceClass And Reccount() > 0
|
|
Select Max(Val(Substr(UNIQUEID,2))) From TABLABIN Into Array laUniqueID
|
|
toFoxBin2Prg.n_ID = laUniqueID(1)
|
|
Else
|
|
.createClasslib_RecordHeader( toModulo )
|
|
Endif
|
|
|
|
*-- Recorro las CLASES
|
|
For X = 1 To 2
|
|
For I = 1 To toModulo._Clases_Count
|
|
loClase = Null
|
|
loClase = toModulo._Clases(m.I)
|
|
|
|
*-- El dataenvironment debe estar primero, luego lo demás.
|
|
If m.X = 1 And Not loClase._BaseClass == 'dataenvironment' ;
|
|
OR m.X = 2 And loClase._BaseClass == 'dataenvironment'
|
|
Loop
|
|
Endif
|
|
|
|
If Empty(loClase._TimeStamp)
|
|
loClase._TimeStamp = .rowTimeStamp( {^2013/11/04 20:00:00} )
|
|
Endif
|
|
If Empty(loClase._UniqueID)
|
|
loClase._UniqueID = toFoxBin2Prg.unique_ID()
|
|
Endif
|
|
|
|
*-- Inserto la clase
|
|
Insert Into TABLABIN ;
|
|
( PLATFORM ;
|
|
, UNIQUEID ;
|
|
, Timestamp ;
|
|
, Class ;
|
|
, CLASSLOC ;
|
|
, BaseClass ;
|
|
, OBJNAME ;
|
|
, Parent ;
|
|
, PROPERTIES ;
|
|
, Protected ;
|
|
, METHODS ;
|
|
, OLE ;
|
|
, OLE2 ;
|
|
, RESERVED1 ;
|
|
, RESERVED2 ;
|
|
, RESERVED3 ;
|
|
, RESERVED4 ;
|
|
, RESERVED5 ;
|
|
, RESERVED6 ;
|
|
, RESERVED7 ;
|
|
, RESERVED8 ;
|
|
, User) ;
|
|
VALUES ;
|
|
( 'WINDOWS' ;
|
|
, loClase._UniqueID ;
|
|
, loClase._TimeStamp ;
|
|
, loClase._Class ;
|
|
, loClase._ClassLoc ;
|
|
, loClase._BaseClass ;
|
|
, loClase._ObjName ;
|
|
, loClase._Parent ;
|
|
, loClase._PROPERTIES ;
|
|
, loClase._PROTECTED ;
|
|
, loClase._METHODS ;
|
|
, loClase._Ole ;
|
|
, loClase._Ole2 ;
|
|
, loClase._RESERVED1 ;
|
|
, loClase._RESERVED2 ;
|
|
, loClase._RESERVED3 ;
|
|
, loClase._ClassIcon ;
|
|
, loClase._ProjectClassIcon ;
|
|
, loClase._Scale ;
|
|
, loClase._Comentario ;
|
|
, loClase._includeFile ;
|
|
, loClase._User )
|
|
|
|
|
|
.insert_AllObjects( @loClase, @toFoxBin2Prg )
|
|
|
|
|
|
*-- Inserto el COMMENT
|
|
Insert Into TABLABIN ;
|
|
( PLATFORM ;
|
|
, UNIQUEID ;
|
|
, Timestamp ;
|
|
, Class ;
|
|
, CLASSLOC ;
|
|
, BaseClass ;
|
|
, OBJNAME ;
|
|
, Parent ;
|
|
, PROPERTIES ;
|
|
, Protected ;
|
|
, METHODS ;
|
|
, OLE ;
|
|
, OLE2 ;
|
|
, RESERVED1 ;
|
|
, RESERVED2 ;
|
|
, RESERVED3 ;
|
|
, RESERVED4 ;
|
|
, RESERVED5 ;
|
|
, RESERVED6 ;
|
|
, RESERVED7 ;
|
|
, RESERVED8 ;
|
|
, User) ;
|
|
VALUES ;
|
|
( 'COMMENT' ;
|
|
, 'RESERVED' ;
|
|
, 0 ;
|
|
, '' ;
|
|
, '' ;
|
|
, '' ;
|
|
, loClase._ObjName ;
|
|
, '' ;
|
|
, '' ;
|
|
, '' ;
|
|
, '' ;
|
|
, '' ;
|
|
, '' ;
|
|
, '' ;
|
|
, Iif(loClase._OlePublic, 'OLEPublic', '') ;
|
|
, '' ;
|
|
, '' ;
|
|
, '' ;
|
|
, '' ;
|
|
, '' ;
|
|
, '' ;
|
|
, '' )
|
|
|
|
Endfor && I = 1 TO toModulo._Clases_Count
|
|
Endfor && X = 1 TO 2
|
|
Endif
|
|
|
|
Use In (Select("TABLABIN"))
|
|
|
|
If toFoxBin2Prg.l_Recompile
|
|
toFoxBin2Prg.compileFoxProBinary()
|
|
Endif
|
|
|
|
toFoxBin2Prg.updateProcessedFile()
|
|
Endwith && THIS
|
|
|
|
|
|
Catch To loEx
|
|
lnCodError = loEx.ErrorNo
|
|
toFoxBin2Prg.updateProcessedFile( 0, '', '', 'E1' )
|
|
|
|
If This.n_Debug > 0 And _vfp.StartMode = 0
|
|
Set Step On
|
|
Endif
|
|
|
|
Throw
|
|
|
|
Finally
|
|
Use In (Select("TABLABIN"))
|
|
Store Null To loFSO, loClase
|
|
Release lcObjName, I, X, loClase, loFSO
|
|
|
|
Endtry
|
|
|
|
Return lnCodError
|
|
|
|
Endproc
|
|
Enddefine
|
|
|
|
|
|
|
|
|
|
Define Class c_conversor_prg_a_scx As c_conversor_prg_a_bin
|
|
#If .F.
|
|
Local This As c_conversor_prg_a_scx Of 'FOXBIN2PRG.PRG'
|
|
#Endif
|
|
*_MEMBERDATA = [<VFPData>] ;
|
|
+ [<memberdata name="escribirarchivobin" display="escribirArchivoBin"/>] ;
|
|
+ [</VFPData>]
|
|
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 "<path>Database.*.*.ext" para encontrar las partes
|
|
*-- con la sintaxis "<path>Database.MemberType.MemberName.ext"
|
|
lcBaseFilename = Juststem( Juststem( Juststem(.c_InputFile) ) )
|
|
lcInputFile = Addbs( Justpath(.c_InputFile) ) + lcBaseFilename + '.*.*.' + Justext(.c_InputFile)
|
|
Endif
|
|
|
|
lnFileCount = Adir( laFiles, lcInputFile, "", 1 )
|
|
Asort( laFiles, 1, 0, 0, 1)
|
|
|
|
For I = 1 To lnFileCount
|
|
If toFoxBin2Prg.n_UseClassPerFile = 1 Then
|
|
lcInputFile_Class = Forcepath( Juststem( laFiles(m.I,1) ), Justpath( .c_InputFile ) ) + '.' + Justext( .c_InputFile )
|
|
lcClassName = Lower( Getwordnum( Justfname( lcInputFile_Class ), 2, '.' ) )
|
|
|
|
*-- Verificación de las Clases, si son Externas y se indicó chequearlas
|
|
If toFoxBin2Prg.l_ClassPerFileCheck And Empty(toFoxBin2Prg.c_ClassOperationType) ;
|
|
AND Ascan( toModulo._ExternalClasses , lcClassName, 1, 0, 1, 1+2+4 ) = 0
|
|
.writeLog( C_TAB + '- ' + loLang.C_OUTER_CLASS_DOES_NOT_MATCH_INNER_CLASSES_LOC + ' [' + lcInputFile_Class + ']' )
|
|
.writeErrorLog( C_TAB + '- ' + loLang.C_WARNING_LOC + ' ' + loLang.C_OUTER_CLASS_DOES_NOT_MATCH_INNER_CLASSES_LOC + ' [' + lcInputFile_Class + ']' )
|
|
Loop && Salteo esta clase
|
|
Endif
|
|
Else && toFoxBin2Prg.n_UseClassPerFile = 2
|
|
lcInputFile_Class = Forcepath( Juststem( laFiles(m.I,1) ), Justpath( .c_InputFile ) ) + '.' + Justext( .c_InputFile )
|
|
lcClassName = Lower( Getwordnum( Justfname( lcInputFile_Class ), 2, '.' ) + '.' + Getwordnum( Justfname( lcInputFile_Class ), 3, '.' ) )
|
|
|
|
*-- Verificación de las Clases, si son Externas y se indicó chequearlas
|
|
If toFoxBin2Prg.l_ClassPerFileCheck And Empty(toFoxBin2Prg.c_ClassOperationType) ;
|
|
AND Ascan( toModulo._ExternalClasses , lcClassName, 1, 0, 2, 1+2+4 ) = 0
|
|
.writeLog( C_TAB + '- ' + loLang.C_OUTER_CLASS_DOES_NOT_MATCH_INNER_CLASSES_LOC + ' [' + lcInputFile_Class + ']' )
|
|
.writeErrorLog( C_TAB + '- ' + loLang.C_WARNING_LOC + ' ' + loLang.C_OUTER_CLASS_DOES_NOT_MATCH_INNER_CLASSES_LOC + ' [' + lcInputFile_Class + ']' )
|
|
Loop && Salteo esta clase
|
|
Endif
|
|
Endif
|
|
|
|
.writeLog( C_TAB + C_TAB + '+ ' + loLang.C_INCLUDING_CLASS_LOC + ' ' + Justfname( lcInputFile_Class ) )
|
|
|
|
*-- addProcessedFile( tcFile, tcInOutType, tcProcessed, tcHasErrors, tcSupported, tcExpanded )
|
|
If toFoxBin2Prg.addProcessedFile( lcInputFile_Class, 'I', 'P1', 'E0', 'S1', 'X1' ) Then
|
|
toFoxBin2Prg.updateProcessedFile()
|
|
Endif
|
|
|
|
toFoxBin2Prg.normalizeFileCapitalization( .T., lcInputFile_Class )
|
|
C_FB2PRG_CODE = C_FB2PRG_CODE + CR_LF + Filetostr( lcInputFile_Class )
|
|
Endfor
|
|
|
|
lnCodeLines = Alines( laCodeLines, C_FB2PRG_CODE )
|
|
Else
|
|
*-- No es clase por archivo, o no se quiere redireccionar a Main.
|
|
C_FB2PRG_CODE = Filetostr( .c_InputFile )
|
|
lnCodeLines = Alines( laCodeLines, C_FB2PRG_CODE )
|
|
|
|
.updateProgressbar( 'Identifying Header Blocks...', 1, lnCodeLines, 1 )
|
|
.identifyHeaderBlocks( @laCodeLines, lnCodeLines, @laLineasExclusion, lnBloquesExclusion, @toModulo, @toFoxBin2Prg )
|
|
|
|
Endif
|
|
|
|
If Not toFoxBin2Prg.l_ProcessFiles Then
|
|
*-- addProcessedFile( tcFile, tcInOutType, tcProcessed, tcHasErrors, tcSupported, tcExpanded )
|
|
If toFoxBin2Prg.addProcessedFile( .c_OutputFile, 'O', 'P1', 'E0', 'S1', 'X0' ) Then
|
|
toFoxBin2Prg.updateProcessedFile()
|
|
Endif
|
|
|
|
Exit && Si se indicó no procesar, se sale aquí. (Modo de simulación)
|
|
Endif
|
|
|
|
*-- Identifico los TEXT/ENDTEXT, #IF .F./#ENDIF
|
|
.updateProgressbar( 'Identifying Excluded Blocks...', 3, lnCodeLines, 1 )
|
|
.identifyExclusionBlocks( @laCodeLines, lnCodeLines, .F., @laLineasExclusion, @lnBloquesExclusion )
|
|
|
|
*-- Identifico el inicio/fin de bloque, definición, cabecera y cuerpo de cada clase
|
|
.identifyCodeBlocks( @laCodeLines, lnCodeLines, @laLineasExclusion, lnBloquesExclusion, @toModulo, @toFoxBin2Prg )
|
|
|
|
Do Case
|
|
Case toFoxBin2Prg.c_SimulateError = 'SIMERR_I1'
|
|
Error 'InputFile Error Simulation'
|
|
Case toFoxBin2Prg.c_SimulateError = 'SIMERR_I0'
|
|
.writeErrorLog( '*** SIMULATED ERROR' )
|
|
Endcase
|
|
|
|
If .l_Error
|
|
.writeLog( '*** ERRORS found - Generation Cancelled' )
|
|
Exit
|
|
Endif
|
|
|
|
toFoxBin2Prg.updateProcessedFile( lnIDInputFile )
|
|
.updateProgressbar( 'Generating Binary...', 0, lnCodeLines, 1 )
|
|
toFoxBin2Prg.doBackup( .F., .T., '', '', '' )
|
|
.createForm()
|
|
.writeBinaryFile( @toModulo, @toFoxBin2Prg )
|
|
Endwith && THIS
|
|
|
|
|
|
Catch To toEx
|
|
If This.n_Debug > 0 And _vfp.StartMode = 0
|
|
Set Step On
|
|
Endif
|
|
|
|
Throw
|
|
|
|
Finally
|
|
Use In (Select("TABLABIN"))
|
|
Release lnCodError, laCodeLines, lnCodeLines, lcInputFile, lcInputFile_Class, lnFileCount, laFiles ;
|
|
, laLineasExclusion, lnBloquesExclusion, I
|
|
Endtry
|
|
|
|
Return
|
|
Endproc
|
|
|
|
|
|
|
|
|
|
Procedure writeBinaryFile
|
|
Lparameters toModulo, toFoxBin2Prg
|
|
*-- Estructura del objeto toModulo generado:
|
|
*-- -----------------------------------------------------------------------------------------------------------
|
|
*-- Version Versión usada para generar la versión PRG analizada
|
|
*-- SourceFile Nombre original del archivo fuente de la conversión
|
|
*-- Ole_Obj_Count Cantidad de objetos definidos en el array ole_objs[]
|
|
*-- Ole_Objs[1] Array de objetos OLE definidos como clases
|
|
*-- ObjName Nombre del objeto OLE (OLE2)
|
|
*-- Parent Nombre del objeto Padre
|
|
*-- CheckSum Suma de verificación
|
|
*-- Value Valor del campo OLE
|
|
*-- Clases_Count Array con las posiciones de los addobjects, definicion y propiedades
|
|
*-- Clases[1] Array con los datos de las clases, definicion, propiedades y métodos
|
|
*-- Nombre El nombre de la clase (ej: "miClase")
|
|
*-- ObjName Nombre del objeto
|
|
*-- Parent Nombre del objeto Padre
|
|
*-- Class Clase de la que hereda la definición
|
|
*-- Classloc Librería donde está la definición de la clase
|
|
*-- Ole Información campo ole
|
|
*-- Ole2 Información campo ole2
|
|
*-- OlePublic Indica si la clase es OLEPublic o no (.T. / .F.)
|
|
*-- Uniqueid ID único
|
|
*-- Comentario El comentario de la clase (ej: "&& Mis comentarios")
|
|
*-- MetaData Información de metadata de la clase (baseclass, timestamp, scale)
|
|
*-- BaseClass Clase de base de la clase
|
|
*-- TimeStamp Timestamp de la clase
|
|
*-- Scale Scale de la clase (pixels, foxels)
|
|
*-- Definicion La definición de la clase (ej: "AS Custom OF LIBRERIA.VCX")
|
|
*-- Inicio/Fin Línea de inicio/fin de la clase (DEFINE CLASS/ENDDEFINE)
|
|
*-- Ini_Cab/Fin_Cab Línea de inicio/fin de la cabecera (def.propiedades, Hidden, Protected, #Include, CLASSDATA, DEFINED_PAM)
|
|
*-- Ini_Cuerpo/Fin_Cuerpo Línea de inicio/fin del cuerpo (ADD OBJECTs y PROCEDURES)
|
|
*-- HiddenProps Propiedades definidas como HIDDEN (ocultas)
|
|
*-- ProtectedProps Propiedades definidas como PROTECTED (protegidas)
|
|
*-- Defined_PAM Propiedades, eventos o métodos definidos por el usuario
|
|
*-- IncludeFile Nombre del archivo de inclusión
|
|
*-- Props_Count Cantidad de propiedades de la clase definicas en el array props[]
|
|
*-- Props[1,2] Array con todas las propiedades de la clase y sus valores. (col.1=Nombre, col.2=Comentario)
|
|
*-- AddObject_Count Cantidad de objetos definidos en el array addobjects[]
|
|
*-- AddObjects[1] Array con las posiciones de los addobjects, definicion y propiedades
|
|
*-- Nombre Nombre del objeto
|
|
*-- ObjName Nombre del objeto
|
|
*-- Parent Nombre del objeto Padre
|
|
*-- Clase Clase del objeto
|
|
*-- ClassLib Librería de clases de la que deriva la clase
|
|
*-- Baseclass Clase de base del objeto
|
|
*-- Uniqueid ID único
|
|
*-- Ole Información campo ole
|
|
*-- Ole2 Información campo ole2
|
|
*-- ZOrder Orden Z del objeto
|
|
*-- Props_Count Cantidad de propiedades del objeto
|
|
*-- Props[1] Array con todas las propiedades del objeto y sus valores
|
|
*-- Procedure_count Cantidad de procedimientos definidos en el array procedures[]
|
|
*-- Procedures[1] Array con las posiciones de los procedures, definicion y comentarios
|
|
*-- Nombre Nombre del procedure
|
|
*-- ProcType Tipo de procedimiento (normal, hidden, protected)
|
|
*-- Comentario Comentario el procedure
|
|
*-- ProcLine_Count Cantidad de líneas del procedimiento
|
|
*-- ProcLines[1] Líneas del procedimiento
|
|
*-- Procedure_count Cantidad de procedimientos definidos en el array procedures[]
|
|
*-- Procedures[1] Array con las posiciones de los procedures, definicion y comentarios
|
|
*-- Nombre Nombre del procedure
|
|
*-- ProcType Tipo de procedimiento (normal, hidden, protected)
|
|
*-- Comentario Comentario el procedure
|
|
*-- ProcLine_Count Cantidad de líneas del procedimiento
|
|
*-- ProcLines[1] Líneas del procedimiento
|
|
*-- -----------------------------------------------------------------------------------------------------------
|
|
#If .F.
|
|
Local toModulo As CL_CLASSLIB Of 'FOXBIN2PRG.PRG'
|
|
Local toFoxBin2Prg As c_foxbin2prg Of 'FOXBIN2PRG.PRG'
|
|
#Endif
|
|
|
|
Try
|
|
Local lcObjName, lnCodError, I, X, loEx As Exception ;
|
|
, loClase As CL_CLASE Of 'FOXBIN2PRG.PRG'
|
|
|
|
With This As c_conversor_prg_a_scx Of 'FOXBIN2PRG.PRG'
|
|
*-- addProcessedFile( tcFile, tcInOutType, tcProcessed, tcHasErrors, tcSupported, tcExpanded )
|
|
toFoxBin2Prg.addProcessedFile( .c_OutputFile, 'O', 'P1', 'E0', 'S1', 'X0' )
|
|
|
|
Do Case
|
|
Case toFoxBin2Prg.c_SimulateError = 'SIMERR_O1'
|
|
Error 'OutputFile Error Simulation'
|
|
Endcase
|
|
|
|
*-- Creo el registro de cabecera
|
|
.createForm_RecordHeader( toModulo )
|
|
|
|
*-- El SCX tiene el INCLUDE en el primer registro
|
|
If Not Empty(toModulo._includeFile)
|
|
Replace RESERVED8 With toModulo._includeFile
|
|
Endif
|
|
|
|
|
|
*-- Recorro las CLASES
|
|
For X = 1 To 2
|
|
For I = 1 To toModulo._Clases_Count
|
|
loClase = Null
|
|
loClase = toModulo._Clases(m.I)
|
|
|
|
*-- El dataenvironment debe estar primero, luego lo demás.
|
|
If m.X = 1 And Not loClase._BaseClass == 'dataenvironment' ;
|
|
OR m.X = 2 And loClase._BaseClass == 'dataenvironment'
|
|
Loop
|
|
Endif
|
|
|
|
If Empty(loClase._TimeStamp)
|
|
loClase._TimeStamp = .rowTimeStamp( {^2013/11/04 20:00:00} )
|
|
Endif
|
|
If Empty(loClase._UniqueID)
|
|
loClase._UniqueID = toFoxBin2Prg.unique_ID()
|
|
Endif
|
|
|
|
*-- Inserto la clase
|
|
Insert Into TABLABIN ;
|
|
( PLATFORM ;
|
|
, UNIQUEID ;
|
|
, Timestamp ;
|
|
, Class ;
|
|
, CLASSLOC ;
|
|
, BaseClass ;
|
|
, OBJNAME ;
|
|
, Parent ;
|
|
, PROPERTIES ;
|
|
, Protected ;
|
|
, METHODS ;
|
|
, OLE ;
|
|
, OLE2 ;
|
|
, RESERVED1 ;
|
|
, RESERVED2 ;
|
|
, RESERVED3 ;
|
|
, RESERVED4 ;
|
|
, RESERVED5 ;
|
|
, RESERVED6 ;
|
|
, RESERVED7 ;
|
|
, RESERVED8 ;
|
|
, User) ;
|
|
VALUES ;
|
|
( 'WINDOWS' ;
|
|
, loClase._UniqueID ;
|
|
, loClase._TimeStamp ;
|
|
, loClase._Class ;
|
|
, loClase._ClassLoc ;
|
|
, loClase._BaseClass ;
|
|
, loClase._ObjName ;
|
|
, loClase._Parent ;
|
|
, loClase._PROPERTIES ;
|
|
, loClase._PROTECTED ;
|
|
, loClase._METHODS ;
|
|
, loClase._Ole ;
|
|
, loClase._Ole2 ;
|
|
, loClase._RESERVED1 ;
|
|
, loClase._RESERVED2 ;
|
|
, loClase._RESERVED3 ;
|
|
, loClase._ClassIcon ;
|
|
, loClase._ProjectClassIcon ;
|
|
, loClase._Scale ;
|
|
, loClase._Comentario ;
|
|
, loClase._includeFile ;
|
|
, loClase._User )
|
|
|
|
|
|
.insert_AllObjects( @loClase, @toFoxBin2Prg )
|
|
|
|
Endfor && I = 1 TO toModulo._Clases_Count
|
|
Endfor && m.X = 1 TO 2
|
|
|
|
*-- Inserto el COMMENT final
|
|
Insert Into TABLABIN ;
|
|
( PLATFORM ;
|
|
, UNIQUEID ;
|
|
, Timestamp ;
|
|
, Class ;
|
|
, CLASSLOC ;
|
|
, BaseClass ;
|
|
, OBJNAME ;
|
|
, Parent ;
|
|
, PROPERTIES ;
|
|
, Protected ;
|
|
, METHODS ;
|
|
, OLE ;
|
|
, OLE2 ;
|
|
, RESERVED1 ;
|
|
, RESERVED2 ;
|
|
, RESERVED3 ;
|
|
, RESERVED4 ;
|
|
, RESERVED5 ;
|
|
, RESERVED6 ;
|
|
, RESERVED7 ;
|
|
, RESERVED8 ;
|
|
, User) ;
|
|
VALUES ;
|
|
( 'COMMENT' ;
|
|
, 'RESERVED' ;
|
|
, 0 ;
|
|
, '' ;
|
|
, '' ;
|
|
, '' ;
|
|
, '' ;
|
|
, '' ;
|
|
, '' ;
|
|
, '' ;
|
|
, '' ;
|
|
, '' ;
|
|
, '' ;
|
|
, '' ;
|
|
, '' ;
|
|
, '' ;
|
|
, '' ;
|
|
, '' ;
|
|
, '' ;
|
|
, '' ;
|
|
, '' ;
|
|
, '' )
|
|
|
|
Use In (Select("TABLABIN"))
|
|
|
|
If toFoxBin2Prg.l_Recompile
|
|
toFoxBin2Prg.compileFoxProBinary()
|
|
Endif
|
|
|
|
toFoxBin2Prg.updateProcessedFile()
|
|
Endwith && THIS
|
|
|
|
|
|
Catch To loEx
|
|
toFoxBin2Prg.updateProcessedFile( 0, '', '', 'E1' )
|
|
|
|
If This.n_Debug > 0 And _vfp.StartMode = 0
|
|
Set Step On
|
|
Endif
|
|
|
|
Throw
|
|
|
|
Finally
|
|
Use In (Select("TABLABIN"))
|
|
Store Null To loClase, loEx
|
|
Release lcObjName, lnCodError, I, X, loClase
|
|
Endtry
|
|
|
|
Return
|
|
|
|
Endproc
|
|
Enddefine
|
|
|
|
|
|
|
|
|
|
Define Class c_conversor_prg_a_pjx As c_conversor_prg_a_bin
|
|
#If .F.
|
|
Local This As c_conversor_prg_a_pjx Of 'FOXBIN2PRG.PRG'
|
|
#Endif
|
|
_MemberData = [<VFPData>] ;
|
|
+ [<memberdata name="analyzecodeblock_buildproj" display="analyzeCodeBlock_BuildProj"/>] ;
|
|
+ [<memberdata name="analyzecodeblock_devinfo" display="analyzeCodeBlock_DevInfo"/>] ;
|
|
+ [<memberdata name="analyzecodeblock_excludedfiles" display="analyzeCodeBlock_ExcludedFiles"/>] ;
|
|
+ [<memberdata name="analyzecodeblock_filecomments" display="analyzeCodeBlock_FileComments"/>] ;
|
|
+ [<memberdata name="analyzecodeblock_serverhead" display="analyzeCodeBlock_ServerHead"/>] ;
|
|
+ [<memberdata name="analyzecodeblock_serverdata" display="analyzeCodeBlock_ServerData"/>] ;
|
|
+ [<memberdata name="analyzecodeblock_textfiles" display="analyzeCodeBlock_TextFiles"/>] ;
|
|
+ [<memberdata name="analyzecodeblock_projectproperties" display="analyzeCodeBlock_ProjectProperties"/>] ;
|
|
+ [</VFPData>]
|
|
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, @toFoxBin2Prg )
|
|
|
|
Do Case
|
|
Case toFoxBin2Prg.c_SimulateError = 'SIMERR_I1'
|
|
Error 'InputFile Error Simulation'
|
|
Case toFoxBin2Prg.c_SimulateError = 'SIMERR_I0'
|
|
.writeErrorLog( '*** SIMULATED ERROR' )
|
|
Endcase
|
|
|
|
If .l_Error
|
|
.writeLog( '*** ERRORS found - Generation Cancelled' )
|
|
Exit
|
|
Endif
|
|
|
|
toFoxBin2Prg.updateProcessedFile( lnIDInputFile )
|
|
.updateProgressbar( 'Generating Binary...', 2, 2, 1 )
|
|
toFoxBin2Prg.doBackup( .F., .T., '', '', '' )
|
|
.createProject()
|
|
.writeBinaryFile( @toProject, @toFoxBin2Prg )
|
|
Endwith && THIS
|
|
|
|
|
|
Catch To toEx
|
|
If This.n_Debug > 0 And _vfp.StartMode = 0
|
|
Set Step On
|
|
Endif
|
|
|
|
Throw
|
|
|
|
Finally
|
|
Use In (Select("TABLABIN"))
|
|
Release laCodeLines, lnCodeLines, laLineasExclusion, lnBloquesExclusion, I
|
|
Endtry
|
|
|
|
Return
|
|
Endproc
|
|
|
|
|
|
|
|
Procedure writeBinaryFile
|
|
Lparameters toProject, toFoxBin2Prg
|
|
*-- -----------------------------------------------------------------------------------------------------------
|
|
#If .F.
|
|
Local toProject As CL_PROJECT Of 'FOXBIN2PRG.PRG'
|
|
Local toFoxBin2Prg As c_foxbin2prg Of 'FOXBIN2PRG.PRG'
|
|
#Endif
|
|
|
|
Try
|
|
Local lnCodError, lcMainProg, loEx As Exception ;
|
|
, loServerHead As CL_PROJ_SRV_HEAD Of 'FOXBIN2PRG.PRG' ;
|
|
, loFile As CL_PROJ_FILE Of 'FOXBIN2PRG.PRG'
|
|
|
|
With This As c_conversor_prg_a_pjx Of 'FOXBIN2PRG.PRG'
|
|
Store Null To loFile, loServerHead
|
|
toProject._HomeDir = Chrtran( toProject._HomeDir, ['], [] )
|
|
toProject._SccData = Chr(3) + Chr(0) + Chr(1) + Replicate( Chr(0), 651 )
|
|
|
|
*-- addProcessedFile( tcFile, tcInOutType, tcProcessed, tcHasErrors, tcSupported, tcExpanded )
|
|
toFoxBin2Prg.addProcessedFile( .c_OutputFile, 'O', 'P1', 'E0', 'S1', 'X0' )
|
|
|
|
Do Case
|
|
Case toFoxBin2Prg.c_SimulateError = 'SIMERR_O1'
|
|
Error 'OutputFile Error Simulation'
|
|
Endcase
|
|
|
|
*-- Creo solo el registro de cabecera del proyecto
|
|
.createProject_RecordHeader( toProject )
|
|
|
|
lcMainProg = ''
|
|
|
|
If Not Empty(toProject._MainProg)
|
|
lcMainProg = Lower( Sys(2014, toProject._MainProg, Addbs(toProject._HomeDir) ) )
|
|
Endif
|
|
|
|
If Empty(toProject._TimeStamp)
|
|
toProject._TimeStamp = .rowTimeStamp( {^2013/11/04 20:00:00} )
|
|
Endif
|
|
If Empty(toProject._ID)
|
|
toProject._ID = toFoxBin2Prg.unique_ID('N')
|
|
Endif
|
|
|
|
*-- Si hay ProjectHook de proyecto, lo inserto
|
|
If Not Empty(toProject._ProjectHookLibrary)
|
|
Insert Into TABLABIN ;
|
|
( Name ;
|
|
, Type ;
|
|
, EXCLUDE ;
|
|
, Key ;
|
|
, RESERVED1 ) ;
|
|
VALUES ;
|
|
( toProject._ProjectHookLibrary + Chr(0) ;
|
|
, 'W' ;
|
|
, .T. ;
|
|
, Upper(Juststem(toProject._ProjectHookLibrary)) ;
|
|
, toProject._ProjectHookClass + Chr(0) )
|
|
Endif
|
|
|
|
*-- Si hay ICONO de proyecto, lo inserto
|
|
If Not Empty(toProject._Icon)
|
|
Insert Into TABLABIN ;
|
|
( Name ;
|
|
, Type ;
|
|
, Local ;
|
|
, Key ) ;
|
|
VALUES ;
|
|
( Sys(2014, toProject._Icon, Addbs(Justpath(Addbs(toProject._HomeDir)))) + Chr(0) ;
|
|
, 'i' ;
|
|
, .T. ;
|
|
, Upper(Juststem(toProject._Icon)) )
|
|
Endif
|
|
|
|
*-- Agrego los ARCHIVOS
|
|
For Each loFile In toProject FoxObject
|
|
|
|
If Empty(loFile._TimeStamp)
|
|
loFile._TimeStamp = .rowTimeStamp( {^2013/11/04 20:00:00} )
|
|
Endif
|
|
If Empty(loFile._ID)
|
|
loFile._ID = toFoxBin2Prg.unique_ID('N')
|
|
Endif
|
|
|
|
Insert Into TABLABIN ;
|
|
( Name ;
|
|
, Type ;
|
|
, EXCLUDE ;
|
|
, MAINPROG ;
|
|
, COMMENTS ;
|
|
, Local ;
|
|
, CPID ;
|
|
, Id ;
|
|
, Timestamp ;
|
|
, OBJREV ;
|
|
, User ;
|
|
, DEVINFO ;
|
|
, Key ) ;
|
|
VALUES ;
|
|
( loFile._Name + Chr(0) ;
|
|
, .fileTypeCode(Justext(loFile._Name), loFile._Type) ;
|
|
, loFile._Exclude ;
|
|
, (loFile._Name == lcMainProg) ;
|
|
, loFile._Comments ;
|
|
, .T. ;
|
|
, loFile._CPID ;
|
|
, loFile._ID ;
|
|
, loFile._TimeStamp ;
|
|
, loFile._ObjRev ;
|
|
, Strconv(loFile._User,14) ;
|
|
, Strconv(loFile._DevInfo,14) ;
|
|
, Upper(Juststem(loFile._Name)) )
|
|
Endfor
|
|
|
|
Use In (Select("TABLABIN"))
|
|
toFoxBin2Prg.updateProcessedFile()
|
|
Endwith && THIS
|
|
|
|
If This.n_Debug > 0 And _vfp.StartMode = 0
|
|
Set Step On
|
|
Endif
|
|
|
|
Catch To loEx
|
|
lnCodError = loEx.ErrorNo
|
|
toFoxBin2Prg.updateProcessedFile( 0, '', '', 'E1' )
|
|
|
|
If This.n_Debug > 0 And _vfp.StartMode = 0
|
|
Set Step On
|
|
Endif
|
|
|
|
Throw
|
|
|
|
Finally
|
|
Use In (Select("TABLABIN"))
|
|
Store Null To loFile, loServerHead
|
|
Release loFile, loServerHead
|
|
|
|
Endtry
|
|
|
|
Return lnCodError
|
|
Endproc
|
|
|
|
|
|
|
|
Procedure identifyCodeBlocks
|
|
Lparameters taCodeLines, tnCodeLines, taLineasExclusion, tnBloquesExclusion, toProject, toFoxBin2Prg
|
|
*--------------------------------------------------------------------------------------------------------------
|
|
* PARÁMETROS: (v=Pasar por valor | @=Pasar por referencia) (!=Obligatorio | ?=Opcional) (IN/OUT)
|
|
* taCodeLines (@! IN ) El array con las líneas del código donde buscar
|
|
* tnCodeLines (@! IN ) Cantidad de líneas de código
|
|
* taLineasExclusion (@! IN ) Array unidimensional con un .T. o .F. según la línea sea de exclusión o no
|
|
* tnBloquesExclusion (@! IN ) Cantidad de bloques de exclusión
|
|
* toProject (@? OUT) Objeto con toda la información del proyecto analizado
|
|
* toFoxBin2Prg (v! IN ) Referencia al objeto principal
|
|
*
|
|
* NOTA:
|
|
* Como identificador se usa el nombre de clase o de procedimiento, según corresponda.
|
|
*--------------------------------------------------------------------------------------------------------------
|
|
External Array taCodeLines, taLineasExclusion
|
|
|
|
#If .F.
|
|
Local toProject As CL_PROJECT Of 'FOXBIN2PRG.PRG'
|
|
Local toFoxBin2Prg As c_foxbin2prg Of 'FOXBIN2PRG.PRG'
|
|
#Endif
|
|
|
|
Try
|
|
Local I, lc_Comentario, lcLine, llBuildProj_Completed, llDevInfo_Completed ;
|
|
, llServerHead_Completed, llFileComments_Completed, llFoxBin2Prg_Completed ;
|
|
, llExcludedFiles_Completed, llTextFiles_Completed, llProjectProperties_Completed
|
|
|
|
With This As c_conversor_prg_a_pjx Of 'FOXBIN2PRG.PRG'
|
|
Store 0 To I
|
|
.c_Type = Upper(Justext(.c_OutputFile))
|
|
|
|
If tnCodeLines > 1
|
|
toProject = Createobject('CL_PROJECT')
|
|
*toProject._HomeDir = ADDBS(JUSTPATH(.c_OutputFile))
|
|
|
|
For I = 1 To tnCodeLines
|
|
.set_Line( @lcLine, @taCodeLines, m.I )
|
|
|
|
Do Case
|
|
Case .lineIsOnlyCommentAndNoMetadata( @lcLine, @lc_Comentario ) && Vacía o solo Comentarios
|
|
Loop
|
|
|
|
Case Not llFoxBin2Prg_Completed And .analyzeCodeBlock_FoxBin2Prg( toProject, @lcLine, @taCodeLines, @m.I, tnCodeLines )
|
|
llFoxBin2Prg_Completed = .T.
|
|
|
|
Case Not llDevInfo_Completed And .analyzeCodeBlock_DevInfo( toProject, @lcLine, @taCodeLines, @m.I, tnCodeLines )
|
|
llDevInfo_Completed = .T.
|
|
|
|
Case Not llServerHead_Completed And .analyzeCodeBlock_ServerHead( toProject, @lcLine, @taCodeLines, @m.I, tnCodeLines )
|
|
llServerHead_Completed = .T.
|
|
|
|
Case .analyzeCodeBlock_ServerData( toProject, @lcLine, @taCodeLines, @m.I, tnCodeLines )
|
|
*-- Puede haber varios servidores, por eso se siguen valuando
|
|
|
|
Case Not llBuildProj_Completed And .analyzeCodeBlock_BuildProj( toProject, @lcLine, @taCodeLines, @m.I, tnCodeLines, @toFoxBin2Prg )
|
|
llBuildProj_Completed = .T.
|
|
|
|
Case Not llFileComments_Completed And .analyzeCodeBlock_FileComments( toProject, @lcLine, @taCodeLines, @m.I, tnCodeLines )
|
|
llFileComments_Completed = .T.
|
|
|
|
Case Not llExcludedFiles_Completed And .analyzeCodeBlock_ExcludedFiles( toProject, @lcLine, @taCodeLines, @m.I, tnCodeLines )
|
|
llExcludedFiles_Completed = .T.
|
|
|
|
Case Not llTextFiles_Completed And .analyzeCodeBlock_TextFiles( toProject, @lcLine, @taCodeLines, @m.I, tnCodeLines )
|
|
llTextFiles_Completed = .T.
|
|
|
|
Case Not llProjectProperties_Completed And .analyzeCodeBlock_ProjectProperties( toProject, @lcLine, @taCodeLines, @m.I, tnCodeLines )
|
|
llProjectProperties_Completed = .T.
|
|
|
|
Endcase
|
|
|
|
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 <BuildProj>
|
|
*--------------------------------------------------------------------------------------------------------------
|
|
* PARÁMETROS: (v=Pasar por valor | @=Pasar por referencia) (!=Obligatorio | ?=Opcional) (IN/OUT)
|
|
* toProject (@? OUT) Objeto con toda la información del proyecto analizado
|
|
* tcLine (@! IN ) Línea de datos en evaluación
|
|
* taCodeLines (@! IN ) El array con las líneas del código donde buscar
|
|
* tnCodeLines (@! IN ) Cantidad de líneas de código
|
|
* toFoxBin2Prg (v! IN ) Referencia al objeto principal
|
|
*--------------------------------------------------------------------------------------------------------------
|
|
Lparameters toProject, tcLine, taCodeLines, I, tnCodeLines, toFoxBin2Prg
|
|
|
|
#If .F.
|
|
Local toProject As CL_PROJECT Of 'FOXBIN2PRG.PRG'
|
|
Local toFoxBin2Prg As c_foxbin2prg Of 'FOXBIN2PRG.PRG'
|
|
#Endif
|
|
|
|
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 = m.I + 1 To tnCodeLines
|
|
lcComment = ''
|
|
.set_Line( @tcLine, @taCodeLines, m.I )
|
|
|
|
Do Case
|
|
Case Left( tcLine, Len(C_BUILDPROJ_F) ) == C_BUILDPROJ_F
|
|
I = m.I + 1
|
|
Exit
|
|
|
|
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 )
|
|
loFile._User = .get_ValueByName_FromListNamesWithValues( 'User', 'C', @laPropsAndValues )
|
|
|
|
If toFoxBin2Prg.n_BodyDevInfo = 1
|
|
loFile._DevInfo = .get_ValueByName_FromListNamesWithValues( 'DevInfo', 'C', @laPropsAndValues )
|
|
Endif
|
|
|
|
toProject.Add( loFile, loFile._Name )
|
|
|
|
Case Upper( Left( tcLine, 10 ) ) == Upper( '*<.HomeDir' )
|
|
toProject._HomeDir = Strextract( tcLine, "'", "'" )
|
|
|
|
Endcase
|
|
Endfor
|
|
Endwith && THIS
|
|
|
|
I = m.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 <DevInfo>
|
|
*------------------------------------------------------
|
|
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 = m.I + 1 To tnCodeLines
|
|
.set_Line( @tcLine, @taCodeLines, m.I )
|
|
|
|
Do Case
|
|
Case Left( tcLine, Len(C_DEVINFO_F) ) == C_DEVINFO_F
|
|
I = m.I + 1
|
|
Exit
|
|
|
|
Case .lineIsOnlyCommentAndNoMetadata( @tcLine )
|
|
Loop && Saltear comentarios
|
|
|
|
Otherwise
|
|
toProject.setParsedProjInfoLine( @tcLine )
|
|
Endcase
|
|
Endfor
|
|
Endwith && THIS
|
|
|
|
I = m.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 <ServerHead>
|
|
*------------------------------------------------------
|
|
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 = m.I + 1 To tnCodeLines
|
|
.set_Line( @tcLine, @taCodeLines, m.I )
|
|
|
|
Do Case
|
|
Case .lineIsOnlyCommentAndNoMetadata( @tcLine )
|
|
Loop && Saltear comentarios
|
|
|
|
Case Left( tcLine, Len(C_SRV_HEAD_F) ) == C_SRV_HEAD_F
|
|
I = m.I + 1
|
|
Exit
|
|
|
|
Otherwise
|
|
loServerHead.setParsedHeadInfoLine( @tcLine )
|
|
Endcase
|
|
Endfor
|
|
Endwith && THIS
|
|
|
|
I = m.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 <ServerData>
|
|
*------------------------------------------------------
|
|
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 = m.I + 1 To tnCodeLines
|
|
.set_Line( @tcLine, @taCodeLines, m.I )
|
|
|
|
Do Case
|
|
Case .lineIsOnlyCommentAndNoMetadata( @tcLine )
|
|
Loop && Saltear comentarios
|
|
|
|
Case Left( tcLine, Len(C_SRV_DATA_F) ) == C_SRV_DATA_F
|
|
I = m.I + 1
|
|
Exit
|
|
|
|
Otherwise
|
|
loServerHead.setParsedInfoLine( loServerData, @tcLine )
|
|
Endcase
|
|
Endfor
|
|
Endwith && THIS
|
|
|
|
loServerHead.add_Server( loServerData )
|
|
I = m.I - 1
|
|
Endif
|
|
|
|
Catch To loEx
|
|
If This.n_Debug > 0 And _vfp.StartMode = 0
|
|
Set Step On
|
|
Endif
|
|
|
|
Throw
|
|
|
|
Finally
|
|
Store Null To loServerData, loServerHead
|
|
Release loServerHead, loServerData
|
|
|
|
Endtry
|
|
|
|
Return llBloqueEncontrado
|
|
Endproc
|
|
|
|
|
|
|
|
Procedure analyzeCodeBlock_FileComments
|
|
*------------------------------------------------------
|
|
*-- Analiza el bloque <FileComments>
|
|
*------------------------------------------------------
|
|
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 = m.I + 1 To tnCodeLines
|
|
.set_Line( @tcLine, @taCodeLines, m.I )
|
|
|
|
Do Case
|
|
Case .lineIsOnlyCommentAndNoMetadata( @tcLine )
|
|
Loop && Saltear comentarios
|
|
|
|
Case Left( tcLine, Len(C_FILE_CMTS_F) ) == C_FILE_CMTS_F
|
|
I = m.I + 1
|
|
Exit
|
|
|
|
Otherwise
|
|
lcFile = Lower( Alltrim( Strtran( Chrtran( Normalize( Strextract( tcLine, ".ITEM(", ").Description", 1, 1 ) ), ["], [] ), 'lcCurDir+', '', 1, 1, 1) ) )
|
|
lcComment = Alltrim( Chrtran( Strextract( tcLine, "=", "", 1, 2 ), ['], [] ) )
|
|
loFile = toProject( lcFile )
|
|
loFile._Comments = lcComment
|
|
loFile = Null
|
|
Endcase
|
|
Endfor
|
|
Endwith && THIS
|
|
|
|
I = m.I - 1
|
|
Endif
|
|
|
|
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 <ExcludedFiles>
|
|
*------------------------------------------------------
|
|
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 = m.I + 1 To tnCodeLines
|
|
.set_Line( @tcLine, @taCodeLines, m.I )
|
|
|
|
Do Case
|
|
Case .lineIsOnlyCommentAndNoMetadata( @tcLine )
|
|
Loop && Saltear comentarios
|
|
|
|
Case Left( tcLine, Len(C_FILE_EXCL_F) ) == C_FILE_EXCL_F
|
|
I = m.I + 1
|
|
Exit
|
|
|
|
Otherwise
|
|
lcFile = Lower( Alltrim( Strtran( Chrtran( Normalize( Strextract( tcLine, ".ITEM(", ").Exclude", 1, 1 ) ), ["], [] ), 'lcCurDir+', '', 1, 1, 1) ) )
|
|
llExclude = Evaluate( Alltrim( Chrtran( Strextract( tcLine, "=", "", 1, 2 ), ['], [] ) ) )
|
|
loFile = toProject( lcFile )
|
|
loFile._Exclude = llExclude
|
|
loFile = Null
|
|
Endcase
|
|
Endfor
|
|
Endwith && THIS
|
|
|
|
I = m.I - 1
|
|
Endif
|
|
|
|
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 <TextFiles>
|
|
*------------------------------------------------------
|
|
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 = m.I + 1 To tnCodeLines
|
|
.set_Line( @tcLine, @taCodeLines, m.I )
|
|
|
|
Do Case
|
|
Case .lineIsOnlyCommentAndNoMetadata( @tcLine )
|
|
Loop && Saltear comentarios
|
|
|
|
Case Left( tcLine, Len(C_FILE_TXT_F) ) == C_FILE_TXT_F
|
|
I = m.I + 1
|
|
Exit
|
|
|
|
Otherwise
|
|
lcFile = Lower( Alltrim( Strtran( Chrtran( Normalize( Strextract( tcLine, ".ITEM(", ").Type", 1, 1 ) ), ["], [] ), 'lcCurDir+', '', 1, 1, 1) ) )
|
|
lcType = Alltrim( Chrtran( Strextract( tcLine, "=", "", 1, 2 ), ['], [] ) )
|
|
loFile = toProject( lcFile )
|
|
loFile._Type = lcType
|
|
loFile = Null
|
|
Endcase
|
|
Endfor
|
|
Endwith && THIS
|
|
|
|
I = m.I - 1
|
|
Endif
|
|
|
|
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 <ProjectProperties>
|
|
*------------------------------------------------------
|
|
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 = m.I + 1 To tnCodeLines
|
|
.set_Line( @tcLine, @taCodeLines, m.I )
|
|
|
|
Do Case
|
|
Case .lineIsOnlyCommentAndNoMetadata( @tcLine )
|
|
Loop && Saltear comentarios
|
|
|
|
Case Left( tcLine, Len(C_PROJPROPS_F) ) == C_PROJPROPS_F
|
|
I = m.I + 1
|
|
Exit
|
|
|
|
Case Left( tcLine ,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 = m.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 = [<VFPData>] ;
|
|
+ [<memberdata name="analyzecodeblock_cdata_inline" display="analyzeCodeBlock_CDATA_inline"/>] ;
|
|
+ [<memberdata name="analyzecodeblock_platform" display="analyzeCodeBlock_platform"/>] ;
|
|
+ [<memberdata name="analyzecodeblock_reportes" display="analyzeCodeBlock_Reportes"/>] ;
|
|
+ [</VFPData>]
|
|
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
|
|
|
|
If This.n_Debug > 0 And _vfp.StartMode = 0
|
|
Set Step On
|
|
Endif
|
|
|
|
Catch To loEx
|
|
lnCodError = loEx.ErrorNo
|
|
|
|
If This.n_Debug > 0 And _vfp.StartMode = 0
|
|
Set Step On
|
|
Endif
|
|
|
|
Throw
|
|
|
|
Finally
|
|
Use In (Select("TABLABIN"))
|
|
Endtry
|
|
|
|
Return lnCodError
|
|
Endproc
|
|
|
|
|
|
|
|
Procedure writeBinaryFile
|
|
Lparameters toReport, toFoxBin2Prg
|
|
*-- -----------------------------------------------------------------------------------------------------------
|
|
#If .F.
|
|
Local toReport As CL_REPORT Of 'FOXBIN2PRG.PRG'
|
|
Local toFoxBin2Prg As c_foxbin2prg Of 'FOXBIN2PRG.PRG'
|
|
#Endif
|
|
|
|
Try
|
|
Local loReg, I, lcFieldType, lnFieldLen, lnFieldDec, lnNumCampo, laFieldTypes(1,18) ;
|
|
, luValor, lnCodError, loEx As Exception ;
|
|
, loLang As CL_LANG Of 'FOXBIN2PRG.PRG'
|
|
|
|
loLang = _Screen.o_FoxBin2Prg_Lang
|
|
Select TABLABIN
|
|
Afields( laFieldTypes )
|
|
loReg = Null
|
|
|
|
*-- 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(m.I), 1, -1, 1, 1+2+4+8 )
|
|
|
|
If lnNumCampo = 0
|
|
*ERROR 'No se encontró el campo [' + laProps(m.I) + '] en la estructura del archivo ' + DBF("TABLABIN")
|
|
Error (Textmerge(loLang.C_FIELD_NOT_FOUND_ON_FILE_STRUCTURE_LOC))
|
|
Endif
|
|
|
|
lcFieldType = laFieldTypes(lnNumCampo,2)
|
|
lnFieldLen = laFieldTypes(lnNumCampo,3)
|
|
lnFieldDec = laFieldTypes(lnNumCampo,4)
|
|
luValor = Evaluate('loReg.' + laProps(m.I))
|
|
|
|
Do Case
|
|
Case Inlist(lcFieldType, 'B') && Double
|
|
AddProperty( loReg, laProps(m.I), Cast( luValor As &lcFieldType. (lnFieldPrec) ) )
|
|
|
|
Case Inlist(lcFieldType, 'F', 'N', 'Y') && Float, Numeric, Currency
|
|
AddProperty( loReg, laProps(m.I), Cast( luValor As &lcFieldType. (lnFieldLen, lnFieldDec) ) )
|
|
|
|
Case Inlist(lcFieldType, 'W', 'G', 'M', 'Q', 'V', 'C') && Blob, General, Memo, Varbinary, Varchar, Character
|
|
AddProperty( loReg, laProps(m.I), luValor )
|
|
|
|
Otherwise && Demás tipos
|
|
AddProperty( loReg, laProps(m.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, m.I )
|
|
|
|
Do Case
|
|
Case .lineIsOnlyCommentAndNoMetadata( @lcLine, @lc_Comentario ) && Vacía o solo Comentarios
|
|
Loop
|
|
|
|
Case Not llFoxBin2Prg_Completed And .analyzeCodeBlock_FoxBin2Prg( toReport, @lcLine, @taCodeLines, @m.I, tnCodeLines )
|
|
llFoxBin2Prg_Completed = .T.
|
|
|
|
Case .analyzeCodeBlock_Reportes( toReport, @lcLine, @taCodeLines, @m.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 <picture>
|
|
*------------------------------------------------------
|
|
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 = m.I + 1 To tnCodeLines
|
|
tcLine = taCodeLines(m.I)
|
|
|
|
If C_DATA_F $ tcLine && Fin del valor
|
|
lcValue = lcValue + CR_LF + Strextract( tcLine, '', C_DATA_F )
|
|
|
|
*-- Ajustes: En los labels, no se usa CR+LF, sino que se usa solo CR
|
|
If toReg.ObjType = "5" Then
|
|
lcValue = Strtran(lcValue, CR_LF, C_CR)
|
|
Endif
|
|
|
|
AddProperty( toReg, tcPropName, lcValue )
|
|
Exit
|
|
|
|
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 <platform=>
|
|
*------------------------------------------------------
|
|
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(m.X) = ' ' + laProps(m.X)
|
|
lnPos = At( Lower(laProps(m.X)) + '="', tcLine )
|
|
|
|
If lnPos > 0
|
|
lnLenPropName = Len(laProps(m.X))
|
|
lnPos2 = At( '"', Substr( tcLine, lnPos + lnLenPropName + 2 ) )
|
|
lcValue = Substr( tcLine, lnPos + lnLenPropName + 2, lnPos2 - 1 )
|
|
|
|
If laProps(m.X) == ' NAME' And Not Empty(lcValue)
|
|
lcValue = This.denormalizeXMLValue(lcValue)
|
|
Endif
|
|
|
|
AddProperty( toReg, laProps(m.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 <reportes>
|
|
*------------------------------------------------------
|
|
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 = m.I + 1 To tnCodeLines
|
|
lcComment = ''
|
|
.set_Line( @tcLine, @taCodeLines, m.I )
|
|
|
|
Do Case
|
|
Case Left( tcLine, Len(C_TAG_REPORTE_F) ) == C_TAG_REPORTE_F
|
|
I = m.I + 1
|
|
Exit
|
|
|
|
Case .analyzeCodeBlock_platform( toReport, @tcLine, @taCodeLines, @m.I, @tnCodeLines, @loReg )
|
|
|
|
Case .analyzeCodeBlock_CDATA_inline( toReport, @tcLine, @taCodeLines, @m.I, tnCodeLines, @loReg, 'picture' )
|
|
|
|
Case .analyzeCodeBlock_CDATA_inline( toReport, @tcLine, @taCodeLines, @m.I, tnCodeLines, @loReg, 'tag' )
|
|
*-- ARREGLO ALGUNOS VALORES CAMBIADOS AL TEXTUALIZAR
|
|
Do Case
|
|
Case loReg.ObjType == "1"
|
|
loReg.Tag = .decode_SpecialCodes_1_31( loReg.Tag )
|
|
Case Inlist(loReg.ObjType, "25", "26") && Dataenvironment, cursors and relations
|
|
loReg.Tag = Iif( Empty( Chrtran( loReg.Tag, CR_LF+C_TAB, '') ), '', Substr(loReg.Tag,3) ) && Quito el ENTER agregado antes
|
|
Otherwise
|
|
loReg.Tag = .decode_SpecialCodes_1_31( loReg.Tag )
|
|
Endcase
|
|
|
|
Case .analyzeCodeBlock_CDATA_inline( toReport, @tcLine, @taCodeLines, @m.I, tnCodeLines, @loReg, 'tag2' )
|
|
*-- ARREGLO ALGUNOS VALORES CAMBIADOS AL TEXTUALIZAR
|
|
If Not Inlist(loReg.ObjType,"5","6","8")
|
|
loReg.TAG2 = Strconv( loReg.TAG2,14 )
|
|
Endif
|
|
|
|
Case .analyzeCodeBlock_CDATA_inline( toReport, @tcLine, @taCodeLines, @m.I, tnCodeLines, @loReg, 'penred' )
|
|
|
|
Case .analyzeCodeBlock_CDATA_inline( toReport, @tcLine, @taCodeLines, @m.I, tnCodeLines, @loReg, 'style' )
|
|
|
|
Case .analyzeCodeBlock_CDATA_inline( toReport, @tcLine, @taCodeLines, @m.I, tnCodeLines, @loReg, 'expr' )
|
|
|
|
Case .analyzeCodeBlock_CDATA_inline( toReport, @tcLine, @taCodeLines, @m.I, tnCodeLines, @loReg, 'supexpr' )
|
|
|
|
Case .analyzeCodeBlock_CDATA_inline( toReport, @tcLine, @taCodeLines, @m.I, tnCodeLines, @loReg, 'comment' )
|
|
|
|
Case .analyzeCodeBlock_CDATA_inline( toReport, @tcLine, @taCodeLines, @m.I, tnCodeLines, @loReg, 'user' )
|
|
|
|
Endcase
|
|
|
|
Endfor
|
|
Endwith && THIS
|
|
|
|
I = m.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
|
|
|
|
Return llBloqueEncontrado
|
|
Endproc
|
|
|
|
Enddefine && CLASS c_conversor_prg_a_frx AS c_conversor_prg_a_bin
|
|
|
|
Enddefine && CLASS c_conversor_prg_a_frx AS c_conversor_prg_a_bin
|
|
|
|
|
|
Define Class c_conversor_prg_a_dbf As c_conversor_prg_a_bin
|
|
#If .F.
|
|
Local This As c_conversor_prg_a_dbf Of 'FOXBIN2PRG.PRG'
|
|
#Endif
|
|
_MemberData = [<VFPData>] ;
|
|
+ [<memberdata name="analyzecodeblock_table" display="analyzeCodeBlock_TABLE"/>] ;
|
|
+ [<memberdata name="analyzecodeblock_fields" display="analyzeCodeBlock_FIELDS"/>] ;
|
|
+ [<memberdata name="analyzecodeblock_indexes" display="analyzeCodeBlock_INDEXES"/>] ;
|
|
+ [<memberdata name="writebinaryfile_structure" display="writeBinaryFile_STRUCTURE"/>] ;
|
|
+ [<memberdata name="writebinaryfile_indexes" display="writeBinaryFile_INDEXES"/>] ;
|
|
+ [</VFPData>]
|
|
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, lnFileCount, laConfig(1), lcConfigItem, lc_DBF_Conversion_Support, lcAlterTable ;
|
|
, loLang As CL_LANG Of 'FOXBIN2PRG.PRG' ;
|
|
, lcTempDBC, llImportData ;
|
|
, loDBF_CFG As CL_DBF_CFG Of 'FOXBIN2PRG.PRG'
|
|
Store 0 To lnCodError, lnCodeLines
|
|
|
|
With This As c_conversor_prg_a_dbf Of 'FOXBIN2PRG.PRG'
|
|
lnIDInputFile = toFoxBin2Prg.n_ProcessedFiles
|
|
loLang = _Screen.o_FoxBin2Prg_Lang
|
|
|
|
*-- If table CFG exists, use it for DBF-specific configuration. FDBOZZO. 2014/06/15
|
|
lnFileCount = toFoxBin2Prg.get_DBF_Configuration( Forceext(.c_InputFile, 'DBF'), @loDBF_CFG, .T. )
|
|
lcTempDBC = Forcepath( '_FB2P', Justpath(.c_OutputFile) )
|
|
|
|
Do Case
|
|
Case lnFileCount = 1 And loDBF_CFG.DBF_Conversion_Support > 0 And Not Inlist(loDBF_CFG.DBF_Conversion_Support, 2, 8)
|
|
With toFoxBin2Prg
|
|
Error (Textmerge(loLang.C_FILE_NAME_IS_NOT_SUPPORTED_LOC))
|
|
Endwith
|
|
|
|
Case lnFileCount = 1 And loDBF_CFG.DBF_Conversion_Support > 0 && Implica 2 u 8
|
|
llImportData = (loDBF_CFG.DBF_Conversion_Support = 8)
|
|
|
|
Case toFoxBin2Prg.DBF_Conversion_Support = 8 && TXT2BIN (DATA IMPORT)
|
|
llImportData = .T.
|
|
|
|
Case toFoxBin2Prg.DBF_Conversion_Support <> 2
|
|
With toFoxBin2Prg
|
|
Error (Textmerge(loLang.C_FILE_NAME_IS_NOT_SUPPORTED_LOC))
|
|
Endwith
|
|
|
|
Otherwise
|
|
* Asume llImportData = .F.
|
|
|
|
Endcase
|
|
|
|
If Not toFoxBin2Prg.l_ProcessFiles Then
|
|
*-- addProcessedFile( tcFile, tcInOutType, tcProcessed, tcHasErrors, tcSupported, tcExpanded )
|
|
If toFoxBin2Prg.addProcessedFile( .c_OutputFile, 'O', 'P1', 'E0', 'S1', 'X0' ) Then
|
|
toFoxBin2Prg.updateProcessedFile()
|
|
Endif
|
|
|
|
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, campos e índices de la tabla
|
|
.identifyCodeBlocks( @laCodeLines, lnCodeLines, @laLineasExclusion, lnBloquesExclusion, @toTable )
|
|
|
|
Do Case
|
|
Case toFoxBin2Prg.c_SimulateError = 'SIMERR_I1'
|
|
Error 'InputFile Error Simulation'
|
|
Case toFoxBin2Prg.c_SimulateError = 'SIMERR_I0'
|
|
.writeErrorLog( '*** SIMULATED ERROR' )
|
|
Endcase
|
|
|
|
If .l_Error
|
|
.writeLog( '*** ERRORS found - Generation Cancelled' )
|
|
Exit
|
|
Endif
|
|
|
|
toFoxBin2Prg.updateProcessedFile( lnIDInputFile )
|
|
.writeBinaryFile_STRUCTURE( @toTable, @toFoxBin2Prg, @lcAlterTable )
|
|
|
|
If llImportData And lnCodeLines > 1 And toTable._I > 1 Then
|
|
*-- Identifico los registros de la tabla y los agrego
|
|
I = toTable._I - 1
|
|
|
|
*!* Changed by: Lutz Scheffler 21.02.2021
|
|
*!* change date="{^2021-02-21,10:57:00}"
|
|
* additional options controlling
|
|
* - new operations of DBF
|
|
toTable.analyzeCodeBlock( C_TABLE_I, @laCodeLines, @m.I, lnCodeLines, @toFoxBin2Prg,;
|
|
IIF( m.lnFileCount = 1, Nvl( m.loDBF_CFG.l_DBF_BinChar_Base64, m.toFoxBin2Prg.l_DBF_BinChar_Base64 ), m.toFoxBin2Prg.l_DBF_BinChar_Base64 ),;
|
|
IIF( m.lnFileCount = 1, Nvl( m.loDBF_CFG.l_DBF_IncludeDeleted, m.toFoxBin2Prg.l_DBF_IncludeDeleted ), m.toFoxBin2Prg.l_DBF_IncludeDeleted ) )
|
|
*!* /Changed by: Lutz Scheffler 21.02.2021
|
|
|
|
Endif
|
|
|
|
If Not Empty(lcAlterTable)
|
|
Execscript(lcAlterTable)
|
|
Endif
|
|
|
|
.writeBinaryFile_INDEXES( @toTable, @toFoxBin2Prg )
|
|
|
|
Endwith && THIS
|
|
|
|
|
|
Catch To loEx
|
|
lnCodError = loEx.ErrorNo
|
|
|
|
If This.n_Debug > 0 And _vfp.StartMode = 0
|
|
Set Step On
|
|
Endif
|
|
|
|
Throw
|
|
|
|
Finally
|
|
Use In (Select("TABLABIN"))
|
|
Use In (Select(Juststem(This.c_OutputFile)))
|
|
|
|
If Not Empty(lcTempDBC)
|
|
Close Databases
|
|
Erase (Forceext(lcTempDBC,'DBC'))
|
|
Erase (Forceext(lcTempDBC,'DCT'))
|
|
Erase (Forceext(lcTempDBC,'DCX'))
|
|
Endif
|
|
|
|
Store Null To loDBF_CFG
|
|
Release loDBF_CFG
|
|
|
|
Endtry
|
|
|
|
Return lnCodError
|
|
Endproc
|
|
|
|
|
|
|
|
Procedure writeBinaryFile_STRUCTURE
|
|
Lparameters toTable, toFoxBin2Prg, tcAlterTable
|
|
*-- -----------------------------------------------------------------------------------------------------------
|
|
#If .F.
|
|
Local toTable As CL_DBF_TABLE Of 'FOXBIN2PRG.PRG'
|
|
Local toFoxBin2Prg As c_foxbin2prg Of 'FOXBIN2PRG.PRG'
|
|
#Endif
|
|
|
|
Try
|
|
Local I, lnCodError, loEx As Exception ;
|
|
, loField As CL_DBF_FIELD Of 'FOXBIN2PRG.PRG' ;
|
|
, loDBFUtils As CL_DBF_UTILS Of 'FOXBIN2PRG.PRG' ;
|
|
, lcCreateTable, lcLongDec, lcFieldDef, lcIndex, lcTempDBC, lnDataSessionID, lnSelect
|
|
|
|
With This As c_conversor_prg_a_dbf Of 'FOXBIN2PRG.PRG'
|
|
Store Null To loField, loIndex, loDBFUtils
|
|
loDBFUtils = Createobject('CL_DBF_UTILS')
|
|
|
|
Store 0 To lnCodError
|
|
Store '' To lcIndex, lcFieldDef, tcAlterTable
|
|
lnDataSessionID = toFoxBin2Prg.DataSessionId
|
|
|
|
*-- addProcessedFile( tcFile, tcInOutType, tcProcessed, tcHasErrors, tcSupported, tcExpanded )
|
|
toFoxBin2Prg.addProcessedFile( .c_OutputFile, 'O', 'P1', 'E0', 'S1', 'X0' )
|
|
|
|
Do Case
|
|
Case toFoxBin2Prg.c_SimulateError = 'SIMERR_O1'
|
|
Error 'OutputFile Error Simulation'
|
|
Endcase
|
|
|
|
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 + ' ;' + CR_LF + ' ('
|
|
Else
|
|
lcTempDBC = Forcepath( '_FB2P', Justpath(.c_OutputFile) )
|
|
Create Database ( lcTempDBC )
|
|
lcCreateTable = 'CREATE TABLE "' + .c_OutputFile + '" CodePage=' + toTable._CodePage + ' ;' + CR_LF + ' ('
|
|
Endif
|
|
|
|
toTable._TableName = .c_OutputFile
|
|
|
|
*-- Conformo los campos
|
|
For Each loField In toTable._Fields FoxObject
|
|
lcLongDec = ''
|
|
|
|
If Not Empty(lcFieldDef)
|
|
lcFieldDef = lcFieldDef + ';' + CR_LF + ', '
|
|
Endif
|
|
|
|
*-- 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, 'N', 'F' ) And loField._Decimals > '0' Or loField._Type = 'B'
|
|
If Empty(lcLongDec)
|
|
lcLongDec = lcLongDec + '('
|
|
Else
|
|
lcLongDec = lcLongDec + ','
|
|
Endif
|
|
lcLongDec = lcLongDec + loField._Decimals
|
|
Endif
|
|
|
|
If Not Empty(lcLongDec)
|
|
lcLongDec = lcLongDec + ')'
|
|
Endif
|
|
|
|
lcFieldDef = lcFieldDef + lcLongDec
|
|
|
|
*-- Null
|
|
lcFieldDef = lcFieldDef + Iif( loField._Null = '.T.', ' NULL', ' NOT NULL' )
|
|
|
|
*-- NoCPTran
|
|
If loField._NoCPTran = '.T.'
|
|
lcFieldDef = lcFieldDef + ' NOCPTRANS'
|
|
Endif
|
|
|
|
*-- AutoInc
|
|
If loField._AutoInc_NextVal <> '0'
|
|
If toFoxBin2Prg.n_ExcludeDBFAutoincNextval = 1
|
|
*-- If AutoIncNextVal is excluded from text, then assign 1 for allowing regeneration
|
|
*-- of DBF with this field.
|
|
tcAlterTable = tcAlterTable + ' ;' + CR_LF + ' ALTER ' + loField._Name + ' ' + loField._Type + ' AUTOINC NEXTVAL 1 STEP ' + loField._AutoInc_Step
|
|
Else
|
|
tcAlterTable = tcAlterTable + ' ;' + CR_LF + ' ALTER ' + loField._Name + ' ' + loField._Type + ' AUTOINC NEXTVAL ' + loField._AutoInc_NextVal + ' STEP ' + loField._AutoInc_Step
|
|
Endif
|
|
Endif
|
|
|
|
loField = Null
|
|
Endfor
|
|
|
|
lcCreateTable = lcCreateTable + lcFieldDef + ')'
|
|
Execscript(lcCreateTable)
|
|
|
|
If Not Empty(tcAlterTable)
|
|
tcAlterTable = 'ALTER TABLE "' + .c_OutputFile + '" ' + tcAlterTable
|
|
Endif
|
|
|
|
*-- Hook para permitir ejecución externa (por ejemplo, para rellenar la tabla con datos)
|
|
If Not Empty(toFoxBin2Prg.run_AfterCreateTable)
|
|
lnSelect = Select()
|
|
Do (toFoxBin2Prg.run_AfterCreateTable) With (lnDataSessionID), (.c_OutputFile), (toTable)
|
|
Set DataSession To (lnDataSessionID) && Por las dudas externamente se cambie
|
|
Select (lnSelect)
|
|
Endif
|
|
|
|
Endwith && THIS
|
|
|
|
|
|
Catch To loEx
|
|
lnCodError = loEx.ErrorNo
|
|
toFoxBin2Prg.updateProcessedFile( 0, '', '', 'E1' )
|
|
loEx.UserValue = 'lcFieldDef="' + Transform(lcFieldDef) + '"' + CR_LF ;
|
|
+ 'lcCreateTable="' + Transform(lcCreateTable) + '"'
|
|
|
|
If This.n_Debug > 0 And _vfp.StartMode = 0
|
|
Set Step On
|
|
Endif
|
|
|
|
Throw
|
|
|
|
Finally
|
|
Store Null To loField, loDBFUtils
|
|
Release I, loField, loDBFUtils ;
|
|
, lcCreateTable, lcLongDec, lcFieldDef, lcTempDBC, lnDataSessionID, lnSelect
|
|
|
|
Endtry
|
|
|
|
Return lnCodError
|
|
Endproc
|
|
|
|
|
|
|
|
Procedure writeBinaryFile_INDEXES
|
|
Lparameters toTable, toFoxBin2Prg
|
|
*-- -----------------------------------------------------------------------------------------------------------
|
|
#If .F.
|
|
Local toTable As CL_DBF_TABLE Of 'FOXBIN2PRG.PRG'
|
|
Local toFoxBin2Prg As c_foxbin2prg Of 'FOXBIN2PRG.PRG'
|
|
#Endif
|
|
|
|
Try
|
|
Local I, lnCodError, loEx As Exception ;
|
|
, loIndex As CL_DBF_INDEX Of 'FOXBIN2PRG.PRG' ;
|
|
, loDBFUtils As CL_DBF_UTILS Of 'FOXBIN2PRG.PRG' ;
|
|
, ldLastUpdate
|
|
|
|
With This As c_conversor_prg_a_dbf Of 'FOXBIN2PRG.PRG'
|
|
Store Null To loIndex
|
|
Store 0 To lnCodError
|
|
Store '' To lcIndex
|
|
loDBFUtils = Createobject('CL_DBF_UTILS')
|
|
|
|
*-- 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) + '"'
|
|
|
|
If This.n_Debug > 0 And _vfp.StartMode = 0
|
|
Set Step On
|
|
Endif
|
|
|
|
Throw
|
|
|
|
Finally
|
|
Store Null To loIndex
|
|
Release I, loIndex, lcIndex, ldLastUpdate
|
|
|
|
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, m.I )
|
|
|
|
Do Case
|
|
Case .lineIsOnlyCommentAndNoMetadata( @lcLine, @lc_Comentario ) && Vacía o solo Comentarios
|
|
Loop
|
|
|
|
Case Not llFoxBin2Prg_Completed And .analyzeCodeBlock_FoxBin2Prg( toTable, @lcLine, @taCodeLines, @m.I, tnCodeLines )
|
|
llFoxBin2Prg_Completed = .T.
|
|
|
|
Case Not llBloqueTable_Completed And toTable.analyzeCodeBlock( @lcLine, @taCodeLines, @m.I, tnCodeLines )
|
|
llBloqueTable_Completed = .T.
|
|
Exit
|
|
|
|
Endcase
|
|
Endfor
|
|
Endif
|
|
Endwith && THIS
|
|
|
|
Catch To loEx
|
|
If This.n_Debug > 0 And _vfp.StartMode = 0
|
|
Set Step On
|
|
Endif
|
|
|
|
Throw
|
|
|
|
Finally
|
|
Release taCodeLines, tnCodeLines, taLineasExclusion, tnBloquesExclusion, toTable ;
|
|
, I, lc_Comentario, lcLine, llFoxBin2Prg_Completed, llBloqueTable_Completed
|
|
Endtry
|
|
|
|
Return
|
|
Endproc
|
|
|
|
|
|
Enddefine && CLASS c_conversor_prg_a_dbf AS c_conversor_prg_a_bin
|
|
|
|
|
|
* SF, Analyse, just locate
|
|
Define Class c_conversor_prg_a_dbc As c_conversor_prg_a_bin
|
|
#If .F.
|
|
Local This As c_conversor_prg_a_dbc Of 'FOXBIN2PRG.PRG'
|
|
#Endif
|
|
_MemberData = [<VFPData>] ;
|
|
+ [<memberdata name="analyzecodeblock_tables" display="analyzeCodeBlock_TABLES"/>] ;
|
|
+ [<memberdata name="analyzecodeblock_views" display="analyzeCodeBlock_VIEWS"/>] ;
|
|
+ [<memberdata name="analyzecodeblock_tablefields" display="analyzeCodeBlock_TABLEFIELDS"/>] ;
|
|
+ [<memberdata name="analyzecodeblock_viewfields" display="analyzeCodeBlock_VIEWFIELDS"/>] ;
|
|
+ [<memberdata name="analyzecodeblock_relations" display="analyzeCodeBlock_RELATIONS"/>] ;
|
|
+ [<memberdata name="analyzecodeblock_connections" display="analyzeCodeBlock_CONNECTIONS"/>] ;
|
|
+ [<memberdata name="analyzecodeblock_database" display="analyzeCodeBlock_DATABASE"/>] ;
|
|
+ [<memberdata name="verify_external_members" display="verify_EXTERNAL_MEMBERS"/>] ;
|
|
+ [</VFPData>]
|
|
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_UseFilesPerDBC > 0 And toFoxBin2Prg.l_RedirectFilePerDBCToMain
|
|
C_FB2PRG_CODE = Filetostr( .c_InputFile )
|
|
lnCodeLines = Alines( laCodeLines, C_FB2PRG_CODE )
|
|
C_FB2PRG_CODE = ''
|
|
|
|
*-- Quito la última parte del cierre de </DATABASE> para anexar lo intermedio
|
|
For X = 1 To lnCodeLines
|
|
If C_DATABASE_F $ laCodeLines(m.X) Then
|
|
Exit
|
|
Endif
|
|
C_FB2PRG_CODE = C_FB2PRG_CODE + laCodeLines(m.X) + CR_LF
|
|
Endfor
|
|
|
|
.updateProgressbar( 'Identifying Header Blocks...', 1, lnCodeLines, 1 )
|
|
.identifyHeaderBlocks( @laCodeLines, lnCodeLines, @laLineasExclusion, lnBloquesExclusion, @toDatabase, @toFoxBin2Prg )
|
|
|
|
.updateProgressbar( 'Loading Code...', 2, lnCodeLines, 1 )
|
|
|
|
*-- Esto crea la máscara de búsqueda "<path>Database.*.*.ext" para encontrar las partes
|
|
*-- con la sintaxis "<path>Database.MemberType.MemberName.ext"
|
|
lcBaseFilename = Juststem( Juststem( Juststem(.c_InputFile) ) )
|
|
lcInputFile = Addbs( Justpath(.c_InputFile) ) + lcBaseFilename + '.*.*.' + Justext(.c_InputFile)
|
|
lnFileCount = Adir( laFiles, lcInputFile, "", 1 )
|
|
|
|
*-- Busco "storedprocedures" y le pongo "z" al inicio
|
|
For I = 1 To lnFileCount
|
|
If Lower( laFiles(m.I,1)) == lcBaseFilename + '.database.storedproceduressource.' + Justext(.c_InputFile) Then
|
|
laFiles(m.I,1) = lcBaseFilename + '.zdatabase.storedproceduressource.' + Justext(.c_InputFile)
|
|
Exit
|
|
Endif
|
|
Endfor
|
|
|
|
Asort( laFiles, 1, -1, 0, 1) && "zstoredprocedures" quedará al final
|
|
|
|
*-- Busco "zstoredprocedures" y le quito la "z" del inicio
|
|
For I = 1 To lnFileCount
|
|
If Lower( laFiles(m.I,1)) == lcBaseFilename + '.zdatabase.storedproceduressource.' + Justext(.c_InputFile) Then
|
|
laFiles(m.I,1) = lcBaseFilename + '.database.storedproceduressource.' + Justext(.c_InputFile)
|
|
Exit
|
|
Endif
|
|
Endfor
|
|
|
|
For I = 1 To lnFileCount
|
|
lcInputFile_Class = Forcepath( Juststem( laFiles(m.I,1) ), Justpath( .c_InputFile ) ) + '.' + Justext( .c_InputFile )
|
|
lcMemberType = Lower( Getwordnum( Justfname( lcInputFile_Class ), 2, '.' ) )
|
|
lcMemberName = Lower( Getwordnum( Justfname( lcInputFile_Class ), 3, '.' ) )
|
|
|
|
If toFoxBin2Prg.l_ProcessFiles Then
|
|
If Not lcMemberType == lcLastMemberType Then
|
|
If Not Empty(lcLastMemberType) Then
|
|
*-- Cambio de tipo de miembro, fin del anterior (connection, table, view, storedprocedures)
|
|
Do Case
|
|
Case lcLastMemberType == 'connection'
|
|
C_FB2PRG_CODE = C_FB2PRG_CODE + C_TAB + C_CONNECTIONS_F + CR_LF
|
|
Case lcLastMemberType == 'table'
|
|
C_FB2PRG_CODE = C_FB2PRG_CODE + C_TAB + C_TABLES_F + CR_LF
|
|
Case lcLastMemberType == 'view'
|
|
C_FB2PRG_CODE = C_FB2PRG_CODE + C_TAB + C_VIEWS_F + CR_LF
|
|
Case lcLastMemberType == 'database'
|
|
*C_FB2PRG_CODE = C_FB2PRG_CODE + CR_LF + CR_LF
|
|
Endcase
|
|
|
|
lcLastMemberType = ''
|
|
Endif
|
|
|
|
*-- Cambio de tipo de miembro, inicio del actual (connection, table, view, storedprocedures)
|
|
Do Case
|
|
Case lcMemberType == 'connection'
|
|
C_FB2PRG_CODE = C_FB2PRG_CODE + CR_LF + CR_LF + C_TAB + C_CONNECTIONS_I + CR_LF
|
|
Case lcMemberType == 'table'
|
|
C_FB2PRG_CODE = C_FB2PRG_CODE + CR_LF + CR_LF + C_TAB + C_TABLES_I + CR_LF
|
|
Case lcMemberType == 'view'
|
|
C_FB2PRG_CODE = C_FB2PRG_CODE + CR_LF + CR_LF + C_TAB + C_VIEWS_I + CR_LF
|
|
Case lcMemberType == 'database'
|
|
C_FB2PRG_CODE = C_FB2PRG_CODE + CR_LF + CR_LF
|
|
Endcase
|
|
Endif
|
|
Endif
|
|
|
|
*-- Verificación de los Miembros, si son Externos y se indicó chequearlos
|
|
If toFoxBin2Prg.l_ClassPerFileCheck And Empty(toFoxBin2Prg.c_ClassOperationType) ;
|
|
AND Ascan( toDatabase._ExternalClasses, lcMemberType + '.' + lcMemberName, 1, 0, 1, 1+2+4 ) = 0
|
|
.writeLog( C_TAB + '- ' + loLang.C_OUTER_MEMBER_DOES_NOT_MATCH_INNER_MEMBERS_LOC + ' [' + lcInputFile_Class + ']' )
|
|
.writeErrorLog( C_TAB + '- ' + loLang.C_WARNING_LOC + ' ' + loLang.C_OUTER_MEMBER_DOES_NOT_MATCH_INNER_MEMBERS_LOC + ' [' + lcInputFile_Class + ']' )
|
|
Loop && Salteo este miembro porque no concuerda con los anotados
|
|
Endif
|
|
|
|
.writeLog( C_TAB + C_TAB + '+ ' + loLang.C_INCLUDING_MEMBER_LOC + ' ' + Justfname( lcInputFile_Class ) )
|
|
|
|
*-- addProcessedFile( tcFile, tcInOutType, tcProcessed, tcHasErrors, tcSupported, tcExpanded )
|
|
If toFoxBin2Prg.addProcessedFile( lcInputFile_Class, 'I', 'P1', 'E0', 'S1', 'X1' ) Then
|
|
toFoxBin2Prg.updateProcessedFile()
|
|
Endif
|
|
|
|
If toFoxBin2Prg.l_ProcessFiles Then
|
|
toFoxBin2Prg.normalizeFileCapitalization( .T., lcInputFile_Class )
|
|
lcTempTxt = Filetostr( lcInputFile_Class )
|
|
|
|
For Y = 7 To Alines( laLines, lcTempTxt )
|
|
C_FB2PRG_CODE = C_FB2PRG_CODE + laLines(m.Y) + CR_LF
|
|
Endfor
|
|
|
|
lcLastMemberType = lcMemberType
|
|
Endif
|
|
Endfor
|
|
|
|
If Not toFoxBin2Prg.l_ProcessFiles Then
|
|
*-- addProcessedFile( tcFile, tcInOutType, tcProcessed, tcHasErrors, tcSupported, tcExpanded )
|
|
If toFoxBin2Prg.addProcessedFile( .c_OutputFile, 'O', 'P1', 'E0', 'S1', 'X0' ) Then
|
|
toFoxBin2Prg.updateProcessedFile()
|
|
Endif
|
|
|
|
Exit && Si se indicó no procesar, se sale aquí. (Modo de simulación)
|
|
Endif
|
|
|
|
If Not Empty(lcLastMemberType) Then
|
|
*-- Cambio de tipo de miembro, fin del anterior (connection, table, view, storedprocedures)
|
|
Do Case
|
|
Case lcLastMemberType == 'connection'
|
|
C_FB2PRG_CODE = C_FB2PRG_CODE + C_TAB + C_CONNECTIONS_F + CR_LF
|
|
Case lcLastMemberType == 'table'
|
|
C_FB2PRG_CODE = C_FB2PRG_CODE + C_TAB + C_TABLES_F + CR_LF
|
|
Case lcLastMemberType == 'view'
|
|
C_FB2PRG_CODE = C_FB2PRG_CODE + C_TAB + C_VIEWS_F + CR_LF
|
|
Case lcLastMemberType == 'database'
|
|
*C_FB2PRG_CODE = C_FB2PRG_CODE + CR_LF + CR_LF
|
|
Endcase
|
|
Endif
|
|
|
|
*-- Agrego la última parte con el cierre de </DATABASE>
|
|
For X = m.X To lnCodeLines
|
|
C_FB2PRG_CODE = C_FB2PRG_CODE + laCodeLines(m.X) + CR_LF
|
|
Endfor
|
|
|
|
lnCodeLines = Alines( laCodeLines, C_FB2PRG_CODE )
|
|
Else
|
|
*-- No es clase por archivo, o no se quiere redireccionar a Main.
|
|
If Not toFoxBin2Prg.l_ProcessFiles Then
|
|
*-- addProcessedFile( tcFile, tcInOutType, tcProcessed, tcHasErrors, tcSupported, tcExpanded )
|
|
If toFoxBin2Prg.addProcessedFile( .c_OutputFile, 'O', 'P1', 'E0', 'S1', 'X0' ) Then
|
|
toFoxBin2Prg.updateProcessedFile()
|
|
Endif
|
|
|
|
Exit && Si se indicó no procesar, se sale aquí. (Modo de simulación)
|
|
Endif
|
|
|
|
C_FB2PRG_CODE = Filetostr( .c_InputFile )
|
|
|
|
lnCodeLines = Alines( laCodeLines, C_FB2PRG_CODE )
|
|
|
|
.updateProgressbar( 'Identifying Header Blocks...', 1, lnCodeLines, 1 )
|
|
.identifyHeaderBlocks( @laCodeLines, lnCodeLines, @laLineasExclusion, lnBloquesExclusion, @toDatabase, @toFoxBin2Prg )
|
|
|
|
Endif
|
|
|
|
*-- Identifico el inicio/fin de bloque, definición, cabecera y cuerpo del reporte
|
|
.updateProgressbar( 'Identifying Code Blocks...', 1, 2, 1 )
|
|
.identifyCodeBlocks( @laCodeLines, lnCodeLines, @laLineasExclusion, lnBloquesExclusion, @toDatabase, @toFoxBin2Prg )
|
|
|
|
Do Case
|
|
Case toFoxBin2Prg.c_SimulateError = 'SIMERR_I1'
|
|
Error 'InputFile Error Simulation'
|
|
Case toFoxBin2Prg.c_SimulateError = 'SIMERR_I0'
|
|
.writeErrorLog( '*** SIMULATED ERROR' )
|
|
Endcase
|
|
|
|
If .l_Error
|
|
.writeLog( '*** ERRORS found - Generation Cancelled' )
|
|
Exit
|
|
Endif
|
|
|
|
toFoxBin2Prg.updateProcessedFile( lnIDInputFile )
|
|
.updateProgressbar( 'Generating Binary...', 2, 2, 1 )
|
|
toFoxBin2Prg.doBackup( .F., .T., '', '', '' )
|
|
*.createTable()
|
|
.writeBinaryFile( @toDatabase, @toFoxBin2Prg )
|
|
Endwith && THIS
|
|
|
|
|
|
Catch To loEx
|
|
lnCodError = loEx.ErrorNo
|
|
|
|
If This.n_Debug > 0 And _vfp.StartMode = 0
|
|
Set Step On
|
|
Endif
|
|
|
|
Throw
|
|
|
|
Finally
|
|
Use In (Select("TABLABIN"))
|
|
Endtry
|
|
|
|
Return lnCodError
|
|
Endproc
|
|
|
|
|
|
|
|
Procedure writeBinaryFile
|
|
Lparameters toDatabase, toFoxBin2Prg
|
|
*-- -----------------------------------------------------------------------------------------------------------
|
|
#If .F.
|
|
Local toDatabase As CL_DBC Of 'FOXBIN2PRG.PRG'
|
|
Local toFoxBin2Prg As c_foxbin2prg Of 'FOXBIN2PRG.PRG'
|
|
#Endif
|
|
|
|
Try
|
|
Local lnCodError, lcEventsFile
|
|
lnCodError = 0
|
|
|
|
*-- addProcessedFile( tcFile, tcInOutType, tcProcessed, tcHasErrors, tcSupported, tcExpanded )
|
|
toFoxBin2Prg.addProcessedFile( This.c_OutputFile, 'O', 'P1', 'E0', 'S1', 'X0' )
|
|
|
|
Do Case
|
|
Case toFoxBin2Prg.c_SimulateError = 'SIMERR_O1'
|
|
Error 'OutputFile Error Simulation'
|
|
Endcase
|
|
|
|
If Not Empty(toDatabase._DBCEventFilename)
|
|
If Left(toDatabase._DBCEventFilename,1) = '.' Then
|
|
lcEventsFile = Addbs( Justpath(.c_InputFile) ) + toDatabase._DBCEventFilename
|
|
Else
|
|
lcEventsFile = toDatabase._DBCEventFilename
|
|
Endif
|
|
If File(lcEventsFile) Then
|
|
lcEventsFile = ''
|
|
Else
|
|
Strtofile( '', lcEventsFile )
|
|
Endif
|
|
|
|
*-- Si no recompilo el EventFilename.prg, el EXE dará un error (aunque el PRG no)
|
|
Compile ( Addbs( Justpath( This.c_OutputFile ) ) + toDatabase._DBCEventFilename )
|
|
Endif
|
|
|
|
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_UseFilesPerDBC > 0 And toFoxBin2Prg.l_RedirectFilePerDBCToMain
|
|
Else
|
|
llEXTERNAL_MEMBER_Completed = .T.
|
|
Endif
|
|
|
|
*-- Búsqueda del ID de inicio de bloque (DEFINE CLASS / PROCEDURE)
|
|
For I = 1 To tnCodeLines
|
|
Store '' To lc_Comentario
|
|
.set_Line( @lcLine, @taCodeLines, m.I )
|
|
|
|
Do Case
|
|
Case .lineIsOnlyCommentAndNoMetadata( @lcLine, @lc_Comentario ) && Excluida, vacía o solo Comentarios
|
|
Loop
|
|
|
|
Case Not llFoxBin2Prg_Completed And .analyzeCodeBlock_FoxBin2Prg( @toDatabase, @lcLine, @taCodeLines, @m.I, tnCodeLines )
|
|
llFoxBin2Prg_Completed = .T.
|
|
|
|
Case Not llEXTERNAL_MEMBER_Completed And .analyzeCodeBlock_EXTERNAL_MEMBER( @toDatabase, @lcLine, @taCodeLines, @m.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, m.I )
|
|
|
|
Do Case
|
|
Case .lineIsOnlyCommentAndNoMetadata( @lcLine, @lc_Comentario ) && Vacía o solo Comentarios
|
|
Loop
|
|
|
|
Case Not llFoxBin2Prg_Completed And .analyzeCodeBlock_FoxBin2Prg( toDatabase, @lcLine, @taCodeLines, @m.I, tnCodeLines )
|
|
llFoxBin2Prg_Completed = .T.
|
|
|
|
Case Not llBloqueDatabase_Completed And toDatabase.analyzeCodeBlock( @lcLine, @taCodeLines, @m.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 ;
|
|
, 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_UseFilesPerDBC > 0 And toFoxBin2Prg.l_ItemPerDBCCheck And Empty(toFoxBin2Prg.c_ClassOperationType)
|
|
For I = 1 To toDatabase._ExternalClasses_Count
|
|
lnItem = 0
|
|
|
|
For X = 1 To toDatabase._Members_Count
|
|
If Lower( toDatabase._Members(m.X,1) ) == Lower( toDatabase._ExternalClasses(m.I,1) )
|
|
lnItem = m.X
|
|
Exit
|
|
Endif
|
|
Endfor
|
|
|
|
If lnItem = 0 Then
|
|
lcClaseExterna = Forcepath( Juststem(toFoxBin2Prg.c_InputFile) + '.' + toDatabase._ExternalClasses(m.I,1) + '.' + Justext(toFoxBin2Prg.c_InputFile), Justpath(toFoxBin2Prg.c_InputFile) )
|
|
*ERROR 'No se ha encontrado la clase externa [' + toDatabase._ExternalClasses(m.I,1) + '] en el archivo [' + toFoxBin2Prg.c_InputFile + ']'
|
|
Error ( loLang.C_EXTERNAL_MEMBER_NAME_WAS_NOT_FOUND_LOC + ' [' + lcClaseExterna + ']' )
|
|
Endif
|
|
|
|
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 = [<VFPData>] ;
|
|
+ [<memberdata name="c_menulocation" display="c_MenuLocation"/>] ;
|
|
+ [<memberdata name="n_menutype" display="n_MenuType"/>] ;
|
|
+ [</VFPData>]
|
|
|
|
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, m.I )
|
|
|
|
Do Case
|
|
Case .lineIsOnlyCommentAndNoMetadata( @lcLine, @lc_Comentario ) && Vacía o solo Comentarios
|
|
Loop
|
|
|
|
Case Not llFoxBin2Prg_Completed And .analyzeCodeBlock_FoxBin2Prg( toMenu, @lcLine, @taCodeLines, @m.I, tnCodeLines )
|
|
llFoxBin2Prg_Completed = .T.
|
|
|
|
Case Not llBloqueMenu_Completed And toMenu.analyzeCodeBlock( @lcLine, @taCodeLines, @m.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 = [<VFPData>] ;
|
|
+ [<memberdata name="convert" display="convert"/>] ;
|
|
+ [<memberdata name="classify_pam_hidden_protected" display="classify_PAM_Hidden_Protected"/>] ;
|
|
+ [<memberdata name="exception2str" display="exception2Str"/>] ;
|
|
+ [<memberdata name="get_add_object_methods" display="get_ADD_OBJECT_METHODS"/>] ;
|
|
+ [<memberdata name="get_class_methods" display="get_CLASS_METHODS"/>] ;
|
|
+ [<memberdata name="get_olepublicobjectname" display="get_OLEPublicObjectName"/>] ;
|
|
+ [<memberdata name="get_propsfrom_protected" display="get_PropsFrom_PROTECTED"/>] ;
|
|
+ [<memberdata name="get_propsandcommentsfrom_reserved3" display="get_PropsAndCommentsFrom_RESERVED3"/>] ;
|
|
+ [<memberdata name="get_propsandvaluesfrom_properties" display="get_PropsAndValuesFrom_PROPERTIES"/>] ;
|
|
+ [<memberdata name="ignoreincorrectdefinedobjects" display="ignoreIncorrectDefinedObjects"/>] ;
|
|
+ [<memberdata name="indentmemo" display="indentMemo"/>] ;
|
|
+ [<memberdata name="memoinoneline" display="memoInOneLine"/>] ;
|
|
+ [<memberdata name="method2array" display="method2Array"/>] ;
|
|
+ [<memberdata name="normalizeassignment" display="normalizeAssignment"/>] ;
|
|
+ [<memberdata name="set_multilinememowithaddobjectproperties" display="set_MultilineMemoWithAddObjectProperties"/>] ;
|
|
+ [<memberdata name="sortmethod" display="sortMethod"/>] ;
|
|
+ [<memberdata name="write_add_objects_withproperties" display="write_ADD_OBJECTS_WithProperties"/>] ;
|
|
+ [<memberdata name="write_all_object_methods" display="write_ALL_OBJECT_METHODS"/>] ;
|
|
+ [<memberdata name="write_classmetadata" display="write_CLASSMETADATA"/>] ;
|
|
+ [<memberdata name="write_class_properties" display="write_CLASS_PROPERTIES"/>] ;
|
|
+ [<memberdata name="write_dbc_header" display="write_DBC_HEADER"/>] ;
|
|
+ [<memberdata name="write_dbc_connections" display="write_DBC_CONNECTIONS"/>] ;
|
|
+ [<memberdata name="write_dbc_tables" display="write_DBC_TABLES"/>] ;
|
|
+ [<memberdata name="write_dbc_table_fields" display="write_DBC_TABLE_FIELDS"/>] ;
|
|
+ [<memberdata name="write_dbc_table_indexes" display="write_DBC_TABLE_INDEXES"/>] ;
|
|
+ [<memberdata name="write_dbc_views" display="write_DBC_VIEWS"/>] ;
|
|
+ [<memberdata name="write_dbc_view_fields" display="write_DBC_VIEW_FIELDS"/>] ;
|
|
+ [<memberdata name="write_dbc_view_indexes" display="write_DBC_VIEW_INDEXES"/>] ;
|
|
+ [<memberdata name="write_dbc_relations" display="write_DBC_RELATIONS"/>] ;
|
|
+ [<memberdata name="write_dbf_header" display="write_DBF_HEADER"/>] ;
|
|
+ [<memberdata name="write_dbf_fields" display="write_DBF_FIELDS"/>] ;
|
|
+ [<memberdata name="write_dbf_indexes" display="write_DBF_INDEXES"/>] ;
|
|
+ [<memberdata name="write_defined_pam" display="write_DEFINED_PAM"/>] ;
|
|
+ [<memberdata name="write_define_class" display="write_DEFINE_CLASS"/>] ;
|
|
+ [<memberdata name="write_define_class_comments" display="write_Define_Class_COMMENTS"/>] ;
|
|
+ [<memberdata name="write_oleobjectdefinitions" display="write_OLEObjectDefinitions"/>] ;
|
|
+ [<memberdata name="write_enddefine_ifapplicable" display="write_ENDDEFINE_IfApplicable"/>] ;
|
|
+ [<memberdata name="write_external_class_header" display="write_EXTERNAL_CLASS_HEADER"/>] ;
|
|
+ [<memberdata name="write_external_member_header" display="write_EXTERNAL_MEMBER_HEADER"/>] ;
|
|
+ [<memberdata name="write_hidden_properties" display="write_HIDDEN_Properties"/>] ;
|
|
+ [<memberdata name="write_include" display="write_INCLUDE"/>] ;
|
|
+ [<memberdata name="write_objectmetadata" display="write_OBJECTMETADATA"/>] ;
|
|
+ [<memberdata name="write_outputfile" display="write_OutputFile"/>] ;
|
|
+ [<memberdata name="write_protected_properties" display="write_PROTECTED_Properties"/>] ;
|
|
+ [<memberdata name="write_txt_reporte" display="write_TXT_REPORTE"/>] ;
|
|
+ [</VFPData>]
|
|
|
|
|
|
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(m.I) )
|
|
Loop
|
|
|
|
Case Right( taProtected(m.I), 1 ) == '^'
|
|
*-- Hidden Property or method
|
|
lcProp = Chrtran( taProtected(m.I), '^', '' )
|
|
If Ascan(taPropsAndComments, '*' + lcProp, 1, 0, 1, 1+2+4) > 0
|
|
Loop && method
|
|
Endif
|
|
tcHiddenProp = tcHiddenProp + ',' + lcProp
|
|
|
|
Otherwise
|
|
*-- Protected Property or method
|
|
If Ascan(taPropsAndComments, '*' + taProtected(m.I), 1, 0, 1, 1+2+4) > 0
|
|
Loop && method
|
|
Endif
|
|
tcProtectedProp = tcProtectedProp + ',' + taProtected(m.I)
|
|
Endcase
|
|
Endfor
|
|
|
|
Endif
|
|
Endproc
|
|
|
|
|
|
|
|
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(m.I,2) = 0
|
|
Loop
|
|
Endif
|
|
|
|
If Empty(toRegObj.Parent)
|
|
lcMethodName = toRegObj.OBJNAME + '.' + taMethods(m.I,1)
|
|
Else
|
|
Do Case
|
|
Case '.' $ toRegObj.Parent
|
|
lcMethodName = Substr(toRegObj.Parent, At('.', toRegObj.Parent) + 1) + '.' + toRegObj.OBJNAME + '.' + taMethods(m.I,1)
|
|
|
|
Case Lower( Left(toRegObj.Parent + '.', Len( toRegClass.OBJNAME + '.' ) ) ) == Lower( toRegClass.OBJNAME + '.' )
|
|
lcMethodName = toRegObj.OBJNAME + '.' + taMethods(m.I,1)
|
|
|
|
Otherwise
|
|
lcMethodName = toRegObj.Parent + '.' + toRegObj.OBJNAME + '.' + taMethods(m.I,1)
|
|
|
|
Endcase
|
|
Endif
|
|
|
|
*-- Genero el método SIN indentar, ya que se hace luego
|
|
taCode(taMethods(m.I,2)) = 'PROCEDURE ' + lcMethodName + CR_LF + .indentMemo( taCode(taMethods(m.I,2)) ) + CR_LF + 'ENDPROC'
|
|
taMethods(m.I,1) = lcMethodName
|
|
Endfor
|
|
Endif
|
|
Endwith && THIS
|
|
|
|
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, toFoxBin2Prg
|
|
*-- DEFINIR MÉTODOS DE LA CLASE
|
|
*-- Ubico los métodos protegidos y les cambio la definición
|
|
External Array taMethods, taCode, taProtected, taPropsAndComments
|
|
|
|
#If .F.
|
|
Local toFoxBin2Prg As c_foxbin2prg Of 'FOXBIN2PRG.PRG'
|
|
#Endif
|
|
|
|
Try
|
|
Local lcMethod, lcMethodName, lnProtectedItem, lnCommentRow, lcProcDef, lcMethods, lnLen
|
|
Store '' To lcMethod, lcMethodName, lcProcDef, lcMethods
|
|
|
|
If tnMethodCount > 0 Then
|
|
With This As c_conversor_bin_a_prg Of 'FOXBIN2PRG.PRG'
|
|
For I = 1 To tnMethodCount
|
|
lcMethodName = Chrtran( taMethods(m.I,1), '^', '' )
|
|
lnProtectedItem = Ascan( taProtected, taMethods(m.I,1), 1, 0, 0, 1+2+4)
|
|
|
|
If lnProtectedItem = 0
|
|
lnProtectedItem = Ascan( taProtected, taMethods(m.I,1) + '^', 1, 0, 0, 1+2+4)
|
|
|
|
If lnProtectedItem = 0
|
|
*-- 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(m.I,1)
|
|
|
|
*-- Comentarios del método (si tiene)
|
|
If lnCommentRow > 0 And Not Empty(taPropsAndComments(lnCommentRow,2))
|
|
* PRG_Compat_Level >= 1
|
|
If Bitand(toFoxBin2Prg.n_PRG_Compat_Level, 1) > 0
|
|
lcMethod = lcMethod + C_TAB + C_TAB + 'HELPSTRING "' + taPropsAndComments(lnCommentRow,2) + '"'
|
|
Else
|
|
* PRG_Compat_Level = 0 (Default old setting)
|
|
lcMethod = lcMethod + C_TAB + C_TAB + '&' + '& ' + taPropsAndComments(lnCommentRow,2)
|
|
Endif
|
|
Endif
|
|
|
|
*-- Código del método
|
|
If taMethods(m.I,2) > 0 Then
|
|
taCode(taMethods(m.I,2)) = lcMethod + CR_LF + .indentMemo( taCode(taMethods(m.I,2)) ) + CR_LF + 'ENDPROC'
|
|
Else
|
|
lnLen = Alen(taCode,1) + 1
|
|
Dimension taCode( lnLen )
|
|
taCode( lnLen ) = lcMethod + CR_LF + 'ENDPROC'
|
|
taMethods(m.I,2) = lnLen
|
|
Endif
|
|
Endfor
|
|
Endwith && THIS
|
|
Endif
|
|
|
|
Catch To loEx
|
|
If This.n_Debug > 0 And _vfp.StartMode = 0
|
|
Set Step On
|
|
Endif
|
|
|
|
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(m.I) = Alltrim( ta_NombresObjsOle(m.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(m.I)) && Un espacio separa la propiedad de su comentario (si tiene)
|
|
|
|
If lnPos = 0
|
|
taPropsAndComments(m.I,1) = Lower( laLines(m.I) )
|
|
taPropsAndComments(m.I,2) = ''
|
|
Else
|
|
taPropsAndComments(m.I,1) = Lower( Left( laLines(m.I), lnPos - 1 ) )
|
|
taPropsAndComments(m.I,2) = Substr( laLines(m.I), lnPos + 1 )
|
|
Endif
|
|
Endfor
|
|
|
|
If 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(m.I) )
|
|
Loop
|
|
Endif
|
|
|
|
If C_MPROPHEADER $ laItems(m.I)
|
|
*-- Solo entrará por aquí cuando se evalúe una propiedad de PROPERTIES con un valor especial (largo)
|
|
lnLenAcum = 0
|
|
lnPosEQ = At( '=', laItems(m.I) )
|
|
lcPropName = lcLastIncompletePropName + Left( laItems(m.I), lnPosEQ - 2 )
|
|
lnLenVal = Int( Val( Substr( laItems(m.I), lnPosEQ + 2 + 517, 8) ) )
|
|
lcValue = Substr( laItems(m.I), lnPosEQ + 2 + 517 + 8 )
|
|
|
|
If Len( lcValue ) < lnLenVal
|
|
*-- Como el valor es multi-línea, debo agregarle los CR_LF que le quitó el ALINES()
|
|
For I = m.I + 1 To m.lnItemCount
|
|
lcValue = lcValue + CR_LF + laItems(m.I)
|
|
|
|
If Len( lcValue ) >= lnLenVal
|
|
Exit
|
|
Endif
|
|
Endfor
|
|
|
|
lcValue = C_FB2P_VALUE_I + CR_LF + lcValue + CR_LF + C_FB2P_VALUE_F
|
|
Else
|
|
lcValue = C_FB2P_VALUE_I + lcValue + C_FB2P_VALUE_F
|
|
Endif
|
|
|
|
*-- Es un valor especial, por lo que se encapsula en un marcador especial
|
|
X = m.X + 1
|
|
Dimension taPropsAndValues(m.X,2)
|
|
taPropsAndValues(m.X,1) = lcPropName
|
|
taPropsAndValues(m.X,2) = .normalizePropertyValue( lcPropName, lcValue, '' )
|
|
|
|
Else
|
|
*-- Propiedad normal
|
|
lnPosEQ = At( '=', laItems(m.I) )
|
|
|
|
If lnPosEQ = 0 Then
|
|
*-- AUTOFIX DE PROPIEDAD PARTIDA:
|
|
*-- Esto solo puede ocurrir cuando en el memo de Propiedades hay alguna propiedad
|
|
*-- partida debido a una edición manual con un Enter erróneo, algo como esto:
|
|
* comm
|
|
* AND2.Caption = "Command2"
|
|
*
|
|
*-- En el caso anterior, las 2 líneas son realmente una:
|
|
* command2.Caption = "Command2"
|
|
*
|
|
*-- Solución: Guardar esta parte del nombre y agregarlo a la próxima propiedad.
|
|
lcLastIncompletePropName = laItems(m.I)
|
|
Loop
|
|
Endif
|
|
|
|
* Skip ZOrderSet property if configured to
|
|
If toFoxBin2Prg.l_RemoveZOrderSetFromProps And Atc( '.ZOrderSet.', '.' + lcLastIncompletePropName + Left( laItems(m.I), lnPosEQ - 2 ) + '.' ) > 0 Then
|
|
lcLastIncompletePropName = ''
|
|
Loop
|
|
Endif
|
|
|
|
X = m.X + 1
|
|
Dimension taPropsAndValues(m.X,2)
|
|
taPropsAndValues(m.X,1) = lcLastIncompletePropName + Left( laItems(m.I), lnPosEQ - 2 )
|
|
taPropsAndValues(m.X,2) = .normalizePropertyValue( taPropsAndValues(m.X,1), Ltrim( Substr( laItems(m.I), lnPosEQ + 2 ) ), '' )
|
|
Endif
|
|
|
|
lcLastIncompletePropName = ''
|
|
Endfor
|
|
|
|
|
|
tnPropsAndValues_Count = m.X
|
|
lcMethods = ''
|
|
|
|
|
|
*-- 2) SORT
|
|
.sortPropsAndValues( @taPropsAndValues, tnPropsAndValues_Count, tnSort )
|
|
|
|
|
|
*-- Agregar propiedades primero
|
|
For I = 1 To m.tnPropsAndValues_Count
|
|
tcSortedMemo = m.tcSortedMemo + m.taPropsAndValues(m.I,1) + ' = ' + m.taPropsAndValues(m.I,2) + CR_LF
|
|
Endfor
|
|
|
|
*-- Agregar 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(m.I) = taProtected(m.I)
|
|
If Ascan( taProtected, taProtected(m.I), 1, -1, 0, 1+2+4 ) = m.I
|
|
tcSortedMemo = tcSortedMemo + taProtected(m.I) + CR_LF
|
|
Else
|
|
Adel( taProtected, m.I )
|
|
tnProtected_Count = tnProtected_Count - 1
|
|
Endif
|
|
Endfor
|
|
|
|
Dimension taProtected(tnProtected_Count)
|
|
Endif
|
|
|
|
Release tcMemo, tlSort, taProtected, tnProtected_Count, tcSortedMemo, I
|
|
Return
|
|
Endproc
|
|
|
|
|
|
|
|
Procedure ignoreCorruptedObjects(lcCursor)
|
|
* Issue#17 - Error, The specified key already exists
|
|
* Para evitar este error se deben ignorar los objetos corruptos (duplicados)
|
|
* Se identifican porque la clase principal el campo Reserved1 tiene vacio en vez de "Class"
|
|
Local lcParentObjName, lcSetDeleted
|
|
Select (lcCursor)
|
|
lcSetDeleted = Set("Deleted")
|
|
Set Deleted Off
|
|
|
|
Scan For PLATFORM = "WINDOWS" And Empty(Parent) And Empty(RESERVED1)
|
|
lcParentObjName = Lower(OBJNAME)
|
|
Delete
|
|
Skip
|
|
Delete Rest While Getwordnum(Lower(Parent) + '.', 1, '.') == lcParentObjName
|
|
Skip -1
|
|
Endscan
|
|
|
|
Set Deleted &lcSetDeleted.
|
|
Return
|
|
Endproc
|
|
|
|
|
|
|
|
Procedure ignoreIncorrectDefinedObjects(lcCursor)
|
|
* Issue#15 - VFP Designer ignored objects should be ignored by FoxBin2Prg
|
|
Local lcObjName, lcParent, lcParentObjName, loObjs As Collection
|
|
loObjs = Createobject("Collection")
|
|
Select (lcCursor)
|
|
|
|
Scan For PLATFORM = "WINDOWS"
|
|
lcObjName = Lower(OBJNAME)
|
|
lcParent = Lower(Parent)
|
|
|
|
If Empty(lcParent)
|
|
lcParentObjName = lcObjName
|
|
Else
|
|
lcParentObjName = lcParent + '.' + lcObjName
|
|
Endif
|
|
|
|
If Not Empty(lcParent)
|
|
* Tiene Parent, y debe existir, si no es ignorado
|
|
* NOTA: Del parent solo se puede comprobar el objeto primario.
|
|
If loObjs.GetKey(Getwordnum(lcParent + '.', 1, '.')) > 0
|
|
* Existe: se agrega al array el nuevo objeto
|
|
* NOTA: Podría estar duplicado, pero no se trata ese caso aquí
|
|
If Not Empty(lcParentObjName) And loObjs.GetKey(lcParentObjName) = 0
|
|
loObjs.Add( '', lcParentObjName )
|
|
Endif
|
|
Else
|
|
* No existe: se ignora
|
|
Delete
|
|
Endif
|
|
Else
|
|
* No Existe: se agrega al array
|
|
If Not Empty(lcParentObjName) And loObjs.GetKey(lcParentObjName) = 0
|
|
loObjs.Add( '', lcParentObjName )
|
|
Endif
|
|
|
|
Endif
|
|
Endscan
|
|
|
|
Return
|
|
Endproc
|
|
|
|
|
|
|
|
Procedure indentMemo
|
|
Lparameters tcMethod, tcIndentation, tlKeepProcHeader
|
|
*-- INDENTA EL CÓDIGO DE UN MÉTODO DADO Y QUITA LA CABECERA DE MÉTODO (PROCEDURE/ENDPROC) SI LA ENCUENTRA
|
|
Try
|
|
Local I, X, lcMethod, llProcedure, lnInicio, lnFin, laLineas(1), lnOffset ;
|
|
, loLang As CL_LANG Of 'FOXBIN2PRG.PRG'
|
|
|
|
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(m.I)) && Última línea de código
|
|
If llProcedure And Left( Chrtran(laLineas(m.I), C_TAB, ' ') + ' ', 8 ) <> C_ENDPROC + ' ' Then
|
|
*ERROR 'Procedimiento sin cerrar. La última línea de código debe ser ENDPROC. [' + laLineas(1) + ']'
|
|
Error (Textmerge(loLang.C_PROCEDURE_NOT_CLOSED_ON_LINE_LOC))
|
|
Endif
|
|
Exit
|
|
Endif
|
|
X = m.X + 1
|
|
Endfor
|
|
|
|
If m.X > 0
|
|
lnFin = lnFin - m.X
|
|
Dimension laLineas(lnFin)
|
|
Endif
|
|
|
|
*-- Si encuentra la cabecera de un PROCEDURE, la saltea
|
|
If llProcedure
|
|
lnOffset = 1
|
|
Endif
|
|
|
|
For I = lnInicio + lnOffset To lnFin - lnOffset
|
|
*-- TEXT/ENDTEXT aquí da error 2044 de recursividad. No usar.
|
|
lcMethod = lcMethod + CR_LF + tcIndentation + laLineas(m.I)
|
|
Endfor
|
|
|
|
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(m.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(m.I,1) + ' = ' + taPropsAndValues(m.I,2) + lcFinDeLinea
|
|
Endfor
|
|
|
|
*-- Quito el ", ;<CRLF>" 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 Not Empty(Alias()) And Inlist(.c_Type, 'SCX', 'VCX') Then
|
|
If Type("METHODS")#"U" Then
|
|
lcMethods = METHODS
|
|
Endif
|
|
toEx.UserValue = toEx.UserValue + 'Error location ' + '..............................' + CR_LF
|
|
|
|
If Type("PARENT")#"U" And Not Empty(Parent) Then
|
|
lcLocation = lcLocation + Parent + '.'
|
|
Endif
|
|
|
|
If Type("OBJNAME")#"U" Then
|
|
lcLocation = lcLocation + OBJNAME
|
|
Endif
|
|
|
|
*-- Busco el Procedure si hay un n_Methods_LineNo
|
|
Alines(laCodeLines, lcMethods)
|
|
|
|
For I = .n_Methods_LineNo To 1 Step -1
|
|
lcLine = Ltrim( laCodeLines(m.I), 0, ' ', Chr(9) )
|
|
|
|
Do Case
|
|
Case Left(lcLine, 10) == 'PROCEDURE '
|
|
lcMethod = Alltrim( Substr( lcLine, 11) )
|
|
lnErrorLine = .n_Methods_LineNo - m.I
|
|
Exit
|
|
|
|
Case Left(lcLine, 9) == 'FUNCTION '
|
|
lcMethod = Alltrim( Substr( lcLine, 10) )
|
|
lnErrorLine = .n_Methods_LineNo - m.I
|
|
Exit
|
|
|
|
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(m.I,2) > 0 Then
|
|
If '.' $ taMethods(m.I,1)
|
|
*-- Los métodos con '.' los mando a otro array
|
|
lnDeleted = lnDeleted + 1
|
|
laMethods(lnDeleted,1) = taMethods(m.I,1)
|
|
laMethods(lnDeleted,2) = taMethods(m.I,2)
|
|
laMethods(lnDeleted,3) = taMethods(m.I,3)
|
|
Adel( taMethods, m.I )
|
|
Endif
|
|
Endif
|
|
Endfor
|
|
|
|
For I = lnDeleted To 1 Step -1
|
|
*-- Los métodos con '.' los paso al final
|
|
I2 = tnMethodCount - lnDeleted + (lnDeleted - m.I) + 1
|
|
taMethods(I2,1) = laMethods(m.I,1)
|
|
taMethods(I2,2) = laMethods(m.I,2)
|
|
taMethods(I2,3) = laMethods(m.I,3)
|
|
Endfor
|
|
|
|
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(m.I)) Or Left( Ltrim(laLine(m.I)),1 ) = '*'
|
|
*-- Skip empty and commented lines
|
|
Else
|
|
If m.I > 1
|
|
For X = m.I-1 To 1 Step -1
|
|
Adel(laLine, m.X)
|
|
Endfor
|
|
lnLineCount = lnLineCount - m.I + 1
|
|
Dimension laLine(lnLineCount)
|
|
Endif
|
|
Exit
|
|
Endif
|
|
Endfor
|
|
|
|
*-- Delete ending empty lines after last "ENDPROC", that is the last not empty line.
|
|
For I = lnLineCount To 1 Step -1
|
|
If Empty(laLine(m.I)) Or Left( Ltrim(laLine(m.I)),1 ) = '*'
|
|
Adel(laLine, m.I)
|
|
Else
|
|
If m.I < lnLineCount
|
|
lnLineCount = m.I
|
|
Dimension laLine(lnLineCount)
|
|
Endif
|
|
Exit
|
|
Endif
|
|
Endfor
|
|
|
|
*-- Identifico los TEXT/ENDTEXT, #IF .F./#ENDIF
|
|
.identifyExclusionBlocks( @laLine, lnLineCount, .F., @laLineasExclusion, @lnBloquesExclusion )
|
|
|
|
*-- Analyze and count line methods, get method names and consolidate block code
|
|
For I = 1 To lnLineCount
|
|
If toFoxBin2Prg.l_RemoveNullCharsFromCode
|
|
laLine(m.I) = Chrtran( laLine(m.I), C_NULL_CHAR, '' )
|
|
Endif
|
|
|
|
lnLine_Len = Len( laLine(m.I) )
|
|
lcLastLine = lcLine
|
|
toFoxBin2Prg.set_Line( @lcLine, @laLine, m.I )
|
|
.get_SeparatedLineAndComment( @lcLine )
|
|
|
|
Do Case
|
|
Case laLineasExclusion(m.I)
|
|
If tnMethodCount > 0 And llProcOpen
|
|
taCode(tnMethodCount) = taCode(tnMethodCount) + laLine(m.I) + CR_LF
|
|
Else
|
|
*-- Invalid method code, as outer code added for tools like ReFox or others, is cleaned up
|
|
Endif
|
|
|
|
Case Right(lcLastLine,1) == ';'
|
|
*-- Saltear el análisis de esta línea, que es continuación de la anterior (lcLastLine).
|
|
taCode(tnMethodCount) = taCode(tnMethodCount) + laLine(m.I) + CR_LF
|
|
Loop
|
|
|
|
Case lnTextNodes = 0 And Upper( Left(lcLine, 10) ) == 'PROCEDURE '
|
|
tnMethodCount = tnMethodCount + 1
|
|
Dimension taMethods(tnMethodCount, 3), taCode(tnMethodCount)
|
|
taMethods(tnMethodCount, 1) = Rtrim( Substr(lcLine, 11), 0, Chr(9), Chr(0), ' ' )
|
|
taMethods(tnMethodCount, 2) = tnMethodCount
|
|
taMethods(tnMethodCount, 3) = ''
|
|
taCode(tnMethodCount) = 'PROCEDURE ' + taMethods(tnMethodCount, 1) + CR_LF && laLine(m.I) + CR_LF
|
|
llProcOpen = .T.
|
|
|
|
Case lnTextNodes = 0 And Upper( Left(lcLine, 9) ) == 'FUNCTION ' && NOT VALID WITH VFP IDE, BUT 3rd. PARTY SOFTWARE CAN USE IT
|
|
tnMethodCount = tnMethodCount + 1
|
|
Dimension taMethods(tnMethodCount, 3), taCode(tnMethodCount)
|
|
taMethods(tnMethodCount, 1) = Rtrim( Substr(lcLine, 10), 0, Chr(9), Chr(0), ' ' )
|
|
taMethods(tnMethodCount, 2) = tnMethodCount
|
|
taMethods(tnMethodCount, 3) = ''
|
|
taCode(tnMethodCount) = 'PROCEDURE ' + taMethods(tnMethodCount, 1) + CR_LF && laLine(m.I) + CR_LF
|
|
llProcOpen = .T.
|
|
|
|
Case lnTextNodes = 0 And Upper( Left(lcLine, 17) ) == 'HIDDEN PROCEDURE '
|
|
tnMethodCount = tnMethodCount + 1
|
|
Dimension taMethods(tnMethodCount, 3), taCode(tnMethodCount)
|
|
taMethods(tnMethodCount, 1) = Rtrim( Substr(lcLine, 18), 0, Chr(9), Chr(0), ' ' )
|
|
taMethods(tnMethodCount, 2) = tnMethodCount
|
|
taMethods(tnMethodCount, 3) = 'HIDDEN '
|
|
taCode(tnMethodCount) = 'HIDDEN PROCEDURE ' + taMethods(tnMethodCount, 1) + CR_LF && laLine(m.I) + CR_LF
|
|
llProcOpen = .T.
|
|
|
|
Case lnTextNodes = 0 And Upper( Left(lcLine, 16) ) == 'HIDDEN FUNCTION ' && NOT VALID WITH VFP IDE, BUT 3rd. PARTY SOFTWARE CAN USE IT
|
|
tnMethodCount = tnMethodCount + 1
|
|
Dimension taMethods(tnMethodCount, 3), taCode(tnMethodCount)
|
|
taMethods(tnMethodCount, 1) = Rtrim( Substr(lcLine, 17), 0, Chr(9), Chr(0), ' ' )
|
|
taMethods(tnMethodCount, 2) = tnMethodCount
|
|
taMethods(tnMethodCount, 3) = 'HIDDEN '
|
|
taCode(tnMethodCount) = 'HIDDEN PROCEDURE ' + taMethods(tnMethodCount, 1) + CR_LF && laLine(m.I) + CR_LF
|
|
llProcOpen = .T.
|
|
|
|
Case lnTextNodes = 0 And Upper( Left(lcLine, 20) ) == 'PROTECTED PROCEDURE '
|
|
tnMethodCount = tnMethodCount + 1
|
|
Dimension taMethods(tnMethodCount, 3), taCode(tnMethodCount)
|
|
taMethods(tnMethodCount, 1) = Rtrim( Substr(lcLine, 21), 0, Chr(9), Chr(0), ' ' )
|
|
taMethods(tnMethodCount, 2) = tnMethodCount
|
|
taMethods(tnMethodCount, 3) = 'PROTECTED '
|
|
taCode(tnMethodCount) = 'PROTECTED PROCEDURE ' + taMethods(tnMethodCount, 1) + CR_LF && laLine(m.I) + CR_LF
|
|
llProcOpen = .T.
|
|
|
|
Case lnTextNodes = 0 And Upper( Left(lcLine, 19) ) == 'PROTECTED FUNCTION ' && NOT VALID WITH VFP IDE, BUT 3rd. PARTY SOFTWARE CAN USE IT
|
|
tnMethodCount = tnMethodCount + 1
|
|
Dimension taMethods(tnMethodCount, 3), taCode(tnMethodCount)
|
|
taMethods(tnMethodCount, 1) = Rtrim( Substr(lcLine, 20), 0, Chr(9), Chr(0), ' ' )
|
|
taMethods(tnMethodCount, 2) = tnMethodCount
|
|
taMethods(tnMethodCount, 3) = 'PROTECTED '
|
|
taCode(tnMethodCount) = 'PROTECTED PROCEDURE ' + taMethods(tnMethodCount, 1) + CR_LF && laLine(m.I) + CR_LF
|
|
llProcOpen = .T.
|
|
|
|
Case lnTextNodes = 0 And Left(lcLine, 7) == 'ENDPROC'
|
|
If lnLine_Len >= 7 And Left( Upper( Chrtran( lcLine , '&'+Chr(9)+Chr(0), ' ') ) + ' ' ,8) == 'ENDPROC '
|
|
*-- Es el final de estructura ENDPROC
|
|
If Not llProcOpen
|
|
*-- Esto no es normal, porque hay más de un ENDPROC, por lo que se ignora.
|
|
Loop
|
|
Endif
|
|
Else
|
|
*-- Es otra cosa (variable, etc)
|
|
taCode(tnMethodCount) = taCode(tnMethodCount) + lcLine + CR_LF
|
|
Loop
|
|
Endif
|
|
|
|
taCode(tnMethodCount) = taCode(tnMethodCount) + lcLine &&+ CR_LF
|
|
llProcOpen = .F.
|
|
|
|
Case lnTextNodes = 0 And Left(laLine(m.I), 7) == 'ENDFUNC' && NOT VALID WITH VFP IDE, BUT 3rd. PARTY SOFTWARE CAN USE IT
|
|
If lnLine_Len >= 7 And Left( Upper( Chrtran( laLine(m.I) , '&'+Chr(9)+Chr(0), ' ') ) + ' ' ,8) == 'ENDFUNC '
|
|
*-- Es el final de estructura ENDPROC
|
|
If Not llProcOpen
|
|
*-- Esto no es normal, porque hay más de un ENDFUNC, por lo que se ignora.
|
|
Loop
|
|
Endif
|
|
lcLine = Strtran( lcLine, 'ENDFUNC', 'ENDPROC' )
|
|
Else
|
|
*-- Es otra cosa (variable, etc)
|
|
taCode(tnMethodCount) = taCode(tnMethodCount) + lcLine + CR_LF
|
|
Loop
|
|
Endif
|
|
|
|
taCode(tnMethodCount) = taCode(tnMethodCount) + lcLine &&+ CR_LF
|
|
llProcOpen = .F.
|
|
|
|
*CASE tnMethodCount = 0 OR NOT llProcOpen AND LEFT( LTRIM(laLine(m.I)),1 ) = '*'
|
|
Case tnMethodCount = 0 Or Not llProcOpen
|
|
*-- Skip empty and commented lines before methods begin
|
|
*-- Aquí como condición podría poner: NOT llProcOpen AND LEFT(laLine(m.I), 7) # 'ENDPROC', pero abarcaría demasiado.
|
|
|
|
Otherwise && Method Code
|
|
taCode(tnMethodCount) = taCode(tnMethodCount) + laLine(m.I) + CR_LF
|
|
|
|
Endcase
|
|
Endfor
|
|
|
|
*-- Agrego los métodos definidos, pero sin código (Protected/Reserved3)
|
|
For I = 1 To tnPropsAndComments_Count
|
|
lcMethod = Chrtran( taPropsAndComments(m.I,1), '*', '' )
|
|
If Left( taPropsAndComments(m.I,1), 1 ) == '*' And Ascan( taMethods, lcMethod, 1, 0, 1, 1+2+4+8 ) = 0
|
|
tnMethodCount = tnMethodCount + 1
|
|
Dimension taMethods(tnMethodCount, 3) &&, taCode(tnMethodCount)
|
|
taMethods(tnMethodCount, 1) = lcMethod
|
|
taMethods(tnMethodCount, 2) = 0
|
|
|
|
lnProtectedLine = Ascan( taProtected, lcMethod, 1, 0, 1, 1+2+4+8 )
|
|
|
|
If lnProtectedLine = 0 Then
|
|
If tnProtected_Count = 0
|
|
lnProtectedLine = 0
|
|
Else
|
|
lnProtectedLine = Ascan( taProtected, lcMethod + '^', 1, 0, 1, 1+2+4+8 )
|
|
Endif
|
|
|
|
If lnProtectedLine = 0 Then
|
|
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 '<<SUBSTR(toRegObj.Parent, AT('.', toRegObj.Parent)+1)>>.<<toRegObj.objName>>' AS <<LOWER(ALLTRIM(toRegObj.Class))>> <<>>
|
|
ENDTEXT
|
|
Else
|
|
*-- Este caso: objeto
|
|
TEXT TO tcCodigo ADDITIVE TEXTMERGE NOSHOW FLAGS 1+2 PRETEXT 1+2
|
|
<<>> ADD OBJECT '<<toRegObj.objName>>' AS <<LOWER(ALLTRIM(toRegObj.Class))>> <<>>
|
|
ENDTEXT
|
|
Endif
|
|
|
|
If Not Empty(lcMemo)
|
|
TEXT TO tcCodigo ADDITIVE TEXTMERGE NOSHOW FLAGS 1 PRETEXT 1+2
|
|
<<C_WITH>> ;
|
|
<<lcMemo>>
|
|
ENDTEXT
|
|
Endif
|
|
|
|
TEXT TO tcCodigo ADDITIVE TEXTMERGE NOSHOW FLAGS 1+2 PRETEXT 1+2
|
|
<<C_TAB + C_TAB>><<C_END_OBJECT_I>> <<>>
|
|
ENDTEXT
|
|
|
|
If Not Empty(toRegObj.CLASSLOC)
|
|
TEXT TO tcCodigo ADDITIVE TEXTMERGE NOSHOW FLAGS 1 PRETEXT 1+2
|
|
ClassLib="<<toRegObj.ClassLoc>>" <<>>
|
|
ENDTEXT
|
|
Endif
|
|
|
|
TEXT TO tcCodigo ADDITIVE TEXTMERGE NOSHOW FLAGS 1 PRETEXT 1+2+4+8
|
|
BaseClass="<<toRegObj.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="<<LOWER( STREXTRACT(toRegObj.ole2, 'OLEObject = ', CHR(13)+CHR(10), 1, 1+2) )>>"
|
|
Value="<<STRCONV(toRegObj.ole,13)>>" <<>>
|
|
ENDTEXT
|
|
Endif
|
|
|
|
TEXT TO tcCodigo ADDITIVE TEXTMERGE NOSHOW FLAGS 1 PRETEXT 1+2
|
|
<<C_END_OBJECT_F>>
|
|
<<>>
|
|
ENDTEXT
|
|
Endwith
|
|
|
|
Catch To loEx
|
|
If This.n_Debug > 0 And _vfp.StartMode = 0
|
|
Set Step On
|
|
Endif
|
|
|
|
Throw
|
|
|
|
Finally
|
|
Release toRegObj, lcMemo, laPropsAndValues, lnPropsAndValues_Count
|
|
Endtry
|
|
|
|
Return
|
|
Endproc
|
|
|
|
|
|
|
|
Procedure write_ALL_OBJECT_METHODS
|
|
Lparameters tcMethods, taMethods, taCode, tnMethodCount, taPropsAndComments, tnPropsAndComments_Count ;
|
|
, taProtected, tnProtected_Count, toFoxBin2Prg, tcCodigo
|
|
|
|
*-- Finalmente, todos los métodos los ordeno y escribo juntos
|
|
Local laMethods(1), laCode(1), lnMethodCount, I, lcMethods
|
|
|
|
If tnMethodCount > 0 Then
|
|
Store '' To lcMethods
|
|
Dimension laMethods(1,3)
|
|
|
|
With This As c_conversor_bin_a_prg Of 'FOXBIN2PRG.PRG'
|
|
.sortMethod( @tcMethods, @taMethods, @taCode, '', @tnMethodCount ;
|
|
, @taPropsAndComments, tnPropsAndComments_Count, @taProtected, tnProtected_Count, @toFoxBin2Prg )
|
|
|
|
lcMethods = C_TAB
|
|
|
|
For I = 1 To tnMethodCount
|
|
*-- Genero los métodos indentados
|
|
*-- Sustituyo el TEXT/ENDTEXT aquí porque a veces quita espacios de la derecha, y eso es peligroso
|
|
If taMethods(m.I,2) = 0
|
|
Loop
|
|
Endif
|
|
|
|
lcMethods = lcMethods + CR_LF + .indentMemo( taCode(taMethods(m.I,2)), Chr(9) + Chr(9), .T. ) + CR_LF
|
|
Endfor
|
|
Endwith && THIS
|
|
|
|
tcCodigo = tcCodigo + lcMethods
|
|
Endif
|
|
|
|
Release tcMethods, taMethods, taCode, tnMethodCount, taPropsAndComments, tnPropsAndComments_Count, taProtected, tnProtected_Count, toFoxBin2Prg ;
|
|
, laMethods, laCode, lnMethodCount, I, lcMethods
|
|
Return
|
|
Endproc
|
|
|
|
|
|
|
|
Procedure write_CLASS_PROPERTIES
|
|
Lparameters toRegClass, taPropsAndValues, taPropsAndComments, taProtected ;
|
|
, tnPropsAndValues_Count, tnPropsAndComments_Count, tnProtected_Count, tcCodigo, toFoxBin2Prg
|
|
|
|
External Array taPropsAndValues, taPropsAndComments
|
|
|
|
Try
|
|
Local lcHiddenProp, lcProtectedProp, lcPropsMethodsDefd, I ;
|
|
, lcPropName, lnProtectedItem, lcComentarios ;
|
|
, loEx As Exception
|
|
|
|
With This As c_conversor_bin_a_prg Of 'FOXBIN2PRG.PRG'
|
|
*-- DEFINIR PROPIEDADES ( HIDDEN, PROTECTED, *DEFINED_PAM )
|
|
Dimension taProtected(1)
|
|
Store '' To lcHiddenProp, lcProtectedProp, lcPropsMethodsDefd
|
|
Store 0 To tnPropsAndValues_Count, tnPropsAndComments_Count, tnProtected_Count
|
|
.get_PropsAndValuesFrom_PROPERTIES( toRegClass.PROPERTIES, 1, @taPropsAndValues, @tnPropsAndValues_Count, '', @toFoxBin2Prg )
|
|
.get_PropsAndCommentsFrom_RESERVED3( toRegClass.RESERVED3, .T., @taPropsAndComments, @tnPropsAndComments_Count, '' )
|
|
.get_PropsFrom_PROTECTED( toRegClass.Protected, .T., @taProtected, @tnProtected_Count, '' )
|
|
|
|
If tnPropsAndValues_Count > 0 Then
|
|
.classify_PAM_Hidden_Protected( @tnPropsAndValues_Count, @taPropsAndValues, @tnProtected_Count, @taProtected ;
|
|
, @tnPropsAndComments_Count, @taPropsAndComments, @lcHiddenProp, @lcProtectedProp )
|
|
.write_DEFINED_PAM( @taPropsAndComments, tnPropsAndComments_Count, @tcCodigo )
|
|
.write_HIDDEN_Properties( @lcHiddenProp, @tcCodigo )
|
|
.write_PROTECTED_Properties( @lcProtectedProp, @tcCodigo )
|
|
|
|
*-- Escribo las propiedades de la clase y sus comentarios (los comentarios aquí son redundantes)
|
|
For I = 1 To tnPropsAndValues_Count
|
|
tcCodigo = tcCodigo + Chr(13) + Chr(10) + Chr(9) + taPropsAndValues(m.I,1) + ' = ' + taPropsAndValues(m.I,2)
|
|
|
|
If tnPropsAndComments_Count > 0 Then
|
|
lnComment = Ascan( taPropsAndComments, taPropsAndValues(m.I,1), 1, 0, 1, 1+2+4+8)
|
|
|
|
If lnComment > 0 And Not Empty(taPropsAndComments(lnComment,2))
|
|
tcCodigo = tcCodigo + Chr(9) + Chr(9) + '&' + '& ' + taPropsAndComments(lnComment,2)
|
|
Endif
|
|
Endif
|
|
Endfor
|
|
|
|
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
|
|
|
|
*<DefinedPropArrayMethod>
|
|
*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
|
|
*</DefinedPropArrayMethod>
|
|
|
|
If tnPropsAndComments_Count > 0
|
|
Local I, lcPropsMethodsDefd, lcType
|
|
lcPropsMethodsDefd = ''
|
|
|
|
TEXT TO tcCodigo ADDITIVE TEXTMERGE NOSHOW FLAGS 1+2 PRETEXT 1+2
|
|
<<>> <<C_DEFINED_PAM_I>>
|
|
ENDTEXT
|
|
|
|
For I = 1 To tnPropsAndComments_Count
|
|
If Empty(taPropsAndComments(m.I,1))
|
|
Loop
|
|
Endif
|
|
|
|
lcType = Left( taPropsAndComments(m.I,1), 1 )
|
|
lcType = Icase( lcType == '*', 'm' ;
|
|
, lcType == '^', 'a' ;
|
|
, 'p' )
|
|
|
|
If lcType == 'p' Then
|
|
tcCodigo = tcCodigo + Chr(13) + Chr(10) + Chr(9) + Chr(9) + '*' + lcType + ': ' + taPropsAndComments(m.I,1)
|
|
Else
|
|
tcCodigo = tcCodigo + Chr(13) + Chr(10) + Chr(9) + Chr(9) + '*' + lcType + ': ' + Substr( taPropsAndComments(m.I,1), 2)
|
|
Endif
|
|
|
|
If Not Empty(taPropsAndComments(m.I,2))
|
|
tcCodigo = tcCodigo + Chr(9) + Chr(9) + '&' + '& ' + taPropsAndComments(m.I,2)
|
|
Endif
|
|
Endfor
|
|
|
|
TEXT TO tcCodigo ADDITIVE TEXTMERGE NOSHOW FLAGS 1+2 PRETEXT 1+2
|
|
<<>> <<C_DEFINED_PAM_F>>
|
|
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'>> <<ALLTRIM(toRegClass.ObjName)>> AS <<LOWER(ALLTRIM(toRegClass.Class))>> <<lcOF_Classlib + IIF(llOleObject, 'OLEPUBLIC', '')>>
|
|
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 <ClassComments> aparte
|
|
If Occurs( Chr(13), toRegClass.RESERVED7 ) > 0 Then
|
|
TEXT TO tcCodigo ADDITIVE TEXTMERGE NOSHOW FLAGS 1+2 PRETEXT 1+2
|
|
<<>> <<C_CLASSCOMMENTS_I>>
|
|
<<THIS.indentMemo( toRegClass.Reserved7, C_TAB + C_TAB + '*' )>>
|
|
<<>> <<C_CLASSCOMMENTS_F>>
|
|
ENDTEXT
|
|
Else && Comentario in-line
|
|
TEXT TO tcCodigo ADDITIVE TEXTMERGE NOSHOW FLAGS 1 PRETEXT 1+2
|
|
<<>> <<'&'+'&'>> <<toRegClass.Reserved7>>
|
|
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
|
|
<<C_EXTERNAL_CLASS_I>> Name="<<toRegClass.objname>>" Baseclass="<<toRegClass.Baseclass>>" <<C_EXTERNAL_CLASS_F>>
|
|
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
|
|
<<C_EXTERNAL_MEMBER_I>> Name="<<tcMemberName>>" Type="<<tcMemberType>>" <<C_EXTERNAL_MEMBER_F>>
|
|
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 "<<toReg.Reserved8>>"
|
|
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
|
|
<<>> <<C_CLASSDATA_I>>
|
|
Baseclass="<<toRegClass.Baseclass>>"
|
|
Timestamp="<<ALLTRIM(THIS.getTimeStamp(toRegClass.Timestamp))>>"
|
|
Scale="<<toRegClass.Reserved6>>"
|
|
Uniqueid="<<toRegClass.Uniqueid>>"
|
|
ENDTEXT
|
|
|
|
If Not Empty(toRegClass.OLE2)
|
|
TEXT TO tcCodigo ADDITIVE TEXTMERGE NOSHOW FLAGS 1 PRETEXT 1+2+4+8
|
|
<<>> Nombre="<<IIF(EMPTY(toRegClass.Parent),'',toRegClass.Parent+'.') + toRegClass.objName>>"
|
|
Parent="<<toRegClass.Parent>>"
|
|
ObjName="<<toRegClass.objname>>"
|
|
OLEObject="<<STREXTRACT(toRegClass.ole2, 'OLEObject = ', CHR(13)+CHR(10), 1, 1+2)>>"
|
|
Value="<<STRCONV(toRegClass.ole,13)>>"
|
|
ENDTEXT
|
|
Endif
|
|
|
|
If Not Empty(toRegClass.RESERVED5)
|
|
TEXT TO tcCodigo ADDITIVE TEXTMERGE NOSHOW FLAGS 1+2 PRETEXT 1+2+4+8
|
|
ProjectClassIcon="<<toRegClass.Reserved5>>"
|
|
ENDTEXT
|
|
Endif
|
|
|
|
If Not Empty(toRegClass.RESERVED4)
|
|
TEXT TO tcCodigo ADDITIVE TEXTMERGE NOSHOW FLAGS 1+2 PRETEXT 1+2+4+8
|
|
ClassIcon="<<toRegClass.Reserved4>>"
|
|
ENDTEXT
|
|
Endif
|
|
|
|
TEXT TO tcCodigo ADDITIVE TEXTMERGE NOSHOW FLAGS 1+2 PRETEXT 1+2+4+8
|
|
<<C_CLASSDATA_F>>
|
|
ENDTEXT
|
|
|
|
tcCodigo = tcCodigo + CR_LF
|
|
|
|
Return
|
|
Endproc
|
|
|
|
|
|
|
|
Procedure write_OBJECTMETADATA
|
|
Lparameters toRegObj, tcCodigo
|
|
Local lcNombre
|
|
|
|
*-- Agrego Metadatos de los objetos (Timestamp, UniqueID)
|
|
TEXT TO tcCodigo ADDITIVE TEXTMERGE NOSHOW FLAGS 1+2 PRETEXT 1+2
|
|
<<>>
|
|
ENDTEXT
|
|
|
|
If '.' $ toRegObj.Parent
|
|
*-- Este caso: clase.objeto.objeto ==> se quita clase
|
|
lcNombre = Substr(toRegObj.Parent, At('.', toRegObj.Parent)+1) + '.' + toRegObj.OBJNAME
|
|
Else
|
|
*-- Este caso: objeto
|
|
lcNombre = toRegObj.OBJNAME
|
|
Endif
|
|
|
|
TEXT TO tcCodigo ADDITIVE TEXTMERGE NOSHOW FLAGS 1 PRETEXT 1+2+4+8
|
|
<<>> <<C_OBJECTDATA_I>>
|
|
ObjPath="<<lcNombre>>"
|
|
UniqueID="<<toRegObj.Uniqueid>>"
|
|
Timestamp="<<ALLTRIM(THIS.getTimeStamp(toRegObj.Timestamp))>>"
|
|
ENDTEXT
|
|
|
|
TEXT TO tcCodigo ADDITIVE TEXTMERGE NOSHOW FLAGS 1+2 PRETEXT 1+2+4+8
|
|
<<C_OBJECTDATA_F>>
|
|
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 <<SUBSTR(tcHiddenProp,2)>>
|
|
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 <<SUBSTR(tcProtectedProp,2)>>
|
|
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 = '</' + C_TAG_REPORTE + '>'
|
|
|
|
TEXT TO C_FB2PRG_CODE ADDITIVE TEXTMERGE NOSHOW FLAGS 1+2 PRETEXT 1+2
|
|
<<lc_TAG_REPORTE_I>>
|
|
ENDTEXT
|
|
|
|
TEXT TO C_FB2PRG_CODE ADDITIVE TEXTMERGE NOSHOW FLAGS 1+2 PRETEXT 1+2
|
|
<<>> platform="WINDOWS " uniqueid="<<toReg.UniqueID>>" timestamp="<<toReg.TimeStamp>>" objtype="<<toReg.ObjType>>" <<>>
|
|
ENDTEXT
|
|
|
|
TEXT TO C_FB2PRG_CODE ADDITIVE TEXTMERGE NOSHOW FLAGS 1 PRETEXT 1+2
|
|
objcode="<<toReg.ObjCode>>" name="<<THIS.normalizeXMLValue(toReg.Name)>>" <<>>
|
|
ENDTEXT
|
|
|
|
TEXT TO C_FB2PRG_CODE ADDITIVE TEXTMERGE NOSHOW FLAGS 1 PRETEXT 1+2
|
|
vpos="<<toReg.vpos>>" hpos="<<toReg.hpos>>" height="<<toReg.height>>" width="<<toReg.width>>" <<>>
|
|
ENDTEXT
|
|
|
|
TEXT TO C_FB2PRG_CODE ADDITIVE TEXTMERGE NOSHOW FLAGS 1 PRETEXT 1+2
|
|
order="<<toReg.order>>" unique="<<toReg.unique>>" <<>>
|
|
ENDTEXT
|
|
|
|
TEXT TO C_FB2PRG_CODE ADDITIVE TEXTMERGE NOSHOW FLAGS 1 PRETEXT 1+2
|
|
environ="<<toReg.environ>>" boxchar="<<toReg.boxchar>>" fillchar="<<toReg.fillchar>>" <<>>
|
|
ENDTEXT
|
|
|
|
TEXT TO C_FB2PRG_CODE ADDITIVE TEXTMERGE NOSHOW FLAGS 1 PRETEXT 1+2
|
|
pengreen="<<toReg.pengreen>>" penblue="<<toReg.penblue>>" fillred="<<toReg.fillred>>" fillgreen="<<toReg.fillgreen>>" <<>>
|
|
ENDTEXT
|
|
|
|
TEXT TO C_FB2PRG_CODE ADDITIVE TEXTMERGE NOSHOW FLAGS 1 PRETEXT 1+2
|
|
fillblue="<<toReg.fillblue>>" pensize="<<toReg.pensize>>" penpat="<<toReg.penpat>>" fillpat="<<toReg.fillpat>>" <<>>
|
|
ENDTEXT
|
|
|
|
TEXT TO C_FB2PRG_CODE ADDITIVE TEXTMERGE NOSHOW FLAGS 1 PRETEXT 1+2
|
|
fontface="<<toReg.fontface>>" fontstyle="<<toReg.fontstyle>>" fontsize="<<toReg.fontsize>>" mode="<<toReg.mode>>" <<>>
|
|
ENDTEXT
|
|
|
|
TEXT TO C_FB2PRG_CODE ADDITIVE TEXTMERGE NOSHOW FLAGS 1 PRETEXT 1+2
|
|
ruler="<<toReg.ruler>>" rulerlines="<<toReg.rulerlines>>" grid="<<toReg.grid>>" gridv="<<toReg.gridv>>" <<>>
|
|
ENDTEXT
|
|
|
|
TEXT TO C_FB2PRG_CODE ADDITIVE TEXTMERGE NOSHOW FLAGS 1 PRETEXT 1+2
|
|
gridh="<<toReg.gridh>>" float="<<toReg.float>>" stretch="<<toReg.stretch>>" stretchtop="<<toReg.stretchtop>>" <<>>
|
|
ENDTEXT
|
|
|
|
TEXT TO C_FB2PRG_CODE ADDITIVE TEXTMERGE NOSHOW FLAGS 1 PRETEXT 1+2
|
|
top="<<toReg.top>>" bottom="<<toReg.bottom>>" suptype="<<toReg.suptype>>" suprest="<<toReg.suprest>>" norepeat="<<toReg.norepeat>>" <<>>
|
|
ENDTEXT
|
|
|
|
TEXT TO C_FB2PRG_CODE ADDITIVE TEXTMERGE NOSHOW FLAGS 1 PRETEXT 1+2
|
|
resetrpt="<<toReg.resetrpt>>" pagebreak="<<toReg.pagebreak>>" colbreak="<<toReg.colbreak>>" resetpage="<<toReg.resetpage>>" <<>>
|
|
ENDTEXT
|
|
|
|
TEXT TO C_FB2PRG_CODE ADDITIVE TEXTMERGE NOSHOW FLAGS 1 PRETEXT 1+2
|
|
general="<<toReg.general>>" spacing="<<toReg.spacing>>" double="<<toReg.double>>" swapheader="<<toReg.swapheader>>" <<>>
|
|
ENDTEXT
|
|
|
|
TEXT TO C_FB2PRG_CODE ADDITIVE TEXTMERGE NOSHOW FLAGS 1 PRETEXT 1+2
|
|
swapfooter="<<toReg.swapfooter>>" ejectbefor="<<toReg.ejectbefor>>" ejectafter="<<toReg.ejectafter>>" plain="<<toReg.plain>>" <<>>
|
|
ENDTEXT
|
|
|
|
TEXT TO C_FB2PRG_CODE ADDITIVE TEXTMERGE NOSHOW FLAGS 1 PRETEXT 1+2
|
|
summary="<<toReg.summary>>" addalias="<<toReg.addalias>>" offset="<<toReg.offset>>" topmargin="<<toReg.topmargin>>" <<>>
|
|
ENDTEXT
|
|
|
|
TEXT TO C_FB2PRG_CODE ADDITIVE TEXTMERGE NOSHOW FLAGS 1 PRETEXT 1+2
|
|
botmargin="<<toReg.botmargin>>" totaltype="<<toReg.totaltype>>" resettotal="<<toReg.resettotal>>" resoid="<<toReg.resoid>>" <<>>
|
|
ENDTEXT
|
|
|
|
TEXT TO C_FB2PRG_CODE ADDITIVE TEXTMERGE NOSHOW FLAGS 1 PRETEXT 1+2
|
|
curpos="<<toReg.curpos>>" supalways="<<toReg.supalways>>" supovflow="<<toReg.supovflow>>" suprpcol="<<toReg.suprpcol>>" <<>>
|
|
ENDTEXT
|
|
|
|
TEXT TO C_FB2PRG_CODE ADDITIVE TEXTMERGE NOSHOW FLAGS 1 PRETEXT 1+2
|
|
supgroup="<<toReg.supgroup>>" supvalchng="<<toReg.supvalchng>>" <<>>
|
|
ENDTEXT
|
|
|
|
C_FB2PRG_CODE = C_FB2PRG_CODE + CR_LF + " <picture><![CDATA[" + toReg.Picture + "]]>"
|
|
|
|
If Inlist(toReg.ObjType, 25, 26) && Dataenvironment, cursors and relations
|
|
C_FB2PRG_CODE = C_FB2PRG_CODE + CR_LF + " <tag><![CDATA[" + Iif( Empty( Chrtran( toReg.Tag, CR_LF+C_TAB, '') ), '', CR_LF + toReg.Tag) + "]]>"
|
|
C_FB2PRG_CODE = C_FB2PRG_CODE + CR_LF + " <tag2><![CDATA[]]>"
|
|
Else
|
|
C_FB2PRG_CODE = C_FB2PRG_CODE + CR_LF + " <tag><![CDATA[" + This.encode_SpecialCodes_1_31( toReg.Tag ) + "]]>"
|
|
C_FB2PRG_CODE = C_FB2PRG_CODE + CR_LF + " <tag2><![CDATA[" + Iif( Inlist(toReg.ObjType,5,6,8), toReg.TAG2, Strconv( toReg.TAG2,13 ) ) + "]]>"
|
|
Endif
|
|
|
|
C_FB2PRG_CODE = C_FB2PRG_CODE + CR_LF + " <penred><![CDATA[" + Transform(toReg.penred) + "]]>"
|
|
C_FB2PRG_CODE = C_FB2PRG_CODE + CR_LF + " <style><![CDATA[" + toReg.Style + "]]>"
|
|
|
|
If Inlist(toReg.ObjType, 25, 26) && Dataenvironment, cursors and relations
|
|
C_FB2PRG_CODE = C_FB2PRG_CODE + CR_LF + " <expr><![CDATA[" + Chrtran( toReg.Expr, C_NULL_CHAR, '' ) + "]]>"
|
|
Else
|
|
C_FB2PRG_CODE = C_FB2PRG_CODE + CR_LF + " <expr><![CDATA[" + toReg.Expr + "]]>"
|
|
Endif
|
|
|
|
C_FB2PRG_CODE = C_FB2PRG_CODE + CR_LF + " <supexpr><![CDATA[" + toReg.supexpr + "]]>"
|
|
C_FB2PRG_CODE = C_FB2PRG_CODE + CR_LF + " <comment><![CDATA[" + toReg.Comment + "]]>"
|
|
C_FB2PRG_CODE = C_FB2PRG_CODE + CR_LF + " <user><![CDATA[" + toReg.User + "]]>"
|
|
|
|
TEXT TO C_FB2PRG_CODE ADDITIVE TEXTMERGE NOSHOW FLAGS 1+2 PRETEXT 1+2
|
|
<<lc_TAG_REPORTE_F>>
|
|
ENDTEXT
|
|
|
|
Catch To loEx
|
|
If This.n_Debug > 0 And _vfp.StartMode = 0
|
|
Set Step On
|
|
Endif
|
|
|
|
Throw
|
|
|
|
Endtry
|
|
|
|
Return
|
|
Endproc
|
|
|
|
|
|
|
|
Procedure write_OLEObjectDefinitions
|
|
*-- Crea la definición del tag *< OLE: /> con la información de todos los objetos OLE
|
|
Lparameters toFoxBin2Prg
|
|
|
|
Local laOLE(1)
|
|
*!* LOCAL lnOLECount, lcOLEChecksum, llOleExistente, loReg
|
|
|
|
*!* #IF .F.
|
|
*!* LOCAL toFoxBin2Prg AS c_foxbin2prg OF 'FOXBIN2PRG.PRG'
|
|
*!* #ENDIF
|
|
|
|
*!* TRY
|
|
*!* SELECT TABLABIN
|
|
*!* SET ORDER TO PARENT_OBJ
|
|
*!* lnOLECount = 0
|
|
|
|
*!* SCAN ALL FOR TABLABIN.PLATFORM = "WINDOWS" AND BASECLASS = 'olecontrol'
|
|
*!* loReg = NULL
|
|
*!* SCATTER MEMO NAME loReg
|
|
|
|
*!* IF toFoxBin2Prg.l_NoTimestamps
|
|
*!* loReg.TIMESTAMP = 0
|
|
*!* ENDIF
|
|
*!* IF toFoxBin2Prg.l_ClearUniqueID
|
|
*!* loReg.UNIQUEID = ''
|
|
*!* ENDIF
|
|
|
|
*!* lcOLEChecksum = SYS(2007, loReg.OLE, 0, 1)
|
|
*!* llOleExistente = .F.
|
|
|
|
*!* IF lnOLECount > 0 AND ASCAN(laOLE, lcOLEChecksum, 1, 0, 0, 0) > 0
|
|
*!* llOleExistente = .T.
|
|
*!* ENDIF
|
|
|
|
*!* lnOLECount = lnOLECount + 1
|
|
*!* DIMENSION laOLE( lnOLECount )
|
|
*!* laOLE( lnOLECount ) = lcOLEChecksum
|
|
|
|
*!* TEXT TO C_FB2PRG_CODE ADDITIVE TEXTMERGE NOSHOW FLAGS 1+2 PRETEXT 1+2
|
|
*!* <<>>
|
|
*!* ENDTEXT
|
|
|
|
*!* ENDSCAN
|
|
|
|
*-- LO QUE SIGUE LO COMENTÉ PORQUE POR CADA OBJETO OLE SE AGREGABA UNA LÍNEA VACÍA QUE QUEDA MUY MAL Y ES INNECESARIA.
|
|
*-- COMO CONSECUENCIA, LOS FORMS O CLASES CON OBJETOS OLE DARÁN DIFERENCIA POR ÚNICA VEZ EN LA CABECERA. - fdbozzo. 29/11/2014 (v1.19.37)
|
|
*
|
|
*SELECT COUNT(*) FROM TABLABIN WHERE TABLABIN.PLATFORM = "WINDOWS" AND BASECLASS == 'olecontrol' INTO ARRAY laOLE
|
|
|
|
*IF laOLE(1) > 0 THEN
|
|
* *-- Lo del <<>> para crear una línea vacía es solamente por compatibilidad con lo antiguo,
|
|
* *-- donde se creaba esta línea cuando el form o clase tenía al menos un objeto OLE.
|
|
* TEXT TO C_FB2PRG_CODE ADDITIVE TEXTMERGE NOSHOW FLAGS 1+2 PRETEXT 1+2
|
|
* <<>>
|
|
* *
|
|
* ENDTEXT
|
|
*ELSE
|
|
|
|
TEXT TO C_FB2PRG_CODE ADDITIVE TEXTMERGE NOSHOW FLAGS 1+2 PRETEXT 1+2
|
|
*
|
|
ENDTEXT
|
|
*ENDIF
|
|
|
|
*!* CATCH TO loEx
|
|
*!* IF THIS.n_Debug > 0 AND _VFP.STARTMODE = 0
|
|
*!* SET STEP ON
|
|
*!* ENDIF
|
|
|
|
*!* THROW
|
|
|
|
*!* FINALLY
|
|
*!* loReg = NULL
|
|
*!* RELEASE loReg
|
|
|
|
*!* ENDTRY
|
|
|
|
*!* RETURN
|
|
Endproc
|
|
|
|
|
|
|
|
Procedure write_OutputFile
|
|
Lparameters tcCodigo, tcOutputFile, toFoxBin2Prg
|
|
|
|
#If .F.
|
|
Local toFoxBin2Prg As c_foxbin2prg Of 'FOXBIN2PRG.PRG'
|
|
#Endif
|
|
|
|
Try
|
|
Local lcExpanded, llFileExists, lnBytes, lcOutputFile, laDirFile(1,5) ;
|
|
, loLang As CL_LANG Of 'FOXBIN2PRG.PRG'
|
|
|
|
lcExpanded = Iif( '.' $ Juststem(tcOutputFile), 'X1', 'X0' )
|
|
|
|
*-- addProcessedFile( tcFile, tcInOutType, tcProcessed, tcHasErrors, tcSupported, tcExpanded )
|
|
If toFoxBin2Prg.addProcessedFile( tcOutputFile, 'O', 'P1', 'E0', 'S1', lcExpanded ) Then
|
|
|
|
Do Case
|
|
Case toFoxBin2Prg.c_SimulateError = 'SIMERR_O1'
|
|
Error 'OutputFile Error Simulation'
|
|
Endcase
|
|
|
|
toFoxBin2Prg.updateProcessedFile()
|
|
Endif
|
|
|
|
If Not toFoxBin2Prg.l_ProcessFiles Then
|
|
Exit && Si se indicó no procesar, salgo del proceso. (Modo de simulación)
|
|
Endif
|
|
|
|
loLang = _Screen.o_FoxBin2Prg_Lang
|
|
lcOutputFile = tcOutputFile
|
|
llFileExists = ( Adir(laDirFile, tcOutputFile) = 1 )
|
|
|
|
If llFileExists And Filetostr( tcOutputFile ) == tcCodigo Then
|
|
*.writeLog( 'El archivo de salida [' + .c_OutputFile + '] no se sobreescribe por ser igual al generado.' )
|
|
This.writeLog( C_TAB + C_TAB + '* ' + Textmerge(loLang.C_OUTPUT_FILE_IS_NOT_OVERWRITEN_LOC) )
|
|
|
|
Else
|
|
If llFileExists Then
|
|
toFoxBin2Prg.doBackup( .F., .T., '', '', '', tcOutputFile )
|
|
toFoxBin2Prg.changeFileAttribute( tcOutputFile, '-R' )
|
|
Endif
|
|
|
|
lnBytes = Strtofile( tcCodigo, tcOutputFile )
|
|
This.writeLog( C_TAB + C_TAB + '- ' + loLang.C_FILENAME_LOC + ': ' + tcOutputFile + ' (' + Alltrim(Transform(lnBytes/1024,'######.##')) + '/' + Alltrim(Transform(Len(tcCodigo)/1024,'######.##')) + ' KiB)' )
|
|
*THIS.writeLog( '- ' + loLang.C_GENERATED_FILE_SIZE_LOC )
|
|
|
|
If lnBytes = 0
|
|
*ERROR 'No se puede generar el archivo [' + .c_OutputFile + '] porque es ReadOnly'
|
|
Error (Textmerge(loLang.C_CANT_GENERATE_FILE_BECAUSE_IT_IS_READONLY_LOC))
|
|
Endif
|
|
Endif
|
|
|
|
toFoxBin2Prg.normalizeFileCapitalization( .F., tcOutputFile )
|
|
Endtry
|
|
Endproc
|
|
|
|
|
|
|
|
|
|
Procedure FixOle2Fields
|
|
|
|
* (This method is taken from Open Source project TwoFox, from Christof Wallenhaupt - http://www.foxpert.com/downloads.htm)
|
|
* OLE2 contains the physical name of the OCX or DLL when a record refers to an ActiveX
|
|
* control. On different developer machines these controls can be located in different
|
|
* folders without affecting the code.
|
|
*
|
|
* When a control is stored outside the project directory, we assume that every developer
|
|
* is responsible for installing and registering the control. Therefore we only leave
|
|
* the file name which should be fixed. It's also sufficient for VFP to locate an OCX
|
|
* file when the control is not registered and the OCX file is stored in the current
|
|
* directory or the application path.
|
|
*--------------------------------------------------------------------------------------
|
|
* Project directory for comparision purposes
|
|
*--------------------------------------------------------------------------------------
|
|
Local lcProjDir
|
|
lcProjDir = Upper(Alltrim(This.cHomeDir))
|
|
If Right(m.lcProjDir,1) == "\"
|
|
lcProjDir = Left(m.lcProjDir, Len(m.lcProjDir)-1)
|
|
Endif
|
|
|
|
*--------------------------------------------------------------------------------------
|
|
* Check all OLE2 fields
|
|
*--------------------------------------------------------------------------------------
|
|
Local lcOcx
|
|
Scan For Not Empty(OLE2)
|
|
lcOcx = Strextract (OLE2, "OLEObject = ", Chr(13), 1, 1+2)
|
|
If This.OcxOutsideProjDir (m.lcOcx, m.lcProjDir)
|
|
This.TruncateOle2 (m.lcOcx)
|
|
Endif
|
|
Endscan
|
|
|
|
Endproc
|
|
|
|
|
|
|
|
Function OcxOutsideProjDir
|
|
Lparameters tcOcx, tcProjDir
|
|
* (This method is taken from Open Source project TwoFox, from Christof Wallenhaupt - http://www.foxpert.com/downloads.htm)
|
|
* Returns .T. when the OCX control resides outside the project directory
|
|
Local lcOcxDir, llOutside
|
|
lcOcxDir = Upper (Justpath (m.tcOcx))
|
|
If Left(m.lcOcxDir, Len(m.tcProjDir)) == m.tcProjDir
|
|
llOutside = .F.
|
|
Else
|
|
llOutside = .T.
|
|
Endif
|
|
|
|
Return m.llOutside
|
|
Endfunc
|
|
|
|
|
|
Procedure TruncateOle2 (tcOcx)
|
|
* (This method is taken from Open Source project TwoFox, from Christof Wallenhaupt - http://www.foxpert.com/downloads.htm)
|
|
* Cambios de un campo OLE2 exclusivamente en el nombre del archivo
|
|
Replace OLE2 With Strtran ( ;
|
|
OLE2 ;
|
|
,"OLEObject = " + m.tcOcx ;
|
|
,"OLEObject = " + Justfname(m.tcOcx) ;
|
|
)
|
|
Endproc
|
|
|
|
|
|
Enddefine
|
|
|
|
|
|
|
|
Define Class c_conversor_vcx_a_prg As c_conversor_bin_a_prg
|
|
#If .F.
|
|
Local This As c_conversor_vcx_a_prg Of 'FOXBIN2PRG.PRG'
|
|
#Endif
|
|
c_Type = 'VCX'
|
|
|
|
|
|
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 (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 )
|
|
|
|
Try
|
|
Local lnCodError, loRegClass, loRegObj, lnMethodCount, laMethods(1), laCode(1), laProtected(1), lnLen, lnObjCount ;
|
|
, laPropsAndValues(1), laPropsAndComments(1), lnLastClass, lnRecno, lcMethods, lcObjName, la_NombresObjsOle(1) ;
|
|
, laObjs(1,4), I, lnPropsAndValues_Count, lnPropsAndComments_Count, lnProtected_Count, lcCodigo, laClasses(1,3) ;
|
|
, lnClassCount, lcOutputFile, lcExternalHeader, lnClassTotal, lnStepCount, lnStep, lcObjPathInsideClass, lnPos ;
|
|
, loLang As CL_LANG Of 'FOXBIN2PRG.PRG'
|
|
Store 0 To lnCodError, lnLastClass, lnObjCount, lnPropsAndValues_Count, lnPropsAndComments_Count, lnProtected_Count ;
|
|
, lnMethodCount, lnClassCount, lnStepCount, lnStep
|
|
Store '' To laMethods, laCode, laProtected, laPropsAndComments, laObjs, lcCodigo, laClasses, lcOutputFile ;
|
|
, C_FB2PRG_CODE, lcExternalHeader
|
|
Store Null To loRegClass, loRegObj
|
|
loLang = _Screen.o_FoxBin2Prg_Lang
|
|
|
|
With This As c_conversor_vcx_a_prg Of 'FOXBIN2PRG.PRG'
|
|
Use (.c_InputFile) Shared Again Noupdate Alias _TABLAORIG
|
|
|
|
If toFoxBin2Prg.n_UseClassPerFile = 0 Or Empty(toFoxBin2Prg.c_ClassToConvert) Then
|
|
*-- Exportar la librería entera a texto
|
|
Select _TABLAORIG.*,Recno() regnum From _TABLAORIG Into Cursor TABLABIN Readwrite
|
|
Else
|
|
*-- Exportar solo una clase a texto cuando se usa ClassPerFile y se indicó una clase
|
|
Select _TABLAORIG.*,Recno() regnum From _TABLAORIG Into Cursor TABLABIN ;
|
|
WHERE PLATFORM == 'WINDOWS ' ;
|
|
AND ( Proper(RESERVED1) == "Class" And Lower(OBJNAME) == toFoxBin2Prg.c_ClassToConvert ;
|
|
OR Lower( Alltrim( Getwordnum( _TABLAORIG.Parent + '.', 1, '.' ) ) ) == toFoxBin2Prg.c_ClassToConvert ) ;
|
|
OR PLATFORM == 'COMMENT ' And Lower(OBJNAME) == toFoxBin2Prg.c_ClassToConvert
|
|
Endif
|
|
|
|
lnStepCount = 7
|
|
Use In (Select("_TABLAORIG"))
|
|
|
|
* Issue#17: Error, The Specified Key already exists (Kirides)
|
|
.ignoreCorruptedObjects('TABLABIN')
|
|
|
|
* Issue#15: Ignorar objetos mal definidos (Doug Hennig)
|
|
.ignoreIncorrectDefinedObjects('TABLABIN')
|
|
|
|
Index On Padr(Lower(PLATFORM + Iif(Empty(Parent),'',Alltrim(Parent)+'.')+OBJNAME),240) Tag PARENT_OBJ Additive
|
|
Set Order To 0 In TABLABIN
|
|
|
|
.get_OLEPublicObjectName( @la_NombresObjsOle )
|
|
|
|
.write_OLEObjectDefinitions( @toFoxBin2Prg )
|
|
|
|
*-- Escribo los métodos ordenados
|
|
lnLastClass = 0
|
|
|
|
*----------------------------------------------
|
|
*-- RECORRO LAS CLASES
|
|
*----------------------------------------------
|
|
Select TABLABIN
|
|
Set Order To PARENT_OBJ
|
|
|
|
If toFoxBin2Prg.n_UseClassPerFile = 0 Or Empty(toFoxBin2Prg.c_ClassToConvert) Then
|
|
Goto Record 1 && Class Library Header/Form Header
|
|
Scatter Fields RESERVED7 Memo Name loRegClass
|
|
|
|
If Not Empty(loRegClass.RESERVED7) Then
|
|
TEXT TO C_FB2PRG_CODE ADDITIVE TEXTMERGE NOSHOW FLAGS 1+2 PRETEXT 1+2
|
|
<<C_LIBCOMMENT_I>> <<loRegClass.Reserved7>> <<C_LIBCOMMENT_F>>
|
|
*
|
|
ENDTEXT
|
|
Endif
|
|
Endif
|
|
|
|
Count All For Upper( TABLABIN.PLATFORM ) = "WINDOWS" And Proper( TABLABIN.RESERVED1 ) == "Class" To lnClassTotal
|
|
|
|
Scan All For Upper( TABLABIN.PLATFORM ) = "WINDOWS" And Proper( TABLABIN.RESERVED1 ) == "Class"
|
|
Store 0 To lnMethodCount
|
|
Store '' To laMethods, laCode, lcCodigo
|
|
lnClassCount = lnClassCount + 1
|
|
Dimension laClasses(lnClassCount,3)
|
|
|
|
loRegClass = Null
|
|
Scatter Memo Name loRegClass
|
|
|
|
*-- Normalización de capitalización y de datos según parametrización
|
|
loRegClass.BaseClass = Lower( loRegClass.BaseClass )
|
|
loRegClass.CLASSLOC = Lower( loRegClass.CLASSLOC )
|
|
loRegClass.Class = Lower( loRegClass.Class )
|
|
loRegClass.OBJNAME = Lower( loRegClass.OBJNAME )
|
|
|
|
If toFoxBin2Prg.l_NoTimestamps
|
|
loRegClass.Timestamp = 0
|
|
Endif
|
|
If toFoxBin2Prg.l_ClearUniqueID
|
|
loRegClass.UNIQUEID = ''
|
|
Else
|
|
loRegClass.UNIQUEID = Alltrim(loRegClass.UNIQUEID)
|
|
Endif
|
|
|
|
lcObjName = Alltrim( loRegClass.OBJNAME )
|
|
laClasses(lnClassCount,1) = Lower( lcObjName )
|
|
laClasses(lnClassCount,2) = ''
|
|
laClasses(lnClassCount,3) = loRegClass.BaseClass
|
|
|
|
If Not toFoxBin2Prg.l_ProcessFiles Then
|
|
Loop && Si se indicó no procesar, salteo el resto del proceso. (Modo de simulación)
|
|
Endif
|
|
|
|
lnStep = lnStep + 1
|
|
.updateProgressbar( 'Processing Class ' + lcObjName + '...', lnStep, lnClassTotal*lnStepCount, 1 )
|
|
|
|
.write_DEFINE_CLASS( @la_NombresObjsOle, @loRegClass, @lcCodigo )
|
|
|
|
.write_DEFINE_CLASS_COMMENTS( @loRegClass, @lcCodigo )
|
|
|
|
.write_CLASSMETADATA( @loRegClass, @lcCodigo )
|
|
|
|
If toFoxBin2Prg.n_UseClassPerFile > 0 Or Not Empty(toFoxBin2Prg.c_ClassToConvert) Then
|
|
.write_EXTERNAL_CLASS_HEADER( @loRegClass, @toFoxBin2Prg, @lcExternalHeader )
|
|
Endif
|
|
|
|
*-------------------------------------------------------------------------------
|
|
*-- RECORRO LOS OBJETOS DENTRO DE LA CLASE ACTUAL PARA EXPORTAR SU DEFINICIÓN
|
|
*-------------------------------------------------------------------------------
|
|
lnObjCount = 0
|
|
lnRecno = Recno()
|
|
Locate For Upper( TABLABIN.PLATFORM ) = "WINDOWS" ;
|
|
AND Lower( Alltrim( Getwordnum( TABLABIN.Parent, 1, '.' ) ) ) == Lower(lcObjName)
|
|
|
|
Scan Rest While Upper( TABLABIN.PLATFORM ) = "WINDOWS" ;
|
|
AND Lower( Alltrim( Getwordnum( TABLABIN.Parent, 1, '.' ) ) ) == Lower(lcObjName)
|
|
|
|
lnObjCount = lnObjCount + 1
|
|
loRegObj = Null
|
|
Scatter Memo Name loRegObj
|
|
|
|
*-- Normalización de capitalización y de datos según parametrización
|
|
loRegObj.BaseClass = Lower( loRegObj.BaseClass )
|
|
loRegObj.CLASSLOC = Lower( loRegObj.CLASSLOC )
|
|
loRegObj.Class = Lower( loRegObj.Class )
|
|
lcObjPathInsideClass = Lower( loRegObj.Parent ) + '.' + Lower( loRegObj.OBJNAME )
|
|
|
|
If lnObjCount > 1 Then
|
|
lnPos = Ascan( laObjs, lcObjPathInsideClass, 1, 0, 4, 1+2+4+8 )
|
|
|
|
If lnPos > 0 Then
|
|
*-- ERROR: Objeto Duplicado
|
|
.writeErrorLog( '* ' + loLang.C_DUPLICATED_OBJECT_LOC + ' "' + loRegObj.Class + '.' + lcObjPathInsideClass ;
|
|
+ '" @Recno ' + Transform(loRegObj.regnum) + ', (1st.Recno:' + Transform(laObjs(lnPos,2)) + ')' )
|
|
Endif
|
|
Endif
|
|
|
|
Dimension laObjs(lnObjCount,4)
|
|
laObjs(lnObjCount,1) = loRegObj
|
|
laObjs(lnObjCount,2) = loRegObj.regnum && ZOrder
|
|
laObjs(lnObjCount,3) = lnObjCount && Alphabetic order
|
|
laObjs(lnObjCount,4) = lcObjPathInsideClass && To check duplicates
|
|
|
|
If toFoxBin2Prg.l_NoTimestamps
|
|
loRegObj.Timestamp = 0
|
|
Endif
|
|
If toFoxBin2Prg.l_ClearUniqueID
|
|
loRegObj.UNIQUEID = ''
|
|
Else
|
|
loRegObj.UNIQUEID = Alltrim(loRegObj.UNIQUEID)
|
|
Endif
|
|
|
|
loRegObj = Null
|
|
Endscan
|
|
|
|
Goto Record (lnRecno)
|
|
Asort(laObjs, 2, -1, 0, 0) && Orden por ZOrder
|
|
|
|
If lnObjCount > 0
|
|
lcCodigo = lcCodigo + CR_LF + ' *-- OBJECTDATA items order determines ZOrder / El orden de los items OBJECTDATA determina el ZOrder '
|
|
|
|
For I = 1 To lnObjCount
|
|
.write_OBJECTMETADATA( laObjs(m.I,1), @lcCodigo )
|
|
Endfor
|
|
|
|
lcCodigo = lcCodigo + CR_LF
|
|
Endif
|
|
|
|
.write_INCLUDE( @loRegClass, @lcCodigo )
|
|
|
|
lnStep = lnStep + 1
|
|
.updateProgressbar( 'Processing Class ' + lcObjName + ' > Writing Properties...', lnStep, lnClassTotal*lnStepCount, 1 )
|
|
|
|
.write_CLASS_PROPERTIES( @loRegClass, @laPropsAndValues, @laPropsAndComments, @laProtected ;
|
|
, @lnPropsAndValues_Count, @lnPropsAndComments_Count, @lnProtected_Count, @lcCodigo, @toFoxBin2Prg )
|
|
|
|
Asort(laObjs, 3, -1, 0, 0) && Orden Alfabético de objetos (del SCAN original)
|
|
|
|
lnStep = lnStep + 1
|
|
.updateProgressbar( 'Processing Class ' + lcObjName + ' > Writing Obtects with Properties...', lnStep, lnClassTotal*lnStepCount, 1 )
|
|
|
|
For I = 1 To lnObjCount
|
|
.write_ADD_OBJECTS_WithProperties( laObjs(m.I,1), @lcCodigo, @toFoxBin2Prg )
|
|
Endfor
|
|
|
|
|
|
*-- OBTENGO LOS MÉTODOS DE LA CLASE PARA POSTERIOR TRATAMIENTO
|
|
lnStep = lnStep + 1
|
|
.updateProgressbar( 'Processing Class ' + lcObjName + ' > Getting Methods...', lnStep, lnClassTotal*lnStepCount, 1 )
|
|
|
|
Dimension laMethods(1,3), laCode(1)
|
|
Store '' To laMethods, laCode
|
|
lnMethodCount = 0
|
|
|
|
.method2Array( loRegClass.METHODS, @laMethods, @laCode, '', @lnMethodCount ;
|
|
, @laPropsAndComments, lnPropsAndComments_Count, @laProtected, lnProtected_Count, @toFoxBin2Prg, @loRegClass )
|
|
|
|
.get_CLASS_METHODS( @lnMethodCount, @laMethods, @laCode, @laProtected, @laPropsAndComments, @toFoxBin2Prg )
|
|
|
|
lnLastClass = 1
|
|
lcMethods = ''
|
|
|
|
*-- RECORRO LOS OBJETOS DENTRO DE LA CLASE ACTUAL PARA OBTENER SUS MÉTODOS
|
|
lnStep = lnStep + 1
|
|
.updateProgressbar( 'Processing Class ' + lcObjName + ' > Getting Objects Methods...', lnStep, lnClassTotal*lnStepCount, 1 )
|
|
|
|
lnRecno = Recno()
|
|
Locate For Upper( TABLABIN.PLATFORM ) = "WINDOWS" And Lower( Alltrim( Getwordnum( TABLABIN.Parent, 1, '.' ) ) ) == Lower(lcObjName)
|
|
|
|
Scan Rest ;
|
|
FOR Upper( TABLABIN.PLATFORM ) = "WINDOWS" And Not Proper( TABLABIN.RESERVED1 ) == "Class" ;
|
|
WHILE Lower( Alltrim( Getwordnum( TABLABIN.Parent, 1, '.' ) ) ) == Lower(lcObjName)
|
|
|
|
loRegObj = Null
|
|
Scatter Memo Name loRegObj
|
|
|
|
*-- Normalización de capitalización y de datos según parametrización
|
|
loRegObj.BaseClass = Lower( loRegObj.BaseClass )
|
|
loRegObj.CLASSLOC = Lower( loRegObj.CLASSLOC )
|
|
loRegObj.Class = Lower( loRegObj.Class )
|
|
|
|
If toFoxBin2Prg.l_NoTimestamps
|
|
loRegObj.Timestamp = 0
|
|
Endif
|
|
If toFoxBin2Prg.l_ClearUniqueID
|
|
loRegObj.UNIQUEID = ''
|
|
Else
|
|
loRegObj.UNIQUEID = Alltrim(loRegObj.UNIQUEID)
|
|
Endif
|
|
|
|
.get_ADD_OBJECT_METHODS( @loRegObj, @loRegClass, @lcMethods, @laMethods, @laCode, @lnMethodCount ;
|
|
, @laPropsAndComments, lnPropsAndComments_Count, @laProtected, lnProtected_Count, @toFoxBin2Prg )
|
|
Endscan
|
|
|
|
lnStep = lnStep + 1
|
|
.updateProgressbar( 'Processing Class ' + lcObjName + ' > Writing Objects Methods...', lnStep, lnClassTotal*lnStepCount, 1 )
|
|
|
|
.write_ALL_OBJECT_METHODS( @lcMethods, @laMethods, @laCode, @lnMethodCount, @laPropsAndComments, lnPropsAndComments_Count, @laProtected ;
|
|
, lnProtected_Count, @toFoxBin2Prg, @lcCodigo )
|
|
|
|
Goto Record (lnRecno)
|
|
.write_ENDDEFINE_IfApplicable( lnLastClass, @lcCodigo )
|
|
laClasses(lnClassCount,2) = lcCodigo
|
|
Endscan
|
|
|
|
If toFoxBin2Prg.n_UseClassPerFile > 0 Then
|
|
lcExternalHeader = lcExternalHeader + CR_LF
|
|
Endif
|
|
|
|
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()
|
|
|
|
.updateProgressbar( 'Writing ' + toFoxBin2Prg.c_VC2 + '...', lnStep, lnClassTotal*lnStepCount, 1 )
|
|
lcCodigo = toFoxBin2Prg.get_PROGRAM_HEADER() + lcExternalHeader + C_FB2PRG_CODE
|
|
|
|
*-- Genero el VC2
|
|
lnStep = lnStep + 1
|
|
lcOutputFile = .c_OutputFile
|
|
|
|
.updateProgressbar( 'Writing ' + toFoxBin2Prg.c_VC2 + '...', lnStep, lnClassTotal*lnStepCount, 1 )
|
|
lcCodigo = toFoxBin2Prg.get_PROGRAM_HEADER() + lcExternalHeader + C_FB2PRG_CODE
|
|
|
|
If .l_Test
|
|
*FOR I = 1 TO lnClassCount
|
|
* lcCodigo = lcCodigo + laClasses(m.I,2)
|
|
*ENDFOR
|
|
*toModulo = lcCodigo
|
|
Else
|
|
Do Case
|
|
Case (toFoxBin2Prg.n_UseClassPerFile = 0 And Not Empty(toFoxBin2Prg.c_ClassToConvert)) && LibName.ClassName.SC2
|
|
For I = 1 To lnClassCount
|
|
lcOutputFile = Addbs( Justpath( .c_OutputFile ) ) + Juststem( .c_OutputFile ) + '.' + laClasses(m.I,1) + '.' + Justext( .c_OutputFile )
|
|
lcCodigo = toFoxBin2Prg.get_PROGRAM_HEADER() + laClasses(m.I,2)
|
|
.write_OutputFile( @lcCodigo, lcOutputFile, @toFoxBin2Prg )
|
|
Endfor
|
|
|
|
Case toFoxBin2Prg.n_UseClassPerFile = 1 && LibName.ClassName.SC2
|
|
If Empty(toFoxBin2Prg.c_ClassToConvert) Then
|
|
.write_OutputFile( @lcCodigo, lcOutputFile, @toFoxBin2Prg )
|
|
Endif
|
|
|
|
For I = 1 To lnClassCount
|
|
lcOutputFile = Addbs( Justpath( .c_OutputFile ) ) + Juststem( .c_OutputFile ) + '.' + laClasses(m.I,1) + '.' + Justext( .c_OutputFile )
|
|
lcCodigo = toFoxBin2Prg.get_PROGRAM_HEADER() + laClasses(m.I,2)
|
|
.write_OutputFile( @lcCodigo, lcOutputFile, @toFoxBin2Prg )
|
|
Endfor
|
|
|
|
Case toFoxBin2Prg.n_UseClassPerFile = 2 && LibName.BaseClass.ClassName.SC2
|
|
If Empty(toFoxBin2Prg.c_ClassToConvert) Then
|
|
.write_OutputFile( @lcCodigo, lcOutputFile, @toFoxBin2Prg )
|
|
Endif
|
|
|
|
For I = 1 To lnClassCount
|
|
lcOutputFile = Addbs( Justpath( .c_OutputFile ) ) + Juststem( .c_OutputFile ) + '.' + laClasses(m.I,3) + '.' + laClasses(m.I,1) + '.' + Justext( .c_OutputFile )
|
|
lcCodigo = toFoxBin2Prg.get_PROGRAM_HEADER() + laClasses(m.I,2)
|
|
.write_OutputFile( @lcCodigo, lcOutputFile, @toFoxBin2Prg )
|
|
Endfor
|
|
|
|
Otherwise
|
|
For I = 1 To lnClassCount
|
|
lcCodigo = lcCodigo + laClasses(m.I,2)
|
|
Endfor
|
|
|
|
.write_OutputFile( @lcCodigo, lcOutputFile, @toFoxBin2Prg )
|
|
Endcase
|
|
Endif
|
|
Endwith && THIS
|
|
|
|
|
|
Catch To toEx
|
|
This.set_UserValue(@toEx)
|
|
|
|
If This.n_Debug > 0 And _vfp.StartMode = 0
|
|
Set Step On
|
|
Endif
|
|
|
|
Throw
|
|
|
|
Finally
|
|
Use In (Select("TABLABIN"))
|
|
Use In (Select("_TABLAORIG"))
|
|
Store Null To loRegClass, loRegObj
|
|
Release toModulo, toEx, toFoxBin2Prg ;
|
|
, lnCodError, loRegClass, loRegObj, lnMethodCount, laMethods, laCode, laProtected, lnLen, lnObjCount ;
|
|
, laPropsAndValues, laPropsAndComments, lnLastClass, lnRecno, lcMethods, lcObjName, la_NombresObjsOle ;
|
|
, laObjs, I, lnPropsAndValues_Count, lnPropsAndComments_Count, lnProtected_Count ;
|
|
, lcCodigo, laClasses, lnClassCount, lcOutputFile
|
|
|
|
Endtry
|
|
|
|
Return
|
|
Endproc
|
|
Enddefine
|
|
|
|
|
|
|
|
Define Class c_conversor_scx_a_prg As c_conversor_bin_a_prg
|
|
#If .F.
|
|
Local This As c_conversor_scx_a_prg Of 'FOXBIN2PRG.PRG'
|
|
#Endif
|
|
c_Type = 'SCX'
|
|
|
|
|
|
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 (v! IN ) Referencia al objeto principal
|
|
*---------------------------------------------------------------------------------------------------
|
|
Lparameters toModulo, toEx As Exception, toFoxBin2Prg
|
|
DoDefault( @toModulo, @toEx, @toFoxBin2Prg )
|
|
|
|
#If .F.
|
|
Local toModulo As CL_CLASSLIB Of 'FOXBIN2PRG.PRG'
|
|
Local toFoxBin2Prg As c_foxbin2prg Of 'FOXBIN2PRG.PRG'
|
|
#Endif
|
|
|
|
Try
|
|
Local lnCodError, loRegClass, loRegObj, lnMethodCount, laMethods(1), laCode(1), laProtected(1), lnLen, lnObjCount ;
|
|
, laPropsAndValues(1), laPropsAndComments(1), lnLastClass, lnRecno, lcMethods, lcObjName, la_NombresObjsOle(1) ;
|
|
, laObjs(1,4), I, lnPropsAndValues_Count, lnPropsAndComments_Count, lnProtected_Count, lcCodigo, laClasses(1,3) ;
|
|
, lnClassCount, lcOutputFile, lcExternalHeader, lnClassTotal, lnStepCount, lnStep, lcObjPathInsideClass, lnPos ;
|
|
, loLang As CL_LANG Of 'FOXBIN2PRG.PRG'
|
|
Store 0 To lnCodError, lnLastClass, lnObjCount, lnPropsAndValues_Count, lnPropsAndComments_Count, lnProtected_Count ;
|
|
, lnMethodCount, lnClassCount, lnStepCount, lnStep
|
|
Store '' To laMethods, laCode, laProtected, laPropsAndComments, laObjs, lcCodigo, laClasses, lcOutputFile ;
|
|
, C_FB2PRG_CODE, lcExternalHeader
|
|
Store Null To loRegClass, loRegObj
|
|
loLang = _Screen.o_FoxBin2Prg_Lang
|
|
|
|
With This As c_conversor_scx_a_prg Of 'FOXBIN2PRG.PRG'
|
|
Use (.c_InputFile) Shared Again Noupdate Alias _TABLAORIG
|
|
Select _TABLAORIG.*,Recno() regnum From _TABLAORIG Into Cursor TABLABIN Readwrite
|
|
Use In (Select("_TABLAORIG"))
|
|
|
|
* Issue#15: Ignorar objetos mal definidos
|
|
.ignoreIncorrectDefinedObjects('TABLABIN')
|
|
|
|
Index On Padr(Lower(PLATFORM + Iif(Empty(Parent),'',Alltrim(Parent)+'.')+OBJNAME),240) Tag PARENT_OBJ Additive
|
|
Set Order To 0 In TABLABIN
|
|
|
|
.get_OLEPublicObjectName( @la_NombresObjsOle )
|
|
|
|
.write_OLEObjectDefinitions( @toFoxBin2Prg )
|
|
|
|
*-- Escribo los métodos ordenados
|
|
lnLastObj = 0
|
|
lnLastClass = 0
|
|
|
|
*----------------------------------------------
|
|
*-- RECORRO LAS CLASES
|
|
*----------------------------------------------
|
|
Select TABLABIN
|
|
Set Order To PARENT_OBJ
|
|
Goto Record 1 && Class Library Header/Form Header
|
|
|
|
loRegClass = Null
|
|
Scatter Fields RESERVED8,RESERVED7 Memo Name loRegClass
|
|
|
|
If Not Empty(loRegClass.RESERVED7) Then
|
|
TEXT TO C_FB2PRG_CODE ADDITIVE TEXTMERGE NOSHOW FLAGS 1+2 PRETEXT 1+2
|
|
<<C_LIBCOMMENT_I>> <<loRegClass.Reserved7>> <<C_LIBCOMMENT_F>>
|
|
*
|
|
ENDTEXT
|
|
Endif
|
|
|
|
|
|
If Not Empty(loRegClass.RESERVED8) Then
|
|
TEXT TO C_FB2PRG_CODE ADDITIVE TEXTMERGE NOSHOW FLAGS 1+2 PRETEXT 1+2
|
|
#INCLUDE "<<loRegClass.Reserved8>>"
|
|
<<>>
|
|
ENDTEXT
|
|
Endif
|
|
|
|
|
|
Count All For TABLABIN.PLATFORM = "WINDOWS" ;
|
|
AND ( Empty( TABLABIN.Parent ) ;
|
|
AND Inlist( Lower( TABLABIN.BaseClass ), 'dataenvironment', 'form', 'formset' ) ) To lnClassTotal
|
|
|
|
Scan All For TABLABIN.PLATFORM = "WINDOWS" ;
|
|
AND ( Empty( TABLABIN.Parent ) ;
|
|
AND Inlist( Lower( TABLABIN.BaseClass ), 'dataenvironment', 'form', 'formset' ) )
|
|
|
|
Store 0 To lnMethodCount
|
|
Store '' To laMethods, laCode, lcCodigo
|
|
lnClassCount = lnClassCount + 1
|
|
Dimension laClasses(lnClassCount,3)
|
|
|
|
loRegClass = Null
|
|
Scatter Memo Name loRegClass
|
|
|
|
*-- Normalización de capitalización y de datos según parametrización
|
|
loRegClass.BaseClass = Lower( loRegClass.BaseClass )
|
|
loRegClass.CLASSLOC = Lower( loRegClass.CLASSLOC )
|
|
loRegClass.Class = Lower( loRegClass.Class )
|
|
loRegClass.OBJNAME = Lower( loRegClass.OBJNAME )
|
|
|
|
If toFoxBin2Prg.l_NoTimestamps
|
|
loRegClass.Timestamp = 0
|
|
Endif
|
|
If toFoxBin2Prg.l_ClearUniqueID
|
|
loRegClass.UNIQUEID = ''
|
|
Else
|
|
loRegClass.UNIQUEID = Alltrim(loRegClass.UNIQUEID)
|
|
Endif
|
|
|
|
lcObjName = Alltrim(loRegClass.OBJNAME)
|
|
laClasses(lnClassCount,1) = Lower( lcObjName )
|
|
laClasses(lnClassCount,2) = ''
|
|
laClasses(lnClassCount,3) = loRegClass.BaseClass
|
|
|
|
If Not toFoxBin2Prg.l_ProcessFiles Then
|
|
Loop && Si se indicó no procesar, salteo el resto del proceso. (Modo de simulación)
|
|
Endif
|
|
|
|
lnStep = lnStep + 1
|
|
.updateProgressbar( 'Processing Class ' + lcObjName + '...', lnStep, lnClassTotal*lnStepCount, 1 )
|
|
|
|
.write_DEFINE_CLASS( @la_NombresObjsOle, @loRegClass, @lcCodigo )
|
|
|
|
.write_DEFINE_CLASS_COMMENTS( @loRegClass, @lcCodigo )
|
|
|
|
.write_CLASSMETADATA( @loRegClass, @lcCodigo )
|
|
|
|
If toFoxBin2Prg.n_UseClassPerFile > 0 Then
|
|
.write_EXTERNAL_CLASS_HEADER( @loRegClass, @toFoxBin2Prg, @lcExternalHeader )
|
|
Endif
|
|
|
|
*-------------------------------------------------------------------------------
|
|
*-- RECORRO LOS OBJETOS DENTRO DE LA CLASE ACTUAL PARA EXPORTAR SU DEFINICIÓN
|
|
*-------------------------------------------------------------------------------
|
|
lnObjCount = 0
|
|
lnRecno = Recno()
|
|
Locate For Upper( TABLABIN.PLATFORM ) = "WINDOWS" And Lower( Alltrim( Getwordnum( TABLABIN.Parent, 1, '.' ) ) ) == Lower(lcObjName)
|
|
|
|
Scan Rest While Upper( TABLABIN.PLATFORM ) = "WINDOWS" And Lower( Alltrim( Getwordnum( TABLABIN.Parent, 1, '.' ) ) ) == Lower(lcObjName)
|
|
lnObjCount = lnObjCount + 1
|
|
loRegObj = Null
|
|
Scatter Memo Name loRegObj
|
|
|
|
*-- Normalización de capitalización y de datos según parametrización
|
|
loRegObj.BaseClass = Lower( loRegObj.BaseClass )
|
|
loRegObj.CLASSLOC = Lower( loRegObj.CLASSLOC )
|
|
loRegObj.Class = Lower( loRegObj.Class )
|
|
lcObjPathInsideClass = Lower( loRegObj.Parent ) + '.' + Lower( loRegObj.OBJNAME )
|
|
|
|
If lnObjCount > 1 Then
|
|
lnPos = Ascan( laObjs, lcObjPathInsideClass, 1, 0, 4, 1+2+4+8 )
|
|
|
|
If lnPos > 0 Then
|
|
*-- ERROR: Objeto Duplicado
|
|
.writeErrorLog( '* ' + loLang.C_DUPLICATED_OBJECT_LOC + ' "' + loRegObj.Class + '.' + lcObjPathInsideClass ;
|
|
+ '" @Recno ' + Transform(loRegObj.regnum) + ', (1st.Recno:' + Transform(laObjs(lnPos,2)) + ')' )
|
|
Endif
|
|
Endif
|
|
|
|
Dimension laObjs(lnObjCount,4)
|
|
laObjs(lnObjCount,1) = loRegObj
|
|
laObjs(lnObjCount,2) = loRegObj.regnum && ZOrder
|
|
laObjs(lnObjCount,3) = lnObjCount && Alphabetic order
|
|
laObjs(lnObjCount,4) = lcObjPathInsideClass && To check duplicates
|
|
|
|
If toFoxBin2Prg.l_NoTimestamps
|
|
loRegObj.Timestamp = 0
|
|
Endif
|
|
If toFoxBin2Prg.l_ClearUniqueID
|
|
loRegObj.UNIQUEID = ''
|
|
Else
|
|
loRegObj.UNIQUEID = Alltrim(loRegObj.UNIQUEID)
|
|
Endif
|
|
|
|
loRegObj = Null
|
|
Endscan
|
|
|
|
Goto Record (lnRecno)
|
|
Asort(laObjs, 2, -1, 0, 0) && Orden por ZOrder
|
|
|
|
If lnObjCount > 0
|
|
lcCodigo = lcCodigo + CR_LF + ' *-- OBJECTDATA items order determines ZOrder / El orden de los items OBJECTDATA determina el ZOrder '
|
|
|
|
For I = 1 To lnObjCount
|
|
.write_OBJECTMETADATA( laObjs(m.I,1), @lcCodigo )
|
|
Endfor
|
|
|
|
lcCodigo = lcCodigo + CR_LF
|
|
Endif
|
|
|
|
.write_INCLUDE( @loRegClass, @lcCodigo )
|
|
|
|
lnStep = lnStep + 1
|
|
.updateProgressbar( 'Processing Class ' + lcObjName + ' > Writing Properties...', lnStep, lnClassTotal*lnStepCount, 1 )
|
|
|
|
.write_CLASS_PROPERTIES( @loRegClass, @laPropsAndValues, @laPropsAndComments, @laProtected ;
|
|
, @lnPropsAndValues_Count, @lnPropsAndComments_Count, @lnProtected_Count, @lcCodigo, @toFoxBin2Prg )
|
|
|
|
Asort(laObjs, 3, -1, 0, 0) && Orden Alfabético de objetos (del SCAN original)
|
|
|
|
lnStep = lnStep + 1
|
|
.updateProgressbar( 'Processing Class ' + lcObjName + ' > Writing Obtects with Properties...', lnStep, lnClassTotal*lnStepCount, 1 )
|
|
|
|
For I = 1 To lnObjCount
|
|
.write_ADD_OBJECTS_WithProperties( laObjs(m.I,1), @lcCodigo, @toFoxBin2Prg )
|
|
Endfor
|
|
|
|
|
|
*-- OBTENGO LOS MÉTODOS DE LA CLASE PARA POSTERIOR TRATAMIENTO
|
|
lnStep = lnStep + 1
|
|
.updateProgressbar( 'Processing Class ' + lcObjName + ' > Getting Methods...', lnStep, lnClassTotal*lnStepCount, 1 )
|
|
|
|
Dimension laMethods(1,3), laCode(1)
|
|
Store '' To laMethods, laCode
|
|
lnMethodCount = 0
|
|
|
|
.method2Array( loRegClass.METHODS, @laMethods, @laCode, '', @lnMethodCount ;
|
|
, @laPropsAndComments, lnPropsAndComments_Count, @laProtected, lnProtected_Count, @toFoxBin2Prg, @loRegClass )
|
|
|
|
.get_CLASS_METHODS( @lnMethodCount, @laMethods, @laCode, @laProtected, @laPropsAndComments, @toFoxBin2Prg )
|
|
|
|
lnLastClass = 1
|
|
lcMethods = ''
|
|
|
|
*-- RECORRO LOS OBJETOS DENTRO DE LA CLASE ACTUAL PARA OBTENER SUS MÉTODOS
|
|
lnStep = lnStep + 1
|
|
.updateProgressbar( 'Processing Class ' + lcObjName + ' > Getting Objects Methods...', lnStep, lnClassTotal*lnStepCount, 1 )
|
|
|
|
lnRecno = Recno()
|
|
Locate For TABLABIN.PLATFORM = "WINDOWS" And Lower( Alltrim( Getwordnum( TABLABIN.Parent, 1, '.' ) ) ) == Lower(lcObjName)
|
|
|
|
Scan Rest ;
|
|
FOR Upper( TABLABIN.PLATFORM ) = "WINDOWS" ;
|
|
AND Not (Empty(TABLABIN.Parent) ;
|
|
AND ( Inlist( Lower( TABLABIN.BaseClass ), 'dataenvironment' , 'form', 'formset' ) ) ) ;
|
|
WHILE Lower( Alltrim( Getwordnum( TABLABIN.Parent, 1, '.' ) ) ) == Lower(lcObjName)
|
|
|
|
loRegObj = Null
|
|
Scatter Memo Name loRegObj
|
|
|
|
*-- Normalización de capitalización y de datos según parametrización
|
|
loRegObj.BaseClass = Lower( loRegObj.BaseClass )
|
|
loRegObj.CLASSLOC = Lower( loRegObj.CLASSLOC )
|
|
loRegObj.Class = Lower( loRegObj.Class )
|
|
|
|
If toFoxBin2Prg.l_NoTimestamps
|
|
loRegObj.Timestamp = 0
|
|
Endif
|
|
If toFoxBin2Prg.l_ClearUniqueID
|
|
loRegObj.UNIQUEID = ''
|
|
Else
|
|
loRegObj.UNIQUEID = Alltrim(loRegObj.UNIQUEID)
|
|
Endif
|
|
|
|
.get_ADD_OBJECT_METHODS( @loRegObj, @loRegClass, @lcMethods, @laMethods, @laCode, @lnMethodCount ;
|
|
, @laPropsAndComments, lnPropsAndComments_Count, @laProtected, lnProtected_Count, @toFoxBin2Prg )
|
|
Endscan
|
|
|
|
lnStep = lnStep + 1
|
|
.updateProgressbar( 'Processing Class ' + lcObjName + ' > Writing Objects Methods...', lnStep, lnClassTotal*lnStepCount, 1 )
|
|
|
|
.write_ALL_OBJECT_METHODS( @lcMethods, @laMethods, @laCode, @lnMethodCount, @laPropsAndComments, lnPropsAndComments_Count, @laProtected ;
|
|
, lnProtected_Count, @toFoxBin2Prg, @lcCodigo )
|
|
|
|
Goto Record (lnRecno)
|
|
.write_ENDDEFINE_IfApplicable( lnLastClass, @lcCodigo )
|
|
laClasses(lnClassCount,2) = lcCodigo
|
|
Endscan
|
|
|
|
If toFoxBin2Prg.n_UseClassPerFile > 0 Then
|
|
lcExternalHeader = lcExternalHeader + CR_LF
|
|
Endif
|
|
|
|
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()
|
|
|
|
|
|
*-- Genero el SC2
|
|
lnStep = lnStep + 1
|
|
lcOutputFile = .c_OutputFile
|
|
|
|
.updateProgressbar( 'Writing ' + toFoxBin2Prg.c_SC2 + '...', lnStep, lnClassTotal*lnStepCount, 1 )
|
|
lcCodigo = toFoxBin2Prg.get_PROGRAM_HEADER() + lcExternalHeader + C_FB2PRG_CODE
|
|
|
|
If .l_Test
|
|
*FOR I = 1 TO lnClassCount
|
|
* lcCodigo = lcCodigo + laClasses(m.I,2)
|
|
*ENDFOR
|
|
*toModulo = lcCodigo
|
|
Else
|
|
Do Case
|
|
Case toFoxBin2Prg.n_UseClassPerFile = 1 && LibName.ClassName.SC2
|
|
.write_OutputFile( @lcCodigo, lcOutputFile, @toFoxBin2Prg )
|
|
|
|
For I = 1 To lnClassCount
|
|
lcOutputFile = Addbs( Justpath( .c_OutputFile ) ) + Juststem( .c_OutputFile ) + '.' + laClasses(m.I,1) + '.' + Justext( .c_OutputFile )
|
|
lcCodigo = toFoxBin2Prg.get_PROGRAM_HEADER() + laClasses(m.I,2)
|
|
.write_OutputFile( @lcCodigo, lcOutputFile, @toFoxBin2Prg )
|
|
Endfor
|
|
|
|
Case toFoxBin2Prg.n_UseClassPerFile = 2 && LibName.BaseClass.ClassName.SC2
|
|
.write_OutputFile( @lcCodigo, lcOutputFile, @toFoxBin2Prg )
|
|
|
|
For I = 1 To lnClassCount
|
|
lcOutputFile = Addbs( Justpath( .c_OutputFile ) ) + Juststem( .c_OutputFile ) + '.' + laClasses(m.I,3) + '.' + laClasses(m.I,1) + '.' + Justext( .c_OutputFile )
|
|
lcCodigo = toFoxBin2Prg.get_PROGRAM_HEADER() + laClasses(m.I,2)
|
|
.write_OutputFile( @lcCodigo, lcOutputFile, @toFoxBin2Prg )
|
|
Endfor
|
|
|
|
Otherwise
|
|
For I = 1 To lnClassCount
|
|
lcCodigo = lcCodigo + laClasses(m.I,2)
|
|
Endfor
|
|
|
|
.write_OutputFile( @lcCodigo, lcOutputFile, @toFoxBin2Prg )
|
|
Endcase
|
|
Endif
|
|
Endwith && THIS
|
|
|
|
|
|
Catch To toEx
|
|
This.set_UserValue(@toEx)
|
|
|
|
If This.n_Debug > 0 And _vfp.StartMode = 0
|
|
Set Step On
|
|
Endif
|
|
|
|
Throw
|
|
|
|
Finally
|
|
Use In (Select("TABLABIN"))
|
|
Use In (Select("_TABLAORIG"))
|
|
Store Null To loRegClass, loRegObj
|
|
Release toModulo, toEx, toFoxBin2Prg ;
|
|
, lnCodError, loRegClass, loRegObj, lnMethodCount, laMethods, laCode, laProtected, lnLen, lnObjCount ;
|
|
, laPropsAndValues, laPropsAndComments, lnLastClass, lnRecno, lcMethods, lcObjName, la_NombresObjsOle ;
|
|
, laObjs, I, lnPropsAndValues_Count, lnPropsAndComments_Count, lnProtected_Count ;
|
|
, lcCodigo, laClasses, lnClassCount, lcOutputFile
|
|
|
|
Endtry
|
|
|
|
Return
|
|
Endproc
|
|
Enddefine
|
|
|
|
|
|
|
|
Define Class c_conversor_pjx_a_prg As c_conversor_bin_a_prg
|
|
_MemberData = [<VFPData>] ;
|
|
+ [<memberdata name="loadfile" display="loadFile"/>] ;
|
|
+ [</VFPData>]
|
|
|
|
#If .F.
|
|
Local This As c_conversor_pjx_a_prg Of 'FOXBIN2PRG.PRG'
|
|
#Endif
|
|
c_Type = 'PJX'
|
|
|
|
|
|
Procedure convert
|
|
*---------------------------------------------------------------------------------------------------
|
|
* PARÁMETROS: (v=Pasar por valor | @=Pasar por referencia) (!=Obligatorio | ?=Opcional) (IN/OUT)
|
|
* toModulo (@! OUT) Objeto generado de clase CL_PROJECT 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'
|
|
Local toModulo As CL_PROJECT Of 'FOXBIN2PRG.PRG'
|
|
#Endif
|
|
DoDefault( @toModulo, @toEx, @toFoxBin2Prg )
|
|
|
|
Try
|
|
Local lnCodError, lcStr, lnPos, lnLen, lnServerCount, loReg, lnLen ;
|
|
, loEx As Exception ;
|
|
, loProject As CL_PROJECT Of 'FOXBIN2PRG.PRG' ;
|
|
, loServerHead As CL_PROJ_SRV_HEAD Of 'FOXBIN2PRG.PRG' ;
|
|
, loLang As CL_LANG Of 'FOXBIN2PRG.PRG'
|
|
|
|
loLang = _Screen.o_FoxBin2Prg_Lang
|
|
Store Null To loProject, loReg, loServerHead
|
|
|
|
With This As c_conversor_pjx_a_prg Of 'FOXBIN2PRG.PRG'
|
|
If toFoxBin2Prg.l_ProcessFiles Then
|
|
If Vartype(toModulo) = "O" And toModulo.Class == 'Cl_project' Then
|
|
*-- Ya esta cargado el objeto del Proyecto y se pasó por referencia
|
|
Else
|
|
.loadModule( @toModulo, @toEx, @toFoxBin2Prg )
|
|
Endif
|
|
|
|
.updateProgressbar( 'Processing Project info...', 2, 3, 1 )
|
|
loProject = toModulo
|
|
loServerHead = loProject._ServerHead
|
|
|
|
C_FB2PRG_CODE = C_FB2PRG_CODE + toFoxBin2Prg.get_PROGRAM_HEADER()
|
|
|
|
|
|
*-- Directorio de inicio
|
|
TEXT TO C_FB2PRG_CODE ADDITIVE TEXTMERGE NOSHOW FLAGS 1+2 PRETEXT 1+2
|
|
LPARAMETERS tcDir
|
|
<<>>
|
|
lcCurdir = SYS(5)+CURDIR()
|
|
CD ( EVL( tcDir, JUSTPATH( SYS(16) ) ) )
|
|
<<>>
|
|
ENDTEXT
|
|
|
|
|
|
*-- Información del programa
|
|
C_FB2PRG_CODE = C_FB2PRG_CODE + loProject.getFormattedDeviceInfoText() + CR_LF
|
|
|
|
|
|
*-- Información de los Servidores definidos
|
|
If Not Empty(loProject._ServerInfo)
|
|
C_FB2PRG_CODE = C_FB2PRG_CODE + loServerHead.getFormattedServerText() + CR_LF
|
|
Endif
|
|
|
|
|
|
*-- Generación del proyecto
|
|
TEXT TO C_FB2PRG_CODE ADDITIVE TEXTMERGE NOSHOW FLAGS 1+2 PRETEXT 1+2
|
|
<<C_BUILDPROJ_I>>
|
|
<<>>*<.HomeDir = <<loProject._HomeDir>> />
|
|
<<>>
|
|
FOR EACH loProject IN _VFP.Projects FOXOBJECT
|
|
<<>> loProject.Close()
|
|
ENDFOR
|
|
<<>>
|
|
STRTOFILE( '', '__newproject.f2b' )
|
|
BUILD PROJECT <<JUSTFNAME( EVL( .c_OriginalFileName, .c_InputFile ) )>> FROM '__newproject.f2b'
|
|
ENDTEXT
|
|
|
|
|
|
*-- Abro el proyecto
|
|
TEXT TO C_FB2PRG_CODE ADDITIVE TEXTMERGE NOSHOW FLAGS 1+2 PRETEXT 1+2
|
|
FOR EACH loProject IN _VFP.Projects FOXOBJECT
|
|
<<>> loProject.Close()
|
|
ENDFOR
|
|
<<>>
|
|
MODIFY PROJECT '<<JUSTFNAME( EVL( .c_OriginalFileName, .c_InputFile ) )>>' NOWAIT NOSHOW NOPROJECTHOOK
|
|
<<>>
|
|
loProject = _VFP.Projects('<<JUSTFNAME( EVL( .c_OriginalFileName, .c_InputFile ) )>>')
|
|
<<>>
|
|
WITH loProject.FILES
|
|
ENDTEXT
|
|
|
|
|
|
*-- Definir archivos del proyecto y metadata: CPID, Timestamp, ID, etc.
|
|
loProject.KeySort = 2
|
|
|
|
For Each loReg In loProject &&FOXOBJECT
|
|
TEXT TO C_FB2PRG_CODE ADDITIVE TEXTMERGE NOSHOW FLAGS 1+2 PRETEXT 1+2
|
|
<<>> .ADD('<<loReg.NAME>>')
|
|
ENDTEXT
|
|
|
|
If toFoxBin2Prg.n_BodyDevInfo=1
|
|
* Generates an extra DevInfo tag for each body PJX record
|
|
TEXT TO C_FB2PRG_CODE ADDITIVE TEXTMERGE NOSHOW FLAGS 1 PRETEXT 1+2+4+8
|
|
<<>> <<'&'>><<'&'>> <<C_FILE_META_I>>
|
|
Type="<<loReg.TYPE>>"
|
|
Cpid="<<INT( loReg.CPID )>>"
|
|
Timestamp="<<INT( loReg.TIMESTAMP )>>"
|
|
ID="<<INT( loReg.ID )>>"
|
|
ObjRev="<<INT( loReg.OBJREV )>>"
|
|
User="<<STRCONV(loReg.USER,13)>>"
|
|
DevInfo="<<STRCONV(loReg.DEVINFO,13)>>"
|
|
<<C_FILE_META_F>>
|
|
ENDTEXT
|
|
Else
|
|
TEXT TO C_FB2PRG_CODE ADDITIVE TEXTMERGE NOSHOW FLAGS 1 PRETEXT 1+2+4+8
|
|
<<>> <<'&'>><<'&'>> <<C_FILE_META_I>>
|
|
Type="<<loReg.TYPE>>"
|
|
Cpid="<<INT( loReg.CPID )>>"
|
|
Timestamp="<<INT( loReg.TIMESTAMP )>>"
|
|
ID="<<INT( loReg.ID )>>"
|
|
ObjRev="<<INT( loReg.OBJREV )>>"
|
|
User="<<STRCONV(loReg.USER,13)>>"
|
|
<<C_FILE_META_F>>
|
|
ENDTEXT
|
|
Endif
|
|
|
|
loReg = Null
|
|
Endfor
|
|
|
|
TEXT TO C_FB2PRG_CODE ADDITIVE TEXTMERGE NOSHOW FLAGS 1+2 PRETEXT 1+2
|
|
<<>> <<C_BUILDPROJ_F>>
|
|
<<>>
|
|
<<>> .ITEM('__newproject.f2b').Remove()
|
|
<<>>
|
|
ENDTEXT
|
|
|
|
|
|
TEXT TO C_FB2PRG_CODE ADDITIVE TEXTMERGE NOSHOW FLAGS 1+2 PRETEXT 1+2
|
|
<<>> <<C_FILE_CMTS_I>>
|
|
ENDTEXT
|
|
|
|
|
|
*-- Agrego los comentarios
|
|
loProject.KeySort = 2
|
|
|
|
For Each loReg In loProject &&FOXOBJECT
|
|
If Not Empty(loReg.COMMENTS)
|
|
C_FB2PRG_CODE = C_FB2PRG_CODE + Chr(13) + Chr(10) + Chr(9) + ".ITEM(lcCurdir + '" + loReg.Name + "').Description = '" + loReg.COMMENTS + "'"
|
|
Endif
|
|
loReg = Null
|
|
Endfor
|
|
|
|
|
|
*-- Exclusiones
|
|
TEXT TO C_FB2PRG_CODE ADDITIVE TEXTMERGE NOSHOW FLAGS 1+2 PRETEXT 1+2
|
|
<<>> <<C_FILE_CMTS_F>>
|
|
<<>>
|
|
<<>> <<C_FILE_EXCL_I>>
|
|
ENDTEXT
|
|
|
|
loProject.KeySort = 2
|
|
|
|
For Each loReg In loProject &&FOXOBJECT
|
|
If loReg.EXCLUDE
|
|
C_FB2PRG_CODE = C_FB2PRG_CODE + Chr(13) + Chr(10) + Chr(9) + ".ITEM(lcCurdir + '" + loReg.Name + "').Exclude = .T."
|
|
Endif
|
|
loReg = Null
|
|
Endfor
|
|
|
|
|
|
*-- Tipos de archivos especiales
|
|
TEXT TO C_FB2PRG_CODE ADDITIVE TEXTMERGE NOSHOW FLAGS 1+2 PRETEXT 1+2
|
|
<<>> <<C_FILE_EXCL_F>>
|
|
<<>>
|
|
<<>> <<C_FILE_TXT_I>>
|
|
ENDTEXT
|
|
|
|
loProject.KeySort = 2
|
|
|
|
For Each loReg In loProject &&FOXOBJECT
|
|
If Inlist( Upper( Justext( loReg.Name ) ), 'H','FPW' )
|
|
C_FB2PRG_CODE = C_FB2PRG_CODE + Chr(13) + Chr(10) + Chr(9) + ".ITEM(lcCurdir + '" + loReg.Name + "').Type = 'T'"
|
|
Endif
|
|
loReg = Null
|
|
Endfor
|
|
|
|
|
|
*-- ProjectHook, Debug, Encrypt, Build y cierre
|
|
TEXT TO C_FB2PRG_CODE ADDITIVE TEXTMERGE NOSHOW FLAGS 1+2 PRETEXT 1+2
|
|
<<>> <<C_FILE_TXT_F>>
|
|
<<C_ENDWITH>>
|
|
<<>>
|
|
<<C_WITH>> loProject
|
|
<<>> <<C_PROJPROPS_I>>
|
|
ENDTEXT
|
|
|
|
If Not Empty(loProject._MainProg)
|
|
TEXT TO C_FB2PRG_CODE ADDITIVE TEXTMERGE NOSHOW FLAGS 1+2 PRETEXT 1+2
|
|
<<>> .SetMain(lcCurdir + '<<loProject._MainProg>>')
|
|
ENDTEXT
|
|
Endif
|
|
|
|
If Not Empty(loProject._Icon)
|
|
TEXT TO C_FB2PRG_CODE ADDITIVE TEXTMERGE NOSHOW FLAGS 1+2 PRETEXT 1+2
|
|
<<>> .Icon = lcCurdir + '<<loProject._Icon>>'
|
|
ENDTEXT
|
|
Endif
|
|
|
|
TEXT TO C_FB2PRG_CODE ADDITIVE TEXTMERGE NOSHOW FLAGS 1+2 PRETEXT 1+2
|
|
<<>> .Debug = <<loProject._Debug>>
|
|
<<>> .Encrypted = <<loProject._Encrypted>>
|
|
<<>> *<.CmntStyle = <<loProject._CmntStyle>> />
|
|
<<>> *<.NoLogo = <<loProject._NoLogo>> />
|
|
<<>> *<.SaveCode = <<loProject._SaveCode>> />
|
|
<<>> *<.User = '<<STRCONV(loProject._User,13)>>' />
|
|
<<>> .ProjectHookLibrary = '<<loProject._ProjectHookLibrary>>'
|
|
<<>> .ProjectHookClass = '<<loProject._ProjectHookClass>>'
|
|
<<>> <<C_PROJPROPS_F>>
|
|
<<C_ENDWITH>>
|
|
<<>>
|
|
ENDTEXT
|
|
|
|
*-- Build y cierre
|
|
TEXT TO C_FB2PRG_CODE ADDITIVE TEXTMERGE NOSHOW FLAGS 1+2 PRETEXT 1+2
|
|
<<>>
|
|
_VFP.Projects('<<JUSTFNAME( EVL( .c_OriginalFileName, .c_InputFile ) )>>').Close()
|
|
ENDTEXT
|
|
|
|
*-- Restauro Directorio de inicio
|
|
TEXT TO C_FB2PRG_CODE ADDITIVE TEXTMERGE NOSHOW FLAGS 1+2 PRETEXT 1+2
|
|
*ERASE '__newproject.f2b'
|
|
CD (lcCurdir)
|
|
RETURN
|
|
ENDTEXT
|
|
|
|
Endif
|
|
|
|
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()
|
|
|
|
|
|
*-- Genero el PJ2
|
|
.updateProgressbar( 'Writing ' + toFoxBin2Prg.c_PJ2 + '...', 3, 3, 1 )
|
|
|
|
If .l_Test
|
|
toModulo = C_FB2PRG_CODE
|
|
Else
|
|
.write_OutputFile( (C_FB2PRG_CODE), .c_OutputFile, @toFoxBin2Prg )
|
|
Endif
|
|
Endwith && THIS
|
|
|
|
|
|
Catch To toEx
|
|
This.set_UserValue(@toEx)
|
|
|
|
lnCodError = toEx.ErrorNo
|
|
|
|
Do Case
|
|
Case lnCodError = 2062 && The specified key already exists ==> loProject.ADD( loReg, loReg.NAME )
|
|
toEx.UserValue = toEx.UserValue + loLang.C_DUPLICATED_FILE_LOC + ': ' + loReg.Name
|
|
Endcase
|
|
|
|
If This.n_Debug > 0 And _vfp.StartMode = 0
|
|
Set Step On
|
|
Endif
|
|
|
|
Throw
|
|
|
|
Finally
|
|
Use In (Select("TABLABIN"))
|
|
Store Null To loProject, loReg, loServerHead
|
|
Release toModulo, toEx, toFoxBin2Prg ;
|
|
, lnCodError, lcStr, lnPos, lnLen, lnServerCount, loReg, lnLen ;
|
|
, loProject, loServerHead
|
|
|
|
Endtry
|
|
|
|
Return
|
|
Endproc
|
|
|
|
|
|
Procedure loadModule
|
|
*---------------------------------------------------------------------------------------------------
|
|
* PARÁMETROS: (v=Pasar por valor | @=Pasar por referencia) (!=Obligatorio | ?=Opcional) (IN/OUT)
|
|
* toModulo (@! 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 toModulo, toEx As Exception, toFoxBin2Prg
|
|
#If .F.
|
|
Local toFoxBin2Prg As c_foxbin2prg Of 'FOXBIN2PRG.PRG'
|
|
Local toModulo As CL_PROJECT Of 'FOXBIN2PRG.PRG'
|
|
#Endif
|
|
DoDefault( @toModulo, @toEx, @toFoxBin2Prg )
|
|
|
|
Try
|
|
Local lnCodError, lcStr, lnPos, lnLen, lnServerCount, loReg, lnLen ;
|
|
, loEx As Exception ;
|
|
, loProject As CL_PROJECT Of 'FOXBIN2PRG.PRG' ;
|
|
, loServerHead As CL_PROJ_SRV_HEAD Of 'FOXBIN2PRG.PRG' ;
|
|
, loServerData As CL_PROJ_SRV_DATA Of 'FOXBIN2PRG.PRG' ;
|
|
, loLang As CL_LANG Of 'FOXBIN2PRG.PRG'
|
|
|
|
loLang = _Screen.o_FoxBin2Prg_Lang
|
|
Store Null To loProject, loReg, loServerHead, loServerData
|
|
|
|
With This As c_conversor_pjx_a_prg Of 'FOXBIN2PRG.PRG'
|
|
Use (.c_InputFile) Shared Again Noupdate Alias _TABLAORIG
|
|
Select * From _TABLAORIG Into Cursor TABLABIN
|
|
Use In (Select("_TABLAORIG"))
|
|
|
|
.updateProgressbar( 'Loading Project info...', 1, 3, 1 )
|
|
|
|
|
|
*-- Obtengo los archivos del proyecto
|
|
loProject = Createobject('CL_PROJECT')
|
|
toModulo = loProject
|
|
loServerHead = loProject._ServerHead
|
|
|
|
loProject.c_InputFile = .c_InputFile
|
|
Scatter Memo Name loReg
|
|
|
|
If toFoxBin2Prg.l_NoTimestamps
|
|
loReg.Timestamp = 0
|
|
Endif
|
|
If toFoxBin2Prg.l_ClearUniqueID
|
|
loReg.Id = 0
|
|
Endif
|
|
|
|
loProject._HomeDir = ['] + Alltrim( .get_ValueFromNullTerminatedValue( loReg.HomeDir ) ) + [']
|
|
loProject._ServerInfo = loReg.RESERVED2
|
|
loProject._Debug = loReg.Debug
|
|
loProject._Encrypted = loReg.Encrypt
|
|
loProject._User = loReg.User
|
|
loProject.parseDeviceInfo( loReg.DEVINFO )
|
|
|
|
*-- Información de los Servidores definidos
|
|
If Not Empty(loProject._ServerInfo)
|
|
loServerHead.parseServerInfo( loProject._ServerInfo )
|
|
loServerHead = Null
|
|
Endif
|
|
|
|
|
|
*--- Ubico el programa principal
|
|
Locate For MAINPROG
|
|
|
|
If Found()
|
|
loProject._MainProg = Lower( Alltrim( .get_ValueFromNullTerminatedValue( Name ) ) )
|
|
Endif
|
|
|
|
|
|
*-- Ubico el Project Hook
|
|
Locate For Type == 'W'
|
|
|
|
If Found()
|
|
loProject._ProjectHookLibrary = Lower( Alltrim( .get_ValueFromNullTerminatedValue( Name ) ) )
|
|
loProject._ProjectHookClass = Lower( Alltrim( .get_ValueFromNullTerminatedValue( RESERVED1 ) ) )
|
|
Endif
|
|
|
|
|
|
*-- Ubico el icono del proyecto
|
|
Locate For Type == 'i'
|
|
|
|
If Found()
|
|
loProject._Icon = Lower( Alltrim( .get_ValueFromNullTerminatedValue( Name ) ) )
|
|
Endif
|
|
|
|
|
|
*-- Escaneo el proyecto
|
|
Scan All For Not Inlist(Type, 'H','W','i' )
|
|
loReg = Null
|
|
Scatter Fields Name,Type,EXCLUDE,COMMENTS,CPID,Timestamp,Id,OBJREV,User,DEVINFO Memo Name loReg
|
|
|
|
If toFoxBin2Prg.l_NoTimestamps
|
|
loReg.Timestamp = 0
|
|
Endif
|
|
If toFoxBin2Prg.l_ClearUniqueID
|
|
loReg.Id = 0
|
|
Endif
|
|
|
|
loReg.Name = Lower( Alltrim( .get_ValueFromNullTerminatedValue( loReg.Name ) ) )
|
|
loReg.COMMENTS = Alltrim( .get_ValueFromNullTerminatedValue( loReg.COMMENTS ) )
|
|
|
|
*-- TIP: Si el "Name" del objeto está vacío, lo salteo
|
|
If Empty(loReg.Name)
|
|
Loop
|
|
Endif
|
|
|
|
Try
|
|
loProject.Add( loReg, loReg.Name )
|
|
Catch To loEx When loEx.ErrorNo = 2062 && The specified key already exists ==> loProject.ADD( loReg, loReg.NAME )
|
|
*-- Saltear y no agregar el archivo duplicado / Bypass and not add the duplicated file
|
|
Endtry
|
|
Endscan
|
|
Endwith && THIS
|
|
|
|
|
|
Catch To toEx
|
|
This.set_UserValue(@toEx)
|
|
|
|
lnCodError = toEx.ErrorNo
|
|
|
|
Do Case
|
|
Case lnCodError = 2062 && The specified key already exists ==> loProject.ADD( loReg, loReg.NAME )
|
|
*toEx.USERVALUE = 'Archivo duplicado: ' + loReg.NAME
|
|
toEx.UserValue = toEx.UserValue + loLang.C_DUPLICATED_FILE_LOC + ': ' + loReg.Name
|
|
Endcase
|
|
|
|
If This.n_Debug > 0 And _vfp.StartMode = 0
|
|
Set Step On
|
|
Endif
|
|
|
|
Throw
|
|
|
|
Finally
|
|
Use In (Select("TABLABIN"))
|
|
Use In (Select("_TABLAORIG"))
|
|
Store Null To loProject, loReg, loServerHead, loServerData
|
|
Release toModulo, toEx, toFoxBin2Prg ;
|
|
, lnCodError, lcStr, lnPos, lnLen, lnServerCount, loReg, lnLen ;
|
|
, loProject, loServerHead, loServerData
|
|
|
|
Endtry
|
|
|
|
Return
|
|
Endproc
|
|
Enddefine
|
|
|
|
|
|
Define Class c_conversor_pjm_a_prg As c_conversor_bin_a_prg
|
|
_MemberData = [<VFPData>] ;
|
|
+ [<memberdata name="strextract_cr" display="strExtract_CR"/>] ;
|
|
+ [</VFPData>]
|
|
|
|
#If .F.
|
|
Local This As c_conversor_pjm_a_prg Of 'FOXBIN2PRG.PRG'
|
|
#Endif
|
|
c_Type = 'PJM'
|
|
|
|
|
|
Procedure convert
|
|
*---------------------------------------------------------------------------------------------------
|
|
* PARÁMETROS: (v=Pasar por valor | @=Pasar por referencia) (!=Obligatorio | ?=Opcional) (IN/OUT)
|
|
* toModulo (!@ 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 toModulo, toEx As Exception, toFoxBin2Prg
|
|
#If .F.
|
|
Local toFoxBin2Prg As c_foxbin2prg Of 'FOXBIN2PRG.PRG'
|
|
#Endif
|
|
DoDefault( @toModulo, @toEx, @toFoxBin2Prg )
|
|
|
|
Try
|
|
If toFoxBin2Prg.l_ProcessFiles Then
|
|
Local lnCodError, lcStr, lnPos, lnLen, lnServerCount, loReg, lnLen ;
|
|
, lcStrPJM, laLines(1), laProps(1) ;
|
|
, loEx As Exception ;
|
|
, loProject As CL_PROJECT Of 'FOXBIN2PRG.PRG' ;
|
|
, loServerHead As CL_PROJ_SRV_HEAD Of 'FOXBIN2PRG.PRG' ;
|
|
, loServerData As CL_PROJ_SRV_DATA Of 'FOXBIN2PRG.PRG' ;
|
|
, loLang As CL_LANG Of 'FOXBIN2PRG.PRG'
|
|
|
|
loLang = _Screen.o_FoxBin2Prg_Lang
|
|
Store Null To loProject, loReg, loServerHead, loServerData
|
|
lcStrPJM = Filetostr( This.c_InputFile )
|
|
This.updateProgressbar( 'Scanning PJM...', 1, 2, 1 )
|
|
|
|
|
|
*-- Obtengo los archivos del proyecto
|
|
loProject = Createobject('CL_PROJECT')
|
|
loServerHead = loProject._ServerHead
|
|
|
|
With loProject As CL_PROJECT Of 'FOXBIN2PRG.PRG'
|
|
*-- Proj.Info
|
|
._CmntStyle = Strextract( lcStrPJM, 'CommentStyle=', CR_LF )
|
|
._Debug = Strextract( lcStrPJM, 'Debug=', CR_LF )
|
|
._Encrypted = Strextract( lcStrPJM, 'Encrypt=', CR_LF )
|
|
._HomeDir = ['] + Lower( Justpath( Sys(5)+Curdir() ) ) + [']
|
|
._ID = ''
|
|
._NoLogo = Strextract( lcStrPJM, 'NoLogo=', CR_LF )
|
|
._ObjRev = 0
|
|
._ProjectHookClass = ''
|
|
._ProjectHookLibrary = ''
|
|
._SaveCode = Strextract( lcStrPJM, 'SaveCode=', CR_LF )
|
|
._ServerHead = Null
|
|
._ServerInfo = 'ServerData'
|
|
._SourceFile = ''
|
|
._TimeStamp = 0
|
|
._Version = Strextract( lcStrPJM, 'Version=', CR_LF )
|
|
|
|
*-- Dev.info
|
|
._Author = Strextract( lcStrPJM, 'Author=', CR_LF )
|
|
._Company = Strextract( lcStrPJM, 'Company=', CR_LF )
|
|
._Address = Strextract( lcStrPJM, 'Address=', CR_LF )
|
|
._City = Strextract( lcStrPJM, 'City=', CR_LF )
|
|
._State = Strextract( lcStrPJM, 'State=', CR_LF )
|
|
._PostalCode = Strextract( lcStrPJM, 'Zip=', CR_LF )
|
|
._Country = Strextract( lcStrPJM, 'Country=', CR_LF )
|
|
|
|
._Comments = Strextract( lcStrPJM, 'Comments=', CR_LF )
|
|
._CompanyName = Strextract( lcStrPJM, 'CompanyName=', CR_LF )
|
|
._FileDescription = Strextract( lcStrPJM, 'FileDescription=', CR_LF )
|
|
._LegalCopyright = Strextract( lcStrPJM, 'LegalCopyright=', CR_LF )
|
|
._LegalTrademark = Strextract( lcStrPJM, 'LegalTrademarks=', CR_LF )
|
|
._ProductName = Strextract( lcStrPJM, 'ProductName=', CR_LF )
|
|
._MajorVer = Strextract( lcStrPJM, 'Major=', CR_LF )
|
|
._MinorVer = Strextract( lcStrPJM, 'Minor=', CR_LF )
|
|
._Revision = Strextract( lcStrPJM, 'Revision=', CR_LF )
|
|
._AutoIncrement = Iif( Strextract( lcStrPJM, 'AutoIncrement=', CR_LF ) = '.T.', '1', '0' )
|
|
Endwith
|
|
|
|
For I = 1 To Alines( laLines, Strextract( lcStrPJM, '[OLEServers]', '[OLEServersEnd]' ), 4 )
|
|
Alines( laProps, laLines(m.I), 1, ',' )
|
|
|
|
If m.I = 1
|
|
With loServerHead As CL_PROJ_SRV_HEAD Of 'FOXBIN2PRG.PRG'
|
|
._LibraryName = laProps(1)
|
|
._InternalName = laProps(2)
|
|
._ProjectName = laProps(3)
|
|
._TypeLibDesc = laProps(4)
|
|
._ServerType = Padl(laProps(5),4)
|
|
._TypeLib = laProps(6)
|
|
Endwith
|
|
|
|
Else
|
|
loServerData = loServerHead.getServerDataObject()
|
|
|
|
With loServerData As CL_PROJ_SRV_DATA Of 'FOXBIN2PRG.PRG'
|
|
._HelpContextID = laProps(4)
|
|
._ServerName = laProps(3)
|
|
._Description = laProps(5)
|
|
._HelpFile = laProps(6)
|
|
._ServerClass = laProps(1)
|
|
._ClassLibrary = laProps(2)
|
|
._Instancing = laProps(7)
|
|
._CLSID = laProps(8)
|
|
._Interface = laProps(9)
|
|
Endwith
|
|
|
|
loServerHead.add_Server( loServerData )
|
|
loServerData = Null
|
|
Endif
|
|
Endfor
|
|
|
|
|
|
|
|
*-- Escaneo el proyecto
|
|
For I = 1 To Alines( laLines, Strextract( lcStrPJM, '[ProjectFiles]', '[EOF]' ), 4 )
|
|
Alines( laProps, laLines(m.I) + ',', 1, ',' )
|
|
loReg = Null
|
|
loReg = Createobject("EMPTY")
|
|
AddProperty( loReg, 'ID', Iif( toFoxBin2Prg.l_ClearUniqueID, 0, Val( laProps(1) ) ) )
|
|
AddProperty( loReg, 'TYPE', laProps(2) )
|
|
AddProperty( loReg, 'NAME', laProps(3) )
|
|
AddProperty( loReg, 'EXCLUDE', Evaluate( laProps(4) ) )
|
|
AddProperty( loReg, 'MAINPROG', laProps(5) )
|
|
AddProperty( loReg, 'CPID', Val( laProps(6) ) )
|
|
AddProperty( loReg, 'COMMENTS', laProps(9) )
|
|
AddProperty( loReg, 'TIMESTAMP', 0 )
|
|
AddProperty( loReg, 'OBJREV', 0 )
|
|
|
|
*-- TIP: Si el "Name" del objeto está vacío, lo salteo
|
|
If Empty(loReg.Name)
|
|
Loop
|
|
Endif
|
|
|
|
Try
|
|
Do Case
|
|
Case loReg.MAINPROG = '.T.'
|
|
loProject._MainProg = loReg.Name
|
|
loProject.Add( loReg, loReg.Name )
|
|
Case loReg.Type == 'W'
|
|
*
|
|
Case loReg.Type == 'i'
|
|
loProject._Icon = loReg.Name
|
|
Otherwise
|
|
loProject.Add( loReg, loReg.Name )
|
|
Endcase
|
|
|
|
Catch To loEx When loEx.ErrorNo = 2062 && The specified key already exists ==> loProject.ADD( loReg, loReg.NAME )
|
|
*-- Saltear y no agregar el archivo duplicado / Bypass and not add the duplicated file
|
|
Finally
|
|
loReg = Null
|
|
Endtry
|
|
Endfor
|
|
|
|
|
|
C_FB2PRG_CODE = C_FB2PRG_CODE + toFoxBin2Prg.get_PROGRAM_HEADER()
|
|
|
|
|
|
*-- Directorio de inicio
|
|
TEXT TO C_FB2PRG_CODE ADDITIVE TEXTMERGE NOSHOW FLAGS 1+2 PRETEXT 1+2
|
|
LPARAMETERS tcDir
|
|
<<>>
|
|
lcCurdir = SYS(5)+CURDIR()
|
|
CD ( EVL( tcDir, JUSTPATH( SYS(16) ) ) )
|
|
<<>>
|
|
ENDTEXT
|
|
|
|
|
|
*-- Información del programa
|
|
C_FB2PRG_CODE = C_FB2PRG_CODE + loProject.getFormattedDeviceInfoText() + CR_LF
|
|
|
|
|
|
*-- Información de los Servidores definidos
|
|
If Not Empty(loProject._ServerInfo)
|
|
C_FB2PRG_CODE = C_FB2PRG_CODE + loServerHead.getFormattedServerText() + CR_LF
|
|
loServerHead = Null
|
|
Endif
|
|
|
|
With This As c_conversor_pjm_a_prg Of 'FOXBIN2PRG.PRG'
|
|
|
|
*-- Generación del proyecto
|
|
TEXT TO C_FB2PRG_CODE ADDITIVE TEXTMERGE NOSHOW FLAGS 1+2 PRETEXT 1+2
|
|
<<C_BUILDPROJ_I>>
|
|
<<>>*<.HomeDir = <<loProject._HomeDir>> />
|
|
<<>>
|
|
FOR EACH loProject IN _VFP.Projects FOXOBJECT
|
|
<<>> loProject.Close()
|
|
ENDFOR
|
|
<<>>
|
|
STRTOFILE( '', '__newproject.f2b' )
|
|
BUILD PROJECT <<JUSTFNAME( EVL( .c_OriginalFileName, .c_InputFile ) )>> FROM '__newproject.f2b'
|
|
ENDTEXT
|
|
|
|
|
|
*-- Abro el proyecto
|
|
TEXT TO C_FB2PRG_CODE ADDITIVE TEXTMERGE NOSHOW FLAGS 1+2 PRETEXT 1+2
|
|
FOR EACH loProject IN _VFP.Projects FOXOBJECT
|
|
<<>> loProject.Close()
|
|
ENDFOR
|
|
<<>>
|
|
MODIFY PROJECT '<<JUSTFNAME( EVL( .c_OriginalFileName, .c_InputFile ) )>>' NOWAIT NOSHOW NOPROJECTHOOK
|
|
<<>>
|
|
loProject = _VFP.Projects('<<JUSTFNAME( EVL( .c_OriginalFileName, .c_InputFile ) )>>')
|
|
<<>>
|
|
WITH loProject.FILES
|
|
ENDTEXT
|
|
|
|
|
|
*-- Definir archivos del proyecto y metadata: CPID, Timestamp, ID, etc.
|
|
loProject.KeySort = 2
|
|
|
|
For Each loReg In loProject &&FOXOBJECT
|
|
TEXT TO C_FB2PRG_CODE ADDITIVE TEXTMERGE NOSHOW FLAGS 1+2 PRETEXT 1+2
|
|
<<>> .ADD('<<loReg.NAME>>')
|
|
ENDTEXT
|
|
TEXT TO C_FB2PRG_CODE ADDITIVE TEXTMERGE NOSHOW FLAGS 1 PRETEXT 1+2+4+8
|
|
<<>> <<'&'>><<'&'>> <<C_FILE_META_I>>
|
|
Type="<<loReg.TYPE>>"
|
|
Cpid="<<INT( loReg.CPID )>>"
|
|
Timestamp="<<INT( loReg.TIMESTAMP )>>"
|
|
ID="<<INT( loReg.ID )>>"
|
|
ObjRev="<<INT( loReg.OBJREV )>>"
|
|
User=""
|
|
<<C_FILE_META_F>>
|
|
ENDTEXT
|
|
loReg = Null
|
|
Endfor
|
|
|
|
TEXT TO C_FB2PRG_CODE ADDITIVE TEXTMERGE NOSHOW FLAGS 1+2 PRETEXT 1+2
|
|
<<>> <<C_BUILDPROJ_F>>
|
|
<<>>
|
|
<<>> .ITEM('__newproject.f2b').Remove()
|
|
<<>>
|
|
ENDTEXT
|
|
|
|
|
|
TEXT TO C_FB2PRG_CODE ADDITIVE TEXTMERGE NOSHOW FLAGS 1+2 PRETEXT 1+2
|
|
<<>> <<C_FILE_CMTS_I>>
|
|
ENDTEXT
|
|
|
|
|
|
*-- Agrego los comentarios
|
|
loProject.KeySort = 2
|
|
|
|
For Each loReg In loProject &&FOXOBJECT
|
|
If Not Empty(loReg.COMMENTS)
|
|
C_FB2PRG_CODE = C_FB2PRG_CODE + Chr(13) + Chr(10) + Chr(9) + ".ITEM(lcCurdir + '" + loReg.Name + "').Description = '" + loReg.COMMENTS + "'"
|
|
Endif
|
|
Endfor
|
|
|
|
|
|
*-- Exclusiones
|
|
TEXT TO C_FB2PRG_CODE ADDITIVE TEXTMERGE NOSHOW FLAGS 1+2 PRETEXT 1+2
|
|
<<>> <<C_FILE_CMTS_F>>
|
|
<<>>
|
|
<<>> <<C_FILE_EXCL_I>>
|
|
ENDTEXT
|
|
|
|
loProject.KeySort = 2
|
|
|
|
For Each loReg In loProject &&FOXOBJECT
|
|
If loReg.EXCLUDE
|
|
C_FB2PRG_CODE = C_FB2PRG_CODE + Chr(13) + Chr(10) + Chr(9) + ".ITEM(lcCurdir + '" + loReg.Name + "').Exclude = .T."
|
|
Endif
|
|
loReg = Null
|
|
Endfor
|
|
|
|
|
|
*-- Tipos de archivos especiales
|
|
TEXT TO C_FB2PRG_CODE ADDITIVE TEXTMERGE NOSHOW FLAGS 1+2 PRETEXT 1+2
|
|
<<>> <<C_FILE_EXCL_F>>
|
|
<<>>
|
|
<<>> <<C_FILE_TXT_I>>
|
|
ENDTEXT
|
|
|
|
loProject.KeySort = 2
|
|
|
|
For Each loReg In loProject &&FOXOBJECT
|
|
If Inlist( Upper( Justext( loReg.Name ) ), 'H','FPW' )
|
|
C_FB2PRG_CODE = C_FB2PRG_CODE + Chr(13) + Chr(10) + Chr(9) + ".ITEM(lcCurdir + '" + loReg.Name + "').Type = 'T'"
|
|
Endif
|
|
loReg = Null
|
|
Endfor
|
|
|
|
|
|
*-- ProjectHook, Debug, Encrypt, Build y cierre
|
|
TEXT TO C_FB2PRG_CODE ADDITIVE TEXTMERGE NOSHOW FLAGS 1+2 PRETEXT 1+2
|
|
<<>> <<C_FILE_TXT_F>>
|
|
<<C_ENDWITH>>
|
|
<<>>
|
|
<<C_WITH>> loProject
|
|
<<>> <<C_PROJPROPS_I>>
|
|
ENDTEXT
|
|
|
|
If Not Empty(loProject._MainProg)
|
|
TEXT TO C_FB2PRG_CODE ADDITIVE TEXTMERGE NOSHOW FLAGS 1+2 PRETEXT 1+2
|
|
<<>> .SetMain(lcCurdir + '<<loProject._MainProg>>')
|
|
ENDTEXT
|
|
Endif
|
|
|
|
If Not Empty(loProject._Icon)
|
|
TEXT TO C_FB2PRG_CODE ADDITIVE TEXTMERGE NOSHOW FLAGS 1+2 PRETEXT 1+2
|
|
<<>> .Icon = lcCurdir + '<<loProject._Icon>>'
|
|
ENDTEXT
|
|
Endif
|
|
|
|
TEXT TO C_FB2PRG_CODE ADDITIVE TEXTMERGE NOSHOW FLAGS 1+2 PRETEXT 1+2
|
|
<<>> .Debug = <<loProject._Debug>>
|
|
<<>> .Encrypted = <<loProject._Encrypted>>
|
|
<<>> *<.CmntStyle = <<loProject._CmntStyle>> />
|
|
<<>> *<.NoLogo = <<loProject._NoLogo>> />
|
|
<<>> *<.SaveCode = <<loProject._SaveCode>> />
|
|
<<>> *<.User = '<<loProject._User>>' />
|
|
<<>> .ProjectHookLibrary = '<<loProject._ProjectHookLibrary>>'
|
|
<<>> .ProjectHookClass = '<<loProject._ProjectHookClass>>'
|
|
<<>> <<C_PROJPROPS_F>>
|
|
<<C_ENDWITH>>
|
|
<<>>
|
|
ENDTEXT
|
|
|
|
|
|
*-- Build y cierre
|
|
TEXT TO C_FB2PRG_CODE ADDITIVE TEXTMERGE NOSHOW FLAGS 1+2 PRETEXT 1+2
|
|
<<>>
|
|
_VFP.Projects('<<JUSTFNAME( EVL( .c_OriginalFileName, .c_InputFile ) )>>').Close()
|
|
ENDTEXT
|
|
|
|
*-- Restauro Directorio de inicio
|
|
TEXT TO C_FB2PRG_CODE ADDITIVE TEXTMERGE NOSHOW FLAGS 1+2 PRETEXT 1+2
|
|
*ERASE '__newproject.f2b'
|
|
CD (lcCurdir)
|
|
RETURN
|
|
ENDTEXT
|
|
|
|
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
|
|
|
|
Endwith && THIS
|
|
Endif
|
|
|
|
toFoxBin2Prg.updateProcessedFile()
|
|
|
|
|
|
*-- Genero el PJ2
|
|
This.updateProgressbar( 'Writing ' + toFoxBin2Prg.c_PJ2 + '...', 2, 2, 1 )
|
|
|
|
If This.l_Test
|
|
toModulo = C_FB2PRG_CODE
|
|
Else
|
|
This.write_OutputFile( (C_FB2PRG_CODE), This.c_OutputFile, @toFoxBin2Prg )
|
|
Endif
|
|
|
|
|
|
Catch To toEx
|
|
This.set_UserValue(@toEx)
|
|
|
|
lnCodError = toEx.ErrorNo
|
|
|
|
Do Case
|
|
Case lnCodError = 2062 && The specified key already exists ==> loProject.ADD( loReg, loReg.NAME )
|
|
*toEx.USERVALUE = 'Archivo duplicado: ' + loReg.NAME
|
|
toEx.UserValue = toEx.UserValue + loLang.C_DUPLICATED_FILE_LOC + ': ' + loReg.Name
|
|
Endcase
|
|
|
|
If This.n_Debug > 0 And _vfp.StartMode = 0
|
|
Set Step On
|
|
Endif
|
|
|
|
Throw
|
|
|
|
Finally
|
|
*USE IN (SELECT("TABLABIN"))
|
|
Store Null To loProject, loReg, loServerHead, loServerData
|
|
Release toModulo, toEx, toFoxBin2Prg ;
|
|
, lnCodError, lcStr, lnPos, lnLen, lnServerCount, loReg, lnLen ;
|
|
, lcStrPJM, laLines, laProps, loProject, loServerHead, loServerData
|
|
|
|
Endtry
|
|
|
|
Return
|
|
Endproc
|
|
|
|
|
|
Procedure strExtract_CR
|
|
Lparameters tcText
|
|
tcText = This.decode_SpecialCodes_CR_LF( Strextract( tcText, 'Comments=', CR_LF ) )
|
|
Return tcText
|
|
Endproc
|
|
|
|
|
|
Enddefine
|
|
|
|
|
|
|
|
Define Class c_conversor_frx_a_prg As c_conversor_bin_a_prg
|
|
#If .F.
|
|
Local This As c_conversor_frx_a_prg Of 'FOXBIN2PRG.PRG'
|
|
#Endif
|
|
|
|
c_Type = 'FRX'
|
|
|
|
|
|
|
|
Procedure convert
|
|
*---------------------------------------------------------------------------------------------------
|
|
* PARÁMETROS: (v=Pasar por valor | @=Pasar por referencia) (!=Obligatorio | ?=Opcional) (IN/OUT)
|
|
* toModulo (!@ 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 toModulo, toEx As Exception, toFoxBin2Prg
|
|
#If .F.
|
|
Local toFoxBin2Prg As c_foxbin2prg Of 'FOXBIN2PRG.PRG'
|
|
#Endif
|
|
DoDefault( @toModulo, @toEx, @toFoxBin2Prg )
|
|
|
|
Try
|
|
With This As c_conversor_frx_a_prg Of 'FOXBIN2PRG.PRG'
|
|
If toFoxBin2Prg.l_ProcessFiles Then
|
|
Local lnCodError, loRegCab, loRegDataEnv, loRegCur, loRegObj, lnMethodCount, laMethods(1), laCode(1), laProtected(1), lnLen ;
|
|
, laPropsAndValues(1), laPropsAndComments(1), lnLastClass, lnRecno, lcMethods, lcObjName, la_NombresObjsOle(1) ;
|
|
, loLang As CL_LANG Of 'FOXBIN2PRG.PRG'
|
|
|
|
loLang = _Screen.o_FoxBin2Prg_Lang
|
|
Store 0 To lnCodError, lnLastClass
|
|
Store '' To laMethods(1), laCode(1), laProtected(1), laPropsAndComments(1)
|
|
Store Null To loRegObj, loRegCab, loRegDataEnv, loRegCur
|
|
|
|
Use (.c_InputFile) Shared Again Noupdate Alias _TABLAORIG
|
|
This.updateProgressbar( 'Scanning FRX...', 1, 2, 1 )
|
|
|
|
*-- Verificación de REPORTE VFP 9
|
|
If Fcount() < 75 Or Empty(Field("USER"))
|
|
*ERROR 'Report [' + (.c_InputFile) + '] is NOT VFP 9 Format! - Please convert to VFP 9 with MODIFY REPORT ' + JUSTFNAME((.c_InputFile))
|
|
Error (Textmerge(loLang.C_REPORT_NOT_IN_VFP9_FORMAT_LOC))
|
|
Endif
|
|
|
|
C_FB2PRG_CODE = C_FB2PRG_CODE + toFoxBin2Prg.get_PROGRAM_HEADER()
|
|
|
|
*SELECT * FROM _TABLAORIG ;
|
|
WHERE ObjType IN (1,25,26) ;
|
|
ORDER BY ObjType ASC ;
|
|
INTO CURSOR TABLABIN_0 READWRITE
|
|
*-- Arreglo bug agrupación de controles. 29/10/2015
|
|
Select * From _TABLAORIG ;
|
|
WHERE ObjType In (1,25,26) ;
|
|
INTO Cursor TABLABIN_0 Readwrite
|
|
|
|
*-- Header
|
|
Select TABLABIN_0
|
|
Locate For ObjType = 1
|
|
|
|
If Found()
|
|
loRegCab = Null
|
|
Scatter Memo Name loRegCab
|
|
|
|
If toFoxBin2Prg.l_NoTimestamps
|
|
loRegCab.Timestamp = 0
|
|
Endif
|
|
If toFoxBin2Prg.l_ClearUniqueID
|
|
loRegCab.UNIQUEID = ''
|
|
Endif
|
|
Endif
|
|
|
|
If .l_ReportSort_Enabled
|
|
*-- ORDENADO
|
|
Select * From _TABLAORIG ;
|
|
WHERE ObjType Not In (1,25,26) ;
|
|
ORDER By vpos,hpos Asc ;
|
|
INTO Cursor TABLABIN Readwrite
|
|
Else
|
|
*-- SIN ORDENAR (Sólo para poder comparar con el original)
|
|
Select * From _TABLAORIG ;
|
|
WHERE ObjType Not In (1,25,26) ;
|
|
INTO Cursor TABLABIN
|
|
Endif
|
|
|
|
loRegObj = Null
|
|
|
|
|
|
*-- Recorro los registros y genero el texto
|
|
If Vartype(loRegCab) = "O"
|
|
.write_TXT_REPORTE( @loRegCab )
|
|
Endif
|
|
|
|
Select TABLABIN
|
|
|
|
Scan All
|
|
loRegObj = Null
|
|
Scatter Memo Name loRegObj
|
|
|
|
If toFoxBin2Prg.l_NoTimestamps
|
|
loRegObj.Timestamp = 0
|
|
Endif
|
|
If toFoxBin2Prg.l_ClearUniqueID
|
|
loRegObj.UNIQUEID = ''
|
|
Endif
|
|
|
|
.write_TXT_REPORTE( @loRegObj )
|
|
Endscan
|
|
|
|
*-- Dataenvironment
|
|
Select TABLABIN_0
|
|
Locate For ObjType = 25
|
|
|
|
If Found()
|
|
loRegDataEnv = Null
|
|
Scatter Memo Name loRegDataEnv
|
|
|
|
If toFoxBin2Prg.l_NoTimestamps
|
|
loRegDataEnv.Timestamp = 0
|
|
Endif
|
|
If toFoxBin2Prg.l_ClearUniqueID
|
|
loRegDataEnv.UNIQUEID = ''
|
|
Endif
|
|
|
|
.write_TXT_REPORTE( @loRegDataEnv )
|
|
Endif
|
|
|
|
*-- Cursors and Relations
|
|
Select TABLABIN_0
|
|
|
|
Scan All For ObjType = 26
|
|
loRegCur = Null
|
|
Scatter Memo Name loRegCur
|
|
|
|
If toFoxBin2Prg.l_NoTimestamps
|
|
loRegCur.Timestamp = 0
|
|
Endif
|
|
If toFoxBin2Prg.l_ClearUniqueID
|
|
loRegCur.UNIQUEID = ''
|
|
Endif
|
|
|
|
.write_TXT_REPORTE( @loRegCur )
|
|
Endscan
|
|
Endif
|
|
|
|
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()
|
|
|
|
|
|
*-- Genero el FR2
|
|
.updateProgressbar( 'Writing ' + toFoxBin2Prg.c_FR2 + '...', 2, 2, 1 )
|
|
|
|
If .l_Test
|
|
toModulo = C_FB2PRG_CODE
|
|
Else
|
|
.write_OutputFile( (C_FB2PRG_CODE), .c_OutputFile, @toFoxBin2Prg )
|
|
Endif
|
|
Endwith && THIS
|
|
|
|
|
|
Catch To toEx
|
|
This.set_UserValue(@toEx)
|
|
|
|
If This.n_Debug > 0 And _vfp.StartMode = 0
|
|
Set Step On
|
|
Endif
|
|
|
|
Throw
|
|
|
|
Finally
|
|
Use In (Select("TABLABIN"))
|
|
Use In (Select("TABLABIN_0"))
|
|
Use In (Select("_TABLAORIG"))
|
|
Store Null To loRegObj, loRegCab, loRegDataEnv, loRegCur
|
|
Release toModulo, toEx, toFoxBin2Prg ;
|
|
, lnCodError, loRegCab, loRegDataEnv, loRegCur, loRegObj, lnMethodCount, laMethods, laCode, laProtected, lnLen ;
|
|
, laPropsAndValues, laPropsAndComments, lnLastClass, lnRecno, lcMethods, lcObjName, la_NombresObjsOle
|
|
|
|
Endtry
|
|
|
|
Return
|
|
Endproc
|
|
Enddefine
|
|
|
|
|
|
|
|
Define Class c_conversor_dbf_a_prg As c_conversor_bin_a_prg
|
|
#If .F.
|
|
Local This As c_conversor_dbf_a_prg Of 'FOXBIN2PRG.PRG'
|
|
#Endif
|
|
c_Type = 'DBF'
|
|
|
|
|
|
Procedure convert
|
|
*---------------------------------------------------------------------------------------------------
|
|
* PARÁMETROS: (v=Pasar por valor | @=Pasar por referencia) (!=Obligatorio | ?=Opcional) (IN/OUT)
|
|
* toModulo (!@ OUT) Contenido del texto generado
|
|
* 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 )
|
|
|
|
*!* Changed by: Lutz Scheffler 11.2.2021
|
|
*!* change date="{^2021-02-11,08:50:00}"
|
|
* If toFoxBin2Prg.l_ProcessFiles is not true
|
|
* and the try block was exited
|
|
* the stuff below was never instatiated
|
|
|
|
*so the whole try / catch block should not run
|
|
|
|
If Not toFoxBin2Prg.l_ProcessFiles Then
|
|
This.write_OutputFile( '', This.c_OutputFile, @toFoxBin2Prg )
|
|
Else &&NOT toFoxBin2Prg.l_ProcessFiles
|
|
*!* /Changed by: Lutz Scheffler 11.2.2021
|
|
|
|
Try
|
|
With This As c_conversor_dbf_a_prg Of 'FOXBIN2PRG.PRG'
|
|
*!* Changed by: Lutz Scheffler 11.2.2021
|
|
*!* change date="{^2021-02-11,08:50:00}"
|
|
*moved up:
|
|
* IF NOT toFoxBin2Prg.l_ProcessFiles THEN
|
|
* .write_OutputFile( '', .c_OutputFile, @toFoxBin2Prg )
|
|
* EXIT && Si se indicó no procesar, se sale aquí. (Modo de simulación)
|
|
* ENDIF
|
|
*!* /Changed by: Lutz Scheffler 11.2.2021
|
|
|
|
Local lnCodError, laDatabases(1), lnDatabases_Count, laDatabases2(1) ;
|
|
, lnLen, lc_FileTypeDesc, laLines(1), lcOutputFile ;
|
|
, ln_HexFileType, ll_FileHasCDX, ll_FileHasMemo, ll_FileIsDBC ;
|
|
, lc_DBC_Name, lnDataSessionID, lnSelect, laDirInfo(1,5) ;
|
|
, llDBCEventsEnabled ;
|
|
, loTable As CL_DBF_TABLE Of 'FOXBIN2PRG.PRG' ;
|
|
, loDBFUtils As CL_DBF_UTILS Of 'FOXBIN2PRG.PRG' ;
|
|
, loLang As CL_LANG Of 'FOXBIN2PRG.PRG' ;
|
|
, loFSO As Scripting.FileSystemObject ;
|
|
, loTextStream As Scripting.TextStream ;
|
|
, loDBC As CL_DBC Of 'FOXBIN2PRG.PRG'
|
|
|
|
loLang = _Screen.o_FoxBin2Prg_Lang
|
|
loFSO = toFoxBin2Prg.o_FSO
|
|
Store Null To loTable, loDBFUtils
|
|
Store 0 To lnCodError
|
|
loDBFUtils = Createobject('CL_DBF_UTILS')
|
|
loDBC = Createobject('CL_DBC')
|
|
|
|
*-- EVALUAR OPCIONES ESPECÍFICAS DE DBF
|
|
.updateProgressbar( 'Scanning DBF Structure...', 1, 3, 1 )
|
|
|
|
*-- Include
|
|
If Not Empty(toFoxBin2Prg.DBF_Conversion_Included) And Not toFoxBin2Prg.DBF_Conversion_Included == '*' ;
|
|
AND Not toFoxBin2Prg.filenameFoundInFilter( Justfname(.c_InputFile), toFoxBin2Prg.DBF_Conversion_Included )
|
|
toFoxBin2Prg.writeLog(' ' + Justfname(.c_InputFile) + ' no está en el filtro DBF_Conversion_Included (' + toFoxBin2Prg.DBF_Conversion_Included + ')' )
|
|
Exit
|
|
Endif
|
|
|
|
*-- Exclude
|
|
If Not Empty(toFoxBin2Prg.DBF_Conversion_Excluded) ;
|
|
AND toFoxBin2Prg.filenameFoundInFilter( Justfname(.c_InputFile), toFoxBin2Prg.DBF_Conversion_Excluded )
|
|
toFoxBin2Prg.writeLog(' ' + Justfname(.c_InputFile) + ' está en el filtro DBF_Conversion_Excluded (' + toFoxBin2Prg.DBF_Conversion_Excluded + ')' )
|
|
Exit
|
|
Endif
|
|
|
|
loDBFUtils.getDBFmetadata( .c_InputFile, @ln_HexFileType, @ll_FileHasCDX, @ll_FileHasMemo, @ll_FileIsDBC, @lc_DBC_Name )
|
|
lc_FileTypeDesc = loDBFUtils.fileTypeDescription(ln_HexFileType)
|
|
lnDatabases_Count = Adatabases(laDatabases)
|
|
|
|
* Si la tabla pertenece a un DBC, desactivar temporalmente los eventos
|
|
If Not Empty(lc_DBC_Name) And Adir(laDirInfo, Fullpath(lc_DBC_Name, .c_InputFile)) = 1
|
|
loDBC._DBC = Fullpath(lc_DBC_Name, .c_InputFile)
|
|
llDBCEventsEnabled = loDBC.DBGetProp(lc_DBC_Name,"DATABASE","DBCEvents")
|
|
|
|
* llDBCEventsEnabled no siempre devuelve .T./.F., a veces devuelve ""
|
|
If Empty(llDBCEventsEnabled)
|
|
llDBCEventsEnabled = .F.
|
|
Endif
|
|
|
|
If llDBCEventsEnabled
|
|
If Not loDBC.DBSetProp(lc_DBC_Name,"DATABASE","DBCEvents",.F.)
|
|
llDBCEventsEnabled = .F.
|
|
Endif
|
|
Endif
|
|
Endif
|
|
|
|
Use (.c_InputFile) Shared Again Noupdate Alias TABLABIN
|
|
lnDataSessionID = toFoxBin2Prg.DataSessionId
|
|
.RestoreDBCEvents(loDBC, @llDBCEventsEnabled)
|
|
|
|
C_FB2PRG_CODE = C_FB2PRG_CODE + toFoxBin2Prg.get_PROGRAM_HEADER()
|
|
|
|
*-- Header
|
|
loTable = Createobject('CL_DBF_TABLE')
|
|
|
|
*-- Exportación de estructura y datos (para Diff solamente)
|
|
Erase (.c_OutputFile + '.TMP' )
|
|
loTextStream = loFSO.CreateTextFile(.c_OutputFile + '.TMP' ) && Replace VFP low-level file funcs.because the 8-16KB limit.
|
|
toFoxBin2Prg.o_TextStream = loTextStream
|
|
|
|
If toFoxBin2Prg.n_FileHandle = -1 Then
|
|
Error 102, (.c_OutputFile)
|
|
Endif
|
|
|
|
loTextStream.WriteLine( C_FB2PRG_CODE ) && Replace VFP low-level file funcs.because the 8-16KB limit.
|
|
* SF, Analyse, call table
|
|
loTable.toText( ln_HexFileType, ll_FileHasCDX, ll_FileHasMemo, ll_FileIsDBC, lc_DBC_Name, .c_InputFile, lc_FileTypeDesc, @toFoxBin2Prg )
|
|
|
|
loTextStream.Close()
|
|
|
|
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()
|
|
|
|
|
|
*-- Genero el DB2, renombrando el TMP
|
|
.updateProgressbar( 'Writing ' + toFoxBin2Prg.c_DB2 + '...', 3, 3, 1 )
|
|
If .l_Test
|
|
toModulo = C_FB2PRG_CODE
|
|
Else
|
|
Do Case
|
|
Case Adir(laDirInfo, .c_OutputFile) > 0 And toFoxBin2Prg.comparedFilesAreEqual( .c_OutputFile + '.TMP', .c_OutputFile ) = 1
|
|
Erase (.c_OutputFile + '.TMP')
|
|
*.writeLog( 'El archivo de salida [' + .c_OutputFile + '] no se sobreescribe por ser igual al generado.' )
|
|
lcOutputFile = .c_OutputFile
|
|
.writeLog( C_TAB + C_TAB + '* ' + Textmerge(loLang.C_OUTPUT_FILE_IS_NOT_OVERWRITEN_LOC) )
|
|
Case toFoxBin2Prg.doBackup( .F., .T., '', '', '' ) ;
|
|
AND toFoxBin2Prg.changeFileAttribute( .c_OutputFile + '.TMP', '-R' ) > 0 ;
|
|
AND Not toFoxBin2Prg.renameTmpFile2Tx2File( .c_OutputFile )
|
|
*ERROR 'No se puede generar el archivo [' + .c_OutputFile + '] porque es ReadOnly'
|
|
Error (Textmerge(loLang.C_CANT_GENERATE_FILE_BECAUSE_IT_IS_READONLY_LOC))
|
|
Endcase
|
|
Endif
|
|
|
|
|
|
*-- Hook para permitir ejecución externa (por ejemplo, para exportar datos)
|
|
If Not Empty(toFoxBin2Prg.run_AfterCreate_DB2)
|
|
lnSelect = Select()
|
|
Do (toFoxBin2Prg.run_AfterCreate_DB2) With (lnDataSessionID), (.c_OutputFile), (loTable)
|
|
Set DataSession To (lnDataSessionID) && Por las dudas externamente se cambie
|
|
Select (lnSelect)
|
|
Endif
|
|
|
|
Endwith && THIS
|
|
|
|
|
|
Catch To toEx
|
|
This.set_UserValue(@toEx)
|
|
|
|
Do Case
|
|
Case toEx.ErrorNo = 13 && Alias not found
|
|
toEx.UserValue = toEx.UserValue + Textmerge(loLang.C_WARN_TABLE_ALIAS_ON_INDEX_EXPRESSION_LOC)
|
|
|
|
*!* CASE toEx.ErrorNo = 1976 && Cannot resolve backlink
|
|
*!* toEx.UserValue = 'WARNING!!' + CR_LF ;
|
|
*!* + "MAY BE DATABASE FIELDS DOESN'T" ;
|
|
*!* + UPPER(JUSTSTEM(THIS.c_InputFile)) + '.field tag keyname)' + CR_LF + CR_LF ;
|
|
*!* + '¡¡ATENCIÓN!!' + CR_LF ;
|
|
*!* + 'ASEGÚRESE DE QUE NO ESTÁ USANDO UN ALIAS DE TABLA EN LAS EXPRESIONES DE LOS ÍNDICES!! (ej: index on ' ;
|
|
*!* + UPPER(JUSTSTEM(THIS.c_InputFile)) + '.campo tag nombreclave)'
|
|
|
|
Endcase
|
|
If This.n_Debug > 0 And _vfp.StartMode = 0
|
|
Set Step On
|
|
Endif
|
|
|
|
Throw
|
|
|
|
Finally
|
|
Use In (Select("TABLABIN"))
|
|
This.RestoreDBCEvents(loDBC, @llDBCEventsEnabled)
|
|
|
|
If Vartype(loTextStream) = "O" Then
|
|
loTextStream.Close()
|
|
Endif
|
|
|
|
*-- Cierro DBC
|
|
For I = 1 To Adatabases(laDatabases2)
|
|
If Ascan( laDatabases, laDatabases2(m.I), 1, 0, 0, 1+2+4 ) = 0
|
|
Set Database To (laDatabases2(m.I))
|
|
Close Databases
|
|
Exit
|
|
Endif
|
|
Endfor
|
|
|
|
Store Null To loTable, loDBFUtils, loTextStream, toFoxBin2Prg.o_TextStream
|
|
*!* Changed by: Lutz Scheffler 11.2.2021
|
|
*!* change date="{^2021-02-11,08:50:00}"
|
|
* Release different, parts moved outsidef IF .. ENDIF
|
|
Release loTextStream ;
|
|
, lnCodError, laDatabases, lnDatabases_Count, laDatabases2, lnLen, lc_FileTypeDesc ;
|
|
, ln_HexFileType, ll_FileHasCDX, ll_FileHasMemo, ll_FileIsDBC, lc_DBC_Name, lnDataSessionID, lnSelect ;
|
|
, loTable, loDBFUtils
|
|
Endtry
|
|
*!* Changed by: Lutz Scheffler 11.2.2021
|
|
*!* change date="{^2021-02-11,08:50:00}"
|
|
* so the whole try / catch block should not run if in simulation
|
|
|
|
Endif &&NOT toFoxBin2Prg.l_ProcessFiles
|
|
|
|
* Release from above
|
|
Release toModulo, toEx, toFoxBin2Prg, loTextStream ;
|
|
*!* /Changed by: Lutz Scheffler 11.2.2021
|
|
|
|
Return
|
|
Endproc
|
|
|
|
|
|
Procedure RestoreDBCEvents(toDBC, tlDBCEventsEnabled)
|
|
#If .F.
|
|
Local toDBC As CL_DBC Of 'FOXBIN2PRG.PRG'
|
|
#Endif
|
|
If tlDBCEventsEnabled And Vartype(toDBC)="O"
|
|
toDBC.DBSetProp('',"DATABASE","DBCEvents",.T.)
|
|
tlDBCEventsEnabled = .F.
|
|
Endif
|
|
Endproc
|
|
|
|
|
|
Enddefine
|
|
|
|
|
|
* SF, Analyse, just locate
|
|
Define Class c_conversor_dbc_a_prg As c_conversor_bin_a_prg
|
|
#If .F.
|
|
Local This As c_conversor_dbc_a_prg Of 'FOXBIN2PRG.PRG'
|
|
#Endif
|
|
c_Type = 'DBC'
|
|
|
|
|
|
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
|
|
With This As c_conversor_dbc_a_prg Of 'FOXBIN2PRG.PRG'
|
|
Local lnCodError, laDatabases(1), lnDatabases_Count, lcEventsFile, lcExternalHeader, lcCodigo ;
|
|
, lnClassCount, laClasses(1,3) ;
|
|
, loConnection As CL_DBC_CONNECTION Of 'FOXBIN2PRG.PRG' ;
|
|
, loTable As CL_DBC_TABLE Of 'FOXBIN2PRG.PRG' ;
|
|
, loView As CL_DBC_VIEW Of 'FOXBIN2PRG.PRG'
|
|
|
|
Store Null To loRelation, loView, loTable
|
|
Store 0 To lnCodError, lnDatabases_Count, lnClassCount
|
|
Store '' To laDatabases, lcEventsFile, lcExternalHeader, laClasses, lcCodigo, C_FB2PRG_CODE
|
|
|
|
lnDatabases_Count = Adatabases(laDatabases)
|
|
Use (.c_InputFile) Shared Again Noupdate Alias TABLABIN
|
|
|
|
If toFoxBin2Prg.l_ProcessFiles Then
|
|
toDatabase = Createobject('CL_DBC')
|
|
toDatabase._DBC = .c_InputFile
|
|
toDatabase.read_DBC_Header()
|
|
|
|
*-- Verifico si hay archivo de eventos, y si hay uno definido pero no existe el archivo,
|
|
*-- creo uno temporalmente para poder abrir la BDD y luego lo elimino.
|
|
If toDatabase._DBCEvents And Not Empty(toDatabase._DBCEventFilename) Then
|
|
*-- El archivo de eventos puede tener path relativo o absoluto
|
|
*-- Ajusto la ruta si no es absoluta
|
|
lcEventsFile = toFoxBin2Prg.get_AbsolutePath( toDatabase._DBCEventFilename, .c_InputFile )
|
|
If File(lcEventsFile) Then
|
|
lcEventsFile = ''
|
|
Else
|
|
Strtofile( '', lcEventsFile )
|
|
Compile (lcEventsFile)
|
|
Endif
|
|
Endif
|
|
|
|
Open Database (.c_InputFile) Shared Noupdate
|
|
|
|
.updateProgressbar( 'Analyzing DBC metadata...', 1, 2, 1 )
|
|
|
|
C_FB2PRG_CODE = C_FB2PRG_CODE + toDatabase.toText(@toFoxBin2Prg)
|
|
|
|
*-- Header
|
|
If toFoxBin2Prg.n_UseFilesPerDBC > 0 Then
|
|
.write_EXTERNAL_MEMBER_HEADER( @toFoxBin2Prg, .F., .F., @lcExternalHeader )
|
|
|
|
*-- Connections
|
|
For Each loConnection In toDatabase._Connections &&FOXOBJECT
|
|
lnClassCount = lnClassCount + 1
|
|
Dimension laClasses(lnClassCount,3)
|
|
laClasses(lnClassCount,1) = Lower( loConnection._Name )
|
|
laClasses(lnClassCount,2) = loConnection._ToText
|
|
laClasses(lnClassCount,3) = 'connection'
|
|
.write_EXTERNAL_MEMBER_HEADER( @toFoxBin2Prg, laClasses(lnClassCount,1), laClasses(lnClassCount,3), @lcExternalHeader )
|
|
Endfor
|
|
|
|
*-- Tables
|
|
For Each loTable In toDatabase._Tables &&FOXOBJECT
|
|
lnClassCount = lnClassCount + 1
|
|
Dimension laClasses(lnClassCount,3)
|
|
laClasses(lnClassCount,1) = Lower( loTable._Name )
|
|
laClasses(lnClassCount,2) = loTable._ToText
|
|
laClasses(lnClassCount,3) = 'table'
|
|
.write_EXTERNAL_MEMBER_HEADER( @toFoxBin2Prg, laClasses(lnClassCount,1), laClasses(lnClassCount,3), @lcExternalHeader )
|
|
Endfor
|
|
|
|
*-- Views
|
|
For Each loView In toDatabase._Views &&FOXOBJECT
|
|
lnClassCount = lnClassCount + 1
|
|
Dimension laClasses(lnClassCount,3)
|
|
laClasses(lnClassCount,1) = Lower( loView._Name )
|
|
laClasses(lnClassCount,2) = loView._ToText
|
|
laClasses(lnClassCount,3) = 'view'
|
|
.write_EXTERNAL_MEMBER_HEADER( @toFoxBin2Prg, laClasses(lnClassCount,1), laClasses(lnClassCount,3), @lcExternalHeader )
|
|
Endfor
|
|
|
|
*-- Stored Procedures
|
|
If Not Empty(toDatabase._StoredProcedures) Then
|
|
lnClassCount = lnClassCount + 1
|
|
Dimension laClasses(lnClassCount,3)
|
|
laClasses(lnClassCount,1) = Lower( 'storedproceduressource' )
|
|
laClasses(lnClassCount,2) = toDatabase._StoredProcedures
|
|
laClasses(lnClassCount,3) = 'database'
|
|
.write_EXTERNAL_MEMBER_HEADER( @toFoxBin2Prg, laClasses(lnClassCount,1), laClasses(lnClassCount,3), @lcExternalHeader )
|
|
Endif
|
|
|
|
lcExternalHeader = lcExternalHeader + CR_LF
|
|
Endif
|
|
|
|
Else
|
|
*-- No procesar, solo reportar
|
|
_Tally = 0
|
|
Select Lower(TB.ObjectName), '', Lower(TB.ObjectType) ;
|
|
FROM TABLABIN TB ;
|
|
WHERE TB.ParentId = 1 And ( TB.ObjectType In (Padr('View',10), Padr('Table',10), Padr('Connection',10) ) ;
|
|
OR TB.ObjectType = Padr('Database',10) And TB.ObjectName = Padr('StoredProceduresSource',128) And Not Empty(TB.Code) ) ;
|
|
INTO Array laClasses
|
|
lnClassCount = _Tally
|
|
Endif
|
|
|
|
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()
|
|
|
|
|
|
*-- Genero el DC2
|
|
lcOutputFile = .c_OutputFile
|
|
|
|
If toFoxBin2Prg.l_ProcessFiles Then
|
|
.updateProgressbar( 'Writing ' + toFoxBin2Prg.c_DC2 + '...', 2, 2, 1 )
|
|
lcCodigo = toFoxBin2Prg.get_PROGRAM_HEADER() + lcExternalHeader + C_FB2PRG_CODE
|
|
Endif
|
|
|
|
If .l_Test
|
|
*FOR I = 1 TO lnClassCount
|
|
* lcCodigo = lcCodigo + laClasses(m.I,2)
|
|
*ENDFOR
|
|
*toDatabase = lcCodigo
|
|
Else
|
|
|
|
If toFoxBin2Prg.n_UseFilesPerDBC > 0 Then
|
|
.write_OutputFile( @lcCodigo, lcOutputFile, @toFoxBin2Prg )
|
|
|
|
For I = 1 To lnClassCount
|
|
* lcOutputFile = '<path>DBCName' + '.' + 'MemberType' + '.' + 'MemberName' + '.' + 'dc2'
|
|
lcOutputFile = Addbs( Justpath( .c_OutputFile ) ) + Juststem( .c_OutputFile ) + '.' + laClasses(m.I,3) + '.' + laClasses(m.I,1) + '.' + Justext( .c_OutputFile )
|
|
lcCodigo = toFoxBin2Prg.get_PROGRAM_HEADER() + laClasses(m.I,2)
|
|
.write_OutputFile( @lcCodigo, lcOutputFile, @toFoxBin2Prg )
|
|
Endfor
|
|
Else
|
|
For I = 1 To lnClassCount
|
|
lcCodigo = lcCodigo + laClasses(m.I,2)
|
|
Endfor
|
|
|
|
.write_OutputFile( @lcCodigo, lcOutputFile, @toFoxBin2Prg )
|
|
Endif
|
|
Endif
|
|
Endwith && THIS
|
|
|
|
Catch To toEx
|
|
This.set_UserValue(@toEx)
|
|
|
|
Catch To toEx
|
|
This.set_UserValue(@toEx)
|
|
|
|
If This.n_Debug > 0 And _vfp.StartMode = 0
|
|
Set Step On
|
|
Endif
|
|
|
|
Throw
|
|
|
|
Finally
|
|
Use In (Select("TABLABIN"))
|
|
Close Databases
|
|
If Not Empty(lcEventsFile) Then
|
|
Erase (lcEventsFile)
|
|
Erase (Forceext(lcEventsFile,'FXP'))
|
|
Endif
|
|
Release toDatabase, toEx, toFoxBin2Prg ;
|
|
, lnCodError, laDatabases, lnDatabases_Count
|
|
Endtry
|
|
|
|
Return
|
|
Endproc
|
|
Enddefine
|
|
|
|
|
|
|
|
Define Class c_conversor_mnx_a_prg As c_conversor_bin_a_prg
|
|
#If .F.
|
|
Local This As c_conversor_mnx_a_prg Of 'FOXBIN2PRG.PRG'
|
|
#Endif
|
|
c_Type = 'MNX'
|
|
|
|
|
|
Procedure convert
|
|
*---------------------------------------------------------------------------------------------------
|
|
* PARÁMETROS: (v=Pasar por valor | @=Pasar por referencia) (!=Obligatorio | ?=Opcional) (IN/OUT)
|
|
* totoMenu (!@ OUT) Objeto generado de clase CL_MENU 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
|
|
With This As c_conversor_mnx_a_prg Of 'FOXBIN2PRG.PRG'
|
|
If toFoxBin2Prg.l_ProcessFiles Then
|
|
Local lnCodError, lnLen ;
|
|
, loLang As CL_LANG Of 'FOXBIN2PRG.PRG'
|
|
|
|
loLang = _Screen.o_FoxBin2Prg_Lang
|
|
Store 0 To lnCodError
|
|
|
|
Use (.c_InputFile) Shared Again Noupdate Alias _TABLAORIG
|
|
Select * From _TABLAORIG Into Cursor TABLABIN
|
|
Use In (Select("_TABLAORIG"))
|
|
.updateProgressbar( 'Analyzing MNX...', 1, 2, 1 )
|
|
|
|
*-- Verificación de menú VFP 9
|
|
If Fcount() < 25 Or Empty(Field("RESNAME")) Or Empty(Field("SYSRES"))
|
|
*ERROR 'Menu [' + (.c_InputFile) + '] is NOT VFP 9 Format! - Please convert to VFP 9 with MODIFY MENU ' + JUSTFNAME((.c_InputFile))
|
|
Error (Textmerge(loLang.C_MENU_NOT_IN_VFP9_FORMAT_LOC))
|
|
Endif
|
|
|
|
*-- Header
|
|
C_FB2PRG_CODE = C_FB2PRG_CODE + toFoxBin2Prg.get_PROGRAM_HEADER()
|
|
|
|
toMenu = Createobject('CL_MENU')
|
|
toMenu.get_DataFromTablabin()
|
|
C_FB2PRG_CODE = C_FB2PRG_CODE + toMenu.toText()
|
|
Endif
|
|
|
|
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()
|
|
|
|
|
|
*-- Genero el MN2
|
|
If toFoxBin2Prg.l_ProcessFiles Then
|
|
.updateProgressbar( 'Writing ' + toFoxBin2Prg.c_MN2 + '...', 2, 2, 1 )
|
|
Endif
|
|
|
|
If .l_Test
|
|
toMenu = C_FB2PRG_CODE
|
|
Else
|
|
.write_OutputFile( (C_FB2PRG_CODE), .c_OutputFile, @toFoxBin2Prg )
|
|
Endif
|
|
Endwith && THIS
|
|
|
|
|
|
Catch To toEx
|
|
This.set_UserValue(@toEx)
|
|
|
|
If This.n_Debug > 0 And _vfp.StartMode = 0
|
|
Set Step On
|
|
Endif
|
|
|
|
Throw
|
|
|
|
Finally
|
|
Use In (Select("TABLABIN"))
|
|
Use In (Select("_TABLAORIG"))
|
|
Release toMenu, toEx, toFoxBin2Prg, lnCodError, lnLen
|
|
Endtry
|
|
|
|
Return
|
|
Endproc
|
|
Enddefine
|
|
|
|
|
|
|
|
Define Class c_conversor_fky_a_prg As c_conversor_bin_a_prg
|
|
#If .F.
|
|
Local This As c_conversor_fky_a_prg Of 'FOXBIN2PRG.PRG'
|
|
#Endif
|
|
c_Type = 'FKY'
|
|
|
|
|
|
Procedure convert
|
|
*---------------------------------------------------------------------------------------------------
|
|
* PARÁMETROS: (v=Pasar por valor | @=Pasar por referencia) (!=Obligatorio | ?=Opcional) (IN/OUT)
|
|
* toMacro (!@ OUT) Objeto generado de clase CL_MACRO con la información leida del texto
|
|
* toEx (!@ OUT) Objeto con información del error
|
|
* toFoxBin2Prg (v! IN ) Referencia al objeto principal
|
|
*---------------------------------------------------------------------------------------------------
|
|
Lparameters toMacro, toEx As Exception, toFoxBin2Prg
|
|
DoDefault( @toMacro, @toEx, @toFoxBin2Prg )
|
|
|
|
#If .F.
|
|
Local toMacro As CL_MACRO Of 'FOXBIN2PRG.PRG'
|
|
Local toFoxBin2Prg As c_foxbin2prg Of 'FOXBIN2PRG.PRG'
|
|
#Endif
|
|
|
|
Local lnCodError, lnLen, lnHandle ;
|
|
, loLang As CL_LANG Of 'FOXBIN2PRG.PRG'
|
|
|
|
Try
|
|
With This As c_conversor_fky_a_prg Of 'FOXBIN2PRG.PRG'
|
|
lnHandle = -1
|
|
|
|
If toFoxBin2Prg.l_ProcessFiles Then
|
|
loLang = _Screen.o_FoxBin2Prg_Lang
|
|
Store 0 To lnCodError
|
|
|
|
.updateProgressbar( 'Analyzing FKY...', 1, 2, 1 )
|
|
|
|
*-- Verificación de archivo de macros válido
|
|
*IF FCOUNT() < 25 OR EMPTY(FIELD("RESNAME")) OR EMPTY(FIELD("SYSRES"))
|
|
* *ERROR 'Menu [' + (.c_InputFile) + '] is NOT VFP 9 Format! - Please convert to VFP 9 with MODIFY MENU ' + JUSTFNAME((.c_InputFile))
|
|
* ERROR (TEXTMERGE(loLang.C_MENU_NOT_IN_VFP9_FORMAT_LOC))
|
|
*ENDIF
|
|
|
|
*-- Header
|
|
C_FB2PRG_CODE = C_FB2PRG_CODE + toFoxBin2Prg.get_PROGRAM_HEADER()
|
|
|
|
toMacro = Createobject('CL_MACRO')
|
|
toMacro.get_DataFromMacroFKY(.c_InputFile, @toFoxBin2Prg)
|
|
C_FB2PRG_CODE = C_FB2PRG_CODE + toMacro.toText()
|
|
Endif
|
|
|
|
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()
|
|
|
|
|
|
*-- Genero el FK2
|
|
If toFoxBin2Prg.l_ProcessFiles Then
|
|
.updateProgressbar( 'Writing ' + toFoxBin2Prg.c_FK2 + '...', 2, 2, 1 )
|
|
Endif
|
|
|
|
If .l_Test
|
|
toMacro = C_FB2PRG_CODE
|
|
Else
|
|
.write_OutputFile( (C_FB2PRG_CODE), .c_OutputFile, @toFoxBin2Prg )
|
|
Endif
|
|
Endwith && THIS
|
|
|
|
|
|
Catch To toEx
|
|
This.set_UserValue(@toEx)
|
|
|
|
If This.n_Debug > 0 And _vfp.StartMode = 0
|
|
Set Step On
|
|
Endif
|
|
|
|
Throw
|
|
|
|
Finally
|
|
*
|
|
Endtry
|
|
|
|
Return
|
|
Endproc
|
|
Enddefine
|
|
|
|
|
|
|
|
Define Class c_conversor_mem_a_prg As c_conversor_bin_a_prg
|
|
#If .F.
|
|
Local This As c_conversor_mem_a_prg Of 'FOXBIN2PRG.PRG'
|
|
#Endif
|
|
c_Type = 'MEM'
|
|
|
|
|
|
Procedure convert
|
|
*---------------------------------------------------------------------------------------------------
|
|
* PARÁMETROS: (v=Pasar por valor | @=Pasar por referencia) (!=Obligatorio | ?=Opcional) (IN/OUT)
|
|
* toMacro (!@ OUT) Objeto generado de clase CL_MACRO con la información leida del texto
|
|
* toEx (!@ OUT) Objeto con información del error
|
|
* toFoxBin2Prg (v! IN ) Referencia al objeto principal
|
|
*---------------------------------------------------------------------------------------------------
|
|
Lparameters toMemVar, toEx As Exception, toFoxBin2Prg
|
|
DoDefault( @toMemVar, @toEx, @toFoxBin2Prg )
|
|
|
|
#If .F.
|
|
Local toMemVar As CL_MEMVAR Of 'FOXBIN2PRG.PRG'
|
|
Local toFoxBin2Prg As c_foxbin2prg Of 'FOXBIN2PRG.PRG'
|
|
#Endif
|
|
|
|
Local lnCodError, lnLen, lnHandle ;
|
|
, loLang As CL_LANG Of 'FOXBIN2PRG.PRG'
|
|
|
|
Private pnCols, pnRows, pnElement
|
|
Store 0 To pnCols, pnRows, pnElement
|
|
|
|
Try
|
|
With This As c_conversor_mem_a_prg Of 'FOXBIN2PRG.PRG'
|
|
lnHandle = -1
|
|
|
|
If toFoxBin2Prg.l_ProcessFiles Then
|
|
loLang = _Screen.o_FoxBin2Prg_Lang
|
|
Store 0 To lnCodError
|
|
|
|
.updateProgressbar( 'Analyzing MEM...', 1, 2, 1 )
|
|
|
|
*-- Verificación de archivo de macros válido
|
|
*IF FCOUNT() < 25 OR EMPTY(FIELD("RESNAME")) OR EMPTY(FIELD("SYSRES"))
|
|
* *ERROR 'Menu [' + (.c_InputFile) + '] is NOT VFP 9 Format! - Please convert to VFP 9 with MODIFY MENU ' + JUSTFNAME((.c_InputFile))
|
|
* ERROR (TEXTMERGE(loLang.C_MENU_NOT_IN_VFP9_FORMAT_LOC))
|
|
*ENDIF
|
|
|
|
*-- Header
|
|
C_FB2PRG_CODE = C_FB2PRG_CODE + toFoxBin2Prg.get_PROGRAM_HEADER()
|
|
|
|
toMemVar = Createobject('CL_MEMVAR')
|
|
toMemVar.get_DataFromMEM(.c_InputFile, @toFoxBin2Prg)
|
|
C_FB2PRG_CODE = C_FB2PRG_CODE + toMemVar.toText()
|
|
Endif
|
|
|
|
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()
|
|
|
|
|
|
*-- Genero el FK2
|
|
If toFoxBin2Prg.l_ProcessFiles Then
|
|
.updateProgressbar( 'Writing ' + toFoxBin2Prg.c_ME2 + '...', 2, 2, 1 )
|
|
Endif
|
|
|
|
If .l_Test
|
|
toMemVar = C_FB2PRG_CODE
|
|
Else
|
|
.write_OutputFile( (C_FB2PRG_CODE), .c_OutputFile, @toFoxBin2Prg )
|
|
Endif
|
|
Endwith && THIS
|
|
|
|
|
|
Catch To toEx
|
|
This.set_UserValue(@toEx)
|
|
|
|
If This.n_Debug > 0 And _vfp.StartMode = 0
|
|
Set Step On
|
|
Endif
|
|
|
|
Throw
|
|
|
|
Finally
|
|
*
|
|
Endtry
|
|
|
|
Return
|
|
Endproc
|
|
Enddefine
|
|
|
|
|
|
|
|
Define Class CL_CUS_BASE As Custom
|
|
*-- Propiedades (Se preservan: CONTROLCOUNT, CONTROLS, OBJECTS, PARENT, CLASS)
|
|
Hidden BaseClass, Top, Width, Classlib, ClassLibrary, Comment ;
|
|
, Height, HelpContextID, Left, Name ;
|
|
, ParentClass, Picture, Tag, WhatsThisHelpID
|
|
|
|
*-- Métodos (Se preservan: INIT, DESTROY, ERROR, ADDPROPERTY)
|
|
*HIDDEN ADDOBJECT, NEWOBJECT, READEXPRESSION, READMETHOD, REMOVEOBJECT ;
|
|
, RESETTODEFAULT, SAVEASCLASS, SHOWWHATSTHIS, WRITEEXPRESSION, WRITEMETHOD
|
|
|
|
_MemberData = [<VFPData>] ;
|
|
+ [<memberdata name="c_texterr" display="c_TextErr"/>] ;
|
|
+ [<memberdata name="n_debug" display="n_Debug"/>] ;
|
|
+ [<memberdata name="set_line" display="set_Line"/>] ;
|
|
+ [<memberdata name="analyzecodeblock" display="analyzeCodeBlock"/>] ;
|
|
+ [<memberdata name="filetypedescription" display="fileTypeDescription"/>] ;
|
|
+ [<memberdata name="get_absolutepath" display="get_AbsolutePath"/>] ;
|
|
+ [<memberdata name="get_separatedlineandcomment" display="get_SeparatedLineAndComment"/>] ;
|
|
+ [<memberdata name="totext" display="toText"/>] ;
|
|
+ [<memberdata name="writeerrorlog" display="writeErrorLog"/>] ;
|
|
+ [</VFPData>]
|
|
|
|
c_TextErr = ''
|
|
n_Debug = 0
|
|
|
|
|
|
Procedure Init
|
|
Set Deleted On
|
|
Set Date YMD
|
|
Set Hours To 24
|
|
Set Century On
|
|
Set Safety Off
|
|
Set TablePrompt Off
|
|
|
|
This.n_Debug = Iif(_vfp.StartMode=0, 1, 0)
|
|
Endproc
|
|
|
|
|
|
Procedure analyzeCodeBlock
|
|
Endproc
|
|
|
|
|
|
Procedure set_Line
|
|
*---------------------------------------------------------------------------------------------------
|
|
* PARÁMETROS: (v=Pasar por valor | @=Pasar por referencia) (!=Obligatorio | ?=Opcional) (IN/OUT)
|
|
* tcLine (!@ OUT) Contenido de la línea en análisis
|
|
* taCodeLines (!@ IN ) Array de líneas del programa analizado
|
|
* I (v! IN ) Número de línea en análisis
|
|
*---------------------------------------------------------------------------------------------------
|
|
Lparameters tcLine, taCodeLines, I
|
|
tcLine = Ltrim( taCodeLines(m.I), 0, Chr(9), ' ' )
|
|
Endproc
|
|
|
|
|
|
Procedure get_AbsolutePath
|
|
Lparameters tc_InputFile, tc_FullPath
|
|
|
|
*-- Ajusto la ruta si no es absoluta
|
|
tc_InputFile = Evl(tc_InputFile,'')
|
|
|
|
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
|
|
|
|
|
|
Procedure get_SeparatedLineAndComment
|
|
*---------------------------------------------------------------------------------------------------
|
|
* PARÁMETROS: (v=Pasar por valor | @=Pasar por referencia) (!=Obligatorio | ?=Opcional) (IN/OUT)
|
|
* tcLine (!@ IN/OUT) Línea a separar del comentario
|
|
* tcComment (@? OUT) Comentario
|
|
* tlDeepCommentAnalysis (v? IN ) Indica realizar un análisis profundo de comentarios (para detectar casos complejos de código con '&&' embebido)
|
|
*---------------------------------------------------------------------------------------------------
|
|
Lparameters tcLine As String, tcComment As String, tlDeepCommentAnalysis As Boolean
|
|
Local ln_AT_Cmt
|
|
tcComment = ''
|
|
ln_AT_Cmt = At( '&'+'&', tcLine)
|
|
|
|
If ln_AT_Cmt > 0
|
|
If tlDeepCommentAnalysis Then
|
|
Local laSeparador(3,3), lcSeparadoresIzq, lcSeparadoresDer, lcStr, lnAT_Amp, lnAT1, lnAT2, lnLen, I, X
|
|
|
|
lcStr = tcLine &&EVL(tcStr, [DEFINE BAR 2 OF OpciónAsub PROMPT "Opción A&]+[&2" &]+[& Comentario Opción A-2])
|
|
laSeparador(1,1) = '"'
|
|
laSeparador(1,2) = '"'
|
|
laSeparador(1,3) = 2
|
|
laSeparador(2,1) = "'"
|
|
laSeparador(2,2) = "'"
|
|
laSeparador(2,3) = 2
|
|
laSeparador(3,1) = '['
|
|
laSeparador(3,2) = ']'
|
|
laSeparador(3,3) = 1
|
|
lcSeparadoresIzq = laSeparador(1,1) + laSeparador(2,1) + laSeparador(3,1)
|
|
lcSeparadoresDer = laSeparador(1,2) + laSeparador(2,2) + laSeparador(3,2)
|
|
lnLen = Len(lcStr)
|
|
|
|
*-- Anular subcadenas para luego encontrar comentarios '&&' (y analizar solo si existe al menos un '&&')
|
|
X = 1
|
|
lnAT1 = At(laSeparador(m.X,1), lcStr)
|
|
|
|
*-- Funcionamiento:
|
|
*-- La anulación de subcadenas se hace comenzando desde la primer comilla doble ["], y luego se va
|
|
*-- cancelando hasta la siguiente. A partir de ahi, se busca carácter a carácter el siguiente separador
|
|
*-- izquierdo de cadena ( '"[ ), se busca su pareja derecha y se cancela el texto entre ambos.
|
|
*-- La anulación de subcadenas es temporal, solo para determinar la verdadera posición del comentario,
|
|
*-- por ejemplo, esto:
|
|
*-- DEFINE BAR 2 OF OpciónAsub PROMPT ""+var+'aa'+["bb]+"Opción A&&2" && Comentario Opción A-2
|
|
*-- se convierte temporalmente en esto:
|
|
*-- DEFINE BAR 2 OF OpciónAsub PROMPT XX+var+XXXX+XXXXX+XXXXXXXXXXXXX && Comentario Opción A-2
|
|
*-- lo que facilita encontrar el comentario '&&' real.
|
|
*-- Si se encuentra algún separador de cadena que no cierre, se genera un error 10 (Syntax Error).
|
|
If lnAT1 > 0 Then
|
|
For I = lnAT1+1 To lnLen
|
|
If m.X > 0 Then
|
|
lnAT2 = At(laSeparador(m.X,2), lcStr, laSeparador(m.X,3))
|
|
|
|
If lnAT2 > 0 Then
|
|
lcStr = Stuff(lcStr, lnAT1, lnAT2-lnAT1+1, Replicate('X',lnAT2-lnAT1+1))
|
|
Else
|
|
ln_AT_Cmt = At( '&'+'&', lcStr)
|
|
|
|
If ln_AT_Cmt = 0 Or ln_AT_Cmt < lnAT1
|
|
*-- No tiene comentario '&&' real, o sí lo tiene y además contiene un delimitador de cadena como parte del comentario
|
|
Exit
|
|
Else
|
|
Error 'Closing string delimiter <' + laSeparador(m.X,2) + '> not found: ' + tcLine
|
|
Endif
|
|
Endif
|
|
Endif
|
|
|
|
*-- Verifico si el carácter es un separador de cadenas: '"[
|
|
X = At( Substr(lcStr, m.I, 1), lcSeparadoresIzq)
|
|
|
|
If m.X > 0 Then
|
|
lnAT1 = At(laSeparador(m.X,1), lcStr)
|
|
Endif
|
|
Endfor
|
|
Endif
|
|
|
|
ln_AT_Cmt = At( '&'+'&', lcStr)
|
|
Endif && tlDeepCommentAnalysis
|
|
|
|
If ln_AT_Cmt > 0
|
|
tcComment = Ltrim( Substr( tcLine, ln_AT_Cmt + 2 ) )
|
|
tcLine = Rtrim( Left( tcLine, ln_AT_Cmt - 1 ), 0, Chr(9), ' ' ) && Quito TABS y espacios
|
|
Endif
|
|
|
|
Endif
|
|
|
|
Return (ln_AT_Cmt > 0)
|
|
Endproc
|
|
|
|
|
|
Procedure writeErrorLog
|
|
Lparameters tcText
|
|
|
|
Try
|
|
This.c_TextErr = This.c_TextErr + Evl(tcText,'') + CR_LF
|
|
Catch
|
|
Endtry
|
|
Endproc
|
|
|
|
|
|
Enddefine
|
|
|
|
|
|
|
|
Define Class CL_COL_BASE As Collection
|
|
#If .F.
|
|
Local This As CL_COL_BASE Of 'FOXBIN2PRG.PRG'
|
|
#Endif
|
|
|
|
*-- Propiedades (Se preservan: COUNT, KEYSORT, NAME)
|
|
**HIDDEN BASECLASS, CLASS, CLASSLIBRARY, COUNT, COMMENT ;
|
|
, PARENT, PARENTCLASS, TAG
|
|
|
|
_MemberData = [<VFPData>] ;
|
|
+ [<memberdata name="n_debug" display="n_Debug"/>] ;
|
|
+ [<memberdata name="_saved" display="_Saved"/>] ;
|
|
+ [<memberdata name="analyzecodeblock" display="analyzeCodeBlock"/>] ;
|
|
+ [<memberdata name="get_separatedlineandcomment" display="get_SeparatedLineAndComment"/>] ;
|
|
+ [<memberdata name="get_absolutepath" display="get_AbsolutePath"/>] ;
|
|
+ [<memberdata name="set_line" display="set_Line"/>] ;
|
|
+ [<memberdata name="totext" display="toText"/>] ;
|
|
+ [</VFPData>]
|
|
|
|
n_Debug = 0
|
|
_Saved = .F. && Indica si la información fue leida y guardada en las propiedades.
|
|
|
|
|
|
Procedure Init
|
|
Set Deleted On
|
|
Set Date YMD
|
|
Set Hours To 24
|
|
Set Century On
|
|
Set Safety Off
|
|
Set TablePrompt Off
|
|
|
|
This.n_Debug = Iif(_vfp.StartMode=0, 1, 0)
|
|
Endproc
|
|
|
|
|
|
Procedure analyzeCodeBlock
|
|
Endproc
|
|
|
|
|
|
Procedure set_Line
|
|
*---------------------------------------------------------------------------------------------------
|
|
* PARÁMETROS: (v=Pasar por valor | @=Pasar por referencia) (!=Obligatorio | ?=Opcional) (IN/OUT)
|
|
* tcLine (!@ OUT) Contenido de la línea en análisis
|
|
* taCodeLines (!@ IN ) Array de líneas del programa analizado
|
|
* I (v! IN ) Número de línea en análisis
|
|
*---------------------------------------------------------------------------------------------------
|
|
Lparameters tcLine, taCodeLines, I
|
|
tcLine = Ltrim( taCodeLines(m.I), 0, Chr(9), ' ' )
|
|
Endproc
|
|
|
|
|
|
Procedure get_AbsolutePath
|
|
Lparameters tc_InputFile, tc_FullPath
|
|
|
|
*-- Ajusto la ruta si no es absoluta
|
|
tc_InputFile = Evl(tc_InputFile,'')
|
|
|
|
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
|
|
|
|
|
|
Procedure get_SeparatedLineAndComment
|
|
*---------------------------------------------------------------------------------------------------
|
|
* PARÁMETROS: (v=Pasar por valor | @=Pasar por referencia) (!=Obligatorio | ?=Opcional) (IN/OUT)
|
|
* tcLine (!@ IN/OUT) Línea a separar del comentario
|
|
* tcComment (@? OUT) Comentario
|
|
* tlDeepCommentAnalysis (v? IN ) Indica realizar un análisis profundo de comentarios (para detectar casos complejos de código con '&&' embebido)
|
|
*---------------------------------------------------------------------------------------------------
|
|
Lparameters tcLine As String, tcComment As String, tlDeepCommentAnalysis As Boolean
|
|
Local ln_AT_Cmt
|
|
tcComment = ''
|
|
ln_AT_Cmt = At( '&'+'&', tcLine)
|
|
|
|
If ln_AT_Cmt > 0
|
|
If tlDeepCommentAnalysis Then
|
|
Local laSeparador(3,3), lcSeparadoresIzq, lcSeparadoresDer, lcStr, lnAT_Amp, lnAT1, lnAT2, lnLen, I, X
|
|
|
|
lcStr = tcLine &&EVL(tcStr, [DEFINE BAR 2 OF OpciónAsub PROMPT "Opción A&]+[&2" &]+[& Comentario Opción A-2])
|
|
laSeparador(1,1) = '"'
|
|
laSeparador(1,2) = '"'
|
|
laSeparador(1,3) = 2
|
|
laSeparador(2,1) = "'"
|
|
laSeparador(2,2) = "'"
|
|
laSeparador(2,3) = 2
|
|
laSeparador(3,1) = '['
|
|
laSeparador(3,2) = ']'
|
|
laSeparador(3,3) = 1
|
|
lcSeparadoresIzq = laSeparador(1,1) + laSeparador(2,1) + laSeparador(3,1)
|
|
lcSeparadoresDer = laSeparador(1,2) + laSeparador(2,2) + laSeparador(3,2)
|
|
lnLen = Len(lcStr)
|
|
|
|
*-- Anular subcadenas para luego encontrar comentarios '&&' (y analizar solo si existe al menos un '&&')
|
|
X = 1
|
|
lnAT1 = At(laSeparador(m.X,1), lcStr)
|
|
|
|
*-- Funcionamiento:
|
|
*-- La anulación de subcadenas se hace comenzando desde la primer comilla doble ["], y luego se va
|
|
*-- cancelando hasta la siguiente. A partir de ahi, se busca carácter a carácter el siguiente separador
|
|
*-- izquierdo de cadena ( '"[ ), se busca su pareja derecha y se cancela el texto entre ambos.
|
|
*-- La anulación de subcadenas es temporal, solo para determinar la verdadera posición del comentario,
|
|
*-- por ejemplo, esto:
|
|
*-- DEFINE BAR 2 OF OpciónAsub PROMPT ""+var+'aa'+["bb]+"Opción A&&2" && Comentario Opción A-2
|
|
*-- se convierte temporalmente en esto:
|
|
*-- DEFINE BAR 2 OF OpciónAsub PROMPT XX+var+XXXX+XXXXX+XXXXXXXXXXXXX && Comentario Opción A-2
|
|
*-- lo que facilita encontrar el comentario '&&' real.
|
|
*-- Si se encuentra algún separador de cadena que no cierre, se genera un error 10 (Syntax Error).
|
|
If lnAT1 > 0 Then
|
|
For I = lnAT1+1 To lnLen
|
|
If m.X > 0 Then
|
|
lnAT2 = At(laSeparador(m.X,2), lcStr, laSeparador(m.X,3))
|
|
|
|
If lnAT2 > 0 Then
|
|
lcStr = Stuff(lcStr, lnAT1, lnAT2-lnAT1+1, Replicate('X',lnAT2-lnAT1+1))
|
|
Else
|
|
ln_AT_Cmt = At( '&'+'&', lcStr)
|
|
|
|
If ln_AT_Cmt = 0 Or ln_AT_Cmt < lnAT1
|
|
*-- No tiene comentario '&&' real, o sí lo tiene y además contiene un delimitador de cadena como parte del comentario
|
|
Exit
|
|
Else
|
|
Error 'Closing string delimiter <' + laSeparador(m.X,2) + '> not found: ' + tcLine
|
|
Endif
|
|
Endif
|
|
Endif
|
|
|
|
*-- Verifico si el carácter es un separador de cadenas: '"[
|
|
X = At( Substr(lcStr, m.I, 1), lcSeparadoresIzq)
|
|
|
|
If m.X > 0 Then
|
|
lnAT1 = At(laSeparador(m.X,1), lcStr)
|
|
Endif
|
|
Endfor
|
|
Endif
|
|
|
|
ln_AT_Cmt = At( '&'+'&', lcStr)
|
|
Endif && tlDeepCommentAnalysis
|
|
|
|
If ln_AT_Cmt > 0
|
|
tcComment = Ltrim( Substr( tcLine, ln_AT_Cmt + 2 ) )
|
|
tcLine = Rtrim( Left( tcLine, ln_AT_Cmt - 1 ), 0, Chr(9), ' ' ) && Quito TABS y espacios
|
|
Endif
|
|
|
|
Endif
|
|
|
|
Return (ln_AT_Cmt > 0)
|
|
Endproc
|
|
|
|
|
|
Procedure toText
|
|
*---------------------------------------------------------------------------------------------------
|
|
* PARÁMETROS: (v=Pasar por valor | @=Pasar por referencia) (!=Obligatorio | ?=Opcional) (IN/OUT)
|
|
* taArray (@? OUT) Array de conexiones
|
|
* tnArray_Count (@? OUT) Cantidad de conexiones
|
|
*---------------------------------------------------------------------------------------------------
|
|
Endproc
|
|
Enddefine
|
|
|
|
|
|
|
|
Define Class CL_CLASSLIB As CL_CUS_BASE
|
|
#If .F.
|
|
Local This As CL_CLASSLIB Of 'FOXBIN2PRG.PRG'
|
|
#Endif
|
|
|
|
_MemberData = [<VFPData>] ;
|
|
+ [<memberdata name="add_ole" display="add_OLE"/>] ;
|
|
+ [<memberdata name="add_class" display="add_Class"/>] ;
|
|
+ [<memberdata name="existeobjetoole" display="existeObjetoOLE"/>] ;
|
|
+ [<memberdata name="_clases" display="_Clases"/>] ;
|
|
+ [<memberdata name="_clases_count" display="_Clases_Count"/>] ;
|
|
+ [<memberdata name="_externalclasses" display="_ExternalClasses"/>] ;
|
|
+ [<memberdata name="_externalclasses_count" display="_ExternalClasses_Count"/>] ;
|
|
+ [<memberdata name="_includefile" display="_IncludeFile"/>] ;
|
|
+ [<memberdata name="_comment" display="_Comment"/>] ;
|
|
+ [<memberdata name="_ole_objs" display="_Ole_Objs"/>] ;
|
|
+ [<memberdata name="_ole_objs" display="_Ole_Objs"/>] ;
|
|
+ [<memberdata name="_sourcefile" display="_SourceFile"/>] ;
|
|
+ [<memberdata name="_version" display="_Version"/>] ;
|
|
+ [</VFPData>]
|
|
|
|
|
|
Dimension _Ole_Objs[1], _Clases[1], _ExternalClasses(1,2)
|
|
_Version = 0
|
|
_SourceFile = ''
|
|
_ExternalClasses_Count = 0
|
|
_Ole_Obj_count = 0
|
|
_Clases_Count = 0
|
|
_includeFile = ''
|
|
_Comment = ''
|
|
|
|
|
|
|
|
Procedure add_OLE
|
|
Lparameters toOle
|
|
|
|
#If .F.
|
|
Local toOle As CL_OLE Of 'FOXBIN2PRG.PRG'
|
|
#Endif
|
|
|
|
With This As CL_CLASSLIB Of 'FOXBIN2PRG.PRG'
|
|
._Ole_Obj_count = ._Ole_Obj_count + 1
|
|
Dimension ._Ole_Objs( ._Ole_Obj_count )
|
|
._Ole_Objs( ._Ole_Obj_count ) = toOle
|
|
Endwith && THIS
|
|
Endproc
|
|
|
|
|
|
|
|
Procedure add_Class
|
|
Lparameters toClase
|
|
|
|
#If .F.
|
|
Local toClase As CL_CLASE Of 'FOXBIN2PRG.PRG'
|
|
#Endif
|
|
|
|
With This As CL_CLASSLIB Of 'FOXBIN2PRG.PRG'
|
|
._Clases_Count = ._Clases_Count + 1
|
|
Dimension ._Clases( ._Clases_Count )
|
|
._Clases( ._Clases_Count ) = toClase
|
|
Endwith && THIS
|
|
Endproc
|
|
|
|
|
|
|
|
Procedure existeObjetoOLE
|
|
*-- Ubico el objeto ole por su nombre (parent+objname), que no se repite.
|
|
Lparameters tcNombre, X
|
|
Local llExiste
|
|
|
|
With This As CL_CLASSLIB Of 'FOXBIN2PRG.PRG'
|
|
For X = 1 To ._Ole_Obj_count
|
|
If Lower(._Ole_Objs(m.X)._Nombre) == Lower(tcNombre)
|
|
llExiste = .T.
|
|
Exit
|
|
Endif
|
|
Endfor
|
|
Endwith && THIS
|
|
|
|
Return llExiste
|
|
Endproc
|
|
|
|
|
|
Enddefine
|
|
|
|
|
|
|
|
Define Class CL_OLE As CL_CUS_BASE
|
|
#If .F.
|
|
Local This As CL_OLE Of 'FOXBIN2PRG.PRG'
|
|
#Endif
|
|
|
|
_MemberData = [<VFPData>] ;
|
|
+ [<memberdata name="_checksum" display="_CheckSum"/>] ;
|
|
+ [<memberdata name="_nombre" display="_Nombre"/>] ;
|
|
+ [<memberdata name="_objname" display="_ObjName"/>] ;
|
|
+ [<memberdata name="_parent" display="_Parent"/>] ;
|
|
+ [<memberdata name="_value" display="_Value"/>] ;
|
|
+ [</VFPData>]
|
|
|
|
_Nombre = ''
|
|
_Parent = ''
|
|
_ObjName = ''
|
|
_CheckSum = ''
|
|
_Value = ''
|
|
Enddefine
|
|
|
|
|
|
|
|
Define Class CL_CLASE As CL_CUS_BASE
|
|
#If .F.
|
|
Local This As CL_CLASE Of 'FOXBIN2PRG.PRG'
|
|
#Endif
|
|
|
|
_MemberData = [<VFPData>] ;
|
|
+ [<memberdata name="add_pathobjname" display="add_PathObjName"/>] ;
|
|
+ [<memberdata name="add_procedure" display="add_Procedure"/>] ;
|
|
+ [<memberdata name="add_property" display="add_Property"/>] ;
|
|
+ [<memberdata name="add_object" display="add_Object"/>] ;
|
|
+ [<memberdata name="c_texterr" display="c_TextErr"/>] ;
|
|
+ [<memberdata name="l_objectmetadatainheader" display="l_ObjectMetadataInHeader"/>] ;
|
|
+ [<memberdata name="_addobject_count" display="_AddObject_Count"/>] ;
|
|
+ [<memberdata name="_addobjects" display="_AddObjects"/>] ;
|
|
+ [<memberdata name="_apathobjname_count" display="_aPathObjName_Count"/>] ;
|
|
+ [<memberdata name="_apathobjnames" display="_aPathObjNames"/>] ;
|
|
+ [<memberdata name="_aprocnames" display="_aProcNames"/>] ;
|
|
+ [<memberdata name="_baseclass" display="_BaseClass"/>] ;
|
|
+ [<memberdata name="_checked" display="_Checked"/>] ;
|
|
+ [<memberdata name="_class" display="_Class"/>] ;
|
|
+ [<memberdata name="_classicon" display="_ClassIcon"/>] ;
|
|
+ [<memberdata name="_classloc" display="_ClassLoc"/>] ;
|
|
+ [<memberdata name="_comentario" display="_Comentario"/>] ;
|
|
+ [<memberdata name="_defined_pam" display="_Defined_PAM"/>] ;
|
|
+ [<memberdata name="_definicion" display="_Definicion"/>] ;
|
|
+ [<memberdata name="_fin" display="_Fin"/>] ;
|
|
+ [<memberdata name="_fin_cab" display="_Fin_Cab"/>] ;
|
|
+ [<memberdata name="_fin_cuerpo" display="_Fin_Cuerpo"/>] ;
|
|
+ [<memberdata name="_hiddenmethods" display="_HiddenMethods"/>] ;
|
|
+ [<memberdata name="_hiddenprops" display="_HiddenProps"/>] ;
|
|
+ [<memberdata name="_includefile" display="_IncludeFile"/>] ;
|
|
+ [<memberdata name="_inicio" display="_Inicio"/>] ;
|
|
+ [<memberdata name="_ini_cab" display="_Ini_Cab"/>] ;
|
|
+ [<memberdata name="_ini_cuerpo" display="_Ini_Cuerpo"/>] ;
|
|
+ [<memberdata name="_metadata" display="_MetaData"/>] ;
|
|
+ [<memberdata name="_nombre" display="_Nombre"/>] ;
|
|
+ [<memberdata name="_objname" display="_ObjName"/>] ;
|
|
+ [<memberdata name="_ole" display="_Ole"/>] ;
|
|
+ [<memberdata name="_ole2" display="_Ole2"/>] ;
|
|
+ [<memberdata name="_olepublic" display="_OlePublic"/>] ;
|
|
+ [<memberdata name="_parent" display="_Parent"/>] ;
|
|
+ [<memberdata name="_procedures" display="_Procedures"/>] ;
|
|
+ [<memberdata name="_procedure_count" display="_Procedure_Count"/>] ;
|
|
+ [<memberdata name="_projectclassicon" display="_ProjectClassIcon"/>] ;
|
|
+ [<memberdata name="_protectedmethods" display="_ProtectedMethods"/>] ;
|
|
+ [<memberdata name="_protectedprops" display="_ProtectedProps"/>] ;
|
|
+ [<memberdata name="_props" display="_Props"/>] ;
|
|
+ [<memberdata name="_prop_count" display="_Prop_Count"/>] ;
|
|
+ [<memberdata name="_scale" display="_Scale"/>] ;
|
|
+ [<memberdata name="_timestamp" display="_TimeStamp"/>] ;
|
|
+ [<memberdata name="_uniqueid" display="_UniqueID"/>] ;
|
|
+ [<memberdata name="_properties" display="_PROPERTIES"/>] ;
|
|
+ [<memberdata name="_protected" display="_PROTECTED"/>] ;
|
|
+ [<memberdata name="_methods" display="_METHODS"/>] ;
|
|
+ [<memberdata name="_reserved1" display="_RESERVED1"/>] ;
|
|
+ [<memberdata name="_reserved2" display="_RESERVED2"/>] ;
|
|
+ [<memberdata name="_reserved3" display="_RESERVED3"/>] ;
|
|
+ [<memberdata name="_reserved4" display="_RESERVED4"/>] ;
|
|
+ [<memberdata name="_reserved5" display="_RESERVED5"/>] ;
|
|
+ [<memberdata name="_reserved6" display="_RESERVED6"/>] ;
|
|
+ [<memberdata name="_reserved7" display="_RESERVED7"/>] ;
|
|
+ [<memberdata name="_reserved8" display="_RESERVED8"/>] ;
|
|
+ [<memberdata name="_user" display="_USER"/>] ;
|
|
+ [</VFPData>]
|
|
|
|
|
|
Dimension _Props[1,2], _AddObjects[1], _Procedures[1], _aProcNames[1], _aPathObjNames[1,2]
|
|
l_ObjectMetadataInHeader = .F.
|
|
c_TextErr = ''
|
|
_Nombre = ''
|
|
_ObjName = ''
|
|
_Parent = ''
|
|
_Checked = .F. && Solo para Clases Externas: Permite saber si la clase fue checkeada contra la Clase Externa.
|
|
_Definicion = ''
|
|
_Class = ''
|
|
_ClassLoc = ''
|
|
_OlePublic = ''
|
|
_Ole = ''
|
|
_Ole2 = ''
|
|
_UniqueID = ''
|
|
_Comentario = ''
|
|
_ClassIcon = ''
|
|
_ProjectClassIcon = ''
|
|
_Inicio = 0
|
|
_Fin = 0
|
|
_Ini_Cab = 0
|
|
_Fin_Cab = 0
|
|
_Ini_Cuerpo = 0
|
|
_Fin_Cuerpo = 0
|
|
_Prop_Count = 0
|
|
_HiddenProps = ''
|
|
_ProtectedProps = ''
|
|
_HiddenMethods = ''
|
|
_ProtectedMethods = ''
|
|
_MetaData = ''
|
|
_BaseClass = ''
|
|
_TimeStamp = 0
|
|
_Scale = ''
|
|
_Defined_PAM = ''
|
|
_includeFile = ''
|
|
_AddObject_Count = 0
|
|
_aPathObjName_Count = 0
|
|
_Procedure_Count = 0
|
|
_PROPERTIES = ''
|
|
_PROTECTED = ''
|
|
_METHODS = ''
|
|
_RESERVED1 = ''
|
|
_RESERVED2 = ''
|
|
_RESERVED3 = ''
|
|
_RESERVED4 = ''
|
|
_RESERVED5 = ''
|
|
_RESERVED6 = ''
|
|
_RESERVED7 = ''
|
|
_RESERVED8 = ''
|
|
_User = ''
|
|
|
|
|
|
Procedure add_PathObjName
|
|
Lparameters tcPathObjName, I
|
|
|
|
With This As CL_CLASE Of 'FOXBIN2PRG.PRG'
|
|
._aPathObjName_Count = ._aPathObjName_Count + 1
|
|
Dimension ._aPathObjNames(._aPathObjName_Count,2)
|
|
._aPathObjNames(._aPathObjName_Count,1) = tcPathObjName
|
|
._aPathObjNames(._aPathObjName_Count,2) = m.I
|
|
Endwith
|
|
|
|
Return
|
|
Endproc
|
|
|
|
|
|
Procedure add_Procedure
|
|
Lparameters toProcedure
|
|
|
|
#If .F.
|
|
Local toProcedure As CL_PROCEDURE Of 'FOXBIN2PRG.PRG'
|
|
#Endif
|
|
|
|
With This As CL_CLASE Of 'FOXBIN2PRG.PRG'
|
|
*-- Verificación de Procedure repetido
|
|
If ._Procedure_Count > 0 And Ascan( ._aProcNames, toProcedure._Nombre, 1, 0, 0, 1+2+4 ) > 0 Then
|
|
.writeErrorLog( '* Duplicated Method "' + toProcedure._Nombre + '" of class "' ;
|
|
+ ._Nombre + '" @line ' + Transform(toProcedure._Inicio) )
|
|
Endif
|
|
|
|
._Procedure_Count = ._Procedure_Count + 1
|
|
Dimension ._Procedures( ._Procedure_Count )
|
|
Dimension ._aProcNames( ._Procedure_Count )
|
|
._Procedures( ._Procedure_Count ) = toProcedure
|
|
._aProcNames( ._Procedure_Count ) = toProcedure._Nombre
|
|
Endwith && THIS
|
|
Endproc
|
|
|
|
|
|
Procedure add_Property
|
|
Lparameters tcProperty As String, tcValue As String, tcComment As String
|
|
|
|
With This As CL_CLASE Of 'FOXBIN2PRG.PRG'
|
|
._Prop_Count = ._Prop_Count + 1
|
|
Dimension ._Props( ._Prop_Count, 3 )
|
|
._Props( ._Prop_Count, 1 ) = tcProperty
|
|
._Props( ._Prop_Count, 2 ) = tcValue
|
|
._Props( ._Prop_Count, 3 ) = tcComment
|
|
Endwith && THIS
|
|
Endproc
|
|
|
|
|
|
Procedure add_Object
|
|
Lparameters toObjeto
|
|
|
|
#If .F.
|
|
Local toObjeto As CL_OBJETO Of 'FOXBIN2PRG.PRG'
|
|
#Endif
|
|
|
|
With This As CL_CLASE Of 'FOXBIN2PRG.PRG'
|
|
._AddObject_Count = ._AddObject_Count + 1
|
|
Dimension ._AddObjects( ._AddObject_Count )
|
|
._AddObjects( ._AddObject_Count ) = toObjeto
|
|
Endwith && THIS
|
|
Endproc
|
|
|
|
|
|
Enddefine
|
|
|
|
|
|
|
|
Define Class CL_PROCEDURE As CL_CUS_BASE
|
|
#If .F.
|
|
Local This As CL_PROCEDURE Of 'FOXBIN2PRG.PRG'
|
|
#Endif
|
|
|
|
_MemberData = [<VFPData>] ;
|
|
+ [<memberdata name="add_line" display="add_Line"/>] ;
|
|
+ [<memberdata name="_comentario" display="_Comentario"/>] ;
|
|
+ [<memberdata name="_inicio" display="_Inicio"/>] ;
|
|
+ [<memberdata name="_nombre" display="_Nombre"/>] ;
|
|
+ [<memberdata name="_procline_count" display="_ProcLine_Count"/>] ;
|
|
+ [<memberdata name="_proclines" display="_ProcLines"/>] ;
|
|
+ [<memberdata name="_proctype" display="_ProcType"/>] ;
|
|
+ [</VFPData>]
|
|
|
|
Dimension _ProcLines[1]
|
|
_Nombre = ''
|
|
_ProcType = ''
|
|
_Comentario = ''
|
|
_ProcLine_Count = 0
|
|
_Inicio = 0
|
|
|
|
|
|
|
|
Procedure add_Line
|
|
Lparameters tcLine As String
|
|
|
|
With This As CL_CLASE Of 'FOXBIN2PRG.PRG'
|
|
._ProcLine_Count = ._ProcLine_Count + 1
|
|
Dimension ._ProcLines( ._ProcLine_Count )
|
|
._ProcLines( ._ProcLine_Count ) = tcLine
|
|
Endwith && THIS
|
|
Endproc
|
|
|
|
|
|
Enddefine
|
|
|
|
|
|
|
|
Define Class CL_OBJETO As CL_CUS_BASE
|
|
#If .F.
|
|
Local This As CL_OBJETO Of 'FOXBIN2PRG.PRG'
|
|
#Endif
|
|
|
|
_MemberData = [<VFPData>] ;
|
|
+ [<memberdata name="add_procedure" display="add_Procedure"/>] ;
|
|
+ [<memberdata name="add_property" display="add_Property"/>] ;
|
|
+ [<memberdata name="c_texterr" display="c_TextErr"/>] ;
|
|
+ [<memberdata name="_aprocnames" display="_aProcNames"/>] ;
|
|
+ [<memberdata name="_baseclass" display="_BaseClass"/>] ;
|
|
+ [<memberdata name="_class" display="_Class"/>] ;
|
|
+ [<memberdata name="_classlib" display="_ClassLib"/>] ;
|
|
+ [<memberdata name="_nombre" display="_Nombre"/>] ;
|
|
+ [<memberdata name="_objname" display="_ObjName"/>] ;
|
|
+ [<memberdata name="_ole" display="_Ole"/>] ;
|
|
+ [<memberdata name="_ole2" display="_Ole2"/>] ;
|
|
+ [<memberdata name="_parent" display="_Parent"/>] ;
|
|
+ [<memberdata name="_writeorder" display="_WriteOrder"/>] ;
|
|
+ [<memberdata name="_procedures" display="_Procedures"/>] ;
|
|
+ [<memberdata name="_procedure_count" display="_Procedure_Count"/>] ;
|
|
+ [<memberdata name="_props" display="_Props"/>] ;
|
|
+ [<memberdata name="_prop_count" display="_Prop_Count"/>] ;
|
|
+ [<memberdata name="_timestamp" display="_TimeStamp"/>] ;
|
|
+ [<memberdata name="_uniqueid" display="_UniqueID"/>] ;
|
|
+ [<memberdata name="_user" display="_User"/>] ;
|
|
+ [<memberdata name="_zorder" display="_ZOrder"/>] ;
|
|
+ [</VFPData>]
|
|
|
|
Dimension _Props[1,1], _Procedures[1], _aProcNames[1]
|
|
c_TextErr = ''
|
|
_Nombre = ''
|
|
_ObjName = ''
|
|
_Parent = ''
|
|
_Class = ''
|
|
_ClassLib = ''
|
|
_BaseClass = ''
|
|
_UniqueID = ''
|
|
_TimeStamp = 0
|
|
_Ole = ''
|
|
_Ole2 = ''
|
|
_Prop_Count = 0
|
|
_Procedure_Count = 0
|
|
_User = ''
|
|
_WriteOrder = 0
|
|
_ZOrder = 0
|
|
|
|
|
|
|
|
Procedure add_Procedure
|
|
Lparameters toProcedure
|
|
|
|
#If .F.
|
|
Local toProcedure As CL_PROCEDURE Of 'FOXBIN2PRG.PRG'
|
|
#Endif
|
|
|
|
With This As CL_OBJETO Of 'FOXBIN2PRG.PRG'
|
|
If '.' $ ._Nombre
|
|
toProcedure._Nombre = Substr( toProcedure._Nombre, At( '.', toProcedure._Nombre, Occurs( '.', ._Nombre) ) + 1 )
|
|
Endif
|
|
|
|
*-- Verificación de Procedure repetido
|
|
If ._Procedure_Count > 0 And Ascan( ._aProcNames, toProcedure._Nombre, 1, 0, 0, 1+2+4 ) > 0 Then
|
|
.writeErrorLog( '* Duplicated Method "' + toProcedure._Nombre + '" of class.object "' ;
|
|
+ ._Nombre + '" @line ' + Transform(toProcedure._Inicio) )
|
|
Endif
|
|
|
|
._Procedure_Count = ._Procedure_Count + 1
|
|
Dimension ._Procedures( ._Procedure_Count )
|
|
Dimension ._aProcNames( ._Procedure_Count )
|
|
._Procedures( ._Procedure_Count ) = toProcedure
|
|
._aProcNames( ._Procedure_Count ) = toProcedure._Nombre
|
|
Endwith && THIS
|
|
Endproc
|
|
|
|
|
|
|
|
Procedure add_Property
|
|
Lparameters tcProperty As String, tcValue As String
|
|
|
|
With This As CL_OBJETO Of 'FOXBIN2PRG.PRG'
|
|
._Prop_Count = ._Prop_Count + 1
|
|
Dimension ._Props( ._Prop_Count, 2 )
|
|
._Props( ._Prop_Count, 1 ) = tcProperty
|
|
._Props( ._Prop_Count, 2 ) = tcValue
|
|
Endwith && THIS
|
|
Endproc
|
|
|
|
|
|
Enddefine
|
|
|
|
|
|
|
|
Define Class CL_REPORT As CL_COL_BASE
|
|
#If .F.
|
|
Local This As CL_REPORT Of 'FOXBIN2PRG.PRG'
|
|
#Endif
|
|
|
|
_MemberData = [<VFPData>] ;
|
|
+ [<memberdata name="_timestamp" display="_TimeStamp"/>] ;
|
|
+ [<memberdata name="_version" display="_Version"/>] ;
|
|
+ [<memberdata name="_sourcefile" display="_SourceFile"/>] ;
|
|
+ [</VFPData>]
|
|
|
|
*-- Report.Info
|
|
_TimeStamp = 0
|
|
_Version = ''
|
|
_SourceFile = ''
|
|
|
|
|
|
Enddefine
|
|
|
|
|
|
|
|
Define Class CL_PROJECT As CL_COL_BASE
|
|
#If .F.
|
|
Local This As CL_PROJECT Of 'FOXBIN2PRG.PRG'
|
|
#Endif
|
|
|
|
_MemberData = [<VFPData>] ;
|
|
+ [<memberdata name="c_inputfile" display="c_InputFile"/>] ;
|
|
+ [<memberdata name="_cmntstyle" display="_CmntStyle"/>] ;
|
|
+ [<memberdata name="_debug" display="_Debug"/>] ;
|
|
+ [<memberdata name="_encrypted" display="_Encrypted"/>] ;
|
|
+ [<memberdata name="_homedir" display="_HomeDir"/>] ;
|
|
+ [<memberdata name="_icon" display="_Icon"/>] ;
|
|
+ [<memberdata name="_mainprog" display="_MainProg"/>] ;
|
|
+ [<memberdata name="_nologo" display="_NoLogo"/>] ;
|
|
+ [<memberdata name="_objrev" display="_ObjRev"/>] ;
|
|
+ [<memberdata name="_projecthookclass" display="_ProjectHookClass"/>] ;
|
|
+ [<memberdata name="_projecthooklibrary" display="_ProjectHookLibrary"/>] ;
|
|
+ [<memberdata name="_savecode" display="_SaveCode"/>] ;
|
|
+ [<memberdata name="_serverinfo" display="_ServerInfo"/>] ;
|
|
+ [<memberdata name="_serverhead" display="_ServerHead"/>] ;
|
|
+ [<memberdata name="_sourcefile" display="_SourceFile"/>] ;
|
|
+ [<memberdata name="_timestamp" display="_TimeStamp"/>] ;
|
|
+ [<memberdata name="_version" display="_Version"/>] ;
|
|
+ [<memberdata name="_sccdata" display="_SccData"/>] ;
|
|
+ [<memberdata name="_address" display="_Address"/>] ;
|
|
+ [<memberdata name="_author" display="_Author"/>] ;
|
|
+ [<memberdata name="_company" display="_Company"/>] ;
|
|
+ [<memberdata name="_city" display="_City"/>] ;
|
|
+ [<memberdata name="_state" display="_State"/>] ;
|
|
+ [<memberdata name="_postalcode" display="_PostalCode"/>] ;
|
|
+ [<memberdata name="_country" display="_Country"/>] ;
|
|
+ [<memberdata name="_comments" display="_Comments"/>] ;
|
|
+ [<memberdata name="_companyname" display="_CompanyName"/>] ;
|
|
+ [<memberdata name="_filedescription" display="_FileDescription"/>] ;
|
|
+ [<memberdata name="_legalcopyright" display="_LegalCopyright"/>] ;
|
|
+ [<memberdata name="_legaltrademark" display="_LegalTrademark"/>] ;
|
|
+ [<memberdata name="_productname" display="_ProductName"/>] ;
|
|
+ [<memberdata name="_majorver" display="_MajorVer"/>] ;
|
|
+ [<memberdata name="_minorver" display="_MinorVer"/>] ;
|
|
+ [<memberdata name="_revision" display="_Revision"/>] ;
|
|
+ [<memberdata name="_languageid" display="_LanguageID"/>] ;
|
|
+ [<memberdata name="_autoincrement" display="_AutoIncrement"/>] ;
|
|
+ [<memberdata name="_user" display="_User"/>] ;
|
|
+ [<memberdata name="decode_specialcodes_cr_lf" display="decode_SpecialCodes_CR_LF"/>] ;
|
|
+ [<memberdata name="encode_specialcodes_cr_lf" display="encode_SpecialCodes_CR_LF"/>] ;
|
|
+ [<memberdata name="getformatteddeviceinfotext" display="getFormattedDeviceInfoText"/>] ;
|
|
+ [<memberdata name="getfilesnotfound" display="getFilesNotFound"/>] ;
|
|
+ [<memberdata name="parsedeviceinfo" display="parseDeviceInfo"/>] ;
|
|
+ [<memberdata name="parsenullterminatedvalue" display="parseNullTerminatedValue"/>] ;
|
|
+ [<memberdata name="setparsedinfoline" display="setParsedInfoLine"/>] ;
|
|
+ [<memberdata name="setparsedprojinfoline" display="setParsedProjInfoLine"/>] ;
|
|
+ [<memberdata name="getrowdeviceinfo" display="getRowDeviceInfo"/>] ;
|
|
+ [</VFPData>]
|
|
|
|
|
|
c_InputFile = ''
|
|
|
|
*-- Proj.Info
|
|
_CmntStyle = 1
|
|
_Debug = .F.
|
|
_Encrypted = .F.
|
|
_HomeDir = ''
|
|
_Icon = ''
|
|
_ID = ''
|
|
_MainProg = ''
|
|
_NoLogo = .F.
|
|
_ObjRev = 0
|
|
_ProjectHookClass = ''
|
|
_ProjectHookLibrary = ''
|
|
_SaveCode = .T.
|
|
_ServerHead = Null
|
|
_ServerInfo = ''
|
|
_SourceFile = ''
|
|
_TimeStamp = 0
|
|
_Version = ''
|
|
_SccData = ''
|
|
_User = ''
|
|
|
|
*-- Dev.info
|
|
_Author = ''
|
|
_Company = ''
|
|
_Address = ''
|
|
_City = ''
|
|
_State = ''
|
|
_PostalCode = ''
|
|
_Country = ''
|
|
|
|
_Comments = ''
|
|
_CompanyName = ''
|
|
_FileDescription = ''
|
|
_LegalCopyright = ''
|
|
_LegalTrademark = ''
|
|
_ProductName = ''
|
|
_MajorVer = ''
|
|
_MinorVer = ''
|
|
_Revision = ''
|
|
_LanguageID = ''
|
|
_AutoIncrement = ''
|
|
|
|
|
|
|
|
Procedure Init
|
|
DoDefault()
|
|
This._ServerHead = Createobject('CL_PROJ_SRV_HEAD')
|
|
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 encode_SpecialCodes_CR_LF
|
|
*---------------------------------------------------------------------------------------------------
|
|
* PARÁMETROS: (v=Pasar por valor | @=Pasar por referencia) (!=Obligatorio | ?=Opcional) (IN/OUT)
|
|
* tcText (!@ IN ) Codifica los caracteres ASCII 10 y 13 de CHR(nCode) a {nCode}
|
|
*---------------------------------------------------------------------------------------------------
|
|
Lparameters tcText
|
|
tcText = Strtran( Strtran( tcText, Chr(10), '{10}' ), Chr(13), '{13}' )
|
|
Return tcText
|
|
Endproc
|
|
|
|
|
|
|
|
Procedure setParsedProjInfoLine
|
|
Lparameters tcProjInfoLine
|
|
This.setParsedInfoLine( This, tcProjInfoLine )
|
|
Endproc
|
|
|
|
|
|
|
|
Procedure setParsedInfoLine
|
|
Lparameters toObject, tcInfoLine
|
|
|
|
Local lcAsignacion, lcCurDir, lcValue, loEx As Exception
|
|
|
|
Try
|
|
lcCurDir = Addbs(This._HomeDir)
|
|
If Left(tcInfoLine,1) == '.'
|
|
lcAsignacion = 'toObject' + tcInfoLine
|
|
Else
|
|
lcAsignacion = 'toObject.' + tcInfoLine
|
|
Endif
|
|
|
|
lcValue = Getwordnum(lcAsignacion, 2, '=')
|
|
|
|
If Type(lcValue) = "C" Then
|
|
lcAsignacion = Getwordnum(lcAsignacion, 1, '=') + '= THIS.encode_SpecialCodes_CR_LF(' + lcValue + ')'
|
|
Endif
|
|
|
|
&lcAsignacion.
|
|
|
|
Catch To loEx
|
|
loEx.UserValue = loEx.UserValue + 'lcAsignacion = [' + Transform(lcAsignacion) + ']' + CR_LF
|
|
Throw
|
|
Endtry
|
|
|
|
Return
|
|
Endproc
|
|
|
|
|
|
|
|
Procedure parseNullTerminatedValue
|
|
Lparameters tcDevInfo, tnPos, tnLen
|
|
Local lcValue, lnNullPos
|
|
lcStr = Substr( tcDevInfo, tnPos, tnLen )
|
|
lnNullPos = At(Chr(0), lcStr )
|
|
If lnNullPos = 0
|
|
lcValue = Chrtran( Left( lcStr, tnLen ), ['], ["] )
|
|
Else
|
|
lcValue = Chrtran( Left( lcStr, Min(tnLen, lnNullPos - 1 ) ), ['], ["] )
|
|
Endif
|
|
lcValue = This.encode_SpecialCodes_CR_LF(lcValue)
|
|
Return lcValue
|
|
Endproc
|
|
|
|
|
|
|
|
Procedure parseDeviceInfo
|
|
Lparameters tcDevInfo
|
|
|
|
Try
|
|
With This As CL_PROJECT Of "FOXBIN2PRG.PRG"
|
|
._Author = .parseNullTerminatedValue( @tcDevInfo, 1, 45 )
|
|
._Company = .parseNullTerminatedValue( @tcDevInfo, 47, 45 )
|
|
._Address = .parseNullTerminatedValue( @tcDevInfo, 93, 45 )
|
|
._City = .parseNullTerminatedValue( @tcDevInfo, 139, 20 )
|
|
._State = .parseNullTerminatedValue( @tcDevInfo, 160, 5 )
|
|
._PostalCode = .parseNullTerminatedValue( @tcDevInfo, 166, 10 )
|
|
._Country = .parseNullTerminatedValue( @tcDevInfo, 177, 45 )
|
|
*--
|
|
._Comments = .parseNullTerminatedValue( @tcDevInfo, 223, 254 )
|
|
._CompanyName = .parseNullTerminatedValue( @tcDevInfo, 478, 254 )
|
|
._FileDescription = .parseNullTerminatedValue( @tcDevInfo, 733, 254 )
|
|
._LegalCopyright = .parseNullTerminatedValue( @tcDevInfo, 988, 254 )
|
|
._LegalTrademark = .parseNullTerminatedValue( @tcDevInfo, 1243, 254 )
|
|
._ProductName = .parseNullTerminatedValue( @tcDevInfo, 1498, 254 )
|
|
._MajorVer = .parseNullTerminatedValue( @tcDevInfo, 1753, 4 )
|
|
._MinorVer = .parseNullTerminatedValue( @tcDevInfo, 1758, 4 )
|
|
._Revision = .parseNullTerminatedValue( @tcDevInfo, 1763, 4 )
|
|
._LanguageID = .parseNullTerminatedValue( @tcDevInfo, 1768, 19 )
|
|
*._AutoIncrement = IIF( SUBSTR( tcDevInfo, 1788, 1 ) = CHR(1), '1', '0' )
|
|
._AutoIncrement = Transform(Asc(Substr(tcDevInfo, 1788, 1))) && Proposed by Doug Hennig
|
|
Endwith && THIS
|
|
|
|
Catch To loEx
|
|
If This.n_Debug > 0 And _vfp.StartMode = 0
|
|
Set Step On
|
|
Endif
|
|
|
|
Throw
|
|
|
|
Endtry
|
|
|
|
Endproc
|
|
|
|
|
|
|
|
Procedure getRowDeviceInfo
|
|
Lparameters tcDevInfo
|
|
|
|
Try
|
|
If Vartype(tcDevInfo) # 'C' Or Len(tcDevInfo) = 0
|
|
tcDevInfo = Replicate( Chr(0), 1795 )
|
|
Endif
|
|
|
|
With This As CL_PROJECT Of "FOXBIN2PRG.PRG"
|
|
tcDevInfo = Stuff( tcDevInfo, 1, Len(._Author), ._Author)
|
|
tcDevInfo = Stuff( tcDevInfo, 47, Len(._Company), ._Company)
|
|
tcDevInfo = Stuff( tcDevInfo, 93, Len(._Address), ._Address)
|
|
tcDevInfo = Stuff( tcDevInfo, 139, Len(._City), ._City)
|
|
tcDevInfo = Stuff( tcDevInfo, 160, Len(._State), ._State)
|
|
tcDevInfo = Stuff( tcDevInfo, 166, Len(._PostalCode), ._PostalCode)
|
|
tcDevInfo = Stuff( tcDevInfo, 177, Len(._Country), ._Country)
|
|
tcDevInfo = Stuff( tcDevInfo, 223, Len(._Comments), ._Comments)
|
|
tcDevInfo = Stuff( tcDevInfo, 478, Len(._CompanyName), ._CompanyName)
|
|
tcDevInfo = Stuff( tcDevInfo, 733, Len(._FileDescription), ._FileDescription)
|
|
tcDevInfo = Stuff( tcDevInfo, 988, Len(._LegalCopyright), ._LegalCopyright)
|
|
tcDevInfo = Stuff( tcDevInfo, 1243, Len(._LegalTrademark), ._LegalTrademark)
|
|
tcDevInfo = Stuff( tcDevInfo, 1498, Len(._ProductName), ._ProductName)
|
|
tcDevInfo = Stuff( tcDevInfo, 1753, Len(._MajorVer), ._MajorVer)
|
|
tcDevInfo = Stuff( tcDevInfo, 1758, Len(._MinorVer), ._MinorVer)
|
|
tcDevInfo = Stuff( tcDevInfo, 1763, Len(._Revision), ._Revision)
|
|
tcDevInfo = Stuff( tcDevInfo, 1768, Len(._LanguageID), ._LanguageID)
|
|
tcDevInfo = Stuff( tcDevInfo, 1788, 1, Chr(Val(._AutoIncrement)))
|
|
tcDevInfo = Stuff( tcDevInfo, 1792, 1, Chr(1))
|
|
Endwith && THIS
|
|
|
|
Catch To loEx
|
|
lnCodError = loEx.ErrorNo
|
|
|
|
If This.n_Debug > 0 And _vfp.StartMode = 0
|
|
Set Step On
|
|
Endif
|
|
|
|
Throw
|
|
|
|
Endtry
|
|
|
|
Return tcDevInfo
|
|
Endproc
|
|
|
|
|
|
|
|
Procedure getFormattedDeviceInfoText
|
|
Try
|
|
Local lcText
|
|
lcText = ''
|
|
|
|
With This As CL_PROJECT Of "FOXBIN2PRG.PRG"
|
|
TEXT TO lcText ADDITIVE TEXTMERGE NOSHOW FLAGS 1+2 PRETEXT 1+2
|
|
<<C_DEVINFO_I>>
|
|
_Author = "<<._Author>>"
|
|
_Company = "<<._Company>>"
|
|
_Address = "<<._Address>>"
|
|
_City = "<<._City>>"
|
|
_State = "<<._State>>"
|
|
_PostalCode = "<<._PostalCode>>"
|
|
_Country = "<<._Country>>"
|
|
*--
|
|
_Comments = "<<._Comments>>"
|
|
_CompanyName = "<<._CompanyName>>"
|
|
_FileDescription = "<<._FileDescription>>"
|
|
_LegalCopyright = "<<._LegalCopyright>>"
|
|
_LegalTrademark = "<<._LegalTrademark>>"
|
|
_ProductName = "<<._ProductName>>"
|
|
_MajorVer = "<<._MajorVer>>"
|
|
_MinorVer = "<<._MinorVer>>"
|
|
_Revision = "<<._Revision>>"
|
|
_LanguageID = "<<._LanguageID>>"
|
|
_AutoIncrement = "<<._AutoIncrement>>"
|
|
<<C_DEVINFO_F>>
|
|
<<>>
|
|
ENDTEXT
|
|
Endwith && THIS
|
|
|
|
Catch To loEx
|
|
If This.n_Debug > 0 And _vfp.StartMode = 0
|
|
Set Step On
|
|
Endif
|
|
|
|
Throw
|
|
|
|
Endtry
|
|
|
|
Return lcText
|
|
Endproc
|
|
|
|
|
|
Function getFilesNotFound(taFiles) As Integer
|
|
*---------------------------------------------------------------------------------------------------
|
|
* PARÁMETROS: (v=Pasar por valor | @=Pasar por referencia) (!=Obligatorio | ?=Opcional) (IN/OUT)
|
|
* taFiles (?@ OUT) Codifica los caracteres ASCII 10 y 13 de CHR(nCode) a {nCode}
|
|
*---------------------------------------------------------------------------------------------------
|
|
External Array taFiles
|
|
|
|
Try
|
|
Local I, lnCount, laDirFile(1,5), lcHomeDir
|
|
|
|
With This As CL_PROJECT Of "FOXBIN2PRG.PRG"
|
|
Dimension taFiles( Max(1,.Count), 2)
|
|
taFiles(1,1) = ''
|
|
taFiles(1,2) = .F.
|
|
lnCount = 0
|
|
lcHomeDir = Addbs( Evl(Justpath(.c_InputFile), ._HomeDir) )
|
|
|
|
For I = 1 To .Count
|
|
taFiles(m.I,1) = .Item(m.I).Name
|
|
taFiles(m.I,2) = ( Adir(laDirFile, .get_AbsolutePath( taFiles(m.I,1), lcHomeDir) ) = 1 )
|
|
|
|
If Not taFiles(m.I,2)
|
|
lnCount = lnCount + 1
|
|
Endif
|
|
Endfor
|
|
|
|
Endwith && THIS
|
|
|
|
Catch To loEx
|
|
If This.n_Debug > 0 And _vfp.StartMode = 0
|
|
Set Step On
|
|
Endif
|
|
|
|
Throw
|
|
|
|
Endtry
|
|
|
|
Return lnCount
|
|
Endfunc
|
|
|
|
|
|
Enddefine
|
|
|
|
|
|
|
|
|
|
Define Class CL_DBC_COL_BASE As CL_COL_BASE
|
|
#If .F.
|
|
Local This As CL_DBC_COL_BASE Of 'FOXBIN2PRG.PRG'
|
|
#Endif
|
|
|
|
_MemberData = [<VFPData>] ;
|
|
+ [<memberdata name="_name" display="_Name"/>] ;
|
|
+ [<memberdata name="__objectid" display="__ObjectID"/>] ;
|
|
+ [<memberdata name="updatedbc" display="updateDBC"/>] ;
|
|
+ [<memberdata name="read_bindatatoproperties" display="read_BinDataToProperties"/>] ;
|
|
+ [</VFPData>]
|
|
|
|
__ObjectID = 0
|
|
_Name = ''
|
|
|
|
|
|
Procedure updateDBC
|
|
*---------------------------------------------------------------------------------------------------
|
|
* PARÁMETROS: (v=Pasar por valor | @=Pasar por referencia) (!=Obligatorio | ?=Opcional) (IN/OUT)
|
|
* tc_OutputFile (v! IN ) Nombre del archivo de salida
|
|
* tnLastID (!@ IN ) Último número de ID usado
|
|
* tnParentID (v! IN ) ID del objeto Padre
|
|
*---------------------------------------------------------------------------------------------------
|
|
Lparameters tc_OutputFile, tnLastID, tnParentID
|
|
Local loObject
|
|
loObject = Null
|
|
|
|
For Each loObject In This FoxObject
|
|
loObject.updateDBC( tc_OutputFile, @tnLastID, tnParentID )
|
|
loObject = Null
|
|
Endfor
|
|
|
|
Return
|
|
Endproc
|
|
|
|
|
|
Procedure __ObjectID_ACCESS
|
|
Return This.Parent.__ObjectID
|
|
Endproc
|
|
|
|
|
|
Enddefine
|
|
|
|
|
|
|
|
Define Class CL_DBC_BASE As CL_CUS_BASE
|
|
#If .F.
|
|
Local This As CL_DBC_BASE Of 'FOXBIN2PRG.PRG'
|
|
#Endif
|
|
|
|
_MemberData = [<VFPData>] ;
|
|
+ [<memberdata name="add_property" display="Add_Property"/>] ;
|
|
+ [<memberdata name="analyzecodeblock_comment" display="analyzeCodeBlock_Comment"/>] ;
|
|
+ [<memberdata name="_dbc" display="_DBC"/>] ;
|
|
+ [<memberdata name="_name" display="_Name"/>] ;
|
|
+ [<memberdata name="_saved" display="_Saved"/>] ;
|
|
+ [<memberdata name="_totext" display="_ToText"/>] ;
|
|
+ [<memberdata name="__objectid" display="__ObjectID"/>] ;
|
|
+ [<memberdata name="dbgetprop" display="DBGETPROP"/>] ;
|
|
+ [<memberdata name="dbsetprop" display="DBSETPROP"/>] ;
|
|
+ [<memberdata name="getallpropertiesfromobjectname" display="getAllPropertiesFromObjectname"/>] ;
|
|
+ [<memberdata name="getbinpropertydatarecord" display="getBinPropertyDataRecord"/>] ;
|
|
+ [<memberdata name="getcodememo" display="getCodeMemo"/>] ;
|
|
+ [<memberdata name="getdbcpropertyidbyname" display="getDBCPropertyIDByName"/>] ;
|
|
+ [<memberdata name="getdbcpropertynamebyid" display="getDBCPropertyNameByID"/>] ;
|
|
+ [<memberdata name="getdbcpropertyvaluetypebypropertyid" display="getDBCPropertyValueTypeByPropertyID"/>] ;
|
|
+ [<memberdata name="getid" display="getID"/>] ;
|
|
+ [<memberdata name="getobjecttype" display="getObjectType"/>] ;
|
|
+ [<memberdata name="read_bindatatoproperties" display="read_BinDataToProperties"/>] ;
|
|
+ [<memberdata name="getbinmemofromproperties" display="getBinMemoFromProperties"/>] ;
|
|
+ [<memberdata name="getreferentialintegrityinfo" display="getReferentialIntegrityInfo"/>] ;
|
|
+ [<memberdata name="getusermemo" display="getUserMemo"/>] ;
|
|
+ [<memberdata name="read_dbc_header" display="read_DBC_Header"/>] ;
|
|
+ [<memberdata name="readnext_dbc_headerdatarecord" display="readNext_DBC_HeaderDataRecord"/>] ;
|
|
+ [<memberdata name="setnextid" display="setNextID"/>] ;
|
|
+ [<memberdata name="updatedbc" display="updateDBC"/>] ;
|
|
+ [</VFPData>]
|
|
|
|
|
|
__ObjectID = 0
|
|
_DBC = ''
|
|
_Name = ''
|
|
_Saved = .F. && Indica si la información fue leida y guardada en las propiedades.
|
|
_ToText = '' && Propiedades pasadas a Texto para guardar en archivo externo xx2
|
|
|
|
|
|
Function add_Property
|
|
*---------------------------------------------------------------------------------------------------
|
|
* PARÁMETROS: (v=Pasar por valor | @=Pasar por referencia) (!=Obligatorio | ?=Opcional) (IN/OUT)
|
|
* tcPropertyName (v! IN ) Nombre de la propiedad a agregar o modificar
|
|
* teValue (v! IN ) Valor de la propiedad
|
|
*---------------------------------------------------------------------------------------------------
|
|
Lparameters tcPropertyName, teValue
|
|
|
|
Local lnPropertyID, tcDataType, leValue, llRetorno, lnDataLen
|
|
|
|
With This As CL_DBC_BASE Of 'FOXBIN2PRG.PRG'
|
|
lnPropertyID = .getDBCPropertyIDByName( Substr(tcPropertyName,2) )
|
|
|
|
If lnPropertyID = -1
|
|
If Pcount()=1
|
|
llRetorno = .AddProperty( tcPropertyName )
|
|
Else
|
|
llRetorno = .AddProperty( tcPropertyName, teValue )
|
|
Endif
|
|
Else
|
|
tcDataType = .getDBCPropertyValueTypeByPropertyID( lnPropertyID )
|
|
lnDataLen = Len(teValue)
|
|
|
|
Do Case
|
|
Case tcDataType = 'L'
|
|
If lnDataLen = 0
|
|
leValue = .F.
|
|
Else
|
|
leValue = Cast( teValue As (tcDataType) )
|
|
Endif
|
|
|
|
Case Inlist(tcDataType, 'N', 'B')
|
|
If lnDataLen = 0
|
|
leValue = 0
|
|
Else
|
|
leValue = Cast( teValue As (tcDataType) (lnDataLen) )
|
|
Endif
|
|
|
|
Otherwise && Asumo 'C'
|
|
If lnDataLen = 0
|
|
leValue = ''
|
|
Else
|
|
leValue = teValue
|
|
Endif
|
|
|
|
Endcase
|
|
|
|
llRetorno = .AddProperty( tcPropertyName, leValue )
|
|
Endif
|
|
Endwith && THIS
|
|
|
|
Return llRetorno
|
|
Endfunc
|
|
|
|
|
|
Procedure analyzeCodeBlock_Comment
|
|
*---------------------------------------------------------------------------------------------------
|
|
* PARÁMETROS: (v=Pasar por valor | @=Pasar por referencia) (!=Obligatorio | ?=Opcional) (IN/OUT)
|
|
* tcLine (!@ IN/OUT) Contenido de la línea en análisis
|
|
* taCodeLines (!@ IN ) Array de líneas del programa analizado
|
|
* I (!@ IN/OUT) Número de línea en análisis
|
|
* tnCodeLines (!@ IN ) Cantidad de líneas del programa analizado
|
|
*---------------------------------------------------------------------------------------------------
|
|
Lparameters tcLine, taCodeLines, I, tnCodeLines
|
|
|
|
If Left(tcLine, Len('<Comment>')) == '<Comment>'
|
|
Local lcValue
|
|
llBloqueEncontrado = .T.
|
|
lcValue = Strextract( taCodeLines(m.I), '<Comment>', '</Comment>', 1, 2 )
|
|
|
|
With This As CL_DBC_BASE Of 'FOXBIN2PRG.PRG'
|
|
If Not '</Comment>' $ tcLine Then
|
|
For I = m.I + 1 To tnCodeLines
|
|
.set_Line( @tcLine, @taCodeLines, m.I )
|
|
|
|
Do Case
|
|
Case '</Comment>' $ tcLine && Fin
|
|
lcValue = lcValue + CR_LF + Left( taCodeLines(m.I), At( '</Comment>', taCodeLines(m.I) ) - 1 )
|
|
Exit
|
|
|
|
Otherwise && Línea de Stored Procedure
|
|
lcValue = lcValue + CR_LF + taCodeLines(m.I)
|
|
Endcase
|
|
Endfor
|
|
Endif
|
|
|
|
.AddProperty( '_Comment', lcValue )
|
|
Endwith && THIS
|
|
Endif
|
|
Endproc
|
|
|
|
|
|
Procedure getAllPropertiesFromObjectname
|
|
*---------------------------------------------------------------------------------------------------
|
|
* PARÁMETROS: (v=Pasar por valor | @=Pasar por referencia) (!=Obligatorio | ?=Opcional) (IN/OUT)
|
|
* tcName (v! IN ) Nombre del objeto
|
|
* tcType (v! IN ) Tipo de objeto (Table, Index, Field, View, Relation)
|
|
* taProperties (!@ OUT) Array con las propiedades encontradas y sus valores
|
|
* tnProperty_Count (!@ OUT) Cantidad de propiedades encontradas
|
|
*---------------------------------------------------------------------------------------------------
|
|
Lparameters tcName, tcType, taProperties, tnProperty_Count
|
|
|
|
External Array taProperties && STRUCTURE: PropName,RecordLen,DataIDLen,DataID,DataType,Data
|
|
|
|
Try
|
|
Local lcValue, leValue, lnSelect, laProperty(1,1), lnRecordLen, lcBinRecord, lnPropertyID ;
|
|
, lnLastPos, lnLenCCode, lcDataType, lcPropName, lcDBF, lnLenData, lnLenHeader
|
|
|
|
With This As CL_DBC_BASE Of 'FOXBIN2PRG.PRG'
|
|
tnProperty_Count = 0
|
|
lnSelect = Select()
|
|
leValue = ''
|
|
tcName = Proper(Rtrim(tcName))
|
|
tcType = Proper(Rtrim(tcType))
|
|
tcProperty = Proper(Rtrim(tcProperty))
|
|
lcDBF = Dbf()
|
|
|
|
Select 0
|
|
Use (lcDBF) Shared Again Noupdate Alias C_TABLABIN2
|
|
|
|
If Inlist( tcType, 'Index', 'Field' )
|
|
Select TB.Property From C_TABLABIN2 TB ;
|
|
INNER Join C_TABLABIN2 TB2 On Str(TB.ParentId)+TB.ObjectType+Lower(TB.ObjectName) = Str(TB2.ObjectID)+Padr(tcType,10)+Padr(Lower(Justext(tcName)),128) ;
|
|
AND TB2.ObjectName = Padr(Lower(Juststem(tcName)),128) ;
|
|
INTO Array laProperty
|
|
|
|
Else
|
|
Select TB.Property From C_TABLABIN2 TB ;
|
|
INNER Join C_TABLABIN2 TB2 On Str(TB.ParentId)+TB.ObjectType+Lower(TB.ObjectName) = Str(TB2.ObjectID)+Padr(tcType,10)+Padr(Lower(tcName),128) ;
|
|
INTO Array laProperty
|
|
|
|
Endif
|
|
|
|
If _Tally > 0
|
|
If Empty(laProperty(1,1))
|
|
Exit
|
|
Endif
|
|
|
|
lnLastPos = 1
|
|
|
|
Do While lnLastPos < Len(laProperty(1,1))
|
|
tnProperty_Count = tnProperty_Count + 1
|
|
Dimension taProperties( tnProperty_Count,6 )
|
|
|
|
lnRecordLen = CToBin( Substr(laProperty(1,1), lnLastPos, 4), "4RS" )
|
|
lcBinRecord = Substr(laProperty(1,1), lnLastPos, lnRecordLen)
|
|
lnLenCCode = CToBin( Substr(lcBinRecord, 4+1, 2), "2RS" )
|
|
lnPropertyID = Asc( Substr(lcBinRecord, 4+2+1, lnLenCCode) )
|
|
lcPropName = .getDBCPropertyNameByID( lnPropertyID )
|
|
lcDataType = .getDBCPropertyValueTypeByPropertyID( lnPropertyID )
|
|
lnLenHeader = 4 + 2 + lnLenCCode
|
|
lcValue = Substr(lcBinRecord, lnLenHeader + 1)
|
|
|
|
Do Case
|
|
Case lcDataType = 'B'
|
|
If lnLenHeader = lnRecordLen
|
|
leValue = 0
|
|
Else
|
|
leValue = Asc( lcValue )
|
|
Endif
|
|
|
|
Case lcDataType = 'L'
|
|
If lnLenHeader = lnRecordLen
|
|
leValue = .F.
|
|
Else
|
|
leValue = ( CToBin( lcValue, "1S" ) = 1 )
|
|
Endif
|
|
|
|
Case lcDataType = 'N'
|
|
If lnLenHeader = lnRecordLen
|
|
leValue = 0
|
|
Else
|
|
leValue = CToBin( lcValue, "4S" )
|
|
Endif
|
|
|
|
Otherwise && Asume 'C'
|
|
If lnLenHeader = lnRecordLen
|
|
leValue = ''
|
|
Else
|
|
leValue = Left( lcValue, At( Chr(0), lcValue ) - 1 )
|
|
Endif
|
|
Endcase
|
|
|
|
taProperties( tnProperty_Count,1 ) = lcPropName
|
|
taProperties( tnProperty_Count,2 ) = lnRecordLen
|
|
taProperties( tnProperty_Count,3 ) = lnLenCCode
|
|
taProperties( tnProperty_Count,4 ) = lnPropertyID
|
|
taProperties( tnProperty_Count,5 ) = lcDataType
|
|
taProperties( tnProperty_Count,6 ) = leValue
|
|
|
|
lnLastPos = lnLastPos + lnRecordLen
|
|
Enddo
|
|
Else
|
|
Error 1562, (tcName)
|
|
Endif
|
|
Endwith && THIS
|
|
|
|
|
|
Catch To loEx
|
|
If This.n_Debug > 0 And _vfp.StartMode = 0
|
|
Set Step On
|
|
Endif
|
|
|
|
Throw
|
|
|
|
Finally
|
|
Use In (Select("C_TABLABIN2"))
|
|
Select (lnSelect)
|
|
Endtry
|
|
|
|
Return leValue
|
|
Endproc
|
|
|
|
|
|
Procedure getDBCPropertyIDByName
|
|
*---------------------------------------------------------------------------------------------------
|
|
* PARÁMETROS: (v=Pasar por valor | @=Pasar por referencia) (!=Obligatorio | ?=Opcional) (IN/OUT)
|
|
* tcPropertyName (v! IN ) Nombre de la propiedad
|
|
* tlRethrowError (v? IN ) Indica si se debe relanzar el error o solo devolver -1
|
|
*---------------------------------------------------------------------------------------------------
|
|
Lparameters tcPropertyName, tlRethrowError
|
|
Local lnPropertyID
|
|
tcPropertyName = Lower(Rtrim(tcPropertyName))
|
|
|
|
Do Case
|
|
Case tcPropertyName == 'null'
|
|
lnPropertyID = 0
|
|
Case tcPropertyName == 'path'
|
|
lnPropertyID = 1
|
|
Case tcPropertyName == 'class'
|
|
lnPropertyID = 2
|
|
Case tcPropertyName == 'comment'
|
|
lnPropertyID = 7
|
|
Case tcPropertyName == 'ruleexpression'
|
|
lnPropertyID = 9
|
|
Case tcPropertyName == 'ruletext'
|
|
lnPropertyID = 10
|
|
Case tcPropertyName == 'defaultvalue'
|
|
lnPropertyID = 11
|
|
Case tcPropertyName == 'parameterlist'
|
|
lnPropertyID = 12
|
|
Case tcPropertyName == 'childtag'
|
|
lnPropertyID = 13
|
|
Case tcPropertyName == 'inserttrigger'
|
|
lnPropertyID = 14
|
|
Case tcPropertyName == 'updatetrigger'
|
|
lnPropertyID = 15
|
|
Case tcPropertyName == 'deletetrigger'
|
|
lnPropertyID = 16
|
|
Case tcPropertyName == 'isunique'
|
|
lnPropertyID = 17
|
|
Case tcPropertyName == 'parenttable'
|
|
lnPropertyID = 18
|
|
Case tcPropertyName == 'parenttag'
|
|
lnPropertyID = 19
|
|
Case tcPropertyName == 'primarykey'
|
|
lnPropertyID = 20
|
|
Case tcPropertyName == 'version'
|
|
lnPropertyID = 24
|
|
Case tcPropertyName == 'batchupdatecount'
|
|
lnPropertyID = 28
|
|
Case tcPropertyName == 'datasource'
|
|
lnPropertyID = 29
|
|
Case tcPropertyName == 'connectname'
|
|
lnPropertyID = 32
|
|
Case tcPropertyName == 'updatename'
|
|
lnPropertyID = 35
|
|
Case tcPropertyName == 'fetchmemo'
|
|
lnPropertyID = 36
|
|
Case tcPropertyName == 'fetchsize'
|
|
lnPropertyID = 37
|
|
Case tcPropertyName == 'keyfield'
|
|
lnPropertyID = 38
|
|
Case tcPropertyName == 'maxrecords'
|
|
lnPropertyID = 39
|
|
Case tcPropertyName == 'shareconnection'
|
|
lnPropertyID = 40
|
|
Case tcPropertyName == 'sourcetype'
|
|
lnPropertyID = 41
|
|
Case tcPropertyName == 'sql'
|
|
lnPropertyID = 42
|
|
Case tcPropertyName == 'tables'
|
|
lnPropertyID = 43
|
|
Case tcPropertyName == 'sendupdates'
|
|
lnPropertyID = 44
|
|
Case tcPropertyName == 'updatablefield' Or tcPropertyName == 'updatable'
|
|
lnPropertyID = 45
|
|
Case tcPropertyName == 'updatetype'
|
|
lnPropertyID = 46
|
|
Case tcPropertyName == 'usememosize'
|
|
lnPropertyID = 47
|
|
Case tcPropertyName == 'wheretype'
|
|
lnPropertyID = 48
|
|
Case tcPropertyName == 'displayclass' && Undocumented
|
|
lnPropertyID = 50
|
|
Case tcPropertyName == 'displayclasslibrary' && Undocumented
|
|
lnPropertyID = 51
|
|
Case tcPropertyName == 'inputmask' && Undocumented
|
|
lnPropertyID = 54
|
|
Case tcPropertyName == 'format' && Undocumented
|
|
lnPropertyID = 55
|
|
Case tcPropertyName == 'caption'
|
|
lnPropertyID = 56
|
|
Case tcPropertyName == 'asynchronous'
|
|
lnPropertyID = 64
|
|
Case tcPropertyName == 'batchmode'
|
|
lnPropertyID = 65
|
|
Case tcPropertyName == 'connectstring'
|
|
lnPropertyID = 66
|
|
Case tcPropertyName == 'connecttimeout'
|
|
lnPropertyID = 67
|
|
Case tcPropertyName == 'displogin'
|
|
lnPropertyID = 68
|
|
Case tcPropertyName == 'dispwarnings'
|
|
lnPropertyID = 69
|
|
Case tcPropertyName == 'idletimeout'
|
|
lnPropertyID = 70
|
|
Case tcPropertyName == 'querytimeout'
|
|
lnPropertyID = 71
|
|
Case tcPropertyName == 'password'
|
|
lnPropertyID = 72
|
|
Case tcPropertyName == 'transactions'
|
|
lnPropertyID = 73
|
|
Case tcPropertyName == 'userid'
|
|
lnPropertyID = 74
|
|
Case tcPropertyName == 'waittime'
|
|
lnPropertyID = 75
|
|
Case tcPropertyName == 'timestamp'
|
|
lnPropertyID = 76
|
|
Case tcPropertyName == 'datatype'
|
|
lnPropertyID = 77
|
|
Case tcPropertyName == 'packetsize' && Undocumented
|
|
lnPropertyID = 78
|
|
Case tcPropertyName == 'database' && Undocumented
|
|
lnPropertyID = 79
|
|
Case tcPropertyName == 'prepared' && Undocumented
|
|
lnPropertyID = 80
|
|
Case tcPropertyName == 'comparememo' && Undocumented
|
|
lnPropertyID = 81
|
|
Case tcPropertyName == 'fetchasneeded' && Undocumented
|
|
lnPropertyID = 82
|
|
Case tcPropertyName == 'offline' && Undocumented
|
|
lnPropertyID = 83
|
|
Case tcPropertyName == 'recordcount' && Undocumented
|
|
lnPropertyID = 84
|
|
Case tcPropertyName == 'undocumented_view_prop_85' && Undocumented
|
|
lnPropertyID = 85
|
|
Case tcPropertyName == 'dbcevents' && Undocumented
|
|
lnPropertyID = 86
|
|
Case tcPropertyName == 'dbceventfilename' && Undocumented
|
|
lnPropertyID = 87
|
|
Case tcPropertyName == 'allowsimultaneousfetch' && Undocumented
|
|
lnPropertyID = 88
|
|
Case tcPropertyName == 'disconnectrollback' && Undocumented
|
|
lnPropertyID = 89
|
|
Otherwise
|
|
If tlRethrowError
|
|
Error 1559, (tcPropertyName)
|
|
Else
|
|
lnPropertyID = -1
|
|
Endif
|
|
Endcase
|
|
|
|
Return lnPropertyID
|
|
Endproc
|
|
|
|
|
|
Procedure getDBCPropertyNameByID
|
|
*---------------------------------------------------------------------------------------------------
|
|
* PARÁMETROS: (v=Pasar por valor | @=Pasar por referencia) (!=Obligatorio | ?=Opcional) (IN/OUT)
|
|
* tcPropertyID (v! IN ) Nombre de la propiedad
|
|
* tlRethrowError (v? IN ) Indica si se debe relanzar el error o solo devolver -1
|
|
*---------------------------------------------------------------------------------------------------
|
|
Lparameters tnPropertyID, tlRethrowError
|
|
Local lcPropertyName
|
|
|
|
Do Case
|
|
Case tnPropertyID = 0
|
|
lcPropertyName = 'null'
|
|
Case tnPropertyID = 1
|
|
lcPropertyName = 'path'
|
|
Case tnPropertyID = 2
|
|
lcPropertyName = 'class'
|
|
Case tnPropertyID = 7
|
|
lcPropertyName = 'comment'
|
|
Case tnPropertyID = 9
|
|
lcPropertyName = 'ruleexpression'
|
|
Case tnPropertyID = 10
|
|
lcPropertyName = 'ruletext'
|
|
Case tnPropertyID = 11
|
|
lcPropertyName = 'defaultvalue'
|
|
Case tnPropertyID = 12
|
|
lcPropertyName = 'parameterlist'
|
|
Case tnPropertyID = 13
|
|
lcPropertyName = 'childtag'
|
|
Case tnPropertyID = 14
|
|
lcPropertyName = 'inserttrigger'
|
|
Case tnPropertyID = 15
|
|
lcPropertyName = 'updatetrigger'
|
|
Case tnPropertyID = 16
|
|
lcPropertyName = 'deletetrigger'
|
|
Case tnPropertyID = 17
|
|
lcPropertyName = 'isunique'
|
|
Case tnPropertyID = 18
|
|
lcPropertyName = 'parenttable'
|
|
Case tnPropertyID = 19
|
|
lcPropertyName = 'parenttag'
|
|
Case tnPropertyID = 20
|
|
lcPropertyName = 'primarykey'
|
|
Case tnPropertyID = 24
|
|
lcPropertyName = 'version'
|
|
Case tnPropertyID = 28
|
|
lcPropertyName = 'batchupdatecount'
|
|
Case tnPropertyID = 29
|
|
lcPropertyName = 'datasource'
|
|
Case tnPropertyID = 32
|
|
lcPropertyName = 'connectname'
|
|
Case tnPropertyID = 35
|
|
lcPropertyName = 'updatename'
|
|
Case tnPropertyID = 36
|
|
lcPropertyName = 'fetchmemo'
|
|
Case tnPropertyID = 37
|
|
lcPropertyName = 'fetchsize'
|
|
Case tnPropertyID = 38
|
|
lcPropertyName = 'keyfield'
|
|
Case tnPropertyID = 39
|
|
lcPropertyName = 'maxrecords'
|
|
Case tnPropertyID = 40
|
|
lcPropertyName = 'shareconnection'
|
|
Case tnPropertyID = 41
|
|
lcPropertyName = 'sourcetype'
|
|
Case tnPropertyID = 42
|
|
lcPropertyName = 'sql'
|
|
Case tnPropertyID = 43
|
|
lcPropertyName = 'tables'
|
|
Case tnPropertyID = 44
|
|
lcPropertyName = 'sendupdates'
|
|
Case tnPropertyID = 45
|
|
lcPropertyName = 'updatablefield'
|
|
Case tnPropertyID = 46
|
|
lcPropertyName = 'updatetype'
|
|
Case tnPropertyID = 47
|
|
lcPropertyName = 'usememosize'
|
|
Case tnPropertyID = 48
|
|
lcPropertyName = 'wheretype'
|
|
Case tnPropertyID = 50
|
|
lcPropertyName = 'displayclass' && Undocumented
|
|
Case tnPropertyID = 51
|
|
lcPropertyName = 'displayclasslibrary' && Undocumented
|
|
Case tnPropertyID = 54
|
|
lcPropertyName = 'inputmask' && Undocumented
|
|
Case tnPropertyID = 55
|
|
lcPropertyName = 'format' && Undocumented
|
|
Case tnPropertyID = 56
|
|
lcPropertyName = 'caption'
|
|
Case tnPropertyID = 64
|
|
lcPropertyName = 'asynchronous'
|
|
Case tnPropertyID = 65
|
|
lcPropertyName = 'batchmode'
|
|
Case tnPropertyID = 66
|
|
lcPropertyName = 'connectstring'
|
|
Case tnPropertyID = 67
|
|
lcPropertyName = 'connecttimeout'
|
|
Case tnPropertyID = 68
|
|
lcPropertyName = 'displogin'
|
|
Case tnPropertyID = 69
|
|
lcPropertyName = 'dispwarnings'
|
|
Case tnPropertyID = 70
|
|
lcPropertyName = 'idletimeout'
|
|
Case tnPropertyID = 71
|
|
lcPropertyName = 'querytimeout'
|
|
Case tnPropertyID = 72
|
|
lcPropertyName = 'password'
|
|
Case tnPropertyID = 73
|
|
lcPropertyName = 'transactions'
|
|
Case tnPropertyID = 74
|
|
lcPropertyName = 'userid'
|
|
Case tnPropertyID = 75
|
|
lcPropertyName = 'waittime'
|
|
Case tnPropertyID = 76
|
|
lcPropertyName = 'timestamp'
|
|
Case tnPropertyID = 77
|
|
lcPropertyName = 'datatype'
|
|
Case tnPropertyID = 78
|
|
lcPropertyName = 'packetsize' && Undocumented
|
|
Case tnPropertyID = 79
|
|
lcPropertyName = 'database' && Undocumented
|
|
Case tnPropertyID = 80
|
|
lcPropertyName = 'prepared' && Undocumented
|
|
Case tnPropertyID = 81
|
|
lcPropertyName = 'comparememo' && Undocumented
|
|
Case tnPropertyID = 82
|
|
lcPropertyName = 'fetchasneeded' && Undocumented
|
|
Case tnPropertyID = 83
|
|
lcPropertyName = 'offline' && Undocumented
|
|
Case tnPropertyID = 84
|
|
lcPropertyName = 'recordcount' && Undocumented
|
|
Case tnPropertyID = 85
|
|
lcPropertyName = 'undocumented_view_prop_85' && Undocumented
|
|
Case tnPropertyID = 86
|
|
lcPropertyName = 'dbcevents' && Undocumented
|
|
Case tnPropertyID = 87
|
|
lcPropertyName = 'dbceventfilename' && Undocumented
|
|
Case tnPropertyID = 88
|
|
lcPropertyName = 'allowsimultaneousfetch' && Undocumented
|
|
Case tnPropertyID = 89
|
|
lcPropertyName = 'disconnectrollback' && Undocumented
|
|
Otherwise
|
|
If tlRethrowError
|
|
Error 1559, (Transform(tnPropertyID))
|
|
Else
|
|
lcPropertyName = ''
|
|
Endif
|
|
Endcase
|
|
|
|
Return lcPropertyName
|
|
Endproc
|
|
|
|
|
|
Procedure getDBCPropertyValueTypeByPropertyID
|
|
*---------------------------------------------------------------------------------------------------
|
|
* PARÁMETROS: (v=Pasar por valor | @=Pasar por referencia) (!=Obligatorio | ?=Opcional) (IN/OUT)
|
|
* tnPropertyID (v! IN ) ID de la Propiedad
|
|
*---------------------------------------------------------------------------------------------------
|
|
Lparameters tnPropertyID
|
|
Local lcValueType ;
|
|
, loLang As CL_LANG Of 'FOXBIN2PRG.PRG'
|
|
|
|
loLang = _Screen.o_FoxBin2Prg_Lang
|
|
lcValueType = ''
|
|
|
|
Do Case
|
|
Case Inlist(tnPropertyID,2,41,46,48,68,73)
|
|
lcValueType = 'B' && Byte
|
|
|
|
Case Inlist(tnPropertyID,17,36,38,40,44,45,64,65,69,80,81,82,83,86,88,89)
|
|
lcValueType = 'L'
|
|
|
|
Case Inlist(tnPropertyID,24,28,37,39,47,67,70,71,75,76,78,84,85)
|
|
lcValueType = 'N'
|
|
|
|
Case Inlist(tnPropertyID,0,1,7,9,10,11,12,13,14,15,16,18,19,20,29,30,32,35) ;
|
|
OR Inlist(tnPropertyID,42,43,49,50,51,54,55,56,66,67,72,74,77,79,87)
|
|
lcValueType = 'C'
|
|
|
|
Otherwise
|
|
*ERROR 'Propiedad [' + TRANSFORM(tnPropertyID) + '] no reconocida.'
|
|
Error (Textmerge(loLang.C_PROPERTY_NAME_NOT_RECOGNIZED_LOC))
|
|
Endcase
|
|
|
|
Return lcValueType
|
|
Endproc
|
|
|
|
|
|
Procedure DBGetProp
|
|
*---------------------------------------------------------------------------------------------------
|
|
* Emula el comando DBGETPROP interno de VFP
|
|
*---------------------------------------------------------------------------------------------------
|
|
* PARÁMETROS: (v=Pasar por valor | @=Pasar por referencia) (!=Obligatorio | ?=Opcional) (IN/OUT)
|
|
* tcName (v! IN ) Nombre del objeto
|
|
* tcType (v! IN ) Tipo de objeto (Table, Index, Field, View, Relation)
|
|
* tcProperty (v! IN ) Nombre de la propiedad
|
|
*---------------------------------------------------------------------------------------------------
|
|
Lparameters tcName, tcType, tcProperty
|
|
|
|
Try
|
|
Local lcValue, lxValue, lnSelect, lcInfo, lnRecno, lnRecordLen, lcBinRecord, lnPropertyID ;
|
|
, lnLastPos, lnLenCCode, lcDataType, lnSerchedDataCC, lcDBF, lnLenData, lnLenHeader ;
|
|
, lcInfo, lnRecno ;
|
|
, loEx As Exception
|
|
|
|
With This As CL_DBC_BASE Of 'FOXBIN2PRG.PRG'
|
|
lnSelect = Select()
|
|
lxValue = ''
|
|
|
|
If .DBPROP_INFO_RECNO(tcName, tcType, tcProperty, @lcInfo, @lnRecno) > 0
|
|
If Empty(lcInfo)
|
|
Exit
|
|
Endif
|
|
|
|
If .DBGETPROP_POS_AND_LEN(tcProperty, @lcInfo, @lnLastPos, @lnRecordLen ;
|
|
, @lcBinRecord, @lnLenCCode, @lnPropertyID)
|
|
|
|
lcDataType = .getDBCPropertyValueTypeByPropertyID( lnPropertyID )
|
|
lnLenHeader = 4 + 2 + lnLenCCode
|
|
lcValue = Substr(lcBinRecord, lnLenHeader + 1)
|
|
|
|
Do Case
|
|
Case lcDataType = 'B'
|
|
If lnLenHeader = lnRecordLen
|
|
lxValue = 0
|
|
Else
|
|
lxValue = Asc( lcValue )
|
|
Endif
|
|
|
|
Case lcDataType = 'L'
|
|
If lnLenHeader = lnRecordLen
|
|
lxValue = .F.
|
|
Else
|
|
lxValue = ( CToBin( lcValue, "1S" ) = 1 )
|
|
Endif
|
|
|
|
Case lcDataType = 'N'
|
|
If lnLenHeader = lnRecordLen
|
|
lxValue = 0
|
|
Else
|
|
lxValue = CToBin( lcValue, "4S" )
|
|
Endif
|
|
|
|
Otherwise && Asume 'C'
|
|
If lnLenHeader = lnRecordLen
|
|
lxValue = ''
|
|
Else
|
|
lxValue = Left( lcValue, At( Chr(0), lcValue ) - 1 )
|
|
Endif
|
|
Endcase
|
|
|
|
Endif
|
|
|
|
Else
|
|
Error 1562, (tcName)
|
|
Endif
|
|
Endwith && THIS
|
|
|
|
|
|
Catch To loEx
|
|
If This.n_Debug > 0 And _vfp.StartMode = 0
|
|
Set Step On
|
|
Endif
|
|
|
|
Throw
|
|
|
|
Finally
|
|
Use In (Select("C_TABLABIN2"))
|
|
Select (lnSelect)
|
|
Endtry
|
|
|
|
Return lxValue
|
|
Endproc
|
|
|
|
|
|
Procedure DBSetProp
|
|
*---------------------------------------------------------------------------------------------------
|
|
* Emula el comando DBSETPROP interno de VFP
|
|
*---------------------------------------------------------------------------------------------------
|
|
* PARÁMETROS: (v=Pasar por valor | @=Pasar por referencia) (!=Obligatorio | ?=Opcional) (IN/OUT)
|
|
* tcName (v! IN ) Nombre del objeto
|
|
* tcType (v! IN ) Tipo de objeto (Table, Index, Field, View, Relation)
|
|
* tcProperty (v! IN ) Nombre de la propiedad
|
|
* txPropertyValue (v! IN ) Valor de la propiedad
|
|
*---------------------------------------------------------------------------------------------------
|
|
Lparameters tcName, tcType, tcProperty, txPropertyValue
|
|
|
|
Try
|
|
Local lnSelect, laProperty(1,1), lnRecordLen, lcBinRecord, lnPropertyID ;
|
|
, lnLastPos, lnLenCCode, lcDataType, lnSerchedDataCC, lnLenData, lnLenHeader ;
|
|
, lcInfo, lnRecno, llSet ;
|
|
, loEx As Exception
|
|
|
|
With This As CL_DBC_BASE Of 'FOXBIN2PRG.PRG'
|
|
lnSelect = Select()
|
|
lcInfo = ''
|
|
|
|
If .DBPROP_INFO_RECNO(tcName, tcType, tcProperty, @lcInfo, @lnRecno) > 0
|
|
If Empty(lcInfo)
|
|
Exit
|
|
Endif
|
|
|
|
If .DBGETPROP_POS_AND_LEN(tcProperty, @lcInfo, @lnLastPos, @lnRecordLen ;
|
|
, @lcBinRecord, @lnLenCCode, @lnPropertyID)
|
|
|
|
lcDataType = .getDBCPropertyValueTypeByPropertyID( lnPropertyID )
|
|
lcBinRecord = .getBinPropertyDataRecord( @txPropertyValue, lnPropertyID )
|
|
|
|
If Empty(lcInfo)
|
|
lcInfo = lcBinRecord
|
|
Else
|
|
lcInfo = Stuff(lcInfo, lnLastPos, lnRecordLen, lcBinRecord)
|
|
Endif
|
|
|
|
Goto Record (lnRecno)
|
|
Replace Property With lcInfo
|
|
Endif
|
|
|
|
llSet = .T.
|
|
|
|
Else
|
|
Error 1562, (tcName)
|
|
Endif
|
|
Endwith && THIS
|
|
|
|
|
|
Catch To loEx
|
|
If This.n_Debug > 0 And _vfp.StartMode = 0
|
|
Set Step On
|
|
Endif
|
|
|
|
Throw
|
|
|
|
Finally
|
|
Use In (Select("C_TABLABIN2"))
|
|
Select (lnSelect)
|
|
Endtry
|
|
|
|
Return llSet
|
|
Endproc
|
|
|
|
|
|
Hidden Procedure DBPROP_INFO_RECNO
|
|
*---------------------------------------------------------------------------------------------------
|
|
* Devuelve el campo property y el número de registro donde lo encontró
|
|
* para ser usado por DBGETPROP y DBSETPROP
|
|
*---------------------------------------------------------------------------------------------------
|
|
* PARÁMETROS: (v=Pasar por valor | @=Pasar por referencia) (!=Obligatorio | ?=Opcional) (IN/OUT)
|
|
* tcName (v! IN ) Nombre del objeto
|
|
* tcType (v! IN ) Tipo de objeto (Table, Index, Field, View, Relation)
|
|
* tcProperty (v! IN ) Nombre de la propiedad
|
|
* tcInfo (@! OUT) Información del campo memo "Property" que contiene el dato indicado
|
|
* tnRecno (@! OUT) Número de registro del campo encontrado
|
|
*---------------------------------------------------------------------------------------------------
|
|
Lparameters tcName, tcType, tcProperty, tcInfo, tnRecno
|
|
|
|
Try
|
|
Local laProperty(1,1), lcDBF, lnTally ;
|
|
, loEx As Exception
|
|
|
|
With This As CL_DBC_BASE Of 'FOXBIN2PRG.PRG'
|
|
tcType = Proper(Rtrim(tcType))
|
|
tcName = Iif(tcType = 'Database', 'Database', Proper(Rtrim(tcName)) )
|
|
tcProperty = Proper(Rtrim(tcProperty))
|
|
lcDBF = Iif(tcType = 'Database', Evl(._DBC, tcName), Dbf())
|
|
tcInfo = ''
|
|
tnRecno = 0
|
|
lnTally = 0
|
|
|
|
Select 0
|
|
Use (lcDBF) Shared Again Alias C_TABLABIN2
|
|
|
|
If Inlist( tcType, 'Index', 'Field' )
|
|
Select TB.Property, Recno() From C_TABLABIN2 TB ;
|
|
INNER Join C_TABLABIN2 TB2 On Str(TB.ParentId)+TB.ObjectType+Lower(TB.ObjectName) = Str(TB2.ObjectID)+Padr(tcType,10)+Padr(Lower(Justext(tcName)),128) ;
|
|
AND TB2.ObjectName = Padr(Lower(Juststem(tcName)),128) ;
|
|
INTO Array laProperty
|
|
|
|
Else
|
|
Select TB.Property, Recno() From C_TABLABIN2 TB ;
|
|
INNER Join C_TABLABIN2 TB2 On Str(TB.ParentId)+TB.ObjectType+Lower(TB.ObjectName) = Str(TB2.ObjectID)+Padr(tcType,10)+Padr(Lower(tcName),128) ;
|
|
INTO Array laProperty
|
|
|
|
Endif
|
|
|
|
If _Tally > 0
|
|
lnTally = _Tally
|
|
tcInfo = laProperty(1,1)
|
|
tnRecno = laProperty(1,2)
|
|
Endif
|
|
Endwith && THIS
|
|
|
|
Catch To loEx
|
|
If This.n_Debug > 0 And _vfp.StartMode = 0
|
|
Set Step On
|
|
Endif
|
|
|
|
Throw
|
|
|
|
Endtry
|
|
|
|
Return lnTally
|
|
Endproc
|
|
|
|
|
|
Hidden Procedure DBGETPROP_POS_AND_LEN
|
|
*---------------------------------------------------------------------------------------------------
|
|
* Devuelve la posición y longitud del dato asociado a la propiedad indicada
|
|
* para ser usado por DBGETPROP y DBSETPROP
|
|
*---------------------------------------------------------------------------------------------------
|
|
* PARÁMETROS: (v=Pasar por valor | @=Pasar por referencia) (!=Obligatorio | ?=Opcional) (IN/OUT)
|
|
* tcProperty (v! IN ) Nombre de la propiedad
|
|
* tcInfo (@! IN ) Información del campo memo "Property" que contiene el dato indicado
|
|
* tnLastPos (@! OUT) Posición del campo Property donde se encontró el dato
|
|
* tnRecordLen (@! OUT) Longitud del registro del dato
|
|
* tcBinRecord (@! OUT) Registro de datos de la propiedad indicada
|
|
* tnLenCCode (@! OUT) Longitud del valor de la propiedad indicada
|
|
* tnPropertyID (@! OUT) ID de la propiedad indicada
|
|
*---------------------------------------------------------------------------------------------------
|
|
Lparameters tcProperty, tcInfo, tnLastPos, tnRecordLen, tcBinRecord, tnLenCCode, tnPropertyID
|
|
|
|
Try
|
|
Local lnSerchedDataCC, llFound ;
|
|
, loEx As Exception
|
|
|
|
With This As CL_DBC_BASE Of 'FOXBIN2PRG.PRG'
|
|
tnLastPos = 1
|
|
lnSerchedDataCC = .getDBCPropertyIDByName( tcProperty, .T. )
|
|
|
|
Do While tnLastPos < Len(tcInfo)
|
|
* Estructura de tcBinRecord
|
|
* ----------------------
|
|
* |RLen|LC|ID|Value |
|
|
* ----------------------
|
|
|
|
tnRecordLen = CToBin( Substr(tcInfo, tnLastPos, 4), "4RS" )
|
|
tcBinRecord = Substr(tcInfo, tnLastPos, tnRecordLen)
|
|
tnLenCCode = CToBin( Substr(tcBinRecord, 4+1, 2), "2RS" )
|
|
tnPropertyID = Asc( Substr(tcBinRecord, 4+2+1, tnLenCCode) )
|
|
|
|
If tnPropertyID = lnSerchedDataCC
|
|
llFound = .T.
|
|
Exit
|
|
Endif
|
|
|
|
tnLastPos = tnLastPos + tnRecordLen
|
|
Enddo
|
|
Endwith && THIS
|
|
|
|
Catch To loEx
|
|
If This.n_Debug > 0 And _vfp.StartMode = 0
|
|
Set Step On
|
|
Endif
|
|
|
|
Throw
|
|
|
|
Endtry
|
|
|
|
Return llFound
|
|
Endproc
|
|
|
|
|
|
Procedure getBinPropertyDataRecord
|
|
Lparameters teData, tnPropertyID
|
|
*---------------------------------------------------------------------------------------------------
|
|
* PARÁMETROS: (v=Pasar por valor | @=Pasar por referencia) (!=Obligatorio | ?=Opcional) (IN/OUT)
|
|
* teData (v! IN ) Dato a codificar
|
|
* tnPropertyID (v! IN ) ID de la propiedad a la que pertenece
|
|
*---------------------------------------------------------------------------------------------------
|
|
|
|
Try
|
|
Local lcBinRecord, lnLen, lcDataType
|
|
|
|
* Estructura de tcBinRecord
|
|
* ----------------------
|
|
* |RLen|LC|ID|Value |
|
|
* ----------------------
|
|
|
|
lcBinRecord = ''
|
|
lcDataType = This.getDBCPropertyValueTypeByPropertyID( tnPropertyID )
|
|
|
|
Do Case
|
|
Case lcDataType = 'B'
|
|
teData = Chr(teData)
|
|
lnLen = 4 + 2 + 1 + 1
|
|
lcBinRecord = BinToC( lnLen, "4RS" ) + BinToC( 1, "2RS" ) + Chr(tnPropertyID) + teData
|
|
|
|
Case lcDataType = 'L'
|
|
teData = BinToC( Iif(teData,1,0), "1S" )
|
|
lnLen = 4 + 2 + 1 + 1
|
|
lcBinRecord = BinToC( lnLen, "4RS" ) + BinToC( 1, "2RS" ) + Chr(tnPropertyID) + teData
|
|
|
|
Case lcDataType = 'N'
|
|
teData = BinToC( teData, "4S" )
|
|
lnLen = 4 + 2 + 1 + 4
|
|
lcBinRecord = BinToC( lnLen, "4RS" ) + BinToC( 1, "2RS" ) + Chr(tnPropertyID) + teData
|
|
|
|
Otherwise && Asume 'C'
|
|
If Empty(teData)
|
|
Exit
|
|
Endif
|
|
lnLen = 4 + 2 + 1 + Len(teData) + 1
|
|
lcBinRecord = BinToC( lnLen, "4RS" ) + BinToC( 1, "2RS" ) + Chr(tnPropertyID) + teData + Chr(0)
|
|
|
|
Endcase
|
|
|
|
|
|
Catch To loEx
|
|
If This.n_Debug > 0 And _vfp.StartMode = 0
|
|
Set Step On
|
|
Endif
|
|
|
|
Throw
|
|
|
|
Endtry
|
|
|
|
Return lcBinRecord
|
|
Endproc
|
|
|
|
|
|
Procedure getID
|
|
Return This.__ObjectID
|
|
Endproc
|
|
|
|
|
|
Procedure getCodeMemo
|
|
Return ''
|
|
Endproc
|
|
|
|
|
|
Procedure getUserMemo
|
|
Return ''
|
|
Endproc
|
|
|
|
|
|
Procedure getBinMemoFromProperties
|
|
Return ''
|
|
Endproc
|
|
|
|
|
|
Procedure getReferentialIntegrityInfo
|
|
Return ''
|
|
Endproc
|
|
|
|
|
|
Procedure getObjectType
|
|
Local lcType
|
|
|
|
With This As CL_DBC_BASE Of 'FOXBIN2PRG.PRG'
|
|
Do Case
|
|
Case .Class == 'Cl_dbc'
|
|
lcType = 'Database'
|
|
|
|
Case .Class == 'Cl_dbc_connection'
|
|
lcType = 'Connection'
|
|
|
|
Case .Class == 'Cl_dbc_table'
|
|
lcType = 'Table'
|
|
|
|
Case .Class == 'Cl_dbc_view'
|
|
lcType = 'View'
|
|
|
|
Case .Class == 'Cl_dbc_index_db' Or .Class == 'Cl_dbc_index_vw'
|
|
lcType = 'Index'
|
|
|
|
Case .Class == 'Cl_dbc_relation'
|
|
lcType = 'Relation'
|
|
|
|
Case .Class == 'Cl_dbc_field_db' Or .Class == 'Cl_dbc_field_vw'
|
|
lcType = 'Field'
|
|
|
|
Otherwise
|
|
*ERROR 'Clase [' + .CLASS + '] desconocida'
|
|
Error (Textmerge(C_UNKNOWN_CLASS_NAME_LOC))
|
|
|
|
Endcase
|
|
Endwith && THIS
|
|
|
|
Return lcType
|
|
Endproc
|
|
|
|
|
|
Procedure readNext_DBC_HeaderDataRecord
|
|
Lparameters tcHeader, tnPos, tnLen, tnID, tcDataType, tcPropName, teData
|
|
|
|
Local lnOffset, llRetorno
|
|
|
|
Try
|
|
With This As CL_DBC_BASE Of 'FOXBIN2PRG.PRG'
|
|
tnPos = Evl(tnPos,1)
|
|
|
|
If tnPos >= Len(tcHeader) Then
|
|
Exit
|
|
Endif
|
|
|
|
tnLen = CToBin( Substr(tcHeader, tnPos, 4), '4RS' )
|
|
tnID = Asc( Substr(tcHeader, tnPos + 4 + 2, 1) )
|
|
tcDataType = .getDBCPropertyValueTypeByPropertyID(tnID)
|
|
lnOffset = Iif(tcDataType = 'C', 1, 0)
|
|
tcPropName = .getDBCPropertyNameByID(tnID, .T.)
|
|
teData = Substr(tcHeader, tnPos + 4 + 2 + 1, tnLen - 4 - 2 - 1 - lnOffset)
|
|
|
|
Do Case
|
|
Case tcDataType = 'B'
|
|
teData = Asc(teData)
|
|
|
|
Case tcDataType = 'L'
|
|
teData = ( CToBin( teData, "1S" ) = 1 )
|
|
|
|
Case tcDataType = 'N'
|
|
teData = CToBin( teData, "4S" )
|
|
|
|
Endcase
|
|
|
|
tnPos = tnPos + tnLen
|
|
llRetorno = .T.
|
|
Endwith
|
|
Endtry
|
|
|
|
Return llRetorno
|
|
Endproc
|
|
|
|
|
|
Procedure read_DBC_Header
|
|
Local lnLen, lnID, leData, lcHeader, lnPos, lcPropName, lcDataType, lnOffset
|
|
|
|
Try
|
|
With This As CL_DBC_BASE Of 'FOXBIN2PRG.PRG'
|
|
Go Top In TABLABIN
|
|
lcHeader = TABLABIN.Property
|
|
._Name = Upper( Justfname( Dbf("TABLABIN") ) )
|
|
|
|
Do While .readNext_DBC_HeaderDataRecord( @lcHeader, @lnPos, @lnLen, @lnID, @lcDataType, @lcPropName, @leData )
|
|
.AddProperty( '_' + lcPropName, leData )
|
|
Enddo
|
|
|
|
Endwith
|
|
Endtry
|
|
Endproc
|
|
|
|
|
|
Procedure setNextID
|
|
Lparameters tnLastID
|
|
tnLastID = tnLastID + 1
|
|
This.__ObjectID = tnLastID
|
|
Endproc
|
|
|
|
|
|
Procedure updateDBC
|
|
*---------------------------------------------------------------------------------------------------
|
|
* PARÁMETROS: (v=Pasar por valor | @=Pasar por referencia) (!=Obligatorio | ?=Opcional) (IN/OUT)
|
|
* tc_OutputFile (v! IN ) Nombre del archivo de salida
|
|
* tnLastID (!@ IN ) Último número de ID usado
|
|
* tnParentID (v! IN ) ID del objeto Padre
|
|
*---------------------------------------------------------------------------------------------------
|
|
Lparameters tc_OutputFile, tnLastID, tnParentID
|
|
|
|
Try
|
|
Local lcMemoWithProperties, lcCodeMemo, lcObjectType, lcRI_Info, lcUserMemo, lcID
|
|
|
|
With This As CL_DBC_BASE Of 'FOXBIN2PRG.PRG'
|
|
.setNextID( @tnLastID )
|
|
lcMemoWithProperties = .getBinMemoFromProperties()
|
|
lcCodeMemo = .getCodeMemo()
|
|
lcObjectType = .getObjectType()
|
|
lcRI_Info = .getReferentialIntegrityInfo()
|
|
lcUserMemo = .getUserMemo()
|
|
lcID = .getID()
|
|
|
|
Insert Into TABLABIN ;
|
|
( ObjectID ;
|
|
, ParentId ;
|
|
, ObjectType ;
|
|
, ObjectName ;
|
|
, Property ;
|
|
, Code ;
|
|
, RIInfo ;
|
|
, User ) ;
|
|
VALUES ;
|
|
( lcID ;
|
|
, tnParentID ;
|
|
, lcObjectType ;
|
|
, Iif(lcObjectType == 'View', ._Name, Lower(._Name)) ;
|
|
, lcMemoWithProperties ;
|
|
, lcCodeMemo ;
|
|
, lcRI_Info ;
|
|
, lcUserMemo )
|
|
Endwith && THIS
|
|
|
|
Catch To loEx
|
|
If This.n_Debug > 0 And _vfp.StartMode = 0
|
|
Set Step On
|
|
Endif
|
|
|
|
Throw
|
|
|
|
Endtry
|
|
|
|
Return
|
|
Endproc
|
|
|
|
|
|
Enddefine
|
|
|
|
|
|
|
|
Define Class CL_DBC As CL_DBC_BASE
|
|
#If .F.
|
|
Local This As CL_DBC Of 'FOXBIN2PRG.PRG'
|
|
#Endif
|
|
|
|
_MemberData = [<VFPData>] ;
|
|
+ [<memberdata name="analyzecodeblock_sp" display="analyzeCodeBlock_SP"/>] ;
|
|
+ [<memberdata name="_comment" display="_Comment"/>] ;
|
|
+ [<memberdata name="_version" display="_Version"/>] ;
|
|
+ [<memberdata name="_dbcevents" display="_DBCEvents"/>] ;
|
|
+ [<memberdata name="_dbceventfilename" display="_DBCEventFilename"/>] ;
|
|
+ [<memberdata name="_connections" display="_Connections"/>] ;
|
|
+ [<memberdata name="_tables" display="_Tables"/>] ;
|
|
+ [<memberdata name="_views" display="_Views"/>] ;
|
|
+ [<memberdata name="_relations" display="_Relations"/>] ;
|
|
+ [<memberdata name="_sourcefile" display="_SourceFile"/>] ;
|
|
+ [<memberdata name="_storedprocedures" display="_StoredProcedures"/>] ;
|
|
+ [<memberdata name="_version" display="_Version"/>] ;
|
|
+ [<memberdata name="_externalclasses" display="_ExternalClasses"/>] ;
|
|
+ [<memberdata name="_externalclasses_count" display="_ExternalClasses_Count"/>] ;
|
|
+ [<memberdata name="_members" display="_Members"/>] ;
|
|
+ [<memberdata name="_members_count" display="_Members_Count"/>] ;
|
|
+ [<memberdata name="add_dbcmember" display="add_DBCMember"/>] ;
|
|
+ [</VFPData>]
|
|
|
|
|
|
*-- Modulo
|
|
Dimension _ExternalClasses(1,2), _Members(1,2)
|
|
_ExternalClasses_Count = 0
|
|
_Members_Count = 0
|
|
_Version = 0
|
|
_SourceFile = ''
|
|
|
|
*-- Database Info
|
|
_Name = ''
|
|
_Comment = ''
|
|
_Version = 0
|
|
_DBCEvents = .F.
|
|
_DBCEventFilename = ''
|
|
_StoredProcedures = ''
|
|
|
|
|
|
Procedure Init
|
|
DoDefault()
|
|
*--
|
|
With This As CL_DBC Of 'FOXBIN2PRG.PRG'
|
|
.AddObject("_Connections", "CL_DBC_CONNECTIONS")
|
|
.AddObject("_Tables", "CL_DBC_TABLES")
|
|
.AddObject("_Views", "CL_DBC_VIEWS")
|
|
Endwith && THIS
|
|
Endproc
|
|
|
|
|
|
Procedure analyzeCodeBlock
|
|
*---------------------------------------------------------------------------------------------------
|
|
* PARÁMETROS: (v=Pasar por valor | @=Pasar por referencia) (!=Obligatorio | ?=Opcional) (IN/OUT)
|
|
* tcLine (!@ IN/OUT) Contenido de la línea en análisis
|
|
* taCodeLines (!@ IN ) Array de líneas del programa analizado
|
|
* I (!@ IN/OUT) Número de línea en análisis
|
|
* tnCodeLines (!@ IN ) Cantidad de líneas del programa analizado
|
|
* toFoxBin2Prg (v! IN ) Referencia al objeto principal
|
|
*--------------------------------------------------------------------------------------------------------------
|
|
Lparameters tcLine, taCodeLines, I, tnCodeLines, toFoxBin2Prg
|
|
|
|
External Array taCodeLines
|
|
|
|
#If .F.
|
|
Local toFoxBin2Prg As c_foxbin2prg Of 'FOXBIN2PRG.PRG'
|
|
#Endif
|
|
|
|
Try
|
|
Local loConnections As CL_DBC_CONNECTIONS Of 'FOXBIN2PRG.PRG' ;
|
|
, loConnection As CL_DBC_CONNECTION Of 'FOXBIN2PRG.PRG' ;
|
|
, loTables As CL_DBC_TABLES Of 'FOXBIN2PRG.PRG' ;
|
|
, loTable As CL_DBC_TABLE Of 'FOXBIN2PRG.PRG' ;
|
|
, loViews As CL_DBC_VIEWS Of 'FOXBIN2PRG.PRG' ;
|
|
, loView As CL_DBC_VIEW Of 'FOXBIN2PRG.PRG' ;
|
|
, llBloqueEncontrado, lcPropName, lcValue, loEx As Exception
|
|
Store '' To lcPropName, lcValue
|
|
Store Null To loConnections, loTables, loViews, loConnection, loTable, loView
|
|
|
|
If Left(tcLine, Len(C_DATABASE_I)) == C_DATABASE_I
|
|
llBloqueEncontrado = .T.
|
|
|
|
With This As CL_DBC Of 'FOXBIN2PRG.PRG'
|
|
For I = m.I + 1 To tnCodeLines
|
|
.set_Line( @tcLine, @taCodeLines, m.I )
|
|
|
|
Do Case
|
|
Case Empty( tcLine )
|
|
Loop
|
|
|
|
Case C_DATABASE_F $ tcLine && Fin
|
|
Exit
|
|
|
|
Case C_CONNECTIONS_I $ tcLine
|
|
loConnections = ._Connections
|
|
loConnections.analyzeCodeBlock( @tcLine, @taCodeLines, @m.I, tnCodeLines )
|
|
|
|
loConnections.KeySort=2
|
|
For Each loConnection In loConnections &&FOXOBJECT
|
|
.add_DBCMember('connection.' + loConnection._Name)
|
|
Endfor
|
|
|
|
Case C_TABLES_I $ tcLine
|
|
loTables = ._Tables
|
|
loTables.analyzeCodeBlock( @tcLine, @taCodeLines, @m.I, tnCodeLines )
|
|
|
|
loTables.KeySort=2
|
|
For Each loTable In loTables &&FOXOBJECT
|
|
.add_DBCMember('table.' + loTable._Name)
|
|
Endfor
|
|
|
|
Case C_VIEWS_I $ tcLine
|
|
loViews = ._Views
|
|
loViews.analyzeCodeBlock( @tcLine, @taCodeLines, @m.I, tnCodeLines )
|
|
|
|
loViews.KeySort=2
|
|
For Each loView In loViews &&FOXOBJECT
|
|
.add_DBCMember('view.' + loView._Name)
|
|
Endfor
|
|
|
|
Case C_STORED_PROC_I $ tcLine
|
|
.analyzeCodeBlock_SP( @tcLine, @taCodeLines, @m.I, tnCodeLines )
|
|
.add_DBCMember('database.storedproceduressource')
|
|
|
|
Case '<Comment>' $ tcLine
|
|
.analyzeCodeBlock_Comment( @tcLine, @taCodeLines, @m.I, tnCodeLines )
|
|
|
|
Otherwise && Otro valor
|
|
*-- Estructura a reconocer:
|
|
* <tagname>ID<tagname>
|
|
lcPropName = Strextract( tcLine, '<', '>', 1, 0 )
|
|
lcValue = Strextract( tcLine, '<' + lcPropName + '>', '</' + lcPropName + '>', 1, 0 )
|
|
.add_Property( '_' + lcPropName, lcValue )
|
|
Endcase
|
|
Endfor
|
|
Endwith && THIS
|
|
Endif
|
|
|
|
Catch To loEx
|
|
If loEx.ErrorNo = 1470 && Incorrect property name.
|
|
loEx.UserValue = 'I=' + Transform(m.I) + ', PropName=[' + Transform(lcPropName) + '], Value=[' + Transform(lcValue) + ']'
|
|
Endif
|
|
|
|
If This.n_Debug > 0 And _vfp.StartMode = 0
|
|
Set Step On
|
|
Endif
|
|
|
|
Throw
|
|
|
|
Finally
|
|
Store Null To loConnections, loTables, loViews, loConnection, loTable, loView
|
|
Release loConnections, loTables, loViews, loConnection, loTable, loView
|
|
Endtry
|
|
|
|
Return llBloqueEncontrado
|
|
Endproc
|
|
|
|
|
|
Procedure analyzeCodeBlock_SP
|
|
*---------------------------------------------------------------------------------------------------
|
|
* PARÁMETROS: (v=Pasar por valor | @=Pasar por referencia) (!=Obligatorio | ?=Opcional) (IN/OUT)
|
|
* tcLine (!@ IN/OUT) Contenido de la línea en análisis
|
|
* taCodeLines (!@ IN ) Array de líneas del programa analizado
|
|
* I (!@ IN/OUT) Número de línea en análisis
|
|
* tnCodeLines (!@ IN ) Cantidad de líneas del programa analizado
|
|
*---------------------------------------------------------------------------------------------------
|
|
Lparameters tcLine, taCodeLines, I, tnCodeLines
|
|
|
|
If Left(tcLine, Len(C_STORED_PROC_I)) == C_STORED_PROC_I
|
|
Local lcValue
|
|
lcValue = ''
|
|
|
|
With This As CL_DBC Of 'FOXBIN2PRG.PRG'
|
|
For I = m.I + 1 To tnCodeLines
|
|
.set_Line( @tcLine, @taCodeLines, m.I )
|
|
|
|
Do Case
|
|
Case C_STORED_PROC_F $ tcLine && Fin
|
|
Exit
|
|
|
|
Otherwise && Línea de Stored Procedure
|
|
lcValue = lcValue + CR_LF + taCodeLines(m.I)
|
|
Endcase
|
|
Endfor
|
|
|
|
.AddProperty( '_StoredProcedures', Substr(lcValue,3) )
|
|
Endwith && THIS
|
|
Endif
|
|
Endproc
|
|
|
|
|
|
Procedure updateDBC
|
|
*---------------------------------------------------------------------------------------------------
|
|
* PARÁMETROS: (v=Pasar por valor | @=Pasar por referencia) (!=Obligatorio | ?=Opcional) (IN/OUT)
|
|
* tc_OutputFile (v! IN ) Nombre del archivo de salida
|
|
* tnLastID (!@ IN ) Último número de ID usado
|
|
* tnParentID (v! IN ) ID del objeto Padre
|
|
*---------------------------------------------------------------------------------------------------
|
|
Lparameters tc_OutputFile, tnLastID, tnParentID
|
|
|
|
Try
|
|
Local loTables As CL_DBC_TABLES Of 'FOXBIN2PRG.PRG' ;
|
|
, loConnections As CL_DBC_CONNECTIONS Of 'FOXBIN2PRG.PRG' ;
|
|
, loViews As CL_DBC_VIEWS Of 'FOXBIN2PRG.PRG'
|
|
Local lcStoredProcedures
|
|
Store Null To loTables, loConnections, loViews
|
|
|
|
With This As CL_DBC Of 'FOXBIN2PRG.PRG'
|
|
loTables = ._Tables
|
|
loConnections = ._Connections
|
|
loViews = ._Views
|
|
lcStoredProcedures = ._StoredProcedures
|
|
|
|
Erase (tc_OutputFile)
|
|
Erase (Forceext(tc_OutputFile,'DCX'))
|
|
Erase (Forceext(tc_OutputFile,'DCT'))
|
|
Create Database (tc_OutputFile)
|
|
Close Databases
|
|
Open Database (tc_OutputFile) Shared
|
|
Use (tc_OutputFile) Shared Again Alias TABLABIN
|
|
tnLastID = 5
|
|
.setNextID(0)
|
|
tnParentID = .__ObjectID
|
|
|
|
lcMemoWithProperties = .getBinMemoFromProperties()
|
|
Update TABLABIN ;
|
|
SET Property = lcMemoWithProperties ;
|
|
WHERE Str(ParentId) + ObjectType + Lower(ObjectName) = Str(1) + Padr('Database',10) + Padr(Lower('Database'),128)
|
|
|
|
If Not Empty(lcStoredProcedures)
|
|
Update TABLABIN ;
|
|
SET Code = lcStoredProcedures ;
|
|
WHERE Str(ParentId) + ObjectType + Lower(ObjectName) = Str(1) + Padr('Database',10) + Padr(Lower('StoredProceduresSource'),128)
|
|
Endif
|
|
|
|
loTables.updateDBC( tc_OutputFile, @tnLastID, tnParentID )
|
|
loViews.updateDBC( tc_OutputFile, @tnLastID, tnParentID )
|
|
loConnections.updateDBC( tc_OutputFile, @tnLastID, tnParentID )
|
|
Endwith && THIS
|
|
|
|
|
|
Catch To loEx
|
|
If This.n_Debug > 0 And _vfp.StartMode = 0
|
|
Set Step On
|
|
Endif
|
|
|
|
Throw
|
|
|
|
Finally
|
|
Close Databases
|
|
Use In (Select("TABLABIN"))
|
|
Store Null To loTables, loConnections, loViews
|
|
Release loTables, loConnections, loViews
|
|
|
|
Endtry
|
|
|
|
Return
|
|
Endproc
|
|
|
|
|
|
|
|
Procedure toText
|
|
Lparameters toFoxBin2Prg
|
|
|
|
#If .F.
|
|
Local toFoxBin2Prg As c_foxbin2prg Of 'FOXBIN2PRG.PRG'
|
|
#Endif
|
|
|
|
Try
|
|
Local I, lcText, lcDBC, laCode(1,1), lcConnections, lcTables, lcViews, loEx As Exception ;
|
|
, loConnections As CL_DBC_CONNECTIONS Of 'FOXBIN2PRG.PRG' ;
|
|
, loTables As CL_DBC_TABLES Of 'FOXBIN2PRG.PRG' ;
|
|
, loViews As CL_DBC_VIEWS Of 'FOXBIN2PRG.PRG' ;
|
|
, loRelations As CL_DBC_RELATIONS Of 'FOXBIN2PRG.PRG'
|
|
Store Null To loRelations, loViews, loTables, loTables
|
|
|
|
With This As CL_DBC Of 'FOXBIN2PRG.PRG'
|
|
Store '' To lcText, lcConnections, lcTables, lcViews
|
|
lcDBC = Juststem(Dbc())
|
|
|
|
TEXT TO lcText ADDITIVE TEXTMERGE NOSHOW FLAGS 1+2 PRETEXT 1+2
|
|
<<>>
|
|
<DATABASE>
|
|
<<>> <Name><<lcDBC>></Name>
|
|
<<>> <Comment><<DBGETPROP(lcDBC,"DATABASE","Comment")>></Comment>
|
|
<<>> <Version><<DBGETPROP(lcDBC,"DATABASE","Version")>></Version>
|
|
<<>> <DBCEvents><<DBGETPROP(lcDBC,"DATABASE","DBCEvents")>></DBCEvents>
|
|
<<>> <DBCEventFilename><<DBGETPROP(lcDBC,"DATABASE","DBCEventFilename")>></DBCEventFilename>
|
|
ENDTEXT
|
|
|
|
*-- Connections
|
|
loConnections = ._Connections
|
|
lcConnections = loConnections.toText( @toFoxBin2Prg )
|
|
|
|
*-- Tables
|
|
loTables = ._Tables
|
|
lcTables = loTables.toText( @toFoxBin2Prg )
|
|
|
|
*-- Views
|
|
loViews = ._Views
|
|
lcViews = loViews.toText( @toFoxBin2Prg )
|
|
|
|
Select Code ;
|
|
FROM TABLABIN ;
|
|
WHERE Str(ParentId) + ObjectType + Lower(ObjectName) = Str(1) + Padr('Database',10) + Padr(Lower('StoredProceduresSource'),128) ;
|
|
INTO Array laCode
|
|
TEXT TO ._StoredProcedures TEXTMERGE NOSHOW FLAGS 1+2 PRETEXT 1+2
|
|
<<>> <<C_STORED_PROC_I>>
|
|
<<laCode(1,1)>>
|
|
<<>> <<C_STORED_PROC_F>>
|
|
ENDTEXT
|
|
|
|
If Not toFoxBin2Prg.n_UseFilesPerDBC > 0 Then
|
|
TEXT TO lcText ADDITIVE TEXTMERGE NOSHOW FLAGS 1+2 PRETEXT 1+2
|
|
<<lcConnections>>
|
|
<<lcTables>>
|
|
<<lcViews>>
|
|
<<>>
|
|
<<._StoredProcedures>>
|
|
ENDTEXT
|
|
Endif
|
|
|
|
TEXT TO lcText ADDITIVE TEXTMERGE NOSHOW FLAGS 1+2 PRETEXT 1+2
|
|
</DATABASE>
|
|
ENDTEXT
|
|
Endwith && THIS
|
|
|
|
|
|
Catch To loEx
|
|
If This.n_Debug > 0 And _vfp.StartMode = 0
|
|
Set Step On
|
|
Endif
|
|
|
|
Throw
|
|
|
|
Finally
|
|
Store Null To loRelations, loViews, loTables, loTables
|
|
Release I, lcDBC, laCode, loConnections, loTables, loViews, loRelations
|
|
|
|
Endtry
|
|
|
|
Return lcText
|
|
Endproc
|
|
|
|
|
|
Procedure getBinMemoFromProperties
|
|
Local lcBinData
|
|
lcBinData = ''
|
|
|
|
With This As CL_DBC Of 'FOXBIN2PRG.PRG'
|
|
lcBinData = lcBinData + .getBinPropertyDataRecord( ._Version, .getDBCPropertyIDByName('Version', .T.) )
|
|
lcBinData = lcBinData + .getBinPropertyDataRecord( ._Comment, .getDBCPropertyIDByName('Comment', .T.) )
|
|
lcBinData = lcBinData + .getBinPropertyDataRecord( ._DBCEvents, .getDBCPropertyIDByName('DBCEvents', .T.) )
|
|
lcBinData = lcBinData + .getBinPropertyDataRecord( ._DBCEventFilename, .getDBCPropertyIDByName('DBCEventFilename', .T.) )
|
|
Endwith && THIS
|
|
|
|
Return lcBinData
|
|
Endproc
|
|
|
|
|
|
Procedure add_DBCMember
|
|
Lparameters tcMemberName
|
|
|
|
With This As CL_DBC Of 'FOXBIN2PRG.PRG'
|
|
._Members_Count = ._Members_Count + 1
|
|
Dimension ._Members( ._Members_Count, 2 )
|
|
._Members( ._Members_Count, 1 ) = Lower(tcMemberName)
|
|
Endwith && THIS
|
|
Endproc
|
|
|
|
|
|
Enddefine
|
|
|
|
|
|
|
|
Define Class CL_DBC_CONNECTIONS As CL_DBC_COL_BASE
|
|
#If .F.
|
|
Local This As CL_DBC_CONNECTIONS Of 'FOXBIN2PRG.PRG'
|
|
#Endif
|
|
|
|
|
|
|
|
Procedure analyzeCodeBlock
|
|
*---------------------------------------------------------------------------------------------------
|
|
* PARÁMETROS: (v=Pasar por valor | @=Pasar por referencia) (!=Obligatorio | ?=Opcional) (IN/OUT)
|
|
* tcLine (!@ IN/OUT) Contenido de la línea en análisis
|
|
* taCodeLines (!@ IN ) Array de líneas del programa analizado
|
|
* I (!@ IN/OUT) Número de línea en análisis
|
|
* tnCodeLines (!@ IN ) Cantidad de líneas del programa analizado
|
|
*---------------------------------------------------------------------------------------------------
|
|
Lparameters tcLine, taCodeLines, I, tnCodeLines
|
|
|
|
Try
|
|
Local llBloqueEncontrado, lcPropName, lcValue, loEx As Exception ;
|
|
, loConnection As CL_DBC_CONNECTION Of 'FOXBIN2PRG.PRG'
|
|
Store Null To loConnection
|
|
Store '' To lcPropName, lcValue
|
|
|
|
If Left(tcLine, Len(C_CONNECTIONS_I)) == C_CONNECTIONS_I
|
|
llBloqueEncontrado = .T.
|
|
|
|
With This As CL_DBC_CONNECTIONS Of 'FOXBIN2PRG.PRG'
|
|
For I = m.I + 1 To tnCodeLines
|
|
.set_Line( @tcLine, @taCodeLines, m.I )
|
|
|
|
Do Case
|
|
Case Empty( tcLine )
|
|
Loop
|
|
|
|
Case C_CONNECTIONS_F $ tcLine && Fin
|
|
Exit
|
|
|
|
Case C_CONNECTION_I $ tcLine
|
|
loConnection = Createobject("CL_DBC_CONNECTION")
|
|
loConnection.analyzeCodeBlock( @tcLine, @taCodeLines, @m.I, tnCodeLines )
|
|
*-- El siguiente PADR() es porque si no "estoXXX" está antes que "esto" cuando keysort=2 (raro...)
|
|
.Add( loConnection, Padr(loConnection._Name,128) )
|
|
|
|
Case '<Comment>' $ tcLine
|
|
.analyzeCodeBlock_Comment( @tcLine, @taCodeLines, @m.I, tnCodeLines )
|
|
|
|
Otherwise && Otro valor
|
|
*-- No hay otros valores
|
|
Endcase
|
|
Endfor
|
|
Endwith && THIS
|
|
Endif
|
|
|
|
Catch To loEx
|
|
If loEx.ErrorNo = 1470 && Incorrect property name.
|
|
loEx.UserValue = 'I=' + Transform(m.I) + ', tcLine=' + Transform(tcLine)
|
|
Endif
|
|
|
|
If This.n_Debug > 0 And _vfp.StartMode = 0
|
|
Set Step On
|
|
Endif
|
|
|
|
Throw
|
|
|
|
Finally
|
|
Store Null To loConnection
|
|
Release lcPropName, lcValue, loConnection
|
|
|
|
Endtry
|
|
|
|
Return llBloqueEncontrado
|
|
Endproc
|
|
|
|
|
|
|
|
Procedure toText
|
|
*---------------------------------------------------------------------------------------------------
|
|
* PARÁMETROS: (v=Pasar por valor | @=Pasar por referencia) (!=Obligatorio | ?=Opcional) (IN/OUT)
|
|
* toFoxBin2Prg (@! IN ) Referencia de toFoxBin2Prg
|
|
*---------------------------------------------------------------------------------------------------
|
|
Lparameters toFoxBin2Prg
|
|
|
|
#If .F.
|
|
Local toFoxBin2Prg As c_foxbin2prg Of 'FOXBIN2PRG.PRG'
|
|
#Endif
|
|
|
|
Try
|
|
Local lcText, loEx As Exception ;
|
|
, loConnection As CL_DBC_CONNECTION Of 'FOXBIN2PRG.PRG'
|
|
|
|
With This As CL_DBC_CONNECTIONS Of 'FOXBIN2PRG.PRG'
|
|
loConnection = Null
|
|
lcText = ''
|
|
.read_BinDataToProperties()
|
|
|
|
If .Count > 0 Then
|
|
|
|
TEXT TO lcText ADDITIVE TEXTMERGE NOSHOW FLAGS 1+2 PRETEXT 1+2
|
|
<<>> <CONNECTIONS>
|
|
ENDTEXT
|
|
|
|
.KeySort = 2
|
|
For Each loConnection In This &&FOXOBJECT
|
|
lcText = lcText + loConnection.toText( loConnection._Name )
|
|
Endfor
|
|
|
|
TEXT TO lcText ADDITIVE TEXTMERGE NOSHOW FLAGS 1+2 PRETEXT 1+2
|
|
<<>> </CONNECTIONS>
|
|
<<>>
|
|
ENDTEXT
|
|
Endif
|
|
|
|
Endwith
|
|
|
|
Catch To loEx
|
|
If This.n_Debug > 0 And _vfp.StartMode = 0
|
|
Set Step On
|
|
Endif
|
|
|
|
Throw
|
|
|
|
Finally
|
|
loConnection = Null
|
|
Release loConnection
|
|
|
|
Endtry
|
|
|
|
Return lcText
|
|
Endproc
|
|
|
|
|
|
Procedure read_BinDataToProperties
|
|
*---------------------------------------------------------------------------------------------------
|
|
* PARÁMETROS: (v=Pasar por valor | @=Pasar por referencia) (!=Obligatorio | ?=Opcional) (IN/OUT)
|
|
* toFoxBin2Prg (@! IN ) Referencia de toFoxBin2Prg
|
|
*---------------------------------------------------------------------------------------------------
|
|
Lparameters toFoxBin2Prg
|
|
|
|
#If .F.
|
|
Local toFoxBin2Prg As c_foxbin2prg Of 'FOXBIN2PRG.PRG'
|
|
#Endif
|
|
|
|
Try
|
|
With This As CL_DBC_CONNECTIONS Of 'FOXBIN2PRG.PRG'
|
|
Local I, lnConnection_Count, laConnections(1), loEx As Exception ;
|
|
, loConnection As CL_DBC_CONNECTION Of 'FOXBIN2PRG.PRG'
|
|
|
|
If ._Saved Then
|
|
lnConnection_Count = .Count
|
|
Exit
|
|
Endif
|
|
|
|
loConnection = Null
|
|
lnConnection_Count = Adbobjects( laConnections,"CONNECTION" )
|
|
|
|
If lnConnection_Count > 0
|
|
For I = 1 To lnConnection_Count
|
|
loConnection = Createobject('CL_DBC_CONNECTION')
|
|
loConnection.read_BinDataToProperties( laConnections(m.I) )
|
|
*-- El siguiente PADR() es porque si no "estoXXX" está antes que "esto" cuando keysort=2 (raro...)
|
|
.Add( loConnection, Padr(Lower(loConnection._Name),128) )
|
|
Endfor
|
|
Endif
|
|
Endwith
|
|
|
|
Catch To loEx
|
|
If This.n_Debug > 0 And _vfp.StartMode = 0
|
|
Set Step On
|
|
Endif
|
|
|
|
Throw
|
|
|
|
Finally
|
|
loConnection = Null
|
|
Release I, loConnection
|
|
|
|
Endtry
|
|
|
|
Return lnConnection_Count
|
|
Endproc
|
|
|
|
|
|
Enddefine
|
|
|
|
|
|
|
|
Define Class CL_DBC_CONNECTION As CL_DBC_BASE
|
|
#If .F.
|
|
Local This As CL_DBC_CONNECTION Of 'FOXBIN2PRG.PRG'
|
|
#Endif
|
|
|
|
_MemberData = [<VFPData>] ;
|
|
+ [<memberdata name="_name" display="_Name"/>] ;
|
|
+ [<memberdata name="_comment" display="_Comment"/>] ;
|
|
+ [<memberdata name="_datasource" display="_DataSource"/>] ;
|
|
+ [<memberdata name="_database" display="_Database"/>] ;
|
|
+ [<memberdata name="_connectstring" display="_ConnectString"/>] ;
|
|
+ [<memberdata name="_asynchronous" display="_Asynchronous"/>] ;
|
|
+ [<memberdata name="_batchmode" display="_BatchMode"/>] ;
|
|
+ [<memberdata name="_connecttimeout" display="_ConnectTimeout"/>] ;
|
|
+ [<memberdata name="_disconnectrollback" display="_DisconnectRollback"/>] ;
|
|
+ [<memberdata name="_displogin" display="_DispLogin"/>] ;
|
|
+ [<memberdata name="_dispwarnings" display="_DispWarnings"/>] ;
|
|
+ [<memberdata name="_idletimeout" display="_IdleTimeout"/>] ;
|
|
+ [<memberdata name="_packetsize" display="_PacketSize"/>] ;
|
|
+ [<memberdata name="_password" display="_PassWord"/>] ;
|
|
+ [<memberdata name="_querytimeout" display="_QueryTimeout"/>] ;
|
|
+ [<memberdata name="_transactions" display="_Transactions"/>] ;
|
|
+ [<memberdata name="_userid" display="_UserId"/>] ;
|
|
+ [<memberdata name="_waittime" display="_WaitTime"/>] ;
|
|
+ [</VFPData>]
|
|
|
|
|
|
*-- Info
|
|
_Name = ''
|
|
_Comment = ''
|
|
_DataSource = ''
|
|
_Database = ''
|
|
_ConnectString = ''
|
|
_Asynchronous = .F.
|
|
_BatchMode = .F.
|
|
_ConnectTimeout = 0
|
|
_DisconnectRollback = .F.
|
|
_DispLogin = 0
|
|
_DispWarnings = .F.
|
|
_IdleTimeout = 0
|
|
_PacketSize = 0
|
|
_PassWord = ''
|
|
_QueryTimeout = 0
|
|
_Transactions = ''
|
|
_UserId = ''
|
|
_WaitTime = 0
|
|
|
|
|
|
Procedure analyzeCodeBlock
|
|
*---------------------------------------------------------------------------------------------------
|
|
* PARÁMETROS: (v=Pasar por valor | @=Pasar por referencia) (!=Obligatorio | ?=Opcional) (IN/OUT)
|
|
* tcLine (!@ IN/OUT) Contenido de la línea en análisis
|
|
* taCodeLines (!@ IN ) Array de líneas del programa analizado
|
|
* I (!@ IN/OUT) Número de línea en análisis
|
|
* tnCodeLines (!@ IN ) Cantidad de líneas del programa analizado
|
|
*---------------------------------------------------------------------------------------------------
|
|
Lparameters tcLine, taCodeLines, I, tnCodeLines
|
|
|
|
Try
|
|
Local llBloqueEncontrado, lcPropName, lcValue, loEx As Exception
|
|
Store '' To lcPropName, lcValue
|
|
|
|
If Left(tcLine, Len(C_CONNECTION_I)) == C_CONNECTION_I
|
|
llBloqueEncontrado = .T.
|
|
|
|
With This As CL_DBC_CONNECTION Of 'FOXBIN2PRG.PRG'
|
|
For I = m.I + 1 To tnCodeLines
|
|
.set_Line( @tcLine, @taCodeLines, m.I )
|
|
|
|
Do Case
|
|
Case Empty( tcLine )
|
|
Loop
|
|
|
|
Case C_CONNECTION_F $ tcLine && Fin
|
|
Exit
|
|
|
|
Case '<Comment>' $ tcLine
|
|
.analyzeCodeBlock_Comment( @tcLine, @taCodeLines, @m.I, tnCodeLines )
|
|
|
|
Otherwise && Propiedad de CONNECTION
|
|
*-- Estructura a reconocer:
|
|
* <name>NOMBRE</name>
|
|
lcPropName = Strextract( tcLine, '<', '>', 1, 0 )
|
|
lcValue = Strextract( tcLine, '<' + lcPropName + '>', '</' + lcPropName + '>', 1, 0 )
|
|
.add_Property( '_' + lcPropName, lcValue )
|
|
Endcase
|
|
Endfor
|
|
Endwith && THIS
|
|
Endif
|
|
|
|
Catch To loEx
|
|
If loEx.ErrorNo = 1470 && Incorrect property name.
|
|
loEx.UserValue = 'I=' + Transform(m.I) + ', tcLine=' + Transform(tcLine) + ', PropName=[' + Transform(lcPropName) + '], Value=[' + Transform(lcValue) + ']'
|
|
Endif
|
|
|
|
If This.n_Debug > 0 And _vfp.StartMode = 0
|
|
Set Step On
|
|
Endif
|
|
|
|
Throw
|
|
|
|
Endtry
|
|
|
|
Return llBloqueEncontrado
|
|
Endproc
|
|
|
|
|
|
Procedure toText
|
|
*---------------------------------------------------------------------------------------------------
|
|
* PARÁMETROS: (v=Pasar por valor | @=Pasar por referencia) (!=Obligatorio | ?=Opcional) (IN/OUT)
|
|
* tcConnection (v! IN ) Nombre de la Conexión
|
|
*---------------------------------------------------------------------------------------------------
|
|
Lparameters tcConnection
|
|
|
|
Try
|
|
Local lcText, loEx As Exception
|
|
|
|
With This As CL_DBC_CONNECTION Of 'FOXBIN2PRG.PRG'
|
|
.read_BinDataToProperties(tcConnection)
|
|
|
|
TEXT TO lcText TEXTMERGE NOSHOW FLAGS 1+2 PRETEXT 1+2
|
|
<<>> <CONNECTION>
|
|
<<>> <Name><<._Name>></Name>
|
|
<<>> <Comment><<._Comment>></Comment>
|
|
<<>> <DataSource><<._DataSource>></DataSource>
|
|
<<>> <Database><<._Database>></Database>
|
|
<<>> <ConnectString><<._ConnectString>></ConnectString>
|
|
<<>> <Asynchronous><<._Asynchronous>></Asynchronous>
|
|
<<>> <BatchMode><<._BatchMode>></BatchMode>
|
|
<<>> <ConnectTimeout><<._ConnectTimeout>></ConnectTimeout>
|
|
<<>> <DisconnectRollback><<._DisconnectRollback>></DisconnectRollback>
|
|
<<>> <DispLogin><<._DispLogin>></DispLogin>
|
|
<<>> <DispWarnings><<._DispWarnings>></DispWarnings>
|
|
<<>> <IdleTimeout><<._IdleTimeout>></IdleTimeout>
|
|
<<>> <PacketSize><<._PacketSize>></PacketSize>
|
|
<<>> <PassWord><<._PassWord>></PassWord>
|
|
<<>> <QueryTimeout><<._QueryTimeout>></QueryTimeout>
|
|
<<>> <Transactions><<._Transactions>></Transactions>
|
|
<<>> <UserId><<._UserId>></UserId>
|
|
<<>> <WaitTime><<._WaitTime>></WaitTime>
|
|
<<>> </CONNECTION>
|
|
ENDTEXT
|
|
|
|
._ToText = lcText
|
|
Endwith
|
|
|
|
Catch To loEx
|
|
If This.n_Debug > 0 And _vfp.StartMode = 0
|
|
Set Step On
|
|
Endif
|
|
|
|
Throw
|
|
|
|
Endtry
|
|
|
|
Return lcText
|
|
Endproc
|
|
|
|
|
|
Procedure getBinMemoFromProperties
|
|
Local lcBinData
|
|
lcBinData = ''
|
|
|
|
With This As CL_DBC_CONNECTION Of 'FOXBIN2PRG.PRG'
|
|
lcBinData = lcBinData + .getBinPropertyDataRecord( ._Asynchronous, .getDBCPropertyIDByName('Asynchronous', .T.) )
|
|
lcBinData = lcBinData + .getBinPropertyDataRecord( ._BatchMode, .getDBCPropertyIDByName('BatchMode', .T.) )
|
|
lcBinData = lcBinData + .getBinPropertyDataRecord( ._DispWarnings, .getDBCPropertyIDByName('DispWarnings') )
|
|
lcBinData = lcBinData + .getBinPropertyDataRecord( ._DispLogin, .getDBCPropertyIDByName('DispLogin', .T.) )
|
|
lcBinData = lcBinData + .getBinPropertyDataRecord( ._Transactions, .getDBCPropertyIDByName('Transactions', .T.) )
|
|
lcBinData = lcBinData + .getBinPropertyDataRecord( ._DisconnectRollback, .getDBCPropertyIDByName('DisconnectRollback', .T.) ) && Undocumented
|
|
lcBinData = lcBinData + .getBinPropertyDataRecord( ._ConnectTimeout , .getDBCPropertyIDByName('ConnectTimeout', .T.) )
|
|
lcBinData = lcBinData + .getBinPropertyDataRecord( ._QueryTimeout, .getDBCPropertyIDByName('QueryTimeout', .T.) )
|
|
lcBinData = lcBinData + .getBinPropertyDataRecord( ._IdleTimeout, .getDBCPropertyIDByName('IdleTimeout', .T.) )
|
|
lcBinData = lcBinData + .getBinPropertyDataRecord( ._WaitTime, .getDBCPropertyIDByName('WaitTime', .T.) )
|
|
lcBinData = lcBinData + .getBinPropertyDataRecord( ._PacketSize, .getDBCPropertyIDByName('PacketSize', .T.) ) && Undocumented
|
|
lcBinData = lcBinData + .getBinPropertyDataRecord( ._DataSource, .getDBCPropertyIDByName('DataSource', .T.) )
|
|
lcBinData = lcBinData + .getBinPropertyDataRecord( ._UserId, .getDBCPropertyIDByName('UserId', .T.) )
|
|
lcBinData = lcBinData + .getBinPropertyDataRecord( ._PassWord, .getDBCPropertyIDByName('PassWord', .T.) )
|
|
lcBinData = lcBinData + .getBinPropertyDataRecord( ._Database, .getDBCPropertyIDByName('Database', .T.) )
|
|
lcBinData = lcBinData + .getBinPropertyDataRecord( ._ConnectString, .getDBCPropertyIDByName('ConnectString', .T.) )
|
|
lcBinData = lcBinData + .getBinPropertyDataRecord( ._Comment, .getDBCPropertyIDByName('Comment', .T.) )
|
|
Endwith
|
|
|
|
Return lcBinData
|
|
Endproc
|
|
|
|
|
|
Procedure read_BinDataToProperties
|
|
Lparameters tcConnection
|
|
|
|
With This As CL_DBC_CONNECTION Of 'FOXBIN2PRG.PRG'
|
|
If Not ._Saved Then
|
|
._Name = Alltrim(tcConnection)
|
|
._Comment = DBGetProp(tcConnection,"CONNECTION","Comment")
|
|
._DataSource = DBGetProp(tcConnection,"CONNECTION","DataSource")
|
|
._Database = DBGetProp(tcConnection,"CONNECTION","Database")
|
|
._ConnectString = DBGetProp(tcConnection,"CONNECTION","ConnectString")
|
|
._Asynchronous = DBGetProp(tcConnection,"CONNECTION","Asynchronous")
|
|
._BatchMode = DBGetProp(tcConnection,"CONNECTION","BatchMode")
|
|
._ConnectTimeout = DBGetProp(tcConnection,"CONNECTION","ConnectTimeout")
|
|
._DisconnectRollback = DBGetProp(tcConnection,"CONNECTION","DisconnectRollback")
|
|
._DispLogin = DBGetProp(tcConnection,"CONNECTION","DispLogin")
|
|
._DispWarnings = DBGetProp(tcConnection,"CONNECTION","DispWarnings")
|
|
._IdleTimeout = DBGetProp(tcConnection,"CONNECTION","IdleTimeout")
|
|
._PacketSize = DBGetProp(tcConnection,"CONNECTION","PacketSize")
|
|
._PassWord = DBGetProp(tcConnection,"CONNECTION","PassWord")
|
|
._QueryTimeout = DBGetProp(tcConnection,"CONNECTION","QueryTimeout")
|
|
._Transactions = DBGetProp(tcConnection,"CONNECTION","Transactions")
|
|
._UserId = DBGetProp(tcConnection,"CONNECTION","UserId")
|
|
._WaitTime = DBGetProp(tcConnection,"CONNECTION","WaitTime")
|
|
*--
|
|
._Saved = .T.
|
|
Endif
|
|
Endwith
|
|
Endproc
|
|
|
|
|
|
Enddefine
|
|
|
|
|
|
|
|
Define Class CL_DBC_TABLES As CL_DBC_COL_BASE
|
|
#If .F.
|
|
Local This As CL_DBC_TABLES Of 'FOXBIN2PRG.PRG'
|
|
#Endif
|
|
|
|
|
|
|
|
Procedure analyzeCodeBlock
|
|
*---------------------------------------------------------------------------------------------------
|
|
* PARÁMETROS: (v=Pasar por valor | @=Pasar por referencia) (!=Obligatorio | ?=Opcional) (IN/OUT)
|
|
* tcLine (!@ IN/OUT) Contenido de la línea en análisis
|
|
* taCodeLines (!@ IN ) Array de líneas del programa analizado
|
|
* I (!@ IN/OUT) Número de línea en análisis
|
|
* tnCodeLines (!@ IN ) Cantidad de líneas del programa analizado
|
|
*---------------------------------------------------------------------------------------------------
|
|
Lparameters tcLine, taCodeLines, I, tnCodeLines
|
|
|
|
Try
|
|
Local llBloqueEncontrado, lcPropName, lcValue, loEx As Exception ;
|
|
, loTable As CL_DBC_TABLE Of 'FOXBIN2PRG.PRG'
|
|
Store Null To loTable
|
|
Store '' To lcPropName, lcValue
|
|
|
|
If Left(tcLine, Len(C_TABLES_I)) == C_TABLES_I
|
|
llBloqueEncontrado = .T.
|
|
|
|
With This As CL_DBC_TABLES Of 'FOXBIN2PRG.PRG'
|
|
For I = m.I + 1 To tnCodeLines
|
|
.set_Line( @tcLine, @taCodeLines, m.I )
|
|
|
|
Do Case
|
|
Case Empty( tcLine )
|
|
Loop
|
|
|
|
Case C_TABLES_F $ tcLine && Fin
|
|
Exit
|
|
|
|
Case C_TABLE_I $ tcLine
|
|
loTable = Createobject("CL_DBC_TABLE")
|
|
loTable.analyzeCodeBlock( @tcLine, @taCodeLines, @m.I, tnCodeLines )
|
|
*-- El siguiente PADR() es porque si no "estoXXX" está antes que "esto" cuando keysort=2 (raro...)
|
|
.Add( loTable, Padr(Lower(loTable._Name),128) )
|
|
|
|
Otherwise && Otro valor
|
|
*-- No hay otros valores
|
|
Endcase
|
|
Endfor
|
|
Endwith && THIS
|
|
Endif
|
|
|
|
Catch To loEx
|
|
If loEx.ErrorNo = 1470 && Incorrect property name.
|
|
loEx.UserValue = 'I=' + Transform(m.I) + ', tcLine=' + Transform(tcLine)
|
|
Endif
|
|
|
|
If This.n_Debug > 0 And _vfp.StartMode = 0
|
|
Set Step On
|
|
Endif
|
|
|
|
Throw
|
|
|
|
Finally
|
|
Store Null To loTable
|
|
Release lcPropName, lcValue, loTable
|
|
|
|
Endtry
|
|
|
|
Return llBloqueEncontrado
|
|
Endproc
|
|
|
|
|
|
|
|
Procedure toText
|
|
*---------------------------------------------------------------------------------------------------
|
|
* PARÁMETROS: (v=Pasar por valor | @=Pasar por referencia) (!=Obligatorio | ?=Opcional) (IN/OUT)
|
|
* toFoxBin2Prg (@! IN ) Referencia de toFoxBin2Prg
|
|
*---------------------------------------------------------------------------------------------------
|
|
Lparameters toFoxBin2Prg
|
|
|
|
#If .F.
|
|
Local toFoxBin2Prg As c_foxbin2prg Of 'FOXBIN2PRG.PRG'
|
|
#Endif
|
|
|
|
Try
|
|
Local lcText, loEx As Exception ;
|
|
, loTable As CL_DBC_TABLE Of 'FOXBIN2PRG.PRG'
|
|
|
|
With This As CL_DBC_TABLES Of 'FOXBIN2PRG.PRG'
|
|
Store Null To loTable
|
|
lcText = ''
|
|
.read_BinDataToProperties()
|
|
|
|
If .Count > 0 Then
|
|
TEXT TO lcText ADDITIVE TEXTMERGE NOSHOW FLAGS 1+2 PRETEXT 1+2
|
|
<<>> <TABLES>
|
|
ENDTEXT
|
|
|
|
.KeySort = 2
|
|
For Each loTable In This &&FOXOBJECT
|
|
lcText = lcText + loTable.toText( loTable._Name )
|
|
Endfor
|
|
|
|
TEXT TO lcText ADDITIVE TEXTMERGE NOSHOW FLAGS 1+2 PRETEXT 1+2
|
|
<<>> </TABLES>
|
|
<<>>
|
|
ENDTEXT
|
|
Endif
|
|
|
|
|
|
Endwith
|
|
|
|
|
|
Catch To loEx
|
|
If Vartype(loTable) = "O" Then
|
|
loEx.UserValue = loEx.UserValue + CR_LF + "loTable._Name = " + Transform(loTable._Name)
|
|
Endif
|
|
|
|
If This.n_Debug > 0 And _vfp.StartMode = 0
|
|
Set Step On
|
|
Endif
|
|
|
|
Throw
|
|
|
|
Finally
|
|
Store Null To loTable
|
|
Release loTable
|
|
|
|
Endtry
|
|
|
|
Return lcText
|
|
Endproc
|
|
|
|
|
|
Procedure read_BinDataToProperties
|
|
*---------------------------------------------------------------------------------------------------
|
|
* PARÁMETROS: (v=Pasar por valor | @=Pasar por referencia) (!=Obligatorio | ?=Opcional) (IN/OUT)
|
|
* toFoxBin2Prg (@! IN ) Referencia de toFoxBin2Prg
|
|
*---------------------------------------------------------------------------------------------------
|
|
Lparameters toFoxBin2Prg
|
|
|
|
#If .F.
|
|
Local toFoxBin2Prg As c_foxbin2prg Of 'FOXBIN2PRG.PRG'
|
|
#Endif
|
|
|
|
Try
|
|
With This As CL_DBC_TABLES Of 'FOXBIN2PRG.PRG'
|
|
Local I, lnTable_Count, laTables(1), loEx As Exception ;
|
|
, loTable As CL_DBC_TABLE Of 'FOXBIN2PRG.PRG'
|
|
|
|
If ._Saved Then
|
|
lnTable_Count = .Count
|
|
Exit
|
|
Endif
|
|
|
|
Store Null To loTable
|
|
Store 0 To I, lnTable_Count
|
|
lnTable_Count = Adbobjects( laTables,"TABLE" )
|
|
|
|
If lnTable_Count > 0
|
|
For I = 1 To lnTable_Count
|
|
loTable = Createobject("CL_DBC_TABLE")
|
|
loTable.read_BinDataToProperties( laTables(m.I) )
|
|
*-- El siguiente PADR() es porque si no "estoXXX" está antes que "esto" cuando keysort=2 (raro...)
|
|
.Add( loTable, Padr(Lower(loTable._Name),128) )
|
|
Endfor
|
|
Endif
|
|
|
|
._Saved = .T.
|
|
Endwith
|
|
|
|
Catch To loEx
|
|
If This.n_Debug > 0 And _vfp.StartMode = 0
|
|
Set Step On
|
|
Endif
|
|
|
|
Throw
|
|
|
|
Finally
|
|
loTable = Null
|
|
Release I, loTable
|
|
|
|
Endtry
|
|
|
|
Return lnTable_Count
|
|
Endproc
|
|
|
|
|
|
Enddefine
|
|
|
|
|
|
|
|
Define Class CL_DBC_TABLE As CL_DBC_BASE
|
|
#If .F.
|
|
Local This As CL_DBC_TABLE Of 'FOXBIN2PRG.PRG'
|
|
#Endif
|
|
|
|
_MemberData = [<VFPData>] ;
|
|
+ [<memberdata name="_name" display="_Name"/>] ;
|
|
+ [<memberdata name="_comment" display="_Comment"/>] ;
|
|
+ [<memberdata name="_path" display="_Path"/>] ;
|
|
+ [<memberdata name="_deletetrigger" display="_DeleteTrigger"/>] ;
|
|
+ [<memberdata name="_inserttrigger" display="_InsertTrigger"/>] ;
|
|
+ [<memberdata name="_updatetrigger" display="_UpdateTrigger"/>] ;
|
|
+ [<memberdata name="_primarykey" display="_PrimaryKey"/>] ;
|
|
+ [<memberdata name="_ruleexpression" display="_RuleExpression"/>] ;
|
|
+ [<memberdata name="_ruletext" display="_RuleText"/>] ;
|
|
+ [<memberdata name="_fields" display="_Fields"/>] ;
|
|
+ [<memberdata name="_indexes" display="_Indexes"/>] ;
|
|
+ [</VFPData>]
|
|
|
|
|
|
*-- Info
|
|
_Name = ''
|
|
_Comment = ''
|
|
_Path = ''
|
|
_DeleteTrigger = ''
|
|
_InsertTrigger = ''
|
|
_UpdateTrigger = ''
|
|
_PrimaryKey = ''
|
|
_RuleExpression = ''
|
|
_RuleText = ''
|
|
|
|
|
|
Procedure Init
|
|
DoDefault()
|
|
*--
|
|
With This As CL_DBC_TABLE Of 'FOXBIN2PRG.PRG'
|
|
.AddObject("_Fields", "CL_DBC_FIELDS_DB")
|
|
.AddObject("_Indexes", "CL_DBC_INDEXES_DB")
|
|
.AddObject("_Relations", "CL_DBC_RELATIONS")
|
|
Endwith && THIS
|
|
Endproc
|
|
|
|
|
|
Procedure analyzeCodeBlock
|
|
*---------------------------------------------------------------------------------------------------
|
|
* PARÁMETROS: (v=Pasar por valor | @=Pasar por referencia) (!=Obligatorio | ?=Opcional) (IN/OUT)
|
|
* tcLine (!@ IN/OUT) Contenido de la línea en análisis
|
|
* taCodeLines (!@ IN ) Array de líneas del programa analizado
|
|
* I (!@ IN/OUT) Número de línea en análisis
|
|
* tnCodeLines (!@ IN ) Cantidad de líneas del programa analizado
|
|
*---------------------------------------------------------------------------------------------------
|
|
Lparameters tcLine, taCodeLines, I, tnCodeLines
|
|
|
|
Try
|
|
Local llBloqueEncontrado, lcPropName, lcValue, loEx As Exception ;
|
|
, loFields As CL_DBC_FIELDS_DB Of 'FOXBIN2PRG.PRG' ;
|
|
, loIndexes As CL_DBC_INDEXES_DB Of 'FOXBIN2PRG.PRG' ;
|
|
, loRelations As CL_DBC_RELATIONS Of 'FOXBIN2PRG.PRG'
|
|
Store Null To loRelations, loIndexes, loFields
|
|
Store '' To lcPropName, lcValue
|
|
|
|
If Left(tcLine, Len(C_TABLE_I)) == C_TABLE_I
|
|
llBloqueEncontrado = .T.
|
|
|
|
With This As CL_DBC_TABLE Of 'FOXBIN2PRG.PRG'
|
|
For I = m.I + 1 To tnCodeLines
|
|
.set_Line( @tcLine, @taCodeLines, m.I )
|
|
|
|
Do Case
|
|
Case Empty( tcLine )
|
|
Loop
|
|
|
|
Case C_TABLE_F $ tcLine && Fin
|
|
Exit
|
|
|
|
Case C_FIELD_ORDER_I $ tcLine
|
|
loFields = ._Fields
|
|
loFields.analyzeOrderCodeBlock( @tcLine, @taCodeLines, @m.I, tnCodeLines )
|
|
|
|
Case C_FIELDS_I $ tcLine
|
|
loFields = ._Fields
|
|
loFields.analyzeCodeBlock( @tcLine, @taCodeLines, @m.I, tnCodeLines )
|
|
|
|
Case C_INDEXES_I $ tcLine
|
|
loIndexes = ._Indexes
|
|
loIndexes.analyzeCodeBlock( @tcLine, @taCodeLines, @m.I, tnCodeLines )
|
|
|
|
Case C_RELATIONS_I $ tcLine
|
|
loRelations = ._Relations
|
|
loRelations.analyzeCodeBlock( @tcLine, @taCodeLines, @m.I, tnCodeLines )
|
|
|
|
Case '<Comment>' $ tcLine
|
|
.analyzeCodeBlock_Comment( @tcLine, @taCodeLines, @m.I, tnCodeLines )
|
|
|
|
Otherwise && Propiedad de TABLE
|
|
*-- Estructura a reconocer:
|
|
* <name>NOMBRE</name>
|
|
lcPropName = Strextract( tcLine, '<', '>', 1, 0 )
|
|
lcValue = Strextract( tcLine, '<' + lcPropName + '>', '</' + lcPropName + '>', 1, 0 )
|
|
.add_Property( '_' + lcPropName, lcValue )
|
|
Endcase
|
|
Endfor
|
|
Endwith && THIS
|
|
Endif
|
|
|
|
Catch To loEx
|
|
If loEx.ErrorNo = 1470 && Incorrect property name.
|
|
loEx.UserValue = 'I=' + Transform(m.I) + ', tcLine=' + Transform(tcLine) + ', PropName=[' + Transform(lcPropName) + '], Value=[' + Transform(lcValue) + ']'
|
|
Endif
|
|
|
|
If This.n_Debug > 0 And _vfp.StartMode = 0
|
|
Set Step On
|
|
Endif
|
|
|
|
Throw
|
|
|
|
Finally
|
|
Store Null To loRelations, loIndexes, loFields
|
|
Release lcPropName, lcValue, loFields, loIndexes, loRelations
|
|
|
|
Endtry
|
|
|
|
Return llBloqueEncontrado
|
|
Endproc
|
|
|
|
Endtry
|
|
|
|
Procedure toText
|
|
*---------------------------------------------------------------------------------------------------
|
|
* PARÁMETROS: (v=Pasar por valor | @=Pasar por referencia) (!=Obligatorio | ?=Opcional) (IN/OUT)
|
|
* tcTable (v! IN ) Nombre de la Tabla
|
|
* toFoxBin2Prg (@! IN ) Referencia de toFoxBin2Prg
|
|
*---------------------------------------------------------------------------------------------------
|
|
Lparameters tcTable, toFoxBin2Prg
|
|
|
|
#If .F.
|
|
Local toFoxBin2Prg As c_foxbin2prg Of 'FOXBIN2PRG.PRG'
|
|
#Endif
|
|
|
|
Try
|
|
Local lcText, lcFields, lcIndexes, lcRelations, loEx As Exception ;
|
|
, loIndexes As CL_DBC_INDEXES_DB Of 'FOXBIN2PRG.PRG' ;
|
|
, loFields As CL_DBC_FIELDS_DB Of 'FOXBIN2PRG.PRG' ;
|
|
, loRelations As CL_DBC_RELATIONS Of 'FOXBIN2PRG.PRG'
|
|
|
|
With This As CL_DBC_TABLE Of 'FOXBIN2PRG.PRG'
|
|
Store Null To loRelations, loFields, loIndexes
|
|
Store '' To lcText, lcFields, lcIndexes, lcRelations
|
|
.read_BinDataToProperties(tcTable)
|
|
|
|
loFields = Createobject('CL_DBC_FIELDS_DB')
|
|
lcFields = loFields.toText( tcTable, @toFoxBin2Prg )
|
|
|
|
loIndexes = Createobject('CL_DBC_INDEXES_DB')
|
|
lcIndexes = loIndexes.toText( tcTable, @toFoxBin2Prg )
|
|
|
|
loRelations = Createobject('CL_DBC_RELATIONS')
|
|
lcRelations = loRelations.toText( tcTable, @toFoxBin2Prg )
|
|
|
|
TEXT TO lcText ADDITIVE TEXTMERGE NOSHOW FLAGS 1+2 PRETEXT 1+2
|
|
<<>>
|
|
<<>> <TABLE>
|
|
<<>> <Name><<._Name>></Name>
|
|
<<>> <Comment><<._Comment>></Comment>
|
|
<<>> <Path><<._Path>></Path>
|
|
<<>> <DeleteTrigger><<._DeleteTrigger>></DeleteTrigger>
|
|
<<>> <InsertTrigger><<._InsertTrigger>></InsertTrigger>
|
|
<<>> <UpdateTrigger><<._UpdateTrigger>></UpdateTrigger>
|
|
<<>> <PrimaryKey><<._PrimaryKey>></PrimaryKey>
|
|
<<>> <RuleExpression><<._RuleExpression>></RuleExpression>
|
|
<<>> <RuleText><<._RuleText>></RuleText>
|
|
<<lcFields>>
|
|
<<lcIndexes>>
|
|
<<lcRelations>>
|
|
<<>> </TABLE>
|
|
ENDTEXT
|
|
|
|
._ToText = lcText
|
|
Endwith
|
|
|
|
|
|
Catch To loEx
|
|
loEx.UserValue = loEx.UserValue + CR_LF + "tcTable = " + Rtrim(Transform(tcTable))
|
|
|
|
If This.n_Debug > 0 And _vfp.StartMode = 0
|
|
Set Step On
|
|
Endif
|
|
|
|
Throw
|
|
|
|
Finally
|
|
Store Null To loRelations, loFields, loIndexes
|
|
Release loIndexes, loFields, loRelations
|
|
|
|
Endtry
|
|
|
|
Return lcText
|
|
Endproc
|
|
|
|
|
|
Procedure updateDBC
|
|
*---------------------------------------------------------------------------------------------------
|
|
* PARÁMETROS: (v=Pasar por valor | @=Pasar por referencia) (!=Obligatorio | ?=Opcional) (IN/OUT)
|
|
* tc_OutputFile (v! IN ) Nombre del archivo de salida
|
|
* tnLastID (!@ IN ) Último número de ID usado
|
|
* tnParentID (v! IN ) ID del objeto Padre
|
|
*---------------------------------------------------------------------------------------------------
|
|
Lparameters tc_OutputFile, tnLastID, tnParentID
|
|
|
|
DoDefault( tc_OutputFile, @tnLastID, tnParentID)
|
|
|
|
With This As CL_DBC_TABLE Of 'FOXBIN2PRG.PRG'
|
|
tnParentID = .__ObjectID
|
|
._Fields.updateDBC( tc_OutputFile, @tnLastID, tnParentID )
|
|
._Indexes.updateDBC( tc_OutputFile, @tnLastID, tnParentID )
|
|
._Relations.updateDBC( tc_OutputFile, @tnLastID, tnParentID )
|
|
Endwith && THIS
|
|
Endproc
|
|
|
|
|
|
Procedure getBinMemoFromProperties
|
|
Local lcBinData
|
|
lcBinData = ''
|
|
|
|
With This As CL_DBC_TABLE Of 'FOXBIN2PRG.PRG'
|
|
lcBinData = lcBinData + .getBinPropertyDataRecord( 1, .getDBCPropertyIDByName('Class', .T.) )
|
|
lcBinData = lcBinData + .getBinPropertyDataRecord( ._Path, .getDBCPropertyIDByName('Path', .T.) )
|
|
lcBinData = lcBinData + .getBinPropertyDataRecord( ._PrimaryKey, .getDBCPropertyIDByName('PrimaryKey', .T.) )
|
|
lcBinData = lcBinData + .getBinPropertyDataRecord( ._RuleExpression, .getDBCPropertyIDByName('RuleExpression', .T.) )
|
|
lcBinData = lcBinData + .getBinPropertyDataRecord( ._RuleText, .getDBCPropertyIDByName('RuleText', .T.) )
|
|
lcBinData = lcBinData + .getBinPropertyDataRecord( ._Comment, .getDBCPropertyIDByName('Comment', .T.) )
|
|
lcBinData = lcBinData + .getBinPropertyDataRecord( ._InsertTrigger, .getDBCPropertyIDByName('InsertTrigger', .T.) )
|
|
lcBinData = lcBinData + .getBinPropertyDataRecord( ._UpdateTrigger, .getDBCPropertyIDByName('UpdateTrigger', .T.) )
|
|
lcBinData = lcBinData + .getBinPropertyDataRecord( ._DeleteTrigger, .getDBCPropertyIDByName('DeleteTrigger', .T.) )
|
|
Endwith && THIS
|
|
|
|
Return lcBinData
|
|
Endproc
|
|
|
|
|
|
Procedure read_BinDataToProperties
|
|
Lparameters tcTable
|
|
|
|
With This As CL_DBC_TABLE Of 'FOXBIN2PRG.PRG'
|
|
If Not ._Saved Then
|
|
._Name = Alltrim(tcTable)
|
|
._Comment = DBGetProp(tcTable,"TABLE","Comment")
|
|
._Path = DBGetProp(tcTable,"TABLE","Path")
|
|
._DeleteTrigger = DBGetProp(tcTable,"TABLE","DeleteTrigger")
|
|
._InsertTrigger = DBGetProp(tcTable,"TABLE","InsertTrigger")
|
|
._UpdateTrigger = DBGetProp(tcTable,"TABLE","UpdateTrigger")
|
|
._PrimaryKey = DBGetProp(tcTable,"TABLE","PrimaryKey")
|
|
._RuleExpression = DBGetProp(tcTable,"TABLE","RuleExpression")
|
|
._RuleText = DBGetProp(tcTable,"TABLE","RuleText")
|
|
*--
|
|
._Saved = .T.
|
|
Endif
|
|
Endwith
|
|
Endproc
|
|
|
|
|
|
Enddefine
|
|
|
|
|
|
|
|
Define Class CL_DBC_FIELDS_DB As CL_DBC_COL_BASE
|
|
#If .F.
|
|
Local This As CL_DBC_FIELDS_DB Of 'FOXBIN2PRG.PRG'
|
|
#Endif
|
|
|
|
_MemberData = [<VFPData>] ;
|
|
+ [<memberdata name="analyzeordercodeblock" display="analyzeOrderCodeBlock"/>] ;
|
|
+ [<memberdata name="a_campos" display="a_Campos"/>] ;
|
|
+ [<memberdata name="n_campos" display="n_Campos"/>] ;
|
|
+ [</VFPData>]
|
|
|
|
|
|
Dimension a_Campos(1,2) && col.1=campo, col.2=definición
|
|
n_Campos = 0
|
|
|
|
|
|
Procedure analyzeCodeBlock
|
|
*---------------------------------------------------------------------------------------------------
|
|
* PARÁMETROS: (v=Pasar por valor | @=Pasar por referencia) (!=Obligatorio | ?=Opcional) (IN/OUT)
|
|
* tcLine (!@ IN/OUT) Contenido de la línea en análisis
|
|
* taCodeLines (!@ IN ) Array de líneas del programa analizado
|
|
* I (!@ IN/OUT) Número de línea en análisis
|
|
* tnCodeLines (!@ IN ) Cantidad de líneas del programa analizado
|
|
*---------------------------------------------------------------------------------------------------
|
|
Lparameters tcLine, taCodeLines, I, tnCodeLines
|
|
|
|
Try
|
|
Local llBloqueEncontrado, lcPropName, lcValue, lnPos, loEx As Exception ;
|
|
, loField As CL_DBC_FIELD_DB Of 'FOXBIN2PRG.PRG'
|
|
Store Null To loField
|
|
Store '' To lcPropName, lcValue
|
|
|
|
If Left(tcLine, Len(C_FIELDS_I)) == C_FIELDS_I
|
|
llBloqueEncontrado = .T.
|
|
|
|
With This As CL_DBC_FIELDS_DB Of 'FOXBIN2PRG.PRG'
|
|
*.n_Campos = 0 && Descomentar para forzar modo LEGACY
|
|
For I = m.I + 1 To tnCodeLines
|
|
.set_Line( @tcLine, @taCodeLines, m.I )
|
|
|
|
Do Case
|
|
Case Empty( tcLine )
|
|
Loop
|
|
|
|
Case C_FIELDS_F $ tcLine && Fin
|
|
Exit
|
|
|
|
Case C_FIELD_I $ tcLine
|
|
loField = Createobject("CL_DBC_FIELD_DB")
|
|
loField.analyzeCodeBlock( @tcLine, @taCodeLines, @m.I, tnCodeLines )
|
|
|
|
If .n_Campos = 0 Then
|
|
*-- MODO LEGACY: Cuando no existe tag de ordenamiento de campos, se agregan en el orden que se leen
|
|
*-- El siguiente PADR() es porque si no "estoXXX" está antes que "esto" cuando keysort=2 (raro...)
|
|
.Add( loField, Padr(Lower(loField._Name),128) )
|
|
Else
|
|
lnPos = Ascan( .a_Campos, loField._Name, 1, 0, 1, 1+2+4+8 )
|
|
.a_Campos( lnPos, 2) = loField
|
|
Endif
|
|
|
|
Otherwise && Otro valor
|
|
*-- No hay otros valores
|
|
Endcase
|
|
Endfor
|
|
|
|
*-- Restablezco el orden de los campos (Solo si n_Campos > 0, que significa que tiene el nuevo tag especial de orden)
|
|
For lnPos = 1 To .n_Campos
|
|
*-- El siguiente PADR() es porque si no "estoXXX" está antes que "esto" cuando keysort=2 (raro...)
|
|
.Add( .a_Campos( lnPos, 2), Padr(Lower(.a_Campos( lnPos, 1)),128) )
|
|
Endfor
|
|
Endwith && THIS
|
|
Endif
|
|
|
|
Catch To loEx
|
|
If loEx.ErrorNo = 1470 && Incorrect property name.
|
|
loEx.UserValue = 'I=' + Transform(m.I) + ', tcLine=' + Transform(tcLine)
|
|
Endif
|
|
|
|
If This.n_Debug > 0 And _vfp.StartMode = 0
|
|
Set Step On
|
|
Endif
|
|
|
|
Throw
|
|
|
|
Finally
|
|
Store Null To loField
|
|
Release lcPropName, lcValue, loField
|
|
|
|
Endtry
|
|
|
|
Return llBloqueEncontrado
|
|
Endproc
|
|
|
|
|
|
Procedure analyzeOrderCodeBlock
|
|
*---------------------------------------------------------------------------------------------------
|
|
* PARÁMETROS: (v=Pasar por valor | @=Pasar por referencia) (!=Obligatorio | ?=Opcional) (IN/OUT)
|
|
* tcLine (!@ IN/OUT) Contenido de la línea en análisis
|
|
* taCodeLines (!@ IN ) Array de líneas del programa analizado
|
|
* I (!@ IN/OUT) Número de línea en análisis
|
|
* tnCodeLines (!@ IN ) Cantidad de líneas del programa analizado
|
|
*---------------------------------------------------------------------------------------------------
|
|
Lparameters tcLine, taCodeLines, I, tnCodeLines
|
|
|
|
Try
|
|
Local llBloqueEncontrado, lcPropName, lcValue, loEx As Exception ;
|
|
, loField As CL_DBC_FIELD_DB Of 'FOXBIN2PRG.PRG'
|
|
Store Null To loField
|
|
Store '' To lcPropName, lcValue
|
|
|
|
If Left(tcLine, Len(C_FIELD_ORDER_I)) == C_FIELD_ORDER_I
|
|
llBloqueEncontrado = .T.
|
|
|
|
With This As CL_DBC_FIELDS_DB Of 'FOXBIN2PRG.PRG'
|
|
For I = m.I + 1 To tnCodeLines
|
|
.set_Line( @tcLine, @taCodeLines, m.I )
|
|
|
|
Do Case
|
|
Case Empty( tcLine )
|
|
Loop
|
|
|
|
Case C_FIELD_ORDER_F $ tcLine && Fin
|
|
Exit
|
|
|
|
Otherwise && nombre del campo en el orden original
|
|
.n_Campos = .n_Campos + 1
|
|
Dimension .a_Campos(.n_Campos, 2)
|
|
.a_Campos(.n_Campos, 1) = tcLine
|
|
|
|
Endcase
|
|
Endfor
|
|
Endwith && THIS
|
|
Endif
|
|
|
|
Catch To loEx
|
|
If This.n_Debug > 0 And _vfp.StartMode = 0
|
|
Set Step On
|
|
Endif
|
|
|
|
Throw
|
|
|
|
Finally
|
|
Store Null To loField
|
|
Release lcPropName, lcValue, loField
|
|
|
|
Endtry
|
|
|
|
Return llBloqueEncontrado
|
|
Endproc
|
|
|
|
|
|
Procedure toText
|
|
*---------------------------------------------------------------------------------------------------
|
|
* PARÁMETROS: (v=Pasar por valor | @=Pasar por referencia) (!=Obligatorio | ?=Opcional) (IN/OUT)
|
|
* tcTable (v! IN ) Nombre de la Tabla
|
|
* toFoxBin2Prg (@! IN ) Referencia de toFoxBin2Prg
|
|
*---------------------------------------------------------------------------------------------------
|
|
Lparameters tcTable, toFoxBin2Prg
|
|
|
|
#If .F.
|
|
Local toFoxBin2Prg As c_foxbin2prg Of 'FOXBIN2PRG.PRG'
|
|
#Endif
|
|
|
|
Try
|
|
Local X, lcText, lnField_Count, laFields(1), loEx As Exception ;
|
|
, loField As CL_DBC_FIELD_DB Of 'FOXBIN2PRG.PRG'
|
|
|
|
With This As CL_DBC_FIELDS_DB Of 'FOXBIN2PRG.PRG'
|
|
Store Null To loField
|
|
Store 0 To X, lnField_Count
|
|
lcText = ''
|
|
|
|
.read_BinDataToProperties( tcTable, @toFoxBin2Prg )
|
|
|
|
If .Count > 0 Then
|
|
TEXT TO lcText ADDITIVE TEXTMERGE NOSHOW FLAGS 1+2 PRETEXT 1+2
|
|
<<>> <FIELD_ORDER>
|
|
<<>>
|
|
ENDTEXT
|
|
|
|
Set Textmerge To Memvar lcText Additive Noshow
|
|
Set Textmerge On
|
|
|
|
.KeySort = 0
|
|
For Each loField In This &&FOXOBJECT
|
|
\ <<loField._Name>>
|
|
Endfor
|
|
|
|
Set Textmerge Off
|
|
Set Textmerge To
|
|
|
|
TEXT TO lcText ADDITIVE TEXTMERGE NOSHOW FLAGS 1+2 PRETEXT 1+2
|
|
<<>> </FIELD_ORDER>
|
|
<<>>
|
|
<<>> <FIELDS>
|
|
ENDTEXT
|
|
|
|
.KeySort = 2 && Comentar para forzar modo LEGACY
|
|
For Each loField In This &&FOXOBJECT
|
|
lcText = lcText + loField.toText( tcTable, loField._Name )
|
|
Endfor
|
|
|
|
TEXT TO lcText ADDITIVE TEXTMERGE NOSHOW FLAGS 1+2 PRETEXT 1+2
|
|
<<>> </FIELDS>
|
|
ENDTEXT
|
|
Endif
|
|
Endwith
|
|
|
|
|
|
Catch To loEx
|
|
If Vartype(loField) = "O" Then
|
|
loEx.UserValue = loEx.UserValue + CR_LF + "tcTable = " + Rtrim(Transform(tcTable)) + ", loField._Name = " + Transform(loField._Name)
|
|
Endif
|
|
|
|
If This.n_Debug > 0 And _vfp.StartMode = 0
|
|
Set Step On
|
|
Endif
|
|
|
|
Throw
|
|
|
|
Finally
|
|
Store Null To loField
|
|
Release loField
|
|
|
|
Endtry
|
|
|
|
Return lcText
|
|
Endproc
|
|
|
|
|
|
Procedure read_BinDataToProperties
|
|
*---------------------------------------------------------------------------------------------------
|
|
* PARÁMETROS: (v=Pasar por valor | @=Pasar por referencia) (!=Obligatorio | ?=Opcional) (IN/OUT)
|
|
* tcTable (@! IN ) Nombre de la tabla de la que se obtendrán los campos
|
|
* toFoxBin2Prg (@! IN ) Referencia de toFoxBin2Prg
|
|
*---------------------------------------------------------------------------------------------------
|
|
Lparameters tcTable, toFoxBin2Prg
|
|
|
|
#If .F.
|
|
Local toFoxBin2Prg As c_foxbin2prg Of 'FOXBIN2PRG.PRG'
|
|
#Endif
|
|
|
|
Try
|
|
With This As CL_DBC_FIELDS_DB Of 'FOXBIN2PRG.PRG'
|
|
Local I, lnField_Count, laFields(1), loEx As Exception ;
|
|
, loField As CL_DBC_FIELD_DB Of 'FOXBIN2PRG.PRG'
|
|
|
|
If ._Saved Then
|
|
lnField_Count = .Count
|
|
Exit
|
|
Endif
|
|
|
|
Store Null To loField
|
|
Store 0 To I, lnField_Count
|
|
_Tally = 0
|
|
|
|
Select Lower(TB.ObjectName) From TABLABIN TB ;
|
|
INNER Join TABLABIN TB2 On Str(TB.ParentId)+TB.ObjectType = Str(TB2.ObjectID)+Padr('Field',10) ;
|
|
AND Lower(TB2.ObjectName) = Padr(Lower(tcTable),128) ;
|
|
INTO Array laFields
|
|
lnField_Count = _Tally
|
|
|
|
If lnField_Count > 0
|
|
For I = 1 To lnField_Count
|
|
loField = Createobject("CL_DBC_FIELD_DB")
|
|
loField.read_BinDataToProperties( tcTable, laFields(m.I) )
|
|
*-- El siguiente PADR() es porque si no "estoXXX" está antes que "esto" cuando keysort=2 (raro...)
|
|
.Add( loField, Padr(Lower(loField._Name),128) )
|
|
Endfor
|
|
Endif
|
|
|
|
._Saved = .T.
|
|
Endwith
|
|
|
|
Catch To loEx
|
|
If This.n_Debug > 0 And _vfp.StartMode = 0
|
|
Set Step On
|
|
Endif
|
|
|
|
Throw
|
|
|
|
Finally
|
|
Use In (Select("TB"))
|
|
Use In (Select("TB2"))
|
|
loField = Null
|
|
Release I, loField
|
|
|
|
Endtry
|
|
|
|
Return lnField_Count
|
|
Endproc
|
|
|
|
|
|
Enddefine
|
|
|
|
|
|
|
|
Define Class CL_DBC_FIELD_DB As CL_DBC_BASE
|
|
#If .F.
|
|
Local This As CL_DBC_FIELD_DB Of 'FOXBIN2PRG.PRG'
|
|
#Endif
|
|
|
|
_MemberData = [<VFPData>] ;
|
|
+ [<memberdata name="_name" display="_Name"/>] ;
|
|
+ [<memberdata name="_caption" display="_Caption"/>] ;
|
|
+ [<memberdata name="_comment" display="_Comment"/>] ;
|
|
+ [<memberdata name="_defaultvalue" display="_DefaultValue"/>] ;
|
|
+ [<memberdata name="_displayclass" display="_DisplayClass"/>] ;
|
|
+ [<memberdata name="_displayclasslibrary" display="_DisplayClassLibrary"/>] ;
|
|
+ [<memberdata name="_format" display="_Format"/>] ;
|
|
+ [<memberdata name="_inputmask" display="_InputMask"/>] ;
|
|
+ [<memberdata name="_ruleexpression" display="_RuleExpression"/>] ;
|
|
+ [<memberdata name="_ruletext" display="_RuleText"/>] ;
|
|
+ [</VFPData>]
|
|
|
|
|
|
*-- Info
|
|
_Name = ''
|
|
_Caption = ''
|
|
_Comment = ''
|
|
_DefaultValue = ''
|
|
_DisplayClass = ''
|
|
_DisplayClassLibrary = ''
|
|
_Format = ''
|
|
_InputMask = ''
|
|
_RuleExpression = ''
|
|
_RuleText = ''
|
|
|
|
|
|
Procedure analyzeCodeBlock
|
|
*---------------------------------------------------------------------------------------------------
|
|
* PARÁMETROS: (v=Pasar por valor | @=Pasar por referencia) (!=Obligatorio | ?=Opcional) (IN/OUT)
|
|
* tcLine (!@ IN/OUT) Contenido de la línea en análisis
|
|
* taCodeLines (!@ IN ) Array de líneas del programa analizado
|
|
* I (!@ IN/OUT) Número de línea en análisis
|
|
* tnCodeLines (!@ IN ) Cantidad de líneas del programa analizado
|
|
*---------------------------------------------------------------------------------------------------
|
|
Lparameters tcLine, taCodeLines, I, tnCodeLines
|
|
|
|
Try
|
|
Local llBloqueEncontrado, lcPropName, lcValue, loEx As Exception
|
|
Store '' To lcPropName, lcValue
|
|
|
|
If Left(tcLine, Len(C_FIELD_I)) == C_FIELD_I
|
|
llBloqueEncontrado = .T.
|
|
|
|
With This As CL_DBC_FIELD_DB Of 'FOXBIN2PRG.PRG'
|
|
For I = m.I + 1 To tnCodeLines
|
|
.set_Line( @tcLine, @taCodeLines, m.I )
|
|
|
|
Do Case
|
|
Case Empty( tcLine )
|
|
Loop
|
|
|
|
Case C_FIELD_F $ tcLine && Fin
|
|
Exit
|
|
|
|
Case '<Comment>' $ tcLine
|
|
.analyzeCodeBlock_Comment( @tcLine, @taCodeLines, @m.I, tnCodeLines )
|
|
|
|
Otherwise && Propiedad de FIELD
|
|
*-- Estructura a reconocer:
|
|
* <name>NOMBRE</name>
|
|
lcPropName = Strextract( tcLine, '<', '>', 1, 0 )
|
|
lcValue = Strextract( tcLine, '<' + lcPropName + '>', '</' + lcPropName + '>', 1, 0 )
|
|
.add_Property( '_' + lcPropName, lcValue )
|
|
Endcase
|
|
Endfor
|
|
Endwith && THIS
|
|
Endif
|
|
|
|
Catch To loEx
|
|
If loEx.ErrorNo = 1470 && Incorrect property name.
|
|
loEx.UserValue = 'I=' + Transform(m.I) + ', tcLine=' + Transform(tcLine) + ', PropName=[' + Transform(lcPropName) + '], Value=[' + Transform(lcValue) + ']'
|
|
Endif
|
|
|
|
If This.n_Debug > 0 And _vfp.StartMode = 0
|
|
Set Step On
|
|
Endif
|
|
|
|
Throw
|
|
|
|
Endtry
|
|
|
|
Return llBloqueEncontrado
|
|
Endproc
|
|
|
|
|
|
Procedure toText
|
|
*---------------------------------------------------------------------------------------------------
|
|
* PARÁMETROS: (v=Pasar por valor | @=Pasar por referencia) (!=Obligatorio | ?=Opcional) (IN/OUT)
|
|
* tcTable (v! IN ) Nombre de la Tabla
|
|
* tcField (v! IN ) Nombre del campo
|
|
*---------------------------------------------------------------------------------------------------
|
|
Lparameters tcTable, tcField
|
|
|
|
Try
|
|
Local lcText, loEx As Exception
|
|
lcText = ''
|
|
|
|
With This As CL_DBC_FIELD_DB Of 'FOXBIN2PRG.PRG'
|
|
.read_BinDataToProperties(tcTable, tcField)
|
|
|
|
TEXT TO lcText ADDITIVE TEXTMERGE NOSHOW FLAGS 1+2 PRETEXT 1+2
|
|
<<>> <FIELD>
|
|
<<>> <Name><<._Name>></Name>
|
|
<<>> <Caption><<._Caption>></Caption>
|
|
<<>> <Comment><<._Comment>></Comment>
|
|
<<>> <DefaultValue><<._DefaultValue>></DefaultValue>
|
|
<<>> <DisplayClass><<._DisplayClass>></DisplayClass>
|
|
<<>> <DisplayClassLibrary><<._DisplayClassLibrary>></DisplayClassLibrary>
|
|
<<>> <Format><<._Format>></Format>
|
|
<<>> <InputMask><<._InputMask>></InputMask>
|
|
<<>> <RuleExpression><<._RuleExpression>></RuleExpression>
|
|
<<>> <RuleText><<._RuleText>></RuleText>
|
|
<<>> </FIELD>
|
|
ENDTEXT
|
|
|
|
._ToText = lcText
|
|
Endwith
|
|
|
|
|
|
Catch To loEx
|
|
loEx.UserValue = loEx.UserValue + CR_LF + "tcTable = " + Rtrim(Transform(tcTable)) + ", tcField = " + Rtrim(Transform(tcField))
|
|
|
|
If This.n_Debug > 0 And _vfp.StartMode = 0
|
|
Set Step On
|
|
Endif
|
|
|
|
Throw
|
|
|
|
Endtry
|
|
|
|
Return lcText
|
|
Endproc
|
|
|
|
|
|
Procedure getBinMemoFromProperties
|
|
Local lcBinData
|
|
lcBinData = ''
|
|
|
|
With This As CL_DBC_FIELD_DB Of 'FOXBIN2PRG.PRG'
|
|
lcBinData = lcBinData + .getBinPropertyDataRecord( ._Comment, .getDBCPropertyIDByName('Comment', .T.) )
|
|
lcBinData = lcBinData + .getBinPropertyDataRecord( ._DefaultValue, .getDBCPropertyIDByName('DefaultValue', .T.) )
|
|
lcBinData = lcBinData + .getBinPropertyDataRecord( ._DisplayClass, .getDBCPropertyIDByName('DisplayClass', .T.) )
|
|
lcBinData = lcBinData + .getBinPropertyDataRecord( ._DisplayClassLibrary, .getDBCPropertyIDByName('DisplayClassLibrary', .T.) )
|
|
lcBinData = lcBinData + .getBinPropertyDataRecord( ._Caption, .getDBCPropertyIDByName('Caption', .T.) )
|
|
lcBinData = lcBinData + .getBinPropertyDataRecord( ._Format, .getDBCPropertyIDByName('Format', .T.) )
|
|
lcBinData = lcBinData + .getBinPropertyDataRecord( ._InputMask, .getDBCPropertyIDByName('InputMask', .T.) )
|
|
lcBinData = lcBinData + .getBinPropertyDataRecord( ._RuleExpression, .getDBCPropertyIDByName('RuleExpression', .T.) )
|
|
lcBinData = lcBinData + .getBinPropertyDataRecord( ._RuleText, .getDBCPropertyIDByName('RuleText', .T.) )
|
|
Endwith && THIS
|
|
|
|
Return lcBinData
|
|
Endproc
|
|
|
|
|
|
Procedure read_BinDataToProperties
|
|
Lparameters tcTable, tcField
|
|
|
|
With This As CL_DBC_FIELD_DB Of 'FOXBIN2PRG.PRG'
|
|
If Not ._Saved Then
|
|
._Name = Alltrim(tcField)
|
|
._Caption = DBGetProp( Rtrim(tcTable) + '.' + Rtrim(tcField),"FIELD","Caption")
|
|
._Comment = DBGetProp( Rtrim(tcTable) + '.' + Rtrim(tcField),"FIELD","Comment")
|
|
._DefaultValue = DBGetProp( Rtrim(tcTable) + '.' + Rtrim(tcField),"FIELD","DefaultValue")
|
|
._DisplayClass = DBGetProp( Rtrim(tcTable) + '.' + Rtrim(tcField),"FIELD","DisplayClass")
|
|
._DisplayClassLibrary = DBGetProp( Rtrim(tcTable) + '.' + Rtrim(tcField),"FIELD","DisplayClassLibrary")
|
|
._Format = DBGetProp( Rtrim(tcTable) + '.' + Rtrim(tcField),"FIELD","Format")
|
|
._InputMask = DBGetProp( Rtrim(tcTable) + '.' + Rtrim(tcField),"FIELD","InputMask")
|
|
._RuleExpression = DBGetProp( Rtrim(tcTable) + '.' + Rtrim(tcField),"FIELD","RuleExpression")
|
|
._RuleText = DBGetProp( Rtrim(tcTable) + '.' + Rtrim(tcField),"FIELD","RuleText")
|
|
*--
|
|
._Saved = .T.
|
|
Endif
|
|
Endwith
|
|
Endproc
|
|
|
|
|
|
Enddefine
|
|
|
|
|
|
|
|
Define Class CL_DBC_INDEXES_DB As CL_DBC_COL_BASE
|
|
#If .F.
|
|
Local This As CL_DBC_INDEXES_DB Of 'FOXBIN2PRG.PRG'
|
|
#Endif
|
|
|
|
|
|
*-- Info
|
|
_Name = ''
|
|
|
|
|
|
Procedure analyzeCodeBlock
|
|
*---------------------------------------------------------------------------------------------------
|
|
* PARÁMETROS: (v=Pasar por valor | @=Pasar por referencia) (!=Obligatorio | ?=Opcional) (IN/OUT)
|
|
* tcLine (!@ IN/OUT) Contenido de la línea en análisis
|
|
* taCodeLines (!@ IN ) Array de líneas del programa analizado
|
|
* I (!@ IN/OUT) Número de línea en análisis
|
|
* tnCodeLines (!@ IN ) Cantidad de líneas del programa analizado
|
|
*---------------------------------------------------------------------------------------------------
|
|
Lparameters tcLine, taCodeLines, I, tnCodeLines
|
|
|
|
Try
|
|
Local llBloqueEncontrado, lcPropName, lcValue, loEx As Exception ;
|
|
, loIndex As CL_DBC_INDEX_DB Of 'FOXBIN2PRG.PRG'
|
|
Store Null To loIndex
|
|
Store '' To lcPropName, lcValue
|
|
|
|
If Left(tcLine, Len(C_INDEXES_I)) == C_INDEXES_I
|
|
llBloqueEncontrado = .T.
|
|
|
|
With This As CL_DBC_INDEXES_DB Of 'FOXBIN2PRG.PRG'
|
|
For I = m.I + 1 To tnCodeLines
|
|
.set_Line( @tcLine, @taCodeLines, m.I )
|
|
|
|
Do Case
|
|
Case Empty( tcLine )
|
|
Loop
|
|
|
|
Case C_INDEXES_F $ tcLine && Fin
|
|
Exit
|
|
|
|
Case C_INDEX_I $ tcLine
|
|
loIndex = Null
|
|
loIndex = Createobject("CL_DBC_INDEX_DB")
|
|
loIndex.analyzeCodeBlock( @tcLine, @taCodeLines, @m.I, tnCodeLines )
|
|
*-- El siguiente PADR() es porque si no "estoXXX" está antes que "esto" cuando keysort=2 (raro...)
|
|
.Add( loIndex, Padr(Lower(loIndex._Name),128) )
|
|
|
|
Otherwise && Otro valor
|
|
*-- No hay otros valores
|
|
Endcase
|
|
Endfor
|
|
Endwith && THIS
|
|
Endif
|
|
|
|
Catch To loEx
|
|
If loEx.ErrorNo = 1470 && Incorrect property name.
|
|
loEx.UserValue = 'I=' + Transform(m.I) + ', tcLine=' + Transform(tcLine)
|
|
Endif
|
|
|
|
If This.n_Debug > 0 And _vfp.StartMode = 0
|
|
Set Step On
|
|
Endif
|
|
|
|
Throw
|
|
|
|
Finally
|
|
Store Null To loIndex
|
|
Release lcPropName, lcValue, loIndex
|
|
|
|
Endtry
|
|
|
|
Return llBloqueEncontrado
|
|
Endproc
|
|
|
|
|
|
Procedure toText
|
|
*---------------------------------------------------------------------------------------------------
|
|
* PARÁMETROS: (v=Pasar por valor | @=Pasar por referencia) (!=Obligatorio | ?=Opcional) (IN/OUT)
|
|
* tcTable (v! IN ) Nombre de la Tabla
|
|
* toFoxBin2Prg (@! IN ) Referencia de toFoxBin2Prg
|
|
*---------------------------------------------------------------------------------------------------
|
|
Lparameters tcTable, toFoxBin2Prg
|
|
|
|
#If .F.
|
|
Local toFoxBin2Prg As c_foxbin2prg Of 'FOXBIN2PRG.PRG'
|
|
#Endif
|
|
|
|
Try
|
|
Local lcText, loEx As Exception ;
|
|
, loIndex As CL_DBC_INDEX_DB Of 'FOXBIN2PRG.PRG'
|
|
|
|
With This As CL_DBC_INDEXES_DB Of 'FOXBIN2PRG.PRG'
|
|
Store Null To loIndex
|
|
lcText = ''
|
|
.read_BinDataToProperties(tcTable, @toFoxBin2Prg)
|
|
|
|
If .Count > 0 Then
|
|
TEXT TO lcText ADDITIVE TEXTMERGE NOSHOW FLAGS 1+2 PRETEXT 1+2
|
|
<<>> <INDEXES>
|
|
ENDTEXT
|
|
|
|
.KeySort = 2 && Comentar para forzar modo LEGACY
|
|
For Each loIndex In This &&FOXOBJECT
|
|
lcText = lcText + loIndex.toText( tcTable + '.' + loIndex._Name )
|
|
Endfor
|
|
|
|
TEXT TO lcText ADDITIVE TEXTMERGE NOSHOW FLAGS 1+2 PRETEXT 1+2
|
|
<<>> </INDEXES>
|
|
ENDTEXT
|
|
Endif
|
|
|
|
|
|
Endwith
|
|
|
|
Catch To loEx
|
|
If Vartype(loIndex) = "O" Then
|
|
loEx.UserValue = loEx.UserValue + CR_LF + "loIndex._Name = " + Rtrim(loIndex._Name)
|
|
Endif
|
|
|
|
If This.n_Debug > 0 And _vfp.StartMode = 0
|
|
Set Step On
|
|
Endif
|
|
|
|
Throw
|
|
|
|
Finally
|
|
Store Null To loIndex
|
|
Release loIndex
|
|
|
|
Endtry
|
|
|
|
Return lcText
|
|
Endproc
|
|
|
|
|
|
Procedure read_BinDataToProperties
|
|
*---------------------------------------------------------------------------------------------------
|
|
* PARÁMETROS: (v=Pasar por valor | @=Pasar por referencia) (!=Obligatorio | ?=Opcional) (IN/OUT)
|
|
* tcTable (v! IN ) Nombre de la Tabla
|
|
* toFoxBin2Prg (@! IN ) Referencia de toFoxBin2Prg
|
|
*---------------------------------------------------------------------------------------------------
|
|
Lparameters tcTable, toFoxBin2Prg
|
|
|
|
#If .F.
|
|
Local toFoxBin2Prg As c_foxbin2prg Of 'FOXBIN2PRG.PRG'
|
|
#Endif
|
|
|
|
Try
|
|
With This As CL_DBC_FIELDS_DB Of 'FOXBIN2PRG.PRG'
|
|
Local I, lnIndex_Count, laIndexes(1), loEx As Exception ;
|
|
, loIndex As CL_DBC_INDEX_DB Of 'FOXBIN2PRG.PRG'
|
|
|
|
If ._Saved Then
|
|
lnIndex_Count = .Count
|
|
Exit
|
|
Endif
|
|
|
|
Store Null To loIndex
|
|
Store 0 To I, lnIndex_Count
|
|
_Tally = 0
|
|
Select Lower(TB.ObjectName) From TABLABIN TB ;
|
|
INNER Join TABLABIN TB2 On Str(TB.ParentId)+TB.ObjectType = Str(TB2.ObjectID)+Padr('Index',10) ;
|
|
AND Lower(TB2.ObjectName) = Padr(Lower(tcTable),128) ;
|
|
INTO Array laIndexes
|
|
lnIndex_Count = _Tally
|
|
|
|
If lnIndex_Count > 0
|
|
For I = 1 To lnIndex_Count
|
|
loIndex = Createobject("CL_DBC_INDEX_DB")
|
|
loIndex.read_BinDataToProperties( tcTable + '.' + laIndexes(m.I) )
|
|
*-- El siguiente PADR() es porque si no "estoXXX" está antes que "esto" cuando keysort=2 (raro...)
|
|
.Add( loIndex, Padr(Lower(loIndex._Name),128) )
|
|
Endfor
|
|
Endif
|
|
|
|
._Saved = .T.
|
|
Endwith
|
|
|
|
Catch To loEx
|
|
If This.n_Debug > 0 And _vfp.StartMode = 0
|
|
Set Step On
|
|
Endif
|
|
|
|
Throw
|
|
|
|
Finally
|
|
Use In (Select("TB"))
|
|
Use In (Select("TB2"))
|
|
loIndex = Null
|
|
Release I, loIndex
|
|
|
|
Endtry
|
|
|
|
Return lnIndex_Count
|
|
Endproc
|
|
|
|
|
|
Enddefine
|
|
|
|
|
|
|
|
Define Class CL_DBC_INDEX_DB As CL_DBC_BASE
|
|
#If .F.
|
|
Local This As CL_DBC_INDEX_DB Of 'FOXBIN2PRG.PRG'
|
|
#Endif
|
|
|
|
_MemberData = [<VFPData>] ;
|
|
+ [<memberdata name="_name" display="_Name"/>] ;
|
|
+ [<memberdata name="_isunique" display="_IsUnique"/>] ;
|
|
+ [<memberdata name="_comment" display="_Comment"/>] ;
|
|
+ [</VFPData>]
|
|
|
|
|
|
*-- Info
|
|
_Name = ''
|
|
_IsUnique = .F.
|
|
_Comment = ''
|
|
|
|
|
|
Procedure analyzeCodeBlock
|
|
*---------------------------------------------------------------------------------------------------
|
|
* PARÁMETROS: (v=Pasar por valor | @=Pasar por referencia) (!=Obligatorio | ?=Opcional) (IN/OUT)
|
|
* tcLine (!@ IN/OUT) Contenido de la línea en análisis
|
|
* taCodeLines (!@ IN ) Array de líneas del programa analizado
|
|
* I (!@ IN/OUT) Número de línea en análisis
|
|
* tnCodeLines (!@ IN ) Cantidad de líneas del programa analizado
|
|
*---------------------------------------------------------------------------------------------------
|
|
Lparameters tcLine, taCodeLines, I, tnCodeLines
|
|
|
|
Try
|
|
Local llBloqueEncontrado, lcPropName, lcValue, loEx As Exception
|
|
Store '' To lcPropName, lcValue
|
|
|
|
If Left(tcLine, Len(C_INDEX_I)) == C_INDEX_I
|
|
llBloqueEncontrado = .T.
|
|
|
|
With This As CL_DBC_INDEX_DB Of 'FOXBIN2PRG.PRG'
|
|
For I = m.I + 1 To tnCodeLines
|
|
.set_Line( @tcLine, @taCodeLines, m.I )
|
|
|
|
Do Case
|
|
Case Empty( tcLine )
|
|
Loop
|
|
|
|
Case C_INDEX_F $ tcLine && Fin
|
|
Exit
|
|
|
|
Case '<Comment>' $ tcLine
|
|
.analyzeCodeBlock_Comment( @tcLine, @taCodeLines, @m.I, tnCodeLines )
|
|
|
|
Otherwise && Propiedad de FIELD
|
|
*-- Estructura a reconocer:
|
|
* <name>NOMBRE</name>
|
|
lcPropName = Strextract( tcLine, '<', '>', 1, 0 )
|
|
lcValue = Strextract( tcLine, '<' + lcPropName + '>', '</' + lcPropName + '>', 1, 0 )
|
|
.add_Property( '_' + lcPropName, lcValue )
|
|
Endcase
|
|
Endfor
|
|
Endwith && THIS
|
|
Endif
|
|
|
|
Catch To loEx
|
|
If loEx.ErrorNo = 1470 && Incorrect property name.
|
|
loEx.UserValue = 'I=' + Transform(m.I) + ', tcLine=' + Transform(tcLine) + ', PropName=[' + Transform(lcPropName) + '], Value=[' + Transform(lcValue) + ']'
|
|
Endif
|
|
|
|
If This.n_Debug > 0 And _vfp.StartMode = 0
|
|
Set Step On
|
|
Endif
|
|
|
|
Throw
|
|
|
|
Endtry
|
|
|
|
Return llBloqueEncontrado
|
|
Endproc
|
|
|
|
|
|
Procedure toText
|
|
*---------------------------------------------------------------------------------------------------
|
|
* PARÁMETROS: (v=Pasar por valor | @=Pasar por referencia) (!=Obligatorio | ?=Opcional) (IN/OUT)
|
|
* tcIndex (v! IN ) Nombre del índice en la forma "tabla.indice"
|
|
*---------------------------------------------------------------------------------------------------
|
|
Lparameters tcIndex
|
|
|
|
Try
|
|
Local lcText, loEx As Exception
|
|
lcText = ''
|
|
|
|
With This As CL_DBC_INDEX_DB Of 'FOXBIN2PRG.PRG'
|
|
.read_BinDataToProperties(tcIndex)
|
|
|
|
TEXT TO lcText ADDITIVE TEXTMERGE NOSHOW FLAGS 1+2 PRETEXT 1+2
|
|
<<>> <INDEX>
|
|
<<>> <Name><<._Name>></Name>
|
|
<<>> <Comment><<._Comment>></Comment>
|
|
<<>> <IsUnique><<._IsUnique>></IsUnique>
|
|
<<>> </INDEX>
|
|
ENDTEXT
|
|
|
|
._ToText = lcText
|
|
Endwith && THIS
|
|
|
|
Catch To loEx
|
|
loEx.UserValue = loEx.UserValue + CR_LF + "tcIndex = " + Rtrim(Transform(tcIndex))
|
|
|
|
If This.n_Debug > 0 And _vfp.StartMode = 0
|
|
Set Step On
|
|
Endif
|
|
|
|
Throw
|
|
|
|
Endtry
|
|
|
|
Return lcText
|
|
Endproc
|
|
|
|
|
|
Procedure getBinMemoFromProperties
|
|
Local lcBinData
|
|
lcBinData = ''
|
|
|
|
With This As CL_DBC_INDEX_DB Of 'FOXBIN2PRG.PRG'
|
|
lcBinData = lcBinData + .getBinPropertyDataRecord( ._IsUnique, .getDBCPropertyIDByName('IsUnique', .T.) )
|
|
Endwith && THIS
|
|
|
|
Return lcBinData
|
|
Endproc
|
|
|
|
|
|
Procedure read_BinDataToProperties
|
|
Lparameters tcIndex
|
|
|
|
With This As CL_DBC_INDEX_DB Of 'FOXBIN2PRG.PRG'
|
|
If Not ._Saved Then
|
|
._Name = Alltrim(Justext(tcIndex))
|
|
._Comment = Rtrim( .DBGetProp(tcIndex,'Index','Comment') )
|
|
._IsUnique = .DBGetProp(tcIndex,'Index','IsUnique')
|
|
*--
|
|
._Saved = .T.
|
|
Endif
|
|
Endwith
|
|
Endproc
|
|
|
|
|
|
Enddefine
|
|
|
|
|
|
|
|
Define Class CL_DBC_INDEXES_VW As CL_DBC_INDEXES_DB
|
|
Enddefine
|
|
|
|
|
|
|
|
Define Class CL_DBC_INDEX_VW As CL_DBC_INDEX_DB
|
|
Enddefine
|
|
|
|
|
|
|
|
Define Class CL_DBC_VIEWS As CL_DBC_COL_BASE
|
|
#If .F.
|
|
Local This As CL_DBC_VIEWS Of 'FOXBIN2PRG.PRG'
|
|
#Endif
|
|
|
|
|
|
Procedure analyzeCodeBlock
|
|
*---------------------------------------------------------------------------------------------------
|
|
* PARÁMETROS: (v=Pasar por valor | @=Pasar por referencia) (!=Obligatorio | ?=Opcional) (IN/OUT)
|
|
* tcLine (!@ IN/OUT) Contenido de la línea en análisis
|
|
* taCodeLines (!@ IN ) Array de líneas del programa analizado
|
|
* I (!@ IN/OUT) Número de línea en análisis
|
|
* tnCodeLines (!@ IN ) Cantidad de líneas del programa analizado
|
|
*---------------------------------------------------------------------------------------------------
|
|
Lparameters tcLine, taCodeLines, I, tnCodeLines
|
|
|
|
Try
|
|
Local llBloqueEncontrado, lcPropName, lcValue, loEx As Exception ;
|
|
, loView As CL_DBC_VIEW Of 'FOXBIN2PRG.PRG'
|
|
Store Null To loView
|
|
Store '' To lcPropName, lcValue
|
|
|
|
If Left(tcLine, Len(C_VIEWS_I)) == C_VIEWS_I
|
|
llBloqueEncontrado = .T.
|
|
|
|
With This As CL_DBC_VIEWS Of 'FOXBIN2PRG.PRG'
|
|
For I = m.I + 1 To tnCodeLines
|
|
.set_Line( @tcLine, @taCodeLines, m.I )
|
|
|
|
Do Case
|
|
Case Empty( tcLine )
|
|
Loop
|
|
|
|
Case C_VIEWS_F $ tcLine && Fin
|
|
Exit
|
|
|
|
Case C_VIEW_I $ tcLine
|
|
loView = Null
|
|
loView = Createobject("CL_DBC_VIEW")
|
|
loView.analyzeCodeBlock( @tcLine, @taCodeLines, @m.I, tnCodeLines )
|
|
*-- El siguiente PADR() es porque si no "estoXXX" está antes que "esto" cuando keysort=2 (raro...)
|
|
.Add( loView, Padr(Lower(loView._Name),128) )
|
|
|
|
Otherwise && Otro valor
|
|
*-- No hay otros valores
|
|
Endcase
|
|
Endfor
|
|
Endwith && THIS
|
|
Endif
|
|
|
|
Catch To loEx
|
|
If loEx.ErrorNo = 1470 && Incorrect property name.
|
|
loEx.UserValue = 'I=' + Transform(m.I) + ', tcLine=' + Transform(tcLine)
|
|
Endif
|
|
|
|
If This.n_Debug > 0 And _vfp.StartMode = 0
|
|
Set Step On
|
|
Endif
|
|
|
|
Throw
|
|
|
|
Finally
|
|
Store Null To loView
|
|
Release lcPropName, lcValue, loView
|
|
|
|
Endtry
|
|
|
|
Return llBloqueEncontrado
|
|
Endproc
|
|
|
|
|
|
Procedure toText
|
|
*---------------------------------------------------------------------------------------------------
|
|
* PARÁMETROS: (v=Pasar por valor | @=Pasar por referencia) (!=Obligatorio | ?=Opcional) (IN/OUT)
|
|
* toFoxBin2Prg (@! IN ) Referencia de toFoxBin2Prg
|
|
*---------------------------------------------------------------------------------------------------
|
|
Lparameters toFoxBin2Prg
|
|
|
|
#If .F.
|
|
Local toFoxBin2Prg As c_foxbin2prg Of 'FOXBIN2PRG.PRG'
|
|
#Endif
|
|
|
|
Try
|
|
Local lcText, lcDBC, loEx As Exception ;
|
|
, loView As CL_DBC_VIEW Of 'FOXBIN2PRG.PRG'
|
|
|
|
With This As CL_DBC_VIEWS Of 'FOXBIN2PRG.PRG'
|
|
Store Null To loView
|
|
lcText = ''
|
|
.read_BinDataToProperties()
|
|
|
|
If .Count > 0 Then
|
|
TEXT TO lcText ADDITIVE TEXTMERGE NOSHOW FLAGS 1+2 PRETEXT 1+2
|
|
<<>> <VIEWS>
|
|
ENDTEXT
|
|
|
|
.KeySort = 2
|
|
For Each loView In This &&FOXOBJECT
|
|
lcText = lcText + loView.toText( loView._Name )
|
|
Endfor
|
|
|
|
TEXT TO lcText ADDITIVE TEXTMERGE NOSHOW FLAGS 1+2 PRETEXT 1+2
|
|
<<>> </VIEWS>
|
|
<<>>
|
|
ENDTEXT
|
|
Endif
|
|
|
|
._Saved = .T.
|
|
Endwith
|
|
|
|
|
|
Catch To loEx
|
|
If Vartype(loView) = "O" Then
|
|
loEx.UserValue = loEx.UserValue + CR_LF + "loView._Name = " + Rtrim(loView._Name)
|
|
Endif
|
|
|
|
If This.n_Debug > 0 And _vfp.StartMode = 0
|
|
Set Step On
|
|
Endif
|
|
|
|
Throw
|
|
|
|
Finally
|
|
Store Null To loView
|
|
Release loView
|
|
|
|
Endtry
|
|
|
|
Return lcText
|
|
Endproc
|
|
|
|
|
|
Procedure read_BinDataToProperties
|
|
*---------------------------------------------------------------------------------------------------
|
|
* PARÁMETROS: (v=Pasar por valor | @=Pasar por referencia) (!=Obligatorio | ?=Opcional) (IN/OUT)
|
|
* toFoxBin2Prg (@! IN ) Referencia de toFoxBin2Prg
|
|
*---------------------------------------------------------------------------------------------------
|
|
Lparameters toFoxBin2Prg
|
|
|
|
#If .F.
|
|
Local toFoxBin2Prg As c_foxbin2prg Of 'FOXBIN2PRG.PRG'
|
|
#Endif
|
|
|
|
Try
|
|
With This As CL_DBC_VIEWS Of 'FOXBIN2PRG.PRG'
|
|
Local I, lnView_Count, laViews(1), loEx As Exception ;
|
|
, loTable As CL_DBC_TABLE Of 'FOXBIN2PRG.PRG'
|
|
Store Null To loTable
|
|
Store 0 To I, tnTable_Count
|
|
|
|
If ._Saved Then
|
|
lnView_Count = .Count
|
|
Exit
|
|
Endif
|
|
|
|
*LG lnView_Count = ADBOBJECTS( laViews, "VIEW" )
|
|
Select Cast(Alltrim(ObjectName) As Varchar(128)) ;
|
|
FROM TABLABIN ;
|
|
WHERE Upper(ObjectType) = 'VIEW' ;
|
|
ORDER By 1 ;
|
|
INTO Array laViews
|
|
lnView_Count = _Tally
|
|
|
|
If lnView_Count > 0
|
|
For I = 1 To lnView_Count
|
|
loView = Createobject("CL_DBC_VIEW")
|
|
loView.read_BinDataToProperties( laViews(m.I) )
|
|
*-- El siguiente PADR() es porque si no "estoXXX" está antes que "esto" cuando keysort=2 (raro...)
|
|
.Add( loView, Padr(Lower(loView._Name),128) )
|
|
Endfor
|
|
Endif
|
|
|
|
._Saved = .T.
|
|
Endwith
|
|
|
|
Catch To loEx
|
|
If This.n_Debug > 0 And _vfp.StartMode = 0
|
|
Set Step On
|
|
Endif
|
|
|
|
Throw
|
|
|
|
Finally
|
|
loView = Null
|
|
Release I, loView
|
|
|
|
Endtry
|
|
|
|
Return lnView_Count
|
|
Endproc
|
|
|
|
Throw
|
|
|
|
Enddefine
|
|
|
|
|
|
|
|
Define Class CL_DBC_VIEW As CL_DBC_BASE
|
|
#If .F.
|
|
Local This As CL_DBC_VIEW Of 'FOXBIN2PRG.PRG'
|
|
#Endif
|
|
|
|
_MemberData = [<VFPData>] ;
|
|
+ [<memberdata name="_name" display="_Name"/>] ;
|
|
+ [<memberdata name="_comment" display="_Comment"/>] ;
|
|
+ [<memberdata name="_tables" display="_Tables"/>] ;
|
|
+ [<memberdata name="_sql" display="_SQL"/>] ;
|
|
+ [<memberdata name="_allowsimultaneousfetch" display="_AllowSimultaneousFetch"/>] ;
|
|
+ [<memberdata name="_batchupdatecount" display="_BatchUpdateCount"/>] ;
|
|
+ [<memberdata name="_comparememo" display="_CompareMemo"/>] ;
|
|
+ [<memberdata name="_connectname" display="_ConnectName"/>] ;
|
|
+ [<memberdata name="_fetchasneeded" display="_FetchAsNeeded"/>] ;
|
|
+ [<memberdata name="_fetchmemo" display="_FetchMemo"/>] ;
|
|
+ [<memberdata name="_fetchsize" display="_FetchSize"/>] ;
|
|
+ [<memberdata name="_maxrecords" display="_MaxRecords"/>] ;
|
|
+ [<memberdata name="_offline" display="_Offline"/>] ;
|
|
+ [<memberdata name="_recordcount" display="_RecordCount"/>] ;
|
|
+ [<memberdata name="_path" display="_Path"/>] ;
|
|
+ [<memberdata name="_parameterlist" display="_ParameterList"/>] ;
|
|
+ [<memberdata name="_prepared" display="_Prepared"/>] ;
|
|
+ [<memberdata name="_ruleexpression" display="_RuleExpression"/>] ;
|
|
+ [<memberdata name="_ruletext" display="_RuleText"/>] ;
|
|
+ [<memberdata name="_sendupdates" display="_SendUpdates"/>] ;
|
|
+ [<memberdata name="_shareconnection" display="_ShareConnection"/>] ;
|
|
+ [<memberdata name="_sourcetype" display="_SourceType"/>] ;
|
|
+ [<memberdata name="_updatetype" display="_UpdateType"/>] ;
|
|
+ [<memberdata name="_usememosize" display="_UseMemoSize"/>] ;
|
|
+ [<memberdata name="_wheretype" display="_WhereType"/>] ;
|
|
+ [<memberdata name="_fields" display="_Fields"/>] ;
|
|
+ [<memberdata name="_indexes" display="_Indexes"/>] ;
|
|
+ [</VFPData>]
|
|
|
|
|
|
*-- Info
|
|
_Name = ''
|
|
_Comment = ''
|
|
_Tables = ''
|
|
_Sql = ''
|
|
_AllowSimultaneousFetch = .F.
|
|
_BatchUpdateCount = 0
|
|
_CompareMemo = .F.
|
|
_ConnectName = ''
|
|
_FetchAsNeeded = .F.
|
|
_FetchMemo = .F.
|
|
_FetchSize = 0
|
|
_MaxRecords = 0
|
|
_Offline = .F.
|
|
_RecordCount = 0
|
|
_Path = ''
|
|
_ParameterList = ''
|
|
_Prepared = .F.
|
|
_RuleExpression = ''
|
|
_RuleText = ''
|
|
_SendUpdates = .F.
|
|
_ShareConnection = .F.
|
|
_SourceType = 0
|
|
_UpdateType = 0
|
|
_UseMemoSize = 0
|
|
_WhereType = 0
|
|
|
|
*-- Sub-objects
|
|
*_Fields = NULL
|
|
*_Indexes = NULL
|
|
*_Relations = NULL
|
|
|
|
|
|
Procedure Init
|
|
DoDefault()
|
|
*--
|
|
With This As CL_DBC_VIEW Of 'FOXBIN2PRG.PRG'
|
|
.AddObject("_Fields", "CL_DBC_FIELDS_VW")
|
|
.AddObject("_Indexes", "CL_DBC_INDEXES_VW")
|
|
.AddObject("_Relations", "CL_DBC_RELATIONS")
|
|
Endwith && THIS
|
|
Endproc
|
|
|
|
|
|
Procedure analyzeCodeBlock
|
|
*---------------------------------------------------------------------------------------------------
|
|
* PARÁMETROS: (v=Pasar por valor | @=Pasar por referencia) (!=Obligatorio | ?=Opcional) (IN/OUT)
|
|
* tcLine (!@ IN/OUT) Contenido de la línea en análisis
|
|
* taCodeLines (!@ IN ) Array de líneas del programa analizado
|
|
* I (!@ IN/OUT) Número de línea en análisis
|
|
* tnCodeLines (!@ IN ) Cantidad de líneas del programa analizado
|
|
*---------------------------------------------------------------------------------------------------
|
|
Lparameters tcLine, taCodeLines, I, tnCodeLines
|
|
|
|
Try
|
|
Local llBloqueEncontrado, lcPropName, lcValue, loEx As Exception ;
|
|
, loFields As CL_DBC_FIELDS_VW Of 'FOXBIN2PRG.PRG' ;
|
|
, loIndexes As CL_DBC_INDEXES_VW Of 'FOXBIN2PRG.PRG' ;
|
|
, loRelations As CL_DBC_RELATIONS Of 'FOXBIN2PRG.PRG'
|
|
Store Null To loRelations, loIndexes, loFields
|
|
Store '' To lcPropName, lcValue
|
|
|
|
If Left(tcLine, Len(C_VIEW_I)) == C_VIEW_I
|
|
llBloqueEncontrado = .T.
|
|
|
|
With This As CL_DBC_VIEW Of 'FOXBIN2PRG.PRG'
|
|
For I = m.I + 1 To tnCodeLines
|
|
.set_Line( @tcLine, @taCodeLines, m.I )
|
|
|
|
Do Case
|
|
Case Empty( tcLine )
|
|
Loop
|
|
|
|
Case C_VIEW_F $ tcLine && Fin
|
|
Exit
|
|
|
|
Case C_FIELD_ORDER_I $ tcLine
|
|
loFields = ._Fields
|
|
loFields.analyzeOrderCodeBlock( @tcLine, @taCodeLines, @m.I, tnCodeLines )
|
|
|
|
Case C_FIELDS_I $ tcLine
|
|
loFields = Null
|
|
loFields = ._Fields
|
|
loFields.analyzeCodeBlock( @tcLine, @taCodeLines, @m.I, tnCodeLines )
|
|
|
|
Case C_INDEXES_I $ tcLine
|
|
loIndexes = Null
|
|
loIndexes = ._Indexes
|
|
loIndexes.analyzeCodeBlock( @tcLine, @taCodeLines, @m.I, tnCodeLines )
|
|
|
|
Case C_RELATIONS_I $ tcLine
|
|
loRelations = Null
|
|
loRelations = ._Relations
|
|
loRelations.analyzeCodeBlock( @tcLine, @taCodeLines, @m.I, tnCodeLines )
|
|
|
|
Case '<Comment>' $ tcLine
|
|
.analyzeCodeBlock_Comment( @tcLine, @taCodeLines, @m.I, tnCodeLines )
|
|
|
|
Otherwise && Propiedad de VIEW
|
|
*-- Estructura a reconocer:
|
|
* <name>NOMBRE</name>
|
|
lcPropName = Strextract( tcLine, '<', '>', 1, 0 )
|
|
lcValue = Strextract( tcLine, '<' + lcPropName + '>', '</' + lcPropName + '>', 1, 0 )
|
|
.add_Property( '_' + lcPropName, lcValue )
|
|
Endcase
|
|
Endfor
|
|
Endwith && THIS
|
|
Endif
|
|
|
|
Catch To loEx
|
|
If loEx.ErrorNo = 1470 && Incorrect property name.
|
|
loEx.UserValue = 'I=' + Transform(m.I) + ', tcLine=' + Transform(tcLine) + ', PropName=[' + Transform(lcPropName) + '], Value=[' + Transform(lcValue) + ']'
|
|
Endif
|
|
|
|
If This.n_Debug > 0 And _vfp.StartMode = 0
|
|
Set Step On
|
|
Endif
|
|
|
|
Throw
|
|
|
|
Finally
|
|
Store Null To loRelations, loIndexes, loFields
|
|
Local lcPropName, lcValue, loFields, loIndexes, loRelations
|
|
|
|
Endtry
|
|
|
|
Return llBloqueEncontrado
|
|
Endproc
|
|
|
|
|
|
Procedure toText
|
|
*---------------------------------------------------------------------------------------------------
|
|
* PARÁMETROS: (v=Pasar por valor | @=Pasar por referencia) (!=Obligatorio | ?=Opcional) (IN/OUT)
|
|
* tcView (v! IN ) Vista en evaluación
|
|
* toFoxBin2Prg (@! IN ) Referencia de toFoxBin2Prg
|
|
*---------------------------------------------------------------------------------------------------
|
|
Lparameters tcView, toFoxBin2Prg
|
|
#If .F.
|
|
Local toFoxBin2Prg As c_foxbin2prg Of 'FOXBIN2PRG.PRG'
|
|
#Endif
|
|
|
|
Try
|
|
Local lcText, lcFields, lcIndexes, lcRelations, lcDBC, loEx As Exception ;
|
|
, loFields As CL_DBC_FIELDS_VW Of 'FOXBIN2PRG.PRG' ;
|
|
, loIndexes As CL_DBC_INDEXES_VW Of 'FOXBIN2PRG.PRG' ;
|
|
, loRelations As CL_DBC_RELATIONS Of 'FOXBIN2PRG.PRG'
|
|
Store Null To loRelations, loIndexes, loFields
|
|
Store '' To lcText, lcFields, lcIndexes, lcRelations
|
|
|
|
With This As CL_DBC_VIEW Of 'FOXBIN2PRG.PRG'
|
|
.read_BinDataToProperties(tcView)
|
|
|
|
TEXT TO lcText ADDITIVE TEXTMERGE NOSHOW FLAGS 1+2 PRETEXT 1+2
|
|
<<>>
|
|
<<>> <VIEW>
|
|
<<>> <Name><<tcView>></Name>
|
|
<<>> <Comment><<._Comment>></Comment>
|
|
<<>> <Tables><<._Tables>></Tables>
|
|
<<>> <SQL><<._SQL>></SQL>
|
|
<<>> <AllowSimultaneousFetch><<._AllowSimultaneousFetch>></AllowSimultaneousFetch>
|
|
<<>> <BatchUpdateCount><<._BatchUpdateCount>></BatchUpdateCount>
|
|
<<>> <CompareMemo><<._CompareMemo>></CompareMemo>
|
|
<<>> <ConnectName><<._ConnectName>></ConnectName>
|
|
<<>> <FetchAsNeeded><<._FetchAsNeeded>></FetchAsNeeded>
|
|
<<>> <FetchMemo><<._FetchMemo>></FetchMemo>
|
|
<<>> <FetchSize><<._FetchSize>></FetchSize>
|
|
<<>> <MaxRecords><<._MaxRecords>></MaxRecords>
|
|
<<>> <Offline><<._Offline>></Offline>
|
|
<<>> <ParameterList><<._ParameterList>></ParameterList>
|
|
<<>> <Prepared><<._Prepared>></Prepared>
|
|
<<>> <RuleExpression><<._RuleExpression>></RuleExpression>
|
|
<<>> <RuleText><<._RuleText>></RuleText>
|
|
<<>> <SendUpdates><<._SendUpdates>></SendUpdates>
|
|
<<>> <ShareConnection><<._ShareConnection>></ShareConnection>
|
|
<<>> <SourceType><<._SourceType>></SourceType>
|
|
<<>> <UpdateType><<._UpdateType>></UpdateType>
|
|
<<>> <UseMemoSize><<._UseMemoSize>></UseMemoSize>
|
|
<<>> <WhereType><<._WhereType>></WhereType>
|
|
ENDTEXT
|
|
|
|
*-- ALGUNOS VALORES QUE EL DBGETPROP OFICIAL NO DEVUELVE
|
|
*-- Path
|
|
*-- OfflineRecordCount
|
|
If ._Offline Then
|
|
TEXT TO lcText ADDITIVE TEXTMERGE NOSHOW FLAGS 1+2 PRETEXT 1+2
|
|
<<>> <Path><<._Path>></Path>
|
|
<<>> <RecordCount><<._RecordCount>></RecordCount>
|
|
ENDTEXT
|
|
Endif
|
|
*--
|
|
|
|
loFields = ._Fields
|
|
lcFields = loFields.toText( tcView )
|
|
|
|
loIndexes = ._Indexes
|
|
lcIndexes = loIndexes.toText( tcView )
|
|
|
|
loRelations = ._Relations
|
|
lcRelations = loRelations.toText( tcView )
|
|
|
|
TEXT TO lcText ADDITIVE TEXTMERGE NOSHOW FLAGS 1+2 PRETEXT 1+2
|
|
<<lcFields>>
|
|
<<lcIndexes>>
|
|
<<lcRelations>>
|
|
<<>> </VIEW>
|
|
ENDTEXT
|
|
|
|
._ToText = lcText
|
|
Endwith && THIS
|
|
|
|
|
|
Catch To loEx
|
|
loEx.UserValue = loEx.UserValue + CR_LF + "tcView = " + Rtrim(Transform(tcView))
|
|
|
|
If This.n_Debug > 0 And _vfp.StartMode = 0
|
|
Set Step On
|
|
Endif
|
|
|
|
Throw
|
|
|
|
Finally
|
|
Store Null To loRelations, loIndexes, loFields
|
|
Release loFields, loIndexes, loRelations
|
|
|
|
Endtry
|
|
|
|
Return lcText
|
|
Endproc
|
|
|
|
|
|
Procedure updateDBC
|
|
*---------------------------------------------------------------------------------------------------
|
|
* PARÁMETROS: (v=Pasar por valor | @=Pasar por referencia) (!=Obligatorio | ?=Opcional) (IN/OUT)
|
|
* tc_OutputFile (v! IN ) Nombre del archivo de salida
|
|
* tnLastID (!@ IN ) Último número de ID usado
|
|
* tnParentID (v! IN ) ID del objeto Padre
|
|
*---------------------------------------------------------------------------------------------------
|
|
Lparameters tc_OutputFile, tnLastID, tnParentID
|
|
|
|
DoDefault( tc_OutputFile, @tnLastID, tnParentID)
|
|
|
|
With This As CL_DBC_VIEW Of 'FOXBIN2PRG.PRG'
|
|
tnParentID = .__ObjectID
|
|
._Fields.updateDBC( tc_OutputFile, @tnLastID, tnParentID )
|
|
._Indexes.updateDBC( tc_OutputFile, @tnLastID, tnParentID )
|
|
._Relations.updateDBC( tc_OutputFile, @tnLastID, tnParentID )
|
|
Endwith && THIS
|
|
Endproc
|
|
|
|
|
|
Procedure getBinMemoFromProperties
|
|
Local lcBinData
|
|
lcBinData = ''
|
|
|
|
With This As CL_DBC_VIEW Of 'FOXBIN2PRG.PRG'
|
|
If ._SourceType = 1
|
|
lcBinData = lcBinData + .getBinPropertyDataRecord( 6, .getDBCPropertyIDByName('Class', .T.) )
|
|
Else
|
|
lcBinData = lcBinData + .getBinPropertyDataRecord( 7, .getDBCPropertyIDByName('Class', .T.) )
|
|
Endif
|
|
lcBinData = lcBinData + .getBinPropertyDataRecord( ._UpdateType, .getDBCPropertyIDByName('UpdateType', .T.) )
|
|
lcBinData = lcBinData + .getBinPropertyDataRecord( ._WhereType, .getDBCPropertyIDByName('WhereType', .T.) )
|
|
lcBinData = lcBinData + .getBinPropertyDataRecord( ._FetchMemo, .getDBCPropertyIDByName('FetchMemo', .T.) )
|
|
lcBinData = lcBinData + .getBinPropertyDataRecord( ._ShareConnection, .getDBCPropertyIDByName('ShareConnection', .T.) )
|
|
lcBinData = lcBinData + .getBinPropertyDataRecord( ._AllowSimultaneousFetch, .getDBCPropertyIDByName('AllowSimultaneousFetch', .T.) ) && Undocumented
|
|
lcBinData = lcBinData + .getBinPropertyDataRecord( ._SendUpdates, .getDBCPropertyIDByName('SendUpdates', .T.) )
|
|
lcBinData = lcBinData + .getBinPropertyDataRecord( ._Prepared, .getDBCPropertyIDByName('Prepared', .T.) ) && Undocumented
|
|
lcBinData = lcBinData + .getBinPropertyDataRecord( ._CompareMemo, .getDBCPropertyIDByName('CompareMemo', .T.) ) && Undocumented
|
|
lcBinData = lcBinData + .getBinPropertyDataRecord( ._FetchAsNeeded, .getDBCPropertyIDByName('FetchAsNeeded', .T.) ) && Undocumented
|
|
lcBinData = lcBinData + .getBinPropertyDataRecord( ._FetchSize, .getDBCPropertyIDByName('FetchSize', .T.) )
|
|
lcBinData = lcBinData + .getBinPropertyDataRecord( ._MaxRecords, .getDBCPropertyIDByName('MaxRecords', .T.) )
|
|
lcBinData = lcBinData + .getBinPropertyDataRecord( ._Tables, .getDBCPropertyIDByName('Tables', .T.) )
|
|
lcBinData = lcBinData + .getBinPropertyDataRecord( ._Sql, .getDBCPropertyIDByName('SQL', .T.) )
|
|
lcBinData = lcBinData + .getBinPropertyDataRecord( ._SourceType, .getDBCPropertyIDByName('SourceType', .T.) )
|
|
lcBinData = lcBinData + .getBinPropertyDataRecord( ._BatchUpdateCount, .getDBCPropertyIDByName('BatchUpdateCount', .T.) )
|
|
lcBinData = lcBinData + .getBinPropertyDataRecord( ._Comment, .getDBCPropertyIDByName('Comment', .T.) )
|
|
lcBinData = lcBinData + .getBinPropertyDataRecord( ._RuleExpression, .getDBCPropertyIDByName('RuleExpression', .T.) )
|
|
lcBinData = lcBinData + .getBinPropertyDataRecord( ._RuleText, .getDBCPropertyIDByName('RuleText', .T.) )
|
|
lcBinData = lcBinData + .getBinPropertyDataRecord( ._ParameterList, .getDBCPropertyIDByName('ParameterList', .T.) )
|
|
lcBinData = lcBinData + .getBinPropertyDataRecord( ._ConnectName, .getDBCPropertyIDByName('ConnectName', .T.) )
|
|
lcBinData = lcBinData + .getBinPropertyDataRecord( ._UseMemoSize, .getDBCPropertyIDByName('UseMemoSize', .T.) )
|
|
lcBinData = lcBinData + .getBinPropertyDataRecord( ._Offline, .getDBCPropertyIDByName('Offline', .T.) ) && Undocumented
|
|
lcBinData = lcBinData + .getBinPropertyDataRecord( ._RecordCount, .getDBCPropertyIDByName('RecordCount', .T.) ) && Undocumented
|
|
lcBinData = lcBinData + .getBinPropertyDataRecord( ._Path, .getDBCPropertyIDByName('Path', .T.) ) && Undocumented
|
|
lcBinData = lcBinData + .getBinPropertyDataRecord( 0, .getDBCPropertyIDByName('undocumented_view_prop_85', .T.) ) && Undocumented
|
|
Endwith && THIS
|
|
|
|
Return lcBinData
|
|
Endproc
|
|
|
|
|
|
Procedure read_BinDataToProperties
|
|
*---------------------------------------------------------------------------------------------------
|
|
* PARÁMETROS: (v=Pasar por valor | @=Pasar por referencia) (!=Obligatorio | ?=Opcional) (IN/OUT)
|
|
* tcView (v! IN ) Vista en evaluación
|
|
*---------------------------------------------------------------------------------------------------
|
|
Lparameters tcView
|
|
|
|
With This As CL_DBC_VIEW Of 'FOXBIN2PRG.PRG'
|
|
If Not ._Saved Then
|
|
._Name = Alltrim(tcView)
|
|
._Comment = DBGetProp(tcView,"VIEW","Comment")
|
|
._Tables = DBGetProp(tcView,"VIEW","Tables")
|
|
._Sql = DBGetProp(tcView,"VIEW","SQL")
|
|
._AllowSimultaneousFetch = DBGetProp(tcView,"VIEW","AllowSimultaneousFetch")
|
|
._BatchUpdateCount = DBGetProp(tcView,"VIEW","BatchUpdateCount")
|
|
._CompareMemo = DBGetProp(tcView,"VIEW","CompareMemo")
|
|
._ConnectName = DBGetProp(tcView,"VIEW","ConnectName")
|
|
._FetchAsNeeded = DBGetProp(tcView,"VIEW","FetchAsNeeded")
|
|
._FetchMemo = DBGetProp(tcView,"VIEW","FetchMemo")
|
|
._FetchSize = DBGetProp(tcView,"VIEW","FetchSize")
|
|
._MaxRecords = DBGetProp(tcView,"VIEW","MaxRecords")
|
|
._Offline = DBGetProp(tcView,"VIEW","Offline")
|
|
._ParameterList = DBGetProp(tcView,"VIEW","ParameterList")
|
|
._Prepared = DBGetProp(tcView,"VIEW","Prepared")
|
|
._RuleExpression = DBGetProp(tcView,"VIEW","RuleExpression")
|
|
._RuleText = DBGetProp(tcView,"VIEW","RuleText")
|
|
._SendUpdates = DBGetProp(tcView,"VIEW","SendUpdates")
|
|
._ShareConnection = DBGetProp(tcView,"VIEW","ShareConnection")
|
|
._SourceType = DBGetProp(tcView,"VIEW","SourceType")
|
|
._UpdateType = DBGetProp(tcView,"VIEW","UpdateType")
|
|
._UseMemoSize = DBGetProp(tcView,"VIEW","UseMemoSize")
|
|
._WhereType = DBGetProp(tcView,"VIEW","WhereType")
|
|
*--
|
|
._Path = .DBGetProp(tcView,"VIEW","Path") && Para las Vistas el DBGETPROP oficial no funciona con Path
|
|
._RecordCount = .DBGetProp(tcView,"VIEW","RecordCount") && Para las Vistas el DBGETPROP oficial no funciona con RecordCount
|
|
*--
|
|
._Saved = .T.
|
|
Endif
|
|
Endwith
|
|
Endproc
|
|
|
|
|
|
Enddefine
|
|
|
|
|
|
|
|
Define Class CL_DBC_FIELDS_VW As CL_DBC_COL_BASE
|
|
#If .F.
|
|
Local This As CL_DBC_FIELDS_VW Of 'FOXBIN2PRG.PRG'
|
|
#Endif
|
|
|
|
_MemberData = [<VFPData>] ;
|
|
+ [<memberdata name="analyzeordercodeblock" display="analyzeOrderCodeBlock"/>] ;
|
|
+ [<memberdata name="a_campos" display="a_Campos"/>] ;
|
|
+ [<memberdata name="n_campos" display="n_Campos"/>] ;
|
|
+ [</VFPData>]
|
|
|
|
Dimension a_Campos(1,2) && col.1=campo, col.2=definición
|
|
n_Campos = 0
|
|
|
|
|
|
Procedure analyzeCodeBlock
|
|
*---------------------------------------------------------------------------------------------------
|
|
* PARÁMETROS: (v=Pasar por valor | @=Pasar por referencia) (!=Obligatorio | ?=Opcional) (IN/OUT)
|
|
* tcLine (!@ IN/OUT) Contenido de la línea en análisis
|
|
* taCodeLines (!@ IN ) Array de líneas del programa analizado
|
|
* I (!@ IN/OUT) Número de línea en análisis
|
|
* tnCodeLines (!@ IN ) Cantidad de líneas del programa analizado
|
|
*---------------------------------------------------------------------------------------------------
|
|
Lparameters tcLine, taCodeLines, I, tnCodeLines
|
|
|
|
Try
|
|
Local llBloqueEncontrado, lcPropName, lcValue, loEx As Exception ;
|
|
, loField As CL_DBC_FIELD_VW Of 'FOXBIN2PRG.PRG'
|
|
Store Null To loField
|
|
Store '' To lcPropName, lcValue
|
|
|
|
If Left(tcLine, Len(C_FIELDS_I)) == C_FIELDS_I
|
|
llBloqueEncontrado = .T.
|
|
|
|
With This As CL_DBC_FIELDS_VW Of 'FOXBIN2PRG.PRG'
|
|
*.n_Campos = 0 && Descomentar para forzar modo LEGACY
|
|
For I = m.I + 1 To tnCodeLines
|
|
.set_Line( @tcLine, @taCodeLines, m.I )
|
|
|
|
Do Case
|
|
Case Empty( tcLine )
|
|
Loop
|
|
|
|
Case C_FIELDS_F $ tcLine && Fin
|
|
Exit
|
|
|
|
Case C_FIELD_I $ tcLine
|
|
loField = Null
|
|
loField = Createobject("CL_DBC_FIELD_VW")
|
|
loField.analyzeCodeBlock( @tcLine, @taCodeLines, @m.I, tnCodeLines )
|
|
|
|
If .n_Campos = 0 Then
|
|
*-- MODO LEGACY: Cuando no existe tag de ordenamiento de campos, se agregan en el orden que se leen
|
|
*-- El siguiente PADR() es porque si no "estoXXX" está antes que "esto" cuando keysort=2 (raro...)
|
|
.Add( loField, Padr(Lower(loField._Name),128) )
|
|
Else
|
|
lnPos = Ascan( .a_Campos, loField._Name, 1, 0, 1, 1+2+4+8 )
|
|
.a_Campos( lnPos, 2) = loField
|
|
Endif
|
|
|
|
Otherwise && Otro valor
|
|
*-- No hay otros valores
|
|
Endcase
|
|
Endfor
|
|
|
|
*-- Restablezco el orden de los campos (Solo si n_Campos > 0, que significa que tiene el nuevo tag especial de orden)
|
|
For lnPos = 1 To .n_Campos
|
|
*-- El siguiente PADR() es porque si no "estoXXX" está antes que "esto" cuando keysort=2 (raro...)
|
|
.Add( .a_Campos( lnPos, 2), Padr(Lower(.a_Campos( lnPos, 1)),128) )
|
|
Endfor
|
|
Endwith && THIS
|
|
Endif
|
|
|
|
Catch To loEx
|
|
If loEx.ErrorNo = 1470 && Incorrect property name.
|
|
loEx.UserValue = 'I=' + Transform(m.I) + ', tcLine=' + Transform(tcLine)
|
|
Endif
|
|
|
|
If This.n_Debug > 0 And _vfp.StartMode = 0
|
|
Set Step On
|
|
Endif
|
|
|
|
Throw
|
|
|
|
Finally
|
|
Store Null To loField
|
|
Release lcPropName, lcValue, loField
|
|
|
|
Endtry
|
|
|
|
Return llBloqueEncontrado
|
|
Endproc
|
|
|
|
|
|
|
|
Procedure analyzeOrderCodeBlock
|
|
*---------------------------------------------------------------------------------------------------
|
|
* PARÁMETROS: (v=Pasar por valor | @=Pasar por referencia) (!=Obligatorio | ?=Opcional) (IN/OUT)
|
|
* tcLine (!@ IN/OUT) Contenido de la línea en análisis
|
|
* taCodeLines (!@ IN ) Array de líneas del programa analizado
|
|
* I (!@ IN/OUT) Número de línea en análisis
|
|
* tnCodeLines (!@ IN ) Cantidad de líneas del programa analizado
|
|
*---------------------------------------------------------------------------------------------------
|
|
Lparameters tcLine, taCodeLines, I, tnCodeLines
|
|
|
|
Try
|
|
Local llBloqueEncontrado, lcPropName, lcValue, loEx As Exception ;
|
|
, loField As CL_DBC_FIELD_DB Of 'FOXBIN2PRG.PRG'
|
|
Store Null To loField
|
|
Store '' To lcPropName, lcValue
|
|
|
|
If Left(tcLine, Len(C_FIELD_ORDER_I)) == C_FIELD_ORDER_I
|
|
llBloqueEncontrado = .T.
|
|
|
|
With This As CL_DBC_FIELDS_VW Of 'FOXBIN2PRG.PRG'
|
|
For I = m.I + 1 To tnCodeLines
|
|
.set_Line( @tcLine, @taCodeLines, m.I )
|
|
|
|
Do Case
|
|
Case Empty( tcLine )
|
|
Loop
|
|
|
|
Case C_FIELD_ORDER_F $ tcLine && Fin
|
|
Exit
|
|
|
|
Otherwise && nombre del campo en el orden original
|
|
.n_Campos = .n_Campos + 1
|
|
Dimension .a_Campos(.n_Campos, 2)
|
|
.a_Campos(.n_Campos, 1) = tcLine
|
|
|
|
Endcase
|
|
Endfor
|
|
Endwith && THIS
|
|
Endif
|
|
|
|
Catch To loEx
|
|
If This.n_Debug > 0 And _vfp.StartMode = 0
|
|
Set Step On
|
|
Endif
|
|
|
|
Throw
|
|
|
|
Finally
|
|
Store Null To loField
|
|
Release lcPropName, lcValue, loField
|
|
|
|
Endtry
|
|
|
|
Return llBloqueEncontrado
|
|
Endproc
|
|
|
|
|
|
Procedure toText
|
|
*---------------------------------------------------------------------------------------------------
|
|
* PARÁMETROS: (v=Pasar por valor | @=Pasar por referencia) (!=Obligatorio | ?=Opcional) (IN/OUT)
|
|
* tcView (v! IN ) Nombre de la Vista
|
|
* toFoxBin2Prg (@! IN ) Referencia de toFoxBin2Prg
|
|
*---------------------------------------------------------------------------------------------------
|
|
Lparameters tcView, toFoxBin2Prg
|
|
|
|
#If .F.
|
|
Local toFoxBin2Prg As c_foxbin2prg Of 'FOXBIN2PRG.PRG'
|
|
#Endif
|
|
|
|
Try
|
|
Local lcText, loEx As Exception ;
|
|
, loField As CL_DBC_FIELD_VW Of 'FOXBIN2PRG.PRG'
|
|
Store Null To loField
|
|
lcText = ''
|
|
|
|
With This As CL_DBC_FIELDS_VW Of 'FOXBIN2PRG.PRG'
|
|
.read_BinDataToProperties(tcView, @toFoxBin2Prg)
|
|
|
|
If .Count > 0 Then
|
|
TEXT TO lcText ADDITIVE TEXTMERGE NOSHOW FLAGS 1+2 PRETEXT 1+2
|
|
<<>> <FIELD_ORDER>
|
|
<<>>
|
|
ENDTEXT
|
|
|
|
Set Textmerge To Memvar lcText Additive Noshow
|
|
Set Textmerge On
|
|
|
|
.KeySort = 0
|
|
For Each loField In This &&FOXOBJECT
|
|
\ <<loField._Name>>
|
|
Endfor
|
|
|
|
Set Textmerge Off
|
|
Set Textmerge To
|
|
|
|
TEXT TO lcText ADDITIVE TEXTMERGE NOSHOW FLAGS 1+2 PRETEXT 1+2
|
|
<<>> </FIELD_ORDER>
|
|
<<>>
|
|
<<>> <FIELDS>
|
|
ENDTEXT
|
|
|
|
.KeySort = 2 && Comentar para forzar modo LEGACY
|
|
For Each loField In This &&FOXOBJECT
|
|
lcText = lcText + loField.toText( tcView, loField._Name )
|
|
Endfor
|
|
|
|
TEXT TO lcText ADDITIVE TEXTMERGE NOSHOW FLAGS 1+2 PRETEXT 1+2
|
|
<<>> </FIELDS>
|
|
ENDTEXT
|
|
Endif
|
|
Endwith
|
|
|
|
|
|
Catch To loEx
|
|
If Vartype(loField) = "O" Then
|
|
loEx.UserValue = loEx.UserValue + CR_LF + "loField._Name = " + Rtrim(loField._Name)
|
|
Endif
|
|
|
|
If This.n_Debug > 0 And _vfp.StartMode = 0
|
|
Set Step On
|
|
Endif
|
|
|
|
Throw
|
|
|
|
Finally
|
|
Store Null To loField
|
|
Release loField
|
|
|
|
Endtry
|
|
|
|
Return lcText
|
|
Endproc
|
|
|
|
|
|
Procedure read_BinDataToProperties
|
|
*---------------------------------------------------------------------------------------------------
|
|
* PARÁMETROS: (v=Pasar por valor | @=Pasar por referencia) (!=Obligatorio | ?=Opcional) (IN/OUT)
|
|
* tcView (@! IN ) Nombre de la vista de la que se obtendrán los campos
|
|
* toFoxBin2Prg (@! IN ) Referencia de toFoxBin2Prg
|
|
*---------------------------------------------------------------------------------------------------
|
|
Lparameters tcView, toFoxBin2Prg
|
|
|
|
#If .F.
|
|
Local toFoxBin2Prg As c_foxbin2prg Of 'FOXBIN2PRG.PRG'
|
|
#Endif
|
|
|
|
Try
|
|
Local I, lcText, lnField_Count, laFields(1), loEx As Exception ;
|
|
, loField As CL_DBC_FIELD_VW Of 'FOXBIN2PRG.PRG'
|
|
Store Null To loField
|
|
Store 0 To I, lnField_Count
|
|
lcText = ''
|
|
|
|
With This As CL_DBC_FIELDS_VW Of 'FOXBIN2PRG.PRG'
|
|
If ._Saved Then
|
|
lnField_Count = .Count
|
|
Exit
|
|
Endif
|
|
|
|
_Tally = 0
|
|
Select Lower(TB.ObjectName) From TABLABIN TB ;
|
|
INNER Join TABLABIN TB2 On Str(TB.ParentId)+TB.ObjectType = Str(TB2.ObjectID)+Padr('Field',10) ;
|
|
AND Lower(TB2.ObjectName) = Padr(Lower(tcView),128) ;
|
|
INTO Array laFields
|
|
lnField_Count = _Tally
|
|
|
|
If lnField_Count > 0
|
|
For I = 1 To lnField_Count
|
|
loField = Createobject("CL_DBC_FIELD_VW")
|
|
loField.read_BinDataToProperties( tcView, laFields(m.I) )
|
|
*-- El siguiente PADR() es porque si no "estoXXX" está antes que "esto" cuando keysort=2 (raro...)
|
|
.Add( loField, Padr(Lower(loField._Name),128) )
|
|
Endfor
|
|
Endif
|
|
|
|
._Saved = .T.
|
|
Endwith
|
|
|
|
Catch To loEx
|
|
If This.n_Debug > 0 And _vfp.StartMode = 0
|
|
Set Step On
|
|
Endif
|
|
|
|
Throw
|
|
|
|
Finally
|
|
Use In (Select("TB"))
|
|
Use In (Select("TB2"))
|
|
loField = Null
|
|
Release loField
|
|
|
|
Endtry
|
|
|
|
Return lnField_Count
|
|
Endproc
|
|
|
|
|
|
Enddefine
|
|
|
|
|
|
|
|
Define Class CL_DBC_FIELD_VW As CL_DBC_BASE
|
|
#If .F.
|
|
Local This As CL_DBC_FIELD_VW Of 'FOXBIN2PRG.PRG'
|
|
#Endif
|
|
|
|
_MemberData = [<VFPData>] ;
|
|
+ [<memberdata name="_name" display="_Name"/>] ;
|
|
+ [<memberdata name="_caption" display="_Caption"/>] ;
|
|
+ [<memberdata name="_comment" display="_Comment"/>] ;
|
|
+ [<memberdata name="_datatype" display="_DataType"/>] ;
|
|
+ [<memberdata name="_defaultvalue" display="_DefaultValue"/>] ;
|
|
+ [<memberdata name="_displayclass" display="_DisplayClass"/>] ;
|
|
+ [<memberdata name="_displayclasslibrary" display="_DisplayClassLibrary"/>] ;
|
|
+ [<memberdata name="_format" display="_Format"/>] ;
|
|
+ [<memberdata name="_inputmask" display="_InputMask"/>] ;
|
|
+ [<memberdata name="_keyfield" display="_KeyField"/>] ;
|
|
+ [<memberdata name="_ruleexpression" display="_RuleExpression"/>] ;
|
|
+ [<memberdata name="_ruletext" display="_RuleText"/>] ;
|
|
+ [<memberdata name="_updatable" display="_Updatable"/>] ;
|
|
+ [<memberdata name="_updatename" display="_UpdateName"/>] ;
|
|
+ [</VFPData>]
|
|
|
|
|
|
*-- Info
|
|
_Name = ''
|
|
_Caption = ''
|
|
_Comment = ''
|
|
_DataType = ''
|
|
_DefaultValue = ''
|
|
_DisplayClass = ''
|
|
_DisplayClassLibrary = ''
|
|
_Format = ''
|
|
_InputMask = ''
|
|
_KeyField = .F.
|
|
_RuleExpression = ''
|
|
_RuleText = ''
|
|
_Updatable = .F.
|
|
_UpdateName = ''
|
|
|
|
|
|
Procedure analyzeCodeBlock
|
|
*---------------------------------------------------------------------------------------------------
|
|
* PARÁMETROS: (v=Pasar por valor | @=Pasar por referencia) (!=Obligatorio | ?=Opcional) (IN/OUT)
|
|
* tcLine (!@ IN/OUT) Contenido de la línea en análisis
|
|
* taCodeLines (!@ IN ) Array de líneas del programa analizado
|
|
* I (!@ IN/OUT) Número de línea en análisis
|
|
* tnCodeLines (!@ IN ) Cantidad de líneas del programa analizado
|
|
*---------------------------------------------------------------------------------------------------
|
|
Lparameters tcLine, taCodeLines, I, tnCodeLines
|
|
|
|
Try
|
|
Local llBloqueEncontrado, lcPropName, lcValue, loEx As Exception
|
|
Store '' To lcPropName, lcValue
|
|
|
|
If Left(tcLine, Len(C_FIELD_I)) == C_FIELD_I
|
|
llBloqueEncontrado = .T.
|
|
|
|
With This As CL_DBC_FIELD_VW Of 'FOXBIN2PRG.PRG'
|
|
For I = m.I + 1 To tnCodeLines
|
|
.set_Line( @tcLine, @taCodeLines, m.I )
|
|
|
|
Do Case
|
|
Case Empty( tcLine )
|
|
Loop
|
|
|
|
Case C_FIELD_F $ tcLine && Fin
|
|
Exit
|
|
|
|
Case '<Comment>' $ tcLine
|
|
.analyzeCodeBlock_Comment( @tcLine, @taCodeLines, @m.I, tnCodeLines )
|
|
|
|
Otherwise && Propiedad de FIELD
|
|
*-- Estructura a reconocer:
|
|
* <name>NOMBRE</name>
|
|
lcPropName = Strextract( tcLine, '<', '>', 1, 0 )
|
|
lcValue = Strextract( tcLine, '<' + lcPropName + '>', '</' + lcPropName + '>', 1, 0 )
|
|
.add_Property( '_' + lcPropName, lcValue )
|
|
Endcase
|
|
Endfor
|
|
Endwith && THIS
|
|
Endif
|
|
|
|
|
|
Catch To loEx
|
|
If loEx.ErrorNo = 1470 && Incorrect property name.
|
|
loEx.UserValue = 'I=' + Transform(m.I) + ', tcLine=' + Transform(tcLine) + ', PropName=[' + Transform(lcPropName) + '], Value=[' + Transform(lcValue) + ']'
|
|
Endif
|
|
|
|
If This.n_Debug > 0 And _vfp.StartMode = 0
|
|
Set Step On
|
|
Endif
|
|
|
|
Throw
|
|
|
|
Endtry
|
|
|
|
Return llBloqueEncontrado
|
|
Endproc
|
|
|
|
|
|
Procedure toText
|
|
*---------------------------------------------------------------------------------------------------
|
|
* PARÁMETROS: (v=Pasar por valor | @=Pasar por referencia) (!=Obligatorio | ?=Opcional) (IN/OUT)
|
|
* tcView (v! IN ) Nombre de la Vista
|
|
* tcField (v! IN ) Nombre del campo
|
|
*---------------------------------------------------------------------------------------------------
|
|
Lparameters tcView, tcField
|
|
|
|
Try
|
|
With This As CL_DBC_FIELD_VW Of 'FOXBIN2PRG.PRG'
|
|
Local lcText, loEx As Exception
|
|
lcText = ''
|
|
|
|
TEXT TO lcText ADDITIVE TEXTMERGE NOSHOW FLAGS 1+2 PRETEXT 1+2
|
|
<<>> <FIELD>
|
|
<<>> <Name><<._Name>></Name>
|
|
<<>> <Caption><<._Caption>></Caption>
|
|
<<>> <Comment><<._Comment>></Comment>
|
|
<<>> <DataType><<._DataType>></DataType>
|
|
<<>> <DefaultValue><<._DefaultValue>></DefaultValue>
|
|
<<>> <DisplayClass><<._DisplayClass>></DisplayClass>
|
|
<<>> <DisplayClassLibrary><<._DisplayClassLibrary>></DisplayClassLibrary>
|
|
<<>> <Format><<._Format>></Format>
|
|
<<>> <InputMask><<._InputMask>></InputMask>
|
|
<<>> <KeyField><<._KeyField>></KeyField>
|
|
<<>> <RuleExpression><<._RuleExpression>></RuleExpression>
|
|
<<>> <RuleText><<._RuleText>></RuleText>
|
|
<<>> <Updatable><<._Updatable>></Updatable>
|
|
<<>> <UpdateName><<._UpdateName>></UpdateName>
|
|
<<>> </FIELD>
|
|
ENDTEXT
|
|
|
|
._ToText = lcText
|
|
Endwith
|
|
|
|
Catch To loEx
|
|
loEx.UserValue = loEx.UserValue + CR_LF + "tcView.tcField = " + Transform(tcView) + '.' + Transform(tcField)
|
|
|
|
If This.n_Debug > 0 And _vfp.StartMode = 0
|
|
Set Step On
|
|
Endif
|
|
|
|
Throw
|
|
|
|
Endtry
|
|
|
|
Return lcText
|
|
Endproc
|
|
|
|
|
|
Procedure getBinMemoFromProperties
|
|
Local lcBinData
|
|
lcBinData = ''
|
|
|
|
With This As CL_DBC_FIELD_VW Of 'FOXBIN2PRG.PRG'
|
|
lcBinData = lcBinData + .getBinPropertyDataRecord( ._Comment, .getDBCPropertyIDByName('Comment', .T.) )
|
|
lcBinData = lcBinData + .getBinPropertyDataRecord( ._DataType, .getDBCPropertyIDByName('DataType', .T.) )
|
|
lcBinData = lcBinData + .getBinPropertyDataRecord( ._KeyField, .getDBCPropertyIDByName('KeyField', .T.) )
|
|
lcBinData = lcBinData + .getBinPropertyDataRecord( ._Updatable, .getDBCPropertyIDByName('UpdatableField', .T.) )
|
|
lcBinData = lcBinData + .getBinPropertyDataRecord( ._UpdateName, .getDBCPropertyIDByName('UpdateName', .T.) )
|
|
lcBinData = lcBinData + .getBinPropertyDataRecord( ._DefaultValue, .getDBCPropertyIDByName('DefaultValue', .T.) )
|
|
lcBinData = lcBinData + .getBinPropertyDataRecord( ._DisplayClass, .getDBCPropertyIDByName('DisplayClass', .T.) )
|
|
lcBinData = lcBinData + .getBinPropertyDataRecord( ._DisplayClassLibrary, .getDBCPropertyIDByName('DisplayClassLibrary', .T.) )
|
|
lcBinData = lcBinData + .getBinPropertyDataRecord( ._Caption, .getDBCPropertyIDByName('Caption', .T.) )
|
|
lcBinData = lcBinData + .getBinPropertyDataRecord( ._Format, .getDBCPropertyIDByName('Format', .T.) )
|
|
lcBinData = lcBinData + .getBinPropertyDataRecord( ._InputMask, .getDBCPropertyIDByName('InputMask', .T.) )
|
|
lcBinData = lcBinData + .getBinPropertyDataRecord( ._RuleExpression, .getDBCPropertyIDByName('RuleExpression', .T.) )
|
|
lcBinData = lcBinData + .getBinPropertyDataRecord( ._RuleText, .getDBCPropertyIDByName('RuleText', .T.) )
|
|
Endwith && THIS
|
|
|
|
Return lcBinData
|
|
Endproc
|
|
|
|
|
|
Procedure read_BinDataToProperties
|
|
Lparameters tcView, tcField
|
|
|
|
With This As CL_DBC_FIELD_VW Of 'FOXBIN2PRG.PRG'
|
|
If Not ._Saved Then
|
|
._Name = Alltrim(tcField)
|
|
._Caption = DBGetProp( Rtrim(tcView) + '.' + Rtrim(tcField),"FIELD","Caption")
|
|
._Comment = DBGetProp( Rtrim(tcView) + '.' + Rtrim(tcField),"FIELD","Comment")
|
|
._DataType = DBGetProp( Rtrim(tcView) + '.' + Rtrim(tcField),"FIELD","DataType")
|
|
._DefaultValue = DBGetProp( Rtrim(tcView) + '.' + Rtrim(tcField),"FIELD","DefaultValue")
|
|
._DisplayClass = DBGetProp( Rtrim(tcView) + '.' + Rtrim(tcField),"FIELD","DisplayClass")
|
|
._DisplayClassLibrary = DBGetProp( Rtrim(tcView) + '.' + Rtrim(tcField),"FIELD","DisplayClassLibrary")
|
|
._Format = DBGetProp( Rtrim(tcView) + '.' + Rtrim(tcField),"FIELD","Format")
|
|
._InputMask = DBGetProp( Rtrim(tcView) + '.' + Rtrim(tcField),"FIELD","InputMask")
|
|
._KeyField = DBGetProp( Rtrim(tcView) + '.' + Rtrim(tcField),"FIELD","KeyField")
|
|
._RuleExpression = DBGetProp( Rtrim(tcView) + '.' + Rtrim(tcField),"FIELD","RuleExpression")
|
|
._RuleText = DBGetProp( Rtrim(tcView) + '.' + Rtrim(tcField),"FIELD","RuleText")
|
|
._Updatable = DBGetProp( Rtrim(tcView) + '.' + Rtrim(tcField),"FIELD","Updatable")
|
|
._UpdateName = DBGetProp( Rtrim(tcView) + '.' + Rtrim(tcField),"FIELD","UpdateName")
|
|
*--
|
|
._Saved = .T.
|
|
Endif
|
|
Endwith
|
|
Endproc
|
|
|
|
|
|
Enddefine
|
|
|
|
|
|
|
|
Define Class CL_DBC_RELATIONS As CL_DBC_COL_BASE
|
|
#If .F.
|
|
Local This As CL_DBC_RELATIONS Of 'FOXBIN2PRG.PRG'
|
|
#Endif
|
|
|
|
|
|
Procedure analyzeCodeBlock
|
|
*---------------------------------------------------------------------------------------------------
|
|
* PARÁMETROS: (v=Pasar por valor | @=Pasar por referencia) (!=Obligatorio | ?=Opcional) (IN/OUT)
|
|
* tcLine (!@ IN/OUT) Contenido de la línea en análisis
|
|
* taCodeLines (!@ IN ) Array de líneas del programa analizado
|
|
* I (!@ IN/OUT) Número de línea en análisis
|
|
* tnCodeLines (!@ IN ) Cantidad de líneas del programa analizado
|
|
*---------------------------------------------------------------------------------------------------
|
|
Lparameters tcLine, taCodeLines, I, tnCodeLines
|
|
|
|
Try
|
|
Local llBloqueEncontrado, lcPropName, lcValue, loEx As Exception ;
|
|
, loRelation As CL_DBC_RELATION Of 'FOXBIN2PRG.PRG'
|
|
Store Null To loRelation
|
|
Store '' To lcPropName, lcValue
|
|
|
|
If Left(tcLine, Len(C_RELATIONS_I)) == C_RELATIONS_I
|
|
llBloqueEncontrado = .T.
|
|
|
|
With This As CL_DBC_RELATIONS Of 'FOXBIN2PRG.PRG'
|
|
For I = m.I + 1 To tnCodeLines
|
|
.set_Line( @tcLine, @taCodeLines, m.I )
|
|
|
|
Do Case
|
|
Case Empty( tcLine )
|
|
Loop
|
|
|
|
Case C_RELATIONS_F $ tcLine && Fin
|
|
Exit
|
|
|
|
Case C_RELATION_I $ tcLine
|
|
loRelation = Null
|
|
loRelation = Createobject("CL_DBC_RELATION")
|
|
loRelation.analyzeCodeBlock( @tcLine, @taCodeLines, @m.I, tnCodeLines )
|
|
|
|
Try
|
|
*-- El siguiente PADR() es porque si no "estoXXX" está antes que "esto" cuando keysort=2 (raro...)
|
|
.Add( loRelation, Padr(Lower(loRelation._Name),128) )
|
|
Catch To loEx When loEx.ErrorNo = 2062 && The specified Key already exists.
|
|
*-- Saltear este error, porque implica que la relación está duplicada
|
|
Endtry
|
|
|
|
Otherwise && Otro valor
|
|
*-- No hay otros valores
|
|
Endcase
|
|
Endfor
|
|
Endwith && THIS
|
|
Endif
|
|
|
|
Catch To loEx
|
|
If loEx.ErrorNo = 1470 && Incorrect property name.
|
|
loEx.UserValue = 'I=' + Transform(m.I) + ', tcLine=' + Transform(tcLine)
|
|
Endif
|
|
|
|
If This.n_Debug > 0 And _vfp.StartMode = 0
|
|
Set Step On
|
|
Endif
|
|
|
|
Throw
|
|
|
|
Finally
|
|
Store Null To loRelation
|
|
Release lcPropName, lcValue, loRelation
|
|
|
|
Endtry
|
|
|
|
Return llBloqueEncontrado
|
|
Endproc
|
|
|
|
|
|
Procedure toText
|
|
*---------------------------------------------------------------------------------------------------
|
|
* PARÁMETROS: (v=Pasar por valor | @=Pasar por referencia) (!=Obligatorio | ?=Opcional) (IN/OUT)
|
|
* tcTable (v! IN ) Tabla de la que obtener las relaciones
|
|
* toFoxBin2Prg (@! IN ) Referencia de toFoxBin2Prg
|
|
*---------------------------------------------------------------------------------------------------
|
|
Lparameters tcTable, toFoxBin2Prg
|
|
|
|
#If .F.
|
|
Local toFoxBin2Prg As c_foxbin2prg Of 'FOXBIN2PRG.PRG'
|
|
#Endif
|
|
|
|
Try
|
|
With This As CL_DBC_RELATIONS Of 'FOXBIN2PRG.PRG'
|
|
Local lcText, loEx As Exception ;
|
|
, loRelation As CL_DBC_RELATION Of 'FOXBIN2PRG.PRG'
|
|
Store Null To loRelation
|
|
lcText = ''
|
|
.read_BinDataToProperties(tcTable, @toFoxBin2Prg)
|
|
|
|
If .Count > 0 Then
|
|
TEXT TO lcText ADDITIVE TEXTMERGE NOSHOW FLAGS 1+2 PRETEXT 1+2
|
|
<<>> <RELATIONS>
|
|
ENDTEXT
|
|
|
|
.KeySort=2 && Comentar para forzar modo LEGACY
|
|
For Each loRelation In This &&FOXOBJECT
|
|
lcText = lcText + loRelation.toText()
|
|
Endfor
|
|
|
|
TEXT TO lcText ADDITIVE TEXTMERGE NOSHOW FLAGS 1+2 PRETEXT 1+2
|
|
<<>> </RELATIONS>
|
|
<<>>
|
|
ENDTEXT
|
|
Endif
|
|
Endwith
|
|
|
|
Catch To loEx
|
|
If This.n_Debug > 0 And _vfp.StartMode = 0
|
|
Set Step On
|
|
Endif
|
|
|
|
Throw
|
|
|
|
Finally
|
|
Store Null To loRelation
|
|
Release I, X, loRelation
|
|
|
|
Endtry
|
|
|
|
Return lcText
|
|
Endproc
|
|
|
|
|
|
Procedure read_BinDataToProperties
|
|
*---------------------------------------------------------------------------------------------------
|
|
* PARÁMETROS: (v=Pasar por valor | @=Pasar por referencia) (!=Obligatorio | ?=Opcional) (IN/OUT)
|
|
* tcTable (v! IN ) Tabla de la que obtener las relaciones
|
|
* toFoxBin2Prg (@! IN ) Referencia de toFoxBin2Prg
|
|
*---------------------------------------------------------------------------------------------------
|
|
Lparameters tcTable, toFoxBin2Prg
|
|
|
|
#If .F.
|
|
Local toFoxBin2Prg As c_foxbin2prg Of 'FOXBIN2PRG.PRG'
|
|
#Endif
|
|
|
|
Try
|
|
With This As CL_DBC_RELATIONS Of 'FOXBIN2PRG.PRG'
|
|
Local I, lnRelation_Count, laRelations(1,5), lcText, loEx As Exception ;
|
|
, loRelation As CL_DBC_RELATION Of 'FOXBIN2PRG.PRG'
|
|
|
|
Store Null To loRelation
|
|
lcText = ''
|
|
I = 0
|
|
|
|
lnRelation_Count = Adbobjects( laRelations, "RELATION" )
|
|
|
|
If lnRelation_Count > 0
|
|
*-- Ordenamiento: Comentar los ASORT para el orden original
|
|
Asort( laRelations, 3, -1, 0, 1 )
|
|
Asort( laRelations, 1, -1, 0, 1 )
|
|
Asort( laRelations, 4, -1, 0, 1 )
|
|
Asort( laRelations, 2, -1, 0, 1 )
|
|
|
|
For I = 1 To lnRelation_Count
|
|
If laRelations(m.I,1) == Upper( Rtrim( tcTable ) )
|
|
loRelation = Createobject('CL_DBC_RELATION')
|
|
loRelation.read_BinDataToProperties( @laRelations, m.I )
|
|
Try
|
|
.Add( loRelation, Padr(Lower(loRelation._Name),128) )
|
|
Catch To loEx When loEx.ErrorNo = 2062 && The specified Key already exists.
|
|
*-- Saltear este error, porque implica que la relación está duplicada
|
|
Endtry
|
|
Endif
|
|
Endfor
|
|
|
|
Endif
|
|
|
|
Endwith
|
|
|
|
Catch To loEx
|
|
If This.n_Debug > 0 And _vfp.StartMode = 0
|
|
Set Step On
|
|
Endif
|
|
|
|
Throw
|
|
|
|
Finally
|
|
Store Null To loRelation
|
|
Release loRelation
|
|
|
|
Endtry
|
|
|
|
Return lcText
|
|
Endproc
|
|
|
|
|
|
Enddefine
|
|
|
|
|
|
|
|
Define Class CL_DBC_RELATION As CL_DBC_BASE
|
|
#If .F.
|
|
Local This As CL_DBC_RELATION Of 'FOXBIN2PRG.PRG'
|
|
#Endif
|
|
|
|
_MemberData = [<VFPData>] ;
|
|
+ [<memberdata name="_childtable" display="_ChildTable"/>] ;
|
|
+ [<memberdata name="_parenttable" display="_ParentTable"/>] ;
|
|
+ [<memberdata name="_childindex" display="_ChildIndex"/>] ;
|
|
+ [<memberdata name="_parentindex" display="_ParentIndex"/>] ;
|
|
+ [<memberdata name="_refintegrity" display="_RefIntegrity"/>] ;
|
|
+ [</VFPData>]
|
|
|
|
|
|
*-- Info
|
|
_ChildTable = ''
|
|
_ParentTable = ''
|
|
_ChildIndex = ''
|
|
_ParentIndex = ''
|
|
_RefIntegrity = ''
|
|
|
|
|
|
|
|
Procedure analyzeCodeBlock
|
|
*---------------------------------------------------------------------------------------------------
|
|
* PARÁMETROS: (v=Pasar por valor | @=Pasar por referencia) (!=Obligatorio | ?=Opcional) (IN/OUT)
|
|
* tcLine (!@ IN/OUT) Contenido de la línea en análisis
|
|
* taCodeLines (!@ IN ) Array de líneas del programa analizado
|
|
* I (!@ IN/OUT) Número de línea en análisis
|
|
* tnCodeLines (!@ IN ) Cantidad de líneas del programa analizado
|
|
*---------------------------------------------------------------------------------------------------
|
|
Lparameters tcLine, taCodeLines, I, tnCodeLines
|
|
|
|
Try
|
|
Local llBloqueEncontrado, lcPropName, lcValue, loEx As Exception
|
|
Store '' To lcPropName, lcValue
|
|
|
|
If Left(tcLine, Len(C_RELATION_I)) == C_RELATION_I
|
|
llBloqueEncontrado = .T.
|
|
|
|
With This As CL_DBC_RELATION Of 'FOXBIN2PRG.PRG'
|
|
For I = m.I + 1 To tnCodeLines
|
|
.set_Line( @tcLine, @taCodeLines, m.I )
|
|
|
|
Do Case
|
|
Case Empty( tcLine )
|
|
Loop
|
|
|
|
Case C_RELATION_F $ tcLine && Fin
|
|
Exit
|
|
|
|
Otherwise && Propiedad de RELATION
|
|
*-- Estructura a reconocer:
|
|
* <name>NOMBRE</name>
|
|
lcPropName = Strextract( tcLine, '<', '>', 1, 0 )
|
|
lcValue = Strextract( tcLine, '<' + lcPropName + '>', '</' + lcPropName + '>', 1, 0 )
|
|
.add_Property( '_' + lcPropName, lcValue )
|
|
Endcase
|
|
Endfor
|
|
Endwith && THIS
|
|
Endif
|
|
|
|
Catch To loEx
|
|
If loEx.ErrorNo = 1470 && Incorrect property name.
|
|
loEx.UserValue = 'I=' + Transform(m.I) + ', tcLine=' + Transform(tcLine) + ', PropName=[' + Transform(lcPropName) + '], Value=[' + Transform(lcValue) + ']'
|
|
Endif
|
|
|
|
If This.n_Debug > 0 And _vfp.StartMode = 0
|
|
Set Step On
|
|
Endif
|
|
|
|
Throw
|
|
|
|
Endtry
|
|
|
|
Return llBloqueEncontrado
|
|
Endproc
|
|
|
|
|
|
Procedure toText
|
|
*---------------------------------------------------------------------------------------------------
|
|
* PARÁMETROS: (v=Pasar por valor | @=Pasar por referencia) (!=Obligatorio | ?=Opcional) (IN/OUT)
|
|
* taRelations (!@ IN ) Array de relaciones
|
|
* X (!@ IN ) Número de relación evaluado
|
|
*---------------------------------------------------------------------------------------------------
|
|
Lparameters taRelations, X
|
|
|
|
External Array taRelations
|
|
|
|
Try
|
|
With This As CL_DBC_RELATION Of 'FOXBIN2PRG.PRG'
|
|
Local lcText, loEx As Exception
|
|
lcText = ''
|
|
.read_BinDataToProperties(@taRelations, m.X)
|
|
|
|
TEXT TO lcText ADDITIVE TEXTMERGE NOSHOW FLAGS 1+2 PRETEXT 1+2
|
|
<<>> <RELATION>
|
|
<<>> <Name><<._Name>></Name>
|
|
<<>> <ChildTable><<._ChildTable>></ChildTable>
|
|
<<>> <ParentTable><<._ParentTable>></ParentTable>
|
|
<<>> <ChildIndex><<._ChildIndex>></ChildIndex>
|
|
<<>> <ParentIndex><<._ParentIndex>></ParentIndex>
|
|
<<>> <RefIntegrity><<._RefIntegrity>></RefIntegrity>
|
|
<<>> </RELATION>
|
|
ENDTEXT
|
|
|
|
._ToText = lcText
|
|
Endwith
|
|
|
|
Catch To loEx
|
|
If This.n_Debug > 0 And _vfp.StartMode = 0
|
|
Set Step On
|
|
Endif
|
|
|
|
Throw
|
|
|
|
Endtry
|
|
|
|
Return lcText
|
|
Endproc
|
|
|
|
|
|
Procedure getReferentialIntegrityInfo
|
|
Return This._RefIntegrity
|
|
Endproc
|
|
|
|
|
|
Procedure getBinMemoFromProperties
|
|
Local lcBinData
|
|
lcBinData = ''
|
|
|
|
With This As CL_DBC_RELATION Of 'FOXBIN2PRG.PRG'
|
|
lcBinData = lcBinData + .getBinPropertyDataRecord( ._ChildIndex, .getDBCPropertyIDByName( 'ChildTag', .T. ) )
|
|
lcBinData = lcBinData + .getBinPropertyDataRecord( ._ParentTable, .getDBCPropertyIDByName( 'ParentTable', .T. ) )
|
|
lcBinData = lcBinData + .getBinPropertyDataRecord( ._ParentIndex, .getDBCPropertyIDByName( 'ParentTag', .T. ) )
|
|
*_ChildTable is used to link the name of the related table.
|
|
Endwith && THIS
|
|
|
|
Return lcBinData
|
|
Endproc
|
|
|
|
|
|
Procedure read_BinDataToProperties
|
|
*---------------------------------------------------------------------------------------------------
|
|
* PARÁMETROS: (v=Pasar por valor | @=Pasar por referencia) (!=Obligatorio | ?=Opcional) (IN/OUT)
|
|
* taRelations (!@ IN ) Array de relaciones
|
|
* I (!@ IN ) Número de relación evaluado
|
|
*---------------------------------------------------------------------------------------------------
|
|
Lparameters taRelations, I
|
|
|
|
External Array taRelations
|
|
|
|
With This As CL_DBC_RELATION Of 'FOXBIN2PRG.PRG'
|
|
If Not ._Saved Then
|
|
._Name = 'Relation ' + Transform(m.I)
|
|
._ChildTable = Alltrim(taRelations(m.I,1))
|
|
._ParentTable = Alltrim(taRelations(m.I,2))
|
|
._ChildIndex = Alltrim(taRelations(m.I,3))
|
|
._ParentIndex = Alltrim(taRelations(m.I,4))
|
|
._RefIntegrity = Alltrim(taRelations(m.I,5))
|
|
*--
|
|
._Saved = .T.
|
|
Endif
|
|
Endwith
|
|
Endproc
|
|
|
|
|
|
Enddefine
|
|
|
|
|
|
|
|
Define Class CL_DBF_TABLE As CL_CUS_BASE
|
|
#If .F.
|
|
Local This As CL_DBF_TABLE Of 'FOXBIN2PRG.PRG'
|
|
#Endif
|
|
|
|
_MemberData = [<VFPData>] ;
|
|
+ [<memberdata name="_codepage" display="_CodePage"/>] ;
|
|
+ [<memberdata name="_database" display="_Database"/>] ;
|
|
+ [<memberdata name="_filetype" display="_FileType"/>] ;
|
|
+ [<memberdata name="_filetype_descrip" display="_FileType_Descrip"/>] ;
|
|
+ [<memberdata name="_indexfile" display="_IndexFile"/>] ;
|
|
+ [<memberdata name="_memofile" display="_MemoFile"/>] ;
|
|
+ [<memberdata name="_lastupdate" display="_LastUpdate"/>] ;
|
|
+ [<memberdata name="_fields" display="_Fields"/>] ;
|
|
+ [<memberdata name="_indexes" display="_Indexes"/>] ;
|
|
+ [<memberdata name="_sourcefile" display="_SourceFile"/>] ;
|
|
+ [<memberdata name="_version" display="_Version"/>] ;
|
|
+ [<memberdata name="_fields" display="_Fields"/>] ;
|
|
+ [<memberdata name="_indexes" display="_Indexes"/>] ;
|
|
+ [<memberdata name="_i" display="_I"/>] ;
|
|
+ [<memberdata name="_tablename" display="_TableName"/>] ;
|
|
+ [</VFPData>]
|
|
|
|
|
|
*-- Modulo
|
|
_Version = 0
|
|
_SourceFile = ''
|
|
_I = 0
|
|
|
|
*-- Table Info
|
|
_TableName = ''
|
|
_CodePage = 0
|
|
_Database = ''
|
|
_FileType = ''
|
|
_FileType_Descrip = ''
|
|
_IndexFile = ''
|
|
_MemoFile = ''
|
|
_LastUpdate = {}
|
|
|
|
*-- Fields and Indexes
|
|
*_Fields = NULL
|
|
*_Indexes = NULL
|
|
|
|
|
|
Procedure Init
|
|
DoDefault()
|
|
*--
|
|
This.AddObject("_Fields", "CL_DBF_FIELDS")
|
|
This.AddObject("_Indexes", "CL_DBF_INDEXES")
|
|
*** DH 06/02/2014: added _Records
|
|
This.AddObject("_Records", "CL_DBF_RECORDS")
|
|
Endproc
|
|
|
|
|
|
Procedure analyzeCodeBlock
|
|
*---------------------------------------------------------------------------------------------------
|
|
* PARÁMETROS: (v=Pasar por valor | @=Pasar por referencia) (!=Obligatorio | ?=Opcional) (IN/OUT)
|
|
* tcLine (!@ IN/OUT) Contenido de la línea en análisis
|
|
* taCodeLines (!@ IN ) Array de líneas del programa analizado
|
|
* I (!@ IN/OUT) Número de línea en análisis
|
|
* tnCodeLines (!@ IN ) Cantidad de líneas del programa analizado
|
|
* toFoxBin2Prg (@! IN ) Referencia de toFoxBin2Prg
|
|
* tl_DBF_BinChar_Base64 out of settings (folder or per-file) Transform NocPTrans fields base64
|
|
* tl_DBF_IncludeDeleted out of settings (folder or per-file) Include deleted records
|
|
*---------------------------------------------------------------------------------------------------
|
|
Lparameters tcLine, taCodeLines, I, tnCodeLines, toFoxBin2Prg, tl_DBF_BinChar_Base64, tl_DBF_IncludeDeleted
|
|
|
|
Try
|
|
Local llBloqueEncontrado, lcPropName, lcValue, llFieldsEvaluated, llIndexesEvaluated ;
|
|
, loEx As Exception ;
|
|
, loFields As CL_DBF_FIELDS Of 'FOXBIN2PRG.PRG' ;
|
|
, loIndexes As CL_DBF_INDEXES Of 'FOXBIN2PRG.PRG' ;
|
|
, loRecords As CL_DBF_RECORDS Of 'FOXBIN2PRG.PRG'
|
|
Store Null To loIndexes, loFields, loRecords
|
|
Store '' To lcPropName, lcValue
|
|
|
|
If Left(tcLine, Len(C_TABLE_I)) == C_TABLE_I
|
|
llBloqueEncontrado = .T.
|
|
|
|
With This As CL_DBF_TABLE Of 'FOXBIN2PRG.PRG'
|
|
For I = m.I + 1 To tnCodeLines
|
|
.set_Line( @tcLine, @taCodeLines, m.I )
|
|
|
|
Do Case
|
|
Case Empty( tcLine )
|
|
Loop
|
|
|
|
Case C_TABLE_F $ tcLine && Fin
|
|
Exit
|
|
|
|
Case Not llFieldsEvaluated And C_FIELDS_I $ tcLine
|
|
loFields = ._Fields
|
|
loFields.analyzeCodeBlock( @tcLine, @taCodeLines, @m.I, tnCodeLines )
|
|
llFieldsEvaluated = .T.
|
|
|
|
Case Not llIndexesEvaluated And C_INDEXES_I $ tcLine
|
|
loIndexes = ._Indexes
|
|
loIndexes.analyzeCodeBlock( @tcLine, @taCodeLines, @m.I, tnCodeLines )
|
|
llIndexesEvaluated = .T.
|
|
|
|
Case C_RECORDS_I $ tcLine
|
|
If llFieldsEvaluated
|
|
* Pensado para poder llamar a este método 2 veces:
|
|
* > La 1ra.para evaluar Campos e Indices, y poder crear la estructura de la tabla
|
|
* al finalizar este paso.
|
|
* > La 2da.para cargar los registros, luego de que se haya creado la tabla,
|
|
* así se van volcando directamente y no se guardan en memoria.
|
|
Exit
|
|
Endif
|
|
|
|
loRecords = ._Records
|
|
*!* Changed by: Lutz Scheffler 21.02.2021
|
|
*!* change date="{^2021-02-21,10:57:00}"
|
|
* additional options controlling
|
|
* - new operations of DBF
|
|
loRecords.analyzeCodeBlock( @tcLine, @taCodeLines, @m.I, tnCodeLines, ._Fields, @toFoxBin2Prg,;
|
|
tl_DBF_BinChar_Base64, tl_DBF_IncludeDeleted )
|
|
*!* /Changed by: Lutz Scheffler 21.02.2021
|
|
Otherwise && Otro valor
|
|
*-- Estructura a reconocer:
|
|
* <tagname>ID<tagname>
|
|
lcPropName = Strextract( tcLine, '<', '>', 1, 0 )
|
|
lcValue = Strextract( tcLine, '<' + lcPropName + '>', '</' + lcPropName + '>', 1, 0 )
|
|
.AddProperty( '_' + lcPropName, lcValue )
|
|
Endcase
|
|
Endfor
|
|
|
|
._I = m.I
|
|
Endwith && THIS
|
|
Endif
|
|
|
|
Catch To loEx
|
|
If loEx.ErrorNo = 1470 && Incorrect property name.
|
|
loEx.UserValue = 'I=' + Transform(m.I) + ', PropName=[' + Transform(lcPropName) + '], Value=[' + Transform(lcValue) + ']'
|
|
Endif
|
|
|
|
If This.n_Debug > 0 And _vfp.StartMode = 0
|
|
Set Step On
|
|
Endif
|
|
|
|
Throw
|
|
|
|
Finally
|
|
Store Null To loIndexes, loFields, loRecords
|
|
Release lcPropName, lcValue, loFields, loIndexes, loRecords
|
|
|
|
Endtry
|
|
|
|
Return llBloqueEncontrado
|
|
Endproc
|
|
|
|
|
|
Procedure toText
|
|
*---------------------------------------------------------------------------------------------------
|
|
* PARÁMETROS: (v=Pasar por valor | @=Pasar por referencia) (!=Obligatorio | ?=Opcional) (IN/OUT)
|
|
* tc_FileTypeDesc (v! IN ) Tipo de archivo (en Hex)
|
|
* tl_FileHasCDX (v! IN ) Indica si el archivo tiene CDX asociado
|
|
* tl_FileHasMemo (v! IN ) Indica si el archivo tiene MEMO (FPT) asociado
|
|
* tl_FileIsDBC (v! IN ) Indica si el archivo es un DBC
|
|
* tc_DBC_Name (v! IN ) Nombre del DBC (si tiene)
|
|
* tc_InputFile (v! IN ) Nombre del archivo de salida
|
|
* tc_FileTypeDesc (v! IN ) Descripción del Tipo de archivo
|
|
* toFoxBin2Prg (@! IN ) Referencia de toFoxBin2Prg
|
|
*---------------------------------------------------------------------------------------------------
|
|
Lparameters tn_HexFileType, tl_FileHasCDX, tl_FileHasMemo, tl_FileIsDBC, tc_DBC_Name, tc_InputFile, tc_FileTypeDesc, toFoxBin2Prg
|
|
|
|
#If .F.
|
|
Local toFoxBin2Prg As c_foxbin2prg Of 'FOXBIN2PRG.PRG'
|
|
#Endif
|
|
|
|
Try
|
|
Local lcText, lcIndexKey, lcIndexFile, laConfig(1), lcValue, lcConfigItem ;
|
|
, lc_DBF_Conversion_Order, lc_DBF_Conversion_Condition, llExportData, laDirFile(1,5), lnFileCount ;
|
|
, loEx As Exception ;
|
|
, loFSO As Scripting.FileSystemObject ;
|
|
, loTextStream As Scripting.TextStream ;
|
|
, loDBF_CFG As CL_DBF_CFG Of 'FOXBIN2PRG.PRG' ;
|
|
, loRecords As CL_DBF_RECORDS Of 'FOXBIN2PRG.PRG' ;
|
|
, loFields As CL_DBF_FIELDS Of 'FOXBIN2PRG.PRG' ;
|
|
, loIndexes As CL_DBF_INDEXES Of 'FOXBIN2PRG.PRG'
|
|
|
|
*** DH 06/02/2014: created variables
|
|
Local laFields[1], lnFieldCount
|
|
loFSO = toFoxBin2Prg.o_FSO
|
|
loTextStream = toFoxBin2Prg.o_TextStream
|
|
Store Null To loIndexes, loFields, loRecords
|
|
Store 0 To lnFileCount
|
|
lcText = ''
|
|
|
|
TEXT TO lcText ADDITIVE TEXTMERGE NOSHOW FLAGS 1+2 PRETEXT 1+2
|
|
<<>>
|
|
<<C_TABLE_I>>
|
|
<<>> <MemoFile><<IIF( tl_FileHasMemo, FORCEEXT(tc_InputFile, 'FPT'), '' )>></MemoFile>
|
|
<<>> <CodePage><<CPDBF('TABLABIN')>></CodePage>
|
|
<<>> <LastUpdate><<IIF( toFoxBin2Prg.l_ClearDBFLastUpdate, '', LUPDATE('TABLABIN') )>></LastUpdate>
|
|
<<>> <Database><<tc_DBC_Name>></Database>
|
|
<<>> <FileType><<TRANSFORM(tn_HexFileType, '@0')>></FileType>
|
|
<<>> <FileType_Descrip><<tc_FileTypeDesc>></FileType_Descrip>
|
|
ENDTEXT
|
|
|
|
*-- Fields
|
|
loFields = This._Fields
|
|
|
|
*** DH 06/02/2014: passed variables to toText
|
|
lcText = lcText + loFields.toText(@laFields, @lnFieldCount, @toFoxBin2Prg)
|
|
|
|
*-- Indexes
|
|
loIndexes = This._Indexes
|
|
lcText = lcText + loIndexes.toText( '', '', tc_InputFile, @toFoxBin2Prg )
|
|
|
|
*-- If table CFG exists, use it for DBF-specific configuration. FDBOZZO. 2014/06/15
|
|
lnFileCount = toFoxBin2Prg.get_DBF_Configuration( Forceext(tc_InputFile, 'DBF'), @loDBF_CFG, .T. )
|
|
|
|
Do Case
|
|
Case lnFileCount = 1 And Inlist(loDBF_CFG.DBF_Conversion_Support, 4, 8)
|
|
*-- Si hay un archivo DBF.CFG, manda sobre la configuración general
|
|
llExportData = .T.
|
|
|
|
Case lnFileCount = 1 And loDBF_CFG.DBF_Conversion_Support > 0
|
|
*-- Si hay un archivo DBF.CFG, manda sobre la configuración general
|
|
* Asume llExportData=.F.
|
|
|
|
Case Inlist(toFoxBin2Prg.DBF_Conversion_Support, 4, 8) && BIN2TXT (DATA EXPORT FOR DIFF)
|
|
llExportData = .T.
|
|
|
|
Otherwise
|
|
* Asume llExportData=.F.
|
|
|
|
Endcase
|
|
|
|
If llExportData Then
|
|
If lnFileCount = 1
|
|
lc_DBF_Conversion_Order = loDBF_CFG.DBF_Conversion_Order
|
|
|
|
If Not Empty(lc_DBF_Conversion_Order)
|
|
lcIndexFile = Forceext(tc_InputFile,'IDX')
|
|
Index On &lc_DBF_Conversion_Order. To (lcIndexFile) Compact
|
|
toFoxBin2Prg.writeLog(' > Using Index order key: ' + lc_DBF_Conversion_Order)
|
|
Endif
|
|
|
|
Endif
|
|
Endif
|
|
|
|
*** DH 06/02/2014: added _Records
|
|
If llExportData
|
|
loRecords = This._Records
|
|
*FWRITE( toFoxBin2Prg.n_FileHandle, lcText )
|
|
loTextStream.WriteLine( lcText ) && Replace VFP low-level file funcs.because the 8-16KB limit.
|
|
*!* Changed by: Lutz Scheffler 21.02.2021
|
|
*!* change date="{^2021-02-21,10:57:00}"
|
|
* additional options controlling
|
|
* - new operations of DBF
|
|
loRecords.toText(@laFields, lnFieldCount, lc_DBF_Conversion_Condition, @toFoxBin2Prg,;
|
|
IIF( m.lnFileCount = 1, Nvl( m.loDBF_CFG.l_DBF_BinChar_Base64, m.toFoxBin2Prg.l_DBF_BinChar_Base64 ), m.toFoxBin2Prg.l_DBF_BinChar_Base64 ),;
|
|
IIF( m.lnFileCount = 1, Nvl( m.loDBF_CFG.l_DBF_IncludeDeleted, m.toFoxBin2Prg.l_DBF_IncludeDeleted ), m.toFoxBin2Prg.l_DBF_IncludeDeleted ))
|
|
*!* /Changed by: Lutz Scheffler 21.02.2021
|
|
lcText = ''
|
|
Endif
|
|
|
|
TEXT TO lcText ADDITIVE TEXTMERGE NOSHOW FLAGS 1+2 PRETEXT 1+2
|
|
<<C_TABLE_F>>
|
|
<<>>
|
|
ENDTEXT
|
|
|
|
*FWRITE( toFoxBin2Prg.n_FileHandle, lcText )
|
|
loTextStream.WriteLine( lcText ) && Replace VFP low-level file funcs.because the 8-16KB limit.
|
|
lcText = ''
|
|
|
|
|
|
Catch To loEx
|
|
If This.n_Debug > 0 And _vfp.StartMode = 0
|
|
Set Step On
|
|
Endif
|
|
|
|
Throw
|
|
|
|
Finally
|
|
If Not Empty(lcIndexFile) And File(lcIndexFile)
|
|
Set Index To
|
|
Erase (lcIndexFile)
|
|
Endif
|
|
|
|
Store Null To loIndexes, loFields, loRecords, loDBF_CFG, loTextStream
|
|
Release loFields, loIndexes, loRecords, loDBF_CFG, loTextStream
|
|
Endtry
|
|
|
|
Return lcText
|
|
Endproc
|
|
|
|
|
|
Enddefine
|
|
|
|
|
|
|
|
Define Class CL_DBF_FIELDS As CL_COL_BASE
|
|
#If .F.
|
|
Local This As CL_DBF_FIELDS Of 'FOXBIN2PRG.PRG'
|
|
#Endif
|
|
|
|
|
|
|
|
Procedure analyzeCodeBlock
|
|
*---------------------------------------------------------------------------------------------------
|
|
* PARÁMETROS: (v=Pasar por valor | @=Pasar por referencia) (!=Obligatorio | ?=Opcional) (IN/OUT)
|
|
* tcLine (!@ IN/OUT) Contenido de la línea en análisis
|
|
* taCodeLines (!@ IN ) Array de líneas del programa analizado
|
|
* I (!@ IN/OUT) Número de línea en análisis
|
|
* tnCodeLines (!@ IN ) Cantidad de líneas del programa analizado
|
|
*---------------------------------------------------------------------------------------------------
|
|
Lparameters tcLine, taCodeLines, I, tnCodeLines
|
|
|
|
Try
|
|
Local llBloqueEncontrado, lcPropName, lcValue, loEx As Exception ;
|
|
, loField As CL_DBF_FIELD Of 'FOXBIN2PRG.PRG' ;
|
|
, loIndex As CL_DBF_INDEX Of 'FOXBIN2PRG.PRG'
|
|
Store Null To loIndex, loField
|
|
Store '' To lcPropName, lcValue
|
|
|
|
If Left(tcLine, Len(C_FIELDS_I)) == C_FIELDS_I
|
|
llBloqueEncontrado = .T.
|
|
|
|
With This As CL_DBF_FIELDS Of 'FOXBIN2PRG.PRG'
|
|
For I = m.I + 1 To tnCodeLines
|
|
.set_Line( @tcLine, @taCodeLines, m.I )
|
|
|
|
Do Case
|
|
Case Empty( tcLine )
|
|
Loop
|
|
|
|
Case C_FIELDS_F $ tcLine && Fin
|
|
Exit
|
|
|
|
Case C_FIELD_I $ tcLine
|
|
loField = Null
|
|
loField = Createobject("CL_DBF_FIELD")
|
|
loField.analyzeCodeBlock( @tcLine, @taCodeLines, @m.I, tnCodeLines )
|
|
.Add( loField, loField._Name )
|
|
|
|
Otherwise && Otro valor
|
|
*-- No hay otros valores
|
|
Endcase
|
|
Endfor
|
|
Endwith && THIS
|
|
Endif
|
|
|
|
Catch To loEx
|
|
If loEx.ErrorNo = 1470 && Incorrect property name.
|
|
loEx.UserValue = 'I=' + Transform(m.I) + ', tcLine=' + Transform(tcLine)
|
|
Endif
|
|
|
|
If This.n_Debug > 0 And _vfp.StartMode = 0
|
|
Set Step On
|
|
Endif
|
|
|
|
Throw
|
|
|
|
Finally
|
|
Store Null To loIndex, loField
|
|
Release lcPropName, lcValue, loField, loIndex
|
|
|
|
Endtry
|
|
|
|
Return llBloqueEncontrado
|
|
Endproc
|
|
|
|
|
|
Procedure toText
|
|
*---------------------------------------------------------------------------------------------------
|
|
* PARÁMETROS: (v=Pasar por valor | @=Pasar por referencia) (!=Obligatorio | ?=Opcional) (IN/OUT)
|
|
* taFields (@? OUT) Array de información de campos
|
|
* tnField_Count (@? OUT) Cantidad de campos
|
|
* toFoxBin2Prg (@! IN ) Referencia de toFoxBin2Prg
|
|
*---------------------------------------------------------------------------------------------------
|
|
Lparameters taFields, tnField_Count, toFoxBin2Prg
|
|
|
|
#If .F.
|
|
Local toFoxBin2Prg As c_foxbin2prg Of 'FOXBIN2PRG.PRG'
|
|
#Endif
|
|
|
|
External Array taFields
|
|
|
|
Try
|
|
Local I, lcText, loEx As Exception ;
|
|
, loField As CL_DBF_FIELD Of 'FOXBIN2PRG.PRG'
|
|
Store Null To loField
|
|
lcText = ''
|
|
Dimension taFields(1,18)
|
|
|
|
TEXT TO lcText ADDITIVE TEXTMERGE NOSHOW FLAGS 1+2 PRETEXT 1+2
|
|
<<>>
|
|
<<>> <<C_FIELDS_I>>
|
|
ENDTEXT
|
|
|
|
tnField_Count = Afields(taFields)
|
|
loField = Createobject('CL_DBF_FIELD')
|
|
|
|
For I = 1 To tnField_Count
|
|
If taFields(m.I,17) > 0 And toFoxBin2Prg.n_ExcludeDBFAutoincNextval = 1
|
|
*-- If AutoIncNextVal is excluded from text, then assign 1 for allowing regeneration
|
|
*-- of DBF with this field.
|
|
taFields(m.I,17) = 1
|
|
Endif
|
|
|
|
lcText = lcText + loField.toText( @taFields, m.I )
|
|
Endfor
|
|
|
|
TEXT TO lcText ADDITIVE TEXTMERGE NOSHOW FLAGS 1+2 PRETEXT 1+2
|
|
<<>> <<C_FIELDS_F>>
|
|
<<>>
|
|
ENDTEXT
|
|
|
|
|
|
Catch To loEx
|
|
If This.n_Debug > 0 And _vfp.StartMode = 0
|
|
Set Step On
|
|
Endif
|
|
|
|
Throw
|
|
|
|
Finally
|
|
Store Null To loField
|
|
Release I, loField
|
|
|
|
Endtry
|
|
|
|
Return lcText
|
|
Endproc
|
|
|
|
|
|
Enddefine
|
|
|
|
|
|
|
|
Define Class CL_DBF_FIELD As CL_CUS_BASE
|
|
#If .F.
|
|
Local This As CL_DBF_FIELD Of 'FOXBIN2PRG.PRG'
|
|
#Endif
|
|
|
|
_MemberData = [<VFPData>] ;
|
|
+ [<memberdata name="_name" display="_Name"/>] ;
|
|
+ [<memberdata name="_type" display="_Type"/>] ;
|
|
+ [<memberdata name="_width" display="_Width"/>] ;
|
|
+ [<memberdata name="_decimals" display="_Decimals"/>] ;
|
|
+ [<memberdata name="_null" display="_Null"/>] ;
|
|
+ [<memberdata name="_nocptran" display="_NoCPTran"/>] ;
|
|
+ [<memberdata name="_field_valid_exp" display="_Field_Valid_Exp"/>] ;
|
|
+ [<memberdata name="_field_valid_text" display="_Field_Valid_Text"/>] ;
|
|
+ [<memberdata name="_field_default_value" display="_Field_Default_Value"/>] ;
|
|
+ [<memberdata name="_table_valid_exp" display="_Table_Valid_Exp"/>] ;
|
|
+ [<memberdata name="_table_valid_text" display="_Table_Valid_Text"/>] ;
|
|
+ [<memberdata name="_longtablename" display="_LongTableName"/>] ;
|
|
+ [<memberdata name="_ins_trig_exp" display="_Ins_Trig_Exp"/>] ;
|
|
+ [<memberdata name="_upd_trig_exp" display="_Upd_Trig_Exp"/>] ;
|
|
+ [<memberdata name="_del_trig_exp" display="_Del_Trig_Exp"/>] ;
|
|
+ [<memberdata name="_tablecomment" display="_TableComment"/>] ;
|
|
+ [<memberdata name="_autoinc_nextval" display="_AutoInc_NextVal"/>] ;
|
|
+ [<memberdata name="_autoinc_step" display="_AutoInc_Step"/>] ;
|
|
+ [</VFPData>]
|
|
|
|
|
|
*-- Field Info
|
|
_Name = '' && 1
|
|
_Type = '' && 2
|
|
_Width = 0 && 3
|
|
_Decimals = 0 && 4
|
|
_Null = .F. && 5
|
|
_NoCPTran = .F. && 6
|
|
_Field_Valid_Exp = '' && 7 - DBC
|
|
_Field_Valid_Text = '' && 8 - DBC
|
|
_Field_Default_Value = '' && 9 - DBC
|
|
_Table_Valid_Exp = '' && 10 - DBC
|
|
_Table_Valid_Text = '' && 11 - DBC
|
|
_LongTableName = '' && 12 - DBC
|
|
_Ins_Trig_Exp = '' && 13 - DBC
|
|
_Upd_Trig_Exp = '' && 14 - DBC
|
|
_Del_Trig_Exp = '' && 15 - DBC
|
|
_TableComment = '' && 16 - DBC
|
|
_AutoInc_NextVal = 0 && 17
|
|
_AutoInc_Step = 0 && 18
|
|
|
|
|
|
|
|
Procedure analyzeCodeBlock
|
|
*---------------------------------------------------------------------------------------------------
|
|
* PARÁMETROS: (v=Pasar por valor | @=Pasar por referencia) (!=Obligatorio | ?=Opcional) (IN/OUT)
|
|
* tcLine (!@ IN/OUT) Contenido de la línea en análisis
|
|
* taCodeLines (!@ IN ) Array de líneas del programa analizado
|
|
* I (!@ IN/OUT) Número de línea en análisis
|
|
* tnCodeLines (!@ IN ) Cantidad de líneas del programa analizado
|
|
*---------------------------------------------------------------------------------------------------
|
|
Lparameters tcLine, taCodeLines, I, tnCodeLines
|
|
|
|
Try
|
|
Local llBloqueEncontrado, lcPropName, lcValue, loEx As Exception
|
|
Store '' To lcPropName, lcValue
|
|
|
|
If Left(tcLine, Len(C_FIELD_I)) == C_FIELD_I
|
|
llBloqueEncontrado = .T.
|
|
|
|
With This As CL_DBF_FIELD Of 'FOXBIN2PRG.PRG'
|
|
For I = m.I + 1 To tnCodeLines
|
|
.set_Line( @tcLine, @taCodeLines, m.I )
|
|
|
|
Do Case
|
|
Case Empty( tcLine )
|
|
Loop
|
|
|
|
Case C_FIELD_F $ tcLine && Fin
|
|
Exit
|
|
|
|
Otherwise && Propiedad de FIELD
|
|
*-- Estructura a reconocer:
|
|
* <name>NOMBRE</name>
|
|
lcPropName = Strextract( tcLine, '<', '>', 1, 0 )
|
|
lcValue = Strextract( tcLine, '<' + lcPropName + '>', '</' + lcPropName + '>', 1, 0 )
|
|
.AddProperty( '_' + lcPropName, lcValue )
|
|
Endcase
|
|
Endfor
|
|
Endwith && THIS
|
|
Endif
|
|
|
|
Catch To loEx
|
|
If loEx.ErrorNo = 1470 && Incorrect property name.
|
|
loEx.UserValue = 'I=' + Transform(m.I) + ', tcLine=' + Transform(tcLine) + ', PropName=[' + Transform(lcPropName) + '], Value=[' + Transform(lcValue) + ']'
|
|
Endif
|
|
|
|
If This.n_Debug > 0 And _vfp.StartMode = 0
|
|
Set Step On
|
|
Endif
|
|
|
|
Throw
|
|
|
|
Endtry
|
|
|
|
Return llBloqueEncontrado
|
|
Endproc
|
|
|
|
|
|
Procedure toText
|
|
*---------------------------------------------------------------------------------------------------
|
|
* PARÁMETROS: (v=Pasar por valor | @=Pasar por referencia) (!=Obligatorio | ?=Opcional) (IN/OUT)
|
|
* taFields (!@ IN ) Array de información de campos
|
|
* I (!@ IN ) Campo en evaluación
|
|
*---------------------------------------------------------------------------------------------------
|
|
Lparameters taFields, I
|
|
|
|
External Array taFields
|
|
|
|
Try
|
|
Local lcText, loEx As Exception
|
|
lcText = ''
|
|
|
|
TEXT TO lcText TEXTMERGE NOSHOW FLAGS 1+2 PRETEXT 1+2
|
|
<<>> <<C_FIELD_I>>
|
|
<<>> <Name><<taFields(m.I,1)>></Name>
|
|
<<>> <Type><<taFields(m.I,2)>></Type>
|
|
<<>> <Width><<taFields(m.I,3)>></Width>
|
|
<<>> <Decimals><<taFields(m.I,4)>></Decimals>
|
|
<<>> <Null><<taFields(m.I,5)>></Null>
|
|
<<>> <NoCPTran><<taFields(m.I,6)>></NoCPTran>
|
|
<<>> <Field_Valid_Exp><<taFields(m.I,7)>></Field_Valid_Exp>
|
|
<<>> <Field_Valid_Text><<taFields(m.I,8)>></Field_Valid_Text>
|
|
<<>> <Field_Default_Value><<taFields(m.I,9)>></Field_Default_Value>
|
|
<<>> <Table_Valid_Exp><<taFields(m.I,10)>></Table_Valid_Exp>
|
|
<<>> <Table_Valid_Text><<taFields(m.I,11)>></Table_Valid_Text>
|
|
<<>> <LongTableName><<taFields(m.I,12)>></LongTableName>
|
|
<<>> <Ins_Trig_Exp><<taFields(m.I,13)>></Ins_Trig_Exp>
|
|
<<>> <Upd_Trig_Exp><<taFields(m.I,14)>></Upd_Trig_Exp>
|
|
<<>> <Del_Trig_Exp><<taFields(m.I,15)>></Del_Trig_Exp>
|
|
<<>> <TableComment><<taFields(m.I,16)>></TableComment>
|
|
<<>> <Autoinc_Nextval><<taFields(m.I,17)>></Autoinc_Nextval>
|
|
<<>> <Autoinc_Step><<taFields(m.I,18)>></Autoinc_Step>
|
|
<<>> <<C_FIELD_F>>
|
|
ENDTEXT
|
|
|
|
|
|
Catch To loEx
|
|
If This.n_Debug > 0 And _vfp.StartMode = 0
|
|
Set Step On
|
|
Endif
|
|
|
|
Throw
|
|
|
|
Endtry
|
|
|
|
Return lcText
|
|
Endproc
|
|
|
|
|
|
Enddefine
|
|
|
|
|
|
|
|
Define Class CL_DBF_INDEXES As CL_COL_BASE
|
|
#If .F.
|
|
Local This As CL_DBF_INDEXES Of 'FOXBIN2PRG.PRG'
|
|
#Endif
|
|
|
|
|
|
Procedure analyzeCodeBlock
|
|
*---------------------------------------------------------------------------------------------------
|
|
* PARÁMETROS: (v=Pasar por valor | @=Pasar por referencia) (!=Obligatorio | ?=Opcional) (IN/OUT)
|
|
* tcLine (!@ IN/OUT) Contenido de la línea en análisis
|
|
* taCodeLines (!@ IN ) Array de líneas del programa analizado
|
|
* I (!@ IN/OUT) Número de línea en análisis
|
|
* tnCodeLines (!@ IN ) Cantidad de líneas del programa analizado
|
|
*---------------------------------------------------------------------------------------------------
|
|
Lparameters tcLine, taCodeLines, I, tnCodeLines
|
|
|
|
Try
|
|
Local llBloqueEncontrado, lcPropName, lcValue, loEx As Exception ;
|
|
, loIndex As CL_DBF_INDEX Of 'FOXBIN2PRG.PRG'
|
|
Store Null To loIndex
|
|
Store '' To lcPropName, lcValue
|
|
|
|
If Left(tcLine, Len(C_INDEXES_I)) == C_INDEXES_I
|
|
llBloqueEncontrado = .T.
|
|
|
|
With This As CL_DBF_INDEXES Of 'FOXBIN2PRG.PRG'
|
|
For I = m.I + 1 To tnCodeLines
|
|
.set_Line( @tcLine, @taCodeLines, m.I )
|
|
|
|
Do Case
|
|
Case Empty( tcLine )
|
|
Loop
|
|
|
|
Case C_INDEXES_F $ tcLine && Fin
|
|
Exit
|
|
|
|
Case C_INDEX_I $ tcLine
|
|
loIndex = Null
|
|
loIndex = Createobject("CL_DBF_INDEX")
|
|
loIndex.analyzeCodeBlock( @tcLine, @taCodeLines, @m.I, tnCodeLines )
|
|
.Add( loIndex, loIndex._TagName )
|
|
|
|
Otherwise && Otro valor
|
|
*-- No hay otros valores
|
|
Endcase
|
|
Endfor
|
|
Endwith && THIS
|
|
Endif
|
|
|
|
Catch To loEx
|
|
If loEx.ErrorNo = 1470 && Incorrect property name.
|
|
loEx.UserValue = 'I=' + Transform(m.I) + ', tcLine=' + Transform(tcLine)
|
|
Endif
|
|
|
|
If This.n_Debug > 0 And _vfp.StartMode = 0
|
|
Set Step On
|
|
Endif
|
|
|
|
Throw
|
|
|
|
Finally
|
|
Store Null To loIndex
|
|
Release lcPropName, lcValue, loIndex
|
|
|
|
Endtry
|
|
|
|
Return llBloqueEncontrado
|
|
Endproc
|
|
|
|
|
|
Procedure toText
|
|
*---------------------------------------------------------------------------------------------------
|
|
* PARÁMETROS: (v=Pasar por valor | @=Pasar por referencia) (!=Obligatorio | ?=Opcional) (IN/OUT)
|
|
* taTagInfo (@? OUT) Array de información de indices
|
|
* tnTagInfo_Count (@? OUT) Cantidad de índices
|
|
* tc_InputFile (v! IN ) Archivo de entrada (el DBF)
|
|
* toFoxBin2Prg (@! IN ) Referencia de toFoxBin2Prg
|
|
*---------------------------------------------------------------------------------------------------
|
|
Lparameters taTagInfo, tnTagInfo_Count, tc_InputFile, toFoxBin2Prg
|
|
|
|
#If .F.
|
|
Local toFoxBin2Prg As c_foxbin2prg Of 'FOXBIN2PRG.PRG'
|
|
#Endif
|
|
|
|
External Array taTagInfo
|
|
|
|
Try
|
|
Local I, lcText, loEx As Exception ;
|
|
, loIndex As CL_DBF_INDEX Of 'FOXBIN2PRG.PRG'
|
|
Store Null To loIndex
|
|
lcText = ''
|
|
Dimension taTagInfo(1,6)
|
|
|
|
If Tagcount() > 0
|
|
TEXT TO lcText ADDITIVE TEXTMERGE NOSHOW FLAGS 1+2 PRETEXT 1+2
|
|
<<>>
|
|
<<>> <<C_CDX_I>><<SYS(2014, CDX(1), ADDBS(JUSTPATH(tc_InputFile) ) )>><<C_CDX_F>>
|
|
<<>>
|
|
<<>> <<C_INDEXES_I>>
|
|
ENDTEXT
|
|
|
|
tnTagInfo_Count = Ataginfo( taTagInfo )
|
|
Asort( taTagInfo, 1, -1, 0, 1 )
|
|
loIndex = Createobject("CL_DBF_INDEX")
|
|
|
|
For I = 1 To tnTagInfo_Count
|
|
lcText = lcText + loIndex.toText( @taTagInfo, m.I )
|
|
Endfor
|
|
|
|
TEXT TO lcText ADDITIVE TEXTMERGE NOSHOW FLAGS 1+2 PRETEXT 1+2
|
|
<<>> <<C_INDEXES_F>>
|
|
<<>>
|
|
ENDTEXT
|
|
Endif
|
|
|
|
|
|
Catch To loEx
|
|
If This.n_Debug > 0 And _vfp.StartMode = 0
|
|
Set Step On
|
|
Endif
|
|
|
|
Throw
|
|
|
|
Finally
|
|
Store Null To loIndex
|
|
Release I, loIndex
|
|
|
|
Endtry
|
|
|
|
Return lcText
|
|
Endproc
|
|
|
|
|
|
Enddefine
|
|
|
|
|
|
|
|
Define Class CL_DBF_INDEX As CL_CUS_BASE
|
|
#If .F.
|
|
Local This As CL_DBF_INDEX Of 'FOXBIN2PRG.PRG'
|
|
#Endif
|
|
|
|
_MemberData = [<VFPData>] ;
|
|
+ [<memberdata name="_tagname" display="_TagName"/>] ;
|
|
+ [<memberdata name="_tagtype" display="_TagType"/>] ;
|
|
+ [<memberdata name="_key" display="_Key"/>] ;
|
|
+ [<memberdata name="_filter" display="_Filter"/>] ;
|
|
+ [<memberdata name="_order" display="_Order"/>] ;
|
|
+ [<memberdata name="_collate" display="_Collate"/>] ;
|
|
+ [</VFPData>]
|
|
|
|
|
|
*-- Index Info
|
|
_TagName = ''
|
|
_TagType = ''
|
|
_Key = ''
|
|
_Filter = ''
|
|
_Order = ''
|
|
_Collate = ''
|
|
|
|
|
|
Procedure analyzeCodeBlock
|
|
*---------------------------------------------------------------------------------------------------
|
|
* PARÁMETROS: (v=Pasar por valor | @=Pasar por referencia) (!=Obligatorio | ?=Opcional) (IN/OUT)
|
|
* tcLine (!@ IN/OUT) Contenido de la línea en análisis
|
|
* taCodeLines (!@ IN ) Array de líneas del programa analizado
|
|
* I (!@ IN/OUT) Número de línea en análisis
|
|
* tnCodeLines (!@ IN ) Cantidad de líneas del programa analizado
|
|
*---------------------------------------------------------------------------------------------------
|
|
Lparameters tcLine, taCodeLines, I, tnCodeLines
|
|
|
|
Try
|
|
Local llBloqueEncontrado, lcPropName, lcValue, loEx As Exception
|
|
Store '' To lcPropName, lcValue
|
|
|
|
If Left(tcLine, Len(C_INDEX_I)) == C_INDEX_I
|
|
llBloqueEncontrado = .T.
|
|
|
|
With This As CL_DBF_INDEX Of 'FOXBIN2PRG.PRG'
|
|
For I = m.I + 1 To tnCodeLines
|
|
.set_Line( @tcLine, @taCodeLines, m.I )
|
|
|
|
Do Case
|
|
Case Empty( tcLine )
|
|
Loop
|
|
|
|
Case C_INDEX_F $ tcLine && Fin
|
|
Exit
|
|
|
|
Otherwise && Propiedad de INDEX
|
|
*-- Estructura a reconocer:
|
|
* <name>NOMBRE</name>
|
|
lcPropName = Strextract( tcLine, '<', '>', 1, 0 )
|
|
lcValue = Strextract( tcLine, '<' + lcPropName + '>', '</' + lcPropName + '>', 1, 0 )
|
|
.AddProperty( '_' + lcPropName, lcValue )
|
|
Endcase
|
|
Endfor
|
|
Endwith && THIS
|
|
Endif
|
|
|
|
Catch To loEx
|
|
If loEx.ErrorNo = 1470 && Incorrect property name.
|
|
loEx.UserValue = 'I=' + Transform(m.I) + ', tcLine=' + Transform(tcLine) + ', PropName=[' + Transform(lcPropName) + '], Value=[' + Transform(lcValue) + ']'
|
|
Endif
|
|
|
|
If This.n_Debug > 0 And _vfp.StartMode = 0
|
|
Set Step On
|
|
Endif
|
|
|
|
Throw
|
|
|
|
Endtry
|
|
|
|
Return llBloqueEncontrado
|
|
Endproc
|
|
|
|
|
|
Procedure toText
|
|
*---------------------------------------------------------------------------------------------------
|
|
* PARÁMETROS: (v=Pasar por valor | @=Pasar por referencia) (!=Obligatorio | ?=Opcional) (IN/OUT)
|
|
* taTagInfo (@! IN ) Array de información de indices
|
|
* I (@! IN ) Indice en evaluación
|
|
*---------------------------------------------------------------------------------------------------
|
|
Lparameters taTagInfo, I
|
|
|
|
External Array taTagInfo
|
|
|
|
Try
|
|
Local X, lcText, loEx As Exception
|
|
lcText = ''
|
|
|
|
For m.X = 1 To Alen(taTagInfo,1)
|
|
If Tag(m.X) == taTagInfo(m.I,1) Then
|
|
Exit
|
|
Endif
|
|
Endfor
|
|
|
|
TEXT TO lcText TEXTMERGE NOSHOW FLAGS 1+2 PRETEXT 1+2
|
|
<<>> <INDEX>
|
|
<<>> <TagName><<taTagInfo(m.I,1)>></TagName>
|
|
<<>> <TagType><<ICASE(LEFT(taTagInfo(m.I,2),3)='BIN','BINARY',PRIMARY(m.X),'PRIMARY',CANDIDATE(m.X),'CANDIDATE',UNIQUE(m.X),'UNIQUE','REGULAR'))>></TagType>
|
|
<<>> <Key><<taTagInfo(m.I,3)>></Key>
|
|
<<>> <Filter><<taTagInfo(m.I,4)>></Filter>
|
|
<<>> <Order><<IIF(DESCENDING(m.X), 'DESCENDING', 'ASCENDING')>></Order>
|
|
<<>> <Collate><<taTagInfo(m.I,6)>></Collate>
|
|
<<>> </INDEX>
|
|
ENDTEXT
|
|
|
|
|
|
Catch To loEx
|
|
If This.n_Debug > 0 And _vfp.StartMode = 0
|
|
Set Step On
|
|
Endif
|
|
|
|
Throw
|
|
|
|
Endtry
|
|
|
|
Return lcText
|
|
Endproc
|
|
|
|
|
|
Enddefine
|
|
|
|
*** DH 06/02/2014: added classes CL_DBF_RECORDS and CL_DBF_RECORD
|
|
|
|
|
|
Define Class CL_DBF_RECORDS As CL_COL_BASE
|
|
#If .F.
|
|
Local This As CL_DBF_RECORDS Of 'FOXBIN2PRG.PRG'
|
|
#Endif
|
|
|
|
|
|
|
|
Procedure analyzeCodeBlock
|
|
*---------------------------------------------------------------------------------------------------
|
|
* PARÁMETROS: (!=Obligatorio | ?=Opcional) (@=Pasar por referencia | v=Pasar por valor) (IN/OUT)
|
|
* tcLine (@! IN/OUT) Contenido de la línea en análisis
|
|
* taCodeLines (@! IN ) Array de líneas del programa analizado
|
|
* I (@! IN/OUT) Número de línea en análisis
|
|
* tnCodeLines (@! IN ) Cantidad de líneas del programa analizado
|
|
* toFields (@! IN ) Estructura de los campos
|
|
* toFoxBin2Prg (@! IN ) Referencia de toFoxBin2Prg
|
|
* tl_DBF_BinChar_Base64 out of settings (folder or per-file) Transform NocPTrans fields base64
|
|
* tl_DBF_IncludeDeleted out of settings (folder or per-file) Include deleted records
|
|
*---------------------------------------------------------------------------------------------------
|
|
Lparameters tcLine, taCodeLines, I, tnCodeLines, toFields, toFoxBin2Prg, tl_DBF_BinChar_Base64, tl_DBF_IncludeDeleted
|
|
|
|
#If .F.
|
|
Local toFields As CL_DBF_FIELDS Of 'FOXBIN2PRG.PRG'
|
|
Local toFoxBin2Prg As c_foxbin2prg Of 'FOXBIN2PRG.PRG'
|
|
#Endif
|
|
|
|
Try
|
|
Local llBloqueEncontrado, lcPropName, lcValue, lcAlias, loEx As Exception ;
|
|
, loRecord As CL_DBF_RECORD Of 'FOXBIN2PRG.PRG' ;
|
|
, loRecordData As Object
|
|
Store Null To loIndex
|
|
Store '' To lcPropName, lcValue, lcAlias
|
|
|
|
If Left(tcLine, Len(C_RECORDS_I)) == C_RECORDS_I
|
|
llBloqueEncontrado = .T.
|
|
|
|
With This As CL_DBF_RECORDSS Of 'FOXBIN2PRG.PRG'
|
|
lcAlias = Alias()
|
|
CursorSetProp("Buffering", 3)
|
|
loRecord = Null
|
|
loRecord = Createobject("CL_DBF_RECORD")
|
|
|
|
For I = m.I + 1 To tnCodeLines
|
|
.set_Line( @tcLine, @taCodeLines, m.I )
|
|
|
|
Do Case
|
|
Case Empty( tcLine )
|
|
Loop
|
|
|
|
Case C_RECORDS_F $ tcLine && Fin
|
|
Exit
|
|
|
|
Case '<RECORD' $ tcLine
|
|
Append Blank
|
|
|
|
loRecord.analyzeCodeBlock( @tcLine, @taCodeLines, @m.I, tnCodeLines, @toFields, tl_DBF_BinChar_Base64 )
|
|
|
|
If Mod(m.I,1000) = 0 Then
|
|
toFoxBin2Prg.updateProgressbar( 'Importing DBF Data... ' + Transform(m.I) + '/' + Transform(tnCodeLines) + '', 1+(m.I/tnCodeLines), 3, 2 )
|
|
DoEvents
|
|
*FFLUSH( toFoxBin2Prg.n_FileHandle, .T. )
|
|
Endif
|
|
|
|
*!* Changed by: Lutz Scheffler 21.02.2021
|
|
*!* change date="{^2021-02-21,10:57:00}"
|
|
* additional options controlling
|
|
* - new operations of DBF, handle include of deleted records
|
|
*!* /Changed by: Lutz Scheffler 21.02.2021
|
|
Case m.tl_DBF_IncludeDeleted And '<DELRECORD' $ tcLine
|
|
Append Blank
|
|
loRecord.analyzeCodeBlock( @tcLine, @taCodeLines, @m.I, tnCodeLines, @toFields, tl_DBF_BinChar_Base64 )
|
|
|
|
Delete
|
|
|
|
If Mod(m.I,1000) = 0 Then
|
|
toFoxBin2Prg.updateProgressbar( 'Importing DBF Data... ' + Transform(m.I) + '/' + Transform(tnCodeLines) + '', 1+(m.I/tnCodeLines), 3, 2 )
|
|
DoEvents
|
|
*FFLUSH( toFoxBin2Prg.n_FileHandle, .T. )
|
|
Endif
|
|
*!* /Changed by: Lutz Scheffler 21.02.2021
|
|
|
|
Otherwise && Otro valor
|
|
*-- No hay otros valores
|
|
Endcase
|
|
Endfor
|
|
|
|
Tableupdate(.T.)
|
|
Endwith && THIS
|
|
Endif
|
|
|
|
Catch To loEx
|
|
If loEx.ErrorNo = 1470 && Incorrect property name.
|
|
loEx.UserValue = 'I=' + Transform(m.I) + ', tcLine=' + Transform(tcLine)
|
|
Endif
|
|
|
|
If This.n_Debug > 0 And _vfp.StartMode = 0
|
|
Set Step On
|
|
Endif
|
|
|
|
Throw
|
|
|
|
Finally
|
|
Tablerevert(.T.)
|
|
CursorSetProp("Buffering", 1)
|
|
|
|
Store Null To loRecord
|
|
Release lcPropName, lcValue, loRecord
|
|
|
|
Endtry
|
|
|
|
Return llBloqueEncontrado
|
|
Endproc
|
|
|
|
|
|
Procedure toText
|
|
*---------------------------------------------------------------------------------------------------
|
|
* PARÁMETROS: (!=Obligatorio | ?=Opcional) (@=Pasar por referencia | v=Pasar por valor) (IN/OUT)
|
|
* taFields (@! IN ) Array de información de campos
|
|
* tnField_Count (v! IN ) Cantidad de campos
|
|
* tc_DBF_Conversion_Condition (v? IN ) Condición de filtro para la conversión. Solo se exporta lo que la cumpla.
|
|
* toFoxBin2Prg (@! IN ) Referencia de toFoxBin2Prg
|
|
* tl_DBF_BinChar_Base64 out of settings (folder or per-file) Transform NocPTrans fields base64
|
|
* tl_DBF_IncludeDeleted out of settings (folder or per-file) Include deleted records
|
|
*---------------------------------------------------------------------------------------------------
|
|
Lparameters taFields, tnField_Count, tc_DBF_Conversion_Condition, toFoxBin2Prg, tl_DBF_BinChar_Base64, tl_DBF_IncludeDeleted
|
|
|
|
External Array taFields
|
|
|
|
#If .F.
|
|
Local toFoxBin2Prg As c_foxbin2prg Of 'FOXBIN2PRG.PRG'
|
|
#Endif
|
|
|
|
Try
|
|
Local lcText, loEx As Exception, I, lnReccount ;
|
|
, loRecord As CL_DBF_RECORD Of 'FOXBIN2PRG.PRG' ;
|
|
, loTextStream As Scripting.TextStream
|
|
Local lcOldDeleted As String
|
|
|
|
lcText = ''
|
|
I = 0
|
|
lnReccount = Reccount() && Realmente no es muy exacto, pero al menos muestra el avance.
|
|
loTextStream = toFoxBin2Prg.o_TextStream
|
|
|
|
TEXT TO lcText ADDITIVE TEXTMERGE NOSHOW FLAGS 1+2 PRETEXT 1+2
|
|
<<>>
|
|
<<>> <<C_RECORDS_I>>
|
|
ENDTEXT
|
|
|
|
*FWRITE( toFoxBin2Prg.n_FileHandle, lcText )
|
|
loTextStream.WriteLine( lcText ) && Replace VFP low-level file funcs.because the 8-16KB limit.
|
|
lcText = ''
|
|
loRecord = Createobject('CL_DBF_RECORD')
|
|
|
|
If Empty(tc_DBF_Conversion_Condition)
|
|
tc_DBF_Conversion_Condition = '.T.'
|
|
Endif
|
|
|
|
*!* Changed by: Lutz Scheffler 21.02.2021
|
|
*!* change date="{^2021-02-21,10:57:00}"
|
|
* additional options controlling
|
|
* - new operations of DBF, handle include of deleted records
|
|
lcOldDeleted = Set("Deleted")
|
|
If m.tl_DBF_IncludeDeleted Then
|
|
Set Deleted Off
|
|
Endif
|
|
*!* /Changed by: Lutz Scheffler 21.02.2021
|
|
|
|
*!* Changed by: Lutz Scheffler 01.03.2021
|
|
*!* change date="{^2021-03-01,12:45:00}"
|
|
* failure with macro substitution<br/>
|
|
* for wharever reason, macro substitution failed
|
|
* EVALUATE() should do
|
|
* Scan For &tc_DBF_Conversion_Condition.
|
|
Scan For EVALUATE(m.tc_DBF_Conversion_Condition)
|
|
*!* /Changed by: Lutz Scheffler 01.03.2021
|
|
|
|
I = m.I + 1
|
|
|
|
lcText = loRecord.toText(@taFields, tnField_Count, tl_DBF_BinChar_Base64 )
|
|
|
|
*FWRITE( toFoxBin2Prg.n_FileHandle, lcText )
|
|
loTextStream.WriteLine( lcText ) && Replace VFP low-level file funcs.because the 8-16KB limit.
|
|
If Mod(m.I,100) = 0 Or Len(lcText) > 8*1024 Then
|
|
toFoxBin2Prg.updateProgressbar( 'Exporting DBF Data... ' + Transform(m.I) + '/' + Transform(lnReccount) + '', 1+(m.I/lnReccount), 3, 2 )
|
|
DoEvents
|
|
*FFLUSH( toFoxBin2Prg.n_FileHandle, .T. )
|
|
Endif
|
|
Endscan
|
|
Set Deleted &lcOldDeleted.
|
|
|
|
toFoxBin2Prg.updateProgressbar( 'Data exported! ', 1+(lnReccount/lnReccount), 3, 2 )
|
|
lcText = ''
|
|
|
|
TEXT TO lcText ADDITIVE TEXTMERGE NOSHOW FLAGS 1+2 PRETEXT 1+2
|
|
<<>> <<C_RECORDS_F>>
|
|
<<>>
|
|
ENDTEXT
|
|
|
|
*FWRITE( toFoxBin2Prg.n_FileHandle, lcText )
|
|
loTextStream.WriteLine( lcText ) && Replace VFP low-level file funcs.because the 8-16KB limit.
|
|
lcText = ''
|
|
|
|
|
|
Catch To loEx
|
|
loEx.UserValue = loEx.UserValue + 'tc_DBF_Conversion_Condition = [' + Transform(tc_DBF_Conversion_Condition) + ']' + CR_LF
|
|
If This.n_Debug > 0 And _vfp.StartMode = 0
|
|
Set Step On
|
|
Endif
|
|
|
|
Throw
|
|
|
|
Finally
|
|
Store Null To loRecord, loTextStream
|
|
Release loRecord, loTextStream
|
|
|
|
Endtry
|
|
|
|
Return lcText
|
|
Endproc
|
|
|
|
|
|
Procedure set_Line
|
|
*---------------------------------------------------------------------------------------------------
|
|
* PARÁMETROS: (v=Pasar por valor | @=Pasar por referencia) (!=Obligatorio | ?=Opcional) (IN/OUT)
|
|
* tcLine (!@ OUT) Contenido de la línea en análisis
|
|
* taCodeLines (!@ IN ) Array de líneas del programa analizado
|
|
* I (v! IN ) Número de línea en análisis
|
|
*---------------------------------------------------------------------------------------------------
|
|
Lparameters tcLine, taCodeLines, I
|
|
tcLine = taCodeLines(m.I)
|
|
Endproc
|
|
|
|
|
|
Enddefine
|
|
|
|
|
|
|
|
Define Class CL_DBF_RECORD As CL_CUS_BASE
|
|
#If .F.
|
|
Local This As CL_DBF_RECORD Of 'FOXBIN2PRG.PRG'
|
|
#Endif
|
|
|
|
_MemberData = [<VFPData>] ;
|
|
+ [</VFPData>]
|
|
|
|
|
|
Procedure analyzeCodeBlock
|
|
*---------------------------------------------------------------------------------------------------
|
|
* PARÁMETROS: (!=Obligatorio | ?=Opcional) (@=Pasar por referencia | v=Pasar por valor) (IN/OUT)
|
|
* tcLine (@! IN/OUT) Contenido de la línea en análisis
|
|
* taCodeLines (@! IN ) Array de líneas del programa analizado
|
|
* I (@! IN/OUT) Número de línea en análisis
|
|
* tnCodeLines (@! IN ) Cantidad de líneas del programa analizado
|
|
* toFields (@! IN ) Estructura de los campos
|
|
* tl_DBF_BinChar_Base64 out of settings (folder or per-file) Transform NocPTrans fields base64
|
|
*---------------------------------------------------------------------------------------------------
|
|
|
|
*!* Changed by: Lutz Scheffler 21.02.2021
|
|
*!* change date="{^2021-02-21,10:57:00}"
|
|
* general note:
|
|
* - added code to handle NoCPTrans coding with or without basr64, just like the flag 4096 of CURSORTOXML
|
|
* - added code parse out deleted records.
|
|
* deleted records should only occur if calling method sends them, so we just accept
|
|
|
|
Lparameters tcLine, taCodeLines, I, tnCodeLines, toFields, tl_DBF_BinChar_Base64
|
|
|
|
#If .F.
|
|
Local toFields As CL_DBF_FIELDS Of 'FOXBIN2PRG.PRG'
|
|
#Endif
|
|
|
|
Try
|
|
Local llBloqueEncontrado, lcFieldName, lcValue, luValue, llOneLineOnly, loEx As Exception ;
|
|
, loField As CL_DBF_FIELD Of 'FOXBIN2PRG.PRG'
|
|
Store '' To lcFieldName, lcValue
|
|
|
|
*!* Changed by: Lutz Scheffler 21.02.2021
|
|
*!* change date="{^2021-02-21,10:57:00}"
|
|
* additional options controlling
|
|
* - new operations of DBF, handle include of deleted records
|
|
* Note, the inclusion of records deleted is done in the method calling, so here it will just be read
|
|
If '<RECORD' $ tcLine Or '<DELRECORD' $ tcLine
|
|
*!* /Changed by: Lutz Scheffler 21.02.2021
|
|
llBloqueEncontrado = .T.
|
|
|
|
With This As CL_DBF_RECORD Of 'FOXBIN2PRG.PRG'
|
|
For I = m.I + 1 To tnCodeLines
|
|
.set_Line( @tcLine, @taCodeLines, m.I )
|
|
|
|
Do Case
|
|
Case Empty( tcLine ) Or Left(tcLine, 1) == '*'
|
|
Loop
|
|
|
|
Case C_RECORD_F $ tcLine && Fin
|
|
Exit
|
|
|
|
*!* Changed by: Lutz Scheffler 21.02.2021
|
|
*!* change date="{^2021-02-21,10:57:00}"
|
|
* additional options controlling
|
|
* - new operations of DBF, handle include of deleted records
|
|
* just end-of-record deleted
|
|
Case C_DEL_RECORD_F $ tcLine && Fin
|
|
Exit
|
|
|
|
*!* /Changed by: Lutz Scheffler 21.02.2021
|
|
Otherwise && Campo de RECORD
|
|
*-- Estructura a reconocer:
|
|
* <fieldName>VALOR</fieldName>
|
|
lcFieldName = Strextract( tcLine, '<', '>', 1, 0 )
|
|
lcValue = Strextract( tcLine, '<' + lcFieldName + '>', '</' + lcFieldName + '>', 1, 0+2 )
|
|
loField = toFields.Item(lcFieldName)
|
|
llOneLineOnly = ('</' + lcFieldName + '>' $ tcLine)
|
|
|
|
lcFieldType = loField._Type
|
|
llNoCPTran = Cast( loField._NoCPTran As Logical)
|
|
*!* Changed by: Lutz Scheffler 14.2.2021
|
|
*!* change date="{^2021-02-14,20:35:00}"
|
|
* Does not recreate .NULL. Field values
|
|
* CAST(.. does not tronsform ".NULL." to .NULL.
|
|
* so we test field for NULL flag and is cValue is ".NULL.", we use .NULL.
|
|
|
|
llNull = Cast( loField._Null As Logical)
|
|
|
|
Do Case
|
|
Case m.llNull And Upper(m.lcValue)=='.NULL.' && .NULL.
|
|
luValue = .Null.
|
|
|
|
*!* /Changed by: Lutz Scheffler 14.2.2021
|
|
|
|
Case lcFieldType == 'L' && Logical (Boolean)
|
|
luValue = Cast(lcValue As Logical)
|
|
|
|
Case lcFieldType == 'G' && General (NOT SUPPORTED)
|
|
luValue = ''
|
|
|
|
Case lcFieldType == 'W' && Blob (Memo binario)
|
|
luValue = Strconv(lcValue,14)
|
|
|
|
Case lcFieldType == 'Q' && Varbinary
|
|
luValue = Strconv(lcValue,14)
|
|
|
|
Case lcFieldType == 'V' && Varchar
|
|
If llNoCPTran And m.tl_DBF_BinChar_Base64 Then
|
|
*-- If NoCPTran, then must encode in b64binary
|
|
*-- SF: might, not must, see XMLTOCURSOR, flag 4096
|
|
luValue = Strconv(lcValue,14)
|
|
Else
|
|
luValue = .Decode(lcValue)
|
|
Endif
|
|
|
|
Case lcFieldType == 'M' && Memo
|
|
If llNoCPTran And m.tl_DBF_BinChar_Base64 Then
|
|
*-- If NoCPTran, then must encode in b64binary
|
|
*-- SF: might, not must, see XMLTOCURSOR, flag 4096
|
|
luValue = Strconv(lcValue,14)
|
|
Else
|
|
If llOneLineOnly And Atc('<![CDATA[', lcValue) = 0
|
|
luValue = .Decode(lcValue, .F.)
|
|
Else
|
|
* Si el memo es multi-línea, leer hasta encontrar el final ']]>' del CDATA.
|
|
luValue = ''
|
|
Do While Not Empty(lcValue)
|
|
If ']]>' $ tcLine Or '</' + lcFieldName + '>' $ tcLine Then
|
|
luValue = .Decode(lcValue, .T.)
|
|
Exit
|
|
Else
|
|
I = m.I + 1
|
|
.set_Line( @tcLine, @taCodeLines, m.I )
|
|
lcValue = lcValue + CR_LF + tcLine
|
|
Endif
|
|
Enddo
|
|
Endif
|
|
Endif
|
|
|
|
Case lcFieldType == 'D' && Date
|
|
luValue = Cast(lcValue As Date)
|
|
|
|
Case lcFieldType == 'T' && Datetime
|
|
luValue = Cast(lcValue As Datetime)
|
|
|
|
Case lcFieldType == 'Y' && Currency
|
|
luValue = Cast(lcValue As Currency)
|
|
|
|
Case lcFieldType == 'I' && Integer
|
|
luValue = Cast(lcValue As Integer)
|
|
|
|
Case lcFieldType == 'B' && Double
|
|
luValue = Cast(lcValue As Double)
|
|
|
|
Case lcFieldType == 'F' && Float
|
|
luValue = Cast(lcValue As Float)
|
|
|
|
Case lcFieldType == 'N' && Numeric
|
|
luValue = Cast(lcValue As Numeric)
|
|
|
|
Otherwise && Asume 'C' && Character
|
|
If llNoCPTran And m.tl_DBF_BinChar_Base64 Then
|
|
*-- If NoCPTran, then must encode in b64binary
|
|
*-- SF: might, not must, see XMLTOCURSOR, flag 4096
|
|
|
|
*-- If NoCPTran, then must encode in b64binary
|
|
luValue = Strconv(lcValue,14)
|
|
Else
|
|
luValue = .Decode(Rtrim(lcValue))
|
|
Endif
|
|
|
|
Endcase
|
|
|
|
If lcFieldType == 'G'
|
|
*-- Saltar campos General
|
|
Else
|
|
Replace (lcFieldName) With (luValue)
|
|
Endif
|
|
|
|
Endcase
|
|
Endfor
|
|
Endwith && THIS
|
|
Endif
|
|
|
|
Catch To loEx
|
|
If loEx.ErrorNo = 1470 && Incorrect property name.
|
|
loEx.UserValue = 'I=' + Transform(m.I) + ', tcLine=' + Transform(tcLine) + ', lcFieldName=[' + Transform(lcFieldName) + '], Value=[' + Transform(lcValue) + ']'
|
|
Endif
|
|
|
|
If This.n_Debug > 0 And _vfp.StartMode = 0
|
|
Set Step On
|
|
Endif
|
|
|
|
Throw
|
|
|
|
Finally
|
|
Store Null To loField
|
|
Release loField
|
|
|
|
Endtry
|
|
|
|
Return llBloqueEncontrado
|
|
Endproc
|
|
|
|
|
|
Procedure toText
|
|
*---------------------------------------------------------------------------------------------------
|
|
* PARÁMETROS: (!=Obligatorio | ?=Opcional) (@=Pasar por referencia | v=Pasar por valor) (IN/OUT)
|
|
* taFields (@! IN ) Array de información de campos
|
|
* tnField_Count (@! IN ) Cantidad de campos
|
|
* tl_DBF_BinChar_Base64 out of settings (folder or per-file) Transform NocPTrans fields base64
|
|
*---------------------------------------------------------------------------------------------------
|
|
* SF, Analyse, calling method decides if deleted records will be included, we just process
|
|
|
|
*!* Changed by: Lutz Scheffler 21.02.2021
|
|
*!* change date="{^2021-02-21,10:57:00}"
|
|
* general note:
|
|
* - added code to handle NoCPTrans coding with or without base64, just like the flag 4096 of CURSORTOXML
|
|
Lparameters taFields, tnField_Count, tl_DBF_BinChar_Base64
|
|
|
|
External Array taFields
|
|
|
|
Try
|
|
Local I, lcText, loEx As Exception, lcField, luValue, lcFieldType, llNoCPTran
|
|
Local lcStartTag, lcEndTag As String
|
|
lcText = ''
|
|
|
|
With This As CL_DBF_RECORD Of 'FOXBIN2PRG.PRG'
|
|
*** FDBOZZO 2014/07/15: New "num" property invalidates the use of REGNUM field
|
|
*!* Changed by: Lutz Scheffler 21.02.2021
|
|
*!* change date="{^2021-02-21,10:57:00}"
|
|
* additional options controlling
|
|
* - new operations of DBF, handle include of deleted records
|
|
* Note: used in the TEXTEMERGEs for start and end tag below, not extra commented
|
|
If Deleted() Then
|
|
lcStartTag = C_DEL_RECORD_I
|
|
lcEndTag = C_DEL_RECORD_F
|
|
Else
|
|
lcStartTag = C_RECORD_I
|
|
lcEndTag = C_RECORD_F
|
|
Endif
|
|
*!* /Changed by: Lutz Scheffler 21.02.2021
|
|
|
|
TEXT TO lcText TEXTMERGE NOSHOW FLAGS 1+2 PRETEXT 1+2
|
|
<<>> <<m.lcStartTag>>
|
|
ENDTEXT
|
|
|
|
For I = 1 To tnField_Count
|
|
lcField = taFields[m.I, 1]
|
|
lcFieldType = taFields[m.I, 2]
|
|
llNoCPTran = taFields[m.I, 6]
|
|
If lcFieldType == 'G'
|
|
*-- Saltar campos de tipo General
|
|
Else
|
|
luValue = Evaluate(lcField)
|
|
|
|
Do Case
|
|
Case lcFieldType $ 'GWQVCM' And luValue == '' ; && Vacío
|
|
Or lcFieldType $ 'DT' And luValue == {} ;
|
|
OR lcFieldType $ 'YIBFN' And luValue == 0
|
|
|
|
Case lcFieldType == 'W' && Blob (Memo binario)
|
|
luValue = Strconv(luValue,13)
|
|
|
|
Case lcFieldType == 'Q' && Varbinary
|
|
luValue = Strconv(luValue,13)
|
|
|
|
Case lcFieldType == 'V' && Varchar
|
|
If llNoCPTran And m.tl_DBF_BinChar_Base64 Then
|
|
*-- If NoCPTran, then must encode in b64binary
|
|
*-- SF: might, not must, see XMLTOCURSOR, flag 4096
|
|
luValue = Strconv(luValue,13)
|
|
Else
|
|
luValue = .Encode(luValue)
|
|
Endif
|
|
|
|
Case lcFieldType $ 'C' && Character
|
|
If llNoCPTran And m.tl_DBF_BinChar_Base64 Then
|
|
*-- If NoCPTran, then must encode in b64binary
|
|
*-- SF: might, not must, see XMLTOCURSOR, flag 4096
|
|
luValue = Strconv(luValue,13)
|
|
Else
|
|
luValue = .Encode(Rtrim(luValue))
|
|
Endif
|
|
|
|
Case lcFieldType $ 'M' && Memo
|
|
If llNoCPTran And m.tl_DBF_BinChar_Base64 Then
|
|
*-- If NoCPTran, then must encode in b64binary
|
|
*-- SF: might, not must, see XMLTOCURSOR, flag 4096
|
|
luValue = Strconv(luValue,13)
|
|
Else
|
|
luValue = .Encode(Rtrim(luValue), .T.)
|
|
Endif
|
|
|
|
Endcase
|
|
|
|
TEXT TO lcText TEXTMERGE NOSHOW flags 1+2 PRETEXT 1+2 additive
|
|
<<>> <<'<' + lcField + '>'>><<luValue>><<'</' + lcField + '>'>>
|
|
ENDTEXT
|
|
Endif
|
|
Next
|
|
|
|
TEXT TO lcText TEXTMERGE NOSHOW FLAGS 1+2 PRETEXT 1+2 additive
|
|
<<>> <<m.lcEndTag>>
|
|
ENDTEXT
|
|
Endwith
|
|
|
|
Catch To loEx
|
|
If This.n_Debug > 0 And _vfp.StartMode = 0
|
|
Set Step On
|
|
Endif
|
|
|
|
Throw
|
|
|
|
Endtry
|
|
|
|
Return lcText
|
|
Endproc
|
|
|
|
|
|
Procedure Encode
|
|
Lparameters tcString, tl_isCDATA
|
|
Local lcString
|
|
If tl_isCDATA Then
|
|
*lcString = '<![CDATA[' + STRTRAN(tcString, ']]>', ']]]]><![CDATA[>') + ']]>'
|
|
lcString = '<![CDATA[' + Strtran( Strtran( tcString, '<![CDATA[', '<![CDATA['), ']]>', ']]>') + ']]>'
|
|
Else
|
|
lcString = Strtran(tcString, '&', '&')
|
|
lcString = Strtran(lcString, '>', '>')
|
|
lcString = Strtran(lcString, '<', '<')
|
|
lcString = Strtran(lcString, '"', '"')
|
|
lcString = Strtran(lcString, "'", ''')
|
|
lcString = Strtran(lcString, '/', '/')
|
|
lcString = Strtran(lcString, Chr(13), ' ')
|
|
lcString = Strtran(lcString, Chr(10), ' ')
|
|
lcString = Strtran(lcString, Chr(9), '	')
|
|
Endif
|
|
Return lcString
|
|
Endproc
|
|
|
|
|
|
Procedure Decode
|
|
Lparameters tcString, tl_isCDATA
|
|
Local lcString
|
|
If tl_isCDATA Then
|
|
lcString = Strtran( Strtran( Strextract( tcString, '<![CDATA[', ']]>'), '<![CDATA[', '<![CDATA['), ']]>', ']]>')
|
|
Else
|
|
lcString = Strtran(tcString, '	', Chr(9))
|
|
lcString = Strtran(lcString, ' ', Chr(10))
|
|
lcString = Strtran(lcString, ' ', Chr(13))
|
|
lcString = Strtran(lcString, '/', '/')
|
|
lcString = Strtran(lcString, ''', "'")
|
|
lcString = Strtran(lcString, '"', '"')
|
|
lcString = Strtran(lcString, '<', '<')
|
|
lcString = Strtran(lcString, '>', '>')
|
|
lcString = Strtran(lcString, '&', '&')
|
|
Endif
|
|
Return lcString
|
|
Endproc
|
|
|
|
|
|
Procedure set_Line
|
|
*---------------------------------------------------------------------------------------------------
|
|
* PARÁMETROS: (v=Pasar por valor | @=Pasar por referencia) (!=Obligatorio | ?=Opcional) (IN/OUT)
|
|
* tcLine (!@ OUT) Contenido de la línea en análisis
|
|
* taCodeLines (!@ IN ) Array de líneas del programa analizado
|
|
* I (v! IN ) Número de línea en análisis
|
|
*---------------------------------------------------------------------------------------------------
|
|
Lparameters tcLine, taCodeLines, I
|
|
tcLine = taCodeLines(m.I)
|
|
Endproc
|
|
|
|
|
|
Enddefine
|
|
|
|
*** DH 06/02/2014: end of added classes
|
|
|
|
|
|
|
|
Define Class CL_PROJ_SRV_HEAD As CL_CUS_BASE
|
|
#If .F.
|
|
Local This As CL_PROJ_SRV_HEAD Of 'FOXBIN2PRG.PRG'
|
|
#Endif
|
|
|
|
_MemberData = [<VFPData>] ;
|
|
+ [<memberdata name="_internalname" display="_InternalName"/>] ;
|
|
+ [<memberdata name="_libraryname" display="_LibraryName"/>] ;
|
|
+ [<memberdata name="_projectname" display="_ProjectName"/>] ;
|
|
+ [<memberdata name="_servercount" display="_ServerCount"/>] ;
|
|
+ [<memberdata name="_servers" display="_Servers"/>] ;
|
|
+ [<memberdata name="_servertype" display="_ServerType"/>] ;
|
|
+ [<memberdata name="_typelib" display="_TypeLib"/>] ;
|
|
+ [<memberdata name="_typelibdesc" display="_TypeLibDesc"/>] ;
|
|
+ [<memberdata name="add_server" display="add_Server"/>] ;
|
|
+ [<memberdata name="decode_specialcodes_cr_lf" display="decode_SpecialCodes_CR_LF"/>] ;
|
|
+ [<memberdata name="encode_specialcodes_cr_lf" display="encode_SpecialCodes_CR_LF"/>] ;
|
|
+ [<memberdata name="getdatafrompair_lendata_structure" display="getDataFromPair_LenData_Structure"/>] ;
|
|
+ [<memberdata name="getformattedservertext" display="getFormattedServerText"/>] ;
|
|
+ [<memberdata name="getrowserverinfo" display="getRowServerInfo"/>] ;
|
|
+ [<memberdata name="getserverdataobject" display="getServerDataObject"/>] ;
|
|
+ [<memberdata name="parseserverinfo" display="parseServerInfo"/>] ;
|
|
+ [<memberdata name="setparsedheadinfoline" display="setParsedHeadInfoLine"/>] ;
|
|
+ [<memberdata name="setparsedinfoline" display="setParsedInfoLine"/>] ;
|
|
+ [</VFPData>]
|
|
|
|
*-- Información interesante sobre Servidores OLE y corrupción de IDs: http://www.west-wind.com/wconnect/weblog/ShowEntry.blog?id=880
|
|
|
|
*-- Server Head info
|
|
Dimension _Servers[1]
|
|
_ServerCount = 0
|
|
_LibraryName = ''
|
|
_InternalName = ''
|
|
_ProjectName = ''
|
|
_TypeLibDesc = ''
|
|
_ServerType = ''
|
|
_TypeLib = ''
|
|
|
|
|
|
|
|
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 encode_SpecialCodes_CR_LF
|
|
*---------------------------------------------------------------------------------------------------
|
|
* PARÁMETROS: (v=Pasar por valor | @=Pasar por referencia) (!=Obligatorio | ?=Opcional) (IN/OUT)
|
|
* tcText (!@ IN ) Codifica los caracteres ASCII 10 y 13 de CHR(nCode) a {nCode}
|
|
*---------------------------------------------------------------------------------------------------
|
|
Lparameters tcText
|
|
tcText = Strtran( Strtran( tcText, Chr(10), '{10}' ), Chr(13), '{13}' )
|
|
Return tcText
|
|
Endproc
|
|
|
|
|
|
|
|
Procedure setParsedHeadInfoLine
|
|
Lparameters tcHeadInfoLine
|
|
This.setParsedInfoLine( This, tcHeadInfoLine )
|
|
Endproc
|
|
|
|
|
|
|
|
Procedure setParsedInfoLine
|
|
Lparameters toObject, tcInfoLine
|
|
|
|
Local lcAsignacion, lcCurDir, lcValue, loEx As Exception
|
|
|
|
Try
|
|
If Left(tcInfoLine,1) == '.'
|
|
lcAsignacion = 'toObject' + tcInfoLine
|
|
Else
|
|
lcAsignacion = 'toObject.' + tcInfoLine
|
|
Endif
|
|
|
|
lcValue = Getwordnum(lcAsignacion, 2, '=')
|
|
|
|
If Type(lcValue) = "C" Then
|
|
lcAsignacion = Getwordnum(lcAsignacion, 1, '=') + '= THIS.encode_SpecialCodes_CR_LF(' + Getwordnum(lcAsignacion, 2, '=') + ')'
|
|
Endif
|
|
|
|
&lcAsignacion.
|
|
|
|
Catch To loEx
|
|
loEx.UserValue = loEx.UserValue + 'lcAsignacion = [' + Transform(lcAsignacion) + ']' + CR_LF
|
|
Throw
|
|
Endtry
|
|
|
|
Return
|
|
Endproc
|
|
|
|
|
|
|
|
Procedure add_Server
|
|
Lparameters toServerData
|
|
|
|
#If .F.
|
|
Local toServerData As CL_PROJ_SRV_DATA Of 'FOXBIN2PRG.PRG'
|
|
#Endif
|
|
|
|
With This As CL_PROJ_SRV_HEAD Of 'FOXBIN2PRG.PRG'
|
|
._ServerCount = ._ServerCount + 1
|
|
Dimension ._Servers( ._ServerCount )
|
|
._Servers( ._ServerCount ) = toServerData
|
|
Endwith && THIS
|
|
Endproc
|
|
|
|
|
|
|
|
Procedure getDataFromPair_LenData_Structure
|
|
Lparameters tcData, tnPos, tnLen
|
|
Local lcData, lnLen
|
|
tnPos = tnPos + 4 + tnLen
|
|
tnLen = Int( Val( Substr( tcData, tnPos, 4 ) ) )
|
|
lcData = Substr( tcData, tnPos + 4, tnLen )
|
|
Return lcData
|
|
Endproc
|
|
|
|
|
|
Procedure getServerDataObject
|
|
Return Createobject('CL_PROJ_SRV_DATA')
|
|
Endproc
|
|
|
|
|
|
|
|
Procedure parseServerInfo
|
|
Lparameters tcServerInfo
|
|
|
|
If Not Empty(tcServerInfo)
|
|
Try
|
|
Local loServerData As CL_PROJ_SRV_DATA Of 'FOXBIN2PRG.PRG'
|
|
|
|
With This As CL_PROJ_SRV_HEAD Of 'FOXBIN2PRG.PRG'
|
|
lcStr = ''
|
|
lnPos = 1
|
|
lnLen = 4
|
|
|
|
lnServerCount = Int( Val( .getDataFromPair_LenData_Structure( @tcServerInfo, @lnPos, @lnLen ) ) )
|
|
._LibraryName = .getDataFromPair_LenData_Structure( @tcServerInfo, @lnPos, @lnLen )
|
|
._InternalName = .getDataFromPair_LenData_Structure( @tcServerInfo, @lnPos, @lnLen )
|
|
._ProjectName = .getDataFromPair_LenData_Structure( @tcServerInfo, @lnPos, @lnLen )
|
|
._TypeLibDesc = .getDataFromPair_LenData_Structure( @tcServerInfo, @lnPos, @lnLen )
|
|
._ServerType = .getDataFromPair_LenData_Structure( @tcServerInfo, @lnPos, @lnLen )
|
|
._TypeLib = .getDataFromPair_LenData_Structure( @tcServerInfo, @lnPos, @lnLen )
|
|
|
|
*-- Información de los servidores
|
|
For I = 1 To lnServerCount
|
|
loServerData = Null
|
|
loServerData = .getServerDataObject()
|
|
|
|
loServerData._HelpContextID = .getDataFromPair_LenData_Structure( @tcServerInfo, @lnPos, @lnLen )
|
|
loServerData._ServerName = .getDataFromPair_LenData_Structure( @tcServerInfo, @lnPos, @lnLen )
|
|
loServerData._Description = .getDataFromPair_LenData_Structure( @tcServerInfo, @lnPos, @lnLen )
|
|
loServerData._HelpFile = .getDataFromPair_LenData_Structure( @tcServerInfo, @lnPos, @lnLen )
|
|
loServerData._ServerClass = .getDataFromPair_LenData_Structure( @tcServerInfo, @lnPos, @lnLen )
|
|
loServerData._ClassLibrary = .getDataFromPair_LenData_Structure( @tcServerInfo, @lnPos, @lnLen )
|
|
loServerData._Instancing = .getDataFromPair_LenData_Structure( @tcServerInfo, @lnPos, @lnLen )
|
|
loServerData._CLSID = .getDataFromPair_LenData_Structure( @tcServerInfo, @lnPos, @lnLen )
|
|
loServerData._Interface = .getDataFromPair_LenData_Structure( @tcServerInfo, @lnPos, @lnLen )
|
|
|
|
.add_Server( loServerData )
|
|
Endfor
|
|
|
|
Endwith && THIS
|
|
|
|
Catch To loEx
|
|
If This.n_Debug > 0 And _vfp.StartMode = 0
|
|
Set Step On
|
|
Endif
|
|
|
|
Throw
|
|
|
|
Finally
|
|
loServerData = Null
|
|
Release loServerData
|
|
|
|
Endtry
|
|
|
|
Endif
|
|
Endproc
|
|
|
|
Endtry
|
|
|
|
|
|
Procedure getRowServerInfo
|
|
Try
|
|
Local lcStr, lnLenH, lnLen, lnPos ;
|
|
, loServerData As CL_PROJ_SRV_DATA Of 'FOXBIN2PRG.PRG'
|
|
Store Null To loServerData
|
|
lcStr = ''
|
|
|
|
With This As CL_PROJ_SRV_HEAD Of 'FOXBIN2PRG.PRG'
|
|
If ._ServerCount > 0
|
|
lnPos = 1
|
|
lnLen = 4
|
|
lnLenH = 103 && Al final es una constante fija :( 4 + 8 + 4 + LEN(._LibraryName) + 4 + LEN(._InternalName) + 4 + LEN(._ProjectName) + 4 + LEN(._TypeLibDesc) - 1
|
|
|
|
*-- Header
|
|
lcStr = lcStr + Padl( 4, 4, ' ' ) + Padl( lnLenH, 4, ' ' )
|
|
lcStr = lcStr + Padl( 4, 4, ' ' ) + Padl( ._ServerCount, 4, ' ' )
|
|
lcStr = lcStr + Padl( Len(._LibraryName), 4, ' ' ) + ._LibraryName
|
|
lcStr = lcStr + Padl( Len(._InternalName), 4, ' ' ) + ._InternalName
|
|
lcStr = lcStr + Padl( Len(._ProjectName), 4, ' ' ) + ._ProjectName
|
|
lcStr = lcStr + Padl( Len(._TypeLibDesc), 4, ' ' ) + ._TypeLibDesc
|
|
lcStr = lcStr + Padl( Len(._ServerType), 4, ' ' ) + ._ServerType
|
|
lcStr = lcStr + Padl( Len(._TypeLib), 4, ' ' ) + ._TypeLib
|
|
|
|
For I = 1 To ._ServerCount
|
|
loServerData = ._Servers(m.I)
|
|
lcStr = lcStr + loServerData.getRowServerInfo()
|
|
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 loServerData
|
|
Release lnLenH, lnLen, lnPos, loServerData
|
|
|
|
Endtry
|
|
|
|
Return lcStr
|
|
Endproc
|
|
|
|
|
|
|
|
Procedure getFormattedServerText
|
|
Try
|
|
Local lcText ;
|
|
, loServerData As CL_PROJ_SRV_DATA Of 'FOXBIN2PRG.PRG'
|
|
Store Null To loServerData
|
|
lcText = ''
|
|
|
|
With This As CL_PROJ_SRV_HEAD Of 'FOXBIN2PRG.PRG'
|
|
TEXT TO lcText ADDITIVE TEXTMERGE NOSHOW FLAGS 1+2 PRETEXT 1+2
|
|
<<C_SRV_HEAD_I>>
|
|
_LibraryName = '<<._LibraryName>>'
|
|
_InternalName = '<<._InternalName>>'
|
|
_ProjectName = '<<._ProjectName>>'
|
|
_TypeLibDesc = '<<._TypeLibDesc>>'
|
|
_ServerType = '<<._ServerType>>'
|
|
_TypeLib = '<<._TypeLib>>'
|
|
<<C_SRV_HEAD_F>>
|
|
ENDTEXT
|
|
|
|
*-- Recorro los servidores
|
|
For I = 1 To ._ServerCount
|
|
loServerData = ._Servers(m.I)
|
|
lcText = lcText + loServerData.getFormattedServerText()
|
|
loServerData = Null
|
|
Endfor
|
|
Endwith && THIS
|
|
|
|
Catch To loEx
|
|
If This.n_Debug > 0 And _vfp.StartMode = 0
|
|
Set Step On
|
|
Endif
|
|
|
|
Throw
|
|
|
|
Finally
|
|
Store Null To loServerData
|
|
Release loServerData
|
|
|
|
Endtry
|
|
|
|
Return lcText
|
|
Endproc
|
|
Enddefine
|
|
|
|
|
|
|
|
Define Class CL_PROJ_SRV_DATA As CL_CUS_BASE
|
|
#If .F.
|
|
Local This As CL_PROJ_SRV_DATA Of 'FOXBIN2PRG.PRG'
|
|
#Endif
|
|
|
|
_MemberData = [<VFPData>] ;
|
|
+ [<memberdata name="_classlibrary" display="_ClassLibrary"/>] ;
|
|
+ [<memberdata name="_clsid" display="_CLSID"/>] ;
|
|
+ [<memberdata name="_description" display="_Description"/>] ;
|
|
+ [<memberdata name="_helpcontextid" display="_HelpContextID"/>] ;
|
|
+ [<memberdata name="_helpfile" display="_HelpFile"/>] ;
|
|
+ [<memberdata name="_interface" display="_Interface"/>] ;
|
|
+ [<memberdata name="_instancing" display="_Instancing"/>] ;
|
|
+ [<memberdata name="_serverclass" display="_ServerClass"/>] ;
|
|
+ [<memberdata name="_servername" display="_ServerName"/>] ;
|
|
+ [<memberdata name="getformattedservertext" display="getFormattedServerText"/>] ;
|
|
+ [<memberdata name="getrowserverinfo" display="getRowServerInfo"/>] ;
|
|
+ [</VFPData>]
|
|
|
|
_HelpContextID = 0
|
|
_ServerName = ''
|
|
_Description = ''
|
|
_HelpFile = ''
|
|
_ServerClass = ''
|
|
_ClassLibrary = ''
|
|
_Instancing = 0
|
|
_CLSID = ''
|
|
_Interface = ''
|
|
|
|
|
|
|
|
Procedure getRowServerInfo
|
|
Try
|
|
Local lcStr, lnLen, lnPos
|
|
|
|
lcStr = ''
|
|
|
|
With This
|
|
If Not Empty(._ServerName)
|
|
lnPos = 1
|
|
lnLen = 4
|
|
|
|
*-- Data
|
|
lcStr = lcStr + Padl( Len(._HelpContextID), 4, ' ' ) + ._HelpContextID
|
|
lcStr = lcStr + Padl( Len(._ServerName), 4, ' ' ) + ._ServerName
|
|
lcStr = lcStr + Padl( Len(._Description), 4, ' ' ) + ._Description
|
|
lcStr = lcStr + Padl( Len(._HelpFile), 4, ' ' ) + ._HelpFile
|
|
lcStr = lcStr + Padl( Len(._ServerClass), 4, ' ' ) + ._ServerClass
|
|
lcStr = lcStr + Padl( Len(._ClassLibrary), 4, ' ' ) + ._ClassLibrary
|
|
lcStr = lcStr + Padl( Len(._Instancing), 4, ' ' ) + ._Instancing
|
|
lcStr = lcStr + Padl( Len(._CLSID), 4, ' ' ) + ._CLSID
|
|
lcStr = lcStr + Padl( Len(._Interface), 4, ' ' ) + ._Interface
|
|
Endif
|
|
Endwith && THIS
|
|
|
|
Catch To loEx
|
|
If This.n_Debug > 0 And _vfp.StartMode = 0
|
|
Set Step On
|
|
Endif
|
|
|
|
Throw
|
|
|
|
Endtry
|
|
|
|
Return lcStr
|
|
Endproc
|
|
|
|
|
|
|
|
Procedure getFormattedServerText
|
|
Try
|
|
Local lcText
|
|
lcText = ''
|
|
|
|
With This
|
|
TEXT TO lcText ADDITIVE TEXTMERGE NOSHOW FLAGS 1+2 PRETEXT 1+2
|
|
<<C_SRV_DATA_I>>
|
|
_HelpContextID = '<<._HelpContextID>>'
|
|
_ServerName = '<<._ServerName>>'
|
|
_Description = '<<._Description>>'
|
|
_HelpFile = '<<._HelpFile>>'
|
|
_ServerClass = '<<._ServerClass>>'
|
|
_ClassLibrary = '<<._ClassLibrary>>'
|
|
_Instancing = '<<._Instancing>>'
|
|
_CLSID = '<<._CLSID>>'
|
|
_Interface = '<<._Interface>>'
|
|
<<C_SRV_DATA_F>>
|
|
ENDTEXT
|
|
Endwith
|
|
|
|
Catch To loEx
|
|
If This.n_Debug > 0 And _vfp.StartMode = 0
|
|
Set Step On
|
|
Endif
|
|
|
|
Throw
|
|
|
|
Endtry
|
|
|
|
Return lcText
|
|
Endproc
|
|
|
|
Enddefine
|
|
|
|
|
|
|
|
Define Class CL_PROJ_FILE As CL_CUS_BASE
|
|
#If .F.
|
|
Local This As CL_PROJ_FILE Of 'FOXBIN2PRG.PRG'
|
|
#Endif
|
|
|
|
_MemberData = [<VFPData>] ;
|
|
+ [<memberdata name="_comments" display="_Comments"/>] ;
|
|
+ [<memberdata name="_cpid" display="_CPID"/>] ;
|
|
+ [<memberdata name="_exclude" display="_Exclude"/>] ;
|
|
+ [<memberdata name="_id" display="_ID"/>] ;
|
|
+ [<memberdata name="_name" display="_Name"/>] ;
|
|
+ [<memberdata name="_objrev" display="_ObjRev"/>] ;
|
|
+ [<memberdata name="_timestamp" display="_Timestamp"/>] ;
|
|
+ [<memberdata name="_type" display="_Type"/>] ;
|
|
+ [<memberdata name="_user" display="_User"/>] ;
|
|
+ [<memberdata name="_devinfo" display="_DevInfo"/>] ;
|
|
+ [</VFPData>]
|
|
|
|
_Name = ''
|
|
_Type = ''
|
|
_Exclude = .F.
|
|
_Comments = ''
|
|
_CPID = 0
|
|
_ID = 0
|
|
_ObjRev = 0
|
|
_TimeStamp = 0
|
|
_User = ''
|
|
_DevInfo = ''
|
|
|
|
Enddefine
|
|
|
|
|
|
|
|
Define Class CL_MENU_COL_BASE As CL_COL_BASE
|
|
_MemberData = [<VFPData>] ;
|
|
+ [<memberdata name="oreg" display="oReg"/>] ;
|
|
+ [<memberdata name="analizarsiexpresionescomandooprocedimiento" display="AnalizarSiExpresionEsComandoOProcedimiento"/>] ;
|
|
+ [<memberdata name="get_datafromtablabin" display="get_DataFromTablabin"/>] ;
|
|
+ [<memberdata name="updatemenu" display="updateMENU"/>] ;
|
|
+ [</VFPData>]
|
|
|
|
|
|
#If .F.
|
|
Local This As CL_MENU_BARPOP Of 'FOXBIN2PRG.PRG'
|
|
#Endif
|
|
|
|
oReg = Null
|
|
|
|
|
|
Procedure get_DataFromTablabin
|
|
*---------------------------------------------------------------------------------------------------
|
|
* PARÁMETROS: (v=Pasar por valor | @=Pasar por referencia) (!=Obligatorio | ?=Opcional) (IN/OUT)
|
|
* toReg (v! IN ) Objeto de datos del registro
|
|
* toCol_LastLevelName (v! IN ) Objeto collection con la pila de niveles analizados
|
|
*---------------------------------------------------------------------------------------------------
|
|
Lparameters toReg, toCol_LastLevelName As Collection
|
|
|
|
Try
|
|
Local I, lcLevelName, lnLastKey, llRetorno, llHayDatos, loReg ;
|
|
, loBarPop As CL_MENU_BARPOP Of 'FOXBIN2PRG.PRG' ;
|
|
, loOption As CL_MENU_OPTION Of 'FOXBIN2PRG.PRG'
|
|
Store Null To loOption, loBarPop
|
|
|
|
With This As CL_MENU_BARPOP Of 'FOXBIN2PRG.PRG'
|
|
lnLastKey = 0
|
|
.oReg = toReg
|
|
lcLevelName = toReg.LevelName
|
|
lnLastKey = Iif( toCol_LastLevelName.Count=0, 0, toCol_LastLevelName.GetKey(toReg.LevelName ) )
|
|
|
|
If lnLastKey = 0
|
|
toCol_LastLevelName.Add( toReg.LevelName, toReg.LevelName )
|
|
Endif
|
|
|
|
Do While Not Eof()
|
|
loReg = Null
|
|
Skip 1
|
|
|
|
If Eof()
|
|
Exit
|
|
Endif
|
|
|
|
loReg = Null
|
|
Scatter Memo Name loReg
|
|
|
|
lnLastKey = toCol_LastLevelName.GetKey(loReg.LevelName)
|
|
|
|
Do Case
|
|
Case Eof()
|
|
llRetorno = .T.
|
|
Exit
|
|
|
|
Case lnLastKey > 0 And lnLastKey < toCol_LastLevelName.Count
|
|
*-- El nombre del analizado actual ya existe y no es el último,
|
|
*-- así que corresponde a un nivel superior.
|
|
Skip -1
|
|
llRetorno = .F.
|
|
Exit
|
|
|
|
Case Inlist( loReg.ObjType, C_OBJTYPE_MENUTYPE_OPTION, C_OBJTYPE_MENUTYPE_BARorPOPUP ) ;
|
|
AND toReg.ObjType = loReg.ObjType
|
|
*-- Un objeto Option no puede anidar a otro Option,
|
|
*-- y un objeto Bar/Popup no puede anidar a otro Bar/Popup
|
|
Skip -1
|
|
llRetorno = .F.
|
|
Exit
|
|
|
|
Case loReg.ObjType = C_OBJTYPE_MENUTYPE_BARorPOPUP && Bar or Popup
|
|
loBarPop = Null
|
|
loBarPop = Createobject('CL_MENU_BARPOP')
|
|
llHayDatos = loBarPop.get_DataFromTablabin( loReg, toCol_LastLevelName )
|
|
llRetorno = .T.
|
|
llRetorno = llHayDatos
|
|
.Add( loBarPop )
|
|
loBarPop = Null
|
|
If Not llHayDatos And toReg.ObjType = C_OBJTYPE_MENUTYPE_OPTION
|
|
Exit
|
|
Endif
|
|
|
|
Case loReg.ObjType = C_OBJTYPE_MENUTYPE_OPTION && Option
|
|
loOption = Null
|
|
loOption = Createobject('CL_MENU_OPTION')
|
|
llHayDatos = loOption.get_DataFromTablabin( loReg, toCol_LastLevelName )
|
|
llRetorno = llHayDatos
|
|
.Add( loOption )
|
|
loOption = Null
|
|
If Not llHayDatos And toReg.ObjType = C_OBJTYPE_MENUTYPE_OPTION
|
|
Exit
|
|
Endif
|
|
|
|
Otherwise
|
|
llRetorno = .T.
|
|
Exit
|
|
|
|
Endcase
|
|
Enddo
|
|
Endwith && THIS
|
|
|
|
Catch To loEx
|
|
If This.n_Debug > 0 And _vfp.StartMode = 0
|
|
Set Step On
|
|
Endif
|
|
|
|
Throw
|
|
|
|
Finally
|
|
If toReg.ObjType = C_OBJTYPE_MENUTYPE_BARorPOPUP
|
|
lnLastKey = toCol_LastLevelName.GetKey(toReg.LevelName)
|
|
If lnLastKey > 0
|
|
toCol_LastLevelName.Remove(lnLastKey)
|
|
Endif
|
|
Endif
|
|
Store Null To loBarPop, loOption
|
|
Release I, lcLevelName, lnLastKey, llHayDatos, loReg, loBarPop, loOption
|
|
Endtry
|
|
|
|
Return llRetorno
|
|
Endproc
|
|
|
|
|
|
Procedure updateMENU
|
|
*---------------------------------------------------------------------------------------------------
|
|
* PARÁMETROS: (v=Pasar por valor | @=Pasar por referencia) (!=Obligatorio | ?=Opcional) (IN/OUT)
|
|
* toConversor (v! IN ) Referencia al conversor para poder usar sus métodos
|
|
*---------------------------------------------------------------------------------------------------
|
|
Lparameters toConversor
|
|
Endproc
|
|
|
|
|
|
Procedure AnalizarSiExpresionEsComandoOProcedimiento
|
|
*---------------------------------------------------------------------------------------------------
|
|
* PARÁMETROS: (v=Pasar por valor | @=Pasar por referencia) (!=Obligatorio | ?=Opcional) (IN/OUT)
|
|
* tcExpr (v! IN ) Expresión a analizar (puede ser una línea o un Procedure)
|
|
* tcProcName (!@ OUT) Nombre del Procedimiento, si se encuentra uno
|
|
* tcProcCode (!@ OUT) Código del Procedimiento, si se encuentra uno
|
|
* tcSourceCode (@? IN ) Si se indica, se buscará el nombre de Procedure para obtener su código
|
|
* tnIndentation (v? IN ) En caso de devolver código, indica si se debe indentar o quitar indentación
|
|
* tlAddProcEndproc (v? IN ) En caso de devolver código, indica si se debe encerrar con PROCEDURE/ENDPROC
|
|
* tlForceProcedure (v? IN ) Indica que se evalúe como Procedure, no como Command
|
|
*---------------------------------------------------------------------------------------------------
|
|
* DETALLE: Los menus guardan en los primeros registros los Comandos o Procedimientos en el campo PROCEDURE,
|
|
* y luego al generar el código lo muestran como Comando si es una sola línea, y si no como Procedure.
|
|
*---------------------------------------------------------------------------------------------------
|
|
Lparameters tcExpr, tcProcName, tcProcCode, tcSourceCode, tnIndentation, tlAddProcEndproc, tlForceProcedure
|
|
|
|
Local laProcLines(1), lnLine_Count, I
|
|
tcProcName = ''
|
|
tcProcCode = ''
|
|
tnIndentation = Evl(tnIndentation,0)
|
|
lnLine_Count = Alines( laProcLines, tcExpr )
|
|
|
|
If lnLine_Count > 1 Or tlForceProcedure
|
|
*-- ES UN PROCEDIMIENTO
|
|
tcProcCode = tcExpr
|
|
|
|
For I = 1 To lnLine_Count
|
|
*-- Si existe el snippet #NAME, lo usa
|
|
If Empty(tcProcName) And Upper( Left( Chrtran( Alltrim(laProcLines(m.I)), C_TAB, ' ' ), 6 ) ) == '#NAME '
|
|
tcProcName = Alltrim( Substr( Alltrim( Chrtran( laProcLines(m.I), C_TAB, ' ' ) ), 7 ) )
|
|
Exit
|
|
Endif
|
|
Endfor
|
|
Else
|
|
*-- ES UN COMANDO, PERO PODRÍA REFERENCIAR A UN PROCEDURE DEL MENU, SE VERIFICA.
|
|
If Not Empty(tcSourceCode)
|
|
If Left( tcExpr, 3 ) == 'DO '
|
|
*-- Parece un Procedimiento, vamos a confirmarlo.
|
|
tcProcName = Alltrim( Strextract( tcExpr, 'DO ', '&'+'&', 1, 2 ) )
|
|
tcProcCode = Strextract( tcSourceCode, 'PROCEDURE ' + tcProcName + CR_LF, CR_LF + 'ENDPROC &'+'& ' + tcProcName )
|
|
If Empty(tcProcCode)
|
|
*-- Era un Command al final, o un Procedure externo,
|
|
*-- que para el caso es lo mismo porque no es del Menu.
|
|
tcProcName = ''
|
|
Endif
|
|
Endif
|
|
Endif
|
|
Endif
|
|
|
|
*-- Si se indicó indentación, se reprocesa el código del procedimiento
|
|
If Not Empty(tcProcCode) And (tnIndentation <> 0 Or tlAddProcEndproc)
|
|
lnLine_Count = Alines( laProcLines, tcProcCode )
|
|
tcProcCode = ''
|
|
|
|
If tlAddProcEndproc
|
|
*tcProcCode = '*' + REPLICATE('-',34) + CR_LF + 'PROCEDURE <<ProcName>>' + CR_LF
|
|
tcProcCode = 'PROCEDURE <<ProcName>>' + CR_LF
|
|
Endif
|
|
|
|
Do Case
|
|
Case tnIndentation = 0
|
|
For I = 1 To lnLine_Count
|
|
*-- No Indentar
|
|
tcProcCode = tcProcCode + laProcLines(m.I) + CR_LF
|
|
Endfor
|
|
|
|
Case tnIndentation > 0
|
|
For I = 1 To lnLine_Count
|
|
*-- Indentar
|
|
tcProcCode = tcProcCode + C_TAB + laProcLines(m.I) + CR_LF
|
|
Endfor
|
|
|
|
Otherwise
|
|
For I = 1 To lnLine_Count
|
|
*-- Quitar indentación
|
|
If Inlist( Left(laProcLines(m.I),1), Space(1), C_TAB )
|
|
tcProcCode = tcProcCode + Substr( laProcLines(m.I), 2 ) + CR_LF
|
|
Else
|
|
tcProcCode = tcProcCode + laProcLines(m.I) + CR_LF
|
|
Endif
|
|
Endfor
|
|
Endcase
|
|
|
|
If tlAddProcEndproc
|
|
tcProcCode = tcProcCode + 'ENDPROC &' + '& <<ProcName>>' + CR_LF
|
|
Endif
|
|
Endif
|
|
|
|
Return
|
|
Endproc
|
|
|
|
|
|
Enddefine
|
|
|
|
|
|
|
|
Define Class CL_MENU As CL_MENU_COL_BASE
|
|
#If .F.
|
|
Local This As CL_MENU Of 'FOXBIN2PRG.PRG'
|
|
#Endif
|
|
|
|
_MemberData = [<VFPData>] ;
|
|
+ [<memberdata name="analyzecodeblock_cleanupcode" display="analyzeCodeBlock_CleanupCode"/>] ;
|
|
+ [<memberdata name="analyzecodeblock_menucode" display="analyzeCodeBlock_MenuCode"/>] ;
|
|
+ [<memberdata name="analyzecodeblock_procedure" display="analyzeCodeBlock_PROCEDURE"/>] ;
|
|
+ [<memberdata name="analyzecodeblock_setupcode" display="analyzeCodeBlock_SetupCode"/>] ;
|
|
+ [<memberdata name="updatemenu_recursivo" display="UpdateMenu_Recursivo"/>] ;
|
|
+ [<memberdata name="_sourcefile" display="_SourceFile"/>] ;
|
|
+ [<memberdata name="_version" display="_Version"/>] ;
|
|
+ [</VFPData>]
|
|
|
|
|
|
*-- Modulo
|
|
_Version = 0
|
|
_SourceFile = ''
|
|
|
|
|
|
Procedure analyzeCodeBlock
|
|
*---------------------------------------------------------------------------------------------------
|
|
* PARÁMETROS: (v=Pasar por valor | @=Pasar por referencia) (!=Obligatorio | ?=Opcional) (IN/OUT)
|
|
* tcLine (!@ IN/OUT) Contenido de la línea en análisis
|
|
* taCodeLines (!@ IN ) Array de líneas del programa analizado
|
|
* I (!@ IN/OUT) Número de línea en análisis
|
|
* tnCodeLines (!@ IN ) Cantidad de líneas del programa analizado
|
|
* toConversor (v! IN ) Referencia al conversor para poder usar sus métodos
|
|
*---------------------------------------------------------------------------------------------------
|
|
Lparameters tcLine, taCodeLines, I, tnCodeLines, toConversor
|
|
|
|
#If .F.
|
|
Local toConversor As c_conversor_prg_a_mnx Of 'FOXBIN2PRG.PRG'
|
|
#Endif
|
|
|
|
Try
|
|
Local llBloqueEncontrado, loReg, lcComment, lcExpr, lcProcName, lcProcCode, loEx As Exception ;
|
|
, llBloque_SetupCode_Analizado, llBloque_CleanupCode_Analizado, llBloque_MenuCode_Analizado ;
|
|
, llBloque_MenuType_Analizado, llBloque_Procedure_Analizado, llBloque_MenuLocation_Analizado ;
|
|
, loOptions As CL_MENU_OPTION Of 'FOXBIN2PRG.PRG' ;
|
|
, loBarPop As CL_MENU_BARPOP Of 'FOXBIN2PRG.PRG'
|
|
Store Null To loBarPop, loOptions
|
|
Store '' To lcComment
|
|
|
|
llBloqueEncontrado = .T.
|
|
|
|
With This As CL_MENU Of 'FOXBIN2PRG.PRG'
|
|
*-- CABECERA DEL MENU
|
|
Scatter Memo Blank Name .oReg
|
|
loReg = .oReg
|
|
|
|
For I = m.I + 0 To tnCodeLines
|
|
.set_Line( @tcLine, @taCodeLines, m.I )
|
|
|
|
Do Case
|
|
Case Empty( tcLine )
|
|
Loop
|
|
|
|
Case toConversor.lineIsOnlyCommentAndNoMetadata( @tcLine, @lcComment, .F., .T. )
|
|
Loop && Saltear comentarios
|
|
|
|
Case Not llBloque_MenuType_Analizado And Left( tcLine, Len(C_MENUTYPE_I) ) == C_MENUTYPE_I
|
|
toConversor.n_MenuType = Int( Val( Strextract( tcLine, C_MENUTYPE_I, C_MENUTYPE_F ) ) )
|
|
loReg.ObjType = toConversor.n_MenuType
|
|
llBloque_MenuType_Analizado = .T.
|
|
|
|
Case Not llBloque_MenuLocation_Analizado And Left( tcLine, Len(C_MENULOCATION_I) ) == C_MENULOCATION_I
|
|
toConversor.c_MenuLocation = Strextract( tcLine, C_MENULOCATION_I, C_MENULOCATION_F )
|
|
Do Case
|
|
Case toConversor.c_MenuLocation == 'REPLACE'
|
|
loReg.Location = C_MENULOCATION_REPLACE
|
|
Case toConversor.c_MenuLocation == 'APPEND'
|
|
loReg.Location = C_MENULOCATION_APPEND
|
|
Otherwise
|
|
If Left(toConversor.c_MenuLocation,6) == 'BEFORE'
|
|
loReg.Location = C_MENULOCATION_BEFORE
|
|
Else
|
|
loReg.Location = C_MENULOCATION_AFTER
|
|
Endif
|
|
loReg.Name = Getwordnum(toConversor.c_MenuLocation,2)
|
|
Endcase
|
|
llBloque_MenuLocation_Analizado = .T.
|
|
|
|
Case Not llBloque_SetupCode_Analizado And .analyzeCodeBlock_SetupCode( @tcLine, @taCodeLines, @m.I, tnCodeLines, toConversor )
|
|
llBloque_SetupCode_Analizado = .T.
|
|
|
|
Case Not llBloque_MenuCode_Analizado And .analyzeCodeBlock_MenuCode( @tcLine, @taCodeLines, @m.I, tnCodeLines, toConversor )
|
|
llBloque_MenuCode_Analizado = .T.
|
|
|
|
Case Not llBloque_CleanupCode_Analizado And .analyzeCodeBlock_CleanupCode( @tcLine, @taCodeLines, @m.I, tnCodeLines, toConversor )
|
|
llBloque_CleanupCode_Analizado = .T.
|
|
|
|
Case Not llBloque_Procedure_Analizado And .analyzeCodeBlock_PROCEDURE( @tcLine, @taCodeLines, @m.I, tnCodeLines, toConversor )
|
|
llBloque_Procedure_Analizado = .T.
|
|
|
|
Otherwise && Otro valor
|
|
*EXIT
|
|
Endcase
|
|
Endfor
|
|
Endwith && THIS
|
|
|
|
|
|
Catch To loEx
|
|
If This.n_Debug > 0 And _vfp.StartMode = 0
|
|
Set Step On
|
|
Endif
|
|
|
|
Throw
|
|
|
|
Finally
|
|
Store Null To loBarPop, loOptions
|
|
Release loReg, lcComment, lcExpr, lcProcName, lcProcCode ;
|
|
, llBloque_SetupCode_Analizado, llBloque_CleanupCode_Analizado, llBloque_MenuCode_Analizado ;
|
|
, llBloque_MenuType_Analizado, llBloque_Procedure_Analizado, llBloque_MenuLocation_Analizado ;
|
|
, loOptions, loBarPop
|
|
|
|
Endtry
|
|
|
|
Return llBloqueEncontrado
|
|
Endproc
|
|
|
|
|
|
Procedure analyzeCodeBlock_SetupCode
|
|
*---------------------------------------------------------------------------------------------------
|
|
* PARÁMETROS: (v=Pasar por valor | @=Pasar por referencia) (!=Obligatorio | ?=Opcional) (IN/OUT)
|
|
* tcLine (!@ IN/OUT) Contenido de la línea en análisis
|
|
* taCodeLines (!@ IN ) Array de líneas del programa analizado
|
|
* I (!@ IN/OUT) Número de línea en análisis
|
|
* tnCodeLines (!@ IN ) Cantidad de líneas del programa analizado
|
|
* toConversor (v! IN ) Referencia al conversor para poder usar sus métodos
|
|
*---------------------------------------------------------------------------------------------------
|
|
Lparameters tcLine, taCodeLines, I, tnCodeLines, toConversor
|
|
|
|
#If .F.
|
|
Local toConversor As c_conversor_prg_a_mnx Of 'FOXBIN2PRG.PRG'
|
|
#Endif
|
|
|
|
Try
|
|
Local llBloqueEncontrado, lcText, lcComment, loEx As Exception
|
|
Store '' To lcText, lcComment
|
|
|
|
If Left(tcLine, Len(C_SETUPCODE_I)) == C_SETUPCODE_I
|
|
llBloqueEncontrado = .T.
|
|
|
|
With This As CL_MENU Of 'FOXBIN2PRG.PRG'
|
|
For I = m.I + 1 To tnCodeLines
|
|
.set_Line( @tcLine, @taCodeLines, m.I )
|
|
|
|
Do Case
|
|
Case C_SETUPCODE_F $ tcLine && Fin
|
|
I = m.I + 1
|
|
Exit
|
|
|
|
Otherwise && Líneas de procedure
|
|
lcText = lcText + CR_LF + taCodeLines(m.I)
|
|
Endcase
|
|
Endfor
|
|
|
|
I = m.I - 1
|
|
.oReg.Setup = Substr( lcText, 3 ) && Quito el primer CR_LF
|
|
Endwith && THIS
|
|
Endif
|
|
|
|
Catch To loEx
|
|
If This.n_Debug > 0 And _vfp.StartMode = 0
|
|
Set Step On
|
|
Endif
|
|
|
|
Throw
|
|
|
|
Endtry
|
|
|
|
Return llBloqueEncontrado
|
|
Endproc
|
|
|
|
|
|
Procedure analyzeCodeBlock_CleanupCode
|
|
*---------------------------------------------------------------------------------------------------
|
|
* PARÁMETROS: (v=Pasar por valor | @=Pasar por referencia) (!=Obligatorio | ?=Opcional) (IN/OUT)
|
|
* tcLine (!@ IN/OUT) Contenido de la línea en análisis
|
|
* taCodeLines (!@ IN ) Array de líneas del programa analizado
|
|
* I (!@ IN/OUT) Número de línea en análisis
|
|
* tnCodeLines (!@ IN ) Cantidad de líneas del programa analizado
|
|
* toConversor (v! IN ) Referencia al conversor para poder usar sus métodos
|
|
*---------------------------------------------------------------------------------------------------
|
|
Lparameters tcLine, taCodeLines, I, tnCodeLines, toConversor
|
|
|
|
#If .F.
|
|
Local toConversor As c_conversor_prg_a_mnx Of 'FOXBIN2PRG.PRG'
|
|
#Endif
|
|
|
|
Try
|
|
Local llBloqueEncontrado, lcText, lcComment, loEx As Exception
|
|
Store '' To lcText, lcComment
|
|
|
|
If Left(tcLine, Len(C_CLEANUPCODE_I)) == C_CLEANUPCODE_I
|
|
llBloqueEncontrado = .T.
|
|
|
|
With This As CL_MENU Of 'FOXBIN2PRG.PRG'
|
|
For I = m.I + 1 To tnCodeLines
|
|
.set_Line( @tcLine, @taCodeLines, m.I )
|
|
|
|
Do Case
|
|
Case C_CLEANUPCODE_F $ tcLine && Fin
|
|
I = m.I + 1
|
|
Exit
|
|
|
|
Otherwise && Líneas de procedure
|
|
lcText = lcText + CR_LF + taCodeLines(m.I)
|
|
Endcase
|
|
Endfor
|
|
|
|
I = m.I - 1
|
|
.oReg.Cleanup = Substr( lcText, 3 ) && Quito el primer CR_LF
|
|
Endwith && THIS
|
|
Endif
|
|
|
|
Catch To loEx
|
|
If This.n_Debug > 0 And _vfp.StartMode = 0
|
|
Set Step On
|
|
Endif
|
|
|
|
Throw
|
|
|
|
Endtry
|
|
|
|
Return llBloqueEncontrado
|
|
Endproc
|
|
|
|
|
|
Procedure analyzeCodeBlock_MenuCode
|
|
*---------------------------------------------------------------------------------------------------
|
|
* PARÁMETROS: (v=Pasar por valor | @=Pasar por referencia) (!=Obligatorio | ?=Opcional) (IN/OUT)
|
|
* tcLine (!@ IN/OUT) Contenido de la línea en análisis
|
|
* taCodeLines (!@ IN ) Array de líneas del programa analizado
|
|
* I (!@ IN/OUT) Número de línea en análisis
|
|
* tnCodeLines (!@ IN ) Cantidad de líneas del programa analizado
|
|
* toConversor (v! IN ) Referencia al conversor para poder usar sus métodos
|
|
*---------------------------------------------------------------------------------------------------
|
|
Lparameters tcLine, taCodeLines, I, tnCodeLines, toConversor
|
|
|
|
#If .F.
|
|
Local toConversor As c_conversor_prg_a_mnx Of 'FOXBIN2PRG.PRG'
|
|
#Endif
|
|
|
|
Try
|
|
Local llBloqueEncontrado, lcExpr, lcProcName, lcProcCode, lcComment, loReg, loEx As Exception ;
|
|
, llBloque_SetupCode_Analizado ;
|
|
, loOptions As CL_MENU_OPTION Of 'FOXBIN2PRG.PRG' ;
|
|
, loBarPop As CL_MENU_BARPOP Of 'FOXBIN2PRG.PRG'
|
|
Store Null To loBarPop, loOptions
|
|
Store '' To lcExpr, lcProcName, lcProcCode, lcComment
|
|
|
|
With This As CL_MENU Of 'FOXBIN2PRG.PRG'
|
|
loReg = .oReg
|
|
|
|
If Left(tcLine, Len(C_MENUCODE_I)) == C_MENUCODE_I
|
|
llBloqueEncontrado = .T.
|
|
|
|
|
|
For I = m.I + 0 To tnCodeLines
|
|
Store '' To lcExpr, lcProcName, lcProcCode
|
|
.set_Line( @tcLine, @taCodeLines, m.I )
|
|
|
|
Do Case
|
|
Case Empty( tcLine )
|
|
Loop
|
|
|
|
Case toConversor.lineIsOnlyCommentAndNoMetadata( @tcLine, @lcComment )
|
|
Loop && Saltear comentarios
|
|
|
|
Case Left( tcLine, Len(C_MENUCODE_F) ) == C_MENUCODE_F
|
|
Exit
|
|
|
|
Case Left( tcLine, Len(C_MENUCODE_I) ) == C_MENUCODE_I
|
|
|
|
Case Left( tcLine, 12 ) == 'DEFINE MENU '
|
|
loReg.OBJCODE = C_OBJCODE_MENUDEFAULT_DEFAULT
|
|
loReg.ProcType = 1
|
|
loReg.Mark = Chr(4)
|
|
loReg.SetupType = 1
|
|
loReg.CleanType = 1
|
|
loReg.ItemNum = Str(0,3)
|
|
lcMenuType = Alltrim( Getwordnum( tcLine, 3 ) )
|
|
*loReg.ObjType = IIF( UPPER(lcMenuType) = '_MSYSMENU', 1, 5 )
|
|
|
|
lcExpr = Alltrim( Strextract( C_FB2PRG_CODE, 'ON SELECTION MENU _MSYSMENU ', CR_LF ) )
|
|
|
|
If Not Empty(lcExpr)
|
|
.AnalizarSiExpresionEsComandoOProcedimiento( lcExpr, @lcProcName, @lcProcCode, @C_FB2PRG_CODE, -1, .F. )
|
|
|
|
If Empty(lcProcCode)
|
|
*-- Comando
|
|
loReg.Procedure = lcExpr
|
|
Else
|
|
*-- Procedure
|
|
lcProcCode = Strtran( lcProcCode, '<<ProcName>>', lcProcName )
|
|
loReg.Procedure = lcProcCode
|
|
Endif
|
|
Endif
|
|
|
|
loBarPop = Null
|
|
loBarPop = Createobject('CL_MENU_BARPOP')
|
|
loBarPop.c_ParentName = ''
|
|
loBarPop.n_ParentCode = .oReg.OBJCODE
|
|
loBarPop.n_ParentType = .oReg.ObjType
|
|
loBarPop.analyzeCodeBlock( @tcLine, @taCodeLines, @m.I, @tnCodeLines, toConversor )
|
|
.Add( loBarPop )
|
|
Exit
|
|
|
|
Case Left( tcLine, 13 ) == 'DEFINE POPUP '
|
|
loReg.OBJCODE = C_OBJCODE_MENUDEFAULT_DEFAULT
|
|
loReg.ProcType = 1
|
|
loReg.Mark = Chr(4)
|
|
loReg.SetupType = 1
|
|
loReg.CleanType = 1
|
|
loReg.ItemNum = Str(0,3)
|
|
loReg.Scheme = 0
|
|
lcExpr = Alltrim( Strextract( C_FB2PRG_CODE, 'ON SELECTION POPUP ALL ', CR_LF ) )
|
|
.AnalizarSiExpresionEsComandoOProcedimiento( lcExpr, @lcProcName, @lcProcCode, @C_FB2PRG_CODE, -1, .F. )
|
|
|
|
If Empty(lcProcCode)
|
|
*-- Comando
|
|
loReg.Procedure = lcExpr
|
|
Else
|
|
*-- Procedure
|
|
lcProcCode = Strtran( lcProcCode, '<<ProcName>>', lcProcName )
|
|
loReg.Procedure = lcProcCode
|
|
Endif
|
|
|
|
loBarPop = Null
|
|
loBarPop = Createobject('CL_MENU_BARPOP')
|
|
loBarPop.c_ParentName = ''
|
|
loBarPop.n_ParentCode = .oReg.OBJCODE
|
|
loBarPop.n_ParentType = .oReg.ObjType
|
|
loBarPop.analyzeCodeBlock( @tcLine, @taCodeLines, @m.I, @tnCodeLines, toConversor )
|
|
.Add( loBarPop )
|
|
|
|
*-- Creo option
|
|
loOption = Null
|
|
loOption = Createobject("CL_MENU_OPTION")
|
|
Scatter Memo Blank Name loOption.oReg
|
|
|
|
With loOption.oReg
|
|
.ObjType = C_OBJTYPE_MENUTYPE_OPTION
|
|
.OBJCODE = C_OBJCODE_MENUOPTION_SUBMENU
|
|
.Mark = Chr(0)
|
|
.Prompt = '\<Shortcut'
|
|
.LevelName = '_MSYSMENU'
|
|
loBarPop.Add( loOption )
|
|
loBarPop.oReg.NUMITEMS = loBarPop.Count
|
|
.ItemNum = Str(loBarPop.Count,3)
|
|
.Scheme = 0
|
|
loBarPop = Null
|
|
Endwith
|
|
|
|
*-- Creo BarPop
|
|
loBarPop = Null
|
|
loBarPop = Createobject('CL_MENU_BARPOP')
|
|
loBarPop.c_ParentName = ''
|
|
loBarPop.n_ParentCode = loOption.oReg.OBJCODE
|
|
loBarPop.n_ParentType = loOption.oReg.ObjType
|
|
loBarPop.analyzeCodeBlock( @tcLine, @taCodeLines, @m.I, @tnCodeLines, toConversor )
|
|
loOption.Add( loBarPop )
|
|
loBarPop = Null
|
|
loOption = Null
|
|
Exit
|
|
|
|
Otherwise && Otro valor
|
|
I = m.I - 1
|
|
Exit
|
|
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 loBarPop, loOptions
|
|
Release lcExpr, lcProcName, lcProcCode, lcComment, loReg, llBloque_SetupCode_Analizado ;
|
|
, loOptions, loBarPop
|
|
|
|
Endtry
|
|
|
|
Return llBloqueEncontrado
|
|
Endproc
|
|
|
|
|
|
Procedure analyzeCodeBlock_PROCEDURE
|
|
*---------------------------------------------------------------------------------------------------
|
|
* PARÁMETROS: (v=Pasar por valor | @=Pasar por referencia) (!=Obligatorio | ?=Opcional) (IN/OUT)
|
|
* tcLine (!@ IN/OUT) Contenido de la línea en análisis
|
|
* taCodeLines (!@ IN ) Array de líneas del programa analizado
|
|
* I (!@ IN/OUT) Número de línea en análisis
|
|
* tnCodeLines (!@ IN ) Cantidad de líneas del programa analizado
|
|
* toConversor (v! IN ) Referencia al conversor para poder usar sus métodos
|
|
*---------------------------------------------------------------------------------------------------
|
|
Lparameters tcLine, taCodeLines, I, tnCodeLines, toConversor
|
|
|
|
#If .F.
|
|
Local toConversor As c_conversor_prg_a_mnx Of 'FOXBIN2PRG.PRG'
|
|
#Endif
|
|
|
|
Try
|
|
Local llBloqueEncontrado, lcText, lcComment, lcProcName, loEx As Exception
|
|
Store '' To lcText, lcComment
|
|
|
|
If Left(tcLine, Len(C_PROC_CODE_I)) == C_PROC_CODE_I
|
|
llBloqueEncontrado = .T.
|
|
|
|
With This As CL_MENU Of 'FOXBIN2PRG.PRG'
|
|
For I = m.I + 1 To tnCodeLines
|
|
.set_Line( @tcLine, @taCodeLines, m.I )
|
|
|
|
Do Case
|
|
Case C_PROC_CODE_F $ tcLine && Fin
|
|
I = m.I + 1
|
|
Exit
|
|
|
|
Otherwise && Líneas de procedure
|
|
*-- Las saltea
|
|
Endcase
|
|
Endfor
|
|
Endwith && THIS
|
|
|
|
I = m.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 toText
|
|
*---------------------------------------------------------------------------------------------------
|
|
* PARÁMETROS: (v=Pasar por valor | @=Pasar por referencia) (!=Obligatorio | ?=Opcional) (IN/OUT)
|
|
*---------------------------------------------------------------------------------------------------
|
|
|
|
Try
|
|
Local lcText, loReg, loHeader, lnNivel, lcEndProcedures, lcExpr, lcProcName, lcProcCode, lcLocation ;
|
|
, loEx As Exception ;
|
|
, loCol_LastLevelName As Collection ;
|
|
, loBarPop As CL_MENU_BARPOP Of 'FOXBIN2PRG.PRG' ;
|
|
, loOption As CL_MENU_OPTION Of 'FOXBIN2PRG.PRG'
|
|
Store Null To loOption, loBarPop, loCol_LastLevelName
|
|
Store '' To lcText, lcEndProcedures
|
|
|
|
With This As CL_MENU Of 'FOXBIN2PRG.PRG'
|
|
loReg = .oReg
|
|
loHeader = loReg
|
|
loBarPop = .Item(1).oReg
|
|
lnNivel = 0
|
|
|
|
Do Case
|
|
Case loReg.Location = C_MENULOCATION_REPLACE
|
|
lcLocation = 'REPLACE'
|
|
Case loReg.Location = C_MENULOCATION_APPEND
|
|
lcLocation = 'APPEND'
|
|
Case loReg.Location = C_MENULOCATION_BEFORE
|
|
lcLocation = 'BEFORE ' + loReg.Name
|
|
Case loReg.Location = C_MENULOCATION_AFTER
|
|
lcLocation = 'AFTER ' + loReg.Name
|
|
Endcase
|
|
|
|
TEXT TO lcText ADDITIVE TEXTMERGE NOSHOW FLAGS 1+2 PRETEXT 1+2
|
|
<<C_MENUTYPE_I>><<loReg.ObjType>><<C_MENUTYPE_F>>
|
|
<<C_MENULOCATION_I>><<lcLocation>><<C_MENULOCATION_F>>
|
|
ENDTEXT
|
|
|
|
If Not Empty(loReg.Setup)
|
|
TEXT TO lcText ADDITIVE TEXTMERGE NOSHOW FLAGS 1+2 PRETEXT 1+2
|
|
<<>>
|
|
<<C_SETUPCODE_I>>
|
|
<<loReg.Setup>>
|
|
<<C_SETUPCODE_F>>
|
|
ENDTEXT
|
|
Endif
|
|
|
|
TEXT TO lcText ADDITIVE TEXTMERGE NOSHOW FLAGS 1+2 PRETEXT 1+2
|
|
<<>>
|
|
<<C_MENUCODE_I>>
|
|
ENDTEXT
|
|
|
|
Do Case
|
|
Case loHeader.ObjType = C_OBJTYPE_MENUTYPE_DEFAULT && Menu Bar (Sistema)
|
|
lcText = lcText + CR_LF + 'DEFINE MENU ' + loBarPop.Name + ' BAR'
|
|
|
|
Case loHeader.ObjType = C_OBJTYPE_MENUTYPE_MENUBARONTOP && Menu Bar (On top)
|
|
lcText = lcText + CR_LF + 'DEFINE MENU ' + loBarPop.Name + ' BAR'
|
|
|
|
Case loHeader.ObjType = C_OBJTYPE_MENUTYPE_SHORTCUT && Shortcut
|
|
lcText = lcText + CR_LF + 'DEFINE POPUP ' + .Item(1).Item(1).Item(1).oReg.Name + ' SHORTCUT RELATIVE FROM MROW(),MCOL()'
|
|
|
|
Endcase
|
|
|
|
|
|
*-- Bars and Popups
|
|
If .Count > 0
|
|
For Each loBarPop In This FoxObject
|
|
lcText = lcText + loBarPop.toText(loReg, lnNivel+0, @lcEndProcedures, loHeader)
|
|
Endfor
|
|
Endif
|
|
|
|
loBarPop = .Item(1).oReg
|
|
|
|
Do Case
|
|
Case loHeader.ObjType = C_OBJTYPE_MENUTYPE_DEFAULT Or loHeader.ObjType = C_OBJTYPE_MENUTYPE_MENUBARONTOP
|
|
*-- Propecimiento principal de _MSYSMENU (ObjType:1, ObjCode:22) (C_OBJTYPE_MENUTYPE_DEFAULT, C_OBJCODE_MENUDEFAULT_DEFAULT)
|
|
If Not Empty(loHeader.Procedure)
|
|
lcExpr = loHeader.Procedure
|
|
.AnalizarSiExpresionEsComandoOProcedimiento( lcExpr, @lcProcName, @lcProcCode, '', 1, .T. )
|
|
|
|
If Empty(lcProcCode)
|
|
*-- Comando
|
|
lcText = lcText + 'ON SELECTION MENU ' + loBarPop.Name + ' ' + lcExpr + CR_LF
|
|
Else
|
|
*-- Procedure
|
|
lcProcName = Evl( lcProcName, Chrtran('SELECTION MENU ' + loBarPop.Name, ' ', '_') + '_FB2P' )
|
|
lcText = lcText + 'ON SELECTION MENU ' + loBarPop.Name + ' DO ' + lcProcName + CR_LF
|
|
lcProcCode = Strtran( lcProcCode, '<<ProcName>>', lcProcName )
|
|
lcEndProcedures = lcEndProcedures + lcProcCode + CR_LF
|
|
Endif
|
|
Endif
|
|
|
|
Case loHeader.ObjType = C_OBJTYPE_MENUTYPE_SHORTCUT
|
|
If Not Empty(loHeader.Procedure)
|
|
lcExpr = loHeader.Procedure
|
|
.AnalizarSiExpresionEsComandoOProcedimiento( lcExpr, @lcProcName, @lcProcCode, '', 1, .T. )
|
|
|
|
If Empty(lcProcCode)
|
|
*-- Comando
|
|
lcText = lcText + 'ON SELECTION POPUP ALL ' + lcExpr + CR_LF
|
|
Else
|
|
*-- Procedure
|
|
lcText = lcText + 'ON SELECTION POPUP ALL ' + loBarPop.Name + ' DO ' + lcProcName + CR_LF
|
|
lcProcCode = Strtran( lcProcCode, '<<ProcName>>', lcProcName )
|
|
lcEndProcedures = lcEndProcedures + lcProcCode + CR_LF
|
|
Endif
|
|
Endif
|
|
|
|
lcText = lcText + 'ACTIVATE POPUP ' + .Item(1).Item(1).Item(1).oReg.Name + CR_LF
|
|
Endcase
|
|
|
|
TEXT TO lcText ADDITIVE TEXTMERGE NOSHOW FLAGS 1+2 PRETEXT 1+2
|
|
<<C_MENUCODE_F>>
|
|
ENDTEXT
|
|
|
|
*-- Procedimientos finales
|
|
If Not Empty(lcEndProcedures)
|
|
lcText = lcText + CR_LF + CR_LF ;
|
|
+ C_PROC_CODE_I + CR_LF ;
|
|
+ lcEndProcedures ;
|
|
+ C_PROC_CODE_F + CR_LF
|
|
Endif
|
|
|
|
If Not Empty(loReg.Cleanup)
|
|
TEXT TO lcText ADDITIVE TEXTMERGE NOSHOW FLAGS 1+2 PRETEXT 1+2
|
|
<<>>
|
|
<<C_CLEANUPCODE_I>>
|
|
<<loReg.Cleanup>>
|
|
<<C_CLEANUPCODE_F>>
|
|
ENDTEXT
|
|
Endif
|
|
|
|
Endwith && THIS
|
|
|
|
|
|
Catch To loEx
|
|
If This.n_Debug > 0 And _vfp.StartMode = 0
|
|
Set Step On
|
|
Endif
|
|
|
|
Throw
|
|
|
|
Finally
|
|
Store Null To loOption, loBarPop, loCol_LastLevelName
|
|
Release loReg, loHeader, lnNivel, lcEndProcedures, lcExpr, lcProcName, lcProcCode, lcLocation ;
|
|
, loCol_LastLevelName, loBarPop, loOption
|
|
|
|
Endtry
|
|
|
|
Return lcText
|
|
Endproc
|
|
|
|
|
|
Procedure get_DataFromTablabin
|
|
*---------------------------------------------------------------------------------------------------
|
|
* PARÁMETROS: (v=Pasar por valor | @=Pasar por referencia) (!=Obligatorio | ?=Opcional) (IN/OUT)
|
|
*---------------------------------------------------------------------------------------------------
|
|
Local loReg, loCol_LastLevelName As Collection
|
|
Store Null To loReg, loCol_LastLevelName
|
|
Go Top
|
|
Scatter Memo Name loReg
|
|
loCol_LastLevelName = Createobject('COLLECTION')
|
|
CL_MENU_COL_BASE::get_DataFromTablabin( loReg, loCol_LastLevelName )
|
|
Store Null To loReg, loCol_LastLevelName
|
|
Release loReg, loCol_LastLevelName
|
|
Endproc
|
|
|
|
|
|
Procedure updateMENU
|
|
*---------------------------------------------------------------------------------------------------
|
|
* PARÁMETROS: (v=Pasar por valor | @=Pasar por referencia) (!=Obligatorio | ?=Opcional) (IN/OUT)
|
|
* toConversor (v! IN ) Referencia al conversor para poder usar sus métodos
|
|
*---------------------------------------------------------------------------------------------------
|
|
Lparameters toConversor
|
|
|
|
#If .F.
|
|
Local toConversor As c_conversor_prg_a_mnx Of 'FOXBIN2PRG.PRG'
|
|
#Endif
|
|
|
|
Select TABLABIN
|
|
|
|
With This As CL_MENU Of 'FOXBIN2PRG.PRG'
|
|
If .n_Debug > 0 Then
|
|
toConversor.writeLog( '' )
|
|
toConversor.writeLog( Replicate('-',80) )
|
|
Endif
|
|
|
|
.UpdateMenu_Recursivo( This, 0, @toConversor )
|
|
|
|
If .n_Debug > 0 Then
|
|
toConversor.writeLog( Replicate('-',80) )
|
|
Endif
|
|
Endwith && THIS
|
|
|
|
Endproc
|
|
|
|
|
|
Procedure UpdateMenu_Recursivo
|
|
*---------------------------------------------------------------------------------------------------
|
|
* PARÁMETROS: (v=Pasar por valor | @=Pasar por referencia) (!=Obligatorio | ?=Opcional) (IN/OUT)
|
|
* toObj (v! IN ) Referencia del objeto CL_MENU_BARPOP o CL_MENU_OPTION
|
|
* tnNivel (v! IN ) Nivel de indentación (solo para debug)
|
|
* toConversor (v! IN ) Referencia al conversor para poder usar sus métodos
|
|
*---------------------------------------------------------------------------------------------------
|
|
Lparameters toObj As Collection, tnNivel, toConversor
|
|
|
|
Local loReg, lcTempName, loEx As Exception
|
|
Store Null To loReg
|
|
|
|
#If .F.
|
|
Local toConversor As c_conversor_prg_a_mnx Of 'FOXBIN2PRG.PRG'
|
|
#Endif
|
|
|
|
Try
|
|
With This As CL_MENU Of 'FOXBIN2PRG.PRG'
|
|
If Vartype( toObj.oReg ) = 'O'
|
|
loReg = toObj.oReg
|
|
|
|
If loReg.ObjType = C_OBJTYPE_MENUTYPE_OPTION
|
|
lcTempName = '_' + Padl( Int( Val(loReg.ItemNum) ), 9, '0')
|
|
|
|
*-- Si el nombre es del tipo "_0000000001" y coincide con el itemNum
|
|
*-- que uso para darle un nombre temporal, lo vuelvo a quitar en el binario.
|
|
If loReg.Name = lcTempName Then
|
|
loReg.Name = ''
|
|
Endif
|
|
Endif
|
|
|
|
Insert Into TABLABIN From Name loReg
|
|
|
|
If .n_Debug > 0 Then
|
|
toConversor.writeLog( Replicate(C_TAB,tnNivel) ;
|
|
+ 'ObjType=' + Transform(loReg.ObjType) ;
|
|
+ ', ObjCode=' + Transform(loReg.OBJCODE) ;
|
|
+ ', Name=' + Transform(loReg.Name) ;
|
|
+ ', LevelName=' + Transform(loReg.LevelName) ;
|
|
+ ', ItemNum=' + Transform(loReg.ItemNum) ;
|
|
+ ', Location=' + Transform(loReg.Location) ;
|
|
+ ', Prompt=' + Transform(loReg.Prompt) ;
|
|
+ ', Message=' + Transform(loReg.Message) ;
|
|
+ ', KeyName=' + Transform(loReg.KEYNAME) ;
|
|
+ ', KeyLabel=' + Transform(loReg.KeyLabel) ;
|
|
+ ', Comment=' + Transform(loReg.Comment) ;
|
|
+ ', SkipFor=' + Transform(loReg.SkipFor) )
|
|
Endif
|
|
|
|
Else
|
|
If .n_Debug > 0 Then
|
|
*toConversor.writeLog( REPLICATE(C_TAB,tnNivel) ;
|
|
+ 'Objeto [' + toObj.CLASS + '] no contiene el objeto oReg (nivel ' + TRANSFORM(tnNivel) + ')' )
|
|
toConversor.writeLog( Replicate(C_TAB,tnNivel) + Textmerge(C_OBJECT_NAME_WITHOUT_OBJECT_OREG_LOC) )
|
|
Endif
|
|
|
|
Endif
|
|
|
|
If toObj.Count > 0 Then
|
|
For Each loReg In toObj FoxObject
|
|
.UpdateMenu_Recursivo( loReg, tnNivel + 1, @toConversor )
|
|
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 loReg
|
|
Release loReg
|
|
|
|
Endtry
|
|
Endproc
|
|
|
|
|
|
Enddefine
|
|
|
|
|
|
|
|
Define Class CL_MENU_BARPOP As CL_MENU_COL_BASE
|
|
_MemberData = [<VFPData>] ;
|
|
+ [<memberdata name="analyzecodeblock_definepopup" display="analyzeCodeBlock_DefinePOPUP"/>] ;
|
|
+ [<memberdata name="updatemenu" display="updateMENU"/>] ;
|
|
+ [<memberdata name="c_parentname" display="c_ParentName"/>] ;
|
|
+ [<memberdata name="n_parentcode" display="n_ParentCode"/>] ;
|
|
+ [<memberdata name="n_parenttype" display="n_ParentType"/>] ;
|
|
+ [</VFPData>]
|
|
|
|
#If .F.
|
|
Local This As CL_MENU_BARPOP Of 'FOXBIN2PRG.PRG'
|
|
#Endif
|
|
|
|
c_ParentName = ''
|
|
n_ParentCode = 0
|
|
n_ParentType = 0
|
|
|
|
|
|
Procedure analyzeCodeBlock
|
|
*---------------------------------------------------------------------------------------------------
|
|
* PARÁMETROS: (v=Pasar por valor | @=Pasar por referencia) (!=Obligatorio | ?=Opcional) (IN/OUT)
|
|
* tcLine (!@ IN/OUT) Contenido de la línea en análisis
|
|
* taCodeLines (!@ IN ) Array de líneas del programa analizado
|
|
* I (!@ IN/OUT) Número de línea en análisis
|
|
* tnCodeLines (!@ IN ) Cantidad de líneas del programa analizado
|
|
* toConversor (v! IN ) Referencia al conversor para poder usar sus métodos
|
|
*---------------------------------------------------------------------------------------------------
|
|
Lparameters tcLine, taCodeLines, I, tnCodeLines, toConversor
|
|
|
|
#If .F.
|
|
Local toConversor As c_conversor_prg_a_mnx Of 'FOXBIN2PRG.PRG'
|
|
#Endif
|
|
|
|
Try
|
|
Local llBloqueEncontrado, lcSubName, lcComment, lnLast_I, loReg, lcExpr, lcProcName, lcProcCode, lcMenuType ;
|
|
, loEx As Exception ;
|
|
, loOption As CL_MENU_OPTION Of 'FOXBIN2PRG.PRG'
|
|
Store Null To loOption
|
|
Store '' To lcSubName, lcComment, lcExpr, lcProcName, lcProcCode
|
|
|
|
With This As CL_MENU_BARPOP Of 'FOXBIN2PRG.PRG'
|
|
Scatter Memo Blank Name .oReg
|
|
loReg = .oReg
|
|
loReg.ObjType = C_OBJTYPE_MENUTYPE_BARorPOPUP
|
|
loReg.ProcType = 1
|
|
loReg.Mark = Chr(0)
|
|
loReg.ItemNum = Str(0,3)
|
|
llBloqueEncontrado = .T.
|
|
|
|
For I = m.I + 0 To tnCodeLines
|
|
Store '' To lcExpr, lcProcName, lcProcCode
|
|
.set_Line( @tcLine, @taCodeLines, m.I )
|
|
|
|
Do Case
|
|
Case Empty( tcLine )
|
|
Loop
|
|
|
|
Case toConversor.lineIsOnlyCommentAndNoMetadata( @tcLine, @lcComment, .F., .T. )
|
|
Loop && Saltear comentarios
|
|
|
|
Case Left( tcLine, Len(C_MENUCODE_F) ) == C_MENUCODE_F
|
|
Exit
|
|
|
|
Case Left( tcLine, Len('ON SELECTION POPUP ' + loReg.Name) ) == 'ON SELECTION POPUP ' + loReg.Name
|
|
Exit
|
|
|
|
Case Left( tcLine, 12 ) == 'DEFINE MENU '
|
|
loReg.OBJCODE = C_OBJCODE_MENUBARPOPUP_MENUBAR
|
|
loReg.Name = Strextract( tcLine, 'DEFINE MENU ', ' BAR' )
|
|
*loReg.NAME = '_MSYSMENU'
|
|
loReg.LevelName = loReg.Name
|
|
loReg.Scheme = Iif( loReg.OBJCODE = C_OBJCODE_MENUBARPOPUP_MENUBAR, 3, 4 )
|
|
|
|
lcExpr = Strextract( C_FB2PRG_CODE, 'ON SELECTION POPUP ALL ', CR_LF )
|
|
.AnalizarSiExpresionEsComandoOProcedimiento( lcExpr, @lcProcName, @lcProcCode, @C_FB2PRG_CODE, -1 )
|
|
loReg.Procedure = Evl(lcProcCode, lcExpr)
|
|
|
|
Case Left( tcLine, 13 ) == 'DEFINE POPUP '
|
|
If .n_ParentCode = C_OBJCODE_MENUDEFAULT_DEFAULT
|
|
loReg.OBJCODE = C_OBJCODE_MENUBARPOPUP_MENUBAR
|
|
loReg.Name = '_MSYSMENU'
|
|
loReg.LevelName = loReg.Name
|
|
loReg.Scheme = 3
|
|
|
|
If .n_ParentType = C_OBJTYPE_MENUTYPE_SHORTCUT
|
|
Exit
|
|
Endif
|
|
Else
|
|
loReg.OBJCODE = C_OBJCODE_MENUBARPOPUP_MENUPAD
|
|
loReg.Scheme = 4
|
|
loReg.Name = Alltrim( Getwordnum( tcLine, 3 ) )
|
|
|
|
If Right(loReg.Name,5) == '_FB2P' && Originalmente era vacío y se la había puesto un nombre temporal.
|
|
loReg.Name = ''
|
|
Endif
|
|
|
|
loReg.LevelName = loReg.Name
|
|
lcExpr = Alltrim( Strextract( C_FB2PRG_CODE, 'ON SELECTION POPUP ' + loReg.Name + ' ', CR_LF ) )
|
|
.AnalizarSiExpresionEsComandoOProcedimiento( lcExpr, @lcProcName, @lcProcCode, @C_FB2PRG_CODE, -1 )
|
|
loReg.Procedure = Evl(lcProcCode, lcExpr)
|
|
Endif
|
|
|
|
Case Left( tcLine, 11 ) == 'DEFINE PAD ' Or Left( tcLine, 11 ) == 'DEFINE BAR '
|
|
loOption = Null
|
|
loOption = Createobject("CL_MENU_OPTION")
|
|
lnLast_I = m.I
|
|
loOption.c_ParentName = loReg.LevelName
|
|
loOption.n_ParentCode = loReg.OBJCODE
|
|
loOption.n_ParentType = loReg.ObjType
|
|
|
|
If Not loOption.analyzeCodeBlock( @tcLine, @taCodeLines, @m.I, tnCodeLines, toConversor )
|
|
I = lnLast_I
|
|
llBloqueEncontrado = .F.
|
|
Exit
|
|
Endif
|
|
|
|
.Add( loOption )
|
|
loOption.oReg.ItemNum = Str(.Count,3)
|
|
loReg.NUMITEMS = .Count
|
|
loReg.Scheme = Iif( loReg.OBJCODE = C_OBJCODE_MENUBARPOPUP_MENUBAR, 3, 4 )
|
|
loOption = Null
|
|
|
|
If I = lnLast_I && No avanzó, debe salir.
|
|
Exit
|
|
Endif
|
|
|
|
Otherwise && Otro valor
|
|
I = m.I - 1
|
|
Exit
|
|
Endcase
|
|
Endfor
|
|
Endwith && THIS
|
|
|
|
Catch To loEx
|
|
If This.n_Debug > 0 And _vfp.StartMode = 0
|
|
Set Step On
|
|
Endif
|
|
|
|
Throw
|
|
|
|
Finally
|
|
Store Null To loOption
|
|
Release lcSubName, lcComment, lnLast_I, loReg, lcExpr, lcProcName, lcProcCode, lcMenuType, loOption
|
|
|
|
Endtry
|
|
|
|
Return llBloqueEncontrado
|
|
Endproc
|
|
|
|
|
|
Procedure toText
|
|
*---------------------------------------------------------------------------------------------------
|
|
* PARÁMETROS: (v=Pasar por valor | @=Pasar por referencia) (!=Obligatorio | ?=Opcional) (IN/OUT)
|
|
* toParentReg (v! IN ) Objeto registro Padre
|
|
* tnNivel (v! IN ) Nivel para indentar
|
|
* tcEndProcedures (!@ OUT) Agregar aquí los procedimientos que irán al final
|
|
* toHeader (v! IN ) Objeto Registro de cabecera del menu
|
|
*---------------------------------------------------------------------------------------------------
|
|
Lparameters toParentReg, tnNivel, tcEndProcedures, toHeader
|
|
|
|
Try
|
|
Local loReg, I, lcText, lcTab, lcExpr, lcProcName, lcProcCode, loEx As Exception ;
|
|
, loBarPop As CL_MENU_BARPOP Of 'FOXBIN2PRG.PRG' ;
|
|
, loOption As CL_MENU_OPTION Of 'FOXBIN2PRG.PRG'
|
|
Store Null To loOption, loBarPop
|
|
Store '' To lcText, lcExpr, lcProcName, lcProcCode
|
|
loReg = This.oReg
|
|
lcTab = Replicate(Chr(9),tnNivel)
|
|
|
|
*-- Menu Bar or Popup (ObjType:2, ObjCode:0 ó 1)
|
|
If loReg.OBJCODE = C_OBJCODE_MENUBARPOPUP_MENUPAD && (Menu Pad)
|
|
If toHeader.ObjType = C_OBJTYPE_MENUTYPE_SHORTCUT
|
|
*-- Shortcut
|
|
If Not Pemstatus(toHeader,'_MenuInicializado', 5) && Header
|
|
AddProperty(toHeader,'_MenuInicializado', .T.)
|
|
Else && Rest
|
|
TEXT TO lcText ADDITIVE TEXTMERGE NOSHOW FLAGS 1+2 PRETEXT 1+2
|
|
<<lcTab>>*----------------------------------
|
|
<<lcTab>>DEFINE POPUP <<loReg.Name>> SHORTCUT RELATIVE
|
|
ENDTEXT
|
|
Endif
|
|
Else && ObjType = C_OBJTYPE_MENUTYPE_DEFAULT o C_OBJTYPE_MENUTYPE_MENUBARONTOP
|
|
*-- Menu
|
|
TEXT TO lcText ADDITIVE TEXTMERGE NOSHOW FLAGS 1+2 PRETEXT 1+2
|
|
<<lcTab>>*----------------------------------
|
|
<<lcTab>>DEFINE POPUP <<loReg.Name>> MARGIN RELATIVE SHADOW COLOR SCHEME <<loReg.Scheme>>
|
|
ENDTEXT
|
|
Endif
|
|
Endif
|
|
|
|
*-- Options (ObjType:3)
|
|
If This.Count > 0
|
|
For Each loOption In This FoxObject
|
|
lcText = lcText + loOption.toText(loReg, tnNivel+0, @tcEndProcedures, toHeader)
|
|
Endfor
|
|
Endif
|
|
|
|
*-- Procedure del POPUP o MENU
|
|
If Not Empty(loReg.Procedure)
|
|
lcExpr = loReg.Procedure
|
|
This.AnalizarSiExpresionEsComandoOProcedimiento( lcExpr, @lcProcName, @lcProcCode, '', 1, .T. )
|
|
|
|
If Empty(lcProcCode)
|
|
*-- Comando
|
|
lcText = lcText + lcTab + 'ON SELECTION POPUP ' ;
|
|
+ Iif( loReg.OBJCODE = C_OBJCODE_MENUBARPOPUP_MENUPAD, loReg.Name, 'ALL' ) + ' ' + lcExpr + CR_LF
|
|
Else
|
|
*-- Procedure
|
|
If Empty(lcProcName)
|
|
lcProcName = Chrtran( Alltrim( Iif( loReg.OBJCODE = C_OBJCODE_MENUBARPOPUP_MENUPAD, loReg.Name, 'ALL' ) ), ' ', '_' ) + '_FB2P'
|
|
Endif
|
|
lcText = lcText + lcTab + 'ON SELECTION POPUP ' ;
|
|
+ Iif( loReg.OBJCODE = C_OBJCODE_MENUBARPOPUP_MENUPAD, loReg.Name, 'ALL' ) + ' DO ' + lcProcName + CR_LF
|
|
tcEndProcedures = tcEndProcedures + Strtran( lcProcCode, '<<ProcName>>', lcProcName ) + CR_LF
|
|
Endif
|
|
|
|
Endif
|
|
|
|
|
|
Catch To loEx
|
|
If This.n_Debug > 0 And _vfp.StartMode = 0
|
|
Set Step On
|
|
Endif
|
|
|
|
Throw
|
|
|
|
Finally
|
|
Store Null To loOption, loBarPop
|
|
Release loReg, I, lcTab, lcExpr, lcProcName, lcProcCode, loBarPop, loOption
|
|
|
|
Endtry
|
|
|
|
Return lcText
|
|
Endproc
|
|
|
|
|
|
Procedure updateMENU
|
|
Endproc
|
|
|
|
|
|
Enddefine
|
|
|
|
|
|
Define Class CL_MENU_OPTION As CL_MENU_COL_BASE
|
|
_MemberData = [<VFPData>] ;
|
|
+ [<memberdata name="analyzecodeblock_definebar" display="analyzeCodeBlock_DefineBAR"/>] ;
|
|
+ [<memberdata name="analyzecodeblock_definepad" display="analyzeCodeBlock_DefinePAD"/>] ;
|
|
+ [<memberdata name="get_definebartext" display="get_DefineBarText"/>] ;
|
|
+ [<memberdata name="get_definepadtext" display="get_DefinePadText"/>] ;
|
|
+ [<memberdata name="get_procnamefromsnippet" display="get_ProcNameFromSnippet"/>] ;
|
|
+ [<memberdata name="c_parentname" display="c_ParentName"/>] ;
|
|
+ [<memberdata name="n_parentcode" display="n_ParentCode"/>] ;
|
|
+ [<memberdata name="n_parenttype" display="n_ParentType"/>] ;
|
|
+ [</VFPData>]
|
|
|
|
#If .F.
|
|
Local This As CL_MENU_OPTION Of 'FOXBIN2PRG.PRG'
|
|
#Endif
|
|
|
|
c_ParentName = ''
|
|
n_ParentCode = 0
|
|
n_ParentType = 0
|
|
|
|
|
|
Procedure analyzeCodeBlock
|
|
*---------------------------------------------------------------------------------------------------
|
|
* PARÁMETROS: (v=Pasar por valor | @=Pasar por referencia) (!=Obligatorio | ?=Opcional) (IN/OUT)
|
|
* tcLine (!@ IN/OUT) Contenido de la línea en análisis
|
|
* taCodeLines (!@ IN ) Array de líneas del programa analizado
|
|
* I (!@ IN/OUT) Número de línea en análisis
|
|
* tnCodeLines (!@ IN ) Cantidad de líneas del programa analizado
|
|
* toConversor (v! IN ) Referencia al conversor para poder usar sus métodos
|
|
*---------------------------------------------------------------------------------------------------
|
|
Lparameters tcLine, taCodeLines, I, tnCodeLines, toConversor
|
|
|
|
#If .F.
|
|
Local toConversor As c_conversor_prg_a_mnx Of 'FOXBIN2PRG.PRG'
|
|
#Endif
|
|
|
|
Try
|
|
Local llBloqueEncontrado, lcComment, loReg, lnLast_I, loEx As Exception, llPadOBar_Analizado ;
|
|
, loBarPop As CL_MENU_BARPOP Of 'FOXBIN2PRG.PRG'
|
|
Store Null To loBarPop
|
|
Store '' To lcComment
|
|
|
|
With This As CL_MENU_OPTION Of 'FOXBIN2PRG.PRG'
|
|
Scatter Memo Blank Name .oReg
|
|
loReg = .oReg
|
|
loReg.Mark = Chr(0)
|
|
loReg.ItemNum = Str(0,3)
|
|
|
|
llBloqueEncontrado = .T.
|
|
|
|
For I = m.I + 0 To tnCodeLines
|
|
.set_Line( @tcLine, @taCodeLines, m.I )
|
|
|
|
Do Case
|
|
Case Empty( tcLine )
|
|
Loop
|
|
|
|
Case toConversor.lineIsOnlyCommentAndNoMetadata( @tcLine, @lcComment, .F., .T. )
|
|
Loop && Saltear comentarios
|
|
|
|
Case Left( tcLine, Len(C_MENUCODE_F) ) == C_MENUCODE_F
|
|
Exit
|
|
|
|
Case Left( tcLine, Len(C_MENUCODE_I) ) == C_MENUCODE_I
|
|
loReg.ObjType = C_OBJTYPE_MENUTYPE_BARorPOPUP
|
|
loReg.OBJCODE = C_OBJCODE_MENUBARPOPUP_MENUBAR
|
|
|
|
Case .analyzeCodeBlock_DefinePAD( @tcLine, @taCodeLines, @m.I, tnCodeLines, toConversor )
|
|
If loReg.Prompt == ''
|
|
*-- Esta opción no corresponde a este nivel. Debe subir.
|
|
llBloqueEncontrado = .F.
|
|
Exit
|
|
Endif
|
|
If loReg.OBJCODE <> C_OBJCODE_MENUOPTION_SUBMENU
|
|
Exit
|
|
Endif
|
|
|
|
Case .analyzeCodeBlock_DefineBAR( @tcLine, @taCodeLines, @m.I, tnCodeLines, toConversor )
|
|
If loReg.Prompt == ''
|
|
*-- Esta opción no corresponde a este nivel. Debe subir.
|
|
llBloqueEncontrado = .F.
|
|
Exit
|
|
Endif
|
|
If loReg.OBJCODE <> C_OBJCODE_MENUOPTION_SUBMENU
|
|
Exit
|
|
Endif
|
|
|
|
Case Left( tcLine, 13 ) == 'DEFINE POPUP '
|
|
loBarPop = Null
|
|
loBarPop = Createobject("CL_MENU_BARPOP")
|
|
lnLast_I = m.I
|
|
loBarPop.c_ParentName = loReg.LevelName
|
|
loBarPop.n_ParentCode = loReg.OBJCODE
|
|
loBarPop.n_ParentType = loReg.ObjType
|
|
.Add( loBarPop )
|
|
If Not loBarPop.analyzeCodeBlock( @tcLine, @taCodeLines, @m.I, tnCodeLines, toConversor )
|
|
I = m.I - 1
|
|
Endif
|
|
loBarPop = Null
|
|
Exit
|
|
|
|
Otherwise && Otro valor
|
|
I = m.I - 1
|
|
Exit
|
|
Endcase
|
|
Endfor
|
|
Endwith && THIS
|
|
|
|
|
|
Catch To loEx When loEx.Message = 'Nivel_Anterior'
|
|
*-- OK. Volver a evaluar en el nivel anterior
|
|
llBloqueEncontrado = .F.
|
|
|
|
Catch To loEx
|
|
If This.n_Debug > 0 And _vfp.StartMode = 0
|
|
Set Step On
|
|
Endif
|
|
|
|
Throw
|
|
|
|
Finally
|
|
Store Null To loBarPop
|
|
Release lcComment, loReg, lnLast_I, llPadOBar_Analizado, loBarPop
|
|
Endtry
|
|
|
|
Return llBloqueEncontrado
|
|
Endproc
|
|
|
|
|
|
Procedure analyzeCodeBlock_DefinePAD
|
|
*---------------------------------------------------------------------------------------------------
|
|
* PARÁMETROS: (v=Pasar por valor | @=Pasar por referencia) (!=Obligatorio | ?=Opcional) (IN/OUT)
|
|
* tcLine (!@ IN/OUT) Contenido de la línea en análisis
|
|
* taCodeLines (!@ IN ) Array de líneas del programa analizado
|
|
* I (!@ IN/OUT) Número de línea en análisis
|
|
* tnCodeLines (!@ IN ) Cantidad de líneas del programa analizado
|
|
* toConversor (v! IN ) Referencia al conversor para poder usar sus métodos
|
|
*---------------------------------------------------------------------------------------------------
|
|
Lparameters tcLine, taCodeLines, I, tnCodeLines, toConversor
|
|
|
|
#If .F.
|
|
Local toConversor As c_conversor_prg_a_mnx Of 'FOXBIN2PRG.PRG'
|
|
#Endif
|
|
|
|
Try
|
|
Local llBloqueEncontrado, lcText, loReg, lnPos, lcPadName, lcExpr, lcComment, lcProcName, lcProcCode, loEx As Exception ;
|
|
, lnNegContainer, lnNegObject
|
|
Store Null To loReg
|
|
Store '' To lcText, lcComment, lcPadName
|
|
|
|
* Estructura ejemplo a analizar:
|
|
*--------------------------------
|
|
* DEFINE PAD _3YM1DR90Z OF _MSYSMENU PROMPT "Opción A con submenú" COLOR SCHEME 3 ;
|
|
* NEGOTIATE NONE, LEFT ;
|
|
* KEY DEL, "Pulsar <DEL>" ;
|
|
* SKIP FOR SKIP_FOR() ;
|
|
* MESSAGE "Mensaje para Opción A con submenú" && Comentario
|
|
*
|
|
* ON PAD _3YM1DR90Z OF _MSYSMENU ACTIVATE POPUP OpciónA_CS
|
|
*--------------------------------
|
|
If Left( tcLine, 11 ) == 'DEFINE PAD '
|
|
llBloqueEncontrado = .T.
|
|
|
|
With This As CL_MENU_OPTION Of 'FOXBIN2PRG.PRG'
|
|
loReg = .oReg
|
|
loReg.ObjType = C_OBJTYPE_MENUTYPE_OPTION
|
|
lcPadName = Alltrim( Strextract( tcLine, 'PAD ' , ' OF' ) )
|
|
loReg.Name = lcPadName
|
|
loReg.LevelName = Alltrim( Strextract( tcLine, ' OF ', ' PROMPT ' ) )
|
|
|
|
If Upper(loReg.LevelName) # Upper(.c_ParentName)
|
|
Exit
|
|
Endif
|
|
|
|
loReg.Prompt = Alltrim( Strextract( tcLine, ' PROMPT ', ' COLOR ' ) )
|
|
loReg.Prompt = Substr( loReg.Prompt, 2, Len( loReg.Prompt ) - 2 )
|
|
|
|
*-- ANALISIS DEL "DEFINE PAD"
|
|
Do Case
|
|
Case ';' $ tcLine
|
|
For I = m.I + 1 To tnCodeLines
|
|
.set_Line( @tcLine, @taCodeLines, m.I )
|
|
|
|
If Empty(loReg.Comment) && No volver a buscar el comentario si ya existe
|
|
*-- Busco si tiene comentario
|
|
If .get_SeparatedLineAndComment( @tcLine, @lcComment )
|
|
loReg.Comment = Strtran( Strtran( lcComment, '<CR>', Chr(13) ), '<LF>', Chr(10) )
|
|
Endif
|
|
Endif
|
|
|
|
Do Case
|
|
Case Left( tcLine, 10 ) == 'NEGOTIATE '
|
|
lcExpr = Alltrim( Strextract( tcLine, 'NEGOTIATE ', ';', 1, 2 ) )
|
|
lnNegContainer = Int( At( ',' + Padr( Alltrim(Getwordnum( lcExpr, 1, ',' )), 6, '_' ) ;
|
|
, '______,NONE__,LEFT__,MIDDLE,RIGHT_' ) / 7 - 1 )
|
|
lnNegObject = Int( At( ',' + Padr( Alltrim(Getwordnum( lcExpr, 2, ',' )), 6, '_' ) ;
|
|
, '______,NONE__,LEFT__,MIDDLE,RIGHT_' ) / 7 - 1 )
|
|
loReg.Location = lnNegContainer + lnNegObject * 2^4
|
|
|
|
Case Left( tcLine, 4 ) == 'KEY '
|
|
lcExpr = Alltrim( Strextract( tcLine, 'KEY ', ';', 1, 2 ) )
|
|
lnPos = At( ',', lcExpr )
|
|
loReg.KEYNAME = Alltrim( Left( lcExpr, lnPos-1 ) )
|
|
loReg.KeyLabel = Alltrim( Strextract( lcExpr, '"', '"' ) )
|
|
|
|
Case Left( tcLine, 9 ) == 'SKIP FOR '
|
|
loReg.SkipFor = Alltrim( Strextract( tcLine, 'SKIP FOR ', ';', 1, 2 ) )
|
|
|
|
Case Left( tcLine, 8 ) == 'MESSAGE '
|
|
loReg.Message = Alltrim( Substr( tcLine, 9 ) )
|
|
|
|
Case Left( tcLine, 8 ) == 'PICTURE '
|
|
loReg.RESNAME = Alltrim( Strextract( tcLine, '"', '"' ) )
|
|
|
|
Case Left( tcLine, 8 ) == 'PICTRES '
|
|
loReg.RESNAME = Alltrim( Strextract( tcLine, 'PICTRES ', ';', 1, 2 ) )
|
|
loReg.SYSRES = 1
|
|
|
|
Otherwise
|
|
* Nada
|
|
Endcase
|
|
|
|
If Not ';' $ tcLine && Fin
|
|
Exit
|
|
Endif
|
|
Endfor
|
|
|
|
Case .set_Line( @tcLine, @taCodeLines, m.I ) And .get_SeparatedLineAndComment( @tcLine, @lcComment )
|
|
*-- Es un Bar de una sola línea y con comentarios
|
|
loReg.Comment = Strtran( Strtran( lcComment, '<CR>', Chr(13) ), '<LF>', Chr(10) )
|
|
|
|
Endcase
|
|
|
|
|
|
* Estructuras ejemplo a analizar:
|
|
*--------------------------------
|
|
* ON PAD _3YM1DR90Z OF _MSYSMENU ACTIVATE POPUP OpciónA_CS
|
|
* ON PAD _3YM1DR90Z OF _MSYSMENU wait window "algo"
|
|
* ON PAD _3YM1DR90Z OF _MSYSMENU DO Menu1_Opción_A_2_Sub_SNIPPET
|
|
*--------------------------------
|
|
|
|
*-- ANALISIS DEL "ON PAD" u "ON SELECTION PAD"
|
|
For I = m.I + 1 To tnCodeLines
|
|
.set_Line( @tcLine, @taCodeLines, m.I )
|
|
|
|
Do Case
|
|
Case Empty( tcLine )
|
|
Loop
|
|
|
|
Case Left( tcLine, 7 ) == 'ON PAD '
|
|
loReg.OBJCODE = C_OBJCODE_MENUOPTION_SUBMENU && Submenu
|
|
|
|
I = m.I + 1
|
|
Exit
|
|
|
|
Case Left( tcLine, 17 ) == 'ON SELECTION PAD '
|
|
lcExpr = Alltrim( Strextract( tcLine, ' OF ' + loReg.LevelName + ' ', '', 1, 2 ) )
|
|
.AnalizarSiExpresionEsComandoOProcedimiento( lcExpr, @lcProcName, @lcProcCode, @C_FB2PRG_CODE, -1, .F. )
|
|
|
|
Do Case
|
|
Case Empty(lcProcCode)
|
|
loReg.OBJCODE = C_OBJCODE_MENUOPTION_COMMAND
|
|
loReg.Command = lcExpr
|
|
|
|
Otherwise
|
|
loReg.Procedure = Strtran( lcProcCode, '<<ProcName>>', lcProcName )
|
|
|
|
If Empty( loReg.Procedure )
|
|
loReg.OBJCODE = C_OBJCODE_MENUOPTION_COMMAND
|
|
loReg.Command = lcExpr
|
|
Else
|
|
loReg.OBJCODE = C_OBJCODE_MENUOPTION_PROCEDURE
|
|
loReg.ProcType = 1
|
|
Endif
|
|
|
|
Endcase
|
|
|
|
I = m.I + 1
|
|
Exit
|
|
|
|
Otherwise
|
|
* Nada
|
|
Endcase
|
|
|
|
If Not ';' $ tcLine && Fin
|
|
I = m.I + 1
|
|
Exit
|
|
Endif
|
|
Endfor
|
|
|
|
I = m.I - 1
|
|
Endwith && THIS
|
|
Endif
|
|
|
|
|
|
Catch To loEx
|
|
If This.n_Debug > 0 And _vfp.StartMode = 0
|
|
Set Step On
|
|
Endif
|
|
|
|
Throw
|
|
|
|
Finally
|
|
Store Null To loReg
|
|
Release tcLine, taCodeLines, I, tnCodeLines, toConversor ;
|
|
, lcText, loReg, lnPos, lcPadName, lcExpr, lcComment, lcProcName, lcProcCode, lnNegContainer, lnNegObject
|
|
|
|
Endtry
|
|
|
|
Return llBloqueEncontrado
|
|
Endproc
|
|
|
|
|
|
Procedure analyzeCodeBlock_DefineBAR
|
|
*---------------------------------------------------------------------------------------------------
|
|
* PARÁMETROS: (v=Pasar por valor | @=Pasar por referencia) (!=Obligatorio | ?=Opcional) (IN/OUT)
|
|
* tcLine (!@ IN/OUT) Contenido de la línea en análisis
|
|
* taCodeLines (!@ IN ) Array de líneas del programa analizado
|
|
* I (!@ IN/OUT) Número de línea en análisis
|
|
* tnCodeLines (!@ IN ) Cantidad de líneas del programa analizado
|
|
* toConversor (v! IN ) Referencia al conversor para poder usar sus métodos
|
|
*---------------------------------------------------------------------------------------------------
|
|
Lparameters tcLine, taCodeLines, I, tnCodeLines, toConversor
|
|
|
|
#If .F.
|
|
Local toConversor As c_conversor_prg_a_mnx Of 'FOXBIN2PRG.PRG'
|
|
#Endif
|
|
|
|
Try
|
|
Local llBloqueEncontrado, lcText, loReg, lnPos, lcBarName, lcExpr, lcComment, lcProcName, lcProcCode, loEx As Exception ;
|
|
, lnNegContainer, lnNegObject
|
|
Store '' To lcText, lcComment, lcBarName
|
|
|
|
* Estructura ejemplo a analizar:
|
|
*--------------------------------
|
|
* DEFINE BAR _3YM1DR90Z OF _MSYSMENU PROMPT "Opción A con submenú" COLOR SCHEME 3 ;
|
|
* NEGOTIATE NONE, LEFT ;
|
|
* KEY DEL, "Pulsar <DEL>" ;
|
|
* SKIP FOR SKIP_FOR() ;
|
|
* MESSAGE "Mensaje para Opción A con submenú" && Comentario
|
|
*
|
|
* ON BAR _3YM1DR90Z OF _MSYSMENU ACTIVATE POPUP OpciónA_CS
|
|
*
|
|
* DEFINE BAR 1 OF _MSYSMENU PROMPT "Opción A con submenú" ;
|
|
* NEGOTIATE NONE, LEFT ;
|
|
* KEY DEL, "Pulsar <DEL>" ;
|
|
* SKIP FOR SKIP_FOR() ;
|
|
* MESSAGE "Mensaje para Opción A con submenú" && Comentario
|
|
*
|
|
* ON BAR 1 OF _MSYSMENU ACTIVATE POPUP OpciónA_CS
|
|
*--------------------------------
|
|
If Left( tcLine, 11 ) == 'DEFINE BAR '
|
|
llBloqueEncontrado = .T.
|
|
|
|
With This As CL_MENU_OPTION Of 'FOXBIN2PRG.PRG'
|
|
loReg = .oReg
|
|
loReg.ObjType = C_OBJTYPE_MENUTYPE_OPTION
|
|
lcBarName = Alltrim( Strextract( tcLine, 'BAR ' , ' OF' ) )
|
|
|
|
If Isdigit(lcBarName)
|
|
*-- Bar#
|
|
loReg.OBJCODE = C_OBJCODE_MENUOPTION_BARNUM
|
|
Else
|
|
*-- Es un BAR del sistema
|
|
loReg.Name = lcBarName
|
|
Endif
|
|
|
|
loReg.LevelName = Alltrim( Strextract( tcLine, ' OF ', ' PROMPT ' ) )
|
|
|
|
If Upper(loReg.LevelName) # Upper(.c_ParentName)
|
|
Exit
|
|
Endif
|
|
|
|
loReg.Prompt = Alltrim( Strextract( tcLine, ' PROMPT ', ';', 1, 2 ) )
|
|
loReg.Prompt = Substr( loReg.Prompt, 2, Len( loReg.Prompt ) - 2 )
|
|
|
|
*-- ANALISIS DEL "DEFINE BAR"
|
|
Do Case
|
|
Case ';' $ tcLine
|
|
For I = m.I + 1 To tnCodeLines
|
|
.set_Line( @tcLine, @taCodeLines, m.I )
|
|
|
|
If Empty(loReg.Comment) && No volver a buscar el comentario si ya existe
|
|
*-- Busco si tiene comentario
|
|
If .get_SeparatedLineAndComment( @tcLine, @lcComment )
|
|
loReg.Comment = Strtran( Strtran( lcComment, '<CR>', Chr(13) ), '<LF>', Chr(10) )
|
|
Endif
|
|
Endif
|
|
|
|
Do Case
|
|
Case Left( tcLine, 10 ) == 'NEGOTIATE '
|
|
lcExpr = Alltrim( Strextract( tcLine, 'NEGOTIATE ', ';', 1, 2 ) )
|
|
lnNegContainer = Int( At( ',' + Padr( Alltrim(Getwordnum( lcExpr, 1, ',' )), 6, '_' ) ;
|
|
, '______,NONE__,LEFT__,MIDDLE,RIGHT_' ) / 7 - 1 )
|
|
lnNegObject = Int( At( ',' + Padr( Alltrim(Getwordnum( lcExpr, 2, ',' )), 6, '_' ) ;
|
|
, '______,NONE__,LEFT__,MIDDLE,RIGHT_' ) / 7 - 1 )
|
|
loReg.Location = lnNegContainer + lnNegObject * 2^4
|
|
|
|
Case Left( tcLine, 4 ) == 'KEY '
|
|
lcExpr = Alltrim( Strextract( tcLine, 'KEY ', ';', 1, 2 ) )
|
|
lnPos = At( ',', lcExpr )
|
|
loReg.KEYNAME = Alltrim( Left( lcExpr, lnPos-1 ) )
|
|
loReg.KeyLabel = Alltrim( Strextract( lcExpr, '"', '"' ) )
|
|
|
|
Case Left( tcLine, 9 ) == 'SKIP FOR '
|
|
loReg.SkipFor = Alltrim( Strextract( tcLine, 'SKIP FOR ', ';', 1, 2 ) )
|
|
|
|
Case Left( tcLine, 8 ) == 'MESSAGE '
|
|
loReg.Message = Alltrim( Substr( tcLine, 9 ) )
|
|
|
|
Case Left( tcLine, 8 ) == 'PICTURE '
|
|
loReg.RESNAME = Alltrim( Strextract( tcLine, '"', '"' ) )
|
|
|
|
Case Left( tcLine, 8 ) == 'PICTRES '
|
|
loReg.RESNAME = Alltrim( Strextract( tcLine, 'PICTRES ', ';', 1, 2 ) )
|
|
loReg.SYSRES = 1
|
|
|
|
Otherwise
|
|
* Nada
|
|
Endcase
|
|
|
|
If Not ';' $ tcLine && Fin
|
|
Exit
|
|
Endif
|
|
Endfor
|
|
|
|
Case .set_Line( @tcLine, @taCodeLines, m.I ) And .get_SeparatedLineAndComment( @tcLine, @lcComment )
|
|
*-- Es un Bar de una sola línea y con comentarios
|
|
loReg.Comment = Strtran( Strtran( lcComment, '<CR>', Chr(13) ), '<LF>', Chr(10) )
|
|
|
|
Endcase
|
|
|
|
If Left(lcBarName,1) == '_'
|
|
*-- Es un BAR del Sistema, así que no tiene ON BAR ni nada más.
|
|
loReg.OBJCODE = C_OBJCODE_MENUOPTION_BARNUM && Bar#
|
|
I = m.I + 1
|
|
Exit
|
|
Endif
|
|
|
|
|
|
* Estructuras ejemplo a analizar:
|
|
*--------------------------------
|
|
* ON BAR _3YM1DR90Z OF _MSYSMENU ACTIVATE POPUP OpciónA_CS
|
|
* ON BAR _3YM1DR90Z OF _MSYSMENU wait window "algo"
|
|
* ON BAR _3YM1DR90Z OF _MSYSMENU DO Menu1_Opción_A_2_Sub_SNIPPET
|
|
* ON SELECTION BAR 1 OF Contracts DO BAR_1_OF_Contracts_FB2P
|
|
*--------------------------------
|
|
|
|
*-- ANALISIS DEL "ON BAR" U "ON SELECTION BAR"
|
|
For I = m.I + 1 To tnCodeLines
|
|
.set_Line( @tcLine, @taCodeLines, m.I )
|
|
|
|
Do Case
|
|
Case Empty( tcLine )
|
|
Loop
|
|
|
|
Case Inlist( Left( tcLine, 11 ), 'DEFINE BAR ', 'DEFINE PAD ' )
|
|
*-- Se encontró el siguiente DEFINE BAR/PAD, por lo que el analizado es de tipo #BAR vacío
|
|
*-- y no tiene ON BAR ni nada más.
|
|
loReg.OBJCODE = C_OBJCODE_MENUOPTION_BARNUM && Bar#
|
|
Exit
|
|
|
|
Case Left( tcLine, 7 ) == 'ON BAR '
|
|
loReg.OBJCODE = C_OBJCODE_MENUOPTION_SUBMENU && Submenu
|
|
|
|
I = m.I + 1
|
|
Exit
|
|
|
|
Case Left( tcLine, 17 ) == 'ON SELECTION BAR '
|
|
lcExpr = Alltrim( Strextract( tcLine, ' OF ' + loReg.LevelName + ' ', '', 1, 2 ) )
|
|
.AnalizarSiExpresionEsComandoOProcedimiento( lcExpr, @lcProcName, @lcProcCode, @C_FB2PRG_CODE, -1, .F. )
|
|
|
|
Do Case
|
|
Case Not Empty(lcProcCode)
|
|
loReg.Procedure = Strtran( lcProcCode, '<<ProcName>>', lcProcName )
|
|
|
|
If Empty( loReg.Procedure )
|
|
loReg.OBJCODE = C_OBJCODE_MENUOPTION_COMMAND
|
|
loReg.Command = lcExpr
|
|
Else
|
|
loReg.OBJCODE = C_OBJCODE_MENUOPTION_PROCEDURE
|
|
loReg.ProcType = 1
|
|
Endif
|
|
|
|
Otherwise
|
|
loReg.OBJCODE = C_OBJCODE_MENUOPTION_COMMAND && Command
|
|
loReg.Command = lcExpr
|
|
|
|
Endcase
|
|
|
|
I = m.I + 1
|
|
Exit
|
|
|
|
Case Left( tcLine, 19 ) == 'ON SELECTION POPUP '
|
|
Exit
|
|
|
|
Otherwise
|
|
* Nada
|
|
Endcase
|
|
|
|
If Not ';' $ tcLine && Fin
|
|
I = m.I + 1
|
|
Exit
|
|
Endif
|
|
Endfor
|
|
Endwith && THIS
|
|
|
|
I = m.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 toText
|
|
*---------------------------------------------------------------------------------------------------
|
|
* PARÁMETROS: (v=Pasar por valor | @=Pasar por referencia) (!=Obligatorio | ?=Opcional) (IN/OUT)
|
|
* toParentReg (v? IN ) Objeto registro Padre
|
|
* tnNivel (v? IN ) Nivel para indentar
|
|
* tcEndProcedures (!@ OUT) Agregar aquí los procedimientos que irán al final
|
|
* toHeader (v! IN ) Objeto Registro de cabecera del menu
|
|
*---------------------------------------------------------------------------------------------------
|
|
Lparameters toParentReg, tnNivel, tcEndProcedures, toHeader
|
|
|
|
Try
|
|
Local loReg, I, lcText, lcTab, lcExpr, lcProcName, lcProcCode, loEx As Exception ;
|
|
, loBarPop As CL_MENU_BARPOP Of 'FOXBIN2PRG.PRG' ;
|
|
, loOption As CL_MENU_OPTION Of 'FOXBIN2PRG.PRG'
|
|
Store Null To loOption, loBarPop, loReg
|
|
lcText = ''
|
|
lcProcName = ''
|
|
|
|
With This As CL_MENU_OPTION Of 'FOXBIN2PRG.PRG'
|
|
loReg = .oReg
|
|
lcTab = Replicate(Chr(9),tnNivel)
|
|
loBarPop = toParentReg
|
|
|
|
*-- Options (ObjType:3 = C_OBJTYPE_MENUTYPE_OPTION)
|
|
Do Case
|
|
Case toParentReg.ObjType = C_OBJTYPE_MENUTYPE_BARorPOPUP And toParentReg.OBJCODE = C_OBJCODE_MENUBARPOPUP_MENUPAD
|
|
*-- Define Bar
|
|
TEXT TO lcText ADDITIVE TEXTMERGE NOSHOW FLAGS 1+2 PRETEXT 1+2
|
|
<<.get_DefineBarText(loReg, loBarPop, tnNivel, toHeader)>>
|
|
ENDTEXT
|
|
|
|
Case toParentReg.ObjType = C_OBJTYPE_MENUTYPE_BARorPOPUP And toParentReg.OBJCODE = C_OBJCODE_MENUBARPOPUP_MENUBAR ;
|
|
AND (toHeader.ObjType = C_OBJTYPE_MENUTYPE_DEFAULT Or toHeader.ObjType = C_OBJTYPE_MENUTYPE_MENUBARONTOP)
|
|
*-- Define Pad
|
|
TEXT TO lcText ADDITIVE TEXTMERGE NOSHOW FLAGS 1+2 PRETEXT 1+2
|
|
<<.get_DefinePadText(loReg, loBarPop, tnNivel, toHeader)>>
|
|
ENDTEXT
|
|
|
|
Endcase
|
|
|
|
If loReg.OBJCODE = C_OBJCODE_MENUOPTION_PROCEDURE && Procedure de BAR o PAD
|
|
*-- Reemplazo el nombre definitivo
|
|
lcExpr = loReg.Procedure
|
|
.AnalizarSiExpresionEsComandoOProcedimiento( lcExpr, @lcProcName, @lcProcCode, '', 1, .T., .T. )
|
|
|
|
If Empty(lcProcCode)
|
|
*-- Comando
|
|
If Empty(lcExpr)
|
|
lcText = Strtran( lcText, 'DO <<ProcName>>', '' )
|
|
Else
|
|
lcText = Strtran( lcText, 'DO <<ProcName>>', lcExpr )
|
|
Endif
|
|
Else
|
|
|
|
*-- Procedure
|
|
If Empty(lcProcName)
|
|
lcProcName = Chrtran( Alltrim( Strextract( lcText, 'DEFINE ', 'PROMPT ' ) ), ' ', '_' ) + '_FB2P'
|
|
Endif
|
|
lcProcCode = Strtran( lcProcCode, '<<ProcName>>', lcProcName )
|
|
lcText = Strtran( lcText, '<<ProcName>>', lcProcName )
|
|
tcEndProcedures = tcEndProcedures + lcProcCode + CR_LF
|
|
Endif
|
|
Endif
|
|
|
|
|
|
*-- Menu Bar or Popup (ObjType:2 [C_OBJTYPE_MENUTYPE_BARorPOPUP], ObjCode:0 ó 1 [C_OBJCODE_MENUBARPOPUP_MENUPAD o C_OBJCODE_MENUBARPOPUP_MENUBAR])
|
|
If .Count > 0
|
|
For Each loBarPop In This FoxObject
|
|
If toParentReg.ObjType = C_OBJTYPE_MENUTYPE_BARorPOPUP ;
|
|
AND toParentReg.OBJCODE = C_OBJCODE_MENUBARPOPUP_MENUBAR ;
|
|
AND toHeader.ObjType = C_OBJTYPE_MENUTYPE_SHORTCUT
|
|
*-- Shortcut
|
|
lcText = lcText + loBarPop.toText(loReg, tnNivel + 0, @tcEndProcedures, toHeader)
|
|
Else
|
|
*-- Menu
|
|
lcText = lcText + loBarPop.toText(loReg, tnNivel + 1, @tcEndProcedures, toHeader)
|
|
Endif
|
|
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 loOption, loBarPop, loReg
|
|
Release loReg, I, lcTab, lcExpr, lcProcName, lcProcCode, loBarPop, loOption
|
|
|
|
Endtry
|
|
|
|
Return lcText
|
|
Endproc
|
|
|
|
|
|
Procedure get_DefineBarText
|
|
*---------------------------------------------------------------------------------------------------
|
|
* PARÁMETROS: (v=Pasar por valor | @=Pasar por referencia) (!=Obligatorio | ?=Opcional) (IN/OUT)
|
|
* toReg (v? IN ) Objeto registro
|
|
* toBarPop (v? IN ) Bar o Popup hijo
|
|
* tnNivel (v? IN ) Nivel para indentar
|
|
* toHeader (v! IN ) Objeto Registro de cabecera del menu
|
|
*---------------------------------------------------------------------------------------------------
|
|
Lparameters toReg, toBarPop, tnNivel, toHeader
|
|
|
|
Try
|
|
Local lcText, lcTab, loEx As Exception ;
|
|
, loBarPop As CL_MENU_BARPOP Of 'FOXBIN2PRG.PRG'
|
|
Store Null To loBarPop
|
|
lcTab = Replicate(Chr(9),tnNivel)
|
|
lcText = ''
|
|
|
|
*-- DEFINE BAR
|
|
*lcText = lcTab + '*----------------------------------' + CR_LF
|
|
lcText = lcText + lcTab + 'DEFINE BAR ' + Alltrim( Evl( toReg.Name, toReg.ItemNum ) ) + ' OF ' + Alltrim(toReg.LevelName) ;
|
|
+ ' PROMPT "' + toReg.Prompt + '"'
|
|
|
|
If Not Empty(toReg.KEYNAME)
|
|
lcText = lcText + ' ;' + CR_LF + lcTab + ' KEY ' + toReg.KEYNAME + ', "' + toReg.KeyLabel + '"'
|
|
Endif
|
|
|
|
If Not Empty(toReg.SkipFor)
|
|
lcText = lcText + ' ;' + CR_LF + lcTab + ' SKIP FOR ' + toReg.SkipFor
|
|
Endif
|
|
|
|
If Not Empty(toReg.RESNAME)
|
|
If toReg.SYSRES = 1
|
|
lcText = lcText + ' ;' + CR_LF + lcTab + ' PICTRES ' + toReg.RESNAME
|
|
Else
|
|
lcText = lcText + ' ;' + CR_LF + lcTab + ' PICTURE "' + toReg.RESNAME + '"'
|
|
Endif
|
|
Endif
|
|
|
|
If Not Empty(toReg.Message)
|
|
lcText = lcText + ' ;' + CR_LF + lcTab + ' MESSAGE ' + toReg.Message
|
|
Endif
|
|
|
|
If Not Empty(toReg.Comment)
|
|
lcText = lcText + ' &' + '& ' + Strtran( Strtran( toReg.Comment, Chr(13), '<CR>' ), Chr(10), '<LF>' )
|
|
Endif
|
|
|
|
*-- ON BAR
|
|
If toReg.OBJCODE <> C_OBJCODE_MENUOPTION_BARNUM && Bar#
|
|
lcText = lcText + CR_LF
|
|
|
|
If toReg.OBJCODE = C_OBJCODE_MENUOPTION_SUBMENU && Submenu
|
|
loBarPop = This.Item(1).oReg
|
|
lcText = lcText + lcTab + 'ON BAR ' + Alltrim( Evl( toReg.Name, toReg.ItemNum ) ) + ' OF ' + Alltrim(toReg.LevelName) ;
|
|
+ ' ACTIVATE POPUP ' + Alltrim(loBarPop.Name)
|
|
Else
|
|
lcText = lcText + lcTab + 'ON SELECTION BAR ' + Alltrim( Evl( toReg.Name, toReg.ItemNum ) ) + ' OF ' + Alltrim(toReg.LevelName)
|
|
|
|
Do Case
|
|
Case toReg.OBJCODE = C_OBJCODE_MENUOPTION_COMMAND && Command
|
|
If Not Empty(toReg.Command)
|
|
lcText = lcText + ' ' + Alltrim(toReg.Command)
|
|
Endif
|
|
Case toReg.OBJCODE = C_OBJCODE_MENUOPTION_PROCEDURE && Procedure
|
|
If Not Empty(toReg.Procedure)
|
|
lcText = lcText + ' DO <<ProcName>>'
|
|
Endif
|
|
Endcase
|
|
Endif
|
|
Endif
|
|
|
|
lcText = lcText + CR_LF
|
|
|
|
Catch To loEx
|
|
If This.n_Debug > 0 And _vfp.StartMode = 0
|
|
Set Step On
|
|
Endif
|
|
|
|
Throw
|
|
|
|
Finally
|
|
Store Null To loBarPop
|
|
Release lcTab, loBarPop
|
|
|
|
Endtry
|
|
|
|
Return lcText
|
|
Endproc
|
|
|
|
|
|
Procedure get_DefinePadText
|
|
*---------------------------------------------------------------------------------------------------
|
|
* PARÁMETROS: (v=Pasar por valor | @=Pasar por referencia) (!=Obligatorio | ?=Opcional) (IN/OUT)
|
|
* toReg (v? IN ) Objeto registro
|
|
* toBarPop (v? IN ) Bar o Popup hijo
|
|
* tnNivel (v? IN ) Nivel para indentar
|
|
* toHeader (v! IN ) Objeto Registro de cabecera del menu
|
|
*---------------------------------------------------------------------------------------------------
|
|
Lparameters toReg, toBarPop, tnNivel, toHeader
|
|
|
|
Try
|
|
Local lcText, lcTab, lnContainer, lnObject, loEx As Exception ;
|
|
, loBarPop As CL_MENU_BARPOP Of 'FOXBIN2PRG.PRG'
|
|
Store Null To loBarPop
|
|
lcTab = Replicate(Chr(9),tnNivel)
|
|
toReg.Name = Evl(toReg.Name, '_' + Transform( Int( Val( toReg.ItemNum ) ), '@L #########') )
|
|
lcText = ''
|
|
|
|
*-- DEFINE PAD
|
|
*lcText = lcTab + '*----------------------------------' + CR_LF
|
|
lcText = lcText + lcTab + 'DEFINE PAD ' + Alltrim(toReg.Name) + ' OF ' + Alltrim(toReg.LevelName) ;
|
|
+ ' PROMPT "' + toReg.Prompt + '"' ;
|
|
+ ' COLOR SCHEME ' + Transform(toBarPop.Scheme)
|
|
|
|
If Not Empty(toReg.Location)
|
|
lnContainer = toReg.Location % 2^4
|
|
lnObject = Int( (toReg.Location - lnContainer) / 2^4 )
|
|
lcText = lcText + ' ;' + CR_LF + lcTab + ' NEGOTIATE ' + Getwordnum('NONE,LEFT,MIDDLE,RIGHT',lnContainer+1,',') ;
|
|
+ ', ' + Getwordnum('NONE,LEFT,MIDDLE,RIGHT',lnObject+1,',')
|
|
Endif
|
|
|
|
If Not Empty(toReg.KEYNAME)
|
|
lcText = lcText + ' ;' + CR_LF + lcTab + ' KEY ' + toReg.KEYNAME + ', "' + toReg.KeyLabel + '"'
|
|
Endif
|
|
|
|
If Not Empty(toReg.SkipFor)
|
|
lcText = lcText + ' ;' + CR_LF + lcTab + ' SKIP FOR ' + toReg.SkipFor
|
|
Endif
|
|
|
|
If Not Empty(toReg.RESNAME)
|
|
If toReg.SYSRES = 1
|
|
lcText = lcText + ' ;' + CR_LF + lcTab + ' PICTRES ' + toReg.RESNAME
|
|
Else
|
|
lcText = lcText + ' ;' + CR_LF + lcTab + ' PICTURE "' + toReg.RESNAME + '"'
|
|
Endif
|
|
Endif
|
|
|
|
If Not Empty(toReg.Message)
|
|
lcText = lcText + ' ;' + CR_LF + lcTab + ' MESSAGE ' + toReg.Message
|
|
Endif
|
|
|
|
If Not Empty(toReg.Comment)
|
|
lcText = lcText + ' &' + '& ' + Strtran( Strtran( toReg.Comment, Chr(13), '<CR>' ), Chr(10), '<LF>' )
|
|
Endif
|
|
|
|
lcText = lcText + CR_LF
|
|
|
|
*-- ON PAD
|
|
If toReg.OBJCODE <> C_OBJCODE_MENUOPTION_BARNUM && Bar#
|
|
lcText = lcText + CR_LF
|
|
|
|
If toReg.OBJCODE = C_OBJCODE_MENUOPTION_SUBMENU && Submenu
|
|
loBarPop = This.Item(1).oReg
|
|
lcText = lcText + lcTab + 'ON PAD ' + Alltrim(toReg.Name) + ' OF ' + Alltrim(toReg.LevelName) ;
|
|
+ ' ACTIVATE POPUP ' + Alltrim(loBarPop.Name)
|
|
Else
|
|
lcText = lcText + lcTab + 'ON SELECTION PAD ' + Alltrim(toReg.Name) + ' OF ' + Alltrim(toReg.LevelName)
|
|
|
|
Do Case
|
|
Case toReg.OBJCODE = C_OBJCODE_MENUOPTION_COMMAND && Command
|
|
If Not Empty(toReg.Command)
|
|
lcText = lcText + ' ' + Alltrim(toReg.Command)
|
|
Endif
|
|
Case toReg.OBJCODE = C_OBJCODE_MENUOPTION_PROCEDURE && Procedure
|
|
If Not Empty(toReg.Procedure)
|
|
lcText = lcText + ' DO <<ProcName>>'
|
|
Endif
|
|
Endcase
|
|
Endif
|
|
Endif
|
|
|
|
lcText = lcText + CR_LF
|
|
|
|
Catch To loEx
|
|
If This.n_Debug > 0 And _vfp.StartMode = 0
|
|
Set Step On
|
|
Endif
|
|
|
|
Throw
|
|
|
|
Finally
|
|
Store Null To loBarPop
|
|
Release lcTab, lnContainer, lnObject, loBarPop
|
|
|
|
Endtry
|
|
|
|
Return lcText
|
|
Endproc
|
|
|
|
|
|
Procedure updateMENU
|
|
Endproc
|
|
|
|
|
|
Enddefine
|
|
|
|
|
|
Define Class CL_DBF_UTILS As Session
|
|
_MemberData = [<VFPData>] ;
|
|
+ [<memberdata name="fields" display="Fields"/>] ;
|
|
+ [<memberdata name="c_backlink_dbc_name" display="c_Backlink_DBC_Name"/>] ;
|
|
+ [<memberdata name="c_filename" display="c_FileName"/>] ;
|
|
+ [<memberdata name="n_headersize" display="n_HeaderSize"/>] ;
|
|
+ [<memberdata name="n_filesize" display="n_FileSize"/>] ;
|
|
+ [<memberdata name="c_lastupdate" display="c_LastUpdate"/>] ;
|
|
+ [<memberdata name="n_debug" display="n_Debug"/>] ;
|
|
+ [<memberdata name="l_filehascdx" display="l_FileHasCDX"/>] ;
|
|
+ [<memberdata name="l_fileisdbc" display="l_FileIsDBC"/>] ;
|
|
+ [<memberdata name="l_filehasmemo" display="l_FileHasMemo"/>] ;
|
|
+ [<memberdata name="n_codepage" display="n_CodePage"/>] ;
|
|
+ [<memberdata name="c_codepagedesc" display="c_CodePageDesc"/>] ;
|
|
+ [<memberdata name="n_datarecordlength" display="n_DataRecordLength"/>] ;
|
|
+ [<memberdata name="n_fieldcount" display="n_FieldCount"/>] ;
|
|
+ [<memberdata name="n_hexfiletype" display="n_HexFileType"/>] ;
|
|
+ [<memberdata name="n_numberofrecords" display="n_NumberOfRecords"/>] ;
|
|
+ [<memberdata name="n_numberofrecordsreal" display="n_NumberOfRecordsReal"/>] ;
|
|
+ [<memberdata name="n_posoffirstdatarecord" display="n_PosOfFirstDataRecord"/>] ;
|
|
+ [<memberdata name="filetypedescription" display="fileTypeDescription"/>] ;
|
|
+ [<memberdata name="getcodepageinfo" display="getCodePageInfo"/>] ;
|
|
+ [<memberdata name="getdbfmetadata" display="getDBFmetadata"/>] ;
|
|
+ [<memberdata name="get_bintableflags" display="get_BinTableFlags"/>] ;
|
|
+ [<memberdata name="get_numtableflags" display="get_NumTableFlags"/>] ;
|
|
+ [<memberdata name="get_structure" display="get_Structure"/>] ;
|
|
+ [<memberdata name="set_bintableflags" display="set_BinTableFlags"/>] ;
|
|
+ [<memberdata name="set_numtableflags" display="set_NumTableFlags"/>] ;
|
|
+ [<memberdata name="totext" display="toText"/>] ;
|
|
+ [<memberdata name="write_dbc_backlink" display="write_DBC_BackLink"/>] ;
|
|
+ [</VFPData>]
|
|
|
|
#If .F.
|
|
Local This As CL_DBF_UTILS Of 'FOXBIN2PRG.PRG'
|
|
#Endif
|
|
|
|
n_Debug = 0
|
|
c_Backlink_DBC_Name = ''
|
|
c_FileName = ''
|
|
n_FileSize = 0
|
|
n_HeaderSize = 0
|
|
c_LastUpdate = ''
|
|
l_FileHasCDX = .F.
|
|
l_FileIsDBC = .F.
|
|
l_FileHasMemo = .F.
|
|
n_CodePage = 0
|
|
c_CodePageDesc = ''
|
|
n_DataRecordLength = 0
|
|
n_HexFileType = 0
|
|
n_FieldCount = 0
|
|
n_NumberOfRecords = 0
|
|
n_NumberOfRecordsReal = 0
|
|
n_PosOfFirstDataRecord = 0
|
|
Fields = Null
|
|
|
|
|
|
Procedure Init
|
|
This.Fields = Createobject("COLLECTION")
|
|
Endproc
|
|
|
|
|
|
Procedure getDBFmetadata
|
|
*---------------------------------------------------------------------------------------------------
|
|
* PARÁMETROS: (v=Pasar por valor | @=Pasar por referencia) (!=Obligatorio | ?=Opcional) (IN/OUT)
|
|
* tc_FileName (v! IN ) Nombre del DBF a analizar
|
|
* tn_HexFileType (@? OUT) Tipo de archivo en hexadecimal (Está detallado en la ayuda de Fox)
|
|
* tl_FileHasCDX (@? OUT) Indica si el archivo tiene CDX asociado
|
|
* tl_FileHasMemo (@? OUT) Indica si el archivo tiene archivo MEMO asociado
|
|
* tl_FileIsDBC (@? OUT) Indica si el archivo es un DBC (base de datos)
|
|
* tcDBC_Name (@? OUT) Si tiene DBC, contiene el nombre del DBC asociado
|
|
*---------------------------------------------------------------------------------------------------
|
|
Lparameters tc_FileName, tn_HexFileType, tl_FileHasCDX, tl_FileHasMemo, tl_FileIsDBC, tcDBC_Name
|
|
|
|
Try
|
|
Local lnHandle, lcStr, lnDataPos, lnFieldCount, lnVal, I, loEx As Exception ;
|
|
, lnCodePage, lcCodePageDesc, lnFileLength ;
|
|
, loField As CL_DBF_UTILS_FIELD Of 'FOXBIN2PRG.PRG'
|
|
Store Null To loField
|
|
tn_HexFileType = 0
|
|
Store '' To tcDBC_Name, lcStr
|
|
lnHandle = Fopen(tc_FileName,0)
|
|
lnFileLength = Fseek(lnHandle,0,2)
|
|
= Fseek(lnHandle,0)
|
|
|
|
If lnHandle = -1
|
|
Exit
|
|
Endif
|
|
|
|
* Bytes Description
|
|
*------------------------------------------------------ ----------- ------------------------------------------
|
|
With This As CL_DBF_UTILS Of 'FOXBIN2PRG.PRG'
|
|
.c_FileName = tc_FileName
|
|
lcStr = Fread(lnHandle,1) && 0 File type
|
|
tn_HexFileType = Evaluate( Transform(Asc(lcStr),'@0') )
|
|
|
|
Do Case
|
|
Case lnFileLength < 65
|
|
Error 15, tc_FileName + ' (FileLength < 65)'
|
|
Case .fileTypeDescription(tn_HexFileType) = 'Unknown'
|
|
Error 15, tc_FileName
|
|
Endcase
|
|
|
|
.n_HexFileType = tn_HexFileType
|
|
lcStr = Fread(lnHandle,3) && 1-3 Last update (YYMMDD)
|
|
.c_LastUpdate = Padl(Asc(Left(lcStr,1)),2,'0') + '/' + Padl(Asc(Substr(lcStr,2,1)),2,'0') + '/' + Padl(Asc(Right(lcStr,1)),2,'0')
|
|
lcStr = Fread(lnHandle,4) && 4-7 Number of records in file
|
|
.n_NumberOfRecords = CToBin(lcStr,"4RS")
|
|
lcStr = Fread(lnHandle,2) && 8-9 Position of first data record
|
|
.n_PosOfFirstDataRecord = CToBin(lcStr,"2RS")
|
|
.n_HeaderSize = Int(.n_PosOfFirstDataRecord + 1)
|
|
If Inlist(tn_HexFileType, 0x30, 0x31, 0x32) Then
|
|
.n_FieldCount = Int( (.n_PosOfFirstDataRecord - 296) / 32 ) && Visual FoxPro
|
|
Else
|
|
.n_FieldCount = Int( (.n_PosOfFirstDataRecord - 33) / 32 )
|
|
Endif
|
|
lcStr = Fread(lnHandle,2) && 10-11 Length of one data record, including delete flag
|
|
.n_DataRecordLength = CToBin(lcStr,"2RS")
|
|
lcStr = Fread(lnHandle,16) && 16-27 Reserved
|
|
lcStr = Fread(lnHandle,1) && 28 Table flags: 0x01=Has CDX, 0x02=Has Memo, 0x04=Id DBC (flags acumulativos)
|
|
.l_FileHasCDX = ( Bitand( Evaluate(Transform(Asc(lcStr),'@0')), 0x01 ) > 0 )
|
|
.l_FileHasMemo = ( Bitand( Evaluate(Transform(Asc(lcStr),'@0')), 0x02 ) > 0 )
|
|
.l_FileIsDBC = ( Bitand( Evaluate(Transform(Asc(lcStr),'@0')), 0x04 ) > 0 )
|
|
lcStr = Fread(lnHandle,1) && 29 Code page mark (0=, 2=850,3=1252)
|
|
lnVal = Evaluate( Transform(Asc(lcStr),'@0') )
|
|
.getCodePageInfo( lnVal, @lnCodePage, @lcCodePageDesc )
|
|
.n_CodePage = lnCodePage
|
|
.c_CodePageDesc = lcCodePageDesc
|
|
lcStr = Fread(lnHandle,2) && 30-31 Reserved, contains 0x00
|
|
*lcStr = FREAD(lnHandle,32 * lnFieldCount) && 32-n Field subrecords (los salteo)
|
|
*---
|
|
For I = 1 To .n_FieldCount
|
|
loField = Createobject("CL_DBF_UTILS_FIELD")
|
|
|
|
With loField As CL_DBF_UTILS_FIELD Of 'FOXBIN2PRG.PRG'
|
|
lcStr = Fread(lnHandle,11)
|
|
.FieldName = Rtrim( lcStr, 0, Chr(0), ' ' )
|
|
lcStr = Fread(lnHandle,1)
|
|
.FieldType = lcStr
|
|
lcStr = Fread(lnHandle,4)
|
|
.FieldDisplacementInRecord = CToBin(lcStr,"4RS")
|
|
lcStr = Fread(lnHandle,1)
|
|
.FieldWidth = Asc(lcStr)
|
|
lcStr = Fread(lnHandle,1)
|
|
.FieldDecimals = Asc(lcStr)
|
|
lcStr = Fread(lnHandle,1)
|
|
.FieldFlags = Asc(lcStr)
|
|
lcStr = Fread(lnHandle,4)
|
|
.NextValueForAutoInc = CToBin(lcStr,"4RS")
|
|
lcStr = Fread(lnHandle,1)
|
|
.StepForAutoInc = Asc(lcStr)
|
|
lcStr = Fread(lnHandle,8)
|
|
Endwith
|
|
|
|
.Fields.Add(loField)
|
|
loField = Null
|
|
Endfor
|
|
*---
|
|
lcStr = Fread(lnHandle,1) && n+1 Header Record Terminator (0x0D)
|
|
|
|
If Inlist(tn_HexFileType, 0x30, 0x31, 0x32) Then
|
|
lcStr = Fread(lnHandle,263) && n+2 to n+264 Backlink (relative path of an associated database (.dbc) file)
|
|
tcDBC_Name = Rtrim(lcStr,0,Chr(0)) && DBC Name (si tiene)
|
|
.c_Backlink_DBC_Name = tcDBC_Name
|
|
Endif
|
|
|
|
.n_FileSize = Fseek(lnHandle, 0, 2)
|
|
.n_NumberOfRecordsReal = Int( (.n_FileSize - .n_HeaderSize) / .n_DataRecordLength )
|
|
Endwith
|
|
|
|
Catch To loEx
|
|
loEx.UserValue = loEx.UserValue + 'lcStr = [' + Transform(lcStr) + '] / LenStr = ' + Transform(Len(Transform(lcStr))) + CR_LF
|
|
If loEx.ErrorNo = 11 Then && Function argument value, type, or count is invalid
|
|
loEx.UserValue = loEx.UserValue + '> POSSIBLE CORRUPTED TABLE' + CR_LF
|
|
Endif
|
|
If This.n_Debug > 0 And _vfp.StartMode = 0
|
|
Set Step On
|
|
Endif
|
|
|
|
Throw
|
|
|
|
Finally
|
|
Fclose(lnHandle)
|
|
Store Null To loField
|
|
Release lcStr, lnDataPos, lnFieldCount, lnVal, I, lnCodePage, lcCodePageDesc, loField
|
|
|
|
Endtry
|
|
|
|
Return lnHandle
|
|
Endproc
|
|
|
|
|
|
Procedure fileTypeDescription
|
|
*---------------------------------------------------------------------------------------------------
|
|
* PARÁMETROS: (v=Pasar por valor | @=Pasar por referencia) (!=Obligatorio | ?=Opcional) (IN/OUT)
|
|
* tn_HexFileType (@? IN ) Tipo de archivo en hexadecimal (Está detallado en la ayuda de Fox)
|
|
*---------------------------------------------------------------------------------------------------
|
|
Lparameters tn_HexFileType
|
|
Local lcFileType
|
|
|
|
Do Case
|
|
Case tn_HexFileType = 0x02 && VFP 9 SP2 Help file, VFPX Edition v1.07.2 debug (beta) // http://stackoverflow.com/questions/3391525/which-header-format-can-be-assumed-by-reading-an-initial-dbf-byte
|
|
lcFileType = 'FoxBASE / dBase II'
|
|
Case tn_HexFileType = 0x03 && VFP 9 SP2 Help file, VFPX Edition v1.07.2 debug (beta) // http://stackoverflow.com/questions/3391525/which-header-format-can-be-assumed-by-reading-an-initial-dbf-byte
|
|
lcFileType = 'FoxBASE+ / FoxPro /dBase III PLUS / dBase IV, no memo'
|
|
Case tn_HexFileType = 0x05 && http://stackoverflow.com/questions/3391525/which-header-format-can-be-assumed-by-reading-an-initial-dbf-byte
|
|
lcFileType = 'dBase V, no memo'
|
|
Case tn_HexFileType = 0x2F && https://msdn.microsoft.com/en-us/subscriptions/securedownloads/st4a0s68%28v=vs.80%29
|
|
lcFileType = 'dBase+/dBase III PLUS, no memo'
|
|
Case tn_HexFileType = 0x30 && VFP 9 SP2 Help file, VFPX Edition v1.07.2 debug (beta) // http://stackoverflow.com/questions/3391525/which-header-format-can-be-assumed-by-reading-an-initial-dbf-byte
|
|
lcFileType = 'Visual FoxPro'
|
|
Case tn_HexFileType = 0x31 && VFP 9 SP2 Help file, VFPX Edition v1.07.2 debug (beta) // http://stackoverflow.com/questions/3391525/which-header-format-can-be-assumed-by-reading-an-initial-dbf-byte
|
|
lcFileType = 'Visual FoxPro, autoincrement enabled'
|
|
Case tn_HexFileType = 0x32 && VFP 9 SP2 Help file, VFPX Edition v1.07.2 debug (beta) // http://stackoverflow.com/questions/3391525/which-header-format-can-be-assumed-by-reading-an-initial-dbf-byte
|
|
lcFileType = 'Visual FoxPro, Varchar, Varbinary, or Blob-enabled'
|
|
Case tn_HexFileType = 0x43 && VFP 9 SP2 Help file, VFPX Edition v1.07.2 debug (beta) // http://stackoverflow.com/questions/3391525/which-header-format-can-be-assumed-by-reading-an-initial-dbf-byte
|
|
lcFileType = 'dBASE IV SQL table files, no memo'
|
|
Case tn_HexFileType = 0x62 && https://msdn.microsoft.com/en-us/subscriptions/securedownloads/st4a0s68%28v=vs.80%29
|
|
lcFileType = 'dBASE IV SQL table files, no memo'
|
|
Case tn_HexFileType = 0x63 && VFP 9 SP2 Help file, VFPX Edition v1.07.2 debug (beta) // http://stackoverflow.com/questions/3391525/which-header-format-can-be-assumed-by-reading-an-initial-dbf-byte
|
|
lcFileType = 'dBASE IV SQL system files, no memo'
|
|
Case tn_HexFileType = 0x7B && http://stackoverflow.com/questions/3391525/which-header-format-can-be-assumed-by-reading-an-initial-dbf-byte
|
|
lcFileType = 'dBASE IV, with memo'
|
|
Case tn_HexFileType = 0x82 && https://msdn.microsoft.com/en-us/subscriptions/securedownloads/st4a0s68%28v=vs.80%29
|
|
lcFileType = 'dBASE IV SQL system files, no memo'
|
|
Case tn_HexFileType = 0x83 && VFP 9 SP2 Help file, VFPX Edition v1.07.2 debug (beta) // http://stackoverflow.com/questions/3391525/which-header-format-can-be-assumed-by-reading-an-initial-dbf-byte
|
|
lcFileType = 'FoxBASE+/dBASE III PLUS, with memo'
|
|
Case tn_HexFileType = 0x8B && VFP 9 SP2 Help file, VFPX Edition v1.07.2 debug (beta) // http://stackoverflow.com/questions/3391525/which-header-format-can-be-assumed-by-reading-an-initial-dbf-byte
|
|
lcFileType = 'dBASE IV with memo'
|
|
Case tn_HexFileType = 0x8E && http://stackoverflow.com/questions/3391525/which-header-format-can-be-assumed-by-reading-an-initial-dbf-byte
|
|
lcFileType = 'dBASE IV with SQL table'
|
|
Case tn_HexFileType = 0xCA && https://msdn.microsoft.com/en-us/subscriptions/securedownloads/st4a0s68%28v=vs.80%29
|
|
lcFileType = 'dBASE IV with memo'
|
|
Case tn_HexFileType = 0xCB && VFP 9 SP2 Help file, VFPX Edition v1.07.2 debug (beta) // http://stackoverflow.com/questions/3391525/which-header-format-can-be-assumed-by-reading-an-initial-dbf-byte
|
|
lcFileType = 'dBASE IV SQL table files, with memo'
|
|
Case tn_HexFileType = 0xE5 && http://stackoverflow.com/questions/3391525/which-header-format-can-be-assumed-by-reading-an-initial-dbf-byte
|
|
lcFileType = 'Clipper SIX driver, with SMT memo'
|
|
Case tn_HexFileType = 0xF5 && VFP 9 SP2 Help file, VFPX Edition v1.07.2 debug (beta) // http://stackoverflow.com/questions/3391525/which-header-format-can-be-assumed-by-reading-an-initial-dbf-byte
|
|
lcFileType = 'FoxPro 2.x (or earlier) with memo'
|
|
Case tn_HexFileType = 0xFA && https://msdn.microsoft.com/en-us/subscriptions/securedownloads/st4a0s68%28v=vs.80%29
|
|
lcFileType = 'FoxPro 2.x (or earlier) with memo'
|
|
Case tn_HexFileType = 0xFB && VFP 9 SP2 Help file, VFPX Edition v1.07.2 debug (beta) // http://stackoverflow.com/questions/3391525/which-header-format-can-be-assumed-by-reading-an-initial-dbf-byte
|
|
lcFileType = 'FoxBASE (with memo?)'
|
|
Otherwise
|
|
lcFileType = 'Unknown'
|
|
Endcase
|
|
|
|
Return lcFileType
|
|
Endproc
|
|
|
|
|
|
Procedure getCodePageInfo
|
|
*---------------------------------------------------------------------------------------------------
|
|
* PARÁMETROS: (v=Pasar por valor | @=Pasar por referencia) (!=Obligatorio | ?=Opcional) (IN/OUT)
|
|
* tnHexCodePage (v! IN ) Código de página en hexadecimal (Está detallado en la ayuda de Fox)
|
|
* tnCodePage (@? OUT) Código de página normal
|
|
* tcDescrip (@? OUT) Descripción del código de página
|
|
*---------------------------------------------------------------------------------------------------
|
|
Lparameters tnHexCodePage, tnCodePage, tcDescrip
|
|
|
|
Local laCodePage(27,3), lnPos
|
|
*Code page Platform Code page identifier
|
|
laCodePage( 1,1) = 437
|
|
laCodePage( 1,2) = 'U.S. MS-DOS'
|
|
laCodePage( 1,3) = 0x01
|
|
|
|
laCodePage( 2,1) = 620
|
|
laCodePage( 2,2) = 'Mazovia (Polish) MS-DOS'
|
|
laCodePage( 2,3) = 0x69
|
|
|
|
laCodePage( 3,1) = 737
|
|
laCodePage( 3,2) = 'Greek MS-DOS (437G)'
|
|
laCodePage( 3,3) = 0x6A
|
|
|
|
laCodePage( 4,1) = 850
|
|
laCodePage( 4,2) = 'International MS-DOS'
|
|
laCodePage( 4,3) = 0x02
|
|
|
|
laCodePage( 5,1) = 852
|
|
laCodePage( 5,2) = 'Eastern European MS-DOS'
|
|
laCodePage( 5,3) = 0x64
|
|
|
|
laCodePage( 6,1) = 857
|
|
laCodePage( 6,2) = 'Turkish MS-DOS'
|
|
laCodePage( 6,3) = 0x6B
|
|
|
|
laCodePage( 7,1) = 861
|
|
laCodePage( 7,2) = 'Icelandic MS-DOS'
|
|
laCodePage( 7,3) = 0x67
|
|
|
|
laCodePage( 8,1) = 865
|
|
laCodePage( 8,2) = 'Nordic MS-DOS'
|
|
laCodePage( 8,3) = 0x66
|
|
|
|
laCodePage( 9,1) = 866
|
|
laCodePage( 9,2) = 'Russian MS-DOS'
|
|
laCodePage( 9,3) = 0x65
|
|
|
|
laCodePage(10,1) = 874
|
|
laCodePage(10,2) = 'Thai Windows'
|
|
laCodePage(10,3) = 0x7C
|
|
|
|
laCodePage(12,1) = 895
|
|
laCodePage(12,2) = 'Kamenicky (Czech) MS-DOS'
|
|
laCodePage(12,3) = 0x68
|
|
|
|
laCodePage(13,1) = 932
|
|
laCodePage(13,2) = 'Japanese Windows'
|
|
laCodePage(13,3) = 0x7B
|
|
|
|
laCodePage(14,1) = 936
|
|
laCodePage(14,2) = 'Chinese Simplified (PRC, Singapore) Windows'
|
|
laCodePage(14,3) = 0x7A
|
|
|
|
laCodePage(15,1) = 949
|
|
laCodePage(15,2) = 'Korean Windows'
|
|
laCodePage(15,3) = 0x79
|
|
|
|
laCodePage(16,1) = 950
|
|
laCodePage(16,2) = 'Traditional Chinese (Hong Kong SAR, Taiwan) Windows'
|
|
laCodePage(16,3) = 0x78
|
|
|
|
laCodePage(17,1) = 1250
|
|
laCodePage(17,2) = 'Eastern European Windows'
|
|
laCodePage(17,3) = 0xC8
|
|
|
|
laCodePage(18,1) = 1251
|
|
laCodePage(18,2) = 'Russian Windows'
|
|
laCodePage(18,3) = 0xC9
|
|
|
|
laCodePage(19,1) = 1252
|
|
laCodePage(19,2) = 'Windows ANSI'
|
|
laCodePage(19,3) = 0x03
|
|
|
|
laCodePage(20,1) = 1253
|
|
laCodePage(20,2) = 'Greek Windows'
|
|
laCodePage(20,3) = 0xCB
|
|
|
|
laCodePage(21,1) = 1254
|
|
laCodePage(21,2) = 'Turkish Windows'
|
|
laCodePage(21,3) = 0xCA
|
|
|
|
laCodePage(22,1) = 1255
|
|
laCodePage(22,2) = 'Hebrew Windows'
|
|
laCodePage(22,3) = 0x7D
|
|
|
|
laCodePage(23,1) = 1256
|
|
laCodePage(23,2) = 'Arabic Windows'
|
|
laCodePage(23,3) = 0x7E
|
|
|
|
laCodePage(24,1) = 10000
|
|
laCodePage(24,2) = 'Standard Macintosh'
|
|
laCodePage(24,3) = 0x04
|
|
|
|
laCodePage(25,1) = 10006
|
|
laCodePage(25,2) = 'Greek Macintosh'
|
|
laCodePage(25,3) = 0x98
|
|
|
|
laCodePage(26,1) = 10007
|
|
laCodePage(26,2) = 'Russian Macintosh'
|
|
laCodePage(26,3) = 0x96
|
|
|
|
laCodePage(27,1) = 10029
|
|
laCodePage(27,2) = 'Macintosh EE'
|
|
laCodePage(27,3) = 0x97
|
|
|
|
lnPos = Ascan( laCodePage, tnHexCodePage, 1, -1, 3, 8 )
|
|
|
|
If lnPos > 0
|
|
tnCodePage = laCodePage(lnPos,1)
|
|
tcDescrip = laCodePage(lnPos,2)
|
|
Else
|
|
tnCodePage = 0
|
|
tcDescrip = ''
|
|
Endif
|
|
|
|
Return
|
|
Endproc
|
|
|
|
|
|
Procedure toText
|
|
*---------------------------------------------------------------------------------------------------
|
|
* PARÁMETROS: (v=Pasar por valor | @=Pasar por referencia) (!=Obligatorio | ?=Opcional) (IN/OUT)
|
|
*---------------------------------------------------------------------------------------------------
|
|
Local lcText, loField As CL_DBF_UTILS_FIELD Of 'FOXBIN2PRG.PRG'
|
|
lcText = ''
|
|
|
|
With This As CL_DBF_UTILS Of 'FOXBIN2PRG.PRG'
|
|
TEXT TO lcText ADDITIVE TEXTMERGE NOSHOW FLAGS 1+2 PRETEXT 1+2
|
|
---------------------------------------------------
|
|
FileName : <<JUSTFNAME(.c_FileName)>>
|
|
---------------------------------------------------
|
|
Backlink_DBC_Name : <<.c_Backlink_DBC_Name>>
|
|
HexFileType : <<TRANSFORM(.n_HexFileType, '@0')>> - <<.fileTypeDescription(.n_HexFileType)>>
|
|
FileSize : <<.n_FileSize>> bytes
|
|
LastUpdate : <<.c_LastUpdate>>
|
|
NumberOfRecords : <<.n_NumberOfRecords>> - REAL: <<.n_NumberOfRecordsReal>>
|
|
PosOfFirstDataRecord : <<.n_PosOfFirstDataRecord>>
|
|
FieldCount : <<.n_FieldCount>>
|
|
DataRecordLength : <<.n_DataRecordLength>>
|
|
FileHasCDX : <<.l_FileHasCDX>>
|
|
FileHasMemo : <<.l_FileHasMemo>>
|
|
FileIsDBC : <<.l_FileIsDBC>>
|
|
CodePage : <<.n_CodePage>> - <<.c_CodePageDesc>>
|
|
|
|
---------------------------------------------------
|
|
ENDTEXT
|
|
|
|
*-- Fields
|
|
loField = .Fields.Item(1)
|
|
lcText = lcText + CR_LF + loField.toText(.T.)
|
|
|
|
For Each loField As CL_DBF_UTILS_FIELD Of 'FOXBIN2PRG.PRG' In .Fields
|
|
lcText = lcText + CR_LF + loField.toText()
|
|
Endfor
|
|
|
|
TEXT TO lcText ADDITIVE TEXTMERGE NOSHOW FLAGS 1+2 PRETEXT 1+2
|
|
|
|
---------------------------------------------------
|
|
Field flags Reference:
|
|
0x01 System Column (not visible to user)
|
|
0x02 Column can store null values
|
|
0x04 Binary column (for CHAR and MEMO only)
|
|
0x06 (0x02+0x04) When a field is NULL and binary (Integer, Currency, and Character/Memo fields)
|
|
0x0C Column is autoincrementing
|
|
|
|
ENDTEXT
|
|
|
|
Endwith
|
|
|
|
Return lcText
|
|
Endproc
|
|
|
|
|
|
Procedure write_DBC_BackLink
|
|
*---------------------------------------------------------------------------------------------------
|
|
* PARÁMETROS: (v=Pasar por valor | @=Pasar por referencia) (!=Obligatorio | ?=Opcional) (IN/OUT)
|
|
* tc_FileName (v! IN ) Nombre del DBF a analizar
|
|
* tcDBC_Name (v! IN ) Nombre del DBC a asociar
|
|
* tdLastUpdate (v! IN ) Fecha de última actualización
|
|
*---------------------------------------------------------------------------------------------------
|
|
Lparameters tc_FileName, tcDBC_Name, tdLastUpdate
|
|
|
|
Try
|
|
Local lnHandle, ln_HexFileType, lcStr, lnDataPos, lnFieldCount, loEx As Exception
|
|
|
|
tcDBC_Name = Evl(tcDBC_Name,'')
|
|
|
|
*IF NOT EMPTY(tcDBC_Name)
|
|
ln_HexFileType = 0
|
|
lnHandle = Fopen(tc_FileName,2)
|
|
|
|
If lnHandle = -1
|
|
Exit
|
|
Endif
|
|
|
|
lcStr = Fread(lnHandle,1) && File type
|
|
ln_HexFileType = Evaluate( Transform(Asc(lcStr),'@0') )
|
|
|
|
If Empty(tdLastUpdate)
|
|
lcStr = Fread(lnHandle,3) && Last update (YYMMDD)
|
|
Else
|
|
lcStr = Chr( Val( Right( Padl( Year( tdLastUpdate ),4,'0'), 2 ) ) ) ;
|
|
+ Chr( Val( Padl( Month( tdLastUpdate ),2,'0' ) ) ) ;
|
|
+ Chr( Val( Padl( Day( tdLastUpdate ),2,'0' ) ) ) && Last update (YYMMDD)
|
|
=Fwrite( lnHandle, Padr(lcStr,3,Chr(0)) )
|
|
Endif
|
|
|
|
=Fread(lnHandle,4) && Number of records in file
|
|
lcStr = Fread(lnHandle,2) && Position of first data record
|
|
lnDataPos = CToBin(lcStr,"2RS")
|
|
If Inlist(ln_HexFileType, 0x30, 0x31, 0x32) Then
|
|
lnFieldCount = (lnDataPos - 296) / 32
|
|
Else
|
|
Exit && No DBC BackLink on older versions!
|
|
Endif
|
|
=Fread(lnHandle,2) && Length of one data record, including delete flag
|
|
=Fread(lnHandle,16) && Reserved
|
|
=Fread(lnHandle,1) && Table flags: 0x01=Has CDX, 0x02=Has Memo, 0x04=Id DBC (flags acumulativos)
|
|
=Fread(lnHandle,1) && Code page mark
|
|
=Fread(lnHandle,2) && Reserved, contains 0x00
|
|
=Fread(lnHandle,32 * lnFieldCount) && Field subrecords (los salteo)
|
|
=Fread(lnHandle,1) && Header Record Terminator (0x0D)
|
|
|
|
If Inlist(ln_HexFileType, 0x30, 0x31, 0x32) Then
|
|
If Fwrite( lnHandle, Padr(tcDBC_Name,263,Chr(0)) ) = 0
|
|
*-- No se pudo actualizar el backlink [] de la tabla []
|
|
Error C_BACKLINK_CANT_UPDATE_BL_LOC + ' [' + tcDBC_Name + '] ' + C_BACKLINK_OF_TABLE_LOC + ' [' + tc_FileName + ']'
|
|
Endif
|
|
Endif
|
|
*ENDIF
|
|
|
|
|
|
Catch To loEx
|
|
If This.n_Debug > 0 And _vfp.StartMode = 0
|
|
Set Step On
|
|
Endif
|
|
|
|
Throw
|
|
|
|
Finally
|
|
Fclose(lnHandle)
|
|
Endtry
|
|
|
|
Return lnHandle
|
|
Endproc
|
|
|
|
|
|
Function get_Structure
|
|
Lparameters taFields, tc_FileName
|
|
|
|
With This As CL_DBF_UTILS Of 'lib_indices.prg'
|
|
Local lnFieldCount
|
|
lnFieldCount = 0
|
|
|
|
If Not Empty(tc_FileName)
|
|
.getDBFmetadata(tc_FileName)
|
|
Endif
|
|
|
|
lnFieldCount = .n_FieldCount
|
|
Dimension taFields(lnFieldCount,4)
|
|
|
|
For I = 1 To lnFieldCount
|
|
With .Fields.Item(m.I)
|
|
taFields(m.I,1) = .FieldName
|
|
taFields(m.I,2) = .FieldType
|
|
taFields(m.I,3) = .FieldWidth
|
|
taFields(m.I,4) = .FieldDecimals
|
|
Endwith
|
|
Endfor
|
|
Endwith
|
|
|
|
Return lnFieldCount
|
|
Endfunc
|
|
|
|
|
|
Procedure get_BinTableFlags
|
|
*-- Leo los flags de la tabla indicada
|
|
Lparameters tcFile
|
|
|
|
Local lnHandle, lcTableFlags
|
|
lnHandle = Fopen(tcFile,0)
|
|
Fseek(lnHandle,28)
|
|
lcTableFlags = Fread(lnHandle,1)
|
|
Fclose(lnHandle)
|
|
Return lcTableFlags
|
|
Endproc
|
|
|
|
|
|
Procedure get_NumTableFlags
|
|
*-- Leo los flags de la tabla indicada
|
|
Lparameters tcFile
|
|
Return Asc( This.get_BinTableFlags(tcFile) )
|
|
Endproc
|
|
|
|
|
|
Procedure set_BinTableFlags
|
|
*-- Seteo los flags en la tabla indicada
|
|
Lparameters tcFile, tcBinTableFlags
|
|
|
|
Local lnHandle, lnWritten
|
|
lnHandle = Fopen(tcFile,1)
|
|
Fseek(lnHandle,28)
|
|
lnWritten = Fwrite(lnHandle, tcTableFlags, 1)
|
|
Fclose(lnHandle)
|
|
Return lnWritten
|
|
Endproc
|
|
|
|
|
|
Procedure set_NumTableFlags
|
|
*-- Seteo los flags en la tabla indicada
|
|
Lparameters tcFile, tnNumTableFlags
|
|
Return This.set_BinTableFlags( tcFile, Chr(tnNumTableFlags) )
|
|
Endproc
|
|
|
|
|
|
Enddefine
|
|
|
|
|
|
Define Class CL_DBF_UTILS_FIELD As Custom
|
|
_MemberData = [<VFPData>] ;
|
|
+ [<memberdata name="fieldname" display="FieldName"/>] ;
|
|
+ [<memberdata name="fieldtype" display="FieldType"/>] ;
|
|
+ [<memberdata name="fieldwidth" display="FieldWidth"/>] ;
|
|
+ [<memberdata name="fielddecimals" display="FieldDecimals"/>] ;
|
|
+ [<memberdata name="fieldflags" display="FieldFlags"/>] ;
|
|
+ [<memberdata name="fielddisplacementinrecord" display="FieldDisplacementInRecord"/>] ;
|
|
+ [<memberdata name="allownulls" display="AllowNulls"/>] ;
|
|
+ [<memberdata name="nocodepagetranslation" display="NoCodePageTranslation"/>] ;
|
|
+ [<memberdata name="fieldvalidationexpression" display="FieldValidationExpression"/>] ;
|
|
+ [<memberdata name="fieldvalidationtext" display="FieldValidationText"/>] ;
|
|
+ [<memberdata name="fielddefaultvalue" display="FieldDefaultValue"/>] ;
|
|
+ [<memberdata name="tablevalidationexpression" display="TableValidationExpression"/>] ;
|
|
+ [<memberdata name="longtablename" display="LongTableName"/>] ;
|
|
+ [<memberdata name="tablevalidationtext" display="TableValidationText"/>] ;
|
|
+ [<memberdata name="inserttriggerexpression" display="InsertTriggerExpression"/>] ;
|
|
+ [<memberdata name="updatetriggerexpression" display="UpdateTriggerExpression"/>] ;
|
|
+ [<memberdata name="deletetriggerexpression" display="DeleteTriggerExpression"/>] ;
|
|
+ [<memberdata name="tablecomment" display="TableComment"/>] ;
|
|
+ [<memberdata name="nextvalueforautoinc" display="NextValueForAutoInc"/>] ;
|
|
+ [<memberdata name="stepforautoinc" display="StepForAutoInc"/>] ;
|
|
+ [<memberdata name="totext" display="toText"/>] ;
|
|
+ [</VFPData>]
|
|
|
|
#If .F.
|
|
Local This As CL_DBF_UTILS_FIELD Of 'FOXBIN2PRG.PRG'
|
|
#Endif
|
|
|
|
FieldName = ''
|
|
FieldType = ''
|
|
FieldWidth = 0
|
|
FieldDecimals = 0
|
|
FieldFlags = 0
|
|
FieldDisplacementInRecord = 0
|
|
AllowNulls = .F.
|
|
NoCodePageTranslation = .F.
|
|
FieldValidationExpression = ''
|
|
FieldValidationText = ''
|
|
FieldDefaultValue = ''
|
|
TableValidationExpression = ''
|
|
TableValidationText = ''
|
|
LongTableName = ''
|
|
InsertTriggerExpression = ''
|
|
UpdateTriggerExpression = ''
|
|
DeleteTriggerExpression = ''
|
|
TableComment = ''
|
|
NextValueForAutoInc = 0
|
|
StepForAutoInc = ''
|
|
|
|
|
|
Procedure toText
|
|
Lparameters tlHeader
|
|
|
|
Local lcText
|
|
lcText = ''
|
|
|
|
If tlHeader
|
|
lcText = lcText + Padr('FieldName',10) + ' ' + Padr('Type',4) + ' ' + Padr('Len',3) + ' ' ;
|
|
+ Padr('Dec',3) + ' ' + Padr('Flg',3) + ' ' + Padl('FDiR',4)
|
|
lcText = lcText + CR_LF + Replicate('-',10) + ' ' + Replicate('-',4) + ' ' + Replicate('-',3) + ' ' ;
|
|
+ Replicate('-',3) + ' ' + Replicate('-',3) + ' ' + Replicate('-',4)
|
|
Else
|
|
With This As CL_DBF_UTILS_FIELD Of 'FOXBIN2PRG.PRG'
|
|
lcText = lcText + Padr(.FieldName,10) + ' ' + Padc(.FieldType,4) + ' ' + Padl(.FieldWidth,3) + ' ' ;
|
|
+ Padl(.FieldDecimals,3) + ' ' + Padc(.FieldFlags,3) + ' ' + Padl(.FieldDisplacementInRecord,4)
|
|
Endwith
|
|
Endif
|
|
|
|
Return lcText
|
|
Endproc
|
|
|
|
|
|
Enddefine
|
|
|
|
|
|
Define Class CL_CFG As Custom
|
|
_MemberData = [<VFPData>] ;
|
|
+ [<memberdata name="c_curdir" display="c_CurDir"/>] ;
|
|
+ [<memberdata name="c_foxbin2prg_fullpath" display="c_Foxbin2prg_FullPath"/>] ;
|
|
+ [<memberdata name="c_foxbin2prg_configfile" display="c_Foxbin2prg_ConfigFile"/>] ;
|
|
+ [<memberdata name="c_db2" display="c_DB2"/>] ;
|
|
+ [<memberdata name="c_dc2" display="c_DC2"/>] ;
|
|
+ [<memberdata name="c_fr2" display="c_FR2"/>] ;
|
|
+ [<memberdata name="c_lb2" display="c_LB2"/>] ;
|
|
+ [<memberdata name="c_mn2" display="c_MN2"/>] ;
|
|
+ [<memberdata name="c_fk2" display="c_FK2"/>] ;
|
|
+ [<memberdata name="c_me2" display="c_ME2"/>] ;
|
|
+ [<memberdata name="c_pj2" display="c_PJ2"/>] ;
|
|
+ [<memberdata name="c_sc2" display="c_SC2"/>] ;
|
|
+ [<memberdata name="c_vc2" display="c_VC2"/>] ;
|
|
+ [<memberdata name="l_classperfilecheck" display="l_ClassPerFileCheck"/>] ;
|
|
+ [<memberdata name="l_clearuniqueid" display="l_ClearUniqueID"/>] ;
|
|
+ [<memberdata name="l_cleardbflastupdate" display="l_ClearDBFLastUpdate"/>] ;
|
|
+ [<memberdata name="n_debug" display="n_Debug"/>] ;
|
|
+ [<memberdata name="n_bodydevinfo" display="n_BodyDevInfo"/>] ;
|
|
+ [<memberdata name="l_notimestamps" display="l_NoTimestamps"/>] ;
|
|
+ [<memberdata name="n_optimizebyfilestamp" display="n_OptimizeByFilestamp"/>] ;
|
|
+ [<memberdata name="n_excludedbfautoincnextval" display="n_ExcludeDBFAutoincNextval"/>] ;
|
|
+ [<memberdata name="l_recompile" display="l_Recompile"/>] ;
|
|
+ [<memberdata name="l_redirectclassperfiletomain" display="l_RedirectClassPerFileToMain"/>] ;
|
|
+ [<memberdata name="n_redirectclasstype" display="n_RedirectClassType"/>] ;
|
|
+ [<memberdata name="l_showerrors" display="l_ShowErrors"/>] ;
|
|
+ [<memberdata name="n_showprogressbar" display="n_ShowProgressbar"/>] ;
|
|
+ [<memberdata name="n_useclassperfile" display="n_UseClassPerFile"/>] ;
|
|
; && SF
|
|
+ [<memberdata name="l_oldfilesperdbc" display="l_OldFilesPerDBC"/>] ;
|
|
+ [<memberdata name="n_usefilesperdbc" display="n_UseFilesPerDBC"/>] ;
|
|
+ [<memberdata name="l_redirectfileperdbctomain" display="l_RedirectFilePerDBCToMain"/>] ;
|
|
+ [<memberdata name="l_itemperdbccheck" display="l_ItemPerDBCCheck"/>] ;
|
|
+ [<memberdata name="l_dbf_binchar_base64" display="l_DBF_BinChar_Base64"/>] ;
|
|
+ [<memberdata name="l_dbf_includedeleted" display="l_DBF_IncludeDeleted"/>] ;
|
|
; && /SF
|
|
+ [<memberdata name="pjx_conversion_support" display="PJX_Conversion_Support"/>] ;
|
|
+ [<memberdata name="vcx_conversion_support" display="VCX_Conversion_Support"/>] ;
|
|
+ [<memberdata name="scx_conversion_support" display="SCX_Conversion_Support"/>] ;
|
|
+ [<memberdata name="frx_conversion_support" display="FRX_Conversion_Support"/>] ;
|
|
+ [<memberdata name="lbx_conversion_support" display="LBX_Conversion_Support"/>] ;
|
|
+ [<memberdata name="mnx_conversion_support" display="MNX_Conversion_Support"/>] ;
|
|
+ [<memberdata name="fky_conversion_support" display="FKY_Conversion_Support"/>] ;
|
|
+ [<memberdata name="mem_conversion_support" display="MEM_Conversion_Support"/>] ;
|
|
+ [<memberdata name="dbf_conversion_support" display="DBF_Conversion_Support"/>] ;
|
|
+ [<memberdata name="dbf_conversion_included" display="DBF_Conversion_Included"/>] ;
|
|
+ [<memberdata name="dbf_conversion_excluded" display="DBF_Conversion_Excluded"/>] ;
|
|
+ [<memberdata name="dbc_conversion_support" display="DBC_Conversion_Support"/>] ;
|
|
+ [<memberdata name="c_backgroundimage" display="c_BackgroundImage"/>] ;
|
|
+ [<memberdata name="n_prg_compat_level" display="n_PRG_Compat_Level"/>] ;
|
|
+ [<memberdata name="copyfrom" display="CopyFrom"/>] ;
|
|
+ [</VFPData>]
|
|
|
|
#If .F.
|
|
Local This As CL_CFG Of 'FOXBIN2PRG.PRG'
|
|
#Endif
|
|
|
|
|
|
*-- Configuration class. By default asumes master value, except when overriding one.
|
|
c_Foxbin2prg_FullPath = ''
|
|
c_Foxbin2prg_ConfigFile = ''
|
|
c_CurDir = ''
|
|
n_Debug = Null
|
|
n_BodyDevInfo = Null
|
|
l_ShowErrors = Null
|
|
n_ShowProgressbar = Null
|
|
l_Recompile = Null
|
|
l_NoTimestamps = Null
|
|
l_ClearUniqueID = Null
|
|
l_ClearDBFLastUpdate = Null
|
|
n_OptimizeByFilestamp = Null
|
|
n_ExcludeDBFAutoincNextval = Null
|
|
l_RedirectClassPerFileToMain = Null
|
|
n_RedirectClassType = Null
|
|
l_RemoveNullCharsFromCode = Null
|
|
l_RemoveZOrderSetFromProps = Null
|
|
n_UseClassPerFile = Null
|
|
*!* Changed by: Lutz Scheffler 21.02.2021
|
|
*!* change date="{^2021-02-21,10:57:00}"
|
|
* additional options controlling
|
|
* - splitt of DBC separated from VCX/SCX
|
|
* - new operations of DBF
|
|
*!* /Changed by: Lutz Scheffler 21.02.2021
|
|
l_OldFilesPerDBC = Null
|
|
n_UseFilesPerDBC = Null
|
|
l_RedirectFilePerDBCToMain = Null
|
|
l_ItemPerDBCCheck = Null
|
|
l_DBF_BinChar_Base64 = Null
|
|
l_DBF_IncludeDeleted = Null
|
|
*!* /Changed by: Lutz Scheffler 21.02.2021
|
|
l_ClassPerFileCheck = Null
|
|
n_ExtraBackupLevels = Null
|
|
c_VC2 = Null
|
|
c_SC2 = Null
|
|
c_PJ2 = Null
|
|
c_FR2 = Null
|
|
c_LB2 = Null
|
|
c_DB2 = Null
|
|
c_DC2 = Null
|
|
c_MN2 = Null
|
|
c_FK2 = Null
|
|
c_ME2 = Null
|
|
PJX_Conversion_Support = Null
|
|
VCX_Conversion_Support = Null
|
|
SCX_Conversion_Support = Null
|
|
FRX_Conversion_Support = Null
|
|
LBX_Conversion_Support = Null
|
|
MNX_Conversion_Support = Null
|
|
FKY_Conversion_Support = Null
|
|
MEM_Conversion_Support = Null
|
|
DBF_Conversion_Support = Null
|
|
DBF_Conversion_Included = Null
|
|
DBF_Conversion_Excluded = Null
|
|
DBC_Conversion_Support = Null
|
|
c_BackgroundImage = Null
|
|
n_PRG_Compat_Level = Null
|
|
|
|
|
|
Procedure CopyFrom
|
|
*-- Copia las propiedades del CFG indicado
|
|
Lparameters toParentCFG
|
|
|
|
With This As CL_CFG Of 'FOXBIN2PRG.PRG'
|
|
.c_Foxbin2prg_FullPath = toParentCFG.c_Foxbin2prg_FullPath
|
|
.c_Foxbin2prg_ConfigFile = toParentCFG.c_Foxbin2prg_ConfigFile
|
|
.c_CurDir = toParentCFG.c_CurDir
|
|
.n_Debug = toParentCFG.n_Debug
|
|
.n_BodyDevInfo = toParentCFG.n_BodyDevInfo
|
|
.l_ShowErrors = toParentCFG.l_ShowErrors
|
|
.n_ShowProgressbar = toParentCFG.n_ShowProgressbar
|
|
.l_Recompile = toParentCFG.l_Recompile
|
|
.l_NoTimestamps = toParentCFG.l_NoTimestamps
|
|
.l_ClearUniqueID = toParentCFG.l_ClearUniqueID
|
|
.l_ClearDBFLastUpdate = toParentCFG.l_ClearDBFLastUpdate
|
|
.n_OptimizeByFilestamp = toParentCFG.n_OptimizeByFilestamp
|
|
.n_ExcludeDBFAutoincNextval = toParentCFG.n_ExcludeDBFAutoincNextval
|
|
.l_RedirectClassPerFileToMain = toParentCFG.l_RedirectClassPerFileToMain
|
|
.n_RedirectClassType = toParentCFG.n_RedirectClassType
|
|
.l_RemoveNullCharsFromCode = toParentCFG.l_RemoveNullCharsFromCode
|
|
.l_RemoveZOrderSetFromProps = toParentCFG.l_RemoveZOrderSetFromProps
|
|
.n_UseClassPerFile = toParentCFG.n_UseClassPerFile
|
|
*!* Changed by: Lutz Scheffler 21.02.2021
|
|
*!* change date="{^2021-02-21,10:57:00}"
|
|
* additional options controlling
|
|
* - splitt of DBC separated from VCX/SCX
|
|
* - new operations of DBF
|
|
.l_OldFilesPerDBC = toParentCFG.l_OldFilesPerDBC
|
|
.n_UseFilesPerDBC = toParentCFG.n_UseFilesPerDBC
|
|
.l_RedirectFilePerDBCToMain = toParentCFG.l_RedirectFilePerDBCToMain
|
|
.l_ItemPerDBCCheck = toParentCFG.l_ItemPerDBCCheck
|
|
.l_DBF_BinChar_Base64 = toParentCFG.l_DBF_BinChar_Base64
|
|
.l_DBF_IncludeDeleted = toParentCFG.l_DBF_IncludeDeleted
|
|
*!* /Changed by: Lutz Scheffler 21.02.2021
|
|
.l_ClassPerFileCheck = toParentCFG.l_ClassPerFileCheck
|
|
.n_ExtraBackupLevels = toParentCFG.n_ExtraBackupLevels
|
|
.c_VC2 = toParentCFG.c_VC2
|
|
.c_SC2 = toParentCFG.c_SC2
|
|
.c_PJ2 = toParentCFG.c_PJ2
|
|
.c_FR2 = toParentCFG.c_FR2
|
|
.c_LB2 = toParentCFG.c_LB2
|
|
.c_DB2 = toParentCFG.c_DB2
|
|
.c_DC2 = toParentCFG.c_DC2
|
|
.c_MN2 = toParentCFG.c_MN2
|
|
.c_FK2 = toParentCFG.c_FK2
|
|
.c_ME2 = toParentCFG.c_ME2
|
|
.PJX_Conversion_Support = toParentCFG.PJX_Conversion_Support
|
|
.VCX_Conversion_Support = toParentCFG.VCX_Conversion_Support
|
|
.SCX_Conversion_Support = toParentCFG.SCX_Conversion_Support
|
|
.FRX_Conversion_Support = toParentCFG.FRX_Conversion_Support
|
|
.LBX_Conversion_Support = toParentCFG.LBX_Conversion_Support
|
|
.MNX_Conversion_Support = toParentCFG.MNX_Conversion_Support
|
|
.FKY_Conversion_Support = toParentCFG.FKY_Conversion_Support
|
|
.MEM_Conversion_Support = toParentCFG.MEM_Conversion_Support
|
|
.DBF_Conversion_Support = toParentCFG.DBF_Conversion_Support
|
|
.DBF_Conversion_Included = toParentCFG.DBF_Conversion_Included
|
|
.DBF_Conversion_Excluded = toParentCFG.DBF_Conversion_Excluded
|
|
.DBC_Conversion_Support = toParentCFG.DBC_Conversion_Support
|
|
.c_BackgroundImage = toParentCFG.c_BackgroundImage
|
|
.n_PRG_Compat_Level = toParentCFG.n_PRG_Compat_Level
|
|
Endwith
|
|
Endproc
|
|
|
|
|
|
Enddefine
|
|
|
|
|
|
Define Class CL_LANG As Custom
|
|
_MemberData = [<VFPData>] ;
|
|
+ [<memberdata name="n_languageselectedmethod" display="n_LanguageSelectedMethod"/>] ;
|
|
+ [</VFPData>]
|
|
|
|
#If .F.
|
|
Local This As CL_LANG Of 'FOXBIN2PRG.PRG'
|
|
#Endif
|
|
|
|
n_LanguageSelectedMethod = 0 && 0=Automatic by version(3)
|
|
|
|
C_ALLOWED_VALUES_ARE_LOC = ""
|
|
C_ASTERISK_EXT_NOT_ALLOWED_LOC = ""
|
|
C_BACKLINK_CANT_UPDATE_BL_LOC = ""
|
|
C_BACKLINK_OF_TABLE_LOC = ""
|
|
C_BACKUP_OF_LOC = ""
|
|
C_CACHING_CONFIG_FOR_DIRECTORY_LOC = ""
|
|
C_CANT_GENERATE_FILE_BECAUSE_IT_IS_READONLY_LOC = ""
|
|
C_CLASSPERFILE_OPTIMIZATION_BASE_ALREADY_PROCESSED_LOC = ""
|
|
C_CONFIGFILE_LOC = ""
|
|
C_CONVERSION_CANCELLED_BY_USER_LOC = ""
|
|
C_CONVERT_ALL_FILES_IN_A_PROJECT_LOC = ""
|
|
C_CONVERT_FOLDER_LOC = ""
|
|
C_BINARY_TO_TEXT_LOC = ""
|
|
C_TEXT_TO_BINARY_LOC = ""
|
|
C_CONVERT_FOLDER_NONE_LOC = ""
|
|
C_CONVERT_FOLDER_QUESTION_LOC = ""
|
|
C_CONVERTER_UNLOAD_LOC = ""
|
|
C_CONVERTING_FILE_LOC = ""
|
|
C_DATA_ERROR_CANT_PARSE_UNPAIRING_DOUBLE_QUOTES_LOC = ""
|
|
C_DUPLICATED_FILE_LOC = ""
|
|
C_DUPLICATED_OBJECT_LOC = ""
|
|
C_ENDDEFINE_MARKER_NOT_FOUND_LOC = ""
|
|
C_END_MARKER_NOT_FOUND_LOC = ""
|
|
C_END_OF_PROCESS_LOC = ""
|
|
C_ERROR_LOC = ""
|
|
C_ERRORS_FOUND_IN_FILE_LOC = ""
|
|
C_EXTENSION_RECONFIGURATION_LOC = ""
|
|
C_EXTERNAL_CLASS_COUNT_DOES_NOT_MATCH_FOUND_CLASSES_LOC = ""
|
|
C_EXTERNAL_CLASS_NAME_WAS_NOT_FOUND_LOC = ""
|
|
C_EXTERNAL_MEMBER_NAME_WAS_NOT_FOUND_LOC = ""
|
|
C_EXTERNAL_PARAMETERS_LOC = ""
|
|
C_FIELD_NOT_FOUND_ON_FILE_STRUCTURE_LOC = ""
|
|
C_FILE_DOESNT_EXIST_LOC = ""
|
|
C_FILE_NAME_IS_NOT_SUPPORTED_LOC = ""
|
|
C_FILE_NOT_FOUND_LOC = ""
|
|
C_FILENAME_LOC = ""
|
|
C_FOXBIN2PRG_ERROR_CAPTION_LOC = ""
|
|
C_FOXBIN2PRG_SYNTAX_INFO_LOC = ""
|
|
C_FOXBIN2PRG_SYNTAX_INFO_EXAMPLE_LOC = ""
|
|
C_FOXBIN2PRG_SYNTAX_INFO_EXAMPLE_LOC_cfg = ""
|
|
C_FOXBIN2PRG_SYNTAX_INFO_EXAMPLE_LOC_tab_cfg = ""
|
|
C_FOXBIN2PRG_JUST_VFP_9_LOC = ""
|
|
C_FOXBIN2PRG_WARN_CAPTION_LOC = ""
|
|
C_GENERATED_FILE_SIZE_LOC = ""
|
|
C_GENERATING_BINARY_LOC = ""
|
|
C_INCLUDING_CLASS_LOC = ""
|
|
C_INCLUDING_MEMBER_LOC = ""
|
|
C_INCORRECT_VFP9_VERSION__MISSING_SP1_LOC = ""
|
|
C_INHERITING_FROM_LOC = ""
|
|
C_INTERACTIVE_DIRECTORY_SELECTION_LOC = ""
|
|
C_INVALID_PARAMETER_LOC = ""
|
|
C_IS_A_FILE_LOC = ""
|
|
C_IS_A_DIRECTORY_LOC = ""
|
|
C_IS_UNSUPPORTED_LOC = ""
|
|
C_LANGUAGE_LOC = ""
|
|
C_MAIN_EXECUTION_LOC = ""
|
|
C_MENU_NOT_IN_VFP9_FORMAT_LOC = ""
|
|
C_NAMES_CAPITALIZATION_PROGRAM_FOUND_LOC = ""
|
|
C_NAMES_CAPITALIZATION_PROGRAM_NOT_FOUND_LOC = ""
|
|
C_OBJECT_NAME_WITHOUT_OBJECT_OREG_LOC = ""
|
|
C_ONLY_SETNAME_AND_GETNAME_RECOGNIZED_LOC = ""
|
|
C_OPTIMIZATION_SKIPPING_ALREADY_PROCESSED_FILE_LOC = ""
|
|
C_OPTION_LOC = ""
|
|
C_OUTER_CLASS_DOES_NOT_MATCH_INNER_CLASSES_LOC = ""
|
|
C_OUTER_MEMBER_DOES_NOT_MATCH_INNER_MEMBERS_LOC = ""
|
|
C_OUTPUT_FILE_IS_NOT_OVERWRITEN_LOC = ""
|
|
C_OUTPUTFILE_TIMESTAMP_NEWER_THAN_INPUTFILE_TIMESTAMP_LOC = ""
|
|
C_OUTPUTFILE_TIMESTAMP_EQUAL_THAN_INPUTFILE_TIMESTAMP_LOC = ""
|
|
C_PRESS_ESC_TO_CANCEL = ""
|
|
C_PROCEDURE_NOT_CLOSED_ON_LINE_LOC = ""
|
|
C_PROCESSING_LOC = ""
|
|
C_PROCESS_PROGRESS_LOC = ""
|
|
C_PROPERTY_NAME_NOT_RECOGNIZED_LOC = ""
|
|
C_READING_CFG_VALUES_FROM_DISK_LOC = ""
|
|
C_REPORT_NOT_IN_VFP9_FORMAT_LOC = ""
|
|
C_REQUESTING_CAPITALIZATION_OF_FILE_LOC = ""
|
|
C_SCANNING_FILE_AND_DIR_INFO_LOC = ""
|
|
C_SOURCEFILE_LOC = ""
|
|
C_SOURCESAFE_COMPATIBILITY_MODE_LOC = ""
|
|
C_STRUCTURE_NESTING_ERROR_ENDPROC_EXPECTED_LOC = ""
|
|
C_STRUCTURE_NESTING_ERROR_ENDPROC_EXPECTED_2_LOC = ""
|
|
C_UNKNOWN_CLASS_NAME_LOC = ""
|
|
C_USE_FILE_TIMESTAMP_OPTIMIZATION_LOC = ""
|
|
C_USING_THIS_SETTINGS_LOC = ""
|
|
C_WARNING_LOC = ""
|
|
C_WARN_TABLE_ALIAS_ON_INDEX_EXPRESSION_LOC = ""
|
|
C_WITH_ERRORS_LOC = ""
|
|
|
|
|
|
|
|
Procedure Init
|
|
Lparameters tcLanguage
|
|
|
|
Try
|
|
Local lcSys16, lnPosProg, laDirInfo(1,5), lcLangStr ;
|
|
, loEx As Exception
|
|
|
|
With This As CL_LANG Of 'FOXBIN2PRG.PRG'
|
|
*-- El lenguaje pasado por parámetro prevalece sobre el existente.
|
|
tcLanguage = Evl(tcLanguage,'')
|
|
|
|
If Empty(tcLanguage)
|
|
.n_LanguageSelectedMethod = 0 && 0=Automatic by version(3)
|
|
Else
|
|
.n_LanguageSelectedMethod = 1 && 1=Assigned by Parameter
|
|
Endif
|
|
|
|
tcLanguage = Upper( Evl(tcLanguage, Version(3)) )
|
|
|
|
Do Case
|
|
Case Inlist(tcLanguage, '33', 'FR') && French (Francés)
|
|
*-------------------------------------------------------------------------------------------------------------------------------------------
|
|
*-- NOTE: MUST USE DOUBLE QUOTES, OR SYNTAX ERRORS HAPPEN WHEN COMPILING. STRANGE :(
|
|
*-------------------------------------------------------------------------------------------------------------------------------------------
|
|
.C_ALLOWED_VALUES_ARE_LOC = "Les valeurs autorisées sont"
|
|
.C_ASTERISK_EXT_NOT_ALLOWED_LOC = "* Et ? extensions ne sont pas autorisées car il est dangereux (binaires peuvent être remplacés par des fichiers vides de XX2)"
|
|
.C_BACKLINK_CANT_UPDATE_BL_LOC = "Impossible de mettre à jour backlink"
|
|
.C_BACKLINK_OF_TABLE_LOC = "de la table"
|
|
.C_BACKUP_OF_LOC = "Faire de sauvegarde des: "
|
|
.C_CACHING_CONFIG_FOR_DIRECTORY_LOC = "La mise en cache pour le répertoire config"
|
|
.C_CANT_GENERATE_FILE_BECAUSE_IT_IS_READONLY_LOC = "Vous ne pouvez pas générer un fichier [<<THIS.c_OutputFile>>] car il est en lecture seule"
|
|
.C_CLASSPERFILE_OPTIMIZATION_BASE_ALREADY_PROCESSED_LOC = "Optimisation: Fichier de base [<<JUSTFNAME(.c_InputFile)>>] Déjà traitée, en sautant traitement de fichier [<<tc_InputFile>>]"
|
|
.C_CONFIGFILE_LOC = "Utilisation du fichier de configuration:"
|
|
.C_CONVERSION_CANCELLED_BY_USER_LOC = "Conversion Annulé par l'utilisateur"
|
|
.C_CONVERT_ALL_FILES_IN_A_PROJECT_LOC = "Convertir tous les fichiers dans un Projet"
|
|
.C_CONVERT_FOLDER_LOC = "Convertir un Dossier"
|
|
.C_BINARY_TO_TEXT_LOC = "Binaire en Texte"
|
|
.C_TEXT_TO_BINARY_LOC = "Texte à Binaire"
|
|
.C_CONVERT_FOLDER_NONE_LOC = "Aucun"
|
|
.C_CONVERT_FOLDER_QUESTION_LOC = "Que la conversion doit être effectuée sur les fichiers de ce dossier?"
|
|
.C_CONVERTER_UNLOAD_LOC = "Convertisseur déchargement"
|
|
.C_CONVERTING_FILE_LOC = "Conversion de fichiers"
|
|
.C_DATA_ERROR_CANT_PARSE_UNPAIRING_DOUBLE_QUOTES_LOC = "Erreur de données: ne peut pas analyser en raison de guillemets non appariés en ligne <<lcMetadatos>>"
|
|
.C_DUPLICATED_FILE_LOC = "fichier dupliqué"
|
|
.C_DUPLICATED_OBJECT_LOC = "Object dupliqué"
|
|
.C_ENDDEFINE_MARKER_NOT_FOUND_LOC = "Vous ne trouvez pas marqueur de fin [ENDDEFINE] de la ligne <<TRANSFORM(toClase._Inicio)>> ID [<<toClase._Nombre>>]"
|
|
.C_END_MARKER_NOT_FOUND_LOC = "Vous ne trouvez pas fin marqueur [<<ta_ID_Bloques(lnPrimerID, 2)>>] qui ferme marqueur de début [<<ta_ID_Bloques(lnPrimerID, 1) >>] en ligne <<TRANSFORM(taBloquesExclusion (tnBloquesExclusion, 1))>>"
|
|
.C_END_OF_PROCESS_LOC = "Fin du processus"
|
|
.C_ERROR_LOC = "ERREUR"
|
|
.C_ERRORS_FOUND_IN_FILE_LOC = "ERREURS TROUVÉ DANS LE FICHIER"
|
|
.C_EXTENSION_RECONFIGURATION_LOC = "Extension Reconfiguration:"
|
|
.C_EXTERNAL_CLASS_COUNT_DOES_NOT_MATCH_FOUND_CLASSES_LOC = "Nombre de classe externe (<<toModulo._ExternalClasses_Count>>) ne correspond pas classes trouvées (<<toModulo._Clases_Count>>) pour le fichier [<<toFoxBin2Prg.c_InputFile>>]"
|
|
.C_EXTERNAL_CLASS_NAME_WAS_NOT_FOUND_LOC = "Aucune classe externe est trouvé"
|
|
.C_EXTERNAL_MEMBER_NAME_WAS_NOT_FOUND_LOC = "Nom de membre externe n'a pas été trouvé"
|
|
.C_EXTERNAL_PARAMETERS_LOC = "PARAMÈTRES EXTERNES"
|
|
.C_FIELD_NOT_FOUND_ON_FILE_STRUCTURE_LOC = "Champ [<< laProps (m.I) >>] ne trouve pas dans la structure du fichier DBF <<('TABLABIN')>>"
|
|
.C_FILE_DOESNT_EXIST_LOC = "Fichier ne existe pas:"
|
|
.C_FILE_NAME_IS_NOT_SUPPORTED_LOC = "File [<<.c_InputFile>>] ne est pas supporté"
|
|
.C_FILE_NOT_FOUND_LOC = "Fichier introuvable"
|
|
.C_FILENAME_LOC = "Fichier"
|
|
.C_FOXBIN2PRG_ERROR_CAPTION_LOC = "ERREUR"
|
|
.C_FOXBIN2PRG_SYNTAX_INFO_LOC = "SYNTAX AND PARAMETERS INFO"
|
|
|
|
TEXT TO .C_FOXBIN2PRG_SYNTAX_INFO_EXAMPLE_LOC TEXTMERGE NOSHOW FLAGS 1 PRETEXT 1+2
|
|
<<>>FoxBin2Prg Home Page and download: https://github.com/fdbozzo/foxbin2prg/wiki - Fernando D. Bozzo (2013.11.25)
|
|
<<>>
|
|
<<>>FOXBIN2PRG.EXE [-c OutFileName] [-t OutFileName]
|
|
<<>>
|
|
<<>>-- Parameter details:
|
|
<<>>No parameter: Calls this info screen
|
|
<<>>-c creates a template config-file <OutFileName> (like FOXBIN2PRG.CFG)
|
|
<<>>-t creates a template table-config-file <OutFileName> (like <Tabellenname>.dbf.cfg)
|
|
<<>>
|
|
<<>>FOXBIN2PRG.EXE <cFileSpec.Ext> [cType [cTextName [cGenText [cDontShowErrors [cDebug [cDontShowProgress [cOriginalFileName [cRecompile [cNoTimestamps [cCFG_File] ] ] ] ] ] ] ] ] ]
|
|
<<>>
|
|
<<>>-- Parameter details:
|
|
<<>>cFileSpec.Ext: Full name (fullpath) of the file to convert or directory name to process
|
|
<<>> - If 'BIN2PRG' is specified, the directory specified in tcType is processed for generating TX2
|
|
<<>> - If 'PRG2BIN' is specified, the directory specified in tcType is processed for regenerating BIN
|
|
<<>> - In SCCAPI (VSS) compatibility mode, it is used to query the conversion support for the file type specified
|
|
<<>> VSS Types: d=DBC, D=DBF, K=Form, B=Label, M=Menu, R=Report, V=Class
|
|
<<>>cType: In SCCAPI (VSS) compatibility mode indicates the input file type.
|
|
<<>> - If specified '*' or '*-' and tc_InputFile is a PJX, all project files are processed
|
|
<<>>cTextName = Text filename. Only for SCCAPI (VSS) compatibility mode.
|
|
<<>>lGenText: .T.=Generates Text, .F.=Regenerates Binary. Only for SCCAPI (VSS) compatibility mode.
|
|
<<>>cDontShowErrors: '1' for NOT showing errors
|
|
<<>>cDebug: '1' for generating process LOGs, stop on errors
|
|
<<>>cDontShowProgress: '1' for NOT showing the process window
|
|
<<>>cOriginalFileName: used in those cases in which inputFile is a temporary filename and you want to generate the correct filename on the header of the text version
|
|
<<>>cRecompile: Indicates recompile ('1') the binary once regenerated. You can specify a Path too (ie, the project one)
|
|
<<>>cNoTimestamps: Indicates if timestamp must be cleared ('1' or empty) or not ('0')
|
|
<<>>cCFG_File: Indicates a CFG filename for not using the default on foxbin2prg directory
|
|
<<>>
|
|
<<>>
|
|
ENDTEXT
|
|
TEXT TO .C_FOXBIN2PRG_SYNTAX_INFO_EXAMPLE_LOC_cfg TEXTMERGE NOSHOW FLAGS 1 PRETEXT 1+2
|
|
<<>>################################################################################################################
|
|
<<>>FOXBIN2PRG.CFG configuration options: (If no values given, these are the DEFAULTS)
|
|
<<>>Version: <<_Screen.c_FB2PRG_EXE_Version>>
|
|
<<>>################################################################################################################
|
|
<<>>
|
|
<<>>extension: tx2=newext && Specify extensions to use. Default FoxBin2Prg extensions ends in '2' (see at the bottom)
|
|
<<>>ShowProgressbar: 1 && 0=Don't show, 1=Allways show, 2= Show only for multi-file processing
|
|
<<>>DontShowErrors: 0 && Show message errors by default
|
|
<<>>NoTimestamps: 1 && Clear timestamps by default for minimize differences
|
|
<<>>Debug: 0 && Don't Activate individual <file>.Log by default
|
|
<<>>BodyDevInfo: 0 && [0=Don't keep DevInfo for body pjx records], 1=Keep DevInfo
|
|
<<>>ExtraBackupLevels: 1 && By default 1 BAK is created. With this you can make more .N.BAK, or none
|
|
<<>>ClearUniqueID: 1 && 0=Keep UniqueID in text files, 1=Clear Unique ID. Useful for Diff and Merge
|
|
<<>>ClearDBFLastUpdate: 1 && 0=Keep DBF LastUpdate, 1=Clear DBF LastUpdate. Useful for Diff.
|
|
<<>>OptimizeByFilestamp: 0 && 1=Optimize file regeneration depending on file timestamp. Dangerous while working with branches!
|
|
<<>>RemoveNullCharsFromCode: 1 && 1=Drop NULL chars from source code
|
|
<<>>RemoveZOrderSetFromProps: 0 && 0=Do not remove ZOrderSet property from object, 1=Remove ZOrderSet property from object
|
|
<<>>Language: (auto) && Language of shown messages and LOGs. EN=English, FR=French, ES=Español, DE=German, Not defined = AUTOMATIC [DEFAULT]
|
|
<<>>ExcludeDBFAutoincNextval: 0 && [0=Do not exclude this value from db2], 1=Exclude this value from db2
|
|
<<>>PRG_Compat_Level: 0 && [0=Legacy], 1=Use HELPSTRING as Class Procedure comment
|
|
<<>>
|
|
<<>>-- Convertion options:
|
|
<<>>PJX_Conversion_Support: 2 && 0=No support, 1=Generate TXT only (Diff), 2=Generate TXT and BIN (Merge)
|
|
<<>>VCX_Conversion_Support: 2 && 0=No support, 1=Generate TXT only (Diff), 2=Generate TXT and BIN (Merge)
|
|
<<>>SCX_Conversion_Support: 2 && 0=No support, 1=Generate TXT only (Diff), 2=Generate TXT and BIN (Merge)
|
|
<<>>FRX_Conversion_Support: 2 && 0=No support, 1=Generate TXT only (Diff), 2=Generate TXT and BIN (Merge)
|
|
<<>>LBX_Conversion_Support: 2 && 0=No support, 1=Generate TXT only (Diff), 2=Generate TXT and BIN (Merge)
|
|
<<>>MNX_Conversion_Support: 2 && 0=No support, 1=Generate TXT only (Diff), 2=Generate TXT and BIN (Merge)
|
|
<<>>FKY_Conversion_Support: 1 && 0=No support, 1=Generate TXT only (Diff)
|
|
<<>>MEM_Conversion_Support: 1 && 0=No support, 1=Generate TXT only (Diff)
|
|
<<>>DBC_Conversion_Support: 2 && 0=No support, 1=Generate TXT only (Diff), 2=Generate TXT and BIN (Merge)
|
|
<<>>DBF_Conversion_Support: 1 && 0=No support, 1=Generate Header TXT only (Diff), 2=Generate Header TXT and BIN (Merge/Only Structure!), 4=Generate TXT with DATA (Diff), 8=Export and Import DATA (Merge/Structure & Data)
|
|
<<>>DBF_Conversion_Included: * && If DBF_Conversion_Support:4, you can specify multiple filemasks: www,fb2p_free.dbf
|
|
<<>>DBF_Conversion_Excluded: && If DBF_Conversion_Support:4, you can specify multiple filemasks: www,fb2p_free.dbf
|
|
|
|
<<>>
|
|
<<>>-- DBC options
|
|
<<>>- File per DBC options (UseFilesPerDBC: 1)
|
|
<<>>OldFilesPerDBC: 0 && 1=Turns the File per DBC options on, 0 uses the old UseClassPerFile etc settings.
|
|
<<>> && Options below will only read if OldFilesPerDBC is set 1 before!
|
|
<<>> && If OldFilesPerDBC is set 0 later, alle setting will be lost
|
|
<<>>UseFilesPerDBC: 0 && 0=One database dc2 file, 1=Multiple file.*.*.dc2 files
|
|
<<>> && 0 creates only a file.dc2 with all DBC (file) data
|
|
<<>> && 1 creates a file.dc2 with DBC properties
|
|
<<>> && and additional DBC files per DBC item (stored-proc, table, ..)
|
|
<<>> && Note: recration only if RedirectFilePerDBCToMain is 1
|
|
<<>>RedirectFilePerDBCToMain 0 && 0=Don't redirect to file.dc2, 1=Redirect to file.tx2 when selecting file.item.*.dc2
|
|
<<>>ItemPerDBCCheck: 0 && 0=Don't check file.item.*.dc2 inclusion, 1=Check file.item.*.dc2 inclusion
|
|
<<>>DBF_BinChar_Base64: 1 && 0=For character type fields, if NoCPTrans 0=do not transform, 1=use Base64 transform (default)
|
|
<<>>DBF_IncludeDeleted: 0 && 0=Do not include deleted records (default), 1=Include deleted records
|
|
<<>>
|
|
<<>>-- CLASS and FORM options (tx2 is to read as vc2 or sc2, VCX might be SCX)
|
|
<<>>- Class per file options (UseClassPerFile: 1)
|
|
<<>>UseClassPerFile: 0 && 0=One library tx2 file, 1=Multiple file.class.tx2 files, 2=Multiple file.baseclass.class.tx2 files
|
|
<<>>RedirectClassPerFileToMain: 0 && 0=Don't redirect to file.tx2, 1=Redirect to file.tx2 when selecting file.class.tx2
|
|
<<>>RedirectClassType: 0 && For classes created with UseClassPerFile>0 in the form file[.baseclass].class.tx2
|
|
<<>> && Those files could be imported like file.tx2::Class::import or like file[.baseclass].class.tx2
|
|
<<>> && For the second form:
|
|
<<>> && 0 Redirect file[.baseclass].class.tx2 to file.VCX and add / replace all other classes of this library
|
|
<<>> && 1 Redirect file[.baseclass].class.tx2 to file[.baseclass].class.VCX and do not touch file.VCX
|
|
<<>> && 2 Redirect file[.baseclass].class.tx2 to file.VCX and do not touch other classes of file.VCX
|
|
<<>>ClassPerFileCheck: 0 && 0=Don't check file.class.tx2 inclusion, 1=Check file.class.tx2 inclusion
|
|
<<>>
|
|
<<>>-- Example configuration for SourceSafe compatibility:
|
|
<<>>extension: pj2=pja && Text file to PJX
|
|
<<>>extension: vc2=vca && Text file to VCX
|
|
<<>>extension: sc2=sca && Text file to SCX
|
|
<<>>extension: fr2=fra && Text file to FRX
|
|
<<>>extension: lb2=lba && Text file to LBX
|
|
<<>>extension: mn2=mna && Text file to MNX
|
|
<<>>extension: db2=dba && Text file to DBF
|
|
<<>>extension: dc2=dca && Text file to DBC
|
|
<<>>-- Additional extensions
|
|
<<>>extension: fk2=fkx && Text file to FKY
|
|
<<>>extension: me2=fkx && Text file to MEM
|
|
<<>>
|
|
<<>>
|
|
ENDTEXT
|
|
TEXT TO .C_FOXBIN2PRG_SYNTAX_INFO_EXAMPLE_LOC_tab_cfg TEXTMERGE NOSHOW FLAGS 1 PRETEXT 1+2
|
|
<<>>-- Individual DBF configuration file (syntax: filename.dbf.cfg) Defaults see FoxBin2prg.cfg
|
|
<<>>DBF_Conversion_Support: <1,2,4,8> && 0=No support, 1=Generate Header TXT only (Diff), 2=Generate Header TXT and BIN (Merge/Only Structure!), 4=Generate TXT with DATA (Diff), 8=Export and Import DATA (Merge/Structure & Data)
|
|
<<>>DBF_Conversion_Order: <c_Expression> && Field expresion. ie: name+str(age,3)
|
|
<<>>DBF_Conversion_Condition: <c_Expression> && Logical expression. ie: age > 10 AND NOT DELETED()
|
|
<<>>DBF_BinChar_Base64: <0,1> && 0=For character type fields, if NoCPTrans 0=do not transform, 1=use Base64 transform
|
|
<<>>DBF_IncludeDeleted: <0,1> && 0=Do not include deleted records, 1=Include deleted records
|
|
<<>>
|
|
ENDTEXT
|
|
.C_FOXBIN2PRG_JUST_VFP_9_LOC = "FOXBIN2PRG est seulement pour Visual FoxPro 9.0!"
|
|
.C_FOXBIN2PRG_WARN_CAPTION_LOC = "AVERTISSEMENT!"
|
|
.C_GENERATED_FILE_SIZE_LOC = "Taille du fichier généré"
|
|
.C_GENERATING_BINARY_LOC = "Génération Binaire"
|
|
.C_INCLUDING_CLASS_LOC = "classe, y compris"
|
|
.C_INCLUDING_MEMBER_LOC = "membres, y compris"
|
|
.C_INCORRECT_VFP9_VERSION__MISSING_SP1_LOC = "SourceSafe Compatibilité ModeIncorrect VFP 9 Version - SP1 manquant! Prévue: 3504 ou plus tard, réelle: " + Version(4)
|
|
.C_INHERITING_FROM_LOC = "Héritant de"
|
|
.C_INTERACTIVE_DIRECTORY_SELECTION_LOC = "Sélection répertoire interactive"
|
|
.C_INVALID_PARAMETER_LOC = "Paramètre non valide"
|
|
.C_IS_A_FILE_LOC = "est un FICHIER"
|
|
.C_IS_A_DIRECTORY_LOC = "est un RÉPERTOIRE"
|
|
.C_IS_UNSUPPORTED_LOC = "ne est pas supporté"
|
|
.C_LANGUAGE_LOC = "FR"
|
|
.C_MAIN_EXECUTION_LOC = "EXÉCUTION PRINCIPALE"
|
|
.C_MENU_NOT_IN_VFP9_FORMAT_LOC = "Menu [<<THIS.c_InputFile>>] ne est pas dans VFP 9 Format! - Se il vous plaît se convertir à VFP 9 avec MODIFY MENU '<<THIS.c_InputFile>>'"
|
|
.C_NAMES_CAPITALIZATION_PROGRAM_FOUND_LOC = "* Programme des noms de capitalisation [<<lcEXE_CAPS>>] trouvé"
|
|
.C_NAMES_CAPITALIZATION_PROGRAM_NOT_FOUND_LOC = "* Programme des noms de capitalisation [<<lcEXE_CAPS>>] introuvables"
|
|
.C_OBJECT_NAME_WITHOUT_OBJECT_OREG_LOC = "Object [<<toObj.CLASS>>] ne contient pas l'objet oReg (niveau <<TRANSFORM(tnNivel)>>)"
|
|
.C_ONLY_SETNAME_AND_GETNAME_RECOGNIZED_LOC = "Opération non reconnu. Seulement SETNAME et GETNAME permis."
|
|
.C_OPTIMIZATION_SKIPPING_ALREADY_PROCESSED_FILE_LOC = "Optimisation: sauter fichier déjà traité [<<(lcFile)>>]"
|
|
.C_OPTION_LOC = "Option"
|
|
.C_OUTER_CLASS_DOES_NOT_MATCH_INNER_CLASSES_LOC = "La classe externe ne correspond pas à la classe interne"
|
|
.C_OUTER_MEMBER_DOES_NOT_MATCH_INNER_MEMBERS_LOC = "L'élément extérieur ne correspond pas aux éléments intérieur"
|
|
.C_OUTPUT_FILE_IS_NOT_OVERWRITEN_LOC = "Optimisation: fichier de sortie [<<lcOutputFile>>] ne était pas écrasé parce que ce est la même que celle générée."
|
|
.C_OUTPUTFILE_TIMESTAMP_EQUAL_THAN_INPUTFILE_TIMESTAMP_LOC = "Optimisation: le fichier de sortie [<<THIS.c_OutputFile>>] pas régénéré en ayant le même horodatage que l'entrée."
|
|
.C_OUTPUTFILE_TIMESTAMP_NEWER_THAN_INPUTFILE_TIMESTAMP_LOC = "Optimisation: le fichier de sortie [<<THIS.c_OutputFile>>] n'a pas été régénéré car il est plus récent que le fichier d'entrée."
|
|
.C_PRESS_ESC_TO_CANCEL = "Appuyez sur Esc pour Annuler"
|
|
.C_PROCEDURE_NOT_CLOSED_ON_LINE_LOC = "Procédure pas fermé. Dernière ligne de code doit être ENDPROC. [<<laLineas(1)>>, Recno:<<RECNO()>>]"
|
|
.C_PROCESSING_LOC = "Traitement du fichier"
|
|
.C_PROCESS_PROGRESS_LOC = "Processus Progrès:"
|
|
.C_PROPERTY_NAME_NOT_RECOGNIZED_LOC = "Propriété [<<TRANSFORM(tnPropertyID)>>] ne est pas reconnu."
|
|
.C_READING_CFG_VALUES_FROM_DISK_LOC = "VALEURS LECTURE CFG À PARTIR DU DISQUE"
|
|
.C_REPORT_NOT_IN_VFP9_FORMAT_LOC = "Rapport [<<THIS.c_InputFile>>] ne est pas dans VFP 9 Format! - Se il vous plaît se convertir à VFP 9 avec MODIFY REPORT '<<THIS.c_InputFile>>'"
|
|
.C_REQUESTING_CAPITALIZATION_OF_FILE_LOC = "- Demande de capitalisation de fichier [<<tcFileName>>]"
|
|
.C_SCANNING_FILE_AND_DIR_INFO_LOC = "Fichier de numérisation et de l'information de répertoire pour"
|
|
.C_SOURCEFILE_LOC = "Fichier source: "
|
|
.C_SOURCESAFE_COMPATIBILITY_MODE_LOC = "Mode de compatibilité SourceSafe"
|
|
.C_STRUCTURE_NESTING_ERROR_ENDPROC_EXPECTED_LOC = "Nesting erreur de structure. ENDPROC prévu, mais a trouvé ENDDEFINE sur la classe <<toClase._Nombre>> (<<loProcedure._Nombre>>), ligne <<TRANSFORM(m.I)>> du fichier <<THIS.c_InputFile>>"
|
|
.C_STRUCTURE_NESTING_ERROR_ENDPROC_EXPECTED_2_LOC = "Nesting erreur de structure. ENDPROC attendue, mais ENDDEFINE sur la classe <<toClase._Nombre>> (<<toObjeto._Nombre>>.<<loProcedure._Nombre>>), ligne <<TRANSFORM(m.I)>> du fichier <<THIS.c_InputFile>>"
|
|
.C_UNKNOWN_CLASS_NAME_LOC = "Classe inconnue[<<THIS.CLASS>>]"
|
|
.C_USE_FILE_TIMESTAMP_OPTIMIZATION_LOC = "Utilisez le fichier Optimisation d'horodatage"
|
|
.C_USING_THIS_SETTINGS_LOC = "Utilisation de ce paramètre"
|
|
.C_WARNING_LOC = "AVERTISSEMENT!"
|
|
.C_WARN_TABLE_ALIAS_ON_INDEX_EXPRESSION_LOC = "AVERTISSEMENT!" + CR_LF+ "ASSUREZ VOUS NE UTILISEZ PAS UN ALIAS DE TABLE SUR LES EXPRESSIONS INDEX CLÉS!! (exemple: index on <<UPPER(JUSTSTEM(THIS.c_InputFile))>>.campo tag keyname)"
|
|
.C_WITH_ERRORS_LOC = "avec des erreurs"
|
|
|
|
Case Inlist(tcLanguage, '34', 'ES') && Spanish (Español)
|
|
*-------------------------------------------------------------------------------------------------------------------------------------------
|
|
*-- NOTA: SE DEBEN USAR COMILLAS DOBLES, O ERRORES DE SINTAXIS OCURREN AL COMPILAR. EXTRAÑO :(
|
|
*-------------------------------------------------------------------------------------------------------------------------------------------
|
|
.C_ALLOWED_VALUES_ARE_LOC = "Los valores permitidos son"
|
|
.C_ASTERISK_EXT_NOT_ALLOWED_LOC = "No se admiten extensiones * o ? porque es peligroso (se pueden pisar binarios con archivo xx2 vacíos)."
|
|
.C_BACKLINK_CANT_UPDATE_BL_LOC = "No se pudo actualizar el backlink"
|
|
.C_BACKLINK_OF_TABLE_LOC = "de la tabla"
|
|
.C_BACKUP_OF_LOC = "Haciendo Backup de: "
|
|
.C_CACHING_CONFIG_FOR_DIRECTORY_LOC = "Cacheando configuración para directorio"
|
|
.C_CANT_GENERATE_FILE_BECAUSE_IT_IS_READONLY_LOC = "No se puede generar el archivo [<<THIS.c_OutputFile>>] porque es ReadOnly"
|
|
.C_CLASSPERFILE_OPTIMIZATION_BASE_ALREADY_PROCESSED_LOC = "Optimización: El archivo Base [<<JUSTFNAME(.c_InputFile)>>] ya fue procesado, ignorando el procesamiento del archivo [<<tc_InputFile>>]"
|
|
.C_CONFIGFILE_LOC = "Usando archivo de configuración:"
|
|
.C_CONVERSION_CANCELLED_BY_USER_LOC = "Conversión Cancelada por el usuario"
|
|
.C_CONVERT_ALL_FILES_IN_A_PROJECT_LOC = "Convertir todos los archivos de un Proyecto"
|
|
.C_CONVERT_FOLDER_LOC = "Convertir Carpeta"
|
|
.C_BINARY_TO_TEXT_LOC = "Binario a Texto"
|
|
.C_TEXT_TO_BINARY_LOC = "Texto a Binario"
|
|
.C_CONVERT_FOLDER_NONE_LOC = "Ninguna"
|
|
.C_CONVERT_FOLDER_QUESTION_LOC = "¿Qué tipo de conversión se debe hacer en esta carpeta?"
|
|
.C_CONVERTER_UNLOAD_LOC = "Descarga del conversor"
|
|
.C_CONVERTING_FILE_LOC = "Convirtiendo archivo"
|
|
.C_DATA_ERROR_CANT_PARSE_UNPAIRING_DOUBLE_QUOTES_LOC = "Error de datos: No se puede parsear porque las comillas no son pares en la línea <<lcMetadatos>>"
|
|
.C_DUPLICATED_FILE_LOC = "Archivo duplicado"
|
|
.C_DUPLICATED_OBJECT_LOC = "Objeto Duplicado"
|
|
.C_ENDDEFINE_MARKER_NOT_FOUND_LOC = "No se ha encontrado el marcador de fin [ENDDEFINE] de la línea <<TRANSFORM( toClase._Inicio )>> para el identificador [<<toClase._Nombre>>]"
|
|
.C_END_MARKER_NOT_FOUND_LOC = "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))>>"
|
|
.C_END_OF_PROCESS_LOC = "Fin del Proceso"
|
|
.C_ERROR_LOC = "ERROR"
|
|
.C_ERRORS_FOUND_IN_FILE_LOC = "SE HAN ENCONTRADOS ERRORES EN EL ARCHIVO"
|
|
.C_EXTENSION_RECONFIGURATION_LOC = "Reconfiguración de extensión:"
|
|
.C_EXTERNAL_CLASS_COUNT_DOES_NOT_MATCH_FOUND_CLASSES_LOC = "El conteo de clases externas (<<toModulo._ExternalClasses_Count>>) no coincide con la cantidad encontrada (<<toModulo._Clases_Count>>) para el archivo [<<toFoxBin2Prg.c_InputFile>>]"
|
|
.C_EXTERNAL_CLASS_NAME_WAS_NOT_FOUND_LOC = "No se encontró la clase externa"
|
|
.C_EXTERNAL_MEMBER_NAME_WAS_NOT_FOUND_LOC = "No se encontró el miembro externo"
|
|
.C_EXTERNAL_PARAMETERS_LOC = "PARÁMETROS EXTERNOS"
|
|
.C_FIELD_NOT_FOUND_ON_FILE_STRUCTURE_LOC = "No se encontró el campo [<<laProps(m.I)>>] en la estructura del archivo <<DBF('TABLABIN')>>"
|
|
.C_FILE_DOESNT_EXIST_LOC = "El archivo no existe:"
|
|
.C_FILE_NAME_IS_NOT_SUPPORTED_LOC = "El archivo [<<.c_InputFile>>] no está soportado"
|
|
.C_FILE_NOT_FOUND_LOC = "No se encontró el archivo"
|
|
.C_FILENAME_LOC = "Archivo"
|
|
.C_FOXBIN2PRG_ERROR_CAPTION_LOC = "ERROR"
|
|
.C_FOXBIN2PRG_SYNTAX_INFO_LOC = "INFORMACIÓN DE SINTAXIS Y PARÁMETROS"
|
|
TEXT TO .C_FOXBIN2PRG_SYNTAX_INFO_EXAMPLE_LOC TEXTMERGE NOSHOW FLAGS 1 PRETEXT 1+2
|
|
<<>>Página principal y descarga de FoxBin2Prg: https://github.com/fdbozzo/foxbin2prg/wiki - Fernando D. Bozzo (2013.11.25)
|
|
<<>>
|
|
<<>>FOXBIN2PRG.EXE [-c OutFileName] [-t OutFileName]
|
|
<<>>
|
|
<<>>-- Parameter details:
|
|
<<>>No parameter: Calls this info screen
|
|
<<>>-c creates a template config-file <OutFileName> (like FOXBIN2PRG.CFG)
|
|
<<>>-t creates a template table-config-file <OutFileName> (like <Tabellenname>.dbf.cfg)
|
|
<<>>
|
|
<<>>FOXBIN2PRG.EXE <cFileSpec.Ext> [cType [cTextName [cGenText [cDontShowErrors [cDebug [cDontShowProgress [cOriginalFileName [cRecompile [cNoTimestamps [cCFG_File] ] ] ] ] ] ] ] ] ]
|
|
<<>>
|
|
<<>>-- Detalle de parámetros:
|
|
<<>>cFileSpec.Ext: Nombre completo (fullpath) del archivo a convertir o del directorio a procesar
|
|
<<>> - Si indica 'BIN2PRG', se procesa el directorio indicado en tcType para generar los TX2
|
|
<<>> - Si indica 'PRG2BIN', se procesa el directorio indicado en tcType para generar los BIN
|
|
<<>> - En modo compatibilidad con SCCAPI (VSS), se usa para preguntar el tipo de soporte de conversión para el tipo de archivo indicado
|
|
<<>> VSS Types: d=DBC, D=DBF, K=Form, B=Label, M=Menu, R=Report, V=Class
|
|
<<>>cType: En modo compatibilidad con SCCAPI (VSS) es el Tipo de archivo de entrada.
|
|
<<>> - i indica '*' o '*-' y tc_InputFile es un PJX, se procesa todo el proyecto
|
|
<<>>cTextName = Nombre del archivo texto. (Solo para compatibilidad con Visual SourceSafe)
|
|
<<>>lGenText: .T.=Genera Texto, .F.=Genera Binario. Solo para compatibilidad con SCCAPI (VSS)
|
|
<<>>cDontShowErrors: '1' para NO mostrar errores
|
|
<<>>cDebug: '1' para generar LOGs del proceso, stop on errors
|
|
<<>>cDontShowProgress: '1' para NO mostrar la ventana de progreso
|
|
<<>>cOriginalFileName: Sirve para los casos en los que inputFile es un nombre temporal y se quiere generar el nombre correcto en la cabecera de la versión texto
|
|
<<>>cRecompile: Indica recompilar ('1') el binario una vez regenerado. También se puede indicar un Path (p.ej, el del proyecto)
|
|
<<>>cNoTimestamps: Indica si se debe anular el timestamp ('1' o vacío) o no ('0')
|
|
<<>>cCFG_File: Indica un nombre de archivo CFG para no usar el predeterminado en el directorio de foxbin2prg
|
|
<<>>
|
|
<<>>
|
|
ENDTEXT
|
|
TEXT TO .C_FOXBIN2PRG_SYNTAX_INFO_EXAMPLE_LOC_cfg TEXTMERGE NOSHOW FLAGS 1 PRETEXT 1+2
|
|
<<>>################################################################################################################
|
|
<<>>FOXBIN2PRG.CFG configuration options: (If no values given, these are the DEFAULTS)
|
|
<<>>Version: <<_Screen.c_FB2PRG_EXE_Version>>
|
|
<<>>################################################################################################################
|
|
<<>>
|
|
<<>>extension: tx2=newext && Specify extensions to use. Default FoxBin2Prg extensions ends in '2' (see at the bottom)
|
|
<<>>ShowProgressbar: 1 && 0=Don't show, 1=Allways show, 2= Show only for multi-file processing
|
|
<<>>DontShowErrors: 0 && Show message errors by default
|
|
<<>>NoTimestamps: 1 && Clear timestamps by default for minimize differences
|
|
<<>>Debug: 0 && Don't Activate individual <file>.Log by default
|
|
<<>>BodyDevInfo: 0 && [0=Don't keep DevInfo for body pjx records], 1=Keep DevInfo
|
|
<<>>ExtraBackupLevels: 1 && By default 1 BAK is created. With this you can make more .N.BAK, or none
|
|
<<>>ClearUniqueID: 1 && 0=Keep UniqueID in text files, 1=Clear Unique ID. Useful for Diff and Merge
|
|
<<>>ClearDBFLastUpdate: 1 && 0=Keep DBF LastUpdate, 1=Clear DBF LastUpdate. Useful for Diff.
|
|
<<>>OptimizeByFilestamp: 0 && 1=Optimize file regeneration depending on file timestamp. Dangerous while working with branches!
|
|
<<>>RemoveNullCharsFromCode: 1 && 1=Drop NULL chars from source code
|
|
<<>>RemoveZOrderSetFromProps: 0 && 0=Do not remove ZOrderSet property from object, 1=Remove ZOrderSet property from object
|
|
<<>>Language: (auto) && Language of shown messages and LOGs. EN=English, FR=French, ES=Español, DE=German, Not defined = AUTOMATIC [DEFAULT]
|
|
<<>>ExcludeDBFAutoincNextval: 0 && [0=Do not exclude this value from db2], 1=Exclude this value from db2
|
|
<<>>PRG_Compat_Level: 0 && [0=Legacy], 1=Use HELPSTRING as Class Procedure comment
|
|
<<>>
|
|
<<>>-- Convertion options:
|
|
<<>>PJX_Conversion_Support: 2 && 0=No support, 1=Generate TXT only (Diff), 2=Generate TXT and BIN (Merge)
|
|
<<>>VCX_Conversion_Support: 2 && 0=No support, 1=Generate TXT only (Diff), 2=Generate TXT and BIN (Merge)
|
|
<<>>SCX_Conversion_Support: 2 && 0=No support, 1=Generate TXT only (Diff), 2=Generate TXT and BIN (Merge)
|
|
<<>>FRX_Conversion_Support: 2 && 0=No support, 1=Generate TXT only (Diff), 2=Generate TXT and BIN (Merge)
|
|
<<>>LBX_Conversion_Support: 2 && 0=No support, 1=Generate TXT only (Diff), 2=Generate TXT and BIN (Merge)
|
|
<<>>MNX_Conversion_Support: 2 && 0=No support, 1=Generate TXT only (Diff), 2=Generate TXT and BIN (Merge)
|
|
<<>>FKY_Conversion_Support: 1 && 0=No support, 1=Generate TXT only (Diff)
|
|
<<>>MEM_Conversion_Support: 1 && 0=No support, 1=Generate TXT only (Diff)
|
|
<<>>DBC_Conversion_Support: 2 && 0=No support, 1=Generate TXT only (Diff), 2=Generate TXT and BIN (Merge)
|
|
<<>>DBF_Conversion_Support: 1 && 0=No support, 1=Generate Header TXT only (Diff), 2=Generate Header TXT and BIN (Merge/Only Structure!), 4=Generate TXT with DATA (Diff), 8=Export and Import DATA (Merge/Structure & Data)
|
|
<<>>DBF_Conversion_Included: * && If DBF_Conversion_Support:4, you can specify multiple filemasks: www,fb2p_free.dbf
|
|
<<>>DBF_Conversion_Excluded: && If DBF_Conversion_Support:4, you can specify multiple filemasks: www,fb2p_free.dbf
|
|
<<>>
|
|
<<>>-- DBC options
|
|
<<>>- File per DBC options (UseFilesPerDBC: 1)
|
|
<<>>OldFilesPerDBC: 0 && 1=Turns the File per DBC options on, 0 uses the old UseClassPerFile etc settings.
|
|
<<>> && Options below will only read if OldFilesPerDBC is set 1 before!
|
|
<<>> && If OldFilesPerDBC is set 0 later, alle setting will be lost
|
|
<<>>UseFilesPerDBC: 0 && 0=One database dc2 file, 1=Multiple file.*.*.dc2 files
|
|
<<>> && 0 creates only a file.dc2 with all DBC (file) data
|
|
<<>> && 1 creates a file.dc2 with DBC properties
|
|
<<>> && and additional DBC files per DBC item (stored-proc, table, ..)
|
|
<<>> && Note: recration only if RedirectFilePerDBCToMain is 1
|
|
<<>>RedirectFilePerDBCToMain 0 && 0=Don't redirect to file.dc2, 1=Redirect to file.tx2 when selecting file.item.*.dc2
|
|
<<>>ItemPerDBCCheck: 0 && 0=Don't check file.item.*.dc2 inclusion, 1=Check file.item.*.dc2 inclusion
|
|
<<>>DBF_BinChar_Base64: 1 && 0=For character type fields, if NoCPTrans 0=do not transform, 1=use Base64 transform (default)
|
|
<<>>DBF_IncludeDeleted: 0 && 0=Do not include deleted records (default), 1=Include deleted records
|
|
<<>>
|
|
<<>>-- CLASS and FORM options
|
|
<<>>- Class per file options (UseClassPerFile: 1)
|
|
<<>>UseClassPerFile: 0 && 0=One library tx2 file, 1=Multiple file.class.tx2 files, 2=Multiple file.baseclass.class.tx2 files
|
|
<<>>RedirectClassPerFileToMain: 0 && 0=Don't redirect to file.tx2, 1=Redirect to file.tx2 when selecting file.class.tx2
|
|
<<>>RedirectClassType: 0 && For classes created with UseClassPerFile>0 in the form file[.baseclass].class.tx2
|
|
<<>> && Those files could be imported like file.tx2::Class::import or like file[.baseclass].class.tx2
|
|
<<>> && For the second form:
|
|
<<>> && 0 Redirect file[.baseclass].class.tx2 to file.VCX and add / replace all other classes of this library
|
|
<<>> && 1 Redirect file[.baseclass].class.tx2 to file[.baseclass].class.VCX and do not touch file.VCX
|
|
<<>> && 2 Redirect file[.baseclass].class.tx2 to file.VCX and do not touch other classes of file.VCX
|
|
<<>>ClassPerFileCheck: 0 && 0=Don't check file.class.tx2 inclusion, 1=Check file.class.tx2 inclusion
|
|
<<>>
|
|
<<>>-- Example configuration for SourceSafe compatibility:
|
|
<<>>extension: pj2=pja && Text file to PJX
|
|
<<>>extension: vc2=vca && Text file to VCX
|
|
<<>>extension: sc2=sca && Text file to SCX
|
|
<<>>extension: fr2=fra && Text file to FRX
|
|
<<>>extension: lb2=lba && Text file to LBX
|
|
<<>>extension: mn2=mna && Text file to MNX
|
|
<<>>extension: db2=dba && Text file to DBF
|
|
<<>>extension: dc2=dca && Text file to DBC
|
|
<<>>-- Additional extensions
|
|
<<>>extension: fk2=fkx && Text file to FKY
|
|
<<>>extension: me2=fkx && Text file to MEM
|
|
<<>>
|
|
<<>>
|
|
ENDTEXT
|
|
TEXT TO .C_FOXBIN2PRG_SYNTAX_INFO_EXAMPLE_LOC_tab_cfg TEXTMERGE NOSHOW FLAGS 1 PRETEXT 1+2
|
|
<<>>-- Archivo de configuración individual para DBF (sintaxis: archivo.dbf.cfg) Defaults see FoxBin2prg.cfg
|
|
<<>>DBF_Conversion_Support: <1,2,4,8> && Ver esta misma configuración más arriba
|
|
<<>>DBF_Conversion_Order: <c_Expression> && Expresión de campo. ej: nombre+str(edad,3)
|
|
<<>>DBF_Conversion_Condition: <c_Expression> && Expresión lógica. ej: edad > 10 AND NOT DELETED()
|
|
<<>>DBF_BinChar_Base64: <0,1> && 0=For character type fields, if NoCPTrans 0=do not transform, 1=use Base64 transform
|
|
<<>>DBF_IncludeDeleted: <0,1> && 0=Do not include deleted records, 1=Include deleted records
|
|
<<>>
|
|
ENDTEXT
|
|
.C_FOXBIN2PRG_JUST_VFP_9_LOC = "¡FOXBIN2PRG es solo para Visual FoxPro 9.0!"
|
|
.C_FOXBIN2PRG_WARN_CAPTION_LOC = "¡ATENCIÓN!"
|
|
.C_GENERATED_FILE_SIZE_LOC = "Tamaño del archivo generado"
|
|
.C_GENERATING_BINARY_LOC = "Generando Binario"
|
|
.C_MENU_NOT_IN_VFP9_FORMAT_LOC = "El Menú [<<THIS.c_InputFile>>] NO está en formato VFP 9! - Por favor convertirlo a VFP 9 con MODIFY MENU '<<THIS.c_InputFile>>'"
|
|
.C_INCLUDING_CLASS_LOC = "Incluyendo clase"
|
|
.C_INCLUDING_MEMBER_LOC = "Incluyendo miembro"
|
|
.C_INCORRECT_VFP9_VERSION__MISSING_SP1_LOC = "Versión Incorrecta de VFP 9 - Falta el SP1! Esperado: 3504 o posterior, actual: " + Version(4)
|
|
.C_INHERITING_FROM_LOC = "Heredando desde"
|
|
.C_INTERACTIVE_DIRECTORY_SELECTION_LOC = "Selección Interactiva de Directorio"
|
|
.C_INVALID_PARAMETER_LOC = "Parámetro inválido"
|
|
.C_IS_A_FILE_LOC = "es un ARCHIVO"
|
|
.C_IS_A_DIRECTORY_LOC = "es un DIRECTORIO"
|
|
.C_IS_UNSUPPORTED_LOC = "no está soportado"
|
|
.C_LANGUAGE_LOC = "ES"
|
|
.C_MAIN_EXECUTION_LOC = "EJECUCIÓN PRINCIPAL"
|
|
.C_NAMES_CAPITALIZATION_PROGRAM_FOUND_LOC = "* Se ha encontrado el programa de capitalización de nombres [<<lcEXE_CAPS>>]"
|
|
.C_NAMES_CAPITALIZATION_PROGRAM_NOT_FOUND_LOC = "* No se ha encontrado el programa de capitalización de nombres [<<lcEXE_CAPS>>]"
|
|
.C_OBJECT_NAME_WITHOUT_OBJECT_OREG_LOC = "Objeto [<<toObj.CLASS>>] no contiene el objeto oReg (nivel <<TRANSFORM(tnNivel)>>)"
|
|
.C_ONLY_SETNAME_AND_GETNAME_RECOGNIZED_LOC = "Operación no reconocida. Solo re reconoce SETNAME y GETNAME."
|
|
.C_OPTIMIZATION_SKIPPING_ALREADY_PROCESSED_FILE_LOC = "Optimización: saltando el archivo ya procesado [<<(lcFile)>>]"
|
|
.C_OPTION_LOC = "Opción"
|
|
.C_OUTER_CLASS_DOES_NOT_MATCH_INNER_CLASSES_LOC = "La clase externa no coincide con las clases internas"
|
|
.C_OUTER_MEMBER_DOES_NOT_MATCH_INNER_MEMBERS_LOC = "El miembro externo no coincide con los miembros internos"
|
|
.C_OUTPUT_FILE_IS_NOT_OVERWRITEN_LOC = "Optimización: el archivo de salida [<<lcOutputFile>>] no se sobreescribe por ser igual al ya existente."
|
|
.C_OUTPUTFILE_TIMESTAMP_EQUAL_THAN_INPUTFILE_TIMESTAMP_LOC = "Optimización: el archivo de salida [<<THIS.c_OutputFile>>] no se regenera por tener el mismo timestamp que el de entrada."
|
|
.C_OUTPUTFILE_TIMESTAMP_NEWER_THAN_INPUTFILE_TIMESTAMP_LOC = "Optimización: el archivo de salida [<<THIS.c_OutputFile>>] no se regenera por tener un timestamp más nuevo que el de entrada."
|
|
.C_PRESS_ESC_TO_CANCEL = "Pulse Esc para Cancelar"
|
|
.C_PROCEDURE_NOT_CLOSED_ON_LINE_LOC = "Procedimiento sin cerrar. La última línea de código debe ser ENDPROC. [<<laLineas(1)>>, Recno:<<RECNO()>>]"
|
|
.C_PROCESSING_LOC = "Procesando archivo"
|
|
.C_PROCESS_PROGRESS_LOC = "Avance del proceso:"
|
|
.C_PROPERTY_NAME_NOT_RECOGNIZED_LOC = "Propiedad [<<TRANSFORM(tnPropertyID)>>] no reconocida."
|
|
.C_READING_CFG_VALUES_FROM_DISK_LOC = "LEYENDO VALORES DEL ARCHIVO CFG DEL DISCO"
|
|
.C_REPORT_NOT_IN_VFP9_FORMAT_LOC = "El Reporte [<<THIS.c_InputFile>>] NO está en formato VFP 9! - Por favor convertirlo a VFP 9 con MODIFY REPORT '<<THIS.c_InputFile>>'"
|
|
.C_REQUESTING_CAPITALIZATION_OF_FILE_LOC = "- Solicitado capitalizar el archivo [<<tcFileName>>]"
|
|
.C_SCANNING_FILE_AND_DIR_INFO_LOC = "Escaneando archivos e información de directorio para"
|
|
.C_SOURCEFILE_LOC = "Archivo origen: "
|
|
.C_SOURCESAFE_COMPATIBILITY_MODE_LOC = "Modo de Compatibilidad SourceSafe"
|
|
.C_STRUCTURE_NESTING_ERROR_ENDPROC_EXPECTED_LOC = "Error de anidamiento de estructuras. Se esperaba ENDPROC pero se encontró ENDDEFINE en la clase <<toClase._Nombre>> (<<loProcedure._Nombre>>), línea <<TRANSFORM(m.I)>> del archivo <<THIS.c_InputFile>>"
|
|
.C_STRUCTURE_NESTING_ERROR_ENDPROC_EXPECTED_2_LOC = "Error de anidamiento de estructuras. Se esperaba ENDPROC pero se encontró ENDDEFINE en la clase <<toClase._Nombre>> (<<toObjeto._Nombre>>.<<loProcedure._Nombre>>), línea <<TRANSFORM(m.I)>> del archivo <<THIS.c_InputFile>>"
|
|
.C_UNKNOWN_CLASS_NAME_LOC = "Clase [<<THIS.CLASS>>] desconocida"
|
|
.C_USE_FILE_TIMESTAMP_OPTIMIZATION_LOC = "Usar Optimización de filestamp de archivo"
|
|
.C_USING_THIS_SETTINGS_LOC = "Usando esta configuración"
|
|
.C_WARNING_LOC = "¡ATENCIÓN!"
|
|
.C_WARN_TABLE_ALIAS_ON_INDEX_EXPRESSION_LOC = "¡ATENCIÓN!" + CR_LF+ "ASEGÚRESE DE QUE NO ESTÁ USANDO UN ALIAS DE TABLA EN LAS EXPRESIONES DE LOS ÍNDICES!! (ej: index on <<UPPER(JUSTSTEM(THIS.c_InputFile))>>.campo tag nombreclave)"
|
|
.C_WITH_ERRORS_LOC = "con errores"
|
|
|
|
Case Inlist(tcLanguage, '49', 'DE') && German (Alemán)
|
|
*-------------------------------------------------------------------------------------------------------------------------------------------
|
|
*-- NOTE: ES MÜSSEN ANFÜHRUNGSZEICHEN BENUTZT WERDEN, ODER SYNTAX ERRORS PASSIEREN BEIM COMPILE. SELTSAM :(
|
|
*-------------------------------------------------------------------------------------------------------------------------------------------
|
|
.C_ALLOWED_VALUES_ARE_LOC = "Erlaubte Werte sind"
|
|
.C_ASTERISK_EXT_NOT_ALLOWED_LOC = "Die Erweiterungen * und ? sind nicht erlaubt, da sie gefährlich sind (Binaries könnten mit xx2 leeren Dateien überschrieben werden)"
|
|
.C_BACKLINK_CANT_UPDATE_BL_LOC = "Backlink kann nicht aktualisiert werden"
|
|
.C_BACKLINK_OF_TABLE_LOC = "von Tabelle"
|
|
.C_BACKUP_OF_LOC = "Erzeuge Backup von: "
|
|
.C_CACHING_CONFIG_FOR_DIRECTORY_LOC = "Caching Config für Verzeichnis"
|
|
.C_CANT_GENERATE_FILE_BECAUSE_IT_IS_READONLY_LOC = "Kann Datei [<<THIS.c_OutputFile>>] nicht generieren, da sie schreibgeschützt ist"
|
|
.C_CLASSPERFILE_OPTIMIZATION_BASE_ALREADY_PROCESSED_LOC = "Optimierung: Grund Datei [<<JUSTFNAME(.c_InputFile)>>] Schon verarbeitet, das Überspringen Verarbeitung der Datei [<<tc_InputFile>>]"
|
|
.C_CONFIGFILE_LOC = "Benutzte Konfigurationsdatei:"
|
|
.C_CONVERSION_CANCELLED_BY_USER_LOC = "Konvertierung durch den Benutzer abgebrochen"
|
|
.C_CONVERT_ALL_FILES_IN_A_PROJECT_LOC = "alle Dateien in einem Projekt zu konvertieren"
|
|
.C_CONVERT_FOLDER_LOC = "Konvertieren Verzeichnis"
|
|
.C_BINARY_TO_TEXT_LOC = "Binär zu Text"
|
|
.C_TEXT_TO_BINARY_LOC = "Text zu Binär"
|
|
.C_CONVERT_FOLDER_NONE_LOC = "Nichts"
|
|
.C_CONVERT_FOLDER_QUESTION_LOC = "Welche Umwandlung sollte sich auf die Dateien dieses Verzeichnis durchgeführt werden?"
|
|
.C_CONVERTER_UNLOAD_LOC = "Konverter wird entladen"
|
|
.C_CONVERTING_FILE_LOC = "Konvertiere Datei"
|
|
.C_DATA_ERROR_CANT_PARSE_UNPAIRING_DOUBLE_QUOTES_LOC = "Datenfehler: Keine Analyse möglich, da ungepaarte Anführungszeichen in Zeile <<lcMetadatos>> sind."
|
|
.C_DUPLICATED_FILE_LOC = "Doppelte Datei"
|
|
.C_DUPLICATED_OBJECT_LOC = "Doppelte Objekt"
|
|
.C_ENDDEFINE_MARKER_NOT_FOUND_LOC = "Kann keinen Ende Marker [ENDDEFINE] in Zeile <<TRANSFORM( toClase._Inicio )>> für die ID [<<toClase._Nombre>>] finden"
|
|
.C_END_MARKER_NOT_FOUND_LOC = "Kann keinen Ende Marker [<<ta_ID_Bloques(lnPrimerID,2)>>] welcher den Start Marker [<<ta_ID_Bloques(lnPrimerID,1)>>] in Zeile <<TRANSFORM(taBloquesExclusion(tnBloquesExclusion,1))>> schließt"
|
|
.C_END_OF_PROCESS_LOC = "Ende desr Prozesses"
|
|
.C_ERROR_LOC = "FEHLER"
|
|
.C_ERRORS_FOUND_IN_FILE_LOC = "FEHLER IN FILE GEFUNDEN"
|
|
.C_EXTENSION_RECONFIGURATION_LOC = "Neukonfiguration der Erweiterungen:" &&wir wollen es mal nicht übertreiben, mit den zusammengesetzten Substantiven
|
|
.C_EXTERNAL_CLASS_COUNT_DOES_NOT_MATCH_FOUND_CLASSES_LOC = "Die Anzahl externee Klassen (<< toModulo._ExternalClasses_Count >>) entspricht nicht der der gefunden Klassen (<< toModulo._Clases_Count >>), Datei: [<< toFoxBin2Prg.c_InputFile >>]"
|
|
.C_EXTERNAL_CLASS_NAME_WAS_NOT_FOUND_LOC = "Keine externe Klasse gefunden"
|
|
.C_EXTERNAL_MEMBER_NAME_WAS_NOT_FOUND_LOC = "Externe Mitglied wurde nicht gefunden"
|
|
.C_EXTERNAL_PARAMETERS_LOC = "EXTERNE PARAMETER"
|
|
.C_FIELD_NOT_FOUND_ON_FILE_STRUCTURE_LOC = "Feld [<<laProps(m.I)>>] nicht in der Struktur von Datei <<DBF('TABLABIN')>> gefunden"
|
|
.C_FILE_DOESNT_EXIST_LOC = "Datei existiert nicht:"
|
|
.C_FILE_NAME_IS_NOT_SUPPORTED_LOC = "Datei [<<.c_InputFile>>] wird nicht unterstützt"
|
|
.C_FILE_NOT_FOUND_LOC = "Datei nicht gefunden"
|
|
.C_FILENAME_LOC = "Datei"
|
|
.C_FOXBIN2PRG_ERROR_CAPTION_LOC = "FEHLER"
|
|
.C_FOXBIN2PRG_SYNTAX_INFO_LOC = "SYNTAX UND PARAMETER INFORMATION"
|
|
TEXT TO .C_FOXBIN2PRG_SYNTAX_INFO_EXAMPLE_LOC TEXTMERGE NOSHOW FLAGS 1 PRETEXT 1+2
|
|
<<>>################################################################################################################
|
|
<<>>FoxBin2Prg Home Page and download: https://github.com/fdbozzo/foxbin2prg/wiki - Fernando D. Bozzo (2013.11.25)
|
|
<<>>
|
|
<<>>################################################################################################################
|
|
<<>>FOXBIN2PRG.EXE [-c OutFileName] [-t OutFileName]
|
|
<<>>
|
|
<<>>-- Parameter:
|
|
<<>>Keine Parameter: Startet dieses Formular
|
|
<<>>-c Erzeugt eine Vorlage <OutFileName> für eine Config-Datei (wie FOXBIN2PRG.CFG)
|
|
<<>>-t Erzeugt eine Vorlage <OutFileName> für eine Tabellen-Config-Datei (wie <Tabellenname>.dbf.cfg)
|
|
<<>>
|
|
<<>>****************************************************************************************************************
|
|
<<>>FOXBIN2PRG.EXE <cFileSpec.Ext> [cType [cTextName [cGenText [cDontShowErrors [cDebug [cDontShowProgress [cOriginalFileName [cRecompile [cNoTimestamps [cCFG_File] ] ] ] ] ] ] ] ] ]
|
|
<<>>
|
|
<<>>-- Parameter:
|
|
<<>>cFileSpec.Ext: Vollständiger Name der Datei (mit Pfad) zum Konvertieren, oder das Verzeichnis zum Konvertieren
|
|
<<>> - wenn 'BIN2PRG' spezifiziert ist, wird das Verzeichnis in cType (!!) zum Erstellen der Textdateien genutzt
|
|
<<>> - wenn 'PRG2BIN' spezifiziert ist, wird das Verzeichnis in cType (!!) zum Erstellen der Binärdateien genutzt
|
|
<<>> - Im SCCAPI (VSS) Kompatibilitätsmodus, wird dies zur Abfrage der Unterstützung der Umwandlung für den genannten Dateityp genutzt
|
|
<<>> VSS Types: d=DBC, D=DBF, K=Form, B=Label, M=Menu, R=Report, V=Class
|
|
<<>>cType: Im SCCAPI (VSS) Kompatibilitätsmodus wird hier der Dateityp der Input-Datei festgelegt
|
|
<<>> - Wird hier '*' oder '*-' angegeben, und tc_InputFile ist ein PJX, werden alle Dateien im PJX konvertiert
|
|
<<>>cTextName: Text Dateiname. Nur im SCCAPI (VSS) Kompatibilitätsmodus.
|
|
<<>>lGenText: .T.=Erzeuge Text, .F.=Erzeuge Binary. Nur im SCCAPI (VSS) Kompatibilitätsmodus.
|
|
<<>>cDontShowErrors: '1' Unterdrückt die Anzeige von Fehlern
|
|
<<>>cDebug: '1' Erzeugt LOG Dateien, Halte bei Fehlern an
|
|
<<>>cDontShowProgress: '1' Zeige kein Fortschrittsfenster
|
|
<<>>cOriginalFileName: Falls als Inputdatei eine temporäre Datei genutz wird, kann hier fürden Kopf der Textdatei der richtige Name angegeben werden.
|
|
<<>>cRecompile: '1' Die erzeugten Binädateien werden nach dem Erzeugen kompiliert. Eine Pfadangabe (d.h., die des Projektes) ist möglich.
|
|
<<>>cNoTimestamps: Legt fest ob der Zeitstempel gelöscht wrden soll ('1' oder leer) oder nicht ('0')
|
|
<<>>cCFG_File: Legt eine alternative Configurationsdate (CFG) fest, die statt der im foxbin2prg Verzeichnis genutzt werden soll. (Anm. des Übersetzers: Keine Angabe über Vererbung in der Verzeichnishierarchie)
|
|
<<>>
|
|
ENDTEXT
|
|
TEXT TO .C_FOXBIN2PRG_SYNTAX_INFO_EXAMPLE_LOC_cfg TEXTMERGE NOSHOW FLAGS 1 PRETEXT 1+2
|
|
<<>>################################################################################################################
|
|
<<>>FOXBIN2PRG.CFG Konfigurations Optionen: (Wird die Option nicht aufgeführt, ist der Wert im Beispiel der Default)
|
|
<<>>Version: <<_Screen.c_FB2PRG_EXE_Version>>
|
|
<<>>
|
|
<<>> Achtung, die Konfigurationsdatein werden vererbt.
|
|
<<>> 1. Defaultwerte
|
|
<<>> 2., optional FOXBIN2PRG.CFG im Vereichnis aus dem FOXBIN2PRG.EXE startet
|
|
<<>> 3., optional FOXBIN2PRG.CFG in der Wurzel des Arbeitsverzeichnises
|
|
<<>> 4., optional FOXBIN2PRG.CFG in jedem Verzeichnis bis zum Arbeitsverzeichnis
|
|
<<>> 5., optional Es können spezielle Einstellungen für einzelne DBF's erzeugt werden (Syntax: <Tabellenname>.dbf.cfg im Verzeichnis der Tabelle)
|
|
<<>> 6., Parameter des Aufrufs von FOXBIN2PRG.EXE.
|
|
<<>>
|
|
<<>> Einige Parameter im Aufruf von FOXBIN2PRG.EXE übersteuert diese Vorgaben (bis auf die Defaults)
|
|
<<>>****************************************************************************************************************
|
|
<<>>
|
|
<<>>extension: tx2=newext && Umdefinition der Dateiendung der Textdateien. Die vordefinierten Endungen enden mit '2' (Beispiel siehe Ende dieser Datei)
|
|
<<>>ShowProgressbar: 1 && 0=Zeige Fortschrittsfenster, 1=Zeige es nicht, 2= Zeige Fortschrittsfenster nur, wen mehrere Dateien konvertiert werden.
|
|
<<>>DontShowErrors: 0 && 0=Zeige Fehler an, 1=Zeige keine Fehler an
|
|
<<>>NoTimestamps: 1 && 0=Zeitstempel werden nicht gelöscht 1=Zeitstempel werden für minimale Unterschiede gelöscht
|
|
<<>>Debug: 0 && 0=Individuelles Logging ist aus 1= Individuelles Log per Datei <Datei>.Log
|
|
<<>>BodyDevInfo: 0 && 0=DevInfo im body-pjx-Datensatz wird nicht erhalten], 1=DevInfo wird erhalten
|
|
<<>>ExtraBackupLevels: 1 && Anzahl der Backup-Ebenen der Binärdateien 0=kein Backup, 1=<Datei>.BAK, n>1= n-Backup-Ebenen, <Datei>.n.BAK
|
|
<<>>ClearUniqueID: 1 && 0=Erhalte die Unique ID in den Text-Dateien, 1=Lösche Unique ID. Nützlich für Diff und Merge
|
|
<<>>ClearDBFLastUpdate: 1 && 0=Erhalte DBF LastUpdate, 1=Lösche DBF LastUpdate. Nützlich für Diff und Merge
|
|
<<>>OptimizeByFilestamp: 0 && 0=Aus, 1=Optimierte Erzeugung der Binärdateien in Abhängigkeit vom Zeitstempel. Gefährlich beim Arbeiten mit Zweigen!
|
|
<<>>RemoveNullCharsFromCode: 1 && 0=Aus 1=Lösche NULL (CHR(0)) Zeichen aus dem Quellcode
|
|
<<>>RemoveZOrderSetFromProps: 0 && 0=Aus, 1=Entferne ZOrderSet Eigenschaft von Objekten
|
|
<<>>Language: (auto) && Sprache für Anzeigen und Logs. EN=English, FR=Français, ES=Español, DE=Deutsch, Nicht definiert = Automatisch [DEFAULT]
|
|
<<>>ExcludeDBFAutoincNextval: 0 && 0=Aus, 1=Entferne diesen Wert aus der Textdate der Datenbank (db2)
|
|
<<>>PRG_Compat_Level: 0 && [0=Legacy], 1=Nutze HELPSTRING als Class Procedure Kommentar
|
|
<<>>
|
|
<<>>----------------------------------------------------------------------------------------------------------------
|
|
<<>>-- Konvertierungs Optionen:
|
|
<<>>PJX_Conversion_Support: 2 && 0=Aus, 1=Erzeuge nur Textdatei (Diff), 2=Erzeuge Text- und Binärdatei (Merge)
|
|
<<>>VCX_Conversion_Support: 2 && 0=Aus, 1=Erzeuge nur Textdatei (Diff), 2=Erzeuge Text- und Binärdatei (Merge)
|
|
<<>>SCX_Conversion_Support: 2 && 0=Aus, 1=Erzeuge nur Textdatei (Diff), 2=Erzeuge Text- und Binärdatei (Merge)
|
|
<<>>FRX_Conversion_Support: 2 && 0=Aus, 1=Erzeuge nur Textdatei (Diff), 2=Erzeuge Text- und Binärdatei (Merge)
|
|
<<>>LBX_Conversion_Support: 2 && 0=Aus, 1=Erzeuge nur Textdatei (Diff), 2=Erzeuge Text- und Binärdatei (Merge)
|
|
<<>>MNX_Conversion_Support: 2 && 0=Aus, 1=Erzeuge nur Textdatei (Diff), 2=Erzeuge Text- und Binärdatei (Merge)
|
|
<<>>FKY_Conversion_Support: 1 && 0=Aus, 1=Erzeuge nur Textdatei (Diff)
|
|
<<>>MEM_Conversion_Support: 1 && 0=Aus, 1=Erzeuge nur Textdatei (Diff)
|
|
<<>>DBC_Conversion_Support: 2 && 0=Aus, 1=Erzeuge nur Textdatei (Diff), 2=Erzeuge Text- und Binärdatei (Merge)
|
|
<<>>DBF_Conversion_Support: 1 && 0=Aus
|
|
<<>> && 1=Erzeuge Textdatei nur für Struktur (Diff)
|
|
<<>> && 2=Erzeuge Text- und Binärdatei nur für Struktur (Merge)
|
|
<<>> && 4=Erzeuge Textdatei nur für Struktur und Daten (Diff)
|
|
<<>> && 8=Erzeuge Text- und Binärdatei nur für Struktur und Daten (Merge)
|
|
<<>>DBF_Conversion_Included: * && Für DBF_Conversion_Support: 4 kann eine mehrfache Dateimaske zum Einbeziehen angegeben werden, z.B.: www,fb2p_free.dbf
|
|
<<>> && *=Alle, Die Maske darf Wildcards (*,?) enthalten
|
|
<<>> && Diese Option kann auch per Tabelle gesetzt werden.
|
|
<<>>DBF_Conversion_Excluded: && Für DBF_Conversion_Support: 4 kann eine mehrfache Dateimaske zum Ausschließen angegeben werden, z.B.: www,fb2p_free.dbf
|
|
<<>> && Leer=Keine Datei auschließen
|
|
<<>>
|
|
<<>>----------------------------------------------------------------------------------------------------------------
|
|
<<>>-- Optionen für DBC
|
|
<<>>- Optionen für Datei per DBC options (UseFilesPerDBC: 1)
|
|
<<>>OldFilesPerDBC: 0 && 1=Die unten stehenden DBC Optionen werden aktiviert, 0=Die UseClassPerFile settings werden genutzt.
|
|
<<>> && Die unten stehenden Optionen werden nur gelesen, wenn OldFilesPerDBC vorher 1 ist!
|
|
<<>> && Wird OldFilesPerDBC wieder auf 0 gesetzt, gehen diese Einstellungen verloren.
|
|
<<>>UseFilesPerDBC: 0 && 0=Erzeuge eine dc2 Datei, 1=Erzeuge mehrfache Dateien.*.*.dc2
|
|
<<>> && 0 Erzeugt eine Datei <Datenbank>.db2 mit allem Inhalt der DBC
|
|
<<>> && 1 Erzeugt eine Datei <Datenbank>.dc2 mit den Eigenschaften der Datenbank
|
|
<<>> && und zusätzlich eine Datei für jedes Item der Datenbank (Gespeicherte Prozeduren, Tabellen, Views, ..)
|
|
<<>> && Achtung! Diese Dateien werden nur dann in die Binädatei einbezogen, wenn RedirectFilePerDBCToMain 1 ist
|
|
<<>>RedirectFilePerDBCToMain 0 && Originale Dokumntation: 0=Keine Umlenkung, 1=Erzeuge <Datenbank>.dbc, wenn <Datenbank>.item.*.dc2 gewählt wurde
|
|
<<>> && Die Bimär-Datenbank wird nur dann automatisch zusammen gefügt, wenn diese Option 1 ist!
|
|
<<>>ItemPerDBCCheck: 0 && 0=Aus, 1=Teste, ob <Datenbank>.item.*.dc2 einbezogen wird.
|
|
<<>>
|
|
<<>>----------------------------------------------------------------------------------------------------------------
|
|
<<>>-- Optionen für DBF (Transformation der DBF)
|
|
<<>>DBF_BinChar_Base64: 1 && Für Felder mit Zeicehn Typ (C,V,M), wenn NoCPTrans, dann 0=nicht transform,ieren, 1=Führe Base64 Transformation aus (default)
|
|
<<>> && Dies entspricht dem Flag 4096 in CursorToXML()
|
|
<<>> && Diese Option kann auch per Tabelle gesetzt werden.
|
|
<<>>DBF_IncludeDeleted: 0 && 0=Ohne gelöschte Datensätze (default), 1=Mit gelöschten Datensätzen
|
|
<<>> && Diese Option kann auch per Tabelle gesetzt werden.
|
|
<<>>
|
|
<<>>----------------------------------------------------------------------------------------------------------------
|
|
<<>>
|
|
<<>>-- Optionen für CLASS und FORM
|
|
<<>>- Optionen für Datei per Klasse (UseClassPerFile: 1) (für VCX: vc2, für SCX: sc2)
|
|
<<>>UseClassPerFile: 0 && 0=Eine Textdatei pro VCX/SCX, 1=Mehrere Dateien <Dateiname>.KlassenName.vc2 files, 2=Mehrere Dateien <Dateiname>.Basisklasse.KlassenName.vc2
|
|
<<>> && Für 1, 2 wird jeweils auch ein Headerdatei <Dateiname>.vc2 erzeugt
|
|
<<>>RedirectClassPerFileToMain: 0 && 0=Keine Umlenkung, 1=Klassen (und Objekte) werden in die VCX/SCX geschrieben wenn eine Datei <Dateiname>[.Basisklasse].KlassenName.vc2 gewählt wurde
|
|
<<>>RedirectClassType: 0 && Für Textdateien die mit UseClassPerFile>0 in der Form file[.baseclass].class.tx2 erstellt wurden.
|
|
<<>> && diese Dateien können als file.tx2::Class::import oder als file[.baseclass].class.tx2 importiert werden.
|
|
<<>> && Für die zweite Form gilt:
|
|
<<>> && 0 Aus file[.baseclass].class.tx2 wird file.VCX und alle dclassen dieser Bibliothek werden neu gelesen
|
|
<<>> && 1 Aus file[.baseclass].class.tx2 wird file[.baseclass].class.VCX, die Bibliothek file.VCX wird ignoriert
|
|
<<>> && 2 Aus file[.baseclass].class.tx2 wird file.VCX aber alle anderen Klassen bleiben unverändert
|
|
<<>>ClassPerFileCheck: 0 && 0=Aus, 1=Teste, ob die Datei einbezogen <Dateiname>[.Basisklasse].KlassenName.vc2 wurde
|
|
<<>>
|
|
<<>>----------------------------------------------------------------------------------------------------------------
|
|
<<>>-- Beispiel für geänderte Textdatei Endungen, hier für SourceSafe Kompatibiltät:
|
|
<<>>extension: pj2=pja && Text Datei für PJX
|
|
<<>>extension: vc2=vca && Text Datei für VCX
|
|
<<>>extension: sc2=sca && Text Datei für SCX
|
|
<<>>extension: fr2=fra && Text Datei für FRX
|
|
<<>>extension: lb2=lba && Text Datei für LBX
|
|
<<>>extension: mn2=mna && Text Datei für MNX
|
|
<<>>extension: db2=dba && Text Datei für DBF
|
|
<<>>extension: dc2=dca && Text Datei für DBC
|
|
<<>>-- Zusätzliche Endungen
|
|
<<>>extension: fk2=fkx && Text Datei für FKY
|
|
<<>>extension: me2=fkx && Text Datei für MEM
|
|
<<>>
|
|
<<>>
|
|
ENDTEXT
|
|
TEXT TO .C_FOXBIN2PRG_SYNTAX_INFO_EXAMPLE_LOC_tab_cfg TEXTMERGE NOSHOW FLAGS 1 PRETEXT 1+2
|
|
<<>>################################################################################################################
|
|
<<>>-- Individual DBF configuration file (Syntax: <Tabellenname>.dbf.cfg im Verzeichnis der Tabelle) Defaults siehe FoxBin2prg.cfg
|
|
<<>>DBF_Conversion_Support: <1,2,4,8> && 0=Aus
|
|
<<>> && 1=Erzeuge Textdatei nur für Struktur (Diff)
|
|
<<>> && 2=Erzeuge Text- und Binärdatei nur für Struktur (Merge)
|
|
<<>> && 4=Erzeuge Textdatei nur für Struktur und Daten (Diff)
|
|
<<>> && 8=Erzeuge Text- und Binärdatei nur für Struktur und Daten (Merge)
|
|
<<>>DBF_Conversion_Order: <c_Expression> && Optional, Reihenfolge der Datensätze. Ausdruck für INDEX ON. ie: name+str(age,3)
|
|
<<>> && leer: normale Reihenfolge
|
|
<<>>DBF_Conversion_Condition: <c_Expression> && Optional, Ausdruck für SELECT FOR. ie: age > 10 AND NOT DELETED()
|
|
<<>> && leer: Alle, außer DBF_IncludeDeleted
|
|
<<>>DBF_BinChar_Base64: <0,1> && Für Felder mit Zeicehn Typ (C,V,M), wenn NoCPTrans, dann 0=nicht transform,ieren, 1=Führe Base64 Transformation aus
|
|
<<>> && Dies entspricht dem Flag 4096 in CursorToXML()
|
|
<<>> && Diese Option kann auch per Tabelle gesetzt werden.
|
|
<<>>DBF_IncludeDeleted: <0,1> && 0=Ohne gelöschte Datensätze, 1=Mit gelöschten Datensätzen
|
|
<<>> && Diese Option kann auch per Tabelle gesetzt werden.
|
|
<<>>
|
|
ENDTEXT
|
|
.C_FOXBIN2PRG_JUST_VFP_9_LOC = "FOXBIN2PRG arbeitet nur für Visual FoxPro 9.0!"
|
|
.C_FOXBIN2PRG_WARN_CAPTION_LOC = "WARNUNG!"
|
|
.C_GENERATED_FILE_SIZE_LOC = "Generierte Dateigröße"
|
|
.C_GENERATING_BINARY_LOC = "Gene Binary"
|
|
.C_INCLUDING_CLASS_LOC = "einschließlich Klasse"
|
|
.C_INCLUDING_MEMBER_LOC = "inklusive Mitglied"
|
|
.C_INCORRECT_VFP9_VERSION__MISSING_SP1_LOC = "Quell-Kompatibilitäts-Mode Incorrect VFP 9 Version - Fehlende SP1! Erwartet: 3504 oder größer, aktuell:" + Version(4)
|
|
.C_INHERITING_FROM_LOC = "Ererbt von"
|
|
.C_INTERACTIVE_DIRECTORY_SELECTION_LOC = "Interaktives Auswählen des Verzeichnises"
|
|
.C_INVALID_PARAMETER_LOC = "Ungültige Parameter"
|
|
.C_IS_A_FILE_LOC = "ist eine DATEI"
|
|
.C_IS_A_DIRECTORY_LOC = "ist ein VERZEICHNIS"
|
|
.C_IS_UNSUPPORTED_LOC = "wird nicht unterstützt"
|
|
.C_LANGUAGE_LOC = "DE"
|
|
.C_MAIN_EXECUTION_LOC = "HAUPTAUSFÜHRUNG"
|
|
.C_MENU_NOT_IN_VFP9_FORMAT_LOC = "Menü [<<THIS.c_InputFile>>] ist NICHT im VFP 9 Format! - Bitte zuerst mit MODIFY MENU '<<THIS.c_InputFile>>' nach VFP 9 konvertieren."
|
|
.C_NAMES_CAPITALIZATION_PROGRAM_FOUND_LOC = "* Programm für Großschreibungssetzung [<<lcEXE_CAPS>>] gefunden"
|
|
.C_NAMES_CAPITALIZATION_PROGRAM_NOT_FOUND_LOC = "* Programm für Großschreibungssetzung [<<lcEXE_CAPS>>] nicht gefunden"
|
|
.C_OBJECT_NAME_WITHOUT_OBJECT_OREG_LOC = "Objekt [<<toObj.CLASS>>] enthält nicht das oReg Objekt (level <<TRANSFORM(tnNivel)>>)"
|
|
.C_ONLY_SETNAME_AND_GETNAME_RECOGNIZED_LOC = "Befehl nicht erkannt. Nur SETNAME und GETNAME erlaubt."
|
|
.C_OPTIMIZATION_SKIPPING_ALREADY_PROCESSED_FILE_LOC = "Optimierung: Überspringen von bereits bearbeiteten Datei [<<(lcFile)>>]"
|
|
.C_OPTION_LOC = "Option"
|
|
.C_OUTER_CLASS_DOES_NOT_MATCH_INNER_CLASSES_LOC = "Die äußere Klasse zeigt nicht die die innere Klassifizierung an"
|
|
.C_OUTER_MEMBER_DOES_NOT_MATCH_INNER_MEMBERS_LOC = "Das äußere Element entspricht nicht den inneren Elementen"
|
|
.C_OUTPUT_FILE_IS_NOT_OVERWRITEN_LOC = "Optimierung: Ausgabedatei [<<lcOutputFile>>] wurde nicht überschrieben, da sie dieselbe ist wie die neu generierte."
|
|
.C_OUTPUTFILE_TIMESTAMP_EQUAL_THAN_INPUTFILE_TIMESTAMP_LOC = "Optimierung: Ausgabedatei [<<THIS.c_OutputFile>>] wurde nicht verlängert, weil ihre Zeitmarke die gleiche der Quelldatei ist."
|
|
.C_OUTPUTFILE_TIMESTAMP_NEWER_THAN_INPUTFILE_TIMESTAMP_LOC = "Optimierung: Ausgabedatei [<<THIS.c_OutputFile>>] wurde nicht erneuert, da sie neuer als die Ursprungsdatei ist."
|
|
.C_PRESS_ESC_TO_CANCEL = "Drücken Sie Esc zum Abbrechen"
|
|
.C_PROCEDURE_NOT_CLOSED_ON_LINE_LOC = "Prozedur nicht geschlossen. Letzte Zeile des Codes muss ENDPROC sein. [<<laLineas(1)>>, Recno:<<RECNO()>>]"
|
|
.C_PROCESSING_LOC = "Bearbeite Datei"
|
|
.C_PROCESS_PROGRESS_LOC = "Bearbeitungsfortschritt:"
|
|
.C_PROPERTY_NAME_NOT_RECOGNIZED_LOC = "Eigenschaft [<<TRANSFORM(tnPropertyID)>>] nicht erkannt."
|
|
.C_READING_CFG_VALUES_FROM_DISK_LOC = "Von der Festplatte gelesene Werte der CFG-DATEI"
|
|
.C_REPORT_NOT_IN_VFP9_FORMAT_LOC = "Report [<<THIS.c_InputFile>>] ist NICHT in VFP 9 Format! - Bitte zuerst nach VFP 9 konvertieren mit MODIFY REPORT '<<THIS.c_InputFile>>'"
|
|
.C_REQUESTING_CAPITALIZATION_OF_FILE_LOC = "- Fordere Großschreibung für Datei [<<tcFileName>>] an"
|
|
.C_SCANNING_FILE_AND_DIR_INFO_LOC = "Scanne Datei- und Verzeichnisinformationen für"
|
|
.C_SOURCEFILE_LOC = "Quell Datei: "
|
|
.C_SOURCESAFE_COMPATIBILITY_MODE_LOC = "Sourcesafe-Kompatibilitätsmodus"
|
|
.C_STRUCTURE_NESTING_ERROR_ENDPROC_EXPECTED_LOC = "Fehler in Verschachtelungsstruktur. ENDPROC erwartet, aber es wurde ENDDEFINE in Klasse <<toClase._Nombre>> (<<loProcedure._Nombre>>), Zeile <<TRANSFORM(m.I)>> der Datei <<THIS.c_InputFile>> gefunden"
|
|
.C_STRUCTURE_NESTING_ERROR_ENDPROC_EXPECTED_2_LOC = "Fehler in Verschachtelungsstruktur. ENDPROC wurde erwartet, aber es wurde ENDDEFINE in Klasse <<toClase._Nombre>> (<<toObjeto._Nombre>>.<<loProcedure._Nombre>>), Zeile <<TRANSFORM(m.I)>> der Datei <<THIS.c_InputFile>> gefunden"
|
|
.C_UNKNOWN_CLASS_NAME_LOC = "Unbekannte Klasse [<<THIS.CLASS>>]"
|
|
.C_USE_FILE_TIMESTAMP_OPTIMIZATION_LOC = "Verwenden Sie die Datei-Zeitstempel-Optimierung"
|
|
.C_USING_THIS_SETTINGS_LOC = "Mit dieser Einstellung"
|
|
.C_WARNING_LOC = "WARNUNG!"
|
|
.C_WARN_TABLE_ALIAS_ON_INDEX_EXPRESSION_LOC = "WARNUNG!" + CR_LF+ "STELLEN SIE SICHER, DAS KEIN TABELLENALIAS IM INDEXAUSDRUCK BENUTZT WIRD!! (z.B.: index on <<UPPER(JUSTSTEM(THIS.c_InputFile))>>.campo tag keyname)"
|
|
.C_WITH_ERRORS_LOC = "mit Fehlern"
|
|
|
|
Otherwise && English (Inglés)
|
|
*-------------------------------------------------------------------------------------------------------------------------------------------
|
|
*-- NOTE: MUST USE DOUBLE QUOTES, OR SYNTAX ERRORS HAPPEN WHEN COMPILING. STRANGE :(
|
|
*-------------------------------------------------------------------------------------------------------------------------------------------
|
|
.C_ALLOWED_VALUES_ARE_LOC = "Allowed values are"
|
|
.C_ASTERISK_EXT_NOT_ALLOWED_LOC = "* and ? extensions are not allowed because it's dangerous (binaries can be overwritten with xx2 empty files)"
|
|
.C_BACKLINK_CANT_UPDATE_BL_LOC = "Could not update backlink"
|
|
.C_BACKLINK_OF_TABLE_LOC = "of table"
|
|
.C_BACKUP_OF_LOC = "Doing Backup of: "
|
|
.C_CACHING_CONFIG_FOR_DIRECTORY_LOC = "Caching config for directory"
|
|
.C_CANT_GENERATE_FILE_BECAUSE_IT_IS_READONLY_LOC = "Cannot generate file [<<THIS.c_OutputFile>>] because it is ReadOnly"
|
|
.C_CLASSPERFILE_OPTIMIZATION_BASE_ALREADY_PROCESSED_LOC = "Optimization: Base File [<<JUSTFNAME(.c_InputFile)>>] already processed, skipping processing of file [<<tc_InputFile>>]"
|
|
.C_CONFIGFILE_LOC = "Using configuration file:"
|
|
.C_CONVERSION_CANCELLED_BY_USER_LOC = "Conversion Cancelled by the user"
|
|
.C_CONVERT_ALL_FILES_IN_A_PROJECT_LOC = "Convert all files in a Project"
|
|
.C_CONVERT_FOLDER_LOC = "Convert Folder"
|
|
.C_BINARY_TO_TEXT_LOC = "Binary to Text"
|
|
.C_TEXT_TO_BINARY_LOC = "Text to Binary"
|
|
.C_CONVERT_FOLDER_NONE_LOC = "None"
|
|
.C_CONVERT_FOLDER_QUESTION_LOC = "What conversion should be performed on the files of this folder?"
|
|
.C_CONVERTER_UNLOAD_LOC = "Converter unload"
|
|
.C_CONVERTING_FILE_LOC = "Converting file"
|
|
.C_DATA_ERROR_CANT_PARSE_UNPAIRING_DOUBLE_QUOTES_LOC = "Data Error: Can't parse because of unpaired double-quotes on line <<lcMetadatos>>"
|
|
.C_DUPLICATED_FILE_LOC = "Duplicated file"
|
|
.C_DUPLICATED_OBJECT_LOC = "Duplicated Object"
|
|
.C_ENDDEFINE_MARKER_NOT_FOUND_LOC = "Cannot find end marker [ENDDEFINE] of line <<TRANSFORM( toClase._Inicio )>> for ID [<<toClase._Nombre>>]"
|
|
.C_END_MARKER_NOT_FOUND_LOC = "Cannot find end marker [<<ta_ID_Bloques(lnPrimerID,2)>>] that closes start marker [<<ta_ID_Bloques(lnPrimerID,1)>>] on line <<TRANSFORM(taBloquesExclusion(tnBloquesExclusion,1))>>"
|
|
.C_END_OF_PROCESS_LOC = "End of Process"
|
|
.C_ERROR_LOC = "ERROR"
|
|
.C_ERRORS_FOUND_IN_FILE_LOC = "ERRORS FOUND IN FILE"
|
|
.C_EXTENSION_RECONFIGURATION_LOC = "Extension Reconfiguration:"
|
|
.C_EXTERNAL_CLASS_COUNT_DOES_NOT_MATCH_FOUND_CLASSES_LOC = "External class count (<<toModulo._ExternalClasses_Count>>) does not match found classes (<<toModulo._Clases_Count>>) for file [<<toFoxBin2Prg.c_InputFile>>]"
|
|
.C_EXTERNAL_CLASS_NAME_WAS_NOT_FOUND_LOC = "External class was not found"
|
|
.C_EXTERNAL_MEMBER_NAME_WAS_NOT_FOUND_LOC = "External member name was not found"
|
|
.C_EXTERNAL_PARAMETERS_LOC = "EXTERNAL PARAMETERS"
|
|
.C_FIELD_NOT_FOUND_ON_FILE_STRUCTURE_LOC = "Field [<<laProps(m.I)>>] not found in structure of file <<DBF('TABLABIN')>>"
|
|
.C_FILE_DOESNT_EXIST_LOC = "File does not exist:"
|
|
.C_FILE_NAME_IS_NOT_SUPPORTED_LOC = "File [<<.c_InputFile>>] is not supported"
|
|
.C_FILE_NOT_FOUND_LOC = "File not found"
|
|
.C_FILENAME_LOC = "File"
|
|
.C_FOXBIN2PRG_ERROR_CAPTION_LOC = "ERROR"
|
|
.C_FOXBIN2PRG_SYNTAX_INFO_LOC = "SYNTAX AND PARAMETERS INFO"
|
|
TEXT TO .C_FOXBIN2PRG_SYNTAX_INFO_EXAMPLE_LOC TEXTMERGE NOSHOW FLAGS 1 PRETEXT 1+2
|
|
<<>>FoxBin2Prg Home Page and download: https://github.com/fdbozzo/foxbin2prg/wiki - Fernando D. Bozzo (2013.11.25)
|
|
<<>>
|
|
<<>>FOXBIN2PRG.EXE [-c OutFileName] [-t OutFileName]
|
|
<<>>
|
|
<<>>-- Parameter details:
|
|
<<>>No parameter: Calls this info screen
|
|
<<>>-c creates a template config-file <OutFileName> (like FOXBIN2PRG.CFG)
|
|
<<>>-t creates a template table-config-file <OutFileName> (like <Tabellenname>.dbf.cfg)
|
|
<<>>
|
|
<<>>FOXBIN2PRG.EXE <cFileSpec.Ext> [cType [cTextName [cGenText [cDontShowErrors [cDebug [cDontShowProgress [cOriginalFileName [cRecompile [cNoTimestamps [cCFG_File] ] ] ] ] ] ] ] ] ]
|
|
<<>>
|
|
<<>>-- Parameter details:
|
|
<<>>cFileSpec.Ext: Full name (fullpath) of the file to convert or directory name to process
|
|
<<>> - If 'BIN2PRG' is specified, the directory specified in tcType is processed for generating TX2
|
|
<<>> - If 'PRG2BIN' is specified, the directory specified in tcType is processed for regenerating BIN
|
|
<<>> - In SCCAPI (VSS) compatibility mode, it is used to query the conversion support for the file type specified
|
|
<<>> VSS Types: d=DBC, D=DBF, K=Form, B=Label, M=Menu, R=Report, V=Class
|
|
<<>>cType: In SCCAPI (VSS) compatibility mode indicates the input file type.
|
|
<<>> - If specified '*' or '*-' and tc_InputFile is a PJX, all project files are processed
|
|
<<>>cTextName = Text filename. Only for SCCAPI (VSS) compatibility mode.
|
|
<<>>lGenText: .T.=Generates Text, .F.=Regenerates Binary. Only for SCCAPI (VSS) compatibility mode.
|
|
<<>>cDontShowErrors: '1' for NOT showing errors
|
|
<<>>cDebug: '1' for generating process LOGs, stop on errors
|
|
<<>>cDontShowProgress: '1' for NOT showing the process window
|
|
<<>>cOriginalFileName: used in those cases in which inputFile is a temporary filename and you want to generate the correct filename on the header of the text version
|
|
<<>>cRecompile: Indicates recompile ('1') the binary once regenerated. You can specify a Path too (ie, the project one)
|
|
<<>>cNoTimestamps: Indicates if timestamp must be cleared ('1' or empty) or not ('0')
|
|
<<>>cCFG_File: Indicates a CFG filename for not using the default on foxbin2prg directory
|
|
<<>>
|
|
<<>>
|
|
ENDTEXT
|
|
TEXT TO .C_FOXBIN2PRG_SYNTAX_INFO_EXAMPLE_LOC_cfg TEXTMERGE NOSHOW FLAGS 1 PRETEXT 1+2
|
|
<<>>################################################################################################################
|
|
<<>>FOXBIN2PRG.CFG configuration options: (If no values given, these are the DEFAULTS)
|
|
<<>>Version: <<_Screen.c_FB2PRG_EXE_Version>>
|
|
<<>>################################################################################################################
|
|
<<>>
|
|
<<>>extension: tx2=newext && Specify extensions to use. Default FoxBin2Prg extensions ends in '2' (see at the bottom)
|
|
<<>>ShowProgressbar: 1 && 0=Don't show, 1=Allways show, 2= Show only for multi-file processing
|
|
<<>>DontShowErrors: 0 && Show message errors by default
|
|
<<>>NoTimestamps: 1 && Clear timestamps by default for minimize differences
|
|
<<>>Debug: 0 && Don't Activate individual <file>.Log by default
|
|
<<>>BodyDevInfo: 0 && [0=Don't keep DevInfo for body pjx records], 1=Keep DevInfo
|
|
<<>>ExtraBackupLevels: 1 && By default 1 BAK is created. With this you can make more .N.BAK, or none
|
|
<<>>ClearUniqueID: 1 && 0=Keep UniqueID in text files, 1=Clear Unique ID. Useful for Diff and Merge
|
|
<<>>ClearDBFLastUpdate: 1 && 0=Keep DBF LastUpdate, 1=Clear DBF LastUpdate. Useful for Diff.
|
|
<<>>OptimizeByFilestamp: 0 && 1=Optimize file regeneration depending on file timestamp. Dangerous while working with branches!
|
|
<<>>RemoveNullCharsFromCode: 1 && 1=Drop NULL chars from source code
|
|
<<>>RemoveZOrderSetFromProps: 0 && 0=Do not remove ZOrderSet property from object, 1=Remove ZOrderSet property from object
|
|
<<>>Language: (auto) && Language of shown messages and LOGs. EN=English, FR=French, ES=Español, DE=German, Not defined = AUTOMATIC [DEFAULT]
|
|
<<>>ExcludeDBFAutoincNextval: 0 && [0=Do not exclude this value from db2], 1=Exclude this value from db2
|
|
<<>>PRG_Compat_Level: 0 && [0=Legacy], 1=Use HELPSTRING as Class Procedure comment
|
|
<<>>
|
|
<<>>-- Convertion options:
|
|
<<>>PJX_Conversion_Support: 2 && 0=No support, 1=Generate TXT only (Diff), 2=Generate TXT and BIN (Merge)
|
|
<<>>VCX_Conversion_Support: 2 && 0=No support, 1=Generate TXT only (Diff), 2=Generate TXT and BIN (Merge)
|
|
<<>>SCX_Conversion_Support: 2 && 0=No support, 1=Generate TXT only (Diff), 2=Generate TXT and BIN (Merge)
|
|
<<>>FRX_Conversion_Support: 2 && 0=No support, 1=Generate TXT only (Diff), 2=Generate TXT and BIN (Merge)
|
|
<<>>LBX_Conversion_Support: 2 && 0=No support, 1=Generate TXT only (Diff), 2=Generate TXT and BIN (Merge)
|
|
<<>>MNX_Conversion_Support: 2 && 0=No support, 1=Generate TXT only (Diff), 2=Generate TXT and BIN (Merge)
|
|
<<>>FKY_Conversion_Support: 1 && 0=No support, 1=Generate TXT only (Diff)
|
|
<<>>MEM_Conversion_Support: 1 && 0=No support, 1=Generate TXT only (Diff)
|
|
<<>>DBC_Conversion_Support: 2 && 0=No support, 1=Generate TXT only (Diff), 2=Generate TXT and BIN (Merge)
|
|
<<>>DBF_Conversion_Support: 1 && 0=No support, 1=Generate Header TXT only (Diff), 2=Generate Header TXT and BIN (Merge/Only Structure!), 4=Generate TXT with DATA (Diff), 8=Export and Import DATA (Merge/Structure & Data)
|
|
<<>>DBF_Conversion_Included: * && If DBF_Conversion_Support:4, you can specify multiple filemasks: www,fb2p_free.dbf
|
|
<<>>DBF_Conversion_Excluded: && If DBF_Conversion_Support:4, you can specify multiple filemasks: www,fb2p_free.dbf
|
|
<<>>
|
|
<<>>-- DBC options
|
|
<<>>- File per DBC options (UseFilesPerDBC: 1)
|
|
<<>>OldFilesPerDBC: 0 && 1=Turns the File per DBC options on, 0 uses the old UseClassPerFile etc settings.
|
|
<<>> && Options below will only read if OldFilesPerDBC is set 1 before!
|
|
<<>> && If OldFilesPerDBC is set 0 later, alle setting will be lost
|
|
<<>>UseFilesPerDBC: 0 && 0=One database dc2 file, 1=Multiple file.*.*.dc2 files
|
|
<<>> && 0 creates only a file.dc2 with all DBC (file) data
|
|
<<>> && 1 creates a file.dc2 with DBC properties
|
|
<<>> && and additional DBC files per DBC item (stored-proc, table, ..)
|
|
<<>> && Note: recration only if RedirectFilePerDBCToMain is 1
|
|
<<>>RedirectFilePerDBCToMain 0 && 0=Don't redirect to file.dc2, 1=Redirect to file.tx2 when selecting file.item.*.dc2
|
|
<<>>ItemPerDBCCheck: 0 && 0=Don't check file.item.*.dc2 inclusion, 1=Check file.item.*.dc2 inclusion
|
|
<<>>DBF_BinChar_Base64: 1 && 0=For character type fields, if NoCPTrans 0=do not transform, 1=use Base64 transform (default)
|
|
<<>>DBF_IncludeDeleted: 0 && 0=Do not include deleted records (default), 1=Include deleted records
|
|
<<>>
|
|
<<>>-- CLASS and FORM options
|
|
<<>>- Class per file options (UseClassPerFile: 1)
|
|
<<>>UseClassPerFile: 0 && 0=One library tx2 file, 1=Multiple file.class.tx2 files, 2=Multiple file.baseclass.class.tx2 files
|
|
<<>>RedirectClassPerFileToMain: 0 && 0=Don't redirect to file.tx2, 1=Redirect to file.tx2 when selecting file.class.tx2
|
|
<<>>RedirectClassType: 0 && For classes created with UseClassPerFile>0 in the form file[.baseclass].class.tx2
|
|
<<>> && Those files could be imported like file.tx2::Class::import or like file[.baseclass].class.tx2
|
|
<<>> && For the second form:
|
|
<<>> && 0 Redirect file[.baseclass].class.tx2 to file.VCX and add / replace all other classes of this library
|
|
<<>> && 1 Redirect file[.baseclass].class.tx2 to file[.baseclass].class.VCX and do not touch file.VCX
|
|
<<>> && 2 Redirect file[.baseclass].class.tx2 to file.VCX and do not touch other classes of file.VCX
|
|
<<>>ClassPerFileCheck: 0 && 0=Don't check file.class.tx2 inclusion, 1=Check file.class.tx2 inclusion
|
|
<<>>
|
|
<<>>-- Example configuration for SourceSafe compatibility:
|
|
<<>>extension: pj2=pja && Text file to PJX
|
|
<<>>extension: vc2=vca && Text file to VCX
|
|
<<>>extension: sc2=sca && Text file to SCX
|
|
<<>>extension: fr2=fra && Text file to FRX
|
|
<<>>extension: lb2=lba && Text file to LBX
|
|
<<>>extension: mn2=mna && Text file to MNX
|
|
<<>>extension: db2=dba && Text file to DBF
|
|
<<>>extension: dc2=dca && Text file to DBC
|
|
<<>>-- Additional extensions
|
|
<<>>extension: fk2=fkx && Text file to FKY
|
|
<<>>extension: me2=fkx && Text file to MEM
|
|
<<>>
|
|
<<>>
|
|
ENDTEXT
|
|
TEXT TO .C_FOXBIN2PRG_SYNTAX_INFO_EXAMPLE_LOC_tab_cfg TEXTMERGE NOSHOW FLAGS 1 PRETEXT 1+2
|
|
<<>>-- Individual DBF configuration file (syntax: filename.dbf.cfg) Defaults see FoxBin2prg.cfg
|
|
<<>>DBF_Conversion_Support: <0,1,2,4,8> && 0=No support, 1=Generate Header TXT only (Diff), 2=Generate Header TXT and BIN (Merge/Only Structure!), 4=Generate TXT with DATA (Diff), 8=Export and Import DATA (Merge/Structure & Data)
|
|
<<>>DBF_Conversion_Order: <c_Expression> && Field expresion. ie: name+str(age,3)
|
|
<<>>DBF_Conversion_Condition: <c_Expression> && Logical expression. ie: age > 10 AND NOT DELETED()
|
|
<<>>DBF_BinChar_Base64: <0,1> && 0=For character type fields, if NoCPTrans 0=do not transform, 1=use Base64 transform
|
|
<<>>DBF_IncludeDeleted: <0,1> && 0=Do not include deleted records, 1=Include deleted records
|
|
<<>>
|
|
ENDTEXT
|
|
.C_FOXBIN2PRG_JUST_VFP_9_LOC = "FOXBIN2PRG is only for Visual FoxPro 9.0!"
|
|
.C_FOXBIN2PRG_WARN_CAPTION_LOC = "WARNING!"
|
|
.C_GENERATED_FILE_SIZE_LOC = "Generated file size"
|
|
.C_GENERATING_BINARY_LOC = "Generating Binary"
|
|
.C_INCLUDING_CLASS_LOC = "Including class"
|
|
.C_INCLUDING_MEMBER_LOC = "Including member"
|
|
.C_INCORRECT_VFP9_VERSION__MISSING_SP1_LOC = "Incorrect VFP 9 version - Missing SP1! Expected: 3504 or later, actual: " + Version(4)
|
|
.C_INHERITING_FROM_LOC = "Inheriting from"
|
|
.C_INTERACTIVE_DIRECTORY_SELECTION_LOC = "Interactive Directory Selection"
|
|
.C_INVALID_PARAMETER_LOC = "Invalid parameter"
|
|
.C_IS_A_FILE_LOC = "is a FILE"
|
|
.C_IS_A_DIRECTORY_LOC = "is a DIRECTORY"
|
|
.C_IS_UNSUPPORTED_LOC = "is unsupported"
|
|
.C_LANGUAGE_LOC = "EN"
|
|
.C_MAIN_EXECUTION_LOC = "MAIN EXECUTION"
|
|
.C_MENU_NOT_IN_VFP9_FORMAT_LOC = "Menu [<<THIS.c_InputFile>>] is NOT in VFP 9 Format! - Please convert to VFP 9 with MODIFY MENU '<<THIS.c_InputFile>>'"
|
|
.C_NAMES_CAPITALIZATION_PROGRAM_FOUND_LOC = "* Names capitalization program [<<lcEXE_CAPS>>] found"
|
|
.C_NAMES_CAPITALIZATION_PROGRAM_NOT_FOUND_LOC = "* Names capitalization program [<<lcEXE_CAPS>>] not found"
|
|
.C_OBJECT_NAME_WITHOUT_OBJECT_OREG_LOC = "Object [<<toObj.CLASS>>] does not contain oReg object (level <<TRANSFORM(tnNivel)>>)"
|
|
.C_ONLY_SETNAME_AND_GETNAME_RECOGNIZED_LOC = "Operation not recognized. Only SETNAME and GETNAME allowed."
|
|
.C_OPTIMIZATION_SKIPPING_ALREADY_PROCESSED_FILE_LOC = "Optimization: skipping already processed file [<<(lcFile)>>]"
|
|
.C_OPTION_LOC = "Option"
|
|
.C_OUTER_CLASS_DOES_NOT_MATCH_INNER_CLASSES_LOC = "The outer class does not match the inner classes"
|
|
.C_OUTER_MEMBER_DOES_NOT_MATCH_INNER_MEMBERS_LOC = "The outer member does not match the inner members"
|
|
.C_OUTPUT_FILE_IS_NOT_OVERWRITEN_LOC = "Optimization: output file [<<lcOutputFile>>] was not overwritten because it is the same as the existing one."
|
|
.C_OUTPUTFILE_TIMESTAMP_EQUAL_THAN_INPUTFILE_TIMESTAMP_LOC = "Optimization: output file [<<THIS.c_OutputFile>>] was not regenerated because it's filestamp is equal than the inputfile."
|
|
.C_OUTPUTFILE_TIMESTAMP_NEWER_THAN_INPUTFILE_TIMESTAMP_LOC = "Optimization: output file [<<THIS.c_OutputFile>>] was not regenerated because it's filestamp is newer than the inputfile."
|
|
.C_PRESS_ESC_TO_CANCEL = "Press Esc to Cancel"
|
|
.C_PROCEDURE_NOT_CLOSED_ON_LINE_LOC = "Procedure not closed. Last line of code must be ENDPROC. [<<laLineas(1)>>, Recno:<<RECNO()>>]"
|
|
.C_PROCESSING_LOC = "Processing file"
|
|
.C_PROCESS_PROGRESS_LOC = "Process Progress:"
|
|
.C_PROPERTY_NAME_NOT_RECOGNIZED_LOC = "Property [<<TRANSFORM(tnPropertyID)>>] is not recognized."
|
|
.C_READING_CFG_VALUES_FROM_DISK_LOC = "READING CFG VALUES FROM DISK"
|
|
.C_REPORT_NOT_IN_VFP9_FORMAT_LOC = "Report [<<THIS.c_InputFile>>] is NOT in VFP 9 Format! - Please convert to VFP 9 with MODIFY REPORT '<<THIS.c_InputFile>>'"
|
|
.C_REQUESTING_CAPITALIZATION_OF_FILE_LOC = "- Requesting capitalization of file [<<tcFileName>>]"
|
|
.C_SCANNING_FILE_AND_DIR_INFO_LOC = "Scanning file and directory information for"
|
|
.C_SOURCEFILE_LOC = "Source file: "
|
|
.C_SOURCESAFE_COMPATIBILITY_MODE_LOC = "SourceSafe Compatibility Mode"
|
|
.C_STRUCTURE_NESTING_ERROR_ENDPROC_EXPECTED_LOC = "Nesting structure error. ENDPROC expected but found ENDDEFINE on class <<toClase._Nombre>> (<<loProcedure._Nombre>>), line <<TRANSFORM(m.I)>> of file <<THIS.c_InputFile>>"
|
|
.C_STRUCTURE_NESTING_ERROR_ENDPROC_EXPECTED_2_LOC = "Nesting structure error. ENDPROC expected but found ENDDEFINE on class <<toClase._Nombre>> (<<toObjeto._Nombre>>.<<loProcedure._Nombre>>), line <<TRANSFORM(m.I)>> of file <<THIS.c_InputFile>>"
|
|
.C_UNKNOWN_CLASS_NAME_LOC = "Unknown class [<<THIS.CLASS>>]"
|
|
.C_USE_FILE_TIMESTAMP_OPTIMIZATION_LOC = "Use file timestamp Optimization"
|
|
.C_USING_THIS_SETTINGS_LOC = "Using this settings"
|
|
.C_WARNING_LOC = "WARNING!"
|
|
.C_WARN_TABLE_ALIAS_ON_INDEX_EXPRESSION_LOC = "WARNING!" + CR_LF+ "MAKE SURE YOU ARE NOT USING A TABLE ALIAS ON INDEX KEY EXPRESSIONS!! (ex: index on <<UPPER(JUSTSTEM(THIS.c_InputFile))>>.campo tag keyname)"
|
|
.C_WITH_ERRORS_LOC = "with errors"
|
|
.n_LanguageSelectedMethod = 0 && 0=Automatic with VERSION(3)
|
|
|
|
Endcase
|
|
Endwith && THIS AS CL_LANG OF 'FOXBIN2PRG.PRG'
|
|
Endtry
|
|
Endproc
|
|
|
|
Enddefine
|
|
|
|
|
|
|
|
Define Class CL_DBF_CFG As Custom
|
|
_MemberData = [<VFPData>] ;
|
|
+ [<memberdata name="dbf_conversion_order" display="DBF_Conversion_Order"/>] ;
|
|
+ [<memberdata name="dbf_conversion_condition" display="DBF_Conversion_Condition"/>] ;
|
|
+ [<memberdata name="dbf_conversion_support" display="DBF_Conversion_Support"/>] ;
|
|
+ [<memberdata name="l_dbf_binchar_base64" display="l_DBF_BinChar_Base64"/>] ;
|
|
+ [<memberdata name="l_dbf_includedeleted" display="l_DBF_IncludeDeleted"/>] ;
|
|
+ [</VFPData>]
|
|
|
|
#If .F.
|
|
Local This As CL_DBF_CFG Of 'FOXBIN2PRG.PRG'
|
|
#Endif
|
|
|
|
|
|
*-- Configuration class. By default asumes master value, except when overriding one.
|
|
DBF_Conversion_Order = ''
|
|
DBF_Conversion_Condition = ''
|
|
DBF_Conversion_Support = Null
|
|
l_DBF_BinChar_Base64 = .Null.
|
|
l_DBF_IncludeDeleted = .Null.
|
|
Enddefine
|
|
|
|
|
|
|
|
Define Class CL_MACRO As CL_COL_BASE
|
|
#If .F.
|
|
Local This As CL_MACRO Of 'FOXBIN2PRG.PRG'
|
|
#Endif
|
|
|
|
_MemberData = [<VFPData>] ;
|
|
+ [<memberdata name="c_inputfile" display="c_InputFile"/>] ;
|
|
+ [<memberdata name="_numberofmacros" display="_NumberOfMacros"/>] ;
|
|
+ [<memberdata name="_debug" display="_Debug"/>] ;
|
|
+ [<memberdata name="_signature" display="_Signature"/>] ;
|
|
+ [<memberdata name="get_datafrommacrofky" display="get_DataFromMacroFKY"/>] ;
|
|
+ [<memberdata name="_macros" display="_Macros"/>] ;
|
|
+ [</VFPData>]
|
|
|
|
|
|
c_InputFile = ''
|
|
|
|
*-- Macro Header
|
|
_Signature = ''
|
|
_Debug = .F.
|
|
_NumberOfMacros = ''
|
|
_Macros = Null && Colección de macros
|
|
|
|
|
|
|
|
Procedure Init
|
|
DoDefault()
|
|
This._Macros = Createobject("COLLECTION")
|
|
Endproc
|
|
|
|
|
|
Procedure get_DataFromMacroFKY(tcInputFile As String, toFoxBin2Prg)
|
|
*---------------------------------------------------------------------------------------------------
|
|
* PARÁMETROS: (v=Pasar por valor | @=Pasar por referencia) (!=Obligatorio | ?=Opcional) (IN/OUT)
|
|
* tcInputFile (!v IN ) Archivo de entrada
|
|
* toFoxBin2Prg (!@ IN ) Referencia al objeto principal
|
|
*---------------------------------------------------------------------------------------------------
|
|
#If .F.
|
|
Local toFoxBin2Prg As c_foxbin2prg Of 'FOXBIN2PRG.PRG'
|
|
#Endif
|
|
|
|
Local lnHandle, lnFileLen, lcMsg, lcStr, lnNumberOfMacros ;
|
|
, loMRec As CL_MACRO_RECORD Of 'FOXBIN2PRG.PRG' ;
|
|
, loColl As Collection ;
|
|
, loEx As Exception
|
|
|
|
Try
|
|
lnHandle = -1
|
|
|
|
With This As CL_MACRO Of 'FOXBIN2PRG.PRG'
|
|
loColl = ._Macros
|
|
lnHandle = Fopen(tcInputFile, 0)
|
|
|
|
If lnHandle = -1
|
|
lcMsg = toFoxBin2Prg.FERROR_Message(tcInputFile)
|
|
Error (lcMsg)
|
|
Endif
|
|
|
|
lnFileLen = Fseek(lnHandle, 0, 2)
|
|
|
|
If lnFileLen < 17
|
|
Error 'Invalid FKY Macro File size'
|
|
Else
|
|
=Fseek(lnHandle, 0, 0)
|
|
Endif
|
|
|
|
._Signature = Fread(lnHandle, 2)
|
|
|
|
If ._Signature <> Chr(0xFF)+Chr(0x79)
|
|
Error 'Invalid FKY Macro signature'
|
|
Endif
|
|
|
|
=Fseek(lnHandle, 14, 1) && Saltar bytes ignorados
|
|
|
|
._NumberOfMacros = Fread(lnHandle, 2)
|
|
lnNumberOfMacros = CToBin(._NumberOfMacros,'2RS')
|
|
|
|
If lnFileLen < 17 + 25 * lnNumberOfMacros
|
|
* 25 caracteres es el tamaño mínimo de una macro sin teclas guardadas (solo la estructura)
|
|
Error 'Invalid FKY Macro File size'
|
|
Endif
|
|
|
|
For I = 1 To lnNumberOfMacros
|
|
loMRec = Createobject("CL_MACRO_RECORD")
|
|
|
|
If Not loMRec.ReadNextMacro(lnHandle)
|
|
Exit
|
|
Endif
|
|
|
|
loColl.Add( loMRec, loMRec.get_Macro_Keystrokes(loMRec.Keystroke, .T.) )
|
|
loMRec = Null
|
|
Endfor
|
|
|
|
* Ordenar alfabéticamente por keystroke
|
|
loColl.KeySort = 2
|
|
|
|
Endwith
|
|
|
|
Catch To loEx
|
|
*loEx.UserValue = loEx.UserValue + 'lcAsignacion = [' + TRANSFORM(lcAsignacion) + ']' + CR_LF
|
|
|
|
If This.n_Debug > 0 And _vfp.StartMode = 0
|
|
Set Step On
|
|
Endif
|
|
|
|
Throw
|
|
|
|
Finally
|
|
If lnHandle <> -1
|
|
=Fclose(lnHandle)
|
|
Endif
|
|
Endtry
|
|
|
|
Return
|
|
Endproc
|
|
|
|
|
|
Procedure toText
|
|
*---------------------------------------------------------------------------------------------------
|
|
* PARÁMETROS: (v=Pasar por valor | @=Pasar por referencia) (!=Obligatorio | ?=Opcional) (IN/OUT)
|
|
*---------------------------------------------------------------------------------------------------
|
|
Local lcText, loMRec As CL_MACRO_RECORD Of 'FOXBIN2PRG.PRG'
|
|
lcText = ''
|
|
|
|
With This As CL_MACRO Of 'FOXBIN2PRG.PRG'
|
|
|
|
*-- Macros
|
|
For Each loMRec As CL_MACRO_RECORD Of 'FOXBIN2PRG.PRG' In ._Macros
|
|
lcText = lcText + CR_LF + loMRec.toText()
|
|
Endfor
|
|
|
|
Endwith
|
|
|
|
Return lcText
|
|
Endproc
|
|
|
|
|
|
Enddefine
|
|
|
|
|
|
|
|
Define Class CL_MACRO_RECORD As CL_CUS_BASE
|
|
_MemberData = [<VFPData>] ;
|
|
+ [<memberdata name="macro_name" display="Macro_Name"/>] ;
|
|
+ [<memberdata name="macro_length" display="Macro_Length"/>] ;
|
|
+ [<memberdata name="keystroke" display="Keystroke"/>] ;
|
|
+ [<memberdata name="macro_keystrokes" display="Macro_Keystrokes"/>] ;
|
|
+ [<memberdata name="readnextmacro" display="ReadNextMacro"/>] ;
|
|
+ [<memberdata name="totext" display="toText"/>] ;
|
|
+ [<memberdata name="tobin" display="toBin"/>] ;
|
|
+ [<memberdata name="get_macro_keystrokes" display="get_Macro_Keystrokes"/>] ;
|
|
+ [<memberdata name="get_keytext" display="get_KeyText"/>] ;
|
|
+ [</VFPData>]
|
|
|
|
*--
|
|
Macro_Name = ''
|
|
Macro_Length = ''
|
|
Keystroke = ''
|
|
Macro_Keystrokes = ''
|
|
|
|
|
|
Procedure ReadNextMacro(tnHandle As Integer)
|
|
*---------------------------------------------------------------------------------------------------
|
|
* PARÁMETROS: (v=Pasar por valor | @=Pasar por referencia) (!=Obligatorio | ?=Opcional) (IN/OUT)
|
|
* tnHandle (!v IN ) FKY file handle
|
|
*---------------------------------------------------------------------------------------------------
|
|
Local lnMacro_Length
|
|
|
|
Try
|
|
With This As CL_MACRO_RECORD Of 'FOXBIN2PRG.PRG'
|
|
.Macro_Name = Fread(tnHandle, 20)
|
|
.Macro_Length = Fread(tnHandle, 2)
|
|
.Keystroke = Fread(tnHandle, 2)
|
|
lnMacro_Length = CToBin(.Macro_Length, '2RS')
|
|
.Macro_Keystrokes = Fread(tnHandle, lnMacro_Length * 2)
|
|
Endwith
|
|
Endtry
|
|
|
|
Return
|
|
Endproc
|
|
|
|
|
|
Procedure toBin As String
|
|
*---------------------------------------------------------------------------------------------------
|
|
* PARÁMETROS: (v=Pasar por valor | @=Pasar por referencia) (!=Obligatorio | ?=Opcional) (IN/OUT)
|
|
*---------------------------------------------------------------------------------------------------
|
|
Local lcText
|
|
|
|
With This As CL_MACRO_RECORD Of 'FOXBIN2PRG.PRG'
|
|
|
|
Endwith
|
|
|
|
Return lcText
|
|
Endproc
|
|
|
|
|
|
Procedure toText As String
|
|
*---------------------------------------------------------------------------------------------------
|
|
* PARÁMETROS: (v=Pasar por valor | @=Pasar por referencia) (!=Obligatorio | ?=Opcional) (IN/OUT)
|
|
*---------------------------------------------------------------------------------------------------
|
|
Local lcText, loField As CL_MACRO_RECORD Of 'FOXBIN2PRG.PRG'
|
|
lcText = ''
|
|
|
|
With This As CL_MACRO_RECORD Of 'FOXBIN2PRG.PRG'
|
|
TEXT TO lcText ADDITIVE TEXTMERGE NOSHOW FLAGS 1+2 PRETEXT 1+2
|
|
<<>><MACRO>
|
|
<<>> Macro_Name : <<ALLTRIM(.Macro_Name, 0, CHR(0), CHR(32))>>
|
|
<<>> Keystroke : <<.get_Macro_Keystrokes(.Keystroke, .T.)>>
|
|
<<>> Macro_Keystrokes: <<.get_Macro_Keystrokes(.Macro_Keystrokes)>>
|
|
<<>></MACRO>
|
|
ENDTEXT
|
|
|
|
Endwith
|
|
|
|
Return lcText
|
|
Endproc
|
|
|
|
|
|
Function get_Macro_Keystrokes(tcMacroStr, tlLiteralForCaption)
|
|
*---------------------------------------------------------------------------------------------------
|
|
* DEVLUELVE LOS LITERALES DE TODAS LAS TECLAS
|
|
*---------------------------------------------------------------------------------------------------
|
|
* PARÁMETROS: (v=Pasar por valor | @=Pasar por referencia) (!=Obligatorio | ?=Opcional) (IN/OUT)
|
|
*---------------------------------------------------------------------------------------------------
|
|
Local lcKeystrokes, I
|
|
|
|
With This As CL_MACRO_RECORD Of 'FOXBIN2PRG.PRG'
|
|
lcKeystrokes = ''
|
|
|
|
For I = 1 To Len(tcMacroStr) Step 2
|
|
lcKeystrokes = lcKeystrokes + .get_KeyText(@tcMacroStr, @I, tlLiteralForCaption)
|
|
Endfor
|
|
Endwith
|
|
|
|
Return lcKeystrokes
|
|
Endfunc
|
|
|
|
|
|
Function get_KeyText(tcMacroStr As String, I As Integer, tlLiteralForCaption As Boolean) As String
|
|
*---------------------------------------------------------------------------------------------------
|
|
* DEVLUELVE EL LITERAL DE UNA TECLA
|
|
*---------------------------------------------------------------------------------------------------
|
|
* PARÁMETROS: (v=Pasar por valor | @=Pasar por referencia) (!=Obligatorio | ?=Opcional) (IN/OUT)
|
|
* tcMacroStr (!@ IN ) Cadena de teclas de la macro
|
|
* I (!@ IN ) Posición actualmente analizada de la cadena
|
|
* tlLiteralForCaption (?v IN ) Indica si algunos caracteres especiales se deben convertir a literal (ej: ";" => "SHIFT+SEMICOLON")
|
|
*---------------------------------------------------------------------------------------------------
|
|
Local lcMod, lcKey, lcKeyName, lcKeyMod, lcTecla, lnKeyVal, lcKeyPair, lnCntMod ;
|
|
, llComplementar, llKeyCodeShift, llKeyCodeCtrl, llKeyCodeAlt, lnMod, lnKey
|
|
|
|
Store '' To lcTecla, lcKeyName, lcKeyMod, lcKey
|
|
lcKeyPair = Substr(tcMacroStr,I,2)
|
|
lnKeyVal = CToBin(lcKeyPair, '2RS')
|
|
lcKey = Left(lcKeyPair,1)
|
|
lcMod = Right(lcKeyPair,1)
|
|
lnMod = Asc(lcMod)
|
|
lnKey = Asc(lcKey)
|
|
lnCntMod = 0
|
|
|
|
* Tratamiento de modificadores
|
|
If Not lcKeyPair == Chr(0xFE)+Chr(0xFF)
|
|
If Bitand(lnMod, 0x80) = 0x80 && LITERAL
|
|
lcKeyMod = lcKeyMod + Iif(Empty(lcKeyMod),'','+') + 'LITERAL'
|
|
Endif
|
|
If Bitand(lnMod, 0x40) = 0x40 && ALT
|
|
*lcKeyMod = lcKeyMod + IIF(EMPTY(lcKeyMod),'','+') + 'ALT'
|
|
llKeyCodeAlt = .T.
|
|
lnCntMod = lnCntMod + 1
|
|
Endif
|
|
If Bitand(lnMod, 0x20) = 0x20 && CTRL
|
|
*lcKeyMod = lcKeyMod + IIF(EMPTY(lcKeyMod),'','+') + 'CTRL'
|
|
llKeyCodeCtrl = .T.
|
|
lnCntMod = lnCntMod + 1
|
|
Endif
|
|
If Bitand(lnMod, 0x10) = 0x10 && SHIFT
|
|
*lcKeyMod = lcKeyMod + IIF(EMPTY(lcKeyMod),'','+') + 'SHIFT'
|
|
llKeyCodeShift = .T.
|
|
lnCntMod = lnCntMod + 1
|
|
Endif
|
|
Endif
|
|
|
|
llComplementar = llKeyCodeAlt Or llKeyCodeCtrl Or llKeyCodeShift
|
|
*llComplementar = llKeyCodeShift
|
|
|
|
* Tratamiento de teclas normales
|
|
* (Ordenar de mayor valor a menor: 0xFFF > 0x000)
|
|
Do Case
|
|
Case lcKeyPair == Chr(0xFE)+Chr(0xFF)
|
|
lcKeyName = 'PAUSE '
|
|
* Buscar el tiempo
|
|
I = I + 2
|
|
lcKeyPair = Substr(tcMacroStr,I,2)
|
|
|
|
If lcKeyPair == Chr(0xFF)+Chr(0xFF)
|
|
lcKeyName = lcKeyName + 'KEY'
|
|
Else
|
|
lnKeyVal = CToBin(lcKeyPair, '2RS')
|
|
lcKeyName = lcKeyName + Ltrim(Str(lnKeyVal/100,5,2))
|
|
Endif
|
|
|
|
Case Bitand(lnMod, 0x01) = 0x01 ;
|
|
OR Bitand(lnMod, 0x10) = 0x10 ;
|
|
OR Bitand(lnMod, 0x20) = 0x20 ;
|
|
OR Bitand(lnMod, 0x40) = 0x40
|
|
*llComplementar = .F.
|
|
|
|
Do Case
|
|
Case Bitand(lnKeyVal, 0x41A3) = 0x41A3
|
|
lcKeyName = 'ALT+DEL'
|
|
|
|
Case Bitand(lnKeyVal, 0x41A2) = 0x41A2
|
|
lcKeyName = 'ALT+INS'
|
|
|
|
Case Bitand(lnKeyVal, 0x41A1) = 0x41A1
|
|
lcKeyName = 'ALT+PGND'
|
|
|
|
Case Bitand(lnKeyVal, 0x41A0) = 0x41A0
|
|
lcKeyName = 'ALT+DNARROW'
|
|
|
|
Case Bitand(lnKeyVal, 0x419F) = 0x419F
|
|
lcKeyName = 'ALT+END'
|
|
|
|
Case Bitand(lnKeyVal, 0x419D) = 0x419D
|
|
lcKeyName = 'ALT+RIGHTARROW'
|
|
|
|
Case Bitand(lnKeyVal, 0x419B) = 0x419B
|
|
lcKeyName = 'ALT+LEFTARROW'
|
|
|
|
Case Bitand(lnKeyVal, 0x4199) = 0x4199
|
|
lcKeyName = 'ALT+PGUP'
|
|
|
|
Case Bitand(lnKeyVal, 0x4198) = 0x4198
|
|
lcKeyName = 'ALT+UPARROW'
|
|
|
|
Case Bitand(lnKeyVal, 0x4197) = 0x4197
|
|
lcKeyName = 'ALT+HOME'
|
|
|
|
Case Bitand(lnKeyVal, 0x418C) = 0x418C
|
|
lcKeyName = 'ALT+F12'
|
|
|
|
Case Bitand(lnKeyVal, 0x418B) = 0x418B
|
|
lcKeyName = 'ALT+F11'
|
|
|
|
Case Bitand(lnKeyVal, 0x4181) = 0x4181
|
|
lcKeyName = 'ALT+0'
|
|
|
|
Case Bitand(lnKeyVal, 0x4180) = 0x4180
|
|
lcKeyName = 'ALT+9'
|
|
|
|
Case Bitand(lnKeyVal, 0x417F) = 0x417F
|
|
lcKeyName = 'ALT+8'
|
|
|
|
Case Bitand(lnKeyVal, 0x417E) = 0x417E
|
|
lcKeyName = 'ALT+7'
|
|
|
|
Case Bitand(lnKeyVal, 0x417D) = 0x417D
|
|
lcKeyName = 'ALT+6'
|
|
|
|
Case Bitand(lnKeyVal, 0x417C) = 0x417C
|
|
lcKeyName = 'ALT+5'
|
|
|
|
Case Bitand(lnKeyVal, 0x417B) = 0x417B
|
|
lcKeyName = 'ALT+4'
|
|
|
|
Case Bitand(lnKeyVal, 0x417A) = 0x417A
|
|
lcKeyName = 'ALT+3'
|
|
|
|
Case Bitand(lnKeyVal, 0x4179) = 0x4179
|
|
lcKeyName = 'ALT+2'
|
|
|
|
Case Bitand(lnKeyVal, 0x4178) = 0x4178
|
|
lcKeyName = 'ALT+1'
|
|
|
|
Case Bitand(lnKeyVal, 0x4171) = 0x4171
|
|
lcKeyName = 'ALT+F10'
|
|
|
|
Case Bitand(lnKeyVal, 0x4170) = 0x4170
|
|
lcKeyName = 'ALT+F9'
|
|
|
|
Case Bitand(lnKeyVal, 0x416F) = 0x416F
|
|
lcKeyName = 'ALT+F8'
|
|
|
|
Case Bitand(lnKeyVal, 0x416E) = 0x416E
|
|
lcKeyName = 'ALT+F7'
|
|
|
|
Case Bitand(lnKeyVal, 0x416D) = 0x416D
|
|
lcKeyName = 'ALT+F6'
|
|
|
|
Case Bitand(lnKeyVal, 0x416C) = 0x416C
|
|
lcKeyName = 'ALT+F5'
|
|
|
|
Case Bitand(lnKeyVal, 0x416B) = 0x416B
|
|
lcKeyName = 'ALT+F4'
|
|
|
|
Case Bitand(lnKeyVal, 0x416A) = 0x416A
|
|
lcKeyName = 'ALT+F3'
|
|
|
|
Case Bitand(lnKeyVal, 0x4169) = 0x4169
|
|
lcKeyName = 'ALT+F2'
|
|
|
|
Case Bitand(lnKeyVal, 0x4168) = 0x4168
|
|
lcKeyName = 'ALT+F1'
|
|
|
|
Case Bitand(lnKeyVal, 0x4132) = 0x4132
|
|
lcKeyName = 'ALT+M'
|
|
|
|
Case Bitand(lnKeyVal, 0x4131) = 0x4131
|
|
lcKeyName = 'ALT+N'
|
|
|
|
Case Bitand(lnKeyVal, 0x4130) = 0x4130
|
|
lcKeyName = 'ALT+B'
|
|
|
|
Case Bitand(lnKeyVal, 0x412F) = 0x412F
|
|
lcKeyName = 'ALT+V'
|
|
|
|
Case Bitand(lnKeyVal, 0x412E) = 0x412E
|
|
lcKeyName = 'ALT+C'
|
|
|
|
Case Bitand(lnKeyVal, 0x412D) = 0x412D
|
|
lcKeyName = 'ALT+X'
|
|
|
|
Case Bitand(lnKeyVal, 0x412C) = 0x412C
|
|
lcKeyName = 'ALT+Z'
|
|
|
|
Case Bitand(lnKeyVal, 0x4126) = 0x4126
|
|
lcKeyName = 'ALT+L'
|
|
|
|
Case Bitand(lnKeyVal, 0x4125) = 0x4125
|
|
lcKeyName = 'ALT+K'
|
|
|
|
Case Bitand(lnKeyVal, 0x4124) = 0x4124
|
|
lcKeyName = 'ALT+J'
|
|
|
|
Case Bitand(lnKeyVal, 0x4123) = 0x4123
|
|
lcKeyName = 'ALT+H'
|
|
|
|
Case Bitand(lnKeyVal, 0x4122) = 0x4122
|
|
lcKeyName = 'ALT+G'
|
|
|
|
Case Bitand(lnKeyVal, 0x4121) = 0x4121
|
|
lcKeyName = 'ALT+F'
|
|
|
|
Case Bitand(lnKeyVal, 0x4120) = 0x4120
|
|
lcKeyName = 'ALT+D'
|
|
|
|
Case Bitand(lnKeyVal, 0x411F) = 0x411F
|
|
lcKeyName = 'ALT+S'
|
|
|
|
Case Bitand(lnKeyVal, 0x411E) = 0x411E
|
|
lcKeyName = 'ALT+A'
|
|
|
|
Case Bitand(lnKeyVal, 0x4119) = 0x4119
|
|
lcKeyName = 'ALT+P'
|
|
|
|
Case Bitand(lnKeyVal, 0x4118) = 0x4118
|
|
lcKeyName = 'ALT+O'
|
|
|
|
Case Bitand(lnKeyVal, 0x4117) = 0x4117
|
|
lcKeyName = 'ALT+I'
|
|
|
|
Case Bitand(lnKeyVal, 0x4116) = 0x4116
|
|
lcKeyName = 'ALT+U'
|
|
|
|
Case Bitand(lnKeyVal, 0x4115) = 0x4115
|
|
lcKeyName = 'ALT+Y'
|
|
|
|
Case Bitand(lnKeyVal, 0x4114) = 0x4114
|
|
lcKeyName = 'ALT+T'
|
|
|
|
Case Bitand(lnKeyVal, 0x4113) = 0x4113
|
|
lcKeyName = 'ALT+R'
|
|
|
|
Case Bitand(lnKeyVal, 0x4112) = 0x4112
|
|
lcKeyName = 'ALT+E'
|
|
|
|
Case Bitand(lnKeyVal, 0x4111) = 0x4111
|
|
lcKeyName = 'ALT+U'
|
|
|
|
Case Bitand(lnKeyVal, 0x4110) = 0x4110
|
|
lcKeyName = 'ALT+Q'
|
|
|
|
Case Bitand(lnKeyVal, 0x410C) = 0x410C
|
|
lcKeyName = [ALT+'] && No está en la ayuda de VFP
|
|
|
|
Case Bitand(lnKeyVal, 0x2194) = 0x2194
|
|
lcKeyName = 'CTRL+TAB'
|
|
|
|
Case Bitand(lnKeyVal, 0x2193) = 0x2193
|
|
lcKeyName = 'CTRL+DEL'
|
|
|
|
Case Bitand(lnKeyVal, 0x2192) = 0x2192
|
|
lcKeyName = 'CTRL+INS'
|
|
|
|
Case Bitand(lnKeyVal, 0x2191) = 0x2191
|
|
lcKeyName = 'CTRL+DNARROW'
|
|
|
|
Case Bitand(lnKeyVal, 0x218D) = 0x218D
|
|
lcKeyName = 'CTRL+UPARROW'
|
|
|
|
Case Bitand(lnKeyVal, 0x218A) = 0x218A
|
|
lcKeyName = 'CTRL+F12'
|
|
|
|
Case Bitand(lnKeyVal, 0x2189) = 0x2189
|
|
lcKeyName = 'CTRL+F11'
|
|
|
|
Case Bitand(lnKeyVal, 0x2184) = 0x2184
|
|
lcKeyName = 'CTRL+PGUP'
|
|
|
|
Case Bitand(lnKeyVal, 0x2177) = 0x2177
|
|
lcKeyName = 'CTRL+HOME'
|
|
|
|
Case Bitand(lnKeyVal, 0x2176) = 0x2176
|
|
lcKeyName = 'CTRL+PGDN'
|
|
|
|
Case Bitand(lnKeyVal, 0x2175) = 0x2175
|
|
lcKeyName = 'CTRL+END'
|
|
|
|
Case Bitand(lnKeyVal, 0x2174) = 0x2174
|
|
lcKeyName = 'CTRL+RIGHTARROW'
|
|
|
|
Case Bitand(lnKeyVal, 0x2173) = 0x2173
|
|
lcKeyName = 'CTRL+LEFTARROW'
|
|
|
|
Case Bitand(lnKeyVal, 0x2167) = 0x2167
|
|
lcKeyName = 'CTRL+F10'
|
|
|
|
Case Bitand(lnKeyVal, 0x2166) = 0x2166
|
|
lcKeyName = 'CTRL+F9'
|
|
|
|
Case Bitand(lnKeyVal, 0x2165) = 0x2165
|
|
lcKeyName = 'CTRL+F8'
|
|
|
|
Case Bitand(lnKeyVal, 0x2164) = 0x2164
|
|
lcKeyName = 'CTRL+F7'
|
|
|
|
Case Bitand(lnKeyVal, 0x2163) = 0x2163
|
|
lcKeyName = 'CTRL+F6'
|
|
|
|
Case Bitand(lnKeyVal, 0x2162) = 0x2162
|
|
lcKeyName = 'CTRL+F5'
|
|
|
|
Case Bitand(lnKeyVal, 0x2161) = 0x2161
|
|
lcKeyName = 'CTRL+F4'
|
|
|
|
Case Bitand(lnKeyVal, 0x2160) = 0x2160
|
|
lcKeyName = 'CTRL+F3'
|
|
|
|
Case Bitand(lnKeyVal, 0x215F) = 0x215F
|
|
lcKeyName = 'CTRL+F2'
|
|
|
|
Case Bitand(lnKeyVal, 0x215E) = 0x215E
|
|
lcKeyName = 'CTRL+F1'
|
|
|
|
Case Bitand(lnKeyVal, 0x2020) = 0x2020
|
|
lcKeyName = 'CTRL+SPACEBAR'
|
|
|
|
Case Bitand(lnKeyVal, 0x201F) = 0x201F
|
|
lcKeyName = 'CTRL+HYPHEN'
|
|
|
|
Case Bitand(lnKeyVal, 0x201E) = 0x201E
|
|
lcKeyName = 'CTRL+CARET'
|
|
|
|
Case Bitand(lnKeyVal, 0x201D) = 0x201D
|
|
lcKeyName = 'CTRL+RBRACKET'
|
|
|
|
Case Bitand(lnKeyVal, 0x201C) = 0x201C
|
|
lcKeyName = 'CTRL+BACKSLASH'
|
|
|
|
Case Bitand(lnKeyVal, 0x201B) = 0x201B
|
|
lcKeyName = 'CTRL+LBRACKET'
|
|
|
|
Case Bitand(lnKeyVal, 0x201A) = 0x201A
|
|
lcKeyName = 'CTRL+Z'
|
|
|
|
Case Bitand(lnKeyVal, 0x2019) = 0x2019
|
|
lcKeyName = 'CTRL+Y'
|
|
|
|
Case Bitand(lnKeyVal, 0x2018) = 0x2018
|
|
lcKeyName = 'CTRL+X'
|
|
|
|
Case Bitand(lnKeyVal, 0x2017) = 0x2017
|
|
lcKeyName = 'CTRL+W'
|
|
|
|
Case Bitand(lnKeyVal, 0x2016) = 0x2016
|
|
lcKeyName = 'CTRL+V'
|
|
|
|
Case Bitand(lnKeyVal, 0x2015) = 0x2015
|
|
lcKeyName = 'CTRL+U'
|
|
|
|
Case Bitand(lnKeyVal, 0x2014) = 0x2014
|
|
lcKeyName = 'CTRL+T'
|
|
|
|
Case Bitand(lnKeyVal, 0x2013) = 0x2013
|
|
lcKeyName = 'CTRL+S'
|
|
|
|
Case Bitand(lnKeyVal, 0x2012) = 0x2012
|
|
lcKeyName = 'CTRL+R'
|
|
|
|
Case Bitand(lnKeyVal, 0x2011) = 0x2011
|
|
lcKeyName = 'CTRL+Q'
|
|
|
|
Case Bitand(lnKeyVal, 0x2010) = 0x2010
|
|
lcKeyName = 'CTRL+P'
|
|
|
|
Case Bitand(lnKeyVal, 0x200F) = 0x200F
|
|
lcKeyName = 'CTRL+O'
|
|
|
|
Case Bitand(lnKeyVal, 0x200E) = 0x200E
|
|
lcKeyName = 'CTRL+N'
|
|
|
|
Case Bitand(lnKeyVal, 0x200D) = 0x200D
|
|
lcKeyName = 'CTRL+M'
|
|
|
|
Case Bitand(lnKeyVal, 0x200C) = 0x200C
|
|
lcKeyName = 'CTRL+L'
|
|
|
|
Case Bitand(lnKeyVal, 0x200B) = 0x200B
|
|
lcKeyName = 'CTRL+K'
|
|
|
|
Case Bitand(lnKeyVal, 0x200A) = 0x200A
|
|
lcKeyName = 'CTRL+ENTER'
|
|
|
|
Case Bitand(lnKeyVal, 0x200A) = 0x200A
|
|
lcKeyName = 'CTRL+J'
|
|
|
|
Case Bitand(lnKeyVal, 0x2009) = 0x2009
|
|
lcKeyName = 'CTRL+I'
|
|
|
|
Case Bitand(lnKeyVal, 0x2008) = 0x2008
|
|
lcKeyName = 'CTRL+H'
|
|
|
|
Case Bitand(lnKeyVal, 0x2007) = 0x2007
|
|
lcKeyName = 'CTRL+G'
|
|
|
|
Case Bitand(lnKeyVal, 0x2006) = 0x2006
|
|
lcKeyName = 'CTRL+F'
|
|
|
|
Case Bitand(lnKeyVal, 0x2005) = 0x2005
|
|
lcKeyName = 'CTRL+E'
|
|
|
|
Case Bitand(lnKeyVal, 0x2004) = 0x2004
|
|
lcKeyName = 'CTRL+D'
|
|
|
|
Case Bitand(lnKeyVal, 0x2003) = 0x2003
|
|
lcKeyName = 'CTRL+C'
|
|
|
|
Case Bitand(lnKeyVal, 0x2002) = 0x2002
|
|
lcKeyName = 'CTRL+B'
|
|
|
|
Case Bitand(lnKeyVal, 0x2001) = 0x2001
|
|
lcKeyName = 'CTRL+A'
|
|
|
|
Case Bitand(lnKeyVal, 0x1188) = 0x1188
|
|
lcKeyName = 'SHIFT+F12'
|
|
|
|
Case Bitand(lnKeyVal, 0x1187) = 0x1187
|
|
lcKeyName = 'SHIFT+F11'
|
|
|
|
Case Bitand(lnKeyVal, 0x115D) = 0x115D
|
|
lcKeyName = 'SHIFT+F10'
|
|
|
|
Case Bitand(lnKeyVal, 0x115C) = 0x115C
|
|
lcKeyName = 'SHIFT+F9'
|
|
|
|
Case Bitand(lnKeyVal, 0x115B) = 0x115B
|
|
lcKeyName = 'SHIFT+F8'
|
|
|
|
Case Bitand(lnKeyVal, 0x115A) = 0x115A
|
|
lcKeyName = 'SHIFT+F7'
|
|
|
|
Case Bitand(lnKeyVal, 0x1159) = 0x1159
|
|
lcKeyName = 'SHIFT+F6'
|
|
|
|
Case Bitand(lnKeyVal, 0x1158) = 0x1158
|
|
lcKeyName = 'SHIFT+F5'
|
|
|
|
Case Bitand(lnKeyVal, 0x1157) = 0x1157
|
|
lcKeyName = 'SHIFT+F4'
|
|
|
|
Case Bitand(lnKeyVal, 0x1156) = 0x1156
|
|
lcKeyName = 'SHIFT+F3'
|
|
|
|
Case Bitand(lnKeyVal, 0x1155) = 0x1155
|
|
lcKeyName = 'SHIFT+F2'
|
|
|
|
Case Bitand(lnKeyVal, 0x1154) = 0x1154
|
|
lcKeyName = 'SHIFT+F1'
|
|
|
|
Case Bitand(lnKeyVal, 0x0186) = 0x0186
|
|
lcKeyName = 'F12'
|
|
|
|
Case Bitand(lnKeyVal, 0x0185) = 0x0185
|
|
lcKeyName = 'F11'
|
|
|
|
Case Inlist(lnKeyVal, 0x0153, 0x1153)
|
|
lcKeyName = 'DEL'
|
|
|
|
Case Inlist(lnKeyVal, 0x0152, 0x1152)
|
|
lcKeyName = 'INS'
|
|
|
|
Case Inlist(lnKeyVal, 0x0151, 0x1151)
|
|
lcKeyName = 'PGDN'
|
|
|
|
Case Inlist(lnKeyVal, 0x0150, 0x1150)
|
|
lcKeyName = 'DNARROW'
|
|
|
|
Case Inlist(lnKeyVal, 0x014F, 0x114F)
|
|
lcKeyName = 'END'
|
|
|
|
Case Inlist(lnKeyVal, 0x014D, 0x114D)
|
|
lcKeyName = 'RIGHTARROW'
|
|
|
|
Case Inlist(lnKeyVal, 0x014B, 0x114B)
|
|
lcKeyName = 'LEFTARROW'
|
|
|
|
Case Inlist(lnKeyVal, 0x0149, 0x1149)
|
|
lcKeyName = 'PGUP'
|
|
|
|
Case Inlist(lnKeyVal, 0x0148, 0x1148)
|
|
lcKeyName = 'UPARROW'
|
|
|
|
Case Bitand(lnKeyVal, 0x0147) = 0x0147
|
|
lcKeyName = 'HOME'
|
|
|
|
Case lnKeyVal = 0x0144
|
|
lcKeyName = 'F10'
|
|
|
|
Case lnKeyVal = 0x0143
|
|
lcKeyName = 'F9'
|
|
|
|
Case lnKeyVal = 0x0142
|
|
lcKeyName = 'F8'
|
|
|
|
Case lnKeyVal = 0x0141
|
|
lcKeyName = 'F7'
|
|
|
|
Case lnKeyVal = 0x0140
|
|
lcKeyName = 'F6'
|
|
|
|
Case lnKeyVal = 0x013F
|
|
lcKeyName = 'F5'
|
|
|
|
Case lnKeyVal = 0x013E
|
|
lcKeyName = 'F4'
|
|
|
|
Case lnKeyVal = 0x013D
|
|
lcKeyName = 'F3'
|
|
|
|
Case lnKeyVal = 0x013C
|
|
lcKeyName = 'F2'
|
|
|
|
Case lnKeyVal = 0x013B
|
|
lcKeyName = 'F1'
|
|
|
|
Case lnKeyVal = 0x010F
|
|
lcKeyName = 'BACKTAB'
|
|
|
|
Case lnKeyVal = 0x0100
|
|
lcKeyName = 'LEFTMOUSE'
|
|
|
|
Otherwise
|
|
*lcKeyName = CHR(lnKeyVal)
|
|
|
|
Endcase
|
|
|
|
Endcase
|
|
|
|
If Empty(lcKeyName)
|
|
|
|
Do Case
|
|
Case Between(lnKey, 0x41, 0x5A) Or Between(lnKey, 0x61, 0x7A) Or Inlist(lnKey, 0x7C, 0x7E) && A..Z, a..z, |, ~
|
|
lcKeyName = lcKey
|
|
llKeyCodeShift = .F.
|
|
|
|
Case Between(lnKey, 0x21, 0x7A) And Not (lnKey = 0x3B)
|
|
llKeyCodeShift = .F.
|
|
lcKeyName = lcKey
|
|
|
|
Case lnKey = 0x7F
|
|
lcKeyName = 'DEL'
|
|
|
|
Case lnKey = 0x7D && "{"
|
|
lcKeyName = 'RBRACE'
|
|
|
|
Case lnKey = 0x7B && "}"
|
|
lcKeyName = 'LBRACE'
|
|
|
|
Case lnKey = 0x3B && ";"
|
|
lcKeyName = 'SEMICOLON'
|
|
|
|
Case lnKey = 0x2C && ","
|
|
lcKeyName = 'SEMICOLON'
|
|
|
|
Case lnKey = 0x20 && " "
|
|
lcKeyName = 'SPACEBAR'
|
|
|
|
Case lnKey = 0x1B
|
|
lcKeyName = 'ESCAPE'
|
|
|
|
Case lnKey = 0x0D
|
|
lcKeyName = 'ENTER'
|
|
|
|
Case lnKey = 0x09
|
|
lcKeyName = 'TAB'
|
|
|
|
Case lnKey = 0x08
|
|
lcKeyName = 'BACKSPACE'
|
|
|
|
Otherwise
|
|
llComplementar = .F.
|
|
lcKeyName = 'x' + Right( Transform(lnKeyVal,'@0'), 4)
|
|
|
|
Endcase
|
|
|
|
*ENDCASE
|
|
Endif
|
|
|
|
* Tratamiento de modificadores
|
|
If Not lcKeyPair == Chr(0xFE)+Chr(0xFF) And llComplementar
|
|
If llKeyCodeShift And At("SHIFT",lcKeyName) = 0 && SHIFT
|
|
lcKeyMod = lcKeyMod + Iif(Empty(lcKeyMod),'','+') + 'SHIFT'
|
|
Endif
|
|
If llKeyCodeCtrl And At("CTRL",lcKeyName) = 0 && CTRL
|
|
lcKeyMod = lcKeyMod + Iif(Empty(lcKeyMod),'','+') + 'CTRL'
|
|
Endif
|
|
If llKeyCodeAlt And At("ALT",lcKeyName) = 0 && ALT
|
|
lcKeyMod = lcKeyMod + Iif(Empty(lcKeyMod),'','+') + 'ALT'
|
|
Endif
|
|
*IF BITAND(lnKeyVal, 0x8000) = 0x8000 && LITERAL
|
|
* lcKeyMod = lcKeyMod + IIF(EMPTY(lcKeyMod),'','+') + 'LITERAL'
|
|
*ENDIF
|
|
Endif
|
|
|
|
* Tratamiento de combinación final
|
|
Do Case
|
|
Case Len(lcKeyName) > 1 And (Not llComplementar Or Empty(lcKeyMod))
|
|
If tlLiteralForCaption
|
|
lcTecla = lcKeyName
|
|
Else
|
|
lcTecla = '{' + lcKeyName + '}'
|
|
Endif
|
|
|
|
Case Empty(lcKeyMod)
|
|
lcTecla = lcKeyName
|
|
|
|
Otherwise
|
|
If tlLiteralForCaption
|
|
lcTecla = lcKeyMod + '+' + lcKeyName
|
|
Else
|
|
lcTecla = '{' + lcKeyMod + '+' + lcKeyName + '}'
|
|
Endif
|
|
|
|
Endcase
|
|
|
|
Return lcTecla
|
|
Endfunc
|
|
|
|
|
|
Enddefine
|
|
|
|
|
|
|
|
Define Class CL_MEMVAR As CL_COL_BASE
|
|
* .MEM FILE STRUCTURE (Based on observation and testing) - Fernando D. Bozzo. 2018/03/24
|
|
* Complementary documentation: https://www.clicketyclick.dk/databases/xbase/format/mem.html#MEM_STRUCT
|
|
|
|
|
|
* STRUCTURE OF VARIABLES
|
|
* Byte Offset Description
|
|
* ----------- -------------------------------------------------------------------------------------------------
|
|
* 0 - 10 NULL terminated VarName. If VarName is empty, then VarName starts at offset 32
|
|
* 11 VarType (A,C,N,Y,B,F,I,Q,D,T,L,0). If VarType is lowercase, then next VarName
|
|
* begins with 2 bytes for VarName length.
|
|
* 12 - 15 Reserved
|
|
* 16 Value length
|
|
* 17 Decimal count
|
|
* 18 - 24 Reserved
|
|
* 25 0x00 if it is an array element, 0x03 if it isn't an array element
|
|
* 26 - 31 Reserved
|
|
* 32 - n If VarName (offset 0-10) is NULL then goto TABLE 1, If VarType=A then continue in TABLE 2,
|
|
* if VarType=0 then continue in TABLE 3, else continue in TABLE 4
|
|
* ...
|
|
* eof Last character is EOF (0x1A) character
|
|
* ----------- -------------------------------------------------------------------------------------------------
|
|
|
|
|
|
* TABLE 1 - ARRAY STRUCTURE (VarType=A)
|
|
* Byte Offset Description
|
|
* ----------- -------------------------------------------------------------------------------------------------
|
|
* 32 - 33 VarName length
|
|
* 34 - n VarName
|
|
* n + 1 Next TABLE: If VarType=A then continue in TABLE 2, if VarType=0 then continue in TABLE 3,
|
|
* else continue in TABLE 4
|
|
* ----------- -------------------------------------------------------------------------------------------------
|
|
|
|
|
|
* TABLE 2 - ARRAY STRUCTURE (VarType=A)
|
|
* Byte Offset Description
|
|
* ----------- -------------------------------------------------------------------------------------------------
|
|
* n - n+1 Array rows
|
|
* n+2 - n+3 Array cols
|
|
* n+4 - x Next Variable structure, or EOF (0x1A)
|
|
* ----------- -------------------------------------------------------------------------------------------------
|
|
|
|
|
|
* TABLE 3 - NULL VALUE STRUCTURE (VarType=0)
|
|
* Byte Offset Description
|
|
* ----------- -------------------------------------------------------------------------------------------------
|
|
* n VarType.
|
|
* n+1 - x Next Variable structure, or EOF (0x1A)
|
|
* ----------- -------------------------------------------------------------------------------------------------
|
|
|
|
|
|
* TABLE 4 - NORMAL VALUE STRUCTURE
|
|
* Byte Offset Description
|
|
* ----------- -------------------------------------------------------------------------------------------------
|
|
* n - x Value of length "value length". If ValTye is a Char type then Value length is the value's width,
|
|
* else the width is 8 for numbers and dates
|
|
* x Next Variable structure, or EOF (0x1A)
|
|
* ----------- -------------------------------------------------------------------------------------------------
|
|
|
|
#If .F.
|
|
Local This As CL_MEMVAR Of 'FOXBIN2PRG.PRG'
|
|
#Endif
|
|
|
|
_MemberData = [<VFPData>] ;
|
|
+ [<memberdata name="c_inputfile" display="c_InputFile"/>] ;
|
|
+ [<memberdata name="_debug" display="_Debug"/>] ;
|
|
+ [<memberdata name="get_datafrommem" display="get_DataFromMEM"/>] ;
|
|
+ [<memberdata name="_memvars" display="_MemVars"/>] ;
|
|
+ [</VFPData>]
|
|
|
|
|
|
c_InputFile = ''
|
|
_Debug = .F.
|
|
_MemVars = Null && Colección de variables de memoria
|
|
|
|
|
|
|
|
Procedure Init
|
|
DoDefault()
|
|
This._MemVars = Createobject("COLLECTION")
|
|
Endproc
|
|
|
|
|
|
Procedure get_DataFromMEM(tcInputFile As String, toFoxBin2Prg)
|
|
*---------------------------------------------------------------------------------------------------
|
|
* PARÁMETROS: (v=Pasar por valor | @=Pasar por referencia) (!=Obligatorio | ?=Opcional) (IN/OUT)
|
|
* tcInputFile (!v IN ) Archivo de entrada
|
|
* toFoxBin2Prg (!@ IN ) Referencia al objeto principal
|
|
*---------------------------------------------------------------------------------------------------
|
|
#If .F.
|
|
Local toFoxBin2Prg As c_foxbin2prg Of 'FOXBIN2PRG.PRG'
|
|
#Endif
|
|
|
|
Local lnHandle, lnFileLen, lcMsg, lcStr, lnNumberOfMacros ;
|
|
, loMVRec As CL_MEMVAR_RECORD Of 'FOXBIN2PRG.PRG' ;
|
|
, loColl As Collection ;
|
|
, loEx As Exception
|
|
|
|
Try
|
|
lnHandle = -1
|
|
|
|
With This As CL_MEMVAR Of 'FOXBIN2PRG.PRG'
|
|
loColl = ._MemVars
|
|
lnHandle = Fopen(tcInputFile, 0)
|
|
|
|
If lnHandle = -1
|
|
lcMsg = toFoxBin2Prg.FERROR_Message(tcInputFile)
|
|
Error (lcMsg)
|
|
Endif
|
|
|
|
lnFileLen = Fseek(lnHandle, 0, 2)
|
|
|
|
If lnFileLen < 1
|
|
Error 'Invalid MEM File size'
|
|
Else
|
|
=Fseek(lnHandle, 0, 0)
|
|
Endif
|
|
|
|
*IF lnFileLen < 17 + 25 * lnNumberOfMacros
|
|
* * 25 caracteres es el tamaño mínimo de una macro sin teclas guardadas (solo la estructura)
|
|
* ERROR 'Invalid FKY Macro File size'
|
|
*ENDIF
|
|
|
|
If lnFileLen > 1
|
|
Do While Not Feof(lnHandle) And Fseek(lnHandle, 0, 1) < (lnFileLen - 1)
|
|
loMVRec = Createobject("CL_MEMVAR_RECORD")
|
|
|
|
If Not loMVRec.ReadNextMemVar(lnHandle)
|
|
Exit
|
|
Endif
|
|
|
|
loColl.Add( loMVRec, loMVRec.getName() + Padl(pnElement, 5, '0') )
|
|
loMVRec = Null
|
|
Enddo
|
|
|
|
* Ordenar alfabéticamente por nombre de variable
|
|
loColl.KeySort = 2
|
|
Endif
|
|
|
|
Endwith
|
|
|
|
Catch To loEx
|
|
*loEx.UserValue = loEx.UserValue + 'lcAsignacion = [' + TRANSFORM(lcAsignacion) + ']' + CR_LF
|
|
|
|
If This.n_Debug > 0 And _vfp.StartMode = 0
|
|
Set Step On
|
|
Endif
|
|
|
|
Throw
|
|
|
|
Finally
|
|
If lnHandle <> -1
|
|
=Fclose(lnHandle)
|
|
Endif
|
|
Endtry
|
|
|
|
Return
|
|
Endproc
|
|
|
|
|
|
Procedure toText
|
|
*---------------------------------------------------------------------------------------------------
|
|
* PARÁMETROS: (v=Pasar por valor | @=Pasar por referencia) (!=Obligatorio | ?=Opcional) (IN/OUT)
|
|
*---------------------------------------------------------------------------------------------------
|
|
Local lcText, loMVRec As CL_MEMVAR_RECORD Of 'FOXBIN2PRG.PRG'
|
|
lcText = ''
|
|
|
|
With This As CL_MEMVAR Of 'FOXBIN2PRG.PRG'
|
|
|
|
*-- Macros
|
|
For Each loMVRec In ._MemVars &&FOXOBJECT
|
|
lcText = lcText + CR_LF + loMVRec.toText()
|
|
Endfor
|
|
|
|
Endwith
|
|
|
|
Return lcText
|
|
Endproc
|
|
|
|
|
|
Enddefine
|
|
|
|
|
|
|
|
Define Class CL_MEMVAR_RECORD As CL_CUS_BASE
|
|
_MemberData = [<VFPData>] ;
|
|
+ [<memberdata name="memvar_name" display="MemVar_Name"/>] ;
|
|
+ [<memberdata name="memvar_namelength" display="MemVar_NameLength"/>] ;
|
|
+ [<memberdata name="memvar_type" display="MemVar_Type"/>] ;
|
|
+ [<memberdata name="memvar_rows" display="MemVar_Rows"/>] ;
|
|
+ [<memberdata name="memvar_cols" display="MemVar_Cols"/>] ;
|
|
+ [<memberdata name="memvar_length" display="MemVar_Length"/>] ;
|
|
+ [<memberdata name="memvar_dec" display="MemVar_Dec"/>] ;
|
|
+ [<memberdata name="memvar_value" display="MemVar_Value"/>] ;
|
|
+ [<memberdata name="memvar_elemtype" display="MemVar_ElemType"/>] ;
|
|
+ [<memberdata name="readnextmemvar" display="ReadNextMemVar"/>] ;
|
|
+ [<memberdata name="totext" display="toText"/>] ;
|
|
+ [<memberdata name="get_memvardata" display="get_MemVarData"/>] ;
|
|
+ [<memberdata name="getrows" display="getRows"/>] ;
|
|
+ [<memberdata name="getcols" display="getCols"/>] ;
|
|
+ [<memberdata name="getlength" display="getLength"/>] ;
|
|
+ [<memberdata name="getdec" display="getDec"/>] ;
|
|
+ [<memberdata name="getvalue" display="getValue"/>] ;
|
|
+ [<memberdata name="getname" display="getName"/>] ;
|
|
+ [<memberdata name="juliantodatetime" display="julianToDateTime"/>] ;
|
|
+ [<memberdata name="isarrayelement" display="isArrayElement"/>] ;
|
|
+ [</VFPData>]
|
|
|
|
*--
|
|
MemVar_Name = ''
|
|
MemVar_NameLength = ''
|
|
MemVar_Type = ''
|
|
MemVar_Rows = ''
|
|
MemVar_Cols = ''
|
|
MemVar_Length = ''
|
|
MemVar_Dec = ''
|
|
MemVar_Value = ''
|
|
MemVar_ElemType = ''
|
|
|
|
|
|
Procedure ReadNextMemVar(tnHandle As Integer)
|
|
*---------------------------------------------------------------------------------------------------
|
|
* PARÁMETROS: (v=Pasar por valor | @=Pasar por referencia) (!=Obligatorio | ?=Opcional) (IN/OUT)
|
|
* tnHandle (!v IN ) FKY file handle
|
|
*---------------------------------------------------------------------------------------------------
|
|
Local lnVarLength, lnVarDec, lnVarNameLength, lcVarNameLength, llVarTypeIsChar
|
|
|
|
Try
|
|
With This As CL_MEMVAR_RECORD Of 'FOXBIN2PRG.PRG'
|
|
.MemVar_Name = Fread(tnHandle, 11)
|
|
.MemVar_Type = Fread(tnHandle, 1)
|
|
=Fseek(tnHandle, 4, 1) && Skip 4 bytes
|
|
.MemVar_Length = Fread(tnHandle, 1)
|
|
.MemVar_Dec = Fread(tnHandle, 1)
|
|
|
|
Do Case
|
|
Case Inlist( Upper(.MemVar_Type), 'C', 'Q', 'L')
|
|
llVarTypeIsChar = .T.
|
|
lnVarLength = .getLength()
|
|
|
|
Case Upper(.MemVar_Type) = 'A'
|
|
* Array
|
|
|
|
Otherwise && Numeric
|
|
lnVarLength = 8
|
|
lnVarDec = .getDec()
|
|
|
|
Endcase
|
|
|
|
=Fseek(tnHandle, 7, 1) && Skip 7 bytes
|
|
.MemVar_ElemType = Fread(tnHandle, 1) && 0x00 if it is an array element, else 0x03
|
|
=Fseek(tnHandle, 6, 1) && Skip 6 bytes
|
|
|
|
If .isArrayElement()
|
|
* Mantiene el contador de elemento
|
|
pnElement = pnElement + 1
|
|
Else
|
|
* Reinicia el conteo de filas, columnas y elemento actual
|
|
Store 0 To pnCols, pnRows, pnElement
|
|
Endif
|
|
|
|
If Empty( Rtrim(.MemVar_Name, 0, Chr(0)) )
|
|
* Long VarName
|
|
lcVarNameLength = Fread(tnHandle, 2)
|
|
lnVarNameLength = CToBin(lcVarNameLength, '2RS')
|
|
.MemVar_Name = Fread(tnHandle, lnVarNameLength)
|
|
Endif
|
|
|
|
Do Case
|
|
Case Inlist(.MemVar_Type, 'A', 'a')
|
|
* ARRAY
|
|
* Rows/Cols
|
|
.MemVar_Rows = Fread(tnHandle, 2)
|
|
.MemVar_Cols = Fread(tnHandle, 2)
|
|
pnCols = .getCols()
|
|
pnRows = .getRows()
|
|
|
|
Case .MemVar_Type = '0'
|
|
* NULL
|
|
* VarType
|
|
.MemVar_Type = Fread(tnHandle, 1)
|
|
.MemVar_Value = Null
|
|
|
|
Otherwise
|
|
* NORMAL VALUE
|
|
* Value
|
|
.MemVar_Value = Fread(tnHandle, lnVarLength)
|
|
|
|
Endcase
|
|
Endwith
|
|
Endtry
|
|
|
|
Return
|
|
Endproc
|
|
|
|
|
|
Function isArrayElement
|
|
#If .F.
|
|
Local This As CL_MEMVAR_RECORD Of 'FOXBIN2PRG.PRG'
|
|
#Endif
|
|
Return Asc(This.MemVar_ElemType) = 0
|
|
Endfunc
|
|
|
|
|
|
Function getRows
|
|
#If .F.
|
|
Local This As CL_MEMVAR_RECORD Of 'FOXBIN2PRG.PRG'
|
|
#Endif
|
|
Return CToBin(This.MemVar_Rows, '2RS')
|
|
Endfunc
|
|
|
|
|
|
Function getCols
|
|
#If .F.
|
|
Local This As CL_MEMVAR_RECORD Of 'FOXBIN2PRG.PRG'
|
|
#Endif
|
|
Return CToBin(This.MemVar_Cols, '2RS')
|
|
Endfunc
|
|
|
|
|
|
Function getLength
|
|
#If .F.
|
|
Local This As CL_MEMVAR_RECORD Of 'FOXBIN2PRG.PRG'
|
|
#Endif
|
|
Return Asc(This.MemVar_Length)
|
|
Endfunc
|
|
|
|
|
|
Function getDec
|
|
#If .F.
|
|
Local This As CL_MEMVAR_RECORD Of 'FOXBIN2PRG.PRG'
|
|
#Endif
|
|
Return Asc(This.MemVar_Dec)
|
|
Endfunc
|
|
|
|
|
|
Function getName
|
|
#If .F.
|
|
Local This As CL_MEMVAR_RECORD Of 'FOXBIN2PRG.PRG'
|
|
#Endif
|
|
Return Rtrim(This.MemVar_Name, 0, Chr(0))
|
|
Endfunc
|
|
|
|
|
|
Function getValue
|
|
With This As CL_MEMVAR_RECORD Of 'FOXBIN2PRG.PRG'
|
|
Local lxValue
|
|
|
|
Do Case
|
|
Case Isnull(.MemVar_Value)
|
|
lxValue = Null
|
|
|
|
Case Upper(.MemVar_Type) = 'L'
|
|
lxValue = ( Asc(.MemVar_Value) = 1 )
|
|
|
|
Case Inlist( Upper(.MemVar_Type), 'C', 'M')
|
|
lxValue = ["] + Rtrim(.MemVar_Value, 0, Chr(0)) + ["]
|
|
|
|
Case Inlist( Upper(.MemVar_Type), 'Q')
|
|
lxValue = '0h' + Strconv(.MemVar_Value,15)
|
|
|
|
Case Upper(.MemVar_Type) = 'D'
|
|
lxValue = Sys(10, CToBin(.MemVar_Value, '8S'))
|
|
|
|
Case Upper(.MemVar_Type) = 'T'
|
|
lxValue =.julianToDateTime( CToBin(.MemVar_Value, '8S') )
|
|
|
|
Case Upper(.MemVar_Type) = 'Y'
|
|
lxValue = CToBin(.MemVar_Value, '8YRS')
|
|
|
|
Case Upper(.MemVar_Type) = 'B'
|
|
lxValue = CToBin(.MemVar_Value, '8BRS')
|
|
|
|
Otherwise && 'N'
|
|
lxValue = CToBin(.MemVar_Value, '8S')
|
|
|
|
*IF .getDec() = 0
|
|
* lxValue = ROUND(lxValue,0)
|
|
*ENDIF
|
|
|
|
Endcase
|
|
Endwith
|
|
|
|
Return lxValue
|
|
Endfunc
|
|
|
|
|
|
Function julianToDateTime(tnJulian As Double)
|
|
Local lnInt, lnDec, ltValue, ldDate, lcTime ;
|
|
, lnSecs, lnMins, lnHours
|
|
|
|
ltValue = {/:}
|
|
lnInt = Int(tnJulian)
|
|
lnDec = tnJulian - lnInt
|
|
ldDate = Evaluate( '{^' + Sys(10, lnInt) + '}' )
|
|
lnSecs = 24 * 60 * 60 * lnDec
|
|
lnHours = Int(lnSecs / 3600)
|
|
lnSecs = lnSecs - lnHours * 3600
|
|
lnMins = Int(lnSecs / 60)
|
|
lnSecs = lnSecs - lnMins * 60
|
|
ltValue = Datetime( Year(ldDate), Month(ldDate), Day(ldDate), lnHours, lnMins, lnSecs)
|
|
|
|
Return ltValue
|
|
Endfunc
|
|
|
|
|
|
Procedure toText As String
|
|
*---------------------------------------------------------------------------------------------------
|
|
* PARÁMETROS: (v=Pasar por valor | @=Pasar por referencia) (!=Obligatorio | ?=Opcional) (IN/OUT)
|
|
*---------------------------------------------------------------------------------------------------
|
|
Local lcText, lcVarName, lcVarType, lnVarLen, lnVarDec, lcPrecision, lnLenName ;
|
|
, loField As CL_MACRO_RECORD Of 'FOXBIN2PRG.PRG'
|
|
lnLenName = 16
|
|
lcText = ''
|
|
lcPrecision = ''
|
|
lcVarName = ''
|
|
|
|
With This As CL_MEMVAR_RECORD Of 'FOXBIN2PRG.PRG'
|
|
lcVarType = Upper(.MemVar_Type)
|
|
lnVarLen = .getLength()
|
|
lnVarDec = .getDec()
|
|
lcVarName = .getName()
|
|
|
|
If Len(lcVarName) < lnLenName
|
|
lcVarName = Padr(lcVarName, lnLenName)
|
|
Endif
|
|
|
|
If lcVarType = 'N'
|
|
If lnVarDec > 0
|
|
lcPrecision = Textmerge( '(<<lnVarLen>>,<<lnVarDec>>)' )
|
|
Else
|
|
lcPrecision = Textmerge( '(<<lnVarLen>>)' )
|
|
Endif
|
|
Endif
|
|
|
|
lcPrecision = Padr(lcPrecision, 10)
|
|
|
|
If lcVarType = 'A'
|
|
pnCols = .getCols()
|
|
pnRows = .getRows()
|
|
pnElement = 0
|
|
|
|
If CToBin(.MemVar_Cols, '2RS') = 0
|
|
* Array Unidimensional
|
|
TEXT TO lcText ADDITIVE TEXTMERGE NOSHOW FLAGS 1 PRETEXT 1+2
|
|
<<lcVarName>> <<lcVarType>>(<<.getRows()>>)
|
|
ENDTEXT
|
|
Else
|
|
* Array Bidimensional
|
|
TEXT TO lcText ADDITIVE TEXTMERGE NOSHOW FLAGS 1 PRETEXT 1+2
|
|
<<lcVarName>> <<lcVarType>>(<<.getRows()>>,<<.getCols()>>)
|
|
ENDTEXT
|
|
Endif
|
|
|
|
Else
|
|
|
|
If .isArrayElement()
|
|
* Elemento de array
|
|
pnElement = pnElement + 1
|
|
|
|
If pnCols = 0
|
|
* Elemento de Array Unidimensional
|
|
TEXT TO lcText ADDITIVE TEXTMERGE NOSHOW FLAGS 1 PRETEXT 1+2
|
|
<<>> (<<STR(pnElement,5)>>) <<lcVarType>><<lcPrecision>> <<.getValue()>>
|
|
ENDTEXT
|
|
|
|
Else
|
|
* Elemento de Array Bidimensional
|
|
TEXT TO lcText ADDITIVE TEXTMERGE NOSHOW FLAGS 1 PRETEXT 1+2
|
|
<<>> (<<STR(CEILING(pnElement/pnCols),5)>>,<<STR(EVL( MOD(pnElement,pnCols), pnCols),5)>>) <<lcVarType>><<lcPrecision>> <<.getValue()>>
|
|
ENDTEXT
|
|
|
|
Endif
|
|
|
|
Else
|
|
* Variable normal
|
|
TEXT TO lcText ADDITIVE TEXTMERGE NOSHOW FLAGS 1 PRETEXT 1+2
|
|
<<lcVarName>> <<lcVarType>><<lcPrecision>> <<.getValue()>>
|
|
ENDTEXT
|
|
Endif
|
|
|
|
Endif
|
|
|
|
Endwith
|
|
|
|
Return lcText
|
|
Endproc
|
|
|
|
|
|
Enddefine
|
|
|