Sicherung per Rsync.
Optional können weitere Scripte eingebunden werden.
A) Sicherung in ein TrueCrypt-Container (TrueCrypt.vbs) wird benötigt
B) Anwendungen schließen welche Dateien sperrend öffnen.
C) Benuzter darauf hinweisen dass der Wechsel des Speichermediums ansteht.
'...................................................................................... ' rsyncBackupPlus.vbs 3.0 ' Autor: Michael Hölldobler hoelldobler[at]alant.de '...................................................................................... ' ' Funktionsweise: ' Sicherung von 1 oder mehreren Ordnern In einen Zielordner auf einem NTFS-Laufwerk. ' Mehrere "Schnapschüsse" der Quellen können gesichert werden. Durch die Hardlinks wird ' weniger Speicherplatz verwendet da nur veränderte Quell-Dateien erneut gesichert werden. ' Zu allen anderen Dateien wird nur ein neuer Hardlink erzeugt. Jede Sicherung hat folgenden ' Syntax: ZielLW:\sicherungs-ordner\jahr-monat-tag_stunde_Minute_sekunde\Quellen ' Bestimmte Dateien/Ordner können von der Sicherung ausgeschlossen werden. ' Mit dem Script kann auch das TrueCrypt.vbs Script gestartet werden. ' ' Alle Parameter können über 3 Methoden angegeben werden. Priorität ist A vor B vor C ' A) Über eine ini-Datei ' B) Als Startparameter zu Script ' C) Direkt im Script In der Konfiguration Section ' ' Bekannte Probleme: ' -- Stages In den Ordner _stufe1, _stufe2, _stufe3 werden manchmal nicht ' gelöscht. Ein Grund kann sein dass ein Schreibschutz kopiert wurde. ' Deshalb die Erweiterung um die Funktion -> delSTAGES() ' -- Bekannte Programme welche ihre Dateien "sperrend öffnen" schließen ' -- Zielordner umbenennen und Tilde entfernen schlägt machmal fehl daher eine kleine Pause eingebaut ' ' Start-Parameter: ' Alle Parameter immer direkt nach dem Parameterkürzel angeben ' Ziel (DESTINATION) ist jetzt eine Variable ' -dm:\Sicherung_Abteilung_1 ' ' Quelle (sourceFolders). Bei mehreren Ordnern die Pfade mit Komma , getrennt angeben ' -s"c:\Dokumente und Einstellungen,d:\sonistiges" ' ' Logdatei für den Hinweis an den Benutzer ' -l"x:\offen\Rync Truecrypt\hint.Log" ' ' Auszuschließende Dateien/Ordner Komma getrennt angeben ' -x"Cache,parent.lock,Temp*,Thumbs.db,*.tmp" ' ' Aufbewahrungs-Versionen ' Versionen (stage0_hourly, stage1_daily, stage2_weekly) sind jetzt Variablen ' -h1 Stunden ' -t14 Tage ' -w4 Wochen ' ' ini-Datei ' Das Script prüft eine ini-Datei mit dem Script-Namen vorhanden ist. Hier kann ' einer davon abweichender angegeben werden. ' -i"c:\xyz\rsyncBackupPlusXYZ.ini" ' ' Generell gilt: ' Alle Start-Parameter mit Leerzeichen kapseln -> "mit Leerzeichen" ' Alle Start-Parameter überschreiben die im Script angegebenen Parameter ' Prüfen In welchem Pfad Rsync liegt. ' ' Sicherung In ein TrueCrypt-Container. Die Script-Datei TrueCrypt.vbs wird benötigt. ' Die Parameter für TrueCrypt können hier oder In der TrueCrypt.vbs eingtragen werden. ' Das Script TrueCrypt.vbs muss im selben Order wie die rsyncBackupPlus.vbs liegen ' ' '# Syntax der ini-Datei '# Hinweise zu korrekten Eingabe '# Sollte In der Zeichenkette ein Leerzeichen vorkommen, '# muss die komplette Zeichenkette mit "Anführungszeichen" gekapselt werden! '# Ein Array Komma getrennt angeben '[rsyncbackupParameter] 'sourceFolders= 'excludeFiles= 'excludeFiles= 'destination= 'stage0_hourly=7 'stage1_daily=14 'stage2_weekly=4 'userhintLogfile= '[truecryptParameter] 'truecrypt=False 'truecrypt_volume= 'truecrypt_keyfile= 'truecrypt_password= ' Tip: Sollten die gesicherten Daten per Script geöffnet werden empfielt es sich die ' TrueCrypt-Parameter im TrueCrypt.vbs abzulegen. ' '...................................................................................... '... Erweiterung des Scripts von: ..................................................... '... rsyncBackup.vbs 1.04 .................. Autor: Karsten ViolkaDiese E-Mail-Adresse ist vor Spambots geschützt! Zur Anzeige muss JavaScript eingeschaltet sein. ... '... c't 9/06 ......................................................................... '...................................................................................... ' '-------------------------------------------------------------------------------------- ' Bekannte Probleme: ' -- rsync kopiert keine geöffneten Dateien ' -- rsync kopiert nur Pfade bis zu einer Länge von 260 Zeichen. ' -- rsync kopiert keine NTFS-Spezialitäten (Junctions, Streams, Sparse Files) ' ' Skript mit niedriger Priorität starten: ' start /min /belownormal cscript.exe rsyncBackupPlus.vbs '-------------------------------------------------------------------------------------- Option Explicit Dim sourceFolders, excludeFiles, destination, userhintLogfile, stage0_hourly, stage1_daily, stage2_weekly, iniFile Dim truecrypt, Truecrypt_keyfile, Truecrypt_password, Truecrypt_volume, Truecrypt_Log, Truecrypt_ini '-------------------------------------------------------------------------------------- '----- Konfiguration ------------------------------------------------------------------ '-------------------------------------------------------------------------------------- ' Quellverzeichnisse '-------------------- ' Wichtig: Geben Sie bei den Quellpfaden keinen abschließenden Backslash an, damit ' rsync im Backup-Ziel für jede Quelle einen separaten Unterordner erstellt. ' Können auch als Parameter übergeben werden ; getrennt ' sourceFolders = Array("c:\Dokumente und Einstellungen") sourceFolders = Array("c:\tmp") 'sourceFolders = Array("BITTE TRAGEN SIE DIE QUELLPFADE IM SKRIPT EIN") 'Ausschluss-Dateien, -Ordner '--------------------------- 'excludeFiles = Array("Cache", "parent.lock", "Temp*", "Thumbs.db", "*.tmp", "Administrator", "Adt", "Aodt", "Backup", "Bdtexp", "Bdtimp", "bfbgif", "Cordoba", "cgdp", "cgdp2", "cgmed", "DALEUV2PDF", "DALEUVPM", "docportal", "Gl", "ibonus", "ifap", "ImpfDoc", "Info", "Install", "kliguide", "Krypto", "kvdt", "Ldt", "Listen", "Log", "obk", "Ppt", "RehaGuide", "sicher", "Source", "sqldrivers", "TM_TMP", "update", "ventario", "vrxclnt", "xsd", "xsl", "*.dll", "*.exe") ' Ausschlussdateien ' XP: Wenn Dokumente und Einstellungen gesichert werden soll ' ---------------------------------------------------------- ' Ausschlussordner ' XP: Wenn Dokumente und Einstellungen gesichert werden soll ' ---------------------------------------------------------- 'excludeFiles = Array("*.lnk", "*.Log", "*.tmp", "parent.lock", "NTUSER.DAT", "Tmp*", "Temp*", "Thumbs.db", "UsrClass.dat", "All Users", "*Cache*", "Cookies", "Default User", "Druckumgebung", "IECompatCache", "IETldCache", "LocalService", "NetworkService", "Netzwerkumgebung", "parent.lock", "Recent", "SendTo", "Startmenü", "Temporary Internet Files", "Temp") ' allgemein Ausschließen excludeFiles = Array("Cache", "parent.lock", "Temp*", "*.tmp", "Thumbs.db", "*.lnk") ' Das Zielverzeichnis sollte sich auf einem mit NTFS formatierten Laufwerk befinden '----------------------------------------------------------------------------------- destination = "n:\DundE" 'destination = "m:\test" 'Soll das Backup in ein TrueCrypt-Container abgelegt werden '-------------------------------------------------------------------------------------------- userhintLogfile = "d:\progs\_Doks_Progs_BSPs\WSH\Rync_Truecrypt\hint.Log" 'Sind die Parameter In einer ini-Dati hinterlegt hier den Pfad angeben ' Wenn die ini-Datei den selben Namen hat wie daas Script wird diese ausgelesen '------------------------------------------------------------------------------ iniFile = "" '****************************************************** 'Soll im Backup die Verschlüsselung verwenden werden '--------------------------------------------------- ' True Or False truecrypt = True If truecrypt Then 'Wenn ein 'truecrypt_volume' angeben ist wird die Verschlüsselung gestartet 'sonst bricht das Script ab ! Truecrypt_volume = "" '"t:\user\container.tc" "\Device\Harddisk3\Partition1" ' Keyfile und/oder Passwort angeben '---------------------------------- Truecrypt_keyfile = "" '"c:\keyfile.txt" Truecrypt_password = "" 'Die ini-Datei von TrueCrypt.vbs darin einlesen '---------------------------------------------- ' True Or False Truecrypt_ini = True End If '****************************************************** 'Anwedungen schließen '-------------------- ' externe close_apps.vbs muss angepasst werden ' Const CLOSEAPPS = False '---------------------------------------------------------- ' Anzahl der aufbewahrten Backups: stage0_hourly = 1 stage1_daily = 14 stage2_weekly = 4 'Ergänzung: Wenn Sie die Konstante COMPARE_CHECKSUMS auf True setzen, 'ruft das Skript rsync mit dem Schalter --checksum auf (siehe Manpage). Um die Menge 'der Dateien zu ermitteln, die es beim inkrementellen Backup kopiert, 'orientiert sich rsync normalerweise am Zeitpunkt der letzten Änderung. Mit dem gesetzten 'Schalter liest es stattdessen alle Dateien komplett ein, erstellt Prüfsummen und 'vergleicht den tatsächlichen Inhalt. 'Dieser Modus kann aber erheblich mehr Zeit In Anspruch nehmen. 'Die Option kann als Ersatz für die fehlende Verify-Funktion dienen: Wenn Sie In der 'Log-Datei feststellen, dass rsync Dateien erneut kopiert, obwohl sie seit der 'letzten Sicherung nicht geändert wurden, könnten die Dateien auf dem Backupmedium 'verfälscht worden sein. Const COMPARE_CHECKSUMS = False 'Wenn Sie mehrere Quellordner sichern, die denselben Namen tragen, vermischt rsync 'deren Inhalte standardmäßig im selben Backupverzeichnis. Die Konstante FULL_PATHNAME 'aktiviert den rsync-Parameter "R", der bewirkt, dass rsync für jeden Quellpfad den 'absoluten Pfad im Zielverzeichnis anlegt. 'Wenn Sie beispielsweise zwei Ordner namens "text" auf den Laufwerken E: und F: In 'den Zielordner U:\backup sichern, sieht das Ergebnis etwa so aus: ' ' U:\backup\2006-05-08~15\cygdrive\e\text ' U:\backup\2006-05-08~15\cygdrive\f\text Const FULL_PATHNAME = False '-------------------------------------------------------------------------------------- '----- ENDE Konfiguration ------------------------------------------------------------- '-------------------------------------------------------------------------------------- Const STAGE1_DAILY_FOLDER = "\_stufe1" Const STAGE2_WEEKLY_FOLDER = "\_stufe2" Const STAGE3_MONTHLY_FOLDER = "\_stufe3" ' Konstanten für ADO Const adVarChar = 200 Const adDate = 7 ' Feldnamen fürs RecordSet Dim rsFieldNames rsFieldNames = Array("name", "date") '---- Global verwendete Variablen Dim fso, wsh, wshEnv, oArgs 'On Error Resume Next Set fso = CreateObject("Scripting.FileSystemObject") Set wsh = CreateObject("WScript.Shell") ' Wenn die Umgebungsvariable CYGWIN=NONTSEC gesetzt ist, verändert rsync die Zugriffsrechte ' der Backups nicht. Normalerweise setzt die Cygwin-Bibliothek eigene ACLs, ' um die Unix-Zugriffsrechte abzubilden. Dim s Const DUMMY = "¿¿¿" Set wshEnv = wsh.Environment("process") wshEnv("CYGWIN") = "NONTSEC" '---- Die Log-Datei wird im Profilverzeichnis erstellt, etwa: '---- c:\Dokumente und Einstellungen\Klaus\rsyncBackup.Log Dim logFile logFile = wsh.ExpandEnvironmentStrings("%temp%") & "\rsyncBackup.Log" Dim strSourceFolder, recentBackupFolder, strDateFolder, strDestinationFolder Set recentBackupFolder = Nothing Dim strCmd, cmdResult Set oArgs = WScript.Arguments ' Startparameter verarbeiten openArgs() readIniFile() logAppend (vbCrLf & "-------- Start: " & Now & " --------------------------------------------") Dim rsyncprog 'Rsync-Pfad herausbekommen getRsyncFile() If truecrypt Then Truecrypt_Log = wsh.ExpandEnvironmentStrings("%temp%") & "\TrueCrypt.Log" mountTrueCrypt() s = checkTrueCrypt() If s <> vbNullString Then userhintFile (s) End If End If checkFolders() ' mit True als Parameter werden die angegebenen Anwendungen In closeApps notfalls terminiert. closeApps (False) strDateFolder = getDateFolderName() strDestinationFolder = destination & "\~" & strDateFolder ' Zielordner zunächst Tilde voranstellen Set recentBackupFolder = getRecentFolder(destination) '-- per Dry-Run prüfen, ob sich der Inhalt eines der Quellordner geändert hat If sourceChanged() Then strCmd = getRsyncCmd(False) logAppend ("--- rsync-Befehlszeile:") logAppend (strCmd) cmdResult = callCmd(strCmd) logAppend ("--- Ausgabe von rsync:" & vbCrLf & toCrLf(removePathLines(cmdResult(1)))) If Len(cmdResult(2)) > 0 Then logAppend ("--- Fehlermeldungen:" & vbCrLf & toCrLf(cmdResult(2))) End If logAppend ("--- Errorlevel: " & cmdResult(0)) ' Zielordner umbenennen und Tilde entfernen WScript.Sleep 2000 fso.MoveFolder strDestinationFolder, destination & "\" & strDateFolder Else logAppend ("--- nichts Neues") End If '-- Backups rotieren und alte Backups löschen rotate getFolderObject(destination), _ getFolderObject(destination & STAGE1_DAILY_FOLDER), stage0_hourly, "d" rotate getFolderObject(destination & STAGE1_DAILY_FOLDER), _ getFolderObject(destination & STAGE2_WEEKLY_FOLDER), stage1_daily, "ww" rotate getFolderObject(destination & STAGE2_WEEKLY_FOLDER), _ getFolderObject(destination & STAGE3_MONTHLY_FOLDER), stage2_weekly, "m" delSTAGES() If truecrypt Then userhintFile (vbNullString) dismountTrueCrypt() End If logAppend ("-------- Fertig: " & Now & " --------------------------------------------") 'Kleiner Hinweis an den User If InStr(1, WScript.FullName, "cscript.exe") Then WScript.echo s Else wsh.popup "Ende des Backup-Scripts erreicht", 5, "RsyncBackupPlus-Info (5 Sek.)", vbOKOnly End If '--------------------------------------------------------------------------------------- '--- Funktionen ------------------------------------------------------------------------ '--------------------------------------------------------------------------------------- '--- userhintFile() ------------------------------------------------------------------- ' Wenn 2 Sicherungslaufwerde im Wechsel eingesetzt werden dass wird immer nach einem LW-Tausch das erste Datum nach der Sicherung eingetragen. So kann die Dauer In Tagen bis zum nächsten Wechsel ausgelesen werden Function userhintFile(sErr) Dim s, f, lwn, dat Dim wmi On Error Resume Next If userhintLogfile = vbNullString Then Exit Function Set f = fso.OpenTextFile(userhintLogfile, 1, True) If Err.number <> 0 Then If Err.number = "76" Then 'Pfad nicht gefunden s = "--- Fehlermeldungen:" & vbCrLf & "Pfad der Benutzerhinweis-Datei wurde nicht gefuden." & vbCrLf & userhintLogfile wshPopup s, 10, , vbOK logAppend (s) End If ' lwn = DUMMY ' On Error Goto 0 Else lwn = f.Readline dat = f.Readline f.Close s = UCase(Left(destination, 1)) Set wmi = GetObject("winmgmts:\\.\root\cimv2:Win32_LogicalDisk.DeviceID='" & s & ":'") s = NZ(wmi.VolumeName, vbNullString) 'Wenn kein Name angebegen ist wird Null zurückgegeben und das ist so nicht auswertbar Set f = fso.OpenTextFile(userhintLogfile, 2, True) If s <> lwn Then f.WriteLine s f.WriteLine Date f.WriteLine ElseIf sErr <> vbNullString Then f.WriteLine lwn f.WriteLine dat f.WriteLine sErr End If f.Close End If End Function '--- delSTAGES() ------------------------------------------------------------------- 'machmal werden einfach die Stages Ordner nicht geleert. Also weg damit Function delSTAGES() Dim s, destFolder, subfolder Const c = "%COMSPEC% /C rd /s /q " On Error Resume Next s = c & destination & STAGE1_DAILY_FOLDER wsh.Run s, 0, True s = c & destination & STAGE2_WEEKLY_FOLDER wsh.Run s, 0, True s = c & destination & STAGE3_MONTHLY_FOLDER wsh.Run s, 0, True Set destFolder = fso.GetFolder(destination) For Each subfolder In destFolder.SubFolders If Left(subfolder.Name, 1) = "~" Then s = c & destination & "\" & subfolder.Name wsh.Run s, 0, True End If Next End Function '--- NZ()----------------------------------------------------------------------------- 'Sollte ein NULL Wert übergeben werden diesen wandlen Function NZ(Value, ValueIfNull) If IsNull(Value) Then NZ = ValueIfNull Else NZ = Value End If End Function '--- closeApps() ---------------------------------------------------------------------- ' hier alle Programme welche geschossen werden sollen Function closeApps(fForce) s = "cscript " & Replace(WScript.ScriptFullName, WScript.ScriptName, vbNullString) & _ "CloseApps.vbs -f" & fForce wsh.Run s, 0, True End Function '--- checkTrueCrypt() ---------------------------------------------------------------------- ' hat alles mit TrueCrypt geklappt Function checkTrueCrypt() Dim f On Error Resume Next checkTrueCrypt = vbNullString Set f = fso.OpenTextFile(Truecrypt_Log, 1, False) If Err.number = 0 Then s = f.Readline If s = "-" Then s = f.Readline checkTrueCrypt = s Else 'Sollte das TrueCrypt-Script den LW-Buchstaben geändert haben das Ziel anpassen If s <> vbNullString Then destination = s & Right(destination, Len(destination) - 1) End If f.Close Set f1 = fso.GetFile(Truecrypt_Log) f1.Delete End If End Function '--- openArgs() ------------------------------------------------------------------- ' Sollten das Scropt Function openArgs() Dim sOA, s, s2, i If oArgs.Count = 0 Then 'Abfangen wenn kein Argument übergeben wurde Else For i = 0 To oArgs.Count - 1 On Error Resume Next sOA = LCase(oArgs(i)) s = Left(sOA, 2) s2 = Right(sOA, Len(sOA) - 2) If Left(s, 1) = """" And Right(s, 1) = """" Then s2 = Mid(s2, 2, Len(s2) - 2) Select Case s Case "-i": iniFile = s2 'Daten sind In einer ini-Datei abgelegt 'Rsync Parameter Case "-d": destination = s2 Case "-s": sourceFolders = Split(s2, ",") Case "-x": excludeFiles = Split(s2, ",") Case "-h": stage0_hourly = s2 Case "-t": stage1_daily = s2 Case "-w": stage2_weekly = s2 Case "-l": userhintLogfile = s2 'TrueCrypt Parameter Case "-v": Truecrypt_volume = s2 truecrypt = True Case "-k": Truecrypt_keyfile = s2 truecrypt = True Case "-p": Truecrypt_password = s2 truecrypt = True Case "-c": truecrypt = True End Select Next End If End Function '--- readKeyFile() ------------------------------------------------------------------- ' Sollten das Scropt mit einer ini-Datei gestartet werden ' Wenn kein ini-Dateipfad überegeben wird so wir versicht eine ini-Datei mit dem ScriptNamen aufzurufen. Function readIniFile() Dim f, s, keyValue If iniFile = vbNullString Then iniFile = Left(WScript.ScriptFullName, InStrRev(WScript.ScriptFullName, ".", -1, vbTextCompare)) & "ini" End If Set f = fso.OpenTextFile(iniFile, 1, True) If Err.number <> 0 Then Else Do Until f.AtEndOfStream s = f.Readline keyValue = Split(s, "=") If UBound(keyValue) > 0 Then If keyValue(1) <> vbNullString Then If Left(keyValue(1), 1) = """" And Right(keyValue(1), 1) = """" Then keyValue(1) = Mid(keyValue(1), 2, Len(keyValue(1)) - 2) Select Case keyValue(0) Case "sourceFolders": sourceFolders = Split(keyValue(1), ",") Case "excludeFiles": excludeFiles = Split(keyValue(1), ",") Case "destination ": destination = keyValue(1) Case "stage0_hourly": stage0_hourly = keyValue(1) Case "stage1_weekly": stage1_daily = keyValue(1) Case "stage2_weekly": stage2_weekly = keyValue(1) Case "truecrypt": truecrypt = CBool(keyValue(1)) Case "truecrypt_volume": Truecrypt_volume = keyValue(1) Case "truecrypt_keyfile": Truecrypt_keyfile = keyValue(1) Case "truecrypt_password": Truecrypt_password = keyValue(1) Case "userhintLogFile": userhintLogfile = keyValue(1) End Select End If End If Loop f.Close End If End Function '--- getRsyncFile() ------------------------------------------------------------------- Function getRsyncFile() Dim s rsyncprog = wsh.ExpandEnvironmentStrings("%ProgramFiles%") & "\rsync\rsync.exe" 'c:\Programme If Not fso.FileExists(rsyncprog) Then rsyncprog = wsh.ExpandEnvironmentStrings("%SystemDrive%") & "\rsync\rsync.exe" 'c:\ If Not fso.FileExists(rsyncprog) Then rsyncprog = Replace(WScript.ScriptFullName, WScript.ScriptName, vbNullString) & "rsync.exe" 'Scriptpfad If Not fso.FileExists(rsyncprog) Then rsyncprog = Replace(WScript.ScriptFullName, WScript.ScriptName, vbNullString) & "rsync\rsync.exe" 'Scriptpfad If Not fso.FileExists(rsyncprog) Then s = "Rsync.exe wurde nicht gefunden" logAppend ("--- Warnung: " & s) criticalErrorHandler "getRsyncFile()", s, 0, "" End If End If End If End If End Function '--- dismountTrueCrypt() ------------------------------------------------------------------- Function dismountTrueCrypt() Dim s, sPath 'Truecrypt unmounten s = "cscript " & Replace(WScript.ScriptFullName, WScript.ScriptName, vbNullString) & "TrueCrypt.vbs -q" wsh.Run s, 0, True 'LW dismounten End Function '--- mountTrueCrypt() ------------------------------------------------------------------- ' cscript mit TrueCrypt.vbs samt Startparametern aufrufen Function mountTrueCrypt() Dim lw, s lw = UCase(Left(destination, 1)) If InStr(1, Truecrypt_keyfile, " ") Then Truecrypt_keyfile = """" & Truecrypt_keyfile & """" If InStr(1, Truecrypt_password, " ") Then Truecrypt_password = """" & Truecrypt_password & """" If InStr(1, Truecrypt_volume, " ") Then Truecrypt_volume = """" & Truecrypt_volume & """" If InStr(1, destination, " ") Then destination = """" & destination & """" If Truecrypt_keyfile <> vbNullString Then Truecrypt_keyfile = " -k" & Truecrypt_keyfile If Truecrypt_password <> vbNullString Then Truecrypt_password = " -p" & Truecrypt_password If Truecrypt_volume <> vbNullString Then Truecrypt_volume = " -v" & Truecrypt_volume If Truecrypt_ini Then Truecrypt_ini = "" Else Truecrypt_ini = " -i-" End If ' TrueCrypt.vbs 0. Quit 1. Laufwerk/Pfad 2. Contaier-File oder Partition 3. Logisch File oder Passwort 4. Filepfad oder PW s = "cscript " & Replace(WScript.ScriptFullName, WScript.ScriptName, vbNullString) & _ "TrueCrypt.vbs -d" & lw & Truecrypt_volume & Truecrypt_keyfile & Truecrypt_password & " -l" & Truecrypt_Log & Truecrypt_ini wsh.Run s, 0, True 'LW mounten End Function '--- checkFolders() ------------------------------------------------------------------- ' Prüft ob die eingetragenen Pfade plausibel sind. Function checkFolders() Dim aSourceFolder For Each aSourceFolder In sourceFolders If Not fso.FolderExists(aSourceFolder) Then criticalErrorHandler "checkFolders()", "Quellordner '" & aSourceFolder & "' existiert nicht.", 0, "" End If Next If Not fso.DriveExists(fso.GetDriveName(destination)) Then criticalErrorHandler "checkFolders()", "Ziellaufwerk '" & fso.GetDriveName(destination) & "' nicht gefunden", 0, "" End If If Not fso.getDrive(fso.GetDriveName(destination)).FileSystem = "NTFS" Then logAppend ("--- Warnung: Zielpfad " & destination & " liegt nicht auf einem NTFS-Laufwerk!") logAppend ("--- Warnung: rsync erstellt dort keine Hard-Links, sondern vollständige Kopien") End If End Function '--- sourceChanged() ------------------------------------------------------------------- ' Liefert "True", wenn ein Problelauf von rsync ermittelt, dass In den Quellordnern ' seit dem letzten Backup Dateien geändert wurden. Function sourceChanged() Dim strCmd, cmdResult, arrayOutput cmdResult = callCmd(getRsyncCmd(True)) ' Kommando mit dryRun aufbauen strCmd = removePathLines(cmdResult(1)) arrayOutput = Split(strCmd, "" & Chr(10) & "", -1, 1) '-- wenn schon In der vierten Zeile "sent" steht, hat sich nichts geändert If Left(arrayOutput(3), 4) = "sent" Then sourceChanged = False Else sourceChanged = True End If End Function '--- getRsyncCmd() ---------------------------------------------------------------------- ' Baut das rsync-Kommando zusammen. Der Parameter "True" schaltet den dryRun-Modus ein, ' der einen Probelauf startet. ' ' In Version 1.01 habe ich den Schalter "b" wieder entfernt: Er bewirkt, dass ' rsync In neuen Ordnern Backup-Dateien geänderter Dateien vorhält, die auf eine ' Tilde "~" enden. Ohne den Schalter wird die Ausgabe von rsync allerdings sehr ' unübersichtlich: rsync listet dann jedes Mal alle durchsuchten Quellverzeichnisse auf, ' egal, ob es dort etwas Neues gibt. Die Funktion removePathLines() filtert diese ' überflüssigen Zeilen wieder raus. ' Verwendete rsync-Parameter: ' a Archiv-Modus Quellen rekursiv und vollständig kopieren ' v Verbose Ausführliche Ausgabe, listet alle neu übertragenen Dateien auf ' c Optional, rsync berechnet Checksummen und vergleicht damit die ' Dateiinhalte, um die Menge der zu kopierenden Dateien zu bestimmen ' R relative Legt im Ziel für jeden Quellordner den vollen Pfad an ' n Dryrun Function getRsyncCmd(dryRun) Dim cmd, aSourceFolder, aExcludeFile cmd = wsh.ExpandEnvironmentStrings("%comspec%") & " /c " & rsyncprog & " -av" If (FULL_PATHNAME = True) Then cmd = cmd & "R" End If If (COMPARE_CHECKSUMS = True) Then cmd = cmd & "c" End If If (dryRun = True) Then cmd = cmd & "n" End If If Not recentBackupFolder Is Nothing Then cmd = cmd & " --Link-dest=""" _ & toCygwinPath(recentBackupFolder.path) & """" End If For Each aExcludeFile In excludeFiles cmd = cmd & " --exclude """ & aExcludeFile & """" Next For Each aSourceFolder In sourceFolders cmd = cmd & " """ & toCygwinPath(aSourceFolder) & """" Next cmd = cmd & " """ & toCygwinPath(strDestinationFolder) & """" getRsyncCmd = cmd End Function '--- getDateFolderName()------------------------------------------------------------ ' Generiert einen Ordnernamen mit dem aktuellen Datum und der Uhrzeit. Function getDateFolderName() Dim jetzt jetzt = Now() getDateFolderName = Year(jetzt) & "-" & addLeadingZero(Month(jetzt))_ & "-" & addLeadingZero(Day(jetzt))_ & "_" & addLeadingZero(Hour(jetzt))_ & "~" & addLeadingZero(Minute(jetzt)) End Function '--- addLeadingZero(number) ------------------------------------------------------------- ' Fügt bei Zahlen < 10 führende Null ein. Function addLeadingZero(number) If number < 10 Then number = "0" & number End If addLeadingZero = number End Function '--- getFolderObject(path) ------------------------------------------------------------- ' Liefert zum übergebenen Pfad-String ein WSH-Objekt vom Typ Folder ' Wenn das Verzeichnis noch nicht existiert, wird es angelegt. Function getFolderObject(path) If (fso.FolderExists(path)) Then Set getFolderObject = fso.GetFolder(path) Else logAppend ("--- Erstelle Ordner: " & path) On Error Resume Next Set getFolderObject = fso.CreateFolder(path) If Err.number <> 0 Then On Error GoTo 0 criticalErrorHandler "getFolderObject()", "Konnte Zielordner nicht erstellen", Err.number, Err.description End If On Error GoTo 0 End If End Function '--- toCygwinPath(String) ----------------------------------------------------------------- ' Wandelt einen Windows-Pfad In das Format, das Cygwin erwartet Function toCygwinPath(path) Dim driveLetter, newPath driveLetter = Left(fso.GetDriveName(path), 1) newPath = Replace(path, "\", "/") newPath = Mid(newPath, 4) toCygwinPath = "/cygdrive/" & driveLetter & "/" & newPath End Function '--- toCrLf(String) ----------------------------------------------------------------------- ' Ersetzt den von rsync ausgegebenen Unix-Zeilenumbruch (LF) ' durch das Windows-übliche Format (CRLF) Function toCrLf(strText) toCrLf = Replace(strText, vbLf, vbCrLf) End Function '--- removePathLines(String) ----------------------------------------------------------------------- ' Entfernt alle Zeilen, die auf einen Backslash enden. ' rsync gibt normalerweise alle Pfade aus, die es auf neue Dateien überprüft, ' auch wenn sich dort gar nichts geändert hat. Diese Routine entfernt diese Zeilen, ' damit die Log-Datei übersichtlich bleibt. Function removePathLines(strText) Dim arrayText, line arrayText = Split(strText, "" & Chr(10) & "", -1, 1) ' Die Ausgabe muss im Unix-Format ' vorliegen, mit LF als Zeilentrenner. For Each line In arrayText If Not Right(line, 1) = "/" Then removePathLines = removePathLines & line & vbLf End If Next End Function '--- logAppend(String) -------------------------------------------------------------------- ' hängt den übergebenen Text an die Log-Datei an Function logAppend(String) Const forAppend = 8 Dim f, errnum On Error Resume Next Set f = fso.OpenTextFile(logFile, forAppend, True) errnum = Err.number On Error GoTo 0 If errnum = 0 Then f.WriteLine(String) f.Close() Else Err.Raise 1, "logAppend", "Konnte Logdatei nicht öffnen" End If End Function '--- getRecentFolder(String) --------------------------------------------------------------- ' Sortiert die im übergebenen Pfad enthaltenen Ordner nach Datum und liefert das jüngste ' Ordner-Objekt zurück ' Parameter: Pfad als String Function getRecentFolder(path) Dim destinationFolder, rs Set destinationFolder = getFolderObject(path) Set rs = newFolderRecordSet(destinationFolder) If Not (rs.EOF) Then rs.Sort = "date DESC" ' absteigend nach Erstellungszeitpunkt sortieren rs.MoveFirst Set getRecentFolder = fso.GetFolder(rs.Fields("name")) Else Set getRecentFolder = Nothing End If rs.Close Set rs = Nothing End Function '--- newFolderRecordSet(Folder-Objekt) ----------------------------------------------------- ' Füllt die Unterordner der übergebenen Folder-Objekts In ein neues RecordSet-Objekt, ' das zum Sortieren verwendet wird. Function newFolderRecordSet(folder) Dim aFolder Set newFolderRecordSet = CreateObject("ADODB.RecordSet") newFolderRecordSet.Fields.Append "name", adVarChar, 255 newFolderRecordSet.Fields.Append "date", adDate newFolderRecordSet.Open For Each aFolder In folder.SubFolders If Left(aFolder.Name, 2) = "20" Then ' nur die Datumsordner In die Liste aufnehmen newFolderRecordSet.AddNew rsFieldNames, Array(aFolder.path, aFolder.DateCreated) End If Next End Function '--- rotate(fromFolder, toFolder, numberToKeep, diffInterval) ------------------------------ ' Verschiebt oder löscht die Backup-Ordner. Für jedes Zeitintervall (Tag, Woche, Monat) wird ' jeweils das zuletzt erstellte Backup archiviert. ' Function rotate(fromFolder, toFolder, numberToKeep, diffInterval) Dim rs, aFolder, lastFolder, i, recentBackup, errNr Set rs = newFolderRecordSet(fromFolder) If Not (rs.EOF) Then rs.Sort = "date DESC" rs.MoveFirst i = 0 Do Until rs.EOF If i >= numberToKeep Then 'MsgBox("übrig:" & rs.fields("name")) 'Das jüngste Backup dieses Datums aus dem toFolder holen. Wenn neuer, ersetzen. Set recentBackup = getRecentBackupForDate(toFolder, rs.Fields("date"), diffInterval) On Error Resume Next If Not recentBackup Is Nothing Then ' Wenn das gewählte Backup vom selben Zeitintervall (Tag) ist und ' später erstellt wurde, soll es das Backup im Zielordner ersetzen. If DateDiff("s", recentBackup.DateCreated, rs.Fields("date")) > 0 Then 'MsgBox("selber Tag & neuer: bewegen") logAppend ("--- bewege " & rs.Fields("name") & " nach " & toFolder.path) fso.MoveFolder fso.GetFolder(rs.Fields("name")), toFolder.path & "\" If Err.number <> 0 Then errNr = Err.number On Error GoTo 0 criticalErrorHandler "rotate()", "Konnte Ordner nicht bewegen", Err.number, Err.description End If 'MsgBox("Vorgänger löschen.") logAppend ("--- Vorgänger löschen " & recentBackup) fso.DeleteFolder recentBackup, True If Err.number <> 0 Then On Error GoTo 0 criticalErrorHandler "rotate()", "Konnte Ordner nicht löschen", Err.number, Err.description End If Else logAppend ("--- lösche " & rs.Fields("name")) 'MsgBox("selber Tag & älter: weg damit.") fso.DeleteFolder fso.GetFolder(rs.Fields("name")), True If Err.number <> 0 Then On Error GoTo 0 criticalErrorHandler "rotate()", "Konnte Ordner nicht löschen", Err.number, Err.description End If End If Else ' Vom diesem Tag existiert noch kein Backup 'MsgBox("noch nicht da, bewegen!") logAppend ("--- bewege " & rs.Fields("name") & " nach " & toFolder.path) fso.MoveFolder fso.GetFolder(rs.Fields("name")), toFolder.path & "\" If Err.number <> 0 Then On Error GoTo 0 criticalErrorHandler "rotate()", "Konnte Ordner nicht bewegen", Err.number, Err.description End If End If On Error GoTo 0 End If i = i + 1 rs.MoveNext Loop End If rs.Close Set rs = Nothing End Function '--- getRecentBackupForDate(folderObj, aDate, diffInterval) ----------------------------- ' Sortiert die Unterverzeichnisse mit Hilfe des ADO RecordSet und liefert ' das das letzte Backup des angegeben Tages/der Woche/des Monats --> diffInterval Function getRecentBackupForDate(folderObj, aDate, diffInterval) Dim rs, exitLoop Set getRecentBackupForDate = Nothing Set rs = newFolderRecordSet(folderObj) If Not (rs.EOF) Then rs.Sort = "date DESC" rs.MoveFirst exitLoop = False Do Until rs.EOF Or exitLoop If DateDiff(diffInterval, rs.Fields("date"), aDate) = 0 Then Set getRecentBackupForDate = fso.GetFolder(rs.Fields("name")) exitLoop = True End If rs.MoveNext Loop End If rs.Close Set rs = Nothing End Function '--- criticalErrorHandler(source, description, errNumber, errDescription) --------------- ' Kritischen Fehler loggen und Programm abbrechen. (xxx Vor dem Aufruf muss die ' Fehlerbehandlung mit "On Error Goto 0" wieder eingeschaltet werden, damit das Skript ' mit dem neu erzeugten Fehler abbricht. xxx) ' Hinweis PopUp Fenster für 60 Sekunden dann Script beenden Function criticalErrorHandler(source, description, errNumber, errDescription) logAppend ("--- Fehler: Funktion " & source & ", " & description) logAppend (" Err.Number: " & errNumber & " Err.Description:" & errDescription) logAppend ("-------- Stop: " & Now & " --------------------------------------------") Err.Clear wsh.popup description, 60, "Sicherung wird gestoppt", vbExclamation + vbSystemModal WScript.Quit 'Err.Raise 1, source, description End Function '--- callCmd(strCommand) ---------------------------------------------------------------- ' Führt Kommandozeilenbefehl aus und liefert Array zurück: ' Index 0: Errorlevel ' Index 1: Ausgabe ' Index 2: Fehlerausgabe Function callCmd(strCommand) Dim strTmpFile, strTmpFile2, outputFile, result, strOutput, strOutput2, failed strTmpFile = fso.GetSpecialFolder(2) & "\" & fso.GetTempName strTmpFile2 = fso.GetSpecialFolder(2) & "\" & fso.GetTempName strOutput = "" strOutput2 = "" strCommand = strCommand & " 1>""" & strTmpFile & """ 2>""" & strTmpFile2 & """" result = wsh.Run(strCommand, 0, True) If fso.FileExists(strTmpFile2) Then If fso.GetFile(strTmpFile2).Size > 0 Then Set outputFile = fso.OpenTextFile(strTmpFile2) strOutput2 = outputFile.Readall outputFile.Close deleteInsistently (strTmpFile2) End If End If If fso.FileExists(strTmpFile) Then If fso.GetFile(strTmpFile).Size > 0 Then Set outputFile = fso.OpenTextFile(strTmpFile) strOutput = outputFile.Readall outputFile.Close callCmd = Array(result, strOutput, strOutput2) deleteInsistently (strTmpFile) Else failed = True End If Else failed = True End If If failed = True Then criticalErrorHandler "callCmd()", "Kommando fehlgeschlagen: " & strCommand _ & vbCrLf & "--- Fehlermeldung: " & strOutput2, 0, "" End If End Function '--- deleteInsistently(strFileName) ----------------------------------------------------- ' Auf einigen Testsystemen trat ein Fehler auf, weil die Funktion callCmd() ihre ' temporären Dateien nicht wieder löschen konnte. Vermutlich blockierte gerade ein ' Virenscanner die Datei. Die Funktion deleteInsistently() unternimmt deshalb 10 Versuche, ' die übergebene Datei zu löschen. Wenn ein Versuch fehlschlägt, probiert es das Skript 5 ' Sekunden später erneut. Function deleteInsistently(strFileName) Dim noOfTries, successful On Error Resume Next noOfTries = 0 successful = False While noOfTries < 10 And Not successful Err.Clear If fso.FileExists(strFileName) Then fso.DeleteFile (strFileName) If Err.number <> 0 Then successful = False noOfTries = noOfTries + 1 logAppend ("--- Warnung: Konnte temporäre Datei " & strFileName & " nicht löschen, Versuch " & noOfTries) WScript.Sleep (5000) Else successful = True End If Else successful = True End If Wend On Error GoTo 0 If Not successful Then logAppend ("--- Warnung: Ich geb's auf.") End If End Function ' -------------------------------------------------- ' --- End Function Section ------------------------- ' --------------------------------------------------