Code :
- ' ----------------------------------------------------------------
- ' Script de backup des dossiers spaux de l'utilisateur en cours
- ' (A exter de prrence avec cscript)
- '
- ' Syntaxe:
- ' backupspecial [<rrtoire_de_destination>]
- '
- ' Si rrtoire de destination est omis,
- ' la copie a lieu dans %temp%\%username%
- '
- ' Le rrtoire 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)
- ' Crion rrsive 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 spaux 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 ntuel des attributs syst des fichiers
- ' afin de permettre un autre backup
- wscript.echo "Effacement des attributs RHS"
- ResetAllAttrib dest
- Wscript.quit
- '--------------------------------------------------------------------
- ' sous-programme de crion rrsive 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 rrsif 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
- '--------------------------------------------------------------------
|
test/ du PC 1 (en réseau)