' -----------------------------------------------
' Compteurs de fichiers dans une arborescence
' JC BELLAMY © 2007
' -----------------------------------------------
Const SW_HIDE=0
Const SW_SHOWNORMAL=1 
Dim folders()
Set fso = CreateObject("Scripting.FileSystemObject")
Set Shell=CreateObject("WScript.Shell")
Set StdOut = WScript.StdOut
Set args  = Wscript.Arguments
TestHost true
If args.count=0 Then
	mess="FilesCount.vbs - Compteur de fichiers" & VBCRLF
	mess=mess & "JC BELLAMY  © 2007"  & VBCRLF
	mess=mess & "------------------"  & VBCRLF
	mess=mess & "Syntaxe :" & VBCRLF
	mess=mess & "FilesCount <disque:>[<dossier>]" & VBCRLF
	wscript.echo mess
	wscript.quit
	End If
Nom=args(0)
If not fso.FolderExists(Nom) Then
	wscript.echo "Le dossier " & Nom & " n'existe pas"
	wscript.quit
	End If 
set dir=fso.GetFolder(Nom)
mess="L'analyse va commencer et peut prendre un temps plus ou moins long" & VBCRLF & VBCRLF
mess=mess & "Les résultats sont stockés dans un fichier texte" & VBCRLF
mess=mess & """FilesCount.txt"" qui sera ouvert automatiquement" & VBCRLF
mess=mess & "par le bloc-notes à la fin du traitement"
rep=shell.Popup(mess, 2, " Compteur de fichiers", vbOKCancel + vbInformation) 
If rep=VBCancel Then wscript.quit

ResultFile="FilesCount.txt"
set ts=fso.CreateTextFile(ResultFile,true)
Titre="Comptage de fichiers dans " & dir.Path
ts.WriteLine Titre
ts.WriteLine String(len(Titre),"-")
nFolders=0
call exploreDir(dir,0)
ErrorTest dir.path
wscript.echo
wscript.echo "Exploration de " & dir.Path & " terminée."
ts.close
shell.run "notepad " & ResultFile, 1
wscript.quit
'--------------------------------------------------------------------
Sub exploreDir(Dir,Level)
Dim collDir,curDir
On error Resume next
NbSubFolders=Dir.SubFolders.Count
NbFiles=Dir.Files.Count
Prefixe=""
For i = 1 To Level
	Prefixe=Prefixe & "..\"
	Next
ts.WriteLine Prefixe & Dir.Name
ts.WriteLine Prefixe & FormatStrR(NbFiles,5) & " fichier" & pluriel(NbFiles)
ts.WriteLine Prefixe & FormatStrR(NbSubFolders,5) & " sous-dossier" & pluriel(NbSubFolders)
ErrorTest dir.path
If err.Number=70 Then	'Permission refusée
	err.clear
else
	set collDir=Dir.SubFolders 
	ErrorTest dir.path
	If err.Number=70 Then	'Permission refusée
		err.clear
	else
		For each curDir in collDir
			call exploreDir(curdir,Level+1)
			Next
		end if
	end if
End Sub
'--------------------------------------------------------------------
Sub ErrorTest(path)
If err.Number<>0 Then
	wscript.echo "erreur dossier " & path & " : " & Err.Description 
	End If
End Sub
'--------------------------------------------------------------------
Function pluriel(n)
If n<2 Then pluriel="" else pluriel="s"
End Function
'--------------------------------------------------------------------
Function FormatStrR(ch,lmax)
l=len(ch)
If l<lmax Then 
	For k = l+1 To lmax
		ch=" " & ch
		Next
	End If
FormatStrR=ch
End Function
'--------------------------------------------------------------------
'Sous-programme de test du moteur
'Vu les sorties générées, c'est CSCRIPT (et non pas WSCRIPT)
'qui doit être utilisé de préférence
Sub TestHost(force)
dim rep
strappli=lcase(Wscript.ScriptFullName)
strFullName =lcase(WScript.FullName)
i=InStr(1,strFullName,".exe",1)
j=InStrRev(strFullName,"\",i,1)
strCommand=Mid(strFullName,j+1,i-j-1)
if strCommand<>"cscript" then
	If force then 
		Init="Ce script doit être lancé avec CSCRIPT"
	Else
		Init="Il est préférable de lancer ce script avec CSCRIPT"
		End If
	rep=MsgBox(Init & VBCRLF & _
	"Cela peut être rendu permanent avec la commande" & VBCRLF & _
	"cscript //H:CScript //S /Nologo" & VBCRLF & _
	"Voulez-vous que ce soit fait automatiquement?", _
	vbYesNo + vbQuestion,strappli)
	if rep=vbYes  then 
		nomcmd="setscript.bat"
		Set ficcmd = fso.CreateTextFile(nomcmd)
		ficcmd.writeline "@echo off"
		ficcmd.writeline "cscript //H:CScript //S /Nologo"
		ficcmd.writeline "pause"
		params=""
		For i = 0 To nbargs-1 
			params=params & " " & args(i)
			next
		ficcmd.writeline chr(34) & strappli & chr(34) & params
		ficcmd.writeline "pause"
		ficcmd.close
		shell.Run nomcmd, SW_SHOWNORMAL,true
		force=true
		end if
    If force then WScript.Quit
	end if
end sub
'--------------------------------------------------------------------