1.66

[WinMPQ.git] / Registry.bas

Attribute VB_Name = "RegistryFunctions"\r
Option Explicit\r
\r
Private Const HKEY_CLASSES_ROOT = &H80000000\r
Private Const HKEY_CURRENT_USER = &H80000001\r
Private Const HKEY_LOCAL_MACHINE = &H80000002\r
Private Const HKEY_USERS = &H80000003\r
Private Const HKEY_PERFORMANCE_DATA = &H80000004\r
Private Const HKEY_CURRENT_CONFIG = &H80000005\r
Private Const HKEY_DYN_DATA = &H80000006\r
Private Const STANDARD_RIGHTS_ALL = &H1F0000\r
Private Const KEY_QUERY_VALUE = &H1\r
Private Const KEY_SET_VALUE = &H2\r
Private Const KEY_CREATE_SUB_KEY = &H4\r
Private Const KEY_ENUMERATE_SUB_KEYS = &H8\r
Private Const KEY_NOTIFY = &H10\r
Private Const SYNCHRONIZE = &H100000\r
Private Const KEY_CREATE_LINK = &H20\r
Private Const KEY_ALL_ACCESS = ((STANDARD_RIGHTS_ALL Or _\r
    KEY_QUERY_VALUE Or KEY_SET_VALUE Or KEY_CREATE_SUB_KEY _\r
    Or KEY_ENUMERATE_SUB_KEYS Or KEY_NOTIFY Or _\r
    KEY_CREATE_LINK) And (Not SYNCHRONIZE))\r
Private Const REG_OPTION_NON_VOLATILE = 0\r
Global Const REG_NONE = 0\r
Global Const REG_SZ = 1\r
Global Const REG_EXPAND_SZ = 2\r
Global Const REG_BINARY = 3\r
Global Const REG_DWORD = 4\r
Global Const REG_DWORD_LITTLE_ENDIAN = 4 ' Same as REG_DWORD\r
Global Const REG_DWORD_BIG_ENDIAN = 5\r
Global Const REG_LINK = 6\r
Global Const REG_MULTI_SZ = 7\r
Global Const REG_RESOURCE_LIST = 8\r
Global Const REG_FULL_RESOURCE_DESCRIPTOR = 9\r
Global Const REG_RESOURCE_REQUIREMENTS_LIST = 10\r
\r
Private Const REG_CREATED_NEW_KEY = &H1\r
Private Const REG_OPENED_EXISTING_KEY = &H2\r
\r
Private Declare Function RegOpenKeyEx Lib "advapi32.dll" Alias "RegOpenKeyExA" _\r
    (ByVal hKey As Long, ByVal lpSubKey As String, ByVal ulOptions As Long, _\r
    ByVal samDesired As Long, phkResult As Long) As Long\r
Private Declare Function RegCloseKey Lib "advapi32.dll" _\r
    (ByVal hKey As Long) As Long\r
Private Declare Function RegEnumValue Lib "advapi32.dll" _\r
    Alias "RegEnumValueA" (ByVal hKey As Long, ByVal dwIndex _\r
    As Long, lpValueName As String, lpcbValueName As Long, ByVal _\r
    lpReserved As Long, lpType As Long, lpData As Any, lpcbData As _\r
    Long) As Long\r
Private Declare Function RegEnumKeyEx Lib "advapi32.dll" _\r
    Alias "RegEnumKeyExA" (ByVal hKey As Long, ByVal dwIndex _\r
    As Long, lpName As String, lpcbName As Long, ByVal _\r
    lpReserved As Long, lpClass As String, lpcbClass As _\r
    Long, lpftLastWriteTime As Any) As Long\r
Private Declare Function RegQueryValueEx Lib "advapi32.dll" _\r
    Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName _\r
    As String, ByVal lpReserved As Long, lpType As Long, lpData As _\r
    Any, lpcbData As Long) As Long\r
Private Declare Function RegCreateKeyEx Lib "advapi32.dll" _\r
    Alias "RegCreateKeyExA" (ByVal hKey As Long, ByVal lpSubKey _\r
    As String, ByVal Reserved As Long, ByVal lpClass As String, _\r
    ByVal dwOptions As Long, ByVal samDesired As Long, _\r
    lpSecurityAttributes As Any, phkResult _\r
    As Long, lpdwDisposition As Long) As Long\r
Private Declare Function RegSetValueEx Lib "advapi32.dll" _\r
    Alias "RegSetValueExA" (ByVal hKey As Long, ByVal lpValueName _\r
    As String, ByVal Reserved As Long, ByVal dwType As Long, _\r
    lpData As Any, ByVal cbData As Long) As Long\r
Private Declare Function RegDeleteValue Lib "advapi32.dll" _\r
    Alias "RegDeleteValueA" (ByVal hKey As Long, ByVal _\r
    lpValueName As String) As Long\r
Private Declare Function RegDeleteKey Lib "advapi32.dll" Alias _\r
    "RegDeleteKeyA" (ByVal hKey As Long, ByVal lpSubKey As String) As Long\r
Sub ConvertValueName(Path As String, ByRef hKey As Long, ByRef Key As String, ValueName As String)\r
Dim Data As String, bNum As Long\r
Data = Mid$(Path, 1, InStr(Path, "\") - 1)\r
Select Case Data\r
Case "HKEY_CLASSES_ROOT"\r
hKey = HKEY_CLASSES_ROOT\r
Case "HKEY_CURRENT_USER"\r
hKey = HKEY_CURRENT_USER\r
Case "HKEY_LOCAL_MACHINE"\r
hKey = HKEY_LOCAL_MACHINE\r
Case "HKEY_USERS"\r
hKey = HKEY_USERS\r
Case "HKEY_PERFORMANCE_DATA"\r
hKey = HKEY_PERFORMANCE_DATA\r
Case "HKEY_CURRENT_CONFIG"\r
hKey = HKEY_CURRENT_CONFIG\r
Case "HKEY_DYN_DATA"\r
hKey = HKEY_DYN_DATA\r
End Select\r
bNum = 1\r
Do Until InStr(bNum, Path, "\") = 0\r
bNum = InStr(bNum, Path, "\") + 1\r
Loop\r
On Error Resume Next\r
Key = Mid$(Path, Len(Data) + 2, bNum - 2 - (Len(Data) + 1))\r
ValueName = Mid$(Path, bNum)\r
On Error GoTo 0\r
End Sub\r
Function GetReg(Path As String, Optional Default)\r
Attribute GetReg.VB_Description = "Reads a value from the registry."\r
Dim hKey As Long, kHandle As Long, Key As String, ValueName As String, Data As String, vLen As Long, vType As Long, NumData As Long\r
ConvertValueName Path, hKey, Key, ValueName\r
If RegOpenKeyEx(hKey, Key, 0&, KEY_QUERY_VALUE, kHandle) = 0 Then\r
    If RegQueryValueEx(kHandle, ValueName, 0&, vType, ByVal 0&, vLen) = 0 Then\r
        Data = String$(vLen, Chr$(0))\r
        If vType = REG_DWORD Or vType = REG_DWORD_BIG_ENDIAN Then\r
            If RegQueryValueEx(kHandle, ValueName, 0&, 0&, NumData, vLen) = 0 Then\r
                GetReg = NumData\r
            End If\r
        Else\r
            If RegQueryValueEx(kHandle, ValueName, 0&, 0&, ByVal Data, vLen) = 0 Then\r
                If vType = REG_SZ Or vType = REG_EXPAND_SZ Or vType = REG_MULTI_SZ Then\r
                    Data = Left$(Data, vLen - 1)\r
                    If Data <> "" Then GetReg = Data\r
                Else\r
                    GetReg = Data\r
                End If\r
            End If\r
        End If\r
    End If\r
    RegCloseKey kHandle\r
    If Not IsEmpty(GetReg) Then Exit Function\r
End If\r
If Not IsError(Default) Then GetReg = Default\r
End Function\r
Function GetRegType(Path As String) As Long\r
Dim hKey As Long, kHandle As Long, Key As String, ValueName As String, Data As String, vLen As Long, vType As Long\r
ConvertValueName Path, hKey, Key, ValueName\r
If RegOpenKeyEx(hKey, Key, 0&, KEY_QUERY_VALUE, kHandle) = 0 Then\r
    If RegQueryValueEx(kHandle, ValueName, 0&, vType, ByVal 0&, ByVal 0&) Then\r
        GetRegType = vType\r
    End If\r
    RegCloseKey kHandle\r
End If\r
End Function\r
Function EnumReg(ByVal Path As String, Index As Long) As String\r
Dim hKey As Long, kHandle As Long, Key As String, ValueName As String, Data As String, vLen As Long\r
If Right$(Path, 1) <> "\" Then Path = Path + "\"\r
ConvertValueName Path, hKey, Key, ValueName\r
ValueName = ""\r
If RegOpenKeyEx(hKey, Key, 0&, KEY_QUERY_VALUE, kHandle) = 0 Then\r
    vLen = 255\r
    Data = String$(255, Chr$(0))\r
    If RegEnumValue(kHandle, Index, ByVal Data, vLen, 0&, 0&, ByVal 0&, 0&) = 0 Then\r
        Data = Left$(Data, vLen)\r
        If Data = String$(255, Chr$(0)) Then Data = ""\r
        EnumReg = Data\r
    End If\r
    RegCloseKey kHandle\r
End If\r
End Function\r
Function EnumKey(ByVal Path As String, Index As Long) As String\r
Dim hKey As Long, kHandle As Long, Key As String, ValueName As String, Data As String, vLen As Long\r
If Right$(Path, 1) <> "\" Then Path = Path + "\"\r
ConvertValueName Path, hKey, Key, ValueName\r
ValueName = ""\r
If RegOpenKeyEx(hKey, Key, 0&, KEY_ENUMERATE_SUB_KEYS, kHandle) = 0 Then\r
    vLen = 255\r
    Data = String$(255, Chr$(0))\r
    If RegEnumKeyEx(kHandle, Index, ByVal Data, vLen, 0&, ByVal 0&, 0&, ByVal 0&) = 0 Then\r
        Data = Left$(Data, vLen)\r
        If Data = String$(255, Chr$(0)) Then Data = ""\r
        EnumKey = Data\r
    End If\r
    RegCloseKey kHandle\r
End If\r
End Function\r
Sub MultiStringToArray(MultiString As String, ByRef StrArray() As String)\r
Dim cNum As Long, cNum2 As Long\r
ReDim StrArray(0)\r
For cNum = 1 To Len(MultiString)\r
    cNum2 = InStr(cNum, MultiString, Chr(0))\r
    If cNum2 = 0 Then cNum2 = Len(MultiString) + 1\r
    ReDim Preserve StrArray(UBound(StrArray) + 1)\r
    StrArray(UBound(StrArray)) = Mid$(MultiString, cNum, cNum2 - cNum)\r
    cNum = cNum2\r
Next cNum\r
End Sub\r
Sub ArrayToMultiString(StrArray() As String, ByRef MultiString As String)\r
Dim sNum As Long\r
MultiString = ""\r
For sNum = 1 To UBound(StrArray)\r
    MultiString = MultiString + StrArray(sNum) + Chr$(0)\r
Next sNum\r
End Sub\r
Sub NewKey(ByVal Path As String, Optional Default, Optional vType)\r
Attribute NewKey.VB_Description = "Creates a new key in the registry."\r
Dim hKey As Long, kHandle As Long, Key As String, ValueName As String, Temp As Long, Setg As String, NumData As Long\r
If Right$(Path, 1) <> "\" Then Path = Path + "\"\r
ConvertValueName Path, hKey, Key, ValueName\r
ValueName = ""\r
If RegCreateKeyEx(hKey, Key, 0&, 0&, REG_OPTION_NON_VOLATILE, KEY_CREATE_SUB_KEY Or KEY_SET_VALUE, ByVal 0&, kHandle, Temp) = 0 Then\r
    If Not IsError(Default) Then\r
        If IsError(vType) Then vType = REG_SZ\r
        If vType = REG_DWORD Or vType = REG_DWORD_BIG_ENDIAN Then\r
            NumData = Default\r
            RegSetValueEx kHandle, ValueName, 0&, vType, NumData, 4\r
        Else\r
            Setg = Default\r
            If vType = REG_SZ Or vType = REG_EXPAND_SZ Or vType = REG_MULTI_SZ Then _\r
                Setg = Setg + Chr$(0)\r
            RegSetValueEx kHandle, ValueName, 0&, vType, ByVal Setg, Len(Setg)\r
        End If\r
    End If\r
    RegCloseKey kHandle\r
End If\r
End Sub\r
Sub SetReg(Path As String, NewValue, Optional vType)\r
Attribute SetReg.VB_Description = "Writes a value to the registry."\r
Dim hKey As Long, kHandle As Long, Key As String, ValueName As String, Setg As String, NumData As Long\r
ConvertValueName Path, hKey, Key, ValueName\r
If RegOpenKeyEx(hKey, Key, 0&, KEY_SET_VALUE, kHandle) = 0 Then\r
    If IsError(vType) Then vType = REG_SZ\r
    If vType = REG_DWORD Or vType = REG_DWORD_BIG_ENDIAN Then\r
        NumData = NewValue\r
        RegSetValueEx kHandle, ValueName, 0&, vType, NumData, 4\r
    Else\r
        Setg = NewValue\r
        If vType = REG_SZ Or vType = REG_EXPAND_SZ Or vType = REG_MULTI_SZ Then _\r
            Setg = Setg + Chr$(0)\r
        RegSetValueEx kHandle, ValueName, 0&, vType, ByVal Setg, Len(Setg)\r
    End If\r
    RegCloseKey kHandle\r
End If\r
End Sub\r
Sub DelReg(Path As String)\r
Attribute DelReg.VB_Description = "Deletes a value from the registry."\r
Dim hKey As Long, kHandle As Long, Key As String, ValueName As String\r
ConvertValueName Path, hKey, Key, ValueName\r
If RegOpenKeyEx(hKey, Key, 0&, KEY_SET_VALUE, kHandle) = 0 Then\r
    RegDeleteValue kHandle, ValueName\r
    RegCloseKey kHandle\r
End If\r
End Sub\r
Sub DelKey(ByVal Path As String)\r
Attribute DelKey.VB_Description = "Deletes a key from the registry."\r
Dim hKey As Long, Key As String, Data As String\r
If Right$(Path, 1) <> "\" Then Path = Path + "\"\r
ConvertValueName Path, hKey, Key, Data\r
RegDeleteKey hKey, Key\r
End Sub\r