Vista - Get access token information using vbscript ?

Hello,

Is it possible to get access token information using vbscript ?

thanks
Vilius

"Vilius Mockûnas" <v_mockunas@xxxxxx> wrote in message
news:%23F8tVUZHKHA.3928@xxxxxxMost of the information in the access token provided to a user when they
authenticate is identical to the information you get when you retrieve the
value of the tokenGroups attribute of the user object. This is an
operational attribute, meaning the values are constructed by AD upon
request. It is a multi-valued array of security group SID's. Each SID value
is itself a byte array. An example for the current user could be:
===========
Option Explicit
Dim objSysInfo, strUserDN, objUser
Dim arrbytSIDs, j, arrstrGroupSIDs()
Dim strHexSID

' Bind to current user object.
Set objSysInfo = CreateObject("ADSystemInfo")
strUserDN = objSysInfo.UserName
Set objUser = GetObject("LDAP://" & strUserDN)

' Retrieve tokenGroups attribute.
objUser.GetInfoEx Array("tokenGroups"), 0
arrbytSIDs = objUser.Get("tokenGroups")

' Convert into an array of hex string values.
If (UBound(arrbytSIDs) = -1) Then
' No group SID values, do nothing.
ElseIf (TypeName(arrbytSIDs) = "Byte()") Then
' One group SID.
ReDim arrstrGroupSIDs(0)
arrstrGroupSIDs(0) = OctetToHexStr(arrbytSIDs)
Else
' More than one SID value in the array.
ReDim arrstrGroupSIDs(UBound(arrbytSIDs))
For j = 0 To UBound(arrbytSIDs)
arrstrGroupSIDs(j) = OctetToHexStr(arrbytSIDs(j))
Next
End If

' Display the SID values.
' Display both hex and decimal values.
For Each strHexSID In arrstrGroupSIDs
Wscript.Echo strHexSID
Wscript.Echo HexSIDToDec(strHexSID)
Next

Function OctetToHexStr(ByVal arrbytOctet)
' Function to convert OctetString (byte array) to Hex string.
Dim k
OctetToHexStr = ""
For k = 1 To Lenb(arrbytOctet)
OctetToHexStr = OctetToHexStr _
& Right("0" & Hex(Ascb(Midb(arrbytOctet, k, 1))), 2)
Next
End Function

Function HexSIDToDec(ByVal strSID)
' Function to convert most hex SID values to decimal format.

Dim arrbytSID, lngTemp, j

ReDim arrbytSID(Len(strSID)/2 - 1)
For j = 0 To UBound(arrbytSID)
arrbytSID(j) = CInt("&H" & Mid(strSID, 2*j + 1, 2))
Next

If (UBound(arrbytSID) = 11) Then
HexSIDToDec = "S-" & arrbytSID(0) & "-" _
& arrbytSID(1) & "-" & arrbytSID(8)

Exit Function
End If

If (UBound(arrbytSID) = 15) Then
HexSIDToDec = "S-" & arrbytSID(0) & "-" _
& arrbytSID(1) & "-" & arrbytSID(8)

lngTemp = arrbytSID(15)
lngTemp = lngTemp * 256 + arrbytSID(14)
lngTemp = lngTemp * 256 + arrbytSID(13)
lngTemp = lngTemp * 256 + arrbytSID(12)

HexSIDToDec = HexSIDToDec & "-" & CStr(lngTemp)

Exit Function
End If

HexSIDToDec = "S-" & arrbytSID(0) & "-" _
& arrbytSID(1) & "-" & arrbytSID(8)

lngTemp = arrbytSID(15)
lngTemp = lngTemp * 256 + arrbytSID(14)
lngTemp = lngTemp * 256 + arrbytSID(13)
lngTemp = lngTemp * 256 + arrbytSID(12)

HexSIDToDec = HexSIDToDec & "-" & CStr(lngTemp)

lngTemp = arrbytSID(19)
lngTemp = lngTemp * 256 + arrbytSID(18)
lngTemp = lngTemp * 256 + arrbytSID(17)
lngTemp = lngTemp * 256 + arrbytSID(16)

HexSIDToDec = HexSIDToDec & "-" & CStr(lngTemp)

lngTemp = arrbytSID(23)
lngTemp = lngTemp * 256 + arrbytSID(22)
lngTemp = lngTemp * 256 + arrbytSID(21)
lngTemp = lngTemp * 256 + arrbytSID(20)

HexSIDToDec = HexSIDToDec & "-" & CStr(lngTemp)

If (UBound(arrbytSID) > 23) Then
lngTemp = arrbytSID(25)
lngTemp = lngTemp * 256 + arrbytSID(24)

HexSIDToDec = HexSIDToDec & "-" & CStr(lngTemp)
End If

End Function

Not sure right now, maybe someone else would know.


"Richard Mueller [MVP]" <rlmueller-nospam@xxxxxx> wrote in
message news:#Gmh6lpHKHA.3736@xxxxxx

Hello,

But this one only works for domain accounts ?

V

"Richard Mueller [MVP]" <rlmueller-nospam@xxxxxx> wrote in
message news:%23Gmh6lpHKHA.3736@xxxxxx

Yes, this only applies to domain accounts. For local accounts you can bind
with the WinNT provider and retrieve the objectSID attribute and treat it
the same way, as a single-valued SID value, which is a byte array, and
convert to hex or decimal format. But I know of no way to retrieve the
equivalent of tokenGroups.

--
Richard Mueller
MVP Directory Services
Hilltop Lab - http://www.rlmueller.net
--

"Vilius Mockûnas" <v_mockunas@xxxxxx> wrote in message
news:uPE9ZwqHKHA.4316@xxxxxx