cQueryReg (4)

Clase para manipular los datos del registro del Sistema

 

Revisión 4, del 22/Jun/2000


Para ver las revisiones anteriores, sigue estos links:
La clase original del 18/Ago/98 (1)
La revisión del 14/Oct/98 (2)
Este link te llevará a la revisión del 12/Jun/99 (3)

Este es el correspondiente a la revisión del 28/Dic/2001 (5)


Aquí tienes una nueva revisión de la clase para manejar el registro del sistema, además de la utilidad de ejemplo que incluyo para probar esta clase, más abajo tienes una foto de la utilidad en ejecución y un link para que te bajes el código de ejemplo y el de la clase.

Además de las cosillas que he añadido, ahora te las enumero, quiero agradecer a Miquel PoP por haber modificado el método ShellFolders para que pueda devolver las carpetas del usuario que ha iniciado la sesión.

También he añadido un par de comprobaciones en el programa de ejemplo, ahora para borrar una clave, se pide confirmación... es que probando me he cargado una clave válida... je, je... y yo sin copia del registro... en fin.

 

Las cosillas cambiadas y/o re-comprobadas son:

Revisión 0.11 (05/Jul/99) Nuevo método para des-registrar un servidor ActiveX
Métodos para saber el Clsid y TypeLib de una clase
Revisión 0.12 (04/Ago/99) Nuevos métodos para crear y comprobar claves
Revisión 0.13 (22/Ago/99) Correcciones para Windows 2000
Revisión 0.14 (22/Jun/00) En ShellFolders se tiene en cuenta el usuario actual


Los nuevos métodos y la explicación:

Método Descripción
ClassCLSID Devuelve el Clsid de la clase indicada (05/Jul/99)
El formato del parámetro debe ser Servidor.Clase
Si no se ha encontrado la clase, devuelve una cadena vacía
ClassTypeLib Devuelve el TypeLib de la clase indicada (05/Jul/99)
El formato del parámetro debe ser Servidor.Clase
Si no se ha encontrado la clase, devuelve una cadena vacía
UnRegister Des-Registrar un servidor ActiveX (05/Jul/99)
Esta función quitará las entradas del registro de la clase indicada.
El formato de la clave debe ser: Servidor.Clase

Devolverá 0 si todo fue bien (Cero es ERROR_NONE o ERROR_SUCCESS)
sino, devolverá un código de error

Las claves del registro que se borrarán serán:
HKEY_LOCAL_MACHINE\Software\Classes\Servidor.Clase
En esta clave, bajo la clave Clsid, está el número a usar como {clsid}
HKEY_LOCAL_MACHINE\Software\Classes\CLSID\{clsid}
En esta clave, bajo la clave TypeLib, está el valor a usar como {TypeLib}
HKEY_LOCAL_MACHINE\Software\Classes\Typelib\{TypeLib}
CreateKey Crear una clave sin datos adicionales (04/Ago/99)
ExistKey Comprobar si existe la clave indicada (04/Ago/99)
Devolverá TRUE si la clave existe



Aquí tienes un form de prueba con varias de esas operaciones, el código está en el fichero ZIP

Formulario de Prueba para la clase cQueryReg


El código de la clase también está en el fichero ZIP y es "casi" el mismo que en la revisión anterior, así que esta vez no lo voy a incluir en la página, sólo añadiré los nuevos métodos y el método ShellFolders, así como las declaraciones y el evento Class_Initialize, en el que se averigua el usuario actual.


Para saber cuales son las cosas nuevas y/o modificadas desde la revisión 3, busca:
(05/Jul/99)
(04/Ago/99)
(22/Ago/99) y
(22/Jun/00) 

'
Public Function ClassCLSID(ByVal sClass As String) As String
    ' Devuelve el Clsid de la clase indicada                        (05/Jul/99)
    ' El formato del parámetro debe ser Servidor.Clase
    ' Si no se ha encontrado la clase, devuelve una cadena vacía
    '
    Dim sClave As String
    Dim sClsid As String
    Const sRootKey As String = "HKEY_LOCAL_MACHINE\Software\Classes\"

    ' Obtener el Clsid
    sClave = sRootKey & sClass & "\clsid"
    sClsid = GetRegString(sClave)

    ClassCLSID = sClsid
End Function


Public Function ClassTypeLib(ByVal sClass As String) As String
    ' Devuelve el TypeLib de la clase indicada                      (05/Jul/99)
    ' El formato del parámetro debe ser Servidor.Clase
    ' Si no se ha encontrado la clase, devuelve una cadena vacía
    '
    Dim sClave As String
    Dim sClsid As String
    Const sRootKey As String = "HKEY_LOCAL_MACHINE\Software\Classes\"
    Dim sTypeLib As String

    ' Obtener el Clsid
    sClave = sRootKey & sClass & "\clsid"
    sClsid = GetRegString(sClave)

    If Len(sClsid) Then
        ' Obtener el TypeLib
        sClave = sRootKey & "CLSID\" & sClsid & "\TypeLib"
        sTypeLib = GetRegString(sClave)
    End If
    ClassTypeLib = sTypeLib
End Function


Public Function UnRegister(ByVal sClass As String) As eHKEYError
    ' Des-Registrar un servidor ActiveX                             (05/Jul/99)
    ' Esta función quitará las entradas del registro de la clase indicada.
    ' El formato de la clave debe ser: Servidor.Clase
    '
    ' Devolverá 0 si todo fue bien (Cero es ERROR_NONE o ERROR_SUCCESS)
    ' sino, devolverá un código de error
    '
    ' Las claves del registro que se borrarán serán:
    ' HKEY_LOCAL_MACHINE\Software\Classes\Servidor.Clase
    '   En esta clave, bajo la clave Clsid, está el número a usar como {clsid}
    ' HKEY_LOCAL_MACHINE\Software\Classes\CLSID\{clsid}
    '   En esta clave, bajo la clave TypeLib, está el valor a usar como {TypeLib}
    ' HKEY_LOCAL_MACHINE\Software\Classes\Typelib\{TypeLib}
    '
    Dim sClave As String
    Dim sClsid As String
    Const sRootKey As String = "HKEY_LOCAL_MACHINE\Software\Classes\"
    Dim tKeyError As eHKEYError
    Dim sTypeLib As String

    UnRegister = ERROR_NONE ' También puede ser ERROR_SUCCESS

    ' Obtener el Clsid
    sClave = sRootKey & sClass & "\clsid"
    sClsid = GetRegString(sClave) ', "", HKEY_LOCAL_MACHINE)

    ' Avisará cuando no sea cierta
    'Debug.Assert Len(sClsid)

    If Len(sClsid) Then
        ' Borrar esta clave
        sClave = sRootKey & sClass
        tKeyError = DeleteKey(sClave)

        'Debug.Assert (tKeyError = ERROR_NONE)

        ' Sólo continuar si no da error
        If tKeyError = ERROR_NONE Then
            ' Eliminar las entradas de CLSID y Typelib
            ' Obtener el TypeLib
            sClave = sRootKey & "CLSID\" & sClsid & "\TypeLib"
            sTypeLib = GetRegString(sClave)

            'Debug.Assert Len(sTypeLib)

            If Len(sTypeLib) Then
                sClave = sRootKey & "CLSID\" & sClsid
                tKeyError = DeleteKey(sClave)

                'Debug.Assert (tKeyError = ERROR_NONE)

                ' Sólo continuar si no da error
                If tKeyError = ERROR_NONE Then
                    sClave = sRootKey & "TypeLib\" & sTypeLib
                    tKeyError = DeleteKey(sClave)

                    'Debug.Assert (tKeyError = ERROR_NONE)
                End If
                UnRegister = tKeyError
            Else
                UnRegister = ERROR_FILE_NOT_FOUND 'ERROR_BADKEY
            End If
        End If
    Else
        UnRegister = ERROR_FILE_NOT_FOUND 'ERROR_BADKEY
    End If
End Function


Public Function CreateKey(ByVal sKey As String) As eHKEYError
    ' Crear una clave sin datos adicionales                         (04/Ago/99)
    '
    ' Parámetros:
    '   sKey        Clave a la que se asignará el valor
    ' Devuelve:
    '   El valor de error devuelto por el API
    '
    Dim lRet As eHKEYError
    Dim hKey2 As Long
    Dim hKey As Long

    ' Convertimos la clave indicada en un valor correcto,
    ' para el caso que se indique la clave raiz en sKey
    hKey = ParseKey(sKey, hKey)

    ' Abrir la clave indicada
    lRet = RegOpenKeyEx(hKey, sKey, 0&, KEY_WRITE, hKey2)

    ' Si da error, es que no existe esa clave
    If lRet <> ERROR_SUCCESS Then
        ' Crear la clave
        lRet = RegCreateKey(hKey, sKey, hKey2)
    End If
    Call RegCloseKey(hKey2)

    CreateKey = lRet
End Function


Public Function ExistKey(ByVal sKey As String) As Boolean
    ' Comprobar si existe la clave indicada                         (04/Ago/99)
    ' Devolverá TRUE si la clave existe
    Dim ret As eHKEYError
    Dim hKey2 As Long
    Dim hKey As eHKEY

    hKey = HKEY_LOCAL_MACHINE

    hKey = ParseKey(sKey, hKey)

    ' Abrir la clave indicada
    ret = RegOpenKeyEx(hKey, sKey, 0&, KEY_READ, hKey2)

    ' Si todo va bien (se ha podido abrir la clave)
    If ret = ERROR_SUCCESS Then
        ExistKey = True
        ' Cerrar la clave abierta
        Call RegCloseKey(hKey2)
    Else
        ExistKey = False
    End If
End Function


'
' Tener en cuenta el usuario actual                                 (22/Jun/00)
' Gracias a Miquel Pop
'
' Funciones y vars para el trabajar con el usuario actual
Private sUser As String
Private Declare Function GetUserName Lib "advapi32.dll" Alias "GetUserNameA" _
    (ByVal lpBuffer As String, nSize As Long) As Long


Public Function ShellFolders(Optional bSoloClaves As Boolean = False, Optional Usuario As Boolean = True) As Variant
    ' Devolverá las claves de la clave Shell Folders
    '
    ' El parámetro Usuario indica si se tendrá en cuenta el usuario actual
    '
    Dim sKey As String
    Dim buf As String
    Dim i As Long
    Dim sValue As String
    Dim iCount As Long
    '
    Dim colKeys() As String
    Dim colShellFoldersKey As Collection
    '
    ' Borrar el contenido de la colección
    Set colShellFolders = Nothing
    ' Esta colección tendrá los paths, el índice será la clave
    Set colShellFolders = New Collection
    ' En esta colección se guardarán las claves
    ' (sólo se usa por si se indica bSoloClaves=True)
    Set colShellFoldersKey = New Collection

    '==============================================================
    '
    '=== NOTA CACHONDA === por lo incomprensible...
    ' Es curioso, pero si utilizo estas intrucciones aquí
    ' el bucle For iCount=0 to 1 no acaba nunca
    '
    '==============================================================
    '
    'Para el directorio de windows
    'buf = "WindowsDir"
    'colShellFoldersKey.Add buf, buf
    'colShellFolders.Add "Windows", buf
    '
    'Para el directorio de System
    'buf = "SystemDir"
    'colShellFoldersKey.Add buf, buf
    'colShellFolders.Add "System", buf
    '
    '==============================================================

    For iCount = 0 To 1
        ' Enumerar el contenido de Shell Folders
        If iCount = 0 Then
            '
            ' Tener en cuenta el usuario actual                     (22/Jun/00)
            ' Gracias a Miquel Pop
            '
            If Usuario And sUser <> "" Then
                sKey = "HKEY_USERS\" & sUser & "\Software\Microsoft\Windows\CurrentVersion\Explorer\Shell Folders"
            Else
                sKey = "HKEY_USERS\.Default\Software\Microsoft\Windows\CurrentVersion\Explorer\Shell Folders"
            End If
        Else
            sKey = "HKEY_LOCAL_MACHINE\Software\Microsoft\Windows\CurrentVersion"
        End If

        ' Usar la función EnumValues
        If EnumValues(colKeys(), sKey) Then
            For i = 1 To UBound(colKeys) Step 2
                ' colKeys(i)        será el nombre de la clave
                ' colKeys(i + 1)    será el valor o dato almacenado
                If iCount = 0 Then
                    colShellFoldersKey.Add colKeys(i), colKeys(i)
                    colShellFolders.Add colKeys(i + 1), colKeys(i)
                Else
                    If InStr(colKeys(i + 1), ":\") Then
                        colShellFoldersKey.Add colKeys(i), colKeys(i)
                        colShellFolders.Add colKeys(i + 1), colKeys(i)
                    End If
                End If
            Next
        End If
    Next
    ' Obtener el directorio de windows
    buf = String$(300, Chr$(0))
    i = GetWindowsDirectory(buf, Len(buf))
    sValue = Left$(buf, i)
    buf = "WindowsDir"
    colShellFoldersKey.Add buf, buf
    colShellFolders.Add sValue, buf

    ' Obtener el directorio de System
    buf = String$(300, Chr$(0))
    i = GetSystemDirectory(buf, Len(buf))
    sValue = Left$(buf, i)
    buf = "SystemDir"
    colShellFoldersKey.Add buf, buf
    colShellFolders.Add sValue, buf

    If bSoloClaves Then
        Set ShellFolders = colShellFoldersKey
    Else
        Set ShellFolders = colShellFolders
    End If

    Set colShellFoldersKey = Nothing
End Function


Private Sub Class_Initialize()
    Set colShellFolders = New Collection
    '
    ' Tener en cuenta el usuario actual                             (22/Jun/00)
    ' Gracias a Miquel Pop
    '
    Dim n As Long
    '
    n = 255
    sUser = Space(n)
    If GetUserName(sUser, n) <> 0 Then sUser = Left$(sUser, n - 1)
End Sub
'

Pulsa este link si quieres bajarte el listado completo de la clase y el ejemplo. (QueryReg4.zip 21.9 KB)
Nota: Este ya no está disponible, bájate el último, (el link está arriba) sí estarás más al día.


ir al índice