Приветствую Вас ГостьСреда, 18.09.2019, 16:32

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


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

Главная » Статьи » 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

Set Fso = Nothing ' Чистим память.
WScript.Quit

Ну вот и весь скрипт.

А также можно повесить на сервак скрипт, который автоматически проверит свободное место на дисках сервера и вовремя оповестит о проблеме.

Данный скрипт является частью минипроекта Автономное управление бэкапами.

Жизнь админа должна быть проще!

 

Категория: Резервное копирование | Добавил: isz (05.10.2015)
Просмотров: 849 | Теги: бэкап, vbs, vbscript, backup, Скрипт, архив | Рейтинг: 0.0/0
Всего комментариев: 0
Добавлять комментарии могут только зарегистрированные пользователи.
[ Регистрация | Вход ]
Категории раздела
Active Directory [10]
DHCP [1]
Windows [12]
Wins [1]
Групповая политика [2]
Программы [2]
Резервное копирование [5]
Сеть [5]
Скрипты [25]
Терминальный сервер [6]
Почта [5]
Реестр [1]
Реестр Windows
Командная строка [6]
CMD: Командная строка Windows
Поиск
Форма входа
Наш опрос
Оцените мой сайт
Всего ответов: 108
Друзья сайта
  • Официальный блог
  • Сообщество uCoz
  • FAQ по системе
  • Инструкции для uCoz
  • Статистика