Option Explicit

Const ADS_GROUP_TYPE_SYSTEM = &h1
Const ADS_GROUP_TYPE_GLOBAL_GROUP = &h2
Const ADS_GROUP_TYPE_LOCAL_GROUP = &h4
Const ADS_GROUP_TYPE_UNIVERSAL_GROUP = &h8
Const ADS_GROUP_TYPE_SECURITY_ENABLED = &h80000000

Dim oADSystemInfo, oUser, aGroups, i, sOutput

Set oADSystemInfo = CreateObject("ADSystemInfo")
Set oUser = GetObject("LDAP://" & oADSystemInfo.UserName)
wscript.echo oADSystemInfo.UserName

oUser.GetInfoEx Array("tokenGroups") , 0
aGroups = oUser.Get("tokenGroups")

If TypeName(aGroups) = "Byte()" Then
'single SID
sOutput = FindGroup(aGroups) & VbCrLf
Elseif UBound(aGroups) > -1 Then
'two or more SID's
For i = 0 To UBound(aGroups)
sOutput = sOutput & FindGroup(aGroups(i)) & VbCrLf
Next
Else
'no SID's
End If

WScript.Echo sOutput

Function FindGroup(aBytes)
Dim oGroup, sHex, iGroupType

sHex = BytesToHexString(aBytes)

On Error Resume Next

Set oGroup = GetObject("LDAP://<SID=" & sHex & ">")

If Err.Number <> 0 Then
'Error
FindGroup = Left(sHex & Space(56),56) & vbTab & vbTab & "Error Binding (SIDHistory?)"
Else
'OK
FindGroup = Left(sHex & Space(56),56) & vbTab
Select Case oGroup.Get("groupType") And 15
Case ADS_GROUP_TYPE_GLOBAL_GROUP
FindGroup = FindGroup & "G"
Case ADS_GROUP_TYPE_GLOBAL_GROUP + ADS_GROUP_TYPE_SYSTEM
FindGroup = FindGroup & "G/S"
Case ADS_GROUP_TYPE_LOCAL_GROUP
FindGroup = FindGroup & "L"
Case ADS_GROUP_TYPE_LOCAL_GROUP + ADS_GROUP_TYPE_SYSTEM
FindGroup = FindGroup & "L/S"
Case ADS_GROUP_TYPE_UNIVERSAL_GROUP
FindGroup = FindGroup & "U"
Case ADS_GROUP_TYPE_UNIVERSAL_GROUP + ADS_GROUP_TYPE_SYSTEM
FindGroup = FindGroup & "U/S"
Case Else
FindGroup = FindGroup & "!"
End Select
FindGroup = FindGroup & vbTab & oGroup.samAccountName
End If

Err.Clear
On Error GoTo 0
End Function

Function BytesToHexString(aBytes)
Dim i

BytesToHexString = ""

For i = 1 To LenB(aBytes)
BytesToHexString = BytesToHexString & Right("0" & Hex(AscB(MidB(aBytes, i, 1))), 2)
Next
End Function