' -----------------------------------------------
' Recherche de fichiers et dossiers compressés
' (partition NTFS exclusivement)
' JC BELLAMY © 2002
' -----------------------------------------------
Const SW_HIDE=0
Const SW_SHOWNORMAL=1 
Dim args,fso,dir,d,fs,Shell
Dim folders(),files()
Set fso = CreateObject("Scripting.FileSystemObject")
Set Shell=CreateObject("WScript.Shell")
TestHost true
Set args  = Wscript.Arguments
Compressed=2048
If args.count=0 Then
	mess="Getcomp.vbs - Recherche de fichiers et dossiers compressés" & VBCRLF
	mess=mess & "(partitions NTFS exclusivement)" & VBCRLF
	mess=mess & "JC BELLAMY  © 2002"  & VBCRLF
	mess=mess & "------------------"  & VBCRLF
	mess=mess & "Syntaxe :" & VBCRLF
	mess=mess & "getcomp <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)
set d=Dir.Drive 
filesystem=d.FileSystem 
If filesystem<>"NTFS" Then
	wscript.echo "Le disque " & d.DriveLetter & ": (" & d.VolumeName & ") n'est pas de type NTFS (" & filesystem &")"
	wscript.quit
	End If
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 & """listcomp.txt"" qui sera ouvert automatiquement" & VBCRLF
mess=mess & "par le bloc-notes à la fin du traitement"
rep=MsgBox(mess, vbInformation + vbOKCancel,"Recherche de dossiers et fichiers compressés")
If rep<>vbOK Then wscript.quit

nFolders=0
nFiles=0
call exploreDir(dir)
ErrorTest dir.path
wscript.echo
wscript.echo "Il a été trouvé :"
wscript.echo FormatStrR(nfolders,5) & " dossier(s) compressé(s)"
wscript.echo FormatStrR(nfiles,5)   & " fichier(s) compressé(s)"
ResultFile="listcomp.txt"
set ts=fso.CreateTextFile(ResultFile,true)
ts.WriteLine("Liste des dossiers compressés de " & dir.Path & " : ")  
ts.WriteLine("---------------------------------" & String(len(dir.Path)+2,"-"))
For i = 0 To nFolders-1
	ts.WriteLine(folders(i))
	Next
ts.WriteBlankLines(2)
ts.WriteLine("Liste des fichiers compressés de " & dir.Path & " : ")  
ts.WriteLine("---------------------------------" & String(len(dir.Path)+2,"-"))

For i = 0 To nFiles-1
	ts.WriteLine(files(i))
	Next
ts.close
shell.run "notepad " & ResultFile, 1
wscript.quit

'--------------------------------------------------------------------
Sub exploreDir(Dir)
Dim collDir, collFic, curDir, curFic
wscript.echo Dir.path
On error Resume next
If Dir.Attributes and Compressed Then
	nFolders=nFolders+1
	redim preserve Folders(nFolders)
	Folders(nFolders-1)=Dir.path
	End If
set collFic=Dir.Files 
ErrorTest dir.path
If err.Number=70 Then	'Permission refusée
	err.clear
else
	For each curFic in collFic
		If curFic.Attributes and Compressed Then 
			nFiles=nFiles+1
			redim preserve Files(nFiles)
			Files(nFiles-1)=Curfic.path
			end if
		Next
	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)
			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
'--------------------------------------------------------------------
'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
'--------------------------------------------------------------------
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
'--------------------------------------------------------------------