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 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200
|
Option Explicit
Dim sSrc,sDest,MyCmd,Temp,Titre,MsgTitre,MsgAttente,Source,Destination,bf
Dim oExec,ws,LogTmpFile,LogFile,Param,Archive,MyDoc,fso
Dim sFileName, oFile, dtmDateModifie, oFolder
'Initialisation du nom du fichier
sFileName = "T:\Verification_Sauvegarde.txt"
' Récupérer l'instance du fichier.
Set fso = CreateObject("Scripting.FileSystemObject")
' On récupére la date de modification du fichier .txt ou la date de la dernière sauvegarde est inscrite
If fso.FileExists("T:\Verification_Sauvegarde.txt" ) = True Then
Set oFile = fso.GetFile("T:\Verification_Sauvegarde.txt" )
dtmDateModifie = oFile.DateLastModified
Set oFolder = Nothing
Else
dtmDateModifie = "Unknown"
End if
Set ws = CreateObject("WScript.Shell")
Set fso = CreateObject("Scripting.FileSystemObject")
Temp = ws.ExpandEnvironmentStrings("%Temp%")
'chemin des sauvegardes récupérer la lettre sur le document texte ddletter.txt
Const ctePourLecture = 1
Const varNomFic = "T:\ddletter.txt"
Dim objFSO, objFichier, Texte, Message
Dim Chaine, Position, mTab
Set objFSO = CreateObject("Scripting.FileSystemObject")
If ( objFSO.FileExists(varNomFic) ) Then
Set objFichier = objFSO.OpenTextFile(varNomFic, ctePourLecture)
'-------------retourne la lettre du disque courant ----------SOURCE-----------
While Not objFichier.AtEndOfStream
'nous lissons le fichier ligne par ligne
chaine = objFichier.ReadLine
'si la chaine de caractère est "courant" =
If Instr(1,chaine, "courant =") <> 0 Then
'we retrieve 2 chains separeted by "Version=" in a table
mTab = Split(chaine, "courant =")
'we diplay the second chain in XML tag <courant>
sSrc = mTab(1) & "Level1"
End If
Wend
objFichier.Close
Set objFichier = Nothing
Else
WScript.Echo "File absent"
End If
Set objFSO = Nothing
WScript.Quit(0)
Archive = "Archive_"& Day(Now) & "_" & Month(Now) & "_" & Year(Now)
If ( objFSO.FileExists(varNomFic) ) Then
Set objFichier = objFSO.OpenTextFile(varNomFic, ctePourLecture)
'------------------ retourne la lettre du disque dur archive ------DEST
While Not objFichier.AtEndOfStream
'nous lissons le fichier ligne par ligne
chaine = objFichier.ReadLine
'si la chaine de caractère est "archive =
If Instr(1,chaine, "archive =") <> 0 Then
'la chaine de caractère est séparée par un =
mTab = Split(chaine, "archive =")
'nous affichons la lettre
sDest = mTab(1) & Archive
End If
Wend
objFichier.Close
Set objFichier = Nothing
Else
WScript.Echo "File absent"
End If
Set objFSO = Nothing
WScript.Quit(0)
Call CreateFolder(bf,Archive)
LogTmpFile = "MyTmpXCopyLog.txt"
LogFile = "MyXCopyLog.txt"
Param = " /Y /E"
MyCmd = "XCopy" & " " & DblQuote(sSrc) & " " & DblQuote(sDest) & " " & Param &" > " & LogTmpFile &_
" & cmd /U /C Type " & LogTmpFile & " > " & LogFile & " & Del " & LogTmpFile & ""
If (DateDiff("d", File.DateLastModified, dtmDateModifie) < 1 ) Then
Titre = "Copie de Sauvegarde "
MsgAttente = "Copie de Sauvegarde : <font color=Yellow>" & DblQuote(sSrc) & " vers " & DblQuote(sDest) & " </font> . . . ."
Call CreateProgressBar(Titre,MsgAttente)
Call LancerProgressBar()
Call Pause(2)
Call Executer(MyCmd,0,True)
Call FermerProgressBar()
ws.run LogFile
End If
'**************************************************************************************************************
Sub CreateFolder(bf,name)
Set fso = CreateObject("Scripting.FileSystemObject")
If Not FSO.FolderExists(bf & "\" & name) Then
bf.subFolders.Add(name)
Else : Exit Sub
End If
End Sub
'**************************************************************************************************************
Function Executer(StrCmd,Console,bWaitOnReturn)
Dim ws,MyCmd,Resultat
Set ws = CreateObject("wscript.Shell")
'La valeur 0 pour cacher la console MS-DOS
If Console = 0 Then
MyCmd = "CMD /C " & StrCmd & ""
Resultat = ws.run(MyCmd,Console,bWaitOnReturn)
If Resultat = 0 Then
Else
MsgBox "Une erreur inconnue est survenue !",16,"Une erreur inconnue est survenue !"
End If
End If
'La valeur 1 pour montrer la console MS-DOS
If Console = 1 Then
MyCmd = "CMD /K " & StrCmd & " "
Resultat = ws.run(MyCmd,Console,bWaitOnReturn)
If Resultat = 0 Then
Else
MsgBox "Une erreur inconnue est survenue !",16,"Une erreur inconnue est survenue !"
End If
End If
Executer = Resultat
End Function
'***********************************************************************************************************
'Fonction pour ajouter les doubles quotes dans une variable
Function DblQuote(strIn)
DblQuote = Chr(34) & strIn & Chr(34)
End Function
'***********************************************************************************************************
Sub CreateProgressBar(Titre,MsgAttente)
Dim ws,fso,f,f2,ts,ts2,Ligne,i,fread,LireTout,NbLigneTotal,Temp,PathOutPutHTML,fhta,oExec
Set ws = CreateObject("wscript.Shell")
Set fso = CreateObject("Scripting.FileSystemObject")
Temp = WS.ExpandEnvironmentStrings("%Temp%")
PathOutPutHTML = Temp & "\Barre.hta"
Set fhta = fso.OpenTextFile(PathOutPutHTML,2,True)
fhta.WriteLine "<HTML>"
fhta.WriteLine "<HEAD>"
fhta.WriteLine "<Title> " & Titre & "</Title>"
fhta.WriteLine "<HTA:APPLICATION"
fhta.WriteLine "ICON = ""magnify.exe"" "
fhta.WriteLine "BORDER=""THIN"" "
fhta.WriteLine "INNERBORDER=""NO"" "
fhta.WriteLine "MAXIMIZEBUTTON=""NO"" "
fhta.WriteLine "MINIMIZEBUTTON=""NO"" "
fhta.WriteLine "SCROLL=""NO"" "
fhta.WriteLine "SYSMENU=""NO"" "
fhta.WriteLine "SELECTION=""NO"" "
fhta.WriteLine "SINGLEINSTANCE=""YES"">"
fhta.WriteLine "</HEAD>"
fhta.WriteLine "<BODY text=""white""><CENTER><DIV><SPAN ID=""ProgressBar""></SPAN>"
fhta.WriteLine "<span><marquee DIRECTION=""LEFT"" SCROLLAMOUNT=""3"" BEHAVIOR=ALTERNATE><font face=""Comic sans MS"">" & MsgAttente &"</font></marquee></span></DIV></CENTER></BODY></HTML>"
fhta.WriteLine "<SCRIPT LANGUAGE=""VBScript""> "
fhta.WriteLine "Set ws = CreateObject(""wscript.Shell"")"
fhta.WriteLine "Temp = WS.ExpandEnvironmentStrings(""%Temp%"")"
fhta.WriteLine "Sub window_onload()"
fhta.WriteLine " CenterWindow 500,90"
fhta.WriteLine " Self.document.bgColor = ""DarkOrange"" "
fhta.WriteLine " End Sub"
fhta.WriteLine " Sub CenterWindow(x,y)"
fhta.WriteLine " Dim iLeft,itop"
fhta.WriteLine " window.resizeTo x,y"
fhta.WriteLine " iLeft = window.screen.availWidth/2 - x/2"
fhta.WriteLine " itop = window.screen.availHeight/2 - y/2"
fhta.WriteLine " window.moveTo ileft,itop"
fhta.WriteLine "End Sub"
fhta.WriteLine "</script>"
fhta.close
End Sub
'**********************************************************************************************
Sub LancerProgressBar()
Set oExec = Ws.Exec("mshta.exe " & Temp & "\Barre.hta")
End Sub
'**********************************************************************************************
Sub FermerProgressBar()
oExec.Terminate
End Sub
'**********************************************************************************************
Sub Pause(NSeconds)
Wscript.Sleep(NSeconds*1000)
End Sub
'**********************************************************************************************
Function DblQuote(Str)
DblQuote = Chr(34) & Str & Chr(34)
End Function
'********************************************************************************************** |
Partager