1.-
El espacio de las unidades grandes (más de 2GB)
(18/Abr)
Como habrás comprobado, si has usado la función del API GetDiskFreeSpace, el valor que se consigue está bien para unidades de hasta 2 gigas, pero si usas unidades más grandes... esa función se queda pequeña. Puedes ver un ejemplo de cómo usarla en Averiguar el espacio libre de una unidad de disco (32 bits), aunque la función que puse en lugar de devolver el espacio libre, devuelve el espacio total del disco.
El problema que uno se encuentra
con esa función es que el valor devuelto es siempre de 2GB
incluso para discos con más espacio... pero ese
"problemilla" se puede solucionar usando otra función
del API. La declaración de esa función para usar con VB no
viene en el fichero WINAPI32.txt, pero he creado una declaración
para que se pueda usar.
Esta es la declaración que viene en el fichero WINBASE.H
WINBASEAPI
BOOL
WINAPI
GetDiskFreeSpaceExA(
LPCSTR lpDirectoryName,
PULARGE_INTEGER lpFreeBytesAvailableToCaller,
PULARGE_INTEGER lpTotalNumberOfBytes,
PULARGE_INTEGER lpTotalNumberOfFreeBytes
);
El problema se me presentó a la hora de convertir el tipo ese PULARGE_INTEGER, busqué en las definiciones y me encontré con esto en el fichero WINNT.H:
#if defined(MIDL_PASS)
typedef struct _ULARGE_INTEGER {
#else // MIDL_PASS
typedef union _ULARGE_INTEGER {
struct {
DWORD LowPart;
DWORD HighPart;
};
struct {
DWORD LowPart;
DWORD HighPart;
} u;
#endif //MIDL_PASS
DWORDLONG QuadPart;
} ULARGE_INTEGER;
typedef ULARGE_INTEGER *PULARGE_INTEGER;
La verdad es que no sabía que
hacer con esto, salvo usar un tipo definido con dos longs, pero
antes de empezar a "probar", rebusqué en los CDs que
tengo del MSDN lo que había sobre esta función, la verdad es
que no encontré demasiado, por no decir nada... salvo un
comentario a cómo poder usar el tipo Currency para valores
grandes, ya que es casi un tipo entero de 8 bits, sólo que el
resultado obtenido habrá que multiplicarlo por 10000, ya que ese
tipo de datos contiene un número con 4 decimales.
Probé y... ¡funcionó! y aquí está la declaración a usar en
Visual Basic:
Private Declare Function GetDiskFreeSpaceEx Lib "kernel32" Alias "GetDiskFreeSpaceExA" _
(ByVal lpRootPathName As String, _
lpFreeBytesAvailableToCaller As Currency, _
lpTotalNumberOfBytes As Currency, _
lpTotalNumberOfFreeBytes As Currency) As Long
Para usarla, hay que multiplicar
por 10000 el valor de los bytes devueltos. Aquí tienes una
función que devuelve el espacio total, así como el espacio
libre, todo ello en bytes:
En esta función el nombre del path puede estar representado por
un nombre UNC: \\Equipo\recurso\
Private Function EspacioLibreEx(ByVal lpRootPathName As String)
'lpRootPathName= Directorio raiz de la unidad a examinar
'Valores devueltos por la función:
Dim ret As Long
Dim lpFreeBytesAvailableToCaller As Currency
Dim lpTotalNumberOfBytes As Currency
Dim lpTotalNumberOfFreeBytes As Currency
'
Dim TotalBytes As Currency
Dim TotalFreeBytes As Currency
ret = GetDiskFreeSpaceEx(lpRootPathName, _
lpFreeBytesAvailableToCaller, _
lpTotalNumberOfBytes, _
lpTotalNumberOfFreeBytes)
TotalBytes = lpTotalNumberOfBytes * 10000
TotalFreeBytes = lpTotalNumberOfFreeBytes * 10000
EspacioLibreEx = Format(TotalBytes, "###,###,###") & " / " & _
Format(TotalFreeBytes, "###,###,###")
End Function
5.-
Cambiar la resolución de la pantalla (y el número de colores)
(25/Jun)
Esto es algo que lo tenía desde
hace tiempo pendiente de poner, pero que al recibir una consulta
sobre el tema, me hizo desempolvar la rutina (como ves aún hay
gente atrevida que me hace consultas, espero que no cunda el
ejemplo)
La cuestión es que he convertido lo que tenía de la MSDN
Library y lo he puesto en un form para que sea operativo y
permita seleccionar de una lista las resoluciones disponibles,
incluso los bits usados para el color, ya sabes: 8 bits son 256
colores.
El código de ejemplo, así como las declaraciones
de las funciones y tipos del API las encontrarás en este link.
Funciones del API usadas:
EnumDisplaySettings
ChangeDisplaySettings
8.-
Seleccionar un directorio, usando SHBrowseForFolder (4/Jul)
Una función del API para
seleccionar sólo un directorio.
En la página de los controles ActiveX tienes un control (y el
código) del "selector de directorios" que yo me
fabriqué y que, aunque no es estándard, al menos me gusta más
que este)
Aquí tienes las declaraciones (las puedes usar en un módulo BAS o en un formulario)
'
Const MAX_PATH = 255
Private Enum eBIF
BIF_RETURNONLYFSDIRS = &H1 'Sólo directorios del sistema
BIF_DONTGOBELOWDOMAIN = &H2 'No incluir carpetas de red
BIF_STATUSTEXT = &H4
BIF_RETURNFSANCESTORS = &H8
BIF_BROWSEFORCOMPUTER = &H1000 'Buscar PCs
BIF_BROWSEFORPRINTER = &H2000 'Buscar impresoras
End Enum
Private Type BrowseInfo
hwndOwner As Long
pIDLRoot As Long 'Especifica dónde se empezará a mostrar
pszDisplayName As Long
lpszTitle As Long
ulFlags As Long
lpfnCallback As Long
lParam As Long
iImage As Long
End Type
Private Declare Function SHBrowseForFolder Lib "shell32.dll" _
(lpbi As BrowseInfo) As Long
Private Declare Sub CoTaskMemFree Lib "ole32.dll" _
(ByVal hMem As Long)
Private Declare Function lstrcat Lib "kernel32.dll" Alias "lstrcatA" _
(ByVal lpString1 As String, ByVal lpString2 As String) As Long
Private Declare Function SHGetPathFromIDList Lib "shell32.dll" _
(ByVal pidList As Long, ByVal lpBuffer As String) As Long
'Si se quiere usar en un form, cambiar el public por private
Public Function BrowseForFolder(ByVal hwndOwner As Long, ByVal sPrompt As String, Optional ByVal vFlags As eBIF) As String
'
Dim iNull As Integer
Dim lpIDList As Long
Dim lResult As Long
Dim sPath As String
Dim udtBI As BrowseInfo
Dim lFlags As Long
If Not IsMissing(vFlags) Then
lFlags = CInt(vFlags)
End If
With udtBI
.hwndOwner = hwndOwner
.lpszTitle = lstrcat(sPrompt, "")
.ulFlags = lFlags Or BIF_RETURNONLYFSDIRS
End With
lpIDList = SHBrowseForFolder(udtBI)
If lpIDList Then
sPath = String$(MAX_PATH, 0)
lResult = SHGetPathFromIDList(lpIDList, sPath)
Call CoTaskMemFree(lpIDList)
iNull = InStr(sPath, vbNullChar)
If iNull Then
sPath = Left$(sPath, iNull - 1)
End If
Else
'Se ha pulsado en cancelar
sPath = ""
End If
BrowseForFolder = sPath
End Function
Para usarlo:
'Para usarlo desde un Form: Label1 = BrowseForFolder(Me.hWnd, "Selecciona un directorio")
9.-
Deshabilitar los botones (y el menú system) de un form Normal o
MDI (10/Jul)
Pues eso, ya que hay gente que se
pregunta el cómo y aquí tienes la respuesta.
En el código de ejemplo se incluye la forma de quitar TODAS las
opciones, incluyendo maximizar, restaurar, etc. y también cómo
quitar sólo lo que te interesa.
También incluyo el código para el VB4 de 16 bits.
Este código vale tanto para forms
normales como para MDI-Form, además si quitas el menú
"Mover", no podrás mover el formulario de sitio.
Hay más constantes, que puedes encontrar en el fichero de las
declaraciones del API que se incluyen con el VB.
En la sección de las declaraciones del MDI-Form escribe lo siguiente:
'------------------------------------------------------------------
'Prueba para quitar opciones del menú System de un MDIForm
'
'Para VB4: (27/Oct/97)
'
'©Guillermo 'guille' Som, 1997-98
'------------------------------------------------------------------
Option Explicit
#If Win32 Then
'Para 32 bits (VB4 y VB5)
Private Declare Function GetSystemMenu Lib "user32" _
(ByVal hWnd As Long, ByVal bRevert As Long) As Long
Private Declare Function DeleteMenu Lib "user32" _
(ByVal hMenu As Long, ByVal nPosition As Long, _
ByVal wFlags As Long) As Long
#Else
'Para 16 bits (VB4 y VB3)
Private Declare Function GetSystemMenu Lib "user" (ByVal hWnd%, ByVal bRevert%) As Integer
Private Declare Function DeleteMenu Lib "user" (ByVal hMenu%, ByVal iditem%, ByVal wFlags%) As Integer
#End If
'Constantes
Const SC_SIZE = &HF000
Const SC_MOVE = &HF010
Const SC_MINIMIZE = &HF020
Const SC_MAXIMIZE = &HF030
Const SC_CLOSE = &HF060
Const SC_RESTORE = &HF120
Const MF_SEPARATOR = &H800
Const MF_BYPOSITION = &H400
Const MF_BYCOMMAND = &H0
Private Sub MDIForm_Load()
#If Win32 Then
Dim hWnd&, hMenu&, Success&
#Else
Dim hWnd%, hMenu%, Success%
#End If
Dim i%
hWnd = Me.hWnd
hMenu = GetSystemMenu(hWnd, 0)
'Quitar todos (va de 0 a 8)
For i = 8 To 0 Step -1
Success = DeleteMenu(hMenu, i, MF_BYPOSITION)
Next
Exit Sub
'Usa esto para quitar los menús que te interesen:
Success = DeleteMenu(hMenu, SC_SIZE, MF_BYCOMMAND)
'Success = DeleteMenu(hMenu, SC_MOVE, MF_BYCOMMAND)
Success = DeleteMenu(hMenu, SC_CLOSE, MF_BYCOMMAND)
Success = DeleteMenu(hMenu, SC_MINIMIZE, MF_BYCOMMAND)
'Success = DeleteMenu(hMenu, SC_MAXIMIZE, MF_BYCOMMAND)
'Success = DeleteMenu(hMenu, SC_RESTORE, MF_BYCOMMAND)
End Sub
11.-
Una API para saber los directorios del Sistema (20/Ago)
Siguiendo con la racha de los últimos días de saber dónde están los distintos directorios del sistema, no sólo Windows ni el System, que esos ya tienen sus correspondientes funciones del API, sino para otros directorios como el de los Archivos de programa, el Menú de Inicio, el Escritorio, los Cookies, etc.
Esta función no la he visto documentada para usarla en Visual Basic, pero gracias a Francisco Charte que respondiendo en las news dio su dirección de internet (La Torre de Babel) en la que había un pequeño ejemplo para Delphi, pues me "calenté" y la convertí en VB y aquí está, con un pequeño ejemplo en el que se dan todas las constantes para poder usarla con esta función para obtener los distintos directorios.
En este "trozo" de espacio de esta página sólo daré algunas de las constantes y la forma general de obtener los directorios, pero en el ejemplo están todas las constantes que he encontrado en la documentación de Microsoft.
Si quieres los listados con el form de ejemplo, pulsa este link. (SHGetSFP.zip 2.65 KB)
'La longitud máxima de un directorio puede ser 260
Const MAX_PATH = 260
'Algunas de las constantes
Const CSIDL_DESKTOP = 0
Const CSIDL_PROGRAMS = 2
Const CSIDL_STARTUP = 7
Const CSIDL_STARTMENU = 11
'La declaración del API:
Private Declare Function SHGetSpecialFolderPath Lib "shell32.dll" Alias "SHGetSpecialFolderPathA" _
(ByVal hWnd As Long, ByVal sPath As String, _
ByVal Folder As Long, ByVal Create As Long) As Long
'Para usarla: (en este ejemplo se mostrará el path del directorio de programas del menú de inicio)
Dim sPath As String
sPath = String$(MAX_PATH + 1, 0)
Call SHGetSpecialFolderPath(Me.hWnd, sPath, CSIDL_PROGRAMS, False)
'Quitarle el CHR$(0) del final
sPath = Left$(sPath, InStr(sPath, Chr$(0)) - 1)
MsgBox "El directorio de los Archivos de programa está en: " & vbCrLf & sPath
Nota del 11/May/2001:
Si quieres saber otros directorios, por ejemplo Archivos de programa, Windows,
etc. puedes usar la clase cQueryReg.
Por ejemplo para saber el directorio de Archivos de programa, tendrías que
hacer algo así:
'
Dim oQR As cQueryReg
Set oQR = New cQueryReg
Label1.Caption = oQR.GetFolder("ProgramFilesDir")
¡Que lo disfrutes!
12.-
Saber si un form se muestra Modal o Normal (28/Ago)
Esto está sacado de un artículo
para VB de 16 bits de la Knowledge Base de Microsoft, la
adaptación ha sido fácil, ya que sólo he tenido que cambiar la
declaración del API.
El truco consiste en saber si el formulario que muestra modal o
no modal a un segundo formulario está habilitado o no.
Ya sabes que cuando se muestra un form de forma modal, los demás formularios de la aplicación están deshabilitados hasta que se oculte o cierre el formulario modal, por tanto se usa GetWindowLong y se comprueba si el estilo del primer form está deshabilitado o no.
Veamos el código de ejemplo.
Crea un proyecto con 2 forms, en el Form1, añade un botón
(Command1) y lo mismo en el Form2.
'FORM1
Option Explicit
Private Sub Command1_Click()
' Flip between "Modeless" and "Modal" display states.
Static ShowStyle As Long
Unload Form2
Form2.Show ShowStyle
ShowStyle = (ShowStyle + 1) Mod 2
If ShowStyle Then
Command1.Caption = "Mostrar Form2: Modal"
Else
Command1.Caption = "Mostrar Form2: No Modal"
End If
End Sub
Private Sub Form_Load()
Command1.Caption = "Mostrar Form2: No Modal"
End Sub
'FOM2
'
'How to Determine Display State of a VB Form, Modal or Modeless
'PSS ID Number: Q77316
'
Option Explicit
Const GWL_STYLE = (-16)
Const WS_DISABLED = &H8000000
'$Añadido por Guillermo 'guille' Som, 28/Ago/1998
Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" _
(ByVal hWnd As Long, ByVal nIndex As Long) As Long
Private Sub Command1_Click()
Unload Me
End Sub
Private Sub Form_Paint()
Dim WinStyle As Long
' Get the Window Style for Form1.
WinStyle = GetWindowLong(Form1.hWnd, GWL_STYLE)
If WinStyle And WS_DISABLED Then
' The WS_DISABLED style is set on "FORM1" when "FORM2"
' is displayed with the Modal flag (Show 1).
Caption = "Se muestra: Modal"
Else
' The WS_DISABLED style is not set on "FORM1" when "FORM2"
' is displayed with the Modeless flag (Show or Show 0).
Caption = "Se muestra: Modeless (no modal)"
End If
End Sub
14.-
timeGetTime, un temporizador más preciso que GetTickCount
(31/Ago)
Este temporizador, también llamado temporizador multimedia, tiene mayor precisión que GetTickCount, a saber:
La precisión de GetTickCount
es (aproximadamente)
de 10 milisegundos en Windows NT 3.5 o superior
de 16 ms. en Windows NT 3.1
de 55 ms. en Windows 95 o superior
Por el contrario, la precisión de
timeGetTime es:
1 milisegundo en Windows 95, y de
5 milisegundos o más, (es configurable), en Windows NT
Tanto uno como el otro, se basan en el tiempo transcurrido desde que se inicio Windows y se vuelve a poner a cero cuando han transcurrido 2^32 milisegundos, es decir después de 49.7 días.
Estas son las declaraciones del API para estas funciones:
Declare Function timeGetTime Lib "winmm.dll" () As Long Declare Function GetTickCount Lib "kernel32.dll" () As Long
Si quieres ver un ejemplo de cómo usar estas funciones, pulsa en este link que te llevará a la página con la clase cGetTimer, en la cual hay un ejemplo en el que se usan los dos temporizadores.
18.-
Enumerar los usuarios de nuestro equipo (profiles)
(15/Oct)
Este ejemplo es para saber los
diferentes usuarios que tienen acceso a nuestro equipo
(profiles).
Para saberlo, he usado la clase cQueryReg (revisión 2 del 14/Oct/98), que permite enumerar claves y valores del
registro del sistema, en este caso la entrada del registro que
nos interesa es:
HKEY_LOCAL_MACHINE\Software\Microsoft\Windows\CurrentVersion\ProfileList
Con el siguiente código, (te recuerdo que necesitas la nueva versión de cQueryReg), se mostrarán en un combo los usuarios, para ello se leen las subclaves que hay en la clave indicada anteriormente, dentro de estas claves habrá más información sobre el usuario, pero aquí sólo vamos a mostrar los nombres.
Nota: deberás tener un formulario con un comboBox llamado cboProfiles.
'
Option Explicit
Private m_QR As cQueryReg 'Clase de manipulación del registro
Private colKeys() As String 'Array para guardar los nombres/contenidos
Private Sub Form_Load()
'Leer del registro los usuarios disponibles
'y añadirlos al combo
'
Dim sKey As String
Dim i As Long
Set m_QR = New cQueryReg
'Borrar el contenido de colKeys
ReDim colKeys(0)
cboProfiles.Clear
cmdConectar.Enabled = False
'Los usuarios disponibles están en:
sKey = "HKEY_LOCAL_MACHINE\Software\Microsoft\Windows\CurrentVersion\ProfileList"
'como mínimo tener el valor por defecto
cboProfiles.AddItem ".Default"
'Leer los nombres de las claves disponibles
If m_QR.EnumKeys(colKeys(), sKey) Then
For i = 1 To UBound(colKeys)
cboProfiles.AddItem colKeys(i)
Next
End If
cboProfiles.ListIndex = 0
End Sub
19.-
Registrar Hot-Keys con nuestra aplicación... para activarla por
ejemplo (07/Dic)
Con este ejemplo lo que se hará
es asignar las teclas Ctrl+F para que al pulsa esa combinación
de teclas, se active nuestra aplicación.
No he hecho pruebas con una aplicación real, pero todo será
cuestión de hacerlo...
Para hacer la prueba, crea un nuevo proyecto y añade el siguiente código:
'------------------------------------------------------------------
'Prueba para registrar una combinación de teclas (06/Dic/98)
'y activar la aplicación al recibirlas...
'
'El código para esperar a que se reciban los mensajes, está
'inspirado en el código de Francisco Charte para usar Drag&Drop
'con el VB4
'
'©Guillermo 'guille' Som, 1998
'------------------------------------------------------------------
Option Explicit
Private Declare Function RegisterHotKey Lib "user32" _
(ByVal hWnd As Long, ByVal id As Long, ByVal fsModifiers As Long, ByVal vk As Long) As Long
Private Declare Function UnregisterHotKey Lib "user32" (ByVal hWnd As Long, ByVal id As Long) As Long
Private Const MOD_ALT = &H1
Private Const MOD_CONTROL = &H2
Private Const MOD_SHIFT = &H4
Private Const WM_HOTKEY = &H312
'Tipos de datos para las funciones del API
Private Type POINTAPI
x As Long
y As Long
End Type
Private Type Msg
hWnd As Long
message As Long
wParam As Long
lParam As Long
time As Long
pt As POINTAPI
End Type 'MSG
Private Const PM_REMOVE = &H1
'funciones para recibir los mensajes de windows
Private Declare Function PeekMessage Lib "user32" Alias "PeekMessageA" _
(lpMsg As Msg, ByVal hWnd As Long, ByVal wMsgFilterMin As Long, _
ByVal wMsgFilterMax As Long, ByVal wRemoveMsg As Long) As Long
Private Declare Function WaitMessage Lib "user32" () As Long
Private Termina As Boolean
Private Sub ProcesaMensajes()
'Para leer mensajes de la cola
Dim Mensaje As Msg
'Mientras Termina no sea True
Do While Not Termina
'esperamos a que llegue un mensaje
WaitMessage
'Si ese mensaje es WM_HOTKEY
If PeekMessage(Mensaje, Me.hWnd, WM_HOTKEY, WM_HOTKEY, PM_REMOVE) Then
'Restauramos el formulario al estado normal
'por si está minimizado
WindowState = vbNormal
'Mostramos el form
Show
End If
'permitimos el trabajo de otros procesos
DoEvents
Loop
End Sub
Private Sub Form_Load()
'registrar las teclas para activación de esta aplicación
Dim ret As Long
Termina = False
'La tecla Crtl+F será la que activará este formulario
ret = RegisterHotKey(Me.hWnd, &HBFFF&, MOD_CONTROL, vbKeyF)
'If ret Then
' Label2 = "Se ha registrado de forma correcta el Hot-Key"
'Else
' Label2 = "No se ha registrado el Hot-Key"
'End If
'Hay que mostrar el form
'sino entrará en el bucle de espera de mensajes sin mostrarse
Show
ProcesaMensajes
End Sub
Private Sub Form_Unload(Cancel As Integer)
Termina = True
'Quitar la Hot-Key registrada
Call UnregisterHotKey(Me.hWnd, &HBFFF&)
End Sub
Este truquillo o forma de hacerlo ha sido gracias a una pregunta en los grupos de noticias de Laura Casanova:
Estoy haciendo un programa en el que debo capturar una secuencia de
teclas, me han comentado que con la funcion RegisterHotKey se puede
conseguir, alguien me puede explicar como funciona la funcion
RegisterHotKey.
Gracias
