Sicherung in eine Cloud mit verschlüsselten Daten

Option Explicit

'--------------------------------------------------
' Version 2.0
' Das Script kopiert Daten in einen verschlüsselten Ordner
' 1. Dateien-Kopierprogramm welches mit einer Script bzw. Commandline steuerbar ist. z.B. FreeFileSync 
' 2. Crypt-Programm das ein Laufwerk oder Ordner zur Verfügung stellt um die Daten zu verschlüsseln z.B. Cryptomator
' 3. CloundProgramm z.B. MagentaCLOUD

' 
'---- Script-Einstellungen ----------------------------------------------

' --- FreeFileSync Kopierprogramm-BatchFile -----------------------------
Const cFFSBatch = "Eigene Dateien.ffs_batch"

' --- Cryptomator Einstellungen --- (Folgende Optionen finden sich in Tressor markieren > Weitere Optionen) ---

' Damit in Cryptomator den korrekte Contaier gefunden wird muss der "Laufwerksname" eingetragen werden
Const cCryptomatorLaufwerksname = "verschlusselt" ' "a_A_o_O_u_U_" '"cryptvault"

' Passwort muss nur angegeben werden wenn nicht "Passwort speichern" angeklickt ist.
Const cCryptomatorPassword = "1" '"passwort"

' Soll Cryptomator nach dem Backup geschlossen werden.
' "True" (Default)
Const cCloseCryptomator = True

' Der Cyptomator Masterkey liegt in einem Bereich der in die Clound kopiert wird! Dieses kopieren verhindern. Der Key wird dann lokal in den App-Data Bereich von Cryptomator verschoben
' "True" (Default)
Const cSecureCryptomatorMasterKey = True 

' Cryptomator nach dem Start versuchen in's System-Tray zu legen.
' "False" (Default)
fCryptomator = False        

' --- MagentaCLOUD -------------------------------------------------
' Soll MagentaCLOUD nach der Kopieraktion geschlossen werden.
' 0 = nicht herunterfahren. Sonst max. Wartezeit bis zum Herunterfahren
' 0 (Default)
Const cCloseMagentaCLOUD = True

' --- Programme schließen (Komma getrennt)--------------------------
Dim closeApps
closeApps = Array("outlook.exe")

' --- Soll der PC nach der Sicherung heruntergefahren werden ------
Const cShuddown = 0

' ------------------------------------------------------------------
' --- Variablen-Deklaration ----------------------------------------
' ------------------------------------------------------------------
Dim oWsh, oFS, oWmi, oF, oProcess, sPF, sPF86, sPFDim, iWartezeit, CPUuse, gsAPPD, sCMD, sLW, sInfo, arr
Dim i, j, s, p, k, sCryptomator, iCryptomator, fCryptomator, iMagentaClound, sMagentaClound, iFreeFileSyncBatch, sFreeFileSyncBatch
Const cSpace = " ", cDQ = """", c2BS = "\\" , cBS = "\" 
Const cAppCryptomator = "cryptomator.exe"         ' Hier den Dateinamen des Verschlüsselungs-Programms eintragen   
Const cAppMagentaClound = "MagentaCloud.App.exe"  ' Hier des Dateinamen des Clound-Programms eintragen

Set oWsh = CreateObject("WScript.Shell")
Set oFS  = CreateObject("Scripting.FileSystemObject")
Set oWmi = GetObject("winmgmts:\\.\root\cimv2")

sPF86 = oWsh.ExpandEnvironmentStrings("%ProgramFiles(x86)%") 
sPF = oWsh.ExpandEnvironmentStrings("%ProgramFiles%")
gsAPPD = oWsh.ExpandEnvironmentStrings("%AppData%") & "\Cryptomator\"
sCMD = oWsh.ExpandEnvironmentStrings("%comspec%") & " /c "


sMagentaClound = wrap(sPF86 & "\Telekom\MagentaCloud\" & cAppMagentaClound, cDQ) & cAppMagentaCloundParameter '"C:\Program Files (x86)\Telekom\MagentaCloud\MagentaCloud.App.exe"
sCryptomator = wrap(sPF & "\Cryptomator\" & cAppCryptomator, cDQ) '"C:\Program Files\Cryptomator\Cryptomator.exe"

sFreeFileSyncBatch = Replace(WScript.ScriptFullName, WScript.ScriptName, vbNullString) & cFFSBatch '"c:\[xxx]\Eigene Dateien.ffs_batch"

Const cAppMagentaCloundParameter = " /hideexp"    ' Mit diesem Startparameter wird kein Explorer-Fenster des MagentaCloud-Ordner geöffnet
Const cInfoAppendix = "Sicherung daher nicht möglich."
Const cInfoFensterKopf = "Fehler im Programmablauf. Bitte Prüfen"
Const cEcho = True

' ------------------------------------------------------------------ 
' --- Funktionen ---------------------------------------------------
' ------------------------------------------------------------------ 

' Prozess-ID herausbekommen (Task-Manager > Register Prozesse)
Function get_pid(programm, fkill)
  Dim  i, j, ogO, oSel
  Const cS = "Select * from Win32_Process Where Name = '"
  get_pid = 0
  If IsObject(oWmi) Then
    On Error Resume Next
    Set oSel = oWmi.ExecQuery (cS & programm & "'" )
    For Each ogO In oSel          
      get_pid = ogO.ProcessId 'True 'ogO.processID
      If fkill Then
        i = ogO.Terminate
      End If     
    Next    
  End If     
End Function

' Dateipfad mit Leerzeichen kapseln 
Function wrap(v, sWrap)
  Dim va, s
  va = v
  If va <> vbNullString Then    
    If InStr(1, va, cSpace, vbTextCompare) Then va = sWrap & va & sWrap
  End If
  wrap = va
End Function

' Anwendung schließen.
' Erst versuchen die Anwendung normal zu beenden.
' Wenn es nicht geht, Programm abschießen.
Function closeAppication()
  Dim obj, s, i, j, k

  'Sanftes Schließen der Anwendung hier z.B. Outlook
  closeAppication = False
  j = ubound(closeApps)
  If j < 0 Then Exit Function
  'If closeApps(0) = vbNullString Then Exit Function
  On Error Resume Next
  For i = 0 To j
    Set obj = Nothing
    s = closeApps(i)
    Select Case LCase(s)
      Case "outlook", "outlook.exe" 'Alles wieteren Produkte von Office öffnen nicht sperrend
        Set obj = GetObject(, "Outlook.Application") '"Outlook.Application.12"
        If Not obj Is Nothing Then
          j = obj.Inspectors.count
          For k = 1 To j
            obj.Inspectors.Item(k).close  0 'olSave
            WScript.Sleep 500
          Next
          obj.Quit
          Set obj = Nothing
          WScript.Sleep 500
          closeAppication = True
        Else
          Err.Clear
        End If
    End Select
    If closeAppication Then WScript.Sleep 2000
  Next
  j = UBound(closeApps)
  For i = 0 To j
    'Sollte das "sanfte" Schließen nicht funktionieren dann die Anwendung abschießen wenn GROSS geschrieben
    If LCase(closeApps(i)) = "outlook" Then
      s = "outlook.exe"
    ElseIf Right(closeApps(i), 4) = ".exe" Then
      s = LCase(closeApps(i))
    Else
      s = vbNullString
    End If
    If s <> vbNullString Then
      s = getFilenameFromPath(s)
      k =  kill_task(s)
      If k = 0 Then
        closeAppication = True
        WScript.Sleep 1000
      End if
    End If
  Next 
End Function

' Diese Funktion prüft 4 x hintereinander ob die Anwendung CPU-Zeit in Anspruch nimmt
Function CPUUSage(sAppName, iCount)
  Dim N1, D1, N2, D2, k, s, x
  Dim oProcess, oSelA, oSelID  
  Const cS = "Select * from Win32_PerfRawData_PerfProc_Process where IDProcess = "
  On Error Resume Next
  s = "Select * from Win32_Process where Name = " & wrap(sAppName, cSQ, True)
  Set oSelA = oWmi.ExecQuery(s)
  For k = 1 To iCount
    For each oProcess in oSelA
      s = cS & wrap(oProcess.Handle, cSQ, True)
      For Each oSelID in oWmi.ExecQuery(s)
        N1 = oSelID.PercentProcessorTime
        D1 = oSelID.TimeStamp_Sys100NS
        Exit For
      Next
      WScript.Sleep 2000 
      For Each oSelID in oWmi.ExecQuery(s)
        N2 = oSelID.PercentProcessorTime
        D2 = oSelID.TimeStamp_Sys100NS
        Exit For
      Next    
      x = x + Round((N2 - N1) / (D2 - D1) * 100, 4)
    Next
    WScript.Sleep 1000
    CPUUSage = CPUUSage + x
  Next  
  Set oSelA = Nothing
End Function 

'--- Cryptomator Funktionen ----------------------------------------
Const gcIdCM = 0, gcPathCM = 1, gcMountNameCM = 2, gcWinDlCM = 3, gcUnlockAfterStartupCM = 4, gcRevealAfterMountCM = 5
Const gcUsesIndividualMountPathCM = 6, gcIndividualMountPathCM = 7, gcUsesReadOnlyModeCM = 8, gcPasswordCM = 9
Const gcPreferredVolumeImplCM = 10, gcPortCM = 11, gcPreferredGvfsSchemeCM = 12, gcUpdateCheck = 13, gcDebugMode = 14
Const cCryptomatorMasterkeyFile = "\masterkey.cryptomator*" 'Cryptomator KeyDatei auf Sicherungsseite

Dim arrCMV, iCryptVault

Function getCryptomatorSettingsVaultInfo(sSearchDrive)
  Dim i, j
  getCryptomatorSettingsVaultInfo = -1
  j = UBound(arrCMV, 2)    
  For i = 0 To j
    If arrCMV(gcIdCM, i) = sSearchDrive Or _
       arrCMV(gcMountNameCM, i) = sSearchDrive Or _
       arrCMV(gcWinDlCM, i) = sSearchDrive Or _
       arrCMV(gcIndividualMountPathCM, i) = sSearchDrive Then    
      getCryptomatorSettingsVaultInfo = i
      Exit for
    End If
  Next
End Function

function getCryptomatorSettingsSettings()
  dim fD, fG, arrCM, i, j, sC, f, sF, sKey, sValue, sPort, sVolumeImpl, sFSScheme, sUpdateCheck, sDebugMode, oF
  const arrMax = 14
  redim arrCM(arrMax, -1)

  sF = gsAPPD & "settings.json"
  f = oFS.FileExists(sF)
  If f Then

    Set oF = oFS.OpenTextFile(sF, 1)
    sC = of.ReadLine 'Erste Zeile mit "{" überspringen
    sC = Trim(of.ReadLine)
    fD = 0
    fG = 0
    Do      
      If InStr(1, sC, ": ", vbTextCompare) Then              
        arr = split(sC, ": ")                 
        sKey =  Trim(Replace(arr(0), """", vbNullString))
        sValue = Trim(Replace(Replace(arr(1), """", vbNullString), ",", vbNullString))
      Else
        If Right(sC, 1) = "," Then sC = Left(sC, Len(sc)-1) 
        sKey = sC
        sValue = ""               
      End If
      
      If sKey = "]" Then
        fD = 2
      ElseIf fD = 1 Then
        If sKey = "}" Then
          'Ende der Gruppe'
          fG = 2
        ElseIf fG = 1 Then
          Select Case sKey 'arr(0)
            Case "id"                      : arrCM(gcIdCM, j) = sValue  'mid(sValue, 2, len(sValue) - 3)'
            Case "path"                    : arrCM(gcPathCM, j) = utf8ToAnsi(Replace(sValue, c2BS, cBS))
            Case "mountName"               : arrCM(gcMountNameCM, j) = sValue
            Case "winDriveLetter"          : arrCM(gcwinDlCM, j) = sValue
            Case "unlockAfterStartup"      : arrCM(gcUnlockAfterStartupCM, j)= CBool(sValue) ' Passwort wurde gespeichert und automatisch entsperren beim Start'
            Case "revealAfterMount"        : arrCM(gcRevealAfterMountCM, j)= CBool(sValue)
            Case "usesIndividualMountPath" : arrCM(gcUsesIndividualMountPathCM, j)= CBool(sValue)'
            Case "individualMountPath"     : arrCM(gcIndividualMountPathCM, j)= Replace(sValue, c2BS, cBS)
            Case "usesReadOnlyMode"        : arrCM(gcUsesReadOnlyModeCM, j)= CBool(sValue)                                    
          End Select
        ElseIf sKey = "{" Then
          'Beginn der Gruppe'
          fG = 1
          j = UBound(arrCM, 2) + 1
          ReDim Preserve arrCM(arrMax, j)
        End If
      ElseIf sKey = "directories" Then
        If sValue = "[]" = 0 then fD = 1        
      ElseIf fD = 2 Then
        Select Case sKey
          Case "port" : sPort = sValue
          Case "preferredVolumeImpl"    : sVolumeImpl = sValue
          Case "preferredGvfsScheme"    : sFSScheme = sValue 'Nicht sicher wofür das verwendet wird da immer "dav"
          Case "checkForUpdatesEnabled" : sUpdateCheck = sValue
          Case "debugMode"              : sDebugMode = sValue          
        End Select
      End If
      sC = Trim(of.readline)
    Loop Until oF.AtEndOfStream
    oF.close

    sF = gsAPPD & "keychain.json"
    f = oFS.FileExists(sF)
    If f Then
      Set oF = oFS.OpenTextFile(sF, 1)
      sC = of.ReadAll
      oF.Close
    Else
      sC = String(20, " ")
    End If
    j = UBound(arrCM, 2)
    
    For i = 0 To j
      arrCM(gcPortCM, i) = sPort
      arrCM(gcPreferredVolumeImplCM, i) = sVolumeImpl
      arrCM(gcPreferredGvfsSchemeCM, i) = sFSScheme
      arrCM(gcUpdateCheck, i) = CBool(sUpdateCheck) 'UpdateCheck sollte ausgeschaltet sein da die Prüfung sich "aufhängen könnte"
      arrCM(gcDebugMode, i) = CBool(sDebugMode)     'Debugmode sollte ausgeschaltet sein
      sKey = cDQ& arrCM(gcIdCM, i) & cDQ& ": {"
      if InStr(1, sC, sKey, vbTextCompare) Then
        arrCM(gcPasswordCM, i) = True
      else
        arrCM(gcPasswordCM, i) = False
      End If
    Next
  End If
  getCryptomatorSettingsSettings = arrCM
End Function

' Cryptomator Tressor einbinden
Function mountCryptomatorSettings(fRun)
  Dim s, s2, k, sC, sF, oApp, sBF
  If iCryptVault > -1 Then
    k = InStrRev(arrCMV(gcPathCM, iCryptVault), cBS )
    sBF = Right(arrCMV(gcPathCM, iCryptVault), Len(arrCMV(gcPathCM, iCryptVault)) - k)
  
    If fRun Then
      'Läuft CN schon und ist der Tressor errichtbar
      iCryptomator = get_pid(cAppCryptomator, false)
      If iCryptomator > 0 Then
        If arrCMV(gcPasswordCM, iCryptVault) Then
          mountCryptomatorSettings = Get_LW_Buchstabe
          If mountCryptomatorSettings = vbNullString Then
            'Cryptomator läuft zwar aber es konnte der Laufwerksbuchstabe nicht ermittelt werden
            get_pid cAppCryptomator, True 'Cyptomator beenden (Kill)         
            WScript.Sleep 1000
          Else
            Exit Function
          End If
        End If  
      End If
        
      If cSecureCryptomatorMasterKey Then
        ' Den Masterkey kopieren damit Cryptomator das LW entschlüsseln kann
        s = arrCMV(iCryptVault, iCryptVault)
        sF = gsAPPD & arrCMV(gcMountNameCM, iCryptVault) & cCryptomatorMasterkeyFile
        oWsh.Run sCMD & "COPY /y " & sF & " " & s, 0, True
      End If    
    
      'Cryptomater starten / aktivieren mit dem gewünschten Tressor
      '"C:\Program Files\cryptomator\cryptomator.exe C:\cryptlager\cryptomatorSettings"  
      s = sCryptomator & " " & wrap(arrCMV(gcPathCM, iCryptVault), """")
      Set oApp = oWsh.Exec(s)    
      k = 0    
      WScript.Sleep 2000
      iCryptomator = oApp.ProcessID
      If cEcho Then WScript.Echo "Cryptomator > gestartet"
    End If
    With oWsh            
      If .AppActivate(iCryptomator) Or .AppActivate(sBF) Then
        If Not fRun Then
          .SendKeys "{TAB}{TAB}{TAB}"
          .SendKeys "~" 'Enter
          WScript.Sleep 500
          .SendKeys "%{F4}"          
          Exit Function
        ElseIf Not arrCMV(gcPasswordCM, iCryptVault) And cCryptomatorPassword <> vbNullString Then      
          sInfo = sInfo & "[Cryptomator] Das Passwort sollte im Programm gespeichert werden." & vbCrLf
          .SendKeys cCryptomatorPassword 
          WScript.Sleep 100   
          .SendKeys "~"
          WScript.Sleep 3000      
        ElseIf arrCMV(gcPasswordCM, iCryptVault) Then
          .SendKeys "~"
          WScript.Sleep 2000
        End If        
      End If   
    End With     
    If fRun Then 
      mountCryptomatorSettings = Get_LW_Buchstabe()
      If cSecureCryptomatorMasterKey Then
        ' Cryptomator-Laufwerk wurde eingebunden dann kann der Masterkey wieder noch %appdata%\roaming\Cryptomator\ verschoben werden
        s = arrCMV(iCryptVault, iCryptVault) & cCryptomatorMasterkeyFile
        sF = gsAPPD & arrCMV(gcMountNameCM, iCryptVault) & cCryptomatorMasterkeyFile
        oWsh.Run sCMD & "Move /y " & s & " " & sF, 0, True
      End If    
      If fCryptomator Then
        If oWsh.AppActivate(iCryptomator) Or oWsh.AppActivate(sBF) Then      
          oWsh.sendkeys "%{F4}~" ' Tastenkürzel um Cryptomator in das System-Tray zu verlegen.      
        End If
      End If
    End If           
  else
    mountCryptomatorSettings = vbNullString
  End If  
End Function

Function Get_LW_Buchstabe()
  Dim k 
' Prüfen ob das Laufwerk von Cryptomator gemountet wurde
  k = 0
  Do 
    WScript.Sleep 100
    If arrCMV(gcPreferredVolumeImplCM, iCryptVault) = "DOKANY" Then    
      Get_LW_Buchstabe = Get_LW_Buchstabe_via_LogicalDisk()     
    Else
      Get_LW_Buchstabe = Get_LW_Buchstabe_via_net_use(false)
    End If    
    k = k + 1
  Loop Until oFS.FolderExists(Get_LW_Buchstabe) Or k >= 10
 
End Function

' Laufwerkseinbindung per Dokany
' Her kann das LW über den Namen ausgelesen werden   
Function Get_LW_Buchstabe_via_LogicalDisk()
  Dim oInstances, oInstance  
  Set oInstances = oWmi.InstancesOf("Win32_LogicalDisk",48)
  For Each oInstance in oInstances
    With oInstance      
      If .VolumeName = arrCMV(gcMountNameCM, iCryptVault) Then
        Get_LW_Buchstabe_via_LogicalDisk = .Name
        Exit For
      End If
    End With
  Next
  Set oInstances = Nothing
End Function

'Deutsche Umlaute wandeln
function utf8ToAnsi(sfolder)
  Dim s
  s = sfolder
  s = Replace(s,  Chr(195) & chr(164), "ä") 
  s = Replace (s, Chr(195) & chr(132), "Ä") 
  s = Replace (s, Chr(195) & Chr(182) , "ö") 
  s = Replace (s, Chr(195) & Chr(150), "Ö") 
  s = Replace (s, Chr(195) & Chr(188), "ü") 
  s = Replace (s, Chr(195) & "œ", "Ü") 
  s = Replace (s, Chr(195) & Chr(255), "ß") 
  utf8ToAnsi = s
End Function

' Laufwerkseinbindung durch Webdav
' Namen mittels net use auslesen
Function Get_LW_Buchstabe_via_net_use(fUnmount)
  Dim s, sF, oF, sC, i, sTmp
  sTmp = oWsh.ExpandEnvironmentStrings("%temp%") & "\~"        
  sF = sTmp & "nv.txt"
  oWSH.run sCMD & "net use > "   & sF, 0, True
  Set oF = oFS.OpenTextFile(sF, 1)      
  Do 
    sC = Trim(oF.ReadLine)
    If sC <> vbNullString Then
      i = InStr(1, sC, arrCMV(gcIdCM, iCryptVault), vbTextCompare)
      If i > 0 Then
        i = InStr(1, sC, c2BS, vbTextCompare)
        If fUnmount Then
          s = "net use /d " & Trim(Left(sC, i -1)) 'Laufwerk-Buchstabe
          oWSH.run sCMD & s, 0, True          
          s = vbNullString
        Else
          s = Trim(Left(sC, i -1)) 'Laufwerk-Buchstabe
          sC = oF.ReadAll
        End If
      End If
    End If
  Loop Until oF.AtEndOfStream
  oF.Close
  oWSH.run sCMD & "DEL /q /f " & sF, 0, True
  Get_LW_Buchstabe_via_net_use = s
End Function

Function unmount_lW()
  Dim s, sF, oF, sC, i, sTmp
  sTmp = oWsh.ExpandEnvironmentStrings("%temp%") & "\~"        
  sF = sTmp & "nv.txt"
  oWSH.run sCMD & "net use > "   & sF, 0, True
  Set oF = oFS.OpenTextFile(sF, 1)      
  Do 
    sC = Trim(oF.ReadLine)
    If sC <> vbNullString Then
      i = InStr(1, sC, arrCMV(gcIdCM, iCryptVault), vbTextCompare)
      If i > 0 Then
        i = InStr(1, sC, c2BS, vbTextCompare)
        s = "net use /d " & Trim(Left(sC, i -1)) 'Laufwerk-Buchstabe
        oWSH.run sCMD & s, 0, True
        sC = oF.ReadAll
      End If
    End If
  Loop Until oF.AtEndOfStream
  oF.Close
  oWSH.run sCMD & "DEL /q /f " & sF, 0, True
End Function

' ------------------------------------------------------------------ 
' --- Programmteil -------------------------------------------------
' ------------------------------------------------------------------ 

' Prüfen ob die FreeFileSyn-Batch Datei vorhanden ist
If Not oFS.FileExists(sFreeFileSyncBatch) Then
  oWsh.Popup "Die FreeFileSync-Bach-Datei '" & sFreeFileSyncBatch & "' wurde nicht gefunden." & vbCrLf & cInfoAppendix, 30, cInfoFensterKopf, vbOK + vbCritical 
  WScript.Quit
End If

' Cryptomator Einstellungen laden
arrCMV = getCryptomatorSettingsSettings()
iCryptVault = getCryptomatorSettingsVaultInfo(cCryptomatorLaufwerksname)
If arrCMV(gcUpdateCheck, iCryptVault) Or arrCMV(gcDebugMode, iCryptVault) Then
  sInfo = "[Cryptomator] ""Auf Udates prüfen"" bzw. ""Debug-Modus"" sollten ausgeschaltet sein" & vbCrLf
End If

If iCryptVault = -1 Then
  oWsh.Popup "Der Cryptomator Laufwerksname '"& cCryptomatorLaufwerksname & "'  wurde nicht gefunden. Bitte korrigieren." & vbCrLf & cInfoAppendix, 30, cInfoFensterKopf, vbOK + vbCritical
  WScript.Quit
Else
  sLW = mountCryptomatorSettings(true)
  ' Ziel-lauferk in den Einstellungen der FreeFileSync überprüfen und ggf. korrigieren
  Set oF = oFS.OpenTextFile(sFreeFileSyncBatch, 1)
  s = oF.ReadAll
  oF.Close  
  If InStr (1, s, "<Right>" & sLW, vbTextCompare) = 0 Then
    arr = Split(s, vbCrLf)
    For i = 0 To UBound(arr)
      If InStr(1, arr(i), "<Right>") Then     
       j = InStr(1, arr(i), cBS)
        arr(i) = left(arr(i), j-3) & sLW & Right(arr(i), Len(arr(i))- j + 1)
      End If
    Next
    s = Join(arr, vbCrLf)
    Set oF = oFS.OpenTextFile(sFreeFileSyncBatch, 2)
    oF.Write s
    oF.Close
  End If   
End If

' Ist MagentaCLOUD schon gestartet? Wenn nicht starten.
iMagentaClound = get_pid(cAppMagentaClound, false)
If iMagentaClound = 0 Then
  If cEcho Then WScript.Echo "MagentaCLOUD > gestartet"
  oWsh.Run sMagentaClound
  iMagentaClound = get_pid(cAppMagentaClound, false)
End If

'Anwendungen schließen
closeAppication  
  
' FreefileSync starten und Datien in das Laufwerk von Cryptomator kopieren  
sFreeFileSyncBatch = wrap(sFreeFileSyncBatch, cDQ)
If cEcho Then WScript.Echo "Datensicherung durchführen"
iFreeFileSyncBatch = oWsh.Run(sFreeFileSyncBatch, 1, True) ' FreeFilesync starten und warten bis die Sicherung beendet ist        

If iCryptomator <> 0 And cCloseCryptomator Then  
  ' Das Script wartet jetzt so lange bist Cryptomator keine Aktivität zeigt.
  Do    
  Loop Until CPUUSage(cAppCryptomator, 2) = 0
  If cEcho Then WScript.Echo "Cryptomator > beenden"    
  mountCryptomatorSettings False     
  If get_pid(cAppCryptomator, True) Then
    Get_LW_Buchstabe_via_net_use true         
  End If
End If

If iMagentaClound <> 0 And cCloseMagentaCLOUD Then   
  ' Das Script wartet jetzt so lange bist die MagentaClound.App keine Aktivität zeigt. Somit müsste der Datenausgleich beendet sein.
  Do    
  Loop Until CPUUSage(cAppMagentaClound, 4) = 0
  If cEcho Then WScript.Echo "MagentaCLOUD > beenden"
  iMagentaClound = get_pid(cAppMagentaClound, True)         
End If

If sInfo <> vbNullString Then oWsh.Popup sInfo, 30, cInfoFensterKopf, vbOKOnly
If cShuddown > 0 Then 
  If oWsh.Popup( "Windows herunterfahren ?", cShuddown, cInfoFensterKopf, vbYesNo + vbDefaultButton1) = vbYes Then
    oWsh.Run "shutdown.exe /p /f ", 0, False
  End If
Else
  If cEcho Then     
    WScript.Echo "Sicherung beendet :-)"
  End If
End If
Set oWsh = Nothing
Set oFS  = Nothing
Set oWmi = Nothing