Set FSO = CreateObject("Scripting.FileSystemObject") SourceFolder = FSO.GetAbsolutePathName(".") 'WScript.Echo SourceFolder ExtractFolder = "extract" ArchiveFolder = "rdiff-backup" Set FSOSourceFolder = FSO.GetFolder(SourceFolder) Set CmdExecutor = CreateObject("WScript.Shell") today = Date ForAppending = 8 outFile = "cleanup.log" MaxFleAge = 1 Dim FileExtentions(5) FileExtentions(0)="gz" FileExtentions(1)="zip" FileExtentions(2)="sql" FileExtentions(3)="tar" FileExtentions(4)="rar" FileExtentions(5)="tgz" If FSO.FileExists(outFile) Then Set logFile = FSO.OpenTextFile(outFile, ForAppending, True) Else Set logFile = FSO.CreateTextFile(outFile, True) End If logfile.Write TimeStamp() & " Starting rdiff-backup." & vbCrLf CleanFolderFiles FSOSourceFolder, False cleanSubFolders FSOSourceFolder, False logfile.Write TimeStamp() & " DONE!" & vbCrLf logFile.Close Function CleanFolderFiles(folder_to_clean, IsRecursiveCleanFolder) logfile.Write TimeStamp() & " Cleaning folder " & folder_to_clean.Name & vbCrLf Set ListFilesToClean = folder_to_clean.Files For Each FileToClean In ListFilesToClean If CheckFile(FileToClean) Then CleanFile FileToClean, IsRecursiveCleanFolder Next End Function Function CheckFile(file_to_check) FileExt = FSO.GetExtensionName(file_to_check.Path) IF Ubound(Filter(FileExtentions, FileExt)) > -1 Then If DateDiff("d", GetDate(file_to_check), today) > MaxFleAge Then CheckFile = True Else CheckFile = False End If Else logfile.Write TimeStamp() & " Unkown file extention " & FileExt & " Skipping" & vbCrLf CheckFile = False End If End Function Function GetDate(file_to_date) FName = file_to_date.Name FPath = Replace(FSO.GetParentFolderName(file_to_date), "\" & ExtractFolder, "") logfile.Write TimeStamp() & " Geting date format for " & FPath & vbCrLf FExt = FSO.GetExtensionName(file_to_date) FNameData = Replace(FName, "." & FExt, "") If InStr(1, FNameData, ".tar") Then FNameData = Replace(FNameData, ".tar", "") End If If StringEndsWith(FPath, "service1035\backups") Then DateInfoArr = Split(FNameData, "-") dFileCreated = CDate(DateInfoArr(2) & "/" & DateInfoArr(1) & "/" & DateInfoArr(0) & " " & DateInfoArr(3) & ":" & DateInfoArr(4) & ":" & DateInfoArr(5)) ElseIf StringEndsWith(FPath, "Backup\Minecraft") Then DateInfoArr = Split(FNameData, "_") TimeInfoArr = Split(DateInfoArr(5), "-") DateStr = DateInfoArr(4) & "/" & DateInfoArr(3) & "/" & DateInfoArr(2) & " " & TimeInfoArr(0) & ":" & TimeInfoArr(1) & ":" & TimeInfoArr(2) logfile.Write TimeStamp() & " Converting string '" & DateStr & "' to date" & vbCrLf dFileCreated = CDate(DateStr) Else logfile.Write TimeStamp() & " Unkown backup folder format " & FPath & " Exiting" & vbCrLf 'dFileCreated = FormatDateTime(file_to_date.DateCreated, "2") wscript.quit End If logfile.Write TimeStamp() & " File = " & FName & " Date = " & dFileCreated & vbCrLf GetDate = dFileCreated End function Function CleanFile(file_to_clean, IsRecursiveCleanFile) logfile.Write TimeStamp() & " Is recursive clean: " & IsRecursiveCleanFile & vbCrLf If IsRecursiveCleanFile Then ExtractFile file_to_clean, True file_to_clean.Delete Else file_to_clean_date = GetDate(file_to_clean) ExtractFile file_to_clean, False CleanFolderFiles FSO.GetFolder(FSOSourceFolder.path & "\" & ExtractFolder), True RdiffArchiveFile file_to_clean, file_to_clean_date End If End Function Function ExtractFile(file_to_extract, IsRecursiveExtract) logfile.Write TimeStamp() & " Is recursive extract: " & IsRecursiveExtract & vbCrLf ExtractFP = FSOSourceFolder.Path & "\" & ExtractFolder ExtractCmdResult = -1 ExtractCmd = "C:\7z-cmd\7za.exe -y x -x!*\plugins\CoreProtect\database.db -o" If IsRecursiveExtract Then ExtractCmd = ExtractCmd & FSO.GetParentFolderName(file_to_extract) & " " Else ExtractCmd = ExtractCmd & ExtractFP & " " End If ExtractCmd = ExtractCmd & file_to_extract.Path logfile.Write TimeStamp() & " Extract cmd " & ExtractCmd & vbCrLf If FSO.FolderExists(ExtractFP) And Not IsRecursiveExtract Then logfile.Write TimeStamp() & " Deleting old extract folder " & ExtractFP & vbCrLf FSO.DeleteFolder(ExtractFP) End If ExtractCmdResult = CmdExecutor.Run(ExtractCmd,1,True) Select Case ExtractCmdResult Case 0 logfile.Write TimeStamp() & " Extracted OK" & vbCrLf Case Else logfile.Write TimeStamp() & " Non-Zero exit code from 7z '" & ExtractCmdResult & "'" & vbCrLf WScript.Quit End Select End Function Function RdiffArchiveFile(file_to_rdiff, usedate ) logfile.Write TimeStamp() & " Begining Rdiff" & vbCrLf RdiffCmdResult = -1 RDiff_FP = FSOSourceFolder.Path & "\" & ArchiveFolder FEpoch = DateDiff("S", "1/1/1970", usedate) ExtractFP = FSOSourceFolder.Path & "\" & ExtractFolder RdiffCmd = "C:\rdiff-backup\rdiff-backup.exe " RdiffCmd = RdiffCmd & "--current-time " & FEpoch & " " RdiffCmd = RdiffCmd & ExtractFP & " " & RDiff_FP logfile.Write TimeStamp() & " Rdif cmd " & RdiffCmd & vbCrLf RdiffCmdResult = CmdExecutor.Run(RdiffCmd,1,True) Select Case RdiffCmdResult Case 0 logfile.Write TimeStamp() & " RDif'd OK, deleting original" & vbCrLf file_to_rdiff.Delete Case 1 logfile.Write TimeStamp() & " Duplicate file. Deleting" & vbCrLf file_to_rdiff.Delete Case Else logfile.Write TimeStamp() & " Non-Zero exit code from RDif '" & RdiffCmdResult & "'" & vbCrLf WScript.Quit End Select End Function Function cleanSubFolders(ParentFolder, IsRecusivecleanSubFolders) Set ChildFoldersList = ParentFolder.SubFolders For Each ChildFolder In ChildFoldersList If (IsRecursiveCleanSubFolders And ChildFolder.Name = ExtractFolder) Or ((Not IsRecursiveCleanSubFolders) And ChildFolder.Name <> ExtractFolder) Then If ChildFolder.Name <> ".sync" And ChildFolder.Name <> ArchiveFolder Then 'Don't clean btsync's .sync folder or our working folder(s) CleanFolderFiles ChildFolder, IsRecusivecleanSubFolders CleanSubFolders ChildFolder, IsRecusivecleanSubFolders End if End If Next End Function Function LZ(ByVal Number) If Number < 10 Then LZ = "0" & CStr(Number) Else LZ = CStr(Number) End If End Function Function TimeStamp Dim CurrTime CurrTime = Now() TimeStamp = CStr(Year(CurrTime)) & "-" _ & LZ(Month(CurrTime)) & "-" _ & LZ(Day(CurrTime)) & " " _ & LZ(Hour(CurrTime)) & ":" _ & LZ(Minute(CurrTime)) & ":" _ & LZ(Second(CurrTime)) End Function Public Function StringEndsWith(ByVal strValue, CheckFor) 'Determines if a string ends with the same characters as 'CheckFor string 'True if end with CheckFor, false otherwise 'Case sensitive by default. If you want non-case sensitive, set 'last parameter to vbTextCompare 'Examples 'MsgBox StringEndsWith("Test", "ST") 'False 'MsgBox StringEndsWith("Test", "ST", vbTextCompare) 'True Dim sCompare Dim lLen lLen = Len(CheckFor) If lLen > Len(strValue) Then Exit Function sCompare = Right(strValue, lLen) StringEndsWith = StrComp(sCompare, CheckFor, vbBinaryCompare) = 0 End Function