VERSION 5.00
Begin VB.Form GPOList 
   BorderStyle     =   1  'Fixed Single
   Caption         =   "Form1"
   ClientHeight    =   960
   ClientLeft      =   2790
   ClientTop       =   2430
   ClientWidth     =   2700
   Icon            =   "Chap13_Listing13_Get_GPO_List_form.frx":0000
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   960
   ScaleWidth      =   2700
   StartUpPosition =   2  'CenterScreen
End
Attribute VB_Name = "GPOList"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False

Option Explicit
'Option Base 0

' From the book "Managing Enterprise Active Directory Services"
' ISBN: 0-672-32125-4

Private Const GPO_LIST_FLAG_MACHINE = &H1
Private Const GPO_LIST_FLAG_SITEONLY = &H2
Private Const TOKEN_ADJUST_PRIVILEGES = &H20
Private Const TOKEN_QUERY = &H8
Private Const SE_PRIVILEGE_ENABLED = &H2
'Private Enum GPO_LINK
Private Const GPLinkUnknown = 0
Private Const GPLinkMachine = 1&
Private Const GPLinkSite = 2&
Private Const GPLinkDomain = 3&
Private Const GPLinkOrganizationalUnit = 4&
'End Enum

'typedef struct _GROUP_POLICY_OBJECT {
'  DWORD    dwOptions;
'  DWORD    dwVersion;
'  LPCTSTR  lpDSPath;
'  LPCTSTR  lpFileSysPath;
'  LPCTSTR  lpDisplayName;
'  TCHAR    szGPOName[50];
'  GPO_LINK GPOLink;
'  LPARAM   lParam;
'  struct   _GROUP_POLICY_OBJECT *pNext;
'  struct   _GROUP_POLICY_OBJECT *pPrev;
'  LPTSTR   lpExtensions;
'  LPARAM   lParam2;
'  LPTSTR   lpLink;
'}

Private Type GROUP_POLICY_OBJECT
    dwOptions As Long
    dwVersion As Long
    lpDSPath As Long
    lpFileSysPath As Long
    lpDisplayName As Long
    szGPOName As String * 50
    GPOLink As Long
    lParam As Long
    pNext As Long
    pPref As Long
    lpExtensions As Long
    lParam2 As Long
    lpLink As Long
End Type


'DWORD GetAppliedGPOList(
'  DWORD dwFlags,
'  LPCTSTR pMachineName,
'  PSID pSidUser,
'  GUID *pGuidExtension,
'  PGROUP_POLICY_OBJECT *ppGPOList
');

'{827D319E-6EAC-11D2-A4EA-00C04F79F83A}

Private Declare Function GetAppliedGPOList Lib "Userenv.dll" _
    (ByVal dwFlags As Long, _
    pMachineName As Long, _
    pSidUser As Long, _
    pGuidExtension As Long, _
    pGPOList As Long) As Boolean
        
Private Declare Sub MoveMemory Lib "kernel32" _
    Alias "RtlMoveMemory" _
    (pDest As Any, _
    pSource As Any, _
    ByVal dwLength As Long)
     
Private Declare Function lstrlenA Lib "kernel32" _
    (ByVal lpString As Long) As Long

Private Declare Function lstrcpyA Lib "kernel32" _
    (ByVal szDest As String, _
    ByVal lpSource As Long) As Long

Private Declare Function GetGPOList Lib "Userenv.dll" _
    Alias "GetGPOListA" ( _
    ByVal hToken As Long, _
    ByVal lpName As String, _
    ByVal lpHostName As String, _
    ByVal lpComputerName As String, _
    ByVal dwFlags As Long, _
    ppGPOList As Long) As Long
    
Private Declare Function FreeGPOList Lib "Userenv.dll" _
    Alias "FreeGPOListA" _
    (ByVal pGPOList As Long) As Long

Private Sub Form_Load()

    Dim strObj As String
    Dim strDC As String
    Dim strSite As String
    
    strObj = "LDAP://adc-xyz-201.xyz.com/CN=rpuckett,OU=Employees,OU=XYZ Users,DC=xyz,DC=com"
    strDC = "adc-xyz-201.amer.xyz.com"
    strSite = "\\adc-xyz-201.amer.xyz.com"
    
    'GPO_LIST_FLAG_MACHINE, 0& or SITEs...
    
    Call GetGPOs(strObj, strDC, strSite, 0&)
    
    Unload Me
    End

End Sub
       
Private Function GetGPOs(ByVal strObjPath As String, ByVal strDCName As String, _
    ByVal strSiteName As String, ByVal lpPolType As Long) As Long
    
    Dim mPtr As Long
    Dim lRet As Long
    Dim lPtr As Long
    Dim pGPOList As GROUP_POLICY_OBJECT
    
    lRet = GetGPOList(0, _
           strObjPath, _
           strDCName, _
           strSiteName, _
           lpPolType, _
           lPtr)
           
    If lRet <> 0 Then
        mPtr = lPtr
        Do While lPtr <> 0
            MoveMemory pGPOList, ByVal lPtr, Len(pGPOList)
            With pGPOList
                Debug.Print "GPO Options: " & .dwOptions
                Debug.Print "GPO Version: " & .dwVersion
                Debug.Print "GPO DS Path: " & StrFromPtrA(.lpDSPath)
                Debug.Print "GPO File System Path: " & StrFromPtrA(.lpFileSysPath)
                Debug.Print "GPO Display Name: " & StrFromPtrA(.lpDisplayName)
                Debug.Print "GPO Link: " & StrFromPtrA(.lpLink)
                Debug.Print "GPO Unique Name: " & .szGPOName
                Select Case .GPOLink
                    Case 0
                        Debug.Print "GPLinkUnknown: No link information is available."
                    Case 1
                        Debug.Print "GPLinkMachine: The GPO is linked to a computer (local or remote)."
                    Case 2
                        Debug.Print "GPLinkSite: The GPO is linked to a site."
                    Case 3
                        Debug.Print "GPLinkDomain: The GPO is linked to a domain."
                    Case 4
                        Debug.Print "GPLinkOrganizationalUnit: The GPO is linked to an organizational unit."
                    Case Else
                        Debug.Print "The GPO Link Type is unknown (" & .GPOLink & ")"
                End Select
                Debug.Print "GPO Param Data: " & StrFromPtrA(.lParam)
                Debug.Print "GPO Extensions: " & StrFromPtrA(.lpExtensions)
                Debug.Print "GPO Param Data 2: " & StrFromPtrA(.lParam2)
                Debug.Print "----------------------------------------------"
                lPtr = .pNext
            End With
        Loop
    Else
        Debug.Print "Error: " & Err.LastDllError
        GetGPOs = lRet
        Exit Function
    End If
    
    lRet = FreeGPOList(mPtr)
    GetGPOs = lRet
    
End Function

Public Function StrFromPtrA(lpStr As Long) As String

   StrFromPtrA = String(lstrlenA(ByVal lpStr), 0&)
   Call lstrcpyA(ByVal StrFromPtrA, ByVal lpStr)
   
End Function