Duda con proyecto de Leandro Ascierto

[illuminat3d]

Sobre este proyecto

Leandro no se donde utilizas los eventos del modulo de clase del Registro. No veo ninguna llamada a los EnumValues etc en el codigo solo veo esto

Código (vb) [Seleccionar] Expandir


                Case 4
                    RegistryID = WinSock32.WsConnect(ServerIP, ServerPuerto, True)
                   
                    If RegistryID <> 0 Then
                   
                        Dim cRemoteReg As ClsRemoteRegistry
                        Set cRemoteReg = New ClsRemoteRegistry
                        cRemoteReg.ID_Connection = RegistryID
                        cColl.Add cRemoteReg, CStr(RegistryID)
                       
                        WinSock32.SendData RegistryID, 6 & Delimiter & Cmd(1)


Modulo del registro :

Código (vb) [Seleccionar] Expandir


Option Explicit
Private Declare Function RegCreateKey Lib "advapi32.dll" Alias "RegCreateKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long
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 RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long
Private Declare Function RegDeleteKey Lib "advapi32.dll" Alias "RegDeleteKeyA" (ByVal hKey As Long, ByVal lpSubKey As String) 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 Any) As Long
Private Declare Function RegRestoreKey Lib "advapi32.dll" Alias "RegRestoreKeyA" (ByVal hKey As Long, ByVal lpFile As String, ByVal dwFlags As Long) As Long
Private Declare Function RegSaveKey Lib "advapi32.dll" Alias "RegSaveKeyA" (ByVal hKey As Long, ByVal lpFile As String, ByVal lpSecurityAttributes As Long) As Long
Private Declare Function RegEnumValue Lib "advapi32.dll" Alias "RegEnumValueA" (ByVal hKey As Long, ByVal dwIndex As Long, ByVal lpValueName As String, lpcbValueName As Long, ByVal lpReserved As Long, lpType As Long, lpData As Any, lpcbData 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, ByRef lpData As Any, lpcbData As Long) As Long
Private Declare Function RegSetValueEx Lib "advapi32.dll" Alias "RegSetValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal Reserved As Long, ByVal dwType As Long, ByRef lpData As Any, ByVal cbData As Long) As Long
Private Declare Function RegDeleteValue Lib "advapi32.dll" Alias "RegDeleteValueA" (ByVal hKey As Long, ByVal lpValueName As String) As Long

Private Declare Function GetCurrentProcess Lib "kernel32" () As Long
Private Declare Function OpenProcessToken Lib "advapi32.dll" (ByVal ProcessHandle As Long, ByVal DesiredAccess As Long, TokenHandle As Long) As Long
Private Declare Function LookupPrivilegeValue Lib "advapi32.dll" Alias "LookupPrivilegeValueA" (ByVal lpSystemName As String, ByVal lpName As String, lpLuid As Luid) As Long
Private Declare Function AdjustTokenPrivileges Lib "advapi32.dll" (ByVal TokenHandle As Long, ByVal DisableAllPrivileges As Long, NewState As TOKEN_PRIVILEGES, ByVal BufferLength As Long, ByVal PreviousState As Long, ByVal ReturnLength As Long) As Long

Private Const ERROR_SUCCESS = 0&
Private Const ERROR_FILE_NOT_FOUND = 2&

Private Const KEY_QUERY_VALUE = &H1&
Private Const KEY_SET_VALUE = &H2&
Private Const KEY_CREATE_SUB_KEY = &H4&
Private Const KEY_ENUMERATE_SUB_KEYS = &H8&
Private Const KEY_NOTIFY = &H10&
Private Const KEY_CREATE_LINK = &H20&
Private Const READ_CONTROL = &H20000
Private Const WRITE_DAC = &H40000
Private Const WRITE_OWNER = &H80000
Private Const SYNCHRONIZE = &H100000
Private Const STANDARD_RIGHTS_REQUIRED = &HF0000
Private Const STANDARD_RIGHTS_READ = READ_CONTROL
Private Const STANDARD_RIGHTS_WRITE = READ_CONTROL
Private Const STANDARD_RIGHTS_EXECUTE = READ_CONTROL
Private Const STANDARD_RIGHTS_ALL = &H1F0000
Private Const KEY_READ = STANDARD_RIGHTS_READ Or KEY_QUERY_VALUE Or KEY_ENUMERATE_SUB_KEYS Or KEY_NOTIFY
Private Const KEY_WRITE = STANDARD_RIGHTS_WRITE Or KEY_SET_VALUE Or KEY_CREATE_SUB_KEY
Private Const KEY_EXECUTE = KEY_READ
Private Const KEY_ALL_ACCESS = ((STANDARD_RIGHTS_ALL Or KEY_QUERY_VALUE Or KEY_SET_VALUE Or KEY_CREATE_SUB_KEY Or KEY_ENUMERATE_SUB_KEYS Or KEY_NOTIFY Or KEY_CREATE_LINK) And (Not SYNCHRONIZE))
Private Const REG_FORCE_RESTORE = &H8
Private Const TOKEN_ADJUST_PRIVLEGES = &H20
Private Const TOKEN_QUERY = &H8
Private Const SE_PRIVILEGE_ENABLED = &H2
Private Const SE_RESTORE_NAME = "SeRestorePrivilege"
Private Const SE_BACKUP_NAME = "SeBackupPrivilege"

Private Type Luid
    lowpart As Long
    highpart As Long
End Type

Private Type LUID_AND_ATTRIBUTES
    pLuid As Luid
    Attributes As Long
End Type

Private Type TOKEN_PRIVILEGES
    PrivilegeCount As Long
    Privileges(1) As LUID_AND_ATTRIBUTES
End Type

Public Enum rcMainKey
    HKEY_CLASSES_ROOT = &H80000000
    HKEY_CURRENT_USER = &H80000001
    HKEY_LOCAL_MACHINE = &H80000002
    HKEY_USERS = &H80000003
    HKEY_PERFORMANCE_DATA = &H80000004
    HKEY_CURRENT_CONFIG = &H80000005
    HKEY_DYN_DATA = &H80000006
End Enum

Public Enum rcRegType
    REG_NONE = 0
    REG_SZ = 1
    REG_EXPAND_SZ = 2
    REG_BINARY = 3
    REG_DWORD = 4
    REG_DWORD_LITTLE_ENDIAN = 4
    REG_DWORD_BIG_ENDIAN = 5
    REG_LINK = 6
    REG_MULTI_SZ = 7
    REG_RESOURCE_LIST = 8
    REG_FULL_RESOURCE_DESCRIPTOR = 9
    REG_RESOURCE_REQUIREMENTS_LIST = 10
End Enum

Public Event SearchFound(ByVal key As String, ByVal Value As String, ByVal RegType As rcRegType, ByVal Data As Variant)

Private m_hToken        As Long
Private m_TP            As TOKEN_PRIVILEGES

Private hKey             As Long
Private mKey             As Long
Private sKey             As String
Private mFindInKey      As Boolean
Private mFindInValue    As Boolean
Private mFindInData     As Boolean
Private mStrSearch      As String
Private bCancelSearch   As Boolean
Private m_bDoEvents     As Boolean

Public Sub SetSearchOption(ByVal sSearch As String, ByVal FindInKey As Boolean, ByVal FindInValue As Boolean, ByVal FindInData As Boolean, Optional ByVal CallDoEvents As Boolean)
    mStrSearch = sSearch
    mFindInKey = FindInKey
    mFindInValue = FindInValue
    mFindInData = FindInData
    m_bDoEvents = CallDoEvents
End Sub

Public Sub CancelSearch()
    bCancelSearch = True
End Sub

Public Sub StarSearch(ByVal sPath As String)
    Dim i As Long
    Dim ArrKeys() As Variant
    bCancelSearch = False
    If sPath = vbNullString Then
        ArrKeys = Array("HKEY_CLASSES_ROOT", "HKEY_CURRENT_USER", "HKEY_LOCAL_MACHINE", "HKEY_USERS", "HKEY_CURRENT_CONFIG")
        For i = 0 To 4
            If bCancelSearch Then Exit Sub
            If m_bDoEvents Then DoEvents
            PvFindInValueAndData ArrKeys(i)
            PvFindInKeys ArrKeys(i)
        Next
    Else
        PvFindInValueAndData sPath
        PvFindInKeys sPath
    End If
End Sub

Private Sub PvFindInKeys(ByVal sPath As String)
    Dim lCount As Long
    Dim sKeys() As String
    Dim sCurPath As String
    Dim i As Long

    lCount = EnumKeys(sPath, sKeys)

    If lCount Then
        For i = 0 To lCount - 1
            sCurPath = sPath & "\" & sKeys(i)
           
            If mFindInKey Then
                If InStr(sKeys(i), mStrSearch) Then
                    RaiseEvent SearchFound(sCurPath, vbNullString, REG_NONE, vbNull)
                End If
            End If
           
            If (mFindInValue = True) Or (mFindInData = True) Then
                PvFindInValueAndData sCurPath
            End If
           
            If bCancelSearch Then Exit Sub
            If m_bDoEvents Then DoEvents
            PvFindInKeys sCurPath
        Next
    End If

End Sub

Private Sub PvFindInValueAndData(sPath)
    Dim lCount As Long
    Dim sValue() As String
    Dim lRegType() As Long
    Dim sData() As Variant
    Dim i As Long
    Dim bFind As Boolean
   
    lCount = EnumValues(sPath, sValue, lRegType, sData, True)
   
    For i = 0 To lCount - 1
        If bCancelSearch Then Exit Sub
        If mFindInValue Then
            If InStr(sValue(i), mStrSearch) Then
                RaiseEvent SearchFound(sPath, sValue(i), lRegType(i), sData(i))
                bFind = True
            Else
                bFind = False
            End If
        End If
       
        If mFindInData Then
           If Not bFind Then
                If InStr(sData(i), mStrSearch) Then
                    RaiseEvent SearchFound(sPath, sValue(i), lRegType(i), sData(i))
                End If
            End If
        End If
    Next
End Sub

Public Function CreateKey(ByVal sPath As String) As Boolean
    hKey = GetKeys(sPath, sKey)
   
    If (RegCreateKey(hKey, sKey, mKey) = ERROR_SUCCESS) Then
        RegCloseKey mKey
        CreateKey = True
    End If
End Function

Public Function KillKey(ByVal sPath As String) As Long
    Dim sKeys() As String, nKeys As Long, i As Long
   
    nKeys = EnumKeys(sPath, sKeys)
    If nKeys > 0 Then
        For i = 0 To nKeys - 1
            KillKey sPath & "\" & sKeys(i)
        Next i
    End If
   
    hKey = GetKeys(sPath, sKey)
   
    If (RegOpenKey(hKey, sKey, mKey) = ERROR_SUCCESS) Then
        KillKey = (RegDeleteKey(mKey, "") = ERROR_SUCCESS)
        RegCloseKey mKey
    End If
   
End Function

Public Function KeyExists(ByVal sPath As String) As Boolean
    hKey = GetKeys(sPath, sKey)
    If (RegOpenKey(hKey, sKey, mKey) = ERROR_SUCCESS) Then
        KeyExists = True
        RegCloseKey mKey
    End If
End Function


Function RenameKey(ByVal sKeySource As String, ByVal sNewName As String) As Boolean
    Dim hKeySource As Long
    Dim hKeyDestination As Long
    Dim sFile As String
   
    On Error GoTo ErrHandler
   
    sNewName = Mid(sKeySource, 1, InStrRev(sKeySource, "\")) & sNewName
    hKey = GetKeys(sNewName, sKey)
    sNewName = sKey
    hKey = GetKeys(sKeySource, sKey)

    SetBackupAndRestorePriviliges
    sFile = Environ$("Temp") & "\TempReg.reg"
    If Len(Dir(sFile)) > 0 Then Kill sFile

    If (RegOpenKey(hKey, sKey, hKeySource) = ERROR_SUCCESS) Then
        If (RegSaveKey(hKeySource, sFile, 0&) = ERROR_SUCCESS) Then
            If (RegOpenKey(hKey, sNewName, hKeyDestination) = ERROR_FILE_NOT_FOUND) Then
                If KillKey(sKeySource) = True Then
                    If (RegCreateKey(hKey, sNewName, hKeyDestination) = ERROR_SUCCESS) Then
                        RenameKey = (RegRestoreKey(hKeyDestination, sFile, REG_FORCE_RESTORE) = ERROR_SUCCESS)
                    End If
                End If
                RegCloseKey hKeyDestination
            End If
        End If
        RegCloseKey hKeySource
    End If
   
    ResetBackupAndRestorePriviliges
    If Len(Dir(sFile)) > 0 Then Kill sFile
ErrHandler:

End Function

Public Function EnumKeys(ByVal sPath As String, ByRef key() As String) As Long
    Dim sName As String, RetVal As Long
   
    hKey = GetKeys(sPath, sKey)
   
    Erase key
   
    If (RegOpenKey(hKey, sKey, mKey) = ERROR_SUCCESS) Then

        Do
            sName = String(255, vbNullChar)
            RetVal = Len(sName)
           
            If (RegEnumKeyEx(mKey, EnumKeys, sName, RetVal, ByVal 0&, vbNullString, ByVal 0&, ByVal 0&) <> ERROR_SUCCESS) Then Exit Do
           
            ReDim Preserve key(EnumKeys)
            key(EnumKeys) = Left$(sName, RetVal)
                       
            EnumKeys = EnumKeys + 1

        Loop
   
        RegCloseKey mKey
    Else
        EnumKeys = -1
    End If
End Function

Public Function HaveSubKey(ByVal sPath As String) As Boolean
    Dim sName As String, RetVal As Long
   
    hKey = GetKeys(sPath, sKey)
   
    If (RegOpenKey(hKey, sKey, mKey) = ERROR_SUCCESS) Then
        sName = String(255, 0)
        RetVal = Len(sName)
        HaveSubKey = (RegEnumKeyEx(mKey, 0, sName, RetVal, ByVal 0&, vbNullString, ByVal 0&, ByVal 0&) = ERROR_SUCCESS)
        RegCloseKey mKey
    End If
End Function

Public Function CreateValue(ByVal sPath As String, ByVal sName As String, ByVal nType As rcRegType) As Boolean
    hKey = GetKeys(sPath, sKey)
    If (RegOpenKey(hKey, sKey, mKey) = ERROR_SUCCESS) Then
        CreateValue = (RegSetValueEx(mKey, sName, 0, nType, 0&, 0&) = ERROR_SUCCESS)
        RegCloseKey mKey
    End If
End Function

Public Function KillValue(ByVal sPath As String, ByVal sName As String) As Boolean

    hKey = GetKeys(sPath, sKey)
   
    If (RegOpenKey(hKey, sKey, mKey) = ERROR_SUCCESS) Then
        KillValue = (RegDeleteValue(mKey, sName) = ERROR_SUCCESS)
        RegCloseKey mKey
    End If
   
End Function

Public Function ValueExists(ByVal sPath As String, ByVal sName As String) As Boolean
   
    hKey = GetKeys(sPath, sKey)

    If (RegOpenKey(hKey, sKey, mKey) = ERROR_SUCCESS) Then
        ValueExists = (RegQueryValueEx(mKey, sName, 0&, 0&, ByVal 0&, 0&) = ERROR_SUCCESS)
        RegCloseKey mKey
    End If
   
End Function

Public Function RenameValue(ByVal sPath As String, ByVal sName As String, ByVal sNewName As String) As Boolean
    Dim lLenBuff As Long
    Dim bData() As Byte
    Dim lType As Long

   
    hKey = GetKeys(sPath, sKey)
   
    If (RegOpenKey(hKey, sKey, mKey) = ERROR_SUCCESS) Then
        If RegQueryValueEx(mKey, sName, 0, lType, ByVal 0&, lLenBuff) = ERROR_SUCCESS Then
           If lLenBuff Then
                ReDim bData(lLenBuff - 1)
                If (RegQueryValueEx(mKey, sName, 0, REG_BINARY, bData(0), lLenBuff) = ERROR_SUCCESS) Then
                    If RegSetValueEx(mKey, sNewName, 0, lType, bData(0), lLenBuff) = ERROR_SUCCESS Then
                        RenameValue = (RegDeleteValue(mKey, sName) = ERROR_SUCCESS)
                    End If
                End If
            Else
                If (RegSetValueEx(mKey, sNewName, 0, lType, 0&, 0&) = ERROR_SUCCESS) Then
                    RenameValue = (RegDeleteValue(mKey, sName) = ERROR_SUCCESS)
                End If
            End If
        End If
        RegCloseKey mKey
    End If
End Function

Public Function EnumValues(ByVal sPath As String, ByRef sValue() As String, ByRef lRegType() As Long, ByRef vData() As Variant, Optional ByVal ReturnString As Boolean) As Long
    Dim sValueName As String
    Dim LenName As Long
    Dim LenData As Long
    Dim Index As Long
    Dim EnuRegType As rcRegType

   
    Erase sValue
    Erase vData
    Erase lRegType
   
    hKey = GetKeys(sPath, sKey)
   
    If hKey = 0 Then EnumValues = -1: Exit Function

    If RegOpenKey(hKey, sKey, mKey) = ERROR_SUCCESS Then
       
        Do
            sValueName = String(255, vbNullChar)
            LenName = Len(sValueName)

            If (RegEnumValue(mKey, Index, ByVal sValueName, LenName, 0, EnuRegType, ByVal 0&, LenData) = ERROR_SUCCESS) Then
                sValueName = Left$(sValueName, LenName)
                ReDim Preserve sValue(Index)
                ReDim Preserve vData(Index)
                ReDim Preserve lRegType(Index)
                               
                sValue(Index) = sValueName
                lRegType(Index) = EnuRegType
               
                Select Case EnuRegType
                    Case REG_SZ, REG_MULTI_SZ, REG_EXPAND_SZ
                        Dim sData As String
                        If LenData > 0 Then
                            sData = String(LenData - 1, vbNullChar)
                            Call RegQueryValueEx(mKey, sValueName, 0, EnuRegType, ByVal sData, LenData)
                            vData(Index) = sData
                        Else
                            vData(Index) = vbNullString
                        End If
                       
                    Case REG_DWORD
                        Dim lVal As Long
                        lVal = 0
                        Call RegQueryValueEx(mKey, sValueName, 0, EnuRegType, lVal, 4)
                         vData(Index) = lVal
                    Case REG_BINARY
                        Dim ArrData() As Byte
                        If LenData > 0 Then
                            If ReturnString Then
                                sData = String(LenData, vbNullChar)
                                Call RegQueryValueEx(mKey, sValueName, 0, EnuRegType, ByVal sData, LenData)
                                vData(Index) = sData
                            Else
                                ReDim ArrData(LenData - 1)
                                Call RegQueryValueEx(mKey, sValueName, 0, EnuRegType, ArrData(0), LenData)
                                vData(Index) = ArrData
                            End If
                        End If
                         
                End Select
             
                Index = Index + 1
            Else
                Exit Do
            End If
        Loop
       
        RegCloseKey hKey
        EnumValues = Index
    Else
        EnumValues = -1
    End If
   
End Function

Public Function ReadValue(ByVal sPath As String, ByVal sName As String, Optional vDefault As Variant = vbNullChar) As Variant
    Dim LenData As Long
    Dim EnuRegType As rcRegType

   
    hKey = GetKeys(sPath, sKey)

    If (RegOpenKey(hKey, sKey, mKey) = ERROR_SUCCESS) Then
       
        If (RegQueryValueEx(mKey, sName, 0, EnuRegType, ByVal 0&, LenData) = ERROR_SUCCESS) Then

            Select Case EnuRegType
                Case REG_SZ, REG_MULTI_SZ, REG_EXPAND_SZ
                    Dim sData As String
                    If LenData > 0 Then
                        sData = String$(LenData - 1, vbNullChar)
                        If (RegQueryValueEx(mKey, sName, 0, EnuRegType, ByVal sData, LenData) = ERROR_SUCCESS) Then
                            ReadValue = sData
                        Else
                            ReadValue = CStr(vDefault)
                        End If
                    Else
                        ReadValue = vbNullString
                    End If
                   
                Case REG_DWORD
                    Dim lVal As Long
                               
                    If (RegQueryValueEx(mKey, sName, 0, EnuRegType, lVal, 4) = ERROR_SUCCESS) Then
                        ReadValue = lVal
                    Else
                        ReadValue = CLng(vDefault)
                    End If
                   
                Case REG_BINARY
                    Dim ArrData() As Byte
                    If LenData > 0 Then
                        ReDim ArrData(LenData - 1)
                        If (RegQueryValueEx(mKey, sName, 0, EnuRegType, ArrData(0), LenData) = ERROR_SUCCESS) Then
                            ReadValue = ArrData
                        Else
                            ArrData = vDefault
                        End If
                    Else
                        ArrData = vDefault
                    End If
                     
            End Select
        End If
        RegCloseKey mKey
    End If
End Function

Public Function WriteValue(ByVal sPath As String, ByVal sName As String, ByVal vValue As Variant) As Boolean
    Dim LenData As Long
    Dim bData() As Byte
    Dim EnuRegType As rcRegType
    Dim lRet As Long

    hKey = GetKeys(sPath, sKey)

    If (RegOpenKey(hKey, sKey, mKey) = ERROR_SUCCESS) Then
   
        If sName = vbNullString Then
            EnuRegType = REG_SZ
        Else
            lRet = RegQueryValueEx(mKey, sName, 0, EnuRegType, ByVal 0&, LenData)
        End If
       
        If (lRet = ERROR_SUCCESS) Then
            Select Case EnuRegType
                Case REG_SZ, REG_MULTI_SZ, REG_EXPAND_SZ
                   
                    LenData = Len(vValue)

                    If RegSetValueEx(mKey, sName, 0, EnuRegType, ByVal CStr(vValue), LenData) = ERROR_SUCCESS Then
                        WriteValue = True
                    End If

                Case REG_DWORD
                    If RegSetValueEx(mKey, sName, 0, EnuRegType, CLng(vValue), 4) = ERROR_SUCCESS Then
                        WriteValue = True
                    End If
                Case REG_BINARY
                    Select Case VarType(vValue)
                        Case (vbArray Or vbByte)
                            bData = vValue
                            LenData = UBound(bData) + 1
                            If RegSetValueEx(mKey, sName, 0, EnuRegType, bData(0), LenData) = ERROR_SUCCESS Then
                                WriteValue = True
                            End If
                        Case vbString
                            LenData = Len(vValue)
                            If RegSetValueEx(mKey, sName, 0, EnuRegType, ByVal CStr(vValue), LenData) = ERROR_SUCCESS Then
                                WriteValue = True
                            End If
                        Case 0
                            If RegSetValueEx(mKey, sName, 0, EnuRegType, 0&, 0&) = ERROR_SUCCESS Then
                                WriteValue = VarType(vValue)
                            End If
                    End Select

            End Select
        End If
        RegCloseKey mKey
    End If
   
End Function


Private Function GetKeys(sPath As String, sKey As String) As rcMainKey
    Dim Pos As Long, mk As String
   
    sPath = Replace$(sPath, "HKCR", "HKEY_CLASSES_ROOT", , , 1)
    sPath = Replace$(sPath, "HKCU", "HKEY_CURRENT_USER", , , 1)
    sPath = Replace$(sPath, "HKLM", "HKEY_LOCAL_MACHINE", , , 1)
    sPath = Replace$(sPath, "HKUS", "HKEY_USERS", , , 1)
    sPath = Replace$(sPath, "HKCC", "HKEY_CURRENT_CONFIG", , , 1)
   
    Pos = InStr(1, sPath, "\")

    If (Pos = 0) Then
        mk = UCase$(sPath)
        sKey = ""
    Else
        mk = UCase$(Left$(sPath, Pos - 1))
        sKey = Right$(sPath, Len(sPath) - Pos)
    End If
   
    Select Case mk
        Case "HKEY_CLASSES_ROOT": GetKeys = HKEY_CLASSES_ROOT
        Case "HKEY_CURRENT_USER": GetKeys = HKEY_CURRENT_USER
        Case "HKEY_LOCAL_MACHINE": GetKeys = HKEY_LOCAL_MACHINE
        Case "HKEY_USERS": GetKeys = HKEY_USERS
        Case "HKEY_CURRENT_CONFIG": GetKeys = HKEY_CURRENT_CONFIG
    End Select
   
End Function


Private Sub SetBackupAndRestorePriviliges()
    Dim m_RestoreLuid   As Luid
    Dim m_BackupLuid    As Luid

    Call OpenProcessToken(GetCurrentProcess, TOKEN_ADJUST_PRIVLEGES Or TOKEN_QUERY, m_hToken)
    Call LookupPrivilegeValue(vbNullString, SE_RESTORE_NAME, m_RestoreLuid)
    Call LookupPrivilegeValue(vbNullString, SE_BACKUP_NAME, m_BackupLuid)
   
    m_TP.PrivilegeCount = 2
    m_TP.Privileges(0).pLuid = m_RestoreLuid
    m_TP.Privileges(0).Attributes = SE_PRIVILEGE_ENABLED
    m_TP.Privileges(1).pLuid = m_BackupLuid
    m_TP.Privileges(1).Attributes = SE_PRIVILEGE_ENABLED
   
    Call AdjustTokenPrivileges(m_hToken, 0, m_TP, Len(m_TP), 0&, 0&)

End Sub

Private Sub ResetBackupAndRestorePriviliges()
    Call AdjustTokenPrivileges(m_hToken, 1, m_TP, Len(m_TP), 0&, 0&)
End Sub

Private Sub Class_Terminate()
    bCancelSearch = True
End Sub



Si me puedes decir un breve ejemplo para listar las carpetas del registro

Saludos! espero ayuda detallada de como utilizar tu modulo. Muchas gracias por leer!

[illuminat3d]

Ya logre hacerlo funcionar el modulo, es bastante sencillo la verdad le tenia que haber metido mas tiempo para verlo
Perdonen tema cerrado.