Option Explicit

‘ form level variable used to store the selected parameter from the list
‘ in the keys combo box
Private m_lSelectedParameter As Long

‘ form level constant declarations used throughout the application to name
‘ the application and section when using the Get and Save settings methods
Private Const APPLICATION_TITLE = “VB6DBHT Chapter 11”
Private Const SECTION_NAME = “Jet 3.5”

Private Sub Form_Load()

‘ load all Jet Registry settings from application section fo the
‘ Windows Registry
LoadJetRegistryInformation APPLICATION_TITLE, SECTION_NAME

With cboKeys

‘ add all of the available parameters for the SetOption method

.AddItem “dbPageTimeout”
.AddItem “dbSharedAsyncDelay”
.AddItem “dbExclusiveAsyncDelay”
.AddItem “dbLockRetry”
.AddItem “dbUserCommitSync”
.AddItem “dbImplicitCommitSync”
.AddItem “dbMaxBufferSize”
.AddItem “dbMaxLocksPerFile”
.AddItem “dbLockDelay”
.AddItem “dbRecycleLVs”
.AddItem “dbFlushTransactionTimeout”

‘ select the first item in the combo box control
.ListIndex = 0

End With

End Sub

Private Sub cboKeys_Click()

Dim lDefaultSetting As Variant

With cboKeys

‘ get a long value from the text version of the key
m_lSelectedParameter = GetParameterFromKey(.Text)

‘ obtain the default setting for the key
lDefaultSetting = GetDefaultKeySetting(.Text)

‘ display the current setting from the applications Registry
‘ settings if there is one, otherwise, display the default
txtSetting = GetSetting(APPLICATION_TITLE, _
SECTION_NAME, _
.Text, _
lDefaultSetting)

End With

End Sub

Private Sub cmdClose_Click()

‘ end the application
Unload Me

End Sub

Private Sub cmdSave_Click()

‘ if there is an error, goto the code labeled by ERR_cmdSave_Click
On Error GoTo ERR_cmdSave_Click:

‘ constant declarations for expected errors
Const ERR_TYPE_MISMATCH = 13
Const ERR_RESERVED_ERROR = 3000

‘ attempt to set the DBEngine option for the given key
‘ an error will occur here if an incorrect setting data type is
‘ entered by the user
DBEngine.SetOption m_lSelectedParameter, GetValueFromSetting(txtSetting)

‘ if the SetOption method was successful, then save the new setting
‘ value in the application Registry section
SaveSetting APPLICATION_TITLE, SECTION_NAME, cboKeys.Text, txtSetting

‘ inform the user of the success
MsgBox “Change has been made.”, vbInformation, “Set Option”

Exit Sub

ERR_cmdSave_Click:

Dim sMessage As String

With Err

Select Case .Number

‘ wrong data type entered for key setting
Case ERR_TYPE_MISMATCH, ERR_RESERVED_ERROR:
sMessage = “Value is of incorrect format.”

‘ unexpected error, create a message from the error
Case Else:
sMessage = “ERROR #” & .Number & “: ” & .Description

End Select

End With

‘ inform the user of the error
MsgBox sMessage, vbExclamation, “ERROR”

‘ repopulate the setting text box with the current or default key
‘ setting and set focus to the text box

cboKeys_Click
txtSetting.SetFocus

End Sub

Private Sub cmdDelete_Click()

‘ remove the setting from the application section of the Windows
‘ Registry
DeleteSetting APPLICATION_TITLE, SECTION_NAME, cboKeys.Text

‘ refresh the setting text box with the default value
cboKeys_Click

‘ inform the user of the success
MsgBox “Key has been deleted.”, vbInformation, “Delete Key”

End Sub

 

——————–

‘Module

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