© Copyright 2008 canalvisualbasic.net Ontecnia. Todos los derechos reservados
Otros sitios web de Ontecnia
Funciones
y ejemplos:
SendMessage:
la que siempre hay que tener a mano
SetWindowWord:
crear ventanas flotantes
GetVolumeInformation:
leer el volumen de un disco (32 bits)
GetDriveType:
comprobar el tipo de unidad
Dejar
una ventana siempre visible
Usar
Sleep en lugar de DoEvents
Marcador
de teléfonos de Win95
La
línea actual y el número de líneas de un text-box
Uso
de PostMessage en lugar de SendMessage
1.-
SendMessage: la que siempre hay que tener a mano
'Declaración del API de 16 bits
Declare Function SendMessage Lib
"User" _
(ByVal hWnd As Integer, ByVal wMsg As Integer, _
ByVal wParam As Integer, lParam As Any) As Long
'Declaración del API de 32 bits.
Declare Function SendMessage Lib
"User32" Alias "SendMessageA" _
(ByVal hwnd As Long, ByVal wMsg As Long, _
ByVal wParam As Long, lParam As Long) As Long
'Utilidades para un menú de
edición:
'
'Declaración de las constantes
Global Const WM_USER = &H400
Global Const EM_GETSEL = WM_USER
+ 0
Global Const EM_SETSEL = WM_USER
+ 1
Global Const EM_REPLACESEL =
WM_USER + 18
Global Const EM_UNDO = WM_USER +
23
Const EM_LINEFROMCHAR = WM_USER +
25
Const EM_GETLINECOUNT = WM_USER +
10
'
Global Const WM_CUT = &H300
Global Const WM_COPY = &H301
Global Const WM_PASTE = &H302
Global Const WM_CLEAR = &H303
'
'Deshacer:
'Nota: si se
hace de esta forma,
'no es
necesario usar una variable para asignar el valor devuelto.
If
SendMessage(Screen.ActiveForm.ActiveControl.hWnd, EM_UNDO, 0, ByVal 0&) Then
End If
'también: x =
SendMessage(Screen.ActiveForm.ActiveControl.hWnd, EM_UNDO, 0, ByVal 0&)
'Copiar:
If
SendMessage(Screen.ActiveForm.ActiveControl.hWnd, WM_COPY, 0, ByVal 0&) Then
End If
'Cortar:
If
SendMessage(Screen.ActiveForm.ActiveControl.hWnd, WM_CUT, 0, ByVal 0&) Then
End If
'Borrar:
If
SendMessage(Screen.ActiveForm.ActiveControl.hWnd, WM_CLEAR, 0, ByVal 0&)
Then
End If
'Pegar:
If
SendMessage(Screen.ActiveForm.ActiveControl.hWnd, WM_PASTE, 0, ByVal 0&)
Then
End If
'Seleccionar Todo:
If
SendMessage(Screen.ActiveForm.ActiveControl.hWnd, EM_SETSEL, 0, ByVal
&HFFFF0000) Then
End If
'Crear un TextBox con 64 KB en
lugar de 32
Global Const WM_USER = &H400
Global Const EM_LIMITTEXT =
WM_USER + 21
Dim LTmp As long
LTmp = SendMessage(Text1.hWnd,
EM_LIMITTEXT, 0, ByVal 0&)
2.-
SetWindowWord: crear ventanas flotantes
Declare Function SetWindowWord
Lib "User" (ByVal hWnd As Integer, ByVal nIndex As Integer, ByVal
wNewWord As Integer) As Integer
Declare Function SetWindowWord
Lib "User32" Alias "SetWindowWord" (ByVal hwnd As Long,
ByVal nIndex As Long, ByVal wNewWord As Long) As Long
'Crear una ventana flotante al
estilo de los tool-bar
'Cuando se minimiza la ventana
padre, también lo hace ésta.
Const SWW_hParent = -8
'En Form_Load (suponiendo que la
ventana padre es Form1)
If SetWindowWord(hWnd,
SWW_hParent, form1.hWnd) Then
End If
'Declaración de Funciones para
tomar las listas de tareas
Declare Function GetWindow Lib
"user" (ByVal hWnd As Integer, ByVal wCmd As Integer) As Integer
Declare Function GetWindowText
Lib "user" (ByVal hWnd As Integer, ByVal lpString As String, ByVal
nMaxCount As Integer) As Integer
Declare Function
GetWindowTextLength Lib "user" (ByVal hWnd As Integer) As Integer
Declare Function IsWindowVisible
Lib "User" (ByVal hWnd As Integer) As Integer
'Declaraciones para 32 bits
Declare Function GetWindow Lib
"user32" Alias "GetWindow" (ByVal hwnd As Long, ByVal wCmd
As Long) As Long
Declare Function GetWindowText
Lib "user32" Alias "GetWindowTextA" (ByVal hwnd As Long,
ByVal lpString As String, ByVal cch As Long) As Long
Declare Function
GetWindowTextLength Lib "user32" Alias
"GetWindowTextLengthA" (ByVal hwnd As Long) As Long
Declare Function IsWindowVisible
Lib "user32" (ByVal hwnd As Long) As Long
'Constantes para GetWindow
Const GW_HWNDFIRST = 0
Const GW_HWNDLAST = 1
Const GW_HWNDNEXT = 2
Const GW_HWNDPREV = 3
Const GW_OWNER = 4
Const GW_CHILD = 5
4.-
GetVolumeInformation: volumen de un disco (sólo 32 bits)
Declare Function
GetVolumeInformation Lib "Kernel32" Alias
"GetVolumeInformationA" (ByVal lpRootPathName As String, ByVal
lpVolumeNameBuffer As String, ByVal nVolumeNameSize As Long,
lpVolumeSerialNumber As Long, lpMaximumComponentLength As Long,
lpFileSystemFlags As Long, ByVal lpFileSystemNameBuffer As String, ByVal
nFileSystemNameSize As Long) As Long
Ejemplo para leer el volumen de
un disco, esta función se puede usar para ¡catalogar los CD's musicales!
Dim lVSN As Long, n As Long, s1
As String, s2 As String
s1=String$(255,Chr$(0))
s2=String$(255,Chr$(0))
l=
GetVolumeInformation("unidad", s1, Len(s1), lVSN, 0, 0, s2, Len(s2))
'lVSN tendrá el valor del Volume
Serial Number (número de serie del volumen)
Si "unidad" es el
CD-ROM y tenemos un disco de música, podemos usar el VSN para hacer un catálogo
de CD's ya que cada CD tiene un número diferente.
5.-
GetDriveType: comprobar el tipo de unidad
Para comprobar si es un CD-ROM (o
CD-musical):
'Valores de retorno de
GetDriveType
Public Const DRIVE_REMOVABLE = 2
Public Const DRIVE_FIXED = 3
Public Const DRIVE_REMOTE = 4
'Estos tipos no están en el
fichero de las declaraciones del API de 16 bits
Public Const DRIVE_CDROM = 5
Public Const DRIVE_RAMDISK = 6
'
Declare Function GetDriveType Lib
"Kernel" (ByVal nDrive As Integer) As Integer
Declare Function GetDriveType Lib
"Kernel32" Alias "GetDriveTypeA" (ByVal nDrive As String) As
Long
Dim lDrive As Long
Dim szRoot As String
szRoot="D:\" 'Poner aquí
la unidad del CD-ROM o la que queramos comprobar
lDrive= GetDriveType(szRoot)
If lDrive = DRIVE_CDROM Then
'Es un
CD-ROM/Compact-Disc
End If
6.-
Dejar una ventana siempre visible
De nuevo usaremos el API de
Windows: SetWindowPos
'Declaración para usar ventanas
siempre visibles
'Versión para 16 bits
Declare Function SetWindowPos Lib
"User" (ByVal hWnd As Integer, ByVal hWndInsertAfter As Integer, ByVal
X As Integer, ByVal Y As Integer, ByVal cx As Integer, ByVal cy As Integer,
ByVal wFlags As Integer) As Integer
'Versión para 32 bits
Declare Function SetWindowPos Lib
"User32" Alias "SetWindowPos" (ByVal hwnd As Long, ByVal
hWndInsertAfter As Long, ByVal x As Long, ByVal y As Long, ByVal cx As Long,
ByVal cy As Long, ByVal wFlags As Long) As Long
' SetWindowPos Flags
Const SWP_NOSIZE = &H1
Const SWP_NOMOVE = &H2
'Const SWP_NOZORDER = &H4
'Const SWP_NOREDRAW = &H8
Const SWP_NOACTIVATE = &H10
'Const SWP_DRAWFRAME = &H20
Const SWP_SHOWWINDOW = &H40
'Const SWP_HIDEWINDOW = &H80
'Const SWP_NOCOPYBITS = &H100
'Const SWP_NOREPOSITION =
&H200
Const SWP_FLAGS = SWP_NOMOVE Or
SWP_NOSIZE Or SWP_SHOWWINDOW Or SWP_NOACTIVATE
'Código para poner en Form_Load
'De esta forma no es necesario
usar una variable para asignar el valor devuelto:
If SetWindowPos(hWnd, -1, 0, 0,
0, 0, SWP_FLAGS) Then
End if
7.-
Usar Sleep en lugar de DoEvents
Por si alguno no lo sabe,
DoEvents se usa cuando queremos que otros programas/procesos de Windows sigan
funcionando, de forma que nuestro programa no se apodere de todo el tiempo de la
CPU. Por ejemplo cuando hacemos un bucle que puede durar "mucho", al
ejecutar DoEvents, Windows permite que otros programas sigan funcionando
normalmente.
Es aconsejable siempre usar
DoEvents ( o Sleep 0&) en los bucles largos. Yo también lo uso cuando
quiero que se "refresque" la información de un control. ¿Cuantas
veces has asignado a un Label un nuevo Caption y no lo ha mostrado?, prueba a
poner DoEvents después de la asignación y verás como se muestra enseguida. (¡oye,
esto debería aparecer en los trucos!)
Este truco está sacado de Tips
& Tricks, from Visual Basic Web Magazine. Según el autor la función
DoEvents hace lo siguiente:
while (PeekMessage(&msg,
NULL, 0, 0, PM_REMOVE)) {
TranslateMessage(&msg);
DispatchMessage(&msg);
}
Con lo cual gasta tiempo
comprobandos otros mensajes en el mismo proceso. Este comportamiento no tiene
valor en un sistema operativo multitarea. Sleep lo hace de forma más eficiente.
La declaración de Sleep es:
Public Declare Sub Sleep Lib
"kernel32" Alias "Sleep" (ByVal dwMilliseconds As Long)
Y se puede llamar de la siguiente
forma:
Sleep 0&
8.-
Manejo del Registro del Sistema
Aquí os pongo algunos ejemplos
para usar el Registro con el API de 32 bits.
Creo que también vale para 16
bits, no lo he probado, pero sólo habrá que cambiar la declaración de las
funciones. Por si vale, pondré también las declaraciones de 16 bits. Pero que
conste que no las he probado.
Si quieres un ejemplo con todas
estas funciones, echale un vistazo al código del programa gsExecute, que está
en gsExec.zip (19 KB) La explicación de cómo funciona este programa la
encontrarás en Programas de Visual Basic.
Normalmente, para obtener los
programas asociados a una extensión, sólo es necesario usar la función:
RegQueryValue. La siguiente función de ejemplo, es la que uso para obtener
información de una clave del registro:
Public Const HKEY_CLASSES_ROOT =
&H80000000
Declare Function RegQueryValue
Lib "advapi32.dll" Alias "RegQueryValueA" _
(ByVal hKey As Long, ByVal lpSubKey As String, ByVal lpValue As String, _
lpcbValue As Long) As Long
'Busca una entrada en el registro
Private Function
QueryRegBase(ByVal Entry As String, Optional vKey) As String
Dim buf As
String
Dim buflen As
Long
Dim hKey As
Long
'Si no se
especifica la clave del Registro, usar HKEY_CLASSES_ROOT
If
IsMissing(vKey) Then
hKey = HKEY_CLASSES_ROOT
Else
hKey = CLng(vKey)
End If
On Local Error
Resume Next
buf =
Space$(300)
buflen =
Len(buf)
'Buscar la
entrada especificada y devolver el valor asignado
If
RegQueryValue(hKey, Entry, buf, buflen) = 0 Then
If buflen > 1 Then
'El formato devuelto es ASCIIZ, así que quitar el último caracter
QueryRegBase = Left$(buf, buflen - 1)
Else
QueryRegBase = ""
End If
Else
QueryRegBase = ""
End If
'Desactivar la
detección de errores
On Local Error
GoTo 0
End Function
Para usarla, por ejemplo para
saber el programa asociado para abrir una determinada extensión, de que
programa se obtiene el icono y que número de icono es:
NOTA: Para usar este ejemplo, hay
que tener un control List2 en el Form y la rutina mostrada antes.
Private Sub
BuscarExtensionID(sExt As String)
Dim lRet As
Long
Dim sKey As
String
Dim sValue As
String
Dim hKey As
Long
Dim sExe As
String
Dim sIcon As
String
Dim lIcon As
Long
Dim sProgId As
String
Dim i As
Integer
Caption =
"Mostrar asociaciones de la clave: " & sExt
List2.Visible
= True
List2.Clear
List2.AddItem
"Valores del Registro para " & sExt
'
'Buscar en el
registro la extensión...
sProgId =
QueryRegBase(sExt)
If
Len(sProgId) Then
List2.AddItem "Clave: " & sProgId
sKey = sProgId & "\DefaultIcon"
List2.AddItem sKey
sValue = QueryRegBase(sKey)
If Len(sValue) Then
i = InStr(sValue, ",")
If i Then
sIcon = Left$(sValue, i - 1)
lIcon = Val(Mid$(sValue, i + 1))
Else 'No tiene programa para Defaulticon
sIcon = sValue
lIcon = 0
sValue = ""
End If
End If
List2.AddItem " Icono de: " & sIcon
List2.AddItem " Icono nº: " & lIcon
'
'Obtener el programa asociado por defecto para Abrir
'no quiere decir que este sea el que se ejecute cuando se haga doble-click
sKey = sProgId & "\Shell\Open\Command"
sValue = QueryRegBase(sKey)
If Len(sValue) Then
i = InStr(sValue, ".")
If i Then
i = InStr(i, sValue, " ")
If i Then
sExe = Trim$(Left$(sValue, i - 1))
Else
sExe = Trim$(sValue)
End If
Else
sExe = Trim$(sValue)
End If
End If
List2.AddItem sKey
List2.AddItem " Programa asociado: " & sExe
End If
End Sub
Ejemplo para crear claves en el
Registro:
Para no alargar demasiado este
fichero, aquí sólo están las declaraciones de las funciones; en los listados
del programa gsExecute, hay ejemplos de cómo crear y borrar claves para
asociar/desasociar un programa a una extensión determinada.
'Claves del Registro
Public Const HKEY_CLASSES_ROOT =
&H80000000
Public Const HKEY_CURRENT_USER =
&H80000001
Public Const HKEY_LOCAL_MACHINE =
&H80000002
Public Const HKEY_USERS =
&H80000003
'
'Para los valores devueltos por
las funciones de manejo del Registro
Public Const ERROR_SUCCESS =
0&
Public Const ERROR_NO_MORE_ITEMS
= 259&
'
' Tipos de datos Reg...
Public Const REG_SZ = 1
'
'Declaraciones del API de Windows
para 32 bits
Declare Function RegQueryValue
Lib "advapi32.dll" Alias "RegQueryValueA" (ByVal hKey As
Long, ByVal lpSubKey As String, ByVal lpValue As String, lpcbValue As Long) As
Long
Declare Function RegEnumKey Lib
"advapi32" Alias "RegEnumKeyA" (ByVal hKey As Long, ByVal
iSubKey As Long, ByVal lpszName As String, ByVal cchName As Long) As Long
Declare Function RegOpenKey Lib
"advapi32" Alias "RegOpenKeyA" (ByVal hKey As Long, ByVal
lpszSubKey As String, phkResult As Long) As Long
Declare Function RegCloseKey Lib
"advapi32" (ByVal hKey As Long) As Long
Declare Function RegCreateKey Lib
"advapi32.dll" Alias "RegCreateKeyA" (ByVal hKey As Long,
ByVal lpSubKey As String, phkResult As Long) As Long
Declare Function RegSetValue Lib
"advapi32.dll" Alias "RegSetValueA" (ByVal hKey As Long,
ByVal lpSubKey As String, ByVal dwType As Long, ByVal lpData As String, ByVal
cbData As Long) As Long
Declare Function RegDeleteKey Lib
"advapi32.dll" Alias "RegDeleteKeyA" (ByVal hKey As Long,
ByVal lpSubKey As String) As Long
'Declaraciones para el API de 16
bits
Declare Function RegQueryValue
Lib "shell.dll" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal
lpValue As String, lpcbValue As Long) As Long
Declare Function RegEnumKey Lib
"shell.dll" (ByVal hKey As Long, ByVal iSubKey As Long, ByVal lpszName
As String, ByVal cchName As Long) As Long
Declare Function RegOpenKey Lib
"shell.dll" (ByVal hKey As Long, ByVal lpszSubKey As String, phkResult
As Long) As Long
Declare Function RegCloseKey Lib
"shell.dll" (ByVal hKey As Long) As Long
Declare Function RegCreateKey Lib
"shell.dll" (ByVal hKey As Long, ByVal lpSubKey As String, phkResult
As Long) As Long
Declare Function RegSetValue Lib
"shell.dll" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal
dwType As Long, ByVal lpData As String, ByVal cbData As Long) As Long
Declare Function RegDeleteKey Lib
"shell.dll" (ByVal hKey As Long, ByVal lpSubKey As String) As Long
Una nota de precaución:
Si vas a trabajar con el registro
del sistema, te recomiendo que antes hagas copia del mismo. En el CD de Windows
95, hay una utilidad: ERU.exe que copia los archivos del Sistema, así como
Autoexec, etc. Si no tienes este programa, copia los archivos System.dat y
User.dat que están el directorio de Windows.
Suerte y que no se te cuelgue!
9.-
Diálogos comunes usando el API de Windows (16 y 32 bits)
Las funciones para manejar los diálogos
comunes del API de Windows, son las siguientes:
Nota: En 16 bits no están todas
las que son, es que no tengo ahora a mano el fichero con las declaraciones para
seleccionar el color y las fuentes. Si las necesitas, no dudes en pedirlas, las
buscaré. en algún sitio tengo que tenerlas. 8-)
'Declaraciones para el API de 16
bits
'Abrir y guardar
Declare Function GetOpenFileName
Lib "commdlg.dll" (lpofn As tagOpenFileName) As Integer
Declare Function GetSaveFileName
Lib "commdlg.dll" (lpofn As tagOpenFileName) As Integer
'Buscar y reemplazar (aún no he
podido ponerlas en marcha???)
Declare Function FindText Lib
"commdlg.dll" (lpFR As tagFindReplace) As Integer
Declare Function ReplaceText Lib
"commdlg.dll" (lpFR As tagFindReplace) As Integer
'Para la impresora
Declare Function PrintDlg Lib
"commdlg.dll" (tagPD As tagPrintDlg) As Integer
'
'Declaraciones para 32 bits
'Abrir y guardar
Declare Function GetOpenFileName
Lib "comdlg32.dll" Alias "GetOpenFileNameA" (pOpenfilename
As OPENFILENAME) As Long
Declare Function GetSaveFileName
Lib "comdlg32.dll" Alias "GetSaveFileNameA" (pOpenfilename
As OPENFILENAME) As Long
Declare Function GetFileTitle Lib
"comdlg32.dll" Alias "GetFileTitleA" (ByVal lpszFile As
String, ByVal lpszTitle As String, ByVal cbBuf As Integer) As Integer
'Buscar y reemplazar
Declare Function FindText Lib
"comdlg32.dll" Alias "FindTextA " (pFindreplace As
FINDREPLACE) As Long
Declare Function ReplaceText Lib
"comdlg32.dll" Alias "ReplaceTextA" (pFindreplace As
FINDREPLACE) As Long
'Para la impresora
Declare Function PrintDlg Lib
"comdlg32.dll" Alias "PrintDlgA" (pPrintdlg As PRINTDLG) As
Long
Declare Function PageSetupDlg Lib
"comdlg32.dll" Alias "PageSetupDlgA" (pPagesetupdlg As
PAGESETUPDLG) As Long
'Para los colores
Declare Function ChooseColor Lib
"comdlg32.dll" Alias "ChooseColorA" (pChoosecolor As
CHOOSECOLOR) As Long
'Las fuentes
Declare Function ChooseFont Lib
"comdlg32.dll" Alias "ChooseFontA" (pChoosefont As
CHOOSEFONT) As Long
No incluyo ejemplos ni las
declaraciones de los tipos, por ser demasiado "grandes". Pero las
incluyo en un listado con ejemplos para abrir, etc., aunque con las funciones
para 16 bits, ya que desde que uso el VB para 32 bits, suelo hacerlo con el
control que trae. Si quieres ver ejemplos usando el control de diálogos
comunes, pasate por la página de trucos.
10.-
Mostrar un icono en la barra de tareas
Gracias a Joe LeVasseur por
enviar este ejemplo de cómo crear un icono en la barra de tareas.
Aquí pongo parte del código,
para los que sólo quieren echar un vistazo:
'---------------
Private Type TIPONOTIFICARICONO
cbSize As Long
hwnd As Long
uId As Long
uFlags As Long
ucallbackMessage As Long
hIcon As Long
szTip As
String * 64
End Type
'------------------
Private Const NIM_ADD = &H0
Private Const NIM_MODIFY =
&H1
Private Const NIM_DELETE =
&H2
Private Const WM_MOUSEMOVE =
&H200
Private Const NIF_MESSAGE =
&H1
Private Const NIF_ICON = &H2
Private Const NIF_TIP = &H4
Private Const WM_LBUTTONDBLCLK =
&H203
Private Const WM_LBUTTONDOWN =
&H201
Private Const WM_LBUTTONUP =
&H202
Private Const WM_RBUTTONDBLCLK =
&H206
Private Const WM_RBUTTONDOWN =
&H204
Private Const WM_RBUTTONUP =
&H205
'--------------------
Private Declare Function
Shell_NotifyIcon Lib "shell32" _
Alias
"Shell_NotifyIconA" (ByVal dwMessage As Long, _
pnid As
TIPONOTIFICARICONO) As Boolean
'--------------------
Private Declare Function
WinExec& Lib "kernel32" _
(ByVal
lpCmdLine As String, ByVal nCmdShow As Long)
'--------------------
Dim t As TIPONOTIFICARICONO
Private Sub Form_Load()
If
App.PrevInstance Then
mnuAcerca_Click
Unload Me
End
End If
'---------------------------------
t.cbSize =
Len(t)
t.hwnd =
picGancho.hwnd
t.uId = 1&
t.uFlags =
NIF_ICON Or NIF_TIP Or NIF_MESSAGE
t.ucallbackMessage = WM_MOUSEMOVE
t.hIcon =
Me.Icon
'---------------------------------
t.szTip =
"Ejemplo de barra de tareas..." & Chr$(0) ' Es un string de
"C" ( \0 )
Shell_NotifyIcon NIM_ADD, t
Me.Hide
App.TaskVisible = False
End Sub
11.-
Cómo usar el marcador telefónico de Windows 95
Gracias de nuevo a Joe LeVasseur
por enviar este ejemplo.
Aquí lo que se muestra es sólo
la forma de usarlo.
Private Declare Function
tapiRequestMakeCall& Lib "TAPI32.DLL" (ByVal DestAddress&,
ByVal AppName$, ByVal CalledParty$, ByVal Comment$)
Private Sub Command1_Click()
Dim
ValDev&, Numero$, NombreProg$, Quien$
Numero =
"123-4567"
NombreProg =
"Mi Programa"
Quien =
"Pepe"
ValDev =
tapiRequestMakeCall(Numero, NombreProg,Quien,"")
End Sub
12.-
Leer la etiqueta y el número de serie de un disco. (Sólo 32 bits)
La función que se usa para esto,
es GetVolumeInformation, que está en el punto 4, pero lo que ahora pongo, es un
ejemplo de cómo usarla.
El ejemplo es un form con una
caja de texto en la que se introduce la unidad (directorio raíz, realmente), de
la que queremos mostrar la información.
Como no es un listado muy grande,
lo pongo al completo.
'---------------------------------------------------------------------------
'Form de prueba para leer la
etiqueta y el número de serie de un disco.
'---------------------------------------------------------------------------
Option Explicit
'Declaración de la función, sólo
está en el API de 32 bits
'
Private Declare Function
GetVolumeInformation Lib "Kernel32" _
Alias
"GetVolumeInformationA" (ByVal lpRootPathName As String, _
ByVal lpVolumeNameBuffer As String, _
ByVal nVolumeNameSize As Long, _
lpVolumeSerialNumber As Long, _
lpMaximumComponentLength As Long, _
lpFileSystemFlags As Long, _
ByVal lpFileSystemNameBuffer As String, _
ByVal nFileSystemNameSize As Long) As Long
Private Sub Command1_Click()
'Acción
Dim lVSN As
Long, n As Long, s1 As String, s2 As String
Dim unidad As
String
Dim sTmp As
String
On Local Error
Resume Next
'Se debe
especificar el directorio raiz
unidad =
Trim$(Text1)
'Reservar
espacio para las cadenas que se pasarán al API
s1 =
String$(255, Chr$(0))
s2 =
String$(255, Chr$(0))
n =
GetVolumeInformation(unidad, s1, Len(s1), lVSN, 0, 0, s2, Len(s2))
's1 será la
etiqueta del volumen
'lVSN tendrá
el valor del Volume Serial Number (número de serie del volumen)
's2 el tipo de
archivos: FAT, etc.
'Convertirlo a
hexadecimal para mostrarlo como en el Dir.
sTmp =
Hex$(lVSN)
Label3(0) = s1
Label3(1) =
Left$(sTmp, 4) & "-" & Right$(sTmp, 4)
Label3(2) = s2
End Sub
Private Sub Command2_Click()
Unload Me
End
End Sub
Private Sub Form_Unload(Cancel As
Integer)
'Asegurarnos
de "liberar" la memoria.
Set Form1 =
Nothing
End Sub
Ahora un "retrato" del
Form:
Otras cosas más que se pueden
hacer con SendMessage.
La declaración de esta función
del API, para 16 y 32 bits, está en el punto 1
Const WM_USER = 1024
Const EM_GETLINECOUNT = WM_USER +
10
Const EM_LINEFROMCHAR = WM_USER +
25
TotalLineas =
SendMessage(Text1.hWnd, EM_GETLINECOUNT, 0, 0&)
LineaActual =
SendMessage(Text1.hWnd, EM_LINEFROMCHAR, -1, 0&) + 1
13.-
Uso de PostMessage en lugar de SendMessage
En la lista de distribución
VB-ES, leí una respuesta sobre que es preferible, en 32 bits, usar PostMessage
en lugar de SendMessage.
Quiero aclarar que el valor
devuelto por la función PostMessage, es si ha podido poner el mensaje en la
cola o no.
Por tanto, si usas SendMessage
para recibir un valor, el ejemplo anterior es un caso, no se te ocurra cambiarla
por PostMessage.
En los demás casos, en los que
simplemente queremos enviar un mensaje a la cola de Windows y no necesitamos
esperar a que la operación termine, si podemos usar PostMessage, ya que esta
función trabaja de forma "asíncrona" y devolverá el control a VB
antes que SendMessage, que trabaja de forma "síncrona" y hasta que no
acabe "su tarea" no vuelve a casa.
La declaración de PostMessage
para el API de 16 y 32 bits:
'Declaración del API de 32 bits
Declare Function PostMessage Lib
"User32" Alias "PostMessageA" _
(ByVal hwnd As Long, ByVal wMsg As Long, _
ByVal wParam As Long, ByVal lParam As Long) As Long
'Declaración del API de 16 bits
Declare Function PostMessage Lib
"User" _
(ByVal hWnd As Integer, ByVal wMsg As Integer, _
ByVal wParam As Integer, lParam As Any) As Integer