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