ADSI(Active Directory Service Interface)是用来对AD中存储数据的访问接口,我认为他是一个架空的框架,与具体的数据访问无关,只是给上层应用提供一个统一的接口。实际工作的就是Provider,应当是Provider访问数据,然后包装成ADSI要求的形式,这些工作对用用户来说完全透明。
Public Function EnumGroups() As VBA.Collection Dim adDomain As IADsContainer Dim adGroup As IADsGroup Dim nResult As VBA.Collection
If m_sAdmin <> vbNullString Then Set adDomain = m_adRoot.OpenDSObject("LDAP://" & m_sExchServer & "/CN=Users," & m_sDomain, _ m_sAdmin, m_sAdminPwd, ADS_SECURE_AUTHENTICATION) Else Set adDomain = GetObject("LDAP://CN=Users," & m_sDomain) End If If adDomain Is Nothing Then Exit Function
Set nResult = New VBA.Collection adDomain.Filter = Array("group","user"”)
On Error Resume Next Dim sName As String Dim sType As String For Each adGroup In adDomain sName = Right(adGroup.Name, Len(adGroup.Name) - 3) ' filter "CN=" Debug.Print sName sType = adGroup.Get(cPropCustomType) If Err.Number = 0 And sType = cTypeRC Then nResult.Add sName, sName End If Err.Clear Next Set EnumGroups = nResult End Function
' add new user to Domain and create mailbox for it Public Function AddAccountEx(ByVal sAccount As String, ByVal sfullName As String, ByVal sDesc As String, _ ByVal sPassword As String) As Long Dim adDomain As IADsContainer Dim adNewUser As IADsUser Dim oMailStore As CDOEXM.IMailboxStore Dim oExchServer As CExchageManager
If m_sAdmin <> vbNullString Then Set adDomain = m_adRoot.OpenDSObject("LDAP://CN=Users," & m_sDomain, _ m_sAdmin, m_sAdminPwd, ADS_SECURE_AUTHENTICATION) Else Set adDomain = GetObject("LDAP://CN=Users," & m_sDomain) End If
Public Function SearchGroup() As ADOdb.Recordset Dim oResult As ADODB.Recordset Dim oCommand As ADODB.Command Dim sConnectionStr As String
If m_sAdmin = vbNullString Then sConnectionStr = "Provider=ADsDSOObject" Else sConnectionStr = "Provider=ADsDSOObject;UID=" & m_sAdmin & ";PWD=" & m_sAdminPwd End If
Set oCommand = New ADODB.Command With oCommand .ActiveConnection = sConnectionStr .CommandTimeout = 15 .CommandText = "select name,description FROM 'LDAP://" & m_sDomain _ & "' WHERE objectCategory='group'" Debug.Print .CommandText .Properties("searchscope") = ADS_SCOPE_SUBTREE .Properties("Chase referrals") = ADS_CHASE_REFERRALS_EXTERNAL Set oResult = .Execute End With If Not oResult Is Nothing Then Do Until oResult.EOF Debug.Print oResult("name"), oResult("description")(0) oResult.MoveNext Loop End If End Function