分享
 
 
 

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

王朝vb·作者佚名  2006-01-09
窄屏简体版  字體: |||超大  

声明部分

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, ByVal Level As Long, bufptr As Any, ByVal prefmaxlen As Long, entriesread As Long, 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, ByVal Level As Long, Buffer As Any, ParamErr As Long) As Long

'用户列表

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

'添加到本地组

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

'删除用户

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 Username 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, ByVal Username As String, ByVal Level As Long, 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 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 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, strUserName, 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 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

添加用户到组

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 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, 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 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, 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 + 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, 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(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

 
 
 
免责声明:本文为网络用户发布,其观点仅代表作者个人观点,与本站无关,本站仅提供信息存储服务。文中陈述内容未经本站证实,其真实性、完整性、及时性本站不作任何保证或承诺,请读者仅作参考,并请自行核实相关内容。
2023年上半年GDP全球前十五强
 百态   2023-10-24
美众议院议长启动对拜登的弹劾调查
 百态   2023-09-13
上海、济南、武汉等多地出现不明坠落物
 探索   2023-09-06
印度或要将国名改为“巴拉特”
 百态   2023-09-06
男子为女友送行,买票不登机被捕
 百态   2023-08-20
手机地震预警功能怎么开?
 干货   2023-08-06
女子4年卖2套房花700多万做美容:不但没变美脸,面部还出现变形
 百态   2023-08-04
住户一楼被水淹 还冲来8头猪
 百态   2023-07-31
女子体内爬出大量瓜子状活虫
 百态   2023-07-25
地球连续35年收到神秘规律性信号,网友:不要回答!
 探索   2023-07-21
全球镓价格本周大涨27%
 探索   2023-07-09
钱都流向了那些不缺钱的人,苦都留给了能吃苦的人
 探索   2023-07-02
倩女手游刀客魅者强控制(强混乱强眩晕强睡眠)和对应控制抗性的关系
 百态   2020-08-20
美国5月9日最新疫情:美国确诊人数突破131万
 百态   2020-05-09
荷兰政府宣布将集体辞职
 干货   2020-04-30
倩女幽魂手游师徒任务情义春秋猜成语答案逍遥观:鹏程万里
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案神机营:射石饮羽
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案昆仑山:拔刀相助
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案天工阁:鬼斧神工
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案丝路古道:单枪匹马
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案镇郊荒野:与虎谋皮
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案镇郊荒野:李代桃僵
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案镇郊荒野:指鹿为马
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案金陵:小鸟依人
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案金陵:千金买邻
 干货   2019-11-12
 
推荐阅读
 
 
 
>>返回首頁<<
 
靜靜地坐在廢墟上,四周的荒凉一望無際,忽然覺得,淒涼也很美
© 2005- 王朝網路 版權所有