Změna hesla ve Windows NT |
||||||||||||||||||||||
![]() |
||||||||||||||||||||||
Postup:
Pro TextBoxy nastavte PasswordChar na "*". nyní zapište následující kód: Option Explicit Const FORMAT_MESSAGE_FROM_HMODULE = &H800 Const FORMAT_MESSAGE_FROM_SYSTEM = &H1000 Const NERR_BASE = 2100 Const MAX_NERR = NERR_BASE + 899 Const LOAD_LIBRARY_AS_DATAFILE = &H2 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 NetApiBufferFree& Lib "netapi32" _ (ByVal Buffer As Long) Private Declare Sub lstrcpyW Lib "kernel32" _ (dest As Any, ByVal src As Any) 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 Private Declare Function NetUserSetInfo Lib "netapi32.dll" _ (ByVal ServerName As String, ByVal Username As String, _ ByVal Level As Long, UserInfo As Any, ParmError As Long) As Long Private Declare Function NetGetDCName Lib "netapi32.dll" ( _ ServerName As Long, domainname As Byte, bufptr As Long) As Long 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 Private Type USER_INFO_1003 usri1003_password As Long End Type Private Sub cmdClose_Click() Unload Me End Sub Private Sub cmdOK_Click() Dim sServer As String, sUser As String Dim sNewPass As String, sOldPass As String Dim UI1003 As USER_INFO_1003 Dim dwLevel As Long Dim lRet As String Dim sNew As String MousePointer = vbHourglass sUser = StrConv(txtUser, vbUnicode) sNewPass = StrConv(txtNew, vbUnicode) If Left(txtMachine, 2) = "\\" Then sServer = StrConv(txtMachine, vbUnicode) Else sServer = StrConv(GetPrimaryDCName(txtMachine), vbUnicode) End If If txtOld = "" Then dwLevel = 1003 sNew = txtNew UI1003.usri1003_password = StrPtr(sNew) lRet = NetUserSetInfo(sServer, sUser, dwLevel, UI1003, 0&) Else sOldPass = StrConv(txtOld, vbUnicode) lRet = NetUserChangePassword(sServer, sUser, sOldPass, sNewPass) End If MousePointer = vbDefault If lRet <> 0 Then DisplayError lRet Else MsgBox "Změna hesla proběhla úspěšně." End If End Sub Private Sub DisplayError(ByVal lCode As Long) 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 (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 lRet = FormatMessage(lFlags, hModule, lCode, 0&, _ sRtrnCode, 256&, 0&) If lRet = 0 Then MsgBox "Chyba : " & Err.LastDllError End If If (hModule <> 0) Then FreeLibrary (hModule) End If sMsg = "Chyba: " & lCode & " - " & sRtrnCode MsgBox sMsg End Sub Public Function GetPrimaryDCName(ByVal DName As String) As String Dim DCName As String, DCNPtr As Long Dim DNArray() As Byte, DCNArray(100) As Byte Dim result As Long DNArray = DName & vbNullChar result = NetGetDCName(0&, DNArray(0), DCNPtr) If result <> 0 Then Msgbox "Chyba: " & result Exit Function End If lstrcpyW DCNArray(0), DCNPtr result = NetApiBufferFree(DCNPtr) DCName = DCNArray() GetPrimaryDCName = Left(DCName, InStr(DCName, Chr(0)) - 1) End Function |
||||||||||||||||||||||
![]() |
||||||||||||||||||||||
Autor: The Bozena |