Это обновлённый скрипт (новая версия) своего предшественника, который умеет не только сообщать о недостаточном месте на дисках, но и сам теперь запускает скрипт избавления от старых бэкапов.
Сам скрипт:
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Скрипт, который следит за свободным местом на всех дисках '
' и запускает скрипт автомитического удаления старых бэкапов. '
' Скрипт написал Анчуров Олег Владимирович в 2016 году. Версия 2. '
' Скрипт FreeSizeInAllDrive.vbs '
' Сайт http://ithelp.moy.su '
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Dim FSO, Drives, D
Set FSO = CreateObject("scripting.filesystemobject")
Dim WshShell, CmpName
Set WshShell = CreateObject("WScript.Shell")
CmpName = WshShell.ExpandEnvironmentStrings("%computername%")
Dim MSG
Dim Letter, VolumeName, TotalSize, FreeSpace, FileSystem
Dim Ratio, MinRatio, Limit, MsgLimit, AutoCleanDisk, MinP
MinRatio = 100
MsgLimit = False
AutoCleanDisk = True 'Переменная указывающая на автоматический запуск скрипта очистки дисков DeleteOldArhivShare.vbs
Limit = 15 'Минимальное значение свободного места на диске в процентах
MSG = ""
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
MSG = MSG + "ПРОТОКОЛ РАБОТЫ СКРИПТА, АВТОМАТИЧЕСКИ ПРОВЕРЯЮЩИЙ ОСТАВШЕЕСЯ МЕСТО НА ДИСКАХ:" & VbLf
MSG = MSG + "Имя сервера: " & CmpName & VbLf & VbLf
Set Drives = FSO.Drives
For Each D In Drives
Letter = D.DriveLetter
MSG = MSG + "Диск: " & Letter & VbLf
If D.IsReady Then
MSG = MSG + "Состояние диска: Доступен" & VbLf
VolumeName = D.VolumeName
MSG = MSG + "Имя диска: " & VolumeName & VbLf
TotalSize = D.TotalSize
FreeSpace = D.FreeSpace
Ratio = Int(FreeSpace / TotalSize * 100)
If Ratio < MinRatio Then MinRatio = Ratio
MSG = MSG + "Общий объём диска: " & ConvertSize(TotalSize) & VbLf
MSG = MSG + "Объём свободного места на диске: " & ConvertSize(FreeSpace) & VbLf
TotalSize = D.TotalSize
FreeSpace = D.FreeSpace
FileSystem = D.FileSystem
MSG = MSG + "Файловая система: " & FileSystem & VbLf
If MinRatio < Limit Then
MsgLimit = True
MSG = MSG + "ВНИМАНИЕ! На данном диске свободного места меньше минимально допустимого значения!" & VbLf
MinP = Int(TotalSize / 100 * Limit)
MSG = MSG + "(Минимальное допустимое значение: " & Limit & "% (" & ConvertSize(MinP) & "))"
End If
MSG = MSG & VbLf
Else
MSG = MSG + "Состояние диска: Недоступен" & VbLf & VbLf
End If
Next
Set FSO = Nothing ' Чистим память.
'msgbox(msg)
If MsgLimit Then
Dim objEmail, SizeAllDeleted, LFAllDeleter
If AutoCleanDisk Then
MSG = MSG + VbLf
MSG = MSG + "Так как объём свободного места на дисках ниже допустимого порога, то будет автоматически запущен скрипт DeleteOldArhivShare, убирающий старые бэкапы!" & VbLf
WshShell.Run ("C:\Scripts\DeleteOldArhivShare.vbs") 'Запуск скрипта, автоматически убирающего старые бэкапы.
End If
MSG = MSG + VbLf
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@itwpenta.ru" ' Кому будет отправляться e-mail
Set objEmail = CreateObject("CDO.Message")
objEmail.From = EmailFrom
objEmail.To = EmailTo
objEmail.Subject = CMPName & ": Отчёт по работе скрипта FreeSizeInAllDrive" ' Тема письма
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 WshShell = Nothing ' Чистим память.
WScript.Quit
Данный скрипт является частью минипроекта Автономное управление бэкапами. |