Comunidad de Visual FoxPro en Español: febrero 2002

25 de febrero de 2002

Saber si existe una tabla o vista en una DBC

VFP tiene al menos dos funciones que podemos utilizar para saber si existe una tabla o vista en una DBC:

1. Con INDBC():

IF NOT DBUSE("MiDbc")
  OPEN DATABASE C:MiDbc
ENDIF
SET DATABASE MiDbc

*-- Saber si existe la tabla "MiTabla"
IF INDBC("MiTabla", "TABLE")
  MESSAGEBOX("Si existe la tabla")
ELSE
  MESSAGEBOX("No existe la tabla")
ENDIF

*-- Saber si existe la vista "MiVista"
IF INDBC("MiVista", "VIEW")
  MESSAGEBOX("Si existe la vista")
ELSE
  MESSAGEBOX("No existe la vista")
ENDIF

2. Con ADBOBJECTS():

IF NOT DBUSE("MiDbc")
  OPEN DATABASE C:MiDbc
ENDIF
SET DATABASE MiDbc

*-- Saber si existe la tabla "MiTabla"
ln = ADBOBJECTS(laArray, "TABLE")
IF ln > 0 AND 0 # ASCAN(laArray, UPPER("MiTabla"))
  MESSAGEBOX("Si existe la tabla")
ELSE
  MESSAGEBOX("No existe la tabla")
ENDIF

*-- Saber si existe la vista "MiVista"
ln = ADBOBJECTS(laArray, "VIEW")
IF ln > 0 AND 0 # ASCAN(laArray, UPPER("MiVista"))
  MESSAGEBOX("Si existe la vista")
ELSE
  MESSAGEBOX("No existe la vista")
ENDIF

Luis María Guayán

24 de febrero de 2002

18 de febrero de 2002

Expandir un combo automáticamente

Un truco para expandir un combo automáticamente cuando este toma el foco.

En el método GotFocus del Combo poner el siguiente código:

KEYBOARD "{x41A0}"

Gracias a Carlos Yohn Zubiria por el truco.

9 de febrero de 2002

Obtener IP, MAC address y GUID

Aquí les dejo las rutinas para obtener: las IP's, las direcciones MAC y obtener un Global Unique IDentifier.

Rutinas para obtener:

Las IPs (todas de todas las LAN) de una máquina.
Las direcciones MAC (de todas las LAN) de una máquina. (esta vez directamente desde VFP sin crear una FLL como publique anteriomente)
Obtener un Global Unique IDentifier

CLEAR
?
? 'Enjoy it, by Alexandre Hedreville'

?
? 'MAC Address'
? '-----------'
? MACAddress()

?
? 'IP Address'
? '-----------'
? IPAddress()

?
? 'GUID'
? '-----------'
? GetGuid()

*!* Windows Sockets
#DEFINE WS_VERSION_REQD        257
#DEFINE WS_VERSION_MAJOR    1
#DEFINE WS_VERSION_MINOR    1
#DEFINE MIN_SOCKETS_REQD    1
#DEFINE SOCKET_ERROR        -1
#DEFINE WSADESCRIPTION_LEN     256
#DEFINE WSASYS_STATUS_LEN     128

*!* Windows NetBIOS
#DEFINE NCBENUM                     55
#DEFINE NCBASTAT                    51
#DEFINE NCBNAMSZ                    16
#DEFINE HEAP_ZERO_MEMORY            8
#DEFINE HEAP_GENERATE_EXCEPTIONS    4
#DEFINE NCBRESET                    50

*!* Devuelve las direcciones MAC
*!* Sintaxis: MACAddress()
*!* Valor devuelto: lcRetVal
*!* lcRetVal viene expresado como una cadena con el formato: 00-04-76-A4-73-3A, 00-04-76-A4-72-13, ...
FUNCTION MACAddress
  LOCAL lcNBC, lcAdapter, lnAdapter, lcSource, lnSource, lcRetVal, lnLength, lnLEnum, lcLEnum
  *!* Instrucciones DECLARE DLL para manipular NetBIOS
  DECLARE INTEGER GetProcessHeap IN Win32API
  DECLARE INTEGER Netbios IN Netapi32.DLL STRING @lpNBC
  DECLARE INTEGER HeapFree IN Win32API INTEGER hHeap, INTEGER dwFlags, STRING @lpMem
  DECLARE INTEGER HeapAlloc IN Win32API INTEGER hHeap, INTEGER dwFlags, INTEGER dwBytes
  DECLARE INTEGER RtlMoveMemory IN Win32API STRING @lpDestination, INTEGER nSource, INTEGER nBytes
  *!* Valores
  lcRetVal  = ''
  lcNBC     = REPLICATE(CHR(0), 64)
  lcLEnum   = REPLICATE(CHR(0), 256)
  lcAdapter = REPLICATE(CHR(0), 600)
  *!* Reservar buffer memoria
  lnLEnum = HeapAlloc(GetProcessHeap(), BITOR(HEAP_GENERATE_EXCEPTIONS, HEAP_ZERO_MEMORY), 256)
  IF lnLEnum <> 0
    *!* Valores
    lcNBC = CHR(NCBENUM) + REPLICATE(CHR(0), 3) + LongToStr(lnLEnum) + ;
      IntToStr(256) + SUBSTR(lcNBC, 11, 544)
    *!* Enum LAN´s
    IF Netbios(@lcNBC) = 0
      *!* Leer buffer memoria
      lnSource = lnLEnum
      RtlMoveMemory(@lcLEnum, lnSource, 256)
      *!* Valores
      lnLength = ASC(SUBSTR(lcLEnum, 1, 1))
      *!* Examinar LAN`s
      FOR lnCnt = 1 TO lnLength
        *!* Valores
        lcAdapter = REPLICATE(CHR(0), 600)
        lcNBC     = CHR(NCBRESET) + REPLICATE(CHR(0), 47) +  ;
          SUBSTR(lcLEnum, lnCnt+1, 1) + REPLICATE(CHR(0), 15)
        *!* Reset LAN
        IF Netbios(@lcNBC) = 0
          *!* Reservar buffer memoria
          lnAdapter = HeapAlloc(GetProcessHeap(), ;
            BITOR(HEAP_GENERATE_EXCEPTIONS, HEAP_ZERO_MEMORY), 600)
          IF lnAdapter <> 0
            *!* Valores
            lcNBC = CHR(NCBASTAT) + REPLICATE(CHR(0), 3) + LongToStr(lnAdapter) + ;
              IntToStr(600) + '*               ' + REPLICATE(CHR(0), 22) + ;
              SUBSTR(lcLEnum, lnCnt+1, 1) + REPLICATE(CHR(0), 15)
            *!* Status LAN
            IF Netbios(@lcNBC)  = 0
              *!* Leer buffer memoria
              lnSource = lnAdapter
              RtlMoveMemory(@lcAdapter, lnSource, 600)
              *!* Componer cadena MAC con guiones y separar multiples MAC`s con comas
              lcRetVal = lcRetVal + RIGHT(DecToHex(ASC(SUBSTR(lcAdapter, 1, 1))), 2) + ;
                '-' + RIGHT(DecToHex(ASC(SUBSTR(lcAdapter, 2, 1))), 2) + ;
                '-' + RIGHT(DecToHex(ASC(SUBSTR(lcAdapter, 3, 1))), 2) + ;
                '-' + RIGHT(DecToHex(ASC(SUBSTR(lcAdapter, 4, 1))), 2) + ;
                '-' + RIGHT(DecToHex(ASC(SUBSTR(lcAdapter, 5, 1))), 2) + ;
                '-' + RIGHT(DecToHex(ASC(SUBSTR(lcAdapter, 6, 1))), 2) + ;
                IIF(lnCnt = lnLength, '', ',')
            ENDIF
            *!* Liberar buffer memoria
            lcSource = LongToStr(lnAdapter)
            HeapFree(GetProcessHeap(), 0, @lcSource)
          ENDIF
        ENDIF
      ENDFOR
    ENDIF
    *!* Liberar buffer memoria
    lcSource = LongToStr(lnLEnum)
    HeapFree(GetProcessHeap(), 0, @lcSource)
  ENDIF
  *!* Retorno
  RETURN lcRetVal
ENDFUNC

Continuar leyendo el artículo »

8 de febrero de 2002

Pasar de hexadecimal a decimal

Una forma fácil de pasar números del sistema hexadecimal al sistema decimal y viceversa.

A partir de VFP 6 podemos pasar un número hexadecimal a decimal de una forma directa. Por ejemplo queremos convertir el número hexadecimal "FFFF" al sistema decimal:

? 0xFFFF

De la misma manera podemos pasar un número decimal al sistema hexadecimal utilizando la función TRANSFORM()

lnDec = 123
? TRANSFORM(lnDec,"@0")

A partir de esto, creamos las correspondientes funciones definidas por el usuario, que nos permiten la conversión de números de un sistema a otro:

*--------------------------------------------
FUNCTION Hex2Dec(tcHex)
  RETURN EVALUATE("0x"+ALLTRIM(tcHex))
ENDFUNC
*--------------------------------------------
FUNCTION Dec2Hex(tnDec)
  RETURN SUBSTR(TRANSFORM(tnDec,"@0"),3)
ENDFUNC
*--------------------------------------------

Luis María Guayán

Ventana sin caption

Es sencillo pero se pregunta muchas veces, aquí teneis como lo hace Carlos Yohn Zubiria ... En las propiedades del formulario, hay que poner:

caption = ""
controlbox = .F.
maxbutton = .F.
minbutton = .F.
movable = .F.

Pablo Roca

7 de febrero de 2002

Extraer la parte numérica de una cadena

Rutina para extraer la parte numérica de una cadena de caracteres.

Extraer la parte numérica, es decir solo devolver los dígitos numéricos del [0]..[9], sin letras ni simbolos especiales.

Ejemplo:

? ExtraerNumeros("AA45BB111C%")

*-------------------------------------
* FUNCTION ExtraerNumeros(tcCadena)
*-------------------------------------
* Extraer la parte numerica de una cadena
* RETORNA: Caracter
* USO: ? ExtraerNumeros("A125FC023")
*-------------------------------------
FUNCTION ExtraerNumeros(tcCadena)
 RETURN CHRTRAN(tcCadena,CHRTRAN(tcCadena,"1234567890",""),"")
ENDFUNC
*-------------------------------------