Visual Basic Programming Code Examples Visual Basic > API and Miscellaneous Code Examples To change a login password use the following routines To change a login password use the following routines Option Explicit 'Error message API Private Declare Function LoadLibraryEx Lib "kernel32" Alias "LoadLibraryExA" (ByVal lpLibFileName As String, ByVal hFile As Long, ByVal dwFlags As Long) As Long Private Declare Function FreeLibrary Lib "kernel32" (ByVal hLibModule As Long) As Long Private Declare Function FormatMessage Lib "kernel32" Alias "FormatMessageA" (ByVal dwFlags As Long, ByVal lpSource As Long, ByVal dwMessageId As Long, ByVal dwLanguageId As Long, ByVal lpBuffer As String, ByVal nSize As Long, Arguments As Any) As Long 'Network Details API Private Declare Function WNetGetUser Lib "mpr.dll" Alias "WNetGetUserA" (ByVal lpName As String, ByVal lpUserName As String, lpnLength As Long) As Long 'Password API Private Declare Function NetUserChangePassword Lib "netapi32.dll" (ByVal domainname As String, ByVal Username As String, ByVal OldPassword As String, ByVal NewPassword As String) As Long 'Purpose : Changes a users password 'Inputs : sOldPassword The old login password. ' sNewPassword The new login password. 'Outputs : Returns an empty string on success, ' else returns an error description. 'Notes : NT/2000 Only 'Revisions : Function UserChangePassword(ByVal sOldPassword As String, ByVal sNewPassword As String) As String Dim sUsername As String, sTempsUsername As String * 512 Dim sDomainControllerName As String Dim lErrorNumber As Long 'Get the user domain name sDomainControllerName = Environ$("USERDOMAIN") If Len(sDomainControllerName) Then 'Get the Username. Note, Could use Environ("UserName") WNetGetUser vbNullString, sTempsUsername, Len(sTempsUsername) sUsername = Left$(sTempsUsername, (InStr(1, sTempsUsername, vbNullChar, vbBinaryCompare) - 1)) 'Convert to Unicode sUsername = StrConv(sUsername, vbUnicode) sOldPassword = StrConv(sOldPassword, vbUnicode) sNewPassword = StrConv(sNewPassword, vbUnicode) sDomainControllerName = StrConv(sDomainControllerName, vbUnicode) lErrorNumber = NetUserChangePassword(sDomainControllerName, sUsername, sOldPassword, sNewPassword) If lErrorNumber Then UserChangePassword = ErrorDescription(lErrorNumber) End If End If End Function 'Converts an error number to an error description Private Function ErrorDescription(ByVal lCode As Long) As String Const FORMAT_MESSAGE_FROM_HMODULE = &H800, FORMAT_MESSAGE_FROM_SYSTEM = &H1000 Const NERR_BASE = 2100, MAX_NERR = NERR_BASE + 899 Const LOAD_LIBRARY_AS_DATAFILE = &H2 Dim sMsg As String Dim sRtrnCode As String Dim lFlags As Long Dim hModule As Long Dim lRet As Long hModule = 0 sRtrnCode = Space$(256) lFlags = FORMAT_MESSAGE_FROM_SYSTEM 'If lRet is in the network range, load the message source If (lCode >= NERR_BASE And lCode <= MAX_NERR) Then hModule = LoadLibraryEx("netmsg.dll", 0&, LOAD_LIBRARY_AS_DATAFILE) If (hModule <> 0) Then lFlags = lFlags Or FORMAT_MESSAGE_FROM_HMODULE End If End If 'Call FormatMessage to allow for message text to be acquired 'from the system or the supplied module handle. lRet = FormatMessage(lFlags, hModule, lCode, 0&, sRtrnCode, 256&, 0&) If (hModule <> 0) Then 'Unloaded message source FreeLibrary hModule End If ErrorDescription = "ERROR: " & lCode & " - " & sRtrnCode 'Clean message lRet = InStr(1, ErrorDescription, vbNullChar) If lRet Then ErrorDescription = Left$(ErrorDescription, lRet - 1) End If lRet = InStr(1, ErrorDescription, vbNewLine) If lRet Then ErrorDescription = Left$(ErrorDescription, lRet - 1) End If End Function 'Demonstration routine Sub Test() Debug.Print UserChangePassword("ajb444", "ajb111") End Sub