В помощь админу

Каталог статей

Главная » Статьи » Windows » Резервное копирование

Адаптированный скрипт автоматического избавления от устаревших архивов

Пришлось на работе перебрать скрипт, приведённый в статье Автоматическое избавление от устаревших архивов, потому что появилась необходимость увеличить количество сетевых шар. Посмотрев на то, что было у меня и прикинув тот факт, что с появлением новых шар, скрипт неимоверно увеличится в объёме, я всё-таки нашёл в себе желание и силы промодифицировать скрипт и тем самым его уменьшить.

Не буду долго рассказывать суть моего апдейта, напишу только одно существенное - теперь достаточно в одной строчке указать список всех "шар" и скрипт сам с ними разберётся. Так же была добавлена функция, которая показывает объём удалённых данных.

А вот и сам скрипт (скрипт содержит комментарии):

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Скрипт, который избавляет админа от процесса слежения за бэкапами '
' Этот скрипт следит за давностью архивов и автоматически удаляет    '
'    просроченные архивы. Также предусмотрен механизм отчётности.     '
'   Скрипт написал Анчуров Олег Владимирович в 2015 году. Версия 2.   '
'                  Скрипт DeleteOldArhiveShare.vbs                        '
'                   Сайт http://ithelp.moy.su                         '
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

on error resume next

Dim Fso, f, f1, fc, fn, a, Folders
Dim MaxDay
Dim Disk
Dim ListFolders, ListFoldersMSG(), ListFoldersBefor(), ListFoldersAfter(), ListFoldersKol()
Dim Prefix, Size, LMax
Dim LFBefor, LFAfter, LFItogo
Dim WshShell, CMPName
Set Fso = CreateObject("Scripting.FileSystemObject")
Set WshShell = CreateObject("WScript.Shell")
CMPName = WshShell.ExpandEnvironmentStrings("%computername%")

Function ConvertSize(Size)
   Prefix = "Байт"
   If Size > 1024 Then
       Size = Size / 1024
       Prefix = "кБайт"
   End If
   If Size > 1024 Then
       Size = Size / 1024
       Prefix = "МБайт"
   End If
   If Size > 1024 Then
       Size = Size / 1024
       Prefix = "ГБайт"
   End If
   If Size > 1024 Then
       Size = Size / 1024
       Prefix = "ТБайт"
   End If
   ConvertSize = CStr(Round(Size, 2)) & Prefix
End Function

ListFolders = Array("Shara1", "Shara2", "Shara3", "Shara4", "SharaN")   'Список сетевых папок
Disk = "\\BackUpServer\"                                           'Сетевой диск, на котором расположены сетевые папки
MaxDay = 90                                                           'Максимальное количество дней хранения ахивов

kAll = 0
LMax = UBound(ListFolders)
Redim ListFoldersMSG(LMax)
Redim ListFoldersBefor(LMax)
Redim ListFoldersAfter(LMax)
Redim ListFoldersKol(LMax)

For i = 0 to LMax
   ListFoldersMSG(i) = ""
   ListFoldersKol(i) = 0
   FullFoldersName = Disk & ListFolders(i)
   Set f = fso.GetFolder(FullFoldersName)
   ListFoldersBefor(i) = f.Size
   Set fc = f.Files
   For Each f1 in fc
   a = DateDiff("d", f1.DateLastModified, Now)
   If a > MaxDay Then 'Если возраст архива больше заданного, то архив на хутор бабочек ловить!
       fn = f1.name
       f1.Delete
       ListFoldersKol(i) = ListFoldersKol(i) + 1
       ListFoldersMSG(i) = ListFoldersMSG(i) + "Удалён архив: " & fn & " - давность архива в днях: " & CStr(a) & vbCrLf
   End If
   Next
   ListFoldersAfter(i) = f.Size
   ListFoldersMSG(i) = ListFoldersMSG(i) + String(50, "-") & vbCrLf
   ListFoldersMSG(i) = ListFoldersMSG(i) + "Всего удалено: " & CStr(ListFoldersKol(i)) & " файлов архивов" & vbCrLf
   a1 = ListFoldersBefor(i)
   LFBefor = ConvertSize(a1)
   a2 = ListFoldersAfter(i)
   LFAfter = ConvertSize(a2)
   a3 = ListFoldersBefor(i) - ListFoldersAfter(i)
   LFItogo = ConvertSize(a3)
   ListFoldersMSG(i) = ListFoldersMSG(i) + "Размер папки " & ListFolders(i) & " (до/после): " & LFBefor & "/" & LFAfter & vbCrLf
   ListFoldersMSG(i) = ListFoldersMSG(i) + "Удалено " & LFItogo & " информации" & vbCrLf
   kAll = kAll + ListFoldersKol(i)
Next

If kAll > 0 then 'Если есть, что рассказать админу, то шлём ему весточку
   Dim objEmail, MSG, SizeAllDeleted, LFAllDeleter
   MSG = "ПРОТОКОЛ РАБОТЫ СКРИПТА, АВТОМАТИЧЕСКИ УБИРАЮЩЕГО СТАРЫЕ АРХИВЫ БЭКАПОВ НА СЕРВЕРЕ " & CMPName & ":" & vbCrLf & vbCrLf
   SizeAllDeleted = 0
   For i = 0 to LMax
       If ListFoldersKol(i) > 0 then
           MSG = MSG + "Протокол удаления архивов " & ListFolders(i) & ":" & vbCrLf
           MSG = MSG + String(50, "=") & vbCrLf
           MSG = MSG + ListFoldersMSG(i)
           MSG = MSG + String(50, "-") & vbCrLf & vbCrLf
           SizeAllDeleted = SizeAllDeleted + (ListFoldersBefor(i) - ListFoldersAfter(i))
       End If
   Next
   a1 = SizeAllDeleted
   LFAllDeleted = ConvertSize(a1)
   MSG = MSG + "Общие итоги: " & vbCrLf
   MSG = MSG + String(40, "=") & vbCrLf
   MSG = MSG + "Всего удалено архивов: " & CStr(kAll) & vbCrLf
   MSG = MSG + "Всего удалено информации: " & CStr(LFAllDeleted) & vbCrLf & vbCrLf
   MSG = MSG + String(40, "=") & vbCrLf
   MSG = MSG + "Время/дата отработки скрипта: " & CStr(Time) & "/" & CStr(Date) & vbCrLf

   Const EmailFrom = "bot@superpuperfirma.ru"         ' от кого будет отправляться e-mail
   Const EmailPassword = "SuperPuperPassword"       ' пароль от e-mail отправителя
   Const strSmtpServer = "smtp.superpuperfirma.ru" ' smtp сервер
   Const EmailTo = "admin@superpuperfirma.ru"    ' Кому будет отправляться e-mail
   Set objEmail = CreateObject("CDO.Message")

   objEmail.From = EmailFrom
   objEmail.To = EmailTo
   objEmail.Subject = "Отчёт по работе скрипта DeleteOldArhiveShare на сервере   " & CMPName ' Тема письма
   objEmail.Textbody = MSG
   objEmail.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
   objEmail.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1
   objEmail.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/sendusername") = EmailFrom
   objEmail.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/sendpassword") = EmailPassword
   objEmail.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/smtpserver") = strSmtpServer
   objEmail.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
   objEmail.Configuration.Fields.Update
   objEmail.Send
   Set objEmail = Nothing ' Чистим память.
End If