會發生兩種問題:
1. 電腦中毒擴大
2. MIS 電話被 User 打爆
此時可利用本 VBScript 程式定時從 DC 的 Event Log 中撈出 Account Lock Out 事件
得知哪個帳號在什麼時間從哪個 IP 被 Lock Out
預設參數設定每 300 秒檢查 300 秒內的 Log
跑此程式的帳號必須有權限可存取目標 DC 的 Event Log
可存成 Log 檔亦可發出信件給需要進行處理的人員
2013.07.05 修改: 合併多個一樣的事件
2013.07.07 選項: 合併多個一樣的事件時的表現方式
2013.08.01 選項: 檢查間格時間內同一事件發生次數大於等於多少次才發報
2013.08.01 選項: 解析用戶端位址
2013.08.01 選項: 檢查間格時間內同一事件發生次數大於等於多少次才發報
2013.08.01 選項: 解析用戶端位址
'------------------------------[設定開始]------------------------------
' 檢查間格時間 (秒)
' 數值為 0 表示只執行一次就結束
WaitSeconds=0
' 查詢距離程式執行時間多久以前開始的 Log 資料 (秒)
TimeRange=600
' 檢查間隔時間內同一事件發生次數大於等於多少次才發報
AlertTimes=3
' 合併相同事件
' 0 相同事件列出所有發生時間
' 1 相同事件只列出頭尾時間, 並加上發生次數
MergeSameEvent=1
' 解析用戶端位址
NameResolve=1
LogServerComputer = "Contoso-DC1"
' 是否要把搜尋記錄存成檔案 true: 存 / false: 不存
' LogToFile=true
LogToFile=true
' 是否要寄信通知 true: 存 / false: 不存
' SendMail=true
SendMail=true
' 要檢查的帳號, 留空時只要 Event Code 符合就會抓出來, 多個帳號以分號 (;) 分隔
' CheckAccount=""
CheckAccount=""
' 發信人
EmailFrom="AccountLockoutCapture@contoso.com"
' 收信人, 多個收信人以分號 (;) 分隔
EmailTo="MIS@contoso.com"
' SMTP Server
SMTPServer="mail.contoso.com"
'------------------------------[設定結束]------------------------------
on error resume next
Dim ResultTimeProcessArray()
Dim ResultContentProcessArray()
Dim ResultTimeArray()
Dim ResultContentArray()
CheckAccount=UCase(CheckAccount)
CheckAccountArray=split(CheckAccount,";")
CheckAccountCount=UBound(CheckAccountArray)
WaitSeconds=WaitSeconds*1000
SwitchWaitSeconds=WaitSeconds
Set QueryStartDateTime = CreateObject("WbemScripting.SWbemDateTime")
Set QueryEndDateTime = CreateObject("WbemScripting.SWbemDateTime")
Set objFSO=CreateObject("Scripting.FileSystemObject")
do
SystemNow=now()
SystemNow_Year=year(SystemNow)
SystemNow_Month=Right("0" & Month(SystemNow), 2)
SystemNow_Day=Right("0" & Day(SystemNow), 2)
SystemNow_Hour=Right("0" & Hour(SystemNow), 2)
SystemNow_Minute=Right("0" & Minute(SystemNow), 2)
SystemNow_Second=Right("0" & Second(SystemNow), 2)
Result=""
ResultArrayProcessIndex=0
ReDim ResultTimeProcessArray(ResultArrayProcessIndex)
ReDim ResultContentProcessArray(ResultArrayProcessIndex)
QueryStartDateTime.SetVarDate dateadd("s", -TimeRange, now)
QueryEndDateTime.SetVarDate dateadd("s", -0, now)
Set objWMIService = GetObject("winmgmts:\\" & LogServerComputer & "\root\cimv2")
Set colEvents = objWMIService.ExecQuery ("Select * from Win32_NTLogEvent Where Logfile = 'Security' and TimeWritten >='" & QueryStartDateTime & "' and TimeWritten <='" & QueryEndDateTime & "' and (EventCode=539 or EventCode=675)")
For Each objEvent in colEvents
t=split(objEvent.TimeWritten,".")
a=split(objEvent.Message,vbcrlf)
ResultTime = ""
ResultContent = ""
if CheckAccount="" then
if objEvent.EventCode=675 then
if Instr(UCase(a(10)),"0X12") <> 0 then
ResultTime = t(0)
ResultContent = Chr(9) & "Event Code: " & Chr(9) & objEvent.EventCode & vbcrlf & a(4) & vbcrlf & a(12) & vbcrlf & vbcrlf
'Result = Result & t(0) & Chr(9) & "Event Code: " & objEvent.EventCode & vbcrlf & a(4) & vbcrlf & a(12) & vbcrlf & vbcrlf
end if
elseif objEvent.EventCode=539 then
ResultTime = t(0)
ResultContent = Chr(9) & "Event Code: " & Chr(9) & objEvent.EventCode & vbcrlf & a(2) & vbcrlf & a(4) & vbcrlf & a(14) & vbcrlf & a(26) & vbcrlf & vbcrlf
'Result = Result & t(0) & Chr(9) & "Event Code: " & Chr(9) & objEvent.EventCode & vbcrlf & a(2) & vbcrlf & a(4) & vbcrlf & a(14) & vbcrlf & a(26) & vbcrlf & vbcrlf
end if
else
for i=0 to CheckAccountCount
if CheckAccountArray(i) <> "" then
if Instr(UCase(a(4)),CheckAccountArray(i)) <> 0 then
if objEvent.EventCode=675 then
if Instr(UCase(a(10)),"0X12") <> 0 then
ResultTime = t(0)
ResultContent = Chr(9) & "Event Code: " & Chr(9) & objEvent.EventCode & vbcrlf & a(4) & vbcrlf & a(12) & vbcrlf & vbcrlf
'Result = Result & t(0) & Chr(9) & "Event Code: " & Chr(9) & objEvent.EventCode & vbcrlf & a(4) & vbcrlf & a(12) & vbcrlf & vbcrlf
end if
elseif objEvent.EventCode=539 then
ResultTime = t(0)
ResultContent = Chr(9) & "Event Code: " & Chr(9) & objEvent.EventCode & vbcrlf & a(2) & vbcrlf & a(4) & vbcrlf & a(14) & vbcrlf & a(26) & vbcrlf & vbcrlf
'Result = Result & t(0) & Chr(9) & "Event Code: " & Chr(9) & objEvent.EventCode & vbcrlf & a(2) & vbcrlf & a(4) & vbcrlf & a(14) & vbcrlf & a(26) & vbcrlf & vbcrlf
end if
end if
end if
next
end if
if (ResultTime <> "") then
ResultTimeDate = Mid(ResultTime, 1, 4) & "." & Mid(ResultTime, 5, 2) & "." & Mid(ResultTime, 7, 2)
ResultTimeTime = Mid(ResultTime, 9, 2) & ":" & Mid(ResultTime, 11, 2) & ":" & Mid(ResultTime, 13, 2)
ReDim Preserve ResultTimeProcessArray(ResultArrayProcessIndex)
ReDim Preserve ResultContentProcessArray(ResultArrayProcessIndex)
ResultTimeProcessArray(ResultArrayProcessIndex) = ResultTimeDate & " " & ResultTimeTime
ResultContentProcessArray(ResultArrayProcessIndex) = ResultContent
ResultArrayProcessIndex = ResultArrayProcessIndex + 1
end if
Next
ResultArrayIndex = 0
ReDim ResultTimeArray(ResultArrayIndex)
ReDim ResultContentArray(ResultArrayIndex)
for i=0 to ResultArrayProcessIndex-1
if (ResultTimeProcessArray(i) <> "") then
ResultTimeArray(ResultArrayIndex) = ResultTimeArray(ResultArrayIndex) & ResultTimeProcessArray(i)
ResultContentArray(ResultArrayIndex) = ResultContentProcessArray(i)
for j=i+1 to ResultArrayProcessIndex-1
if (ResultTimeProcessArray(j) <> "") then
if ( ResultContentProcessArray(j) = ResultContentProcessArray (i) ) then
if (ResultTimeArray(ResultArrayIndex) <> "") then
ResultTimeArray(ResultArrayIndex) = ResultTimeArray(ResultArrayIndex) & vbcrlf
end if
ResultTimeArray(ResultArrayIndex) = ResultTimeArray(ResultArrayIndex) & ResultTimeProcessArray(j)
ResultTimeProcessArray(j) = ""
end if
end if
next
ResultArrayIndex = ResultArrayIndex +1
ReDim Preserve ResultTimeArray(ResultArrayIndex)
ReDim Preserve ResultContentArray(ResultArrayIndex)
end if
next
for i=0 to ResultArrayIndex-1
ResultTimeSplit = split(ResultTimeArray(i),vbcrlf)
ResultTimesCount = ubound(ResultTimeSplit)
if MergeSameEvent = 1 then
if ubound(ResultTimeSplit) > 0 then
ResultTimeArray(i) = ResultTimeSplit(0) & " - " & ResultTimeSplit(ResultTimesCount) & " / Total: " & ResultTimesCount + 1 & " times"
end if
end if
if ResultTimesCount >= AlertTimes then
if NameResolve = 1 then
ResultContentSplit = split(ResultContentArray(i),vbcrlf)
ResultContentReplace=""
for j=0 to ubound(ResultContentSplit)
if ( Instr(ResultContentSplit(j),"用戶端位址:") <> 0 or Instr(ResultContentSplit(j),"來源網路位址:") <> 0 )then
NameResolveIP = ResultContentSplit(j)
NameResolveIP = Replace(NameResolveIP, "用戶端位址:", "")
NameResolveIP = Replace(NameResolveIP, "來源網路位址:", "")
NameResolveIP = Replace(NameResolveIP, " ", "")
NameResolveIP = Replace(NameResolveIP, " ", "")
ResultContentSplit(j) = ResultContentSplit(j) & " (" & IPtoHost(NameResolveIP) & ")"
end if
ResultContentReplace = ResultContentReplace & ResultContentSplit(j) & vbcrlf
next
ResultContentArray(i) = ResultContentReplace
end if
Result = Result & ResultTimeArray(i) & vbcrlf
Result = Result & "-------------------" & vbcrlf
Result = Result & ResultContentArray(i) & vbcrlf
end if
next
for i=0 to ResultArrayIndex-1
Result = Replace(Result,"-------------------" & vbcrlf & "-------------------", "-------------------")
next
if Result <> "" then
Result = LogServerComputer & " Account Lockout Capture" & vbcrlf & vbcrlf & Result
' 寫入檔案
if LogToFile=true then
LogFile = left(Wscript.ScriptFullName,len(Wscript.ScriptFullName)-len(Wscript.ScriptName)) & "\AccountLockoutCapture_" & SystemNow_Year & SystemNow_Month & SystemNow_Day & "_" & SystemNow_Hour & SystemNow_Minute & SystemNow_Second & ".log"
Set objTextStream = objFSO.OpenTextFile(LogFile, 8, true)
objTextStream.WriteLine Result
objTextStream.Close
Set objTextStream = Nothing
end if
' 寄出信件
if SendMail=true then
Set objMessage = CreateObject("CDO.Message")
objMessage.Subject = LogServerComputer & " Account Lockout Capture"
objMessage.From = EmailFrom
objMessage.TextBody = Result
objMessage.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/sendusing")=2
objMessage.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/smtpserver")=SMTPServer
objMessage.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/smtpserverport")=25
EmailToArray=split(EmailTo,";")
for j=0 to UBound(EmailToArray)
objMessage.To = EmailToArray(j)
objMessage.Configuration.Fields.Update
objMessage.Send
next
end if
end if
WScript.Sleep WaitSeconds
loop while WaitSeconds > 0
Function IPtoHost(strIpaddress)
Set objWMIService = GetObject("winmgmts:\\.\root\cimv2")
Set colPings = objWMIService.ExecQuery ("Select * from Win32_PingStatus Where Address = '" & strIpaddress & "' And Timeout = 10 And ResolveAddressNames = True")
For Each objStatus in colPings
If IsNull(objStatus.StatusCode) or objStatus.StatusCode <> 0 Then
'***** Computer did not respond.
IPtoHost = checkServerName(strIpaddress)
Else
IPtoHost = objstatus.ProtocolAddressResolved
End if
Next
Set objWMIService = Nothing
Set colPings = Nothing
End Function
Function checkServerName(serverIP)
Set objShell = CreateObject("WScript.Shell")
Set objExec = objShell.Exec("ping -n 1 -a " & serverIP)
blank = objExec.StdOut.ReadLine
strPingResults = LCase(objExec.StdOut.ReadLine)
split2 = split(strPingResults)
checkServerName = split2(1)
End Function
沒有留言:
張貼留言