Customizing Front Ends

[csolomon]

Hello,

Recently I split my DB and I would like for each FE to be customized so that the user will only see what they need to access. I do not use a log in to authenticate users so I wanted to know if I could just make a copy of the FE and then customize a copy for each user.

I appreciate the input

[Stewart Ross]

You can customise different front ends for different users or groups of users as you wish, although developing an individual database for each user seems very labour-intensive to me.

It's also possible to develop custom user settings tables (quite independent of the limited user security in Access itself) which you can then use to implement a custom front-end. That way you can present different options to users depending on the network log-in name of the current user (easily found using system functions).

There are any number of possibilities for further development, limited only by your time and imagination...

-Stewart

[csolomon]

Thanks for the response Stewart. I have just one DB, but several users. Currently I am using the switchboard list for users to access what they need but i would like to limit that.

In another DB I developed, I am using a login to authenticate users and determine what they see, so I know this way is effective. I just don't have it for my production DB as yet. So I guess my options are to develop using the log in authentication or customize each FE.

[NeoPa]

To save having to manage the logging in yourself, you could get the username from Windows (if that's right for what you want to do). This function should help with that :

'GetUser returns the user's logged on name.
Public Function GetUser() As String
    Dim strUserKey As String

    If Environ("OS") = "Windows_NT" Then
        strUserKey = "SOFTWARE\Microsoft\Windows NT\CurrentVersion\Winlogon"
        GetUser = RegRead(conHKLM, strUserKey, "DefaultUserName")
    Else
        'Windows (95, 98 or ME)
        GetUser = Environ("UserName")
    End If
End Function

PS. I strongly recommend the approach advocated by Stewart. Managing various different databases for this reason would be against your best interest.

[ChipR]

Here's some code I use from Allen Browne, which he notes is safter than testing Environ().

Private Declare Function apiGetUserName Lib "advapi32.dll" Alias _
    "GetUserNameA" (ByVal lpBuffer As String, nSize As Long) As Long

Public Function GetNetworkUserName() As String
On Error GoTo Err_Handler
    'Purpose:   Returns the network login name
    'Return:    The name, or "{Unknown}" on error.
    'Note:      Safer than testing Environ().
    Dim lngLen As Long
    Dim lngX As Long
    Dim strUserName As String
    
    strUserName = String$(254, 0&)
    lngLen = 255&
    lngX = apiGetUserName(strUserName, lngLen)
    If (lngX > 0&) Then
        strUserName = Left$(strUserName, lngLen - 1&)
    End If
    
    If strUserName <> vbNullString Then
        GetNetworkUserName = strUserName
    Else
        GetNetworkUserName = "{unknown}"
    End If

Exit_Handler:
    Exit Function

Err_Handler:
    Call LogError(Err.number, Err.Description, conMod & ".fOSUserName")
    Resume Exit_Handler
End Function

I also keep each user's username in a table, along with which type of permissions they should have, User or Manager. Then I open the appropriate menu and forms for thier user type.

[NeoPa]

Usage of Environ() (which is quite risky as a user can change it) was restricted in my code to when running on pre-NT based Windows.

Unfortunately, the OS function call in the NT side was a call to a module which I didn't include (oops). I did scan it before posting - but missed this one :(

I'll include the other module, just in case of interest, but Chip's code is probably quite adequate instead (and doesn't require a separate module.

Module - modOS.

Option Compare Database
Option Explicit

'Windows API Variable Prefixes
'cb = Count of Bytes (32-bit)
'w  = Word (16-bit)
'dw = Double Word (32-bit)
'lp = Long Pointer (32-bit)
'b  = Boolean (32-bit)
'h  = Handle (32-bit)
'ul = Unsigned Long (32-bit)

Public Const conHKCR = &H80000000
Public Const conHKCU = &H80000001
Public Const conHKLM = &H80000002
Public Const conHKU = &H80000003
Public Const conStandardRightsAll = &H1F0000
Public Const conReadControl = &H20000
Public Const conStandardRightsRead = (conReadControl)
Public Const conRegSz = 1
Public Const conOK = 0&
Public Const conKeyQueryValue = &H1
Public Const conKeySetValue = &H2
Public Const conKeyCreateLink = &H20
Public Const conKeyCreateSubKey = &H4
Public Const conKeyEnumerateSubKeys = &H8
Public Const conKeyNotify = &H10
Public Const conSynchronise = &H100000
Public Const conRegOptionNonVolatile = 0
Public Const conKeyAllAccess = ((conStandardRightsAll _
                              Or conKeyQueryValue _
                              Or conKeyCreateSubKey _
                              Or conKeyEnumerateSubKeys _
                              Or conKeyNotify _
                              Or conKeyCreateLink) _
                            And (Not conSynchronise))
Public Const conKeyRead = ((conReadControl _
                         Or conKeyQueryValue _
                         Or conKeyEnumerateSubKeys _
                         Or conKeyNotify) _
                       And (Not conSynchronise))

Private Const conUseShowWindow = &H1&
Private Const conNormalPriority = &H20&
Private Const conInfinite = -1&
Private Const conWinVis = &H10000000
Private Const conGWLStyle = -16

Private Type typStartupInfo
    cbLen As Long
    lpReserved As String
    lpDesktop As String
    lpTitle As String
    dwX As Long
    dwY As Long
    dwXSize As Long
    dwYSize As Long
    dwXCount As Long
    dwYCount As Long
    dwFillAtt As Long
    dwFlags As Long
    wShowWindow As Integer
    cbReserved2 As Integer
    lpReserved2 As Long
    hStdIn As Long
    hStdOut As Long
    hStdErr As Long
End Type

Private Type typProcInfo
    hProc As Long
    hThread As Long
    dwProcID As Long
    dwThreadID As Long
End Type

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 RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) _
                             As Long
Private Declare Function RegQueryValueExStr Lib "advapi32.dll" _
    Alias "RegQueryValueExA" (ByVal hKey As Long, _
                              ByVal lpValueName As String, _
                              ByVal lpReserved As Long, _
                              lpType As Long, _
                              ByVal lpData As String, _
                              lpcbData As Long) As Long

Private Declare Function CreateProcessA Lib "kernel32" ( _
    ByVal lpApplicationName As Long, _
    ByVal lpCommandLine As String, _
    ByVal lpProcessAttributes As Long, _
    ByVal lpThreadAttributes As Long, _
    ByVal bInheritHandles As Long, _
    ByVal dwCreationFlags As Long, _
    ByVal lpEnvironment As Long, _
    ByVal lpCurrentDirectory As Long, _
    lpStartupInfo As typStartupInfo, _
    lpProcessInformation As typProcInfo) As Long
Private Declare Function WaitForSingleObject Lib "kernel32" ( _
    ByVal hHandle As Long, _
    ByVal dwMilliseconds As Long) As Long
Private Declare Function CloseHandle Lib "kernel32" ( _
    ByVal hObject As Long) As Long

Private Declare Function FindWindowEx Lib "user32" _
    Alias "FindWindowExA" (ByVal hwndParent As Long, _
                           ByVal hwndChildAfter As Long, _
                           ByVal lpszClass As String, _
                           ByVal lpszWindow As String) As Long
Private Declare Function GetWindowLong Lib "user32" _
    Alias "GetWindowLongA" (ByVal hwndID As Long, _
                            ByVal nIndex As Long) As Long

Public Function RegRead(ByVal lngHive As Long, _
                        ByVal strKey As String, _
                        ByVal strValue As String) As Variant
    Dim intIdx As Integer, intHK As Integer
    Dim strWork As String
    Dim lngRet As Long, cbLen As Long, lngHKey As Long, lngType As Long

    RegRead = Null
    strKey = strKey & Chr(0)
    lngRet = RegOpenKeyEx(lngHive, strKey, 0, conKeyRead, lngHKey)
    If lngRet = conOK Then
        'Create buffer to store value
        strWork = Space(255)
        cbLen = 255
        lngRet = RegQueryValueExStr(lngHKey, _
                                    strValue, _
                                    0&, _
                                    lngType, _
                                    strWork, _
                                    cbLen)
        RegRead = Left(strWork, cbLen - 1)
        If Len(RegRead) = 254 Then RegRead = Null
        'Close key
        Call RegCloseKey(lngHKey)
    End If
End Function

'ShellWait() executes a command synchronously (Shell() works asynchronously).
Public Sub ShellWait(strCommand As String, _
                     Optional intWinStyle As Integer = vbNormalFocus)
    Dim objProcInfo As typProcInfo
    Dim objStart As typStartupInfo
    Dim lngRet As Long

    'Initialize the typStartupInfo structure:
    With objStart
        .cbLen = Len(objStart)
        .dwFlags = conUseShowWindow
        .wShowWindow = intWinStyle
    End With
    'Start the shelled application:
    Call CreateProcessA(lpApplicationName:=0&, _
                        lpCommandLine:=strCommand, _
                        lpProcessAttributes:=0&, _
                        lpThreadAttributes:=0&, _
                        bInheritHandles:=1&, _
                        dwCreationFlags:=conNormalPriority, _
                        lpEnvironment:=0&, _
                        lpCurrentDirectory:=0&, _
                        lpStartupInfo:=objStart, _
                        lpProcessInformation:=objProcInfo)
    'Wait for the shelled application to finish
    Call WaitForSingleObject(hHandle:=objProcInfo.hProc, _
                             dwMilliseconds:=conInfinite)
    Call CloseHandle(hObject:=objProcInfo.hProc)
End Sub

Public Function DBWindowVisible() As Boolean
    Dim hWnd As Long, lngStyle As Long

    'Get handle of MDIClient window of current application
    hWnd = FindWindowEx(hWndAccessApp, 0, "MDIClient", vbNullString)
    'Within that, find child window matching class Odb (database window)
    hWnd = FindWindowEx(hWnd, 0, "Odb", vbNullString)
    'Default result to False in case handle wasn't found
    DBWindowVisible = False
    If (hWnd) Then
        'Having found window, check the visibility flag of its style value
        lngStyle = GetWindowLong(hWnd, conGWLStyle)
        DBWindowVisible = ((lngStyle And conWinVis) = conWinVis)
    End If
End Function