PureBasic Forums - English

Code: Select all

EnableExplicit

IncludePath #PB_Compiler_Home + "INCLUDES\"
XIncludeFile "COMatePLUS.pbi"
XIncludeFile "VariantHelper_Include.pb"

#False = 0
#True = 1
#ADS_SCOPE_SUBTREE = 2

Declare ADObjectExists(object$, property$ = "sAMAccountName")
Declare ADGetUserGroups(Array group$(1), user$ = "")

Define.COMateObject oConnection, oDSE
Define.s sDNSDomain, sHostServer, sConfiguration

oConnection = COMate_CreateObject("ADODB.Connection")
Debug "COMate_CreateObject('ADODB.Connection')=" + COMate_GetLastErrorDescription()

If oConnection
  oConnection\SetProperty("Provider='ADsDSOObject;'")
  Debug "oConnection\SetProperty('Provider = ADsDSOObject')=" + COMate_GetLastErrorDescription()
  
  oConnection\invoke("Open('Active Directory Provider')")
  Debug "oConnection\invoke('Open('Active Directory Provider'')=" + COMate_GetLastErrorDescription()
  
  oDSE = COMate_GetObject("LDAP://RootDSE")
  Debug "COMate_GetObject('LDAP://RootDSE')=" + COMate_GetLastErrorDescription()
  If oDSE
    sHostServer = oDSE\GetStringProperty("dnsHostName")
    Debug "oDSE\GetStringProperty('dnsHostName')=" + sHostServer
    sConfiguration = oDSE\GetStringProperty("ConfigurationNamingContext")
    Debug "oDSE\GetStringProperty('ConfigurationNamingContext')=" + sConfiguration
    sDNSDomain = oDSE\GetStringProperty("defaultNamingContext")
    Debug "oDSE\GetStringProperty('defaultNamingContext')=" + sDNSDomain
    
    Dim userGroups$(10)
    Debug "ADGetUserGroups="+Hex(ADGetUserGroups(userGroups$(), "stowera"))
    Debug "after ArraySize(userGroups$())="+ Str(ArraySize(userGroups$()))
    Define i
    For i = 0 To ArraySize(userGroups$())-1
      Debug "Group "+Str(i)+": "+userGroups$(i)
    Next i
    oDSE\Release()
  EndIf
  oConnection\Release()
EndIf

End

Procedure ADObjectExists(object$, property$ = "sAMAccountName")
  ; return >0 if object exists, 0 otherwise
  Shared sHostServer, sDNSDomain, oConnection
  object$=LTrim(object$)
  object$ = ReplaceString(object$, "cn=", "",#PB_String_NoCase,1)
  Debug "object$="+object$
  Protected query$, recordCount
  Protected.COMateObject oRecordSet
  query$ = "<LDAP://" + sHostServer + "/" + sDNSDomain + ">;(" + property$ + "=" + object$ + ");ADsPath;subtree"
  Debug "query$="+query$
  
  If oConnection
    oRecordSet = oConnection\GetObjectProperty("Execute('" + query$ + "')")
    Debug "oConnection\GetObjectProperty=" + COMate_GetLastErrorDescription()
    Debug "oRecordSet="+Hex(oRecordSet)
    If oRecordSet
      recordCount = oRecordSet\GetIntegerProperty("RecordCount")
      Debug "oRecordSet\GetIntegerProperty=" + COMate_GetLastErrorDescription()
      Debug "recordCount="+Hex(recordCount)
      oRecordSet\Release()
      ProcedureReturn recordCount
    Else
      ; problem querying AD
      ProcedureReturn 0
    EndIf
  Else
    ; problem with AD connection
    ProcedureReturn 0
  EndIf
EndProcedure

Procedure ADGetUserGroups(Array group$(1), user$ = "")
; pass a string array which will be resized and filled with all groups
; the user is an immediate member of - if no user specified, defaults
; to logged on user
  Debug "ArraySize(group$())="+ Str(ArraySize(group$()))
  If user$=""
    user$ = GetEnvironmentVariable("USERNAME")
  EndIf
  Debug "before user$="+user$
  Shared sHostServer, sDNSDomain, oConnection
  user$=LTrim(user$)
  user$ = ReplaceString(user$, "cn=", "",#PB_String_NoCase,1)
  Debug "after user$="+user$
  Protected query$, recordCount, member
  Protected.COMateObject oRecordSet, oFields, oValue, oUser, oEnum
  query$ = "<LDAP://" + sHostServer + "/" + sDNSDomain + ">;(sAMAccountName=" + user$ + ");ADsPath;subtree"
  Debug "query$="+query$
  
  If oConnection
    oRecordSet = oConnection\GetObjectProperty("Execute('" + query$ + "')")
    Debug "oConnection\GetObjectProperty=" + COMate_GetLastErrorDescription()
    Debug "oRecordSet="+Hex(oRecordSet)
    If oRecordSet
      recordCount = oRecordSet\GetIntegerProperty("RecordCount")
      Debug "oRecordSet\GetIntegerProperty=" + COMate_GetLastErrorDescription()
      Debug "recordCount="+Hex(recordCount)
      If recordCount
        oFields = oRecordSet\GetObjectProperty("fields(0)")
        Debug "oRecordSet\GetObjectProperty('fields(0)')=" + COMate_GetLastErrorDescription()
        Debug "oFields="+Hex(oFields)
        If oFields
          Protected Value$ = oFields\GetStringProperty("value")
          Debug "oFields\GetStringProperty('value')=" + COMate_GetLastErrorDescription()
          Debug "Value$="+Value$
          oUser = COMate_GetObject(Value$)
          Debug "COMate_GetObject(Value$)=" + COMate_GetLastErrorDescription()
          If oUser
            Protected.VARIANT *members = oUser\GetVariantProperty("memberof")
            Debug "oUser\GetVariantProperty('memberof')=" + COMate_GetLastErrorDescription()
            Debug "*members="+Hex(*members)
            Protected.SAFEARRAY *memberArray = VT_ARRAY(*members)
            Protected *varDD.VARIANT, i
            Debug saLBound(*memberArray)
            Debug saUBound(*memberArray)
            ReDim group$(saUBound(*memberArray)+1)
            For i = saLBound(*memberArray) To saUBound(*memberArray)
              *varDD = SA_VARIANT(*memberArray, i)
              If *varDD\vt <> #VT_BSTR
                VariantChangeType_(*varDD, *varDD, 0, #VT_BSTR)
              EndIf
              Protected name$ = PeekS(*varDD\bstrVal, -1, #PB_Unicode)
              Debug name$
              group$(i)=name$
              VariantClear(*varDD)
            Next
            saFreeSafeArray(*memberArray)
            VariantClear(*members)
            FreeMemory(*members)
            oUser\Release()
          EndIf
          oFields\Release()
        EndIf
      EndIf
      oRecordSet\Release()
      ProcedureReturn recordCount
    Else
      ; problem querying AD
      ProcedureReturn 0
    EndIf
  Else
    ; problem with AD connection
    ProcedureReturn 0
  EndIf
EndProcedure