Using GetTokenInformation in Visual Basic 6 to determine whether a user is an admin

Question

I am using GetTokenInformation as a part of the code that determines if the current thread is running as an Administrator.

Anyway, I have a structure for TOKEN INFORMATION that looks like this:

Private Type TOKEN_GROUPS
   GroupCount As Long
   Groups(500) As SID_AND_ATTRIBUTES
End Type

Then, I invoke GetTokenInformation like so:

res = GetTokenInformation(<Process Handle>, 2, <TOKEN_GROUPS>, _
                            <Token Info Length>, <Buffer Length)

The first invocation is to get the Buffer Length, then I invoke it again to get the token information.

Anyway, the application will suddenly crash when the account that run the application is connected to a domain. Apparently, the size of the,

Groups(500) As SID.AND.ATTRIBUTES

is not enough and is causing a buffer overrun. I don't know why that is (MSDN says that I should provide an ANYSIZE_ARRAY or 1). Increasing the size of the Groups to 1000 fixes the problem.

As a quick fix and since I don't have an idea on how to get the appropriate size of Groups, I am planning to just ReDim the Groups until the call succeeds.

Here's my question:

1. I have an On Error clause, but when the buffer overrun occurs, the On Error can't catch it and my app suddenly crashes. Why is that?

2. Given the code below

Private Type TOKEN_GROUPS
   GroupCount As Long
   Groups() As SID_AND_ATTRIBUTES 'FAILING
   'Groups(1000) As SID_AND_ATTRIBUTES DOES NOT FAIL
End Type

Dim X as TOKEN_GROUPS
ReDim Preserve X.Groups(1000) As SID_AND_ATTRIBUTES 'FAILING

res = GetTokenInformation(<Process Handle>, 2, <TOKEN_GROUPS>, <Token Info Length>, <Buffer Length)

res = GetTokenInformation(<Process Handle>, 2, <TOKEN_GROUPS>, <Token Info Length>, <Buffer Length)

Why is that when I declared Groups as 1000, the GetTokenInformation call is not failing but when I declared an "empty" Groups() and ReDim'd it to 1000, it is failing?

Answer 1

If you want to use dynamicly sized array for Groups you'll need "custom API call marshaling" code. Basicly couple of CopyMemory's and an array resize

Option Explicit

'--- for OpenProcessToken
Private Const TOKEN_READ                    As Long = &H20008

Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (pTo As Any, uFrom As Any, ByVal lSize As Long)
Private Declare Function GetCurrentProcess Lib "kernel32" () As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Private Declare Function OpenProcessToken Lib "advapi32.dll" (ByVal ProcessHandle As Long, ByVal DesiredAccess As Long, TokenHandle As Long) As Long
Private Declare Function GetTokenInformation Lib "advapi32.dll" (ByVal TokenHandle As Long, ByVal TokenInformationClass As Long, TokenInformation As Any, ByVal TokenInformationLength As Long, ReturnLength As Long) As Long

Private Type SID_AND_ATTRIBUTES
    Sid             As Long
    Attributes      As Long
End Type

Private Type VB_TOKEN_GROUPS
    GroupCount      As Long
    Groups()        As SID_AND_ATTRIBUTES
End Type


Private Sub Command1_Click()
    Dim hProcessID      As Long
    Dim hToken          As Long
    Dim lNeeded         As Long
    Dim baBuffer()      As Byte
    Dim uGroups         As VB_TOKEN_GROUPS

    hProcessID = GetCurrentProcess()
    If hProcessID <> 0 Then
        If OpenProcessToken(hProcessID, TOKEN_READ, hToken) = 1 Then
            Call GetTokenInformation(hToken, 2, ByVal 0, 0, lNeeded)
            ReDim baBuffer(0 To lNeeded)
            '--- enum TokenInformationClass { TokenUser = 1, TokenGroups = 2, ... }
            If GetTokenInformation(hToken, 2, baBuffer(0), UBound(baBuffer), lNeeded) = 1 Then
                Call CopyMemory(uGroups.GroupCount, baBuffer(0), 4)
                ReDim uGroups.Groups(0 To uGroups.GroupCount - 1)
                Call CopyMemory(uGroups.Groups(0), baBuffer(4), uGroups.GroupCount * Len(uGroups.Groups(0)))
            End If
            Call CloseHandle(hToken)
        End If
        Call CloseHandle(hProcessID)
    End If
End Sub

Answer 2

There is another question here that seems to have solved the GetTokenInformation call. Copied from the accepted answer:

Call GetTokenInformation(hToken, 1, ByVal 0, 0, lNeeded)
ReDim baBuffer(0 To lNeeded)
...