LISTER VOS DROITS CONCERNANT LES REPERTOIRES DE VOTRE ORDINATEUR OU CEUX DU RÉSEAU

'____________________________________________________________________________________________
'______________________________________listPerm.bat__________________________________________
'____________________________________________________________________________________________
showacls.vbs
showacls.bat
analyze.bat
del showacls.txt
del showacls.bat

'____________________________________________________________________________________________
'____________________________________showACLS.vbs____________________________________________
'____________________________________________________________________________________________
Dim ShellO
Set ShellO = CreateObject("WScript.Shell")
Dim FSO
Set FSO = CreateObject("Scripting.FileSystemObject")
Dim SListe
Dim Schemin

'permettant de mettre en place la fenetre parcourir pour choisir le repertoire source
ReturnOnlyFSDirs = &H0001
Set oShell = WScript.CreateObject("Shell.Application" )
Title = "Veuillez sélectionner un dossier"
Flags=ReturnOnlyFSDirs
'InitDir = "C:\" '<-- Adapter selon les besoins
Set Item = oShell.BrowseForFolder(0, Title, Flags, InitDir)
If Not Item Is Nothing Then
	Result=Item.Title
	If InStr(1, Result, ":" ) = 0 Then
		Result=Item.ParentFolder.ParseName(Item.Title).Path
	End If
	Schemin = Result
	Else
	WScript.echo "Aucun dossier n'a été sélectionné !", vbExclamation, Title
End If

'Schemin = var 'Dossier à modifier

'Ouverture du fichier contenant l'arborescence du répertoire à traiter vers le Bureau
Dim Fichier
Set Fichier = FSO.CreateTextFile("showacls.bat")
'Lister l'arborescence du dossier
ListerDossier Schemin, Fichier
'Fermeture du fichier contenant l'arborescence du répertoire à traiter
Fichier.WriteLine "analyze.vbs"
Fichier.Close

Function ListerDossier(Schemin, Fichier) 'Lister l'arborescence du dossier
	On Error Resume Next
	Dim FSO
	Set FSO = CreateObject("Scripting.FileSystemObject")
	Dim ObjRep
	Set ObjRep = FSO.GetFolder(Schemin) 'dossier
	Dim ObjSubRep
	Set ObjSubRep = ObjRep.SubFolders 'sous-dossiers
	Dim ObjSubRepItem
	For Each ObjSubRepItem In ObjSubRep 'Traiter chaque sous-dossier
		'WScript.echo ObjSubRepItem.Path
		'chaine = "cacls " & vbclrf & ObjSubRepItem.Path & vbclrf & " >> showACLS.txt"
		Fichier.WriteLine ("cacls " & chr(34) & ObjSubRepItem.Path & chr(34) & " >> showacls.txt") 'Ecrire le path dans la liste
		ListerDossier ObjSubRepItem.Path, Fichier 'traiter les sous-dossiers
	Next
End Function


'_____________________________________________________________________________________________
'_________________________________________analyze.vbs_________________________________________
'_____________________________________________________________________________________________
On error resume next
'Variables globales à prévoir : nomPC
'connaitre le nom de l'ordi
cheminFichier="showACLS.txt" 'fichier source
Dim FSO 'déclaration file system object
Dim cheminCourant, utilisateurCourant, tableau, chaineTotale, chaineLigne 'variables globales
Dim boolOK 'booléen stockant la nature de l'autorisation (Autoriser ou Refuser)
Redim tableau(6) 'tableau contenant 6 colonnes (de 0 à 5)
Set FSO = CreateObject("Scripting.FileSystemObject")'instanciation
Set lecture = FSO.OpenTextFile(cheminFichier)'on instancie le fichier texte
Dim cpt 'compteur permettant d'éviter de fermer le tableau à la première ligne
cpt=0
enteteFichier
Do While Not lecture.AtEndOfStream 'on parcourt chaque ligne du fichier texte
    boolOK = True 'remise à zéro
	ligne = lecture.Readline
	ligne = trim(ligne) 'on supprime les espaces entourant la ligne
	If NOT(Instr(ligne, "<Account Domain not found>") <> 0) Then
		If (reconnaissanceLigne(ligne) = 0) Then 'on ouvre un tableau temporaire
			'WScript.echo "type 0"
			If (cpt <> 0) Then 'la première ligne est de type 0
				fermetureTableau
			End If
			ligneM=cas0(ligne) 'ligne de la forme chemin|utilisateur|droits
			tab=Split(ligneM, "|") 'split permet de traiter la ligne comme un tableau
			'WScript.echo tab(0)
			ouvertureCas0 'on initialise le tableau
			cheminCourant=tab(0) 
			utilisateurCourant=tab(1)
			If (Instr(tab(2), "(DENY)") <> 0 Or Instr(tab(2), "R") <> 0) Then
				boolOK = true
			Else 
				boolOK = false
			End If
			tableau(0)=cheminCourant
			tableau(1)=utilisateurCourant
			'WScript.echo "cellule 2 " & tab(2)
			gererDroits(tab(2))
		Else
			If (reconnaissanceLigne(ligne) = 1) Then 'on ouvre un tableau temporaire
				fermetureTableau
				ligneM=cas1(ligne)
				tab=Split(ligneM, "|")
				ouvertureCas1 'on initialise le tableau en gardant la premiere cellule (le chemin)
				tableau(1)=tab(0) 'on remplit le champ utilisateur
				If (Instr(tab(1), "(DENY)") <> 0 Or Instr(tab(1), "R") <> 0) Then
					boolOK = true
				Else 
					boolOK = false
				End If
				gererDroits(tab(1))
			Else
				If (reconnaissanceLigne(ligne) = 2) Then 'on poursuit l'écriture du tableau
					'WScript.echo "type2"
					affectationDroitsCas2 ligne, boolOK
				End If
			End If
		End If
	End If
Loop
fermetureTableau 'ferme la dernière ligne
ecritureSortie chaineLigne
'WScript.echo chaineLigne
lecture.Close

'fonction permettant de faire la distinction entre les différents types de lignes
Function reconnaissanceLigne(ligne)
	If (mid(ligne, 2,2) = ":\") Then
		reconnaissanceLigne=0
	Else 
		If (Instr(ligne,"\") <> 0 Or Instr(ligne, "Everyone") <> 0 ) Then
			reconnaissanceLigne=1
		Else
			If (left(ligne, 12) = "FILE_GENERIC" Or left(ligne, 6) = "DELETE" Or left(ligne, 5) = "READ_" Or _
			left(ligne, 11) = "SYNCHRONIZE" Or left(ligne, 9) = "FILE_READ" Or left(ligne, 10) = "FILE_WRITE" Or _
			left(ligne, 12) = "FILE_EXECUTE" Or left(ligne, 11) = "FILE_DELETE" Or left(ligne, 11) = "FILE_APPEND" Or _
			left(ligne, 12) = "GENERIC_READ" Or left(ligne, 15) = "GENERIC_EXECUTE" Or left(ligne, 13) = "GENERIC_WRITE") Then
				reconnaissanceLigne=2
				'WScript.echo "type de ligne : 2 " & ligne
			Else 
				reconnaissanceLigne=-1
			End If
		End If
	End If
End Function

'fonction traitant le cas 0

Function cas0(chaine)
	'If (Instr(chaine, "hiberfil.sys") <> 0) Then 'on ne veut pas traiter le fichier hiberfil.sys
	'	cas0=""
	'Else
		chaine=trim(chaine)
		Dim sep1, sep2
		'gestion du cas de Everyone
		If (Instr(chaine, "Everyone") <> 0) Then
			sep1=Instr(chaine, "Everyone") - 1
			cas0=left(chaine, sep1-2) & "|" & mid(chaine, sep1+1, 8) & "|" & right(chaine, len(chaine) - (sep1+9))
			'WScript.echo "cas 0 pour Everyone " & cas0
		Else
			If (Instr(chaine, "COSMOS\") <> 0) Then
				sep1=Instr(chaine, "COSMOS\") - 1
			Else
				If (Instr(chaine, "NT AUTHORITY\") <> 0) Then
					sep1=Instr(chaine, "NT AUTHORITY\") - 1
				Else
					If (Instr(chaine, "BUILTIN\") <> 0 ) Then
						sep1=Instr(chaine, "BUILTIN\") - 1
					End If
				End If
			End If
			chemin=left(chaine, sep1-1)
			'on regarde si on est dans un cas de special access
			If (compteur2Points(chaine) = 2) Then
				sep2 = InStrRev(chaine, ":")
			Else 
				If (compteur2Points(chaine) = 3) Then 'cas de special access
					sep2 = InStrRev(chaine, ":(")
				End If
			End If
			utilisateur = right(left(chaine, sep2-1),sep2-sep1-1)
			droits=right(chaine, len(chaine)-sep2)
			cas0=chemin & "|" & utilisateur & "|" & droits
		End If
	'End If
End Function

Function cas1(chaine)
	chaine=trim(chaine)
	If (Instr(chaine, "Everyone") <> 0) Then
		sepT=Instr(chaine, "Everyone")
		chaine = right(chaine, len(chaine)-sepT+1)
		'WScript.echo "chaine " & chaine
		cas1=left(chaine, 8) & "|" & right(chaine, len(chaine) - (septT+9))
		'WScript.echo "cas1 pour Everyone : " & cas1
	Else
		Dim i
		i=Instr(chaine, ":") 'prend le premier ":" rencontré donc pas de problème pour le special access
		cas1=left(chaine, i-1) & "|" & right(chaine, len(chaine)-i)
		cas1=trim(cas1)
		'WScript.echo "cas1 : " & cas1
	End If
End Function

'forme du tableau final : chemin|utilisateur|Hérité|Lecture|Ecriture|Execution
Sub affectationDroitsCas2(ligne, P) 'P:permissions de départ Autoriser ou Refuser
	If (Instr(ligne, "FILE_READ") <> 0 OR Instr(ligne, "GENERIC_READ") <> 0) Then
		tableau(4)="-"
		If (P=True) Then
			tableau(3)="O"
		Else
			If (P=False) Then
				tableau(3)="N"
			End If
		End If
	Else 
		If (Instr(ligne, "FILE_WRITE") <> 0 OR Instr(ligne, "GENERIC_WRITE") <> 0) Then
			tableau(4)="-"
			If (P=True) Then
				tableau(4)="O"
			Else
				If (boolOk=False) Then
					tableau(4)="N"
				End If
			End If	
		Else			
			If (Instr(ligne,"FILE_EXECUTE") <> 0 OR Instr(ligne, "GENERIC_EXECUTE") <> 0) Then
				tableau(4)="-"
				If (P=True) Then
					tableau(5)="O"
					'WScript.echo "executer"
				Else
					If (P=False) Then
						tableau(5)="N"
					End If
				End If
			End If
		End If
	End If
End Sub

Sub gererDroits(droits)
	If (Instr(droits, "F") <> 0) Then 'l'utilisateur a tous les droits
		tableau(3)="O"
		tableau(4)="O"
		tableau(5)="O"
	Else
		If (Instr(droits, "C") <> 0) Then
			tableau(3)="O"
			tableau(4)="O"
			tableau(5)="O"
		Else
			If (Instr(droits, "R") <> 0) Then
				tableau(3)="N"
				tableau(4)="N"
				tableau(5)="N"
			End If
		End If
	End If
	'héritage
	If (Instr(droits, "(CI)") <> 0 Or Instr(droits, "(OI)") <> 0 Or Instr(droits, "(IO)") <> 0 ) Then
		tableau(2)="O"
	End If
End sub

'permet de déterminer si on est sur une ligne contenant (special access:)
Function compteur2Points(chaine)
	Dim cpt, chaineTmp, i 'indice
	cpt = 0
	i=Instr(chaine, ":") 'on est sûr qu'il y en a au moins un sur la ligne et au maximum il y en a 2
	cpt = 1
	chaineTmp=right(chaine, len(chaine)-i)
	Do While (Instr(chaineTmp, ":") <> 0)
		i=Instr(chaineTmp, ":")
		cpt = cpt + 1
		chaineTmp=right(chaineTmp, len(chaineTmp)-i)
	Loop
	compteur2Points=cpt
End Function

Sub ouvertureCas0()
	For i=0 to Ubound(tableau)-1
		tableau(i)="-"
	Next
	chaineTotale = ""
	For i=0 to Ubound(tableau)-1
		chaineTotale=chaineTotale & tableau(i) & ";"
	Next
End Sub

Sub ouvertureCas1() 'fonction gardant le chemin précédent
	For i=1 to Ubound(tableau)-1
		tableau(i)="-"
	Next
	chaineTotale = ""
	For i=0 to Ubound(tableau)-1
		chaineTotale=chaineTotale & tableau(i) & ";"
	Next
End Sub

Sub fermetureTableau() 'fonction fermant le tableau càd le copiant dans le fichier
	For i = 0 to Ubound(tableau)-1
	   chaineLigne=chaineLigne & tableau(i) & ";"
	Next
	chaineLigne=chaineLigne & vbcrlf
	For i = 2 to Ubound(tableau)-1
		tableau(i) = "-"
	Next
	'WScript.echo chaineLigne
	'chaineTotale=chaineLigne & vbcrlf & chaineTotale 'chaine finale contenant tous les droits
End Sub

Sub ecritureSortie(chaineF)
	Set sortie = FSO.CreateTextFile("perms.txt")
	With sortie
	.writeLine chaineF
	End With
End Sub