30 de diciembre de 2005

Convertir una expresión de caracteres en una expresión de fecha

Considerando que la función CTOD( ) no es segura, creé esta función para convertir una expresión de caracteres - fecha en formato corto - en una expresión de fecha.

Según la propia ayuda de VFP: "Nota: CTOD( ) puede crear valores ambiguos de fecha y generar un error de compilación...", entonces, como estoy importando datos que están en EXCEL necesité de esta función que, tal vez, pueda serle útil a otros.

Sintaxis:
StrToDate(cExpresion, cFormatoDeFecha)
Parámetros:
  • cExpresion: Especifica una expresión de caracteres.
  • cFormatoDeFecha: especifica el formato en el cual se encuetra cExpresion.
Ejemplo de uso:
? StrToDate("2004/5/30";"a/m/d")
? StrToDate("2004-5-30";"a-m-d")
? StrToDate("04.5.30","a.m.d";)
? StrToDate("30/5/4";"d/m/a")
Function StrToDate
    Lparameters lcFecha,lcFormatOrig
    Local ARRAY laFec(3)
    Local nn, lcEstr
    lcDelim = Iif(GetWordCount(lcFormatOrig,"/") = 3, "/", ;
      Iif(GetWordCount(lcFormatOrig,"-") = 3, "-", ;
      Iif(GetWordCount(lcFormatOrig,".") = 3, ".","")))
    If Empty(lcDelim)
       Return {}
       *-- puede ser mejor devolver .f. para provocar un error
    EndIf
    lcFormatOrig = Lower(lcFormatOrig) && por si acaso
    For nn = 1 to 3
        lcEstr = GetWordNum(lcFormatOrig,nn,lcDelim)
        laFec(Iif(lcEstr="a",1,Iif(lcEstr="m",2,3)))=Val(GetWordNum(lcFecha,nn,lcDelim))
    EndFor
    *-- Por si el año se haya escrito abreviado (se interpreta del siglo XXI)
    *-- se puede mejorar esta parte comprobando SET CENTURY TO ROLLOVER
    If Len(Alltrim(Str(laFec(1)))) > 4
       laFec(1)=2000 + laFec(1)
    EndIf
    Return Date(laFec(1),laFec(2),laFec(3))
EndFunc
Mario Esquivel Bado

25 de diciembre de 2005

WMI y Visual FoxPro 9.0 SP1

WMI nos ofrece una serie de funciones sobre el equipo que nos permiten extraer información como números de series de dispositivos USB, CD-Room, Mainboard y tipo de chasis, sobre estos dos últimos trataremos en este artículo.

WMI y Visual FoxPro 9.0 SP1

WMI nos ofrece una serie de funciones sobre el equipo que nos permiten extraer información como números de series de dispositivos USB, CD-Room, Mainboard y tipo de chasis, sobre estos dos últimos trataremos en este artículo.

El dinamismo que nos permite VFP9 y la íntima relación con el sistema operativo describiremos el código que nos permite extraer el número de serie del mainboard y el tipo de chasis en que nuestro sistema se encuentra operando.

* activamos el programa para crear una clase que contiene la descripción del chasis
* SET PROCEDURE TO serial

CLEAR
* nombre equipo o servidor
strComputer = "."
* creamos el objeto con la referencia . que nos indica que es el equipo local
objWMIService = GETOBJECT("winmgmts:{impersonationLevel=impersonate}!\\" + strComputer + "\root\cimv2")
* extraemos la consulta de la raiz que nos permite ver las propiedades a un objeto
colSMBIOS = objWMIService.ExecQuery ("Select * from Win32_SystemEnclosure")

* recorremos el objeto para extraer el número de serie y el número de parte
FOR EACH objSMBIOS IN colSMBIOS
  ? "Número de parte: " + objSMBIOS.PartNumber
  ? "Número de serie: " + objSMBIOS.SerialNumber
NEXT
* recorremos el objeto para extraer el número de tipo 
* de chasis y llamamos a la clase que los contiene
FOR EACH objChassis IN colSMBIOS
  FOR EACH objItem IN objChassis.ChassisTypes
    o_chasis=CREATEOBJECT("c_chasis")
    ? "El chasis es: "+o_chasis.chasis(objitem)
  NEXT
NEXT

* definición de la clase que nos permite validar el # del tipo de chases
DEFINE CLASS c_chasis AS CUSTOM
  PROCEDURE chasis(n_chasis)
    DO CASE
      CASE n_chasis=1
        RETURN "Other"
      CASE n_chasis=2
        RETURN "Unknown "
      CASE n_chasis=3
        RETURN " Desktop "
      CASE n_chasis=4
        RETURN " Low Profile Desktop "
      CASE n_chasis=5
        RETURN " Pizza Box  "
      CASE n_chasis=6
        RETURN " Mini Tower "
      CASE n_chasis=7
        RETURN " Tower "
      CASE n_chasis=8
        RETURN " Portable"
      CASE n_chasis=9
        RETURN " Laptop "
      CASE n_chasis=10
        RETURN " Notebook "
      CASE n_chasis=11
        RETURN " Hand Held "
      CASE n_chasis=12
        RETURN " Docking Station "
      CASE n_chasis=13
        RETURN " All in One "
      CASE n_chasis=14
        RETURN " Sub Notebook "
      CASE n_chasis=15
        RETURN " Space-Saving"
      CASE n_chasis=16
        RETURN " Lunch Box  "
      CASE n_chasis=17
        RETURN " Main System Chassis"
      CASE n_chasis=18
        RETURN " Expansion Chassis "
      CASE n_chasis=19
        RETURN " SubChassis "
      CASE n_chasis=20
        RETURN " Bus Expansion Chassis "
      CASE n_chasis=21
        RETURN " Peripheral Chassis "
      CASE n_chasis=22
        RETURN " Storage Chassis "
      CASE n_chasis=23
        RETURN " Rack Mount Chassis "
      CASE n_chasis=24
        RETURN " Sealed-Case PC "
    ENDCASE
ENDDEFINE

Franklin S. Garzón A. (Ecuador)

12 de diciembre de 2005

Deshabilitar RegEdit y RegEdit32

Con esta opción, se puede evitar deshabilitar la ejecución de las herramientas estándar, para la edición del Registro de Windows, tanto para RegEdit y RegEdit32.

Nota: Para que los cambios tengan efectos, puede ser necesario re-Iniciar el Sistema, dependerá de la versión de Windows.

La información para poder realizar esta opción, consiste es establecer los datos correspondientes en el Registro de Windows.

IMAGEN 1


Notas sobre el código de ejemplo:
En el código de ejemplo se utiliza las funciones API para realizar las acciones en el Registro de Windows.

Esta, no es más, que una de las opciones que puedes utilizar para manipular el Registro

Puedes usar o aplicar las que utilizas actualmente, o las que se encuentran en FFC, etc...

Aunque, en el ejemplo se muestra "donde hay que escribir en el registro" y "cómo"

Este segundo aspecto "cómo" no tiene mayor relevancia, ya que el truco esta en saber "donde", que es la idea base de este mini-artículo o referencia.

Descargar código fuente -> proyecto de ejemplo

Ficheros del proyecto:

form: Formulario -> código ejemplo funcional
declaraciones.prg: Declaraciones -> API.
funciones.prg: Funciones -> para manipular el Registro.
cs_ejemplo.h: #Define -> utilizados

Nota: Para ejecutar el formulario de forma correcta, establece el directorio por defecto, en la ubicación donde lo tengas, el código de ejemplo no realiza comprobación, ni asignación alguna.

Por ejemplo: SET DEFAULT TO "C: \PRUEBAS"



Antonio Muñoz de Burgos y Caravaca

7 de diciembre de 2005

Evite la ruta explícita almacenada en la propiedad Picture

VFP insiste en añadir explicitamente la ruta completa y el nombre de un archivo gráfico en la hoja de propiedades. Ese comportamiento es absolutamente indeseable porque la ruta raramente, es la misma en producción que en desarrollo.

Si usted está seguro de que la carpeta que contiene la imagen gráfica está en el PATH, usted puede configurar por código la propiedad Picture solo con el nombre del archivo. No se olvide de agregar la línea EXTERNAL FILE para asegurarse de que el archivo sea incluido en el proyecto (.PJX):
THIS.Picture = "MiGrafico.JPG"
EXTERNAL FILE MiGrafico.JPG
Pero si usted desea configurar la propiedad Picture en la hoja de propiedades, especifique el nombre del archivo como una expresión, como en el ejemplo siguiente (ingreselo como se muestra, incluyendo las comillas):
="MiGrafico.JPG"
VFP Tips & Tricks - Drew Speedie

5 de diciembre de 2005

Solucionar Error: OLE error code 0x80040112: Appropriate license for this class

Este es un error común al momento de trabajar con algunos ActiveX, veremos la forma de solucionar (o por lo menos darle la vuela)...

Cuando se trabaja con los ActiveX que están incluidos dentro de la distribución de VFP, suele pasar un error justo cuando se ejecuta una línea como la siguiente:
Local loWSock, lcIp
loWSock = CreateObject("MSWinsock.Winsock")
lcIp = loWSock.LocalIP
MessageBox(lcIp)

El código anterior funciona correctamente dentro del IDE de VFP, pero cuando se crea un .EXE y éste tiene algún código donde se crea un objeto por medio de las funciones CREATEOBJECT() , NEWOBJECT(), o por medio del método ADDObject marca el citado error.

Por qué pasa eso?

Este error sucede debido a una restricción de los mismos, que para que funcionen en VFP es necesario que los ActiveX estén embebidos ya sea en un formulario o en una clase heredada de OLEControl.

Cómo solucionarlo

Como comentaba anteriormente, es buena práctica crear clases en donde se tenga embebido dicho control, como un ejemplo aquí tiene un código que hace uso del control MSCommonDialog:
frmMyForm = CREATEOBJECT("Form")

FrmMyForm.AddObject("oleObject1","oleComDialObject")
   WITH FrmMyForm.OleObject1
      .SetOptions()
      .showopen()
      ?.FileName
   ENDWITH

DEFINE CLASS oleComDialObject as OLEControl
    OleClass ="MSComDlg.CommonDialog.1"
    PROCEDURE SetOptions
      #define COMMDLOG_DEFAULT_FLAG 0x00080000
      #define COMMDLOG_RO 4
      #define COMMDLOG_MULTFILES 512

      This.Flags = COMMDLOG_DEFAULT_FLAG + COMMDLOG_RO + COMMDLOG_MULTFILES
      This.FileName = "*.dbf"
      This.filter = "DBF Files|*.dbf"
    ENDPROC
ENDDEFINE

Si deseas mayor documentacion Doug Hennig tiene un documento que explica a mayor detalle el manejo de ActiveX con VFP:

--- Using Visual FoxPro ActiveX Controls (118K) ---
http://downloads.stonefield.com/pub/axsamp.zip

Y también está documentado en el MSDN de VFP como un Bug:

--- BUG: License Error with ActiveX Control Added at Run-Time ---
http://support.microsoft.com/?scid=192693

Espero les sea de utilidad.

Un agradecimiento a Alex Feldstein por el código de MSCommonDialog

Espartaco Palma Martínez

2 de diciembre de 2005

Determinar si un campo es AutoIncremental

Determinar si es un campo específico es un campo AutoIncremental, es un poco molesto. Esa información está solamente disponible comprobando la 17° o 18° columna de la matriz creada por AFIELDS() en la fila del campo.

La rutina X8IsAutoInc.PRG de este artículo hace que esa información sea fácil de consultar.

* 
*  X8IsAutoInc.PRG
*
*  RETURNs a logical value indicating whether the
*  passed field is an AutoInc field.
*
*  Author:  Drew Speedie  
*
*  lParameters
*  tcFieldName (R)  FieldName or Alias.FieldName
*                     to be checked to see if it
*                     is an AutoInc field.
*      tcAlias (O)  If tcFieldName is passed as
*                     Alias.FieldName, this parameter
*                     is ignored.
*                   If tcFieldName is passed as 
*                     just a FieldName, this parameter
*                     is REQUIRED, specifying the ALIAS()
*                     whose tcFieldName is to be
*                     checked to see if it is an AutoInc
*                     field.
*
*  If tcFieldName is in a REMOTE VIEW, this routine
*    RETURNS .F.
*  If tcFieldName is in a LOCAL VIEW, this routine 
*    RETURNS a logical value indicating whether tcFieldName
*    in its base table is an AutoInc field.
*
*  The Alias specified in tcFieldName/tcAlias must be USED(),
*  if the Alias is a local view, its base table must
*  also be USED().
*
LPARAMETERS tcFieldName, tcAlias

IF VERSION(5) < 800
  RETURN .f.
ENDIF

IF NOT VARTYPE(tcFieldName) = "C" ;
     OR EMPTY(tcFieldName) 
  ASSERT .f. MESSAGE "tcFieldName is required"
  RETURN .NULL.
ENDIF

LOCAL lcAlias, lcFieldName
lcFieldName = UPPER(ALLTRIM(tcFieldName))
IF OCCURS(".",lcFieldName) = 1
  lcAlias = JUSTSTEM(lcFieldName)
  lcFieldName = JUSTEXT(lcFieldName)
 ELSE
  IF VARTYPE(tcAlias) = "C" AND NOT EMPTY(tcAlias) 
    lcAlias = UPPER(ALLTRIM(tcAlias))
   ELSE
    ASSERT .f. MESSAGE "tcAlias is required when po does not include the Alias"
    RETURN .NULL.
  ENDIF
ENDIF       

IF CURSORGETPROP("SourceType",lcAlias) = 2
  *
  *  remote view
  *
  RETURN .f.
ENDIF

LOCAL laFields[1], xx, llAutoInc, llView, lnSelect
llAutoInc = .f.

lnSelect = SELECT(0)
SELECT (lcAlias)

llView = CURSORGETPROP("SourceType",lcAlias) = 1
IF llView
  lcAlias = X8BTABLE(lcAlias+"."+lcFieldName,CURSORGETPROP("Database",lcAlias))
  SELECT (lcAlias)
ENDIF

AFIELDS(laFields)
xx = ASCAN(laFields,lcFieldName,1,-1,1,15)
IF xx > 0
  llAutoInc = laFields[xx,17] > 0
ENDIF

SELECT (lnSelect)

RETURN llAutoInc

VFP Tips & Tricks - Drew Speedie