Blue Flower

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 Violka Diese 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 -------------------------
' --------------------------------------------------

 

ccc