Attribute VB_Name = "RegisterDao"
Option Compare Database
Option Explicit

Private Const HKEY_LOCAL_MACHINE = &H80000002
Public Const KEY_QUERY_VALUE = &H1
Public Const ERROR_SUCCESS = 0&
Public Const MAX_PATH = 260
Public Const S_OK = &H0

Private Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long
Private 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
Private 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
Private Declare Function LoadLibrary Lib "kernel32" Alias "LoadLibraryA" (ByVal lpLibFileName As String) As Long
Private Declare Function FreeLibrary Lib "kernel32" (ByVal hLibModule As Long) As Long

Private Declare Function RegDaoDll Lib "dao360.dll" Alias "DllRegisterServer" () As Long

Private Const REGKEY As String = "SOFTWARE\Microsoft\Windows\CurrentVersion"
Private Const REGVAL As String = "CommonFilesDir"
Private Const DLLLOCATION As String = "\Microsoft Shared\DAO\dao360.dll"

Public Function DaoReg() As Boolean
Dim hKey As Long
Dim stName As String
Dim cb As Long
Dim hMod As Long
    ' First, find DAO. Ordinarily we could call the shell32/shfolder
    ' functions to find the location of the "Common Files" folder,
    ' but this will not work on Windows 95. So, go right to the
    ' registry to find:
    '   $(PROGRAM FILES)\$(COMMON FILES)\Microsoft Shared\DAO
    
    If (ERROR_SUCCESS = RegOpenKeyEx(HKEY_LOCAL_MACHINE, REGKEY, 0, KEY_QUERY_VALUE, hKey)) Then
        cb = MAX_PATH
        stName = String$(cb, vbNullChar)
                
        If (ERROR_SUCCESS = RegQueryValueEx(hKey, REGVAL, 0&, ByVal 0&, ByVal stName, cb)) Then
            ' Ok, now build the full DLL path
            stName = StFromSz(stName) & DLLLOCATION
            
            ' Load DAO so we can try to register it
            hMod = LoadLibrary(stName)
            If hMod Then
                ' Find out if the registration works
                DaoReg = (RegDaoDll() = S_OK)
                
                Call FreeLibrary(hMod)
            End If
        End If
        Call RegCloseKey(hKey)
    End If
End Function

'------------------------------------------------------------
'   StFromSz
'
'    Find the first vbNullChar in a string, and return
'    everything prior to that character. Extremely
'    useful when combined with the Windows API function calls.
'------------------------------------------------------------
Public Function StFromSz(ByVal sz As String) As String
    
    Dim ich As Integer
    
    ich = InStr(sz, vbNullChar)
    Select Case ich
        ' It's best to put the most likely case first.
        Case Is > 1
            ' Found in the string, so return the portion
            ' up to the null character.
            StFromSz = Left$(sz, ich - 1)
        Case 0
            ' Not found at all, so just
            ' return the original value.
            StFromSz = sz
        Case 1
            ' Found at the first position, so return an empty string.
            StFromSz = vbNullString
    End Select
End Function