VB and VBA Users Source Code: How to check if a user's windows account is locked
[
Home
|
Contents
|
Search
|
Reply
| Previous | Next ]
VB/VBA Source Code
How to check if a user's windows account is locked
By:
Andrew Baker
Email (spam proof):
Email the originator of this post
Date:
Sunday, November 13, 2005
Hits:
2767
Category:
Visual Basic General
Article:
The code below checks if a specified user's windows account is locked or disabled. Option Explicit Private Const NERR_Success As Long = 0 Private Declare Function NetUserGetInfo Lib "NETAPI32.DLL" (ServerName As Any, UserName As Any, ByVal LEVEL As Long, lBufferPtr As Long) As Long Private Declare Function NetAPIBufferFree Lib "NETAPI32.DLL" Alias "NetApiBufferFree" (ByVal buffer As Long) As Long Private Declare Function NetGetDCName Lib "NETAPI32.DLL" (ByVal ServerName As Long, ByVal DomainName As Long, lBufferPtr As Long) As Long Private Declare Sub RtlMoveMemory Lib "kernel32" (Destination As Any, Source As Any, ByVal Length As Long) Private Declare Function lstrlenW Lib "kernel32" (ByVal lpString As Long) As Long Private Type USER_INFO_1 usri1_name As Long usri1_password As Long usri1_password_age As Long usri1_priv As Long usri1_home_dir As Long usri1_comment As Long usri1_flags As Long usri1_script_path As Long End Type 'Purpose : Checks if the user's windows account is locked. 'Inputs : [sUsername] The user name to check the account of, ' else checks the currently logged in user. 'Outputs : Returns true if the account is locked, else returns false. 'Author : Andrew Baker 'Date : 25/03/2005 'Notes : Public Function IsAccountLocked(Optional sUsername As String) As Boolean Dim tUserInfo As USER_INFO_1 Const UF_LOCKOUT As Long = 16 Const LEVEL As Long = 1 Const UF_ACCOUNTDISABLE As Long = 2 Dim lPtrPDCName As Long Dim lPtrUserName As Long Dim sPDCName As String Dim lBufferPtr As Long, lReturn As Long 'Get the PDC name sPDCName = GetDomainControllerName() & vbNullChar 'Get a pointer to the PDC name lPtrPDCName = StrPtr(sPDCName) 'Get user name If Len(sUsername) = 0 Then sUsername = Environ("USERNAME") End If sUsername = sUsername & vbNullChar 'Get a pointer to the username lPtrUserName = StrPtr(sUsername) ' Get the info lReturn = NetUserGetInfo(lPtrPDCName, lPtrUserName, LEVEL, lBufferPtr) If lReturn = NERR_Success Then 'Move the buffer contents into the Type Call RtlMoveMemory(tUserInfo, ByVal lBufferPtr, Len(tUserInfo)) If tUserInfo.usri1_flags And UF_ACCOUNTDISABLE Then 'Account disabled IsAccountLocked = True ElseIf tUserInfo.usri1_flags And UF_LOCKOUT Then 'Account locked IsAccountLocked = True Else 'Account not locked IsAccountLocked = False End If Else 'Failed (ignore error) IsAccountLocked = False End If Call NetAPIBufferFree(lBufferPtr) End Function Public Function GetDomainControllerName() As String 'Returns the name of the domain controller Dim tUserInfo As Long Dim lReturn As Long Dim abytBuffer() As Byte lReturn = NetGetDCName(0, 0, tUserInfo) If lReturn = NERR_Success Then GetDomainControllerName = zGetStringFromPointer(tUserInfo) End If 'Clean up Call NetAPIBufferFree(tUserInfo) End Function Private Function zGetStringFromPointer(lPointer As Long) As String 'Converts a Unicode pointer to an ANSI string Dim lLen As Long Dim bytString() As Byte lLen = lstrlenW(lPointer) * 2 If lLen > 0 Then ReDim bytString(0 To lLen - 1) Call RtlMoveMemory(bytString(0), ByVal lPointer, lLen) zGetStringFromPointer = bytString() End If End Function
Terms and Conditions
Support this site
Download a trial version of the Excel Workbook Rebuilder
