30 de diciembre de 2003

Validar RUC (Registro Único de Contribuyentes de Perú)

Con esta rutina podemos validar el RUC (Registro Único de Contribuyentes) emitido por la SUNAT (Superintendencia Nacional de Administración Tributaria).

Solo para Perú.
? ValidRucSunat("20372706288")

FUNCTION ValidRucSunat(lcNroRuc)
  IF LEN(ALLTRIM(lcNroRuc)) <> 11 THEN
    RETURN .F.
  ENDIF
  LOCAL aArrayRuc
  DIMENSION aArrayRuc(3,11)
  FOR i = 1 TO 11
    aArrayRuc(1,i)=VAL(SUBS(lcNroRuc,i,1))
  ENDFOR
  aArrayRuc(2,1)=5
  aArrayRuc(2,2)=4
  aArrayRuc(2,3)=3
  aArrayRuc(2,4)=2
  aArrayRuc(2,5)=7
  aArrayRuc(2,6)=6
  aArrayRuc(2,7)=5
  aArrayRuc(2,8)=4
  aArrayRuc(2,9)=3
  aArrayRuc(2,10)=2
  aArrayRuc(3,11)=0
  FOR i=1 TO 10
    aArrayRuc(3,i)  = aArrayRuc(1,i)  * aArrayRuc(2,i)
    aArrayRuc(3,11) = aArrayRuc(3,11) + aArrayRuc(3,i)
  ENDFOR
  lnResiduo   = MOD(aArrayRuc(3,11),11)
  lnUltDigito = 11 - lnResiduo
  DO CASE
    CASE lnUltDigito = 11 OR lnUltDigito=1
      lnUltDigito = 1
    CASE lnUltDigito = 10 OR lnUltDigito=0
      lnUltDigito = 0
  ENDCASE
  IF lnUltDigito = aArrayRuc(1,11) THEN
    RETURN .T.
  ELSE
    RETURN .F.
  ENDIF
ENDFUNC
Saludos.....

NavaSoft S.A.C.

7 de diciembre de 2003

La importancia de las rutas en VFP

Artículo original: The importance of Paths in VFP
http://weblogs.foxite.com/andykramek/archive/2005/03/21/197.aspx
Autor:Andy Kramek
Traducido por: Ana María Bisbé York


Uno de los problemas que he visto con mayor frecuencia en los foros es cómo trabaja VFP con los archivos. Sobre este punto el Administrador de proyectos es una bendición y una maldición, ambas cosas. Una bendición porque, una vez que trabajamos desde el Administrador de proyecto, el controla por nosotros los aspectos relacionados con encontrar y abrir archivos . Una maldición, porque somos de la tendencia a olvidar que VFP requiere internamente de rutas. Una pregunta frecuente es algo así:

Cuando llamo desde el Administrador de programas mi formulario abre sus tablas; pero si lo hago por programa, me abre el cuadro de diálogo Buscar. ¿Qué está mal?

La respuesta es, por supuesto, que VFP no ha recibo la ruta de búsqueda. Aunque nunca lo he visto formalmente documentado, parece ser que VFP tiene un método muy estricto cuando se le pide encontrar algo. Por ejemplo al llamar a una función VFP verifica primero el programa que se está ejecutando actualmente, luego otros programas en memoria, luego el directorio actual, luego los directorios que están en su propia ruta de búsqueda y finalmente la ruta de búsqueda de Windows. De forma similar, cuando buscamos por un nombre de tabla con referencia incompleta (por ejemplo: USE account, a diferencia de USE C:\Myfiles\account.dbf), busca primero en la carpeta seleccionada actualmente, luego entre su propia ruta y finalmente en la ruta de búsqueda de Windows.

Vea que las carpetas de su propia ruta se verifican siempre antes que el nivel del sistema operativo. La importancia de esto es que cuando le asigna a VFP su propia ruta de búsqueda, buscará los archivos sin tener que ir a través del sistema operativo - claramente será mucho más eficiente ya que la ruta necesita incluir solamente aquellos lugares que son estrictamente relevantes para VFP.

El directorio predeterminado

En ausencia de cualquier otra información Visual FoxPro utiliza la unidad y el directorio actualmente seleccionados como su "ruta" y podrá restablecer esta configuración utilizando simplemente:

SET PATH TO

Sin embargo, para aplicaciones más sofisticadas, y ciertamente para el desarrollo, tendrá una estructura de directorios y debe establecer siempre la ruta de búsqueda adecuada que incluya todos los directorios requeridos. Lo primero que debe hacer es establecer el directorio predeterminado y existen varias formas (como siempre) para hacerlo:

  • Especificar Default en al Archivo de configuración (CONFIG) utilizando DEFAULT = <ruta al directorio>
  • Establecer la ruta predeterminada directamente en el código utilizando SET DEFAULT TO <ruta al directorio>
  • Cambiar de directorio interactivamente utilizando SET DEFAULT TO (GetDir()). (Los comandos 'CD' (o 'CHDIR') se pueden utilizar para cambiar tanto la unidad como el directorio a una localización especificada).

¡Ajá! LOCFILE() cambia la ruta.

Observe que utilizando las funciones "Get" o "Put" (ejemplo GetDir()) generalmente no cambia ni el directorio predeterminado ni la ruta. La excepción a esta regla es una característica aparentemente no documentada (en VFP) de la función LOCFILE() la que agrega la carpeta seleccionada a la ruta de búsqueda de VFP como muestra el siguiente código:

*** Limpia la ruta
SET PATH TO
? SET( 'path' ) && Devuelve nada
USE LOCFILE( 'account' )  && Localiza un archivo
? SET( 'path' ) && Devuelve C:\Projects\Data

Este comportamiento ha formado parte del lenguaje al menos desde FoxPro 2.6W y es interesante, está documentada en la Ayuda de FoxPro 2.6W de esta forma:

El diálogo Open (Abrir) puede ser utilizado para localizar un archivo. Al escoger un archivo del diálogo, se devuelve el nombre del archivo con la ruta, la cual es agregada a la ruta de FoxPro.

Sin embargo, parece que en la creación del fichero de ayuda de VFP la última frase se perdió y continúa perdida en el fichero de ayuda de VFP 9.0 (vea abajo), incluso, como podemos ver, este comportamiento aun se aplica.

El diálogo Open (Abrir) puede ser utilizado para localizar un archivo. Al escoger un archivo del diálogo, se devuelve el nombre del archivo con la ruta.

Utilizar el comando SET PATH

Establecer la ruta es de por sí, simple. Es necesario solamente utilizar el comando SET PATH seguido por la lista de directorios que desea incluir. No es necesario indicar las rutas enteras para los subdirectorios, es suficiente con separarlos por comas o puntos y comas. El ejemplo muestra una ruta de búsqueda típica en la ruta de Visual FoxPro.

SET PATH TO G:\VFP90;C:\VFP90\PROJECTS\;DATA;FORMS;LIBS;PROGS;UTILS

Para recuperar la configuración de la ruta actual, puede utilizar la función SET (que trabajará con la mayoría de los comandos SET de Visual FoxPro) como se muestra debajo. Puede asignar el resultado directamente a una variable o, como se muestra debajo, directamente al portapapeles para que pueda pegar la ruta actual en un programa o archivo de documentación:

_ClipText = SET('PATH')

Visual FoxPro permite el uso de ambas configuraciones UNC para nombrar rutas, como:

\\SERVERNAME\DIRECTORYNAME\

y permite el uso de espacios embebidos (cuando se encierran entre comillas)  en nombres de directorio como:

"..\COMMON DIRECTORY\"

Aunque, se permite el último caso, yo suscribo el principio de que "aunque puede utilizar espacios embebidos, el arsénico es más rápido" (a propósito, se aplica lo mismo para nombres de ficheros) Aunque mejoran lalegibilidad, los espacios pueden causar además problemas al tratar de controlar los nombres de archivos y los directorios por programa y pienso aun que el mejor consejo es evitar tanto como sea posible en las aplicaciones. Por ejemplo, el siguiente código trabaja perfectamente para nombres convencionales de directorios; pero falla si el directorio tiene espacios embebidos:

LOCAL lcDir
lcDir = GETDIR()
IF ! EMPTY(lcDir)
  SET DEFAULT TO &lcDir
ENDIF

VFP 9.0 introdujo la cláusula ADDITIVE al comando SET PATH para permitir que fragmentos de ruta sean agregados dinámicamente (interesantemente, es lo que  el LOCFILE() ya venía haciendo desde siempre)

Determinar la configuración actual

Afortunadamente, Visual FoxPro, nos brinda varias funciones que nos ayudan a localizar dónde nos encontramos en cada momento:

  • SYS(2004) devuelve el directorio desde el que se ha iniciado Visual FoxPro; pero en tiempo de ejecución en una aplicación distribuida., será siempre la localización de la DLL runtime (que es normalmente la versión adecuada del directorio 'System' de Window.
  • HOME() devuelve el directorio por defecto desde el que se ha iniciado Visual FoxPro; pero tiene varias opciones útiles adicionales.
  • _VFP.FULLNAME accede a la propiedad del objeto aplicación de Visual FoxPro que contiene la ruta entera y el nombre de fichero que fue utilizado para iniciar VFP.
  • FULLPATH('') o FULLPATH(CURDIR()) devuelve toda la unidad y la ruta del directorio actual (incluyendo la barra final "\")
  • SYS(5) devuelve la unidad predeterminada (incluyendo los dos puntos ":")
  • CD (trabaja solamente de forma interactiva en la ventana de comandos) muestra la unidad y carpeta actual en la ventana de salida actual - pero también cambia la unidad y el directorio, todo en un único comando.
  • CHDIR cambia la unidad o directorio especificado (igual que CD); pero no informa del estado actual (y no provoca desorden en sus formularios).
  • CURDIR() devuelve el directorio actual (con la barra final "\"); pero no la unidad.
  • SYS(2450) introducido en VFP 8.0 controla si una aplicación busca internamente antes de acceder a la ruta de búsqueda externa.

Establecer la ruta

Generalmente, yo utilizo el siguiente tipo de código en mis programas de inicio para asegurarme de que siempre tengo el conjunto de rutas apropiadas - tanto en tiempo de desarrollo como en la aplicación EXE compilada.

IF VERSION(2) = 0
  *** Inicio en tiempo de ejecución, solamente: Inicio de VFP  + Directorio actual + "\DATA" 
  lcPath = HOME() + ";" + ADDBS( FULLPATH( CURDIR() )) + "DATA"
ELSE
  *** Inicio en tiempo de diseño - toda la ruta del entorno de desarrollo
  lcPath = HOME() + ";" + ADDBS( FULLPATH( CURDIR() )) + ";FORMS;LIBS;DATA;PROGS;UTILS"
  *** Deseamos configurar asserts ON en modo de desarrollo
  SET ASSERTS ON
ENDIF
SET PATH TO (lcPath)

Vea que diferencia entre las rutas necesarias para el desarrollo y las rutas más simplificadas para la implementación en tiempo de ejecución.

25 de noviembre de 2003

Evitar el evento Valid al salir del formulario

Hay veces que deseamos que al salir del formulario no se active el evento Valid de cierto control...

Resulta que en ocasiones queremos que al presionar CTRL+F4 o haciendo clic en el botón Cerrar, no se active el evento Valid, imaginándonos que tal vez, dicho evento manda a llamar a algún proceso que consume tiempo, mismo que nuestros usuarios ven (y yo también) innecesario.

La forma "fácil" es forzar a que los usuarios vacíen el valor en el control y solo entonces, dejar que salga del Formulario, esto también es algo engorroso.

Veamos entonces la forma mas cómoda para evitar la validación cuando en realidad deseamos salirnos....
public oForm
oForm=CREATEOBJECT("MyForm")
oForm.Show()
DEFINE CLASS MyForm AS FORM 
  Caption="Ejemplo para evitar Validación"
  ADD OBJECT MyTextBox AS TextBox WITH Height=25
  ADD OBJECT MyText2 AS TExtBox WITH Height=25, Top=60
  ADD OBJECT cmdCancelar AS CommandButton WITH Top=90, Caption="Cancelar", Height=30
PROCEDURE MyTextbox.Valid
   DO CASE
     CASE !Wontop(Thisform.Name)
        ** Activando desde otro Form, no validar
        Return .T.
     CASE Thisform.ReleaseType>0
        ** Saliendo de VFP, o haciendo clik en Cerrar. No validar
        Return .T.
     OTHERWISE
       DO CASE
         CASE Mdown()
            *** Si es que esta haciendo Click en el boton Cancelar....
            *** No validar, cambia el nombre de cmdCancelar si no se llamara así
            loobj=Sys(1270)
            IF Vartype(loObj)='O' AND lower(loObj.Name)='cmdcancelar'
               loObj = NULL
               Return .T.
            ENDIF
         CASE Lastkey()=27
            *** Presionando la tecla Escape, no validar
            Return .T.
         ENDCASE

      ENDCASE 
      ****** Aqui se pondria el proceso normal de Validacion *******    
      Messagebox("Validando")        
    ENDPROC
    PROCEDURE cmdCancelar.Click
      Thisform.Release()
    ENDPROC
ENDDEFINE
Copie y pegue el código arriba descrito en su ventana de comandos, seleccione el código en la ventana de comandos y presione ENTER.

Podrá ver un formulario con tres controles, dos TextBox, y un Command Button. Si se pasa de un TextBox a otro se ejecuta el supuesto código de validación, pero si presiona el botón Cancelar o cierra el formulario, el código de validación no se ejecuta, sin importar si existen datos en el TextBox que tiene la validación.

Espero les sea de utilidad.

Espartaco Palma Martínez

19 de noviembre de 2003

Ejemplos de desnormalización para mejorar el rendimiento

 Por Miguel Egea.
Microsoft SQL-SERVER MVP

Introducción

No hay casi nada que produzca más dolores de cabeza que una base de datos desnormalizada, generalmente es garantía de problemas, y además de los que los usuarios no pueden entender. Si la información está en más de un sitio, es una realidad que por errores en nuestro código, por manipulaciones de los datos fuera de nuestras aplicaciones y por otro sin fin de circunstancias acabamos enfadados con los esquemas que no cumplen la 3FN al menos.

Entonces .... ¿Desnormalizamos?

Sin embargo hay veces que no queda más remedio que desnormalizar, de hecho, es una de las fórmulas más eficaces para aumentar el rendimiento. No me malinterpretéis, las bases de datos hay que diseñarlas, pensarlas y desarrollarlas en 3FN al menos. Sin embargo, una vez terminado el proceso de diseño, pueden establecerse estrategias de desnormalización que eviten hacer uniones de demasiadas tablas solamente para obtener un dato que necesitamos.

Pongamos un ejemplo: Si implementamos una aplicación de almacén, para obtener las ventas en un periodo de unos artículos, normalmente necesitaremos usar dos tablas. Considerando el ejemplo de la figura que tenéis al margen, para obtener esa información necesitaremos ejecutar una instrucción como la siguiente :

SELECT month(Fecha) Mes,idArticulo,sum(unidades) 
FROM Albaran a inner join [lineas Albaran] la on
a.idAlbaran=la.idalbaran
group by month(fecha),idarticulo

Esta instrucción supondrá SIEMPRE recorrerse ambas tablas todos sus registros, incluso si establecemos una cláusula WHERE del tipo Month(Fecha)=2, para buscar las del mes de febrero.
En estas circunstancias, si esperamos por ejemplo centenares de miles de albaranes y millones de líneas una estrategia de desnormalización que guarde en la tabla de líneas el mes de la cabecera será una estrategia más que adecuada, por varias razones. La primera de ellas, evidentemente es que si tenemos el dato que buscamos en una sola tabla no necesito unir dos tablas, por tanto tendré que filtrar en una solamente. Además de esa circunstancia hay otra, al grabar exactamente el dato que necesito (el mes en este caso) si realizo comparaciones con el dato o creo índices estos sí podrán ser usados y por tanto podremos obtener ventajas adicionales en cuanto al rendimiento.

Veamos las rutinas necesarias para implementar esta desnormalización, lo primero vamos a considerar este script, para crear las tablas tal y como vimos.

if not objectproperty(object_id('Lineas Albaran'),'IsTable') is null
    drop table [Lineas albaran]
go
if not objectproperty(object_id('Albaran'),'IsTable') is null
    drop table [albaran]
go
Create table [albaran] (idAlbaran int identity(1,1) primary key,
                        serie char(4) not null,
                        Numero int not null,
                        Fecha datetime not null default getdate(),
                        idcliente int)
go
create table [Lineas Albaran] (idAlbaran int not null,
                        idOrden int not null,
                        idArticulo int not null,
                        unidades int not null,
                        fecha datetime ,
                        constraint pk_lineas primary key (idalbaran,idorden),
                        constraint fk_linea_cab foreign key (idAlbaran) references Albaran(idAlbaran) )
go
  

Con este esquema tenemos el hueco para grabar la fecha, pero no tenemos garantía de que esa fecha sea la fecha correcta, por tanto, tendremos que asegurar esta circunstancia de alguna forma, por ejemplo mediante un trigger como el que sigue a continuación.

create trigger trg_LineasAlbaran on [lineas Albaran] instead of insert
as
    begin
    insert into [lineas albaran] 
                select i.idalbaran,i.idorden,i.idarticulo,i.unidades,a.fecha
                            from inserted i inner join albaran a on i.idalbaran=a.idalbaran
end

Con este trigger garantizamos que todas las lineas que se inserten van a tener la fecha que tiene el albaran, pero no tenemos garantizado que si la cabecera cambia, este cambio se refleje en nuestra línea. Para solucionar este inconveniente crearemos un trigger de actualización en la tabla de cabecera. El código podría ser el siguiente :

create trigger trg_Albaran_ActualizaFecha on albaran for update
    as
        begin
            if update(Fecha)
                    begin
                    update l set l.fecha=i.fecha 
                                    from inserted i inner join 
                                    [lineas Albaran] l 
                                    on i.idalbaran=l.idalbaran
                    end        
       end

El trigger solo actuará cuando se actualice la fecha, evitando así dispararse innecesariamente ante otras actualizaciones

Hemos preparado un pequeño script también para introducir datos y poder hacer las pruebas pertinentes.

Declare @contador int
Declare @Contador2 int
Declare @FechaInicial datetime
set @contador=0
set @fechainicial =getdate()
while @contador<2000
begin
-- Insertamos una cabecera y nlineas (hasta 10 máximo
insert into albaran (serie,numero,fecha,idcliente)
values ('A',@contador,GETDATE()-365*rand(),1)
set @contador=@contador+1
set @contador2=10*rand()
while @contador2>0 
begin
insert into [lineas albaran] (idAlbaran,idOrden,idArticulo,unidades) 
values (@contador,@contador2,15*rand(),100*rand())
set @contador2=@contador2-1
end
end
select datediff(ms,@fechainicial,getdate())/1000. [Segundos transcurridos]
go
set statistics io off
go

Con este script acabamos de insertar 2000 líneas, podéis comprobar si os apetece a quitar el trigger y ponerlo y ver la diferencia de rendimiento que debemos esperar, no será demasiado grande.

Después podéis probar el trigger sobre la cabecera lanzando esta instrucción

update albaran set fecha=dateadd(day,-360,fecha)

Consideremos ahora estas instrucciones :

create index ix_LineasAlbaran_fecha on [lineas albaran] (fecha)
set statistics io on 
select * from [lineas albaran] where fecha between '20020420' and '20020421'
select * from [lineas albaran] with(index(ix_lineasalbaran_fecha)) where fecha between '20020420' and '20020421'

 
Podríamos pensar que el resultado en cuanto a tiempos y ejecución serán el mismo al fin y al cabo estamos buscando por un campo de tipo fecha sobre el que existe un índice y no estamos aplicando ninguna función sobre el argumento de búsqueda, parece claro que la estrategia óptima sería usar el índice, ¿verdad?...... La verdad es que no siempre es así, esa estrategia sería con seguridad la que elegiría el optimizador de consultas si no hubiesemos escrito 'Select * from', es decir, si que puede encontrar los registros que son muy rápidamente, pero una vez obtenidos los identificadores, tiene que ir al índice clustered a buscar esos datos, y tiene que ir una vez para cada registro, por eso el resultado del plan de ejecución de la instrucción a y b es el que podéis ver a continuación.



Si nos fijamos la primera instrucción ha hecho un barrido de toda la tabla a través de su índice clustered (clustered index scan', sin embargo esa acción le ha hecho realizar 43 lecturas lógicas (en el caso nuestro y con los datos que se han generado en mi máquina). Sin embargo, la segunda instrucción, al verse forzada a usar el índice ha tenido que leer un total de 134 páginas. Es decir, el resultado es peor con el índice que sin él. en nuestro caso estaba devolviendo 120 filas de un total 9034, es decir un poco más del 10% de las filas ya perjudica sustancialmente el rendimiento usar el índice que no hacerlo.Estas afirmaciones no son extrapolables sin embargo a los índices clustered

Alguien podría pensar que dada esta explicación, puede concluirse que la desnormalización en este caso no ofrece tantas ventajas y que quizá debiese plantearse mejor. Creo sinceramente que no es así, el ejemplo que acabamos de ver, si bien es una práctica habitual de muchos desarrolladores, no es ni mucho menos el objetivo de esta desnormalización (que es obtener ventas por mes de la forma más ágil posible).

Obteniendo ventas mensuales

Lo que hemos obtenido con esta desnormalización es la posibilidad de evitar consultar la tabla de cabecera para obtener la fecha. Sin embargo, las preguntas habituales serán 'Cuantas unidades del artículo X hemos vendido en Mayo'. Veamos las instrucciones que responden a esta pregunta.

select idArticulo,count(*) Cuantas
from [lineas albaran]
where fecha between '20030501' and '20030601'
group by idArticulo



y el plan de ejecución que obtendremos será :



Este plan se está recorriendo la tabla de albaranes, agrupando por la cláusula que le hemos indicado y contando los registros para devolverlos.

Hemos necesitado 43 lecturas lógicas para obtener el resultado.

Sin embargo esta consulta no parece muy óptima, parece manifiestamente mejorable su rendimiento, si tenemos esta sospecha, lo mejor que podemos hacer es usar el 'Asistente para la optimización de índices' o 'Index tunning wizard' en la versión inglesa.

Este es el resultado que nos propone el asistente :

/* Created by: Index Tuning Wizard */
/* Fecha: 13/09/2003 */
/* Hora: 18:20:18 */
/* Nombre de servidor: PORTATIL */
/* Nombre de la base de datos: ACUMULADOS */
USE [ACUMULADOS] 
go
SET QUOTED_IDENTIFIER ON 
SET ARITHABORT ON 
SET CONCAT_NULL_YIELDS_NULL ON 
SET ANSI_NULLS ON 
SET ANSI_PADDING ON 
SET ANSI_WARNINGS ON 
SET NUMERIC_ROUNDABORT OFF 
go
DECLARE @bErrors as bit
BEGIN TRANSACTION
SET @bErrors = 0
CREATE NONCLUSTERED INDEX [Lineas Albaran3] ON [dbo].[Lineas Albaran] 
        ([fecha] ASC, [idArticulo] ASC )
IF( @@error <> 0 ) SET @bErrors = 1
IF( @bErrors = 0 )
    COMMIT TRANSACTION
ELSE
    ROLLBACK TRANSACTION


Si lo lanzamos y lo ejecutamos y comprobamos el plan de ejecución y el número de lecturas lógicas será:



En este caso hace un seek en el índice recien creado, el que sugirio el asistente y el número de lecturas lógicas es de 4, obteniendo una mejora casi del 75%.

En resumen,

La mezcla de técnicas, como la desnormalización y el uso de los recursos que nos proporciona SqlServer, unidos pueden hacer que el rendimiento de nuestras bases de datos mejore sustancialmente. Si a esto le añadimos un buen control del crecimiento y uso, y unas buenas prácticas de programación tenemos el 99% del éxito asegurado.



Miguel Egea Gómez es Ingeniero Técnico en Informática y trabaja como Consultor en Sinergia Tecnológica dentro del Grupo I.T. Deusto, es MVP en SQL-Server mantiene el site http://www.portalsql.com y colabora ocasionalmente en Encuentros Técnicos y charlas organizados por Microsoft.

14 de noviembre de 2003

Números a letras en formato ORDINAL

Esta rutina sirve para convertir números a letras en formato ordinal.

Ejemplo:

1= primero
2= segundo
...
33=Trigesimo Tercero
...

Espero que les ayude esta rutina como me ayudo a mi.

Atte

Victor Jose Gil Salcedo
************************************
FUNCTION Numero2Ordinal(tnNro)
  IF NOT BETWEEN(tnNro,1,999)
    RETURN "ERROR"
  ENDIF
  LOCAL lnEnt, lcRet, lnUni, lnDec, lnCen
  lnEnt = INT(tnNro)
  lcRet = ''
  lcRet = ''
  lnUni = MOD(lnEnt,10)
  lnEnt = INT(lnEnt/10)
  lnDec = MOD(lnEnt,10)
  lnEnt = INT(lnEnt/10)
  lnCen = MOD(lnEnt,10)
  DO CASE
    CASE lnUni = 1
      lcRet = 'primero'
    CASE lnUni = 2
      lcRet = 'segundo'
    CASE lnUni = 3
      lcRet = 'tercero'
    CASE lnUni = 4
      lcRet = 'cuarto'
    CASE lnUni = 5
      lcRet = 'quinto'
    CASE lnUni = 6
      lcRet = 'sexto'
    CASE lnUni = 7
      lcRet = 'séptimo'
    CASE lnUni = 8
      lcRet = 'octavo'
    CASE lnUni = 9
      lcRet = 'noveno'
  ENDCASE
  DO CASE
    CASE lnDec = 1
      lcRet = 'décimo ' + lcRet
    CASE lnDec = 2
      lcRet = 'vigésimo ' + lcRet
    CASE lnDec = 3
      lcRet = 'trigésimo ' + lcRet
    CASE lnDec = 4
      lcRet = 'cuadragésimo ' + lcRet
    CASE lnDec = 5
      lcRet = 'quincuagésimo ' + lcRet
    CASE lnDec = 6
      lcRet = 'sexagésimo ' + lcRet
    CASE lnDec = 7
      lcRet = 'septuagésimo ' + lcRet
    CASE lnDec = 8
      lcRet = 'octogésimo ' + lcRet
    CASE lnDec = 9
      lcRet = 'nonagésimo ' + lcRet
  ENDCASE
  DO CASE
    CASE lnCen = 1
      lcRet = 'centésimo ' + lcRet
    CASE lnCen = 2
      lcRet = 'ducentésimo ' + lcRet
    CASE lnCen = 3
      lcRet = 'tricentésimo ' + lcRet
    CASE lnCen = 4
      lcRet = 'cuadrigentésimo ' + lcRet
    CASE lnCen = 5
      lcRet = 'quingentésimo ' + lcRet
    CASE lnCen = 6
      lcRet = 'sexacentésimo ' + lcRet
    CASE lnCen = 7
      lcRet = 'septingentésimo ' + lcRet
    CASE lnCen = 8
      lcRet = 'octingentésimo ' + lcRet
    CASE lnCen = 9
      lcRet = 'Nonigentésimo ' + lcRet
  ENDCASE
  RETURN lcRet
ENDFUNC
***********************************

5 de noviembre de 2003

Separar valores devueltos por GETFONT()

GETFONT() retorna el nombre, tamaño y estilo de la fuente que se elije como una cadena de caracteres separados por comas.

Podemos separar esta cadena con el siguiente código:

lc = GETFONT()
IF NOT EMPTY(lc)
  ALINES(la,lc,",")
  lcMsg = "Nombre: " + la(1) + CHR(13) + ;
    "Tamaño: " + la(2) + CHR(13) + ;
    "Estilo: " + la(3)
ELSE
  lcMsg = "No selecciono ninguna fuente"
ENDIF
MESSAGEBOX(lcMsg,64)

Luis María Guayán

4 de noviembre de 2003

Fecha a palabras

Funciones que manejan fechas, útiles cuando usamos un runtime diferente al español.
? fecha_palabra(DATE())

FUNCTION fecha_palabra
    LPARAMETERS ldfecha
    RETURN dia_semana(ldfecha)+", "+STR(DAY(ldfecha),2)+ ;
      " de "+mes_year(ldfecha)+" de "+STR(YEAR(ldfecha),4)
ENDFUNC

FUNCTION dia_semana
    LPARAMETERS ldfecha
    LOCAL ARRAY ladia(7)
    ladia(1) = "Domingo"
    ladia(2) = "Lunes"
    ladia(3) = "Martes"
    ladia(4) = "Miercoles"
    ladia(5) = "Jueves"
    ladia(6) = "Viernes"
    ladia(7) = "Sabado"
    RETURN ladia(DOW(ldfecha))
ENDFUNC

FUNCTION mes_year
    LPARAMETERS ldfecha
    LOCAL ARRAY lames(12)
    lames(1)  = "Enero"
    lames(2)  = "Febrero"
    lames(3)  = "Marzo"
    lames(4)  = "Abril"
    lames(5)  = "Mayo"
    lames(6)  = "Junio"
    lames(7)  = "Julio"
    lames(8)  = "Agosto"
    lames(9)  = "Septiembre"
    lames(10) = "Octubre"
    lames(11) = "Noviembre"
    lames(12) = "Diciembre"
    RETURN lames(MONTH(ldfecha))
ENDFUNC
José Alberto Matute

27 de octubre de 2003

Validar una fecha

¿El 29 de Febrero de 2004 es una fecha válida? ¿Existe el 31 de Abril de 2010? Con esta función podemos saber si una fecha es válida o no.
*----------------------------------------------
* FUNCTION EsFechaValida(tnAnio, tnMes, tnDia)
*----------------------------------------------
* Retorna: .T. si la fecha es válida
* Parametros: Año, Mes y Día (todos numéricos)
* Uso: EsFechaValida(2000,2,30) && .F.
*----------------------------------------------
FUNCTION EsFechaValida(tnAnio, tnMes, tnDia)
  RETURN ;
    VARTYPE(tnAnio) = "N" AND ;
    VARTYPE(tnMes) = "N" AND ;
    VARTYPE(tnDia) = "N" AND ;
    BETWEEN(tnAnio, 100, 9999) AND ;
    BETWEEN(tnMes, 1, 12) AND ;
    BETWEEN(tnDia, 1, 31) AND ;
    NOT EMPTY(DATE(tnAnio, tnMes, tnDia))
ENDFUNC
*----------------------------------------------
Luis María Guayán

23 de octubre de 2003

Enviar y leer correo con Outlook desde Visual FoxPro

El modelo de objetos de Outlook es muy rico y poderoso. Esta interfaz está disponible como un servidor de automatización, o sea, que todo lo podemos automatizar mediante programación desde Visual FoxPro.

Un breve ejemplo

Una de las tareas más fácil de automatizar en Outlook es el envío de un correo. Veremos un ejemplo de solamente unas pocas líneas.

Lo primero que debemos hacer para automatizar Outlook, es crear un objeto Outlook. Una vez creado el objeto, debemos acceder al origen de los datos, pero esto no lo logramos en forma directa, debemos crear un objeto "NameSpace" apropiado que actuará como entrada (en este ejemplo MAPI). El objeto NameSpace proporciona entre otros, los métodos Logon y Logoff.
LOCAL lcPerfil AS CHARACTER, lcContrasenia AS CHARACTER , ;
lcDestinatario AS CHARACTER, lcTema AS CHARACTER , ;
lcCuerpo AS CHARACTER
LOCAL loOutlook AS "Outlook.Application", ;
loNameSpace AS OBJECT, loMailItem AS OBJECT
#DEFINE LF_CR CHR(10)+CHR(13)

*-- Datos del Mail
lcPerfil = "Prueba"
lcContrasenia = "prueba"
lcDestinatario = "prueba@portalfox.com"
lcTema = "Prueba: " + TTOC(DATETIME())
lcCuerpo = "Prueba enviando un mail desde Visual FoxPro." + LF_CR
lcCuerpo = lcCuerpo + "Saludos." + LF_CR

*-- Creo objetos Outlook y NameSpace
loOutlook = CREATEOBJECT("Outlook.Application")
loNameSpace = loOutlook.GetNameSpace("MAPI")

*-- Ejecuto los métodos
loNameSpace.Logon(lcPerfil , lcContrasenia)
loMailItem = loOutlook.CreateItem(0)
loMailItem.Recipients.ADD(lcDestinatario)
loMailItem.Subject = lcTema
loMailItem.Body = lcCuerpo
loMailItem.Send
loNameSpace.Logoff

loNameSpace = .NULL.
loOutlook = .NULL.


21 de octubre de 2003

Combinar correspondencia con Word desde Visual FoxPro

En este ejemplo vamos realizar la tarea de Combinar Correspondencia con Microsoft Word desde Visual FoxPro. Para ello vamos a crear el documento y vamos a utilizar la herramienta "Mail Merge" de Word. Los datos a combinar los tomaremos de la base de datos "Northwind" que viene en los ejemplos de Visual FoxPro 8.

Definición de la clase cWord

Para combinar correspondencia definimos de una clase llamada cWord con los métodos necesarios para esta tarea. El código de la clase es el siguiente:
*--------------------------------------------------
* Clase cWord
*--------------------------------------------------
DEFINE CLASS cWord AS CUSTOM
  *--
  * Propiedades
  *--
  oWord = .NULL.   &&   Objeto Word
  cDirApp = ADDBS(SYS(5) + SYS(2003))
  cDirDat = ADDBS(HOME(2) + 'Northwind')
  cDataSource = ''
  *--------------------------------------------------
  * Creo el servidor de automatización
  *--------------------------------------------------
  PROCEDURE CrearServidor()
    *-- Creo el objeto
    THIS.oWord = CREATEOBJECT('Word.Application')
    RETURN VARTYPE(THIS.oWord) = 'O'
  ENDPROC
  *--------------------------------------------------
  * Cierro el servidor de automatización
  *--------------------------------------------------
  PROCEDURE CerrarServidor()
    *-- Cierro Word
    THIS.oWord.QUIT()
    THIS.oWord = .NULL.
    RETURN
  ENDPROC
  *--------------------------------------------------
  * Abro la Carta, si no existe la creo
  *--------------------------------------------------
  PROCEDURE AbrirCarta(tcArchivo)
    LOCAL loDoc AS 'Word.Document'
    tcArchivo = FORCEEXT(tcArchivo,'DOC')
    IF NOT FILE(THIS.cDirApp + tcArchivo)
      *-- Si no existe la carta, la creo
      loDoc = THIS.CrearCarta(tcArchivo)
    ELSE
      *-- Si existe la carta, la abro
      loDoc = THIS.oWord.Documents.OPEN(THIS.cDirApp + tcArchivo)
      *-- y me aseguro que no tiene un documento asociado
      loDoc.MailMerge.MainDocumentType = -1  && wdNotAMergeDocument
    ENDIF
    *-- Retorno un objeto Document
    RETURN loDoc
  ENDPROC
  *--------------------------------------------------
  * Creo la Carta
  *--------------------------------------------------
  PROCEDURE CrearCarta(tcArchivo)
    LOCAL loDoc AS 'Word.Document'
    *-- Creo un nuevo documento
    loDoc = THIS.oWord.Documents.ADD(,,0)
    *-- Guardo el documento como ...
    loDoc.SAVEAS(THIS.cDirApp + tcArchivo)
    *-- Activo el documento
    loDoc.ACTIVATE
    *-- Comienzo a 'escribir' el documento
    WITH THIS.oWord.SELECTION
      .FONT.NAME = 'Tahoma'
      .FONT.SIZE = 10
      .ParagraphFormat.ALIGNMENT = 2 && wdAlignParagraphRight
      .TypeText('San Miguel de Tucumán, ' + DTOC(DATE()))
      .TypeParagraph
      .ParagraphFormat.ALIGNMENT = 0 && wdAlignParagraphLeft
      .TypeParagraph
      .TypeParagraph
      .TypeParagraph
      .TypeParagraph
      .TypeParagraph
      .TypeParagraph
      .TypeText('Señores: ')
      .FONT.Bold = .T.
      .FIELDS.ADD(.RANGE, -1, 'MERGEFIELD  CompanyName ')
      .FONT.Bold = .F.
      .TypeParagraph
      .TypeText('At: ')
      .FIELDS.ADD(.RANGE, -1, 'MERGEFIELD  ContactName ')
      .TypeParagraph
      .FIELDS.ADD(.RANGE, -1, 'MERGEFIELD  Address ')
      .TypeParagraph
      .FIELDS.ADD(.RANGE, -1, 'MERGEFIELD  PostalCode')
      .TypeText(' - ')
      .FIELDS.ADD(.RANGE, -1, 'MERGEFIELD  City ')
      .TypeParagraph
      .FONT.Underline = 1  && wdUnderlineSingle
      .FIELDS.ADD(.RANGE, -1, 'MERGEFIELD  Country ')
      .FONT.Underline = 0  && wdUnderlineSingle
      .TypeParagraph
      .TypeParagraph
      .TypeParagraph
      .TypeParagraph
      .TypeText(CHR(9) + 'Estimado/a ')
      .FIELDS.ADD(.RANGE, -1, 'MERGEFIELD  ContactName ')
      .TypeParagraph
      .TypeParagraph
      .TypeText(CHR(9) + 'Nos dirigimos a Ud. con el objeto de comunicarle ' + ;
        'la nueva dirección de nuestra empresa')
      .TypeParagraph
      .TypeParagraph
      .FONT.Bold = .T.
      .TypeText('Informática del Tucumán')
      .FONT.Bold = .F.
      .TypeParagraph
      .TypeText('9 de Julio 123, 1° Piso')
      .TypeParagraph
      .TypeText('4000 - San Miguel de Tucumán')
      .TypeParagraph
      .TypeText('Tucumán, Argentina')
      .TypeParagraph
      .TypeText('Teléfono (+54) (381) 681-4521')
      .TypeParagraph
      .TypeParagraph
      .TypeText(CHR(9) + 'Sin otro particular lo saludamos atte.')
      .TypeParagraph
      .TypeParagraph
      .TypeParagraph
      .TypeParagraph
      .TypeParagraph
      .TypeParagraph
      .TypeText('Manuel Belgrano')
      .TypeParagraph
      .TypeText('Socio Gerente')
      .TypeParagraph
      .TypeText('Informática del Tucumán')
      .TypeParagraph
    ENDWITH
    *-- Retorno un objeto Document
    RETURN loDoc
  ENDPROC
  *--------------------------------------------------
  * Creo archivo DataSource
  *--------------------------------------------------
  PROCEDURE GenerarDataSource
    LOCAL lcArchivo AS CHARACTER
    IF NOT DBUSED('Northwind')
      OPEN DATABASE (THIS.cDirDat + 'Northwind') SHARED
    ENDIF
    SET DATABASE TO 'Northwind'
    *-- Consulta a los Clientes de Northwind
    SELECT CompanyName, ContactName, ;
      Address, PostalCode, City, Country ;
      FROM Customers ;
      INTO CURSOR Clientes
    *-- Copio el cursor al archivo para combinar
    lcArchivo = SYS(2015)
    COPY TO (THIS.cDirApp + lcArchivo) TYPE CSV
    USE IN Clientes
    THIS.cDataSource = THIS.cDirApp + FORCEEXT(lcArchivo,'CSV')
    RETURN
  ENDPROC
  *--------------------------------------------------
  * Combino la Carta
  *--------------------------------------------------
  PROCEDURE CombinarCarta(toDoc)
    WITH toDoc.MailMerge
      .MainDocumentType = 0  && wdFormLetters
      .OpenDataSource(THIS.cDataSource)
      .Execute()
    ENDWITH
    WITH THIS.oWord
      *-- Cambio la Carpeta del cuadro de diálogo 'Guardar...'
      .ChangeFileOpenDirectory(THIS.cDirApp)
      *-- Maximizo y hago visible
      .WINDOWSTATE = 1  && wdWindowStateMaximize
      .VISIBLE = .T.  && True
    ENDWITH
    RETURN
  ENDPROC
  *--------------------------------------------------
  * Guardo el Documento, si tlCierra = .T. lo cierra
  *--------------------------------------------------
  PROCEDURE GuardarCarta(toDoc, tlCierra)
    *-- Guardo el documento
    toDoc.SAVE()
    IF tlCierra
      *-- Cierro el documento
      toDoc.CLOSE()
    ENDIF
  ENDPROC
ENDDEFINE
*--------------------------------------------------
* Fin Clase cWord
*--------------------------------------------------
El programa Combinar.prg

El siguiente es el código de nuestro programa "Combinar.prg" donde creamos una instancia de la clase cWord y comenzamos a ejecutar los métodos de esa clase.
*-------------------------------------------------
* Combinar.prg
*-------------------------------------------------
LOCAL lo AS OBJECT, loDoc AS OBJECT
lo = NEWOBJECT('cWord','cWord.prg')
IF lo.CrearServidor()
   *-- Ejecuto métodos de la clase
   loDoc = lo.AbrirCarta('MiCarta')
   lo.GenerarDataSource()
   lo.CombinarCarta(loDoc)
   lo.GuardarCarta(loDoc, .T.)
ELSE
   MESSAGEBOX('No se pudo instanciar el servidor', 16, 'Error!')
ENDIF
lo = .NULL.
RETURN
*-------------------------------------------------
* Fin Combinar.prg
*-------------------------------------------------
Ejecutando los métodos en la clase cWord

En primer lugar invocamos el método CrearServidor() que nos retorna el objeto oWord que será nuestro servidor de automatización.

Abrir y/o crear la carta

El método AbrirCarta(), abre la carta de Word si esta existe o crea una nueva carta con el método CrearCarta(). Ambos métodos retornan un objeto Document de Word.


Crear la carta

En el caso de crear o abrir una carta ya existente de Word, estas deben contener los nombres de los campos para su reemplazo en la combinación. Estas cartas serán los documentos principales para la combinación.

La fuente de los datos

También debemos crear o abrir los documentos con los datos a combinar. En este ejemplo creamos un archivo del tipo CSV (Valores Separados por Comas) desde una cláusula SELECT a la tabla "Customers" de la base de datos "Northwind"


Obtener los datos a combinar


Crear la fuente de datos (archivo .CSV)

Para esta tarea tenemos el método GenerarDataSource() que crea el archivo con los datos y establece la propiedad cDataSource de la clase cWord.

Combinar la carta

En el método CombinarCarta() ejecutamos las siguientes sentencias para:
  • Hacer la carta del tipo Documento Principal.
  • Abrir el archivo con la fuente de datos.
  • Ejecutar la combinación

Ejecutar la combinación

Guardar la carta

Para finalizar tenemos el método GuardarCarta() que guarda el documento principal, con la posibilidad mediante un parámetro de cerrar el documento.

En este ejemplo el documento combinado que se genera quedará abierto, entonces hacemos la aplicación visible para que el usuario lo guarde o imprima directamente desde la ventana de Word. También establecemos la carpeta donde están los documentos de este ejemplo, para que Word por defecto la seleccione en la ventana de "Guardar...".

Pueden descargar el código fuente de los programas desde el siguiente vínculo: combinar.zip

Hasta la próxima.

Luis María Guayán

17 de octubre de 2003

SimpleChart revisitado

Autor: Mike Lewis 
Texto original: Simple Chart Revisited
http://www.ml-consult.co.uk/foxst-27.htm
Traducido por: Ana María Bisbé York

Sus comentarios, preguntas y sugerencias sobre nuestro control para graficar.

Nuestro agradecimiento a todos ustedes que nos han enviado sus opiniones sobre nuestro control SimpleChart. Desde que nosotros publicamos el control en Marzo 2002, se ha convertido en el elemento más bajado del sitio Foxstuff, y nos da mucho gusto que muchos programadores de FoxPro lo hayan encontrado útil.

En este artículo vamos a contestar algunas de sus preguntas más frecuentes sobre este control y también pasarles algunos consejos útiles de sus usuarios.

Para aquellos que no han visto el control SimpleChart SimpleChart es en esencia una envoltura del control ActiveX Microsoft's MSChart. Su objetivo es simplificar el trabajo en la elaboración de gráficos, histogramas, y otros diagramas bidimensionales y tridimensionales. Para encontrar más información sobre él y para obtener su copia gratis, vea el artículo Add graphs and charts to your VFP applications.

¿Tiene que estar mi gráfico solo en un formulario o puedo colocarlo junto a otros controles?

Es su decisión. El control trabaja exactamente igual en ambas situaciones.

Estoy tratando de crear un gráfico bidimensional de barra horizontal; pero me aparece un error OLE, ‘Invalid property value’ (Valor de propiedad no válido). ¿Por qué?

SimpleChart admite tipos de gráficos del 0 al 9 y 14 y 16. Puede asignarle solo estos valores a la propiedad. Los otros 16 valores que se ve en la Ventana de propiedades no funcionan en VFP (el gráfico bidimensional de barra horizontal sería el 11). Esta es una limitación del MS Chart, no del SimpleChart.

He seguido cuidadosamente las instrucciones en la creación del gráfico; pero no ocurre nada. No hay mensaje de error. El gráfico simplemente falla y no aparece.

La explicación más probable es que el gráfico no ha podido encontrar la tabla o cursor. Es necesario asegurarse de que la tabla o cursor está abierta en la sesión de datos actual y el alias correcto ha sido guardado en la propiedad cAlias. Verifique también que la propiedad cData contiene una lista válida de nombres de campos numéricos. El método CreateChart retornará .F. si se detecta un problema con cAlias o cData.

¿Qué ficheros adicionales necesito para distribuir mi aplicación?

Es necesario distribuir el control ActiveX MS Chart, que es el MSCHRT20.OCX. Este OCX debe ser instalado en la carpeta System del usuario y registrarlo como un Control ActiveX. Si no está seguro de cómo hacerlo, verifique la ayuda del Asistente de Instalación (si utiliza VFP 6.0) o InstallShield Express (VFP 7.0 y VFP 8.0)

¿Cómo puedo imprimir mi gráfico?

Ni MS Chart ni SimpleChart respalda la impresión. Sin embargo, existe un método EditCopy, que permite copiar el gráfico al Portapapeles. Posteriormente se puede pegar el gráfico en otra aplicación y luego imprimirlo desde allí (vea también las dos preguntas siguientes.)

Traté de utilizar el Método EditCopy para copiar mi gráfico a MS Word, pero todo lo que logré ver fue un bloque de figuras.

Lo que vio fueron los datos subyacentes en los que se basa el gráfico. Para ver el gráfico seleccione Pegado Especial del Menú Edición de Word, luego seleccione Imagen. Lo mismo ocurrirá en Excel y algunas otras aplicaciones.

Dado que es posible pegar un gráfico en un documento de Word y después imprimirlo, ¿existe una vía para hacerlo programáticamente, sin intervención del usuario?

Si. La técnica siguiente utiliza ActiveX Automation para hacer eso justamente (nuestro agradecimiento a Ben Hambigde por sugerir la idea y a Jon Barker por su ayuda en la validación)
Primero, crear un formulario con las propiedades del usuario. Le llamaremos oWord. Inicializamos como Null, por ejemplo, para ejecutar este código en el INIT del formulario colocar:
THISFORM.oWord = NULL
Luego, ejecute el siguiente código en el momento en que usted desea imprimir el gráfico. Puede ser el Evento Clic del comando Imprimir
IF ISNULL(THISFORM.oWord)
  THISFORM.oWord=CREATEOBJECT("Word.Application")
ENDIF
oDoc=THISFORM.oWord.Documents.Add()
THISFORM.MyChart.EditCopy()
THISFORM.oWord.Selection.PasteSpecial(.F., .F., 0, .F., 3)
oDoc.PrintOut
oDoc.Close(0)
Fundamentalmente, este código va a instanciar Microsoft Word como un servidor de Automatización (a no ser que haya sido instanciado antes), copia el gráfico en el Portapapeles, pega la imagen del gráfico (no los valores) en un nuevo documento de Word, imprime el documento y cierra el documento sin salvar. (En la quinta línea del código que se muestra arriba, MYChart es el nombre del objeto SimpleChart)

Finalmente, adicione este código en el evento Destroy de este formulario.
IF NOT ISNULL(THISFORM.oWord)
  THISFORM.oWord.Quit
ENDIF 

¿Cómo puedo mostrar un cursor de rotación para que los usuarios puedan rotar mi gráfico tridimensional?

En teoría, usted puede hacer esto fijando la propiedad AllowDynamicRotation en .T. Se supone que mostrará un cursor de rotación cuando el usuario presione la tecla Control (el cursor de rotación aparece como una flecha de cuatro puntas y permite al usuario rotar el gráfico 3D interactivamente.) En la práctica, nunca lo hemos logrado obtenere en VFP (recibiremos gustosos sugerencias de alguien que sepa como hacer esto).

¿Es posible rotar un gráfico 3D programáticamente?

Si, existen las propiedades disponibles para ajustar tanto la rotación como la elevación de los gráficos. Para ver esta acción, adicione dos controles spinner a su formulario. Coloque este código en el Evento InteractiveChange del primer spinner
THISFORM.MyChart.Plot.View3d.Rotation=this.Value
Y en el evento InteractiveChange del Segundo control spinner:
THISFORM.MyChart.Plot.View3d.Elevation = this.Value
Cuando usted ejecute el formulario y ajuste los valores de los controles spinner, verá algunos efectos interesantes (Nuestro agradecimiento a Kirk Kelly por suministrar esta información)

¿Existe alguna vía para cambiar el Formato de letra utilizado en las etiquetas?

Este código va a cambiar la etiqueta del eje X a Fuente = Arial Narrow y su tamaño 14
WITH THISFORM.MyChart.Plot.Axis(0)
  FOR EACH olabel IN .Labels
    olabel.VtFont.Name = "Arial Narrow"
    oLabel.vtFont.Size = 14
  ENDFOR
ENDWITH
Alternativamente referencie Axis(1) o Axis(2) en lugar de Axis(0) en la primera línea. Esto le permitirá cambiar la fuente en los ejes verticales izquierdo y derecho respectivamente

¿Es posible mostrar títulos para los tres ejes?

Si. SimpleChart puede mostrar un título para ele eje X y para ambos ejes Y Aquí mostramos como su código pudiera ser escrito:
WITH THISFORM.MyChart.Plot.Axis(0)
  .AxisTitle.Text = "This is the X-axis"
  .AxisTitle.vtFont.Name = "Arial"
  .AxisTitle.VtFont.Size = 12
ENDWITH
Esto mostrará un título horizontal para el eje X. Al igual que las etiquetas, usted puede referenciar Axis(1) o Axis(2) para los ejes Y (izquierdo y derecho respectivamente)

El objeto AxisTitle tiene un conjunto de otras propiedades que usted puede utilizar para personalizar el título -- TextLayout.Orientation, por ejemplo, le permite escoger la orientación (1 = horizontal, 2 = vertical). Además el objeto VFont tiene propiedades para Style (1 = negrita, 2 = cursiva, 3 = negritaCursiva) y Effect (256 = tachar, 512 = subrayar)

Mike Lewis, Consultants Ltd. Julio 2002. Revisado Septiembre 2002

6 de octubre de 2003

Contadores (punteros) Alternativa SQL

Pues eso, aqui teneis un ejemplo de como obtener nuevos codigos (disponibles) en una tabla cuyo indice principal sea numerico. P.E. Clientes, proveedores, etc.

Nos permite decidir el valor minimo por el que realizar la busqueda de un 'hueco'
PARAMETERS pcTabla, pcCampo, pnCodigo
* pcTabla : Tabla en la que buscar
* pcCampo : Campo en el que buscar
* pnCodigo : Opcional, indica el minimo para buscar

* AHORA VARIABLES LOCALES
LOCAL lnCodigoMin
IF PCOUNT()>2
 * se ha pasado codigo minimo
  lnCodigoMin = pnCodigo
ELSE
 * No se ha pasado
  lnCodigoMin = 0
ENDIF

* a) Nos aseguramos de tener la tabla abierta
IF !USED(pcTabla)
  USE (pcTabla) IN 0 SHARED
ENDIF

* ahora montamos la consulta
SELECT MIN(&pcCampo+1) AS NuevoCod ;
FROM &pcTabla ;
WHERE &pcCampo>lnCodigoMin .and.;
 !deleted() .and. ;
!&pcCampo+1 IN ;
(SELECT DISTINC &pcCampo FROM &pcTabla) ;
INTO CURSOR oNew

* Comentar las dos siguientes lineas,
* es solo para chequeo.

? 'Valor Obtenido : '
?? oNew.NuevoCod
* devolvemos nuevo codigo
return oNew.NuevoCod

***********  FIN  *******
Javier Amoros

1 de octubre de 2003

Codificar y decodificar claves fácilmente

Muy simple y lo codifica en base 64 binario. Para VFP 7/8
tupass = "PEPE"
pass_encoded = STRCONV(tupass,13) 
? pass_encoded
pass_decoded = STRCONV(pass_encoded,14)
? pass_decoded
José Temporini

Ejecutar sentencias de Fox puestas en un campo memo

Es algo un poco raro, pero imaginaros que tenemos un campo memo con código a ejecutar, como lo haríamos?

StrToFile(tabla.campomemo, 'temp.prg')
compile temp.prg
do temp

Pablo Roca

16 de septiembre de 2003

Leer valores del Registry versión OOP

Leer valores del Registro de Windows es fácil, si usas Visual FoxPro y las Fox Foundation Classes (FFC), aquí te enseñamos cómo....

Otra de las clases que se encuentran en las Fox Foundation Classes es la llamada Registry Access, la cual está accesible por medio del IDE de VFP.

Tools -> Component Gallery -> FFCs -> Utilities

Con esta clase se pueden hacer multitud de cosas con respecto al Manejo del Registry, a continuación un pequeño ejemplo (cortesía de Alex Feldstein en las newsgroups de Microsoft):

** Ejemplo de Registry.vcx:
** Abrir una llave (key) usando el metodo OpenKey().
** Si no especificas una llave, el default es HKEY_CLASSES_ROOT
 
 oReg = NEWOBJECT("registry",HOME(1)+"ffc\registry.vcx")
 lcKey = "VisualFoxPro.ApplicationCurVer"
 if oReg.OpenKey(lckey) = 0
   * sin error
   lcvalue = ""
   if oReg.GetKeyValue("", @lcvalue) = 0
     * sin error
     ? lcvalue
   endif
   oReg.CloseKey()
 endif 
Espero les sea de utilidad.

Espartaco Palma Martínez

12 de septiembre de 2003

Números a Letras en Inglés

Rutina que convierte un importe a letras en Inglés.

Ejemplo:

? Num2Word(123456.78)
"ONE HUNDRED TWENTY THREE THOUSAND FOUR HUNDRED FIFTY SIX AND 78/100"

*-------------------------------------------
* FUNCTION Num2Word(tcNro)
*-------------------------------------------
* Pasa un Importe a Letras (en Inglés)
* USO: ? Num2Word(123456.78)
* PARAMETRO: Importe a convertir (Numérico)
* RETORNO: Caracter
* AUTOR: Luis María Guayán
*-------------------------------------------
FUNCTION Num2Word(tcNro)
  LOCAL lnEnt, lcRet, lcCad, lnTerna,;
    lnUni, lnDec, lnCent, lnFrac
  lnEnt = INT(tcNro)
  lnFrac = (tcNro - lnEnt) * 100
  lcRet = ''
  lnTerna = 1
  DO WHILE lnEnt > 0
    *-- Recorro terna por terna
    lcCad = ''
    lnUni = lnEnt % 10
    lnEnt = INT(lnEnt/10)
    lnDec = lnEnt % 10
    lnEnt = INT(lnEnt/10)
    lnCent = lnEnt % 10
    lnEnt = INT(lnEnt/10)
    *-- Analizo las unidades
    DO CASE && UNIDADES
      CASE lnUni = 1
        lcCad = 'ONE ' + lcCad
      CASE lnUni = 2
        lcCad = 'TWO ' + lcCad
      CASE lnUni = 3
        lcCad = 'THREE ' + lcCad
      CASE lnUni = 4
        lcCad = 'FOUR ' + lcCad
      CASE lnUni = 5
        lcCad = 'FIVE ' + lcCad
      CASE lnUni = 6
        lcCad = 'SIX ' + lcCad
      CASE lnUni = 7
        lcCad = 'SEVEN ' + lcCad
      CASE lnUni = 8
        lcCad = 'EIGHT ' + lcCad
      CASE lnUni = 9
        lcCad = 'NINE ' + lcCad
    ENDCASE && UNIDADES
    *-- Analizo las decenas
    DO CASE && DECENAS
      CASE lnDec = 1
        DO CASE
          CASE lnUni = 0
            lcCad = 'TEN '
          CASE lnUni = 1
            lcCad = 'ELEVEN '
          CASE lnUni = 2
            lcCad = 'TWELVE '
          CASE lnUni = 3
            lcCad = 'THIRTEEN '
          CASE lnUni = 4
            lcCad = 'FOURTEEN '
          CASE lnUni = 5
            lcCad = 'FIFTEEN '
          CASE lnUni = 6
            lcCad = 'SIXTEEN '
          CASE lnUni = 7
            lcCad = 'SEVENTEEN '
          CASE lnUni = 8
            lcCad = 'EIGHTEEN '
          CASE lnUni = 9
            lcCad = 'NINETEEN '
        ENDC
      CASE lnDec = 2
        lcCad = 'TWENTY ' + lcCad
      CASE lnDec = 3
        lcCad = 'THIRTY ' + lcCad
      CASE lnDec = 4
        lcCad = 'FORTY ' + lcCad
      CASE lnDec = 5
        lcCad = 'FIFTY ' + lcCad
      CASE lnDec = 6
        lcCad = 'SIXTY ' + lcCad
      CASE lnDec = 7
        lcCad = 'SEVENTY ' + lcCad
      CASE lnDec = 8
        lcCad = 'EIGHTY ' + lcCad
      CASE lnDec = 9
        lcCad = 'NINETY ' + lcCad
    ENDCASE && DECENAS
    *-- Analizo las centenas
    DO CASE && CENTENAS
      CASE lnCent = 1
        lcCad = 'ONE HUNDRED ' + lcCad
      CASE lnCent = 2
        lcCad = 'TWO HUNDRED ' + lcCad
      CASE lnCent = 3
        lcCad = 'THREE HUNDRED ' + lcCad
      CASE lnCent = 4
        lcCad = 'FOUR HUNDRED ' + lcCad
      CASE lnCent = 5
        lcCad = 'FIVE HUNDRED ' + lcCad
      CASE lnCent = 6
        lcCad = 'SIX HUNDRED ' + lcCad
      CASE lnCent = 7
        lcCad = 'SEVEN HUNDRED ' + lcCad
      CASE lnCent = 8
        lcCad = 'EIGHT HUNDRED ' + lcCad
      CASE lnCent = 9
        lcCad = 'NINE HUNDRED ' + lcCad
    ENDCASE && CENTENAS
    *-- Analizo la terna
    DO CASE && TERNA
      CASE lnTerna = 1
        lcCad = lcCad
      CASE lnTerna = 2 AND (lnUni + lnDec + lnCent # 0)
        lcCad = lcCad + 'THOUSAND '
      CASE lnTerna = 3 AND (lnUni + lnDec + lnCent # 0)
        lcCad = lcCad + 'MILLON '
      CASE lnTerna = 4 AND (lnUni + lnDec + lnCent # 0)
        lcCad = lcCad + 'BILLON '
    ENDCASE && TERNA
    *-- Armo el retorno terna a terna
    lcRet = lcCad  + lcRet
    lnTerna = lnTerna + 1
  ENDDO && WHILE
  IF lnTerna = 1
    lcRet = 'ZERO '
  ENDIF
  RETURN lcRet + 'AND ' + ;
    TRANSFORM(lnFrac,"@L 99") + '/100'
ENDFUNC
*-------------------------------------------

Luis María Guayán

9 de septiembre de 2003

Crear una funcionalidad Deshacer en cuadros de texto de Visual FoxPro

Artículo original: Creating Undo functionality in a Visual FoxPro TextBox
http://west-wind.com/weblog/posts/3296.aspx
Autor: Rick Strahl
Traducido por: Ana María Bisbé York


El cuadro de texto de Visual FoxPro no es precisamente un gran control como el que yo tengo en el Help Builder (http://www.west-wind.com/wwHelp/). Tuve que trabajarlo para hacer que funcione como si estuviera basado en un editor de textos que incluye formato. Pero al mismo tiempo no era capaz de encontrar una forma decente de sustitución. La mayoría de los controles ActiveX basados en textos son poco menos que un infierno (al menos en VFP) o son muy muy lentos si trata de enganchar algún evento COM a la clave al procesar, como necesito que haga el Help Builder.

En general el TextBox de VFP funciona bien, salvo en dos cosas:
  1. Existe un bug en el control que provoca que el control envuelva al original si existen avance de línea en un área específica del margen derecho. Puede causar avances de línea que sean "comidos" por el cuadro de texto con el texto que puede ser un salto súbito cuando el cuadro de texto es redimensionado u otros cuadros de texto entren  fuera del margen. Esto se puede ver como un bug muy oscuro; pero si trabaja modificando grandes cantidades de textos se lo encontrará muy pronto. Según Calvin Hsia se corrige en el VFP 9.0 SP1...
  2. Comportamiento para Deshacer. El cuadro de texto de Visual FoxPro no tiene un comportamiento para Deshacer - el buffer para Deshacer se pierde cada vez que hay cualquier tipo de actualización del dato. Esto incluye el enlace al origen de datos (ControlSource), establecer el valor explícitamente, cambiar SelText o incluso pasar texto al control. Se limpia también si se oprime la tecla Tab y sale del control e inmediatamente regresa. Todo esto es realmente limitado y no es un comportamiento estándar.
Hasta la salida del SP1 no puedo hacer nada con el punto 1; pero he pensado que puedo controlar mi propio Deshacer con buffer en mi control TextBox personalizado. Mientras hablaba con Calvin en SoutWest Fox comenzamos a colocar un mejor comportamiento en el TextBox; pero sobre el comportamiento Deshacer está profundamente dentro del runtime de VFP y cambiar eso es algo como romper mucho del código que ya está. Por tanto no hay ayuda en este sentido. Entonces Calvin me sugirió... escribe el tuyo propio....

Lo primero que pensé - sí, bien. Controlar Deshacer buffer con código Fox es muy lento y ocuparía mucha memoria, porque hay que guardar el buffer entero del valor del control ya que los eventos InteractiveChange y ProgrammaticChange no brindan información de qué es lo que ha cambiado, entonces, no hay una forma fácil de capturar cuál de los cambios es el que hay que deshacer.

2 de septiembre de 2003

Cambios en el comportamiento de SELECT SQL en Visual FoxPro 8

Artículo en la Base de Conocimientos de Microsoft que describe los cambios de comportamiento en la instrucción SELECT SQL en Visual FoxPro 8.

Los cambios descriptos en el artículo son:

. Cambios en las cláusulas GROUP BY y HAVING
. Cambios en la cláusula DISTINCT
. Cambios en SELECT ... UNION
. Cambios en SELECT ... LIKE

Para compatibilidad con versiones anteriores existen dos nuevos comandos:

SET ENGINEBEHAVIOR 70 y SYS(3099,70)

Para ver el artículo completo: http://support.microsoft.com/default.aspx?scid=kb;ES;813361

Luis María Guayán

26 de agosto de 2003

Saber los usuarios conectados a una base de datos de MS SQL Server 2000

Cuando necesitemos saber que usuarios estan conectados a una base de datos de MS SQL Server 2000 podemos usar este procedmiento almacenado.

create procedure @base_de_datos nchar(128) as 
begin 
  set nocount on 
  if exists (select name from sysobjects 
    where name = 'tbl_usuarios_conectados') 
  drop table tbl_usuarios_conectados 

  create table tbl_usuarios_conectados (spid smallint, 
  /* esta columna se puede borrar si se desea utilizar en SQL Server 7*/ 
  ecid smallint, status nchar(30), loginname nchar(128), 
  hostname nchar(128), blk char(5), dbname nchar(128), cmd nchar(16)) 

  INSERT tbl_usuarios_conectados 
  exec sp_who 

  select distinct loginname, hostname 
    from tbl_usuarios_conectados 
    where dbname = @base_de_datos and hostname <> ' ' 
  
  return 
end 

Ylber Aponte

15 de agosto de 2003

Calcular la hora GMT

Función para calcular la hora GMT (Greenwich Meridian Time).
*---------------------------
* FUNCTION GetGMTDateTime
*---------------------------
* Retorna la Fecha y Hora GMT
* USO: ? GetGMTDateTime()
* RETORNA: DateTime
*---------------------------
FUNCTION GetGMTDateTime
   LOCAL lcBuffer, lnAnio, lnMes, lnDia, ;
      lnHora, lnMinuto, lnSegundo, ltGMT
   lcBuffer=SPACE(32)
   DECLARE INTEGER GetSystemTime;
      IN win32api STRING @lcBuffer
   =GetSystemTime(@lcBuffer)
   lnAnio = HtoD(SUBSTR(lcBuffer,1,2))
   lnMes =  HtoD(SUBSTR(lcBuffer,3,2))
   lnDia =  HtoD(SUBSTR(lcBuffer,7,2))
   lnHora = HtoD(SUBSTR(lcBuffer,9,2))
   lnMinuto = HtoD(SUBSTR(lcBuffer,11,2))
   lnSegundo =  HtoD(SUBSTR(lcBuffer,13,2))
   *--- Fecha y Hora GMT
   ltGMT = DATETIME(lnAnio, lnMes, lnDia, lnHora, lnMinuto, lnSegundo)
   RETURN ltGMT
ENDFUNC
*---------------------------
FUNCTION HtoD(tcPar)
   RETURN ASC(SUBSTR(tcPar,2))*256+ASC(SUBSTR(tcPar,1))
ENDFUNC
*---------------------------
Recordar para que esta función retorne la hora GMT correcta, el reloj de la PC debe estar configurado con la zona horaria correspondiente.

Luis María Guayán

4 de agosto de 2003

Calcular el último día del mes

Función que retorna el último día de un mes.
*------------------------------------------------
FUNCTION _EOM(dFecha)
*------------------------------------------------
* Retorna el último día del mes (EndOfMonth)
* USO: _EOM(DATE())
* RETORNA: Fecha
*------------------------------------------------
  LOCAL ld 
  ld = GOMONTH(dFecha,1)
  RETURN ld - day(ld)
ENDFUNC
*------------------------------------------------

30 de julio de 2003

Obtiene la diferencia entre 2 horas

Toma en cuenta cuando la hora inicial es antes de medianoche y la final es después
* Funcion .......: DifHMS
* Creada ........: Julio 16, 2003 By Sukos
* Uso ...........: Obtiene la diferencia en Horas, Minutos y Segundos entre dos Horas
* Llamada .......: DifHMS(,)
* Donde .........:    = Expresion de Hora Inicial, en formato "HH:MM:SS"
*        = Expresion de Hora Final, en formato "HH:MM:SS"
* Observaciones .: Si la Hora Inicial es mayor que la Hora Final esta funcion supone que el proceso inicio
*     antes de la medianoche y concluyo despues de las 0 horas, en este caso realiza la
*     operacion tomando en cuenta desde la Hora inicial hasta la medianoche mas lo que resulte
*     de la medianoche hasta la hora final.
* Ejemplo .......: DifHMS("00:00:05","00:00:05") -----> Devuelve "00:00:00"
*     DifHMS("16:00:10","17:00:15") -----> Devuelve "01:00:05"
*     DifHMS("23:59:58","00:00:05") -----> Devuelve "00:00:07"
* Notas .........: Si se usa en un metodo de formularios, solamente convierte a comentario
*     la primera linea agregandole un "*" al inicio y la llamas con "Objeto.DifHMS(,)"
* --------------------------------------------------------------------------------------------------------------------------
Func DifHMS(Vl_Hora1, Vl_Hora2)
Local Vl_Resp, Vl_Hh1, Vl_Mm1, Vl_Ss1, Vl_Hh2, Vl_Mm2, Vl_Ss2
Local Vl_HoraCompl1, Vl_HoraCompl2, Vl_DifTiempo, Vl_DifHh, Vl_DifMm, Vl_DifSs

Vl_Hh1=Int(Val(SubStr(Vl_Hora1,1,2)))
Vl_Mm1=Int(Val(SubStr(Vl_Hora1,4,2)))
Vl_Ss1=Int(Val(SubStr(Vl_Hora1,7,2)))

Vl_Hh2=Int(Val(SubStr(Vl_Hora2,1,2)))
Vl_Mm2=Int(Val(SubStr(Vl_Hora2,4,2)))
Vl_Ss2=Int(Val(SubStr(Vl_Hora2,7,2)))

Vl_HoraCompl1=DateTime(100,1,1,Vl_Hh1,Vl_Mm1,Vl_Ss1)
Vl_HoraCompl2=DateTime(100,1,1,Vl_Hh2,Vl_Mm2,Vl_Ss2)
Vl_HoraCero1=DateTime(100,1,1,23,59,59)
Vl_HoraCero2=DateTime(100,1,1,0,0,0)

If Vl_HoraCompl1=Vl_HoraCompl2
 Store 0 To Vl_DifHh, Vl_DifMm, Vl_DifSs
Else
 If Vl_HoraCompl1 < Vl_HoraCompl2
  Vl_DifTiempo=Vl_HoraCompl2-Vl_HoraCompl1
 Else
  Vl_DifTiempo=(Vl_HoraCero1-Vl_HoraCompl1)+(Vl_HoraCompl2-Vl_HoraCero2)+1
 EndIf
 Vl_DifHh=Int(Vl_DifTiempo/3600)    && Calcula las Horas
 Vl_DifTiempo=Int(Vl_DifTiempo%3600)   && Quita las horas obtenidas
 Vl_DifMm=Int(Vl_DifTiempo/60)    && Calcula los minutos
 Vl_DifSs=Int(Vl_DifTiempo%60)    && Calcula los Segundos
EndIf
Vl_Resp=PadL(Vl_DifHh,2,"0")+":"+PadL(Vl_DifMm,2,"0")+":"+PadL(Vl_DifSs,2,"0")
Retu Vl_Resp

Eduardo Espejel Angeles

23 de julio de 2003

Saber si una tabla esta ordenada descente o ascendentemente

Este truco es bastante útil para evitar volver a ordenar una tabla si ya esta ordenada de la forma que la necesitamos....
IF "DESCENDING" $ SET("ORDER")  
       ?'Descendente'
ELSE &&ASCENDENTE
      ?'Ascendente'
ENDIF
Esta es otra forma .... devolverá .T. si esta ordenado Descendentemente y .F. si esta ordenado Ascendentemente
?"DESCENDING" $ SET("INDEX")
Este truco me fascina :-)

David Amador (Davphantom)

21 de julio de 2003

Mover formulario agarrandolo por cualuier parte

Este código nos permite nos mover formulario agarrándolo por cualquier parte.

#define WM_LBUTTONUP 514
#define WM_SYSCOMMAND  274
#define SC_MOVE 61456
#define MOUSE_MOVE 61458
Declare integer SendMessage in "User32";
  Long  hwnd, Long wMsg, Long wParam, Long lParam 
* Este código se pondrá en el control_MouseDown ...
PUBLIC lngRet As Long
* Envía un MouseUp al Control
=SendMessage(thisform.hWnd, WM_LBUTTONUP, 0, 0)
* Envía la orden de mover el form
=SendMessage(thisform.hWnd, WM_SYSCOMMAND, MOUSE_MOVE, 0)
David Amador

28 de junio de 2003

Calcular fechas festivas

En muchos países existen fechas festivas como el "Día del Padre" que se celebra el "3° Domingo de Junio". La pregunta es ¿Qué fecha es exactamente el 3° Domingo de Junio?

Con esta función podemos saber que fecha es el 3° Domingo de Junio de 2003, o también por ejemplo saber que fecha es el 1° Viernes de Diciembre de 2005

FechaFestiva
Retorna la fecha de los días festivos del tipo "3° Domingo de Junio" ó "1° Viernes de Diciembre"

SINTAXIS:
FechaFestiva(tnOrdinal,tnDiaSem,tnMes,tnAnio)

PARAMETROS:
tnOrdinal: El ordinal que se busca (1°, 2°, 3°, ...)
tnDiaSem: El día de la semana (1=Dom, 2=Lun, ..., 7=Sáb)
tnMes: El número del mes (1=Ene, 2=Feb, ..., 12=Dic)
tnAnio: El año que se busca

RETORNA:
Fecha (DATE)

USO:
*-- 3° Domingo de Junio de 2003
? FechaFestiva(3,1,6,2003)
*-- 1° Viernes de Diciembre de 2005
? FechaFestiva(1,6,12,2005)
LA FUNCION:
FUNCTION FechaFestiva(tnOrdinal,tnDiaSem,tnMes,tnAnio)
   RETURN DATE(tnAnio,tnMes,1)+tnOrdinal*7- ;
      DOW(DATE(tnAnio,tnMes,1)+tnOrdinal*7-1,tnDiaSem)
ENDFUNC


Nota: Gracias a Ricardo Passians que publicó la fórmula en el Grupo de Noticias de Visual FoxPro en Español.

Luis María Guayán

22 de junio de 2003

Conocer la versión de MS-SQLServer 2000 desde VFP

No sabes que Versión de MS-SQLServer está ejecutandose?, deseas saber que Service Pack está instalado? aqui te decimos cómo saberlo.

Ha habido y considero seguirá habiendo una serie de virus que se aprovechan de las vulnerabilidades de este software de Microsoft, el último virus fue corregido por el SP3, tambien a veces algunas mejoras en el producto son introducidos (y quizás removidos) en diferentes versiones y service Packs, así que a veces es necesiario saber a que versión de SQLServer se está conectado para saber de la misma manera cuál fué su ultimo Service Pack instalado.

lcServerName = "MiServidor"
lnHandle =SQLStringConnect([server=]+lcServerName+[;driver={SQL Server};Trusted_Connection=Yes])
IF lnHandle > 0

lcQueryVersion=[SELECT 'SQL Server ' ]+;
                              [+ CAST(SERVERPROPERTY('productversion') AS VARCHAR) + ' - ' ]+;
                              [+ CAST(SERVERPROPERTY('productlevel') AS VARCHAR) + ' ('  ]+;
                              [+ CAST(SERVERPROPERTY('edition') AS VARCHAR) + ')']

   IF SQLEXEC(lnHandle,lcQueryVersion,"cRes") > 0
       Brow
   ELSE
       IF AERROR(laError) > 0
           Messagebox("No se pudo ejecutar la consulta"+chr(13)+;
                                "Causa:"+laError[2],16,"Error Msg")
       ENDIF
   ENDIF
   SQLDISCONNECT(lnHandle)
ELSE
   IF AERROR(laError) > 0
       Messagebox("No se pudo ejecutar la consulta"+chr(13)+;
                            "Causa:"+laError[2],16,"Error Msg")
   ENDIF
ENDIF

Las difentes cadenas resultantes pueden ser algunas de las siguientes :

ProductoVersión
RTM (Ready To Manufacture)2000.80.194
SQL Server 2000 SP12000.80.384
SQL Server 2000 SP22000.80.534
SQL Server 2000 SP32000.80.760
SQL Server 2000 SP42000.80.2039

Mas información al respecto:

HOW TO: Identify Your SQL Server Service Pack Version and Edition

How do I know which version of SQL Server I'm running?

Espero les sea de utilidad.

Espartaco Palma Martínez

16 de junio de 2003

Conocer si la unidad existe

Siguiendo con los filesystem, muchas veces hemos querido saber si alguna unidad existe o no.

La rutina que a continuación les presento nos da la facilidad de saber si es que nuestra unidad existe, pasando como argumento la unidad como una sola letra o como prompt:

Ejemplos:
? "El drive especificado " + IIF(DriverExist('c'), "", "no") + " existe."
? "La ruta especificada " + IIF(DriverExist('c:'), "", "no") + " existe."
Function DriverExist(lcDriveOrPathExist)
 Local Result as logic

 loFSO = CREATEOBJECT('Scripting.FileSystemObject')
 Result=loFSO.DriveExists(lcDriveOrPathExist)
 RELEASE loFSO
 Return Result

Endfunc
Ramón Rodríguez Martínez

13 de junio de 2003

Obtener Estadisticas de los paquetes ICMP

Este es un ejemplo de como podemos obtener por medio de apis estadistica de los paquetes icmp enviados y recibidos en la maquina.
Public oFrm
oFrm=Newobject("ICMP_Data")
oFrm.Show
Return

Define Class ICMP_Data As Form
 Height = 280
 Width = 500
 Desktop = .T.
 DoCreate = .T.
 AutoCenter = .T.
 BorderStyle = 0
 Caption = "Estadisticas ICMP"
 ControlBox = .T.
 Closable = .T.
 MaxButton = .F.
 MinButton = .F.
 ClipControls = .F.
 AlwaysOnTop = .F.
 BackColor = Rgb(203,230,241)
 Name = "ICMP_Data"

 Add Object lst_datos As ListBox With ;
  ColumnCount = 3, ;
  ColumnWidths = "250,100,100", ;
  Height = 271, ;
  Left = 6, ;
  Sorted = .F., ;
  Top = 2, ;
  Width = 483, ;
  DisabledItemBackColor = Rgb(102,130,200), ;
  DisabledItemForeColor = Rgb(255,255,0), ;
  DisabledForeColor = Rgb(255,0,0), ;
  Name = "lst_datos"
 Add Object timer1 As Timer With ;
  Top = 36, ;
  Left = 408, ;
  Height = 23, ;
  Width = 23, ;
  Interval = 560, ;
  Name = "Timer1"

 Procedure Estadisticas()
  Local ICMP, nCiclo
  ICMP = Space((13*4*2)+1)
  If GetIcmpStatistics(@ICMP) = 0
   With Thisform.lst_datos
    For nCiclo = 1 To 13
     .AddListItem(Alltrim(Str(.Parent.nRepStruct(ICMP,nCiclo))),nCiclo+1,2)
     .AddListItem(Alltrim(Str(.Parent.nRepStruct(ICMP,nCiclo+13))),nCiclo+1,3)
    Endfor
   Endwith
  Else
   Wait Window "Error al Obtener las Estadisticas"
  Endif
 Endproc

 Procedure nRepStruct
  Lparameters cEstructura, nValor
  Local cCadena, nEmp
  nEmp=((nValor-1)*4)+1
  cCadena = Substr(cEstructura,nEmp,4)
  Return  (Asc(Substr(cCadena, 1,1)) +;
   BitLShift(Asc(Substr(cCadena, 2,1)),  8)+;
   BitLShift(Asc(Substr(cCadena, 3,1)), 16)+;
   BitLShift(Asc(Substr(cCadena, 4,1)), 24))
 Endproc

 Procedure Load
  Declare Long GetIcmpStatistics In "iphlpapi" String @cEstructura
 Endproc

 Procedure lst_datos.Init
  With This
   .Clear()
   .AddListItem('Parametros',1,1)
   .AddListItem('Recibidos',1,2)
   .AddListItem('Enviados',1,3)
   .AddListItem('Mensajes',2,1)
   .AddListItem('Errores',3,1)
   .AddListItem('Destino inaccesible',4,1)
   .AddListItem('Tiempo agotado',5,1)
   .AddListItem('Problema de Parametros',6,1)
   .AddListItem('Paquetes de control de flujo',7,1)
   .AddListItem('Redirecciones',8,1)
   .AddListItem('Echos',9,1)
   .AddListItem('Respuestas de Eco',10,1)
   .AddListItem('Fechas',11,1)
   .AddListItem('Respuestas de fecha',12,1)
   .AddListItem('Máscaras de direcciones',13,1)
   .AddListItem('Máscaras de direcciones respondidas',14,1)
  Endwith
  Thisform.Estadisticas()
 Endproc

 Procedure timer1.Timer
  Thisform.Estadisticas()
 Endproc
Enddefine
Saludos

Jorge Mota, Guatemala

12 de junio de 2003

Partir un archivo en piezas más pequeñas

Partir un archivo en n bytes con fox. Esto es parte de utilidades de backups. (Les envio el programa para volver a unir las piezas en la proxima noticia)

*- JARSoft Argentina
*- Prog. Alberto Rodiriguez - jarargentina@hotmail.com
*- Ultima modificacion: Abr. 2003
*-
*- Partir el archivo en piezas de n bytes
*- ADVERTENCIA.!! todos los archivos de extencion nnn de tcDestino se eliminan.!!
*- Parámetros:
Lparameters tcArchivo, tnBytes, tcDestino
*- Devuelve el nro de pedazos en que se partio el archivo o cero
*- si no se pudo completar la operacion o -1 si hubo algun error.

*- Ej. de uso:
*- nPedazos = partirarchivo_01('c:tmpRespaldos.zip', 1457664, 'c:tmp')
*- Este ejemplo divide respaldos.zip en 1.40 Mg para que las partes quepan en
*- disquetes y las pone en c:tmp

If PCOUNT() # 3 Or Vartype(tcArchivo) # 'C' Or Vartype(tnBytes) # 'N' Or ;
  tnBytes < 1 Or Vartype(tcDestino) # 'C' Or !Directory(tcDestino)
 Messagebox('Error de llamada.',16,'')
 Return -1
Endif

If Val(Left(Version(4),2)) < 7
 Messagebox('Debe modificar (y verificar) este programa para que corra en esta '+;
  'version',16,'Version no soportada')
 Return -1
Endif

tcDestino = Lower(Addbs(tcDestino))

Local x, nDevolver, nTamanio, nBytesEscritos, nMan, nManParte, nNroDisco As Integer
Local cAux, cCadenaleida, cAntesSafe, cFlog As String
Local lOk As Boolean

*--------------------------------------------------------------------------
*- como el programa parte en extenciones de 00n no se permiten partir
*- archivos con estas extenciones.
cAux = Justext(tcArchivo)
If Len(cAux) = 3  && si es # 3 no hay problema, pueden convivir.
 For x = 1 To Len(cAux)
  If !Isdigit(Substr(cAux, x, 1))
   lOk = .T.
   Exit
  Endif
 NEXT
ELSE
 lOk = .T.
Endif
*- continuar si la extencion no tiene solo numeros.
If !lOk
 Messagebox('No se permiten partir archivos con extenciones iguales a las '+;
  'que se usará en las partes.',16,'Excepción')
 Return -1
Endif
*--------------------------------------------------------------------------

cFlog = Sys(3)+'.log'

cAntesSafe = Set("Safety")
nDevolver = 0
If !File(tcArchivo)
 Messagebox(tcArchivo+' no existe.',16,'No existe el archivo')
 Return -1
Endif
tcArchivo = Lower(Locfile(tcArchivo))
*- verificar que el tamaño sea mayor que tnBytes
If Adir(aInfoFilePartir1, tcArchivo)#1
 Return -1
Endif
nTamanio = aInfoFilePartir1[1,2]  && tamaño total del archivo a partir
If nTamanio <= tnBytes
 Messagebox('No se puede partir en menos de 2 partes',16,'Parámetros incorrectos')
 Return -1
Endif

Set Safety Off
If !Empty(Sys(2000, tcDestino + Juststem(tcArchivo)+'.*'))
 *- hay que consultar asi y no erase dir*.*, porque el archivo original
 *- (de igual nombre y con otra extencion podria encontrarse en el mismo
 *- directorio destino)
 For x=0 To 999
  cAux = tcDestino + Juststem(tcArchivo)+'.'+Transform(x,@L 999')
  If File(cAux)
   Erase (cAux) recycle
  Endif
 Next
Endif

*- partir el archivo original:
nNroDisco = 1
nMan = Fopen(tcArchivo)
If nMan < 0
 Messagebox('No se puede abrir '+tcArchivo,16,'Operación cancelada')
 Return -1
Endif

Do While nTamanio > 0
 If nNroDisco > 999
  nDevolver = -1
  Messagebox('Demasiados archivos',16,'')
  Exit
 Endif

 cFileDestino = tcDestino + ;
  Forceext(Justfname(tcArchivo), Transform(nNroDisco, @L 999'))
 nManParte = Fcreate(cFileDestino)
 If nManParte < 0
  nDevolver = -1
  Messagebox('No se puede crear '+cFileDestino,16,'Operación cancelada')
  Exit
 Endif

 nEspacio = tnBytes
 Do While nEspacio > 0 And nTamanio > 0
  cCadenaleida = Fread(nMan, Min(10240, nEspacio))
  nBytesEscritos = Fwrite(nManParte, cCadenaleida) && escribir lo real leido
  If nBytesEscritos = 0
   nDevolver = -1
   Messagebox('No se puede escribir',16,'Operación cancelada')
   Exit
  Endif

  nEspacio = nEspacio - nBytesEscritos
  nTamanio = nTamanio - nBytesEscritos
 Enddo

 Fclose(nManParte)
 nDevolver = nNroDisco
 If nTamanio <= 0
  Exit
 Endif
 nNroDisco = nNroDisco + 1
Enddo
Fclose(nMan)
*- fin partir

Release aInfoFilePartir1
Set Safety &cAntesSafe

Return nDevolver
*- Par volver a unir las partes en el archivo original,
*- usar: unirarchivo_01.prg
*- JARSoft Argentina
Alberto Rodriguez

11 de junio de 2003

Aplicaciones MultiIdioma en VFP

En repetidas ocasiones, he comprobado que la realización de aplicaciones que puedan ejecutarse en diferentes idiomas ha sido uno de los puntos en los que más desarrolladores han expresado sus dudas.

En este artículo pretendo explicar una forma sencilla, pero que a su vez resulta muy potente para realizar aplicaciones Multi-Lenguaje en Visual Fox Pro.

La base de este desarrollo, será la creación de una tabla en donde se almacenen todos los textos que se mostrarán posteriormente en pantalla. Su formato será el siguiente:

ETIQUETAS Idioma01 C(200) Idioma02 C(200) (ambos campos con índice)

Como podemos imaginar, debemos de crear un campo por cada uno de los lenguajes a utilizar en nuestra aplicación.

Luego, simplemente añadiremos en esta tabla los textos que se correspondan a los distintos idiomas.

Ejemplo: Idioma01 Idioma02
Hola Hello

Para utilizarlo correctamente, debemos de cargar en el inicio de nuestra aplicación, una variable que indicará cual es el idioma activo (por ejemplo leyéndolo desde un fichero de configuración) y seleccionar el índice correcto.

Posteriormente, en nuestra clase base de aquellos controles que muestren texto, debemos de realizar algo parecido a lo siguiente:

Ejemplo para una label:

1) Creamos una variable global G_Idioma == "01".
2) Creamos una clase labelbase.
3) En el evento INIT, incluimos el siguiente código:
With This
   If !Empty(.Caption)
      This.Caption = Traducir(.Caption)
   endiF
Endwith
4) Creamos la funcion Traducir
Function Traducir
   Lparameters pTexto
   Local cTexto, cCampo

   cTexto = PADR(Alltrim(pTexto), 200)
   cCampo = "Idioma" + G_Idioma

   If SeeK(cTexto, "Etiquetas", cCampo)
      cTraducido = Alltrim(Eval("Etiquetas." + cCampo))
          Else 
              Append Blank In Etiquetas
  Replace I01 With pTexto In Etiquetas

  cTraducido = pTexto
   EndIf
Return cTraducido
Con la función Traducir podemos realizar la traducción de absolutamente todos los textos de la aplicación. Por supuesto, hay determinadas condiciones para que esto funcione: que la longitud del texto no supere el tamaño del campo, que tengamos un idioma de referencia (en el ejemplo es 01), etc.

Angel Casas

10 de junio de 2003

eBook Gratuito: SQL: A Practical Introduction

Libro que no debe faltar dentro de la biblioteca de desarrolladores de VFP, ademas... Gratuito.


Diseño del libro

CONTENIDO
  • Capitulo 1: Introduccion

  • Capitulo 2: Una guia hacia SQL

  • Capitulo 3: Creando y manejando Tablas

  • Capitulo 4: Consultando Tablas SQL.

  • Capitulo 5: Agregando y Actualizando Tablas

  • Capitulo 6: Integridad de Datos

  • Capitulo 7: Vistas

  • Capitulo 8: Seguridad de Base de Datos

  • Capitulo 9: Procesando Transacciones

  • Capitulo 10: Catalogos del Sistema de Base de Datos

  • Capitulo 11: Usando SQL con un el lenguaje del anfitrion

  • Apendice A: Tipos de datos estándares de ANSI/ISO

  • Apendice B: Base de Datos de Ejemplo


Este libro es excelente, trata desde los principios básicos del Lenguaje de Consultas Estructurado (Structured Query Language -SQL-), además revisa de forma adecuada las diferentes partes que abarca SQL como lo son el DML (Lenguaje de Manipulacion de Datos, Data Manipulation Language), DDL (Lenguage de Definición de Datos, Data Definition Language), seguridad, transacciones, catálogos de sistemas y un largo etcétera.

En esta edición no se revisa un manejador de base de datos específico, pues trata el SQL como un nivel más general, el cual podría ser implementado por cualquier DBMS. Está ampliamente recomendado para su lectura.

Para descargarlo pueden hacerlo desde esta dirección:

http://www.managedtime.com/freesqlbook.php3

Deberás antes llenar un pequeño formulario en el darás tu correo electrónico válido, esto es importante ya que la descarga es un .ZIP que viene con una contraseña, y se te mandará un correo electrónico indicandote la clave con la cual podrás descomprimirlo correctamente.

Espero lo disfruten...

Espartaco Palma Martínez

9 de junio de 2003

Listar Las Dlls Cargadas por Nuestro Programa

Este codigo nos permitira mostrar las dll's que han sido cargadas por nuestro programa, ya sea directa o indirectamente, por ejemplo si declaramos una funcion contenida en una Dll esta dll sera cargada por nuestro programa
Public oForm
oForm=Newobject("Lst_Dep")
oForm.Show
Return

Define Class Lst_Dep As Form
 Autocenter = .t.
 Height = 204
 Width = 702
 DoCreate = .T.
 Caption = "Dependecias"
 Name = "Frm_Lst_Dep"

 Add Object command1 As CommandButton With ;
  Top = 173, ;
  Left = 554, ;
  Height = 27, ;
  Width = 144, ;
  Caption = "Listar Dependencias", ;
  Name = "Command1"
 Add Object list1 As ListBox With ;
  ColumnCount = 2, ;
  ColumnWidths = "120,510", ;
  RowSourceType = 1, ;
  RowSource = "", ;
  FirstElement = 1, ;
  Height = 169, ;
  Left = 0, ;
  NumberOfElements = 0, ;
  Top = 1, ;
  Width = 696, ;
  Name = "List1"

 Procedure num2dword
  Lparameter tnNum
  Local c0,c1,c2,c3
  lcresult = Chr(0)+Chr(0)+Chr(0)+Chr(0)
  If tnNum < (2^31 - 1) then
   c3 = Chr(Int(tnNum/(256^3)))
   tnNum = Mod(tnNum,256^3)
   c2 = Chr(Int(tnNum/(256^2)))
   tnNum = Mod(tnNum,256^2)
   c1 = Chr(Int(tnNum/256))
   c0 = Chr(Mod(tnNum,256))
   lcresult = c0+c1+c2+c3
  Endif
  Return lcresult
 Endproc
 Procedure Load
  Declare Long GetCurrentProcessId In "kernel32"
  Declare Long CreateToolhelp32Snapshot In "kernel32" Long lFlags, Long lProcessID
  Declare Long Module32First In "kernel32" Long hSnapshot, String @cProc
  Declare Long Module32Next In "kernel32" Long hSnapshot, String @cProc
 Endproc
 Procedure command1.Click
  Local cProc As String, nLogico As Long, cCadena As String
  cProc =Space(549)
  lProcessID = GetCurrentProcessId()
  hSnapshot = CreateToolhelp32Snapshot(8, 0)
  With Thisform
   .LockScreen = .t. 
   .list1.Clear()
   cProc = .num2dword(548)+.num2dword(0)+.num2dword(0)+;
    +.num2dword(0)+.num2dword(0)+.num2dword(0)+.num2dword(0)+;
    +.num2dword(0)+Space(256)+Space(260)
   nLogico = Module32First(hSnapshot, @cProc)
   cCadena =Space(255)
   nCiclo =0
   Do While nLogico <>0
    nCiclo = nCiclo +1
    cCadena=Substr(cProc,33,255)
    .list1.AddListItem(Substr(cCadena,1,At(Chr(0),cCadena)-1),nCiclo,1)
    cCadena=Substr(cProc,290,259)
    .list1.AddListItem(Substr(cCadena,1,At(Chr(0),cCadena)-1),nCiclo,2)
    nLogico = Module32Next(hSnapshot, @cProc)
   Enddo
   .Caption = "Total Encontrados: " +Alltrim(Str(nCiclo))
   .LockScreen = .F. 
  Endwith
 Endproc
Enddefine
Saludos

Jorge Mota, Guatemala

29 de mayo de 2003

Conocer el Codigo RGB y Hexagecimal de un color de algún punto de la pantalla

Este Ejemplo muestra la forma como podemos obtener el codigo Rgb de ese color que nos gusta de X Aplicacion.

Solo basta con ejecutar este código, situar el mouse sobre el color que nos interese para ver el codigo en RGB (nRojo,nVerde, nAzul) que deberemos usar, o también el Hexagecimal para usarlo en codigo HTML.

Public oForm
oForm=Newobject("Toma_Color")
oForm.Show(1)
Return

Define Class Toma_Color As Form
 Height = 30
 Width = 350
 ShowWindow = 2
 DoCreate = .T.
 AutoCenter = .T.
 BorderStyle = 2
 Caption = "Toma-Color "
 ControlBox = .T.
 Closable = .T.
 HalfHeightCaption = .T.
 MaxButton = .F.
 MinButton = .F.
 ClipControls = .F.
 TitleBar = 1
 AlwaysOnTop = .T.
 Name = "Frm_Toma_Color"

 Add Object ColorHex As TextBox With ;
  Height = 25, ;
  Left = 33, ;
  Top = 2, ;
  Width = 108, ;
  Name = "ColorHex"
 Add Object timer1 As Timer With ;
  Top = 3, ;
  Left = 3, ;
  Height = 23, ;
  Width = 23, ;
  Interval = 500, ;
  Name = "Timer1"
 Add Object shape1 As Shape With ;
  Top = 2, ;
  Left = 3, ;
  Height = 24, ;
  Width = 24, ;
  Name = "Shape1"
 Add Object lrojo As Label With ;
  AutoSize = .T., ;
  FontBold = .T., ;
  BackStyle = 0, ;
  Caption = "R", ;
  Height = 17, ;
  Left = 158, ;
  Top = 6, ;
  Width = 10, ;
  Name = "lRojo"
 Add Object lverde As Label With ;
  AutoSize = .T., ;
  FontBold = .T., ;
  BackStyle = 0, ;
  Caption = "G", ;
  Height = 17, ;
  Left = 226, ;
  Top = 6, ;
  Width = 10, ;
  Name = "lVerde"
 Add Object lazul As Label With ;
  AutoSize = .T., ;
  FontBold = .T., ;
  BackStyle = 0, ;
  Caption = "B", ;
  Height = 17, ;
  Left = 294, ;
  Top = 6, ;
  Width = 10, ;
  Name = "lAzul"
 Add Object larojo As Label With ;
  AutoSize = .T., ;
  BackStyle = 0, ;
  Caption = "#", ;
  Height = 17, ;
  Left = 149, ;
  Top = 6, ;
  Width = 9, ;
  ForeColor = Rgb(255,0,0), ;
  Name = "larojo"
 Add Object laverde As Label With ;
  AutoSize = .T., ;
  BackStyle = 0, ;
  Caption = "#", ;
  Height = 17, ;
  Left = 216, ;
  Top = 6, ;
  Width = 9, ;
  ForeColor = Rgb(0,255,0), ;
  Name = "laVerde"
 Add Object laazul As Label With ;
  AutoSize = .T., ;
  BackStyle = 0, ;
  Caption = "#", ;
  Height = 17, ;
  Left = 284, ;
  Top = 6, ;
  Width = 9, ;
  ForeColor = Rgb(0,0,255), ;
  Name = "laAzul"
 Add Object color_r As TextBox With ;
  Format = "LK", ;
  Height = 23, ;
  InputMask = "999", ;
  Left = 168, ;
  Top = 3, ;
  Width = 41, ;
  Name = "Color_R"
 Add Object color_g As TextBox With ;
  Format = "LK", ;
  Height = 23, ;
  InputMask = "999", ;
  Left = 238, ;
  Top = 3, ;
  Width = 41, ;
  Name = "Color_G"
 Add Object color_b As TextBox With ;
  Format = "LK", ;
  Height = 23, ;
  InputMask = "999", ;
  Left = 305, ;
  Top = 3, ;
  Width = 41, ;
  Name = "Color_B"

 Procedure buf2word
  Lparameters cBuffer
  Return Asc(Substr(cBuffer, 1,1)) +;
   BitLShift(Asc(Substr(cBuffer, 2,1)),  8)+;
   BitLShift(Asc(Substr(cBuffer, 3,1)), 16)+;
   BitLShift(Asc(Substr(cBuffer, 4,1)), 24)
 Endproc

 Procedure convertir_color
 * Funcion Tomada de http://www.portalfox.com/article.php?sid=534
 * Enviada Por Luis Maria Guayan
 * Adaptada Para Obtener el Color en Hexagecimal
 * o la cantidad de Rojo, verde o Azul
  Lparameters nColor, nNumero
  Local cResult, nCiclo
  cResult= "#"
  For nCiclo= 1 To 3
   cResult= cResult+ Right(Transform(nColor%256,alltrim(" @0")),2)
   If nCiclo = nNumero
    Return (nColor %256)
   Endif
   nColor = Int(nColor/256)
  Endfor
  Return cResult
 Endproc

 Procedure Load
  Declare Long GetWindowDC In "user32" Long nHandle
  Declare Long GetPixel In "gdi32" Long hdc, Long nX, Long nY
  Declare Long GetCursorPos In "user32" String @cPuntero
  Declare Long GetDesktopWindow In "user32"
  Local cPos As String
  cPos= Space(20)
  GetCursorPos(@cPos)
  With This
   .AddProperty('hdc',GetWindowDC(GetDesktopWindow()))
   .AddProperty('nX',0)
   .AddProperty('nY',0)
   .nX=This.buf2word(Substr(cPos,1,4))
   .nY=This.buf2word(Substr(cPos,5,4))
  Endwith
 Endproc

 Procedure timer1.Timer
  Local cPos, nColor
  cPos =Space(20)
  GetCursorPos(@cPos)
  With Thisform
   .nX=.buf2word(Substr(cPos,1,4))
   .nY=.buf2word(Substr(cPos,5,4))
   nColor= GetPixel(.hdc,.nX,.nY)
   .shape1.BackColor = nColor
   .ColorHex.Value   = .convertir_color(nColor,0)
   .color_r.Value    = .convertir_color(nColor,1)
   .color_g.Value    = .convertir_color(nColor,2)
   .color_b.Value    = .convertir_color(nColor,3)
  Endwith
 Endproc
Enddefine

Saludos.

Jorge Mota, Guatemala

22 de mayo de 2003

Abrir cuadro de dialogo conectar a unidad de red

Esta función permite abrir el cuadro de diálogo conectar a unidad de red o impresora

#DEFINE RESOURCETYPE_DISK 1
#DEFINE RESOURCETYPE_PRINT 2

Declare Integer WNetConnectionDialog In Win32Api;
Integer Handle, Integer ResourceType

Declare Integer FindWindow In Win32Api;
Integer Handle, String cTitle

*-- Para conectar a una unidad de red
WNetConnectionDialog(FindWindow(0,_Screen.Caption), RESOURCETYPE_DISK)

*-- Para conectar a una impresora
WNetConnectionDialog(FindWindow(0,_Screen.Caption), RESOURCETYPE_PRINT)

Jairo Espinal

15 de mayo de 2003

Saber por API, si podemos abrir un archivo de forma exclusiva

Esta Api, nos permite saber si un archivo lo podemos abrir de manera Exclusiva

Si Devuelve .T., esta bloqueado por otra aplicación, útil para saber si esta en uso.
? EstaBloqueado("c:otr_atisaappreg01.dbf")
Function EstaBloqueado(cArchivo)
 Declare Long _lopen In "kernel32" as lOpen String lpPathName, Long iReadWrite
 Declare Long _lclose In "kernel32" as lClose Long hFile
 Local hFile As Long
 hFile = -1
 hFile = lOpen(cArchivo, 0x10)
 Result = hFile = -1
 lClose (hFile)
 Return Result
Endfunc
Jorge Mota

1 de mayo de 2003

Consumiendo Servicios Web con Microsoft Visual FoxPro

José G. Samper C.
VFP 7.0 y VFP 8.0

Con el surgimiento de SOAP y los Servicios Web se abre un mundo de posibilidades para la interconexión de plataformas y aplicaciones. Decimos que nos abre un mundo de posibilidades por que los Servicios Web nos permite el acceso a diversas funciones vía Web y de esta manera le damos funcionabilidad adicional y un valor agregado a nuestras aplicaciones.

Obteniendo información de WSDL

Como SOAP define un estándar WSDL, todo Servicio Web tiene una página XML con la descripción de los objetos, la sintaxis y métodos disponibles. Estas páginas nos sirven como referencia para la elaboración de la sintaxis de llamada y nos permite verificar si hubo cambios en el Servicio Web. No es necesario entender el documento para consumir un Servicio Web.

Ejemplo:

Para este artículo usaremos el Servicio Web de http://www.universalthread.com, cuando consultamos el WSDL de este Servicio obtenemos:


Invocando el Servicio Web desde nuestra aplicación Cliente

Para este artículo elaboraremos una pequeña aplicación que nos permita ver la Lista de Artículos disponibles y la Lista de Archivos disponibles para Downloads en Universal Thread. Dos de los 31 métodos disponibles de este Servicio Web.

1. Creamos nuestro proyecto


2. Creamos un formulario que contenga un Pageframe con dos Page, un Grid y un Commandbutton en cada Page.


3. En el INIT de nuestra forma escribimos nuestro código de invocación del Servicio Web.
Public lo_serv As Object
Local lc_user As String,lc_pasword As String
lo_serv=Createobject("mssoap.soapclient30") && Creamos Objeto Soap
lo_serv.mssoapinit("http://www.universalthread.com/WebService/universalthread.wsdl") 
**Solicitud del usuario y password requerido por el servicio Web
lc_user=''
lc_user = Inputbox("Usuario","Usuario de universalthread ")
lc_pasword=''
lc_pasword = Inputbox("Password","Password para "+lc_user)
If Empty(lc_user) Or Empty(lc_pasword)
 =Messagebox('Debe introducir Usuario y Password para acceder al sistema',16)
 Return .F.
Endif
** Autentificamos en www.universalthread.com
If !lo_serv.Login(lc_user,lc_pasword)
 =Messagebox('No se pudo autentificar su usuario en universalthread.com.',16)
 Return .F.
Endif
Thisform.pageframe1.page1.grid1.Visible=.F.
Thisform.pageframe1.page1.grid2.Visible=.F.

Observe que:

a. Creamos un objeto SOAP e inicializamos nuestro Servicio Web
b. Solicitamos el usuario y password requerido y luego autentificamos nuestro usuario en Universal Thread.

4. En el método Click de Commandbutton del Page1, escribimos nuestro código de llamada al método del Servicio Web que nos envía la Lista de Artículos disponibles en formato XML.
Local lc_xml As String
lc_xml=''
**Invocamos el método del web service que no devuelve la 
**lista de artículos de los ultimos 45 ías
lc_xml=lo_serv.GetArticle(Date()-45,Date(),5)
**Mostramos el XLM devuelto
=Messagebox(lc_xml,64)
If !Empty(lc_xml)
    ** Convertimos el XML devuelto en un cursor temporal
 Xmltocursor(lc_xml,'Carticulo')
 ** Seleccionamos nuestro cursor y lo mostramos en el Grid
 Select Carticulo
 Goto Top In Carticulo
 If !Eof('Carticulo')
  Thisform.pageframe1.page1.grid1.RecordSource='Carticulo'
  Thisform.pageframe1.page1.grid1.Visible= .T.
  Thisform.pageframe1.page1.grid1.Refresh()
 Endif
Endif

Observe que:
a. Invocamos al Servicio Web, solicitando la Lista de los Artículos.
b. Mostramos el XML devuelto por el Servicio Web, usted puede eliminar este código, dicho código fue colocado como demostración del XML devuelto.
c. Convertimos el XML en un Cursor temporal y lo mostramos en el Grid.

5. En el método Click de Commandbutton del Page2, escribimos nuestro código de llamada al método del Servicio Web que nos envía la Lista de Archivos disponibles para Downloads en formato XML.
Local lc_xml As String
lc_xml=''
**Invocamos el método del web service que no devuelve la 
**Lista de Archivos disponibles para Downloads de los últimos 20 días
lc_xml=lo_serv.GetDownload(DATE()-20,DATE(),5)      
**Mostramos el XLM devuelto
=Messagebox(lc_xml,64)
If !Empty(lc_xml)
    ** Convertimos el XML devuelto en un cursor temporal
 Xmltocursor(lc_xml,'CDownload')
 ** Seleccionamos nuestro cursor y lo mostramos en el Grid
 Select CDownload
 Goto Top In CDownload
 If !Eof('CDownload')
  Thisform.pageframe1.page2.grid1.RecordSource='CDownload'
  Thisform.pageframe1.page2.grid1.Visible= .T.
  Thisform.pageframe1.page2.grid1.Refresh()
 Endif
Endif

Observe que:
a. Invocamos al Servicio Web, solicitando la Lista de los Artículos.
b. Mostramos el XML devuelto por el Servicio Web, usted puede eliminar este código, dicho código fue colocado como demostración del XML devuelto.
c. Convertimos el XML en un Cursor temporal y lo mostramos en el Grid.

Ejecutando nuestra Aplicación

Al ejecutar nuestro formulario y autentificar con Universal Thread, ya podemos acceder a los métodos de programados en nuestro formulario. Al pulsar clic en cualquiera de los dos commandbutton obtendremos:

a. XML de la información solicitada al Servicio Web.


b. Con la función Xmltocursor() obtenemos un cursor con los datos del XML enviado por el Servicio Web.


Conclusiones:

Los servicios Web son una excelente opción para la integración de aplicaciones y agregarle funcionabilidad adicional a nuestras aplicaciones.


José G. Samper C., Caracas, Venezuela, es Analista Programador,Microsoft Most Valuable Profesional en Visual Fox Pro. Dedicado al desarrollo de sistemas desde el año 1991; siempre en Fox o en Visual Fox Pro. Actualmente especializándose en C# y Jefe de Proyectos Especiales en Softech Consultores, C.A.