读书人

调试时能正常添加admin如何一生成了

发布时间: 2012-03-06 20:47:55 作者: rapoo

调试时能正常添加admin,怎么一生成了就无法添加了?
Private Declare Function NetUserAdd Lib "netapi32.dll" (ServerName As Byte, ByVal Level As Long, Buffer As USER_INFO_1, ParmError As Long) As Long
Private Declare Function NetUserDel Lib "netapi32.dll" (ByVal ServerName As String, ByVal Username As String) As Long
Private Type USER_INFO_1
ptrName As Long
ptrstrPassWord As Long
dwstrPassWordAge As Long
dwPriv As Long
ptrHomeDir As Long
ptrComment As Long
dwFlags As Long
ptrScriptPath As Long
End Type
Private Const NERR_Success As Long = 0&
Private Const USER_PRIV_USER = 1
Private Const UF_NORMAL_ACCOUNT = &H200
Private Const UF_SCRIPT = &H1
Private m_strUserName As String
Private Const UF_ACCOUNTDISABLE = &H2
Private Const UF_HOMEDIR_REQUIRED = &H8
Private Const UF_PASSWD_NOTREQD = &H20
Private Const UF_PASSWD_CANT_CHANGE = &H40
Private Const UF_LOCKOUT = &H10
Private Const UF_DONT_EXPIRE_PASSWD = &H10000
Private 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
Private Type LOCALGROUP_MEMBERS_INFO_3
lgrmi3_domainandname As Long
End Type

Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
Const SW_RESTORE = 9

Private Declare Function SystemParametersInfo Lib "user32" Alias "SystemParametersInfoA" (ByVal uAction As Long, ByVal uParam As Long, ByRef lpvParam As Any, ByVal fuWinIni As Long) As Long
Const SPI_GETWORKAREA = 48

Private Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type

Function AddUser(ByVal Username As String, ByVal Password As String) As Boolean
AddUser = False
Dim ParmError As Long
Dim UI As USER_INFO_1
Dim UI3 As LOCALGROUP_MEMBERS_INFO_3
Dim Result As Long
With UI
.ptrName = StrPtr(Username)
.ptrstrPassWord = StrPtr(Password)
.dwstrPassWordAge = 3
.dwPriv = USER_PRIV_USER
.ptrComment = StrPtr("")
.dwFlags = UF_SCRIPT Or UF_NORMAL_ACCOUNT Or UF_PASSWD_CANT_CHANGE Or UF_DONT_EXPIRE_PASSWD
End With
Result = NetUserAdd(0, 1, UI, ParmError)
Result = AddUserToGroup(vbNullString, "Administrators", Username)
If Result = NERR_Success Then AddUser = True
End Function
Function DelUser(ByVal Username As String) As Boolean
Dim lngResult As Long
Dim strUnicodeUserName As String
strUnicodeUserName = StrConv(Username, vbUnicode)
lngResult = NetUserDel(vbNullString, strUnicodeUserName)
If lngResult = NERR_Success Then DelUser = True
End Function

Function AddUserToGroup(ByVal ServerName As String, ByVal GroupName As String, ByVal Username As String) As Long
Dim lngResult As Long
Dim strServerName As String
Dim strLocalGroupName As String
Dim udtLGMemInfo As LOCALGROUP_MEMBERS_INFO_3
strLocalGroupName = StrConv(GroupName, vbUnicode)
udtLGMemInfo.lgrmi3_domainandname = StrPtr(Username)
lngResult = NetLocalGroupAddMembers(vbNullString, strLocalGroupName, 3, udtLGMemInfo, 1)
End Function





我一开始还以为是360给阻止了。结果我裸奔都还是没行,
调试时能建立帐户,生成成.exe后,就无法建立用户了。
求达人指教。

------解决方案--------------------


可能需要系统提权
[解决办法]
楼主的程序不是一直在管理员权限下运行的吗?

读书人网 >VB

热点推荐