Crear un buffer rapidamente

Primero, aclaremos conceptos. Llamo "buffer" a un objeto muy liviano cuya unica función es contener data temporal en forma de propiedades. En muchos sentidos vendría a ser como una versión light de un STRUCT, solo que sin la posibilidad de incluir métodos; solo propiedades.

Por ejemplo, si quiero pasar información sobre una persona de un form a otro, me seria muy útil pasar un solo parámetro que contuviera toda la información de esa persona. Una forma de lograr esto es crear una clase "Persona" que contenga las propiedades para almacenar la información sobre una persona, pero muchas veces queremos lograr lo mismo sin la sobrecarga de crear una clase que en si misma no hace nada.

Ese objeto "temporal" que sirve para almacenar múltiples informaciones relacionadas, es lo que llamo "buffer". La función crearBuffer hace justamente eso: crea un buffer con una lista de propiedades dada y, opcionalmente, inicializa esas propiedades con los datos suministrados; todo en una misma instrucción.

Ejemplo:

LOCAL oPersona
oPersona = crearBuffer("nombre,apellido,cedula,fechaNac,cargo","Victor","Espina","12345678",{18-11-1970})
 
?oPersona.Nombre --> "Victor"
?oPersona.Apellido --> "Espina"

Práctico, cierto? aqui les dejo el código fuente.

*-- crearBuffer
*   Funcion para crear un buffer de datos e inicializarlo. Compatible con VFP 5 o superior
*
*   Autor: V Espina
*
*   Ejemplo:
*   oBuff = CFDBuffer("Nombre,Apellido","Victor","Espina")
*   ?oBuff.Nombre -> "Victor"
*   ?oBuff.Apellido -> "Espina"
*
PROCEDURE crearBuffer
LPARAMETERS pcItemList,p0,p1,p2,p3,p4,p5,p6,p7,p8,p9,p10,p11,p12,p13,p14,p15,p16,p17,p18,p19
 *
 LOCAL oBuff,i,cProp
 oBuff=CREATEOBJECT("Custom")
 
 LOCAL cPropName,uPropValue,nCount
 LOCAL ARRAY aProps[1]
 nCount = ALINES(aProps,STRT(pcItemList,",",CHR(13)+CHR(10)))
 FOR i=1 TO MIN(nCount,20)
  cPropName = aProps[i]
  uPropValue = EVALUATE("P" + ALLTRIM(STR(i - 1)))
  oBuff.AddProperty(cPropName, uPropValue)
 ENDFOR
  
 RETURN oBuff
 *
ENDPROC

Victor Espina

Una manera distinta de armar un IN dinamico a partir de una lista de elementos

Esta es una situación que seguro les ha pasado muchas veces. Tienen un SP que recibe un parametro usado para filtrar sobre una tabla, digamos @status. Normalmente haríamos algo como esto:

SELECT *
  FROM tabla
 WHERE (@status IS NULL OR status = @status)

Eso nos permitiria filtrar por un status especifico o no filtrar por status, indicando el valor NULL. Pero luego nos topamos con una situación en la que necesitamos filtrar por DOS valores de status distintos, digamos, registros ACTIVOS y ANULADOS. Obviamente nuestra primera intención es hacer:

SELECT *
  FROM tabla
 WHERE (@status IS NULL OR status IN (@status))

lo cual no es una instrucción valida para SQL Server, sin importar lo logico que se vea. Normalmente la solución a esta situación pasa por la creación de una función que tome un VARCHAR con la lista de valores separados por coma y devuelva un TABLE con los valores ya separados, y luego usamos ese TABLE para hacer un FULL JOIN o un IN (SELECT).

Pero hoy encontre una solución bien sencilla, usando las desconocidas (al menos para mi) capacidades XML de SQL Server. La idea, basicamente, es usar la lista de valores para crear un XML y luego usar ese XML como una fuente datos en un IN (SELECT). Aplicando esto al ejemplo que mencionaba al principio, la cosa quedaria asi:

DECLARE @x XML
SET @x = '' + REPLACE( @status, ',', '') + ''

SELECT *
  FROM tabla
 WHERE status IN (SELECT x.j.value('.', 'VARCHAR(max)') AS item FROM @x.nodes('//j') x(j))

Simple, cierto?

Victor Espina

Abrir un cursor para lectura/escritura

Como sabemos, los cursores creados por el comando SELECT INTO en VFP son solo lectura. A partir de VFP 7 se incluyo una clausula llamada READWRITE que nos permite indicar si queremos que el cursor sea de lectura-escritura, lo cual es sumamente útil en infinidad de situaciones.

Sin embargo, para los que por algún motivo aun debemos seguir trabajando con versiones anteriores a VFP 6, convertir un cursor a lectura-escritura representa todo un reto. El truco mas usado para lograr esto en VFP 6 es usar la clausula NOFILTER para asegurarnos que VFP creara un cursor fisico temporal, hacer una copia fisica del cursor temporal con otro nombre, cerrar el cursor original y luego abrir el cursor temporal con el nombre original del cursor:

SELECT * FROM mitabla INTO CURSOR Q1 NOFILTER
SELECT Q1
COPY FILE (DBF("Q1")) TO ("Q1.TMP")
USE IN Q1
SELECT 0
USE ("Q1.TMP") ALIAS Q1

Pero esta solución dista mucho de ser perfecta, especialmente si el cursor original contaba con columnas cuyo nombre superara los 10 caracteres. En estos casos, el nombre de esas columnas era truncado lo cual causaba molestos problemas con las referencias a esas columnas en el código.

Hace un tiempo ayudé a un amigo a encontrar una forma de solventar este problema, y me encontré con que, como siempre, VFP me daba todas las herramientas necesarias para lograrlo; era solo cuestión de ponerlas a trabajar juntas.

En este caso, la ayuda llegó de mano de los arrays. Yo sabía desde siempre que VFP contaba con una función que tomaba la estructura de un DBF o cursor y la almacenaba en un array. Lo que no sabía es que tanto el comando CREATE CURSOR como INSERT INTO contenían la clausula FROM ARRAY.

El resultado? una función que recibe el nombre de un cursor solo-lectura y lo convierte en lectura-escritura respetando los nombres largos de columna.

Aqui les dejo la función por si les resulta útil (NOTA Nov 19: limpié y mejorpe un poco el código, ademas de corregir un problema cuando el cursor original estaba vacío).

* openForUpdate()
* Función que recibe un cursor de S/L y lo convierte en L/E respetando las columnas con nombres largos
*
* Autor: Victor Espina
*
PROCEDURE openForUpdate(pcCursor)
 *
 * Obtenemos el schema del cursor
 LOCAL ARRAY aSchema[1]
 AFIELDS(aSchema, pcCursor)
 
 * Obtenemos el contenido del cursor
 LOCAL ARRAY aRows[1]
 LOCAL nRowCount
 SELECT * FROM (pcCursor) INTO ARRAY aRows
 nRowCount = _TALLY
 
 * Cerrar el cursor original, lo recreamos como un cursor de L/E
 * y lo llenamos con los datos originales (si habia)
 SELECT (pcCursor)
 USE
 CREATE CURSOR (pcCursor) FROM ARRAY aSchema
 IF nRowCount > 0 
  INSERT INTO (pcCursor) FROM ARRAY aRows
 ENDIF
 GO TOP 
 *
ENDPROC

Victor Espina

Consumir cualquier Web Service con Visual FoxPro

Este artículo es para mostrarles como podemos invocar cualquier Web Services desde Visual FoxPro.

Primero quisiera comentar, que NO soy un experto en ésto de los WEB services, pero he tomado algo de experiencia en el uso de los mismos. En éste artículo trataré de explicarlo con palabras simples.

Es importante leer al respecto, siempre es sencillo encontrar información en Wikipedia.

Vamos comenzando por la lógica de "ejecución" de un web service:

1. Creamos la petición de ejecución de una función del Web Service, ésto se llama XML REQUEST.
2. Enviamos el REQUEST al web service, la cual es una URL que termina con wsdl.
3. Obtenemos un XML RESPONSE, que es el resultado de haber invocado la función específica del WS.

Vamos por partes:

Para saber como es el REQUEST, utilizo una aplicación Open Source llamada soapUI, la cual pueden descargar desde: http://www.soapui.org/

Lo descargamos, al abrir el soapUI vemos ésto:



La URL del web service es: http://www.webservicex.net/globalweather.asmx?WSDL



Con ésto, soapUI interperta las funciones que existen en ése WebService, y nos crea un ejemplo de REQUEST por cada una de ellas, en éste caso observaremos como el REQUEST de la función GetWeather:



Hasta aquí, tenemos cubierto el paso 1 de la ejecución de un Web Service, el dos es simple.. damos clic en el botón de "PLAY" y se cumple el segundo paso, al mismo tiempo que obtenemos el XML RESPONSE:

Funciones de fechas definidas por el usuario

Un resumen de diversas funciones de fecha definidas por el usuario que complementan las funciones de Fecha que provee Visual FoxPro.

A lo largo de mi vida como desarrollador, fui acumulando diversas funciones definidas por el usuario, para distintos tipos de necesidades. En el caso de Fechas he recopilado varias funciones, (algunas fueron ya publicadas en el artículo Trabajar con fechas y horas en Visual FoxPro) que se fueron mejorando por distintos participantes de los foros que yo participo.

Aquí un resumen de funciones referidas a Meses:

* Números de días del mes (Number Days Of Month)

? nDoM(DATE(2012,2,1))

FUNCTION nDoM(tdFecha)
  RETURN DAY(GOMONTH(DATE(YEAR(tdFecha),MONTH(tdFecha),1),1)-1)
ENDFUNC 

* Principio del mes (Begin Of Month)

? BoM(DATE())

FUNCTION BoM(tdFecha)
  RETURN DATE(YEAR(tdFecha),MONTH(tdFecha),1)
ENDFUNC 

* Fin de mes (End Of Month)

? EoM(DATE())

FUNCTION EoM(tdFecha)
  RETURN GOMONTH(DATE(YEAR(tdFecha),MONTH(tdFecha),1),1)-1
ENDFUNC 

*- Fin del trimestre (End Of Quarter)

? EOQ(DATE())

FUNCTION EOQ(tdFecha)
  RETURN GOMONTH(DATE(YEAR(tdFecha),CEILING(MONTH(tdFecha)/3)*3,1),1)-1
ENDFUNC

Las siguientes funciones retornan la fecha de un día específico, como por ejemplo el primer lunes de enero, o el último domingo de febrero

*-- Tercer Domingo de Octubre de 2011

? OrdDOW(3,1,10,2011)

FUNCTION OrdDOW(tnOrd,tnDow,tnMonth,tnYear)
  * tnOrd:   1=Primero, 2=Segundo, 3=Tercero, ...
  * tnDow:   1=Domingo ... 7=Sabado
  * tnMonth: 1=Enero ... 12=Diciembre
  * tnYear:  1900 ... 9999
   RETURN DATE(tnYear,tnMonth,1)+tnOrd*7- ;
      DOW(DATE(tnYear,tnMonth,1)+tnOrd*7-1,tnDow)
ENDFUNC

* Último Miercoles de Octubre de 2011

? LastDOW(4,9,2011)

FUNCTION LastDOW(tnDow,tnMonth,tnYear)
  * tnDow:   1=Domingo ... 7=Sabado
  * tnMonth: 1=Enero ... 12=Diciembre
  * tnYear:  1900 ... 9999
  LOCAL ld
  ld = GOMONTH(DATE(tnYear,tnMonth,1),1)-1
  RETURN ld - (DOW(ld) - tnDow) % 7
ENDFUNC

Luis María Guayán

¿Necesitas rellenar formularios WEB desde VFP?

Bueno este ultimo aporte se comprueba la ejecución de código PHP desde VFP como también el paso de parámetros con el método POST que hace posible poder reemplazar o emular un formulario web siempre y cuando este no posea el famoso captcha que son esas imágenes deformadas que debemos tipear en un campo, bueno esta método o mejor dicho algo parecido es el que usan esos robot form o roboform o como sean que les llamen a esos programas que rellenan un par de miles de veces el mismo formulario con el objetivo de colapsar el servidor.

Mas sobre formularios, para poder rellenar un formulario WEB desde VFP debes abrir este con el navegador y verificar el código que te trae, y busca los nombres de campos que quieres rellenar y que método generalmente es algún PHP) es el que procesa esta información, posteriormente armas tu PRG en VFP para el envío de estas variables y su contenido.

¿Que otras cosas podríamos hacer?Por ejemplo:

• lanzar un backup de mysql desde un terminal VFP
• lanzar cualquier comando y/o programa siempre y cuando tenga acceso en el servidor
• analizar la comunicación entre el servidor y el cliente web

A pesar de que existen herramientas mejores como ssh para ejecuciones remotas y otras herramientas de análisis de trafico pero en fin.

Se muestran a continuación 4 segmentos de código:

1. el código FOXPRO que hace las llamadas y recibe los resultados.
2. código PHP que recibe los parámetros del VFP y ejecuta instrucciones y devuelve el control al VFP
3. el formulario HTML que estamos emulando desde el VFP
4. la base de datos MySql para hacer la prueba

Requerimientos

• WIN7 no probé versiones inferiores
• VFP8.0 o superior debería funcionar desde la 6.0 pero no lo probé
• Yo use fedora 10 con apache 2.2.10, PHP 5.2.6 y MySql 5.0.67 pero alternativamente podríamos utilizar xampp (win32 portable), o wamp o similares que se ejecutan en la misma maquina

*//--------------------------------------------------------------------------------------------
*//............................................................................................
*//......Fecha:   18-08-2011.............................................................
*//......Autor:   OMAR DUILIO ROJAS FORNERON.............................................
*//......Localidad:  Encarnación-Paraguay...orodrf@gmail.com................................
*//......Funcion:  Ejecuta un metodo php y envia ciertos parametros por metodo POST.......
*//......    Es basicamente un metodo que ejecuta una rutina php en un servidor y...
*//......    que envia parametros, para que me podia servir esto? bueno supongamos..
*//......    que hay algun servidor que tiene un formulario y que deseas rellenar...
*//......    desde el VFP (como los formsbot o roboform) siempre y cuando no tenga..
*//......    el famoso captcha que es una imagen distorcionada de letras/numeros....
*//......    que debemos ingresar tambien en un campo...............................
*//......    Requisitos:
*//......    Tener un servidor web con soporte php y mysql ((como apache)) y un ....
*//......    terminal con posibilidad de correr VFP................................. 
*//......    server.................................................................
*//......    Existen excelentes herramientas como WAMP, XAMPP (portable) y otros en.
*//......    la que se ejecutan en la misma maquina sin necesidad de un servidor....
*//......    .......................................................................
*//......Compatib.:  Ha sido desarrollado y probado con VFP8.0 y en win7 con firefox5.y.....
*//......    como servidor use un fedora10 c/apache 2.2.10, php5.2.6 y mysql 5.0.67.
*//............................................................................................
*//--------------------------------------------------------------------------------------------
LOCAL oHttp,vhost,dbase,vuser,vpass


*// estas variables son utilizadas en php
* $dbhost=$_POST["vhost"];   /*HOSTNAME*/
* $dbasen=$_POST["dbase"];   /*DATABASE*/
* $dbuser=$_POST["vuser"];   /*USERNAME*/
* $dbpass=$_POST["vpass"];   /*USERPASS*/
xhost ="192.168.1.3"     &&nombre del servidor obs: usen IP los nombres no siempre funcionan
xbase ="xdbase"      &&nombre de la base de datos mysql
xuser ="admin"      &&nombre del usuario
xpass ="admin"      &&contraseña

&&parametros que pasaremos a php
xparameters="&vhost="+xhost+;
   "&dbase="+xbase+;
   "&vuser="+xuser+;
   "&vpass="+xpass

oHttp = CreateObject( "MSXML2.XMLHTTP" )
oHttp.Open( "post", "http://"+xhost+"/php/x.php", .f.)
oHttp.setRequestHeader("Content-Type", "application/x-www-form-urlencoded")
oHttp.Send( xparameters )

* muestra los estados de respuesta
? oHttp.Status
? oHttp.StatusText
? "Response length:", LEN(oHttp.StatusText)
? oHttp.GetAllResponseHeaders()
? oHttp.GetResponseHeader("content-type")

* envia codigos html devueltos por php a un archivo de texto y al navegador
DELETE FILE ([C:\TEMP\RESPONSE.HTML])
STRTOFILE( oHttp.ResponseText, [C:\TEMP\RESPONSE.HTML] )
MODI FILE ([C:\TEMP\RESPONSE.HTML]) NOWAIT
RELEASE oHTTP
RUN [EXPLORER C:\TEMP\RESPONSE.HTML] /N
RETURN
*// FIN DEL PROGRAMA VFP
*//----------------------------------------------------------------------------------------------------------

* codigo php llamado desde VFP
 /*
 //--------------------------------------------------------------------------------------------
 //............................................................................................
 //......Fecha:   18-08-2011............................................................
 //......Autor:   OMAR DUILIO ROJAS FORNERON............................................
 //......Localidad:  Encarnación-Paraguay...orodrf@gmail.com...............................
 //......Funcion:  Metodo de ejemplo, para ser llamado desde VFP por metodo POST.........
 //......    lo unico que hace es conectarse al servidor mysql y mostrar una tabla.
 //......    llamada producto de la base de datos xbase............................
 //--------------------------------------------------------------------------------------------
 */
 
 echo "<html>";
 echo "<head>";
 echo "<title>Codigo php ejecutado desde VFP, by ODRF++</title>";
 echo "</head>";
 echo "<body>";
 
 
 $dbhost=$_POST["vhost"];   /*HOSTNAME*/
 $dbasen=$_POST["dbase"];   /*DATABASE*/
 $dbuser=$_POST["vuser"];   /*USERNAME*/
 $dbpass=$_POST["vpass"];   /*USERPASS*/
 
 echo "debug: [";
 echo $dbhost,$dbasen,$dbuser,$dbpass;
 print( "]\n" );
 
 // connect to mysql
 if ( !($link=mysql_connect( $dbhost, $dbuser, $dbpass)) ) {
  echo "Error conectando a MYSQL";
  exit();
 }
 if (!mysql_select_db( $dbasen, $link)) {
  echo "Error seleccionando la base de datos";
  exit();
 }
 
 // consultamos la base de datos
 $res=mysql_query( "select * from producto limit 40", $link );
 if (!$res) {
  echo "la consulta fallo".mysql_error();
  exit();
 }
 
 // traemos registros seleccionados
 echo "<table summary=summary frame=box>";
 while ( $frec=mysql_fetch_array( $res ) ) {
  echo "<tr>";
  echo "<td>",$frec["codigo"],"</td>";
  echo "<td>",$frec["nombre"],"</td>";
  echo "<td>",$frec["codiva"],"</td>";
  echo "</tr>";
 }
 echo "</table>";
 mysql_free_result($res);
 
 
 // disconnect
 mysql_close( $link );
 echo "</body>";
 echo "</html>";

*// el siguiente es codigo del formulario que suplantamos o emulamos desde vfp podria nombrarse como INDEX.HTML
*<body>
* <h1>*** Datos de productos ***, testing php, mysql and httpd</h1>
* <form method="post" action="x.php">
* <fieldset>
*  <legend>Login de usuario:</legend>
*  <table>
*   <tr>
*    <td><label>Hostname</label></td>
*    <td><input name="vhost" type="text"  value="" size="20" maxlength="50"></td>
*   </tr>
*   <tr>
*    <td><label>Database</label></td>
*    <td><input name="dbase" type="text" value="" size="20" maxlength="50"></td>
*   </tr>
*   <tr>
*    <td><label>User</label></td>
*    <td><input name="vuser" type="text"  value="" size="20" maxlength="50"></td>
*   </tr>
*   <tr>
*    <td><label>Pass</label></td>
*    <td><input name="vpass" type="text"  value="" size="20" maxlength="50"></td>
*   </tr>
*  </table>
*  <hr width="100%">
*  <input name="send" type="submit" value="Enviar">
*  <input name="defa" type="reset"  value="Descartar">
*  <br>
* </fieldset>
*
*</body>
*</html>
*//----------------------------------------------------------------------------------------------------------
<!--pagebreak-->

*// y por ultimo la base de datos mysql guardarlo en algun lugar accesible al servidor mysql como x.sql
*//    para importarlo al mysql ejecutar 
*// WIN-SHELL  mysql -u root -p < C:\TEMP\x.sql
*// LINUX-SHELL  mysql -u root -p < /home/x.sql
*//  ambos deben tener la direccion exacta donde guardaron este fichero
-- MySQL dump 10.13  Distrib 5.1.41, for Win32 (ia32)
--
-- Host: localhost    Database: xdbase
-- ------------------------------------------------------
-- Server version 5.1.41

/*!40101 SET @OLD_CHARACTER_SET_CLIENT=@@CHARACTER_SET_CLIENT */;
/*!40101 SET @OLD_CHARACTER_SET_RESULTS=@@CHARACTER_SET_RESULTS */;
/*!40101 SET @OLD_COLLATION_CONNECTION=@@COLLATION_CONNECTION */;
/*!40101 SET NAMES utf8 */;
/*!40103 SET @OLD_TIME_ZONE=@@TIME_ZONE */;
/*!40103 SET TIME_ZONE='+00:00' */;
/*!40014 SET @OLD_UNIQUE_CHECKS=@@UNIQUE_CHECKS, UNIQUE_CHECKS=0 */;
/*!40014 SET @OLD_FOREIGN_KEY_CHECKS=@@FOREIGN_KEY_CHECKS, FOREIGN_KEY_CHECKS=0 */;
/*!40101 SET @OLD_SQL_MODE=@@SQL_MODE, SQL_MODE='NO_AUTO_VALUE_ON_ZERO' */;
/*!40111 SET @OLD_SQL_NOTES=@@SQL_NOTES, SQL_NOTES=0 */;

--
-- Table structure for table 'producto'
--
CREATE DATABASE xdbase IF NOT EXISTS;
USE xdbase;


DROP TABLE IF EXISTS 'producto';
/*!40101 SET @saved_cs_client     = @@character_set_client */;
/*!40101 SET character_set_client = utf8 */;
CREATE TABLE 'producto' (
  'CODIGO' char(15) NOT NULL,
  'NOMBRE' char(55) NOT NULL,
  'CODIVA' char(3) NOT NULL,
  'CODMED' char(5) NOT NULL,
  'XTIPO' char(1) NOT NULL,
  'XGRUPO' char(3) NOT NULL,
  'CODBAR' char(20) NOT NULL,
  'foto' mediumblob NOT NULL,
  PRIMARY KEY ('CODIGO','NOMBRE','CODBAR')
) ENGINE=MyISAM DEFAULT CHARSET=latin1;
/*!40101 SET character_set_client = @saved_cs_client */;

--
-- Dumping data for table 'producto'
--

LOCK TABLES 'producto' WRITE;
/*!40000 ALTER TABLE 'producto' DISABLE KEYS */;
INSERT INTO 'producto' VALUES ('0002GOL','ESPEJO','10G','1  1','1','1','','ABCDEFG'),
('00093','RETEN','10G','1  1','1','1','','ABCDEFG'),
('00101004','SOPORTE','10G','1  1','1','1','','ABCDEFG'),
('00105180MB','GOMA RADIADOR INFERIOR','00E','1  1','1','1','','ABCDEFG'),
('001120','LIMPIA PARABRISAS','10G','1  1','1','2','','ABCDEFG'));º
/*!40000 ALTER TABLE 'producto' ENABLE KEYS */;
UNLOCK TABLES;
/*!40103 SET TIME_ZONE=@OLD_TIME_ZONE */;

/*!40101 SET SQL_MODE=@OLD_SQL_MODE */;
/*!40014 SET FOREIGN_KEY_CHECKS=@OLD_FOREIGN_KEY_CHECKS */;
/*!40014 SET UNIQUE_CHECKS=@OLD_UNIQUE_CHECKS */;
/*!40101 SET CHARACTER_SET_CLIENT=@OLD_CHARACTER_SET_CLIENT */;
/*!40101 SET CHARACTER_SET_RESULTS=@OLD_CHARACTER_SET_RESULTS */;
/*!40101 SET COLLATION_CONNECTION=@OLD_COLLATION_CONNECTION */;
/*!40111 SET SQL_NOTES=@OLD_SQL_NOTES */;

-- Dump completed on 2011-07-29 16:50:16
*----------------------------------------------------------------------------------------------

Rutina que genera un archivo de texto .sql con formato de Backup MySql

Rutina en VFP 8.0 que genera un backup (un archivo de texto .sql con formato de Backup MySql) que puede ser importado desde un servidor MySql

Mediante la sentencia:

mysql -u root -p < xSQL.sql

donde xSQL.sql es el archivo generado mediante esta rutina.

Con la intención de que a alguien le pueda servir ya que también puede ser utilizado para migrar los datos de sistemas hechos en Clipper 5x o dBase hacia un servidor MySql.

Se envía sin ningún tipo de garantía, lo he probado y funciona!!! pero no pretendo ganarme ningún problema legal por el mal uso del mismo!!!

Funciona básicamente cargando en una matriz todas las tablas de un directorio, posteriormente es leído tabla por tabla y enviado las sentencias SQL que genera la estructura de la tabla.

Posteriormente si tiene registros la tabla entonces son enviados cada uno de ellos en forma de instrucción INSERT tal cual lo haríamos de forma manual. se utiliza la misma forma o formato que hace MYSQLDUMP es decir un backup generado desde MySql.

En fin, si a alguien le sirve y si lo mejora y lo publica mejor todavía!!!!

Cualquier consulta y/o aclaración tienen mi correo!!!

OMAR ROJAS
orodrf@gmail.com

*//-----------------------------------------------------------------------------------------
*//.........................................................................................
*//......Fecha:      26-07-2011.............................................................
*//......Autor:      OMAR DUILIO ROJAS FORNERON.............................................
*//......Localidad:  Encarnación-Paraguay...xodrf@hotmail.com...............................
*//......Funcion:    Envia una(as) tabla(s) DBF a un servidor mysql.........................
*//......            Es decir pide un directorio y lee la estructura de cada tabla DBF que..
*//......            existe en el y lo envia con sus datos a un archivo de texto con........
*//......            formato de backup que deberia ser tomado por cualquier servidor como...
*//......            mysql y hasta con pocos cambios deberia funcionar para cualquier SQL...
*//......            server.................................................................
*//......Compatib.:  Ha sido desarrollado y probado con VFP8.0 pero deberia funcionar con ..
*//......            todas las verciones desde VFP6.0 en adelante...........................
*//.........................................................................................
*//-----------------------------------------------------------------------------------------

*// inicialización
SET DATE TO ITALIAN
SET SAFETY OFF
SET SCOREBOARD OFF
SET TALK OFF
#define XCOMM  "-- "  &&definimos los caracteres de comentario para el servidor mysql

*//
*//   Generamos un archivo de salida en formato texto
*//
_Xdir=GETDIR( CURDIR(), [Indique el Directorio] )
IF EMPTY( _Xdir )==.T.
  RETURN
ENDIF
_Len=ADIR( _Mat, _Xdir+"*.DBF" )
IF _Len==0
  MESSAGEBOX( [NO SE ENCONTRO NINGUNA TABLA], 61, [WARNING] )
  RETURN
ENDIF

*//---------------------------------------------------------------
* mysql tables type:
*    TINYINT[(length)] [UNSIGNED] [ZEROFILL]
*  | SMALLINT[(length)] [UNSIGNED] [ZEROFILL]
*  | MEDIUMINT[(length)] [UNSIGNED] [ZEROFILL]
*  | INT[(length)] [UNSIGNED] [ZEROFILL]
*  | INTEGER[(length)] [UNSIGNED] [ZEROFILL]
*  | BIGINT[(length)] [UNSIGNED] [ZEROFILL]
*  | REAL[(length,decimals)] [UNSIGNED] [ZEROFILL]
*  | DOUBLE[(length,decimals)] [UNSIGNED] [ZEROFILL]
*  | FLOAT[(length,decimals)] [UNSIGNED] [ZEROFILL]
*  | DECIMAL(length,decimals) [UNSIGNED] [ZEROFILL]
*  | NUMERIC(length,decimals) [UNSIGNED] [ZEROFILL]
*  | DATE
*  | TIME
*  | TIMESTAMP
*  | DATETIME
*  | CHAR(length) [BINARY | ASCII | UNICODE]
*  | VARCHAR(length) [BINARY]
*  | TINYBLOB
*  | BLOB
*  | MEDIUMBLOB
*  | LONGBLOB
*  | TINYTEXT [BINARY]
*  | TEXT [BINARY]
*  | MEDIUMTEXT [BINARY]
*  | LONGTEXT [BINARY]
*  | ENUM(value1,value2,value3,...)
*  | SET(value1,value2,value3,...)
*  | spatial_type
*//---------------------------------------------------------------

*//------------------------------------------------------
*// buscamos destino de fichero de texto de salida
_olddir=CURDIR()
_MisDoc=[C:\TEMP\]
CD( _MisDoc )
_Salida=PUTFILE( "Fichero de Salida", "XSQL", "SQL" )
CD( _olddir )
IF EMPTY( _Salida )
  RETURN
ENDIF

*//------------------------------------------------------
*// apertura del fichero a bajo nivel
_han=FCREATE( _Salida, 0 )
IF FERROR()!=0 .OR. _han==-1
  RETURN
ENDIF
_tab=CHR(9)
_eol=CHR(13)+CHR(10)

*//------------------------------------------------------
*//  enviamos cabecera
*//------------------------------------------------------
FPUTS( _han, XCOMM+"*//............................................................................................" )
FPUTS( _han, XCOMM+"*//......Fecha:         "+DTOC(DATE())+"......................................................." )
FPUTS( _han, XCOMM+"*//......Autor:         OMAR ROJAS............................................................." )
FPUTS( _han, XCOMM+"*//......Localidad:     Encarnación-Paraguay...xodrf@hotmail.com..............................." )
FPUTS( _han, XCOMM+"*//......               Backup generado desde VFPX............................................." )
FPUTS( _han, XCOMM+"*//......               ......................................................................." )
FPUTS( _han, XCOMM+"*//......               para importar desde mysql ejecutar el siguiente comando................" )
FPUTS( _han, XCOMM+"*//......               WIN-SHELL:    mysql -u root -p < C:\xSQL.sql..........................." )
FPUTS( _han, XCOMM+"*//......               LINUX-SHELL:  mysql -u root -p < /home/xSQL.sql........................" )
FPUTS( _han, XCOMM+"*//............................................................................................" )
FPUTS( _han, XCOMM+"*//............................................................................................" )
FPUTS( _han, XCOMM )
FPUTS( _han, XCOMM )
FPUTS( _han, XCOMM+[*// CAMBIAR EL NOMBRE DE LA BASE DE DATOS A UTILIZAR] )
FPUTS( _han, [CREATE DATABASE IF NOT EXIST mibasededatos;] )
FPUTS( _han, [USE mibasededatos;] )
FPUTS( _han, XCOMM )
FPUTS( _han, XCOMM )

*//------------------------------------------------------
*// procesamos cada elemento de matriz (cada tabla)
_gir=1
FOR _gir=1 TO _Len STEP 1
  
  USE (_Xdir+_Mat[ _gir, 1]) IN 0 ALIAS XTABLE NOUPDATE
  _Table=SUBSTR( _Mat[ _gir, 1 ], 1, AT( ".", _Mat[ _gir, 1 ], 1 )-1 )
  FPUTS( _han, "CREATE TABLE "+_Table+" (" )
  IF UPPER(_Table)=="FOXUSER"
    USE IN XTABLE
    _gir=_gir+1
    LOOP
  ENDIF
  
  *// captura campos
  _col  =1
  _Slen  =AFIELDS( _Struct, [XTABLE] )
  FOR _Sgir=1 TO _Slen STEP 1

    *//----------------------------------------------------------
    *// realizamos las conversiones de campos DBF a mysql
    *Field type: 
    *C=Character
    *D=Date
    *L=Logical
    *M=Memo
    *N=Numérico
    *F=Float
    *I=Integer
    *B=Double
    *Y=Currency
    *T=DateTime
    *G=General
    DO CASE
      CASE _Struct[_Sgir,2]=="C"
        _type  ="CHAR ("+ALLTRIM(STR(_Struct[_Sgir,3],3,0))+")"
      
      CASE _Struct[_Sgir,2]=="D"
        _type  ="DATE"
      
      CASE _Struct[_Sgir,2]=="L"
        _type  ="TINYINT (1)"
      
      CASE _Struct[_Sgir,2]=="M"
        _type  ="LONGTEXT"
      
      CASE _Struct[_Sgir,2]=="N"
        _type  ="DOUBLE ("+ALLTRIM(STR(_Struct[_Sgir,3],3,0))+", "+ALLTRIM(STR(_Struct[_Sgir,4],2,0))+")"
      
      CASE _Struct[_Sgir,2]=="F"
        _type  ="FLOAT ("+ALLTRIM(STR(_Struct[_Sgir,3],3,0))+", "+ALLTRIM(STR(_Struct[_Sgir,4],2,0))+")"
      
      CASE _Struct[_Sgir,2]=="I"
        _type  ="INT ("+ALLTRIM(STR(_Struct[_Sgir,3],3,0))+")"
      
      CASE _Struct[_Sgir,2]=="B"
        _type  ="DOUBLE ("+ALLTRIM(STR(_Struct[_Sgir,3],3,0))+", "+ALLTRIM(STR(_Struct[_Sgir,4],2,0))+")"
      
      CASE _Struct[_Sgir,2]=="Y"
        _type  ="DOUBLE ("+ALLTRIM(STR(_Struct[_Sgir,3],3,0))+", "+ALLTRIM(STR(_Struct[_Sgir,4],2,0))+")"
      
      CASE _Struct[_Sgir,2]=="T"
        _type  ="DATETIME"
      
      CASE _Struct[_Sgir,2]=="G"
        _type  ="LONGTEXT BINARY"
        
    ENDCASE
    _line=_tab+_Struct[_Sgir,1]+" "+_type
    FPUTS( _han, IIF( _Sgir<_Slen, _line+",", _line ) )
    
  ENDFOR
  RELEASE _line,_type
  
  *//
  *//  aca deberia verificarse y alterar el codigo de modo tal que permita generar las claves de indexado
  *//  complejas de VFP de modo tal que sea equivalente en mysql, el siguiente simplemente cuando tiene
  *//  una clave de indexado compleja la omite es decir no crea ningun indice para la tabla mysql
  *//  una expresion compleja seria algo como sigue:
  *//  index on campo1+campo2 o DTOS(fecha) u otros similares to ... 
  *//
  
  *// captura de indices
  _TagName=LEFT( _Mat[ _gir, 1], AT( ".", _Mat[ _gir, 1 ] )-1 )+".CDX"
  _ltag=TAGCOUNT()
  IF _ltag>0
    
    *// OMITIMOS EXPRESIONES COMPLEJAS EN INDICES
    FOR _Sgir=1 TO _ltag
      _sexp  =KEY( _Sgir )
      _lsexp  =LEN( ALLTRIM( _sexp ) )
      _error  =.F.
      _kstr  =""
      _ckey  =0
      FOR _tgir=1 TO _lsexp
        _byte=ASC(SUBSTR(_sexp,_tgir,1))
        IF !(BETWEEN(_byte,48,57) OR BETWEEN(_byte,65,97) OR BETWEEN(_byte,90,122))
          _error=.T.
        ENDIF
      ENDFOR
      IF _error
        LOOP
      ENDIF
      _Kstr=_Kstr+IIF( _ckey>1,",", "" ) + KEY( _Sgir )
      _ckey=_ckey+1
    ENDFOR
    IF _ckey>0
      FSEEK( _han, -2, 1 )
      FPUTS( _han, "," )
      FWRITE( _han, _tab+[PRIMARY KEY(]+_Kstr+[)] )
    ENDIF
    RELEASE _kstr,_sexp,_ltag,_ckey,_TagName,_ltag

  ENDIF
  FPUTS( _han, " );" )

  *// solo si hay registros en la tabla DBF procedemos a insertarlos 
  IF RECCOUNT()>0

    *//--------------------------------------------------------------------
    *// enviamos sentencia insert con los campos
    _line=""
    FOR _Sgir=1 TO _Slen STEP 1
      _line=_line+_Struct[_Sgir,1]+IIF( _Sgir<_Slen, ",", "" )
    ENDFOR
    FPUTS( _han, "INSERT INTO "+_Table+" ("+_line+") VALUES" )
  
    *// enviamos cada registro de la tabla
    SELECT XTABLE
    GO TOP
    DO WHILE !EOF()
      
      _line="("
      
      IF DELETED()
        SKIP +1
        LOOP
      ENDIF
      SCATTER TO _rec
      FOR _Sgir=1 TO _Slen STEP 1
        DO CASE
          CASE _Struct[_Sgir,2]=="C"
            _value=CHR(39)+ALLTRIM(_rec[_Sgir])+CHR(39)
          CASE _Struct[_Sgir,2]=="D"
            _value=CHR(39)+STRTRAN( STR(YEAR(_rec[_Sgir]),4,0)+"-"+STR(MONTH(_rec[_Sgir]),2,0)+"-"+STR(DAY(_rec[_Sgir]),2,0), " ", "0" )+CHR(39)
          CASE _Struct[_Sgir,2]=="L"
            _value=CHR(39)+IIF( _rec[_Sgir], "1", "0" )+CHR(39)
          CASE _Struct[_Sgir,2]=="M"
            _value=CHR(39)+_rec[_Sgir]+CHR(39)
          CASE _Struct[_Sgir,2]=="N"
            _value=CHR(39)+ALLTRIM(STR(_rec[_Sgir],_Struct[_Sgir,3],_Struct[_Sgir,4]))+CHR(39)
          CASE _Struct[_Sgir,2]=="F"
            _value=CHR(39)+ALLTRIM(STR(_rec[_Sgir],_Struct[_Sgir,3],_Struct[_Sgir,4]))+CHR(39)
          CASE _Struct[_Sgir,2]=="I"
            _value=CHR(39)+ALLTRIM(STR(_rec[_Sgir],_Struct[_Sgir,3],_Struct[_Sgir,4]))+CHR(39)
          CASE _Struct[_Sgir,2]=="B"
            _value=CHR(39)+ALLTRIM(STR(_rec[_Sgir],_Struct[_Sgir,3],_Struct[_Sgir,4]))+CHR(39)
          CASE _Struct[_Sgir,2]=="Y"
            _value=CHR(39)+ALLTRIM(STR(_rec[_Sgir],_Struct[_Sgir,3],_Struct[_Sgir,4]))+CHR(39)
          CASE _Struct[_Sgir,2]=="T"
            _value=CHR(39)+TRANSFORM( TTOC(_rec[_Sgir],1), "@r 9999-99-99 99:99:99" )+CHR(39)
          CASE _Struct[_Sgir,2]=="G"
            _value=CHR(39)+_rec[_Sgir]+CHR(39)
        ENDCASE
        _line=_line+_value+IIF( _Sgir<_Slen, ",", ")" )
      ENDFOR
            
      *// enviamos el registro al archivo
      FWRITE( _han, _line )
      SKIP +1
      
      *// si es el ultimo registro finalizamos sentencia sql
      IF EOF()
        FWRITE( _han, ";"+_eol )
      ELSE
        FWRITE( _han, ","+_eol )
      ENDIF
      
    ENDDO
  
  ENDIF
  USE IN XTABLE
  FWRITE( _han, _eol+_eol )
    
ENDFOR

FWRITE( _han, _eol )
FWRITE( _han, _eol )
FCLOSE( _han )
MESSAGEBOX( [END], 64, [MESSAGE] )
RETURN

*//
*//  FIN DEL PROGRAMA
*//

* sample output
*CREATE TABLE IF NOT EXISTS 'usuarios' (
*  'id' int(11) NOT NULL AUTO_INCREMENT,
*  'usuario' varchar(30) CHARACTER SET utf8 COLLATE utf8_unicode_ci NOT NULL,
*  'pass' varchar(30) CHARACTER SET utf8 COLLATE utf8_unicode_ci NOT NULL,
*  'nivel' enum('USUARIO','ADMIN') CHARACTER SET utf8 COLLATE utf8_unicode_ci NOT NULL DEFAULT 'USUARIO',
*  'fechaAlta' datetime NOT NULL,
*  'ip' varchar(15) CHARACTER SET utf8 COLLATE utf8_unicode_ci DEFAULT NULL,
*  'activo' tinyint(1) NOT NULL DEFAULT '1',
*  'ultimoLogin' datetime DEFAULT NULL,
*  'email' varchar(100) CHARACTER SET utf8 COLLATE utf8_unicode_ci DEFAULT NULL,
*  'nombre' varchar(50) COLLATE utf8_spanish2_ci DEFAULT NULL,
*  'apellido' varchar(50) COLLATE utf8_spanish2_ci DEFAULT NULL,
*  'paisId' int(11) NOT NULL,
*  'comentarios' text COLLATE utf8_spanish2_ci,
*  PRIMARY KEY ('id'),
*  UNIQUE KEY 'usuario' ('usuario')
*) ENGINE=InnoDB  DEFAULT CHARSET=utf8 COLLATE=utf8_spanish2_ci AUTO_INCREMENT=10 ;
*INSERT INTO 'usuarios' ('id', 'usuario', 'pass', 'nivel', 'fechaAlta', 'ip', 'activo', 'ultimoLogin', 'email', 
*  'nombre', 'apellido', 'paisId', 'comentarios') VALUES
*(1, 'admin', 'admin', 'ADMIN', '2009-07-27 11:23:03', '127.0.0.1', 1, '2009-08-24 15:42:00', 'admin@demo.com', 
*  'Usuario', 'Administrador', 1, 'soy administrador ;)'),
*(2, 'usuario', 'usuario', 'USUARIO', '2009-07-28 16:19:58', '127.0.0.1', 1, '2009-08-24 15:48:46', 'juan@perez.com', 
*  'Juan', 'Perez', 1, NULL),
*(4, 'acarizza', '1234', 'USUARIO', '0000-00-00 00:00:00', '127.0.0.1', 0, '2009-08-18 22:10:51', 'email@server.com', 
*  'Andres', 'Carizza', 1, 'probando ''comilla "comilla doble \\ barra invertida /barra *asterisco'),
*(5, 'maria', '1234', 'USUARIO', '0000-00-00 00:00:00', NULL, 1, NULL, 'maria@hotmail.com', 
*  'Maria', 'Juana', 2, 'Comentarios para el campo de texto'),
*(7, 'juan', '1234', 'USUARIO', '0000-00-00 00:00:00', NULL, 1, NULL, 'juan@hotmail.com', 
*  'Juan', '', 4, ''),
*(9, 'pepe', '1234', 'USUARIO', '0000-00-00 00:00:00', NULL, 1, NULL, 'pepe@pepe.com', 
*  'Pepe', 'Perez', 3, 'hola que tal');
*//-----------------------------------------------------------------------------------------------

¿Que es un valor NULL entre amigos?

Versión original: What's a NULL amongst friends?
http://weblogs.foxite.com/jimbooth/archive/2007/03/16/3458.aspx
Autor: Jim Booth
Traducido por: Luis María Guayán

---

NULL, ese valor de datos que sigue estando en el camino. ¿Cómo me libero de lo valores NULL? ¿Cómo es que NULL no es igual a NULL? ¿Suenan familiares estas preguntas?

NULL es un concepto muy importante en bases de datos relacionales, pero también es una molestia en el trasero cuando es permitido y/o usado inadecuadamente.

Simplemente decir NULL significa que "no sé cual es este valor". Si hace la pregunta si el valor de no sé es igual el valor de no sé, la única respuesta lógica es no sé.

¿Por qué NULL es tan molesto? Porque es permitido en lugares donde no debería ser permitido. El valor real de los NULL está en la situación donde es importante saber cuando el valor de un campo es desconocido, a diferencia de sólo 0 ó una cadena vacía.

Tome el ejemplo de un campo de código postal. Si el campo es una cadena vacía, entonces es obvio que el valor del código postal es desconocido, así que no hay realmente ninguna razón de permitir NULL en un campo de código postal. Uno puede simplemente proveer como valor por defecto una cadena vacía y terminar con esto. Esto quita la necesidad de ocuparnos de los valores NULL en ese campo, porque estos valores no estarán nunca allí.

Por otra parte imagine una aplicación de seguimientos de condiciones meteorológicas por un período de tiempo. Hay un campo para la temperatura y ese valor realmente puede ser 0. También puede haber una entrada en la tabla donde la temperatura no fue registrada y por lo tanto su valor es desconocido. ¿Cómo puede observar la diferencia entre una temperatura de 0 y una temperatura desconocida? Uso NULL. NULL significa que no sé (la temperatura no fue registrada). Hábilmente NULL evitará que los cálculos de la temperatura media sean incorrectos tratando una temperatura no medida como si fuera medida como 0. Por supuesto una vez que permite NULL en el campo, debe ocuparse de la posibilidad de que este valor esté allí. Si suma un campo en una tabla de 1.000.000 de registros donde solo un registro tiene NULL, la suma será NULL, entonces tiene que asegurarse de excluir los valores NULL en la suma.

De esta manera, al final ¿Es malo tener un valor NULL en un campo? No si es necesario por el diseño de aplicación, pero sí, si está allí simplemente porque no se tomó el tiempo para no permitirlo y proporcionar un valor por defecto.

---

Control UAC en Windows 7 / Vista

Como controlar el nivel de ejecución de nuestras aplicaciones bajo entornos Windows 7 / Vista. Y como podemos modificar este nivel con un archivo manifest (XML), previamente incrustado en nuestra aplicación.

En Windows XP los administradores no tienen ningún problema para ejecutar un instalador, modificar el registro, o crear carpetas en las areas protegidas por el sistema, pero en Windows 7, un administrador no tiene el acceso total.

Sin embargo, es posible establecer los privilegios de una aplicación desde su ensamblado para que ésta exija estos privilegios al sistema al ejecutarse, marcando privilegios en el manifiesto de la aplicación. Cuando se crea un nuevo proceso, el servicio de información de aplicaciones (AIS) inspecciona el manifiesto de la aplicación que está incrustado en los recursos de la aplicación. Esto prevalece sobre cualquier otro tipo de marcado de aplicaciones, incluido el marcado de compatibilidad de una aplicación o la detección del instalador de UAC (User Access Control). El manifiesto define un nivel de ejecución que indica a Windows los privilegios necesarios para ejecutar el archivo binario. El marcado del manifiesto de aplicación es relevante sólo para archivos EXE, no DLL, UAC no inspecciona archivos DLL durante la creación del proceso.

Las tres posibilidades de nivel de ejecución son:

• asInvoker: la aplicacion obtiene los privilegios de aquel usuario o proceso que lo ejecutó (esta configuracion es la que se establece por defecto en cualquier proyecto nuevo).
• highestAvailable: la aplicacion exije los privilegios mas altos posibles de acuerdo al usuario que ejecutó el programa.
• requireAdministrator: establece que el proceso se debe crear con un token de usuario que sea miembro del grupo administradores. Si el usuario que intentó crear este proceso no es administrador, se mostrará un cuadro de diálogo para que proporcione sus credenciales.

Para ver los actuales privilegios que posee nuestra aplicación. Podemos acceder al archivo manifest que tiene incrustado nuestro aplicativo. La manera mas sencilla es a través del bloc de notas (NotePad.exe).
Con la ventana de comandos abierta ejecutamos lo siguiente:

Notepad   myapp.exe  

Una vez dentro pulsamos las teclas de búsqueda "Ctrl+B". Nos aparecerá la ventana de búsqueda de texto y tecleamos "assembly" (sin comillas), Pulsamos <Intro>. Y acto seguido nos localizará el archivo manifest que tiene nuestra aplicación incrustado. Tal y como se muestra en la siguiente figura.



Como se podrá comprobar, se "ve" perfectamente el archivo manifest que tiene incrustada nuestra aplicación. Con las funciones propias de copiar y pegar podemos extraer el contenido, y analizar el archivo.

<assemblyIdentity
  type="win32"
  name="myapp"
  version="1.0.0.0"
  processorArchitecture="*"/>
 <description>myapp - VFPX</description>
 <trustInfo xmlns="urn:schemas-microsoft-com:asm.v3">
  <security>
   <requestedPrivileges>
    <requestedExecutionLevel
     level="AsInvoker"
     uiAccess="false"/>
   </requestedPrivileges>
  </security>
 </trustInfo>
 <dependency>
  <dependentAssembly>
   <assemblyIdentity
    type="win32"
    name="Microsoft.Windows.Common-Controls"
    version="6.0.0.0"
    publicKeyToken="6595b64144ccf1df"
    language="*"
    processorArchitecture="*"/>
  </dependentAssembly>
 </dependency>
</assembly>

Se puede ver en negrita el privilegio actual que posee nuestra aplicación.
Podemos cambiar el privilegio, por algunos de los tres modos mencionados anteriormente: asInvoker, highestAvailable, requireAdministrator.

Guardamos el archivo como un archivo de texto con el nombre de nuestra aplicación : myapp+exe+manifest. En el mismo directorio donde ya se ubica nuestro ejecutable.

myapp.exe.manifest

Ahora vamos a incluir el archivo manifest dentro de nuestro ejecutable. Para eso primero compilamos nuestro proyecto dentro del Fox y con una pequeña utilidad de Microsoft, incluida dentro del Windows SDK MT.EXE (http://msdn.microsoft.com/en-us/library/aa375649%28v=vs.85%29.aspx).

Incrustaremos nuestro archivo manifest. Siempre desde la línea de comandos. También se puede generar un archivo .BAT para que nos automatice todo el proceso. La instrucción quedaría de la siguiente manera.

MT -manifest  myapp.exe.manifest    -outputresource:myapp.exe;1

Así de sencillo y fácil se pueden incluir archivos manifest en nuestros ejecutables. Y con los privilegios que nos sean necesarios en cada situación. Yo por ejemplo utilizo un ejecutable para actualizar mis programas a través de Internet y por supuesto tiene los privilegios de Administrador (requireAdministrator). Así se pueden registrar OCX, acceder al registro del sistema etc. Etc.

Se puede descargar el MT.EXE desde aquí: http://dl.dropbox.com/u/10421838/mt.exe

Antonio L. Montagut ( www.ontarioxb.es )

Enlaces de Interés:
http://blogs.msdn.com/b/calvin_hsia/archive/2007/04/13/add-a-manifest-to-control-your-application-vista-uac-behavior.aspx
http://msdn.microsoft.com/en-us/library/aa375649%28v=vs.85%29.aspx
http://es.wikipedia.org/wiki/Control_de_cuentas_de_usuario
http://en.wikipedia.org/wiki/User_Account_Control

Planificar tareas

Artículo original: Scheduling Tasks
http://doughennig.blogspot.com/2007/04/scheduling-tasks.html
Autor: Doug Hennig
Traducido por: Ana María Bisbé York

---

Stonefield Query tiene hace algunos años un planificador de informes. Nosotros simplemente empleamos el Planificador de tareas de Windows para ejecutar Stonefield Query, con el nombre de los informes a ejecutar y dónde enviar las salidas como parámetros, según el plan deseado. Para comunicarnos con el Planificador de Tareas, utilizamos el TaskScheduler.DLL, escrito por Mark Pryor. Parece que el sitio de donde lo descargué ya no está activo, por lo que está incluido en la descarga que mencionaré luego.

Sin embargo, después de actualizar a Windows Vista, descubrí que no trabajaba el planificador. Investigando este problema, descubrí que Windows Vista incluye Planificador de Tareas 2.0, donde la DLL fue escrita para soportar el Planificador de Tareas 1.0, que tiene una interfaz completamente diferente. Por tanto, volvemos al pasado, a la pizarra de dibujo.

Afortunadamente, la documentación de MSDN sobre el Planificador de Tareas 2.0 tenía toneladas de detalles y muchos ejemplos escritos en VBScript, que son fácilmente convertibles a VFP. Debido a que aun necesito utilizar el Planificador de Tareas 1.0, con XP y los sistemas anteriores, decidí crear una clase base TaskScheduler y a partir de ella, unas subclases XP y Vista.

No voy a mostrar el código para estas clases porque es muy largo (se puede descargar desde la página Technical Papers de mi sitio Web); pero he aquí algunos ejemplos sobre lo fácil que son de utilizar estas clases para planificar tareas. Estos ejemplos corren en Vista, en su lugar, emplee XPTaskScheduler para Windows XP o anterior.

* Crear una tarea que se ejecute cada día a las 3:00 AM.

loSchedule = createobject('VistaTaskScheduler')
with loSchedule
  .TaskName = 'Nombre de mi tarea'
  .UserName = 'Nombre de usuario de Windows'
  .Password = 'Contraseña de Windows'
  .StartTime = {^2007-04-26 03:00:00}
  .EXEName = 'Ruta completa del EXE'
  .EXEParameters = 'Todos los parámetros a pasar'
  .ScheduleType = 1 && diario
  if not .CreateTask()
    messagebox(.ErrorMessage)
  endif not .CreateTask()
endwith

* Crear una tarea  que se ejecute Martes, Jueves y Sábados a las 3:00 AM
* cada dos semanas.

loSchedule = createobject('VistaTaskScheduler')
with loSchedule
  .TaskName = 'Nombre de mi tarea'
  .UserName = 'Nombre de usuario de Windows'
  .Password = 'Contraseña de Windows'
  .StartTime = {^2007-04-26 03:00:00}
  .EXEName = 'Ruta completa del EXE'
  .EXEParameters = 'Todos los parámetros a pasar'
  .ScheduleType = 2 && semanal
  .Interval = 2
  store .T. to .DaysOfWeek[3], .DaysOfWeek[5], .DaysOfWeek[7]
  if not .CreateTask()
    messagebox(.ErrorMessage)
  endif not .CreateTask()
endwith

* Crear una tarea mensual que corra los días 1ro y 15 de cada mes a las 3:00 AM

loSchedule = createobject('VistaTaskScheduler')
with loSchedule
  .TaskName = 'Nombre de mi tarea'
  .UserName = 'Nombre de usuario de Windows'
  .Password = 'Contraseña de Windows'
  .StartTime = {^2007-04-26 03:00:00}
  .EXEName = 'Ruta completa del EXE'
  .EXEParameters = 'Todos los parámetros a pasar'
  .ScheduleType = 3
  store .T. to .DaysOfMonth[1], .DaysOfMonth[15]
  .MonthsOfYear = .T. && inicializa los 12 elementos de la matriz en .T.
  if not .CreateTask()
    messagebox(.ErrorMessage)
  endif not .CreateTask()
endwith

Decodificar QR usando ZBar

Anteriormente, publiqué un artículo para crear un código QR usando la Api de Google.

Ahora intento ejemplificar la Lectura de un QR usando la aplicación ZBar que es Open Source, y contiene unos ejecutables dentro de la carpeta BIN que en particular utilizo para este ejemplo el zbarimg.exe

Para este ejemplo, se supone que previamente se tiene "copiada" en portapapeles el QR a decodificar, usando GDI+ lo almaceno en un archivo temporal para decodificarlo.

El código es el siguiente:

SET DEFAULT TO SYS(5)+ADDBS(SYS(2003))

* --- Creamos una imagen desde el portapapeles para validar el QR ---
* --- Código de Luis María Guayan, Gracias por tus aportaciones. ---
Do System.App
loBmp = _Screen.System.Drawing.Bitmap.FromClipboard()
IF ISNULL(loBmp)
  MESSAGEBOX("Debe copiar antes la imagen del CBB al portapapeles!!",16,"Lector QR")
  RETURN
ENDIF 
uidImagen = ADDBS(SYS(2023)) + SYS(2015)+".png"
loBmp.Save(uidImagen, _Screen.System.Drawing.Imaging.ImageFormat.Png)

* --- Creamos el comando de DOS para ejecutar ZBar excelente herramienta open source ---
* --- http://zbar.sourceforge.net/  ---
lpComando = SYS(5)+ADDBS(SYS(2003))+"ZBar\zbarimg.exe -D "+uidImagen+ " > "+uidImagen+".txt"
TEXT TO xBAT NOSHOW ADDITIVE TEXTMERGE PRETEXT 7
echo off
<<lpComando>>
ENDTEXT
uidBat = ADDBS(SYS(2023)) + SYS(2015) + [.bat]
STRTOFILE(xBAT,uidBat)
zCommando = uidBat
Ejecuta(zCommando, 0)
BorraArchivo(uidBat)

* --- Ahora cargamos el contenido del QR ---
cContenidoQR = "" 
IF FILE(uidImagen+".txt")
  cContenidoQR = FILETOSTR(uidImagen+".txt")
ENDIF 
BorraArchivo(uidImagen)
BorraArchivo(uidImagen+".txt")

* --- Lo mostramos a pantalla ---
Messagebox(IIF(EMPTY(cContenidoQR),"ERROR: No se pudo leer el QR",cContenidoQR),64,"Lector QR")

*---------------------------------------------------
FUNCTION BorraArchivo(pFile)
*---------------------------------------------------
* Esta funcion elimina el archivo indicado como parametro
* si es que existe en Disco
*---------------------------------------------------
  IF FILE(pFile)
    DELETE FILE (pFile)
  ENDIF 
ENDFUNC 
*---------------------------------------------------

*---------------------------------------------------
FUNCTION Ejecuta(cComando, iStatus)
*---------------------------------------------------
*!* Esta funcion ejecuta un comando de DOS indicado
*!* como primer parámetro, el segundo es el estilo
*!* de la ventana a utilizar, ver el sig. listado
*!* entEstiloVentana Descripción
*!* 0 Oculta la ventana y activa otra.
*!* 1 Activa y muestra una ventana. Si la ventana está minimizada o maximizada, el sistema la restaura con su posición y tamaño originales. 
*!*             Una aplicación debe especificar este indicador cuando muestre la ventana por primera vez.
*!* 2 Activa la ventana y la muestra minimizada.
*!* 3 Activa la ventana y la muestra maximizada.
*!* 4 Muestra una ventana con su tamaño y posición más recientes. La ventana activa permanece activa.
*!* 5 Activa la ventana y la muestra con su tamaño y posición actuales.
*!* 6 Minimiza la ventana especificada y activa la siguiente ventana de mayor nivel en orden Z.
*!* 7 Muestra la ventana minimizada. La ventana activa permanece activa.
*!* 8 Muestra la ventana en su estado actual. La ventana activa permanece activa.
*!* 9 Activa y muestra la ventana. Si la ventana está minimizada o maximizada, el sistema la restaura con su posición y tamaño originales. 
*!*             Una aplicación debe especificar este indicador cuando se restaure una ventana minimizada.
*!* 10 Establece el estado de presentación a partir del estado del programa que inició la aplicación.
*----------------------------------------------------
  TRY 
    oShell = createobject("WScript.Shell") 
    oShell.Run(cComando,iStatus,.T.) 
  CATCH TO xEcepcion
    lsErrorEcepcion = "No se pudo ejecutar: "+cComando+ " RS:"+TRANSFORM(xEcepcion.ErrorNo) + CHR(13)+CHR(10)+  "Mensaje: " + xEcepcion.Message
    Messagebox(lsErrorEcepcion,16,"Lector QR")
  FINALLY
    *  
  ENDTRY   
ENDFUNC
*----------------------------------------------------

Pueden descargar el ejemplo completo, con librerias y ejecutables adicionales desde aqui

Baltazar Moreno

Utilizando el control TreeView (4/4)

Cuarta y última parte de una serie de códigos de ejemplos sobre como utilizar el control TreeView en VFP, escritos por el turco Cetin Basoz (Microsoft Visual FoxPro MVP 1999-2010).

* Define some constant
#DEFINE tvwFirst     0
#DEFINE tvwLast      1
#DEFINE tvwNext      2
#DEFINE tvwPrevious  3
#DEFINE tvwChild     4
#DEFINE cnLOG_PIXELS_X 88
#DEFINE cnLOG_PIXELS_Y 90
* 1440 twips por pulgadas
#DEFINE cnTWIPS_PER_INCH 1440

oForm = CREATEOBJECT('myForm')
oForm.SHOW
READ EVENTS

DEFINE CLASS myForm AS FORM
  HEIGHT = 640
  WIDTH = 800
  AUTOCENTER = .T.
  CAPTION = "TreeView - TestPad"
  NAME = "myForm"

  *-- Node object reference
  nodx = .F.
  nxtwips = .F.
  nytwips = .F.

  ADD OBJECT oletreeview AS OLECONTROL WITH ;
    TOP = 0, LEFT = 0, HEIGHT = 600, WIDTH = 750, ;
    ANCHOR = 15, NAME = "OleTreeView", ;
    OLECLASS = 'MSComCtlLib.TreeCtrl'

  ADD OBJECT oleimageslist AS OLECONTROL WITH ;
    TOP = 0, LEFT = 0, HEIGHT = 100, WIDTH = 100, ;
    NAME = "oleImagesList",;
    OLECLASS = 'MSComCtlLib.ImageListCtrl'

  *-- Fill the tree values
  PROCEDURE filltree
    LPARAMETERS tcDirectory, tcImage
    THIS.SHOW
    CREATE CURSOR crsNodes (NodeKey c(15), ParentKey c(15), NodeText m, NewParent c(15))
    LOCAL oNode
    WITH THIS.oletreeview.nodes
      oNode=.ADD(,tvwFirst,"root"+PADL(.COUNT,3,'0'),tcDirectory,tcImage)
    ENDWITH
    INSERT INTO crsNodes (NodeKey, ParentKey, NodeText) VALUES (oNode.KEY, '',oNode.TEXT)
    THIS._SubFolders(oNode)

  ENDPROC

  PROCEDURE pixeltotwips

    *-- Code for PixelToTwips method
    LOCAL liHWnd, liHDC, liPixelsPerInchX, liPixelsPerInchY

    * Declare some Windows API functions.
    DECLARE INTEGER GetActiveWindow IN WIN32API
    DECLARE INTEGER GetDC IN WIN32API INTEGER iHDC
    DECLARE INTEGER GetDeviceCaps IN WIN32API INTEGER iHDC, INTEGER iIndex

    * Get a device context for VFP.
    liHWnd = GetActiveWindow()
    liHDC = GetDC(liHWnd)

    * Get the pixels per inch.
    liPixelsPerInchX = GetDeviceCaps(liHDC, cnLOG_PIXELS_X)
    liPixelsPerInchY = GetDeviceCaps(liHDC, cnLOG_PIXELS_Y)

    * Get the twips per pixel.
    THISFORM.nxtwips = ( cnTWIPS_PER_INCH / liPixelsPerInchX )
    THISFORM.nytwips = ( cnTWIPS_PER_INCH / liPixelsPerInchY )
    RETURN

  ENDPROC

  *-- Collect subfolders
  PROCEDURE _SubFolders
    LPARAMETERS oNode
    LOCAL nChild, oNodex
    lcFolder = oNode.FULLPATH
    lcFolder = STRTRAN(lcFolder,":\\",":\")
    oFS = CREATEOBJECT('Scripting.FileSystemObject')
    oFolder = oFS.GetFolder(lcFolder)
    WITH THISFORM.oletreeview
      lnIndent = 0
      lnIndex = oNode.INDEX
      DO WHILE lnIndex # oNode.Root.INDEX ;
          AND TYPE('.nodes(lnIndex).Parent')='O' ;
          AND !ISNULL(.nodes(lnIndex).PARENT)
        lnIndex = .nodes(lnIndex).PARENT.INDEX
        lnIndent = lnIndent + 1
      ENDDO
      lcChildKeyPrefix = 'L'+PADL(lnIndent,3,'0')+'_'
    ENDWITH
    WITH THISFORM.oletreeview.nodes
      IF oNode.Children > 0
        IF oNode.CHILD.KEY = oNode.KEY+"dummy"
          .REMOVE(oNode.CHILD.INDEX)
          FOR EACH oSubFolder IN oFolder.Subfolders
            INSERT INTO crsNodes ;
              (NodeKey, ParentKey, NodeText) ;
              VALUES ;
              (lcChildKeyPrefix+' '+PADL(RECCOUNT('crsNodes')+1,5,'0'), ;
              oNode.KEY, oSubFolder.PATH)
            oNodex = .ADD(oNode.KEY, tvwChild, ;
              crsNodes.NodeKey, oSubFolder.NAME, "ClosedFolder","OpenFolder" )
            oNodex.ExpandedImage = "OpenFolder"
            IF oSubFolder.NAME # "System Volume Information" AND oSubFolder.Subfolders.COUNT > 0
              oNodex = .ADD(crsNodes.NodeKey, tvwChild, ;
                crsNodes.NodeKey+"dummy", "dummy", "ClosedFolder","OpenFolder" )
            ENDIF
          ENDFOR
        ENDIF
      ELSE
        IF oFolder.Subfolders.COUNT > 0
          oNodex = .ADD(oNode.KEY, tvwChild, ;
            oNode.KEY+"dummy", "dummy", "ClosedFolder","OpenFolder" )
        ENDIF
      ENDIF
    ENDWITH
  ENDPROC

  PROCEDURE QUERYUNLOAD
    THISFORM.nodx = .NULL.
    CLEAR EVENTS
  ENDPROC

  PROCEDURE INIT
    THIS.pixeltotwips()
    SET TALK OFF
    * Check to see if OCX installed and loaded.
    IF TYPE("THIS.oleTreeView") # "O" OR ISNULL(THIS.oletreeview)
      RETURN .F.
    ENDIF
    IF TYPE("THIS.oleImagesList") # "O" OR ISNULL(THIS.oleimageslist)
      RETURN .F.
    ENDIF
    lcIconPath = HOME(0) + "Graphics\Icons\"
    WITH THIS.oleimageslist
      .ImageHeight = 32
      .ImageWidth = 32
      .ListImages.ADD(,"OpenFolder",LOADPICTURE(lcIconPath+"Win95\openfold.ico"))
      .ListImages.ADD(,"ClosedFolder",LOADPICTURE(lcIconPath+"Win95\clsdfold.ico"))
      .ListImages.ADD(,"Drive",LOADPICTURE(lcIconPath+"Computer\drive01.ico"))
      .ListImages.ADD(,"Floppy",LOADPICTURE(lcIconPath+"Win95\35floppy.ico"))
      .ListImages.ADD(,"NetDrive",LOADPICTURE(lcIconPath+"Win95\drivenet.ico"))
      .ListImages.ADD(,"CDDrive",LOADPICTURE(lcIconPath+"Win95\CDdrive.ico"))
      .ListImages.ADD(,"RAMDrive",LOADPICTURE(lcIconPath+"Win95\desktop.ico"))
      .ListImages.ADD(,"Unknown",LOADPICTURE(lcIconPath+"Misc\question.ico"))
    ENDWITH

    WITH THIS.oletreeview
      .linestyle =1
      .labeledit =1
      .indentation = 5
      .imagelist = THIS.oleimageslist.OBJECT
      .PathSeparator = '\'
      .OLEDRAGMODE = 1
      .OLEDROPMODE = 1
    ENDWITH

    oFS = CREATEOBJECT('Scripting.FileSystemObject')
    LOCAL ARRAY aDrvTypes[7]
    aDrvTypes[1]="Unknown"
    aDrvTypes[2]="Floppy"
    aDrvTypes[3]="Drive"
    aDrvTypes[4]="NetDrive"
    aDrvTypes[5]="CDDrive"
    aDrvTypes[6]="RAMDrive"

    FOR EACH oDrive IN oFS.Drives
      IF oDrive.IsReady
        THIS.filltree(oDrive.Rootfolder.PATH, aDrvTypes[oDrive.DriveType+1])
      ENDIF
    ENDFOR
  ENDPROC

  PROCEDURE oletreeview.Expand
    *** ActiveX Control Event ***
    LPARAMETERS NODE
    THISFORM._SubFolders(NODE)
    NODE.ensurevisible
  ENDPROC

  PROCEDURE oletreeview.NodeClick
    *** ActiveX Control Event ***
    LPARAMETERS NODE
    NODE.ensurevisible
    THIS.DropHighlight = .NULL.
  ENDPROC

  PROCEDURE oletreeview.MOUSEDOWN
    *** ActiveX Control Event ***
    LPARAMETERS BUTTON, SHIFT, x, Y
    WITH THISFORM
      oHitTest = THIS.HitTest( x * .nxtwips, Y * .nytwips )
      IF TYPE("oHitTest")= "O" AND !ISNULL(oHitTest)
        THIS.SELECTEDITEM = oHitTest
      ENDIF
      .nodx = THIS.SELECTEDITEM
    ENDWITH
    oHitTest = .NULL.
  ENDPROC

  PROCEDURE oletreeview.OLEDRAGOVER
    *** ActiveX Control Event ***
    LPARAMETERS DATA, effect, BUTTON, SHIFT, x, Y, state
    oHitTest = THIS.HitTest( x * THISFORM.nxtwips, Y * THISFORM.nytwips )
    IF TYPE("oHitTest")= "O"
      THIS.DropHighlight = oHitTest
    ENDIF
  ENDPROC

  PROCEDURE oletreeview.OLEDRAGDROP
    *** ActiveX Control Event ***
    LPARAMETERS DATA, effect, BUTTON, SHIFT, x, Y
    IF DATA.GETFORMAT(1)     &&CF_TEXT
      WITH THIS
        IF !ISNULL(THISFORM.nodx) AND TYPE(".DropHighLight") = "O" AND !ISNULL(.DropHighlight)
          loSource = THISFORM.nodx
          loTarget = .DropHighlight
          IF loSource.KEY # loTarget.KEY AND TYPE('loSource.Parent') = 'O'
            lcSourceParentKey = loSource.PARENT.KEY
            lcTargetParentKey = loTarget.PARENT.KEY
            IF SUBSTR(lcSourceParentKey,1,AT('_',lcSourceParentKey)-1) == ;
                SUBSTR(lcTargetParentKey,1,AT('_',lcTargetParentKey)-1)
              lcSourceKey = IIF(lcSourceParentKey == lcTargetParentKey,'',;
                IIF(SHIFT=1,'mv','cp'))+loSource.KEY
              lcSourceText = loSource.TEXT
              llRemoveSource = (lcSourceParentKey == lcTargetParentKey OR SHIFT=1)

              * Check here for children repopulation since we're simulating with existing directories
              * llGetChildren should be false for copy-move from another parent dir
              llGetChildren  = (lcSourceParentKey == lcTargetParentKey)

              IF llRemoveSource
                .nodes.REMOVE(loSource.INDEX)
              ENDIF
              * Check if node exists already
              IF TYPE('.Nodes(lcSourceKey)') # 'O'
                oNode=.nodes.ADD(loTarget.KEY,tvwPrevious,lcSourceKey,lcSourceText,;
                  "ClosedFolder","OpenFolder")
                .SELECTEDITEM = oNode
                IF llGetChildren
                  THISFORM._SubFolders(oNode)
                ENDIF
              ENDIF
            ENDIF
          ENDIF
        ENDIF
      ENDWITH
    ENDIF
    THIS.DropHighlight = .NULL.
  ENDPROC

ENDDEFINE

Gracias Cetin por compartir y autorizar esta publicación.

Utilizando el control TreeView (3/4)

Tercera parte de una serie de códigos de ejemplos sobre como utilizar el control TreeView en VFP, escritos por el turco Cetin Basoz (Microsoft Visual FoxPro MVP 1999-2010).

#DEFINE tvwFirst    0
#DEFINE tvwLast    1
#DEFINE tvwNext    2
#DEFINE tvwPrevious    3
#DEFINE tvwChild    4

#DEFINE cnLOG_PIXELS_X 88
#DEFINE cnLOG_PIXELS_Y 90
#DEFINE cnTWIPS_PER_INCH 1440

TEXT to myMenu noshow
Lparameters toNode,toForm

DEFINE POPUP shortcut SHORTCUT RELATIVE FROM MROW(),MCOL()
DEFINE BAR 1 OF shortcut PROMPT "Key"
DEFINE BAR 2 OF shortcut PROMPT "Text"
DEFINE BAR 3 OF shortcut PROMPT "Fullpath"
DEFINE BAR 4 OF shortcut PROMPT "Index"
DEFINE BAR 5 OF shortcut PROMPT "New Item"
ON SELECTION BAR 1 OF shortcut ;
    wait window toNode.Key timeout 2
ON SELECTION BAR 2 OF shortcut  ;
    wait window toNode.Text timeout 2
ON SELECTION BAR 3 OF shortcut  ;
    wait window toNode.Fullpath timeout 2
ON SELECTION BAR 4 OF shortcut  ;
    wait window Transform(toNode.Index) timeout 2
ON SELECTION BAR 5 OF shortcut toForm.ShowIt(toNode)
ACTIVATE POPUP shortcut

ENDTEXT

*StrToFile(m.myMenu,'myTVShcut.mpr')

oForm = CREATEOBJECT('myForm')
WITH oForm
  .ADDOBJECT('Tree','myTreeView')
  .ADDOBJECT('Lister','Lister')
  WITH .Tree
    .WIDTH = 700
    .HEIGHT = 600
    .Nodes.ADD(,0,"root0",'Main node 1')
    .Nodes.ADD(,0,"root1",'Main node 2')
    .Nodes.ADD(,0,"root2",'Main node 3')
    .Nodes.ADD('root1',4,"child11",'Child11')
    .Nodes.ADD('root1',4,"child12",'Child12')
    .Nodes.ADD('root2',4,"child21",'Child22')
    .Nodes.ADD('child21',3,"child20",'Child21')
    oNodx=.Nodes.ADD('child11',4,"child111",'child113')
    oNodx.Bold=.T.
    .Nodes.ADD('child111',3,"child112",'child112')
    .Nodes.ADD('child112',3,"child113",'child111')

    .Nodes.ADD('child12',4,"child121",'child121')
    .Nodes.ADD('child12',4,"child122",'child122')

    .Nodes.ADD('child112',4,"child1121",'child1121')
    .Nodes.ADD('child112',4,"child1122",'child1122')
    .Nodes.ADD('child112',4,"child1123",'child1123')
    .Nodes.ADD('child112',4,"child1124",'child1124')
    .Nodes.ADD('child112',4,"child1125",'child1125')

    .Nodes.ADD('child1121',4,"child11211",'child11211')
    .Nodes.ADD('child1121',4,"child11212",'child11212')

    .Nodes.ADD('child11211',4,"child112111",'child112111')
    .Nodes.ADD('child11212',4,"child112121",'child112121 last added')
    .VISIBLE = .T.
    .Nodes(.Nodes.COUNT).Ensurevisible
    WITH .FONT
      .SIZE = 12
      .NAME = 'Times New Roman'
      .Bold = .F.
      .Italic = .T.
    ENDWITH
  ENDWITH
  .Lister.LEFT = .WIDTH - .Lister.WIDTH
  .lister.VISIBLE = .T.
  .SHOW()
ENDWITH
READ EVENTS

FUNCTION TVLister
  LPARAMETERS toTV
  LOCAL lnIndex,lnLastIndex
  WITH toTV
    lnIndex     = .Nodes(1).Root.FirstSibling.INDEX
    lnLastIndex = .Nodes(1).Root.LastSibling.INDEX
    _GetSubNodes(lnIndex,toTV,lnIndex)
    DO WHILE lnIndex # lnLastIndex
      lnIndex = .Nodes(lnIndex).NEXT.INDEX
      _GetSubNodes(lnIndex,toTV,lnIndex)
    ENDDO
  ENDWITH

FUNCTION _GetSubNodes
  LPARAMETERS tnIndex, toTV, tnRootIndex
  LOCAL lnIndex, lnLastIndex
  WITH toTV
    WriteNode(tnIndex,toTV, tnRootIndex)
    IF .Nodes(tnIndex).Children > 0
      lnIndex  = .Nodes(tnIndex).CHILD.INDEX
      lnLastIndex = .Nodes(tnIndex).CHILD.LastSibling.INDEX
      _GetSubNodes(lnIndex,toTV,tnRootIndex)
      DO WHILE lnIndex # lnLastIndex
        lnIndex = .Nodes(lnIndex).NEXT.INDEX
        _GetSubNodes(lnIndex,toTV,tnRootIndex)
      ENDDO
    ENDIF
  ENDWITH

FUNCTION WriteNode
  LPARAMETERS tnCurIndex, toTV,tnRootIndex
  LOCAL lnRootIndex, lnIndex, lcPrefix, lcKey, lnLevel
  lnIndex = tnCurIndex

  WITH toTV
    lcPrefix = '+-' + .Nodes(lnIndex).TEXT
    lnLevel = 0
    DO WHILE lnIndex # tnRootIndex
      lnIndex = .Nodes(lnIndex).PARENT.INDEX
      lcPrefix = IIF(.Nodes(lnIndex).LastSibling.INDEX = lnIndex,' ','|')+SPACE(3)+lcPrefix
      lnLevel = lnLevel + 1
    ENDDO
    ? lcPrefix
  ENDWITH

FUNCTION WalkTree
  LPARAMETERS oNode,lnIndent,tlPlus
  ? IIF(tlPlus,'+','')+REPLICATE(CHR(9),lnIndent)+oNode.TEXT
  IF !ISNULL(oNode.CHILD)
    WalkTree(oNode.CHILD,lnIndent+1,.T.)
  ENDIF
  IF !ISNULL(oNode.NEXT)
    WalkTree(oNode.NEXT,lnIndent,.F.)
  ENDIF
  RETURN
ENDFUNC

DEFINE CLASS myForm AS FORM
  AUTOCENTER = .T.
  HEIGHT = 640
  WIDTH = 800

  nxtwips = .F.
  nytwips = .F.

  PROCEDURE QUERYUNLOAD
    CLEAR EVENTS
  ENDPROC

  PROCEDURE ShowIt
    LPARAMETERS toNode
    MESSAGEBOX("Form method called with " + toNode.FULLPATH)
  ENDPROC

  PROCEDURE INIT
    *-- Code for PixelToTwips method
    LOCAL liHWnd, liHDC, liPixelsPerInchX, liPixelsPerInchY

    * Declare some Windows API functions.
    DECLARE INTEGER GetActiveWindow IN WIN32API
    DECLARE INTEGER GetDC IN WIN32API INTEGER iHDC
    DECLARE INTEGER GetDeviceCaps IN WIN32API INTEGER iHDC, INTEGER iIndex

    * Get a device context for VFP.
    liHWnd = GetActiveWindow()
    liHDC = GetDC(liHWnd)

    * Get the pixels per inch.
    liPixelsPerInchX = GetDeviceCaps(liHDC, cnLOG_PIXELS_X)
    liPixelsPerInchY = GetDeviceCaps(liHDC, cnLOG_PIXELS_Y)

    * Get the twips per pixel.
    THIS.nxtwips = ( cnTWIPS_PER_INCH / liPixelsPerInchX )
    THIS.nytwips = ( cnTWIPS_PER_INCH / liPixelsPerInchY )
    RETURN
  ENDPROC


  PROCEDURE CheckRest
    LPARAMETERS tnIndex, tlCheck, toTreeView
    LOCAL lnIndex, lnLastIndex
    WITH toTreeView
      .Nodes(tnIndex).Checked = tlCheck
      IF .Nodes(tnIndex).Children > 0
        lnIndex  = .Nodes(tnIndex).CHILD.INDEX
        lnLastIndex = .Nodes(tnIndex).CHILD.LastSibling.INDEX
        THIS.CheckRest(lnIndex, tlCheck, toTreeView)
        DO WHILE lnIndex # lnLastIndex
          lnIndex = .Nodes(lnIndex).NEXT.INDEX
          THIS.CheckRest(lnIndex, tlCheck, toTreeView)
        ENDDO
      ENDIF
    ENDWITH
  ENDPROC

ENDDEFINE

DEFINE CLASS myTreeView AS OLECONTROL
  OLEDRAGMODE = 1
  OLEDROPMODE = 1
  NAME = "OleTreeView"
  OLECLASS = 'MSComCtlLib.TreeCtrl'

  PROCEDURE INIT
    WITH THIS
      .OBJECT.CheckBoxes = .T.
      .linestyle =1
      .labeledit =1
      .indentation = 5
      .PathSeparator = '\'
    ENDWITH
  ENDPROC
  PROCEDURE NodeClick
    *** ActiveX Control Event ***
    LPARAMETERS NODE
    NODE.ensurevisible
    MESSAGEBOX(NODE.FULLPATH + CHR(13) +TRANS(NODE.INDEX),0,"NodeClick",2000)
  ENDPROC

  PROCEDURE MOUSEDOWN
    LPARAMETERS BUTTON, SHIFT, x, Y
    IF BUTTON=2
      lcWhere = ''
      oNode = THIS.HitTest( x * THISFORM.nxtwips, Y * THISFORM.nytwips )
      IF TYPE("oNode")= "O" AND !ISNULL(oNode)
        *        DO myTVShcut.mpr with oNode
        EXECSCRIPT(m.MyMenu, oNode, THISFORM)
      ENDIF
    ENDIF
  ENDPROC

  PROCEDURE MOUSEUP
    LPARAMETERS BUTTON, SHIFT, x, Y
    *!*      if button=2
    *!*          nodefault
    *!*          Wait window 'Right click occured in Mup' timeout 2
    *!*      endif
    IF BUTTON=1
      oNode = THIS.HitTest( x * THISFORM.nxtwips, Y * THISFORM.nytwips )
      IF TYPE("oNode")= "O" AND !ISNULL(oNode)
        IF oNode.KEY # 'root1'
          oNode.Checked = .F.
        ELSE
          THISFORM.CheckRest(oNode.INDEX,oNode.Checked,THIS)
        ENDIF
      ENDIF
    ENDIF
  ENDPROC

  *!*      Procedure NodeCheck
  *!*    *** ActiveX Control Event ***
  *!*    Lparameters node,dummy
  *!*    IF node.Key = 'root1'
  *!*    thisform.CheckRest(node.Index,node.Checked,this)
  *!*    endif
  *!*    endproc

  PROCEDURE _SubNodes
    LPARAMETERS tnIndex, tnLevel
    LOCAL lnIndex
    lcFs = ''
    WITH THIS
      ? IIF(tnLevel=0,'',REPLICATE(CHR(9),tnLevel))+.Nodes(tnIndex).TEXT, "[Actual index :"+TRANS(tnIndex)+"]"
      IF .Nodes(tnIndex).Children > 0
        lnIndex  = .Nodes(tnIndex).CHILD.INDEX
        ._SubNodes(lnIndex,tnLevel+1)
        DO WHILE lnIndex # .Nodes(tnIndex).CHILD.LastSibling.INDEX
          lnIndex = .Nodes(lnIndex).NEXT.INDEX
          ._SubNodes(lnIndex,tnLevel+1)
        ENDDO
      ENDIF
    ENDWITH
  ENDPROC

  PROCEDURE ExpandAll
    LPARAMETERS tnIndex
    LOCAL lnIndex
    WITH THIS
      .Nodes(tnIndex).Expanded = .T.
      IF .Nodes(tnIndex).Children > 0
        lnIndex  = .Nodes(tnIndex).CHILD.INDEX
        .ExpandAll(lnIndex)
        DO WHILE lnIndex # .Nodes(tnIndex).CHILD.LastSibling.INDEX
          lnIndex = .Nodes(lnIndex).NEXT.INDEX
          .ExpandAll(lnIndex)
        ENDDO
      ENDIF
    ENDWITH
  ENDPROC
ENDDEFINE

DEFINE CLASS Lister AS COMMANDBUTTON
  CAPTION = 'Listado'
  HEIGHT = 32
  WIDTH = 100

  PROCEDURE CLICK
    ACTIVATE SCREEN
    TvLister(THISFORM.Tree)
    WITH THISFORM.Tree
      *  WalkTree(.Nodes(1),0)
      *    .ExpandAll(.SelectedItem.Index)
    ENDWITH
  ENDPROC

  PROCEDURE click1
    ACTIVATE SCREEN
    CLEAR
    LOCAL lnIndex
    WITH THISFORM.Tree
      lnIndex = .Nodes(1).Root.FirstSibling.INDEX
      ._SubNodes(lnIndex,0)
      DO WHILE lnIndex # .Nodes(1).Root.LastSibling.INDEX
        lnIndex = .Nodes(lnIndex).NEXT.INDEX
        ._SubNodes(lnIndex,0)
      ENDDO
    ENDWITH
  ENDPROC
ENDDEFINE

Gracias Cetin por compartir y autorizar esta publicación.

Utilizando el control TreeView (2/4)

Segunda parte de una serie de códigos de ejemplos sobre como utilizar el control TreeView en VFP, escritos por el turco Cetin Basoz (Microsoft Visual FoxPro MVP 1999-2010).

SELECT PADR('Customer_'+cust_id,20) AS NodeID, ;
  PADR('',20) AS ParentID, ;
  PADR(Company,100) AS NodeText, ;
  0 AS LEVEL ;
  FROM (HOME(2)+'data\customer') ;
  UNION ;
  SELECT PADR('Orders_'+order_id,20) AS NodeID, ;
  PADR('Customer_'+c.cust_id,20) AS ParentID, ;
  PADR(ALLTRIM(TRANSFORM(order_id))+":"+TRANSFORM(Order_Date),100) AS NodeText, ;
  1 AS LEVEL ;
  FROM (HOME(2)+'data\Orders') o ;
  INNER JOIN (HOME(2)+'data\customer') c ON o.cust_id == c.cust_id ;
  UNION ;
  SELECT 'OrdItems_'+oi.order_id+'_'+PADL(line_no,3,'0') AS NodeID, ;
  'Orders_'+o.order_id AS ParentID, ;
  TRANSFORM(oi.line_no)+':'+p.Prod_Name-(' ['+TRANSFORM(oi.Quantity)+']') AS NodeText, ;
  2 AS LEVEL ;
  FROM (HOME(2)+'data\OrdItems') oi ;
  INNER JOIN (HOME(2)+'data\Orders') o ON oi.order_id == o.order_id ;
  INNER JOIN (HOME(2)+'data\customer') c ON o.cust_id == c.cust_id ;
  INNER JOIN (HOME(2)+'data\products') p ON oi.product_id == p.product_id ;
  ORDER BY LEVEL ;
  INTO CURSOR myTree ;
  nofilter

#DEFINE tvwFirst 0
#DEFINE tvwLast 1
#DEFINE tvwNext 2
#DEFINE tvwPrevious 3
#DEFINE tvwChild 4

PUBLIC oForm
oForm = CREATEOBJECT('myTreeForm','myTree')
oForm.SHOW

DEFINE CLASS myTreeForm AS FORM
  HEIGHT = 640
  WIDTH = 800
  Autocenter = .T.
  CAPTION = "TreeView - TestPad"

  nxtwips = 0
  nytwips = 0
  cursorbehind = ''

  ADD OBJECT TreeView AS OLECONTROL WITH ;
    HEIGHT = 640, WIDTH = 800, ;
    anchor = 15, OLECLASS = 'MSComCtlLib.TreeCtrl'

  PROCEDURE INIT
    LPARAMETERS tcCursorName
    WITH THIS.TreeView
      .linestyle =1
      .labeledit =1
      .indentation = 5
      .PathSeparator = '\'
      .SCROLL = .T.
      .OLEDRAGMODE = 0
      .OLEDROPMODE = 0
    ENDWITH
    THIS.cursorbehind = m.tcCursorName
    THIS.PixelToTwips()
    THIS.Populate()
  ENDPROC

  PROCEDURE Populate
    SELECT (THIS.cursorbehind)
    WITH THIS.TreeView.Nodes
      SCAN
        IF EMPTY(ParentID)
          oNode = .ADD(,tvwFirst,TRIM(NodeID),TRIM(NodeText))
          oNode.Bold = .T.
        ELSE
          oNode = .ADD(TRIM(ParentID),tvwChild,TRIM(NodeID) ,TRIM(NodeText))
          IF OCCURS('\',oNode.FULLPATH)=1
            oNode.BACKCOLOR = 0x00FFFF
            oNode.FORECOLOR = 0xFF0000
          ENDIF
          IF OCCURS('\',oNode.FULLPATH)=2
            oNode.FORECOLOR = 0x0000FF
          ENDIF
        ENDIF
      ENDSCAN
    ENDWITH
  ENDPROC

  PROCEDURE PixelToTwips
    LOCAL liHDC, liPixelsPerInchX, liPixelsPerInchY
    #DEFINE cnLOG_PIXELS_X 88
    #DEFINE cnLOG_PIXELS_Y 90
    #DEFINE cnTWIPS_PER_INCH 1440

    DECLARE INTEGER GetActiveWindow IN WIN32API
    DECLARE INTEGER GetDC IN WIN32API INTEGER iHDC
    DECLARE INTEGER GetDeviceCaps IN WIN32API INTEGER iHDC, INTEGER iIndex

    liHDC = GetDC(GetActiveWindow())

    liPixelsPerInchX = GetDeviceCaps(liHDC, cnLOG_PIXELS_X)
    liPixelsPerInchY = GetDeviceCaps(liHDC, cnLOG_PIXELS_Y)

    THIS.nxtwips = ( cnTWIPS_PER_INCH / liPixelsPerInchX )
    THIS.nytwips = ( cnTWIPS_PER_INCH / liPixelsPerInchY )
  ENDPROC

  PROCEDURE TreeView.MOUSEMOVE
    LPARAMETERS BUTTON, SHIFT, x, Y
    WITH THISFORM
      oHitTest = THIS.HitTest( x * .nxtwips, Y * .nytwips )
      IF TYPE("oHitTest")= "O" AND !ISNULL(oHitTest)
        WAIT WINDOW NOWAIT oHitTest.FULLPATH
      ENDIF
    ENDWITH
    oHitTest = .NULL.
  ENDPROC

  PROCEDURE TreeView.NodeClick
    LPARAMETERS oNode
    LOCAL aNodeInfo[1]
    IF ALINES(aNodeInfo,oNode.KEY,1,'_') = 2 && Customer or orders
      IF LOWER(aNodeInfo[1]) == 'customer'
        SELECT * FROM customer WHERE cust_id = aNodeInfo[2]
      ELSE
        SELECT * FROM orders WHERE VAL(order_id) = VAL(aNodeInfo[2])
      ENDIF
    ELSE
      SELECT * FROM orditems ;
        WHERE VAL(order_id) = VAL(aNodeInfo[2]) AND line_no = VAL(aNodeInfo[3])
    ENDIF
  ENDPROC
ENDDEFINE

Gracias Cetin por compartir y autorizar esta publicación.

Utilizando el control TreeView (1/4)

Primera parte de una serie de códigos de ejemplos sobre como utilizar el control TreeView en VFP, escritos por el turco Cetin Basoz (Microsoft Visual FoxPro MVP 1999-2010).

#DEFINE tvwFirst 0
#DEFINE tvwLast 1
#DEFINE tvwNext 2
#DEFINE tvwPrevious 3
#DEFINE tvwChild 4

oForm = CREATEOBJECT('myForm')
WITH oForm
  .ADDOBJECT('Tree','myTreeView')
  .ADDOBJECT('Lister','Lister')
  WITH .Tree
    .Nodes.ADD(,0,"root1",'Main node 2')
    .Nodes.ADD(,0,"root2",'Main node 3')
    .Nodes.ADD('root1',4,"child11",'Child11')
    .Nodes.ADD('root1',4,"child12",'Child12')
    .Nodes.ADD('root2',4,"child21",'Child22')
    .Nodes.ADD('child21',3,"child20",'Child21')
    .Nodes.ADD('child11',4,"child111",'child113')
    .Nodes.ADD('child111',3,"child112",'child112')
    .Nodes.ADD('child112',3,"child113",'child111')
    .Nodes.ADD('root1',3,"root0",'Main node 1')
    .VISIBLE = .T.
  ENDWITH
  .Lister.LEFT = .WIDTH - .Lister.WIDTH
  .Lister.VISIBLE = .T.
  .SHOW()
ENDWITH
READ EVENTS

DEFINE CLASS myForm AS FORM
  AUTOCENTER = .T.
  HEIGHT = 640
  WIDTH = 800
  PROCEDURE QUERYUNLOAD
    CLEAR EVENTS
  ENDPROC
ENDDEFINE

DEFINE CLASS myTreeView AS OLECONTROL
  OLEDRAGMODE = 1
  OLEDROPMODE = 1
  NAME = "OleTreeView"
  OLECLASS = 'MSComCtlLib.TreeCtrl'
  HEIGHT = 600
  WIDTH = 700

  PROCEDURE INIT
    WITH THIS
      .linestyle =1
      .labeledit =1
      .indentation = 5
      .PathSeparator = '\'
    ENDWITH
  ENDPROC

  PROCEDURE NodeClick
    *** ActiveX Control Event ***
    LPARAMETERS NODE
    NODE.ensurevisible
    MESSAGEBOX(NODE.FULLPATH,TRANS(NODE.INDEX))
  ENDPROC

  PROCEDURE _SubNodes
    LPARAMETERS tnIndex, tnLevel
    LOCAL lnIndex
    lcFs = ''
    WITH THIS
      ? IIF(tnLevel=0,'',REPLICATE(CHR(9),tnLevel))+.Nodes(tnIndex).TEXT, "[Actual index :"+TRANS(tnIndex)+"]"
      IF .Nodes(tnIndex).Children > 0
        lnIndex  = .Nodes(tnIndex).CHILD.INDEX
        ._SubNodes(lnIndex,tnLevel+1)
        DO WHILE lnIndex # .Nodes(tnIndex).CHILD.LastSibling.INDEX
          lnIndex = .Nodes(lnIndex).NEXT.INDEX
          ._SubNodes(lnIndex,tnLevel+1)
        ENDDO
      ENDIF
    ENDWITH
  ENDPROC
ENDDEFINE

DEFINE CLASS lister AS COMMANDBUTTON
  CAPTION = 'Listado'
  HEIGHT = 32
  WIDTH = 100

  PROCEDURE CLICK
    ACTIVATE SCREEN
    CLEAR
    LOCAL lnIndex
    WITH THISFORM.Tree
      lnIndex = .Nodes(1).Root.FirstSibling.INDEX
      ._SubNodes(lnIndex,0)
      DO WHILE lnIndex # .Nodes(1).Root.LastSibling.INDEX
        lnIndex = .Nodes(lnIndex).NEXT.INDEX
        ._SubNodes(lnIndex,0)
      ENDDO
    ENDWITH
  ENDPROC
ENDDEFINE

Gracias Cetin por compartir y autorizar esta publicación.

Seleccionar uno o mas registros aleatoriamente

Tomemos como ejemplo que deseamos seleccionar aleatoriamente un solo Cliente de la tabla Northwind!Customers, para ello nos ayudaremos con la función RAND() de VFP:

*-- Por primera vez tomo una semilla a partir del reloj del sistema. 
*-- Ver la ayuda de la función RAND()
RAND(-1)

SELECT TOP 1 *, RAND() AS Rnd ;
 FROM (HOME(2) + "Northwind\Customers") ;
 ORDER BY Rnd

En el caso de que necesitemos seleccionar mas clientes aleatoriamente de la tabla Customers, por ejemplo 5 clientes :

SELECT TOP 5 *, RAND() AS Rnd ;
 FROM (HOME(2) + "Northwind\Customers") ;
 ORDER BY Rnd

Documentación en Español de FoxyPreviewer

Artículo original: FoxyPreviewer Documentation
http://foxypreviewer.codeplex.com/documentation
Autor: VFPIMAGING
Traducido por: Luis Maria Guayán

---

Requisitos previos:

Visual FoxPro 9 SP2

Si utiliza formularios de nivel superior, se requiere la instalación de la última revisión acumulativa para VFP9 SP2 KB968409, para corregir un error del SP2 que hace que la barra de herramientas en un formulario de nivel superior se muestre deshabilitada. La forma más fácil de actualizar su VFP9SP2 con las revisiones más recientes es instalar el "Woody's Runtime Installer", que se puede encontrar aquí: Woody VFP9 SP2 Runtime Installer con todas las revisiones (Rev 7423)

Uso:

Para usarlo con sus propios informes se hizo aún más simple de lo que era originalmente. Ahora puede utilizar FoxyPreviewer de dos maneras:

1 - Sin cambiar nada de código en su aplicación (Modo Simplificado)

Vea lo fácil es cambiar completamente el aspecto y darle algunos super poderes a sus informes:

DO FOXYPREVIEWER.APP 
REPORT FORM YourReport PREVIEW 

Eso es todo!

Esto significa que todo lo que necesita hacer es "DO FoxyPreviewer.App" al inicio de su ejecutable, y todos los informes que utilizan la cláusula "PREVIEW" se visualizaran mediante la interfaz simplificada y súper poderosa de FoxyPreviewer.

Tenga en cuenta que algunas funciones no están disponibles con esta opción, pero siguen siendo más vistosos, como se puede ver en la tabla al final de este artículo.

2 - El modo original y mas poderoso (Modo Mejorado)

Con sólo cuatro líneas de código podrá incluir más funcionalidades:

LOCAL loReport AS "PreviewHelper" OF "FoxyPreviewer.App" 
loReport = CREATEOBJECT("PreviewHelper") 
loReport.AddReport(_Samples + "\Solution\Reports\colors.frx", "FOR Client = 'VFPx' ") && FRX File, Clauses 
loReport.RunReport() 

El archivo principal es FOXYPREVIEWER.APP que contiene la clase PreviewHelper que es la clase que se necesita para crear una instancia para que las nuevas opciones de barra de herramientas. Ésta usa la clase ExtensionHandler de ReportListener para realizar todos los cambios en la barra de herramientas original.


Comparación entre los dos modos:

Función	Vista previa predeterminada de VFP 9	FoxyPreviewer simplificado	FoxyPreviewer mejorado
Búsqueda en vista previa	No	Si	Si
Botón del cuadro de diálogo de impresora	No	Si	Si
Miniaturas de vista previa de páginas	No	Si	Si
Guardar como archivo de imagen	No	Si	Si
Guardar como PDF	No	Si	Si
Guardar como RTF	No	Si	Si
Guardar como XLS / XML	No	Si	Si
Guardar como HTML	No	No	Si
Guardar como TXT	No	No	Si
Número de copias	No	No	Si
Lista desplegable de impresoras	No	No	Si
Textos justificados	No	Si	Si
Botones grandes	No	Si	Si
Enviar correo electrónico	No	Si	Si
Cambiar la configuración interactivamente	No	Si	Si
Traducido a otros idiomas	No	Si	Si
Barra de progreso mejorada	No	Si	Si
Líneas de código necesario para ejecutar un informe	1	1	4

Personalización en Modo Mejorado

Toda la información siguiente se aplica solamente al Modo Mejorado !!!
Obviamente que puede elegir qué funciones estarán disponibles en la barra de herramientas de la vista previa del informe. Hay algunas propiedades evidentes que puede establecerse para configurar sus necesidades. A continuación se muestran los métodos y propiedades disponibles:

La grandeza de VFP 9 viene en paquetes pequeños

Artículo original: Big VFP 9 thingd come in small package
Autor: Drew Speedie (QEPD)
Traducido por: Ana María Bisbé York

---

Nota de la traductora

Este texto corresponde a la sesión que fue preparada por el MS VFP MVP Drew Speedie para la Conferencia Southwest Fox 2005. Pocos meses antes de la conferencia, Drew Speedie falleció; pero su trabajo fue presentado por otro de los grandes de la comunidad VFP, el también MS VFP MVP, Andy Kramek.

Deseamos agradecer a Andy Kramek y Russ Swall de Vision Pace, donde trabajaba Drew Speedie, por la posibilidad que nos han brindado de distribuir la obra de Drew y que todos sigamos aprendiendo de el. Sirva este trabajo de traducción como homenaje de recordación a Drew Speedie. ¡Gracias Drew!

Resumen

Cada nueva versión de cualquier software contiene siempre varias "pequeñas" mejoras que no reciben mucha publicidad. Estos pequeños avances no merecen un tema para una hora de sesión en conferencias de desarrolladores. Sin embargo, si se agrupan todos juntos, comprenden una parte significativa de lo que vamos a utilizar a diario en el desarrollo de nuestras aplicaciones VFP 9.
Código de ejemplo Los archivos con código de ejemplo para esta presentación consta de un único archivo EXAMPLES.APP. Ejecute DO EXAMPLES, y el código de ejemplo para todos estos elementos se copiará en su disco en la misma carpeta que EXAMPLES.APP al seleccionar alguno de los botones Source (Código fuente) o Run (Ejecutar)
Palabra clave ADDITIVE para el comando SET PATH Agregar nuevas rutas al SET PATH actual ha sido siempre una tarea tediosa en VFP, típicamente lo hacíamos así:

LOCAL lcPath 
lcPath = SET("PATH") + ";C:\Projects\MyApp\Data"
SET PATH TO &lcPath 

En VFP 9, el comando SET PATH se ha mejorado para soportar la palabra clave ADDITIVE, por lo que se reduce a lo siguiente:

SET PATH TO "C:\Projects\MyApp\Data" ADDITIVE 

Todo lo que aparece a continuación funciona en VFP 9 para agregar una ruta por programa:

LOCAL lcDataPath
lcDataPath = "C:\Projects\MyApp\Data"
SET PATH TO (m.lcDataPath) ADDITIVE 

LOCAL lcDataPath
lcDataPath = ["C:\Projects\MyApp\Data"]
SET PATH TO &lcDataPath ADDITIVE 

LOCAL lcDataPath
lcDataPath = "C:\Projects\MyApp\Data"
SET PATH TO "&lcDataPath" ADDITIVE 

Cuando utiliza macrosustitución, se requiere el conjunto extra de delimitadores, debido a que en versiones anteriores ha podido asignar a SET PATH una carpeta llamada \ADDITIVE:

SET PATH TO ADDITIVE 

SELECT … WITH (BUFFERING = .T.) VFP 9 tiene muchas mejoras. Una de los que podría utilizar frecuentemente es la cláusula nueva WITH (Buffering = <lExpr>).

Antes de VFP 9, cuando el cursor (tabla, vista, etc) era guardado en buffer, la sentencia SELECT SQL siempre recibía los registros del disco. Los registros almacenados en buffer eran siempre ignorados, de tal forma que tenía que buscar otras vías para recibir los registros desde el cursor en buffer.

Esta mejora permite especificar si la sentencia SELECT va a utilizar los registros en buffer o los registros en disco; solamente añadiendo una cláusula WITH (Buffering = .T.) después de cada tabla deseada en la cláusula FROM ya el SELECT recibe los registros en buffer en lugar de los registros en disco.

Por ejemplo, he estado utilizando esta nueva cláusula para simplificar el código que recibía un registro de un cursor de tabla en buffer, para verificar algún valor. El código antiguo tenía este aspecto:

LOCAL lnRecno, lnSelect, lnValue
lnSelect = SELECT(0)
lnRecno = IIF(EOF(),0,RECNO())
SELECT TargetCursor
LOCATE FOR <SomeCondition>
lnValue = <SomeFieldValueOrWhatever>
IF m.lnRecno = 0
  GO BOTTOM
  IF NOT EOF()
    SKIP
  ENDIF
ELSE
  GOTO (m.lnRecno)
ENDIF
SELECT (m.lnSelect) 

...el código nuevo es este:

LOCAL lnValue
SELECT * FROM TargetCursor ;
  WITH (BUFFERING=.T.) ;
  FOR <SomeCondition> ;
  INTO CURSOR Junk
lnValue = <SomeFieldValueOrWhatever>
USE IN SELECT("Junk") 

O, ¿qué tal este código para obtener un cursor llamado InvoiceTotal del cursor LineItems (buffered) durante una entrada de datos:

SELECT SUM(Quantity*Price) AS TheTotal ;
  FROM LineItems WITH (BUFFERING=.T.) ;
  INTO CURSOR InvoiceTotal 

Notas:

• Especificar WITH (Buffering=.F.) es lo mismo que omitir la cláusula WITH - tendremos el comportamiento predeterminado.
• Cuando el cursor especificado en FROM no está almacenado en buffer, no hay ningún efecto al especificar WITH (Buffering=.T.), la cláusula es ignorada.
• La cláusula WITH se aplica a nivel de tabla - específicamente para aquellas tablas del FROM, para las que desee ese comportamiento.
  Si está habilitado el buffer por filas, la ejecución de SELECT dispara un TABLEUPDATE() implícito para cada tabla con buffer de líneas en SELECT para las que ha especificado WITH (BUFFERING = .T.)
• El nuevo comando SET SQLBUFFERING está igualado a OFF, póngalo en ON para especificar que todas las sentencias SELECT utilizan implícitamente WITH (BUFFERING = .T.) para todas las tablas en la cláusula FROM.

Se pueden realizar transacciones de tablas libres. VFP 9 agrega la posibilidad de realizar transacciones sobre tablas libres y cursores creados con CREATE CURSOR - las actualizaciones a los cursores pueden ejecutar ROLLBACK junto con todas las otras tablas contenidas y vistas en una transacción VFP.

Esta característica está basada en dos nuevas funciones:

• MAKETRANSACTABLE()
• ISTRANSACTABLE()

Un uso importante de esta nueva funcionalidad es en sistemas de herencia, donde debe actualizar una combinación, o para todas las tablas libres, o para alguna combinación de las tablas contenidas y las tablas libres, - antes, solamente las actualizaciones a tablas contenidas podían ser deshechas si fallaba la transacción.

Saber la versión de un Libro de Excel

Con esta función podemos saber la versión con que fue guardado un libro de Excel.

lc = GETFILE("xls*")
? VersionLibroExcel(lc)

FUNCTION VersionLibroExcel(tcFile)
  LOCAL ln, lcFormat, lo
  IF NOT EMPTY(tcFile)
    lo = CREATEOBJECT("Excel.Application")
    lo.Workbooks.OPEN(tcFile)
    ln = lo.ActiveWorkbook.FileFormat
    DO CASE
      CASE ln = 16
        lcFormat = "Excel 2"
      CASE ln = 29
        lcFormat = "Excel 3"
      CASE ln = 33
        lcFormat = "Excel 4"
      CASE ln = 39
        lcFormat = "Excel 5 y 95"
      CASE ln = 43
        lcFormat = "Excel 97-2003 (Guardado desde 2003)"
      CASE ln = 51
        lcFormat = "Excel 2007-2010"
      CASE ln = 56
        lcFormat = "Excel 97-2003 (Guardado desde 2007-2010)"
      CASE ln = -4143
        lcFormat = "Excel 97, 2000, 2002 y 2003"
      OTHERWISE
        lcFormat = "Otro Formato # " + TRANSFORM(ln)
    ENDCASE
    lo.ActiveWorkbook.Close(.F.)
    lo.Quit
    lo = Null
  ELSE
    lcFormat = "No se especifico archivo"
  ENDIF
  RETURN lcFormat
ENDFUNC

Luis María Guayán

Establecer el cursor del sistema

Artículo original: Setting the System Cursor
http://www.sweetpotatosoftware.com/SPSBlog/PermaLink,guid,07ac6929-b3ed-410f-a29d-dca6b7e8cf5d.aspx
Autor: Craig Boyd
Traducido por: Ana María Bisbé York

---

Alguien estuvo preguntando en Universal Thread (http://www.universalthread.com) sobre cómo colocar el cursor del ratón sobre una cadena de texto. Hacer esto es bastante fácil utilizando GDI+ y Visual FoxPro 9.0. El siguiente ejemplo, listo para ejecutar, va a guardar el icono actual del cursor y luego lo cambia por la cadena "VFP ROCKS!" Permitirá además seleccionar un archivo imagen para que se utilice como icono del cursor, lo que en realidad es la técnica que emplea el ejemplo de la cadena. Finalmente, después de ejecutar los dos ejemplos, va a restablecer el cursor en la misma forma en que estaba (lo que ahorra el tiempo de ir al Panel de Control -> Ratón). Basta con copiar y pegar el siguiente código en un archivo PRG en VFP 9.0 y ejecutarlo.

NOTAS IMPORTANTES: La porción activa del ratón es el centro de la imagen. Las imágenes para el segundo ejemplo no se limitan solamente a iconos, se admiten la mayoría de los formatos de imagen. Pero; tenga cuidado sobre el tamaño de la imagen que selecciona para el segundo ejemplo. He captado una pequeña, muy pequeña, ya que el cursor del ratón en un punto ... lo que hace muy difícil hacer clic sobre los objetos. (risas)

LOCAL lnPreviousIconHandle, lnNewIconHandle, lcImageFile, loExc AS EXCEPTION
*!* Guarda el icono actual del controlador del ratón para poderlo recuperar luego
m.lnPreviousIconHandle = GetCurrentCursorHandle()
IF m.lnPreviousIconHandle != 0
  TRY
    m.lnNewIconHandle = ;
      GetHICONFromString("VFP ROCKS!", 0, 0, "Arial", 12, 1, 3, RGB(255,0,0), 255, 0)
    IF m.lnNewIconHandle != 0
      SetSystemCursorToHICON(m.lnNewIconHandle)
    ENDIF
    MESSAGEBOX("Oprima Aceptar cuando esté lista para el siguiente ejemplo.")
    SET DEFAULT TO (ADDBS(HOME(4)) + "Icons\Computer\")
    m.lcImageFile = GETPICT("","Seleccione un archivo imagen", "Seleccionar")
    m.lnNewIconHandle = GetHICONFromImage(m.lcImageFile)
    IF m.lnNewIconHandle != 0
      SetSystemCursorToHICON(m.lnNewIconHandle)
    ENDIF
    MESSAGEBOX("Oprima Aceptar cuando esté listo para " + ;
      "devolverle la imagen original al cursor.")
  CATCH TO loExc
    *!* Ups Error!
  FINALLY
    *!* Establecer el icono del cursor de misma manera que estaba
    SetSystemCursorToHICON(m.lnPreviousIconHandle)
  ENDTRY
ENDIF
***************************************
FUNCTION GetCurrentCursorHandle()
***************************************
  LOCAL lnReturn
  DECLARE INTEGER CopyIcon IN Win32Api INTEGER
  DECLARE INTEGER GetCursor IN Win32Api AS _GetCursor
  *!* Guardar el cursor actual para que pueda recuperarlo
  m.lnReturn = CopyIcon(_GetCursor())
  CLEAR DLLS "CopyIcon", "_GetCursor"
  RETURN (lnReturn)
ENDFUNC
***************************************
FUNCTION SetSystemCursorToHICON(tnIconHandle, tnCursorStateToSet)
***************************************
  *!* Las directivas del procesador se proporcionan
  *!* para que sepamos lo que está disponible
  #DEFINE OCR_NORMAL 32512
  *!* #define OCR_IBEAM 32513
  *!* #define OCR_WAIT 32514
  *!* #define OCR_CROSS 32515
  *!* #define OCR_UP 32516
  *!* #define OCR_SIZE 32640 /* OBSOLETE: use OCR_SIZEALL */
  *!* #define OCR_ICON 32641 /* OBSOLETE: use OCR_NORMAL */
  *!* #define OCR_SIZENWSE 32642
  *!* #define OCR_SIZENESW 32643
  *!* #define OCR_SIZEWE 32644
  *!* #define OCR_SIZENS 32645
  *!* #define OCR_SIZEALL 32646
  *!* #define OCR_ICOCUR 32647 /* OBSOLETE: use OIC_WINLOGO */
  *!* #define OCR_NO 32648
  *!* #define OCR_HAND 32649
  *!* #define OCR_APPSTARTING 32650
  IF PCOUNT() = 1
    m.tnCursorStateToSet = OCR_NORMAL
  ENDIF
  DECLARE SetSystemCursor IN Win32Api INTEGER, INTEGER
  SetSystemCursor(m.tnIconHandle,m.tnCursorStateToSet)
  CLEAR DLLS "SetSystemCursor"
ENDFUNC
***************************************
FUNCTION GetHICONFromImage(tcImageName)
***************************************
  LOCAL lnIconHandle, lnBitmap, lnReturn
  STORE 0 TO m.lnIconHandle, m.lnBitmap, m.lnReturn
  DECLARE INTEGER GdipCreateBitmapFromFile IN GDIPLUS.DLL ;
    STRING wFilename, INTEGER @ nImage
  DECLARE LONG GdipCreateHICONFromBitmap IN GDIPLUS.DLL ;
    INTEGER nBitmap, INTEGER @hbmReturn
  IF !EMPTY(tcImageName)
    GdipCreateBitmapFromFile(STRCONV(m.tcImageName+CHR(0),5), @m.lnBitmap)
    IF m.lnBitmap != 0
      GdipCreateHICONFromBitmap(m.lnBitmap, @m.lnIconHandle)
      IF m.lnIconHandle != 0
        m.lnReturn = m.lnIconHandle
      ENDIF
    ENDIF
  ENDIF
  CLEAR DLLS "GdipCreateHICONFromBitmap", "GdipCreateBitmapFromFile"
  RETURN m.lnReturn
ENDPROC
***************************************
PROCEDURE GetHICONFromString(tcString, tnXCoord, tnYCoord, tcFontName, ;
    tnFontSize, tnFontStyle, tnUnitofMeasure, ;
    tnRGB, tnAlpha, tnStringFormat)
***************************************
  LOCAL logpColor, logpSolidBrush, logpFont, ;
    logpStringFormat, logpPoint, logpGraphics, ;
    logpBitamp, lnBitmap, lnIconHandle
  DECLARE LONG GdipCreateHICONFromBitmap IN GDIPLUS INTEGER nBitmap, INTEGER @hbmReturn
  DECLARE LONG GdipSetTextRenderingHint IN GDIPLUS LONG graphics, LONG mode
  DECLARE LONG GdipSetInterpolationMode IN GDIPLUS LONG graphics, LONG interpolation
  DECLARE LONG GdipSetSmoothingMode IN GDIPLUS LONG graphics, LONG SmoothingMd
  IF TYPE("m.tcString") = "C" AND TYPE("m.tnXCoord") = "N" ;
      AND TYPE("m.tnYCoord") = "N" AND TYPE("m.tcFontName") = "C" ;
      AND TYPE("m.tnFontSize") = "N"
    SET CLASSLIB TO (ADDBS(HOME(1)) + "FFC\_gdiplus.vcx")
    *!* Si los 4 parámetros no se envían, se establecen valores predeterminados
    IF TYPE("m.tnFontStyle") != "N"
      m.tnFontStyle = 0
    ENDIF
    IF TYPE("m.tnUnitofMeasure") != "N"
      m.tnUnitofMeasure = 3
    ENDIF
    IF TYPE("m.tnRGB") != "N"
      m.tnRGB = 0
    ENDIF
    IF TYPE("m.tnAlpha") != "N"
      m.tnAlpha = 255
    ENDIF
    IF TYPE("m.tnStringFormat") != "N"
      m.tnStringFormat = 0
    ENDIF
    m.logpColor = CREATEOBJECT("gpcolor", MOD(m.tnRGB, 256), ;
      MOD(BITRSHIFT(m.tnRGB, 8), 256), ;
      MOD(BITRSHIFT(m.tnRGB, 16), 256), ;
      m.tnAlpha)
    m.logpSolidBrush = CREATEOBJECT("gpsolidbrush", m.logpColor.argb)
    m.logpFont = CREATEOBJECT("gpfont", m.tcFontName, m.tnFontSize, ;
      m.tnFontStyle, m.tnUnitofMeasure)
    m.logpStringFormat = CREATEOBJECT("gpstringformat", m.tnStringFormat)
    m.logpPoint = CREATEOBJECT("gppoint", m.tnXCoord, m.tnYCoord)
    m.logpbitmap = CREATEOBJECT("gpBitmap")
    *!* Se podría utilizar GdipMeasureString para obtener la medida
    *!* para que el tamaño no fuera escrito directamente
    m.logpbitmap.CREATE(110, 24)
    m.logpGraphics = CREATEOBJECT("gpgraphics")
    m.logpGraphics.CreateFromImage(m.logpbitmap)
    *!* Las tres líneas de código siguientes hacen que el texto generado
    *!* se vea bien, no todo dentado
    GdipSetTextRenderingHint(m.logpGraphics.gethandle(), 3)
    GdipSetInterpolationMode(m.logpGraphics.gethandle(), 7)
    GdipSetSmoothingMode(m.logpGraphics.gethandle(), 4)
    m.logpGraphics.DrawStringA(m.tcString, m.logpFont, m.logpPoint, ;
      m.logpStringFormat, m.logpSolidBrush)
    m.lnIconHandle = 0
    GdipCreateHICONFromBitmap(m.logpbitmap.GetHandle(), @m.lnIconHandle)
    m.lnReturn = m.lnIconHandle
    STORE .NULL. TO m.logpbitmap, m.logpColor, m.logpSolidBrush, m.logpFont, ;
      m.logpStringFormat, m.logpPoint, m.logpGraphics
    RELEASE m.logpbitmap, m.logpColor, m.logpSolidBrush, m.logpFont, ;
      m.logpStringFormat, m.logpPoint, m.logpGraphics
  ENDIF
  CLEAR DLLS "GdipCreateHICONFromBitmap", "GdipSetTextRenderingHint", ;
    "GdipSetInterpolationMode", "GdipSetSmoothingMode"
  RETURN m.lnReturn
ENDFUNC