VB and VBA Users Source Code: Changing a login password
[
Home
|
Contents
|
Search
|
Reply
| Previous | Next ]
VB/VBA Source Code
Changing a login password
By:
Andrew Baker
Email (spam proof):
Email the originator of this post
Date:
Friday, March 02, 2001
Hits:
871
Category:
Networks
Article:
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. 'Author : Andrew Baker 'Date : 14/01/2001 12:20 '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
Terms and Conditions
Support this site
Download a trial version of the Excel Workbook Rebuilder
