Script de backup des dossiers

Soyez le premier à donner votre avis sur cette source.

Snippet vu 5 121 fois - Téléchargée 17 fois

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

Ajouter un commentaire

Commentaire

cs_scoubi
Messages postés
5
Date d'inscription
jeudi 23 janvier 2003
Statut
Membre
Dernière intervention
11 juin 2013
-
Bon code, petite question : si j'ai un dossier avec des fichiers et sous dossiers, l'ensemble faisant 20 Go et que je souhaite par la suite sauvegarder sur DVD sans compresser les données.
est il possible de sauvegarder les données dans un dossier du genre "disk-1", disk-2" ,... faisant chacune 4.3 Go afin que chacune d'entre elle soit sauvegardé sur DVD (sans compression bien sur) ?.

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.