Probleme Sur un Sript AD

Version imprimable

bonjour, voici mon probleme
j'ai fait un petit script qui me permet de trouver des comptes ayant une date d'expiration
concernant l'affichage de service, nologin, displayname,chemin LDAP aucun probleme, par contre pour afficher la date de l'expiration du compte impossibilite bien sur tout ca dans un fichier

voici mon script, merci pour votre aide

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
'========================
'Option Explicit
 
Dim dtmAdjusted, lngSeconds, str64Bit, dtmDateValue
Dim objShell, lngBiasKey, lngBias, k
Dim objRootDSE, strDNSDomain, objConnection, objRecordset
Dim strBase, strFilter, strAttributes, strQuery, strDN, strFileName
 
dtmDateValue = #02/11/2008# 
 
' Obtain local Time Zone bias from machine registry.
Set objShell = CreateObject("Wscript.Shell")
lngBiasKey = objShell.RegRead("HKLM\System\CurrentControlSet\Control\" _
& "TimeZoneInformation\ActiveTimeBias")
If UCase(TypeName(lngBiasKey)) = "LONG" Then
lngBias = lngBiasKey
ElseIf UCase(TypeName(lngBiasKey)) = "VARIANT()" Then
lngBias = 0
For k = 0 To UBound(lngBiasKey)
lngBias = lngBias + (lngBiasKey(k) * 256^k)
Next
End If
 
' Convert current date/time value to UTC.
dtmAdjusted = DateAdd("n", lngBias, dtmDateValue)
 
 
' Find number of seconds since 1/1/1601.
lngSeconds = DateDiff("s", #1/1/1601#, dtmAdjusted)
 
' Convert the number of seconds to a string
' and convert to 100-nanosecond intervals.
str64Bit = CStr(lngSeconds) & "0000000"
 
 
' Determine DNS domain name.
Set objRootDSE = GetObject("LDAP://rootDSE")
strDNSDomain = objRootDSE.Get("defaultNamingContext")
 
' Use ADO to search Active Directory.
Set objConnection = CreateObject("ADODB.Connection")
objConnection.Provider = "ADsDSOObject"
objConnection.Open "Active Directory Provider"
Set objRecordset = CreateObject("ADODB.Recordset")
objRecordset.ActiveConnection = objConnection
 
' cherche domaine.
strBase = "<LDAP://" & strDNSDomain & ">"
 
 
 
' Filtre expiration de compte.
strFilter = "(& (objectCategory=person)(objectClass=user)" _
& "(accountExpires<=" & str64Bit & ")(!accountExpires=0))"
 
 
'--- search for object in AD ---
On Error Resume Next
 
Set objUser = GetObject _
("LDAP://rootDSE")
 
dtmAccountExpiration = objUser.AccountExpiration
 
If Err.Number = -2147467259 Or dtmAccountExpiration = #1/1/1601# Then
'WScript.Echo "No account expiration date specified"
Else
'WScript.Echo "Account expiration date: " & objUser.AccountExpiration -1
End If
 
 
 
' Retrieve Distinguished Names.
strAttributes = "distinguishedName,department,name,displayName,dtmaccountExpiration"',accountexpires"
 
 
' Use ADO to query AD.
strQuery = strBase & ";" & strFilter & ";" & objectClass & "," & strAttributes & ";subtree"
objRecordset.Source = strQuery
objRecordset.Open
 
'Declaration des constantes pour gérer les fichiers resultats et sauvegardes
Repsource ="d:\"
RepDest ="d:\essai\"
filename ="test.txt"
 
'Verification de l'existance du fichier 
Set fso = CreateObject("Scripting.FilesystemObject")
 
If (fso.fileExists (filename)) Then
'Sauvegarde du fichier tous les jours
fso.Copyfile filename, RepDest 
Set f = fso.OpenTextFile (filename,2)
Else
Set f = fso.CreateTextFile(filename)
End If
 
' Enumerate expired user accounts.
Do Until objRecordSet.EOF
strDN = objRecordSet.Fields("distinguishedName")
StrDP = objRecordset.Fields("department")
STRNA = objRecordset.Fields("name")
strDD = objRecordset.Fields("displayName")
strAE = objrecordset.fields("dtmAccountExpiration")
'STREX = objRecordset.Fields("AccountExpires")
'WScript.Echo strDp 
f.write strdp & ";" & strna & ";" & strDD & ";" & strAE & ";" & strdn & vbCrLf '";" & strex &
objRecordSet.MoveNext
Loop
 
f.close
MsgBox "Fin"
' Clean up.
objRecordset.Close
objConnection.Close
Set objRootDSE = Nothing
Set objConnection = Nothing
Set objRecordSet = Nothing

Salut,

pour etre honnete je ne comprends pas grand chose à ton script.
Il y a des bout de codes qui pourraient marcher ou qui font 2 fois la même chose, mais mis bout à bout ca ne donne pas grand résultat. Plus toutes ces lignes que tu as mis en commentaire et qui peuvent etre utiles...
Vu le peu de réponses que tu as, je te propose de tout reprendre à 0 et de voir comment je fais dans cet exemple :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
On Error Resume Next

Const ADS_SCOPE_SUBTREE = 2
Set objConnection = CreateObject("ADODB.Connection")
Set objCommand =   CreateObject("ADODB.Command")
objConnection.Provider = "ADsDSOObject"
objConnection.Open "Active Directory Provider"
Set objCommand.ActiveConnection = objConnection

objCommand.Properties("Page Size") = 2000
objCommand.Properties("Searchscope") = ADS_SCOPE_SUBTREE

Set objExcel = CreateObject("Excel.Application")
Set ObjFso = CreateObject("Scripting.FileSystemObject")

objExcel.Visible = True
objExcel.Workbooks.Add()


SiteOpt = "Ou=Users,Ou=Site, Ou=Location,dc=fabrikam,dc=com"

objExcel.Cells(1, 1).Value = "Liste des Comptes dont le compte n'expire jamais, le " & FormatDateTime(Now, vbLongDate)
objExcel.Cells(1, 1).Font.Bold = True
objExcel.Cells(1, 1).Font.Size = 10
objExcel.Cells(1, 1).Font.ColorIndex = 3
' Ajout des titres de colonnes
objExcel.Cells(3, 2).Value = "distinguishedName"
objExcel.Cells(3, 2).Font.ColorIndex = 5
objExcel.Cells(3, 3).Value = "department"
objExcel.Cells(3, 3).Font.ColorIndex = 5
objExcel.Cells(3, 4).Value = "name"
objExcel.Cells(3, 4).Font.ColorIndex = 5
objExcel.Cells(3, 5).Value = "displayName"
objExcel.Cells(3, 5).Font.ColorIndex = 5
objExcel.Cells(3, 6).Value = "AccountExpirationDate"
objExcel.Cells(3, 6).Font.ColorIndex = 5
x = 4

objCommand.CommandText = "SELECT AdsPath FROM 'LDAP://" & SiteOpt & "WHERE objectCategory='user'"
Set objRecordSet = objCommand.Execute

objRecordSet.MoveFirst
Do Until objRecordSet.EOF
   Set objUser = GetObject(objRecordSet.Fields("AdsPath").Value)
   
   objExcel.Cells(x, 2).Value = objUser.distinguishedName
   objExcel.Cells(x, 3).Value = objUser.department
   objExcel.Cells(x, 4).Value = objUser.name
   objExcel.Cells(x, 5).Value = objUser.displayName
   dtmAccountExpiration = objUser.AccountExpirationDate 
   If Err.Number = -2147467259 Or Instr(dtmAccountExpiration, "1970") > 0 Or Instr(dtmAccountExpiration, "1601") > 0 Then
      objExcel.Cells(x, 6).Value = "This account has no expiration date."
   Else
      objExcel.Cells(x, 6).Value = "Account expiration date: " & objUser.AccountExpirationDate
   End If

   x = x + 1

   objRecordSet.MoveNext
Loop

objExcel.Cells(x, 1).Value = x-4 & " entries found"
x= x + 1
objExcel.Cells(x, 1).Value = "*****    End of list    *****"
objExcel.Cells(x, 1).Font.Bold = True
objExcel.Cells(x, 1).Font.Size = 10
objExcel.Cells(x, 1).Font.ColorIndex = 3

Dans la variable SiteOpt, tu remplaces les valeurs par celles qui correspondent à ton active directory avec des sous Ou si necessaire.
En espérant que ceci puisse t'aider.

A++

25/01/2008, 13h37
ced600

Une recherche sur le site n'a jamais tué personne !!!!

http://www.developpez.net/forums/sho...d.php?t=470395

Salut,

par principe je ne réponds pas aux demandes d'aide par message privé, le forum est justement là pour ca. Donc je reprends ton code issus du MP :
Code:

1 2 3 4 5 6 7 8 9 10 11 12 objCommand.CommandText = "SELECT name,displayname,department,accountexpires FROM 'LDAP://OU=ADO,OU=Users,OU=SGAM,OU=FR,DC=europe,DC=am,DC=socgen' WHERE objectCategory='user'" Set objRecordSet = objCommand.Execute objRecordSet.MoveFirst Do Until objRecordSet.EOF objExcel.Cells(x, 3).Value = objrecordset.Fields("department").Value objExcel.Cells(x, 4).Value = objrecordset.Fields("name").Value objExcel.Cells(x, 5).Value = objrecordset.fields("displayName").value dtmAccountExpiration = objUser.AccountExpirationDate
et je te dis : il sort d'ou ton ObjUser ? Pour avoir une chance que ca marche, tu devrais essayer ceci :
Code:

1 2 dtmAccountExpiration = objrecordset.fields("accountexpires")
Le probleme est que accountexpires c'est un large integer par exemple :
23 décembre 2008 donne 128745468000000000
Il te faut donc convertir 128745468000000000 en 23 Decembre 2008.
Pour ceci tu peux utiliser cette fonction que j'ai trouvé sur le net :
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 Sub DateConv lngBias = 0 dtmAccountExpiration = Integer8Date(objDate, lngBias) End Sub Function Integer8Date(objDate, lngBias) ' Function to convert Integer8 (64-bit) value to a date, adjusted for ' local time zone bias. Dim lngAdjust, lngDate, lngHigh, lngLow lngAdjust = lngBias lngHigh = objDate.HighPart lngLow = objdate.LowPart ' Account for bug in IADslargeInteger property methods. If (lngLow < 0) Then lngHigh = lngHigh + 1 End If If (lngHigh = 0) And (lngLow = 0) Then lngAdjust = 0 End If lngDate = #1/1/1601# + (((lngHigh * (2 ^ 32)) _ + lngLow) / 600000000 - lngAdjust) / 1440 Integer8Date = CDate(lngDate) End Function
Tout ca pour dire que ce n'est pas la plus simple comme méthode.
Si tu vas voir l'article "How Can I Return a List of All the Users Whose User Account Never Expires?" des scriptings guys de microsoft :

http://www.microsoft.com/technet/scr...5/hey0902.mspx

tu retrouveras la phrase suivante qui résume bien ce que je viens de te dire.

"Because accountExpires is a large integer value that tracks time via the number of nanoseconds that have expired since January 1, 1601, we decided to skip that whole mess and use accountExpirationDate instead."

Donc fais un select sur ADSPath comme dans mon 1er post et bosse avec accountExpirationDate, tu gagneras ton temps.

A++

son objuser viens de la :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
Set objConnection = CreateObject("ADODB.Connection")
Set objCommand =   CreateObject("ADODB.Command")
objConnection.Provider = "ADsDSOObject"
objConnection.Open "Active Directory Provider"
Set objCommand.ActiveConnection = objConnection
 
objCommand.Properties("Page Size") = 1000
objCommand.Properties("Searchscope") = 2
 
 
 Set WshNet = CreateObject("WScript.Network")
User = WshNet.Username
 
strUser = User
 
objCommand.CommandText = "SELECT Name, ADsPath FROM 'LDAP://dc=mjs,dc=local' where name='" & strUser & "*' and objectCategory='user'"
Set objRecordSet = objCommand.Execute
If objRecordSet.RecordCount > 0 Then
 
' on inscrit le cn dans une variable, et voilà
 
usrCN = objRecordSet.Fields("ADsPath").Value
Set objUser = GetObject (usrCN)
 
End If
 
dtmAccountExpiration = objUser.AccountExpirationDate
 
If dtmAccountExpiration <> "01/01/1601 01:00:00" Then
    MsgBox "Votre compte expire le : " & objUser.AccountExpirationDate, vbExclamation, "Avertissement"
End If

Le liens que j'ai mis en réponse :mrgreen:

Ce code corrigé (à la fin du poste) avertis un utilisateur du nombre de jour lui restant avant expiration de son compte.

Je me disais qu'il ne serait pas difficilement modifiable par ProtoSteph pour qu'il obtienne ce qu'il désire.