Sauvegarde des données d'un réseau en vbscript
Description
Descriptif du programme:
Cré une copie de sauvegarde de données se trouvant sur differents serveurs ou postes du réseau.
Le listing des sauvegarde à effectuer est inscrit dans un fichier texte. Le chemin de celui-ci devra être transmis au programme en tant qu'argument.
suppression de l'ancienne sauvegarde si le parametre "/raz" est transmis au programme.
Les fichiers systemes cachés ainsi que tous les chemins listés dans ExceptFile.txt et ExeptRep.txt ne seront pas sauvegardés.
Détection et gestion des chemins longs (chemins de plus de 256 caractères).
Tronque le nom des fichiers et dossiers à [MaxNameLength] caractères s'ils le dépassent.
Création de deux rapports:
un fichier rapport.txt qui contient la date de la sauvegarde, le listing des dossiers sauvegardés ainsi qu'un indicateur de déroulement de la sauvegarde (OK ou PB)
un fichier erreurs.txt qui contient toutes les erreurs et tous les avertissements
Création d'un fichier InfoSav.vbs dans le dossier 'démarrage' du pc indiquant l'état de la sauvegarde(en cours, OK ou PB).
Il s'exécute automatiquement à la fin de la sauvegarde si une session est déja ouverte ou à la prochaine ouverture de session.
Ce programme a un vécu de 3 ans.
j'ai corrigé les bugs pendant 1 ans (erreurs de programmation mais aussi bug window: les chemins long etc...)
Cela fait maintenant 2 ans qu'il tourne sans bug sur un réseau de 500pc 1500cptes 8serveurs
Reste à faire:
1)sauvegarde des ACL
2)interface web d'administration des sauvegardes avec:
configuration des variables du programme (MaxNameLength, racinesav, ScriptFilePath, DriveTemp)
création et configuration des taches planifiées pour la sauvegarde
3)Programme de restauration des données et des ACL
Cré une copie de sauvegarde de données se trouvant sur differents serveurs ou postes du réseau.
Le listing des sauvegarde à effectuer est inscrit dans un fichier texte. Le chemin de celui-ci devra être transmis au programme en tant qu'argument.
suppression de l'ancienne sauvegarde si le parametre "/raz" est transmis au programme.
Les fichiers systemes cachés ainsi que tous les chemins listés dans ExceptFile.txt et ExeptRep.txt ne seront pas sauvegardés.
Détection et gestion des chemins longs (chemins de plus de 256 caractères).
Tronque le nom des fichiers et dossiers à [MaxNameLength] caractères s'ils le dépassent.
Création de deux rapports:
un fichier rapport.txt qui contient la date de la sauvegarde, le listing des dossiers sauvegardés ainsi qu'un indicateur de déroulement de la sauvegarde (OK ou PB)
un fichier erreurs.txt qui contient toutes les erreurs et tous les avertissements
Création d'un fichier InfoSav.vbs dans le dossier 'démarrage' du pc indiquant l'état de la sauvegarde(en cours, OK ou PB).
Il s'exécute automatiquement à la fin de la sauvegarde si une session est déja ouverte ou à la prochaine ouverture de session.
Source / Exemple :
'*******************************************************************************
'*** PROGRAMME DE SAUVEGARDE RESEAU
'*** descriptif:
'*** Cré une copie de sauvegarde de données se trouvant sur differents serveurs ou postes du réseau.
'*** Le listing des sauvegarde à effectuer est inscrit dans un fichier texte. Le chemin de celui-ci devra être transmis au programme en tant qu'argument.
'*** suppression de l'ancienne sauvegarde si le parametre "/raz" est transmis au programme
'*** Les fichiers systemes cachés ainsi que tous les chemins listés dans ExceptFile.txt et ExeptRep.txt ne seront pas sauvegardés
'*** Détection et gestions des chemins longs (chemins de plus de 256 caractères)
'*** Tronque à [MaxNameLength] caractères le nom des fichiers et dossiers dépassant [MaxNameLength] caractères
'*** Création de deux rapports:
'*** un fichier rapport.txt qui contient la date de la sauvegarde, le listing des dossiers sauvegardés ainsi qu'un indicateur de déroulement de la sauvegarde (OK ou PB)
'*** un fichier erreurs.txt qui contient toutes les erreurs et tous les avertissements
'*** Création d'un fichier InfoSav.vbs dans le dossier 'démarrage' du pc indiquant l'état de la sauvegarde(en cours, OK ou PB).
'*** Il s'exécute automatiquement à la fin de la sauvegarde si une session est déja ouverte ou à la prochaine ouverture de session.
'***
'*** utilisation:
'*** Définir tout d'abord les constantes spécifique à votre réseau cf ci-dessous
'*** Utilisez des fichiers batch pour lancer des sauvegardes (ci joint 2 ex: week.bat et weekend.bat)
'*** Utiliser le planificateur de tache windows pour planifier les sauvegardes
'*** NB: Tous les partages listés dans le fichier listing(week.txt weekend.txt etc...) doivent être accessibles. Vérifiez le en le parcourant avec l'explorateur window.
'*** Utiliser de préférence les partages d'administration windows de chaque lecteur (c$, d$, e$ etc...)
'***
'*** A venir:
'*** 1)sauvegarde des ACL
'*** 2)interface web d'administration des sauvegardes avec:
'*** configuration des variables du programme (MaxNameLength, racinesav, etc...)
'*** création et configuration des taches planifiées pour la sauvegarde
'*** 3)Programme de restauration des données et des ACL
'***
'*******************************************************************************
On error resume next
' définition des constantes
' constantes à modifier par l'administrateur suivant la config désirée
const MaxNameLength = 60 'correspond à la longueur max des noms des dossiers et fichiers sauvegardés -> si la longueur dépasse, la sauvegarde se fera avec le noms tronqué à [MaxNameLength] caractère.
const racinesav = "e:\sauvegarde" 'correspond au dossier racine où sera stoqué la sauvegarde(disque dur externe usb ou ide/sata amovible)
'NB: racinesav doit être un chemin du type lecteur:\dossier (ex e:\sav) et non un chemin du type lecteur:\ (ex E:\ ne fonctionnera pas)
const ScriptFilePath = "c:\documents and settings\all users\menu démarrer\programmes\démarrage\infosav.vbs" 'correspond au chemin du script qui aura pour tache d'afficher l'état de la sauvegarde (en cours, PB, OK)
const DriveTemp="x:" 'DriveTemp correspond au lecteur réseau qui sera utilisé pour la gestion des chemins long. NB: spécifier un lecteur libre
'constantes ne devant pas être modifiées
const MaxPathLength = 246 'correspond à la longueur max d'un chemin (+13 caracteres pour chemin\fichier) -> au dela, utilisation d'un lecteur réseau
const ForReading = 1
const ForWriting = 2
const ForAppending = 8
Const OverWrite = True
if len(trim(racinesav))<4 then msgbox "La constante 'racinesav' doit être un chemin du type lecteur:\dossier. Arrêt du programme.",vbCritical + vbOkOnly + vbSystemModal + 0,"Erreur sauvegarde.vbs" : wscript.quit
' déclaration de variables
dim listedossiers() 'tableau listant tous les sous-dossiers du dossier à sauvegarder
dim ListeExceptFile() 'tableau listant tous les fichiers à ne pas sauvegarder
dim ListeExceptRep() 'tableau listant tous les dossiers à ne pas sauvegarder
strcomputer = "."
erreurglobale=false
FindLongPath=false
Set objFSO = CreateObject("Scripting.FileSystemObject")
' Récupération et traitement des arguments
if WScript.Arguments.item(0)<>"/?" then ScriptWrite("initialisation") 'cré le script InfoSav.vbs
err.clear()
if not objFSO.FolderExists(racinesav) Then objFSO.CreateFolder(racinesav) 'doit impérativement exister pour l'écriture d'erreurs
if err.number<>0 then exitprog()
Set objArgs = WScript.Arguments
if WScript.Arguments.Count<1 then ' erreur: il faut au moins 1 argument
Set objErrFile = objFSO.OpenTextFile(racinesav & "\erreurs.txt", ForWriting, True)
ErrWrite("initialisation")
ErrWrite("Le script a été lancé sans aucun argument. Taper 'sauvegarde.vbs /?' pour plus d'informations.")
exitprog()
end if
if WScript.Arguments.item(0)="/?" then 'affiche aide
wscript.echo "AIDE POUR LE LANCEMENT DU SCRIPT DE SAUVEGARDE:" & chr(13) & chr(13) & " sauvegarde.vbs /raz [workfile]" & chr(13) & " /raz : supprime entièrement l'ancienne sauvegarde. (facultatif)" & chr(13) & " workfile : le chemin du fichier contenant la liste des dossiers à sauvegarder."
exitprog()
end if
i=0
if WScript.Arguments.item(0)="/raz" then
'suppression de toute l'ancienne sauvegarde
if not deltree(racinesav) then 'racinesav n'a pas pu être supprimé
Set objErrFile = objFSO.OpenTextFile(racinesav & "\erreurs.txt", ForWriting, True)
ErrWrite("initialisation")
ErrWrite("L'ancienne sauvegarde (" & racinesav & ") n'a pas pu être supprimée")
if WScript.Arguments.Count=1 then
ErrWrite("Aucun listing de travail n'a été transmis au programme")
exitprog()
end if
else 'racinesav a été supprimé
err.clear()
objFSO.CreateFolder(racinesav)
if err.number<>0 then exitprog()
if WScript.Arguments.Count=1 then
Set objErrFile = objFSO.OpenTextFile(racinesav & "\erreurs.txt", ForWriting, True)
ErrWrite("initialisation")
ErrWrite("L'ancienne sauvegarde a été supprimée mais aucun listing de travail n'a été transmis au programme")
exitprog()
else
Set objErrFile = objFSO.OpenTextFile(racinesav & "\erreurs.txt", ForWriting, True)
ErrWrite("initialisation")
end if
end if
i=1
else
Set objErrFile = objFSO.OpenTextFile(racinesav & "\erreurs.txt", ForAppending, True)
ErrWrite("initialisation")
end if
If not objFSO.FileExists(WScript.Arguments.item(i)) Then
ErrWrite("Le fichier passé en paramètre contenant le listing du travail a exécuter n'existe pas")
exitprog()
end if
Err.Clear()
Set objWorkFile = objFSO.OpenTextFile(WScript.Arguments.item(i), ForReading, false)
If Err.Number <> 0 Then
ErrWrite("Erreur d'ouverture du fichier passé en paramètre")
exitprog()
end if
' Création du fichier contenant le script affichant les infos sur le déroulement de la sauvegarde
ScriptWrite("debut")
' ouverture du fichier rapport.txt contenant les infos sur le déroulement de la sauvegarde
Err.Clear()
Set objTextFile = objFSO.OpenTextFile(racinesav & "\rapport.txt", ForAppending, True)
objTextFile.WriteLine(" ")
objTextFile.WriteLine("SAUVEGARDE DU " & date)
If Err.Number <> 0 Then ErrWrite("Erreur d'ouverture ou d'écriture du fichier ./rapport.txt")
'initialisation des tableaux ListeExceptionFile() et ListeExceptRep()
NbreExceptFile=0
exception "readfile", "file" 'lecture du fichier ./ExceptFile.txt
NbreExceptRep=0
exception "readfile", "rep" 'lecture du fichier ./ExceptRep.txt
'Lancement des sauvegardes
Do While Not objWorkFile.AtEndOfStream 'lecture du fichier contenant les chemins à sauvegarder
'suppression des espaces à droite et à gauche et suppression du \ en fin de chemin s'il existe
source=trim(objWorkFile.ReadLine)
if mid(source, len(source), 1)="\" then source = mid(source, 1, len(source)-1)
'traitement
if not objFSO.FolderExists(source) then
if lcase(mid(source,1,3))<>"rem" and source<>"" then
ErrWrite("Le dossier '" & source & "' n'existe pas ou n'a pas été trouvé")
decalage=""
while len(source)+len(decalage)<50
decalage=decalage & " "
wend
objTextFile.WriteLine(" Le " & date & " de " & time & " à " & time & ": sauvegarde de: " & source & decalage & "Contrôle: ERREUR ")
erreurglobale=true
end if
else
if mid(source, 1, 2)<>"\\" then 'chemin local
'transforme le chemin local en chemin réseau et remplace le : du lecteur par $ (utilisation du partage d'administration windows: C$, D$, E$ etc...)
Set oNetwork = CreateObject("WScript.Network")
source = "\\" & oNetwork.ComputerName & "\" & mid(source, 1, 1) & "$" & mid(source, 3, len(source))
Set oNetwork = nothing
end if
cible = racinesav & mid(source, 2, len(source))
call sauve()
end if
loop
' Création du fichier contenant le script affichant les infos sur le déroulement de la sauvegarde
ScriptWrite("fin")
exitprog()
'------------------------------------------------------------
' Procédure de sauvegarde et de contrôle
sub sauve()
dim CopyAfterAll()
On error resume next
DateDepart=date
errsauve=false
depart=time
'suppression du dossier cible s'il existe
if objFSO.FolderExists(cible) and len(cible)>3 Then
if not deltree(cible) then ErrWrite("Le dossier " & cible & " n'a pas pu être supprimé")
end if
'création de l'arborescence cible
if len(cible) > 3 then 'du genre c:\undossier\unautre\etc
i = 4
do
slach = Instr(i, cible, "\")
if slach > 4 then ' un \ a été trouvé
dossier = mid(cible, 1, slach-1)
If not objFSO.FolderExists(dossier) Then
objFSO.CreateFolder(dossier)
end if
else
if len(cible) <= i-1 then exit do
If not objFSO.FolderExists(cible) Then
objFSO.CreateFolder(cible)
end if
end if
i = slach + 1
loop until slach < 5
end if
'Initialise le tableau listedossier(): contient tous les sous dossiers de "source"
NbreDossier=listerep(source)
'sauvegarde de tous les fichiers sauf les fichiers systemes cachés
if NbreDossier>0 then
'Modification du tableau listedossiers(): troncature de tous les noms > MaxNameLenght
SearchAndRenLongName(NbreDossier)
'Création de la structure de répertoire
debut=len(source)+1
for i=2 to NbreDossier 'le dossier cible de base est déja créé (i=1)
Err.Clear()
if listedossiers(1,i)="" then dossier=cible & mid(listedossiers(0,i), debut) else dossier=cible & mid(listedossiers(1,i), debut)
if len(dossier)<=MaxPathLength then 'on ne cré que les dossiers < MaxPathLength. Toutes les données se trouvant dans les sous dossiers seront copiés dans ce dossier.
objFSO.CreateFolder(dossier)
If Err.Number <> 0 Then
ErrWrite("Pb création structure répertoire: le dossier '" & dossier & "' n'a pas pu être créé.")
erreurglobale=true
errsauve=true
end if
end if
next
'recopie de tous les fichiers de tous les dossiers sauf les fichiers systemes cachés
for i=1 to NbreDossier
if listedossiers(1,i)="" then index=0 else index=1
dossier=listedossiers(0,i)
if len(dossier)>MaxPathLength then dossier=smallpath(dossier, DriveTemp, MaxPathLength)
Set objFolder = objFSO.GetFolder(dossier)
Set colFiles = objFolder.Files
if len(listedossiers(0,i))<=MaxPathLength and not TestAccessFile(colFiles) then
dossier=smallpath(dossier, DriveTemp, MaxPathLength)
Set objFolder = objFSO.GetFolder(dossier)
Set colFiles = objFolder.Files
end if
NbreCopyAfterAll=0
redim CopyAfterAll(1,0)
For Each objFile in colFiles
if not exception(listedossiers(0,i) & "\" & objFile.name, "file") and (objFile.Attributes AND 6)<>6 then
dossier=cible & mid(listedossiers(index,i), debut)
if len(dossier)>MaxPathLength then
FindLongPath=true
ErrWrite("Le fichier '" & listedossiers(0,i) & "\" & objFile.name & "' doit être sauvegardé dans un dossier parent(Chemin trop long)")
end if
ret=CopyFile(objFile.Path, dossier, objFile.name)
if ret<0 then
if ret=-1 then 'objfile.name>MaxNameLenght
NbreCopyAfterAll=NbreCopyAfterAll+1
redim preserve CopyAfterAll(1,NbreCopyAfterAll)
CopyAfterAll(0,NbreCopyAfterAll)=objFile.Path
CopyAfterAll(1,NbreCopyAfterAll)=dossier
end if
if ret=-3 then 'erreur de copie du fichier
ErrWrite("Erreur de copie du fichier " & listedossiers(0,i) & "\" & objFile.name)
erreurglobale=true
errsauve=true
end if
else
if objFile.size<>ret then
ErrWrite("Erreur sur le fichier '" & listedossiers(0,i) & "\" & objFile.name & "'. La taille du fichier source(" & objFile.size & ") est différente de celle du fichier cible(" & ret & ").")
erreurglobale=true
errsauve=true
end if
end if
end if
Next
for j=1 to NbreCopyAfterAll 'sauvegarde de tous les fichiers devant être renommés
ret=CopyFile(CopyAfterAll(0,j), CopyAfterAll(1,j), "*")
if ret=-3 then 'erreur de copie du fichier
ErrWrite("Erreur de copie du fichier " & CopyAfterAll(0,j))
erreurglobale=true
errsauve=true
else
Set objFile = objFSO.GetFile(CopyAfterAll(0,j))
if objFile.size<>ret then
ErrWrite("Erreur sur le fichier '" & CopyAfterAll(0,j) & "'. La taille du fichier source(" & objFile.size & ") est différente de celle du fichier cible(" & ret & ").")
erreurglobale=true
errsauve=true
end if
end if
next
next
end if
fin=time
decalage=""
while len(source)+len(decalage)<50
decalage=decalage & " "
wend
Err.Clear()
if errsauve=true then
objTextFile.WriteLine(" Le " & DateDepart & " de " & depart & " à " & fin & ": sauvegarde de: " & source & decalage & "Contrôle: ERREUR ")
else
objTextFile.WriteLine(" Le " & DateDepart & " de " & depart & " à " & fin & ": sauvegarde de: " & source & decalage & "Contrôle: OK ")
end if
If Err.Number <> 0 Then ErrWrite("Erreur d'écriture dans le fichier objtextfile")
end sub
'------------------------------------------------------------
' Fonction de copie de fichiers avec gestion des noms longs et dossiers longs
function CopyFile(Fichier_Source, Chemin_Cible, Nom_Cible)
On Error Resume Next
'CopyFile=size fichier cible traitement OK
'CopyFile=-1 NomCible>MaxNameLength
'CopyFile=-3 Erreur de copy du fichier
FichierSource=Fichier_Source
CheminCible=Chemin_Cible
NomCible=Nom_Cible
if len(CheminCible)>MaxPathLength then 'FichierSource sera copié dans le premier sur dossier accessible et renommé si necessaire
do 'recherche du dernier sur dossier <= MaxPathLength
k=InstrRev(CheminCible, "\")
CheminCible=mid(CheminCible, 1, k-1)
if k<=MaxPathLength then exit do
loop
NomCible="*"
end if
MaxLongName=MaxPathLength +12 -len(CheminCible) 'longueur max d'un chemin MaxPathLength + 13 avec fichier (\nomfich.txt) -> sans l' "\" 12
if MaxLongName>MaxNameLength then MaxLongName=MaxNameLength
if len(NomCible)>MaxLongName then CopyFile=-1 : exit function 'le fichier doit être renommé -> sera traité une fois que les fichiers courts auront été sauvegardés
if NomCible="*" then 'on détermine le nom et l'extension du fichier source puis on recherche un nom unique tout en gardant l'extension
k=InstrRev(FichierSource, "\")
NomCible=mid(FichierSource, k+1)
k=InstrRev(NomCible, ".")
extension=""
if len(NomCible)-k <=4 and len(NomCible)-k > 0 then
extension=mid(NomCible, k)
NomCible=mid(NomCible, 1, k-1)
end if
id=0
if len(NomCible)>MaxLongName-len(extension) then id=1 : NomCible=mid(NomCible, 1, MaxLongName-len(extension)-2) & "_0"
do while objFSO.FileExists(CheminCible & "\" & NomCible & extension)
str_id="_" & Cstr(id)
nbrechar=len(NomCible)-len(str_id)
if nbrechar<0 then CopyFile=-3 : exit function
NomCible=mid(NomCible, 1, nbrechar) & str_id
id=id+1
loop
NomCible=NomCible & extension
end if
Err.Clear()
objFSO.CopyFile FichierSource, CheminCible & "\" & NomCible, OverWrite
if Err.number<>0 then CopyFile=-3 : exit function
Set objTemp = objFSO.GetFile(CheminCible & "\" & NomCible)
objTemp.Attributes = 0
CopyFile=objTemp.size
end function
'------------------------------------------------------------
' Fonction de listing des sous dossiers d'un dossier sauf dossiers systemes cachés
function listerep(dossier)
On error resume next
Set objFSO = CreateObject("Scripting.FileSystemObject")
redim listedossiers(1,1)
'listedossiers(0, x): path dossier source.
'listedossiers(1, x): contient path dossier cible(qui sera initialisé lors de la création de la structure de repertoire si le nom du dossier cible est différent de celui du dossier source)
If not objFSO.FolderExists(dossier) Then listerep=0 : exit function
listedossiers(0,1)=dossier
dimtab=1
ajout=2
Err.Clear()
i=1
fin = 1
'recherche de tous les sous dossiers
do
do
if (len(listedossiers(0,i)) > MaxPathLength) then 'avec mappage immédiat gestion chemin long
CheminCourt=smallpath(listedossiers(0,i), DriveTemp, MaxPathLength)
Err.Clear()
Set objFolder = objFSO.GetFolder(CheminCourt)
Set colSubfolders = objFolder.Subfolders
tempon=colSubfolders.count
If Err.Number <> 0 Then
ErrWrite("Erreur dans fonction listerep(). Problème d'accés au dossier '" & listedossiers(0,i) & "'.")
for j=i+1 to ajout-1
listedossiers(0, j-1)=listedossiers(0, j)
next
fin=fin-1
ajout=ajout-1
i=i-1
listedossiers(0, ajout)=""
elseif colSubfolders.count > 0 then
dimtab = dimtab + colSubfolders.count
redim Preserve listedossiers(1,dimtab)
For Each objSubfolder in colSubfolders
tempon=retrievepath(objSubfolder.path)
If not exception(tempon, "rep") and (objSubFolder.Attributes AND 6)<>6 Then
listedossiers(0,ajout) = tempon
ajout = ajout + 1
end if
Next
end if
else 'sans mappage immédiat
Err.Clear()
Set objFolder = objFSO.GetFolder(listedossiers(0,i))
Set colSubfolders = objFolder.Subfolders
tempon=colSubfolders.count
If Err.Number <> 0 Then
ErrWrite("Erreur dans fonction listerep(). Problème d'accés au dossier '" & listedossiers(0,i) & "'.")
for j=i+1 to ajout-1
listedossiers(0, j-1)=listedossiers(0, j)
next
fin=fin-1
ajout=ajout-1
i=i-1
listedossiers(0, ajout)=""
elseif colSubfolders.count > 0 then
dimtab = dimtab + colSubfolders.count
redim Preserve listedossiers(1,dimtab)
mappage=false
if TestAccessSubfolder(colsubfolders)=false then
mappage=true
CheminCourt=smallpath(listedossiers(0,i), DriveTemp, MaxPathLength)
Set objFolder = objFSO.GetFolder(CheminCourt)
Set colSubfolders = objFolder.Subfolders
end if
For Each objSubfolder in colSubfolders
if mappage=true then tempon=retrievepath(objSubfolder.path) else tempon=objSubfolder.path
If not exception(tempon, "rep") and (objSubFolder.Attributes AND 6)<>6 Then
listedossiers(0,ajout)=tempon
ajout = ajout + 1
end if
Next
end if
end if
i=i+1
loop while i<=fin
if ajout-1 = fin then exit do 'aucun sous dossier n'a été trouvé
i = fin+1
fin = ajout-1
loop
listerep=fin
If Err.Number <> 0 Then ErrWrite("Une erreur s'est produite dans la fonction listerep().")
end function
'------------------------------------------------------------
' Procédure de création du script permettant d'informer l'administrateur du bon ou mauvais déroulement de la sauvegarde
sub ScriptWrite(etape)
On error resume next
Err.Clear()
Set objscriptFile = objFSO.OpenTextFile(ScriptFilePath, Forwriting, True)
if etape="initialisation" then
objscriptFile.WriteLine("Set objFSO = CreateObject(" & chr(34) & "Scripting.FileSystemObject" & chr(34) & ")")
objscriptFile.WriteLine("msgbox" & CHR(34) & "L'initialisation du programme n'a pas pu se faire." & CHR(34) & " & chr(13) & " & CHR(34) & "L'erreur se situe dans les arguments passés au script ou à la création du dossier racine de sauvegarde." & chr(34) & ",," & chr(34) & "Rapport sauvegarde" & chr(34))
objscriptFile.WriteLine("objFSO.DeleteFile(" & chr(34) & ScriptFilePath & chr(34) & ")")
end if
if etape="debut" then
objscriptFile.WriteLine("Set objFSO = CreateObject(" & chr(34) & "Scripting.FileSystemObject" & chr(34) & ")")
objscriptFile.WriteLine("msgbox" & CHR(34) & "La sauvegarde est bloquée ou n'est pas terminée. A VERIFIER" & chr(34) & ",," & chr(34) & "Rapport sauvegarde" & chr(34))
objscriptFile.WriteLine("objFSO.DeleteFile(" & chr(34) & ScriptFilePath & chr(34) & ")")
end if
if etape="fin" then
ARLN=""
if FindLongPath=true then ARLN= CHR(34) & " & vbCrLf & " & CHR(34) & "(Des chemins longs ont été trouvés)"
if erreurglobale=true then
objscriptFile.WriteLine("Set objFSO = CreateObject(" & chr(34) & "Scripting.FileSystemObject" & chr(34) & ")")
objscriptFile.WriteLine("msgbox" & CHR(34) & "Des erreurs ont été détectées pendant la sauvegarde. Pour plus d'informations, éditer le fichier rapport.txt et erreurs.txt." & ARLN & chr(34) & ",," & chr(34) & "Rapport sauvegarde" & chr(34))
objscriptFile.WriteLine("objFSO.DeleteFile(" & chr(34) & ScriptFilePath & chr(34) & ")")
else
objscriptFile.WriteLine("Set objFSO = CreateObject(" & chr(34) & "Scripting.FileSystemObject" & chr(34) & ")")
objscriptFile.WriteLine("msgbox" & CHR(34) & "La sauvegarde s'est effectuée correctement." & ARLN & chr(34) & ",," & chr(34) & "Rapport sauvegarde" & chr(34))
objscriptFile.WriteLine("objFSO.DeleteFile(" & chr(34) & ScriptFilePath & chr(34) & ")")
end if
end if
objscriptFile.close
If Err.Number <> 0 Then ErrWrite("Erreur d'ouverture ou d'écriture du fichier objsriptfile")
end sub
'------------------------------------------------------------
' Procédure d'écriture des erreurs
sub ErrWrite(texte)
'On error resume next
if texte="initialisation" then
objErrFile.WriteLine("RAPPORT D'ERREURS PENDANT LA SAUVEGARDE DU " & date & ":")
else
if Err.Number<>0 then
objErrFile.WriteLine(" " & texte & "(erreur" & Err.Number & ": " & err.description & ")")
else
objErrFile.WriteLine(" " & texte)
end if
end if
Err.Clear()
end sub
'------------------------------------------------------------
' fonction permettant de lire le fichier ExceptFile.txt ou ExeceptRep.txt contenant les fichiers ou dossiers ne devant pas être copiés
' pourquoi: Certain fichier ne pouvant jamais être copiés(systeme en cours d'execution), on évite de les traiter pour ne pas occasionner d'erreur
function exception(TemponPath, RepOrFile)
On error resume next
RepOrFile=lcase(RepOrFile)
path=lcase(TemponPath)
exception=false
if path="readfile" then 'lecture du fichier; renvoi true si des exceptions ont été trouvées sinon false
Err.Clear()
if RepOrFile="rep" then Set objExceptFile = objFSO.OpenTextFile("ExceptRep.txt", ForReading, false)
if RepOrFile="file" then Set objExceptFile = objFSO.OpenTextFile("ExceptFile.txt", ForReading, false)
If Err.Number <> 0 Then
if RepOrFile="rep" then NbreExceptRep=0 else NbreExceptFile=0
exit function
end if
Do While Not objExceptFile.AtEndOfStream
tempon=trim(objExceptFile.ReadLine)
if tempon<>"" and lcase(mid(tempon, 1, 3))<>"rem" then
if RepOrFile="rep" then
NbreExceptRep = NbreExceptRep + 1
redim Preserve listeExceptRep(NbreExceptRep)
ListeExceptRep(NbreExceptRep) = lcase(tempon)
else
NbreExceptFile = NbreExceptFile + 1
redim Preserve listeExceptFile(NbreExceptFile)
ListeExceptFile(NbreExceptFile) = lcase(tempon)
end if
end if
loop
objExceptFile.close
exit function
end if
if RepOrFile="file" and NbreExceptFile>0 then
for y=1 to NbreExceptFile
if ListeExceptFile(y)=path then
exception=true
exit function
end if
next
end if
if RepOrFile="rep" and NbreExceptRep>0 then
for y=1 to NbreExceptRep
PosEtoile=instr(ListeExceptRep(y), "*")
if PosEtoile then
find=true
tempon1=ListeExceptRep(y)
tempon2=path
do 'vérifie si tempon1 et tempon2 sont identiques en écartant les sous-dossier marqués '*'
if mid(tempon1, 1, PosEtoile-1)<>mid(tempon2, 1, PosEtoile-1) then find=false : exit do
tempon1=mid(tempon1, PosEtoile+2)
tempon2=mid(tempon2, PosEtoile)
tempon2=mid(tempon2, instr(tempon2,"\")+1)
PosEtoile=instr(tempon1, "*")
loop while PosEtoile>0
if find=true and instr(tempon2, tempon1) then exception=true : exit function
else
if ListeExceptRep(y)=path then
exception=true
exit function
end if
end if
next
end if
end function
'------------------------------------------------------------
' Procédure de fermeture du script
sub exitprog()
On error resume next
tempon=smallpath("", DriveTemp, MaxPathLength) 'supprime le lecteur réseau s'il existe
objtextFile.close
objErrFile.close
objWorkFile.close
'Lance le script d'information sur le déroulement de la sauvegarde si une session est ouverte
if objFSO.FileExists(ScriptFilePath) Then
Set objWMIService = GetObject("winmgmts:{impersonationLevel=impersonate}!\\.\root\cimv2")
Set colComputer = objWMIService.ExecQuery("Select * from Win32_ComputerSystem")
For Each objComputer in colComputer
if not isnull(objComputer.UserName) then
Set WshShell = WScript.CreateObject("WScript.Shell")
WshShell.Run (chr(34) & ScriptFilePath & chr(34))
end if
exit for
Next
end if
wscript.quit
end sub
'------------------------------------------------------------
' Procédure de recherche et de renommage des dossiers dont la longueur du nom dépasse MaxNameLength
sub SearchAndRenLongName(NbreLignes)
On error resume next
dim ListeNewName()
redim ListeNewName(0)
NbreNewName=0
ParentRep=""
Err.Clear()
for x=1 to NbreLignes
PosLastBSlash=InStrRev(listedossiers(0,x), "\")
NomRep=mid(listedossiers(0,x),PosLastBSlash+1)
LastParentRep=ParentRep
ParentRep=mid(listedossiers(0,x), 1, PosLastBSlash)
if ParentRep<>LastParentRep then redim ListeNewName(0) : NbreNewName=0
if len(NomRep)>MaxNameLength then
'renomme dossier et verif existe pas déja (avec gestion des noms déja renommés)
id=0
do 'recherche d'un nom unique
str_id="_" & Cstr(id)
newname=mid(NomRep,1,MaxNameLength-len(str_id)) & str_id
doublon=false
'on verifie que sur ce niveau ce nom n'a pas été déja utilisé pour les dossiers déja renommés
y=1
while y<=NbreNewName and doublon=false
if newname=ListeNewName(y) then doublon=true
y=y+1
wend
'on vérifie tous les noms de dossier de ce niveau
y=x-1
if y>0 then
TestPos=InStrRev(listedossiers(0,y), "\")
TestParentRep=mid(listedossiers(0,y), 1, TestPos)
while y>0 and TestParentRep=ParentRep and doublon=false
OverName=mid(listedossiers(0,y),TestPos+1)
if newname=overname then doublon=true
y=y-1
TestPos=InStrRev(listedossiers(0,y), "\")
TestParentRep=mid(listedossiers(0,y), 1, TestPos)
wend
end if
y=x+1
if y<=NbreLignes then
TestPos=InStrRev(listedossiers(0,y), "\")
TestParentRep=mid(listedossiers(0,y), 1, TestPos)
while y<=NbreLignes and TestParentRep=ParentRep and doublon=false
OverName=mid(listedossiers(0,y),TestPos+1)
if newname=overname then doublon=true
y=y+1
TestPos=InStrRev(listedossiers(0,y), "\")
TestParentRep=mid(listedossiers(0,y), 1, TestPos)
wend
end if
id=id+1
loop while doublon=true
'newname est unique -> on affecte les changements à tous les dossiers concernés
NbreNewName=NbreNewName+1
redim preserve ListeNewName(NbreNewName)
ListeNewName(NbreNewName)=newname
if listedossiers(1,x)="" then
ParentRepSearch=listedossiers(0,x) & "\"
index=0
listedossiers(1,x)=ParentRep & newname
else
ParentRepSearch=listedossiers(1,x) & "\"
index=1
PosLastBSlash1=InStrRev(listedossiers(1,x), "\")
listedossiers(1,x)=mid(listedossiers(1,x), 1, PosLastBSlash1) & newname
end if
'renomme tous les dossiers enfants (se trouvant obligatoirement aprés cet enregistrement)
NbreChar=len(ParentRepSearch)
for y=x+1 to NbreLignes
TestParentRep=mid(listedossiers(index,y), 1, NbreChar)
if TestParentRep=ParentRepSearch then 'dossier ayant la meme racine->change la racine
listedossiers(1,y)=listedossiers(1,x) & mid(listedossiers(index,y), NbreChar)
end if
next
end if
next
redim ListeNewName(0)
If Err.Number <> 0 Then ErrWrite("Une erreur s'est produite dans la fonction SearchAndRenLongName().")
end sub
'------------------------------------------------------------
' fonction permettant de supprimer tous les espaces droite et gauche de la variable chaine name
' et de remplacer par un '_' les espaces qu'il y a dans la chaine
function format(name)
On error resume next
tempon1=trim(name)
tempon2=""
espace=false
for pos=1 to len(tempon1)
car = mid(tempon1, pos, 1)
if car=" " then
if espace=false then
tempon2 = tempon2 & "_"
espace=true
end if
else
espace=false
tempon2 = tempon2 & car
end if
next
format = tempon2
end function
'------------------------------------------------------------
' fonction suppression arborescence répertoire, renvoi true si OK sinon false
function deltree(tree)
On error resume next
Set objFSO = CreateObject("Scripting.FileSystemObject")
deltree=true
if not objFSO.FolderExists(tree) then exit function
err.clear
objFSO.DeleteFolder(tree)
if Err.Number <> 0 then deltree=false
exit function
end function
'------------------------------------------------------------
' fonction retournant un chemin court en utilisant un lecteur réseau.
function smallpath(path, lecteur, maxpath)
On error resume next
set oNet = CreateObject("Wscript.Network")
If objFSO.DriveExists(lecteur) Then oNet.RemoveNetworkDrive lecteur
if path="" then
Set oNet = nothing
exit function
end if
if mid(path, 2, 1)=":" then path="\\127.0.0.1\" & mid(path, 1, 1) & "$" & mid(path,3) 'traitement d'un dossier local
if len(path) <= maxpath then ' mappage de tout le chemin
err.clear
oNet.MapNetworkDrive lecteur, path
If Err.Number = 0 Then smallpath = lecteur & "\"
else
if mid(path, maxpath+1, 1)="\" then
firstpart=mid(path, 1, maxpath)
secondpart=mid(path, maxpath+1)
else
k=InstrRev(path, "\", -1, 1)
if k<6 then
Set oNet = nothing
exit function 'chemin trop court
else
firstpart=mid(path, 1, k-1)
secondpart=mid(path, k)
end if
end if
do while not objFSO.FolderExists(firstpart) 'vérification chemin existe pour montage lecteur réseau
k=InstrRev(firstpart, "\", -1, 1)
if k<6 then
Set oNet = nothing
exit function 'chemin trop court
else
secondpart=mid(firstpart, k) & secondpart
firstpart=mid(firstpart, 1, k-1)
end if
loop
'mappage d'une partie du path
err.clear
oNet.MapNetworkDrive lecteur, firstpart
If Err.Number = 0 Then smallpath = lecteur & secondpart
end if
Set oNet = nothing
FindLongPath=true
end function
'------------------------------------------------------------
' fonction retournant un chemin UNC d'un chemin ayant un lecteur réseau.
function retrievepath(path)
On error resume next
set oNet = CreateObject("Wscript.Network")
set colDrives = oNet.EnumNetworkDrives
lecteur=lcase(mid(path, 1, 2))
chemin=mid(path, 3)
For k = 0 to colDrives.Count-1 Step 2
if lcase(colDrives.Item(k))=lecteur then
retrievepath=colDrives.Item(k+1) & chemin
exit for
end if
Next
Set oNet = nothing
Set colDrives = nothing
end function
'------------------------------------------------------------
' fonction testant l'accés à tous les sous dossiers d'un dossier. (for each ne fonctionne qu'avec les dossiers accessible. Si dossier inaccessible -> le nbre d'iteration sera différent du nbre de dossier)
function TestAccessSubfolder(collectionrep)
On error resume next
cpt=0
for each rep in collectionrep
cpt=cpt+1
next
if cpt<>collectionrep.count then TestAccessSubfolder=false else TestAccessSubfolder=true
end function
'------------------------------------------------------------
' fonction testant l'accés à tous les fichiers d'un dossier. (for each ne fonctionne qu'avec les dossiers accessible. Si dossier inaccessible -> le nbre d'iteration sera différent du nbre de dossier)
function TestAccessFile(collectionfile)
On error resume next
cpt=0
for each file in collectionfile
cpt=cpt+1
next
if cpt<>collectionfile.count then TestAccessFile=false else TestAccessFile=true
end function
Conclusion :
Ce programme a un vécu de 3 ans.
j'ai corrigé les bugs pendant 1 ans (erreurs de programmation mais aussi bug window: les chemins long etc...)
Cela fait maintenant 2 ans qu'il tourne sans bug sur un réseau de 500pc 1500cptes 8serveurs
Reste à faire:
1)sauvegarde des ACL
2)interface web d'administration des sauvegardes avec:
configuration des variables du programme (MaxNameLength, racinesav, ScriptFilePath, DriveTemp)
création et configuration des taches planifiées pour la sauvegarde
3)Programme de restauration des données et des ACL
Codes Sources
A voir également
- Sauvegarde des données d'un réseau en vbscript
- Récupérer données json (javascript) - Conseils pratiques -Javascript
- Sauvegarde sql ✓ - Forum SQL
- Sauvegarde oracle ✓ - Forum Delphi / Pascal
- Vbscript msgbox - Conseils pratiques -Visual Basic / VB.NET
- Le jeu de sauvegarde contient la sauvegarde d'une base de données qui n'est pas la base de données ✓ - Forum Delphi / Pascal
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.