-=Белый Медведь=-
Профиль
Группа: Комодератор
Сообщений: 4054
Регистрация: 24.4.2006
Где: г. Тверь
Репутация: 61
Всего: 109
|
Привет всем!!! Написал тут скриптик, который выполняется каждый раз при включении компа. Может, пригодиться кому...  Скриптик запускаю на всех компах своего домена, используя групповые политики, для слежения за состоянием установленных операционных систем. Алгоритм работы (упрощённо) следующий: 1. Проверяем, а запускался ли скрипт сегодня... 2. Проверяем наличие папки C:\Log, в том случае, если папка отсутствует, создаём её. 3. Получаем список всех установленных на компьютере программ 4. Проверяем, установлен ли на компьютере антивирус от Microsoft 5. При необходимости устанавливаем обновления для Microsoft Security Essentials 6. Получаем список нужных событий за предыдущий день и отправляем их системному администратору по почте (у меня в офисе свой почтовый сервачок...) | Код |
'Стартовый скрипт.
'1. Проверяем, а запускался ли скрипт сегодня...
'2. Проверяем наличие папки C:\Log, в том случае, если папка отсутствует, создаём её.
'3. Получаем список всех установленных на компьютере программ
'4. Проверяем, установлен ли на компьютере антивирус от Microsoft
'5. При необходимости устанавливаем обновления для Microsoft Security Essentials
'6. Получаем список нужных событий за предыдущий день и отправляем их системному администратору
Option Explicit
Const ForAppending = 8
Dim InstalledProgramms
Dim MSSEExist
Dim strS, intP
Dim strEvents
Dim strDELevel ' Уровень детализации сбора информации о событиях системного журнала:
'1 - только ошибки, 2 - ошибки + предупреждения
Dim strDate ' Дата, на которую нужно собирать события
Dim strEmail ' Текст письма для отправки
Dim strShedulerEMail ' Электронный адрес "from"
Dim strAdminsEMail ' e-mail админов, кто должен получать отчёты о работе скрипта
Dim strShedulerLogin ' Логин для входа на SMTP-сервер
Dim strShedulerPass ' Пароль для входа на SMTP-сервер
Dim strSMTP ' SMTP-сервер
strDELevel = 1
strDate = CStr(Date-1)
'0. Задаём параметры отправки почты
strEmail = ""
strShedulerEMail = "Report from " & COMPUTERNAME & "<[email protected]>"
strAdminsEMail = "Михаил Медведев<***@it69.ru>; Александр Белов<***@it69.ru>"
strShedulerLogin = "sheduler"
strShedulerPass = ***
strSMTP = "sdd-group.ru"
'1. Проверяем, а запускался ли скрипт сегодня...
If MyFileExist ("C:\LOG\StartUp.LOG") Then
strS = TextFromFile ("C:\LOG\StartUp.LOG")
intP = InStr (strS, CStr(date))
If intP Then
AppendToFile "C:\LOG\StartUp.LOG", "Начало работы: " & CStr (Now)
AppendToFile "C:\LOG\StartUp.LOG", "Скрипт сегодня уже запускался." & vbCrLf & "Завершение работы." & vbCrLf
WScript.Quit
End If
End If
'2. Проверяем наличие папки C:\Log, в том случае, если папка отсутствует, создаём её.
If Not FolderExist ("C:\LOG") Then
FolderCreate ("C:\LOG")
AppendToFile "C:\LOG\StartUp.LOG", "Начало работы: " & CStr (Now)
AppendToFile "C:\LOG\StartUp.LOG", "Была создана папка ""C:\LOG"""
Else
AppendToFile "C:\LOG\StartUp.LOG", "Начало работы: " & CStr (Now)
End If
'3. Получаем список всех установленных на компьютере программ
AppendToFile "C:\LOG\StartUp.LOG", "Получаем список всех установленных на компьютере программ."
InstalledProgramms = InstalledSoftware
'4. Проверяем, установлен ли на компьютере антивирус от Microsoft
AppendToFile "C:\LOG\StartUp.LOG", "Ищем Microsoft Security Essentials."
MSSEExist = InStr (InstalledProgramms, "Microsoft Security Essentials")
If MSSEExist Then
AppendToFile "C:\LOG\StartUp.LOG", "Найден Microsoft Security Essentials."
Else
AppendToFile "C:\LOG\StartUp.LOG", "НЕ найден Microsoft Security Essentials."
End If
'5. При необходимости устанавливаем обновления для Microsoft Security Essentials
If MSSEExist Then
strEmail = "Результат установки обновлений баз для Microsoft Security Essentials:" & _
StartProgram ("\\Iserver\AV\msse\mpam-fe.exe") &vbCrLf & vbCrLf
AppendToFile "C:\LOG\StartUp.LOG", strEmail
End If
'6. Получаем список событий за предыдущий день и отправляем их системному администратору
AppendToFile "C:\LOG\StartUp.LOG", "Получаем список важных событий из системных журналов " _
& "за предыдущий день и отправляем их администратору"
AppendToFile "C:\LOG\StartUp.LOG", "Дата для сбора событий: " & strDate
If strDELevel = 1 Then
strEvents = EventsList (strDate, "System", 1) & _
EventsList (strDate, "Application", 1)
Else
strEvents = EventsList (strDate, "System", 1) & _
EventsList (strDate, "System", 2) & _
EventsList (strDate, "Application", 1) & _
EventsList (strDate, "Application", 2)
End If
If Len( strEvents) Then
strEmail = strEmail & "События за " & CStr(Date-1) & vbCrLf & vbCrLf & strEvents
End If
If Len( strEmail) Then
AppendToFile "C:\LOG\StartUp.LOG", SendEMail ( strShedulerEMail, strShedulerLogin, strShedulerPass, strSMTP, strAdminsEMail, strEmail)
Else
AppendToFile "C:\LOG\StartUp.LOG", "Отправлять по почте админу нечего. Письмо отправляться не будет!!!"
End If
AppendToFile "C:\LOG\StartUp.LOG", "Завершение работы: " & CStr (Now) & vbCrLf
WScript.Quit
'********************************************************************
'*
'* Процедура : AppendToFile
'* Описание : Дописывает в файл текстовую информацию
'* Вход : strFileName - имя файла, в который нужно дописать информацию
'* strString - дописываемая информация
'*
'********************************************************************
Sub AppendToFile(ByVal strFileName, ByVal strString)
Dim fso, f
Err.Clear
On Error Resume Next
Set fso = CreateObject("Scripting.FileSystemObject")
Set f = fso.OpenTextFile(strFileName, ForAppending, True)
f.WriteLine strString
f.Close
Set f = Nothing
Set fso = Nothing
End Sub
'********************************************************************
'*
'* Функция : MyFileExist
'* Описание : Функция проверки существования файла
'* Вход : Имя файла
'* Выход : true, если файл существует, и false, если файл отсутствует.
'*
'********************************************************************
Function MyFileExist (ByVal FileName)
dim fso
Err.Clear
On Error Resume Next
Set fso = WScript.CreateObject("Scripting.FileSystemObject")
MyFileExist = (fso.FileExists(FileName))
Set fso = Nothing
end Function
'********************************************************************
'*
'* Функция : FolderExist
'* Описание : Функция проверки существования папки
'* Вход : Имя папки
'* Выход : true, если папка существует, и false, если папка отсутствует.
'*
'********************************************************************
Function FolderExist (ByVal FolderName)
dim fso
Err.Clear
On Error Resume Next
Set FSO = CreateObject("Scripting.FileSystemObject")
FolderExist = (FSO.FolderExists(FolderName))
Set fso = Nothing
end Function
'********************************************************************
'*
'* Функция : FolderCreate
'* Описание : Функция создания папки по нужному пути
'* Вход : Полный путь к создаваемой папке.
'* Выход : нет
'*
'********************************************************************
Function FolderCreate (ByVal FolderName)
dim objFSO, objFolder
Err.Clear
On Error Resume Next
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFolder = objFSO.CreateFolder(FolderName)
Set objFolder = Nothing
Set objFSO = Nothing
FolderCreate = Err.Number
Err.Clear
end Function
'********************************************************************
'*
'* Функция : InstalledSoftware
'* Описание : Функция возвращает список установленных программ
'* Вход :
'* Выход : Список установленных программ
'*
'********************************************************************
Function InstalledSoftware
Const HKLM = &H80000002 'HKEY_LOCAL_MACHINE
Dim strKey, strEntry1a, strEntry1b, strEntry2, strEntry3, strEntry4, strEntry5, objReg
Dim arrSubkeys, strSubkey, strValue1, intRet1, strValue2, intValue3, intValue4, intValue5
Dim strS
strKey = "SOFTWARE\Microsoft\Windows\CurrentVersion\Uninstall\"
strEntry1a = "DisplayName"
strEntry1b = "QuietDisplayName"
strEntry2 = "InstallDate"
strEntry3 = "VersionMajor"
strEntry4 = "VersionMinor"
strEntry5 = "EstimatedSize"
Set objReg = GetObject("winmgmts://./root/default:StdRegProv")
objReg.EnumKey HKLM, strKey, arrSubkeys
For Each strSubkey In arrSubkeys
intRet1 = objReg.GetStringValue(HKLM, strKey & strSubkey, strEntry1a, strValue1)
If intRet1 <> 0 Then
objReg.GetStringValue HKLM, strKey & strSubkey, strEntry1b, strValue1
End If
If strValue1 <> "" Then
strS = strS & "Display Name: " & strValue1 & vbtab
End If
objReg.GetStringValue HKLM, strKey & strSubkey, strEntry2, strValue2
If strValue2 <> "" Then
strS = strS & "Install Date: " & strValue2 & vbtab
End If
objReg.GetDWORDValue HKLM, strKey & strSubkey, strEntry3, intValue3
objReg.GetDWORDValue HKLM, strKey & strSubkey, strEntry4, intValue4
If intValue3 <> "" Then
strS = strS & "Version: " & intValue3 & "." & intValue4 & vbtab
End If
objReg.GetDWORDValue HKLM, strKey & strSubkey, strEntry5, intValue5
If intValue5 <> "" Then
strS = strS & "Estimated Size: " & Round(intValue5/1024, 3) & " megabytes"
End If
strS = strS & vbcrlf
Next
InstalledSoftware = strS
end Function
'********************************************************************
'*
'* Функция : blnTestString
'* Описание : Определяет соответствует ли строка шаблону
'* Вход : strString - строка
'* strPath - шаблон (регулярное выражение)
'* Выход : true - соответствует шаблону; false - не соответствует шаблону
'*
'********************************************************************
Function blnTestString(ByVal strString, ByVal strPath)
Dim RegEx
' Создаём экземпляр объекта RegExp
Set RegEx = CreateObject("VBScript.RegExp")
' Настраиваем режимы работы регулярного выражения
RegEx.IgnoreCase = True ' Осуществляем поиск игнорируя размер букв
RegEx.Global = False ' Ищем до первого совпадения
RegEx.MultiLine = False ' Текст не является многострочным
RegEx.Pattern = strPath ' Устанавливаем шаблон регулярного выражения
' Тестируем строку на соответствие шаблону
blnTestString = RegEx.Test(strString)
' Уничтожаем экземпляр объекта RegExp
Set RegEx = Nothing
End Function
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'#
'# Процедура StartProgram
'# Описание: Запускает программу
'# Вход : полное имя к исполняемому файлу
'# Выход : нет
'#
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Function StartProgram (byval strProgramName)
Dim WSHShell
On Error Resume Next
Err.Clear
Set WSHShell = WScript.CreateObject("WScript.Shell")
WshShell.Run strProgramName, 1, True
Set WSHShell = Nothing
If Err.Number <> 0 Then
StartProgram = "Ошибка запуска программы: " & Err.Number & vbCrLf & "Расшифровка ошибки: " & Err.Description
Err.Clear
Else
StartProgram = "Запуск " & strProgramName & "прошёл успешно."
End If
On Error Goto 0
End Function
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'#
'# Процедура TextFromFile
'# Описание: Возвращает текст из текстового файла
'# Вход : полное имя к текстовому файлу
'# Выход : нет
'#
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Function TextFromFile (byval strFileName)
Const ForReading = 1
Dim objFSO, objTextFile
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objTextFile = objFSO.OpenTextFile (strFileName, ForReading)
TextFromFile = objTextFile.ReadAll
Set objTextFile = Nothing
Set objFSO = Nothing
End Function
'********************************************************************
'*
'* Функция : EventsList
'* Описание : Возвращает список событий указанного типа за указанный день.
'* Вход :
'* strDay - дата, за которую собираются события.
'* Дата указывается в формате "15-12-2009"
'*
'* strLogfile - тип журнала
'* System - "система"
'* Application - "приложение"
'*
'*
'* intEventsType - тип возвращаемых событий
'*
'* 1 - Error
'* 2 - Warning
'* 3 - Information
'* 4 - Security audit success
'* 5 - Security audit failure
'*
'* Выход : текстовая строка
'*
'********************************************************************
Function EventsList (byval strDay, byval strLogfile, byval intEventsType)
Const CONVERT_TO_LOCAL_TIME = True
Dim objWMIService, colEvents, objEvent, dtmStartDate, dtmEndDate, DateToCheck, WMIDateToString, strS
strS= ""
Set dtmStartDate = CreateObject("WbemScripting.SWbemDateTime")
Set dtmEndDate = CreateObject("WbemScripting.SWbemDateTime")
DateToCheck = CDate(strDay)
dtmStartDate.SetVarDate DateToCheck, CONVERT_TO_LOCAL_TIME
dtmEndDate.SetVarDate DateToCheck + 1, CONVERT_TO_LOCAL_TIME
Set objWMIService = GetObject("winmgmts:{impersonationLevel=impersonate}!\\.\root\cimv2")
Set colEvents = objWMIService.ExecQuery _
("Select * from Win32_NTLogEvent Where Logfile = '" & strLogfile & "' " _
& "and EventType = " & intEventsType _
& " and TimeWritten >= '" & dtmStartDate & "' and TimeWritten < '" & dtmEndDate & "'")
For Each objEvent in colEvents
strS = strS & "Category: " & objEvent.Category & vbcrlf
strS = strS & "Computer Name: " & objEvent.ComputerName & vbcrlf
strS = strS & "Event Code: " & objEvent.EventCode & vbcrlf
strS = strS & "Message: " & objEvent.Message & vbcrlf
strS = strS & "Record Number: " & objEvent.RecordNumber & vbcrlf
strS = strS & "Source Name: " & objEvent.SourceName & vbCrLf
WMIDateToString = Mid(objEvent.TimeWritten, 7, 2) & "-" & _
Mid(objEvent.TimeWritten, 5, 2) & "-" & _
Left(objEvent.TimeWritten, 4)
strS = strS & "Time Written: " & WMIDateToString& vbcrlf
strS = strS & "Event Type: " & objEvent.Type & vbcrlf
strS = strS & "User: " & objEvent.User & vbcrlf
strS = strS & objEvent.LogFile & vbCrLf & vbcrlf
Next
Set dtmStartDate = Nothing
Set dtmEndDate = Nothing
EventsList = strS
End Function
'********************************************************************
'*
'* Функция : SendEMail
'* Описание : Функция отправляет письмо по указанному адресу
'* Вход :
'* strFrom - e-mail отправителя
'* strLogin - логин на smtp-сервер
'* strPass - пароль на smtp-сервер
'* SMTPServer - smtp-сервер
'* strTo - e-mail адресата
'* strTextbody - текст письма
'* Выход : 0 - ошибок при отправке не произошло
'* номер ошибки + расшифровка при ошибке отправки
'*
'********************************************************************
Function SendEMail ( byval strFrom, byval strLogin, byval strPass, byval SMTPServer, byval strTo, byval strTextbody)
Dim intSMTPPort, bSMTPUseSSL, intUseAuth, objEmail
intSMTPPort = 25 ' Порт SMTP Сервера
bSMTPUseSSL = False ' При соединении с SMTP через SSL, необходимо изменить значение на True
intUseAuth = 1 ' Если SMTP-аутентификация не требуется, можно установить значение 0. Для NTLM аутентификации - значение 2
On Error Resume Next
Err.Clear
Set objEmail = CreateObject("CDO.Message")
objEmail.From = strFrom
objEmail.To = strTo
objEmail.Subject = "Startup Script."
objEmail.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
objEmail.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/smtpserver") = SMTPServer
objEmail.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = intUseAuth
objEMail.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = bSMTPUseSSL
objEmail.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = intSMTPPort
objEmail.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/sendusername") = strLogin
objEmail.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/sendpassword") = strPass
objEmail.TextBody = strTextbody
objEmail.Configuration.Fields.Update
objEmail.Send
Set objEmail = Nothing
If Err.Number Then
SendEMail = Err.Number & " - " & Err.Description
Else
SendEMail = 0
End If
On Error Goto 0
End Function
'********************************************************************
'*
'* Функция : COMPUTERNAME
'* Описание : Возвращает имя компьютера
'* Вход : нет
'* Выход : DNS-имя компьютера
'*
'********************************************************************
Function COMPUTERNAME
Dim WshShell
Set WshShell = CreateObject("WScript.Shell")
COMPUTERNAME = WshShell.ExpandEnvironmentStrings("%COMPUTERNAME%")
Set WshShell = Nothing
End Function
|
--------------------
Программистами не рождаются, - это родовая травма...   |
Стартовый скрипт. в помощь системному администратору 
Загрузка ...
