1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
| ' ----------------------------------------------------------------
' 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
'-------------------------------------------------------------------- |
