Dim Username, UserPass
Dim oDomain, oUser
Username = "user1"
UserPass = "user1"
Set oDomain = GetObject("WinNT://yang")
Set oUser = oDomain.Create("user", Username)
If (Err.Number = 0) Then
oUser.SetInfo
oUser.SetPassword UserPass
oUser.SetInfo
Else
MsgBox "创建用户" & Username & "出错!"
End If
Set oUser = Nothing
Set oDomain = Nothing
End Sub
'初始化用户名,组名
Private Sub Form_Load()
Dim dso As IADsOpenDSObject
Dim container As IADsContainer
Set container = GetObject("WinNT://yang")
container.Filter = Array("User")
Dim user As IADsUser
For Each user In container
Combo1.AddItem user.Name
Next
container.Filter = Array("Group")
Dim group As IADsGroup
For Each group In container
Combo2.AddItem group.Name
Next
container.Filter = Array("Group")
For Each group In container
List2.AddItem group.Name
Next
End Sub
'得到指定用户所在的组
Private Sub Command1_Click()
Dim dso As IADsOpenDSObject
Dim user As IADsUser
Dim Username As String
Dim userdomain As String
Dim group As IADsGroup
Dim container As IADsContainer
Username = Combo1.Text
Set container = GetObject("WinNT://yang")
Set user = GetObject("WinNT://yang/" & Username & ",user")
For Each group In user.Groups
List1.AddItem group.Name
Next
End Sub
Option Explicit
Private Sub Form_Load()
If IsAdmin Then
MsgBox "Your an Administrator", vbInformation, Caption
Else
MsgBox "Keep Dreaming", vbInformation, Caption
End If
End Sub
'in a module
Option Explicit
Option Base 0 ' Important assumption for this code
Private Const ANYSIZE_ARRAY = 20 'Fixed at this size for comfort. Could be bigger or made dynamic.
Type SID_AND_ATTRIBUTES
Sid As Long
Attributes As Long
End Type
Type TOKEN_GROUPS
GroupCount As Long
Groups(ANYSIZE_ARRAY) As SID_AND_ATTRIBUTES
End Type
Type SID_IDENTIFIER_AUTHORITY
Value(0 To 5) As Byte
End Type
Declare Function GetCurrentProcess Lib "Kernel32" () As Long
Declare Function GetCurrentThread Lib "Kernel32" () As Long
Declare Function OpenProcessToken Lib "Advapi32" ( _
ByVal ProcessHandle As Long, ByVal DesiredAccess As Long, _
TokenHandle As Long) As Long
Declare Function OpenThreadToken Lib "Advapi32" ( _
ByVal ThreadHandle As Long, ByVal DesiredAccess As Long, _
ByVal OpenAsSelf As Long, TokenHandle As Long) As Long
Declare Function GetTokenInformation Lib "Advapi32" ( _
ByVal TokenHandle As Long, TokenInformationClass As Integer, _
TokenInformation As Any, ByVal TokenInformationLength As Long, _
ReturnLength As Long) As Long
Declare Function AllocateAndInitializeSid Lib "Advapi32" ( _
pIdentifierAuthority As SID_IDENTIFIER_AUTHORITY, _
ByVal nSubAuthorityCount As Byte, ByVal nSubAuthority0 As Long, _
ByVal nSubAuthority1 As Long, ByVal nSubAuthority2 As Long, _
ByVal nSubAuthority3 As Long, ByVal nSubAuthority4 As Long, _
ByVal nSubAuthority5 As Long, ByVal nSubAuthority6 As Long, _
ByVal nSubAuthority7 As Long, lpPSid As Long) As Long
Declare Function RtlMoveMemory Lib "Kernel32" ( _
Dest As Any, Source As Any, ByVal lSize As Long) As Long
Declare Function IsValidSid Lib "Advapi32" (ByVal pSid As Long) As Long
Declare Function EqualSid Lib "Advapi32" (pSid1 As Any, pSid2 As Any) As Long
Declare Sub FreeSid Lib "Advapi32" (pSid As Any)
Declare Function CloseHandle Lib "Kernel32" (ByVal hObject As Long) As Long
Public Function IsAdmin() As Boolean
Dim hProcessToken As Long
Dim BufferSize As Long
Dim psidAdmin As Long
Dim lResult As Long
Dim X As Integer
Dim tpTokens As TOKEN_GROUPS
Dim tpSidAuth As SID_IDENTIFIER_AUTHORITY
' Obtain current process token
If Not OpenThreadToken(GetCurrentThread(), TOKEN_QUERY, True, hProcessToken) Then
Call OpenProcessToken(GetCurrentProcess(), TOKEN_QUERY, hProcessToken)
End If
If hProcessToken Then
' Deternine the buffer size required
Call GetTokenInformation(hProcessToken, ByVal TokenGroups, 0, 0, BufferSize) ' Determine required buffer size
If BufferSize Then
ReDim InfoBuffer((BufferSize \ 4) - 1) As Long
' Retrieve your token information
lResult = GetTokenInformation(hProcessToken, ByVal TokenGroups, InfoBuffer(0), BufferSize, BufferSize)
If lResult <> 1 Then Exit Function
' Move it from memory into the token structure
Call RtlMoveMemory(tpTokens, InfoBuffer(0), Len(tpTokens))
' Retreive the admins sid pointer
lResult = AllocateAndInitializeSid(tpSidAuth, 2, SECURITY_BUILTIN_DOMAIN_RID, _
DOMAIN_ALIAS_RID_ADMINS, 0, 0, 0, 0, 0, 0, psidAdmin)
If lResult <> 1 Then Exit Function
If IsValidSid(psidAdmin) Then
For X = 0 To tpTokens.GroupCount
' Run through your token sid pointers
If IsValidSid(tpTokens.Groups(X).Sid) Then
' Test for a match between the admin sid equalling your sid's
If EqualSid(ByVal tpTokens.Groups(X).Sid, ByVal psidAdmin) Then
IsAdmin = True
Exit For
End If
End If
Next
End If
If psidAdmin Then Call FreeSid(psidAdmin)
End If
Call CloseHandle(hProcessToken)
End If
End Function