' ----------------------------------------------------------------
' Script de backup des dossiers spéciaux de l'utilisateur en cours
' (A exécuter de préférence avec cscript)
'
' Syntaxe: 
'	backupspecial [<répertoire_de_destination>]
'
'   Si répertoire de destination est omis,
'   la copie a lieu dans %temp%\%username%
'
'   Le répertoire de destination peut exister ou non
'
' JC BELLAMY © 2001
' ----------------------------------------------------------------
Dim net, shell, args, fso, fldrs, spf, dirtemp, fdest
Set net   = Wscript.CreateObject("WScript.Network")
Set shell = WScript.CreateObject("WScript.Shell")
Set fso   = WScript.CreateObject("Scripting.FileSystemObject")
Set args  = Wscript.Arguments
If args.count=0 Then
	User=net.UserName
	Set dirtemp = fso.GetSpecialFolder(2)
	dest=dirtemp & "\" & user
Else
	dest=args(0)
	End If
If right(dest,1)="\" Then dest=left(dest,len(dest)-1)

' Création récursive du dossier destination s'il n'existe pas
If not fso.FolderExists(dest) Then SuperCreateFolder dest

dest=dest & "\"
Set fldrs=Shell.SpecialFolders
spf=array("AppData","Desktop","Favorites","MyDocuments", _
          "NetHood","PrintHood","Programs","Recent", _
		  "SendTo","StartMenu","Templates")
wscript.echo "Copie des dossiers spéciaux du compte " & user & " vers " & dest
For i = 0 to UBound(spf)
	curfolder=fldrs(spf(i))
	wscript.echo curfolder
	fso.CopyFolder curfolder, dest, true
	next
' Effacement éventuel des attributs système des fichiers 
' afin de permettre un autre backup
wscript.echo "Effacement des attributs RHS"
ResetAllAttrib dest 
Wscript.quit

'--------------------------------------------------------------------
' sous-programme de création récursive de dossier
Sub SuperCreateFolder(fd)
If fd="" Then exit sub
bs=InstrRev(fd,"\")
parent=left(fd,bs-1)
If len(parent)>2 Then
	If not fso.FolderExists(parent) then SuperCreateFolder Parent
	End If
fso.CreateFolder(fd)
End Sub
'--------------------------------------------------------------------
' sous-programme d'effacement récursif des attributs RHS
Sub ResetAllAttrib(fd)
dim collSubfolder,collFiles,subfd,curfile,curfd
set curfd=fso.GetFolder(fd) 
curfd.Attributes=ResetAttrib(curfd.Attributes)
set collSubfolder=curfd.SubFolders 
For each subfd in collSubfolder
	ResetAllAttrib subfd.path
	Next
set collFiles=curfd.Files
For each curfile in collFiles
	curfile.Attributes=ResetAttrib(curfile.Attributes)
	Next
End Sub
'--------------------------------------------------------------------
Function ResetAttrib(Attr)
ReadOnly=1
Hidden=2
System=4
If Attr and ReadOnly Then Attr=Attr-ReadOnly
If Attr and Hidden Then Attr=Attr-Hidden
If Attr and System Then Attr=Attr-System
ResetAttrib=Attr
End Function
'--------------------------------------------------------------------