registryinformation.bas

来自「VB6数据库开发指南》的配套源程序」· BAS 代码 · 共 153 行

Attribute VB_Name = "RegistryInformation"
Option Explicit


Public Sub LoadJetRegistryInformation(sApplicationName As String, _
                                      sSectionName As String)

' if there is an error, goto the code labeled by
' ERR_LoadJetRegistryInformation
On Error GoTo ERR_LoadJetRegistryInformation:

    Dim vSettings As Variant
    Dim nCount As Integer
    
    ' constant declaration for expected error
    Const ERR_TYPE_MISMATCH = 13
    
    ' obtain all of the settings from the Registry section for the given
    ' application
    vSettings = GetAllSettings(sApplicationName, sSectionName)
    
    ' set all of the options that were specified in the Jet 3.5 section for
    ' the current application
    For nCount = 0 To UBound(vSettings, 1)
        
        DBEngine.SetOption GetParameterFromKey _
                             (vSettings(nCount, 0)), _
                              GetValueFromSetting(vSettings(nCount, 1))
                              
    Next nCount

Exit Sub

ERR_LoadJetRegistryInformation:

    With Err
    
        Select Case .Number
        
            ' there was no settings specified in the Registry for the
            ' given application, just continue without displaying an
            ' error message
            Case ERR_TYPE_MISMATCH:
                
            ' unexpected error, create a message from the error
            Case Else:
                MsgBox "ERROR #" & .Number & ": " & .Description, _
                        vbExclamation, "ERROR"
                
        End Select
    
    End With

End Sub

Public Function GetValueFromSetting(vSetting As Variant) As Variant

    ' if the setting is a number, return a long, otherwise return a string
    
    If (IsNumeric(vSetting)) Then
        GetValueFromSetting = CLng(vSetting)
    Else
        GetValueFromSetting = CStr(vSetting)
    End If
    
End Function

Public Function GetDefaultKeySetting(sKey As String) As Variant

    ' return the defualt key setting for the key specified
    
    Select Case sKey
        
        Case "dbPageTimeout":
            GetDefaultKeySetting = 5000
        
        Case "dbSharedAsyncDelay":
            GetDefaultKeySetting = 0
        
        Case "dbExclusiveAsyncDelay":
            GetDefaultKeySetting = 2000
        
        Case "dbLockEntry":
            GetDefaultKeySetting = 20
        
        Case "dbUserCommitSync":
            GetDefaultKeySetting = "Yes"
        
        Case "dbImplicitCommitSync":
            GetDefaultKeySetting = "No"
        
        Case "dbMaxBufferSize":
            GetDefaultKeySetting = 0
        
        Case "dbMaxLocksPerFile":
            GetDefaultKeySetting = 9500
        
        Case "dbLockDelay":
            GetDefaultKeySetting = 100
        
        Case "dbRecycleLVs":
            GetDefaultKeySetting = 0
        
        Case "dbFlushTransactionTimeout":
            GetDefaultKeySetting = 500
    
    End Select

End Function

Public Function GetParameterFromKey(ByVal sKey As String) As Long
    
    ' return the correct constant for the given key
    
    Select Case sKey
        
        Case "dbPageTimeout":
            GetParameterFromKey = dbPageTimeout
        
        Case "dbSharedAsyncDelay":
            GetParameterFromKey = dbSharedAsyncDelay
        
        Case "dbExclusiveAsyncDelay":
            GetParameterFromKey = dbExclusiveAsyncDelay
        
        Case "dbLockRetry":
            GetParameterFromKey = dbLockRetry
        
        Case "dbUserCommitSync":
            GetParameterFromKey = dbUserCommitSync
        
        Case "dbImplicitCommitSync":
            GetParameterFromKey = dbImplicitCommitSync
        
        Case "dbMaxBufferSize":
            GetParameterFromKey = dbMaxBufferSize
        
        Case "dbMaxLocksPerFile":
            GetParameterFromKey = dbMaxLocksPerFile
        
        Case "dbLockDelay":
            GetParameterFromKey = dbLockDelay
        
        Case "dbRecycleLVs":
            GetParameterFromKey = dbRecycleLVs
        
        Case "dbFlushTransactionTimeout":
            GetParameterFromKey = dbFlushTransactionTimeout
    
    End Select

End Function