User-proofing an Access Application

You'll look at this code and go

HUH

and for the most part, I do too.
It's Windows API code from Dev Ashish, and I don't pretend to understand it.
The upshot is you can put this code in a regular module, and then call
ReturnUserName()
ReturnComputerName()

That is monstrously useful...

Private sub Form_Open(Cancel as Integer)

if ReturnUserName <> "MyLoginName"
    Cancel = True ' the form bails
end if

end sub

OR

Private sub SomeButton_Click()
select case true
    case ReturnUserName = "JoeWho"
        docmd.openform "JoesForm"
    case ReturnUserName = "BobbyWhat"
       msgbox "forget Bob, no joy for you"
    case else
        Msgbox "I don't know you from Jack the Bear"
end select
end sub

Please see Dev Ashish's wonderful site at http://www.mvps.org/access/ for more

Option Compare Database
Option Explicit

Private Type USER_INFO_2
    usri2_name As Long
    usri2_password  As Long  ' Null, only settable
    usri2_password_age  As Long
    usri2_priv  As Long
    usri2_home_dir  As Long
    usri2_comment  As Long
    usri2_flags  As Long
    usri2_script_path  As Long
    usri2_auth_flags  As Long
    usri2_full_name As Long
    usri2_usr_comment  As Long
    usri2_parms  As Long
    usri2_workstations  As Long
    usri2_last_logon  As Long
    usri2_last_logoff  As Long
    usri2_acct_expires  As Long
    usri2_max_storage  As Long
    usri2_units_per_week  As Long
    usri2_logon_hours  As Long
    usri2_bad_pw_count  As Long
    usri2_num_logons  As Long
    usri2_logon_server  As Long
    usri2_country_code  As Long
    usri2_code_page  As Long
End Type

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


Private Declare Function GetComputerName Lib "Kernel32" _
Alias "GetComputerNameA" _
(ByVal lpBuffer As String, nSize As Long) As Long

 
Private Declare Function apiNetGetDCName _
    Lib "netapi32.dll" Alias "NetGetDCName" _
    (ByVal servername As Long, _
    ByVal DomainName As Long, _
    bufptr As Long) As Long
 
' function frees the memory that the NetApiBufferAllocate
' function allocates.
Private Declare Function apiNetAPIBufferFree _
    Lib "netapi32.dll" Alias "NetApiBufferFree" _
    (ByVal buffer As Long) _
    As Long
 
' Retrieves the length of the specified wide string.
Private Declare Function apilstrlenW _
    Lib "Kernel32" Alias "lstrlenW" _
    (ByVal lpString As Long) _
    As Long
 
Private Declare Function apiNetUserGetInfo _
    Lib "netapi32.dll" Alias "NetUserGetInfo" _
    (servername As Any, _
    username As Any, _
    ByVal Level As Long, _
    bufptr As Long) As Long
 
' moves memory either forward or backward, aligned or unaligned,
' in 4-byte blocks, followed by any remaining bytes
Private Declare Sub sapiCopyMem _
    Lib "Kernel32" Alias "RtlMoveMemory" _
    (Destination As Any, _
    Source As Any, _
    ByVal Length As Long)
 
Private Declare Function apiGetUserName Lib _
    "advapi32.dll" Alias "GetUserNameA" _
    (ByVal lpBuffer As String, _
    nSize As Long) _
    As Long
 
Private Const MAXCOMMENTSZ = 256
Private Const NERR_SUCCESS = 0
Private Const ERROR_MORE_DATA = 234&
Private Const MAX_CHUNK = 25
Private Const ERROR_SUCCESS = 0&


'******** Code Start ********
'This code was originally written by Dev Ashish.
'It is not to be altered or distributed,
'except as part of an application.
'You are free to use it in any application,
'provided the copyright notice is left unchanged.
'
'Code Courtesy of
'Dev Ashish
'
 
Function fGetFullNameOfLoggedUser(Optional strUserName As String) As String
'
' Returns the full name for a given UserID
'   NT/2000 only
' Omitting the strUserName argument will try and
' retrieve the full name for the currently logged on user
'
On Error GoTo ErrHandler
Dim pBuf As Long
Dim dwRec As Long
Dim pTmp As USER_INFO_2
Dim abytPDCName() As Byte
Dim abytUserName() As Byte
Dim lngRet As Long
Dim I As Long
 
    ' Unicode
    abytPDCName = fGetDCName() & vbNullChar
    If (Len(strUserName) = 0) Then strUserName = fGetUserName()
    abytUserName = strUserName & vbNullChar
 
    ' Level 2
    lngRet = apiNetUserGetInfo( _
                            abytPDCName(0), _
                            abytUserName(0), _
                            2, _
                            pBuf)
    If (lngRet = ERROR_SUCCESS) Then
        Call sapiCopyMem(pTmp, ByVal pBuf, Len(pTmp))
        fGetFullNameOfLoggedUser = fStrFromPtrW(pTmp.usri2_full_name)
    End If
 
    Call apiNetAPIBufferFree(pBuf)
ExitHere:
    Exit Function
ErrHandler:
    fGetFullNameOfLoggedUser = vbNullString
    Resume ExitHere
End Function
 
Private Function fGetUserName() As String
' Returns the network login name
Dim lngLen As Long, lngRet As Long
Dim strUserName As String
    strUserName = String$(254, 0)
    lngLen = 255
    lngRet = apiGetUserName(strUserName, lngLen)
    If lngRet Then
        fGetUserName = Left$(strUserName, lngLen - 1)
    End If
End Function
 
Function fGetDCName() As String
Dim pTmp As Long
Dim lngRet As Long
Dim abytBuf() As Byte
 
    lngRet = apiNetGetDCName(0, 0, pTmp)
    If lngRet = NERR_SUCCESS Then
        fGetDCName = fStrFromPtrW(pTmp)
    End If
    Call apiNetAPIBufferFree(pTmp)
End Function
 
Private Function fStrFromPtrW(pBuf As Long) As String
Dim lngLen As Long
Dim abytBuf() As Byte
 
    ' Get the length of the string at the memory location
    lngLen = apilstrlenW(pBuf) * 2
    ' if it's not a ZLS
    If lngLen Then
        ReDim abytBuf(lngLen)
        ' then copy the memory contents
        ' into a temp buffer
        Call sapiCopyMem( _
                abytBuf(0), _
                ByVal pBuf, _
                lngLen)
        ' return the buffer
        fStrFromPtrW = abytBuf
    End If
End Function


Function ReturnUserName() As String
' returns the NT Domain User Name
Dim rString As String * 255, sLen As Long, tString As String
    tString = ""
    On Error Resume Next
    sLen = GetUserName(rString, 255)
    sLen = InStr(1, rString, Chr(0))
    If sLen > 0 Then
        tString = Left(rString, sLen - 1)
    Else
        tString = rString
    End If
    On Error GoTo 0
    ReturnUserName = UCase(Trim(tString))
End Function

 
Function ReturnComputerName() As String
    Dim rString As String * 255, sLen As Long, tString As String
    tString = ""
    On Error Resume Next
    sLen = GetComputerName(rString, 255)
    sLen = InStr(1, rString, Chr(0))
    If sLen > 0 Then
        tString = Left(rString, sLen - 1)
    Else
        tString = rString
    End If
    On Error GoTo 0
    ReturnComputerName = UCase(Trim(tString))
End Function

Select allOpen in new window

I forget ... what Version of Access are you using ?

mx

2007

Here is a KB on how to password protect a form or report ...

How to Create a Password Protected Form or Report
http://support.microsoft.com/?kbid=209871

mx

Yay!!  Thanks so much!  I'll be working on this later today and can't wait to try this out.  What i'd love to have on my apps is a "Release Me" button that I click and that turns off all my debuggers, cleans everything up, and gets the app ready for users... oh yeah and makes the Release Me button invisible :)

this will go a long way to helping.

LOL

With the ReturnUserName code, on the form that has the cmdReleaseMe button, you put in the Form Open event

if returnusername <> "epuglise" them
    me.cmdReleaseMe.visible = false
end if

The API code I posted gets put in a standard module and can then get used ANYWHERE in the rest of your VBA code.
I use it to hide buttons, change what opens on click events, filter what combo boxes display, the whole nine yards.

The Get Login name code/link I posted is much simpler and accomplishes the same thing ... Gets the Windows logged in user name.

"Release Me"
or Rescue Me !

You can certainly add code that does this ... which you could call from a hidden Macro I suppose.

mx

@DatabaseMX

Both your code and mine come from Dev Ashish's site.
I find both the logon username and computername to be immensely useful.
Different printers, different install bases, different x86/x64 configurations...

I use them both across 50+ and reports and they're dead simple to use.
Each to their own, I guess.

Best page I ever googled when I started out
http://www.mvps.org/access/tencommandments.htm

"computername"
>> http://www.mvps.org/access/api/api0009.htm

mx

The entire module I posted came in its entirety from Dev site -- I think!
I can't find it now, there, anymore -- but it was the first API code I ever used.
Never messed with it, add to it, or subtracted from it.

On the other hand, It is simpler syntax from what is posetd there now.
Maybe someone extended it -- and didn't post there own disclaimer in there, so now I think it was all Dev's code
I'm not sure.

One thing I am sure of, is it's dead simple.

"The entire module I posted came in its entirety from Dev site -- I think!"
I get that ... it came form this link:
http://www.mvps.org/access/api/api0066.htm

I'm just saying the other two code snippets are a lot shorter and is what I've been using for years.

mx

@DatabaseMX
I don't disagree.  What I posted is long, and I also don't understand it.
I like the syntax though!

Dim SomeString as string
SomeString = ReturnUserName

I can remember that when I find my next nifty use of it.
fOSUserName ... not so much.
But that's me :)
Looking at API alphabet soup makes my head hurt.
Doesn't mean I don't use it when it's needful.

Up to the OP now!

"fOSUserName ... not so much."
What do you mean ?

mx

LOL

"What was the name of that function that returned the username?  Oh yeah--ReturnUserName!"

LOL

What's so funny ?


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

Function ReturnUserName() As String
' Returns the network login name
Dim lngLen As Long, lngX As Long
Dim strUserName As String
    strUserName = String$(254, 0)
    lngLen = 255
    lngX = apiGetUserName(strUserName, lngLen)
    If ( lngX > 0 ) Then
        ReturnUserName = Left$(strUserName, lngLen - 1)
    Else
        ReturnUserName = vbNullString
    End If
End Function


How hard is that ?

mx

:)
I'd have to understand the code to do that
API code is where I come closest to breaking Dev Ashish's commandment #8

'Thou shalt not copy and paste other people's code without at least attempting to understand what it does.'

I don't really understand the API code--so I don't monkey with any farther than functionality requires, lest it destroy the entire universe.  I honestly wouldn't dare to attempt what you did there--because most of the dependencies are incomprehensible to me.  Any time I do monkey with it, I break it.  And then I wind up copying and pasting in the code without alterations anyway.

API -- the magical black box.  Not that I like black boxes.  I'd prefer to understand my code--but I haven't got the time to become an API coder.  So I use it when VBA can't or won't do what I need.

But the code you propose (and the link I referenced) has API code ...

All I did was change the name of the Function ...  which could be anything you want to call it.

mx

@DatabaseMX
But lets say I get it in my head to change this:

Private Declare Function GetComputerName Lib "Kernel32" _
Alias "GetComputerNameA" _
(ByVal lpBuffer As String, nSize As Long) As Long

Almost certainly it'll get busted.  My latest foray into API is here
https://www.experts-exchange.com/questions/26878741/MS-Access-VBA-Open-Explorer-exe-window-to-thumbnails-extra-large-icons-view.html
All I wanted to do at the end was pass in a path to this function:

Function EnumChildProc(ByVal lhWnd As Long, ByVal lParam As Long) As Long
Dim RetVal As Long
Dim WinClassBuf As String * 255, WinTitleBuf As String * 255
Dim WinClass As String, WinTitle As String
Dim WinRect As RECT
Dim WinWidth As Long, WinHeight As Long

RetVal = GetClassName(lhWnd, WinClassBuf, 255)
WinClass = StripNulls(WinClassBuf)  ' remove extra Nulls & spaces
RetVal = GetWindowText(lhWnd, WinTitleBuf, 255)
WinTitle = StripNulls(WinTitleBuf)
ChildCount = ChildCount + 1
' see the Windows Class and Title for each Child Window enumerated
'Debug.Print "   Child Class = "; WinClass; ", Title = "; WinTitle
' You can find any type of Window by searching for its WinClass
If WinClass = "ShellTabWindowClass" Then
    Call ChangeView(lhWnd)
    Exit Function
End If

If WinClass = "ThunderTextBox" Then    ' TextBox Window
   RetVal = GetWindowRect(lhWnd, WinRect)  ' get current size
   WinWidth = WinRect.Right - WinRect.Left ' keep current width
   WinHeight = (WinRect.Bottom - WinRect.Top) * 2 ' double height
   RetVal = MoveWindow(lhWnd, 0, 0, WinWidth, WinHeight, True)
   EnumChildProc = False
Else
   EnumChildProc = True
End If
End Function


Crash!  Bang!  Boom!  MS Access has encountered an error and is restarting....

So I don't mess with the API code I google up ... much :)
It can be very unforgiving if mistreated...and I only have a vague idea of how to treat it.
But that's me.

YMMV, epuglise's too, No Biggie

Ok, I think I understand the shorter bit of code from DatabaseMX better and I hate using code i don't understand (make debugging even harder for me).

DbMX:  I'm using your steps with the images embedded and I think I do need the shift bypass code you reference.

Nick67: thx for the explicit code for opening the db with admin functions if it is "me".

My head hurts :(

Ok another question.  I'm scared to death of globals because i think some coding class at one time made a big deal about not using globals... BUT... do you think it makes sense to create a global that identifies the user as either an "Admin" or a "User" (which would be determined based on who the user is (from the get user id function)? I was thinking that the user type could be set when the app is opened the first time?

Then depending on what form needs what access, I could determine on a form-by-form basis what is visible and available and what is not.

Thank you for your advice.

(PS if that is a different question let me know and I'll open a separate question)

@Nick: so those two functions turn on or off the entire tool bar; I assume a custom toolbar would consist of:
1. turning everything off
2. turning on only those things that apply to a particular user?

Lots of good suggestions (and code) that got me to my solution: a global that identifies the type of user and then makes visible (or not) various program elements depending on that user type.

Thanks for the advice and code.

PS @dbmx:  i've seen other references to locking a db remotely, but the www.members.shaw link isn't working.