VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "Registry"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = True

    '==========================================
    '
    'Visual Basic 6 Registry class
    '
    'Written By Jon Lennart Berg, Zap Software
    '
    'For more great stuff, visit:
    '
    'http://www.angelfire.com/geek/ZapSoft/
    '
    '==========================================
    


    Option Explicit

    '==========================================
    'Win32 API Constants
    '==========================================
    Private Const REG_SZ = 1
    Private Const REG_BINARY = 3
    Private Const REG_DWORD = 4
    Private Const ERROR_SUCCESS = 0&

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

    '==========================================
    'Win32 API routines
    '==========================================
    Private Declare Function SetParent Lib "user32" (ByVal hWndChild As Long, ByVal hWndNewParent As Long) As Long
    Private Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long
    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 RegDeleteKey Lib "advapi32.dll" Alias "RegDeleteKeyA" (ByVal hKey As Long, ByVal lpSubKey As String) As Long
    Private Declare Function RegDeleteValue Lib "advapi32.dll" Alias "RegDeleteValueA" (ByVal hKey As Long, ByVal lpValueName As String) 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 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
    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, lpData As Any, ByVal cbData As Long) As Long
    Private Declare Function RegEnumKey Lib "advapi32.dll" Alias "RegEnumKeyA" (ByVal hKey As Long, ByVal dwIndex As Long, ByVal lpName As String, ByVal cbName 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 Byte, lpcbData As Long) As Long

    Public Function CreateRegKey(ByVal hKey As StdRegHeaders, StrPath As String) As Boolean
        On Local Error Resume Next
        Dim Keyhandle As Long

        If RegCreateKey(hKey, StrPath, Keyhandle) = 0 Then
            Call RegCloseKey(Keyhandle)
            Let CreateRegKey = True
        Else
            Let CreateRegKey = False
        End If
    End Function

    'EXAMPLE:
    '
    'text1.text = getstring(HKEY_CURRENT_USE
    '     R, "Software\VBW\Registry", "String")
    '
    Public Function ReadRegString(ByVal hKey As StdRegHeaders, StrPath As String, strValue As String) As String
        On Local Error Resume Next
        Dim keyhand As Long
        Dim datatype As Long
        Dim lResult As Long
        Dim strBuf As String
        Dim lDataBufSize As Long
        Dim intZeroPos As Integer
        Dim lValueType As Long

        If RegOpenKey(hKey, StrPath, keyhand) = 0 Then
            Let lResult = RegQueryValueEx(keyhand, strValue, 0&, lValueType, ByVal 0&, lDataBufSize)
            If lValueType = REG_SZ Then
                Let strBuf = String$(lDataBufSize, Chr$(32))
                Let lResult = RegQueryValueEx(keyhand, strValue, 0&, 0&, ByVal strBuf, lDataBufSize)
            
                If lResult = ERROR_SUCCESS Then
                    Let intZeroPos = InStr(strBuf, Chr$(0))
                    If intZeroPos > 0 Then
                        Let ReadRegString = Left$(strBuf, intZeroPos - 1)
                    Else
                        Let ReadRegString = strBuf
                    End If
                End If
            End If
            Call RegCloseKey(keyhand)
        End If
    End Function


    'EXAMPLE:
    '
    'Call savestring(HKEY_CURRENT_USER, "Sof
    '     tware\VBW\Registry", "String", text1.tex
    '     t)
    '
    Public Sub SaveRegString(hKey As StdRegHeaders, StrPath As String, strValue As String, strdata As String)
        On Local Error Resume Next
        Dim keyhand As Long
        Dim R As Long

        Call RegCreateKey(hKey, StrPath, keyhand)
        If keyhand <> 0 Then
            Call RegSetValueEx(keyhand, strValue, 0, REG_SZ, ByVal strdata, Len(strdata))
            Call RegCloseKey(keyhand)
        End If
    End Sub

    'EXAMPLE:
    '
    'text1.text = getdword(HKEY_CURRENT_USER
    '     , "Software\VBW\Registry", "Dword")
    '
    Public Function ReadRegWord(ByVal hKey As StdRegHeaders, ByVal StrPath As String, ByVal strValueName As String) As Long
        On Local Error Resume Next
        Dim lResult As Long
        Dim lValueType As Long
        Dim lBuf As Long
        Dim lDataBufSize As Long
        Dim R As Long
        Dim keyhand As Long

        If RegOpenKey(hKey, StrPath, keyhand) = 0 Then
            Let lDataBufSize = 4
            Let lResult = RegQueryValueEx(keyhand, strValueName, 0&, lValueType, lBuf, lDataBufSize)

            If lResult = ERROR_SUCCESS Then
                If lValueType = REG_DWORD Then Let ReadRegWord = lBuf
            End If
            Call RegCloseKey(keyhand)
        End If
    End Function

    'EXAMPLE"
    '
    'Call SaveDword(HKEY_CURRENT_USER, "Soft
    '     ware\VBW\Registry", "Dword", text1.text)
    '
    '
    Public Sub SaveRegWord(ByVal hKey As StdRegHeaders, ByVal StrPath As String, ByVal strValueName As String, ByVal lData As Long)
        On Local Error Resume Next
        Dim lResult As Long
        Dim keyhand As Long

        If RegCreateKey(hKey, StrPath, keyhand) = 0 Then
            lResult = RegSetValueEx(keyhand, strValueName, 0&, REG_DWORD, lData, 4)
            Call RegCloseKey(keyhand)
        End If
    End Sub

    'EXAMPLE:
    '
    'Call DeleteKey(HKEY_CURRENT_USER, "Soft
    '     ware\VBW")
    '
    Public Sub DeleteRegKey(ByVal hKey As StdRegHeaders, ByVal strKey As String)
        On Local Error Resume Next
        Call RegDeleteKey(hKey, strKey)
    End Sub

    'EXAMPLE:
    '
    'Call DeleteValue(HKEY_CURRENT_USER, "So
    '     ftware\VBW\Registry", "Dword")
    '

    Public Sub DeleteRegValue(ByVal hKey As StdRegHeaders, ByVal StrPath As String, ByVal strValue As String)
        On Local Error Resume Next
        Dim keyhand As Long
        If RegOpenKey(hKey, StrPath, keyhand) = 0 Then
            Call RegDeleteValue(keyhand, strValue)
            Call RegCloseKey(keyhand)
        End If
    End Sub

    Public Function SubKeyCount(ByVal hKey As StdRegHeaders, ByVal StrPath As String)
        On Local Error Resume Next
        Dim lRegResult As Long
        Dim lCounter As Long
        Dim hCurKey As Long
        Dim strBuffer As String
        Dim lDataBufferSize As Long
        Dim intZeroPos As Integer
        
        Let lCounter = 0
        If RegOpenKey(hKey, StrPath, hCurKey) = 0 Then
            Do
                Let lDataBufferSize = 255
                Let strBuffer = String$(lDataBufferSize, Chr$(32))
                
                Let lRegResult = RegEnumKey(hCurKey, lCounter, strBuffer, lDataBufferSize)
                If lRegResult = ERROR_SUCCESS Then
                    lCounter = lCounter + 1
                Else
                    Exit Do
                End If
                Let strBuffer = ""
                DoEvents
            Loop
    
            Call RegCloseKey(hCurKey)
            Let strBuffer = ""
            Let SubKeyCount = lCounter
        End If
    End Function

    Public Function SubKeyName(ByVal hKey As StdRegHeaders, ByVal StrPath As String, ByVal Index As Long) As String
        On Local Error Resume Next
        Dim lRegResult As Long
        Dim lCounter As Long
        Dim hCurKey As Long
        Dim strBuffer As String
        Dim lDataBufferSize As Long
        Dim intZeroPos As Integer
        Dim work As String

        Let lCounter = 1
        If Index < 1 Then Exit Function
        If RegOpenKey(hKey, StrPath, hCurKey) = 0 Then
            Do
                Let lDataBufferSize = 255
                Let strBuffer = String$(lDataBufferSize, Chr$(32))
                Let lRegResult = RegEnumKey(hCurKey, (lCounter - 1), strBuffer, lDataBufferSize)
                
                If lRegResult = ERROR_SUCCESS Then
                    Let intZeroPos = InStr(1, strBuffer, Chr$(0))
                    If intZeroPos > 0 Then
                        Let work = Left$(strBuffer, intZeroPos - 1)
                    Else
                        Let work = strBuffer
                    End If
    
                    If lCounter = Index Then
                        Let SubKeyName = work
                        Exit Do
                    Else
                        lCounter = lCounter + 1
                    End If
                Else
                    Exit Do
                End If
                DoEvents
            Loop
            Call RegCloseKey(hCurKey)
        End If
    End Function

    Public Function SubValueCount(ByVal hKey As StdRegHeaders, ByVal StrPath As String) As Long
        On Local Error Resume Next
        Dim lRegResult As Long
        Dim hCurKey As Long
        Dim lValueNameSize As Long
        Dim strValueName As String
        Dim lCounter As Long
        Dim byDataBuffer(4000) As Byte
        Dim lDataBufferSize As Long
        Dim lValueType As Long
        Dim intZeroPos As Integer
        Dim work As String
        
        If RegOpenKey(hKey, StrPath, hCurKey) = 0 Then
            Let lCounter = 0
            Do
                Let lValueNameSize = 255
                Let lDataBufferSize = 4000
                Let strValueName = String$(lValueNameSize, Chr$(32))
                
                lRegResult = RegEnumValue(hCurKey, lCounter, strValueName, lValueNameSize, 0&, lValueType, byDataBuffer(0), lDataBufferSize)
                
                If lRegResult = ERROR_SUCCESS Then
                    lCounter = lCounter + 1
                Else
                    Exit Do
                End If
                DoEvents
            Loop
            
            Call RegCloseKey(hCurKey)
            Let SubValueCount = lCounter
        End If
    End Function

    Public Function SubValueName(ByVal hKey As StdRegHeaders, ByVal StrPath As String, ByVal Index As Long) As String
        On Local Error Resume Next
        Dim lRegResult As Long
        Dim hCurKey As Long
        Dim lValueNameSize As Long
        Dim strValueName As String
        Dim lCounter As Long
        Dim byDataBuffer(4000) As Byte
        Dim lDataBufferSize As Long
        Dim lValueType As Long
        Dim intZeroPos As Integer
        Dim work As String
        
        If Index < 1 Then Exit Function
        If RegOpenKey(hKey, StrPath, hCurKey) = 0 Then
            Let lCounter = 1
            Do
                Let lValueNameSize = 255
                Let lDataBufferSize = 4000
                Let strValueName = String$(lValueNameSize, Chr$(32))
                Let lRegResult = RegEnumValue(hCurKey, (lCounter - 1), strValueName, lValueNameSize, 0&, lValueType, byDataBuffer(0), lDataBufferSize)
                
                If lRegResult = ERROR_SUCCESS Then
                    Let intZeroPos = InStr(1, strValueName, Chr$(0))
                    If intZeroPos > 0 Then
                        Let work = Left$(strValueName, intZeroPos - 1)
                    Else
                        Let work = strValueName
                    End If
                
                    If Index = lCounter Then
                        Let SubValueName = work
                        Exit Do
                    Else
                        Let lCounter = lCounter + 1
                    End If
                Else
                    Exit Do
                End If
                DoEvents
            Loop
    
            Call RegCloseKey(hCurKey)
        End If
    End Function


    Public Function SubValueType(ByVal hKey As StdRegHeaders, ByVal StrPath As String, ByVal Index As Long) As String
        On Local Error Resume Next
        Dim lRegResult As Long
        Dim hCurKey As Long
        Dim lValueNameSize As Long
        Dim strValueName As String
        Dim lCounter As Long
        Dim byDataBuffer(4000) As Byte
        Dim lDataBufferSize As Long
        Dim lValueType As Long
        Dim intZeroPos As Integer
        
        If Index < 1 Then Exit Function
        If RegOpenKey(hKey, StrPath, hCurKey) = 0 Then
            Let lCounter = 1
            Do
                Let lValueNameSize = 255
                Let lDataBufferSize = 4000
                Let strValueName = String$(lValueNameSize, Chr$(32))
                Let lRegResult = RegEnumValue(hCurKey, (lCounter - 1), strValueName, lValueNameSize, 0&, lValueType, byDataBuffer(0), lDataBufferSize)
                
                If lRegResult = ERROR_SUCCESS Then
                    If Index = lCounter Then
                        Select Case lValueType
                        Case REG_SZ: Let SubValueType = "UNI"
                        Case REG_BINARY: Let SubValueType = "BIN"
                        Case REG_DWORD: Let SubValueType = "WRD"
                        End Select
                        Exit Do
                    Else
                        Let lCounter = lCounter + 1
                    End If
                Else
                    Exit Do
                End If
                DoEvents
            Loop
            Call RegCloseKey(hCurKey)
        End If
    End Function