27 de diciembre de 2001

Conversion de numeros a letras (pesetas y euros)

A lo peor un poco tarde ... pero aqui está ...

Es una modificación a la función enviada por Luis Maria Guayan, pero esta acepta Euros y Pesetas, distingue el genero (masculino o femenino) de la moneda y tiene alguna pequeña corrección.
**********************************************************************
*
* Funcion: Num2Let
*
* Convierte un numero a letras. Valido para Euros y Pesetas
*
* Sintaxis:
*
*        =Num2Let(tnNumero, tlEuro, tnDecimales)
*
* Parametros:
*
*        tnNumero = Número a convertir
*        tlEuro (si se devuelve en Euros .T. o Pesetas .F.)
*        tnDecimales (numero de decimales, por defecto 2)
*
* Ejemplos:
*
*       = Num2Let(125.21, .T.)
*       = Num2Let(63241, .F.)
*
* Retorno:
*
*        El numero en caracter
*
* Nota:
*
* Creación           : Luis Maria Guayan
* Ultima Modificacion: 27/12/2001 Juan Encinar, Oscar Fariña, Pablo Roca
**********************************************************************
FUNCTION Num2Let(tnNumero,tlEuro,tnDecimales)
  LOCAL lnEntero, lnFraccion,lcRet
  lcret = ''
  IF PCOUNT()<2
     tlEuro = .T.
  ENDIF
  IF tnNumero<0
     lcret = 'MENOS '
     tnNumero=ABS(tnNumero)
  ENDIF
  
  IF type("tnDecimales") = "L"
     tnDecimales = 2
  ENDIF
  
  lnEntero   = INT(tnNumero)
  lnFraccion = INT((tnNumero - lnEntero) * 10^tndecimales)
  
  lcret = lcret+N2L(lnEntero, .T., tlEuro) + IIF(MOD(lnEntero,1000000)=0 AND lnEntero > 0,' DE ','')+;
  IIF(tlEuro,IIF(lnEntero=1,'UN EURO','EUROS'),IIF(lnEntero=1,'UNA PESETA','PESETAS'))+;
  IIF(lnFraccion > 0,' CON '+ ;
  N2L(lnFraccion, .T., .T.) + IIF(lnFraccion=1,'UN CENTIMO','CENTIMOS'),'')
  RETURN lcret
ENDFUNC

*--------------------------------
* FUNCTION N2L(tnNro, tlBandera, tlMasculino)
*--------------------------------
* Convierte un número entero en letras
* Usada por Let2Num (deben estar ambas)
* USO: ? N2L(1032) -> "MIL TREINTA Y DOS"
* PARAMETROS: lnNro = Número a convertir
*           : tlBandera (solo para diferenciar cuando retorna "UNO" o "UN")
*           : tlMasculino (para diferenciar si la moneda es genero masculino .T. / femenino .F.)
* RETORNA: Caracter
* AUTOR: LMG
* modificada por Juan Encinar, Oscar Fariña, Pablo Roca 27/12/2001
*--------------------------------
FUNCTION N2L(tnNro, tlBandera, tlMasculino)
  LOCAL lnEntero, lcRetorno, lnTerna, lcMiles, ;
    lcCadena, lnUnidades, lnDecenas, lnCentenas,lcCadena2
    
  lcCadena2 = ''
  lnEntero  = INT(tnNro)
  lcRetorno = ''
  lnTerna = 1
  DO WHILE lnEntero > 0
    lcCadena = ''
    lnUnidades = MOD(lnEntero, 10)
    lnEntero   = INT(lnEntero / 10)
    lnDecenas  = MOD(lnEntero, 10)
    lnEntero   = INT(lnEntero / 10)
    lnCentenas = MOD(lnEntero, 10)
    lnEntero   = INT(lnEntero / 10)

    *--- Analizo la terna
    DO CASE
      CASE lnTerna = 1
        lcMiles = ''
      CASE lnTerna = 2 AND (lnUnidades+lnDecenas+lnCentenas # 0)
        lcMiles = 'MIL '
      CASE lnTerna = 3 
        lcMiles = IIF(lnUnidades = 1 AND lnDecenas = 0 AND ;
          lnCentenas = 0, 'UN MILLON ', 'MILLONES ')
      CASE lnTerna = 4 AND (lnUnidades+lnDecenas+lnCentenas # 0)
        lcMiles = 'MIL '
      CASE lnTerna = 5 AND (lnUnidades+lnDecenas+lnCentenas # 0)
        lcMiles = IIF(lnUnidades = 1 AND lnDecenas = 0 AND ;
          lnCentenas = 0, 'BILLON ', 'BILLONES ')
      CASE lnTerna > 5
        lcRetorno = ' ERROR: NUMERO DEMASIADO GRANDE '
        EXIT
    ENDCASE

    *--- Analizo las unidades
    DO CASE
      CASE lnUnidades = 1
      IF !(allt(str(tnNro)) $ "100,1000,1000000,1000000000")
         IF tlMasculino
            lcCadena = IIF(lnTerna = 1 AND NOT tlBandera, 'UNO ', IIF(lnCentenas#0 or lnDecenas#0,'UN ',' '))
         ELSE
            if lnterna = 1
               lcCadena = 'UNA '
            else
               lcCadena = IIF(lnCentenas#0 or lnDecenas#0,'UN'+IIF(lnTerna < 3,'A ',' '),'')
            endif
            
         ENDIF
      ENDIF
      
      CASE lnUnidades = 2
        lcCadena = 'DOS '
      CASE lnUnidades = 3
        lcCadena = 'TRES '
      CASE lnUnidades = 4
        lcCadena = 'CUATRO '
      CASE lnUnidades = 5
        lcCadena = 'CINCO '
      CASE lnUnidades = 6
        lcCadena = 'SEIS '
      CASE lnUnidades = 7
        lcCadena = 'SIETE '
      CASE lnUnidades = 8
        lcCadena = 'OCHO '
      CASE lnUnidades = 9
        lcCadena = 'NUEVE '
    ENDCASE

    *--- Analizo las decenas
    DO CASE
      CASE lnDecenas = 1
        DO CASE
          CASE lnUnidades = 0
            lcCadena = 'DIEZ '
          CASE lnUnidades = 1
            lcCadena = 'ONCE '
          CASE lnUnidades = 2
            lcCadena = 'DOCE '
          CASE lnUnidades = 3
            lcCadena = 'TRECE '
          CASE lnUnidades = 4
            lcCadena = 'CATORCE '
          CASE lnUnidades = 5
            lcCadena = 'QUINCE '
          OTHER
            lcCadena = 'DIECI' + lcCadena
        ENDCASE
      CASE lnDecenas = 2
        lcCadena = IIF(lnUnidades = 0, 'VEINTE ', 'VEINTI') + lcCadena
      CASE lnDecenas = 3
        lcCadena = 'TREINTA ' + IIF(lnUnidades = 0, '', 'Y ') + lcCadena
      CASE lnDecenas = 4
        lcCadena = 'CUARENTA ' + IIF(lnUnidades = 0, '', 'Y ') + lcCadena
      CASE lnDecenas = 5
        lcCadena = 'CINCUENTA ' + IIF(lnUnidades = 0, '', 'Y ') + lcCadena
      CASE lnDecenas = 6
        lcCadena = 'SESENTA ' + IIF(lnUnidades = 0, '', 'Y ') + lcCadena
      CASE lnDecenas = 7
        lcCadena = 'SETENTA ' + IIF(lnUnidades = 0, '', 'Y ') + lcCadena
      CASE lnDecenas = 8
        lcCadena = 'OCHENTA ' + IIF(lnUnidades = 0, '', 'Y ') + lcCadena
      CASE lnDecenas = 9
        lcCadena = 'NOVENTA ' + IIF(lnUnidades = 0, '', 'Y ') + lcCadena
    ENDCASE

    *--- Analizo las centenas
    
    lcCadena2 = ''
    DO CASE
      CASE lnCentenas = 1
        lcCadena2 = IIF(lnUnidades = 0 AND lnDecenas = 0, ;
          'CIEN ', 'CIENTO ') 
      CASE lnCentenas = 2
        lcCadena2 = 'DOSCIENTOS ' 
      CASE lnCentenas = 3
        lcCadena2 = 'TRESCIENTOS ' 
      CASE lnCentenas = 4
        lcCadena2 = 'CUATROCIENTOS ' 
      CASE lnCentenas = 5
        lcCadena2 = 'QUINIENTOS ' 
      CASE lnCentenas = 6
        lcCadena2 = 'SEISCIENTOS ' 
      CASE lnCentenas = 7
        lcCadena2 = 'SETECIENTOS ' 
      CASE lnCentenas = 8
        lcCadena2 = 'OCHOCIENTOS ' 
      CASE lnCentenas = 9
        lcCadena2 = 'NOVECIENTOS ' 
    ENDCASE
   IF lnTerna < 3 
      lcCadena2 = IIF(tlMasculino,lcCadena2,STRTRAN(lcCadena2,'TOS','TAS'))
   ENDIF
   lcCadena  = lcCadena2+lcCadena

    *--- Armo el retorno terna a terna
    lcRetorno = lcCadena+lcMiles+lcRetorno
    lnTerna = lnTerna + 1
  ENDDO
  IF lnTerna = 1
    lcRetorno = 'CERO '
  ENDIF
  RETURN lcRetorno
ENDFUNC

*--------------------------------
Pablo Roca

20 de diciembre de 2001

Creando un programa Instalador de una aplicación de Visual FoxPro usando InstallShield Express

Autor: Mike Stewart
Traducido por: Raul Licona


Sumario
InstallShield Express - Visual FoxPro Limited Edition provee una manera fácil e intuitiva para empaquetar y distribuir tus aplicaciones de Visual FoxPro. Usando la tecnología compresiva y flexible para instalaciones de InstallShield Express para Windows Installer, puedes crear un proyecto Instalador o paquete, incluyendo archivos específicos con sus propiedades, y entonces distribuir los archivos de la aplicación desde el Instalador.

Contenido
  • Introducción
  • Preparando tu aplicación para la distribución
  • Creando el programa Instalador usando InstallShield Express
  • Distribuyendo tu aplicación
  • Escenarios de distribución de Visual FoxPro
  • Información adicional
Introducción
InstallShield Express usa Microsoft Windows Installer, el cual hace posible a los usuarios el instalar y configurar sus productos y aplicaciones eficientemente. Windows Installer es parte de Windows 2000 y Windows Cero Administración que ofrecen para reducir todos los costos de desarrollo, uso y manejo de computadoras de escritorio.

Este documento no significa que sea un reemplazo de la documentación de InstallShield Express, la cual debes leer primero. Es meramente un suplemento para asistir a los desarrolladores de Visual FoxPro en el uso de InstallShield Express para empaquetar y distribuir las aplicaciones. Para más información de las opciones de InstallShield, observa la documentación de InstallShield Express.

Nota: Puedes usar cualquier programa de creación de Instaladores que use la tecnología Windows Installer para crear paquetes Instaladores .msi o .msm.

Hay varios elementos que debes considerar antes de preparar la distribución de tu aplicación. Debes identificar la estructura de tu aplicación, decidir como será enviada a los usuarios, y decidir cual será la mejor organización de tu programa Instalador. Cuando todos los elementos hayan sido identificados estarás listo para distribuir tus aplicaciones de Visual FoxPro.

Para distribuir las aplicaciones de Visual FoxPro 
  1. Genera un archivo de aplicación o ejecutable. Para más información sobre el tema de generar una aplicación, vea "Compilando una Aplicación" en la Ayuda en línea de Visual FoxPro.
  2. Crea un directorio de distribución que contenga todos los archivos que un usuario debe tener para correr la aplicación.
  3. Crea un paquete Instalador usando un programa que utilice Windows Installer, como puede ser InstallShield Express - Visual FoxPro Limited Edition.
  4. Empaca y distribuye tus discos de aplicación y cualquier documentación impresa. Dependiendo del programa de creación Instalador que uses, el programa debe crear el disco imagen por ti, o tal vez tener una copia de los archivos para realizar una instalación manualmente.
Para usar InstallShield Express - Visual FoxPro Limited Edition, debes instalar los componentes desde la página de Instalación de Visual FoxPro 7.0 (VFPStart) localizada en el directorio raíz del CD de Visual FoxPro 7.0. Para información adicional sobre InstallShield Express observa la documentación en línea de InstallShield Express.

Preparando tu aplicación para la distribución
Antes de que puedas distribuir tus aplicaciones, debes generar un archivo de aplicación con una extensión .app, un archivo ejecutable con extensión .exe, o un componente COM con extensión .dll.
Previo a la generación de tu aplicación, asegúrate que tu proyecto incluya los archivos necesarios para tu aplicación, tanto como los archivos de recursos, como archivos de gráficas y plantillas. Para más información sobre los tipos de archivos que puedes incluir en tu aplicación, observa "Incluyendo Recursos en la Aplicación" en la Ayuda en línea de Visual FoxPro.

El ambiente de desarrollo de Visual FoxPro contiene muchas características y archivos que han sido licenciados solo para tu uso. Si tu aplicación contiene cualquiera de estas características o archivos, debes de eliminarlas de tu aplicación antes de la creación de tu programa Instalador. Para una lista de archivos redistribuible, observa Redist.txt, localizado en tu directorio de Visual FoxPro y en "Removiendo Características y Archivos Restringidos de Visual FoxPro" en la Ayuda en línea de Visual FoxPro.

Cuando escoja el tipo de construcción que quiere crear, considere el tamaño final del archivo de aplicación y cuales usuarios tienen instalado Visual FoxPro en sus computadoras.
  • Archivo de aplicación (.app) Este archivo requiere que el usuario tenga una copia instalada de Visual FoxPro. Un archivo .app comúnmente es más pequeño que un archivo .exe.
  • Archivo ejecutable (.exe) Este archivo incluye el cargador de Visual FoxPro, así el usuario no requiere que tenga instalado Visual FoxPro.
  • Archivo servidor COM (.dll) Usado para crear un archivo que puede ser llamado por otras aplicaciones.
Nota Un servidor COM también puede tener la extensión .exe.

Algunos escenarios de distribución tal vez requieran fusionar módulos aparte de los archivos de tiempo de ejecución de Visual FoxPro. Para más información, observa "Escenarios de distribución de Visual FoxPro" mas adelante en este documento.

Asegurando un correcto comportamiento en tiempo de ejecución
Un archivo de aplicación ejecutable siempre comprueba la presencia de la librería de tiempo de ejecución de Visual FoxPro, vfp7r.dll. Para ejecutar un archivo de aplicación .exe usando la versión de desarrollo de Visual FoxPro, debes forzar la aplicación a usar el archivo en lugar del archivo VFP7.exe de Visual FoxPro. Para más información, observa "Asegurando un correcto comportamiento en tiempo de ejecución" en la Ayuda en línea de Visual FoxPro.

Creando el programa Instalador usando InstallShield Express
El primer paso en la creación de tu programa Instalador es la creación del proyecto Instalador. La Instalación creada con InstallShield Express está basada en un archivo de proyecto (.ism). Este archivo almacena toda la lógica e información necesaria para construir tu archivo Instalador (.msi) compatible con Windows Installer.

Para crear un proyecto Instalador
  1. Abre InstallShield Express.
  2. En el menú File haz clic en New. La caja de dialogo New Project aparecerá.
  3. Escribe o examina la ruta y nombre del archivo de tu nuevo proyecto en el campo Project Name and Location.
  4. Haz clic en OK.

Tamaño completo de una carpeta

Una comoda manera de saber el tamaño completo de una carpeta
LOCAL loFSO, loFolder
loFSO = CREATEOBJECT("Scripting.FileSystemObject")
loFolder = loFSO.GetFolder("c:Windows")
? loFolder.Size()

21 de noviembre de 2001

Capturar el último error con una API

Esta forma es muy sencilla y facil cuando nos complicamos al capturar el número de error provocado utilizando ONError de VFP.

*----- API
DECLARE INTEGER GetLastError IN kernel32
*------

? GetLastError() 

20 de noviembre de 2001

UPPER() y LOWER() mediante API

Aqui lo tienen una función de la API de Windows para UPPER() y LOWER()
DECLARE INTEGER CharLower IN user32 STRING @ lpsz 
DECLARE INTEGER CharUpper IN user32 STRING @ lpsz 
     
lcText = "Jack and Jill went up the hill" 

? CharLower (@lcText) 
? lcText 

? CharUpper (@lcText) 
? lcText 

Jimmy Pozo Jiménez

7 de noviembre de 2001

Acelerando los programas

Autor: Jim Booth
Traducido por: Pablo Roca

Cómo hacer tus programas rápidos, o cómo eliminar las partes lentas de las aplicaciones.

Todo el mundo quiere velocidad. Veloz es mejor, dicen. ¿Cómo puedes optimizar tu código? ¿Existe alguna metodología estructurada que nos permita obtener el mejor rendimiento en nuestras aplicaciones? Este mes examinaremos algunos principios que pueden ser "implementados" en el proceso de optimización del código. Este artículo no tratará sobre la tecnología Rushmore, Rushmore ha sido y será cubierta en otros artículos. En vez de eso nos centraremos en prácticas de programación y técnicas para obtener el mejor rendimiento de nuestras aplicaciones.

Datos

Algunos tipos de datos se manejan más rápidos que otros en Visual FoxPro. Esto tiene que ver con la manera en que los datos son almacenados en un fichero dbf contra la forma en que son almacenados en memoria. Por ejemplo, el tipo Entero es almacenado en el DBF tal y como se usa en memoria, sin embargo, el tipo Numérico se almacenada como una cadena de números y se utiliza en memoria como un número binario en coma flotante. El tipo Numérico debe ser convertido de acá para allá una y otra vez cuando lo usamos. Cuando sea posible, usaremos un Entero para los valores numéricos (o un Doble para los números en coma flotante).

Los tipos Fecha y DateTime ocupan la misma cantidad de espacio en un DBF. Sin embargo, las Fechas se almacenan en el formato estandar ANSI AAAAMMDD, mientras que los campos DateTime se almacenan como un número de 8 bytes. En memoria, ambos tipos utilizan el formato de número de 8 Bytes, pero los campos del tipo Fecha tienen que ser convertidos, y los del tipo DateTime no. Podemos utilizar el tipo DateTime para todos nuestros datos de Calendario y obtener lo mejor de VFP. Si sólo necesitamos la Fecha, dejaremos el tiempo en el valor por defecto 00:00:00.

¿Cuándo un número no es un número? Cuando nunca se utiliza en cálculos. Por ejemplo, números de teléfono, códigos postales, números de cliente, números de factura son ejemplos de números que no son números. ¿Cuándo fue la última vez que tuviste que calcular la media de los números de factura en una tabla? Almacenemos esos valores en campos de tipo carácter, y limitemos los caracteres a sólo números. Los datos alfanuméricos se manipulan más rápidos que los datos numéricos, utilicemos datos numéricos sólo cuando sea realmente un número (es el momento de utilizar Enteros o Dobles).

Los campos Memo te permiten almacenar datos de longitud variable, pero podemos abusar de ellos por desidia. No utilices campos Memo sólo porque no tienes ganas de calcular cual es la longitud máxima del dato. Haciendo esto codificaras un poco más rápido pero la aplicación se ralentizará considerablemente. Los campos Memo utilizan más tiempo en las búsquedas y en ser procesados. Utiliza campos Carácter siempre que sea posible.

Construcciones

Algunas construcciones de programación son más rápidas que otras. El bulcle FOR/ENDFOR es más rápido que su equivalente DO WHILE/ENDDO. SCAN/ENDSCAN es más rápido que el equivalente DO WHILE NOT EOF()/SKIP/ENDDO. Utiliza las contrucciones más rápidas para obtener un código más rápido, o como dijo una vez George Goley, "Make your code faster by taking the slow parts out" (Haz tu código más rápido eliminando las partes lentas).

Creación de Objetos

La creación de objetos consume tiempo. Ahí no hay nada que hacer. Entonces, ¿cómo optimizaremos la contrucción de objetos?

No crees un objeto hasta que lo necesites. Cuando utilices objetos de interfaz como Marcos de Página (PageFrames), no llenes las páginas (con los objetos de las mismas) hasta que el usuario entre por primera vez en ellas. Esto se llama "delayed instantiation" ("instanciación retrasada") y puede lograrse creando las páginas con todos sus componentes en el Diseñador de Formularios. Entonces, tomando cada página y salvando el conjunto de controles de cada página como una clase contenedor utilizando la opción Guardar como Clase... (Save As Class) del menú Archivo (File). Borra todos los controles de la página. Pon una etiqueta en la página con la Propiedad Visible puesta a .F., en el evento UIEnable coloca un código como este:

IF TYPE("THIS.Parent.Container1.Name") = "C" 
  RETURN
ENDIF
THIS.Parent.AddObject("Container1","YourSavedClass")
THIS.Parent.Refresh()
Con servidores de automatization utiliza la función GetObject() mejor que la función CreateObject. GetObject() encontrará cualquier instancia existente del ojeto mientras que CreateObject() siempre creará una nueva aunque el objeto ya exista. Si el objeto que buscas existe, puedes evitar la instanciación usando la función GetObject().

Refrescando Pantallas

Si quieres ver algo interesante, prueba a hacer un seguimiento del evento Refresh y ejecuta una de tus aplicaciones. Solo ejecútala un momento haciendo algunas cosas y entonces mira los eventos Refresh que se han "disparado". Te puedes llevar una sorpresa cuando veas cuantas veces se ha ejecutado el evento Refresh.

A menudo es más rápido llamar al Refresh de un control individual que llamar al Refresh del Formulario. Intenta limitar las llamadas a Refresh a aquellas que sean imprescindibles. Recuerda que llamando al Refresh del Formulario se llamarán los eventos Refresh de todos los controles en el mismo. Ocurre lo mismo cuando se "Refresca" (actualiza) una rejilla, una página en un Marco de Páginas y las demás clases contendor.

Expresiones de Nombre en lugar de Macros

Cuando sea posible, utiliza una "name expresion" (Expresión de Nombre) en lugar de una Macro. Las Macros se tienen que expandir e interpretar en tiempo de ejecución cada vez que se encuentran. Las Macros no sólo hacen tu código ilegible y la lógica obscura, sino que además tardan más tiempo en ejecutarse.

Por el otro lado, las Expresiones de Nombre se ejecutan mucho más rápido. Se pueden utilizar en cualquier lugar en el que VFP espere encontrar el nombre de algo. Nombres como nombres de tabla, nombres de fichero, nombres de campo, etc son los candidatos para las expresiones de nombre. Los dos siguientes ejemplos de código muestran la idea:

* Ejemplo 1 Macros
LOCAL lcNombredeCampo
USE AlgunaTablaRealmenteGrande
USE AlguanOtraTabla IN 0
SCAN
  lcNombredeCampo = "AlgunaTablaRealmenteGrande.SumadeAyer"
  SELECT AlgunaOtraTabla
  SCAN FOR AlgunaOtraTabla.ForeignKey = AlgunaTablaRealmenteGrande.PrimaryKey
    REPLACE &lcNombredeCampo WITH &lcNombredeCampo + AlgunaOtraTable.SumadeVentas
  ENDSCAN
ENDSCAN

* Ejemplo 2 Expresión de nombre
LOCAL lcNombredeCampo
USE AlgunaTablaRealmenteGrande
USE AlgunaOtraTabla IN 0
SCAN
  lcNombredeCampo = "AlguanTablaRealmenteGrande.SumadeAyer"
  SELECT AlgunaOtraTabla
  SCAN FOR AlgunaOtraTabla.ForeignKey = AlgunaTablaRealmenteGrande.PrimaryKey
    REPLACE (lcNombredeCampo) WITH EVALUATE(lcNombredeCampo) + AlgunaOtraTabla.SumadeVentas
  ENDSCAN
ENDSCAN

El segundo ejemplo se ejecutará más rápido que el primero. Reseñar el uso de la función EVALUATE() para conseguir el valor almacenado en el campo.

Haciendo Referencia a las propiedades de los objetos

Referirse a Propiedades de Objetos es más lento que referirse a variables de memoria. Cuando necesitas escribir código que usará una Propiedad de un Objeto múltiples veces será más rápido poner el valor de la Propiedad en una variable de memoria y utilizar la variable en el código posterior. Dos ejemplos para ilustrarlo:

* Ejemplo 1
USE AlgunaTabla
SCAN FOR AlgunCampo = THISFORM.AlgunaPropiedad
  Blah
  Blah
  Blah
ENDSCAN

* Ejemplo 2
USE AlgunaTabla
LOCAL lcValor
lcValor = THISFORM.AlgunaPropiedad
SCAN FOR AlgunCampo = lcValor
  Blah
  Blah
  Blah
ENDSCAN
El segundo ejemplo se ejecutará más rápido.

Otro método de optimizar el acceso a las Propiedades es utilizar la instrucción WITH/ENDWITH. Cuando necesites acceder a varias propiedades del mismo objeto puedes hacerlo más rápido usanto WITH/ENDWITH.

 * Ejemplo 1
THISFORM.Propiedad1 = "ABC"
THISFORM.Propiedad2 = "ABC"
THISFORM.Propiedad3 = "ABC"
THISFORM.Propiedad4 = "ABC"
THISFORM.Propiedad5 = "ABC"
THISFORM.Propiedad6 = "ABC"
THISFORM.Propiedad7 = "ABC"
THISFORM.Propiedad8 = "ABC"

* Ejemplo 2
WITH THISFORM
  .Propiedad1 = "ABC"
  .Propiedad2 = "ABC"
  .Propiedad3 = "ABC"
  .Propiedad4 = "ABC"
  .Propiedad5 = "ABC"
  .Propiedad6 = "ABC"
  .Propiedad7 = "ABC"
  .Propiedad8 = "ABC"
ENDWITH


Otras Optimizaciones

Abre las tablas sólo una vez cuando sea posible, abriendo instancias adicionales de una tabla incrementa el consumo de memoria y ralentiza otras operaciones.

Manda la salida a la ventana activa en ese momento siempre que puedas, toma más tiempo actualizar una ventana en segundo plano que actualizar la que está activa.

Puedes utilizar la Propiedad LockScreen de un Formulario para impedir modificaciones interactivas del contenido de un formulario durante las operaciones. Pon LockScreen a .T. antes de comenzar una operación y ponlo a .F. cuando se haya completado. Aunque no nos da una gran mejora de tiempos, hace que el interfaz parezca más concisa, ya que el usuario no ve las actualizaciones como una secuencia.

En el programa de comienzo pon siempre SET DOHISTORY OFF. Además, cuando sea posible, SET TALK OFF. Ambas, DOHISTORY y TALK, gastan tiempo en hacer sus cosas, desactivándolas dejan de gastar ese tiempo.

Los Formularios individuales se cargan antes que los Conjuntos de Formularios. Esto es normal, porque los Conjuntos de Formularios deben crear múltiples formularios. Cuando sea posible utiliza formularios individuales separados de tal manera que sólo crearás aquellos que el usuario vaya a utilizar.

Utilizar el Entorno de Datos de un Formulario o Informe es mucho más rápido abriendo las tablas que codificar instrucciones USE para abrirlas.

Borrar los objetos de la memoria tan pronto como hayas acabado de utilizarlos. Esto libera más memoria para los objetos que están siendo usados todavía.

Escribe las instrucciones IF de manera que su expresión tenga como resultado .T. habitualmente.

Para código condicional en métodos, escribe una instrucción IF al principio que ejecute RETURNS cuando la expresión sea verdadera para salir rápidamente del método. Se ejecutará más rápido que haciendo que VFP analice el método entero para encontrarse con que no necesita ejecutar nada del ese código.

Escribe las instrucciones DO CASE de tal manera que los primeros apartados CASE sean los que se ejecuten más a menudo.

Resumen

Este artículo muestra algunas cosas diferentes que puedes hacer cuando escribes tus aplicaciones para mejorar su rendimiento. Optimizar una aplicación es un proceso laborioso, siguiendo estos principios desde el comienzo de la codificación reducirás la complejidad de optimizar el código después.

2 de octubre de 2001

Pablo Roca es MVP de VisualFoxpro

Desde el 1 de Octubre me han nombrado MVP de VisualFoxpro, por ello quiero hacer el siguiente comentario ... Aunque me alegra enormemente, tanto como por el reconocimiento y como por los beneficios de ser MVP, me da un tanto verguenza ... y no dejo de acordarme de al menos dos personas que creo se lo merecen mas que yo (Carlos Yohn Zubiria y Luis Maria Guayan).

¿Como empezo todo?

Bueno, despues de haber trabajado 8 años en una multinacional (Fujitsu España), me instalé por mi cuenta ... y estaba muy acostumbrado a siempre tener alguien de mano a quien pedirle ayuda ... el principio fue duro, pero gracias a que pude consultar mis dudas en compuserve y en los grupos de news, gente que ofrecia ayuda desinteresadamente sin pedir nada a cambio. Esto me sorprendió y con el tiempo vi que tenia que devolver lo que me habian ofrecido otros en su dia.

Despues de llevar un tiempo en las news y cansado de ver que siempre habia las mismas preguntas. Pensaba que teniamos que avanzar y dar por cerradas las tipicas preguntas, de eso vino el nacimiento de PortalFox.

Una vez creado PortalFox, me puse en contacto con Luis Maria Guayan, que sin dudarlo se puso a la disposicion de PortalFox y ofrecio todos sus articulos (si mal no recuerdo aun creo que la mayoria de articulos son suyos)

El empujon definitivo se lo dió Isaac Venegas, que es el Sysop de chat y Relaciones Publicas.

¡Gracias a los dos, amigos!

A partir de ahi, pues PortalFox há ido creciendo a lo que actualmente espero que sea, un punto de encuentro para toda la comunidad hispana de desarrolladores de VisualFoxpro.

Gracias a todos (especialmente a los SysOps de PortalFox) y espero que sigamos en la misma linea o mejor.

Pablo Roca MS VFP - MVP

24 de septiembre de 2001

Generar un GUID

Obtiene un GUID en formato {nnnnnnnn-nnnn-nnnn-nnnn-nnnnnnnnnnnn}
*!* Obtiene un GUID en formato {nnnnnnnn-nnnn-nnnn-nnnn-nnnnnnnnnnnn}
*!* Sintaxis: GetGuid()
*!* Valor devuelto: lcGuid
FUNCTION GetGuid
  LOCAL lnCnt, lcGuid, lcData1, lcData2, lcData3, lcData4, lcData5
  *!* Instrucciones DECLARE DLL para manipular obtener un GUID
  DECLARE INTEGER CoCreateGuid IN Ole32.DLL STRING @lpGuid
  *!* Valores
  lnCnt   = 0
  lcGuid  = ""
  lcData1 = ""
  lcData2 = ""
  lcData3 = ""
  lcData4 = ""
  lcData5 = ""
  lpGuid  = REPLICATE(CHR(0), 17)
  *!* Obtener el GUID
  IF CoCreateGuid(@lpGuid) = 0
    *!* Valores
    *!* Los 8 primeros dígitos
    lcData1 = RIGHT(TRANSFORM(StrToLong(LEFT(lpGuid, 4)), ";@0"), 8)
    *!* Los 4 segundos dígitos
    lcData2 = RIGHT(TRANSFORM(StrToLong(SUBSTR(lpGuid, 5, 2)), ";@0"), 4)
    *!* Los 4 terceros dígitos
    lcData3 = RIGHT(TRANSFORM(StrToLong(SUBSTR(lpGuid, 7, 2)), ";@0"), 4)
    *!* Los 4 cuartos digitos
    lcData4 = RIGHT(TRANSFORM(StrToLong(SUBSTR(lpGuid, 9, 1)), ";@0"), 2);
      + RIGHT(TRANSFORM(StrToLong(SUBSTR(lpGuid, 10, 1)), ";@0"), 2)
    lcData5 = ""
    *!* Los 12 digitos finales
    FOR lnCnt = 1 TO 6
      lcData5 = lcData5 + RIGHT(TRANSFORM(StrToLong(SUBSTR(lpGuid, 10 + lnCnt, 1))), 2)
    ENDFOR
    *!* Verifica la longitud de los 12 digitos finales. Si son menores de 12 es que el resto son 0
    IF LEN(lcData5) < 12
      lcData5 = lcData5 + REPLICATE("0", 12 - LEN(lcData5))
    ENDIF
    *!* Valores
    lcGuid = "{" + lcData1 + "-" + lcData2 + "-" + lcData3 + "-" + lcData4 + "-" + lcData5 + "}"
  ENDIF
  *!* Retorno
  RETURN lcGuid
ENDFUNC
*!* Convierte un 4-byte CHARACTER STRING a un LONG INTEGER
*!* Sintaxis: StrToLong(tcLongStr)
*!* Valor devuelto: lnRetval
*!* Argumentos: tcLongStr
*!* tcLongStr especifica el 4-byte character string a convertir
FUNCTION StrToLong
  LPARAMETERS tcLongStr
  LOCAL lnCnt, lnRetVal, lcLongStr
  *!* Valores
  lnRetVal  = 0
  lcLongStr = IIF(EMPTY(tcLongStr), "", tcLongStr)
  *!* Convertir
  FOR lnCnt = 0 TO 24 STEP 8
    lnRetVal  = lnRetVal + (ASC(lcLongStr) * (2^lnCnt))
    lcLongStr = RIGHT(lcLongStr, LEN(lcLongStr) - 1)
  NEXT
  *!* Retorno
  RETURN lnRetVal
ENDFUNC

21 de septiembre de 2001

Database Design for Mere Mortals

Titulo : Database Design for Mere Mortals : A Hands-On Guide to Relational Database Design
Autor : Michael Hernandez
ISBN : 0201694719
Editora: Addison-Wesley Pub Co
Nº Paginas: 480



Contenido :

1- ¿ Que es un banco de datos relacional ?
2- Objetivos del Proyecto
3- Terminologías
4- Visión Conceptual
5- Comenzando el Proceso
6- Analizando el Banco de Datos Existente
7- Estableciendo las estructuras de las tablas
8- Índices
9- Especificación de los campos
10- Relacionamientos entre las tablas
11- Reglas de Negocio
12- Vistas
13- Examinando la integridad de los Datos
14- Un Mal Proyecto . Que se debe hacer
15- Cometiéndose o Quebrando reglas

Comentario :

El autor explica en un lenguaje común (fácil de entender) como desarrollar cualquier Base de datos . Sin importar la tecnología de esa base de datos , ni el lenguaje (puede ser en Vfox , Access , MS SQL Server , etc) .

El autor muestra en el libro como iniciar un proyecto , como realizar la documentación del mismo , todo lo que se debe hacer antes de escribir la primer línea de código . Todo es mostrado con muchos ejemplos , bien detallado y creo que es una lectura obligatoria para todos lo que día a día trabajamos , modificamos y proyectamos bases de datos .

Cada vez que comienzo un nuevo proyecto , le doy una leída a los capítulos 5 , 6 y 7 . Y con eso me evito futuros dolores de cabeza por un mal diseño . El editor técnico del libro es Jim Booth .   Destaque: ' Los capítulos 5 y 6 , donde la atención del autor para los detalles es impresionante y las explicaciones del proceso de entrevista son imprescindibles para cualquier persona , incluyendo los proyectistas con experiencia en de bases de datos relacionales ' Palabras de Jim Booth en su opinión sobre el libro .

Observaciones: Yo en realidad tengo la versión en Portugués de este libro (ISBN 85-346-1089-4 Editora Makron Books) coloque la información del libro en ingles porque se que para muchos de uds es mas fácil leer libros en ingles que en portugués.

Mas Info: Aquí

Nivel : Inicial-Intermedio.

20 de septiembre de 2001

VFP 7: Los nuevos comandos, funciones y clases.

Nuevos comandos, funciones y clases de Visual FoxPro 7
Por: Pablo Roca

COMANDOS Y VARIABLES DE SISTEMA

_Codesense System Variable
Contiene el nombre de la aplicación que crea funciones de IntelliSense.

_OBJECTBROWSER System Variable
Contiene el nombre de la aplicación del browser del objeto.

_TASKLIST System Variable
Esta variable de sistema contiene el nombre del programa encargado de la lista de tareas.

_VSBUILD System Variable
Contiene el nombre de la aplicación de la estructura del proyecto del Visual Estudio

FUNCIONES

ADLLS( ) Function
Retorna un vector conteniendo el nombre de las DLLs cargadas.

ASESSIONS( ) Function
Retorna el número de sesiones de datos.

ASTACKINFO( ) Function
Retorna un vector que provee información acerca del objeto en un programa, aplicación o DLL, como por ejemplo; nivel de la pila de llamadas, nombre del programa en curso, modulo, número de linea, etc.

ATAGINFO( ) Function
Crea un vector que contiene información acerca del nombre, número y tipos de índices y expresiones claves.

CursorToXML( ) Function
Convierte un cursor de Visul FoxPro a XML

EDITSOURCE( ) Function
Abre el editor visual de FoxPro y, coloca opcionalmente el cursor. Requerido por Editor de Shortcuts.

EXECSCRIPT( ) Function
Permite ejecutar líneas múltiples de código desde variables, tablas, y otro texto como runtime.

GETWORDCOUNT( ) Function
Cuenta las palabras de una cadena
cString = "AAA aaa, BBB bbb, CCC ccc."
? GetWordCount(cString) && 6 – grupos de caractéres, definidos por " "
? GetWordCount(cString, ",") && 3 - grupos de caractéres, definidos por ","
? GetWordCount(cString, ".") && 1 - grupos de caractéres, definidos por "."

GETWORDNUM( ) Function
Devuelve una palabra especificada de una cadena.
cString = "AAA aaa BBB bbb CCC ccc"
?GETWORDNUM(cString,2) && devuelve aaa
?GETWORDNUM(cString,4) && devuelve bbb

QUARTER( ) Function
Retorna el cuarto del año de una expresión fecha o datetime.

CLASES


EditorOptions Property
Esta propiedad del objeto especifica las opciones del Editor de Visual FoxPro que se habilitarán, por ejemplo.
VFP.EditorOptions = "lq" && Desabilita AUTO IntelliSense.
_VFP.EditorOptions = "LQ" && Habilita Auto IntelliSense

FoxCode Property
Especifica el nombre de la tabla FOXCODE usada por VFP7 IntelliSense, por defecto es FOXCODE y se encuentra en HOME()

FoxTask Property
Especifica el nombre de la tabla FOXTASK que soporta el administrador de tareas de VFP.

MouseEnter Event
Habilita DHTML. Ocurre cuando en cursor del mouse se mueve.

RowColChange Property
Identifica el tipo de cambio hecho en un grid.
Grid.RowColChange
0- Sin cambios.
1- Cambio de fila.
2- Cambio de columna.
3- Cambio de fila y columna.

SelectedItemBackColor, SelectedItemForeColor
Soporta colores en combobox, listbox y grid.

VisualEffect Property
Soporta SpecialEffect entre controles.

19 de septiembre de 2001

Visual Foxpro 5 , Fundamentos y Técnicas de Programación (Rubén Iglesias)

Título: Visual Foxpro 5 , Fundamentos y Técnicas de Programación
Autor: Rubén Iglesias 
ISBN : 970-15-0349-X
Editora: Ra-Ma
Nº Paginas: 491


Contenido :

  1. Bases de Datos y Tablas
  2. Instrucciones Básicas
  3. La Tecnología Rushmore
  4. Menús a la Carta
  5. Programación Orientada a Objetos
  6. Análisis y Diseño Orientado a Objetos
  7. Programación Orientada a Formularios
  8. Las clases de Base
  9. Gestion de Informes
  10. El archivo Config.fpw
  11. Aplicacion Práctica
  12. Creación de un Ajedrez
  13. Apendices

Comentario :

La explicacion que da Iglesias de el uso de cada componente es muy bien ilustrada y ejemplificada .
Las propiedades y eventos de los controles estan bien explicados . Solo faltaria hablar un poco mas de clases . Destaque capitulo 3 (Rushmore), ejemplos y explicaciones bien detalladas del uso de esta tecnologia .

Nivel : Iniciante.

18 de septiembre de 2001

Crea documentos XML anidados con VFP 7.0

LOCAL StringXML,StringXML2

***********************************************
* Aquí se crea un documento básico en XML que  contiene
* tres datos personales y un TAG vacío para las direcciones
***********************************************

StringXML=[]
StringXML = CreateDocumentXML(StringXML,"nombre","Aleix")
StringXML = CreateDocumentXML(StringXML,"apellidos","Lamela")
StringXML = CreateDocumentXML(StringXML,"dni","12345678A")
StringXML = CreateDocumentXML(StringXML,"detallesDirecciones")

***********************************************
* Ahora crearemos las direcciones de la misma manera
***********************************************

StringXML2=[]
StringXML2 = CreateDocumentXML(StringXML2,"Calle","Diagonal")
StringXML2 = CreateDocumentXML(StringXML2,"Piso","4")
StringXML2 = CreateDocumentXML(StringXML2,"Puerta","1")

***********************************************
* Aqui vamos a agregar Documento XML a otro donde nos interese.
***********************************************

LOCAL PadreXML  as msxml2.DOMDocument
LOCAL HijosXML  as msxml2.DOMDocument
LOCAL ELEMENTOS  AS MSXML2.IXMLDOMElement 
PadreXML =  CREATEOBJECT("msxml2.domdocument")
HijosXML  =  CREATEOBJECT("msxml2.domdocument")
HijosXML.async=.f.
PadreXML.async=.f.
HijosXML.loadXML(StringXML2)
PadreXML.loadXML(StringXML)
HijosXML.documentElement 
PadreXML.documentElement.selectSingleNode("detallesDirecciones").appendChild(HijosXML.documentElement)


************************************************
* Y ya esta , ahora solo tienes que mirar el contenido
***********************************************


IF MESSAGEBOX("¿Desea guardar el contenido en disco?",32+4) = 6
    PadreXML.save("c:DocumentoPersonal.xml")
ELSE
    MESSAGEBOX(PadreXML.xml)
ENDIF

RETURN

***********************************************
* Esta función Acepta Tres Parámetros, un Documento Raíz 
* , el Nuevo TAG que se le quiere agregar
* Y el Valor del Tag
***********************************************

FUNCTION CreateDocumentXML(DocumentRoot  as String,;
                                           NewElement  as String, ;
                                           NewValue  as String)
 LOCAL ElDocumento  as MSXML2.DOMDocument 
 LOCAL ELElemento  as MSXML2.IXMLDOMElement 
 LOCAL LaRaiz  as MSXML2.IXMLDOMElement 
 IF PCOUNT() >= 1  THEN 

 ***********************************************
 * Cargo el Documento nuevo
 ***********************************************

 ElDocumento =  CREATEOBJECT("MSXML2.DOMDocument")
 ElDocumento.async= .F.
 ElDocumento.loadXML(DocumentRoot)
 ENDIF
 IF PCOUNT() >= 2  THEN 

 ***********************************************
 * Extraigo los datos principales
 ***********************************************
 LaRaiz = ElDocumento.documentElement 
 ***********************************************
 * Creo el nuevo Elemento
 ***********************************************
 ElElemento = ElDocumento.createElement(NewElement)
 LaRaiz.appendChild(ElElemento)
 ENDIF
 IF PCOUNT()=3  THEN
 LaRaiz.lastChild.text = NewValue
 ENDIF

 RETURN ElDocumento.xml 
ENDFUNC

11 de septiembre de 2001

Modificar el volumen de los altavoces

Enviada al grupo de noticias por Patrick Espinosa, aqui tenemos como hacerlo ...
Declare Integer waveOutSetVolume in Winmm Integer wDeviceID, Integer dwVolume

waveOutSetVolume(0,0xFFFFFFFF)
Para poner en silencio total se debe poner 0x00000000. Los primeros 4 son para el canal (altavoz) izquierdo y los 4 de los últimos 4 para el canal derecho, por lo que por ejemplo si quieres que nada más se escuche el altavoz izquierda debes poner un 0xFFFF0000.

29 de agosto de 2001

Validar CIF (solo España)

Para la validación de un C.I.F. se deben realizar una serie de operaciones matemáticas, para lo cual, de los 9 caracteres que componen dicho código se utilizan únicamente los caracteres numéricos situados en las posiciones 2 a 8. Sirva como ejemplo el C.I.F. que se muestra en el gráfico sobre este texto, en el que dichas cifras serían 4635353

En primer lugar, deben sumarse las cifras existentes en los lugares pares, con lo que se obtendrá un valor (R1). Así pues: R1 = 6 + 5 + 5 = 16.

En segundo lugar, cada cifra en lugar impar se multiplica por 2, sumándose las dos cifras del producto si este fuera superior a 9:

4 x 2 = 8;
3 x 2 = 6;
3 x 2 = 6;
3 x 2 = 6.

Los resultados obtenidos se suman entre sí, con lo que se obtiene un segundo valor (R2). De esta forma: R2 = 8 + 6 + 6 + 6 = 26.

Seguidamente se suman R1 y R2, con lo que se obtiene R:

R = R1 + R2 = 42.

Una vez calculado R, de esta cantidad sólo es útil el valor de la cifra de las unidades (U), en este caso: U = 2.

Se halla ahora la diferencia (D) de restar a 10 el valor de U, con lo que D estará dentro del rango de valores entre 1 y 10. En este último caso, se cambiará su valor a cero. En el ejemplo:

D = 10 - 2 = 8.

Si la sociedad es de tipo privado y española, el dígito hallado será el carácter de validación y ocupará la última posición del C.I.F.; en cualquier otro caso, dicho carácter deberá corresponder a una letra, por lo que se aplicará la siguiente tabla de conversión:

1 2 3 4 5 6 7 8 9 0
A B C D E F G H I J

Rafael Bilbao Aragonés

22 de agosto de 2001

Validar el número de CUIT o CUIL

¿Cómo validar el número de C.U.I.T. o C.U.I.L.? (Solo para Argentina)

En la República Argentina a todas las personas físicas o jurídicas, se le otorga un número conocido como Clave Única de Identificación Tributaria (C.U.I.T.) o Clave Única de Identificación Laboral (C.U.I.L.).

Para saber si este número es correcto utilizaremos la función:

? _ValidaCUIT("20-16886271-8")

*------------------------------------------------
* FUNCTION _ValidaCUIT(tcCUIT)
*------------------------------------------------
* Valida el número de CUIT o CUIL
* USO: _ValidaCUIT(<99-99999999-9>)
* RETORNA: Lógico
*------------------------------------------------
FUNCTION _ValidaCUIT(tcCUIT)
  LOCAL lnSuma, llRet
  IF EMPTY(tcCuit)
    llRet = .T.
  ELSE
    IF TYPE('tcCuit') = 'C' AND LEN(tcCuit) = 13
      lnSuma = VAL(SUBS(tcCUIT,11,1)) * 2 + ;
        VAL(SUBS(tcCUIT,10,1)) * 3 + ;
        VAL(SUBS(tcCUIT,9,1)) * 4 + ;
        VAL(SUBS(tcCUIT,8,1)) * 5 + ;
        VAL(SUBS(tcCUIT,7,1)) * 6 + ;
        VAL(SUBS(tcCUIT,6,1)) * 7 + ;
        VAL(SUBS(tcCUIT,5,1)) * 2 + ;
        VAL(SUBS(tcCUIT,4,1)) * 3 + ;
        VAL(SUBS(tcCUIT,2,1)) * 4 + ;
        VAL(SUBS(tcCUIT,1,1)) * 5
      llRet = VAL(SUBS(tcCUIT,13,1)) = ;
        IIF(MOD(lnSuma,11) = 0, 0, 11-MOD(lnSuma,11))
    ELSE
      *--- No es Char o no tiene el largo correcto
      llRet = .F.
    ENDIF
  ENDIF
  RETURN llRet
ENDFUNC

Luis María Guayán

21 de agosto de 2001

Calcular la letra de un DNI (para España)

Facil rutina para calcular la letra del DNI, (valido solo para España) ...
************************************************************
*
* Funcion: LETRADNI
*
* Dado un DNI devuelve la letra
*
* Parametros:
*
* tndni - DNI en formato numerico
*
* Ejemplos:
*
* letra =letradni(32415874)
*
* Retorno
*
* caracter - la letra de verificacion
*
* Fecha de Creacion  : 21/08/2001 Pablo Roca
* Ultima Modificacion: 21/08/2001 Pablo Roca
*
************************************************************
FUNCTION letradni
LPARAMETERS tndni
RETURN SUBSTR("TRWAGMYFPDXBNJZSQVHLCKE",MOD(tndni,23)+1,1)
Pablo Roca

18 de agosto de 2001

Algunas funciones de la API de Windows

Por Luis María Guayán

Algunas funciones de la API de Windows usadas desde Visual FoxPro

Conectandose a la red desde Visual FoxPro

Funciones de la API de Windows para conectarse, desconectarse e interrogar sobre una conexión de red. Estas funciones son:
  • Interroga sobre una conexión de red...: WNetGetConnection
  • Añade una nueva conexión de red......: WNetAddConnection
  • Cancela una conexión de red.............: WNetCancelConnection
Ahora podemos usar directamente funciones definidas por el usuario para una fácil implementación en nuestras aplicaciones de Visual FoxPro. Estas tres funciones se describen a continuación:
*----------------------------------------
* FUNCTION GetConnection(lcDrive)
*----------------------------------------
* Retorna el nombre de la PC y recurso
* compartido de una conexión de red
* PARAMETROS: lcDrive
* USO: ? GetConnection("K:")
*----------------------------------------
FUNCTION GetConnection(lcDrive)
DECLARE INTEGER WNetGetConnection IN WIN32API ;
STRING lpLocalName, ;
STRING @lpRemoteName, ;
INTEGER @lpnLength
LOCAL cRemoteName, nLength, lcRet, llRet
cRemoteName=SPACE(100)
nLength = 100
llRet = WNetGetConnection(lcDrive,@cRemoteName,@nLength)
lcRet = LEFT(cRemoteName,AT(CHR(0),cRemoteName)-1)
RETURN lcRet
ENDFUNC

*----------------------------------------
* FUNCTION AddConnection(tcDrive,tcResource,tcPassword)
*----------------------------------------
* Conecta un recurso compartido a la unidad tcDrive
* USO: ? AddConnection("Z:","PC_REMOTARECURSO")
*----------------------------------------
FUNCTION AddConnection(tcDrive,tcResource,tcPassword)
LOCAL lnRet
DECLARE INTEGER WNetAddConnection IN WIN32API;
STRING @lpzRemoteName, ;
STRING @lpzPassword,;
STRING @lpzLocalName
IF PARAMETERS() < 3
lnRet = WNetAddConnection(@tcResource,0,@tcDrive)
ELSE
lnRet = WNetAddConnection(@tcResource,@tcPassword, @tcDrive)
ENDIF
IF lnRet # 0
RETURN "Error " + ALLT(STR(lnRet)) + ;
" al conectar el drive " + tcDrive
ENDIF
RETURN ""
ENDFUNC

*----------------------------------------
* FUNCTION CancelConnection(tcDrive)
*----------------------------------------
* Desconecta una unidad de red
* USO: ? CancelConnection("Z:")
*----------------------------------------
FUNCTION CancelConnection(tcDrive)
LOCAL lnRet
DECLARE INTEGER WNetCancelConnection IN WIN32API;
STRING @lpzLocalName, ;
INTEGER nForce
lnRet = WNetCancelConnection( @tcDrive, 0)
IF lnRet # 0
RETURN "Error " + ALLT(STR(lnRet)) + ;
" al desconectar el drive " + tcDrive
ENDIF
RETURN ""
ENDFUNC

*----------------------------------------

Algunos directorios importantes

Muchas veces queremos que nuestras aplicaciones lean o escriban archivos en los directorios que estan por defecto en todas las computadoras que tienen instalado Windows. Por ejemplo el directorio "C:WINDOSW"

La ruta y el nombre de estos directorios, lo podemos conocer con las siguientes funciones de la API de Windows:
  • Directorio de Windows................: GetWindowsDirectory
  • Directorio System de Windows.....: GetSystemDirectory
  • Directorio Temporal de Windows...: GetTempPath
Estas funciones de la API las declaramos directamente en las siguientes funciones definidas por el usuario, para invocarlas facilmente desde Visual FoxPro. Las funciones son las siguientes:
*----------------------------------------
* FUNCTION WinDir()
*----------------------------------------
* Retorna el directorio de Windows
* USO: ? WinDir() -> "C:WINNT"
*----------------------------------------
FUNCTION WinDir()
LOCAL lcPath, lnSize
lcPath = SPACE(255)
lnsize = 255
DECLARE INTEGER GetWindowsDirectory IN Win32API ;
STRING @pszSysPath,;
INTEGER cchSysPath
lnSize = GetWindowsDirectory(@lcPath, lnSize)
IF lnSize <= 0
lcPath = ""
ELSE
lcPath = ADDBS(SUBSTR(lcPath, 1, lnSize))
ENDIF
RETURN lcPath
ENDFUNC

*----------------------------------------
* FUNCTION SystemDir()
*----------------------------------------
* Retorna el directorio SYSTEM de Windows
* USO: ? SystemDir() -> "C:WINNTSYSTEM32"
*----------------------------------------
FUNCTION SystemDir()
LOCAL lcPath, lnSize
lcPath = SPACE(255)
lnsize = 255
DECLARE INTEGER GetSystemDirectory IN Win32API ;
STRING @pszSysPath,;
INTEGER cchSysPath
lnSize = GetSystemDirectory(@lcPath, lnSize)
IF lnSize <= 0
lcPath = ""
ELSE
lcPath = ADDBS(SUBSTR(lcPath, 1, lnSize))
ENDIF
RETURN lcPath
ENDFUNC

*----------------------------------------
* FUNCTION TempDir()
*----------------------------------------
* Retorna la ruta de los archivos temporales
* USO: ? TempDir() -> "C:WINNTTEMP"
*----------------------------------------
FUNCTION TempDir()
LOCAL lcPath, lnRet
lcPath = SPACE(255)
lnSize = 255
DECLARE INTEGER GetTempPath IN WIN32API ;
INTEGER nBufSize, ;
STRING @cPathName
lnRet = GetTempPath(lnSize, @lcPath)
IF lnRet <= 0
lcPath = ""
ELSE
lcPath = ADDBS(SUBSTR(lcPath, 1, lnRet))
ENDIF
RETURN lcPath
ENDFUNC

*----------------------------------------

Nombre de usuario y computadora

Cuando queremos saber el nombre de usuario o el nombre de la computadora, podemos usar directamente desde FoxPro el comando SYS(0), que nos devuelve información sobre el equipo de red cuando se utiliza Visual FoxPro en un entorno de red. Pero también existen las siguientes funciones de la API de Windows que nos devuelven esta información:
  • Retorna el nombre del usuario.............: GetUserName
  • Retorna el nombre de la computadora...: GetComputerName
Las funciones escritas en código de Visual FoxPro y de fácil uso son las siguientes:
*----------------------------------------
* FUNCTION UserName()
*----------------------------------------
* Retorna el nombre del usuario
* USO: ? UserName() -> "LUISG"
*----------------------------------------
FUNCTION UserName()
LOCAL lcUser, lnSize
lcUser = SPACE(80)
lnSize = 80
DECLARE INTEGER GetUserName IN WIN32API ;
STRING @cUserName, ;
INTEGER @nSize
=GetUserName(@lcUser, @lnSize)
IF lnSize < 2
lcUser = ""
ELSE
lcUser = SUBSTR(lcUser, 1, lnSize-1)
ENDIF
RETURN lcUser
ENDFUNC

*----------------------------------------
* FUNCTION ComputerName()
*----------------------------------------
* Retorna el nombre de la computadora
* USO: ? ComputerName() -> "PC_DESARROLLO"
*----------------------------------------
FUNCTION ComputerName()
LOCAL lcComputer, lnSize
lcComputer = SPACE(80)
lnSize = 80
DECLARE INTEGER GetComputerName IN WIN32API ;
STRING @cComputerName, ;
INTEGER @nSize
=GetComputername(@lcComputer, @lnSize)
IF lnSize < 2
lcComputer = ""
ELSE
lcComputer = SUBSTR(lcComputer, 1, lnSize)
ENDIF
RETURN lcComputer
ENDFUNC

*----------------------------------------

Sonidos y espera

Mediante la API de Windows, podemos ejecutar los sonidos del sistema o cualquier archivo de extensión .wav. También podemos detener la ejecución del programa durante "n" milisegundos. Las funciones son las siguientes:
  • Ejecuta el sonido predeterminado del sistema...: MessageBeep
  • Ejecuta el sonido de un archivo wav...............: PlaySound
  • Detiene la ejecución de un programa...............: Sleep
Para ejecutar estas funciones desde Visual FoxPro usamos lo siguiente:

*----------------------------------------
* FUNCTION Beep(tnSound)
*----------------------------------------
* Ejecuta el sonido predeterminado del sistema
* USO: ? Beep(0)
*----------------------------------------
FUNCTION Beep(tnSound)
tnSound = IIF(VARTYPE(tnSound) = "N", tnSound, 1)
DECLARE INTEGER MessageBeep IN WIN32API ;
INTEGER nSound
RETURN IIF(MessageBeep(tnSound) = 1, .T., .F.)
ENDFUNC

*----------------------------------------
* FUNCTION PlayWav(lcWaveFile, lnPlayType)
*----------------------------------------
* Ejecuta un archivo .WAV
* USO: PlayWave( [,])
* Archivo_Wav = Ruta completa del archivo .Wav
* Ejecucion = 1 - Ejecución en background (default)
* 0 - La aplicación espera la ejecución
* 2 - Si el archivo no existe, no ejecuta el default
* 4 - Apaga el sonido que se está ejecutando
* 8 - Continuado
*----------------------------------------
FUNCTION PlayWav(lcWaveFile, lnPlayType)
lnPlayType = IIF(VARTYPE(lnPlayType) = "N", lnPlayType, 1)
DECLARE INTEGER PlaySound IN WINMM.DLL ;
STRING cWave, ;
INTEGER nModule, ;
INTEGER nType
RETURN IIF(PlaySound(lcWaveFile,0,lnPlayType) = 1, .T., .F.)
ENDFUNC

*----------------------------------------
* FUNCTION Sleep(lnMiliSeg)
*----------------------------------------
* Función que detiene la ejecución de un programa
* durante "n" milisegundos sin interfase con el teclado.
* USO: ? Sleep(1500)
*----------------------------------------
FUNCTION Sleep(lnMiliSeg)
lnMiliSeg = IIF(VARTYPE(lnMiliSeg) = "N", lnMiliSeg, 1000)
DECLARE Sleep IN WIN32API ;
INTEGER nMillisecs
RETURN IIF(Sleep(lnMiliSeg) = 1, .T., .F.)
ENDFUNC

*----------------------------------------

Posición del cursor

Algunas funciones de la API de Windows son muy curiosas, como esta que nos permite configurar la posición del cursor en nuestra pantalla:
  • Posiciona el cursor en la pantalla......: SetCursorPos
Esta función en código de Visual FoxPro es:

*----------------------------------------
* FUNCTION SetCurPos(lnX, lnY)
*----------------------------------------
* Coloca el cursor en la posición especificada
* USO: ? SetCurPos(50,200)
*----------------------------------------
FUNCTION SetCurPos(lnX, lnY)
lnX = IIF(EMPTY(lnX),0,lnX)
lnY = IIF(EMPTY(lnY),0,lnY)
DECLARE INTEGER SetCursorPos IN WIN32API ;
INTEGER lnX, ;
INTEGER lnY
RETURN IIF(SetCursorPos(lnX, lnY) = 1, .T., .F.)
ENDFUNC

*----------------------------------------

Verificar si la aplicación está activa

Podemos saber si una aplicación está activa, para ello tenemos la función de la API:
  • Busca la ventana activa......: FindWindows
A esta función se le debe pasar como parámetro, el título (caption) de la aplicación. Este parámetro debe ser exactamente igual al título de la ventana de la aplicación que queremos verificar:

*----------------------------------------
* FUNCTION IsActive(tcCaption)
*----------------------------------------
* Verifica si una aplicación ya está activa
* USO: ? IsActive("Calculadora")
*----------------------------------------
FUNCTION IsActive(tcCaption)
DECLARE INTEGER FindWindow IN WIN32API ;
STRING cNULL, ;
STRING cWinName
RETURN FindWindow(0, tcCaption) # 0
ENDFUNC
*----------------------------------------

Con esta función podemos comprobar si nuestra aplicación de Visual FoxPro ya ha sido iniciada en una PC y así no iniciarla nuevamente. Para lograrlo escribiremos una función que se invoca en el inicio de nuestra aplicación, luego de haber colocado el título a nuestra ventana principal.

*----------------------------------------
* FUNCTION YaActiva()
*----------------------------------------
* Comprueba que la aplicación no se esta ejecutando
* Invoca a IsActive() descripta anteriormente
*----------------------------------------
FUNCTION YaActiva()
LOCAL llRet, lcCaption
llRet = .F.
lcCaption = _SCREEN.Caption
*--- Renombra temporariamente el caption de la app
_SCREEN.Caption = "_" + lcCaption
IF IsActive(lcCaption)
*--- Si ya esta activo
MESSAGEBOX("Este sistema ya está activo",16,"Aviso")
llRet = .T.
ENDIF
_SCREEN.Caption = lcCaption
RETURN llRet
ENDFUNC

*----------------------------------------

Si la función YaActiva() retorna .T., entonces ya hay una instancia de la aplicación activa, y debemos cancelar la nueva ejecución.

Mas funciones

Muchas funciones de la API de Windows ya fueron tratadas en este Portal y existen muchas funciones mas, de la que podemos sacar provecho, y darle un toque mas profesional a nuestras aplicaciones.

Los métodos Access y Assign

Métodos Access y Assign

Se ha mejorado Visual FoxPro para que admita los métodos Access y Assign. Estos métodos definidos por el usuario permiten ejecutar código cuando se consulta el valor de una propiedad o cuando se intenta modificar el valor de una propiedad.

El código del método Access se ejecuta cuando se consulta el valor de una propiedad, normalmente con la propiedad en una referencia de objeto, al almacenar el valor de la propiedad en una variable o al mostrar el valor de la propiedad con un signo de interrogación (?).

El código del método Assign se ejecuta cuando se intenta modificar el valor de una propiedad, normalmente mediante los comandos STORE o = para asignar un nuevo valor a la propiedad.

Los métodos Access y Assign sólo se ejecutan cuando se consultan o modifican los valores de las propiedades en tiempo de ejecución. La consulta o modificación de los valores de las propiedades en tiempo de diseño no hace que se ejecuten los métodos Access y Assign.

Nota: Como el valor que intenta asignar a la propiedad se pasa al método Assign, debe incluir una instrucción PARAMETERS o LPARAMETERS en el método Assign para aceptar el valor.

Puede crear independientemente los métodos Access y Assign (puede crear un método Access sin un método Assign o un método Assign sin un método Access).

Puede crear métodos Access y Assign para propiedades creadas mediante programación en una instrucción DEFINE CLASS o de forma interactiva para un formulario o una clase con el Diseñador de formularios y el Diseñador de clases.

Nota: También se pueden crear métodos Access y Assign para todas las propiedades nativas de Visual FoxPro. Por ejemplo, puede crear un método Access para la propiedad Left de un formulario, lo que le permitirá ejecutar código siempre que se consulte la propiedad Left del formulario. Puede crear un método Assign para una propiedad nativa de sólo lectura de Visual FoxPro (por ejemplo, la propiedad ParentClass), pero el método nunca se ejecutará.

Ventajas de los métodos Access y Assign

Los métodos Access y Assign proporcionan las ventajas siguientes:
  • Puede crear una interfaz pública para una clase o un objeto que separe la interfaz de la implementación.
  • Puede implementar fácilmente la validación de las propiedades.
  • Puede proteger fácilmente las propiedades en controles ActiveX que derivan de clases.
Crear métodos Access y Assign

Las mejoras del comando DEFINE CLASS y de los Diseñadores de formularios y de clases le permiten crear métodos Access y Assign mediante programación y de forma interactiva.

Nuevos sufijos para DEFINE CLASS

Se han agregado dos sufijos, _ACCESS y _ASSIGN, al comando DEFINE CLASS para crear métodos Access y Assign. Si anexa una de estas palabras clave al nombre de una función o un procedimiento, se creará un método Access o Assign para una propiedad que tenga el mismo nombre que la función o el procedimiento.

Por ejemplo, el siguiente ejemplo de código utiliza DEFINE CLASS para crear una clase personalizada llamada MiClase. Se crea una propiedad definida por el usuario, MiPropiedad, para la clase. A continuación se crea un método Access para MiPropiedad con la instrucción PROCEDURE.
Cuando se consulta el valor de la propiedad, se ejecuta el código del procedimiento (WAIT WINDOW 'Éste es el método Access'). También se crea un método Assign para MiPropiedad, de nuevo con una instrucción PROCEDURE. Cuando se intente modificar el valor de la propiedad, se ejecutará el código del procedimiento (WAIT WINDOW 'Éste es el método Assign').

Observe el uso de la instrucción LPARAMETERS para aceptar el valor pasado al método Assign. Este ejemplo también muestra cómo puede crear propiedades de sólo lectura.

DEFINE CLASS MiClase AS Custom
   MiPropiedad = 100 && Propiedad definida por el usuario

   PROCEDURE MiPropiedad_ACCESS && Método Access
      WAIT WINDOW 'Éste es el método Access';
          +  ' ' + PROGRAM( )
      RETURN THIS.MiPropiedad
   ENDPROC

   PROCEDURE MiPropiedad_ASSIGN && Método Assign
      LPARAMETERS tAssign  && Necesario para aceptar el valor
      WAIT WINDOW 'Éste es el método Assign';
          + ' ' + PROGRAM( )
   ENDPROC
ENDDEFINE

El ejemplo siguiente muestra cómo puede agregar un método Assign a una propiedad nativa de Visual FoxPro y realizar una sencilla validación del valor de la propiedad que intenta establecer. Observe que en este ejemplo se crea un método Assign sin un método Access correspondiente.

Se usa DEFINE CLASS para crear una clase Form llamada frmMiForm. Se crea un método Assign llamado Left_ASSIGN con una instrucción PROCEDURE. El código del método Assign se ejecuta siempre que se intente asignar un valor a la propiedad Left del formulario.

Si intenta asignar un valor negativo a la propiedad Left, se muestra un mensaje y no se modifica el valor de la propiedad Left. Si intenta asignar un valor no negativo a la propiedad Left, la propiedad Left del formulario queda establecida a dicho valor.

DEFINE CLASS frmMiForm AS Form
   PROCEDURE Left_ASSIGN && Método Assign
      LPARAMETERS tAssign  && Necesario para aceptar el valor
      
      DO CASE
         CASE tAssign < 0 && valor de Left negativo
            WAIT WINDOW 'El valor tiene que ser mayor que 0'
         OTHERWISE  && valor de Left no negativo
            THIS.Left = tAssign
      ENDCASE
   ENDPROC
ENDDEFINE
Los Diseñadores de clases y de formularios
Para crear un método Access o Assign en el Diseñador de formularios
  1. Elija Nueva propiedad en el menú Formulario.Se muestra el cuadro de diálogo Nueva propiedad.
  2. Escriba el nombre de la propiedad que va a crear en el cuadro de texto Nombre y, a continuación, seleccione la casilla de verificación Método Access o la casilla de verificación Método Assign (o ambas).
  3. Elija Agregar para crear la propiedad del formulario y para crear los métodos Access y Assign de la propiedad.
Para crear un método Access o Assign para una propiedad intrínseca de Visual FoxPro en el Diseñador de formularios
  1. Elija Nuevo método en el menú Formulario.Se muestra el cuadro de diálogo Nuevo método.
  2. Escriba el nombre de la propiedad intrínseca seguido de _Access o _Assign en el cuadro de texto Nombre. Por ejemplo, para crear un método Access para la propiedad Left, escriba Left_Access en el cuadro de texto Nombre.
  3. Elija Agregar para crear métodos Access o Assign para la propiedad intrínseca.
Nota En el Diseñador de formularios sólo puede crear propiedades con métodos Access y Assign para un formulario o un conjunto de formularios. Para crear propiedades con métodos Access y Assign para un control o un objeto, utilice el Diseñador de clases para crear la clase de control o de objeto. En el Diseñador de clases, agregue propiedades con métodos Access y Assign al control o al objeto y después agregue la clase de control u objeto al formulario en el Diseñador de formularios.

Para crear un método Access o Assign para una clase en el Diseñador de clases
  1. Elija Nueva propiedad en el menú Clase.Se muestra el cuadro de diálogo Nueva propiedad.
  2. Escriba el nombre de la propiedad que va a crear en el cuadro de texto Nombre y, a continuación, seleccione la casilla de verificación Método Access o la casilla de verificación Método Assign (o ambas).
  3. Elija Agregar para crear una propiedad para la clase y crear los métodos Access o Assign de la propiedad.
Método THIS_ACCESS

Se ha agregado a Visual FoxPro 6.0 un nuevo método global de clase, THIS_ACCESS. El código de un método THIS_ACCESS se ejecuta siempre que se intente modificar el valor de un miembro de un objeto o siempre que se intente consultar un miembro de un objeto.

El método THIS_ACCESS se crea en el código en un comando DEFINE CLASS o en los cuadros de diálogo Nuevo método o Modificar propiedades de las bibliotecas de clases visuales .vcx. Un método THIS_ACCESS siempre debe devolver una referencia de objeto; si no es así, se generará un error. Normalmente se devuelve la referencia de objeto THIS. El método THIS_ACCESS también debe incluir un parámetro para aceptar el nombre del miembro del objeto que se modifica o consulta.

El siguiente ejemplo muestra cómo crear un método THIS_ACCESS en el código de un comando DEFINE CLASS. Cuando este ejemplo se ejecuta como programa, 'Caption' se muestra dos veces, la primera cuando se le asigna un valor a la propiedad Caption y la segunda cuando se consulta el valor de la propiedad Caption. Después se muestra el valor de la propiedad Caption ('abc').

CLEAR
oTempObj = CREATEOBJECT('MiForm')  && Crea una instancia del formulario
oTempObj.Caption = 'abc'  && Asigna un valor y desencadena THIS_ACCESS
? oTempObj.Caption  && Consulta un valor y desencadena THIS_ACCESS

DEFINE CLASS MiForm AS Form
   PROCEDURE THIS_ACCESS
      LPARAMETER cMemberName  && Nombre del miembro del objeto

      IF cMemberName = 'caption'
         ? cMemberName  && Muestra el nombre del miembro del objeto
      ENDIF
      RETURN THIS
   ENDPROC
ENDDEFINE
Observe que THIS_ACCESS no pretende ser un sustituto global de los métodos Access y Assign (sólo proporciona información acerca del miembro del objeto al que se tiene acceso o se consulta). A diferencia de los métodos Access y Assign, THIS_ACCESS no proporciona control sobre los valores devueltos a miembros de objeto específicos.

Notas de programación de Access y Assign

Las secciones siguientes describen la información de programación para métodos Access y Assign.

Alcance

Los métodos Access y Assign están protegidos de forma predeterminada (no puede tener acceso a un método Access o Assign ni modificarlo desde fuera de la clase en la que se cree el método Access o Assign).

Incluya la palabra clave HIDDEN cuando cree un método Access o Assign para impedir el acceso y las modificaciones a las propiedades desde fuera de la definición de clase. Sólo los métodos y los eventos de la definición de la clase pueden tener acceso a las propiedades ocultas. Mientras que las subclases de la definición de clase pueden tener acceso a las propiedades protegidas, sólo la definición de la clase puede tener acceso a las propiedades ocultas.

Nota Si no incluye la palabra clave HIDDEN, puede crear subclases con los métodos Access y Assign.

Depuración

Puede ver el código de los métodos Access y Assign en la ventana Seguimiento de la ventana Depurador. Sin embargo, los métodos Access y Assign no se pueden ejecutar en las ventanas Inspección y Locales de la ventana Depurador.

Pasar matrices a los métodos Assign

Se pasan matrices a los métodos Access y Assign de la misma forma en que se pasan a procedimientos estándar de Visual FoxPro.

Si ejecuta SET UDFPARMS TO REFERENCE o se antepone @ al nombre de la matriz, se pasa la matriz completa al método Access o Assign. Si ejecuta SET UDFPARMS TO VALUE o escribe el nombre de la matriz entre paréntesis, se pasa por valor el primer elemento de la matriz. Los elementos de matriz siempre se pasan por valor. Para obtener más información acerca de cómo pasar valores y matrices, vea SET UDFPARMS.

Controles ActiveX

Las propiedades, los eventos o los métodos nativos de los controles ActiveX no admiten las propiedades Access y Assign. Sin embargo, las propiedades, los eventos y los métodos del Contenedor OLE que contiene al control ActiveX sí admite los métodos Access y Assign.

Método ResetToDefault

Si ejecuta el método ResetToDefault para un método Access o Assign se modifica el código del método Access o Assign al miniprograma predeterminado. El resultado es que el código heredado del método, si lo hubiera, no se ejecuta. La técnica utilizada para asegurar que el código heredado de la clase primaria se ejecuta varía según el tipo de método.

Coloque el código siguiente en la subclase de un método Access para ejecutar el código en la clase primaria:
RETURN DODEFAULT( )
Coloque el código siguiente en la subclase de un método Access para ejecutar el código de la clase primaria:
LPARAMETERS vnewval
DODEFAULT(vnewval)
THIS.<propiedad> = vnewval
Coloque el código siguiente en la subclase de un método THIS_ACCESS para ejecutar el código de la clase primaria:
LPARAMETERS cmember 
RETURN DODEFAULT(cmember)

Luis María Guayán

18 de julio de 2001

Encriptar clave de acceso (II)

Otra rutina para encriptar/desencriptar una clave de acceso.

Con esta rutina podemos encriptar/desencriptar una clave de acceso

La función Encripta() tiene tres parámetros Cadena a encriptar: La cadena que queremos encriptar. Llave: Llave para encriptar. Para desencriptar debemos usar la misma "llave". Bandera: Esta bandera me permite indicar si la cadena a encriptar puede ser desencriptada.

La función Desencripta() tiene dos parámetros Cadena a desencriptar: La cadena que queremos desencriptar. Llave: Llave para desencriptar. Esta "llave" debe ser la misma que usamos para encriptar.

Como ejemplo podemos usar:

lc = Encripta("MiClave", "MiLlave")
? lc
? Desencripta(lc, "MiLlave")
Si agregamos la bandera para no desencriptar obtenemos:
lc = Encripta("MiClave", "MiLlave", .T.)
? lc
? Desencripta(lc, "MiLlave")

Con esto le podemos dar seguridad a nuestros usuarios que "nadie" puede saber su clave de acceso. Para comparar la clave de acceso ingresada, la debemos encriptar con la "llave" y la "bandera" en .T., y recién allí comparo la clave encriptada con la guardada en nuestra tabla.

La "llave" utilizada puede ser el nombre de usuario, con esto la misma contraseña para dos usuarios distintos, una vez encriptada será diferente.

Las funciones en VFP 6 son las siguientes:

*---------------------------------------------
* Función que encripta una cadena
* Parámetros:
*    tcCadena - Cadena a encriptar
*    tcLlave - Llave para encriptar (Debe ser la misma para Desencriptar)
*    tlSinDesencripta - .F. para proceso que se puede usar Desencripta
*       Los textos encriptados con este tlSinDesencripta en .T. no se pueden
*       desencriptar, ya que el mecanismo de encriptamiento utilizado
*       produce perdida de informacion que impide la inversion del proceso
* Retorno: Caracter (el doble de largo que el texto pasado)
*---------------------------------------------
FUNCTION Encripta(tcCadena, tcLlave, tlSinDesencripta)
 LOCAL lc, ln, lcRet
 LOCAL lnClaveMul, lnClaveXor
 IF EMPTY(tcLlave)
  tcLlave = ""
 ENDIF
 =GetClaves(tcLlave,@lnClaveMul,@lnClaveXor)
 lcRet = ""
 lc = tcCadena
 DO WHILE LEN(lc) > 0
  ln = BITXOR(ASC(lc)*(lnClaveMul+1),lnClaveXor)
  IF tlSinDesencripta
   *-- Encripta de modo que no se puede desencriptar
   ln = BITAND(ln+(ln%256)*17+INT(ln/256)*135+ ;
    INT(ln/256)*(ln%256),65535)
  ENDIF
  lcRet = lcRet+BINTOC(ln-32768,2)
  lnClaveMul = BITAND(lnClaveMul+59,0xFF)
  lnClaveXor = BITAND(BITNOT(lnClaveXor),0xFFFF)
  lc = IIF(LEN(lc) > 1,SUBS(lc,2),"")
 ENDDO
 RETURN lcRet
ENDFUNC

*---------------------------------------------
* Función que desencripta una cadena encriptada
* Parámetros:
*    tcCadena - Cadena a desencriptar
*    tcLlave - Llave para desencriptar (Debe ser la misma de Encriptar)
* Retorno: Caracter (la mitad de largo que el texto pasado)
*---------------------------------------------
FUNCTION Desencripta(tcCadena, tcLlave)
 LOCAL lc, ln, lcRet, lnByte
 LOCAL lnClaveMul, lnClaveXor
 IF EMPTY(tcLlave)
  tcLlave = ""
 ENDIF
 =GetClaves(tcLlave, @lnClaveMul, @lnClaveXor)
 lcRet = ""
 FOR ln = 1 TO LEN(tcCadena)-1 STEP 2
  lnByte = BITXOR(CTOBIN(SUBS(tcCadena, ln,2))+ ;
   32768,lnClaveXor)/(lnClaveMul+1)
  lnClaveMul = BITAND(lnClaveMul+59, 0xFF)
  lnClaveXor = BITAND(BITNOT(lnClaveXor), 0xFFFF)
  lcRet = lcRet+CHR(IIF(BETWEEN(lnByte,0,255),lnByte,0))
 ENDFOR
 RETURN lcRet
ENDFUNC

*---------------------------------------------
* Función usada por Encripta y Desencripta
*---------------------------------------------
FUNCTION GetClaves(tcLlave, tnClaveMul, tnClaveXor)
 LOCAL lc, ln
 lc = ALLTRIM(LOWER(tcLlave))
 tnClaveMul = 31
 tnClaveXor = 3131
 DO WHILE NOT EMPTY(lc)
  tnClaveMul = BITXOR(tnClaveMul,ASC(lc))
  tnClaveXor = BITAND((tnClaveXor+1)*(ASC(lc)+1),0xFFFF)
  lc = IIF(LEN(lc) > 1,SUBS(lc,2),"")
 ENDDO
ENDFUNC

*---------------------------------------------

4 de junio de 2001

Transacciones con SQL Server (I)

Una parte importante del desarrollo de una aplicación cliente / servidor es la gestión de transacciones, el rendimiento del servidor y la consistencia de los datos depende en gran medida de cómo construyamos y ejecutemos las transacciones.

Una transacción es una unidad lógica de trabajo sobre la que agrupamos un conjunto de acciones que se ejecuta de forma ‘todo o nada’.

Nivel de Aislamiento

SQL Server ofrece cuatro niveles de aislamiento, que realizan y mantienen bloqueos durante la transacción. Como desarrolladores debemos recordar que las transacciones deben de ser cortas y lo menos estrictas posibles, aunque algunas veces nos resulte difícil conseguirlo.

READ COMMITED

(Predeterminado) La transacción mantiene bloqueos compartidos sobre los datos durante el tiempo que dura la lectura. No existe bloqueo que impida a otra transacción modificar los datos una vez leídos.

READ UNCOMMITED

Este es el nivel menos restrictivo y permite la lectura de datos no confirmados por otra transacción.

REPEATABLE READ

Activa y mantiene bloqueos según vamos leyendo datos, de esta forma evita que sean modificados por otra transacción, puede hacer que otras transacciones se bloqueen. Solo bloquea datos existentes, no evita que se puedan añadir nuevas filas.

SERIALIZABLE

Impide que se realicen modificaciones en las tablas que estamos leyendo, hasta que la transacción termina. Este es el nivel más restrictivo.

Como se procesan las transacciones.

El procesamiento de transacciones se lleva a cabo de tres formas en SQL Server:

AUTOCONFIRMACION

(Predeterminado) Cada instrucción de T-SQL crea su propia transacción y se confirma cuando finaliza.

IMPLÍCITA

Algunos comandos SQL hacen que SQL Server de comienzo a una transacción, que nosotros finalizaremos con el pertinente COMMIT WORK o ROLLBACK WORK

EXPLICITA

Con este modo el desarrollador es el responsable de controlar la transacción desde el programa, iniciándola (BEGIN TRAN) y finalizarla (COMMIT WORK / ROLLBACK WORK

¿Y los Triggers?

Puede que alguna sentencia incluida en la transacción dispare un Trigger, los Triggers ya operan dentro del ámbito de una transacción ya sea explicita o implícita, por ello solo incluiremos la instrucción ROLLBACK WORK dentro de ellos.

La próxima semana código de ejemplo.

Luis Rey García
Advanced & Frontdata Systems

29 de mayo de 2001

I.R. con Triggers (SQL)

Probablemente en las futuras versiones de SQL Server Microsoft incluya la propagación en cascada de las restricciones de claves externas, de momento hasta la versión 7, o lo gestionamos en la aplicación cliente o con procedimientos almacenados.

Estos procedimientos los podemos aplicar a cualquier gestor de base de datos, (SQL Server, Informix, Oracle, Sybase, etc), siempre verificando la sintaxis, ya que de un gestor a otro varía. Los procedimientos expuestos son aplicables a SQL Server.

Tablas Inserted y Deleted

Estas tablas contienen las filas modificadas almacenadas en el registro de transacciones, en realidad son vistas, su estructura coincide con la tabla que acaba de ser modificada. Se utilizan para conocer que cambios se han realizado, hago referencia a ellas dentro de los Triggers.

Borrado en cascada

Este tipo de disparador es fácil de implementar. Con un ejemplo lo ilustraremos mejor, vamos a crear un Trigger para borrar la cabecera de una factura y sus líneas.
CREATE TRIGGER CabFac_Del_LinFac ON CabFac                
FOR DELETE AS
IF @@ROWCOUNT = 0  
  RETURN  
DELETE LinFac  
FROM LinFac L, deleted d  
WHERE L.Id_Fac = d.Id_Fac  
IF @@ERROR  0  
  BEGIN  
    RAISEERROR (‘Error al borrar líneas de factura….’, 16, 1)  
    ROLLBACK TRAN
    RETURN
  END
Hay que tener presente que los Triggers se activan posteriormente a la acción, por tanto hay que revisar las restricciones de clave externa de la tabla de CabFac para que permita borrar.

Actualizaciones en cascada

Esto si que se complica un poco. Pensemos en lo que significa modificar una clave primaria, seria como eliminar una fila e insertar una nueva, esto hace que perdamos la relación entre las filas a las que deben afectar los cambios. Personalmente os recomiendo que limitéis la actualización a una fila, de este modo las tablas inserted y deleted solo tendrán una fila. Utilicemos el ejemplo de la cabecera y líneas de factura para ilustrar este procedimiento.
CREATE TRIGGER
CabFac_Upd_LinFac ON CabFac  
FOR UPDATE AS  
   DECLARE @nRows INT, @nId_Old INT, @nId_new INT  
  SELECT @nRows = @@ROWCOUNT  
  IF @nRows = 0  
    RETURN  
  IF UPDATED(Id_Fac)  
    BEGIN  
    IF @nRows = 1  
      BEGIN  
        SELECT @nId_Old = Id_Fac FROM deleted  
        SELECT @nId_New = Id_Fac FROM inserted  
        UPDATE LinFac SET id_Fac = @nId_New  
        WHERE Id_Fac = @nId_Old  
      END  
  ELSE  
    BEGIN  
      RAISERROR (‘No se puede actualizar mas de una Factura a la vez’, 16, 1)  
      ROLLBACK TRAN  
      RETURN  
    END
  END

Algunas recomendaciones

Revisar las restricciones de claves externas ya que pueden impedir que se dispare el Trigger.
Una buena técnica para las actualizaciones en cascada es insertar una nueva fila con el valor de la clave nueva, modificar las filas de la tabla que hacen referencia a este valor y por ultimo eliminar la fila antigua.

Rapidito

Como podéis observar integrar todo este código de Triggers es una tarea ardua, sobre todo en bases de datos con muchas tablas, para agilizar este proceso podemos utilizar el Asistente para Upsizing del VFP (solo SQL Server y Oracle :-( ) , el Access (con mucho cuidado ;-) ) u otra herramienta especifica para estos menesteres.

Luis Rey García
Advanced & Frontdata Systems, S.L.

23 de mayo de 2001

OBTENER UN CAMPO AUTOINCREMENTAL

Supongo que muchos programadores utilizaran en sus bases de datos campos Autoincrementales, y más de uno habrá tenido problemas a la hora de saber que es lo que acaba de insertar.

Buenas noticias:
En la mayoría de las DBS existen unas variables globales que guardan el ultimo valor añadido a una columna Autoincremental.

Malas noticias:
Las variables de los autoincrementales no son las mismas para diferentes DBS.
El proceso en el que intervenga un campo autoincremental es un poco manual

Tres pasos:
Establecer las transacciones a MANUALES
= SQLSetProp(THIS.nConn, "Transactions", 2)
Insertamos la fila.
VL_C_SQL = “INSERT NIVEL ( DESCR ) VALUES ( “ + THISFORM.DESCR.VALUE + “ )”
IF SQLExec(THIS.nConn, VL_C_SQL) 
   THIS.GetLastError
   = SQLRollBack(THIS.nConn)
   Return -1
ENDIF
Obtenemos el autoincremental
VL_C_SQL = “SELECT @@IDENTITY””
IF SQLExec(THIS.nConn, VL_C_SQL, “CX_SERIAL”)
   THIS.GetLastError
   =SQLRollBack(THIS.nConn)
   Return –1
ENDIF

THIS.Serial = CX_SERIAL.exp

Este código esta sacado de su contexto habitual, espero que os aclare las dudas.

Pablo Roca

15 de mayo de 2001

Calcula el factorial de un número

Función recursiva para calcular el factorial de un número
*************************************
* Funcion recursiva para calcular el factorial de un numero
* para todo N en los naturales > 0
* Forma de Uso: ? Factorial(cb) 
*
* Autor: Ramón Rodriguez Martinez
* e-mail cesa@ases.net.mx
* URL http://www.empresavirtual.com.mx
************************************
Function Factorial(Numero)
if Numero
    return 1
Else
    Numero=Numero*Factorial(Numero-1)
Endif
Return Numero
EndFunc

Ordena con QuickSort

Funcion recursiva para ordenar arrays por el método de QuickSort

**************************************
* Funcion recursiva para ordenar arrays por el método de QuickSort
* L es el límite inferior del arreglo y R el limite superior
* o lo que es lo mismo L es la parte izquirda de la particion y R la derecha
*
* Se utiliza A como una variable privada previamente definida 
* Ejemlo de uso
*
*Dimension a[3]
*A[1]=5
*A[2]=4
*A[3]=3
*qsort(1,3)
*?A[1],A[2],a[3]
*
* Autor: Ramón Rodriguez Martinez
**************************************
procedure qSort(l, r)
Local   i, j, x, y
 i = l
 j = r
 x = a[Int((l+r)/2)]
 Do While i < j
     Do while a[i] < x
      i = i + 1
     EndDo
     Do while x < a[j]
      j = j - 1
     EndDo
     if i <= j then
        y = a[i]
        a[i] = a[j]
        a[j] = y
        i = i + 1
        j = j - 1
     endIf
   EndDo
   if l < j then
    qSort(l, j)
   endif
   if i < r then
    qSort(i, r)
   endif
endProc
Ramón Rodriguez Martinez

19 de abril de 2001

Limitar un campo memo

Para limitar la entrada de un campo memo a X lineas, simplemente hay que poner en el keypress lo siguiente:

LPARAMETERS nKeyCode, nShiftAltCtrl
IF nkeycode = 13
   IF OCCURS(chr(13),this.value) >=5
      NODEFAULT
   ENDIF
ENDIF

En este ejemplo se limita a 6 lineas.

Pablo Roca

18 de abril de 2001

Desconectar una unidad de red con WSH

Desconectar una unidad de red con Microsoft Windows Script Host

o = CREATEOBJECT('Wscript.Network')
* o.RemoveNetworkDrive(Unidad)
o.RemoveNetworkDrive("Z:")
Luis María Guayán

6 de abril de 2001

Seleccionar un numero aleatorio

Como saben tenemos la función del RAND() para obtener un resultado entre cero y uno, pero que pasa con aquellas personas que desean generar un numero aleatorio entre dos números dados?

Aquí tienen una pequeña muestra de como generar un numero aleatorio partiendo de dos números dados y usando la función RAND()

Ejemplo:
? damenumaleatorio(10,99)
*---------------------------
FUNCTION damenumaleatorio
   PARAMETERS primero, segundo
   RAND(-1)
   RETURN INT((segundo - primero + 1) ;
      * RAND() + primero)
ENDFUNC
*---------------------------

Nota del editor: Para que los valores retornados por la función RAND() sean lo mas aleatorio posible tener en cuenta la ayuda de la función en la documentación de Visual FoxPro:

Sintaxis:

RAND([nSeedValue])

Parámetros

nSeedValue: Especifica el valor Seed que determina la secuencia de valores que devuelve RAND().
RAND() devuelve la misma secuencia de números aleatorios si utiliza el mismo valor Seed para nSeedValue la primera vez que ejecuta la función RAND(), seguida de llamadas posteriores a la función RAND() sin nSeedValue.

Si nSeedValue es negativo la primera vez que ejecuta RAND(), se usará un valor Seed a partir del reloj del sistema. Para obtener la serie más aleatoria de números, utilice inicialmente RAND() con un argumento negativo y después, ejecute RAND() sin ningún argumento.

Si omite nSeedValue, RAND() utilizará de forma predeterminada el valor Seed 100.001.

5 de abril de 2001

Cargar en un array las palabras de una cadena

Podemos cortar una cadena en palabras y cargarlas en un array de "n" posiciones, donde "n" es el número de palabras contenidas en la cadena.
lc = "Bienvenidos a Visual FoxPro"
ln = ALINES(la, STRTRAN(ALLTRIM(lc), " ", chr(13)))
FOR i = 1 TO ln
    ? la(i)
ENDFOR
Luis María Guayán

3 de abril de 2001

Convertir una variable DATE() a caracter no ambiguo

Con la función DtoCNA() (Date to Caracter no ambiguo) podemos convertir una fecha a una cadena no ambigua para su lectura o impresión.

Ejemplo:
*--- Español en formato largo y Separador "-"
? DTOCNA({07/10/2000}, "E", "L", "-")
   -> 07-OCT-2000

*--- Alemán en formato corto y Separador "/"
? DTOCNA({07/10/2000}, "A", "C", "/")
   -> 07/OKT/00
*-----------------------------------------------------------------
* FUNCTION DTOCNA(tdFecha, tcLeng, tcLong, tcSep)
*-----------------------------------------------------------------
* Date TO Caracter No Ambiguo
* PARAMETROS:
*  tdFecha: Fecha a convertir. Default = DATE()
*  tcLeng:
*    [E]spañol [I]nglés [F]rancés [A]lemán
*    i[T]aliano [P]ortugués
*  tcLong:
*    [L]argo: 12 ENE 2000 ó [C]orto: 01 ENE 00
*  tcSep:
*    Caracter separador del dia-mes-año. Default = " "
*    Si tcSep = .NULL. no tiene separador
* RETORNO: Caracter
* USO: ? DTOCNA({01/01/1999}, "I", "C", "-") -> 01-JAN-99
* AUTOR: LMG - 2000/06/15
*-----------------------------------------------------------------
FUNCTION DTOCNA(tdFecha, tcLeng, tcLong, tcSep)
  LOCAL lcMes, lnI
  IF EMPTY(tdFecha) OR NOT VARTYPE(tdFecha) $ "DT"
    tdFecha = DATE()
  ENDIF
  IF EMPTY(tcLeng) OR NOT UPPER(tcLeng) $ "EIFATP"
    tcLeng = "E"
  ELSE
    tcLeng = UPPER(tcLeng)
  ENDIF
  IF EMPTY(tcLong) OR NOT UPPER(tcLong) $ "CL"
    tcLong = "L"
  ELSE
    tcLong = UPPER(tcLong)
  ENDIF
  IF EMPTY(tcSep)
    tcSep = " "
  ELSE
    IF ISNULL(tcSep)
      tcSep = ""
    ENDIF
  ENDIF
  lnI = (MONTH(tdFecha)* 3) - 2
  DO CASE
    CASE tcLeng = "E"
      lcMes = SUBS("ENEFEBMARABRMAYJUNJULAGOSETOCTNOVDIC", lnI, 3)
    CASE tcLeng = "I"
      lcMes = SUBS("JANFEBMARAPRMAYJUNJULAUGSEPOCTNOVDEC", lnI, 3)
    CASE tcLeng = "F"
      lcMes = SUBS("JANFEVMARAVRMAIJUNJULAOUSEPOCTNOVDEC", lnI, 3)
    CASE tcLeng = "A"
      lcMes = SUBS("JANFEBMARAPRMAIJUNJULAUGSEPOKTNOVDEZ", lnI, 3)
    CASE tcLeng = "T"
      lcMes = SUBS("GENFEBMARAPRMAGGIULUGAGOSETOTTNOVDIC", lnI, 3)
    CASE tcLeng = "P"
      lcMes = SUBS("JANFEVMARABRMAIJUNJULAGOSETOUTNOVDEZ", lnI, 3)
  ENDCASE
  RETURN TRAN(DAY(tdFecha), "@L 99") + tcSep + lcMes + tcSep + ;
    IIF(tcLong = "L", TRAN(YEAR(tdFecha), "@L 9999"), ;
    TRAN(YEAR(tdFecha) % 100, "@L 99"))
ENDFUNC

*-----------------------------------------------------------------
Luis María Guayán

Diferencia en días, horas, minutos y segundos de dos variables DATETIME()

Rutina para calcular la diferencia entre dos variables DATETIME() y retornar una cadena en DIAS, HORAS, MINUTOS y SEGUNDOS.
*-----------------------------
* FUNCTION Dif_DHMS(ttIni,ttFin)
*-----------------------------
* Calcula la diferencia de dos variables
* DATETIME y retorna en formato
* ### Días, ## Horas, ## Minutos, ## Segundos
*-----------------------------
FUNCTION Dif_DHMS(ttIni,ttFin)
  LOCAL ln, lnDia, lnHor, lnMin, lnSeg
  IF EMPTY(ttFin)
    ttFin = DATETIME()
  ENDIF
  ln = ttFin - ttIni
  lnSeg = MOD(ln,60)
  ln = INT(ln/60)
  lnMin = MOD(ln,60)
  ln = INT(ln/60)
  lnHor = MOD(ln,24)
  lnDia = INT(ln/24)
  RETURN ALLTRIM(STR(lnDia))+ " Días, "+ ;
    TRAN(lnHor, "@L 99")+ " Horas, "+ ;
    TRAN(lnMin, "@L 99")+ " Minutos, "+ ;
    TRAN(lnSeg, "@L 99")+ " Segundos"
ENDFUNC
*-----------------------------
Luis María Guayán

Ventana de LOGIN

Con la clase Login podemos tener facilmente un control de acceso a nuestras aplicaciones.

Ejemplo

IF _Login(1)
  MESSAGEBOX("Usuario autenticado OK.",64,"Login")
ELSE
   *-- Usuario no válido
   RETURN
ENDIF

* ----------------------------------------
* Function _Login( lnNivel, lnNivelSup)
* ----------------------------------------
* Funcion que muestra el form de LOGIN
* Parámetros:
*     lnNivel [opc] - Nivel autorizado.
*     si se omite permite cualquier 
*     usuario registrado
* ----------------------------------------
FUNCTION _Login( lnNivel, lnNivelSup)
  LOCAL llRet
  IF PARAMETERS() < 1
    lnNivel = 0
  ENDIF
  IF PARAMETERS() < 2
    lnNivelSup = 10
  ENDIF
  loForm = CREATEOBJECT("Login", lnNivel, lnNivelSup)
  loForm.SHOW()
  llRet = loForm.lRetorno
  RELEASE loForm
  loForm = .NULL.
  RETURN llRet
ENDFUNC
* ----------------------------------------
*-- Class:        Login
*-- Ingreso de password
* ----------------------------------------
DEFINE CLASS Login AS FORM
  HEIGHT = 110
  WIDTH = 220
  DOCREATE = .T.
  AUTOCENTER = .T.
  BORDERSTYLE = 2
  CAPTION = "Ingrese usuario y contraseña"
  CONTROLBOX = .F.
  CLOSABLE = .F.
  MAXBUTTON = .F.
  MINBUTTON = .F.
  WINDOWTYPE = 1
  *-- Nivel inferior de acceso
  nNivelInf = -1
  *-- Nivel superior de acceso
  nNivelSup = -1
  *-- Numero de intentos de validacion
  nIntentos = -1
  NAME = "Login"
  *-- retorna .T. si el usuario y contraseña son correctos
  lRetorno = .F.
  ADD OBJECT cmdaceptar AS COMMANDBUTTON WITH ;
    TOP = 72, LEFT = 48, HEIGHT = 25, WIDTH = 72, ;
    FONTNAME = "MS Sans Serif", FONTSIZE = 8, ;
    CAPTION = "Aceptar", DEFAULT = .T., ;
    TABINDEX = 5, NAME = "cmdAceptar"
  ADD OBJECT cmdcancelar AS COMMANDBUTTON WITH ;
    TOP = 72, LEFT = 133, HEIGHT = 25, WIDTH = 72, ;
    FONTNAME = "MS Sans Serif", ;
    FONTSIZE = 8, CANCEL = .T., ;
    CAPTION = "Cancelar", ;
    TABINDEX = 6, NAME = "cmdCancelar"
  ADD OBJECT lblusuario AS LABEL WITH ;
    FONTNAME = "MS Sans Serif", FONTSIZE = 8, ;
    ALIGNMENT = 1, BACKSTYLE = 0, CAPTION = "Usuario", ;
    HEIGHT = 15, LEFT = 12, TOP = 16, WIDTH = 60, ;
    TABINDEX = 2, NAME = "lblUsuario"
  ADD OBJECT lblcontrasena AS LABEL WITH ;
    FONTNAME = "MS Sans Serif", FONTSIZE = 8, ;
    ALIGNMENT = 1, BACKSTYLE = 0, CAPTION = "Contraseña", ;
    HEIGHT = 15, LEFT = 12, TOP = 40, WIDTH = 60, ;
    TABINDEX = 4, NAME = "lblContrasena"
  ADD OBJECT txtusuario AS TEXTBOX WITH ;
    FONTNAME = "MS Sans Serif", FONTSIZE = 8, ;
    FORMAT = "k", HEIGHT = 21, ;
    LEFT = 85, MAXLENGTH = 15, ;
    TABINDEX = 1, TOP = 12, ;
    WIDTH = 120, NAME = "txtUsuario"
  ADD OBJECT txtcontrasena AS TEXTBOX WITH ;
    FONTNAME = "MS Sans Serif", FONTSIZE = 8, ;
    FORMAT = "k", HEIGHT = 21, ;
    LEFT = 85, MAXLENGTH = 15, ;
    TABINDEX = 3, TOP = 36, ;
    WIDTH = 120, PASSWORDCHAR = "*", ;
    NAME = "txtContrasena"
  PROCEDURE validausuario
    LPARAMETERS tcUsuario, tcContrasena, tnNivelInf, tnNivelSup
    LOCAL lcUser, lcPass, lnNivel
    *--- pasa usuario a mayuscula
    tcUsuario = ALLTRIM(UPPER(tcUsuario))
    tcContrasena = ALLTRIM(tcContrasena)
    *-----------------------------
    *--- Aqui busco los datos del usuario
    *--- en la tabla de Usuarios
    *-----------------------------
    lcUser = "LUIS"
    lcPass = "siul"
    lnNivel = 5
    *-----------------------------
    *--- valido usuario y contraseña
    IF NOT (tcUsuario == lcUser ;
        AND tcContrasena == lcPass)
      *--- No existe usuario o Contraseña no válida
      =MESSAGEBOX('Usuario o contraseña inválida',48,'Advertencia')
      RETURN .F.
    ENDI
    IF NOT BETWEEN(lnNivel, tnNivelInf, tnNivelSup)
      *--- Nivel no autorizado
      =MESSAGEBOX('Usuario no autorizado para este módulo',48,'Advertencia')
      RETURN .F.
    ENDI
    *--- Todo correcto
    RETURN .T.
  ENDPROC
  PROCEDURE UNLOAD
    RETURN THISFORM.lRetorno
  ENDPROC
  PROCEDURE INIT
    LPARAMETERS tnNivelInf, tnNivelSup
    IF PARAMETERS() < 0
      tnNivelInf = 0
    ENDIF
    IF PARAMETERS() < 1
      tnNivelSup = 10
    ENDIF
    THISFORM.nIntentos = 0
    THISFORM.nNivelInf = tnNivelInf
    THISFORM.nNivelSup = tnNivelSup
    THISFORM.txtUsuario.SETFOCUS
    THISFORM.cmdAceptar.DEFAULT = .T.   && porque lo pierde en el SetFocus
  ENDPROC
  PROCEDURE cmdaceptar.CLICK
    THISFORM.nIntentos=THISFORM.nIntentos+1
    THISFORM.lRetorno=THISFORM.ValidaUsuario( ;
      THISFORM.txtUsuario.VALUE, ;
      THISFORM.txtContrasena.VALUE, ;
      THISFORM.nNivelInf, THISFORM.nNivelSup)
    IF THISFORM.lRetorno
      THISFORM.HIDE
    ELSE
      IF THISFORM.nIntentos < 3 
        IF EMPTY(THISFORM.txtUsuario.VALUE)
          THISFORM.txtUsuario.SETFOCUS
        ELSE
          THISFORM.txtContrasena.SETFOCUS
        ENDI
      ELSE
        =MESSAGEBOX('Acceso denegado',16,'Advertencia')
        THISFORM.HIDE
      ENDI
    ENDI
  ENDPROC
  PROCEDURE cmdcancelar.CLICK
    THISFORM.lRetorno=.F.
    THISFORM.HIDE
  ENDPROC
ENDDEFINE
* ----------------------------------------
*-- EndDefine: Login
* ----------------------------------------
Luis María Guayán

Buscar si Word o Excel están instalados

Con estas dos funciones podemos saber si Word ® o Excel ® están instalados en la PC.

*----------------------------------------------------
* FUNCTION BuscaWord
* Busca si MS Word está instalado en la PC
*----------------------------------------------------
FUNCTION BuscaWord
  LOCAL lcErrorAnt, loApp, CR
  CR = CHR(13)
  lcErrorAnt = ON("ERROR")
  ON ERROR DO _MiError
  loApp = CREATEOBJECT("Word.Application")
  IF VARTYPE(loApp) = "O"
    MESSAGEBOX("Nombre: " + loApp.NAME + CR + ;
      "Versión: " + loApp.VERSION + CR + ;
      "Build: " + TRANSFORM(loApp.BUILD), 64 )
    RELEASE loApp
  ELSE
    MESSAGEBOX("Word no está instalado", 16)
  ENDIF
  ON ERROR &lcErrorAnt
  RETURN
ENDFUNC

*----------------------------------------------------
* FUNCTION BuscaExcel
* Busca si MS Excel está instalado en la PC
*----------------------------------------------------
FUNCTION BuscaExcel
  LOCAL lcErrorAnt, loApp, CR
  CR = CHR(13)
  lcErrorAnt = ON("ERROR")
  ON ERROR DO _MiError
  loApp = CREATEOBJECT("Excel.Application")
  IF VARTYPE(loApp) = "O"
    MESSAGEBOX("Nombre: " + loApp.NAME + CR + ;
      "Versión: " + loApp.VERSION + CR + ;
      "Build: " + TRANSFORM(loApp.BUILD), 64 )
    RELEASE loApp
  ELSE
    MESSAGEBOX("Word no está instalado", 16)
  ENDIF
  ON ERROR &lcErrorAnt
  RETURN
ENDFUNC

*----------------------------------------------------
* PROCEDURE _MiError
* Usado por BuscaWord y BuscaExcel
*----------------------------------------------------
PROCEDURE _MiError
  RETURN
ENDPROC
*----------------------------------------------------

Luis María Guayán

29 de marzo de 2001

Búsqueda de paréntesis en la ventana activa

Problemática:

¿Quién no ha tenido alguna vez que encontrar en un programa el paréntesis cerrado asociado a un paréntesis abierto? Esta utilidad intenta dar solución a este problema.

Descripción:

Búsqueda del token asociado (que denominaremos "Pareado") al token seleccionado en la ventana activa.

Con el símil de la problemática, el token seleccionado sería el paréntesis abierto y el pareado el paréntesis cerrado.

Restricciones:

(R1) El token seleccionado sólo puede ser un carácter.
(R2) La correspondencia entre token seleccionado y su pareado está fija en el programa, restringiéndose a la siguiente:
'(' ')'
'[' ']'
(R3) El token seleccionado es siempre el carácter situado a la derecha del cursor.
(R4) Si se encuentra el Pareado, el cursor se situará a la izquierda del mismo.

Se cree conveniente esta forma porque las ejecuciones sucesivas, sin mover el cursor, siempre nos llevan a los mismos pareados.

Condicionantes:

(C1) Necesidad de enviar resultado a una ventana.
Aunque resulte curioso, si no se envía ningún resultado a otra ventana, ya sea la ventana principal de Visual FoxPro o una ventana activa definida por el usuario, el programa tarda mucho más en ejecutarse. No he logrado averiguar este extraño comportamiento. En la versión actual, por cada carácter procesado se escribe, en esa ventana, un único carácter (que se asemeja a un molino en movimiento [recuerdo de viejos tiempos ;)]) en la columna 1 y siempre en la misma línea.

(C2) Determinar condición de principio/fin de archivo por número de caracteres repetidos.
Al llegar el principio o fin del archivo en la ventana en la que hacemos la búsqueda, dado que el cursor no puede ir más allá, siemre se lee el mismo carácter (el primero o el último).
Ante la imposibilidad de determinar cuándo se ha llegado al principio o al final del archivo, se establece como heurística para que se cumpla dicha condición la lectura de un mismo carácter un número determinado de veces (véase parámetro).

(C3) Obtención de caracteres retrasada.
En cada ejecución del programa se obtiene como primer carácter el último carácter procesado en la ejecución anterior. Este extraño suceso que no me explico (¿quizá esté haciendo algo mal?) se ha solventado asignando al portapapeles (variable del sistema _CLIPTEXT) un carácter especial (CHR(255)).

Parámetros:

(P1) tnNumMaxCaracteresRepetidos (e) : Número de veces que se debe leer un mismo carácter para establecer la condición de princpio/fin de archivo. (véase (C2)).
Valor predeterminado: 100.

(P2) tlDebug (e) : Establece el programa en modo depuración para mostrar trazas.
.T. : Modo depuración.
.F. : Modo normal (Valor predeterminado).
(P3) tlCrearVentanaSalida (e) : Necesario por (C1).
.T. : Resultados a una ventana que crea el programa.
.F. : Resultados a la ventana principal de Visual FoxPro (Valor predeterminado).

Uso:

Para un uso cómodo se puede asociar a una combinación de teclas, como por ejemplo:
ON KEY LABEL ALT+8 DO "BuscarPareado"
* ON KEY LABEL ALT+8 DO "D:\JavierValero\vfp\Experimentos\Proyecto\Pruebas\progs\BuscarPareado" WITH 50,.F.,.F.

Así, para una ejecución correcta, situar el cursor a la derecha de un carácter '(' o ')' y pulsar ALT+8, y el cursor se nos situaría en su paréntesis asociado.

Bugs:

(BUG1) Por la heurística adoptada en (C2), el programa puede devolver una búsqueda insatisfactoria en ciertos casos. Por ejemplo, es muy común poner comentarios incluyendo muchos '*'. Si el par de tokens asociados se encuentra entre líneas de ese tipo y el parámetro es muy pequeño, el programa puede devolver que se ha llegado al principio/fin de archivo cuando no es cierto. Para evitar esto, habría que aumentar el valor del parámetro mencionado.

(BUG2) Por el criterio adoptado en (C3) si el carácter en la ventana de búsqueda

Mejoras:

- No limitar los token a caracteres sino a palabras, para que así se puedan encontrar los IF-ENDIF, DO WHILE-ENDDO, ...

**************************************
* BuscarPareado.prg
**************************************
* Autor: JVA
* Versión: 1.0
* Fecha creación: 27/03/2001
* Modificaciones realizadas: Ninguna
* Notas: Debido a la inexperiencia del autor,
* puede que haya conceptos mal
* interpretados de Visual FoxPro y
* además puede que parte del apartado
* de  'Condicionantes:' sea erróneo.
**************************************
LPARAMETERS tnNumMaxCaracteresRepetidos, tlDebug, tlCrearVentanaSalida

PRIVATE ALL

* Para simular un molinillo en movimiento cuando 
* el programa está en ejecución

#DEFINE MOLINILLO "|/-"
#DEFINE MOLINILLO_NUM_CARACTERES 20
#DEFINE MOLINILLO REPLICATE("|",5) + ;
  REPLICATE("/",5) + REPLICATE("-",5) + ;
  REPLICATE("",5)

* Dirección de exploración en la ventana de 
* búsqueda: hacia la derecha o la izquierda
#DEFINE DIRECCION_DERECHA "D"
#DEFINE DIRECCION_IZQUIERDA "I"

* Valores predeterminados para los parámetros
#DEFINE DEFECTO_NUM_MAX_CARACTERES_REPETIDOS 100
#DEFINE DEFECTO_DEBUG .F.
#DEFINE DEFECTO_VENTANA .F.

* Condicionante (C3): Carácter especial para el portapapeles
#DEFINE CARACTER_EN_PORTAPAPELES  CHR(255)

* Declaración de una variable como privada.
#DEFINE PRIVATE_DECL

* (C2) Número de caracteres repetidos para 
* determinar condición principio/fin de archivo
LOCAL lnNumMaxCaracteresRepetidos

* Carácter seleccionado por el usuario para 
* buscar su pareado.

* Se coge el carácter a la derecha del cursor.
LOCAL lcCaracterSeleccionado

* Carácter pareado del .
LOCAL lcCaracterPareado

* Indica si debemos ir cogiendo caracteres 
* hacia la izquierda o la derecha.
LOCAL lcDireccion

* Retorno de procedimientos
LOCAL llRetorno

* Programa en depuración
* Si .T. se muestran trazas en la ventana activa
LOCAL llDebug

* Crear ventana de salida para enviar los resultados
LOCAL llCrearVentanaSalida

* Para restaurar el antiguo valor de SET TYPEAHEAD
LOCAL lcOldTypeAhead

* Para restaurar el antiguo valor de SET STATUS BAR
LOCAL lcSetStatusBar

* Indice para mostrar el molinillo en movimiento
PRIVATE_DECL pnMolinillo = 0

lcSetStatusBar = SET("STATUS BAR")
IF lcSetStatusBar = "OFF"
   SET STATUS BAR ON
ENDIF

* Valores predeterminados
lnNumMaxCaracteresRepetidos = DEFECTO_NUM_MAX_CARACTERES_REPETIDOS
llDebug = DEFECTO_DEBUG
llCrearVentanaSalida = DEFECTO_VENTANA

*
*  Procesar parámetros
*

IF (PCOUNT() > 0)
   IF (UPPER(VARTYPE(tnNumMaxCaracteresRepetidos)) = 'N')
      lnNumMaxCaracteresRepetidos = tnNumMaxCaracteresRepetidos
   ENDIF
ENDIF

IF (PCOUNT() > 1)
   IF (UPPER(VARTYPE(tlDebug)) = 'L')
      llDebug = tlDebug
   ENDIF
ENDIF

IF (PCOUNT() > 2)
   IF (UPPER(VARTYPE(tlCrearVentanaSalida)) = 'L')
      llCrearVentanaSalida = tlCrearVentanaSalida
   ENDIF
ENDIF

IF (llDebug=.T.)
   CLEAR
ENDIF

* Si TYPEAHEAD = cero, no funciona el programa
lcOldTypeAhead = STR(SET('TYPEAHEAD'))
SET TYPEAHEAD TO 20

* Ventana donde se envían los resultados (C1)LOCAL lcNombreVentanaSalida   

* Nombre de la ventana de búsqueda
LOCAL lcVentanaBusqueda 

IF ( llCrearVentanaSalida = .T.)
   lcNombreVentanaSalida = "W_TMP" + SYS(3)
   DO WHILE (WEXIST(lcNombreVentanaSalida) = .T.)
      lcNombreVentanaSalida = "W_TMP" + SYS(3)
   ENDDO
   lcVentanaBusqueda = WTITLE()
   DEFINE WINDOW (lcNombreVentanaSalida) FROM 1,1 TO 2,2 CLOSE FLOAT
   ACTIVATE WINDOW (lcNombreVentanaSalida)
   ACTIVATE WINDOW (lcVentanaBusqueda)
ENDIF

_CLIPTEXT = CARACTER_EN_PORTAPAPELES

* Coger el carácter a la derecha del cursor (R3)
lcCaracterSeleccionado = Caracter DIRECCION_DERECHA)

* Condicionante (C3)

DO WHILE (lcCaracterSeleccionado == CARACTER_EN_PORTAPAPELES)

   lcCaracterSeleccionado = Caracter(DIRECCION_DERECHA)
ENDDO

IF (llDebug=.T.)
? "Carácter seleccionado=[" + lcCaracterSeleccionado + "]"
ENDIF

* Obtener el Pareado del carácter Seleccionado
llRetorno = CaracterPareado(lcCaracterSeleccionado, @lcCaracterPareado, @lcDireccion)

IF (llRetorno = .F.)
   SET MESSAGE TO 'Se desconoce el pareado para el carácter [' + lcCaracterSeleccionado + ']'
   RETURN .F.
ELSE
   SET MESSAGE TO "Buscando pareado " + lcCaracterPareado + " ..."
ENDIF

IF (llDebug=.T.)
   ?? "   Carácter pareado=[" + lcCaracterPareado + "]"
   ? ""
ENDIF

IF (lcDireccion = DIRECCION_IZQUIERDA)
   * Nos quedamos en la posición original
   Caracter(DIRECCION_IZQUIERDA)
ELSE  
   * Nada, o entonces volveríamos a leer el 
   * mismo carácter pareado.
ENDIF

* Número de Pareados encontrados, para tratar 
* la anidación de pareados
LOCAL lnNumPareados 

* Número de veces que se repite un mismo carácter
LOCAL lnNumCaracteresRepetidos  

* Último carácter leído
LOCAL lcCaracter 

* Para comparar si se repite un carácter
LOCAL lcOldCaracter 

lnNumPareados = 0  
lnNumCaracteresRepetidos = 0 
lcOldCaracter = CARACTER_EN_PORTAPAPELES 

* Condicionante (C2)
DO WHILE ( (lnNumCaracteresRepetidos(lnNumPareados >= 0) )
   lcCaracter = Caracter(lcDireccion)
   *
   * Tratar la anidación de los Pareados
   *
   * Anidamos pareado
   IF (lcCaracter == lcCaracterSeleccionado)
      lnNumPareados = lnNumPareados + 1
   ENDIF
   
   * Desanidamos pareado
   IF (lcCaracter == lcCaracterPareado)
      lnNumPareados = lnNumPareados - 1
   ENDIF

   IF (llDebug=.T.)
      ?? "NumPareados=" + STR(lnNumPareados) + "  "
   ENDIF

   *
   * Tratar la condición de principio/fin de archivo
   * mediante el reconocimiento de la repetición 
   * del mismo carácter.
   *
   IF (lcCaracter == lcOldCaracter)
      lnNumCaracteresRepetidos = lnNumCaracteresRepetidos + 1
   ELSE
      lnNumCaracteresRepetidos = 0
   ENDIF

   lcOldCaracter = lcCaracter
   
   IF (llDebug = .T.)
      ? lcCaracter + " ASC=" + ALLTRIM(STR(ASC(lcCaracter))) AT 1
   ENDIF
ENDDO

IF ((lnNumPareados 

   * Nos hemos pasado un carácter
   Caracter(DIRECCION_IZQUIERDA)
ELSE
   * Nada, o entonces volveríamos a leer el 
   * mismo carácter pareado
ENDIF

IF (lcCaracter == lcCaracterPareado)
   SET MESSAGE TO "Encontrado " + lcCaracterPareado + "."
ELSE
   IF (lcDireccion == DIRECCION_DERECHA)
      SET MESSAGE TO "No se encuentra " + lcCaracterPareado + ". Se llegó al final del archivo."
   ELSE
      SET MESSAGE TO "No se encuentra " + lcCaracterPareado + ". Se llegó al principio del archivo."
   ENDIF
ENDIF

IF ( llCrearVentanaSalida = .T.)
   RELEASE WINDOW (lcNombreVentanaSalida)
ENDIF

_CLIPTEXT = CARACTER_EN_PORTAPAPELES

*
* Restaurar entorno
*
SET TYPEAHEAD TO &lcOldTypeAhead
IF lcSetStatusBar = "OFF"
   SET STATUS BAR OFF
ENDIF

?? "." AT 1
* SET MESSAGE TO

RETURN .T.

****************
PROCEDURE Caracter
****************
LPARAMETERS tcDireccion
LOCAL lcC

IF (tcDireccion = DIRECCION_DERECHA)
   KEYBOARD '{SHIFT+RIGHTARROW}{CTRL+C}' PLAIN CLEAR
   KEYBOARD '{RIGHTARROW}' PLAIN
ELSE
   KEYBOARD '{SHIFT+LEFTARROW}{CTRL+C}' PLAIN CLEAR
   KEYBOARD '{LEFTARROW}' PLAIN
ENDIF

DOEVENTS

*
* Condicionante (C1)
*
?? SUBSTR(MOLINILLO, pnMolinillo+1, 1) AT 1
pnMolinillo = (pnMolinillo + 1) % 40

lcC = substr(_cliptext,1,1)
return lcC
ENDPROC  && Caracter

****************
PROCEDURE CaracterPareado
****************
LPARAMETERS tcCaracterBuscar, tcCaracterPareado, tcDireccion
* !!! Pasar los dos últimos por referencia !!!

LOCAL llRetorno, lnPosicion
LOCAL DIMENSION aPareadosBeg[2]
LOCAL DIMENSION aPareadosEnd[2]
aPareadosBeg[1] = '('
aPareadosEnd[1] = ')'
aPareadosBeg[2] = '['
aPareadosEnd[2] = ']'

llRetorno = .T.  && Suponemos que sí está
lnPosicion = ASCAN(aPareadosBeg,tcCaracterBuscar)

IF (lnPosicion != 0)
   tcCaracterPareado = aPareadosEnd[lnPosicion]
   tcDireccion = DIRECCION_DERECHA
ELSE
   lnPosicion = ASCAN(aPareadosEnd,tcCaracterBuscar)
   IF ( lnPosicion != 0)
      tcCaracterPareado = aPareadosBeg[lnPosicion]
      tcDireccion = DIRECCION_IZQUIERDA
   ELSE
      llRetorno = .F.
   ENDIF
ENDIF

RETURN llRetorno

ENDPROC  && CaracterPareado

****************
Javier Valero