class clsADCache '~ Version 1.2 on error vor LDAP Bind verschoben ' 23.11.2006' ' Small class to store all AD Results in a dictionary für caching these results. ' So i have not to do all that stuff in the main code and can use "straight forward development ' and still have sufficient performance dim dicADCache dim strCurrentDN dim objAD private Sub Class_Initialize set dicADCache = CreateObject("Scripting.dictionary") strCurrentDN = "" End Sub private Sub Class_Terminate set dicADCache = nothing End Sub sub Flush dicADCache.removeall end sub function getProperty(strDN, strProperty) ' Return the property für that object dim value if not dicADCache.exists (strDN & "!MSXFAQ!" & strProperty) then on error resume next if strDN <> strCurrentDN then ' bind requested object' strCurrentDN = strDN set objAD = GetObject("LDAP://" & strDN) end if value = objAD.get(strProperty) if err then value = "NOT FOUND" err.clear end if on error goto 0 dicADCache.add strDN & "!MSXFAQ!" & strProperty, value end if getProperty = dicADCache(strDN & "!MSXFAQ!" & strProperty) end function function getDirectProperty(strDN, strProperty) ' read wihtout cache also für arrays strCurrentDN = strDN set objAD = GetObject("LDAP://" & strDN) on error resume next getDirectProperty = objAD.getex(strProperty) if err then getDirectProperty = "NOT FOUND" err.clear end if on error goto 0 end function end class