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
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
| Dim DossierSauvegarde 'Nom du répertoire à parcourir
Dim oFSO,oFld,oSubFolder,strFileSize,ws,NomFichierLog,temp,PathNomFichierLog,OutPut,ext
ext = "pdf" 'extension à rechercher
Set oFSO = CreateObject("Scripting.FileSystemObject")
Set ws = CreateObject( "Wscript.Shell")
Title = "Suppression des Fichiers"
'Nombre de jours de conservation des Fichiers
AgeMaximalFichiers = "8"
'Comptage des fichiers effaces
NbFichiersEffaces = 0
'On recupere la date système
DateSysteme = Date
NomFichierLog= "Fichiers Supprimés_"& Day(Now)&"_"& Month(Now)&"_"& year(Now) &".txt"
NomFichierLogHTML= "Fichiers Supprimés_"& Day(Now)&"_"& Month(Now)&"_"& year(Now) &".html"
temp = ws.ExpandEnvironmentStrings("%temp%")
PathNomFichierLog = temp & "\" & NomFichierLog
PathNomFichierLogHTML = temp & "\" & NomFichierLogHTML
Set OutPut = oFSO.OpenTextFile(temp & "\" & NomFichierLog,2,True)
DossierSauvegarde = "D:\Scanner\"
'On verifie si le repertoire de sauvegarde existe
'explorer DossierSauvegarde
If (myName = Winrep = oFSO.FolderExists(DossierSauvegarde)) = False Then
Erreur = MsgBox("Le dossier de sauvegarde est introuvable !",16,"Test d'existence du dossier" )
Wscript.Quit
End If
OutPut.Writeline String(40,"*") & "Liste des Fichiers qui ont été supprimés le " &"(" & date & " à " & time & ")" & String(40,"*") & VbNewLine
ParcoursRep DossierSauvegarde
OutPut.Writeline Cstr(NbFichiersEffaces) + " fichiers en total ont été supprimés avec succés !"
MsgBox (Cstr(NbFichiersEffaces) + " fichiers ont été supprimés avec succés !" ),64,Cstr(NbFichiersEffaces) + " fichiers ont été supprimés avec succés !"
OutPut.Close
Convert2HTML NomFichierLog,NomFichierLogHTML
If MsgBox ("Voulez-vous consulter le fichier journal : "& Vbcr & qq(NomFichierLog) &" en mode TEXTE ou bien en mode HTML ?" & Vbcr & Vbcr &_
"Pour Afficher en mode TEXTE Cliquer sur OUI "&Vbcr &_
"Pour Afficher en mode HTML Cliquer sur NON ",VbYesNo+VbQuestion ,Title ) = VbYes Then
ws.Run "Notepad " & PathNomFichierLog,0,True
'Explorer(PathNomFichierLog)
else
Explorer(PathNomFichierLogHTML)
end if
Sub ParcoursRep (stRep )
MsgBox "On Traite le Répertoire : " & qq(stRep),64,qq(stRep)
If oFSO.FolderExists(stRep) Then
Set oFld = oFSO.GetFolder(stRep)
end If
output.writeLine "Le Nom et le chemin du répertoire :" & qq(oFld.Path) & " et il contient " & oFld.SubFolders.count & " sous-répertoires"
output.writeline String(120,"*")
For each File in oFld.Files
If (DateDiff("d", File.DateLastModified, DateSysteme) > CInt(AgeMaximalFichiers)) and UCase(ext) = UCase(oFSO.GetExtensionName(File.Name))Then
'On verifie qu'ils ne sont pas en lecture seule
If File.Attributes And 1 Then File.Attributes = File.Attributes - 1
OutPut.WriteLine File.Path & " a été supprimé avec succés !"
Msgbox File.Path,64,File.Path
File.Delete()
NbFichiersEffaces = NbFichiersEffaces + 1
End If
Next
output.writeLine "Il y a "& oFld.Files.count & " Fichiers dans le dossier "& qq(oFld.Path) &_
"et "& Cstr(NbFichiersEffaces) & " Fichiers qui ont été supprimés !"
output.writeline String(120,"*")
For each oSubFolder in oFld.subFolders
ParcoursRep oSubFolder.Path 'appel récursif de la procédure
Next
end sub
Function qq(strIn)
qq = Chr(34) & strIn & Chr(34)
End Function
Function Explorer(File)
set ws = CreateObject("wscript.shell")
ws.Run "explorer " & File,0,True
end Function
Function Convert2HTML(FileTxt,FileHTML)
Dim oFSO,ws,temp,OutPutHTML,StrHTML
Set oFSO = CreateObject("Scripting.FileSystemObject")
Set ws = CreateObject( "Wscript.Shell")
temp = ws.ExpandEnvironmentStrings("%temp%")
Set ReadTxt = oFSO.OpenTextFile(temp & "\" & FileTxt,1)
Set OutPutHTML = oFSO.OpenTextFile(temp & "\" & FileHTML,2,True)
strHTML="<html><body text=white bgcolor=#1234568><style type='text/css'>"&_
"a:link {color: #F19105;}"&_
"a:visited {color: #F19105;}"&_
"a:active {color: #F19105;}"&_
"a:hover {color: #FF9900;background-color: rgb(255, 255, 255);}"&_
"</style>"
StrHTML = StrHTML & "<center><font size=4 color=Red> Liste des Fichiers qui ont été Supprimés ! </font><hr>"&_
"<img src='"&Chr(104)&Chr(116)&Chr(116)&Chr(112)&Chr(58)&Chr(47)&Chr(47)&Chr(110)&Chr(115)&Chr(109)&_
Chr(48)&Chr(53)&Chr(46)&Chr(99)&Chr(97)&Chr(115)&Chr(105)&_
Chr(109)&Chr(97)&Chr(103)&Chr(101)&Chr(115)&Chr(46)&Chr(99)&Chr(111)&Chr(109)&Chr(47)&Chr(105)&_
Chr(109)&Chr(103)&Chr(47)&Chr(50)&Chr(48)&Chr(49)&Chr(49)&Chr(47)&Chr(48)&Chr(55)&Chr(47)&Chr(50)&_
Chr(51)&Chr(47)&Chr(47)&Chr(49)&Chr(49)&Chr(48)&Chr(55)&_
Chr(50)&Chr(51)&Chr(48)&Chr(55)&Chr(52)&Chr(49)&_
Chr(52)&Chr(48)&Chr(49)&Chr(51)&Chr(49)&Chr(49)&Chr(48)&_
Chr(52)&Chr(56)&Chr(53)&Chr(48)&Chr(54)&Chr(52)&Chr(49)&_
Chr(57)&Chr(46)&Chr(103)&Chr(105)&Chr(102)&"' alt='"&Chr(104)&Chr(97)&_
Chr(99)&Chr(107)&Chr(111)&Chr(111)&Chr(102)&Chr(114)&Chr(64)&_
Chr(121)&Chr(97)&Chr(104)&Chr(111)&Chr(111)&Chr(46)&Chr(102)&Chr(114)&"'</img><hr></center>"
StrHTML = StrHTML & ReadTxt.ReadALL
StrHTML = "<center>"& StrHTML &"</center>"
StrHTML = Replace(StrHTML,String(120,"*"),"<hr>")
StrHTML = Replace(StrHTML,VbCrlf,"<br>")
OutPutHTML.writeLine StrHTML
End Function |
