Active Directory et ASP
Robert PARLSON
-
kami58 Messages postés 2 Statut Membre -
kami58 Messages postés 2 Statut Membre -
Bonjour,
Quelqu'un peut -il m'aider en me donnant un exemple de code ASP ou VB, effectuant le traitement suivant :
Authentifier des utilisateurs en vérifiant leur présence dans la base de données utilisateurs d'Active Directory.
Merci d'avance
Robert
Quelqu'un peut -il m'aider en me donnant un exemple de code ASP ou VB, effectuant le traitement suivant :
Authentifier des utilisateurs en vérifiant leur présence dans la base de données utilisateurs d'Active Directory.
Merci d'avance
Robert
A voir également:
- Active Directory et ASP
- Directory list & print - Télécharger - Divers Utilitaires
- Comment activé - Guide
- Active partition disk - Télécharger - Stockage
- Directory opus - Télécharger - Gestion de fichiers
- Npd activé c'est quoi - Guide
1 réponse
V'là ce qui traine chez Microsoft pour 'Example Code for Searching for Users' ...
URL = http://msdn.microsoft.com/library/default.asp?url=/library/en-us/netdir/ad/example_code_for_searching_for_users.asp
---------------------------------------------------------------------------
Dim Con As ADODB.Connection
Dim ocommand As ADODB.Command
Dim gc As IADs
On Error Resume Next
'Maximum number of items to list on a msgbox.
MAX_DISPLAY = 5
'Prompt for surname to search for.
strName = InputBox("This routine searches in the current domain for users with the specified surname." & vbCrLf & vbCrLf &"Specify the surname:")
If strName = "" Then
msgbox "No surname was specified. The routine will search for all users."
End If
'Create ADO connection object for Active Directory
Set Con = CreateObject("ADODB.Connection")
If (Err.Number <> 0) Then
BailOnFailure Err.Number, "on CreateObject"
End If
Con.Provider = "ADsDSOObject"
If (Err.Number <> 0) Then
BailOnFailure Err.Number, "on Provider"
End If
Con.Open "Active Directory Provider"
If (Err.Number <> 0) Then
BailOnFailure Err.Number, "on Open"
End If
'Create ADO command object for the connection.
Set ocommand = CreateObject("ADODB.Command")
If (Err.Number <> 0) Then
BailOnFailure Err.Number, "on CreateObject"
End If
ocommand.ActiveConnection = Con
If (Err.Number <> 0) Then
BailOnFailure Err.Number, "on Active Connection"
End If
'Get the ADsPath for the domain to search.
Set root = GetObject("LDAP://rootDSE")
If (Err.Number <> 0) Then
BailOnFailure Err.Number, "on GetObject for rootDSE"
End If
sDomain = root.Get("defaultNamingContext")
If (Err.Number <> 0) Then
BailOnFailure Err.Number, "on Get on defaultNamingContext"
End If
Set domain = GetObject("LDAP://" & sDomain)
If (Err.Number <> 0) Then
BailOnFailure Err.Number, "on GetObject for domain"
End If
'Build the ADsPath element of the commandtext
sADsPath = "<" & domain.ADsPath & ">"
'Build the filter element of the commandtext
If (strName = "") Then
sFilter = "(&(objectCategory=person)(objectClass=user))"
Else
sFilter = "(&(objectCategory=person)(objectClass=user)(sn=" & strName & "))"
End If
'Build the returned attributes element of the commandtext.
sAttribsToReturn = "name,distinguishedName"
'Build the depth element of the commandtext.
sDepth = "subTree"
'Assemble the commandtext.
ocommand.CommandText = sADsPath & ";" & sFilter & ";" & sAttribsToReturn & ";" & sDepth
If (Err.Number <> 0) Then
BailOnFailure Err.Number, "on CommandText"
End If
'Display
show_items "CommandText: " & ocommand.CommandText, ""
'Execute the query.
Set rs = ocommand.Execute
If (Err.Number <> 0) Then
BailOnFailure Err.Number, "on Execute"
End If
strText = "Found " & rs.RecordCount & " Users in the domain:"
intNumDisplay = 0
intCount = 0
' Navigate the record set
rs.MoveFirst
While Not rs.EOF
intCount = intCount + 1
strText = strText & vbCrLf & intCount & ") "
For i = 0 To rs.Fields.Count - 1
If rs.Fields(i).Type = adVariant And Not (IsNull(rs.Fields(i).Value)) Then
strText = strText & rs.Fields(i).Name & " = "
For j = LBound(rs.Fields(i).Value) To UBound(rs.Fields(i).Value)
strText = strText & rs.Fields(i).Value(j) & " "
Next
Else
strText = strText & rs.Fields(i).Name & " = " & rs.Fields(i).Value & vbCrLf
End If
Next
intNumDisplay = intNumDisplay + 1
'Display in msgbox if there are MAX_DISPLAY items to display
If intNumDisplay = MAX_DISPLAY Then
Call show_items(strText, "Users in domain")
strText = ""
intNumDisplay = 0
End If
rs.MoveNext
Wend
show_items strText, "Users in domain"
'''''''''''''''''''''''''''''''''''''''
'Display subroutines
'''''''''''''''''''''''''''''''''''''''
Sub show_items(strText, strName)
MsgBox strText, vbInformation, "Search domain for users with Surname " & strName
End Sub
Sub BailOnFailure(ErrNum, ErrText) strText = "Error 0x" & Hex(ErrNum) & " " & ErrText
MsgBox strText, vbInformation, "ADSI Error"
WScript.Quit
End Sub
Envoyé par Alexandre GROLLEAU
Alias kami58
URL = http://msdn.microsoft.com/library/default.asp?url=/library/en-us/netdir/ad/example_code_for_searching_for_users.asp
---------------------------------------------------------------------------
Dim Con As ADODB.Connection
Dim ocommand As ADODB.Command
Dim gc As IADs
On Error Resume Next
'Maximum number of items to list on a msgbox.
MAX_DISPLAY = 5
'Prompt for surname to search for.
strName = InputBox("This routine searches in the current domain for users with the specified surname." & vbCrLf & vbCrLf &"Specify the surname:")
If strName = "" Then
msgbox "No surname was specified. The routine will search for all users."
End If
'Create ADO connection object for Active Directory
Set Con = CreateObject("ADODB.Connection")
If (Err.Number <> 0) Then
BailOnFailure Err.Number, "on CreateObject"
End If
Con.Provider = "ADsDSOObject"
If (Err.Number <> 0) Then
BailOnFailure Err.Number, "on Provider"
End If
Con.Open "Active Directory Provider"
If (Err.Number <> 0) Then
BailOnFailure Err.Number, "on Open"
End If
'Create ADO command object for the connection.
Set ocommand = CreateObject("ADODB.Command")
If (Err.Number <> 0) Then
BailOnFailure Err.Number, "on CreateObject"
End If
ocommand.ActiveConnection = Con
If (Err.Number <> 0) Then
BailOnFailure Err.Number, "on Active Connection"
End If
'Get the ADsPath for the domain to search.
Set root = GetObject("LDAP://rootDSE")
If (Err.Number <> 0) Then
BailOnFailure Err.Number, "on GetObject for rootDSE"
End If
sDomain = root.Get("defaultNamingContext")
If (Err.Number <> 0) Then
BailOnFailure Err.Number, "on Get on defaultNamingContext"
End If
Set domain = GetObject("LDAP://" & sDomain)
If (Err.Number <> 0) Then
BailOnFailure Err.Number, "on GetObject for domain"
End If
'Build the ADsPath element of the commandtext
sADsPath = "<" & domain.ADsPath & ">"
'Build the filter element of the commandtext
If (strName = "") Then
sFilter = "(&(objectCategory=person)(objectClass=user))"
Else
sFilter = "(&(objectCategory=person)(objectClass=user)(sn=" & strName & "))"
End If
'Build the returned attributes element of the commandtext.
sAttribsToReturn = "name,distinguishedName"
'Build the depth element of the commandtext.
sDepth = "subTree"
'Assemble the commandtext.
ocommand.CommandText = sADsPath & ";" & sFilter & ";" & sAttribsToReturn & ";" & sDepth
If (Err.Number <> 0) Then
BailOnFailure Err.Number, "on CommandText"
End If
'Display
show_items "CommandText: " & ocommand.CommandText, ""
'Execute the query.
Set rs = ocommand.Execute
If (Err.Number <> 0) Then
BailOnFailure Err.Number, "on Execute"
End If
strText = "Found " & rs.RecordCount & " Users in the domain:"
intNumDisplay = 0
intCount = 0
' Navigate the record set
rs.MoveFirst
While Not rs.EOF
intCount = intCount + 1
strText = strText & vbCrLf & intCount & ") "
For i = 0 To rs.Fields.Count - 1
If rs.Fields(i).Type = adVariant And Not (IsNull(rs.Fields(i).Value)) Then
strText = strText & rs.Fields(i).Name & " = "
For j = LBound(rs.Fields(i).Value) To UBound(rs.Fields(i).Value)
strText = strText & rs.Fields(i).Value(j) & " "
Next
Else
strText = strText & rs.Fields(i).Name & " = " & rs.Fields(i).Value & vbCrLf
End If
Next
intNumDisplay = intNumDisplay + 1
'Display in msgbox if there are MAX_DISPLAY items to display
If intNumDisplay = MAX_DISPLAY Then
Call show_items(strText, "Users in domain")
strText = ""
intNumDisplay = 0
End If
rs.MoveNext
Wend
show_items strText, "Users in domain"
'''''''''''''''''''''''''''''''''''''''
'Display subroutines
'''''''''''''''''''''''''''''''''''''''
Sub show_items(strText, strName)
MsgBox strText, vbInformation, "Search domain for users with Surname " & strName
End Sub
Sub BailOnFailure(ErrNum, ErrText) strText = "Error 0x" & Hex(ErrNum) & " " & ErrText
MsgBox strText, vbInformation, "ADSI Error"
WScript.Quit
End Sub
Envoyé par Alexandre GROLLEAU
Alias kami58
