Attribute VB_Name = "basWinReg"
Option Explicit

'**********************************************************************************************************
' NAME:  WinReg.BAS
' TITLE: Windows Registry Access Interface Module.
' DESCR: This file defines constants, types, and functions which are used to interface with the
'        Windows System Registry.
' NOTES: 1)We declare the external Win32 API calls to the registry, and then we create a series of
'         functions that call these but format the results or take care of the error handling specifically
'         oriented to OPOS device instance info.
'
'**********************************************************************************************************

'----------------------------------------------------------------------------------------------------------
' Constants
'----------------------------------------------------------------------------------------------------------

' Internal:
' Weigh-Tronix OPOS registry values have embedded comments in them which are separated from the value
' by white space and this character.  Make sure this constant syncs up with the one defined in the OPOS
' SO code!
Public Const REG_COMMENT_MARK = "|||"
Public Const REG_OPOSPROVIDER_KEY = "--OPOS--PROVIDER--"

' OPOS Spec Definitions:
Public Const OPOS_ROOTKEY = "SOFTWARE\OLEforRetail\ServiceOPOS"
Public Const OPOS_ROOTKEY_PROVIDER = "SOFTWARE\OLEforRetail\ServiceInfo"
Public Const OPOS_CLASSKEY_SCALE = "Scale"

' Win32 Return Values:
Public Const ERROR_SUCCESS = 0&
Public Const ERROR_FILE_NOT_FOUND = 2&
Public Const ERROR_NO_MORE_ITEMS = 259&

' Win32 Reg API Hive Definitions:
Public Const HKEY_CLASSES_ROOT = &H80000000
Public Const HKEY_CURRENT_CONFIG = &H80000005
Public Const HKEY_CURRENT_USER = &H80000001
Public Const HKEY_DYN_DATA = &H80000006
Public Const HKEY_LOCAL_MACHINE = &H80000002
Public Const HKEY_PERFORMANCE_DATA = &H80000004
Public Const HKEY_USERS = &H80000003

' Win32 Reg AOU Key Value Types:
Public Const REG_NONE = 0
Public Const REG_SZ = 1
Public Const REG_EXPAND_SZ = 2
Public Const REG_BINARY = 3
Public Const REG_DWORD = 4
Public Const REG_DWORD_LITTLE_ENDIAN = 4
Public Const REG_DWORD_BIG_ENDIAN = 5
Public Const REG_LINK = 6
Public Const REG_MULTI_SZ = 7
Public Const REG_RESOURCE_LIST = 8
Public Const REG_FULL_RESOURCE_DESCRIPTOR = 9
Public Const REG_RESOURCE_REQUIREMENTS_LIST = 10

' Win32 Security Descriptor Permissions:
Public Const READ_CONTROL = &H20000
Public Const STANDARD_RIGHTS_WRITE = (READ_CONTROL)
Public Const STANDARD_RIGHTS_ALL = &H1F0000
Public Const STANDARD_RIGHTS_READ = (READ_CONTROL)
Public Const SYNCHRONIZE = &H100000
Public Const KEY_CREATE_LINK = &H20
Public Const KEY_CREATE_SUB_KEY = &H4
Public Const KEY_ENUMERATE_SUB_KEYS = &H8
Public Const KEY_EVENT = &H1
Public Const KEY_QUERY_VALUE = &H1
Public Const KEY_NOTIFY = &H10
Public Const KEY_SET_VALUE = &H2
Public Const KEY_READ = ((STANDARD_RIGHTS_READ Or KEY_QUERY_VALUE Or KEY_ENUMERATE_SUB_KEYS Or KEY_NOTIFY) And (Not SYNCHRONIZE))
Public Const KEY_EXECUTE = ((KEY_READ) And (Not SYNCHRONIZE))
Public Const KEY_WRITE = ((STANDARD_RIGHTS_WRITE Or KEY_SET_VALUE Or KEY_CREATE_SUB_KEY) And (Not SYNCHRONIZE))
Public 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))


'----------------------------------------------------------------------------------------------------------
' Types
'----------------------------------------------------------------------------------------------------------

' Win32 security descriptor type
Type SECURITY_ATTRIBUTES
        nLength As Long
        lpSecurityDescriptor As Long
        bInheritHandle As Long
End Type


'----------------------------------------------------------------------------------------------------------
' External Library Declarations:
'----------------------------------------------------------------------------------------------------------
' Win32 Reg API functions that we care about
' Note that if you declare the lpData parameter as String, you must pass it By Value.
Declare Function RegOpenKey Lib "advapi32.dll" Alias "RegOpenKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long
Declare Function RegOpenKeyEx Lib "advapi32.dll" Alias "RegOpenKeyExA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal ulOptions As Long, ByVal samDesired As Long, phkResult As Long) As Long
Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long
Declare Function RegQueryInfoKey Lib "advapi32.dll" Alias "RegQueryInfoKeyA" (ByVal hKey As Long, ByVal lpClass As String, lpcbClass As Long, lpReserved As Long, lpcSubKeys As Long, lpcbMaxSubKeyLen As Long, lpcbMaxClassLen As Long, lpcValues As Long, lpcbMaxValueNameLen As Long, lpcbMaxValueLen As Long, lpcbSecurityDescriptor As Long, lpftLastWriteTime As Integer) As Long
Declare Function RegQueryValue Lib "advapi32.dll" Alias "RegQueryValueA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal lpValue As String, lpcbValue As Long) As Long
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
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
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, ByVal lpData As String, lpcbData As Long) As Long
Declare Function RegSetValue Lib "advapi32.dll" Alias "RegSetValueA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal dwType As Long, ByVal lpData As String, ByVal cbData As Long) As Long
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
Declare Function RegCreateKey Lib "advapi32.dll" Alias "RegCreateKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long
Declare Function RegDeleteKey Lib "advapi32.dll" Alias "RegDeleteKeyA" (ByVal hKey As Long, ByVal lpSubKey As String) As Long
Declare Function RegSaveKey Lib "advapi32.dll" Alias "RegSaveKeyA" (ByVal hKey As Long, ByVal lpFile As String, lpSecurityAttributes As SECURITY_ATTRIBUTES) As Long
Declare Function RegSaveKey2 Lib "advapi32.dll" Alias "RegSaveKeyA" (ByVal hKey As Long, ByVal lpFile As String, ByVal lpSecurityAttributes As Long) As Long
Declare Function RegRestoreKey Lib "advapi32.dll" Alias "RegRestoreKeyA" (ByVal hKey As Long, ByVal lpFile As String, ByVal dwFlags As Long) As Long
Declare Function RegReplaceKey Lib "advapi32.dll" Alias "RegReplaceKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal lpNewFile As String, ByVal lpOldFile As String) As Long

Function GetOPOSRegDevices(szDevClass As String, nIndex As Integer) As String

    'Gets all devices of a given device class from the registry

    Const lpcbData = 100
    Dim n As Integer
    Dim ret As Long
    Dim hKey As Long
    Dim szSubKey As String
    Dim lpType As Long
    Dim lpData As String * lpcbData
    
    GetOPOSRegDevices = ""
    
    hKey = 0
    szSubKey = OPOS_ROOTKEY & "\" & szDevClass
    lpType = 0
    lpData = ""
    
    'Open the key for this device class
    ret = RegOpenKeyEx(HKEY_LOCAL_MACHINE, szSubKey, 0, KEY_ALL_ACCESS, hKey)
    If (ret <> ERROR_SUCCESS) Then
        'Debug.Print "RegOpenKeyEx Failed"
        Exit Function
    End If
    
    'Get the next enumerated key for this index
    ret = RegEnumKey(hKey, nIndex, lpData, lpcbData)
    If (ret = ERROR_NO_MORE_ITEMS) Then
        'Safe error
        RegCloseKey (hKey)
        Exit Function
    ElseIf ret <> ERROR_SUCCESS Then
        'Bad error
        'Debug.Print "RegEnumKey Failed"
        RegCloseKey (hKey)
        Exit Function
    End If
    
    'Find that terminating NULL character reminiscent of C-Strings
    n = InStr(lpData, Chr(0))
    If (n > 0) Then
        GetOPOSRegDevices = Left(lpData, n - 1)
    Else
        GetOPOSRegDevices = lpData
    End If
    
    RegCloseKey (hKey)
    
End Function

Function ExistOPOSRegDevice(szDevClass As String, szDevName As String) As Long

    'Desc: This routine simply checks to see if the given device name, under the given device class
    '      exists. It returns a 1 if yes, and 0 otherwise.

    Const lpcbData = 100
    Dim i, n As Long
    Dim ret As Long
    Dim hKey As Long
    Dim szSubKey As String
    Dim lpType As Long
    Dim lpData As String * lpcbData
    Dim rg As String
    
    hKey = 0
    szSubKey = OPOS_ROOTKEY & "\" & szDevClass
    lpType = 0
    lpData = ""
    
    ExistOPOSRegDevice = 0
    
    'Open up the key for this device class
    ret = RegOpenKeyEx(HKEY_LOCAL_MACHINE, szSubKey, 0, KEY_ALL_ACCESS, hKey)
    If (ret <> ERROR_SUCCESS) Then
        'Debug.Print "RegOpenKeyEx Failed"
        Exit Function
    End If
    
    'We're going to enumerate over all the sub-keys in this class, testing each one if the name matches.
    'The reason we do this is because simply opening a reg key that doesn't already exist will create it!
    i = 0
    While ret <> ERROR_NO_MORE_ITEMS
        ret = RegEnumKey(hKey, i, lpData, lpcbData)
        If (ret = ERROR_NO_MORE_ITEMS) Then
            'Safe error
            RegCloseKey (hKey)
            Exit Function
        ElseIf ret <> ERROR_SUCCESS Then
            'Bad error
            'Debug.Print "RegEnumKey Failed"
            RegCloseKey (hKey)
            Exit Function
        End If
        
        'Find that terminating NULL character reminiscent of C-Strings
        n = InStr(lpData, Chr(0))
        If (n > 0) Then
            rg = Left(lpData, n - 1)
        Else
            rg = lpData
        End If
        
        'If we have a match we're done
        If (rg = szDevName) Then
            ExistOPOSRegDevice = 1
            RegCloseKey (hKey)
            Exit Function
        End If
        
        i = i + 1
    Wend

    RegCloseKey (hKey)
    
End Function

Function ExistOPOSRegKey(szDevClass As String, szDevName As String) As Long

    'Desc: This routine simply checks to see if the given key exists.
    
    Dim ret As Long
    Dim hKey As Long
    Dim szSubKey As String
    
    hKey = 0
    szSubKey = OPOS_ROOTKEY_PROVIDER & "\" & szDevName
    
    ExistOPOSRegKey = 0
    
    'Open up the key for this device class
    ExistOPOSRegKey = RegOpenKeyEx(HKEY_LOCAL_MACHINE, szSubKey, 0, KEY_ALL_ACCESS, hKey)
    
    RegCloseKey (hKey)
    
End Function

Function GetOPOSRegValue(szDevClass As String, szDevName As String, szValueName As String, szDefault As String) As String
    
    ' Desc: A convenience routine to get a named value for given device name under a device class.
    ' This routine expects that all values are string types in the registry. It takes a "default"
    ' value to return if there are any problems getting the named value, like it doesn't exist, or is
    ' invalid. This routine will also strip out the optional comment character, the white space preceding,
    ' and the comment following the registry value which all Weigh-Tronix OPOS registry values can option-
    ' ally contain.
    ' This routine can also retrieve a value from the OPOS standard service provider key, if the
    ' szDevClass is REG_OPOSPROVIDER_KEY. In this case, the szDevName parameter is used as the Service
    ' Provider's name (i.e. Weigh-Tronix).
    
    Const lpcbData = 100
    Dim n As Integer
    Dim ret As Long
    Dim hKey As Long
    Dim szSubKey As String
    Dim lpType As Long
    Dim lpData As String * lpcbData
    Dim rg, sz As String
    
    If (szDevClass = REG_OPOSPROVIDER_KEY) Then
        szSubKey = OPOS_ROOTKEY_PROVIDER & "\" & szDevName
    Else
        szSubKey = OPOS_ROOTKEY & "\" & szDevClass & "\" + szDevName
    End If
    
    hKey = 0
    lpType = 0
    lpData = ""
    
    'If anything goes wrong, we'll return the default value
    GetOPOSRegValue = szDefault
    
    'Open up the key under the device class for this instance
    ret = RegOpenKeyEx(HKEY_LOCAL_MACHINE, szSubKey, 0, KEY_ALL_ACCESS, hKey)
    If (ret <> ERROR_SUCCESS) Then
        'Debug.Print "RegOpenKeyEx Failed"
        Exit Function
    End If
    
    'Query the value requested
    ret = RegQueryValueEx(hKey, szValueName, 0, lpType, ByVal lpData, lpcbData)
    If (ret = ERROR_FILE_NOT_FOUND) Then
        'Safe error
    ElseIf ret <> ERROR_SUCCESS Then
        'Bad error
        'Debug.Print "RegQueryValueEx Failed on " & szValueName & ":" & Str(ret)
        RegCloseKey (hKey)
        Exit Function
    End If
    
    'These values must be strings according to OPOS Spec
    If (lpType = REG_SZ) Then
        rg = Left(lpData, lpcbData - 1)
        
        'Strip out NULL and everything after
        n = InStr(rg, Chr(0))
        If n > 0 Then rg = Left(rg, n - 1)
            
        'Strip out optional comment string
        sz = REG_COMMENT_MARK
        n = InStr(rg, sz)
        If (n > 0) Then
            rg = Left(rg, n - 1)
            GetOPOSRegValue = RTrim(rg)
        Else
            GetOPOSRegValue = rg
        End If
    Else
        'OPOS defines only string values!
        'Set error state here
    End If
    
    RegCloseKey (hKey)
    
End Function

Function SetOPOSRegValue(szDevClass As String, szDevName As String, szValueName As String, szValue As String, szComment As String) As Long
    
    ' Desc: This routine will set a registry value for a specific device instance.  It will also embed an
    '       optional comment in the value, if specified.
    '       This routine can also set a value for the OPOS standard service provider key, if the
    '       szDevClass is REG_OPOSPROVIDER_KEY. In this case, the szDevName parameter is used as the
    '       Service Provider's name (i.e. Weigh-Tronix).

    Dim ret As Long
    Dim hKey As Long
    Dim szSubKey As String
    Dim szValueFinal As String
    
    'Compute the final value we're setting
    szValueFinal = szValue
    If (Len(szComment) > 0) Then
        szValueFinal = szValue & "  " & REG_COMMENT_MARK & " " & szComment
    End If
    
    If (szDevClass = REG_OPOSPROVIDER_KEY) Then
        szSubKey = OPOS_ROOTKEY_PROVIDER & "\" & szDevName
    Else
        szSubKey = OPOS_ROOTKEY & "\" & szDevClass & "\" + szDevName
    End If
    
    hKey = 0
        
    'Open up the key for this device instance
    ret = RegOpenKeyEx(HKEY_LOCAL_MACHINE, szSubKey, 0, KEY_ALL_ACCESS, hKey)
    If (ret <> ERROR_SUCCESS) Then
        'Debug.Print "RegOpenKeyEx Failed"
        SetOPOSRegValue = ret
        Exit Function
    End If
    
    'Set the value
    ret = RegSetValueEx(hKey, szValueName, 0, REG_SZ, ByVal szValueFinal, Len(szValueFinal))
    If (ret <> ERROR_SUCCESS) Then
        'Debug.Print "RegSetValueEx Failed"
        SetOPOSRegValue = ret
        RegCloseKey (hKey)
        Exit Function
    End If
    
    SetOPOSRegValue = ret
    RegCloseKey (hKey)
    
End Function


Function ListOPOSRegDevice(szDevClass As String, szDevName As String) As String

    ' Desc: This routine will return a string that contains the list of all registry values of a device
    '       instance. The format of the list is compatible with the REGEDIT4 value notation which is a
    '       value name enclosed in double quotes, followed by an equals (=), followed by the string value
    '       enclosed in double quotes. The default value of the key, which is unnamed, is indicated by the
    '       'at' character (@) not in quotes.
    '       Each list entry is terminated by the equivalent of a C-style '\n' character which is a
    '       carriage return (13) followed by a new line (10).

    Const cbValueName = 200
    Const cbData = 200
    Dim i As Integer
    Dim ret
    Dim hKey As Long
    Dim dwIndex As Long
    Dim szSubKey As String
    Dim lpType As Long
    Dim szValList As String
    Dim lpcbValueName As Long
    Dim szValueName, lpValueName As String * cbValueName
    Dim lpcbData As Long
    Dim szData, lpData As String * cbData
    
    ListOPOSRegDevice = ""
    
    hKey = 0
    szSubKey = OPOS_ROOTKEY & "\" & szDevClass & "\" & szDevName
    
    ret = RegOpenKeyEx(HKEY_LOCAL_MACHINE, szSubKey, 0, KEY_ALL_ACCESS, hKey)
    If (ret <> ERROR_SUCCESS) Then
        'Debug.Print "RegOpenKeyEx failed"
        Exit Function
    End If
    
    'Iterate over each value and build up a string containing a list of all values
    dwIndex = 0
    szValList = ""
    ret = ERROR_SUCCESS
    While ret = ERROR_SUCCESS
        lpcbValueName = cbValueName
        lpcbData = cbData
    
        ret = RegEnumValue(hKey, dwIndex, lpValueName, lpcbValueName, 0, lpType, lpData, lpcbData)
        If (ret = ERROR_SUCCESS) Then
            'Compute the value name
            If (lpcbValueName = 0) Then
                szValueName = "@"
            Else
                'Get everything before the null terminator
                szValueName = """" & Left(lpValueName, lpcbValueName) & """"
            End If
            
            'Compute the value data
            If (lpType = REG_SZ) Then
                'Get everything before the null terminator
                szData = """" & Left(lpData, lpcbData - 1) & """"
            Else
                'If it's not a string type, it's not OPOS compliant
                szData = """(Invalid Value Type)"""
            End If
            
            'Tack it on to the end of our list
            szValList = szValList & szValueName & "=" & szData & Chr(&HD) & Chr(&HA)
        End If
        dwIndex = dwIndex + 1
    Wend
    
    RegCloseKey (hKey)
    
    ListOPOSRegDevice = szValList
    
End Function

Function CreateOPOSRegKey(szDevClass As String, szDevName As String) As Long

    ' Desc: This convenience routine will create a new key for a device instance under a given device
    '       class. If the OPOS standard Registry path for this class does not exist, this routine will
    '       create it.
    '       This routine can also create a key under the OPOS standard service provider key, if the
    '       szDevClass is REG_OPOSPROVIDER_KEY. In this case, the szDevName parameter is used as the
    '       Service Provider's name to create (i.e. Weigh-Tronix).

    Dim ret As Long
    Dim hKey As Long
    Dim hNewKey As Long
    Dim szSubKey As String
    Dim szOposKey As String

    If (szDevClass = REG_OPOSPROVIDER_KEY) Then
        szSubKey = OPOS_ROOTKEY_PROVIDER
    Else
        szSubKey = OPOS_ROOTKEY & "\" & szDevClass
    End If
    
    hKey = 0

    'Check if the OPOS reg structure exists
    ret = RegOpenKeyEx(HKEY_LOCAL_MACHINE, szSubKey, 0, KEY_ALL_ACCESS, hKey)
    If (ret = ERROR_FILE_NOT_FOUND) Then
        ' Try to create it
        ret = RegCreateKey(HKEY_LOCAL_MACHINE, szSubKey, hKey)
    End If
    
    If (ret <> ERROR_SUCCESS) Then
        'Debug.Print "RegOpenKeyEx Failed"
        CreateOPOSRegKey = ret
        Exit Function
    End If
    
    ret = RegCreateKey(hKey, szDevName, hNewKey)
    If (ret <> ERROR_SUCCESS) Then
        'Debug.Print "RegCreateKey Failed"
        CreateOPOSRegKey = ret
        RegCloseKey (hKey)
        Exit Function
    End If
    
    CreateOPOSRegKey = ret
    RegCloseKey (hKey)
    
End Function

Function DeleteOPOSRegKey(szDevClass As String, szDevName As String) As Long

    ' Desc: This convenience routine simply deletes the given device instance key.
    
    Dim ret As Long
    Dim hKey As Long
    Dim szSubKey As String

    hKey = 0
    szSubKey = OPOS_ROOTKEY & "\"
    szSubKey = szSubKey + szDevClass + "\" + szDevName
        
    ret = RegOpenKeyEx(HKEY_LOCAL_MACHINE, szSubKey, 0, KEY_ALL_ACCESS, hKey)
    If (ret <> ERROR_SUCCESS) Then
        'Debug.Print "RegOpenKeyEx Failed"
        DeleteOPOSRegKey = ret
        Exit Function
    End If
    
    ret = RegDeleteKey(hKey, "")
    If (ret <> ERROR_SUCCESS) Then
        'Debug.Print "RegDeleteKey Failed"
        DeleteOPOSRegKey = ret
        RegCloseKey (hKey)
        Exit Function
    End If
    
    DeleteOPOSRegKey = ret
    RegCloseKey (hKey)
    
End Function