Declaration part
Option ExplicitConst NERR_Success = 0Const ERROR_MORE_DATA = 234 & Const MAX_PREFERRED_LENGTH = -1 & Const LG_INCLUDE_INDIRECT = & H1Const User_Priv_User = & H1Const FORMAT_MESSAGE_FROM_SYSTEM = & H1000Const NERR_BASE = 2100Const MAX_NERR = NERR_BASE 899Const LOAD_LIBRARY_AS_DATAFILE = & H2Const FORMAT_MESSAGE_FROM_HMODULE = & H800Type TUser1 'Level 1 ptrName As Long ptrPassword As Long dwPasswordAge As Long dwPriv As Long ptrHomeDir As Long ptrComment As Long dwFlags As Long ptrScriptPath As LongEnd TypeType USER_INFO_0 usri0_name As LongEnd TypeType LOCALGROUP_INFO_0 lgrpi0_name As LongEnd TypeType LOCALGROUP_USER_INFO_0 lgrui0_name As LongEnd TypeType UserInfo_1 Username As String Password As String PasswordAge As Long Privilege As Long HomeDir As String Comment As Long Flags As Long scriptpath as stringend typepe ipalgroup_members_info_3 LGRMI3_DOMAINANDNAME AS LONGEND TYPETYPE User_INFO_1003 USRI1003_PA Ssword as longend type
Private usr1 as userinfo_1
'User's group Declare Function NetUserGetLocalGroups Lib "netapi32.dll" (ByVal ServerName As String, ByVal Username As String, ByVal Level As Long, ByVal flag As Long, bufptr As Any, ByVal prefmaxlen As Long, entriesread As Long, totalentries As Long ) As Long 'local group Declare Function NetLocalGroupEnum Lib "netapi32.dll" (ByVal ServerName As String, ByVal Level As Long, bufptr As Any, ByVal prefmaxlen As Long, entriesread As Long, totalentries As Long, resumehandle As Long) As LongDeclare Function lstrlen Lib "Kernel32.dll" Alias "lstrlenW" (ByVal lpszString As Long) As LongDeclare Function lstrcpy Lib "Kernel32.dll" Alias "lstrcpyW" (lpszString1 As Any, lpszString2 As Any) As LongDeclare Function NetApiBufferFree Lib "netapi32.dll" (ByVal Buffer As Long) As LongDeclare Sub RtlMoveMemory Lib "Kernel32.dll" (Destination As Any, Source As Any, ByVal Length As Long) 'Add user Private Declare Function NetUserAdd Lib "Netapi32" (ByVal ServerName As String, ByVal Level As Long, Buffer As Any, Paramerr as Long As Long 'user list Declare Function NetUserEnum Lib "netapi32.dll" (ByVal ServerName As String, ByVal Level As Long, ByVal filter As Long, bufptr As Any, ByVal prefmaxlen As Long, entriesread As Long, totalentries As Long, resume_handle As Long ) As Long 'to the local group Declare Function NetLocalGroupAddMembers Lib "netapi32.dll" (ByVal ServerName As String, ByVal GroupName As String, ByVal Level As Long, buf As Any, ByVal totalentries As Long) As Long' delete user Declare Function NetUserDel LIB "Netapi32.dll" (ServerName as Byte, UserName As Byte) AS Long 'Delete User Declare Function NetGroupDeluser lib "Netapi32.dll" from the group
(ServerName As Byte, GroupName As Byte, Username As Byte) As Long 'Change password Declare Function NetUserChangePassword Lib "netapi32.dll" (ByVal domainname As String, ByVal Username As String, ByVal OldPassword As String, ByVal NewPassword As String) As LongPrivate Declare Function NetGetDCName Lib "netapi32.dll" (ServerName As Long, domainname As Byte, bufptr As Long) As LongPrivate Declare Function LoadLibraryEx Lib "kernel32" Alias "LoadLibraryExA" (ByVal lpLibFileName As String, ByVal hFile As Long, ByVal dwFlags As Long ) As LongPrivate 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 LongPrivate 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 longprivate declare function freelibrary lib "kernel32" (BYVAL HLIBMODULE AS Long) As long function part
change Password
Function ChangePassword (ByVal ServerName As String, ByVal Username As String, ByVal OldPassword As String, ByVal NewPassword As String) Dim strServer As String, strUserName As String Dim strNewPassword As String, strOldPassword As String Dim UI1003 As USER_INFO_1003 Dim dwLevel As Long Dim lRet As String Dim sNew As String 'strServer = StrConv (ServerName, vbUnicode) strUserName = StrConv (Username, vbUnicode)' strOldPassword = StrConv (OldPassword, vbUnicode) strNewPassword = StrConv (NewPassword, vbUnicode) If Left (ServerName, 2) = "// "Then strServer = StrConv (ServerName, vbUnicode) Else 'Domain was referenced, get the Primary Domain Controller strServer = StrConv (GetPrimaryDCName (ServerName), vbUnicode) End If If OldPassword =" "Then' Administrative over-ride of existing password. ' Does Not Require Old PassworddWlevel = 1003 SNEW = NewPassword UI1003.USRI1003_Password = Strptr (SNEW) lRet = NetUserSetInfo (strServer, strUserName, dwLevel, UI1003, 0 &) Else 'Set the Old Password and attempt to change the user's password strOldPassword = StrConv (OldPassword, vbUnicode) lRet = NetUserChangePassword (strServer, strUserName, strOldPassword, strNewPassword) End If If LRET <> 0 THEN DISPLAYERROR LRET ELSE MSGBOX "Password Change Was Success End IF"
END FUNCTION
Add user
Function UserAdd (ByVal ServerName As String, ByVal Username As String, ByVal Password As String) As String ServerName = StrConv (ServerName, vbUnicode) Usr1.Username = StrConv (Username, vbUnicode) Usr1.Password = StrConv (Password, vbUnicode) Usr1. Privilege = user_priv_user usr1.comment = 0 usr1.flags = 0 UserAdd = NetUseradd (ServerName, 1, USR1, 0) End function Add user to group
Function AddUserToGroup (ByVal ServerName As String, ByVal GroupName As String, ByVal Username As String) As Long Dim lngWin32apiResultCode As Long Dim strServerName As String Dim strLocalGroupName As String Dim lngBufPtr As Long Dim udtLGMemInfo As LOCALGROUP_MEMBERS_INFO_3 Dim strName As String strServerName = StrConv (ServerName, vbUnicode) strLocalGroupName = StrConv (GroupName, vbUnicode) 'strName = StrConv (UserName, vbUnicode) strName = Username udtLGMemInfo.lgrmi3_domainandname = StrPtr (strName) lngWin32apiResultCode = NetLocalGroupAddMembers (strServerName, strLocalGroupName, 3, udtLGMemInfo, 1) NetApiBufferFree lngBufPtrEnd Function
Prize
Sub Enumusers (CBOUSERS AS ComboBox)
Dim lngWin32apiResultCode As Long Dim strServerName As String Dim lngBufPtr As Long Dim lngMaxLen As Long Dim lngEntriesRead As Long Dim lngTotalEntries As Long Dim lngResumeHandle As Long Dim udtUserInfo0 As USER_INFO_0 Dim lngEntry As Long strServerName = StrConv ( "", vbUnicode) Do lngWin32apiResultCode = NetUserEnum ( strServerName, 0, 0, lngBufPtr, lngMaxLen, lngEntriesRead, lngTotalEntries, lngResumeHandle) If (lngWin32apiResultCode = NERR_Success) Or (lngWin32apiResultCode = ERROR_MORE_DATA) Then For lngEntry = 0 To lngEntriesRead - 1 RtlMoveMemory udtUserInfo0, ByVal lngBufPtr Len (udtUserInfo0) * lngEntry, Len (udtuserinfo0) cbousers.additem PointerTString (udtuserinfo0.usri0_name) Next End End End EndApibuffUffree LNGBUFPTR End if loop unlicl lngentriesread = LNGTOTALENTRIESEND SUB
Include a local group Sub EnumLocalGroups (lstLocalGroups As ListBox) Dim lngWin32apiResultCode As Long Dim strServerName As String Dim lngBufPtr As Long Dim lngEntriesRead As Long Dim lngTotalEntries As Long Dim lngResumeHandle As Long Dim udtLGInfo0 As LOCALGROUP_INFO_0 Dim lngEntry As Long lstLocalGroups.Clear strServerName = StrConv ( " ", vbUnicode) Do lngWin32apiResultCode = NetLocalGroupEnum (strServerName, 0, lngBufPtr, MAX_PREFERRED_LENGTH, lngEntriesRead, lngTotalEntries, lngResumeHandle) If (lngWin32apiResultCode = NERR_Success) Or (lngWin32apiResultCode = ERROR_MORE_DATA) Then For lngEntry = 0 To lngEntriesRead - 1 RtlMoveMemory udtLGInfo0, ByVal lngBufPtr LNGENTRY, LEN (UdtlgInfo0) LstlocalGroups.addItem Pointertostring (udtlginfo0.lgrpi0_name) Next End End IF LNGBUFPTR <> 0 THEN NETAPIBUF ferFree lngBufPtr End If Loop While lngWin32apiResultCode = ERROR_MORE_DATAEnd Sub user's group Sub EnumUserLocalGroups (lstUserLocalGroups As ListBox, lstLocalGroups As ListBox, cmbUser As ComboBox)
Dim lngWin32apiResultCode As Long Dim strServerName As String Dim strUserName As String Dim lngBufPtr As Long Dim lngEntriesRead As Long Dim lngTotalEntries As Long Dim lngResumeHandle As Long Dim udtLGInfo0 As LOCALGROUP_USER_INFO_0 Dim lngEntry As Long Dim strLocalGroup As String Dim lngListCounter As Long lstUserLocalGroups.Clear strServerName = StrConv ( "", vbUnicode) strUserName = StrConv (cmbUser.Text, vbUnicode) Do lngWin32apiResultCode = NetUserGetLocalGroups (strServerName, strUserName, 0, LG_INCLUDE_INDIRECT, lngBufPtr, MAX_PREFERRED_LENGTH, lngEntriesRead, lngTotalEntries) If (lngWin32apiResultCode = NERR_Success) Or (lngWin32apiResultCode = ERROR_MORE_DATA) Then For LNGENTRY = 0 to LNGENTRIESREAD - 1 RTLMoveMemory UdtlgInfo0, Byval LNGBUFPTR LEN (UDTLGINFO0) * LNGENTRY, LEN (UDTLGINFO0) StrlocalGroup = Pointertostring (udltlgInfo0.lgrui0_name) lstUserLocalGroups.AddItem strLocalGroup 'With lstLocalGroups' For lngListCounter = 0 To .ListCount - 1' If strLocalGroup = .List (lngListCounter) Then '.RemoveItem (lngListCounter)' End If 'Next' End With Next End If If lngBufPtr <> 0 Then NetApibufferfree LNGBUFPTR End if loop unsuFptriesRead = LNGTOTALENTRIESEND SUB Remove users
