用VB写的一个组件，实现添加系统用户，并添加到指定组

Option Explicit Const NERR_Success = 0 Const ERROR_MORE_DATA = 234& Const MAX_PREFERRED_LENGTH = -1& Const LG_INCLUDE_INDIRECT = &H1 Const User_Priv_User = &H1 Const FORMAT_MESSAGE_FROM_SYSTEM = &H1000 Const NERR_BASE = 2100 Const MAX_NERR = NERR_BASE + 899 Const LOAD_LIBRARY_AS_DATAFILE = &H2 Const FORMAT_MESSAGE_FROM_HMODULE = &H800 Type 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 Long End Type Type USER_INFO_0 usri0_name As Long End Type Type LOCALGROUP_INFO_0 lgrpi0_name As Long End Type Type LOCALGROUP_USER_INFO_0 lgrui0_name As Long End Type Type 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 String End Type Type LOCALGROUP_MEMBERS_INFO_3 lgrmi3_domainandname As Long End Type Type USER_INFO_1003 usri1003_password As Long End Type Private Usr1 As UserInfo_1 ’用户所在组 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 ’本地组 Declare Function NetLocalGroupEnum Lib "netapi32.dll" (ByVal ServerName As String,totalentries As Long,resumehandle As Long) As Long Declare Function lstrlen Lib "Kernel32.dll" Alias "lstrlenW" (ByVal lpszString As Long) As Long Declare Function lstrcpy Lib "Kernel32.dll" Alias "lstrcpyW" (lpszString1 As Any,lpszString2 As Any) As Long Declare Function NetApiBufferFree Lib "netapi32.dll" (ByVal Buffer As Long) As Long Declare Sub RtlMoveMemory Lib "Kernel32.dll" (Destination As Any,Source As Any,ByVal Length As Long) ’添加用户 Private Declare Function NetUserAdd Lib "Netapi32" (ByVal ServerName As String,Buffer As Any,ParamErr As Long) As Long ’用户列表 Declare Function NetUserEnum Lib "netapi32.dll" (ByVal ServerName As String,ByVal filter As Long,resume_handle As Long) As Long ’添加到本地组 Declare Function NetLocalGroupAddMembers Lib "netapi32.dll" (ByVal ServerName As String,ByVal GroupName As String,buf As Any,ByVal totalentries As Long) As Long ’删除用户 Declare Function NetUserDel Lib "netapi32.dll" (ServerName As Byte,Username As Byte) As Long ’从组中删除用户 Declare Function NetGroupDelUser Lib "netapi32.dll" (ServerName As Byte,GroupName As Byte,Username As Byte) As Long ’修改密码 Declare Function NetUserChangePassword Lib "netapi32.dll" (ByVal domainname As String,ByVal OldPassword As String,ByVal NewPassword As String) As Long Private Declare Function NetGetDCName Lib "netapi32.dll" (ServerName As Long,domainname As Byte,bufptr As Long) As Long 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 NetUserSetInfo Lib "netapi32.dll" (ByVal ServerName As String,UserInfo As Any,ParmError As Long) 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 FreeLibrary Lib "kernel32" (ByVal hLibModule As Long) As Long 函数部分 修改密码 Function ChangePassword(ByVal ServerName 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 password dwLevel = 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,strOldPassword,strNewPassword) End If If lRet <> 0 Then DisplayError lRet Else MsgBox "Password Change was Successful" End If End Function 添加用户 Function UserAdd(ByVal ServerName 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 添加用户到组 Function AddUserToGroup(ByVal ServerName 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 lngBufPtr End Function 列举用户 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,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 PointerToString(udtUserInfo0.usri0_name) Next End If If lngBufPtr <> 0 Then NetApiBufferFree lngBufPtr End If Loop Until lngEntriesRead = lngTotalEntries End Sub 列举本地组 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,MAX_PREFERRED_LENGTH,lngResumeHandle) 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) lstLocalGroups.AddItem PointerToString(udtLGInfo0.lgrpi0_name) Next End If If lngBufPtr <> 0 Then NetApiBufferFree lngBufPtr End If Loop While lngWin32apiResultCode = ERROR_MORE_DATA End Sub 用户所在组 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,LG_INCLUDE_INDIRECT,lngTotalEntries) If (lngWin32apiResultCode = NERR_Success) Or (lngWin32apiResultCode = ERROR_MORE_DATA) Then For lngEntry = 0 To lngEntriesRead - 1 RtlMoveMemory udtLGInfo0,Len(udtLGInfo0) strLocalGroup = PointerToString(udtLGInfo0.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 Until lngEntriesRead = lngTotalEntries End Sub 删除用户 Function DelUser(ByVal SName As String,ByVal UName As String) As Long Dim UNArray() As Byte,SNArray() As Byte UNArray = UName & vbNullChar SNArray = SName & vbNullChar DelUser = NetUserDel(SNArray(0),UNArray(0)) End Function

（编辑：李大同）

【声明】本站内容均来自网络，其相关言论仅代表作者个人观点，不代表本站立场。若无意侵犯到您的权利，请及时与联系站长删除相关内容!