Visual Basic Programming Code Examples

Check if a loggin password and user name are correct Rather than having seperate passwords for each of your applications, it is useful to use the users loggin password. The following code demonstrates two techniques which demonstrate how to verify if the password is given is the same as the loggin password. The UserValidate is slower than the UserCheckPassword function, but will work with any permissions. 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. 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 'Demonstration routine Sub Test() 'Check if password is valid Debug.Print "Password valid, method 1: " & UserCheckPassword(Environ$("USERNAME"), "mypassword") Debug.Print "Password valid method 2: " & UserValidate(Environ$("USERNAME"), "mypassword") End Sub