Solved

Windows NT Administrative Rights

Posted on 1998-08-10
5
263 Views
Last Modified: 2008-02-01
How can I check (on Windows NT) to see if the current user has Administrative rights?
0
Comment
Question by:cantrell
  • 3
  • 2
5 Comments
 
LVL 2

Author Comment

by:cantrell
Comment Utility
Adjusted points to 100
0
 
LVL 14

Expert Comment

by:waty
Comment Utility
If you want the complete sample project, e-mail me :
   waty.thierry@usa.net.

Otherwise, here is the code

Create a NTAPI.bas with following :

'All variables must be declared
Option Explicit
Option Base 0     ' Important assumption for this code
                  ' Arrays starts at 0
 
'****************************************
' Private Type Declarations
'****************************************
Private Type MungeLong
  x As Long
  Dummy As Integer
End Type
     
Private Type MungeInt
  XLo As Integer
  XHi As Integer
  Dummy As Integer
End Type

Private Type TUser1006
  ptrHomeDir As Long
End Type

'****************************************
' Constant declarations
'****************************************

Public Const UF_SCRIPT = &H1
Public Const UF_ACCOUNTDISABLE = &H2
Public Const UF_HOMEDIR_REQUIRED = &H8
Public Const UF_LOCKOUT = &H10
Public Const UF_PASSWD_NOTREQD = &H20
Public Const UF_PASSWD_CANT_CHANGE = &H40
       
Public Const UF_TEMP_DUPLICATE_ACCOUNT = &H100
Public Const UF_NORMAL_ACCOUNT = &H200
Public Const UF_INTERDOMAIN_TRUST_ACCOUNT = &H800
Public Const UF_WORKSTATION_TRUST_ACCOUNT = &H1000
Public Const UF_SERVER_TRUST_ACCOUNT = &H2000
       
Public Const UF_DONT_EXPIRE_PASSWD = &H10000
Public Const UF_MNS_LOGON_ACCOUNT = &H20000

Public Const AF_OP_PRINT = 1
Public Const AF_OP_COMM = 2
Public Const AF_OP_SERVER = 4
Public Const AF_OP_ACCOUNTS = 8

Public Const DateFormat As String = "dd/mm/yyyy hh:nn:ss"

'****************************************
' API function declarations
'****************************************
Private Declare Function NetShareDel Lib "netapi32.dll" _
  (ByRef servername As Byte, _
   ByRef netname As Byte, _
   ByVal reserved As Long) As Long

Private Declare Function NetUserEnum Lib "netapi32.dll" _
 _
  (ByRef servername As Byte, _
   ByVal level As Long, _
   ByVal lFilter As Long, _
   ByRef buffer As Long, _
   ByVal prefmaxlen As Long, _
   ByRef entriesread As Long, _
   ByRef totalentries As Long, _
   ByRef ResumeHandle As Long) As Long

Private Declare Function NetGroupEnumUsers Lib "netapi32.dll" Alias _
     "NetGroupGetUsers" _
  (ByRef servername As Byte, _
   ByRef GroupName As Byte, _
   ByVal level As Long, _
   ByRef buffer As Long, _
   ByVal prefmaxlen As Long, _
   ByRef entriesread As Long, _
   ByRef totalentries As Long, _
   ByRef ResumeHandle As Long) As Long
   
Private Declare Function NetUserGetGroups Lib "netapi32.dll" _
  (ByRef servername As Byte, _
   ByRef username As Byte, _
   ByVal level As Long, _
   ByRef buffer As Long, _
   ByVal prefmaxlen As Long, _
   ByRef entriesread As Long, _
   ByRef totalentries As Long) As Long
   
Private Declare Function NetQueryDisplayInformation Lib "netapi32.dll" _
  (ByRef servername As Byte, _
   ByVal level As Long, _
   ByVal Index As Long, _
   ByVal EntriesRequested As Long, _
   ByVal PreferredMaximumLength As Long, _
   ByRef ReturnedEntryCount As Long, _
   ByRef SortedBuffer As Long) As Long
   
Private Declare Function NetUserGetInfo Lib "NETAPI32" _
  (ByRef servername As Byte, _
   ByRef username As Byte, _
   ByVal level As Long, _
   ByRef buffer As Long) As Long
   
Private Declare Function NetUserSetInfo Lib "NETAPI32" _
  (ByRef servername As Byte, _
   ByRef username As Byte, _
   ByVal level As Long, _
   ByRef buffer As TUser1006, _
   ByRef parm_err As Long) As Long
   
Private Declare Function NetShareGetInfo Lib "NETAPI32" _
  (ByRef servername As Byte, _
   ByRef netname As Byte, _
   ByVal level As Long, _
   ByRef buffer As Long) As Long
   
Private Declare Function NetAPIBufferFree Lib "netapi32.dll" Alias _
     "NetApiBufferFree" (ByVal Ptr As Long) As Long
     
Private Declare Function NetAPIBufferAllocate Lib "netapi32.dll" Alias _
     "NetApiBufferAllocate" (ByVal ByteCount As Long, Ptr As Long) As Long
     
Private Declare Function PtrToInt Lib "kernel32" Alias "lstrcpynW" _
  (RetVal As Any, ByVal Ptr As Long, ByVal nCharCount As Long) As Long
   
Private Declare Function PtrToStr Lib "kernel32" Alias "lstrcpyW" _
     (RetVal As Byte, ByVal Ptr As Long) As Long
   
Private Declare Function StrToPtr Lib "kernel32" Alias "lstrcpyW" _
     (ByVal Ptr As Long, Source As Byte) As Long
   
Private Declare Function StrLen Lib "kernel32" Alias "lstrlenW" _
     (ByVal Ptr As Long) As Long
 
Private Declare Function GetDiskFreeSpace Lib "kernel32" _
 Alias "GetDiskFreeSpaceA" _
 (ByVal lpRootPathName As String, _
 lpSectorsPerCluster As Long, _
 lpBytesPerSector As Long, _
 lpNumberOfFreeClusters As Long, _
 lpTotalNumberOfClusters As Long) As Long
 
Private Declare Function NetGetDCName Lib "netapi32.dll" _
  (ByRef servername As Byte, _
   ByRef DomainName As Byte, _
   ByRef buffer As Long) As Long
 
Private Declare Function NetGroupAddUser Lib "netapi32.dll" _
  (ByRef servername As Byte, _
   ByRef GroupName As Byte, _
   ByRef username As Byte) As Long
   
Private Declare Function NetGroupDelUser Lib "netapi32.dll" _
  (ByRef servername As Byte, _
   ByRef GroupName As Byte, _
   ByRef username As Byte) As Long

'****************************************
' Public Methods
'****************************************

Public Function GetPDC(Server As String, domain As String, PDC As String) As Long
  Dim Result As Long
  Dim SNArray() As Byte
  Dim DArray() As Byte
  Dim DCNPtr As Long
  Dim STRArray(100) As Byte
   
  SNArray = Server & vbNullChar      ' Move to byte array
  DArray = domain & vbNullChar       ' Move to byte array
           
  Result = NetGetDCName(SNArray(0), _
     DArray(0), DCNPtr)
 
  GetPDC = Result
   
  If Result = 0 Then
    Result = PtrToStr(STRArray(0), DCNPtr)
    PDC = Left(STRArray(), StrLen(DCNPtr))
  Else
    PDC = ""
  End If
  NetAPIBufferFree (DCNPtr)
End Function

Public Function AddUser(domain As String, Group As String, User As String) As Boolean
  Dim Result As Long
  Dim PDC As String
  Dim SNArray() As Byte
  Dim GNArray() As Byte
  Dim UNArray() As Byte
  Dim Ok As Boolean
 
  Result = GetPDC("", domain, PDC)
  If Result <> 0 Then GoTo HandleError
  SNArray = PDC & vbNullChar         ' Move to byte array
  GNArray = Group & vbNullChar       ' Move to byte array
  UNArray = User & vbNullChar        ' Move to byte array
   
  Result = NetGroupAddUser(SNArray(0), GNArray(0), UNArray(0))
  If Result <> 0 Then GoTo HandleError
   
  AddUser = True
ExitHere:
  Exit Function
HandleError:
  On Error Resume Next
  AddUser = False
  GoTo ExitHere

End Function

Public Function DelUser(domain As String, Group As String, User As String) As Boolean
  Dim Result As Long
  Dim PDC As String
  Dim SNArray() As Byte
  Dim GNArray() As Byte
  Dim UNArray() As Byte
  Dim Ok As Boolean
  Dim Stamp As String
 
  Result = GetPDC("", domain, PDC)
  If Result <> 0 Then GoTo HandleError
  SNArray = PDC & vbNullChar         ' Move to byte array
  GNArray = Group & vbNullChar         ' Move to byte array
  UNArray = User & vbNullChar         ' Move to byte array
 
  Result = NetGroupDelUser(SNArray(0), GNArray(0), UNArray(0))
  If Result <> 0 Then GoTo HandleError
 
  DelUser = True
ExitHere:
  Exit Function
HandleError:
  On Error Resume Next
  DelUser = False
  GoTo ExitHere
RuntimeError:
  Resume HandleError
End Function


Function QuickEnumerate(domain As String, level As Long, _
      Size As Long, Data() As String) As Boolean
' To enumerate Users specify Level = 1
' To enumerate Machines specify Level = 2 (not implemented)
' To enumerate Groups specify Level = 3

' Returns an array holding strings og usernames ogr groupnames
' Groupnames are returned as a string where the first 20 letters are groupname,
' and the last letters is a groupdescription

  On Error GoTo RuntimeError
  Dim APIResult As Long
  Dim Result As Long
  Dim PDC As String
  Dim SNArray() As Byte
  Dim EntriesRequested As Long
  Dim PreferredMaximumLength As Long
  Dim ReturnedEntryCount As Long
  Dim SortedBuffer As Long
  Dim TempPtr As MungeLong
  Dim tempstr As MungeInt
  Dim STRArray(500) As Byte
  Dim i As Integer
  Dim Index As Long
  Dim NextIndex As Long
  Dim MoreData As Boolean
  'Dim InternalData() As String
  Dim ArrayRoom As String
  Dim name As String
  Dim comment As String
       
  ReDim Data(1 To 8000)
  ArrayRoom = 8000 'If arraydefinition changes size, also change this number
  If Not (level = 1 Or level = 3) Then GoTo HandleError
  Result = GetPDC("", domain, PDC)
  If Result <> 0 Then GoTo HandleError
  Size = 0
  SNArray = PDC & vbNullChar         ' Move to byte array
  Index = 0                          ' Start with the first entry
  EntriesRequested = 500
  PreferredMaximumLength = 6000      ' Buffer size:
                                     ' Specifies the size of the chunks
                                     ' used to transfer user data from the
                                     ' NT directory database
                                     ' Try experimenting
  Do
    APIResult = NetQueryDisplayInformation(SNArray(0), level, Index, _
         EntriesRequested, PreferredMaximumLength, ReturnedEntryCount, _
         SortedBuffer)
   
    If APIResult <> 0 And APIResult <> 234 Then    ' 234 means multiple reads
                                                   ' required
      GoTo HandleError
    End If
         
    For i = 1 To ReturnedEntryCount
      Size = Size + 1
      If Size > ArrayRoom Then
        ArrayRoom = ArrayRoom + 2000
        ReDim Preserve Data(1 To ArrayRoom)
      End If
      Select Case level
        Case Is = 1
         
          ' Get pointer to string from beginning of buffer
          ' Copy 4-byte block of memory in 2 steps
          Result = PtrToInt(tempstr.XLo, SortedBuffer + (i - 1) * 24, 2)
          Result = PtrToInt(tempstr.XHi, SortedBuffer + (i - 1) * 24 + 2, 2)
          LSet TempPtr = tempstr ' munge 2 integers into a Long
          ' Copy string to array
          Result = PtrToStr(STRArray(0), TempPtr.x)
          Data(Size) = Left(STRArray, StrLen(TempPtr.x))
         
          ' Get pointer to string from beginning of buffer
          ' Copy 4-byte block of memory in 2 steps
          Result = PtrToInt(tempstr.XLo, SortedBuffer + (i - 1) * 24 + 20, 2)
          Result = PtrToInt(tempstr.XHi, SortedBuffer + (i - 1) * 24 + 22, 2)
          LSet TempPtr = tempstr ' munge 2 integers into a Long
          NextIndex = TempPtr.x
                   
        Case Is = 3
          ' Get pointer to string from beginning of buffer
          ' Copy 4-byte block of memory in 2 steps
          Result = PtrToInt(tempstr.XLo, SortedBuffer + (i - 1) * 20, 2)
          Result = PtrToInt(tempstr.XHi, SortedBuffer + (i - 1) * 20 + 2, 2)
          LSet TempPtr = tempstr ' munge 2 integers into a Long
          ' Copy string to array
          Result = PtrToStr(STRArray(0), TempPtr.x)
          name = Left(STRArray, StrLen(TempPtr.x))
         
          ' Get pointer to string from beginning of buffer
          ' Copy 4-byte block of memory in 2 steps
          Result = PtrToInt(tempstr.XLo, SortedBuffer + (i - 1) * 20 + 4, 2)
          Result = PtrToInt(tempstr.XHi, SortedBuffer + (i - 1) * 20 + 6, 2)
          LSet TempPtr = tempstr ' munge 2 integers into a Long
          ' Copy string to array
          Result = PtrToStr(STRArray(0), TempPtr.x)
          comment = Left(STRArray, StrLen(TempPtr.x))
                   
          Data(Size) = "1234567890123456789012"
          LSet Data(Size) = name
          Data(Size) = Data(Size) & comment
                   
          ' Get pointer to string from beginning of buffer
          ' Copy 4-byte block of memory in 2 steps
          Result = PtrToInt(tempstr.XLo, SortedBuffer + (i - 1) * 20 + 16, 2)
          Result = PtrToInt(tempstr.XHi, SortedBuffer + (i - 1) * 20 + 18, 2)
          LSet TempPtr = tempstr ' munge 2 integers into a Long
          NextIndex = TempPtr.x
                   
      End Select
    Next i
    Result = NetAPIBufferFree(SortedBuffer)         ' Don't leak memory
    'If ReturnedEntryCount = 0 Then GoTo Handleerror ' In the odd event that there are no entries
    Index = NextIndex
  Loop Until APIResult = 0          'No more data
 
 ' ReDim Data(1 To Size)
 ' For i = 1 To Size           ' I am not sure whether this is a smart move, but it has
                              ' been made to insure that only real date is passed
                              ' accros the DCOM connection, and not empty array fields
  '  Data(i) = InternalData(i)
  'Next i
 
  If Size > 0 Then
    ReDim Preserve Data(1 To Size)  ' I am not sure whether this is a smart move, but it has
  Else                              ' been made to insure that only real date is passed
    ReDim Preserve Data(1 To 1)     ' accros the DCOM connection, and not empty array fields
  End If
 
  QuickEnumerate = True
ExitHere:
  Exit Function
HandleError:
  On Error Resume Next
  QuickEnumerate = False
  GoTo ExitHere
RuntimeError:
  Resume HandleError
End Function

Function EnumerateGroupMembers(domain As String, Group As String, _
     Size As Long, Data() As String) As Boolean
 
  On Error GoTo RuntimeError

  Dim Ok As Boolean
  Dim Result As Long
  Dim bufptr As Long
  Dim entriesread As Long
  Dim totalentries As Long
  Dim ResumeHandle As Long
  Dim BufLen As Long
  Dim SNArray() As Byte
  Dim GNArray() As Byte
  Dim STRArray(99) As Byte
  Dim PDC As String
  Dim i As Integer
  Dim TempPtr As MungeLong
  Dim tempstr As MungeInt
  'Dim InternalData() As String
  Dim ArrayRoom As Long
   
  ReDim Data(1 To 5000)
  ArrayRoom = 5000 'If arraydefinition changes size, also change this number
   
  Result = GetPDC("", domain, PDC)
  If Result <> 0 Then GoTo HandleError
 
  SNArray = PDC & vbNullChar         ' Move to byte array
  GNArray = Group & vbNullChar       ' Move to Byte array
 
  BufLen = 1000                      ' Buffer size:
                                     ' Specifies the size of the chunks
                                     ' used to transfer user data from the
                                     ' NT directory database
                                     ' Try experimenting
  ResumeHandle = 0                   ' Start with the first entry
  Size = 0
  Do
    Result = NetGroupEnumUsers(SNArray(0), GNArray(0), 0, bufptr, _
      BufLen, entriesread, totalentries, ResumeHandle)
   
   
    If Result <> 0 And Result <> 234 Then    ' 234 means multiple reads
                                             ' required
      GoTo HandleError
    End If
     
    For i = 1 To entriesread
      Size = Size + 1
      If Size > ArrayRoom Then
        ArrayRoom = ArrayRoom + 1000
        ReDim Preserve Data(1 To ArrayRoom)
      End If
      ' Get pointer to string from beginning of buffer
      ' Copy 4-byte block of memory in 2 steps
      Result = PtrToInt(tempstr.XLo, bufptr + (i - 1) * 4, 2)
      Result = PtrToInt(tempstr.XHi, bufptr + (i - 1) * 4 + 2, 2)
      LSet TempPtr = tempstr ' munge 2 integers into a Long
      ' Copy string to array
      Result = PtrToStr(STRArray(0), TempPtr.x)
      Data(Size) = Left(STRArray, StrLen(TempPtr.x))
    Next i
       
    Result = NetAPIBufferFree(bufptr)         ' Don't leak memory
           
  Loop Until entriesread = totalentries
 
  'ReDim Data(1 To Size)
  'For i = 1 To Size          ' I am not sure whether this is a smart move, but it has
                              ' been made to insure that only real date is passed
                              ' accros the DCOM connection
  '  Data(i) = InternalData(i)
  'Next i
  If Size > 0 Then
    ReDim Preserve Data(1 To Size)  ' I am not sure whether this is a smart move, but it has
  Else                              ' been made to insure that only real date is passed
    ReDim Preserve Data(1 To 1)     ' accros the DCOM connection
  End If
 
  EnumerateGroupMembers = True
ExitHere:
  Exit Function
HandleError:
  On Error Resume Next
  EnumerateGroupMembers = False
  GoTo ExitHere
RuntimeError:
  Resume HandleError
End Function

Function EnumerateUsersGroupMembships(domain As String, User As String, _
     Size As Long, Data() As String) As Boolean
 
  On Error GoTo RuntimeError

  Dim Ok As Boolean
  Dim Result As Long
  Dim bufptr As Long
  Dim entriesread As Long
  Dim totalentries As Long
  Dim BufLen As Long
  Dim SNArray() As Byte
  Dim UNArray() As Byte
  Dim STRArray(99) As Byte
  Dim PDC As String
  Dim i As Integer
  Dim TempPtr As MungeLong
  Dim tempstr As MungeInt
  'Dim InternalData() As String
  Dim ArrayRoom As Long
   
  ReDim Data(1 To 500)
  ArrayRoom = 500 'If arraydefinition changes size, also change this number
   
  Result = GetPDC("", domain, PDC)
  If Result <> 0 Then GoTo HandleError
 
  SNArray = PDC & vbNullChar         ' Move to byte array
  UNArray = User & vbNullChar       ' Move to Byte array
 
  BufLen = 1000                      ' Buffer size:
                                     ' Specifies the size of the chunks
                                     ' used to transfer user data from the
                                     ' NT directory database
                                     ' Try experimenting
  Size = 0
  'do
    Result = NetUserGetGroups(SNArray(0), UNArray(0), 0, bufptr, _
      BufLen, entriesread, totalentries)
   
   
    If Result <> 0 Then
      GoTo HandleError
    End If
     
    For i = 1 To entriesread
      Size = Size + 1
      If Size > ArrayRoom Then
        ArrayRoom = ArrayRoom + 200
        ReDim Preserve Data(1 To ArrayRoom)
      End If
      ' Get pointer to string from beginning of buffer
      ' Copy 4-byte block of memory in 2 steps
      Result = PtrToInt(tempstr.XLo, bufptr + (i - 1) * 4, 2)
      Result = PtrToInt(tempstr.XHi, bufptr + (i - 1) * 4 + 2, 2)
      LSet TempPtr = tempstr ' munge 2 integers into a Long
      ' Copy string to array
      Result = PtrToStr(STRArray(0), TempPtr.x)
      Data(Size) = Left(STRArray, StrLen(TempPtr.x))
    Next i
       
    Result = NetAPIBufferFree(bufptr)         ' Don't leak memory
           
  'Loop Until entriesread = totalentries
 
  If Size > 0 Then
    ReDim Preserve Data(1 To Size)    ' I am not sure whether this is a smart move, but it has
  Else                                ' been made to insure that only real date is passed
    ReDim Preserve Data(1 To 1)    ' accros the DCOM connection
  End If
 
  If entriesread <> totalentries Then GoTo HandleError
  EnumerateUsersGroupMembships = True
ExitHere:
  Exit Function
HandleError:
  On Error Resume Next
  EnumerateUsersGroupMembships = False
  GoTo ExitHere
RuntimeError:
  Resume HandleError
End Function

Public Function GetUserInfo(domain As String, User As String, Info As User_Info_3) As Boolean

  'Not all fields in res are set by this function yet

  Dim Result As Long
  Dim bufptr As Long
  Dim str As String
  Dim SNArray() As Byte
  Dim UNArray() As Byte
  Dim PDC As String
  Dim STRArray(500) As Byte
 
  Dim TempPtr As MungeLong
  Dim tempstr As MungeInt
 
  Dim DateVar As Date
  Dim TimeStart As Date
 
  Set Info = New User_Info_3
       
  TimeStart = DateSerial(1970, 1, 1) + TimeSerial(1, 0, 0)
 
  Result = GetPDC("", domain, PDC)
  If Result <> 0 Then GoTo HandleError
 
  SNArray = PDC & vbNullChar       ' Move to byte array
  UNArray = User & vbNullChar       ' Move to byte array
           
  Result = NetUserGetInfo(SNArray(0), _
     UNArray(0), 3, bufptr)
 
  If Result = 0 Then
    With Info
      ' Get pointer to string from beginning of buffer
      ' Copy 4-byte block of memory in 2 steps
      Result = PtrToInt(tempstr.XLo, bufptr + 0, 2)
      Result = PtrToInt(tempstr.XHi, bufptr + 2, 2)
      LSet TempPtr = tempstr ' munge 2 integers into a Long
      ' Copy string to array
      Result = PtrToStr(STRArray(0), TempPtr.x)
      .name = Left(STRArray, StrLen(TempPtr.x))
     
      .password = "****************************"
     
      ' Get pointer to string from beginning of buffer
      ' Copy 4-byte block of memory in 2 steps
      Result = PtrToInt(tempstr.XLo, bufptr + 8, 2)
      Result = PtrToInt(tempstr.XHi, bufptr + 10, 2)
      LSet TempPtr = tempstr ' munge 2 integers into a Long
     
      DateVar = DateAdd("s", -TempPtr.x, Now)
      .password_last_set = Format(DateVar, DateFormat)
     
       
      ' Get pointer to string from beginning of buffer
      ' Copy 4-byte block of memory in 2 steps
      Result = PtrToInt(tempstr.XLo, bufptr + 12, 2)
      Result = PtrToInt(tempstr.XHi, bufptr + 14, 2)
      LSet TempPtr = tempstr ' munge 2 integers into a Long
      Select Case TempPtr.x
        Case 0
          .priv = "Guest"
        Case 1
          .priv = "User"
        Case 2
          .priv = "Administrator"
        Case 3
          .priv = "Mask"
        Case Else
          .priv = "Unknown"
      End Select
     
         
      ' Get pointer to string from beginning of buffer
      ' Copy 4-byte block of memory in 2 steps
      Result = PtrToInt(tempstr.XLo, bufptr + 16, 2)
      Result = PtrToInt(tempstr.XHi, bufptr + 18, 2)
      LSet TempPtr = tempstr ' munge 2 integers into a Long
      ' Copy string to array
      Result = PtrToStr(STRArray(0), TempPtr.x)
      .home_dir = Left(STRArray, StrLen(TempPtr.x))
 
      ' Get pointer to string from beginning of buffer
      ' Copy 4-byte block of memory in 2 steps
      Result = PtrToInt(tempstr.XLo, bufptr + 20, 2)
      Result = PtrToInt(tempstr.XHi, bufptr + 22, 2)
      LSet TempPtr = tempstr ' munge 2 integers into a Long
      ' Copy string to array
      Result = PtrToStr(STRArray(0), TempPtr.x)
      .comment = Left(STRArray, StrLen(TempPtr.x))
     
      ' Get pointer to string from beginning of buffer
      ' Copy 4-byte block of memory in 2 steps
      Result = PtrToInt(tempstr.XLo, bufptr + 24, 2)
      Result = PtrToInt(tempstr.XHi, bufptr + 26, 2)
      LSet TempPtr = tempstr ' munge 2 integers into a Long
      .flags = TempPtr.x
     
      ' Get pointer to string from beginning of buffer
      ' Copy 4-byte block of memory in 2 steps
      Result = PtrToInt(tempstr.XLo, bufptr + 28, 2)
      Result = PtrToInt(tempstr.XHi, bufptr + 30, 2)
      LSet TempPtr = tempstr ' munge 2 integers into a Long
      ' Copy string to array
      Result = PtrToStr(STRArray(0), TempPtr.x)
      .script_path = Left(STRArray, StrLen(TempPtr.x))
 
      ' Get pointer to string from beginning of buffer
      ' Copy 4-byte block of memory in 2 steps
      Result = PtrToInt(tempstr.XLo, bufptr + 32, 2)
      Result = PtrToInt(tempstr.XHi, bufptr + 34, 2)
      LSet TempPtr = tempstr ' munge 2 integers into a Long
      .auth_flags = TempPtr.x
                 
      ' Get pointer to string from beginning of buffer
      ' Copy 4-byte block of memory in 2 steps
      Result = PtrToInt(tempstr.XLo, bufptr + 36, 2)
      Result = PtrToInt(tempstr.XHi, bufptr + 38, 2)
      LSet TempPtr = tempstr ' munge 2 integers into a Long
      ' Copy string to array
      Result = PtrToStr(STRArray(0), TempPtr.x)
      .full_name = Left(STRArray, StrLen(TempPtr.x))
 
      ' Get pointer to string from beginning of buffer
      ' Copy 4-byte block of memory in 2 steps
      Result = PtrToInt(tempstr.XLo, bufptr + 40, 2)
      Result = PtrToInt(tempstr.XHi, bufptr + 42, 2)
      LSet TempPtr = tempstr ' munge 2 integers into a Long
      ' Copy string to array
      Result = PtrToStr(STRArray(0), TempPtr.x)
      .usr_comment = Left(STRArray, StrLen(TempPtr.x))
     
      ' Get pointer to string from beginning of buffer
      ' Copy 4-byte block of memory in 2 steps
      Result = PtrToInt(tempstr.XLo, bufptr + 44, 2)
      Result = PtrToInt(tempstr.XHi, bufptr + 46, 2)
      LSet TempPtr = tempstr ' munge 2 integers into a Long
      ' Copy string to array
      Result = PtrToStr(STRArray(0), TempPtr.x)
      .parms = Left(STRArray, StrLen(TempPtr.x))
     
      ' Get pointer to string from beginning of buffer
      ' Copy 4-byte block of memory in 2 steps
      Result = PtrToInt(tempstr.XLo, bufptr + 48, 2)
      Result = PtrToInt(tempstr.XHi, bufptr + 50, 2)
      LSet TempPtr = tempstr ' munge 2 integers into a Long
      ' Copy string to array
      Result = PtrToStr(STRArray(0), TempPtr.x)
      .workstations_allowed = Left(STRArray, StrLen(TempPtr.x))
      If .workstations_allowed = "" Then .workstations_allowed = "All"
     
      ' Get pointer to string from beginning of buffer
      ' Copy 4-byte block of memory in 2 steps
      Result = PtrToInt(tempstr.XLo, bufptr + 52, 2)
      Result = PtrToInt(tempstr.XHi, bufptr + 54, 2)
      LSet TempPtr = tempstr ' munge 2 integers into a Long
      If TempPtr.x = 0 Then
        .last_logon = "Never"
      Else
        DateVar = DateAdd("s", TempPtr.x, TimeStart)
        .last_logon = Format(DateVar, DateFormat)
      End If
           
      ' Get pointer to string from beginning of buffer
      ' Copy 4-byte block of memory in 2 steps
      Result = PtrToInt(tempstr.XLo, bufptr + 56, 2)
      Result = PtrToInt(tempstr.XHi, bufptr + 58, 2)
      LSet TempPtr = tempstr ' munge 2 integers into a Long
      If TempPtr.x = 0 Then
        .last_logoff = "Unknown"
      Else
        DateVar = DateAdd("s", TempPtr.x, TimeStart)
        .last_logoff = Format(DateVar, DateFormat)
      End If
           
      ' Get pointer to string from beginning of buffer
      ' Copy 4-byte block of memory in 2 steps
      Result = PtrToInt(tempstr.XLo, bufptr + 60, 2)
      Result = PtrToInt(tempstr.XHi, bufptr + 62, 2)
      LSet TempPtr = tempstr ' munge 2 integers into a Long
      If TempPtr.x = -1 Then
        .acct_expires = "Never"
      Else
        DateVar = DateAdd("s", TempPtr.x, TimeStart)
        .acct_expires = Format(DateVar, DateFormat)
      End If
     
      ' Get pointer to string from beginning of buffer
      ' Copy 4-byte block of memory in 2 steps
      Result = PtrToInt(tempstr.XLo, bufptr + 64, 2)
      Result = PtrToInt(tempstr.XHi, bufptr + 66, 2)
      LSet TempPtr = tempstr ' munge 2 integers into a Long
      If TempPtr.x = -1 Then
        .max_storage = "Unlimited"
      Else
        .max_storage = TempPtr.x
      End If
     
      ' Get pointer to string from beginning of buffer
      ' Copy 4-byte block of memory in 2 steps
      Result = PtrToInt(tempstr.XLo, bufptr + 68, 2)
      Result = PtrToInt(tempstr.XHi, bufptr + 70, 2)
      LSet TempPtr = tempstr ' munge 2 integers into a Long
      .units_per_week = TempPtr.x
     
      ' Get pointer to string from beginning of buffer
      ' Copy 4-byte block of memory in 2 steps
      Result = PtrToInt(tempstr.XLo, bufptr + 72, 2)
      Result = PtrToInt(tempstr.XHi, bufptr + 74, 2)
      LSet TempPtr = tempstr ' munge 2 integers into a Long
      .logon_hours = TempPtr.x
     
      ' Get pointer to string from beginning of buffer
      ' Copy 4-byte block of memory in 2 steps
      Result = PtrToInt(tempstr.XLo, bufptr + 76, 2)
      Result = PtrToInt(tempstr.XHi, bufptr + 78, 2)
      LSet TempPtr = tempstr ' munge 2 integers into a Long
      .bad_pw_count = TempPtr.x
     
      ' Get pointer to string from beginning of buffer
      ' Copy 4-byte block of memory in 2 steps
      Result = PtrToInt(tempstr.XLo, bufptr + 80, 2)
      Result = PtrToInt(tempstr.XHi, bufptr + 82, 2)
      LSet TempPtr = tempstr ' munge 2 integers into a Long
      .num_logons = TempPtr.x
     
      ' Get pointer to string from beginning of buffer
      ' Copy 4-byte block of memory in 2 steps
      Result = PtrToInt(tempstr.XLo, bufptr + 84, 2)
      Result = PtrToInt(tempstr.XHi, bufptr + 86, 2)
      LSet TempPtr = tempstr ' munge 2 integers into a Long
      ' Copy string to array
      Result = PtrToStr(STRArray(0), TempPtr.x)
      .logon_server = Left(STRArray, StrLen(TempPtr.x))
     
      ' Get pointer to string from beginning of buffer
      ' Copy 4-byte block of memory in 2 steps
      Result = PtrToInt(tempstr.XLo, bufptr + 88, 2)
      Result = PtrToInt(tempstr.XHi, bufptr + 90, 2)
      LSet TempPtr = tempstr ' munge 2 integers into a Long
      .country_code = TempPtr.x
     
      ' Get pointer to string from beginning of buffer
      ' Copy 4-byte block of memory in 2 steps
      Result = PtrToInt(tempstr.XLo, bufptr + 92, 2)
      Result = PtrToInt(tempstr.XHi, bufptr + 94, 2)
      LSet TempPtr = tempstr ' munge 2 integers into a Long
      .code_page = TempPtr.x
     
      ' Get pointer to string from beginning of buffer
      ' Copy 4-byte block of memory in 2 steps
      Result = PtrToInt(tempstr.XLo, bufptr + 96, 2)
      Result = PtrToInt(tempstr.XHi, bufptr + 98, 2)
      LSet TempPtr = tempstr ' munge 2 integers into a Long
      .user_id = TempPtr.x
     
      ' Get pointer to string from beginning of buffer
      ' Copy 4-byte block of memory in 2 steps
      Result = PtrToInt(tempstr.XLo, bufptr + 100, 2)
      Result = PtrToInt(tempstr.XHi, bufptr + 102, 2)
      LSet TempPtr = tempstr ' munge 2 integers into a Long
      .primary_group_id = TempPtr.x
     
      ' Get pointer to string from beginning of buffer
      ' Copy 4-byte block of memory in 2 steps
      Result = PtrToInt(tempstr.XLo, bufptr + 104, 2)
      Result = PtrToInt(tempstr.XHi, bufptr + 106, 2)
      LSet TempPtr = tempstr ' munge 2 integers into a Long
      ' Copy string to array
      Result = PtrToStr(STRArray(0), TempPtr.x)
      .profile = Left(STRArray, StrLen(TempPtr.x))
     
      ' Get pointer to string from beginning of buffer
      ' Copy 4-byte block of memory in 2 steps
      Result = PtrToInt(tempstr.XLo, bufptr + 108, 2)
      Result = PtrToInt(tempstr.XHi, bufptr + 110, 2)
      LSet TempPtr = tempstr ' munge 2 integers into a Long
      ' Copy string to array
      Result = PtrToStr(STRArray(0), TempPtr.x)
      .home_dir_drive = Left(STRArray, StrLen(TempPtr.x))
     
      ' Get pointer to string from beginning of buffer
      ' Copy 4-byte block of memory in 2 steps
      Result = PtrToInt(tempstr.XLo, bufptr + 112, 2)
      Result = PtrToInt(tempstr.XHi, bufptr + 114, 2)
      LSet TempPtr = tempstr ' munge 2 integers into a Long
      If TempPtr.x = 0 Then
        .password_expired = "No"
      Else
        .password_expired = "Yes"
      End If
     
    End With
  Else
    GoTo HandleError
  End If
  Result = NetAPIBufferFree(bufptr)         ' Don't leak memory
 
  GetUserInfo = True
ExitHere:
  Exit Function
HandleError:
  On Error Resume Next
  GetUserInfo = False
  GoTo ExitHere
RuntimeError:
  Resume HandleError
 
End Function



***************************************************************
A class clsUserInfo :
Option Explicit

Private Type User3           ' Level 3
                            ' User_Info_3
    name As String
    password As String
    password_last_set As String
    priv As String
    home_dir As String
    comment As String
    flags As Long
    script_path As String
    auth_flags As Long
    full_name As String
    usr_comment As String
    parms As String
    workstations_allowed As String
    last_logon As String
    last_logoff As String
    acct_expires As String
    max_storage As String
    units_per_week As Long
    logon_hours As Long         'Bad type choice
    bad_pw_count As Long
    num_logons As Long
    logon_server As String
    country_code As Long
    code_page As Long
    user_id As Long
    primary_group_id As Long
    profile As String
    home_dir_drive As String
    password_expired As String
End Type

Private User As User3
   
Public Property Let name(str As String)
  User.name = str
End Property

Public Property Let password(str As String)
  User.password = str
End Property

Public Property Let password_last_set(str As String)
  User.password_last_set = str
End Property

Public Property Let priv(str As String)
  User.priv = str
End Property

Public Property Let home_dir(str As String)
  User.home_dir = str
End Property

Public Property Let comment(str As String)
  User.comment = str
End Property

Public Property Let flags(lng As Long)
  User.flags = lng
End Property

Public Property Let script_path(str As String)
  User.script_path = str
End Property

Public Property Let auth_flags(lng As Long)
  User.auth_flags = lng
End Property
 
Public Property Let full_name(str As String)
  User.full_name = str
End Property
 
Public Property Let usr_comment(str As String)
  User.usr_comment = str
End Property
 
Public Property Let parms(str As String)
  User.parms = str
End Property
 
Public Property Let workstations_allowed(str As String)
  User.workstations_allowed = str
End Property
 
Public Property Let last_logon(str As String)
  User.last_logon = str
End Property
 
Public Property Let last_logoff(str As String)
  User.last_logoff = str
End Property
 
Public Property Let acct_expires(str As String)
  User.acct_expires = str
End Property
 
Public Property Let max_storage(str As String)
  User.max_storage = str
End Property
 
Public Property Let units_per_week(lng As Long)
  User.units_per_week = lng
End Property
 
Public Property Let logon_hours(lng As Long)
  User.logon_hours = lng
End Property
 
Public Property Let bad_pw_count(lng As Long)
  User.bad_pw_count = lng
End Property
 
Public Property Let num_logons(lng As Long)
  User.num_logons = lng
End Property

Public Property Let logon_server(str As String)
  User.logon_server = str
End Property

Public Property Let country_code(lng As Long)
  User.country_code = lng
End Property

Public Property Let code_page(lng As Long)
  User.code_page = lng
End Property

Public Property Let user_id(lng As Long)
  User.user_id = lng
End Property
 
Public Property Let primary_group_id(lng As Long)
  User.primary_group_id = lng
End Property
 
Public Property Let profile(str As String)
  User.profile = str
End Property
 
Public Property Let home_dir_drive(str As String)
  User.home_dir_drive = str
End Property
 
Public Property Let password_expired(str As String)
  User.password_expired = str
End Property

'**************************************************

Public Property Get name() As String
  name = User.name
End Property

Public Property Get password() As String
  password = User.password
End Property

Public Property Get password_last_set() As String
  password_last_set = User.password_last_set
End Property

Public Property Get priv() As String
  priv = User.priv
End Property

Public Property Get home_dir() As String
  home_dir = User.home_dir
End Property

Public Property Get comment() As String
  comment = User.comment
End Property

Public Property Get flags() As Long
  flags = User.flags
End Property

Public Property Get script_path() As String
  script_path = User.script_path
End Property

Public Property Get auth_flags() As Long
  auth_flags = User.auth_flags
End Property
 
Public Property Get full_name() As String
  full_name = User.full_name
End Property
 
Public Property Get usr_comment() As String
  usr_comment = User.usr_comment
End Property
 
Public Property Get parms() As String
  parms = User.parms
End Property
 
Public Property Get workstations_allowed() As String
  workstations_allowed = User.workstations_allowed
End Property
 
Public Property Get last_logon() As String
  last_logon = User.last_logon
End Property
 
Public Property Get last_logoff() As String
  last_logoff = User.last_logoff
End Property
 
Public Property Get acct_expires() As String
  acct_expires = User.acct_expires
End Property
 
Public Property Get max_storage() As String
  max_storage = User.max_storage
End Property
 
Public Property Get units_per_week() As Long
  units_per_week = User.units_per_week
End Property
 
Public Property Get logon_hours() As Long
  logon_hours = User.logon_hours
End Property
 
Public Property Get bad_pw_count() As Long
  bad_pw_count = User.bad_pw_count
End Property
 
Public Property Get num_logons() As Long
  num_logons = User.num_logons
End Property

Public Property Get logon_server() As String
  logon_server = User.logon_server
End Property

Public Property Get country_code() As Long
  country_code = User.country_code
End Property

Public Property Get code_page() As Long
  code_page = User.code_page
End Property

Public Property Get user_id() As Long
  user_id = User.user_id
End Property
 
Public Property Get primary_group_id() As Long
  primary_group_id = User.primary_group_id
End Property
 
Public Property Get profile() As String
  profile = User.profile
End Property
 
Public Property Get home_dir_drive() As String
  home_dir_drive = User.home_dir_drive
End Property
 
Public Property Get password_expired() As String
  password_expired = User.password_expired
End Property
 
 
***************************************************************
 
Save this as a form :

VERSION 5.00
Begin VB.Form FrmEnum
   Caption         =   "Enumeration"
   ClientHeight    =   4680
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   4680
   LinkTopic       =   "Form1"
   ScaleHeight     =   4680
   ScaleWidth      =   4680
   StartUpPosition =   3  'Windows Default
   Begin VB.ListBox LstEnum
      BeginProperty Font
         Name            =   "Courier"
         Size            =   9.75
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   2985
      Left            =   120
      TabIndex        =   4
      Top             =   1560
      Width           =   4455
   End
   Begin VB.CommandButton CmdGroups
      Caption         =   "Enum groups"
      Height          =   495
      Left            =   2573
      TabIndex        =   3
      Top             =   840
      Width           =   1215
   End
   Begin VB.TextBox TxtDomain
      Height          =   285
      Left            =   1613
      TabIndex        =   2
      Top             =   240
      Width           =   2415
   End
   Begin VB.CommandButton CmdUsers
      Caption         =   "Enum users"
      Height          =   495
      Left            =   893
      TabIndex        =   0
      Top             =   840
      Width           =   1215
   End
   Begin VB.Label LblDomain
      Caption         =   "Domain:"
      Height          =   255
      Left            =   653
      TabIndex        =   1
      Top             =   240
      Width           =   735
   End
End
Attribute VB_Name = "FrmEnum"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'All variables must be declared
Option Explicit
Private UsersShown As Boolean

Function IsFlag(Flags As Long, TestFlag As Long) As Boolean

    ' Determines if testflag is set in flag
   
     IsFlag = ((Flags And TestFlag) = TestFlag)
     
End Function

Private Sub CmdGroups_Click()
  Dim Ok As Boolean
  Dim Size As Long
  Dim Data() As String
  Dim i As Long
  UsersShown = False
  LstEnum.Clear
  Ok = QuickEnumerate(TxtDomain, 3, Size, Data)
  If Ok Then
   For i = 1 To Size
     LstEnum.AddItem (Data(i))
   Next i
  Else
    MsgBox ("Error when trying to enumerate groups")
  End If
End Sub

Private Sub CmdUsers_Click()
  Dim Ok As Boolean
  Dim Size As Long
  Dim Data() As String
  Dim i As Long
  LstEnum.Clear
  Ok = QuickEnumerate(TxtDomain, 1, Size, Data)
  If Ok Then
   For i = 1 To Size
     LstEnum.AddItem (Data(i))
   Next i
   UsersShown = True
  Else
    MsgBox ("Error when trying to enumerate Users")
    UsersShown = False
  End If
End Sub

Private Sub Form_Load()
  UsersShown = False
End Sub

Private Sub LstEnum_Click()
Dim Ok As Boolean
Dim Info As User_Info_3
Dim Groups() As String
Dim Size As Long
Dim i As Long
  If UsersShown Then
    If LstEnum.ListIndex <> -1 Then
      Ok = GetUserInfo(TxtDomain, LstEnum.Text, Info)
      If Not Ok Then
        MsgBox ("Unable to get information about " & LstEnum.Text)
      Else
        FrmUserInfo.TxtUserName.Text = Info.name
        FrmUserInfo.TxtFullName.Text = Info.full_name
        FrmUserInfo.TxtDescription.Text = Info.comment
        FrmUserInfo.TxtPrivilege.Text = Info.priv
        If IsFlag(Info.Flags, UF_ACCOUNTDISABLE) Then
          FrmUserInfo.TxtAcctActive.Text = "No"
        Else
          FrmUserInfo.TxtAcctActive.Text = "Yes"
        End If
        If IsFlag(Info.Flags, UF_LOCKOUT) Then
          FrmUserInfo.TxtAcctLockedOut.Text = "Yes"
        Else
          FrmUserInfo.TxtAcctLockedOut.Text = "No"
        End If
        FrmUserInfo.TxtAcctExpires.Text = Info.acct_expires
        FrmUserInfo.TxtLastLogon.Text = Info.last_logon
        FrmUserInfo.TxtNumLogons.Text = Info.num_logons
        FrmUserInfo.TxtPasswordLastSet.Text = Info.password_last_set
        FrmUserInfo.TxtPasswordExpired.Text = Info.password_expired
        If IsFlag(Info.Flags, UF_PASSWD_CANT_CHANGE) Then
          FrmUserInfo.TxtPasswordChangeable.Text = "No"
        Else
          FrmUserInfo.TxtPasswordChangeable.Text = "Yes"
        End If
        If IsFlag(Info.Flags, UF_DONT_EXPIRE_PASSWD) Then
          FrmUserInfo.TxtPasswordNeverExpires.Text = "No"
        Else
          FrmUserInfo.TxtPasswordNeverExpires.Text = "Yes"
        End If
        FrmUserInfo.TxtBadPwCount.Text = Info.bad_pw_count
        FrmUserInfo.TxtUserProfilePath.Text = Info.profile
        FrmUserInfo.TxtLoginScriptName.Text = Info.script_path
        FrmUserInfo.TxtHomedir.Text = Info.home_dir
        FrmUserInfo.TxtHomedirDrive.Text = Info.home_dir_drive
        FrmUserInfo.TxtWorkstationsAllowed.Text = Info.workstations_allowed
     
        FrmUserInfo.CmbGlobalGroups.Clear
        FrmUserInfo.CmbGlobalGroups.Text = "Press button to view memberships"
        Ok = EnumerateUsersGroupMembships(TxtDomain.Text, LstEnum.Text, Size, Groups)
        If Not Ok Then
          MsgBox ("Unable to retrieve information about Global Group Memberships for " & LstEnum.Text)
        Else
          For i = 1 To Size
            FrmUserInfo.CmbGlobalGroups.AddItem (Groups(i))
          Next i
          FrmUserInfo.Show vbModal, Me
        End If
      End If
    End If
  End If
End Sub

0
 
LVL 2

Author Comment

by:cantrell
Comment Utility
Great code. I need one thing though. When trying to run the code above I get the message "USER DEFINED TYPE NOT DEFINE" from Public Function GetUserInfo(domain As String, User As String, Info As User_Info_3) As Boolean... Help.
0
 
LVL 14

Accepted Solution

by:
waty earned 100 total points
Comment Utility
You have to call your class "User_Info_3".

By the way, you will be able to download this source from my web site :
   http://www.geocities.com/ResearchTriangle/6311/
0
 
LVL 2

Author Comment

by:cantrell
Comment Utility
Thank you waty. I guess that was my fault - I didn't put the appropriate code in a class module... Thanks again. Cantrell
0

Featured Post

Highfive + Dolby Voice = No More Audio Complaints!

Poor audio quality is one of the top reasons people don’t use video conferencing. Get the crispest, clearest audio powered by Dolby Voice in every meeting. Highfive and Dolby Voice deliver the best video conferencing and audio experience for every meeting and every room.

Join & Write a Comment

Background What I'm presenting in this article is the result of 2 conditions in my work area: We have a SQL Server production environment but no development or test environment; andWe have an MS Access front end using tables in SQL Server but we a…
You can of course define an array to hold data that is of a particular type like an array of Strings to hold customer names or an array of Doubles to hold customer sales, but what do you do if you want to coordinate that data? This article describes…
Get people started with the process of using Access VBA to control Outlook using automation, Microsoft Access can control other applications. An example is the ability to programmatically talk to Microsoft Outlook. Using automation, an Access applic…
Show developers how to use a criteria form to limit the data that appears on an Access report. It is a common requirement that users can specify the criteria for a report at runtime. The easiest way to accomplish this is using a criteria form that a…

762 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

12 Experts available now in Live!

Get 1:1 Help Now