PureBasic Forum

#ADS_SERVER_BIND = $200
#ADS_SECURE_AUTHENTICATION = 1

XIncludeFile "COMatePLUS.pbi"
Global Dim Username$(1)

;===========================
Procedure.s LDAP_GetDNSServer()
    Result$ = "Error - unable to complete"
    objRootDSE.COMateObject
    objRootDSE = COMate_GetObject("LDAP://RootDSE")
    If objRootDSE   
        Result$ = objRootDSE\GetStringProperty("dnsHostName")       
    EndIf
    objRootDSE\Release()
    ProcedureReturn Result$
EndProcedure
;Debug LDAP_GetDNSServer()
;===========================
Procedure.s LDAP_GetDefaultNamingContext()        ;ex.:  "DC=Domain,DC=com"
    Result$ = "Error - unable to complete"
    objRootDSE.COMateObject
    objRootDSE = COMate_GetObject("LDAP://RootDSE")
    If objRootDSE   
        objRootDSE\GetStringProperty("dnsHostName")
        Result$ = objRootDSE\GetStringProperty("DefaultNamingContext")       
    EndIf
    objRootDSE\Release()
    ProcedureReturn Result$
EndProcedure
;Debug LDAP_GetDefaultNamingContext()   
;===========================
Procedure.l LDAP_CountUsers(DefaultNamingContext$)
    objConnection.CoMateObject
    objCommand.CoMateObject
    objRecordSet.CoMateObject   
    objConnection = COMate_CreateObject("ADODB.Connection")
    objCommand = COMate_CreateObject("ADODB.Command")
    objRecordSet = COMate_CreateObject("ADODB.RecordSet")
    If objConnection And objCommand And objRecordSet
        objConnection\SetProperty("Provider = 'ADsDSOObject'")
        If objConnection\Invoke("Open('Active Directory Provider')") = #S_OK
            String$ = "<GC://" + DefaultNamingContext$ + ">;(objectCategory=User);sAMAccountName;subtree"
            If COMate_GetLastErrorCode() = #S_OK
                objCommand\SetProperty("ActiveConnection = " + Str(objConnection) + " as COMateObject")
                objCommand\SetProperty("Properties('Page Size') = 1000")
                objCommand\SetProperty("CommandText = '" + String$ + "'")
                objRecordSet = objCommand\GetObjectProperty("Execute()")
                err$ = COMate_GetLastErrorDescription()
                If objRecordSet
                    rcount.l = objRecordSet\GetIntegerProperty("RecordCount")
                    If rcount > 0
                        CurrentItem.l = 0
                        For counter.l = 1 To rcount
                            If Trim(objRecordSet\GetStringProperty("Fields('sAMAccountName')\Value")) <> ""
                                CurrentItem = CurrentItem + 1   
                            EndIf
                            objRecordSet\Invoke("MoveNext")
                        Next
                    EndIf
                    objRecordSet\Invoke("Close")
                EndIf               
            EndIf   
        EndIf
        objRecordSet\Release()
        objCommand\Release()
        objConnection\Release()
    EndIf   
    ProcedureReturn CurrentItem
EndProcedure 
;DefaultNamingContext$ = LDAP_GetDefaultNamingContext()
;Debug LDAP_CountUsers(DefaultNamingContext$)
;===========================
Procedure.l LDAP_GetUserList(DefaultNamingContext$, NbrUsers.l)
    If NbrUsers > 0
        Dim Username$(NbrUsers-1)
        objConnection.CoMateObject
        objCommand.CoMateObject
        objRecordSet.CoMateObject   
        objConnection = COMate_CreateObject("ADODB.Connection")
        objCommand = COMate_CreateObject("ADODB.Command")
        objRecordSet = COMate_CreateObject("ADODB.RecordSet")
        If objConnection And objCommand And objRecordSet
            objConnection\SetProperty("Provider = 'ADsDSOObject'")
            If objConnection\Invoke("Open('Active Directory Provider')") = #S_OK
                String$ = "<GC://" + DefaultNamingContext$ + ">;(objectCategory=User);sAMAccountName;subtree"
                If COMate_GetLastErrorCode() = #S_OK
                    objCommand\SetProperty("ActiveConnection = " + Str(objConnection) + " as COMateObject")
                    objCommand\SetProperty("Properties('Page Size') = 100")
                    objCommand\SetProperty("CommandText = '" + String$ + "'")
                    objRecordSet = objCommand\GetObjectProperty("Execute()")
                    err$ = COMate_GetLastErrorDescription()
                    If objRecordSet
                        rcount.l = objRecordSet\GetIntegerProperty("RecordCount")
                        If rcount > 0
                            CurrentItem.l = 0
                            For counter.l = 1 To rcount
                                User$ = objRecordSet\GetStringProperty("Fields('sAMAccountName')\Value")
                                If Trim(User$) <> ""
                                    Username$(CurrentItem) = User$
                                    CurrentItem = CurrentItem + 1   
                                EndIf
                                objRecordSet\Invoke("MoveNext")
                            Next
                            SortArray(Username$(), #PB_Sort_Ascending|#PB_Sort_NoCase)
                        EndIf
                        objRecordSet\Invoke("Close")
                    EndIf               
                EndIf   
            EndIf
            objRecordSet\Release()
            objCommand\Release()
            objConnection\Release()
        EndIf   
    EndIf
    ProcedureReturn CurrentItem
EndProcedure
;DefaultNamingContext$ = LDAP_GetDefaultNamingContext()
;NbrUsers.l = LDAP_CountUsers(DefaultNamingContext$)
;LDAP_GetUserList(DefaultNamingContext$, NbrUsers)   
;For counter.l = 0 To NbrUsers-1 : Debug Username$(counter) : Next
;===========================
Procedure.s LDAP_GetUserInfo(DefaultNamingContext$, Username$)
    Result$ = ""
    objConnection.COMateObject
    objCommand.COMateObject
    objRecordSet.COMateObject
    objConnection = COMate_CreateObject("ADODB.Connection")
    objCommand = COMate_CreateObject("ADODB.Command")
    objRecordSet = COMate_CreateObject("ADODB.RecordSet")
    If objConnection And objCommand And objRecordSet
        objConnection\SetProperty("Provider='ADsDSOObject'")
        If objConnection\Invoke("Open('Active Directory Provider')") = #S_OK
            String$ = "<GC://" + DefaultNamingContext$ + ">;(objectCategory=User);sAMAccountName,displayName,distinguishedName,givenName,sn,mail,userPrincipalName,telephoneNumber,facsimileTelephoneNumber,department,company;subtree"
            If COMate_GetLastErrorCode() = #S_OK
                objCommand\SetProperty("ActiveConnection = " + Str(objConnection) + " as COMateObject")
                objCommand\SetProperty("Properties('Page Size') = 100")
                objCommand\SetProperty("CommandText = '" + String$ + "'")
                objRecordSet = objCommand\GetObjectProperty("Execute()")                   
                ;err$ = COMate_GetLastErrorDescription()
                If objRecordSet
                    rcount.l = objRecordSet\GetIntegerProperty("RecordCount")
                    If rcount > 0
                        For counter.l = 1 To rcount
                            If objRecordSet\GetStringProperty("Fields('sAMAccountName')\Value") = Username$
                                Result$ = objRecordSet\GetStringProperty("Fields('displayName')\Value")
                                Result$ + "/" + objRecordSet\GetStringProperty("Fields('distinguishedName')\Value")
                                Result$ + "/" + objRecordSet\GetStringProperty("Fields('givenName')\Value")
                                Result$ + "/" + objRecordSet\GetStringProperty("Fields('sn')\Value")
                                Result$ + "/" + objRecordSet\GetStringProperty("Fields('mail')\Value")
                                Result$ + "/" + objRecordSet\GetStringProperty("Fields('userPrincipalName')\Value")
                                Result$ + "/" + objRecordSet\GetStringProperty("Fields('telephoneNumber')\Value")
                                Result$ + "/" + objRecordSet\GetStringProperty("Fields('facsimileTelephoneNumber')\Value")
                                Result$ + "/" + objRecordSet\GetStringProperty("Fields('department')\Value")
                                Result$ + "/" + objRecordSet\GetStringProperty("Fields('company')\Value")                                                               
                                counter = rcount
                            EndIf                       
                            objRecordSet\Invoke("MoveNext")
                        Next
                    EndIf
                    objRecordSet\Invoke("Close")
                EndIf   
            EndIf
        EndIf
        objRecordSet\Release()
        objCommand\Release()
        objConnection\Release()
    Else
        Result$ = "Error - ADO not available"       
    EndIf
    ProcedureReturn Result$
EndProcedure
;DefaultNamingContext$ = LDAP_GetDefaultNamingContext()
;Debug LDAP_GetUserInfo(DefaultNamingContext$, "User")
;===========================
Procedure.l LDAP_IsAccountLocked(Domain$, Username$)
    IsLocked.l = #False
    objUser.COMateObject
    objUser = COMate_GetObject("WinNT://" + Domain$ + "/" + Username$)
    If objUser
        If objUser\GetIntegerProperty("IsAccountLocked") = -1
            IsLocked.l = #True
        EndIf
        objUser\Release()
    EndIf
    ProcedureReturn IsLocked
EndProcedure
;Debug LDAP_IsAccountLocked("MyDomain.com", "User")
;===========================
Procedure.l LDAP_IsAccountDisabled(Domain$, Username$)
    IsDisabled.l = #False
    objUser.COMateObject
    objUser = COMate_GetObject("WinNT://" + Domain$ + "/" + Username$)
    If objUser
        If objUser\GetIntegerProperty("AccountDisabled") = -1
            IsDisabled.l = #True
        EndIf
        objUser\Release()
    EndIf
    ProcedureReturn IsDisabled
EndProcedure
;Debug LDAP_IsAccountDisabled("MyDomain.com", "User")


;===========================
Procedure.l LDAP_GetLockoutThreshold(DefaultNamingContext$)
    objDomain.COMateObject
    objDomain = COMate_GetObject("LDAP://" + DefaultNamingContext$)
    If objDomain
        LockoutThreshold.l = objDomain\GetIntegerProperty("Get('lockoutThreshold')")
        objDomain\Release()
    EndIf
    ProcedureReturn LockoutThreshold
EndProcedure
;DefaultNamingContext$ = LDAP_GetDefaultNamingContext()
;Debug LDAP_GetLockoutThreshold(DefaultNamingContext$)
;===========================
Procedure.l LDAP_EnableAccount(DNSServer$, DistinguishedName$, DomainAdmin$, DomainPassword$)
    LDAP$ = "LDAP://" + DNSServer$ + "/" + DistinguishedName$
    objDSO.COMateObject
    objUser.COMateObject       
    objDSO = COMate_GetObject("LDAP:")
    If objDSO
        objUser = objDSO\GetObjectProperty("OpenDSObject('" + LDAP$ + "','" + DomainAdmin$ + "','" + DomainPassword$ + "','" + Str(#ADS_SERVER_BIND | #ADS_SECURE_AUTHENTICATION) + "')")
        If objUser
            If objUser\GetIntegerProperty("AccountDisabled") = -1
                objUser\SetProperty("AccountDisabled = 0")
                objUser\Invoke("SetInfo")
            EndIf
            objUser\Release()
        EndIf
        objDSO\Release()
    EndIf
EndProcedure
;Username$ = "xxxxxxx"
;DomainAdmin$ = "xxxxxxx"
;DomainPassword$ = "xxxxxxx"
;DNSServer$ = StringField(LDAP_GetDNSServer(),1,".")
;DefaultNamingContext$ = LDAP_GetDefaultNamingContext()
;DistinguishedName$ = StringField(LDAP_GetUserInfo(DefaultNamingContext$, Username$), 2, "/")
;LDAP_EnableAccount(DNSServer$, DistinguishedName$, DomainAdmin$, DomainPassword$)
;===========================
Procedure.l LDAP_DisableAccount(DNSServer$, DistinguishedName$, DomainAdmin$, DomainPassword$)
    LDAP$ = "LDAP://" + DNSServer$ + "/" + DistinguishedName$
    objDSO.COMateObject
    objUser.COMateObject       
    objDSO = COMate_GetObject("LDAP:")
    If objDSO
        objUser = objDSO\GetObjectProperty("OpenDSObject('" + LDAP$ + "','" + DomainAdmin$ + "','" + DomainPasswordDecoded$ + "','" + Str(#ADS_SERVER_BIND | #ADS_SECURE_AUTHENTICATION) + "')")
        If objUser
            If objUser\GetIntegerProperty("AccountDisabled") = 0
                objUser\SetProperty("AccountDisabled = -1")
                objUser\Invoke("SetInfo")
            EndIf
            objUser\Release()
        EndIf
        objDSO\Release()
    EndIf
EndProcedure
;Username$ = "xxxxxxx"
;DomainAdmin$ = "xxxxxxx"
;DomainPassword$ = "xxxxxxx"
;DNSServer$ = StringField(LDAP_GetDNSServer(),1,".")
;DefaultNamingContext$ = LDAP_GetDefaultNamingContext()
;DistinguishedName$ = StringField(LDAP_GetUserInfo(DefaultNamingContext$, Username$), 2, "/")
;LDAP_EnableAccount(DNSServer$, DistinguishedName$, DomainAdmin$, DomainPassword$)
;===========================
Procedure.l LDAP_UnlockAccount(DNSServer$, DistinguishedName$, DomainAdmin$, DomainPassword$)
    LDAP$ = "LDAP://" + DNSServer$ + "/" + DistinguishedName$
    objDSO.COMateObject
    objUser.COMateObject       
    objDSO = COMate_GetObject("LDAP:")
    If objDSO
        objUser = objDSO\GetObjectProperty("OpenDSObject('" + LDAP$ + "','" + DomainAdmin$ + "','" + DomainPassword$ + "','" + Str(#ADS_SERVER_BIND | #ADS_SECURE_AUTHENTICATION) + "')")
        If objUser
            If objUser\GetIntegerProperty("IsAccountLocked") = -1
                objUser\SetProperty("IsAccountLocked = 0")
                objUser\Invoke("SetInfo")
            EndIf
            objUser\Release()
        EndIf
        objDSO\Release()
    EndIf
EndProcedure
;Username$ = "xxxxxxx"
;DomainAdmin$ = "xxxxxxx"
;DomainPassword$ = "xxxxxxx"
;DNSServer$ = StringField(LDAP_GetDNSServer(),1,".")
;DefaultNamingContext$ = LDAP_GetDefaultNamingContext()
;DistinguishedName$ = StringField(LDAP_GetUserInfo(DefaultNamingContext$, Username$), 2, "/")
;LDAP_UnlockAccount(DNSServer$, DistinguishedName$, DomainAdmin$, DomainPassword$)
;===========================
Procedure.l LDAP_LockAccount(DefaultNamingContext$, LockoutThreshold.l, Username$)
    If LockoutThreshold > 0
        objDSO.COMateObject
        objDSO = COMate_GetObject("LDAP:")
        If objDSO
            For counter.l = 0 To LockoutThreshold 
                objUser = objDSO\GetObjectProperty("OpenDSObject('LDAP://" + DefaultNamingContext$ + "','" + Username$ + "','WRONG_PASSWORD','" + Str(#ADS_SECURE_AUTHENTICATION) + "')")
            Next
            objDSO\Release()
        EndIf
    EndIf
EndProcedure
;Username$ = "xxxxxxx"
;DefaultNamingContext$ = LDAP_GetDefaultNamingContext()
;LockoutThreshold.l = LDAP_GetLockoutThreshold(DefaultNamingContext$)
;LDAP_LockAccount(DefaultNamingContext$, LockoutThreshold.l, Username$)
;===========================
Procedure.l LDAP_SetPassword(DNSServer$, DistinguishedName$, DomainAdmin$, DomainPassword$, NewPassword$, ForceChangeAtNextLogin.l)
    LDAP$ = "LDAP://" + DNSServer$ + "/" + DistinguishedName$
    objDSO.COMateObject
    objUser.COMateObject       
    objDSO = COMate_GetObject("LDAP:")
    If objDSO
        objUser = objDSO\GetObjectProperty("OpenDSObject('" + LDAP$ + "','" + DomainAdmin$ + "','" + DomainPassword$ + "','" + Str(#ADS_SERVER_BIND | #ADS_SECURE_AUTHENTICATION) + "')")
        If objUser
            objUser\Invoke("SetPassword('" + NewPassword$ + "')")
            If ForceChangeAtNextLogin = 1
                objUser\Invoke("Put('pwdLastSet', 0)")
            EndIf
            objUser\Invoke("SetInfo")
            objUser\Release()
        EndIf
        objDSO\Release()
    EndIf
EndProcedure
;Username$ = "xxxxxxx"
;DomainAdmin$ = "xxxxxxx"
;DomainPassword$ = "xxxxxxx"
;DNSServer$ = StringField(LDAP_GetDNSServer(),1,".")
;DefaultNamingContext$ = LDAP_GetDefaultNamingContext()
;DistinguishedName$ = StringField(LDAP_GetUserInfo(DefaultNamingContext$, Username$), 2, "/")
;LDAP_SetPassword(DNSServer$, DistinguishedName$, DomainAdmin$, DomainPassword$, "ThisNewPassword", 1)