RegistryGet

Private Function RegistryGetKeyValue( _
        eRootKey As EnumFormPosRegistryRootKeys, _
        strKeyName As String, _
        strValueName As String) _
        As Variant
    ' Comments  : Returns a value from the system registry
    ' Parameters: eRootKey - The root key
    '             strKeyName - The name of the key
    '             strValueName - The name of the value
    ' Returns   : The data in the registry value
    '
    Dim lngRetVal As Long
    Dim lngHKey As Long
    Dim varValue As Variant
    Dim strValueData As String
    Dim lngValueType As Long
    Dim lngDataSize As Long
    
    On Error GoTo PROC_ERR
    
    varValue = Empty
    
    lngRetVal = RegOpenKeyEx(eRootKey, strKeyName, 0&, KEY_QUERY_VALUE, _
        lngHKey)
    
    If mcregErrorNone = lngRetVal Then
        
        lngRetVal = RegQueryValueExNULL(lngHKey, strValueName, 0&, lngValueType, _
            0&, lngDataSize)
        
        If mcregErrorNone = lngRetVal Then
            
            Select Case lngValueType
                    
                    ' String type
                Case REG_SZ:
                    If lngDataSize > 0 Then
                        strValueData = String(lngDataSize, 0)
                        lngRetVal = RegQueryValueExString(lngHKey, strValueName, 0&, _
                            lngValueType, strValueData, lngDataSize)
                        If InStr(strValueData, vbNullChar) > 0 Then
                            strValueData = Mid$(strValueData, 1, InStr(strValueData, _
                                vbNullChar) - 1)
                        End If
                    End If
                    If mcregErrorNone = lngRetVal Then
                        varValue = Left$(strValueData, lngDataSize)
                    Else
                        varValue = Empty
                    End If
                    
                Case Else
                    'No other data types supported
                    lngRetVal = -1
                    
            End Select
            
        End If
        
        RegCloseKey (lngHKey)
    End If
    
    'Return varValue
    RegistryGetKeyValue = varValue
    PROC_EXIT:
    Exit Function
    PROC_ERR:
    MsgBox "Error: " & Err.Number & ". " & Err.Description, , _
        "RegistryGetKeyValue"
    Resume PROC_EXIT
End Function

' In the Declarations section of the form declare the variable
Private mFormPos As CFormPos
Private Sub Form_Load()
    ' Instantiate variable
    Set mFormPos = New CFormPos
    ' Assign current form to the Form property of the object
    Set mFormPos.Form = Me
    ' Assign alternative value to the AppName property
    mFormPos.RegistryPath = "SOFTWARE\FMS\Test CFormPos"
    mFormPos.SubKey = "Form Positions"
    
    ' restore to previously-saved locations. If not previously
    ' saved, then simply center the form
    If Not mFormPos.RestoreForm Then
        mFormPos.CenterForm
    End If
End Sub

Private Sub Form_Unload(Cancel As Integer)
    
    ' Save current position for next time
    mFormPos.SaveForm
End Sub

'---====[ pAssed by vbTips32 codeBook ]====---

Private Function RegistryGetKeyValue( _
eRootKey As EnumFormPosRegistryRootKeys, _
strKeyName As String, _
strValueName As String) _
As Variant
' Comments : Returns a value from the system registry

' Parameters: eRootKey - The root key

' strKeyName - The name of the key

' strValueName - The name of the value

' Returns : The data in the registry value

'

Dim lngRetVal As Long
Dim lngHKey As Long
Dim varValue As Variant
Dim strValueData As String
Dim lngValueType As Long
Dim lngDataSize As Long

On Error GoTo PROC_ERR

varValue = Empty

lngRetVal = RegOpenKeyEx(eRootKey, strKeyName, 0&, KEY_QUERY_VALUE, _
lngHKey)

If mcregErrorNone = lngRetVal Then

lngRetVal = RegQueryValueExNULL(lngHKey, strValueName, 0&, lngValueType, _
0&, lngDataSize)

If mcregErrorNone = lngRetVal Then

Select Case lngValueType

' String type

Case REG_SZ:
If lngDataSize > 0 Then
strValueData = String(lngDataSize, 0)
lngRetVal = RegQueryValueExString(lngHKey, strValueName, 0&, _
lngValueType, strValueData, lngDataSize)
If InStr(strValueData, vbNullChar) > 0 Then
strValueData = Mid$(strValueData, 1, InStr(strValueData, _
vbNullChar) - 1)
End If
End If
If mcregErrorNone = lngRetVal Then
varValue = Left$(strValueData, lngDataSize)
Else
varValue = Empty
End If

Case Else
'No other data types supported

lngRetVal = -1

End Select

End If

RegCloseKey (lngHKey)
End If

'Return varValue

RegistryGetKeyValue = varValue
PROC_EXIT:
Exit Function
PROC_ERR:
MsgBox "Error: " & Err.Number & ". " & Err.Description, , _
"RegistryGetKeyValue"
Resume PROC_EXIT
End Function

' In the Declarations section of the form declare the variable

Private mFormPos As CFormPos
Private Sub Form_Load()
' Instantiate variable

Set mFormPos = New CFormPos
' Assign current form to the Form property of the object

Set mFormPos.Form = Me
' Assign alternative value to the AppName property

mFormPos.RegistryPath = "SOFTWARE\FMS\Test CFormPos"
mFormPos.SubKey = "Form Positions"

' restore to previously-saved locations. If not previously

' saved, then simply center the form

If Not mFormPos.RestoreForm Then
mFormPos.CenterForm
End If
End Sub

Private Sub Form_Unload(Cancel As Integer)

' Save current position for next time

mFormPos.SaveForm
End Sub

'---====[ pAssed by vbTips32 codeBook ]====---