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
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.
