romfast/foxbin2prg
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity
Files
333f45b517b8371a19bffc7b1119598967fa1303
foxbin2prg/foxbin2prg.prg
Lutz 333f45b517 Bar # 2
2021-04-22 07:59:45 +02:00

32579 lines
1.2 MiB
Raw Blame History

*---------------------------------------------------------------------------------------------------
* 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
* 05/03/2021 LScheffler v1.19.57 Bug Fix: For RedirectClassType = 2, Path was set wrong
* 2021-03-04 DH v1.19.58 Enhancement: added support for writing to a different folder than the source code (Doug Hennig)
* 2021-03-04 DH v1.19.58 Enhancement: added configuration item: HomeDir, which determines if HomeDir is saved in PJ2 files (Doug Hennig)
* 09/03/2021 LScheffler v1.19.59 Bug Fix: For RedirectClassType = 2, Path was set wrong
* 09/03/2021 LScheffler v1.19.59 Doc: Improved, Better description of ClassPerFileCheck.
* 09/03/2021 LScheffler v1.19.59 Bug Fix: RedirectClassType = 2, UseClassPerFile = 2 failed.
* 09/03/2021 LScheffler v1.19.59 Enhancement: Added option to create config file template based on current values of a directory
* 09/03/2021 LScheffler v1.19.59 Enhancement: Log settings object handed to execute (Debug > 0)
* 22/03/2021 LScheffler v1.19.60 Enhancement: -cC options learned to create default FoxBin2Prg._cfg file
* 22/03/2021 LScheffler v1.19.60 Enhancement: -t Option learned to create default <tablename>._cfg file, if table is open.
* 22/03/2021 LScheffler v1.19.60 Enhancement: Handling of additional non structural index per DBF in Bin2Text and Text2Bin see config per DBF
* 22/03/2021 LScheffler v1.19.60 Enhancement: Debug-Logging for Index
* 22/03/2021 LScheffler v1.19.60 Bug Fix: DBF_Conversion_Condition was read, but never used
* 22/03/2021 LScheffler v1.19.60 Bug Fix: DBF_Conversion_Order sets an index that later would be stored as structural index
* 22/03/2021 LScheffler v1.19.60 Bug Fix: config options with text value fail, if line comment is set
* 22/03/2021 LScheffler v1.19.60 Enhancement: FoxBin2Prg template and debug output ordered and completed, order synched, grouped and groups named
* 22/03/2021 LScheffler v1.19.60 Enhancement: Option BackgroundImage was read, but not in template
* 22/03/2021 LScheffler v1.19.60 Bug Fix: issue #53 Variable lnFileCount in get_filesfromdirectory
* 23/03/2021 LScheffler v1.19.61 Bug Fix: missnamed property
* 30/03/2021 LScheffler v1.19.62 Bug Fix: *_Conversion_Support options not read from config file
* 30/03/2021 LScheffler v1.19.62 Bug Fix: Extension shift options not read from config file
* 30/03/2021 LScheffler v1.19.62 Bug Fix: RedirectFilePerDBCToMain option was defined wrong in configuration example
* 30/03/2021 LScheffler v1.19.62 Enhancement: Debug logging, level of config file.
* 12/04/2021 LScheffler v1.19.63 Bug Fix: Tables without indexes cause an error that the "Table ## is not marked as belonging to the ## database" (jstagerGH)
* 12/04/2021 LScheffler v1.19.63 Docu: Readme reworked (mattslay)
* </HISTORIAL DE CAMBIOS Y NOTAS IMPORTANTES>
*
*---------------------------------------------------------------------------------------------------
* <TESTEO, REPORTE DE BUGS Y MEJORAS (AGRADECIMIENTOS)>
* 08/04/2021 jstagerGH BUG REPORT v1.19.62 Tables without indexes cause an error that the "Table ## is not marked as belonging to the ## database"
* 30/03/2021 Sergej s-s-a BUG REPORT v1.19.61 Ignoring extention in foxbin2prg.cfg
* 16/03/2021 msueping BUG REPORT v1.19.57 Variable lnFileCount in get_filesfromdirectory
* 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)
* 01/04/2020 FDBOZZO Bug report v1.19.51 No se respetan las propiedades de VCX/SCX con nombre "note" (Tracy Pearson)
* 14/02/2021 Lutz Scheffler Bug report v1.19.51 conversion dbf -> prg, error if only test mode (toFoxBin2Prg.l_ProcessFiles is false)
* 14/02/2021 Lutz Scheffler Bug report v1.19.51 conversion prg -> dbf, fields with .NULL. value are incorectly recreated
* 15/02/2021 Lutz Scheffler Bug report v1.19.52 processing directory, flush log file after loop instead of file
* 16/02/2021 Lutz Scheffler Bug report v1.19.52 conversion prg -> vcx, files per class could create one class multiple times
* 03/03/2021 Lutz Scheffler Bug report v1.19.53 DBF_Conversion_Condition, problem with macro expansion
* 04/03/2021 Lutz Scheffler Bug report v1.19.55 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.
* 05/03/2021 Lutz Scheffler Bug report v1.19.56 For RedirectClassType = 2, Path was set wrong
* 09/03/2021 Lutz Scheffler Bug report v1.19.57 For RedirectClassType = 2, Path was set wrong
* 09/03/2021 Lutz Scheffler Bug report v1.19.57 RedirectClassType = 2, UseClassPerFile = 2 failed.
* xx/xx/2021 Lutz Scheffler Bug report v1.19.59 DBF_Conversion_Condition was read, but never used
* xx/xx/2021 Lutz Scheffler Bug report v1.19.59 DBF_Conversion_Order sets an index that later would be stored as structural index
* xx/xx/2021 Lutz Scheffler Bug report v1.19.59 config options with text value fail, if line comment is set
* </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
*
*---------------------------------------------------------------------------------------------------
*** LScheffler 2021-03-08: added optional set of parameters, config file
* Usage 1
* 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
*** DH 2021-03-04: added tcOutputFolder parameter
* tcOutputFolder (v? IN ) The output folder to write to (optional: if it isn't specified, the same folder as the source is used)
*---------------------------------------------------------------------------------------------------
* Ej: DO FOXBIN2PRG.PRG WITH "C:\DESA\INTEGRACION\LIBRERIA.VCX"
*---------------------------------------------------------------------------------------------------
*** DH 2021-03-04: added tcOutputFolder parameter
*- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
*** LScheffler 2021-03-08: added optional set of parameters, config file
* Usage 2
* PARAMETERS: (v=Pasar por valor | @=Pasar por referencia) (!=Obligatorio | ?=Opcional) (IN/OUT)
* tc_InputFile (c! IN ) Modus (case sensitive)
* -c Create config template "tcType" with default values
* -C Create config "tcType" with values of directory named by outputfile
* -t Create config template "tcType" for config-per-table file
* tcType (v! IN ) file to create
*---------------------------------------------------------------------------------------------------
Lparameters tc_InputFile, tcType, tcTextName, tlGenText, tcDontShowErrors, tcDebug, tcDontShowProgress, tcOriginalFileName ;
, tcRecompile, tcNoTimestamps, tcCFG_File, tcOutputFolder
*-- 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_CDXIDX_I '<IndexFiles>' && SF written, but not read
#Define C_CDXIDX_F '</IndexFiles>' && SF written, but not read
#Define C_CDX_I '<IndexFile' && SF written, but not read
#Define C_CDX_F '</IndexFile>' && SF written, but not read
#Define C_CDX_Type_ 'Type="'
#Define C_CDX_Type_Struct 'Structural'
#Define C_CDX_Type_Compound 'Compound'
#Define C_CDX_Type_IDX 'Standalone'
#Define C_CDX_File_ 'File="'
#Define C_INDEXES_I '<INDEXES>' && SF Read / write, no len, used w/o äDEFINE too, len
#Define C_INDEXES_F '</INDEXES>' && SF Read / write, no len, used w/o äDEFINE too, len
#Define C_INDEX_I '<INDEX>' && SF used for read, not write?
#Define C_INDEX_F '</INDEX>' && SF used for read, not write?
*#Define C_LEN_CDX_I Len(C_CDX_I) && SF not used; deactivated
*#Define C_LEN_CDX_F Len(C_CDX_F) && SF not used; deactivated
*#Define C_LEN_INDEX_I Len(C_INDEX_I) && SF not used (possibly do to errornous definition of #DEFINE); deactivated
*#Define C_LEN_INDEX_F Len(C_INDEX_F) && SF not used (possibly do to errornous definition of #DEFINE); deactivated
#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_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 tc_InputFile=='-t' Then
pcParamX = tc_InputFile
tc_InputFile = tcType
tcType = pcParamX
Release pcParamX
Endif
* only 2 paras for -cCt
Do Case
Case Pcount()=1 And tcType == '-t' And !Empty( Dbf() )
tc_InputFile = Dbf() + '._cfg'
Case Pcount()=1 And Upper( tcType ) =='-C'
tc_InputFile = 'FoxBin2PRG._cfg'
Case Pcount()#2 And ( Upper( tcType ) =='-C' Or tcType =='-t' )
tc_InputFile = ""
tcType = ""
Endcase
*!* /Changed by: Lutz Scheffler 15.2.2021
Try
loEx = Null
loCnv = Createobject("c_foxbin2prg")
*** DH 2021-03-04: handle tcOutputFolder
If Not Empty(tcOutputFolder)
loCnv.cOutputFolder = tcOutputFolder
Endif &&not empty(tcOutputFolder)
*** DH 2021-03-04: end of new code
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="n_pjx_conversion_support" display="n_PJX_Conversion_Support"/>] ;
+ [<memberdata name="n_vcx_conversion_support" display="n_VCX_Conversion_Support"/>] ;
+ [<memberdata name="n_scx_conversion_support" display="n_SCX_Conversion_Support"/>] ;
+ [<memberdata name="n_frx_conversion_support" display="n_FRX_Conversion_Support"/>] ;
+ [<memberdata name="n_lbx_conversion_support" display="n_LBX_Conversion_Support"/>] ;
+ [<memberdata name="n_mnx_conversion_support" display="n_MNX_Conversion_Support"/>] ;
+ [<memberdata name="n_dbc_conversion_support" display="n_DBC_Conversion_Support"/>] ;
+ [<memberdata name="n_dbf_conversion_support" display="n_DBF_Conversion_Support"/>] ;
+ [<memberdata name="c_dbf_conversion_included" display="c_DBF_Conversion_Included"/>] ;
+ [<memberdata name="c_dbf_conversion_excluded" display="c_DBF_Conversion_Excluded"/>] ;
+ [<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"/>] ;
+ [</VFPData>]
*!* ;&& SF -> String to long
*!* + [<memberdata name="a_processedfiles" display="a_ProcessedFiles"/>] ;
*!* + [<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"/>] ;
*!* + [<memberdata name="c_language_in" display="c_Language_In"/>] ;
*!* + [<memberdata name="writelog_flush" display="writeLog_Flush"/>] ;
*!* ;&& /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.63'
*--
c_Language = '' && EN, FR, ES, DE
c_Language_In = '(auto)'
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_PRG_Compat_Level = 0 && 0=COMPATIBLE WITH FoxBin2Prg v1.19.49 and earlier, 1=Include HELPSTRING
n_ExcludeDBFAutoincNextval = 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_UseClassPerFile = 0
n_PRG_Compat_Level = 0 && 0=COMPATIBLE WITH FoxBin2Prg v1.19.49 and earlier, 1=Include HELPSTRING
n_ExcludeDBFAutoincNextval = 0
l_ClassPerFileCheck = .F.
l_RedirectClassPerFileToMain = .F.
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_PJ2 = 'PJ2' && PJX
c_VC2 = 'VC2' && VCX
c_SC2 = 'SC2' && SCX
c_FR2 = 'FR2' && FRX
c_LB2 = 'LB2' && LBX
c_MN2 = 'MN2' && MNX
c_DB2 = 'DB2' && DBF
c_DC2 = 'DC2' && DBC
c_FK2 = 'FK2' && FKY
c_ME2 = 'ME2' && MEM
n_PJX_Conversion_Support = 2
n_VCX_Conversion_Support = 2
n_SCX_Conversion_Support = 2
n_FRX_Conversion_Support = 2
n_LBX_Conversion_Support = 2
n_MNX_Conversion_Support = 2
n_DBC_Conversion_Support = 2
n_DBF_Conversion_Support = 1
n_FKY_Conversion_Support = 1
n_MEM_Conversion_Support = 1
c_DBF_Conversion_Included = ''
c_DBF_Conversion_Excluded = ''
*** DH 2021-03-04: added cOutputFolder and n_HomeDir properties
cOutputFolder = '' && the folder to write files to (blank = same folder as source file)
n_HomeDir = 1 && 0 = don't save HomeDir in PJ2, 1 = save HomeDir in PJ2
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
Procedure c_Language_In_ACCESS
If This.n_CFG_Actual = 0 Or Isnull( This.o_Configuration( This.n_CFG_Actual ) )
Return This.c_Language_In
Else
Return Nvl( This.o_Configuration( This.n_CFG_Actual ).c_Language_In, This.c_Language_In )
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 n_PJX_Conversion_Support_ACCESS
If This.n_CFG_Actual = 0 Or Isnull( This.o_Configuration( This.n_CFG_Actual ) )
Return This.n_PJX_Conversion_Support
Else
Return Nvl( This.o_Configuration( This.n_CFG_Actual ).n_PJX_Conversion_Support, This.n_PJX_Conversion_Support )
Endif
Endproc
Procedure n_VCX_Conversion_Support_ACCESS
If This.n_CFG_Actual = 0 Or Isnull( This.o_Configuration( This.n_CFG_Actual ) )
Return This.n_VCX_Conversion_Support
Else
Return Nvl( This.o_Configuration( This.n_CFG_Actual ).n_VCX_Conversion_Support, This.n_VCX_Conversion_Support )
Endif
Endproc
Procedure n_SCX_Conversion_Support_ACCESS
If This.n_CFG_Actual = 0 Or Isnull( This.o_Configuration( This.n_CFG_Actual ) )
Return This.n_SCX_Conversion_Support
Else
Return Nvl( This.o_Configuration( This.n_CFG_Actual ).n_SCX_Conversion_Support, This.n_SCX_Conversion_Support )
Endif
Endproc
Procedure n_FRX_Conversion_Support_ACCESS
If This.n_CFG_Actual = 0 Or Isnull( This.o_Configuration( This.n_CFG_Actual ) )
Return This.n_FRX_Conversion_Support
Else
Return Nvl( This.o_Configuration( This.n_CFG_Actual ).n_FRX_Conversion_Support, This.n_FRX_Conversion_Support )
Endif
Endproc
Procedure n_LBX_Conversion_Support_ACCESS
If This.n_CFG_Actual = 0 Or Isnull( This.o_Configuration( This.n_CFG_Actual ) )
Return This.n_LBX_Conversion_Support
Else
Return Nvl( This.o_Configuration( This.n_CFG_Actual ).n_LBX_Conversion_Support, This.n_LBX_Conversion_Support )
Endif
Endproc
Procedure n_DBC_Conversion_Support_ACCESS
If This.n_CFG_Actual = 0 Or Isnull( This.o_Configuration( This.n_CFG_Actual ) )
Return This.n_DBC_Conversion_Support
Else
Return Nvl( This.o_Configuration( This.n_CFG_Actual ).n_DBC_Conversion_Support, This.n_DBC_Conversion_Support )
Endif
Endproc
Procedure n_DBF_Conversion_Support_ACCESS
If This.n_CFG_Actual = 0 Or Isnull( This.o_Configuration( This.n_CFG_Actual ) )
Return This.n_DBF_Conversion_Support
Else
Return Nvl( This.o_Configuration( This.n_CFG_Actual ).n_DBF_Conversion_Support, This.n_DBF_Conversion_Support )
Endif
Endproc
Procedure n_MNX_Conversion_Support_ACCESS
If This.n_CFG_Actual = 0 Or Isnull( This.o_Configuration( This.n_CFG_Actual ) )
Return This.n_MNX_Conversion_Support
Else
Return Nvl( This.o_Configuration( This.n_CFG_Actual ).n_MNX_Conversion_Support, This.n_MNX_Conversion_Support )
Endif
Endproc
Procedure n_FKY_Conversion_Support_ACCESS
If This.n_CFG_Actual = 0 Or Isnull( This.o_Configuration( This.n_CFG_Actual ) )
Return This.n_FKY_Conversion_Support
Else
Return Nvl( This.o_Configuration( This.n_CFG_Actual ).n_FKY_Conversion_Support, This.n_FKY_Conversion_Support )
Endif
Endproc
Procedure n_MEM_Conversion_Support_ACCESS
If This.n_CFG_Actual = 0 Or Isnull( This.o_Configuration( This.n_CFG_Actual ) )
Return This.n_MEM_Conversion_Support
Else
Return Nvl( This.o_Configuration( This.n_CFG_Actual ).n_MEM_Conversion_Support, This.n_MEM_Conversion_Support )
Endif
Endproc
Procedure c_DBF_Conversion_Included_ACCESS
If This.n_CFG_Actual = 0 Or Isnull( This.o_Configuration( This.n_CFG_Actual ) )
Return This.c_DBF_Conversion_Included
Else
Return Nvl( This.o_Configuration( This.n_CFG_Actual ).c_DBF_Conversion_Included, This.c_DBF_Conversion_Included )
Endif
Endproc
Procedure c_DBF_Conversion_Excluded_ACCESS
If This.n_CFG_Actual = 0 Or Isnull( This.o_Configuration( This.n_CFG_Actual ) )
Return This.c_DBF_Conversion_Excluded
Else
Return Nvl( This.o_Configuration( This.n_CFG_Actual ).c_DBF_Conversion_Excluded, This.c_DBF_Conversion_Excluded )
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
*** DH 2021-03-04: added n_HomeDir_Access
Procedure n_HomeDir_ACCESS
If This.n_CFG_Actual = 0 Or Isnull( This.o_Configuration( This.n_CFG_Actual ) )
Return This.n_HomeDir
Else
Return Nvl( This.o_Configuration( This.n_CFG_Actual ).n_HomeDir, This.n_HomeDir )
Endif
Endproc
*** DH 2021-03-04: end of new code
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
* tl_ForceLog (v? IN ) Force logging of settings. used on cfg setting as object
*--------------------------------------------------------------------------------------------------------------
Lparameters tcDontShowProgress, tcDontShowErrors, tcNoTimestamps, tcDebug, tcRecompile, tcExtraBackupLevels ;
, tcClearUniqueID, tcOptimizeByFilestamp, tc_InputFile, tcInputFile_Type, toParentCFG, tl_ForceLog
#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 + ;
' CFG_Actual:' + Transform(.n_CFG_Actual) + Icase(.n_CFG_Actual=1, ' [MASTER]', ' [SECONDARY]') )
Else
lo_CFG = Createobject('CL_CFG')
lo_Configuration.Add( lo_CFG, lc_CFG_Path )
.n_CFG_Actual = lo_Configuration.Count
.writeLog( '> ' + Upper(loLang.C_CACHING_CONFIG_FOR_DIRECTORY_LOC) + ': ' + lc_CFG_Path + ;
' CFG_Actual:' + Transform(.n_CFG_Actual) + Icase(.n_CFG_Actual=1, ' [MASTER]', ' [SECONDARY]') )
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
*settings for internal work, not processing
* Depricated:
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), 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 , At('&'+'&',laConfig(m.I)) - 10 ) )
.changeLanguage(lcValue)
lo_CFG.c_Language_In = m.lcValue
.writeLog( C_TAB + Justfname(lcConfigFile) + ' > Language: ' + Transform(lcValue) + ' (' + .c_Language + ')' )
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), 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), 16 ) == Lower('BackgroundImage:')
lcValue = Alltrim( Substr( laConfig(m.I), 17 ) )
Do Case
Case Empty(lcValue)
lo_CFG.c_BackgroundImage = lcValue
.writeLog( C_TAB + Justfname(lcConfigFile) + ' > BackgroundImage: (Empty)' )
Case Adir( laDirInfo, lcValue ) > 0
lo_CFG.c_BackgroundImage = lcValue
.writeLog( C_TAB + Justfname(lcConfigFile) + ' > BackgroundImage: ' + Transform(lo_CFG.c_BackgroundImage) )
Otherwise
.writeLog( C_TAB + Justfname(lcConfigFile) + ' > BackgroundImage: File not found: ' + Transform(lo_CFG.c_BackgroundImage) )
Endcase
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
*** DH 2021-03-04: handle n_HomeDir configuration setting
Case Left( laConfig(m.I), 8 ) == Lower('HomeDir:')
lcValue = Alltrim( Substr( laConfig(m.I), 9 ) )
If Inlist( lcValue, '0', '1' ) Then
lo_CFG.n_HomeDir = Int( Val( lcValue ) )
.writeLog( C_TAB + Justfname(lcConfigFile) + ' > HomeDir: ' + Transform(lo_CFG.n_HomeDir) )
Endif
*** DH 2021-03-04: end of new code
**************
*Conversion operation by type
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.n_PJX_Conversion_Support = Int( Val( lcValue ) )
.writeLog( C_TAB + Justfname(lcConfigFile) + ' > PJX_Conversion_Support: ' + Transform(lo_CFG.n_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.n_VCX_Conversion_Support = Int( Val( lcValue ) )
.writeLog( C_TAB + Justfname(lcConfigFile) + ' > VCX_Conversion_Support: ' + Transform(lo_CFG.n_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.n_SCX_Conversion_Support = Int( Val( lcValue ) )
.writeLog( C_TAB + Justfname(lcConfigFile) + ' > SCX_Conversion_Support: ' + Transform(lo_CFG.n_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.n_FRX_Conversion_Support = Int( Val( lcValue ) )
.writeLog( C_TAB + Justfname(lcConfigFile) + ' > FRX_Conversion_Support: ' + Transform(lo_CFG.n_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.n_LBX_Conversion_Support = Int( Val( lcValue ) )
.writeLog( C_TAB + Justfname(lcConfigFile) + ' > LBX_Conversion_Support: ' + Transform(lo_CFG.n_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.n_MNX_Conversion_Support = Int( Val( lcValue ) )
.writeLog( C_TAB + Justfname(lcConfigFile) + ' > MNX_Conversion_Support: ' + Transform(lo_CFG.n_MNX_Conversion_Support) )
Endif
Case Left( laConfig(m.I), 23 ) == Lower('DBF_Conversion_Support:')
lcValue = Alltrim( Substr( laConfig(m.I), 24 ) )
If Inlist( lcValue, '0', '1', '2', '4', '8' ) Then
lo_CFG.n_DBF_Conversion_Support = Int( Val( lcValue ) )
.writeLog( C_TAB + Justfname(lcConfigFile) + ' > DBF_Conversion_Support: ' + Transform(lo_CFG.n_DBF_Conversion_Support) )
Endif
Case Left( laConfig(m.I), 23 ) == Lower('DBC_Conversion_Support:')
lcValue = Alltrim( Substr( laConfig(m.I), 24 ) )
If Inlist( lcValue, '0', '1', '2' ) Then
lo_CFG.n_DBC_Conversion_Support = Int( Val( lcValue ) )
.writeLog( C_TAB + Justfname(lcConfigFile) + ' > DBC_Conversion_Support: ' + Transform(lo_CFG.n_DBC_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.n_FKY_Conversion_Support = Int( Val( lcValue ) )
.writeLog( C_TAB + Justfname(lcConfigFile) + ' > FKY_Conversion_Support: ' + Transform(lo_CFG.n_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.n_MEM_Conversion_Support = Int( Val( lcValue ) )
.writeLog( C_TAB + Justfname(lcConfigFile) + ' > MEM_Conversion_Support: ' + Transform(lo_CFG.n_MEM_Conversion_Support) )
Endif
*-------- setting for container files (not pjx) --------
*Classes and forms ( vcx / scx)
*!* 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), 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
*Databases
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
*/-------- setting for container files (not pjx) --------
*general files
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), 14 ) == Lower('ClearUniqueID:')
lcValue = Alltrim( Substr( laConfig(m.I), 15 ) )
If Not Inlist( Transform(tcClearUniqueID), '0', '1' ) And Inlist( lcValue, '0', '1' ) Then
tcClearUniqueID = lcValue
.writeLog( C_TAB + Justfname(lcConfigFile) + ' > ClearUniqueID: ' + Transform(lcValue) )
Endif
Case Left( laConfig(m.I), 20 ) == Lower('OptimizeByFilestamp:')
lcValue = Alltrim( Substr( laConfig(m.I), 21 ) )
If Not Inlist( Transform(tcOptimizeByFilestamp), '0', '1', '2' ) And Inlist( lcValue, '0', '1', '2' ) Then
tcOptimizeByFilestamp = lcValue
.writeLog( C_TAB + Justfname(lcConfigFile) + ' > OptimizeByFilestamp: ' + Transform(lcValue) )
Endif
Case Left( laConfig(m.I), 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(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) )
*pjx special
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
*dbf special
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), 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), 24 ) == Lower('DBF_Conversion_Included:')
lcValue = Alltrim( Substr( laConfig(m.I), 25 , At('&'+'&',laConfig(m.I)) - 25 ) )
If Not Empty(lcValue) Then
lo_CFG.c_DBF_Conversion_Included = lcValue
.writeLog( C_TAB + Justfname(lcConfigFile) + ' > DBF_Conversion_Included: ' + Transform(lo_CFG.c_DBF_Conversion_Included) )
Endif
Case Left( laConfig(m.I), 24 ) == Lower('DBF_Conversion_Excluded:')
lcValue = Alltrim( Substr( laConfig(m.I), 25 , At('&'+'&',laConfig(m.I)) - 25 ) )
If Not Empty(lcValue) Then
lo_CFG.c_DBF_Conversion_Excluded = lcValue
.writeLog( C_TAB + Justfname(lcConfigFile) + ' > DBF_Conversion_Excluded: ' + Transform(lo_CFG.c_DBF_Conversion_Excluded) )
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
*Text file extensions
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
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.
If Not tl_ForceLog Then
Exit
Endif &&NOT tl_ForceLog
Endif
* SF
.writeLog( '> ' + loLang.C_USING_THIS_SETTINGS_LOC + ':' )
*internal info, just what is read to this moment
.writeLog( C_TAB + 'CFG_Actual: ' + Transform(.n_CFG_Actual) + Icase(.n_CFG_Actual=1, ' [MASTER]', ' [SECONDARY]') )
.writeLog( C_TAB + 'CFG_CachedAccess: ' + Transform(.l_CFG_CachedAccess) )
.writeLog( C_TAB + 'tc_InputFile: ' + Transform(Evl(tc_InputFile,'') ) )
.writeLog( C_TAB + 'Foxbin2prg_ConfigFile: ' + Transform(Evl(lo_CFG.c_Foxbin2prg_ConfigFile, '(Internal defaults)') ) )
*settings for internal work, not processing
.writeLog( C_TAB + 'Language: ' + Transform(.c_Language) + ' (' + .c_Language_In + ')' )
.writeLog( C_TAB + 'ShowProgressbar: ' + Transform(.n_ShowProgressbar) )
.writeLog( C_TAB + 'ShowErrors: ' + Transform(.l_ShowErrors) )
.writeLog( C_TAB + 'ExtraBackupLevels: ' + Transform(.n_ExtraBackupLevels) )
Do Case
Case Empty ( .c_BackgroundImage )
.writeLog( C_TAB + 'BackgroundImage: ' + '(Empty)' )
Case Lower( Justfname ( .c_BackgroundImage ) ) == 'foxbin2prg.jpg'
.writeLog( C_TAB + 'BackgroundImage: ' + Transform(.c_BackgroundImage) + '(Internal default)' )
Otherwise
.writeLog( C_TAB + 'BackgroundImage: ' + Transform(.c_BackgroundImage) )
Endcase
.writeLog( C_TAB + 'Debug: ' + Transform(.n_Debug) )
* SF, 2021/030/06: added DH HomeDir option
.writeLog( C_TAB + 'HomeDir: ' + Transform(.n_HomeDir) )
*Conversion operation by type
.writeLog( C_TAB + 'PJX_Conversion_Support ' + Transform(.n_PJX_Conversion_Support) )
.writeLog( C_TAB + 'VCX_Conversion_Support ' + Transform(.n_VCX_Conversion_Support) )
.writeLog( C_TAB + 'SCX_Conversion_Support ' + Transform(.n_SCX_Conversion_Support) )
.writeLog( C_TAB + 'FRX_Conversion_Support ' + Transform(.n_FRX_Conversion_Support) )
.writeLog( C_TAB + 'LBX_Conversion_Support ' + Transform(.n_LBX_Conversion_Support) )
.writeLog( C_TAB + 'MNX_Conversion_Support ' + Transform(.n_MNX_Conversion_Support) )
.writeLog( C_TAB + 'DBF_Conversion_Support ' + Transform(.n_DBF_Conversion_Support) )
.writeLog( C_TAB + 'DBC_Conversion_Support ' + Transform(.n_DBC_Conversion_Support) )
.writeLog( C_TAB + 'FKY_Conversion_Support ' + Transform(.n_FKY_Conversion_Support) )
.writeLog( C_TAB + 'MEM_Conversion_Support ' + Transform(.n_MEM_Conversion_Support) )
*setting for container files (not pjx)
*Classes and forms ( vcx / scx)
.writeLog( C_TAB + 'UseClassPerFile: ' + Transform(.n_UseClassPerFile) )
.writeLog( C_TAB + 'ClassPerFileCheck: ' + Transform(.l_ClassPerFileCheck) )
.writeLog( C_TAB + 'RedirectClassPerFileToMain: ' + Transform(.l_RedirectClassPerFileToMain) )
.writeLog( C_TAB + 'RedirectClassType: ' + Transform(.n_RedirectClassType) )
*Databases
*!* Changed by: Lutz Scheffler 21.02.2021
*!* change date="{^2021-02-21,10:57:00}"
* additional options controlling
* - split of DBC separated from VCX/SCX
* - new operations of DBF
.writeLog( C_TAB + 'OldFilesPerDBC: ' + Transform(.l_OldFilesPerDBC) )
.writeLog( C_TAB + 'UseFilesPerDBC: ' + Transform(.n_UseFilesPerDBC) )
.writeLog( C_TAB + 'RedirectFilePerDBCToMain: ' + Transform(.l_RedirectFilePerDBCToMain) )
.writeLog( C_TAB + 'ItemPerDBCCheck: ' + Transform(.l_ItemPerDBCCheck) )
.writeLog( C_TAB + 'DBF_BinChar_Base64: ' + Transform(.l_DBF_BinChar_Base64) )
.writeLog( C_TAB + 'DBF_IncludeDeleted: ' + Transform(.l_DBF_IncludeDeleted) )
*!* /Changed by: Lutz Scheffler 21.02.2021
*general files
.writeLog( C_TAB + 'NoTimestamps: ' + Transform(.l_NoTimestamps) )
.writeLog( C_TAB + 'ClearUniqueID: ' + Transform(.l_ClearUniqueID) )
.writeLog( C_TAB + 'OptimizeByFilestamp: ' + Transform(.n_OptimizeByFilestamp) )
.writeLog( C_TAB + 'RemoveNullCharsFromCode: ' + Transform(.l_RemoveNullCharsFromCode) )
.writeLog( C_TAB + 'RemoveZOrderSetFromProps: ' + Transform(.l_RemoveZOrderSetFromProps) )
.writeLog( C_TAB + 'PRG_Compat_Level: ' + Transform(.n_PRG_Compat_Level) )
*Parameter only:
.writeLog( C_TAB + 'Recompile: ' + Transform(.l_Recompile) + ' (' + tcRecompile + ')' )
*pjx special
.writeLog( C_TAB + 'BodyDevInfo: ' + Transform(.n_BodyDevInfo) )
*dbf special
.writeLog( C_TAB + 'ClearDBFLastUpdate: ' + Transform(.l_ClearDBFLastUpdate) )
.writeLog( C_TAB + 'ExcludeDBFAutoincNextval: ' + Transform(.n_ExcludeDBFAutoincNextval) )
.writeLog( C_TAB + 'DBF_Conversion_Included ' + Transform(.c_DBF_Conversion_Included) )
.writeLog( C_TAB + 'DBF_Conversion_Excluded ' + Transform(.c_DBF_Conversion_Excluded) )
.writeLog( C_TAB + 'DBF_BinChar_Base64: ' + Transform(.l_DBF_BinChar_Base64) )
.writeLog( C_TAB + 'DBF_IncludeDeleted: ' + Transform(.l_DBF_IncludeDeleted) )
*Text file extensions
.writeLog( C_TAB + 'extension: VC2 ' + Transform(.c_VC2) )
.writeLog( C_TAB + 'extension: SC2 ' + Transform(.c_SC2) )
.writeLog( C_TAB + 'extension: FR2 ' + Transform(.c_FR2) )
.writeLog( C_TAB + 'extension: LB2 ' + Transform(.c_LB2) )
.writeLog( C_TAB + 'extension: MN2 ' + Transform(.c_MN2) )
.writeLog( C_TAB + 'extension: DB2 ' + Transform(.c_DB2) )
.writeLog( C_TAB + 'extension: DC2 ' + Transform(.c_DC2) )
.writeLog( C_TAB + 'extension: FK2 ' + Transform(.c_FK2) )
.writeLog( C_TAB + 'extension: ME2 ' + Transform(.c_ME2) )
.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, lcValue
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, 23 ) == Lower('DBF_Conversion_Support:')
to_out_DBF_CFG.n_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.n_DBF_Conversion_Support) )
Endif
Case Left( lcConfigItem, 21 ) == Lower('DBF_Conversion_Order:')
to_out_DBF_CFG.DBF_Conversion_Order = Alltrim( Substr( laConfig(m.I), 22 , At('&'+'&',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 , At('&'+'&',laConfig(m.I)) - 26 ) )
If tlGenerateLog Then
This.writeLog(' ' + Justfname(lcTableCFG) + ' > DBF_Conversion_Condition: ' + to_out_DBF_CFG.DBF_Conversion_Condition )
Endif
*!* Changed by: Lutz Scheffler 18.03.2021
*!* change date="{^2021-03-18,10:57:00}"
* additional options controlling
* - new operations of DBF, additional list of non structural index files
Case Left( lcConfigItem, 14 ) == Lower('DBF_IndexList:')
to_out_DBF_CFG.DBF_IndexList = Substr( laConfig(m.I), 15 , At('&'+'&',laConfig(m.I)) - 15 )
If tlGenerateLog Then
This.writeLog(' ' + Justfname(lcTableCFG) + ' >DBF_IndexList: ' + Transform(to_out_DBF_CFG.DBF_IndexList) )
Endif
*!* /Changed by: Lutz Scheffler 18.03.2021
*!* 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, 19 ) == Lower('DBF_BinChar_Base64:')
lcValue = Alltrim( Substr( laConfig(m.I), 20 ) )
If Inlist( m.lcValue, '0', '1' ) Then
to_out_DBF_CFG.l_DBF_BinChar_Base64 = ( Transform(m.lcValue ) == '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, 19 ) == Lower('DBF_IncludeDeleted:')
lcValue = Alltrim( Substr( laConfig(m.I), 20 ) )
If Inlist( m.lcValue, '0', '1' ) Then
to_out_DBF_CFG.l_DBF_IncludeDeleted = ( Transform( m.lcValue ) == '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', .n_PJX_Conversion_Support > 0 ;
, lcExt == 'VCX', .n_VCX_Conversion_Support > 0 ;
, lcExt == 'SCX', .n_SCX_Conversion_Support > 0 ;
, lcExt == 'FRX', .n_FRX_Conversion_Support > 0 ;
, lcExt == 'LBX', .n_LBX_Conversion_Support > 0 ;
, lcExt == 'MNX', .n_MNX_Conversion_Support > 0 ;
, lcExt == 'DBC', .n_DBC_Conversion_Support > 0 ;
, lcExt == 'DBF', Not Isnull(loDBF_CFG) And loDBF_CFG.n_DBF_Conversion_Support > 0 Or .n_DBF_Conversion_Support > 0 ;
, lcExt == 'FKY', .n_FKY_Conversion_Support > 0 ;
, lcExt == 'MEM', .n_MEM_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, .n_PJX_Conversion_Support = 2 ;
, lcExt == .c_VC2, .n_VCX_Conversion_Support = 2 ;
, lcExt == .c_SC2, .n_SCX_Conversion_Support = 2 ;
, lcExt == .c_FR2, .n_FRX_Conversion_Support = 2 ;
, lcExt == .c_LB2, .n_LBX_Conversion_Support = 2 ;
, lcExt == .c_MN2, .n_MNX_Conversion_Support = 2 ;
, lcExt == .c_FK2, .n_FKY_Conversion_Support = 2 ;
, lcExt == .c_ME2, .n_MEM_Conversion_Support = 2 ;
, lcExt == .c_DB2, Not Isnull(loDBF_CFG) And Inlist(loDBF_CFG.n_DBF_Conversion_Support, 2, 8) ;
OR (Inlist(.n_DBF_Conversion_Support, 2, 8) ;
AND (Isnull(loDBF_CFG) Or Not Inlist(loDBF_CFG.n_DBF_Conversion_Support, 1, 4))) ;
, lcExt == .c_DC2, .n_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'), .n_PJX_Conversion_Support ;
, Inlist(lcExt, .c_VC2, 'VCX'), .n_VCX_Conversion_Support ;
, Inlist(lcExt, .c_SC2, 'SCX'), .n_SCX_Conversion_Support ;
, Inlist(lcExt, .c_FR2, 'FRX'), .n_FRX_Conversion_Support ;
, Inlist(lcExt, .c_LB2, 'LBX'), .n_LBX_Conversion_Support ;
, Inlist(lcExt, .c_MN2, 'MNX'), .n_MNX_Conversion_Support ;
, Inlist(lcExt, .c_FK2, 'FKY'), .n_FKY_Conversion_Support ;
, Inlist(lcExt, .c_ME2, 'MEM'), .n_MEM_Conversion_Support ;
, Inlist(lcExt, .c_DB2, 'DBF'), Icase( Isnull(loDBF_CFG) Or loDBF_CFG.n_DBF_Conversion_Support = 0, .n_DBF_Conversion_Support, loDBF_CFG.n_DBF_Conversion_Support ) ;
, Inlist(lcExt, .c_DC2, 'DBC'), .n_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, lcType ;
, 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.
lcType = Evl(tcType,'')
tcType = Upper( lcType )
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(lcType, '(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
*!* Changed by: Lutz Scheffler 09.3.2021
*!* change date="{^2021-03-09,08:06:00}"
* log settings for tcCFG_File - cfg as object
.evaluateConfiguration( @tcDontShowProgress, @tcDontShowErrors, @tcNoTimestamps, @tcDebug, @tcRecompile, @tcBackupLevels ;
, @tcClearUniqueID, @tcOptimizeByFilestamp, @tc_InputFile, @lcInputFile_Type, , Vartype(tcCFG_File) = "O" )
*!* /Changed by: Lutz Scheffler 09.3.2021
*!* 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 Lower(m.lcType)=='-c'
* not handled
Case m.lcType=='-t'
* not handled
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( Justpath( m.tc_InputFile ) + '\' + Juststem( Juststem( m.tc_InputFile ) ) + '.' + Justext( m.tc_InputFile ) )
*remove baseclass
If .n_UseClassPerFile = 2
*remove baseclass
tc_InputFile = Lower( Justpath( m.tc_InputFile ) + '\' + 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
*!* Changed by: Lutz Scheffler 15.2.2021
*!* change date="{^2021-02-15,18:44:00}"
* added option to create config files
Case m.lcType=='-t' And ( Vartype( m.tc_InputFile )='C' And !Empty( m.tc_InputFile ) )
loLang = _Screen.o_FoxBin2Prg_Lang
Strtofile( Strtran( Strtran( '*' + m.loLang.C_FOXBIN2PRG_SYNTAX_INFO_EXAMPLE_LOC_tab_cfg, 0h0D0A, 0h0D0A + '*'), 0h0D0A + '*' + 0h0D0A, 0h0D0A0D0A), m.tc_InputFile )
Case m.lcType=='-c'
tc_InputFile = Iif( Vartype( m.tc_InputFile )='C' And !Empty( m.tc_InputFile ), m.tc_InputFile, 'FoxBin2Prg._cfg' )
loLang = _Screen.o_FoxBin2Prg_Lang
Strtofile( Strtran( '*' + Strtran( m.loLang.C_FOXBIN2PRG_SYNTAX_INFO_EXAMPLE_LOC_cfg, 0h0D0A, 0h0D0A + '*'), 0h0D0A + '*' + 0h0D0A, 0h0D0A0D0A), m.tc_InputFile )
*!* /Changed by: Lutz Scheffler 15.2.2021
*!* Changed by: Lutz Scheffler 07.3.2021
*!* change date="{^2021-03-07,18:44:00}"
* added option to create config files with values
Case m.lcType=='-C'
Local;
lcText As String,;
lcValue As String,;
lcReturn As String,;
lnLines As Number,;
lnLine As Number,;
lnOptions As Number,;
lnOption As Number
lnOptions = 48
Local Array;
laLines(1),;
laOptions(m.lnOptions,3)
tc_InputFile = Iif( Vartype( m.tc_InputFile )='C' And !Empty( m.tc_InputFile ), m.tc_InputFile, 'FoxBin2Prg._cfg' )
loLang = _Screen.o_FoxBin2Prg_Lang
lcText = Strtran( '*' + Strtran( m.loLang.C_FOXBIN2PRG_SYNTAX_INFO_EXAMPLE_LOC_cfg, 0h0D0A, 0h0D0A + '*'), 0h0D0A + '*' + 0h0D0A, 0h0D0A0D0A)
lnLines = Alines(laLines,m.lcText)
*now for each option
laOptions(01,1) = "*ShowProgressbar:" && 0=Don't show, 1=Allways show, 2= Show only for multi-file processing
laOptions(01,2) = ".n_ShowProgressbar"
laOptions(01,3) = 0
laOptions(02,1) = "*DontShowErrors:" && 0,1 Show message errors by default
laOptions(02,2) = ".l_ShowErrors"
laOptions(02,3) = 3
laOptions(03,1) = "*NoTimestamps:" && 0,1 Clear timestamps by default for minimize differences
laOptions(03,2) = ".l_NoTimestamps"
laOptions(03,3) = 1
laOptions(04,1) = "*Debug:" && 0,1 Don't Activate individual <file>.Log by default
laOptions(04,2) = ".n_Debug"
laOptions(04,3) = 0
laOptions(05,1) = "*BodyDevInfo:" && 0,1 [0=Don't keep DevInfo for body pjx records], 1=Keep DevInfo
laOptions(05,2) = ".n_BodyDevInfo"
laOptions(05,3) = 0
laOptions(06,1) = "*ExtraBackupLevels:" && n By default 1 BAK is created. With this you can make more .N.BAK, or none
laOptions(06,2) = ".n_ExtraBackupLevels"
laOptions(06,3) = 0
laOptions(07,1) = "*ClearUniqueID:" && 0,1 0=Keep UniqueID in text files, 1=Clear Unique ID. Useful for Diff and Merge
laOptions(07,2) = ".l_ClearUniqueID"
laOptions(07,3) = 1
laOptions(08,1) = "*ClearDBFLastUpdate:" && 0,1 0=Keep DBF LastUpdate, 1=Clear DBF LastUpdate. Useful for Diff.
laOptions(08,2) = ".l_ClearDBFLastUpdate"
laOptions(08,3) = 1
laOptions(09,1) = "*OptimizeByFilestamp:" && 0,1,2 1=Optimize file regeneration depending on file timestamp. Dangerous while working with branches!
laOptions(09,2) = ".n_OptimizeByFilestamp"
laOptions(09,3) = 0
laOptions(10,1) = "*RemoveNullCharsFromCode:" && 0,1 1=.t. 1=Drop NULL chars from source code
laOptions(10,2) = ".l_RemoveNullCharsFromCode"
laOptions(10,3) = 1
laOptions(11,1) = "*RemoveZOrderSetFromProps:" && 0,1 1=.t. 0=Do not remove ZOrderSet property from object, 1=Remove ZOrderSet property from object
laOptions(11,2) = ".l_RemoveZOrderSetFromProps"
laOptions(11,3) = 1
laOptions(12,1) = "*Language:" && Language of shown messages and LOGs. EN=English, FR=French, ES=Español, DE=German, Not defined = AUTOMATIC [DEFAULT]
laOptions(12,2) = ".c_Language_In"
laOptions(12,3) = 0
laOptions(13,1) = "*ExcludeDBFAutoincNextval:" && 0,1 [0=Do not exclude this value from db2], 1=Exclude this value from db2
laOptions(13,2) = ".n_ExcludeDBFAutoincNextval"
laOptions(13,3) = 0
laOptions(14,1) = "*PRG_Compat_Level:" && n [0=Legacy], 1=Use HELPSTRING as Class Procedure comment
laOptions(14,2) = ".n_PRG_Compat_Level"
laOptions(14,3) = 0
laOptions(15,1) = "*HomeDir:" && 0,1 0 = don't save HomeDir in PJ2, [1 = save HomeDir in PJ2]
laOptions(15,2) = ".n_HomeDir"
laOptions(15,3) = 0
laOptions(16,1) = "*PJX_Conversion_Support:" && n 0=No support, 1=Generate TXT only (Diff), 2=Generate TXT and BIN (Merge)
laOptions(16,2) = ".n_PJX_Conversion_Support"
laOptions(16,3) = 0
laOptions(17,1) = "*VCX_Conversion_Support:" && n 0=No support, 1=Generate TXT only (Diff), 2=Generate TXT and BIN (Merge)
laOptions(17,2) = ".n_VCX_Conversion_Support"
laOptions(17,3) = 0
laOptions(18,1) = "*SCX_Conversion_Support:" && n 0=No support, 1=Generate TXT only (Diff), 2=Generate TXT and BIN (Merge)
laOptions(18,2) = ".n_SCX_Conversion_Support"
laOptions(18,3) = 0
laOptions(19,1) = "*FRX_Conversion_Support:" && n 0=No support, 1=Generate TXT only (Diff), 2=Generate TXT and BIN (Merge)
laOptions(19,2) = ".n_FRX_Conversion_Support"
laOptions(19,3) = 0
laOptions(20,1) = "*LBX_Conversion_Support:" && n 0=No support, 1=Generate TXT only (Diff), 2=Generate TXT and BIN (Merge)
laOptions(20,2) = ".n_LBX_Conversion_Support"
laOptions(20,3) = 0
laOptions(21,1) = "*DBC_Conversion_Support:" && 0=No support, 1=Generate TXT only (Diff), 2=Generate TXT and BIN (Merge)
laOptions(21,2) = ".n_DBC_Conversion_Support"
laOptions(21,3) = 0
laOptions(22,1) = "*DBF_Conversion_Support:" && n 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)
laOptions(22,2) = ".n_DBF_Conversion_Support"
laOptions(22,3) = 0
laOptions(23,1) = "*MNX_Conversion_Support:" && n 0=No support, 1=Generate TXT only (Diff), 2=Generate TXT and BIN (Merge)
laOptions(23,2) = ".n_MNX_Conversion_Support"
laOptions(23,3) = 0
laOptions(24,1) = "*FKY_Conversion_Support:" && n 0=No support, 1=Generate TXT only (Diff)
laOptions(24,2) = ".n_FKY_Conversion_Support"
laOptions(24,3) = 0
laOptions(25,1) = "*MEM_Conversion_Support:" && 0=No support, 1=Generate TXT only (Diff)
laOptions(25,2) = ".n_MEM_Conversion_Support"
laOptions(25,3) = 0
laOptions(26,1) = "*DBF_Conversion_Included:" && n If DBF_Conversion_Support:4, you can specify multiple filemasks: www,fb2p_free.dbf
laOptions(26,2) = ".c_DBF_Conversion_Included"
laOptions(26,3) = 5
laOptions(27,1) = "*DBF_Conversion_Excluded:" && n If DBF_Conversion_Support:4, you can specify multiple filemasks: www,fb2p_free.dbf
laOptions(27,2) = ".c_DBF_Conversion_Excluded"
laOptions(27,3) = 4
laOptions(28,1) = "*OldFilesPerDBC:" && 0,1 1=.t. 1=Turns the File per DBC options on, 0 uses the old UseClassPerFile etc settings.
laOptions(28,2) = ".l_OldFilesPerDBC"
laOptions(28,3) = 1
laOptions(29,1) = "*UseFilesPerDBC:" && 0,1 0=One database dc2 file, 1=Multiple file.*.*.dc2 files
laOptions(29,2) = ".n_UseFilesPerDBC"
laOptions(29,3) = 0
laOptions(30,1) = "*RedirectFilePerDBCToMain:" && 0,1 1=.t. 0=Don't redirect to file.dc2, 1=Redirect to file.tx2 when selecting file.item.*.dc2
laOptions(30,2) = ".l_RedirectFilePerDBCToMain"
laOptions(30,3) = 1
laOptions(31,1) = "*ItemPerDBCCheck:" && 0,1 1=.t. 0=Don't check file.item.*.dc2 inclusion, 1=Check file.item.*.dc2 inclusion
laOptions(31,2) = ".l_ItemPerDBCCheck"
laOptions(31,3) = 1
laOptions(32,1) = "*DBF_BinChar_Base64:" && 0,1 1=.t. 0=For character type fields, if NoCPTrans 0=do not transform, 1=use Base64 transform (default)
laOptions(32,2) = ".l_DBF_BinChar_Base64"
laOptions(32,3) = 1
laOptions(33,1) = "*DBF_IncludeDeleted:" && 0,1 1=.t. 0=Do not include deleted records (default), 1=Include deleted records
laOptions(33,2) = ".l_DBF_IncludeDeleted"
laOptions(33,3) = 1
laOptions(34,1) = "*UseClassPerFile:" && n 0=One library tx2 file, 1=Multiple file.class.tx2 files, 2=Multiple file.baseclass.class.tx2 files
laOptions(34,2) = ".n_UseClassPerFile"
laOptions(34,3) = 0
laOptions(35,1) = "*RedirectClassPerFileToMain:" && 0,1 1=.t. 0=Don't redirect to file.tx2, 1=Redirect to file.tx2 when selecting file.class.tx2
laOptions(35,2) = ".l_RedirectClassPerFileToMain"
laOptions(35,3) = 1
laOptions(36,1) = "*RedirectClassType:" && 0,1,2 For classes created with UseClassPerFile>0 in the form file[.baseclass].class.tx2
laOptions(36,2) = ".n_RedirectClassType"
laOptions(36,3) = 0
laOptions(37,1) = "*ClassPerFileCheck:" && 0,1 1=.t. 0=Don't check file.class.tx2 inclusion, 1=Check file.class.tx2 inclusion
laOptions(37,2) = ".l_ClassPerFileCheck"
laOptions(37,3) = 1
laOptions(38,1) = "*extension: pj2=" && ext Text file to PJX
laOptions(38,2) = ".c_pj2"
laOptions(38,3) = 2
laOptions(39,1) = "*extension: vc2=" && ext Text file to VCX
laOptions(39,2) = ".c_vc2"
laOptions(39,3) = 2
laOptions(40,1) = "*extension: sc2=" && ext Text file to SCX
laOptions(40,2) = ".c_sc2"
laOptions(40,3) = 2
laOptions(41,1) = "*extension: fr2=" && ext Text file to FRX
laOptions(41,2) = ".c_fr2"
laOptions(41,3) = 2
laOptions(42,1) = "*extension: lb2=" && ext Text file to LBX
laOptions(42,2) = ".c_lb2"
laOptions(42,3) = 2
laOptions(43,1) = "*extension: mn2=" && ext Text file to MNX
laOptions(43,2) = ".c_mn2"
laOptions(43,3) = 2
laOptions(44,1) = "*extension: db2=" && ext Text file to DBF
laOptions(44,2) = ".c_db2"
laOptions(44,3) = 2
laOptions(45,1) = "*extension: dc2=" && ext Text file to DBC
laOptions(45,2) = ".c_dc2"
laOptions(45,3) = 2
laOptions(46,1) = "*extension: fk2=" && ext Text file to FKY
laOptions(46,2) = ".c_fk2"
laOptions(46,3) = 2
laOptions(47,1) = "*extension: me2=" && ext Text file to MEM
laOptions(47,2) = ".c_me2"
laOptions(47,3) = 2
laOptions(48,1) = "*BackgroundImage:" && ext Text file to MEM
laOptions(48,2) = ".c_BackgroundImage"
laOptions(48,3) = 6
For lnOption = 1 To m.lnOptions
lnLine = Ascan( m.laLines , m.laOptions( m.lnOption, 1 ), 1, -1, 1, 4)
If m.lnLine >0 Then
lcText = m.laLines( m.lnLine )
lcValue = Strextract( m.lcText , m.laOptions( m.lnOption, 1 ), '&'+'&' ,1 , 3)
Do Case
Case m.laOptions( m.lnOption, 3 ) = 0
lcReturn = Padr(' ' + Transform( Evaluate( m.laOptions( m.lnOption, 2 ) ) ), Len(m.lcValue) + 1 )
Case m.laOptions( m.lnOption, 3 ) = 1
lcReturn = Padr(' ' + Iif ( Evaluate( m.laOptions( m.lnOption, 2 )), '1', '0' ), Len(m.lcValue) + 1 )
Case m.laOptions( m.lnOption, 3 ) = 2
lcReturn = Padr(Evaluate( m.laOptions( m.lnOption, 2 )), Len(m.lcValue) + 1 )
Case m.laOptions( m.lnOption, 3 ) = 3
lcReturn = Padr(' ' + Iif ( Evaluate( m.laOptions( m.lnOption, 2 )), '0', '1' ), Len(m.lcValue) + 1 )
Case m.laOptions( m.lnOption, 3 ) = 4
lcReturn = ' ' + Transform( Evaluate( m.laOptions( m.lnOption, 2 ) ) )
lcReturn = Padr( m.lcReturn , Max( Len ( m.lcReturn )+1, Len( m.lcValue ) + 1 ) )
Case m.laOptions( m.lnOption, 3 ) = 5
If Empty( Evaluate( m.laOptions( m.lnOption, 2 ) ) )
lcReturn = ' *'
Else &&Empty( Evaluate( m.laOptions( m.lnOption, 2 ) ) )
lcReturn = ' ' + Transform( Evaluate( m.laOptions( m.lnOption, 2 ) ) )
Endif &&Empty( Evaluate( m.laOptions( m.lnOption, 2 ) ) )
lcReturn = Padr( m.lcReturn , Max( Len ( m.lcReturn )+1, Len( m.lcValue ) + 1 ) )
Case m.laOptions( m.lnOption, 3 ) = 6
If Lower( Justfname ( Evaluate( m.laOptions( m.lnOption, 2 ) ) ) ) == 'foxbin2prg.jpg' Then
lcReturn = ''
Else &&LOWER( JUSTFNAME ( Evaluate( m.laOptions( m.lnOption, 2 ) ) ) ) == 'foxbin2prg.jpg'
lcReturn = ' ' + Transform( Evaluate( m.laOptions( m.lnOption, 2 ) ) )
Endif &&LOWER( JUSTFNAME ( Evaluate( m.laOptions( m.lnOption, 2 ) ) ) ) == 'foxbin2prg.jpg'
lcReturn = Padr( m.lcReturn , Max( Len ( m.lcReturn )+1, Len( m.lcValue ) + 1 ) )
Otherwise
* not defined. loop
Loop
Endcase
laLines( m.lnLine ) = Substr(Strtran(m.laLines( m.lnLine ) , m.lcValue, m.lcReturn), 2 )
Endif &&lnLine >0
Endfor &&lnOption
lcText = ''
lnLines = m.lnLines+1
Dimension;
M.laLines( m.lnLines )
Ains(m.laLines,4)
laLines( 4 ) = Textmerge( m.loLang.C_FOXBIN2PRG_SYNTAX_INFO_EXAMPLE_LOC_Header4 )
For lnLine = 1 To m.lnLines
lcText = m.lcText+ m.laLines( m.lnLine )+0h0D0A
Endfor &&lnLine
Strtofile( m.lcText, m.tc_InputFile )
*!* /Changed by: Lutz Scheffler 07.3.2021
Case Empty(tc_InputFile)
*-- (Ejemplo de sintaxis y uso)
*MESSAGEBOX( loLang.C_FOXBIN2PRG_SYNTAX_INFO_EXAMPLE_LOC, 0+64+4096, 'FoxBin2Prg ' + THIS.c_FB2PRG_EXE_Version + ': ' + loLang.C_FOXBIN2PRG_SYNTAX_INFO_LOC + ' (' + .c_Language + ')', 60000 )
loFrm_Main = Createobject('frm_main', This)
loFrm_Main.Show()
Read Events
lnCodError = 0
Otherwise
*-- EJECUCIÓN NORMAL
If Atc('-INTERACTIVE', ('-' + tcType)) > 0 ;
AND Atc('-BIN2PRG', ('-' + tcType)) = 0 And Atc('-PRG2BIN', ('-' + tcType)) = 0 ;
AND lcInputFile_Type == C_FILETYPE_DIRECTORY Then
*-- Se seleccionó un directorio y se puede elegir: Bin2Txt, Txt2Bin y Nada
.writeLog( loLang.C_INTERACTIVE_DIRECTORY_SELECTION_LOC )
loFrm_Interactive = Createobject('frm_interactive', This)
loFrm_Interactive.Show()
Read Events
lnConversionOption = loFrm_Interactive.n_ConversionType
If loFrm_Interactive.l_FileTimeStampOptimization
If .n_OptimizeByFilestamp = 0 Then
.n_OptimizeByFilestamp = 2
Endif
Else
.n_OptimizeByFilestamp = 0
Endif
loFrm_Interactive.Release()
loFrm_Interactive = Null
Do Case
Case lnConversionOption = 1 && Bin2Txt
tcType = tcType + '-BIN2PRG'
Case lnConversionOption = 2 && Txt2Bin
tcType = tcType + '-PRG2BIN'
Otherwise && None
Error 1799 && Conversion Cancelled
Endcase
Endif
*-- Evaluación de FileSpec de entrada
Do Case
Case Atc('-BIN2PRG', ('-' + tcType)) = 0 And Atc('-PRG2BIN', ('-' + tcType)) = 0 ;
AND lcInputFile_Type == C_FILETYPE_FILE ;
AND ( '*' $ Justext( tc_InputFile ) Or '?' $ Justext( tc_InputFile ) )
If .l_ShowErrors
*MESSAGEBOX( 'No se admiten extensiones * o ? porque es peligroso (se pueden pisar binarios con archivo xx2 vacíos).', 0+48+4096, 'FOXBIN2PRG: ERROR!!', 60000 )
Messagebox( loLang.C_ASTERISK_EXT_NOT_ALLOWED_LOC, 0+48+4096, 'FoxBin2Prg ' + This.c_FB2PRG_EXE_Version + ': ' + loLang.C_FOXBIN2PRG_ERROR_CAPTION_LOC, 60000 )
Exit
Else
Error loLang.C_ASTERISK_EXT_NOT_ALLOWED_LOC
Endif
Case lcInputFile_Type == C_FILETYPE_FILE And ( '*' $ Juststem( tc_InputFile ) Or '?' $ Juststem( tc_InputFile ) )
*-- SE QUIEREN TODOS LOS ARCHIVOS DE UNA EXTENSIÓN
lcFileSpec = Fullpath( tc_InputFile )
.c_LogFile = Addbs( Justpath( lcFileSpec ) ) + Strtran( Justfname( lcFileSpec ), '*', '_ALL' ) + '.LOG'
If .n_Debug > 0 Then
Erase ( .c_LogFile )
Endif
If Evl(tcType,'0') <> '*' Then
If .n_ShowProgressbar <> 0 And .l_ProcessFiles Then
.loadProgressbarForm()
Endif
Do Case
Case .l_Recompile And Len(tcRecompile) > 3 And Directory(tcRecompile)
Cd (tcRecompile)
Case tcRecompile == '1'
Cd (Justpath(lcFileSpec))
Endcase
Endif
lnFileCount = Adir( laFiles, lcFileSpec, '', 1 )
For I = 1 To lnFileCount
toModulo = Null
lcFile = Forcepath( laFiles(m.I,1), Justpath( lcFileSpec ) )
Do Case
Case Upper( Justext( Evl(tc_InputFile,'') ) ) == 'PJX' And Left(Evl(tcType,'0'),1) == '*'
*-- SE QUIEREN CONVERTIR A TEXTO TODOS LOS ARCHIVOS DE UNO O MÁS PROYECTOS PJX
*-- Filespec: "*.PJX", "*"
.evaluate_Full_PJX(lcFile, tcRecompile, @toModulo, @toEx, tcOriginalFileName, .c_LogFile, tcType)
Case Upper( Justext( Evl(tc_InputFile,'') ) ) == .c_PJ2 And Left(Evl(tcType,'0'),1) == '*'
*-- SE QUIEREN CONVERTIR A BINARIO TODOS LOS ARCHIVOS DE UNO O MÁS PROYECTOS PJ2
*-- Filespec: "*.PJ2", "*"
.evaluate_Full_PJ2(lcFile, tcRecompile, @toModulo, @toEx, tcOriginalFileName, .c_LogFile, tcType)
Case Atc('-BIN2PRG', ('-' + tcType)) > 0
*-- SE QUIEREN CONVERTIR A TEXTO TODOS LOS ARCHIVOS DE UN DIRECTORIO
*-- Filespec: "*.*"
If .hasSupport_Bin2Prg(lcFile) Then
.updateProgressbar( loLang.C_PROCESSING_LOC + ' ' + lcFile + '...', m.I, lnFileCount, 0 )
lnCodError = .convert( lcFile, @toModulo, @toEx, .F., tcOriginalFileName )
.writeLog_Flush()
Do Case
Case lnCodError = 1799 && Conversion Cancelled
Error 1799
Case lnCodError > 0
.doWriteErrorLog( @toEx )
llError = .T.
.l_Error = .F.
Endcase
Endif
Case Atc('-PRG2BIN', ('-' + tcType)) > 0
*-- SE QUIEREN CONVERTIR A BINARIO TODOS LOS ARCHIVOS DE UN DIRECTORIO
*-- Filespec: "*.*"
If .hasSupport_Prg2Bin(lcFile) Then
.updateProgressbar( loLang.C_PROCESSING_LOC + ' ' + lcFile + '...', m.I, lnFileCount, 0 )
lnCodError = .convert( lcFile, @toModulo, @toEx, .F., tcOriginalFileName )
.writeLog_Flush()
Do Case
Case lnCodError = 1799 && Conversion Cancelled
Error 1799
Case lnCodError > 0
.doWriteErrorLog( @toEx )
llError = .T.
.l_Error = .F.
Endcase
Endif
Case Empty( Justext( Evl(tc_InputFile,'') ) )
*-- NO SE INDICÓ NINGUNA EXTENSIÓN
Error loLang.C_INVALID_PARAMETER_LOC + ': cInputFile = "' + tc_InputFile + '"'
Otherwise
*-- DEMÁS ARCHIVOS
*-- Filespec: "*.EXT"
.updateProgressbar( loLang.C_PROCESSING_LOC + ' ' + lcFile + '...', m.I, lnFileCount, 0 )
lnCodError = .convert( lcFile, @toModulo, @toEx, .T., tcOriginalFileName )
.writeLog_Flush()
Do Case
Case lnCodError = 1799 && Conversion Cancelled
Error 1799
Case lnCodError > 0
.doWriteErrorLog( @toEx )
Endcase
Endcase
Endfor && I = 1 TO lnFileCount
If llError
.l_Error = .T.
Endif
Exit
Case Atc('-BIN2PRG', ('-' + tcType)) > 0
.writeLog( '> ' + loLang.C_OPTION_LOC + ': BIN2PRG' )
If .n_ShowProgressbar <> 0 And .l_ProcessFiles Then
.loadProgressbarForm()
.o_Frm_Avance.Caption = Strtran( .o_Frm_Avance.Caption, '> -', '(Bin>Txt) -' )
Endif
Do Case
Case lcInputFile_Type == C_FILETYPE_DIRECTORY
*-- CONVERSION BIN2PRG DE UN DIRECTORIO Y SUBDIRECTORIOS
.writeLog( '> InputFile ' + loLang.C_IS_A_DIRECTORY_LOC )
.writeLog()
Do Case
Case .l_Recompile And Len(tcRecompile) > 3 And Directory(tcRecompile)
Cd (tcRecompile)
Case .l_Recompile
Cd (tc_InputFile)
Endcase
.c_LogFile = Addbs(tc_InputFile) + tcType + '.LOG'
If .n_Debug > 0 Then
Erase ( .c_LogFile )
Endif
.get_FilesFromDirectory( tc_InputFile, @laFiles, @lnFileCount )
For I = 1 To lnFileCount
toModulo = Null
lcFile = laFiles(m.I)
If Not .hasSupport_Bin2Prg( lcFile ) Or Not Adir(laDirInfo, lcFile) > 0 Then
Loop
Endif
.updateProgressbar( loLang.C_PROCESSING_LOC + ' ' + lcFile + '...', m.I, lnFileCount, 0 )
lnCodError = .convert( lcFile, @toModulo, @toEx, .F., tcOriginalFileName )
*!* Changed by: Lutz Scheffler 15.2.2021
*!* change date="{^2021-02-15,06:57:00}"
* flushing the log after each file let us only see last file
* why ever, it should be appended, but we simply move
* .writeLog_Flush() after ENDFOR
* .writeLog_Flush()
Do Case
Case lnCodError = 1799 && Conversion Cancelled
Error 1799
Case lnCodError > 0
.doWriteErrorLog( @toEx )
Endcase
Endfor && I = 1 TO lnFileCount
.writeLog_Flush()
*!* /Changed by: Lutz Scheffler 15.2.2021
.updateProgressbar( loLang.C_END_OF_PROCESS_LOC, lnFileCount, lnFileCount, 0 )
Exit
Case Not .hasSupport_Bin2Prg( tc_InputFile ) Or Not Adir(laDirInfo, tc_InputFile) > 0
.writeLog( '> InputFile ' + loLang.C_IS_UNSUPPORTED_LOC )
.writeLog()
Exit
Endcase
Case Atc('-PRG2BIN', ('-' + tcType)) > 0
.writeLog( '> ' + loLang.C_OPTION_LOC + ': PRG2BIN' )
If .n_ShowProgressbar <> 0 And .l_ProcessFiles Then
.loadProgressbarForm()
.o_Frm_Avance.Caption = Strtran( .o_Frm_Avance.Caption, '> -', '(Txt>Bin) -' )
Endif
Do Case
Case lcInputFile_Type == C_FILETYPE_DIRECTORY
*-- CONVERSION PRG2BIN DE UN DIRECTORIO Y SUBDIRECTORIOS
.writeLog( '> InputFile ' + loLang.C_IS_A_DIRECTORY_LOC )
.writeLog()
Do Case
Case .l_Recompile And Len(tcRecompile) > 3 And Directory(tcRecompile)
Cd (tcRecompile)
Case .l_Recompile
Cd (tc_InputFile)
Endcase
.c_LogFile = Addbs(tc_InputFile) + tcType + '.LOG'
If .n_Debug > 0 Then
Erase ( .c_LogFile )
Endif
.get_FilesFromDirectory( tc_InputFile, @laFiles, @lnFileCount )
For I = 1 To lnFileCount
toModulo = Null
lcFile = laFiles(m.I)
If Not .hasSupport_Prg2Bin( lcFile ) Or Not Adir(laDirInfo, lcFile) > 0 Then
Loop
Endif
.updateProgressbar( loLang.C_PROCESSING_LOC + ' ' + lcFile + '...', m.I, lnFileCount, 0 )
lnCodError = .convert( lcFile, @toModulo, @toEx, .F., tcOriginalFileName )
*!* Changed by: Lutz Scheffler 15.2.2021
*!* change date="{^2021-02-15,06:57:00}"
* flushing the log after each file let us only see last file
* why ever, it should be appended, but we simply move
* .writeLog_Flush() after ENDFOR
* .writeLog_Flush()
Do Case
Case lnCodError = 1799 && Conversion Cancelled
Error 1799
Case lnCodError > 0
.doWriteErrorLog( @toEx )
Endcase
Endfor && I = 1 TO lnFileCount
.writeLog_Flush()
*!* /Changed by: Lutz Scheffler 15.2.2021
.updateProgressbar( loLang.C_END_OF_PROCESS_LOC, lnFileCount, lnFileCount, 0 )
Exit
Case Not .hasSupport_Prg2Bin( tc_InputFile ) Or Not Adir(laDirInfo, tc_InputFile) > 0
.writeLog( '> InputFile ' + loLang.C_IS_UNSUPPORTED_LOC )
.writeLog()
Exit
Endcase
Endcase
*-- UN ARCHIVO INDIVIDUAL O CONSULTA DE SOPORTE DE ARCHIVO
If lcInputFile_Type = C_FILETYPE_QUERYSUPPORT
*-- Consulta de soporte de conversión (compatibilidad con SourceSafe)
*-- SourceSafe consulta el tipo de soporte de cada archivo antes del Checkin/Checkout
*-- para saber si se puede hacer Diff y Merge.
*-- Para los códigos de tipo de archivo ver ayuda de "Type Property"
Do Case
Case tc_InputFile $ FILETYPE_PROJECT && PJX (J no exite en FoxPro, es un valor inventado para evitar conflicto con los tipos existentes)
lnCodError = .n_PJX_Conversion_Support
Case tc_InputFile == FILETYPE_CLASSLIB
lnCodError = .n_X_Conversion_Support
Case tc_InputFile == FILETYPE_FORM
lnCodError = .n_SCX_Conversion_Support
Case tc_InputFile == FILETYPE_REPORT
lnCodError = .n_FRX_Conversion_Support
Case tc_InputFile == FILETYPE_LABEL
lnCodError = .n_LBX_Conversion_Support
Case tc_InputFile == FILETYPE_MENU
lnCodError = .n_MNX_Conversion_Support
Case tc_InputFile == FILETYPE_DATABASE
lnCodError = .n_DBC_Conversion_Support
Case tc_InputFile == FILETYPE_FREETABLE
lnCodError = .n_DBF_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(.n_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(.n_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(.n_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(.n_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(.n_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(.n_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(.n_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(.n_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(.n_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(.n_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(.n_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 .n_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 .n_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 .n_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 .n_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 .n_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(.n_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 .n_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 .n_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 .n_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 .n_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
*** DH 2021-03-04: handle cOutputFolder
loConversor.cOutputFolder = This.cOutputFolder
*-- 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, @tnFileCount )
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 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 = 800
KeyPreview = .T.
MaxButton = .T.
MinButton = .F.
MinHeight = 800
MinWidth = 1024
Name = "FRM_MAIN"
ShowWindow = 2
Width = 1024
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 = 744, ;
Left = 12, ;
Name = "edt_Help", ;
ReadOnly = .T., ;
ScrollBars = 2, ;
Top = 12, ;
Width = 996
Add Object 'cmd_Close' As CommandButton With ;
Anchor = 4+8, ;
Cancel = .T., ;
Caption = "Close", ;
Height = 27, ;
Left = 924, ;
Name = "cmd_Close", ;
Top = 764, ;
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+0h0D0A+;
STRTRAN(loLang.C_FOXBIN2PRG_SYNTAX_INFO_EXAMPLE_LOC_cfg,'&'+'&','')+0h0D0A+;
STRTRAN(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
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"
*** DH 2021-03-04: added cOutputFolder property
cOutputFolder = ''
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&#13;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 ), '&#13;', C_CR ), '&#10;', 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.
* 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 loadModule
*---------------------------------------------------------------------------------------------------
* PARÁMETROS: (v=Pasar por valor | @=Pasar por referencia) (!=Obligatorio | ?=Opcional) (IN/OUT)
* toModulo (!@ OUT) Objeto generado de clase correspondiente con la información leida del texto
* toEx (!@ OUT) Objeto con información del error
* toFoxBin2Prg (!@ IN ) Referencia al objeto principal
*---------------------------------------------------------------------------------------------------
Lparameters toModulo, toEx As Exception, toFoxBin2Prg
#If .F.
Local toFoxBin2Prg As c_foxbin2prg Of 'FOXBIN2PRG.PRG'
#Endif
*LOCAL loLang as CL_LANG OF 'FOXBIN2PRG.PRG'
*loLang = _SCREEN.o_FoxBin2Prg_Lang
*THIS.writeLog( C_TAB + loLang.C_CONVERTING_FILE_LOC + ' ' + THIS.c_OutputFile + '...' )
*RELEASE loLang
Return
Endproc
Procedure normalizeAssignment
Lparameters tcAsignacion, tcComentario
Local lcPropName, lcValor, lnCodError, lcExpNormalizada, lnPos
With This As c_conversor_base Of 'FOXBIN2PRG.PRG'
.get_SeparatedPropAndValue( @tcAsignacion, @lcPropName, @lcValor )
tcComentario = ''
.normalizePropertyValue( @lcPropName, @lcValor, @tcComentario )
tcAsignacion = lcPropName + ' = ' + lcValor
Endwith
Release tcComentario, lcPropName, lcValor, lnCodError, lcExpNormalizada, lnPos
Return tcAsignacion
Endproc
Procedure normalizePropertyValue
*-- Este método se ejecuta cuando se genera el tx2 desde el binario
Lparameters tcProp, tcValue, tcComentario
Local lcValue, I
tcComentario = ''
*-- Limpieza de caracteres sin uso
*IF INLIST(tcValue, '..\', '..\..\' ) THEN
* MESSAGEBOX( 'Encontrado valor "' + tcValue + '" en propiedad "' + tcProp, 4096, PROGRAM() )
* tcValue = ''
*ENDIF
*-- Ajustes de algunos casos especiales
Do Case
Case tcProp == '_memberdata'
lcValue = ''
For I = 1 To Occurs( '/>', tcValue )
*TEXT TO lcValue TEXTMERGE ADDITIVE NOSHOW FLAGS 1+2 PRETEXT 1+2
* <<>> <<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, '&#13+10;' ), C_CR, '&#13;' ), C_LF, '&#10;' ), '&#13+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 &amp; &&
tcValor = Strtran(tcValor, Chr(39), Chr(38) + 'apos;') && reemplaza ' por &apos; &&
tcValor = Strtran(tcValor, Chr(34), Chr(38) + 'quot;') && reemplaza " por &quot; &&
tcValor = Strtran(tcValor, '<', Chr(38) + 'lt;') && reemplaza < por &lt; &&
tcValor = Strtran(tcValor, '>', Chr(38) + 'gt;') && reemplaza > por &gt; &&
tcValor = Strtran(tcValor, Chr(13)+Chr(10), Chr(10)) && reeemplaza CR+LF por LF
tcValor = Chrtran(tcValor, Chr(13), Chr(10)) && reemplaza CR por LF
Return tcValor
Endproc
Function rowTimeStamp(ltDateTime)
* Generate a FoxPro 3.0-style row timestamp
*-- CONVIERTE UN DATO TIPO DATETIME EN TIMESTAMP NUMERICO USADO POR LOS ARCHIVOS SCX/VCX/etc.
Local lcTimeValue, tnTimeStamp
Try
If Empty(ltDateTime)
tnTimeStamp = 0
Exit
Endif
If Vartype(m.ltDateTime) <> 'T'
m.ltDateTime = Datetime()
Endif
tnTimeStamp = ( Year(m.ltDateTime) - 1980) * 2^25 ;
+ Month(m.ltDateTime) * 2^21 ;
+ Day(m.ltDateTime) * 2^16 ;
+ Hour(m.ltDateTime) * 2^11 ;
+ Minute(m.ltDateTime) * 2^5 ;
+ Sec(m.ltDateTime)
Endtry
Return Int(tnTimeStamp)
Endfunc
Procedure set_UserValue
Lparameters toEx As Exception
Endproc
Procedure sortPropsAndValues_SetAndGetSCXPropNames
*--------------------------------------------------------------------------------------------------------------
* PARÁMETROS: (v=Pasar por valor | @=Pasar por referencia) (!=Obligatorio | ?=Opcional) (IN/OUT)
* tcOperation (v! IN ) Operación a realizar ("SETNAME" o "GETNAME")
* tcPropName (v! IN ) Nombre de la propiedad
*--------------------------------------------------------------------------------------------------------------
Lparameters tcOperation, tcPropName
Try
Local lcPropName, lcClass, lnPos ;
, loEx As Exception ;
, loLang As CL_LANG Of 'FOXBIN2PRG.PRG'
loLang = _Screen.o_FoxBin2Prg_Lang
lcPropName = tcPropName
tcOperation = Upper(Evl(tcOperation,''))
Do Case
Case tcOperation == 'GETNAME'
lcPropName = Substr(tcPropName,5)
Case Not tcOperation == 'SETNAME'
Error loLang.C_ONLY_SETNAME_AND_GETNAME_RECOGNIZED_LOC
Case lcPropName == 'Name' && System "Name" property
lcPropName = 'A999' + lcPropName
Otherwise
*-- Soporte de evaluación de propiedades por clase evaluada
With This
#If .F. &&USED("foxbin2prg_keywords") THEN
lcClass = Icase( .c_ClaseActual == 'grid', 'all' ;
, .c_ClaseActual == 'form', 'all' ;
, .c_ClaseActual == 'pageframe', 'all' ;
, .c_ClaseActual == 'control', 'all' ;
, .c_ClaseActual == 'container', 'all' ;
, .c_ClaseActual == 'toolbar', 'all' ;
, .c_ClaseActual )
lnPos = Iif( Seek( Padr(lcClass,15) + Padr(lcPropName,30), 'foxbin2prg_keywords' ), foxbin2prg_keywords.i_order, 0 )
#Else
Do Case
Case .c_ClaseActual == 'checkbox'
lnPos = Ascan( .a_SpecialProps_Chk, lcPropName, 1, 0, 1, 1+2+4 )
Case .c_ClaseActual == 'collection'
lnPos = Ascan( .a_SpecialProps_Coll, lcPropName, 1, 0, 1, 1+2+4 )
Case .c_ClaseActual == 'combobox'
lnPos = Ascan( .a_SpecialProps_Cbo, lcPropName, 1, 0, 1, 1+2+4 )
Case .c_ClaseActual == 'commandgroup'
lnPos = Ascan( .a_SpecialProps_Cmg, lcPropName, 1, 0, 1, 1+2+4 )
Case .c_ClaseActual == 'commandbutton'
lnPos = Ascan( .a_SpecialProps_Cmd, lcPropName, 1, 0, 1, 1+2+4 )
Case .c_ClaseActual == 'cursor'
lnPos = Ascan( .a_SpecialProps_Cur, lcPropName, 1, 0, 1, 1+2+4 )
Case .c_ClaseActual == 'cursoradapter'
lnPos = Ascan( .a_SpecialProps_CA, lcPropName, 1, 0, 1, 1+2+4 )
Case .c_ClaseActual == 'dataenvironment'
lnPos = Ascan( .a_SpecialProps_DE, lcPropName, 1, 0, 1, 1+2+4 )
Case .c_ClaseActual == 'editbox'
lnPos = Ascan( .a_SpecialProps_Edt, lcPropName, 1, 0, 1, 1+2+4 )
Case .c_ClaseActual == 'formset'
lnPos = Ascan( .a_SpecialProps_Frs, lcPropName, 1, 0, 1, 1+2+4 )
*-- Comento la clase grid, porque puede contener a todos los controles, como un form
*CASE .c_ClaseActual == 'grid'
* lnPos = ASCAN( .a_SpecialProps_Grd, lcPropName, 1, 0, 1, 1+2+4 )
*-- Comento la clase form, porque puede contener a todos los controles, como un form
*CASE .c_ClaseActual == 'form'
* lnPos = ASCAN( .a_SpecialProps_Frm, lcPropName, 1, 0, 1, 1+2+4 )
*-- Comento la clase pageframe, porque puede contener a todos los controles, como un form
*CASE .c_ClaseActual == 'pageframe'
* lnPos = ASCAN( .a_SpecialProps_Pgf, lcPropName, 1, 0, 1, 1+2+4 )
*-- Comento la clase control, porque puede contener a todos los controles, como un form
*CASE .c_ClaseActual == 'control'
* lnPos = ASCAN( .a_SpecialProps_Ctl, lcPropName, 1, 0, 1, 1+2+4 )
*-- Comento la clase container, porque puede contener a todos los controles, como un form
*CASE .c_ClaseActual == 'container'
* lnPos = ASCAN( .a_SpecialProps_Cnt, lcPropName, 1, 0, 1, 1+2+4 )
Case .c_ClaseActual == 'column'
lnPos = Ascan( .a_SpecialProps_Grc, lcPropName, 1, 0, 1, 1+2+4 )
Case .c_ClaseActual == 'header'
lnPos = Ascan( .a_SpecialProps_Grh, lcPropName, 1, 0, 1, 1+2+4 )
Case .c_ClaseActual == 'hyperlink'
lnPos = Ascan( .a_SpecialProps_Hlk, lcPropName, 1, 0, 1, 1+2+4 )
Case .c_ClaseActual == 'image'
lnPos = Ascan( .a_SpecialProps_Img, lcPropName, 1, 0, 1, 1+2+4 )
Case .c_ClaseActual == 'label'
lnPos = Ascan( .a_SpecialProps_Lbl, lcPropName, 1, 0, 1, 1+2+4 )
Case .c_ClaseActual == 'line'
lnPos = Ascan( .a_SpecialProps_Lin, lcPropName, 1, 0, 1, 1+2+4 )
Case .c_ClaseActual == 'listbox'
lnPos = Ascan( .a_SpecialProps_Lst, lcPropName, 1, 0, 1, 1+2+4 )
Case .c_ClaseActual == 'olebound'
lnPos = Ascan( .a_SpecialProps_Ole, lcPropName, 1, 0, 1, 1+2+4 )
Case .c_ClaseActual == 'optiongroup'
lnPos = Ascan( .a_SpecialProps_Opg, lcPropName, 1, 0, 1, 1+2+4 )
Case .c_ClaseActual == 'optionbutton'
lnPos = Ascan( .a_SpecialProps_Opb, lcPropName, 1, 0, 1, 1+2+4 )
Case .c_ClaseActual == 'projecthook'
lnPos = Ascan( .a_SpecialProps_Phk, lcPropName, 1, 0, 1, 1+2+4 )
Case .c_ClaseActual == 'relation'
lnPos = Ascan( .a_SpecialProps_Rel, lcPropName, 1, 0, 1, 1+2+4 )
Case .c_ClaseActual == 'reportlistener'
lnPos = Ascan( .a_SpecialProps_Rls, lcPropName, 1, 0, 1, 1+2+4 )
Case .c_ClaseActual == 'separator'
lnPos = Ascan( .a_SpecialProps_Sep, lcPropName, 1, 0, 1, 1+2+4 )
Case .c_ClaseActual == 'shape'
lnPos = Ascan( .a_SpecialProps_Shp, lcPropName, 1, 0, 1, 1+2+4 )
Case .c_ClaseActual == 'spinner'
lnPos = Ascan( .a_SpecialProps_Spn, lcPropName, 1, 0, 1, 1+2+4 )
Case .c_ClaseActual == 'textbox'
lnPos = Ascan( .a_SpecialProps_Txt, lcPropName, 1, 0, 1, 1+2+4 )
Case .c_ClaseActual == 'timer'
lnPos = Ascan( .a_SpecialProps_Tmr, lcPropName, 1, 0, 1, 1+2+4 )
*-- Comento la clase toolbar, porque puede contener a todos los controles, como un form
*CASE .c_ClaseActual == 'toolbar'
* lnPos = ASCAN( .a_SpecialProps_Tbr, lcPropName, 1, 0, 1, 1+2+4 )
Case .c_ClaseActual == 'xmladapter'
lnPos = Ascan( .a_SpecialProps_XMLAda, lcPropName, 1, 0, 1, 1+2+4 )
Case .c_ClaseActual == 'xmlfield'
lnPos = Ascan( .a_SpecialProps_XMLFld, lcPropName, 1, 0, 1, 1+2+4 )
Case .c_ClaseActual == 'xmltable'
lnPos = Ascan( .a_SpecialProps_XMLTbl, lcPropName, 1, 0, 1, 1+2+4 )
Otherwise
lnPos = Ascan( .a_SpecialProps, lcPropName, 1, 0, 1, 1+2+4 )
Endcase
#Endif
*IF lnPos2 <> lnPos
* ERROR 'lnPos y lnPos2 no coinciden para "' + .c_ClaseActual + '.' + lcPropName + '"! lnPos=' + TRANSFORM(lnPos) + ', lnPos2=' + TRANSFORM(lnPos2)
*ENDIF
*-- Genera una propiedad con el formato "A nnn Propiedad", donde los valores más altos quedan al final,
*-- de modo que primero van las props nativas, luego las del usuario y al final "name", que es especial.
*-- Ej: "A004ScaleMode", ..., "A998UserProp", "A999Name"
lcPropName = 'A' + Padl( Evl(lnPos,998), 3, '0' ) + lcPropName
Endwith && THIS
Endcase
Catch To loEx
If This.n_Debug > 0 And _vfp.StartMode = 0
Set Step On
Endif
Throw
Finally
Release tcOperation, tcPropName, lnPos, loEx
Endtry
Return lcPropName
Endproc
Procedure sortPropsAndValues
* KNOWLEDGE BASE:
* 02/12/2013 FDBOZZO Fidel Charny me pasó un ejemplo donde se pierden propiedades físicamente
* si se ordenan alfabéticamente en un ADD OBJECT. Pierde "picture" y otras más.
* Pareciera que la última debe ser "Name".
*--------------------------------------------------------------------------------------------------------------
* PARÁMETROS: (v=Pasar por valor | @=Pasar por referencia) (!=Obligatorio | ?=Opcional) (IN/OUT)
* taPropsAndValues (!@ IN ) El array con las propiedades y valores del objeto o clase
* tnPropsAndValues_Count (v! IN ) Cantidad de propiedades
* tnSortType (v! IN ) Tipo de sort:
* 0=Solo separar propiedades de clase y de objetos (.)
* 1=Sort completo de propiedades (para la versión TEXTO)
* 2=Sort completo de propiedades con "Name" al final (para la versión BIN)
*--------------------------------------------------------------------------------------------------------------
Lparameters taPropsAndValues, tnPropsAndValues_Count, tnSortType
External Array taPropsAndValues
Try
Local I, X, lnArrayCols, laPropsAndValues(1,2), lcPropName, lcSortedMemo, lcMethods ;
, 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&#10;Este el 2&#10;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
Enddefine
Define Class c_conversor_prg_a_vcx As c_conversor_prg_a_bin
#If .F.
Local This As c_conversor_prg_a_vcx Of 'FOXBIN2PRG.PRG'
#Endif
*_MEMBERDATA = [<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
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
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
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="analyzecodeblockC_CDX_I" 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.n_DBF_Conversion_Support > 0 And Not Inlist(loDBF_CFG.n_DBF_Conversion_Support, 2, 8)
With toFoxBin2Prg
Error (Textmerge(loLang.C_FILE_NAME_IS_NOT_SUPPORTED_LOC))
Endwith
Case lnFileCount = 1 And loDBF_CFG.n_DBF_Conversion_Support > 0 && Implica 2 u 8
llImportData = (loDBF_CFG.n_DBF_Conversion_Support = 8)
Case toFoxBin2Prg.n_DBF_Conversion_Support = 8 && TXT2BIN (DATA IMPORT)
llImportData = .T.
Case toFoxBin2Prg.n_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
* SF
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' ;
, loLang As CL_LANG Of 'FOXBIN2PRG.PRG' ;
, ldLastUpdate ;
, lcIndexFile
With This As c_conversor_prg_a_dbf Of 'FOXBIN2PRG.PRG'
Store Null To loIndex
Store 0 To lnCodError
Store '' To lcIndex
Store .Null. To lcIndexFile
loDBFUtils = Createobject('CL_DBF_UTILS')
If toTable._Indexes.Count # 0 Then
loLang = _Screen.o_FoxBin2Prg_Lang
toFoxBin2Prg.writeLog( Replicate('+', 100) )
toFoxBin2Prg.writeLog( loLang.C_INDEX2BIN_PROCESSING_LOC )
toFoxBin2Prg.writeLog( ' ' + Replicate('-', 98) )
*-- Regenero los índices
For Each loIndex In toTable._Indexes FoxObject
Do Case
Case Isnull ( m.lcIndexFile ) And Empty (m.loIndex._IndexFile)
toFoxBin2Prg.writeLog( loLang.C_INDEX2BIN_STRUCTURAL_LOC )
toFoxBin2Prg.writeLog( ' ' + Replicate('- ', 49) )
Case Isnull ( m.lcIndexFile ) And m.loIndex._StandAlone
toFoxBin2Prg.writeLog( loLang.C_INDEX2BIN_STANDALONE_LOC + m.loIndex._IndexFile )
Case Isnull ( m.lcIndexFile )
toFoxBin2Prg.writeLog( loLang.C_INDEX2BIN_COMPOUND_LOC + m.loIndex._IndexFile )
toFoxBin2Prg.writeLog( ' ' + Replicate('- ', 59) )
Case ! m.lcIndexFile == m.loIndex._IndexFile And m.loIndex._StandAlone
toFoxBin2Prg.writeLog( ' ' + Replicate('-', 98) )
toFoxBin2Prg.writeLog( loLang.C_INDEX2BIN_STANDALONE_LOC + m.loIndex._IndexFile )
Case ! m.lcIndexFile == m.loIndex._IndexFile
toFoxBin2Prg.writeLog( ' ' + Replicate('-', 98) )
toFoxBin2Prg.writeLog( loLang.C_INDEX2BIN_COMPOUND_LOC + m.loIndex._IndexFile )
toFoxBin2Prg.writeLog( ' ' + Replicate('- ', 59) )
Endcase
lcIndexFile = m.loIndex._IndexFile
lcIndex = 'INDEX ON ' + loIndex._Key
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
If m.loIndex._StandAlone Then
lcIndex = m.lcIndex + ' TO ' + m.lcIndexFile
Else &&m.loIndex._StandAlone
lcIndex = m.lcIndex + ' TAG ' + loIndex._TagName + Iif( Empty( m.lcIndexFile ), '', ' OF ' + m.lcIndexFile )
toFoxBin2Prg.writeLog( ' ' + m.loIndex._TagName )
Endif &&m.loIndex._StandAlone
&lcIndex.
Endfor
toFoxBin2Prg.writeLog( Replicate('+', 100) + 0h0D0A )
Endif &&toTable._Indexes.COUNT # 0
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()
toFoxBin2Prg.writeLog( Replicate('+', 100) )
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'
*** DH 2021-03-04: handle cOutputFolder
If Not Empty(This.cOutputFolder)
tcOutputFile = Forcepath(tcOutputFile, This.cOutputFolder)
Endif Not Empty(This.cOutputFolder)
*** DH 2021-03-04: end of new code
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()
*-- 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
*** DH 2021-03-04: only output HomeDir if we're supposed to
If toFoxBin2Prg.n_HomeDir = 1
TEXT TO C_FB2PRG_CODE ADDITIVE TEXTMERGE NOSHOW FLAGS 1+2 PRETEXT 1+2
<<C_BUILDPROJ_I>>
<<>>*<.HomeDir = <<loProject._HomeDir>> />
ENDTEXT
Else
TEXT TO C_FB2PRG_CODE ADDITIVE TEXTMERGE NOSHOW FLAGS 1+2 PRETEXT 1+2
<<C_BUILDPROJ_I>>
ENDTEXT
Endif toFoxBin2Prg.n_HomeDir = 1
*** DH 2021-03-04: end of updated code
TEXT TO C_FB2PRG_CODE ADDITIVE TEXTMERGE NOSHOW FLAGS 1+2 PRETEXT 1+2
<<>>
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
*** DH 2021-03-04: only output HomeDir if we're supposed to
If toFoxBin2Prg.n_HomeDir = 1
TEXT TO C_FB2PRG_CODE ADDITIVE TEXTMERGE NOSHOW FLAGS 1+2 PRETEXT 1+2
<<C_BUILDPROJ_I>>
<<>>*<.HomeDir = <<loProject._HomeDir>> />
ENDTEXT
Else
TEXT TO C_FB2PRG_CODE ADDITIVE TEXTMERGE NOSHOW FLAGS 1+2 PRETEXT 1+2
<<C_BUILDPROJ_I>>
ENDTEXT
Endif toFoxBin2Prg.n_HomeDir = 1
*** DH 2021-03-04: end of updated code
TEXT TO C_FB2PRG_CODE ADDITIVE TEXTMERGE NOSHOW FLAGS 1+2 PRETEXT 1+2
<<>>
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.c_DBF_Conversion_Included) And Not toFoxBin2Prg.c_DBF_Conversion_Included == '*' ;
AND Not toFoxBin2Prg.filenameFoundInFilter( Justfname(.c_InputFile), toFoxBin2Prg.c_DBF_Conversion_Included )
toFoxBin2Prg.writeLog(' ' + Justfname(.c_InputFile) + ' no está en el filtro DBF_Conversion_Included (' + toFoxBin2Prg.c_DBF_Conversion_Included + ')' )
Exit
Endif
*-- Exclude
If Not Empty(toFoxBin2Prg.c_DBF_Conversion_Excluded) ;
AND toFoxBin2Prg.filenameFoundInFilter( Justfname(.c_InputFile), toFoxBin2Prg.c_DBF_Conversion_Excluded )
toFoxBin2Prg.writeLog(' ' + Justfname(.c_InputFile) + ' está en el filtro DBF_Conversion_Excluded (' + toFoxBin2Prg.c_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
* SF
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)
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
* SF
SET STEP ON
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
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)
* SF tags
If .Count > 0 Then
TEXT TO lcText ADDITIVE TEXTMERGE NOSHOW FLAGS 1+2 PRETEXT 1+2
<<>> <<C_INDEXES_I>>
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
<<>> <<C_INDEXES_F>>
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)
* SF tags
TEXT TO lcText ADDITIVE TEXTMERGE NOSHOW FLAGS 1+2 PRETEXT 1+2
<<>> <<C_INDEX_I>>
<<>> <Name><<._Name>></Name>
<<>> <Comment><<._Comment>></Comment>
<<>> <IsUnique><<._IsUnique>></IsUnique>
<<>> <<C_INDEX_F>>
ENDTEXT
* /SF
._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
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 C_CDX_F $ tcLine && End of index file, temporary ignore
Loop
Case Not llFieldsEvaluated And C_FIELDS_I $ tcLine
loFields = ._Fields
loFields.analyzeCodeBlock( @tcLine, @taCodeLines, @m.I, tnCodeLines )
llFieldsEvaluated = .T.
* new style, multiple index files
Case Not llIndexesEvaluated And C_CDXIDX_I $ tcLine
loIndexes = ._Indexes
loIndexes.analyzeIndexFilesBlock( @tcLine, @taCodeLines, @m.I, tnCodeLines )
llIndexesEvaluated = .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, lc_DBF_IndexList, 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)
*-- 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.n_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.n_DBF_Conversion_Support > 0
*-- Si hay un archivo DBF.CFG, manda sobre la configuración general
* Asume llExportData=.F.
Case Inlist(toFoxBin2Prg.n_DBF_Conversion_Support, 4, 8) && BIN2TXT (DATA EXPORT FOR DIFF)
llExportData = .T.
Otherwise
* Asume llExportData=.F.
Endcase
* Lutz Scheffler 18.03.2021 added handling DBF_IndexList:
If lnFileCount = 1
lc_DBF_IndexList = loDBF_CFG.DBF_IndexList
If Not Empty(lc_DBF_IndexList)
toFoxBin2Prg.writeLog(' > Using non structural index files: ' + lc_DBF_IndexList)
Endif
Endif
* Lutz Scheffler 18.03.2021 moved index to get Settings per DBF
*-- Indexes
loIndexes = This._Indexes
lcText = lcText + loIndexes.toText( '', '', tc_InputFile, @toFoxBin2Prg, lc_DBF_IndexList)
* /Lutz Scheffler 18.03.2021
* setting temporary order
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
* Lutz Scheffler 18.03.2021 added handling DBF_Conversion_Condition:
lc_DBF_Conversion_Condition = loDBF_CFG.DBF_Conversion_Condition
If Not Empty(lc_DBF_Conversion_Condition)
toFoxBin2Prg.writeLog(' > Using Conversion Condition: ' + lc_DBF_Conversion_Condition)
Endif
* /Lutz Scheffler 18.03.2021
Endif
Endif
* /setting temporary order
*** 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
* remove temporary order
If Not Empty(lcIndexFile) And File(lcIndexFile)
Set Index To
Erase (lcIndexFile)
Endif
* /remove temporary order
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
* SF
Procedure analyzeIndexFilesBlock
*---------------------------------------------------------------------------------------------------
* 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, loEx As Exception
If Left(tcLine, Len(C_CDXIDX_I)) == C_CDXIDX_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_CDXIDX_F $ tcLine && Fin
Exit
Case C_CDX_I $ tcLine
.analyzeIndexFileBlock( @tcLine, @taCodeLines, @m.I, tnCodeLines )
Otherwise && Otro valor
*-- No hay otros valores
Endcase
Endfor
Endwith && THIS
Endif
Catch To loEx
If This.n_Debug > 0 And _vfp.StartMode = 0
Set Step On
Endif
Throw
Finally
Endtry
Return llBloqueEncontrado
Endproc &&analyzeIndexFilesBlock
Procedure analyzeIndexFileBlock
*---------------------------------------------------------------------------------------------------
* 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, loEx As Exception
Local lcFile As String, llStandAlone As Boolean
If Left(tcLine, Len(C_CDX_I)) == C_CDX_I
llBloqueEncontrado = .T.
lcFile = Strextract(m.tcLine,C_CDX_File_,'"',1)
llStandAlone = Strextract(m.tcLine,C_CDX_Type_,'"',1) == C_CDX_Type_IDX
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_CDX_F $ tcLine && Fin
Exit
Case C_INDEXES_I $ tcLine
.analyzeCodeBlock( @tcLine, @taCodeLines, @I, m.tnCodeLines, m.lcFile, m.llStandAlone )
Otherwise && Otro valor
*-- No hay otros valores
Endcase
Endfor
Endwith && THIS
Endif
Catch To loEx
If This.n_Debug > 0 And _vfp.StartMode = 0
Set Step On
Endif
Throw
Finally
Endtry
Return llBloqueEncontrado
Endproc &&analyzeIndexFileBlock
* /SF
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, tcIndexFile, tlStandAlone
Try
Local llBloqueEncontrado, loEx As Exception ;
, loIndex As CL_DBF_INDEX Of 'FOXBIN2PRG.PRG'
Store Null To loIndex
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, tcIndexFile, tlStandAlone )
.Add( loIndex, loIndex._TagName )
Otherwise && Otro valor
*-- No hay otros valores
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 loIndex
Release loIndex
Endtry
Return llBloqueEncontrado
Endproc
* sf proc wrapping index
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
* tc_DBF_IndexList (? IN ) comm a delimited list of non structuiral index files
*---------------------------------------------------------------------------------------------------
Lparameters taTagInfo, tnTagInfo_Count, tc_InputFile, toFoxBin2Prg, tc_DBF_IndexList
#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' ;
loLang As CL_LANG Of 'FOXBIN2PRG.PRG'
Store Null To loIndex
lcText = ''
Dimension taTagInfo(1,6)
* SF tags
Local;
lcText As String,;
loIndex As "CL_DBF_INDEX"
Local Array;
taTagInfo (1,6)
Local;
lcIndexFile As String,;
lcIndexType As String
loLang = _Screen.o_FoxBin2Prg_Lang
toFoxBin2Prg.writeLog( Replicate('+', 100) )
toFoxBin2Prg.writeLog( loLang.C_INDEX2TXT_PROCESSING_LOC )
*!* Changed by: SF 18.3.2021
*!* <pdm>
*!* <change date="{^2021-03-18,10:34:00}">Changed by: SF<br />
*!* Standalone index <em>tc_InputFile.IDX</em> will be included if <em>DBF_Conversion_Order</em> is activated
*!* use only tags of structural compound index file
*!* </change>
*!* </pdm>
lcIndexFile = Juststem( Dbf() ) + '.CDX'
* If Tagcount() > 0
If Tagcount( m.lcIndexFile ) > 0
lcIndexType = C_CDX_Type_Struct
toFoxBin2Prg.writeLog( ' ' + Replicate('-', 98) )
toFoxBin2Prg.writeLog( ' ' + m.lcIndexType )
TEXT To m.lcText Additive Textmerge Noshow Flags 1+2 Pretext 1+2
<<>>
<<>> <<C_CDX_I>> <<C_CDX_Type_>><<m.lcIndexType>>" >
<<>>
<<>> <<C_INDEXES_I>>
ENDTEXT
* tnTagInfo_Count = Ataginfo( taTagInfo )
tnTagInfo_Count = Ataginfo( taTagInfo, m.lcIndexFile )
*!* /Changed by: SF 18.3.2021
Asort( m.taTagInfo, 1, -1, 0, 1 )
loIndex = Createobject("CL_DBF_INDEX")
For I = 1 To m.tnTagInfo_Count
lcText = m.lcText + m.loIndex.toText( @taTagInfo, m.I )
Endfor
TEXT To m.lcText Additive Textmerge Noshow Flags 1+2 Pretext 1+2
<<>> <<C_INDEXES_F>>
<<>> <<C_CDX_F>>
<<>>
ENDTEXT
Endif
If ! Empty( m.tc_DBF_IndexList ) And Vartype( m.tc_DBF_IndexList ) = 'C' Then
Local Array;
laIndexFiles( 1 )
toFoxBin2Prg.writeLog( ' ' + Replicate('-', 98) )
toF1oxBin2Prg.writeLog( loLang.C_INDEX2TXT_EXTRAFILES_LOC )
toFoxBin2Prg.writeLog( ' ' + Replicate('- ', 49) )
*Additional index files
Alines( laIndexFiles, m.tc_DBF_IndexList ,5 , ',' )
For Each lcIndexFile In laIndexFiles
Try
lcIndexFile = Sys(2014, ''+m.lcIndexFile, Addbs(Justpath(tc_InputFile) ) )
lcIndexType = Substr(Filetostr(m.lcIndexFile),5,4)
lcIndexType = Iif( m.lcIndexType = 0hFFFFFFFF, C_CDX_Type_IDX, C_CDX_Type_Compound )
toFoxBin2Prg.writeLog( ' '+m.lcIndexType + ' ' + m.lcIndexFile )
Set Index To ( m.lcIndexFile )
If Tagcount( m.lcIndexFile ) > 0 Then
lnTagInfo_Count = Ataginfo( taTagInfo , m.lcIndexFile )
TEXT TO lcText ADDITIVE TEXTMERGE NOSHOW FLAGS 1+2 PRETEXT 1+2
<<>>
<<>> <<C_CDX_I>> <<C_CDX_Type_>><<m.lcIndexType+'"'>> <<C_CDX_File_>><<m.lcIndexFile+'"'>> >
<<>>
<<>> <<C_INDEXES_I>>
ENDTEXT
lnTagInfo_Count = Ataginfo( laTagInfo , m.lcIndexFile)
Asort( laTagInfo, 1, -1, 0, 1 )
loIndex = Createobject("CL_DBF_INDEX")
For I = 1 To lnTagInfo_Count
lcText = lcText + loIndex.toText( @laTagInfo, m.I )
Endfor
TEXT TO lcText ADDITIVE TEXTMERGE NOSHOW FLAGS 1+2 PRETEXT 1+2
<<>> <<C_INDEXES_F>>
<<>> <<C_CDX_F>>
<<>>
ENDTEXT
Endif &&TAGCOUNT( m.lcIndexFile ) > 0
Catch To m.loEx When m.loEx.ErrorNo = 1
*File Not found
toFoxBin2Prg.writeLog( loLang.C_INDEX2TXT_NOFILE_LOC + m.lcIndexFile)
Catch To m.loEx When m.loEx.ErrorNo=114
*INDEX does not match
toFoxBin2Prg.writeLog( loLang.C_INDEX2TXT_NOTTHISTABLE_LOC + m.lcIndexFile)
Catch To m.loEx
If This.n_Debug > 0 And _vfp.StartMode = 0
Set Step On
Endif
Throw
Finally
Store Null To m.loIndex
Release I, m.loIndex
Endtry
Endfor &&lcIndexFile
Endif &&! EMPTY(toFoxBin2Prg.a_InputFiles)
If !Empty(m.lcText) Then
TEXT TO lcText TEXTMERGE NOSHOW FLAGS 1+2 PRETEXT 1+2
<<>> <<C_CDXIDX_I>><<m.lcText>>
<<>> <<C_CDXIDX_F>>
ENDTEXT
Endif &&!EMPTY(m.lcText)
toFoxBin2Prg.writeLog( Replicate('+', 100)+0h0D0A )
* /SF
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="_indexfile" display="_IndexFile"/>] ;
+ [<memberdata name="_standalone" display="_StandAlone"/>] ;
+ [<memberdata name="_tagname" display="_TagName"/>] ;
+ [<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
_IndexFile = ''
_StandAlone = .F.
_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, tcIndexFile, tlStandAlone
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'
._IndexFile = Evl( m.tcIndexFile, '')
._StandAlone = m.tlStandAlone
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
* SF tags
TEXT TO lcText TEXTMERGE NOSHOW FLAGS 1+2 PRETEXT 1+2
<<>> <<C_INDEX_I>>
<<>> <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>
<<>> <<C_INDEX_F>>
ENDTEXT
* /SF
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[', '&lt;![CDATA['), ']]>', ']]&gt;') + ']]>'
Else
lcString = Strtran(tcString, '&', '&amp;')
lcString = Strtran(lcString, '>', '&gt;')
lcString = Strtran(lcString, '<', '&lt;')
lcString = Strtran(lcString, '"', '&quot;')
lcString = Strtran(lcString, "'", '&#39;')
lcString = Strtran(lcString, '/', '&#47;')
lcString = Strtran(lcString, Chr(13), '&#13;')
lcString = Strtran(lcString, Chr(10), '&#10;')
lcString = Strtran(lcString, Chr(9), '&#9;')
Endif
Return lcString
Endproc
Procedure Decode
Lparameters tcString, tl_isCDATA
Local lcString
If tl_isCDATA Then
lcString = Strtran( Strtran( Strextract( tcString, '<![CDATA[', ']]>'), '&lt;![CDATA[', '<![CDATA['), ']]&gt;', ']]>')
Else
lcString = Strtran(tcString, '&#9;', Chr(9))
lcString = Strtran(lcString, '&#10;', Chr(10))
lcString = Strtran(lcString, '&#13;', Chr(13))
lcString = Strtran(lcString, '&#47;', '/')
lcString = Strtran(lcString, '&#39;', "'")
lcString = Strtran(lcString, '&quot;', '"')
lcString = Strtran(lcString, '&lt;', '<')
lcString = Strtran(lcString, '&gt;', '>')
lcString = Strtran(lcString, '&amp;', '&')
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
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_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' ) )
*!* Changd By: SF 22.4.2021
*!* <pdm>
*!* <change date="{^2021-04-22,06:49:00}">Changd By: SF<br />
*!* Old style determeines generic name from set name by testing as digit. It could be only digit. :(
*!* New style wraps it in ", so anything in " is set name
*!* </change>
*!* </pdm>
Do Case
Case LEFT ( m.lcBarName, 1 ) = '"'
lcBarName = Substr( m.lcBarName, 2, Len( m.lcBarName ) - 2 )
loReg.Name = m.lcBarName
loReg.OBJCODE = C_OBJCODE_MENUOPTION_BARNUM
Case Isdigit( m.lcBarName )
*-- Bar#
loReg.OBJCODE = C_OBJCODE_MENUOPTION_BARNUM
Otherwise
*-- Es un BAR del sistema
loReg.Name = m.lcBarName
Endcase
*!* /Changd By: SF 22.4.2021
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 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 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' ;
, lcName , lcName2
Store Null To loBarPop
lcTab = Replicate(Chr(9),tnNivel)
lcText = ''
*!* Changed by SF 22.4.2021
*!* <pdm>
*!* <change date="{^2021-04-22,06:24:00}">Changed by SF<br />
*!* If the BAR real name starts (legaly) with a digit it could not be recreated
*!* added code to add additional information to recreate the name
*!* name will wrap into " , so we got DEFINE BAR "Number" OF
*!* also use variable on all places instead of EVL(..
*!* </change>
*!* </pdm>
If !Empty(toReg.Name) And ISDIGIT( toReg.Name ) Then
lcName = ALLTRIM( toReg.Name )
lcName2 = '"' + Alltrim(toReg.Name) + '"'
Else &&!Empty(toReg.Name) And ISDIGIT( toReg.Name )
lcName = ALLTRIM( Evl(toReg.Name, '_' + Transform( Int( Val( toReg.ItemNum ) ), '@L #########') ) )
lcName2 = m.lcName
Endif &&!Empty(toReg.Name) And ISDIGIT( toReg.Name )
* SF
* location of definition of MENU BAR Evl( toReg.Name, toReg.ItemNum )
* /SF
*-- DEFINE BAR
*lcText = lcTab + '*----------------------------------' + CR_LF
lcText = lcText + lcTab + 'DEFINE BAR ' + m.lcName2 + ' 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 ' + m.lcName + ' OF ' + Alltrim(toReg.LevelName) ;
+ ' ACTIVATE POPUP ' + Alltrim(loBarPop.Name)
Else
lcText = lcText + lcTab + 'ON SELECTION BAR ' + m.lcName + ' 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
*!* /Changed by SF 22.4.2021
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
*!* Changed by SF 21.4.2021
*!* <pdm>
*!* <change date="{^2021-04-21,22:33:00}">Changed by SF<br />
*!* If the PAD real name starts (leagly) with "_" it could not be recreated
*!* added code to add additional information to recreate the name
*!* name will simple wrapped into ", so we got DEFINE PAD "_Name" OF
*!* </change>
*!* </pdm>
Try
Local lcText, lcTab, lnContainer, lnObject, loEx As Exception ;
, loBarPop As CL_MENU_BARPOP Of 'FOXBIN2PRG.PRG' ;
, lcName2
Store Null To loBarPop
lcTab = Replicate(Chr(9),tnNivel)
If !Empty(toReg.Name) And toReg.Name = '_' Then
lcName2 = '"' + Alltrim(toReg.Name) + '"'
toReg.Name = toReg.Name
Else &&!EMPTY(toReg.Name) AND toReg.Name = '_'
toReg.Name = Evl(toReg.Name, '_' + Transform( Int( Val( toReg.ItemNum ) ), '@L #########') )
lcName2 = Alltrim(toReg.Name)
Endif &&!EMPTY(toReg.Name) AND toReg.Name = '_'
*!* /Changed by SF 21.4.2021
lcText = ''
*-- DEFINE PAD
*lcText = lcTab + '*----------------------------------' + CR_LF
lcText = lcText + lcTab + 'DEFINE PAD ' + m.lcName2 + ' 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="n_pjx_conversion_support" display="PJX_Conversion_Support"/>] ;
+ [<memberdata name="n_vcx_conversion_support" display="n_VCX_Conversion_Support"/>] ;
+ [<memberdata name="n_scx_conversion_support" display="n_SCX_Conversion_Support"/>] ;
+ [<memberdata name="n_frx_conversion_support" display="n_FRX_Conversion_Support"/>] ;
+ [<memberdata name="n_lbx_conversion_support" display="n_LBX_Conversion_Support"/>] ;
+ [<memberdata name="n_mnx_conversion_support" display="n_MNX_Conversion_Support"/>] ;
+ [<memberdata name="n_dbc_conversion_support" display="n_DBC_Conversion_Support"/>] ;
+ [<memberdata name="n_dbf_conversion_support" display="n_DBF_Conversion_Support"/>] ;
+ [<memberdata name="n_fky_conversion_support" display="n_FKY_Conversion_Support"/>] ;
+ [<memberdata name="n_mem_conversion_support" display="n_MEM_Conversion_Support"/>] ;
+ [<memberdata name="c_dbf_conversion_included" display="c_DBF_Conversion_Included"/>] ;
+ [<memberdata name="c_dbf_conversion_excluded" display="c_DBF_Conversion_Excluded"/>] ;
+ [<memberdata name="c_backgroundimage" display="c_BackgroundImage"/>] ;
+ [<memberdata name="n_prg_compat_level" display="n_PRG_Compat_Level"/>] ;
+ [<memberdata name="copyfrom" display="CopyFrom"/>] ;
+ [<memberdata name="c_language_in" display="c_Language_In"/>] ;
+ [</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 = ''
c_Language_In = Null
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
n_PJX_Conversion_Support = Null
n_VCX_Conversion_Support = Null
n_SCX_Conversion_Support = Null
n_FRX_Conversion_Support = Null
n_LBX_Conversion_Support = Null
n_MNX_Conversion_Support = Null
n_DBC_Conversion_Support = Null
n_DBF_Conversion_Support = Null
n_FKY_Conversion_Support = Null
n_MEM_Conversion_Support = Null
c_DBF_Conversion_Included = Null
c_DBF_Conversion_Excluded = Null
c_BackgroundImage = Null
n_PRG_Compat_Level = Null
*** DH 2021-03-04: added n_HomeDir property
n_HomeDir = 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
.c_Language_In = toParentCFG.c_Language_In
.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
.n_PJX_Conversion_Support = toParentCFG.n_PJX_Conversion_Support
.n_VCX_Conversion_Support = toParentCFG.n_VCX_Conversion_Support
.n_SCX_Conversion_Support = toParentCFG.n_SCX_Conversion_Support
.n_FRX_Conversion_Support = toParentCFG.n_FRX_Conversion_Support
.n_LBX_Conversion_Support = toParentCFG.n_LBX_Conversion_Support
.n_MNX_Conversion_Support = toParentCFG.n_MNX_Conversion_Support
.n_DBC_Conversion_Support = toParentCFG.n_DBC_Conversion_Support
.n_DBF_Conversion_Support = toParentCFG.n_DBF_Conversion_Support
.n_FKY_Conversion_Support = toParentCFG.n_FKY_Conversion_Support
.n_MEM_Conversion_Support = toParentCFG.n_MEM_Conversion_Support
.c_DBF_Conversion_Included = toParentCFG.c_DBF_Conversion_Included
.c_DBF_Conversion_Excluded = toParentCFG.c_DBF_Conversion_Excluded
.c_BackgroundImage = toParentCFG.c_BackgroundImage
.n_PRG_Compat_Level = toParentCFG.n_PRG_Compat_Level
*** DH 2021-03-04: handle n_HomeDir
.n_HomeDir = toParentCFG.n_HomeDir
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_Header4 = ""
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 = ""
C_INDEX2TXT_PROCESSING_LOC = ""
C_INDEX2TXT_EXTRAFILES_LOC = ""
C_INDEX2TXT_NOFILE_LOC = ""
C_INDEX2TXT_NOTTHISTABLE_LOC = ""
C_INDEX2BIN_PROCESSING_LOC = ""
C_INDEX2BIN_STRUCTURAL_LOC = ""
C_INDEX2BIN_STANDALONE_LOC = ""
C_INDEX2BIN_COMPOUND_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 <cFileSpec.Ext> [cType [cTextName [cGenText [cDontShowErrors [cDebug [cDontShowProgress [cOriginalFileName [cRecompile [cNoTimestamps [cCFG_File [cOutputFolder] ] ] ] ] ] ] ] ] ] ]
<<>>
<<>>-- 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 of several file types must be cleared ('1' or empty) or not ('0')
<<>>cCFG_File: Indicates a CFG filename for not using the default on foxbin2prg directory
<<>>cOutputFolder: The output folder to write to. If it isn't specified, the same folder as the source is used.
<<>>
<<>>- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
<<>>
<<>>FOXBIN2PRG.EXE [-c|-C|-t [OutFileName]]
<<>>
<<>>-- Parameter details:
<<>>No parameter: Calls this info screen
<<>>-c creates a template config-file <OutFileName> (like FOXBIN2PRG.CFG)
<<>>-C creates a config-file <OutFileName> (like FOXBIN2PRG.CFG) with current options of folder of <OutFileName>
<<>> If OutFileName is not given a FoxBin2Prg._cfg config file will be created at default folder
<<>>-t creates a template table-config-file <OutFileName> (like <Tablename>.dbf.cfg)
<<>> If OutFileName is not given, and a table is open a <Tablename>.dbf._cfg config file will be created at table folder.
<<>>
<<>>
ENDTEXT
*** DH 2021-03-04: added HomeDir to text
.C_FOXBIN2PRG_SYNTAX_INFO_EXAMPLE_LOC_Header4 = "*Options for folder <<.c_Recompile>>, read as of <<DATETIME()>>"
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>>
<<>>****************************************************************************************************************
<<>>
<<>>-- Settings for internal work, not processing
<<>>Language: (auto) && Language of shown messages and LOGs. EN=English, FR=French, ES=Español, DE=German, Not defined = AUTOMATIC [DEFAULT]
<<>>ShowProgressbar: 1 && 0=Don't show, 1=Allways show, 2= Show only for multi-file processing
<<>>DontShowErrors: 0 && Show message errors by default
<<>>ExtraBackupLevels: 1 && By default 1 BAK is created. With this you can make more .N.BAK, or none
<<>>Debug: 0 && Don't Activate individual <file>.Log by default
<<>>BackgroundImage: <cFile> && Backgroundimage for process form. Empty for empty Background. File not found uses default.
<<>>HomeDir: 1 && 0 = don't save HomeDir in PJ2, [1 = save HomeDir in PJ2]
<<>>----------------------------------------------------------------------------------------------------------------
<<>>
<<>>-- Conversion operation by type
<<>>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)
<<>>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)
<<>>FKY_Conversion_Support: 1 && 0=No support, 1=Generate TXT only (Diff)
<<>>MEM_Conversion_Support: 1 && 0=No support, 1=Generate TXT only (Diff)
<<>>----------------------------------------------------------------------------------------------------------------
<<>>
<<>>Setting for container files (not pjx)
<<>>-- 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: 1 precedes
<<>>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
<<>> && Only used if import file is in file[.baseclass].class.tx2 syntax
<<>> && Ignored for RedirectClassType: 2
<<>>- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
<<>>
<<>>-- 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
<<>>----------------------------------------------------------------------------------------------------------------
<<>>
<<>>-- General files
<<>>NoTimestamps: 1 && Clear timestamps of several file types by default for minimize text-file differences
<<>>ClearUniqueID: 1 && 0=Keep UniqueID in text files, 1=Clear Unique ID. Useful for Diff and Merge
<<>>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
<<>>PRG_Compat_Level: 0 && [0=Legacy], 1=Use HELPSTRING as Class Procedure comment
<<>>----------------------------------------------------------------------------------------------------------------
<<>>
<<>>-- PJX special
<<>>BodyDevInfo: 0 && [0=Don't keep DevInfo for body pjx records], 1=Keep DevInfo
<<>>----------------------------------------------------------------------------------------------------------------
<<>>
<<>>-- DBF special
<<>>ClearDBFLastUpdate: 1 && 0=Keep DBF LastUpdate, 1=Clear DBF LastUpdate. Useful for Diff.
<<>>ExcludeDBFAutoincNextval: 0 && [0=Do not exclude this value from db2], 1=Exclude this value from db2
<<>>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
<<>>DBF_BinChar_Base64: 1 && 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
<<>>----------------------------------------------------------------------------------------------------------------
<<>>
<<>>-- Text file extensions
<<>>extension: tx2=newext && Specify extensions to use. Default FoxBin2Prg extensions ends in '2' (see at the bottom)
<<>>-- 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
<<>>Version: <<_Screen.c_FB2PRG_EXE_Version>>
<<>>****************************************************************************************************************
<<>>
<<>>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_IndexList: <cFile_List> && comma delimited list of additonal non structural index files, cdx or idx
<<>>DBF_BinChar_Base64: <0,1> && 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"
.C_INDEX2TXT_PROCESSING_LOC = " Processing index"
.C_INDEX2TXT_EXTRAFILES_LOC = " Additional index files"
.C_INDEX2TXT_NOFILE_LOC = " Not a File "
.C_INDEX2TXT_NOTTHISTABLE_LOC = " Index does not match table "
.C_INDEX2BIN_PROCESSING_LOC = " Creating index"
.C_INDEX2BIN_STRUCTURAL_LOC = " TAGs for structural index"
.C_INDEX2BIN_STANDALONE_LOC = " Standalone index "
.C_INDEX2BIN_COMPOUND_LOC = " TAGs for compound index "
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 <cFileSpec.Ext> [cType [cTextName [cGenText [cDontShowErrors [cDebug [cDontShowProgress [cOriginalFileName [cRecompile [cNoTimestamps [cCFG_File [cOutputFolder] ] ] ] ] ] ] ] ] ] ]
<<>>
<<>>-- 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
<<>>cOutputFolder: The output folder to write to. If it isn't specified, the same folder as the source is used.
<<>>
<<>>- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
<<>>
<<>>FOXBIN2PRG.EXE [-c|-C|-t [OutFileName]]
<<>>
<<>>-- Parameter details:
<<>>No parameter: Calls this info screen
<<>>-c creates a template config-file <OutFileName> (like FOXBIN2PRG.CFG)
<<>>-C creates a config-file <OutFileName> (like FOXBIN2PRG.CFG) with current options of folder of <OutFileName>
<<>> If OutFileName is not given a FoxBin2Prg._cfg config file will be created at default folder
<<>>-t creates a template table-config-file <OutFileName> (like <Tablename>.dbf.cfg)
<<>> If OutFileName is not given, and a table is open a <Tablename>.dbf._cfg config file will be created at table folder.
<<>>
ENDTEXT
*** DH 2021-03-04: added HomeDir to text
.C_FOXBIN2PRG_SYNTAX_INFO_EXAMPLE_LOC_Header4 = "*Options for folder <<.c_Recompile>>, read as of <<DATETIME()>>"
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>>
<<>>****************************************************************************************************************
<<>>
<<>>-- Settings for internal work, not processing
<<>>Language: (auto) && Language of shown messages and LOGs. EN=English, FR=French, ES=Español, DE=German, Not defined = AUTOMATIC [DEFAULT]
<<>>ShowProgressbar: 1 && 0=Don't show, 1=Allways show, 2= Show only for multi-file processing
<<>>DontShowErrors: 0 && Show message errors by default
<<>>ExtraBackupLevels: 1 && By default 1 BAK is created. With this you can make more .N.BAK, or none
<<>>Debug: 0 && Don't Activate individual <file>.Log by default
<<>>BackgroundImage: <cFile> && Backgroundimage for process form. Empty for empty Background. File not found uses default.
<<>>HomeDir: 1 && 0 = don't save HomeDir in PJ2, [1 = save HomeDir in PJ2]
<<>>----------------------------------------------------------------------------------------------------------------
<<>>
<<>>-- Conversion operation by type
<<>>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)
<<>>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)
<<>>FKY_Conversion_Support: 1 && 0=No support, 1=Generate TXT only (Diff)
<<>>MEM_Conversion_Support: 1 && 0=No support, 1=Generate TXT only (Diff)
<<>>----------------------------------------------------------------------------------------------------------------
<<>>
<<>>Setting for container files (not pjx)
<<>>-- 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: 1 precedes
<<>>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
<<>> && Only used if import file is in file[.baseclass].class.tx2 syntax
<<>> && Ignored for RedirectClassType: 2
<<>>- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
<<>>
<<>>-- 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
<<>>----------------------------------------------------------------------------------------------------------------
<<>>
<<>>-- General files
<<>>NoTimestamps: 1 && Clear timestamps of several file types by default for minimize text-file differences
<<>>ClearUniqueID: 1 && 0=Keep UniqueID in text files, 1=Clear Unique ID. Useful for Diff and Merge
<<>>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
<<>>PRG_Compat_Level: 0 && [0=Legacy], 1=Use HELPSTRING as Class Procedure comment
<<>>----------------------------------------------------------------------------------------------------------------
<<>>
<<>>-- PJX special
<<>>BodyDevInfo: 0 && [0=Don't keep DevInfo for body pjx records], 1=Keep DevInfo
<<>>----------------------------------------------------------------------------------------------------------------
<<>>
<<>>-- DBF special
<<>>ClearDBFLastUpdate: 1 && 0=Keep DBF LastUpdate, 1=Clear DBF LastUpdate. Useful for Diff.
<<>>ExcludeDBFAutoincNextval: 0 && [0=Do not exclude this value from db2], 1=Exclude this value from db2
<<>>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
<<>>DBF_BinChar_Base64: 1 && 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
<<>>----------------------------------------------------------------------------------------------------------------
<<>>
<<>>-- Text file extensions
<<>>extension: tx2=newext && Specify extensions to use. Default FoxBin2Prg extensions ends in '2' (see at the bottom)
<<>>-- 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
<<>>Version: <<_Screen.c_FB2PRG_EXE_Version>>
<<>>****************************************************************************************************************
<<>>
<<>>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_IndexList: <cFile_List> && comma delimited list of additonal non structural index files, cdx or idx
<<>>DBF_BinChar_Base64: <0,1> && 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"
.C_INDEX2TXT_PROCESSING_LOC = " Processing index"
.C_INDEX2TXT_EXTRAFILES_LOC = " Additional index files"
.C_INDEX2TXT_NOFILE_LOC = " Not a File "
.C_INDEX2TXT_NOTTHISTABLE_LOC = " Index does not match table "
.C_INDEX2BIN_PROCESSING_LOC = " Creating index"
.C_INDEX2BIN_STRUCTURAL_LOC = " TAGs for structural index"
.C_INDEX2BIN_STANDALONE_LOC = " Standalone index "
.C_INDEX2BIN_COMPOUND_LOC = " TAGs for compound index "
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 <cFileSpec.Ext> [cType [cTextName [cGenText [cDontShowErrors [cDebug [cDontShowProgress [cOriginalFileName [cRecompile [cNoTimestamps [cCFG_File [cOutputFolder] ] ] ] ] ] ] ] ] ] ]
<<>>
<<>>-- 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 einiger Dateiarten gelöscht werden 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)
<<>>cOutputFolder: Der Ordner in die die Ausgabedatei geschrieben werden soll. Wenn nicht angegeben, das Verzeichnis der Quelle.
<<>>- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
<<>>
<<>>FOXBIN2PRG.EXE [-c|-C|-t [OutFileName]]
<<>>
<<>>-- Parameter:
<<>>Keine Parameter: Startet dieses Formular
<<>>-c Erzeugt eine Vorlage <OutFileName> für eine Config-Datei (wie FOXBIN2PRG.CFG)
<<>>-C Erzeugt eine Config-Datei <OutFileName> (wie FOXBIN2PRG.CFG) mit den aktuellen Optionen des Pfades von <OutFileName>
<<>> Wird OutFileName nicht angegeben, so wird eine Konfigurationsdatei FoxBin2Prg._cfg angelegt.
<<>>-t Erzeugt eine Vorlage <OutFileName> für eine Tabellen-Config-Datei (wie <Tabellenname>.dbf.cfg)
<<>> Wird OutFileName nicht angegeben und ist eine Tabelle offen,
<<>> so wird eine Konfigurationsdatei <Tabellenname>.dbf._cfg im Verzeichnis der Tabelle angelegt.
<<>>
ENDTEXT
*** DH 2021-03-04: added HomeDir to text
.C_FOXBIN2PRG_SYNTAX_INFO_EXAMPLE_LOC_Header4 = "*Optionen für Verzeichnis <<.c_Recompile>>, gelesen am <<DATETIME() gelesen.>>"
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 Konfigurationsdateien 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 übersteueren diese Vorgaben (bis auf die Defaults)
<<>>****************************************************************************************************************
<<>>
<<>>Interne Einstellungen
<<>>Language: (auto) && Sprache für Anzeigen und Logs. EN=English, FR=Français, ES=Español, DE=Deutsch, Nicht definiert = Automatisch [DEFAULT]
<<>>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
<<>>ExtraBackupLevels: 1 && Anzahl der Backup-Ebenen der Binärdateien 0=kein Backup, 1=<Datei>.BAK, n>1= n-Backup-Ebenen, <Datei>.n.BAK
<<>>Debug: 0 && 0=Individuelles Logging ist aus 1= Individuelles Log per Datei <Datei>.Log
<<>>BackgroundImage: <cFile> && Hintergrundbild für das Formular zur Fortschrittsanzeige.
<<>> && Leer erzeugt kein Hintergrundbild., Wird die Datei nicht gefunden, wird der Standardhintergrund verwendet.
<<>>HomeDir: 1 && 0 = Die Eigenschaft HomeDir wird nicht in die PJ2 gespeichert, [1 = Die Eigenschaft wird gespeichert]
<<>>
<<>>----------------------------------------------------------------------------------------------------------------
<<>>-- 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)
<<>>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)
<<>>FKY_Conversion_Support: 1 && 0=Aus, 1=Erzeuge nur Textdatei (Diff)
<<>>MEM_Conversion_Support: 1 && 0=Aus, 1=Erzeuge nur Textdatei (Diff)
<<>>----------------------------------------------------------------------------------------------------------------
<<>>
<<>> ------Einstellungen für Container-Dateien (not pjx)
<<>>-- 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: 1 hat Vorrang
<<>>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 Klassen 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
<<>> && Nur für die file[.baseclass].class.tx2 Syntax
<<>> && Wird für RedirectClassType: 2 ignoriert
<<>>- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
<<>>
<<>>-- 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 Dokumentation: 0=Keine Umlenkung, 1=Erzeuge <Datenbank>.dbc, wenn <Datenbank>.item.*.dc2 gewählt wurde
<<>> && Die Binä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.
<<>>----------------------------------------------------------------------------------------------------------------
<<>>
<<>>Allgemeine Dateien
<<>>NoTimestamps: 1 && 0=Zeitstempel einiger Dateiarten werden nicht gelöscht 1=Zeitstempel werden zum Minimieren der Text-Datei-Unterschiede gelöscht
<<>>ClearUniqueID: 1 && 0=Erhalte die Unique ID in den Text-Dateien, 1=Lösche Unique ID. 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
<<>>PRG_Compat_Level: 0 && [0=Legacy], 1=Nutze HELPSTRING als Class Procedure Kommentar
<<>>----------------------------------------------------------------------------------------------------------------
<<>>
<<>>-- speziell PJX
<<>>BodyDevInfo: 0 && 0=DevInfo im body-pjx-Datensatz wird nicht erhalten], 1=DevInfo wird erhalten
<<>>----------------------------------------------------------------------------------------------------------------
<<>>
<<>>-- speziell DBF
<<>>ClearDBFLastUpdate: 1 && 0=Erhalte DBF LastUpdate, 1=Lösche DBF LastUpdate. Nützlich für Diff und Merge
<<>>ExcludeDBFAutoincNextval: 0 && 0=Aus, 1=Entferne diesen Wert aus der Textdate der Datenbank (db2)
<<>>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
<<>>DBF_BinChar_Base64: 1 && Für Felder mit Zeichen 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.
<<>>----------------------------------------------------------------------------------------------------------------
<<>>
<<>>-- Text-Datei Endungen
<<>>extension: tx2=newext && Umdefinition der Dateiendung der Textdateien. Die vordefinierten Endungen enden mit '2' (Beispiel siehe Ende dieser Datei)
<<>>-- 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
<<>>Version: <<_Screen.c_FB2PRG_EXE_Version>>
<<>>****************************************************************************************************************
<<>>
<<>>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_IndexList: <cFile_List> && Kommagetrennte Liste von Dateien. Zusätzliche Index - Dateien. CDX oder IDX. Nicht der Strukturelle Index
<<>>DBF_BinChar_Base64: <0,1> && Für Felder mit Zeichen 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"
.C_INDEX2TXT_PROCESSING_LOC = " Ermittle Index"
.C_INDEX2TXT_EXTRAFILES_LOC = " Zusätzliche Index Dateien"
.C_INDEX2TXT_NOFILE_LOC = " Keine Datei "
.C_INDEX2TXT_NOTTHISTABLE_LOC = " Index passt nicht zur Tabelle "
.C_INDEX2BIN_PROCESSING_LOC = " Erstelle Index"
.C_INDEX2BIN_STRUCTURAL_LOC = " TAGs für den strukturellen Index"
.C_INDEX2BIN_STANDALONE_LOC = " Eigenständige Indexdatei: "
.C_INDEX2BIN_COMPOUND_LOC = " TAGs für verbundene Indexdatei: "
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 <cFileSpec.Ext> [cType [cTextName [cGenText [cDontShowErrors [cDebug [cDontShowProgress [cOriginalFileName [cRecompile [cNoTimestamps [cCFG_File [cOutputFolder] ] ] ] ] ] ] ] ] ] ]
<<>>
<<>>-- 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 of several file types must be cleared ('1' or empty) or not ('0')
<<>>cCFG_File: Indicates a CFG filename for not using the default on foxbin2prg directory
<<>>cOutputFolder: The output folder to write to. If it isn't specified, the same folder as the source is used.
<<>>
<<>>- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
<<>>
<<>>FOXBIN2PRG.EXE [-c|-C|-t [OutFileName]]
<<>>
<<>>-- Parameter details:
<<>>No parameter: Calls this info screen
<<>>-c creates a template config-file <OutFileName> (like FOXBIN2PRG.CFG)
<<>>-C creates a config-file <OutFileName> (like FOXBIN2PRG.CFG) with current options of folder of <OutFileName>
<<>> If OutFileName is not given a FoxBin2Prg._cfg config file will be created at default folder
<<>>-t creates a template table-config-file <OutFileName> (like <Tablename>.dbf.cfg)
<<>> If OutFileName is not given, and a table is open a <Tablename>.dbf._cfg config file will be created at table folder.
<<>>
<<>>
ENDTEXT
*** DH 2021-03-04: added HomeDir to text
.C_FOXBIN2PRG_SYNTAX_INFO_EXAMPLE_LOC_Header4 = "*Options for folder <<.c_Recompile>>, read as of <<DATETIME()>>"
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>>
<<>>****************************************************************************************************************
<<>>
<<>>-- Settings for internal work, not processing
<<>>Language: (auto) && Language of shown messages and LOGs. EN=English, FR=French, ES=Español, DE=German, Not defined = AUTOMATIC [DEFAULT]
<<>>ShowProgressbar: 1 && 0=Don't show, 1=Allways show, 2= Show only for multi-file processing
<<>>DontShowErrors: 0 && Show message errors by default
<<>>ExtraBackupLevels: 1 && By default 1 BAK is created. With this you can make more .N.BAK, or none
<<>>Debug: 0 && Don't Activate individual <file>.Log by default
<<>>BackgroundImage: <cFile> && Backgroundimage for process form. Empty for empty Background. File not found uses default.
<<>>HomeDir: 1 && 0 = don't save HomeDir in PJ2, [1 = save HomeDir in PJ2]
<<>>----------------------------------------------------------------------------------------------------------------
<<>>
<<>>-- Conversion operation by type
<<>>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)
<<>>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)
<<>>FKY_Conversion_Support: 1 && 0=No support, 1=Generate TXT only (Diff)
<<>>MEM_Conversion_Support: 1 && 0=No support, 1=Generate TXT only (Diff)
<<>>----------------------------------------------------------------------------------------------------------------
<<>>
<<>>Setting for container files (not pjx)
<<>>-- 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: 1 precedes
<<>>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
<<>> && Only used if import file is in file[.baseclass].class.tx2 syntax
<<>> && Ignored for RedirectClassType: 2
<<>>- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
<<>>
<<>>-- 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
<<>>----------------------------------------------------------------------------------------------------------------
<<>>
<<>>-- General files
<<>>NoTimestamps: 1 && Clear timestamps of several file types by default for minimize text-file differences
<<>>ClearUniqueID: 1 && 0=Keep UniqueID in text files, 1=Clear Unique ID. Useful for Diff and Merge
<<>>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
<<>>PRG_Compat_Level: 0 && [0=Legacy], 1=Use HELPSTRING as Class Procedure comment
<<>>----------------------------------------------------------------------------------------------------------------
<<>>
<<>>-- PJX special
<<>>BodyDevInfo: 0 && [0=Don't keep DevInfo for body pjx records], 1=Keep DevInfo
<<>>----------------------------------------------------------------------------------------------------------------
<<>>
<<>>-- DBF special
<<>>ClearDBFLastUpdate: 1 && 0=Keep DBF LastUpdate, 1=Clear DBF LastUpdate. Useful for Diff.
<<>>ExcludeDBFAutoincNextval: 0 && [0=Do not exclude this value from db2], 1=Exclude this value from db2
<<>>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
<<>>DBF_BinChar_Base64: 1 && 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
<<>>----------------------------------------------------------------------------------------------------------------
<<>>
<<>>-- Text file extensions
<<>>extension: tx2=newext && Specify extensions to use. Default FoxBin2Prg extensions ends in '2' (see at the bottom)
<<>>-- 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
<<>>Version: <<_Screen.c_FB2PRG_EXE_Version>>
<<>>****************************************************************************************************************
<<>>
<<>>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_IndexList: <cFile_List> && comma delimited list of additonal non structural index files, cdx or idx
<<>>DBF_BinChar_Base64: <0,1> && 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"
.C_INDEX2TXT_PROCESSING_LOC = " Processing index"
.C_INDEX2TXT_EXTRAFILES_LOC = " Additional index files"
.C_INDEX2TXT_NOFILE_LOC = " Not a File "
.C_INDEX2TXT_NOTTHISTABLE_LOC = " Index does not match table "
.C_INDEX2BIN_PROCESSING_LOC = " Creating index"
.C_INDEX2BIN_STRUCTURAL_LOC = " TAGs for structural index"
.C_INDEX2BIN_STANDALONE_LOC = " Standalone index "
.C_INDEX2BIN_COMPOUND_LOC = " TAGs for compound index "
.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_support" display="DBF_Conversion_Support"/>] ;
+ [<memberdata name="dbf_conversion_order" display="DBF_Conversion_Order"/>] ;
+ [<memberdata name="dbf_conversion_condition" display="DBF_Conversion_Condition"/>] ;
+ [<memberdata name="dbf_indexlist" display="DBF_IndexList"/>] ;
+ [<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_Support = Null
DBF_Conversion_Order = ''
DBF_Conversion_Condition = ''
DBF_IndexList = ''
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
Reference in New Issue View Git Blame Copy Permalink