Sauvegarde des données d'un réseau en vbscript

Soyez le premier à donner votre avis sur cette source.

Vue 10 220 fois - Téléchargée 904 fois

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.

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

Ajouter un commentaire

Commentaires

Messages postés
3
Date d'inscription
mardi 18 janvier 2005
Statut
Membre
Dernière intervention
26 mars 2012

je ne connais pas RSYNC mais j'utilise ROBOCOPY (en standard à partir de win XP) qui fait des copies avec plein d'option (meme scheduler dans la version XP10)
Messages postés
15
Date d'inscription
lundi 19 janvier 2009
Statut
Membre
Dernière intervention
26 janvier 2009

Je ne connaissais pas rsync et effectivement suivant le type de sauvegarde qu'on veut mettre en place, limiter le temps de transfert peut être interressant.
Dans mon cas, la sauvegarde s'exécute tous les weekends du vendredi soir jusqu'au lundi matin donc pas de contrainte de temps.
Par contre, l'adaptation du script peut se faire trés facilement en modifiant le code de la ligne 343.
Messages postés
2215
Date d'inscription
mardi 11 novembre 2003
Statut
Membre
Dernière intervention
16 juillet 2009

Si tu veux accélérer les transferts, tu devrait jeter un coup d'oeil à rsync, il fait un backup en ne transmettant que les parties des fichiers qui ont changer

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.