List Sécurité sur répertoire + barre de progression HTA

**Maxmoon13** · 25/03/2013, 16h18

Bonjour,

Je ne sais pas si le sujet a déjà été évoqué mais je n'ai rien trouvé qui réponde à ma question.
J'ai un script VBS qui me liste dans un fichier HTML les groupes et type de sécurité positionné sur une arborescence. Cette partie fonctionne très bien mais dans le cas ou l'arborescence cible est sur le réseau ça peu prendre beaucoup de temps de traitement et aucune indication comme quoi le script tourne toujours... Donc je me suis dis que j'allais mettre une barre de progression en HTA.
J'ai réussi à combiner mon vbs et mon hta et ça fonctionne le problème c'est que la fenêtre hta ne s'actualise pas au fur et à mesure du traitement, en gros la barre de progression reste au début et quand le script se termine elle se remplie... pareil j'ai mis en plus un décompte des dossiers traité / à traiter et il ne s'actualise qu'à la fin du script, je voudrais qu'il le fasse en temps réel.
Bref je sais pas si je suis très clair dans mes explications, mais j'espère que vous pourrez m'aider...

Je précise que je ne script pas depuis très longtemps donc j'ai quelque connaissance mais il m'en manque encore beaucoup, merci d'avance pour votre indulgence.

Voici mon code :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
188
 
<html>
	<HEAD> <meta http-equiv="Content-Type" content="text/html; charset=iso-8859-15">
		<TITLE>Folder Permission</TITLE>
		<HTA:APPLICATION ID = 'FolderPerm'
		CAPTION = Yes
		INNERBORDER = No
		MAXIMIZEBUTTON = No
		SCROLL = No
                >
	<script language="VBScript">
	    dim MonTimer, nbFolder, cFolder
 
		Sub quit_OnClick			
			Self.close
		end sub
		Sub Window_onLoad
			window.resizeTo 530,200			
			quit.setAttribute "disabled", true
			fin.style.visibility="hidden"
			wait.style.visibility="visible"
			tb1.width=1
			StartTimer
			Prog()
		End Sub
		Sub StartTimer			
			MonTimer = window.setInterval ("MonScript", 100, "VBScript") 'Appel de MonScript toutes les 1/2 secondes
		End sub
		Sub StopTimer
			window.ClearInterval MonTimer
		End sub
		sub MonScript
			tb1.width = tb1.width+10
			if tb1.Width > 500 then tb1.Width =1
		End Sub		
		Sub Prog () 			
			Const ForReading = 1, ForWriting = 2, ForAppending = 8
			Const FullAccessMask = 2032127, ModifyAccessMask = 1245631, WriteAccessMask = 118009
			Const ROAccessMask = 1179817	
			nbFolder = 1
			cFolder = 0
			strComputer = "."			
			sParentFolder = select_a_folder("Sélectionner un dossier a scanner : ","")			
			SParentFoldern=replace(sParentFolder,"\","" )
			SParentFoldern=replace(sParentFoldern,":","" )			
			CountFolder sParentFolder, nbFolder			
			Set fso = CreateObject("Scripting.FileSystemObject" )					
			fullfilename=SParentFoldern&".html"   
			Set fsOut = fso.OpenTextFile(fullfilename, ForWriting, True)			
			On Error Resume Next
			fsOut.Writeline ("<html>"&vbCr&"<head>"&vbCr&"<title>Groupe de securite positionnes sur "& SParentFolder &"</title>"&vbCr&"</head>" )
			strTableHead = "<table border=2 bordercolor='#000010' width='90%' id='Table1'>"
			fsOut.Writeline strTableHead
			fsOut.Writeline "<tr><td width='50%'>Dossier</td>" & "<td width='50%'>Groupes</td>" & "<td width='50%'>Permissions</td></tr>"
			strTableFoot = "</table>"
			fsOut.Close	
			OutputFolderInfo sParentFolder, fullfilename			
			ShowSubFolders FSO.GetFolder(sParentFolder),fullfilename			
			Set fso = CreateObject("Scripting.FileSystemObject" )
			fsOut.Writeline strTableFoot
			fsOut.Close			
			fin.style.visibility="visible"
			wait.style.visibility="hidden"
			quit.setAttribute "disabled", false
			StopTimer
			Quit
		End sub
 
		Function select_a_folder(message,directory)
			Const WINDOW_HANDLE = 0
			Const NO_OPTIONS = 0
			Set objShell = CreateObject("Shell.Application" )
			Set objFolder = objShell.BrowseForFolder _
				(WINDOW_HANDLE, message , NO_OPTIONS, directory)		
			On Error Resume Next
			Set objFolderItem = objFolder.Self
			If Err <> 0 Then				
				Self.close		
			Else
				select_a_folder = objFolderItem.Path
			end if			
		End Function
 
		Public Sub OutputFolderInfo(FolderName , sOutfile)
			Const FullAccessMask = 2032127, ModifyAccessMask = 1245631, WriteAccessMask = 1180095
			Const ROAccessMask = 1179817
			Const ForReading = 1, ForWriting = 2, ForAppending = 8		
 
			strComputer = "."
			folderpath = Replace(FolderName, "\", "\\" )
			objectpath = "winmgmts:Win32_LogicalFileSecuritySetting.path='" & folderpath & "'"
			'récupere la securite en place sur l'objet
			Set wmiFileSecSetting = GetObject(objectpath)
			RetVal = wmiFileSecSetting.GetSecurityDescriptor(wmiSecurityDescriptor)
			If Err Then
				MsgBox ("GetSecurityDescriptor failed" & vbCrLf & Err.Number & vbCrLf & Err.Description)
				Err.Clear
			End If
			Set objWMIService = GetObject("winmgmts:" & "{impersonationLevel=impersonate}!\\" & _
				strComputer & "\root\cimv2" )
			Set colFolders = objWMIService.ExecQuery("SELECT * FROM Win32_Directory WHERE Name ='" & _
				folderpath & "'" )
			For Each objFolder In colFolders
				compteur cFolder, nbFolder
				DACL = wmiSecurityDescriptor.DACL
				Set fso = CreateObject("Scripting.FileSystemObject" )
				Set fsOut = fso.OpenTextFile(sOutfile, ForAppending, True)		
				For Each wmiAce In DACL
					Set Trustee = wmiAce.Trustee
					fsOut.Writeline "<tr><td width='50%'>"&objFolder.Name&"</td>" & _
					"<td width='50%'>"&Trustee.Domain&"\"&Trustee.Name&"</td>"            
					FoundAccessMask = False
					CustomAccessMask = False
					While Not FoundAccessMask And Not CustomAccessMask
						If wmiAce.AccessMask = FullAccessMask Then
							AccessType = "Full Control"
							FoundAccessMask = True					
						End If
						If wmiAce.AccessMask = ModifyAccessMask Then
							AccessType = "Lecture / Ecriture"
							FoundAccessMask = True					
						End If
						If wmiAce.AccessMask = WriteAccessMask Then
							AccessType = "Lecture / Ecriture"
							FoundAccessMask = True					
						End If
						If wmiAce.AccessMask = ROAccessMask Then
							AccessType = "Lecture Seule"
							FoundAccessMask = True					
						Else
							CustomAccessMask = True					
						End If
					Wend         
					If FoundAccessMask Then
						fsOut.Writeline "<td width='50%'>"&AccessType&"</td></tr>"
					Else
						fsOut.Writeline "<td width='50%'>Custom</td></tr>"                
					End If         
				Next
				Set fsOut = Nothing
				Set fso = Nothing
			Next
			Set fsOut = Nothing
			Set fso = Nothing
		End Sub
		Sub ShowSubFolders (Folder,fname)
			On Error Resume Next
			For Each Subfolder in Folder.SubFolders
				Call OutputFolderInfo(Subfolder.Path,fname)            
				call ShowSubFolders (Subfolder,fname)
			Next
		End Sub
		Sub CountFolder (sParentFolder, nbFolder)
			Dim  i	
			Set fso = CreateObject("Scripting.FileSystemObject")
			Set rep = fso.GetFolder(sParentFolder) 
			Set ssRep = rep.SubFolders
			For each i in ssRep
				nbFolder = nbFolder + 1					
			Next
			For Each CurrentFolder In ssRep
				CountFolder CurrentFolder.path, nbFolder
			Next
			WriteReport "1 / "& nbFolder, nbDossier			
		End sub	
		Sub WriteReport(strItem,slineID)
				slineID.innerHTML = "<p>" & strItem & "</p>"			
		End Sub
		Sub compteur (cFolder, nbFolder)
			cFolder = cFolder + 1
			WriteReport cFolder &" / "& nbFolder, nbDossier
		End sub
	</script>
	</HEAD>
	<BODY>
	</TABLE>
<TABLE id="tb1" bgColor=blue
 height=15 width=0
 cellSpacing=1 cellPadding=1 border=2> 
 <TR><TD></TD></TR>
</TABLE><BR>
	<div ID="wait" align="center">TRAITEMENT EN COURS VEUILLEZ PATIENTER</div>
	<div ID="fin" align="center">FIN DU TRAITEMENT</div>
	</br><input type="button" value="Quitter" name="quit">
	<div ID="nbDossier" align="Center">  </div>	
 
	</BODY>
</html>

**hackoofr** · 25/03/2013, 17h02

Regardez ici peut-être on a le même problème de la barre de progression Code2Folder+ProgressBar.hta
J'attends encore les tests des membres pour me confirmer la limite de la Progress Bar , peut-être que vous me donniez d'autres idées