How to get the AD groups a user is member of (ASP)
Hi all,
The following ASP sample shows how to get all Active Directory groups of the user accessing the ASP page.
Note: I know ASP is quite old and people should be using ASP.NET instead. But I'm posting this sample because translating it to VBScript is pretty straightforward, and I still have many customers using VBScript.
<%
' Get domain\user from client
'
Response.Write "<b>FROM CLIENT</b><br><br>"
sLogonUser = Request.ServerVariables("Logon_User")
sDomain = Mid(sLogonUser, 1, Instr(1, sLogonUser, "\") - 1)
sLogonName = Mid(sLogonUser, Instr(1, sLogonUser, "\") + 1)
Response.Write "<b>Logon User:</b><br>" & sDomain & "\" & sLogonName & "<br><br>"
' Create ADO connection to Active Directory
'
Set oConnection = CreateObject("ADODB.Connection")
With oConnection
.Provider = "ADsDSOObject"
.Mode = "1" 'Read
.Properties("Encrypt Password") = True
.Open "Active Directory Provider"
End With
' Create command to search user in Active Directory
'
Set oCommand = CreateObject("ADODB.Command")
oCommand.ActiveConnection = oConnection
' Build the ADsPath element of the CommandText
'
Set oRoot = GetObject("LDAP://" & sDomain & "/rootdse")
Set oDomain = GetObject("LDAP://" & sDomain & "/" & oRoot.Get("defaultNamingContext"))
sADsPath = "<" & oDomain.ADsPath & ">"
' Build the filter element of the CommandText
'
sFilter = "(&(objectCategory=Person)(objectClass=user)(sAMAccountName=" & sLogonName & "))"
' Build the returned attributes element of the CommandText
'
sAttribsToReturn = "distinguishedName,memberOf,primaryGroupID,objectSID"
' Build the depth element of the CommandText
'
sDepth = "subTree"
' Assemble the CommandText
'
ocommand.CommandText = sADsPath & ";" & sFilter & ";" & sAttribsToReturn & ";" & sDepth
' Execute the query
'
Set oRS = ocommand.Execute
' Only one user should meet the criteria
'
If (oRS.RecordCount = 1) Then
Response.Write "<br><b>FROM ACTIVE DIRECTORY</b><br><br>"
' Get that user's info
'
oRS.MoveFirst
For i = 0 To oRS.Fields.Count - 1
' distinguishedName
'
If (oRS.Fields(i).Name = "distinguishedName") Then
' adVarWChar
'
Response.Write "<b>distinguishedName:</b><br>"
Response.Write oRS.Fields(i).Value & "<br>"
' memberOf
'
ElseIf (oRS.Fields(i).Name = "memberOf") Then
' adVariant
'
Response.Write "<b>memberOf:</b><br>"
For Each value In oRS.Fields(i).Value
Response.Write value & ";<br>"
Next
' primaryGroupID
'
ElseIf (oRS.Fields(i).Name = "primaryGroupID") Then
' adInteger
'
Response.Write "<b>primaryGroupID:</b><br>"
iPrimaryGroupID = oRS.Fields(i).Value
Response.Write CStr(iPrimaryGroupID) & "<br>"
' objectSID
'
ElseIf (oRS.Fields(i).Name = "objectSID") Then
' adVarBinary
'
Response.Write "<b>objectSID (binary):</b><br>"
vObjectSID = oRS.Fields(i).Value
Response.write Get_HexString(vObjectSID) & "<br>"
Response.Write "<b>objectSID (SDDL):</b><br>"
sObjectSID = SDDL_SID(vObjectSID)
Response.write sObjectSID & "<br>"
End If
Next
' The primary group is not included in memberOf...
' We have the SDDL form of the user's SID.
' Remove the user's RID ( the last sub authority)
' up to the "-"
'
sDomainSID = Mid(sObjectSID, 1, (InStrREV(sObjectSID,"-")))
' Build the SID of the Primary group
' from the domainSID and the Primary Group RID in
' the PrimaryGroupID.
'
sGroupRID = StrRID(iPrimaryGroupID)
sDomainSID = sDomainSID & sGroupRID
' Get the primary group
'
set oPrimaryGroup = GetObject("LDAP://" & sDomain & "/<SID=" & sDomainSID & ">")
Response.Write "<b>primaryGroup:</b><br>" & oPrimaryGroup.Get("DistinguishedName") & "<br>"
End If
'==============================================================================
'HELPER FUNCTIONS
'==============================================================================
'------------------------------------------------------------------------------
' Function that does all the magic.
' Using the definition of a SID structure from
' WinNT.H
'
' The binary SID is converted to its SDDL counterpart
'
function SDDL_SID ( oSID )
dim IssueAuthorities(11)
IssueAuthorities(0) = "-0-0"
IssueAuthorities(1) = "-1-0"
IssueAuthorities(2) = "-2-0"
IssueAuthorities(3) = "-3-0"
IssueAuthorities(4) = "-4"
IssueAuthorities(5) = "-5"
IssueAuthorities(6) = "-?"
IssueAuthorities(7) = "-?"
IssueAuthorities(8) = "-?"
IssueAuthorities(9) = "-?"
' First byte is the revision value
'
Revision = ascb(midB(osid,1,1))
' Second byte is the number of sub authorities in the
' SID
'
SubAuthorities = CInt(ascb(midb(oSID,2,1)))
strSDDL = "S-" & Revision
IssueIndex = CInt(ascb(midb(oSID,8,1)))
' BYtes 2 - 8 are the issueing authority structure
' Currently these values are in the form:
' { 0, 0, 0, 0, 0, X}
'
' We use this fact to retreive byte number 8 as the index
' then look up the authorities for an array of values
'
strSDDL = strSDDL & IssueAuthorities(IssueIndex)
' The sub authorities start at byte number 9. The are 4 bytes long and
' the number of them is stored in the SubAuthorities variable.
'
index = 9
i = index
for k = 1 to SubAuthorities
' Very simple formula, the sub authorites are stored in the
' following order:
' Byte Index Starting Bit
' Byte 0 - Index 0
' Byte 1 - Index + 1 7
' Byte 2 - Index + 2 15
' Byte 3 - Index + 3 23
' Bytes0 - 4 make a DWORD value in whole. We need to shift the bits
' bits in each byte and sum them all together by multipling by powers of 2
' So the sub authority would be built by the following formula:
'
' SUbAuthority = byte0*2^0 + Byte1*2^8 + byte2*2^16 + byte3*2^24
'
' this be done using a simple short loop, initializing the power of two
' variable ( p2 ) to 0 before the start an incrementing by 8 on each byte
' and summing them all together.
'
p2 = 0
subtotal = 0
for j = 1 to 4
dblSubAuth = CDbl(ascb(midb(osid,i,1))) * (2^p2)
subTotal = subTotal + dblSubAuth
p2 = p2 + 8
i = i + 1
next
' Convert the value to a string, add it to the SDDL Sid and continue
'
strSDDL = strSDDL & "-" & cstr(subTotal)
next
SDDL_SID = strSDDL
end function
'------------------------------------------------------------------------------
'------------------------------------------------------------------------------
' Build an HexString SID
'
function Get_HexString( oSID )
outStr = ""
for i = 0 to Ubound(oSid)
b = hex(ascb(midb(oSid,i+1,1)))
if( len(b) = 1 ) then b = "0" & b
outStr = outStr & b
next
Get_HexString = outStr
end function
'------------------------------------------------------------------------------
'------------------------------------------------------------------------------
' Function StrRID returns and unsigned long of
' the given RID value
'
' If the most significant bit is set in a VB Long
' then VB will interpret the value as a negative number
' and CStr will convert the unsigned long into a string with a leading
' "-" sign.
'
' This function checks to see if the most significant bit
' is set, then tricks the CStr function into outputting
' and unsigned long value by using a double float value
' to store the RID value, then uses the CStr function to get the
' string version.
'
function StrRID( inVal )
dim dLocal
if( (inVal and &H80000000) <> 0 ) then
dLocal = CDbl((inval and &H7FFFFFFF))
dLocal = dLocal + 2^31
StrRID = cstr(dLocal)
else
StrRID = Cstr(inVal)
end if
end function
'------------------------------------------------------------------------------
%>
Regards,
Alex (Alejandro Campos Magencio)