Vb Issues

[mnashed]

I have been asked to ad some code to one of our databases.. currently this database looks to active directory for log in information... we would like it to look to a specific OU, is that possible ... i have copied the code into here. this has my additions that dont work in it

Option Explicit
 
Private Declare Function LogonUser Lib "Advapi32" Alias "LogonUserA" (ByVal lpszUsername As String, ByVal lpszDomain As Any, ByVal lpszPassword As String, ByVal dwLogonType As Long, ByVal dwLogonProvider As Long, phToken As Long) As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Private Declare Function FormatMessage Lib "kernel32" Alias "FormatMessageA" (ByVal dwFlags As Long, lpSource As Any, ByVal dwMessageId As Long, ByVal dwLanguageId As Long, ByVal lpBuffer As String, ByVal nSize As Long, Arguments As Long) As Long
Private Declare Function NetUserChangePassword Lib "netapi32.dll" (ByVal sDomain As String, ByVal sUserName As String, ByVal sOldPassword As String, ByVal sNewPassword As String) As Long
 
'Purpose   :    Checks if a the NT password for a user is correct.
'Inputs    :    UserName                The username
'               Password                The password
'               [Domain]                If DOMAIN is omitted uses the local account database.
'Outputs   :    Returns True if the password and user name are valid.
'Notes     :    Windows NT and 2000 ONLY. Will work on any machine.
'               Slower than the UserCheckPassword function, but more reliable.
 
If LogonUser = ITAdmins Is True Then
 
 
 
 
 
 
 
 
 
Function UserValidate(sUserName As String, sPassword As String, Optional sDomain As String) As Boolean
    Dim lReturn As Long
    Const NERR_BASE = 2100
    Const NERR_PasswordCantChange = NERR_BASE + 143
    Const NERR_PasswordHistConflict = NERR_BASE + 144
    Const NERR_PasswordTooShort = NERR_BASE + 145
    Const NERR_PasswordTooRecent = NERR_BASE + 146
 
    If Len(sDomain) = 0 Then
        sDomain = Environ$("USERDOMAIN")
    End If
 
    'Call API to check password.
    lReturn = NetUserChangePassword(StrConv(sDomain, vbUnicode), StrConv(sUserName, vbUnicode), StrConv(sPassword, vbUnicode), StrConv(sPassword, vbUnicode))
 
    'Test return value.
    Select Case lReturn
    Case 0, NERR_PasswordCantChange, NERR_PasswordHistConflict, NERR_PasswordTooShort, NERR_PasswordTooRecent
        UserValidate = True
    Case Else
        UserValidate = False
    End Select
End Function
 
 
'Purpose   :    Checks if a the NT password for a user is correct.
'Inputs    :    UserName                The username
'               Password                The password
'               [Domain]                If DOMAIN is omitted uses the local account database.
'Outputs   :    Returns True if the password and user name are valid.
'Notes     :    Windows NT and 2000 ONLY. Requires correct permissions to run (must have
'               the SE_TCB_NAME privilege. In User Manager, this is the "Act as part of the
'               Operating System" right).
 
Function UserCheckPassword(ByVal UserName As String, ByVal Password As String, Optional ByVal Domain As String = vbNullString) As Boolean
    Dim lRet As Long, hToken As Long
 
    Const LOGON32_LOGON_NETWORK = 3&            'Intended for high performance servers to authenticate clear text passwords
    Const LOGON32_LOGON_INTERACTIVE = 2&        'Intended for users who will be interactively using the machine, such as a user being logged on by a terminal server
    Const LOGON32_LOGON_BATCH = 4&
 
    Const LOGON32_PROVIDER_DEFAULT = 0&         'Use the standard logon provider for the system
    Const LOGON32_PROVIDER_WINNT40 = 2&         'Use the Windows NT 4.0 logon provider
    Const LOGON32_PROVIDER_WINNT35 = 1&         'Use the Windows NT 3.5 logon provider
    Const LOGON32_PROVIDER_WINNT50 = 3&         'Use the Windows 2000 logon provider.
 
    'Check the username and password
    lRet = LogonUser(UserName, Domain, Password, LOGON32_LOGON_NETWORK, LOGON32_PROVIDER_DEFAULT, hToken)
 
    If lRet Then
        'Password correct
        UserCheckPassword = True
        CloseHandle hToken
    Else
        'Failed:
        Debug.Print "Error: " & DLLErrorText(Err.LastDllError)
    End If
End Function
 
 
'Purpose     :  Return the error message associated with LastDLLError
'Inputs      :  lLastDLLError               The error number of the last DLL error (from Err.LastDllError)
'Outputs     :  Returns the error message associated with the DLL error number
'Notes       :
'Revisions   :
 
Public Function DLLErrorText(ByVal lLastDLLError As Long) As String
    Dim sBuff As String * 256
    Dim lCount As Long
    Const FORMAT_MESSAGE_ALLOCATE_BUFFER = &H100, FORMAT_MESSAGE_ARGUMENT_ARRAY = &H2000
    Const FORMAT_MESSAGE_FROM_HMODULE = &H800, FORMAT_MESSAGE_FROM_STRING = &H400
    Const FORMAT_MESSAGE_FROM_SYSTEM = &H1000, FORMAT_MESSAGE_IGNORE_INSERTS = &H200
    Const FORMAT_MESSAGE_MAX_WIDTH_MASK = &HFF
 
    lCount = FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM Or FORMAT_MESSAGE_IGNORE_INSERTS, 0, lLastDLLError, 0&, sBuff, Len(sBuff), ByVal 0)
    If lCount Then
        DLLErrorText = Left$(sBuff, lCount - 2)    'Remove line feeds
    End If
 
End Function
 
Sub TestLogin()
    'Check if password is valid
    Debug.Print "Password valid, method 1: " & UserCheckPassword("rcurran", InputBox("Password"))
    Debug.Print "Password valid method 2: " & UserValidate("rcurran", InputBox("Password"))
    'Debug.Print "Password valid, method 1: " & UserCheckPassword(Environ$("USERNAME"), "password")
    'Debug.Print "Password valid method 2: " & UserValidate(Environ$("USERNAME"), "password")
End Sub
 
Function bConfirmCreateLogin(psUser As String, psPassword As String, Optional psDomain As String) As Boolean
    On Error GoTo R_Err
    Dim sSQL As String
    bConfirmCreateLogin = False
    If UserValidate(psUser, psPassword, psDomain) = True Then
        'Confirm User Created
        If DCount("UserID", "tblUser", "UserName=""" & Nz(psUser, "") & """ ") = 0 Then
            sSQL = "INSERT INTO tblUser (UserName, FullName) SELECT """ & Nz(psUser, "") & """,""" & UCase(Nz(psUser, "")) & """ "
            DoCmd.SetWarnings False
            DoCmd.RunSQL (sSQL)
        End If
        bConfirmCreateLogin = True
    End If
R_Err:
    On Error Resume Next
    DoCmd.SetWarnings True
    Exit Function
R_Exit:
    bConfirmCreateLogin = False
    Resume R_Err
End Function
Else: MsgBox "YOU ARE NOT AUTHORIZED"
End If