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 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187
| Option Explicit
Dim booErreur
Dim strMessageFinal, strNomDomaine
Dim objFSO, objDomaineNT, objDossierRacine, objFichierArborescence, objFichierLog
Const conDossierRacine = "C:\Test\"
Const conCheminDossierEcriture = "C:\Recuperation_SAM\"
Const conFichierUtilisateurs = "Utilisateurs.txt"
Const conFichierGroupes = "Groupes.txt"
Const conFichierOrdinateurs = "Ordinateurs.txt"
Const conFichierArborescence = "Arborescence.txt"
Const conFichierLog = "LogsCreation.txt"
Const conMessageFinal = "Script terminé"
Const conCaractereSeparateur = ";"
Const conLecture = 1 'Spécifie que le fichier est en lecture
Const conEcriture = 2 'spécifie que le fichier est en écriture
booErreur = False 'initialisation de présence d'erreur à False
strMessageFinal = "Script terminé"
Do
strNomDomaine = InputBox("Saisir le nom de domaine (de type domXXXX) :","Nom du domaine","domXXXX")
Loop While (strNomDomaine = "domXXXX") 'Boucle tant que strNomDomaine = domXXXX
If strNomDomaine <> "" Then 'si strNomDomaine est non null alors exécution, sinon rien
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objDomaineNT = GetObject("WinNT://" & strNomDomaine & ",domain") 'se connecte au domaine strNomDomaine
Wscript.Echo "Nom de domaine : " & objDomaineNT.Name
Set objFichierUtilisateurs = objFSO.OpenTextFile(conCheminDossierEcriture & conFichierUtilisateurs, conLecture, False)
subCreationUtilisateur objFichierUtilisateur, objFichierLog
Set objFichierGroupes = objFSO.OpenTextFile(conCheminDossierEcriture & conFichierGroupes, conLecture, False)
subCreationGroupe objFichierGroupes, objFichierLog
Set objDossierRacine = objFSO.GetFolder(conDossierRacine)
Set objFichierArborescence = objFSO.OpenTextFile(conCheminDossierEcriture & conFichierArborescence, conLecture, False)
Set objFichierLog = objFSO.OpenTextFile(conCheminDossierEcriture & conFichierLog, conEcriture, True)
Wscript.Echo "Lecture du fichier " & conFichierArborescence & ". Veuillez patienter..."
subParcourirArborescence objDossierRacine, objFichierArborescence, objFichierLog
If booErreur Then
strMessageFinal = strMessageFinal & vbcrlf & "Des erreurs sont survenues durant l'exécution du script, veuillez consulter le fichier " & conFichierLog
End If
MsgBox strMessageFinal,vbInformation,"Fin"
Else 'si Annuler est sélectionné
MsgBox "Vous avez annulé l'exécution du script",vbInformation,"Annulation"
End If
'=============================== Procédures et fonctions ===========================================
Sub subCreationUtilisateur(objFichierUtilisateur, objFicLog)
Dim tabLigneLue
Dim objUtilisateurCree
Wscript.Echo "Lecture du fichier " & conFichierUtilisateurs
Do While Not objFichier.AtEndOfStream
tabLigneLue = Split(objFichierUtilisateur.ReadLine, conCaractereSeparateur, -1, 1) 'créée un tableau à partir de la ligne du fichier lue, le séparateur étant conCaractereSeparateur
On Error Resume Next 'au cas où l'utilisateur existe déjà
Set objUtilisateurCree = objDomaineNT.Create("User", tabLigneLue(1)) 'créée l'utilsateur
objUtilisateurCree.SetInfo 'rend effective les modifications apportées à l'utilisateur
objUtilisateurCree.FullName = tabLigneLue(3)
objUtilisateurCree.Description = tabLigneLue(4)
'objUtilisateurCree. = tabLigneLue()
objUtilisateurCree.PasswordExpired = tabLigneLue(5)
objUtilisateurCree.PasswordExpirationDate = tabLigneLue(6)
objUtilisateurCree.AccountDisabled = tabLigneLue(7)
objUtilisateurCree.LoginScript = tabLigneLue(8)
'objUtilisateurCree.LoginHours = tabLigneLue()
'objUtilisateurCree.LoginWorkstations = tabLigneLue()
'objUtilisateurCree.AccountExpirationDate = tabLigneLue()
objUtilisateurCree.SetInfo
objUtilisateurCree.Password = "MotDePasse"
objUtilisateurCree.SetInfo
If Err <> 0 Then
subGestionErreur objFicLog, tabLigneLue(1), Err.Number, Err.Description
End If
On Error Goto 0
Loop
End Sub
Sub subCreationGroupe(objFichierGroupe, objFicLog)
Dim tabLigneLue
Dim objGroupeCree
Dim strCheminUtilisateur
Wscript.Echo "Lecture du fichier " & conFichierGroupes
Do While Not objFichierGroupe.AtEndOfStream
tabLigneLue = Split(objFichierGroupe.ReadLine, conCaractereSeparateur, -1, 1) 'créée un tableau à partir de la ligne du fichier lue, le séparateur étant conCaractereSeparateur
On Error Resume Next 'au cas où le groupe existe déjà
Set objGroupeCree = objDomaineNT.Create("Group", tabLigneLue(1)) 'créée le groupe
objGroupeCree.SetInfo 'rend effective la création du groupe
If Err <> 0 Then
subGestionErreur objFicLog, tabLigneLue(1), Err.Number, Err.Description
End If
On Error Goto 0
'ce qui suit permet de déplacer les utilisateurs dans les bons groupes
For i=5 To Ubound(tabLigneLue) 'boucle de 5 à la valeur de la dernière case du tableau
strCheminUtilisateur = "WinNT://" & strNomDomaine & "/" & tabLigneLue(i)
If Not objGroupeCree.IsMember(strCheminUtilisateur) 'vérifie si l'utilisateur n'est pas déjà membre du groupe
objGroupeCree.Add(strCheminUtilisateur) 'si non, l'ajoute au groupe
End If
Next
Loop
End Sub
Sub subParcourirArborescence(objDossierParent, objFichierLecture, objFicLog)
'parcourt l'arborescence de façon RECURSIVE tous les fichiers et les dossiers, puis lance, si le chemin de l'objet est présent dans le fichier, la procédure subDroitsArborescence pour réécrire les ACE
Dim colFicArbo, colSousDossiers
Dim objFicArbo, objDossierArbo
Set colFicArbo = objDossierParent.Files
If colFicArbo.Count <> 0 Then
For Each objFicArbo In colFicArbo 'Non récursif
booCheminExiste = False 'permet de savoir si le fichier est référencé dans le fichier de droits (conFichierArborescence)
Do While Not objFichierLecture.AtEndOfStream
tabLigneLue = Split(objFichierLecture.ReadLine, conCaractereSeparateur, -1, 1)
If tabLigneLue(1) = objFicArbo.Path Then
booCheminExiste = True 'le fichier est bien référencé, donc on passe à Vrai
subDroitsArborescence objFicArbo.Path, objFichierLecture, objFicLog, tabLigneLue
Exit Do 'permet de ne pas continuer inutilement la recherche
End If
Loop
If Not booCheminExiste Then 'comme le fichier n'est pas référencé, alors la procédure d'erreur est lancée
subGestionErreur objFicLog, objFicArbo.Path, 998, "Le fichier ciblé n'est pas référencé dans le fichier " & conFichierArborescence
End If
Next
End If
Set colSousDossiers = objDossierParent.SubFolders
If colSousDossiers.Count <> 0 Then 'vérifie qu'il y a des sous-dossiers
For Each objDossierArbo In colSousDossiers
booCheminExiste = False 'permet de savoir si le fichier est référencé dans le fichier de droits (conFichierArborescence)
Do While Not objFichierLecture.AtEndOfStream
tabLigneLue = Split(objFichierLecture.ReadLine, conCaractereSeparateur, -1, 1)
If tabLigneLue(1) = objDossierArbo.Path Then
booCheminExiste = True 'le fichier est bien référencé, donc on passe à Vrai
subDroitsArborescence objDossierArbo.Path, objFichierLecture, objFicLog, tabLigneLue
Exit Do 'permet de ne pas continuer inutilement la recherche
End If
Loop
If Not booCheminExiste Then 'comme le fichier n'est pas référencé, alors la procédure d'erreur est lancée
subGestionErreur objFicLog, objDossierArbo.Path, 999, "Le dossier ciblé n'est pas référencé dans le fichier " & conFichierArborescence
End If
subParcourirArborescence objDossierArbo, objFichierLecture, objFicLog 'RECURSIVITE !!!!!
Next
End If
End Sub
Sub subDroitsArborescence(strCheminObjetArbo, objFichierLecture, objFicLog, tabTableauACE) 'réécrit pour l'objet donné les ACL
Dim objWMIDroits, objWMISecurityDescriptor, objACE, objTrustee
Dim RetVal
Dim colDACL
On Error Resume Next 'Gestion d'erreur pour ma pomme
Set objWMIDroits = GetObject("winmgmts:").Get("win32_LogicalFileSecuritySetting='" & strCheminObjetArbo & "'")
RetVal = objWMIDroits.GetSecurityDescriptor(objWMISecurityDescriptor)
colDACL = objWMISecurityDescriptor.DACL
For Each objACE In colDACL
Set objTrustee = objACE.Trustee
'C'est ici que je dois inclure la charge utile pour modifier les droits des dossiers mais je ne sais pas comment faire :evilred:
Next
If Err <> 0 Then
subGestionErreur objFicLog, strCheminObjetArbo, Err.Number, Err.Description
End If
On Error Goto 0 'fin de la gestion d'erreur
Set objWMIDroits = Nothing
Set objACE = Nothing
Set objTrustee = Nothing
End Sub
Sub subGestionErreur(objFicLog, strCheminErreur, intNumeroErreur, strDescriptionErreur)
booErreur = True
objFicLog.WriteLine "L'erreur porte sur : " & strCheminErreur
objFicLog.WriteLine "Numéro d'erreur : " & intNumeroErreur
objFicLog.WriteLine "Description d'erreur : " & strDescriptionErreur & vbcrlf
End Sub |
Partager