' Запускает скрипт из сетевой папки в невидимом режиме в контексте пользователя.
' Предварительно скрипт копируется в каталог %TEMP%\_scripts, чтобы обойти предупреждение безопасности.

on error resume next

set args = WScript.Arguments
num = args.Count

if num = 0 then
	WScript.Echo "Usage: [CScript | WScript] " + WScript.ScriptName + " <some script arguments>"
	WScript.Quit 1
end if

Const ForReading = 1, ForWriting = 2, ForAppending = 8
Const WindowsFolder = 0, SystemFolder = 1, TemporaryFolder = 2

Set WshShell = WScript.CreateObject("WScript.Shell")
Set oShellEnv = WshShell.Environment("Process")
Set objFSO = CreateObject("Scripting.FileSystemObject")
ComputerName = oShellEnv("ComputerName")
UserName = oShellEnv("UserName")
UserDomain = oShellEnv("USERDOMAIN")
Proc = oShellEnv("PROCESSOR_ARCHITECTURE")

sroot = "\\SCRIPTSERVER\scripts\user\"
lroot = "\\SCRIPTSERVER\scripts\logs\" & UserDomain & "\user\"

tmp = objFSO.GetSpecialFolder(TemporaryFolder)
tf = tmp & "\_scripts\"
BuildFullPath tf
If Not objFSO.FolderExists(tf) Then WScript.Quit

dt = now()
fdt = Right(Year(dt), 2) & _
Right("0" & Month(dt), 2) & _
Right("0" & Day(dt), 2) & "_" & _
Right("0" & Hour(dt), 2) & _
Right("0" & Minute(dt), 2) & _
Right("0" & Second(dt), 2)

q = Chr(34)
cmd = q & oShellEnv("ComSpec") & q & " /c "

For Each arg in args
Do
	' default lkeep value
	lkeep = 2

	Select Case arg
	Case "BackupUserFolders"
		scr = "BackupUserFolders\backupUF.cmd"
		lkeep = 9
	Case Else
		Exit Do
	End Select

	lgf = lroot & arg & "\" & ComputerName & "\" & UserName & "_" & fdt & ".log"

	sn = Replace(scr, "\", "_")
	scr = sroot & scr
	If Not objFSO.FileExists(scr) Then Exit Do

	scrt = tf & sn
	If lkeep > 0 Then
		tlf = scrt & "_" & fdt & ".log"
		DeleteOldLogs tf, sn & "_*.log", 0
	Else
		tlf = "NUL"
	End If

	objFSO.CopyFile scr, scrt, True
	If Not objFSO.FileExists(scrt) Then Exit Do

	el = WshShell.Run(q & scrt & q & ">" & q & tlf & q & " 2>&1", 0, True)
	objFSO.DeleteFile scrt
	If lkeep = 0 Or Not objFSO.FileExists(tlf) Then Exit Do

	Set objFile = objFSO.GetFile(tlf)
	If objFile.Size = 0 Then
		objFSO.DeleteFile tlf
		Exit Do
	End If

	ln = objFSO.GetFileName(lgf)
	lf = objFSO.GetParentFolderName(lgf)
	BuildFullPath lf
	If Not objFSO.FolderExists(lf) Then Exit Do

	DeleteOldLogs lf, UserName & "_*", lkeep
	objFSO.CopyFile tlf, lgf, True
	objFSO.DeleteFile tlf

Loop While False
Next


' === Функции ===

Sub BuildFullPath(ByVal FullPath) ' === Создать каталог
	If Not objFSO.FolderExists(FullPath) Then
		BuildFullPath objFSO.GetParentFolderName(FullPath)
		objFSO.CreateFolder FullPath
	End If
End Sub

Sub DeleteOldLogs(ByVal sFolder, mask, keep)
	on error resume next
	Set oFolder = objFSO.GetFolder(sFolder)
	If oFolder.Files.Count > keep Then
		Set oFiles = CreateObject("Scripting.Dictionary")
		For Each oFile In oFolder.Files
			If CompareFileName(oFile.Name, mask) Then oFiles.Add oFile.Path, 1
		Next

		Dim lFiles : lFiles = oFiles.Keys
		If lFiles.Count > 1 Then ReverseArray lFiles

		n = 0
		For Each sFile In lFiles
			n = n+1
			if n > keep Then objFSO.DeleteFile sFile
		Next
		Set oFiles = Nothing
	End If
End Sub

Private Function CompareFileName (ByVal Name, ByVal Filter) ' (recursive)
	CompareFileName = False
	Dim np, fp: np = 1: fp = 1
	Do
		If fp > Len(Filter) Then CompareFileName = np > len(name): Exit Function
		If Mid(Filter,fp) = ".*" Then	' special case: ".*" at end of filter
			If np > Len(Name) Then CompareFileName = True: Exit Function
			End If
		If Mid(Filter,fp) = "." Then	' special case: "." at end of filter
			CompareFileName = np > Len(Name): Exit Function
			End If
		Dim fc: fc = Mid(Filter,fp,1): fp = fp + 1

		Select Case fc
		Case "*"
			CompareFileName = CompareFileName2(name,np,filter,fp)
			Exit Function
		Case "?"
			If np <= Len(Name) And Mid(Name,np,1) <> "." Then np = np + 1
		Case Else
			If np > Len(Name) Then Exit Function
			Dim nc: nc = Mid(Name,np,1): np = np + 1
			If Strcomp(fc,nc,vbTextCompare)<>0 Then Exit Function
		End Select
	Loop
End Function

Private Function CompareFileName2 (ByVal Name, ByVal np0, ByVal Filter, ByVal fp0)
	Dim fp: fp = fp0
	Dim fc2
	Do	' skip over "*" and "?" characters in filter
		If fp > Len(Filter) Then CompareFileName2 = True: Exit Function
		fc2 = Mid(Filter,fp,1): fp = fp + 1
		If fc2 <> "*" And fc2 <> "?" Then Exit Do
	Loop
	If fc2 = "." Then
		If Mid(Filter,fp) = "*" Then	' special case: ".*" at end of filter
			CompareFileName2 = True: Exit Function
		End If
		If fp > Len(Filter) Then	' special case: "." at end of filter
			CompareFileName2 = InStr(np0,Name,".") = 0: Exit Function
		End If
	End If
	Dim np
	For np = np0 To Len(Name)
		Dim nc: nc = Mid(Name,np,1)
		If StrComp(fc2,nc,vbTextCompare)=0 Then
			If CompareFileName(Mid(Name,np+1),Mid(Filter,fp)) Then
				CompareFileName2 = True: Exit Function
			End If
		End If
	Next
	CompareFileName2 = False
End Function

Sub ReverseArray(ByRef arr)
	Dim i, j, last, half, temp
	last = UBound(arr)
	half = Int(last/2)

	For i = 0 To half
		temp = arr(i)
		arr(i) = arr(last-i)
		arr(last-i) = temp
	Next
End Sub

@echo off
rem === new version
set "sroot=\\SCRIPTSERVER\scripts\user\BackupUserFolders"
call cscript.exe /nologo "%sroot%\backupUF.vbs"
exit /b
rem === / new version

on error resume next

Set WSHShell = CreateObject("WScript.Shell")
Set Folders = CreateObject("Scripting.Dictionary")
Set oShellEnv = WSHShell.Environment("Process")
Set objWMIService = GetObject("winmgmts:\\.\root\cimv2")

Set objFSO = CreateObject("Scripting.FileSystemObject")
Dim strCurDir : strCurDir = objFSO.GetParentFolderName(WScript.ScriptFullName)

Dim toroot : toroot="\\BACKUPSERVER\Backups$"
Dim incf : incf="*.doc? *.xls? *.dot? *.xlt? *.rtf *.txt"

Dim strFilePath, objIniFile, strKey, cfgVar, cfgVal, strLine, strSection, intDelimPos, n, oExec
q = Chr(34)

Const ForReading   = 1
Const ForWriting   = 2
Const ForAppending = 8

Dim mSlashes : Set mSlashes = New RegExp
mSlashes.Global = True
mSlashes.Pattern = "\\+" ' matches multiple slashes

Dim bQuot : Set bQuot = New RegExp
bQuot.Global = True
bQuot.Pattern = "^""(.*)""$" ' matches boundary quotes

' === Рабочий стол, Документы
Dim fromf, fromp, fromc, objItem, sqlres
For Each fromf in array("Desktop", "MyDocuments")
	fromp = WSHShell.SpecialFolders(fromf)
	If Not Folders.Exists(fromp) Then Folders.Add fromp, fromf
Next

' === Прочие папки с локальных дисков
Dim otherf
If WScript.Arguments.Count > 0 Then otherf = CheckAD() Else otherf = True
If otherf Then
	Dim ufolders : ufolders = Array("MyDocuments", "My documents", "Documents", "Документы", "Мои документы")

	Set colItems = objWMIService.ExecQuery("Select * From Win32_Volume Where DriveType=3 and DriveLetter like '[A-Z]:'")
	For Each objItem in colItems : For Each fromf in ufolders
		fromp = objItem.Name & fromf
		If objFSO.FolderExists(fromp) Then 
			If Not Folders.Exists(fromp) Then Folders.Add fromp, Replace(objItem.DriveLetter,":","") & "-" & fromf
		End If
	Next : Next
End If

' === Отключить уведомление "Автоматическое скачивание файлов"
Dim AppInitDownReg, AppInitDownVal
AppInitDownReg = "HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Notifications\Settings\Windows.System.AppInitiatedDownload\Enabled"
WSHShell.RegWrite AppInitDownReg, 0, "REG_DWORD"
AppInitDownVal = RegRead(AppInitDownReg)

' === Папки облачных сервисов
Const HKEY_CURRENT_USER  = &H80000001
Const HKEY_LOCAL_MACHINE = &H80000002

Dim oReg : Set oReg=GetObject("winmgmts:{impersonationLevel=impersonate}!\\.\root\default:StdRegProv")
Dim CloudName, strKeyPath, arrSubKeys, subkey

' === OneDrive
If AppInitDownVal = 0 Then
	CloudName = "OneDrive"
	' CloudName = "OneDrive ### DISABLED"
	strKeyPath = "Software\Microsoft\" & CloudName & "\Accounts"

	oReg.EnumKey HKEY_CURRENT_USER, strKeyPath, arrSubKeys
	For Each subkey In arrSubKeys
		fromp = RegRead("HKEY_CURRENT_USER\" & strKeyPath & "\" & subkey & "\UserFolder")
		If fromp <> False Then
			If Not Folders.Exists(fromp) Then Folders.Add fromp, CloudName & "\" & subkey
		End If
	Next
End If

' === Dropbox
CloudName = "Dropbox"
strFilePath = oShellEnv("LOCALAPPDATA") & "\Dropbox\info.json"
If objFSO.FileExists(strFilePath) Then
	If objFSO.GetFile(strFilePath).Size > 0 Then
		Set objIniFile = objFSO.OpenTextFile(strFilePath, ForReading, False)
		strLine = Trim(objIniFile.ReadAll)
		objIniFile.Close
		With (New RegExp)
			.Global = True
			.Pattern = "^.*{[^{]*""path""\s*:\s*""([^""]+)""[^}]*}.*$"

			If .Test(strLine) Then
				fromp = mSlashes.Replace(.Replace(strLine, "$1"), "\")
				If Not Folders.Exists(fromp) Then Folders.Add fromp, CloudName
			End If
		End With
	End If
End If

' === Yandex Disk
CloudName = "YandexDisk"
strKeyPath = "Software\Yandex"

oReg.EnumKey HKEY_CURRENT_USER, strKeyPath, arrSubKeys
For Each subkey In arrSubKeys : If InStr(1, subkey, "Yandex.Disk", 1) = 1 Then
	fromp = RegRead("HKEY_CURRENT_USER\" & strKeyPath & "\" & subkey & "\RootFolder")
	If fromp <> False Then
		If Not Folders.Exists(fromp) Then Folders.Add fromp, CloudName
		Exit For
	End If
End If : Next

' === Google Drive
CloudName = "GoogleDrive"

' === Google Drive Business
strKeyPath = "HKEY_CURRENT_USER\Software\Google\DriveFS\Share"

fromp = RegRead(strKeyPath & "\MountPoint")
fromc = RegRead(strKeyPath & "\BasePath")

If fromp <> False And fromc <> False Then
	fromp = fromp & ":"
	If objFSO.FolderExists(fromp) And objFSO.FolderExists(fromc) Then
		Set colItems = objWMIService.ExecQuery("SELECT * FROM Win32_Process WHERE Name Like 'GoogleDriveFS.exe'")
		If colItems.Count > 0 And Not Folders.Exists(fromp) Then Folders.Add fromp, CloudName & "\Business"
	End If
End If

' === Mail.Ru Disk-O
CloudName = "Mail.Ru"
strKeyPath = "Software\Mail.Ru\Mail.Ru_Disko"

Dim strValue, out, chrc
oReg.GetBinaryValue HKEY_CURRENT_USER, strKeyPath, "disks", strValue

If VarType(strValue) > 8192 Then
	out = ""
	For Each chrc In strValue
		If chrc = 10 Or (chrc > 31 And chrc < 127) Then out = out & Chr(chrc)
	Next

	If out <> "" Then
		Set colItems = objWMIService.ExecQuery("SELECT * FROM Win32_Process WHERE Name Like 'Disko.exe'")
		If colItems.Count > 0 Then
			With (New RegExp)
				.Global = True
				.Pattern = "^([a-zA-Z]:).+disk_name$"

				n = 0
				For Each strLine In Split(out, vbLf) : If .Test(strLine) Then
					n = n+1
					fromp = .Replace(strLine, "$1")
					If Not Folders.Exists(fromp) Then Folders.Add fromp, CloudName & "\Disk-O-" & n
				End If : Next
			End With
		End If
	End If
End If

' === Box Sync
CloudName = "BoxSync"
strFilePath = oShellEnv("LOCALAPPDATA") & "\Box Sync\sync_root_folder.txt"
If objFSO.FileExists(strFilePath) Then
	If objFSO.GetFile(strFilePath).Size > 0 Then
		Set objIniFile = objFSO.OpenTextFile(strFilePath, ForReading, False)
		fromp = Trim(objIniFile.ReadLine)
		objIniFile.Close
		If Not Folders.Exists(fromp) Then Folders.Add fromp, CloudName
	End If
End If

' === Файл конфигурации
Dim ComputerName : ComputerName = oShellEnv("COMPUTERNAME")
Dim UserName : UserName = oShellEnv("USERNAME")
Dim IncPaths : Set IncPaths = CreateObject("Scripting.Dictionary")
Dim ExcPaths : Set ExcPaths = CreateObject("Scripting.Dictionary")

strFilePath = strCurDir & "\settings\" & UserName & "\" & ComputerName & ".cfg"
If objFSO.FileExists(strFilePath) Then
	Set objIniFile = objFSO.OpenTextFile(strFilePath, ForReading, False)
	Do While objIniFile.AtEndOfStream = False
		strLine = Trim(Replace(objIniFile.ReadLine, VBTab, " "))
		If Left(strLine, 1) <> "#" Then
			intDelimPos = InStr(1, strLine, "=", 1)
			If intDelimPos > 0 Then
				cfgVar = Trim(Left(strLine, intDelimPos - 1))
				cfgVal = bQuot.Replace(Trim(Mid(strLine, intDelimPos + 1)), "$1")

				If InStr(1, cfgVar, "_uset", 1) = 1 Then
					intDelimPos = InStr(1, cfgVar, "|", 1)
					If intDelimPos > 0 Then
						cfgVar = Trim(Mid(cfgVar, intDelimPos + 1))
						If cfgVar <> "" And Not IncPaths.Exists(cfgVar) Then IncPaths.Add cfgVar, cfgVal
					Else
						incf = incf & " " & cfgVal
					End If
				Else
					If cfgVal = "-" And Not ExcPaths.Exists(cfgVar) Then
						ExcPaths.Add cfgVar, 1
					ElseIf Not Folders.Exists(cfgVal) Then
						Folders.Add cfgVal, cfgVar
					End If
				End If
			End If
		End If
	Loop
	objIniFile.Close
End If

' === Удаление пересекающихся путей
Dim p1, p2
WScript.Echo "Folders list:"
n = 0
For Each p1 In Folders.Keys
	n = n+1
	WScript.Echo n & ". " & Folders.Item(p1) & " : " & p1

	For Each p2 In Folders.Keys : If p1 <> p2 And Instr(1, p1, mSlashes.Replace(p2 & "\", "\"), 1) = 1 Then
		Folders.Remove(p1)
		WScript.Echo "!!! Warning, folder " & q & p1 & q & " intersects with " & q & p2 & q & " (excluded)"
		Exit For
	End If : Next
Next

' === Бэкап
If Folders.Count > 0 Then
	Dim ExecStr, nodcopy, incp, fromall
	fromall = ""
	' Improve Robocopy performance
	If WSHShell.Run(q & oShellEnv("ComSpec") & q & " /c robocopy.exe /? | find.exe /i " & q & "/NODCOPY" & q, 0, True) = 0 Then nodcopy = " /NODCOPY" Else nodcopy = ""

	For Each fromp In Folders.Keys : If objFSO.FolderExists(fromp) Then
		fromf = Folders.Item(fromp)
		fromall = fromall & q & fromp & q & vbCrLf
		If ExcPaths.Exists(fromf) Then
			WScript.Echo "!!! Folder " & q & fromf & q & " in exclude list, skip backup"
		Else
			If IncPaths.Exists(fromf) Then incp = " " & IncPaths.Item(fromf) Else incp = ""

			ExecStr = "Robocopy.exe " & q & fromp & q & " " & q & toroot & "\" & UserName & "\" & ComputerName & "\" & fromf & q & " " & incf & incp & " /s /purge /ipg:100 /z /np /ndl /r:5 /w:5 /copy:DT" & nodcopy
'			WScript.Echo ExecStr
			Set oExec = WSHShell.Exec(ExecStr)
			Do While oExec.Status = 0
				WScript.Sleep 100
				WScript.StdOut.Write(D2W(oExec.StdOut.ReadAll()))
				WScript.StdErr.Write(D2W(oExec.StdErr.ReadAll()))
			Loop
		End If
	End If : Next

	Dim datafldr : datafldr = oShellEnv("ProgramData") & "\scripts\BackupUserFolders"
	If fromall <> "" And objFSO.FolderExists(datafldr) Then 
		Dim XDfile : XDfile = datafldr & "\XD_" & UserName & ".txt"
		Dim objXDfile : Set objXDfile = objFSO.OpenTextFile(XDfile, ForWriting, True)
		objXDfile.Write(Trim(fromall))
		objXDfile.Close
		Set objXDfile = Nothing
	End If
End If

' === Функции

Function CheckAD()
	CheckAD = False

	Dim objSysInfo : Set objSysInfo = CreateObject("ADSystemInfo")
	Dim objNetwork : Set objNetwork = CreateObject("WScript.Network")
	Dim objUser : Set objUser = GetObject("LDAP://" & objSysInfo.UserName)

	If Not IsEmpty(objNetwork.ComputerName) And Not IsEmpty(objUser.sAMAccountName) And (Not IsEmpty(objUser.wWWHomePage) Or Not IsEmpty(objUser.url)) Then
		Dim ComputerName : ComputerName = UCase(objNetwork.ComputerName)
		Dim sAMAccountName : sAMAccountName = UCase(objUser.sAMAccountName)
		Dim URLs : Set URLs = CreateObject("Scripting.Dictionary")

		If Not IsEmpty(objUser.url) Then
			If VarType(objUser.url) >= 8192 Then
				Dim url : For Each url in objUser.url
					If Not URLs.Exists(url) Then URLs.Add url, 1
				Next
			Else
				URLs.Add objUser.url, 1
			End If  
		End If
		If Not IsEmpty(objUser.wWWHomePage) And Not URLs.Exists(objUser.wWWHomePage) Then URLs.Add objUser.wWWHomePage, 1

		If URLs.Count > 0 And (in_array(URLs.Keys, ComputerName) Or ComputerName = sAMAccountName) Then CheckAD = True
	End If
End Function

Function in_array(arr, item)
	Dim curitem
	For Each curitem In arr
		If UCase(curitem) = UCase(item) Then 
			in_array = True
			Exit Function
		End If
	Next
	in_array = False
End Function

Function RegRead(key)
	RegRead = False
	On Error Resume Next
	regValue = WSHShell.Regread(trim(key))
	If err.number = 0 Then RegRead = regValue
End Function

Function D2W(DOS_STRING)
'	DOS:
'	128(А)-175(п)
'	224(р)-239(я)
'	240(Ё),241(ё)
'	WIN:
'	192(А)-255(я)
'	184(ё),168(Ё)

	If Len(DOS_STRING)=0 Then Exit Function
	Dim i, s
	For i=1 To Len(DOS_STRING)
		s=Asc(Mid(DOS_STRING,i,1))
		If s>=128 And s<=175 Then
			D2W = D2W & Chr(s + 64)
		ElseIf s>=224 And s<=239 Then
			D2W = D2W & Chr(s + 16)
		ElseIf s=240 Then
			D2W = D2W & Chr(168)
		ElseIf s=241 Then
			D2W = D2W & Chr(184)
		Else
			D2W = D2W & Chr(s)
		End If

	Next
End Function

Function ConvertFromUTF8(strIn)
	Dim objIn: Set objIn = CreateObject("ADODB.Stream")

	objIn.Open
	objIn.CharSet = "Windows-1251"
	objIn.WriteText strIn
	objIn.Position = 0
	objIn.CharSet = "UTF-8"
	ConvertFromUTF8 = objIn.ReadText
	objIn.Close
End Function

@echo off
if exist "%~dp0exclude.txt" for /f "eol=# tokens=1" %%c in ('type "%~dp0exclude.txt"') do ^
if /i "%%~c" == "%COMPUTERNAME%" (echo %COMPUTERNAME% is in exclude list, exiting & exit /b)

for /f "tokens=1-7 delims=.,:/ " %%a in ("%date: =0% %time: =0%") do set "dt=%%c%%b%%a_%%d%%e%%f%%g"
set "tmplog=%TEMP%\_backupLF.cmd_%dt%.log"

start "backupLF.cmd" /b /wait /low "%ComSpec%" /c "%~dp0backupLF.cmd" > "%tmplog%" 2>&1

if not exist "%tmplog%" exit /b 1
for %%a in ("%tmplog%") do if %%~za == 0 (del /f /q "%tmplog%" & exit /b 1)

set "logdir=\\SCRIPTSERVER\scripts\logs\comp\BackupLocalFolders\%COMPUTERNAME%"
if not exist "%logdir%" mkdir "%logdir%"
set "log=%logdir%\%dt%.log"

copy /y "%tmplog%" "%log%"
del /f /q "%tmplog%"

for /f "skip=10 delims=" %%a in ('dir "%logdir%\*.log" /O-N /A-D /B') do (del /f /q "%logdir%\%%a" >> "%log%" 2>&1)

@echo off

:: Files to copy
set "incf=*.doc? *.xls? *.dot? *.xlt? *.rtf"

:: Files to exclude
set "XF=!readme.txt"

:: if not "%COMPUTERNAME%" == "IVANOV" if not "%COMPUTERNAME%" == "PETROV" exit /b
if not "%USERNAME%" == "%COMPUTERNAME%$" exit /b

chcp 1251 >nul

set "datafldr=%ProgramData%\scripts\BackupUserFolders"
if not exist "%datafldr%" (
	mkdir "%datafldr%" && icacls.exe "%datafldr%" /grant *S-1-5-32-545:^(OI^)M
) || (
	if not exist "%datafldr%" (
		echo Cannot create "%datafldr%" folder
	) else (
		echo Cannot set permissions on "%datafldr%" folder
	)
	exit /b 1
)

if not exist "%datafldr%\XD_*.txt" (echo No data files & exit /b)

setlocal enabledelayedexpansion
set "XD="
for %%a in ("%datafldr%\XD_*.txt") do for /f "tokens=*" %%b in ('type "%%~a"') do set XD=!XD! %%b
endlocal & set "XD=%XD%"

if not defined XD (echo Wrong exclude data, check BackupUserFolders script & exit /b)
if defined XF set XF=/XF %XF%

set "backTO=\\BACKUPSERVER\BackupsPC$\%COMPUTERNAME%"
set XD=/XD%XD% "%ProgramData%" "%ProgramFiles%" "%PUBLIC:\Public=%" "%SystemRoot%" "$Recycle.Bin" "RECYCLER" "System Volume Information" "Documents and Settings" "$WINDOWS.~BT"
if defined ProgramFiles(x86) set XD=%XD% "%ProgramFiles(x86)%"

set "rbcopy=%SystemRoot%\System32\Robocopy.exe"

"%rbcopy%" /? | find.exe /i "/NODCOPY" >nul && set "nodcopy=/NODCOPY" || set "nodcopy="

for /f "tokens=2 delims=:=" %%d in ('wmic.exe logicaldisk where "drivetype=3" get name /format:value') do (
	"%rbcopy%" "%%d:\\" "%backTO%\%%d" %incf% %XD% "%%d:\Program Files" "%%d:\Program Files (x86)" "%%d:\ProgramData" "%%d:\Windows" "%%d:\Windows.old" "%%d:\Users" %XF% /s /purge /ipg:100 /z /np /xj /ndl /r:5 /w:5 /copy:DT /a-:SH %nodcopy%
	call :rmempty "%backTO%\%%d"
)
rem call :rmempty "%backTO%"

chcp 866 >nul
exit /b

:rmempty
for %%a in (d -d) do for /f %%b in ('dir /a:%%a /b %1 2^>nul') do exit /b 1
echo Directory %1 is empty, let's remove it
rmdir /q %1
exit /b 0