首页 诗词 字典 板报 句子 名言 友答 励志 学校 网站地图
当前位置: 首页 > 教程频道 > 开发语言 > VB >

调试时能正常添加admin,如何一生成了就无法添加了

2012-03-06 
调试时能正常添加admin,怎么一生成了就无法添加了?Private Declare Function NetUserAdd Lib netapi32.dl

调试时能正常添加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后,就无法建立用户了。
求达人指教。

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


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

热点排行