Script de backup des dossiers

Commenter

Contenu du snippet

' ----------------------------------------------------------------
' 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
'
' PGM DJEBBI © 2010
' ----------------------------------------------------------------

Source / Exemple : 


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
'--------------------------------------------------------------------

A voir également

S'inscrire maintenant

Vous n'êtes pas encore membre ?

inscrivez-vous, c'est gratuit et ça prend moins d'une minute !

Les membres obtiennent plus de réponses que les utilisateurs anonymes.

Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.

Le fait d'être membre vous permet d'avoir des options supplémentaires.

Du même auteur (djebbipgm)