Mensaje enviado por "Gonzalo Vázquez PérezFDpcmV6" <asipvb@hotmail.com>

Hola a todos. Aquí tenéis una aplicacioncilla desarrollada por mi para listar todos los módems del ordenador. Lo único que hay que hacer es abrir un nuevo proyecto y pegar esto en el formulario.

Esta aplicación funciona perfectamente en Windows 95 y en Windows 98. En Windows NT no lo he probado pero seguro que lo hace bien, y si no lo hace únicamente habría que cambiar la clave que se abre.

Un saludo a todos y espero que os sea útil.


'Estructura necesaria para la Api RegEnumKeyEx
Private Type FILETIME
     dwLowDateTime As Long
     dwHighDateTime As Long
End Type


'Declaración de las apis
Private Declare Function RegOpenKey Lib "advapi32.dll" Alias "RegOpenKeyA" (ByVal Hkey As Long, ByVal lpSubKey As String, phkResult As Long) As Long
Private Declare Function RegEnumKeyEx Lib "advapi32.dll" Alias "RegEnumKeyExA" (ByVal Hkey As Long, ByVal dwIndex As Long, ByVal lpName As
String, lpcbName As Long, ByVal lpReserved As Long, ByVal lpClass As String, lpcbClass As Long, lpftLastWriteTime As FILETIME) As Long
Private Declare Function RegCloseKey Lib "advapi32.dll" (ByVal Hkey As Long) As Long
Private Declare Function RegQueryValueEx Lib "advapi32.dll" Alias "RegQueryValueExA" (ByVal Hkey As Long, ByVal lpValueName As String, ByVal
lpReserved As Long, lpType As Long, lpData As Any, lpcbData As Long) As Long

'Constantes obligatorias
Private Const REG_SZ = 1 'Cadena terminada en Null
Private Const ERROR_SUCCESS = 0 'Operación exitosa

'Solo se necesita declarar la que vamos a usar. En nuestro caso HKEY_LOCAL_MACHINE
Private Const HKEY_CURRENT_USER = &H80000001
Private Const HKEY_LOCAL_MACHINE = &H80000002




Public Function getstring(Hkey As Long, strPath As String, strValue As String)
Dim keyhand As Long
Dim datatype As Long
Dim lResult As Long
Dim strBuf As String
Dim lDataBufSize As Long

'Abre la clave
lResult = RegOpenKey(Hkey, strPath, keyhand)
'Consulta el tamaño del buffer
lResult = RegQueryValueEx(keyhand, strValue, 0&, lValueType, ByVal 0&,
lDataBufSize)
If lValueType = REG_SZ Then
    strBuf = String(lDataBufSize, " ")
    'Consulta el valor
    lResult = RegQueryValueEx(keyhand, strValue, 0&, 0&, ByVal strBuf, lDataBufSize)
    If lResult = ERROR_SUCCESS Then
        getstring = Left$(strBuf, Len(strBuf) - 1)
    End If
End If
'Cierra la clave
lResult = RegCloseKey(Hkey)
End Function




Private Sub Form_Load()

Dim FT As FILETIME

Dim KeyHandle As Long
Dim curIndex As Long
Dim keyLen As Long
Dim ClassLen As Long
Dim Reserved As Long

Dim lResult As Long

Dim KeyName As String
Dim ClassName As String

Dim strString As String
Dim strMsg As String
Dim strPath As String


'Clave que se va a abrir
strPath = "System\CurrentControlSet\Services\Class\Modem"


'Abre la clave
lResult = RegOpenKey(HKEY_LOCAL_MACHINE, strPath, KeyHandle)
If lResult <> ERROR_SUCCESS Then
   MsgBox "No se puede abrir esa clave"
   Exit Sub
End If

strMsg = "Los módems del sistema son: " + vbCrLf + vbCrLf
strPath = strPath & "\"
'Lista las subclaves
Do
    keyLen& = 2000
    ClassLen = 2000
    KeyName = String(keyLen, 0)
    ClassName = String$(ClassLen, 0)
    ' Enumera las subclaves
    lResult = RegEnumKeyEx(KeyHandle, curIndex, KeyName$, keyLen, Reserved, ClassName, ClassLen, FT)
    curIndex = curIndex + 1
    If lResult = ERROR_SUCCESS Then
        ' Obtiene el modelo de la subclave
        strString = getstring(HKEY_LOCAL_MACHINE, strPath & Left$(KeyName, keyLen), "Model")
        strMsg = strMsg & strString + vbCrLf + vbCrLf
    End If
Loop While lResult = ERROR_SUCCESS 'mientras haya subclaves

' Cierra la clave
Call RegCloseKey(KeyHandle)


'Resultado final.
MsgBox strMsg, vbInformation, "MODEMS"

End Sub