Windows Server 2008のファイルアクセスログをCSVにして保存する

ファイルサーバのファイルアクセスログを取ろうと思いまして、監査ポリシーの[オブジェクトアクセスの監査]を有効にしてみたのは良いものの、ログが大量に記録されてしまうのでDISK容量も食うしバイナリのままだと読みにくいしで、最低限の情報だけCSVファイルにしてためられるようにスクリプトを作ってみました。

WMIでWin32_NTLogEventを参照しているだけなので、クエリの条件を変更すればいろいろなデータを最低限記録しておけると思います。

また、動作には[ローカルコンピュータポリシー]で監査設定を有効にしておく必要があります。

あとはデータベースにでも格納して、適度に検索機能でも付けておけば結構役に立つかなと思います。

実行はコマンドプロンプト上で行います。
セキュリティログを参照する場合には、コンピュータの管理者権限が必要になるので注意してください。

実行形式は以下のような形式になります。

cscript //B "G:\share\Doc\<このファイル>.vbs" <サーバ名>

BATファイル等にまとめてもらえれば、一度に複数のサーバのイベントを取得出来るので監査ログを取得したいサーバが複数あっても楽に取得が可能だと思います。
また、実行結果は以下のようなCSV形式のデータになります。

時間,サーバ名,ファイルパス,処理
2009/07/26 23:38:22,SERV30.pnpk.local,administrator,G:\share\Doc\pnpk.vbs,ReadData (または ListDirectory)

Win32_NTLogEvent関連のWEBサイトを参考にさせていただきました。
改めて感謝いたします。

とりあえず動作するだけ。という形式なので、利用する場合には適当に修正してご利用ください。

''ファイルサーバアクセスログをCSV形式で出力するスクリプト
'実行例
'	cscript //B "hogehoge.vbs" <サーバ名>
'CSVファイルとして保存する場合は以下のような形式で実行します。
'	cscript //B "hogehoge.vbs" <サーバ名> > ファイルサーバログ.vbs

Option Explicit

Const CONVERT_TO_LOCAL_TIME = True

Dim strComputer	'コンピュータ名

'引数が一個の場合はそれをコンピュータ名に指定する。
If WScript.Arguments.Count = 1 Then
	strComputer = WScript.Arguments.Item(0)
Else
	'それ以外の場合にはローカルコンピュータを指定する。
	strComputer = "."
End If

Dim objWMIService
Set objWMIService = GetObject("winmgmts:" & "{(Security)}\\" & strComputer & "\root\cimv2")
Dim dtmStartDate
Dim dtmEndDate
Set dtmStartDate = CreateObject("WbemScripting.SWbemDateTime")
Set dtmEndDate   = CreateObject("WbemScripting.SWbemDateTime") 

Dim DateToCheck
Dim intEndDate

'タスクスケジューラで実行する場合には実行時の誤差を考えて00分から59分59秒前のログまでを取得。
'手っ取り早くログを確認する場合にはnowで取得。
DateToCheck = year(now) & "-" & month(now) & "-" & day(now) & " " & hour(now) & ":00"
'DateToCheck = now

'現在の時間から-3599秒前までのログを参照します。この値を例えば-60にすれば一分間のログを参照します。

intEndDate = -3599

dtmStartDate.SetVarDate  DateAdd("s",intEndDate,DateToCheck), CONVERT_TO_LOCAL_TIME
dtmEndDate.SetVarDate DateToCheck, CONVERT_TO_LOCAL_TIME

Dim strMessage
Dim arrMessage
Dim strMessageLine

Dim colLoggedEvents
Dim objEvent

'Windows Server 2008で動作します。他のバージョンのOSの場合や取得するイベントIDを変更する場合には以下のクエリを変更してください。
Set colLoggedEvents = objWMIService.ExecQuery _
    ("Select * From Win32_NTLogEvent Where (EventCode = 4663 Or EventCode = 4656) And SourceName = 'Microsoft-Windows-Security-Auditing' And TimeWritten >= '" &_
     dtmStartDate & "' and TimeWritten < '" & dtmEndDate & "'") 

Dim i
Dim boolAccess

i = 0

For Each objEvent in colLoggedEvents
	Wscript.Stdout.Write ConvertUTCToDate(objEvent.TimeGenerated) & ","
	Wscript.Stdout.Write objEvent.ComputerName & ","
	
	'オブジェクトへのアクセスが試行されました。
	If objEvent.EventCode = 4663 Then
		Wscript.Stdout.Write "アクセスの試行" & ","
	'オブジェクトに対するハンドルが要求されました。
	ElseIf objEvent.EventCode = 4656 Then
		Wscript.Stdout.Write "ハンドルの要求" & ","
	'それ以外の不明なイベントIDの場合(発生する事は無いけれど)
	Else
		Wscript.Stdout.Write "不明なアクセス" & ","
	End If
	
	'イベント数の合計をカウント
	i = i +1
	
	boolAccess = False
	
    strMessage = Replace(objEvent.Message,vbTab,"")
    arrMessage = Split(strMessage,vbCrlf)

	for each strMessageLine in arrMessage
	    If boolAccess = False Then
	    	If SearchWord(strMessageLine,"アカウント名:") Then
				Wscript.Stdout.Write Replace(strMessageLine,"アカウント名:","") & ","

	    	ElseIf SearchWord(strMessageLine,"オブジェクト名:") Then
				Wscript.Stdout.Write Replace(strMessageLine,"オブジェクト名:","") & ","

	    	ElseIf SearchWord(strMessageLine,"アクセス:") Then
				Wscript.Stdout.Write Replace(strMessageLine,"アクセス:","")
				boolAccess = True
			End If
		ElseIf Not SearchWord(strMessageLine,"アクセス マスク:") Then
			If strMessageLine <> "" Then
				Wscript.Stdout.Write ";" & strMessageLine
			End If
		Else
			Wscript.Stdout.Write vbCrlf
			boolAccess = False
		End If
		
		'取得した文字列を全て表示させる場合には以下のコメントアウトを外して代わりに上のIF文をコメントアウト
		'Wscript.Stdout.WriteLine strMessageLine
	Next
Next

'イベントログをアプリケーションログに書き込み
Call WriteEVENT(0,strComputer & "の" & DateToCheck & "から " & intEndDate & " 秒までのアクセスログは" & i & "件でした。")

'イベントログの書き込み
Sub WriteEVENT(int,strBODY)
	Dim objShell
	Set objShell = Wscript.CreateObject("Wscript.Shell")
	objShell.LogEvent int,strBODY
End Sub

'UTC時間を日付に変換
Function ConvertUTCToDate(STR_DateTime)
	ConvertUTCToDate = CDate(Mid(STR_DateTime, 5, 2) & "/" &_
	Mid(STR_DateTime, 7, 2) & "/" & Left(STR_DateTime, 4) & " " &_
	Mid(STR_DateTime, 9, 2) & ":" &_
	Mid(STR_DateTime, 11, 2) & ":" &_
	Mid(STR_DateTime, 13, 2))
	'+540
	ConvertUTCToDate = DateAdd("h",9,CDATE(ConvertUTCToDate))
End Function

'日付をUTC時間に変換
Function ConvertDateToUTC(datDateTime,intMinuteOffset)
	ConvertDateToUTC = Year(datDateTime) & LeadingZero(Month(datDateTime)) &_
	 LeadingZero(Day(datDateTime))  & LeadingZero(Hour(datDateTime)) &_
	 LeadingZero(Minute(datDateTime)) & LeadingZero(Second(datDateTime))
	ConvertDateToUTC = ConvertDateToUTC & ".000000"
	If intMinuteOffset > 0 Then
		ConvertDateToUTC = ConvertDateToUTC & "+" & intMinuteOffset
	Else
		ConvertDateToUTC = ConvertDateToUTC & intMinuteOffset
	End If
End Function

'数値の整形
Function LeadingZero(intNumber)
	If intNumber < 10 Then
		LeadingZero = "0" & intNumber
	Else
		LeadingZero = intNumber
	End If
End Function

'文字列の検索
Function SearchWord(strSearchObject,strKeyword)
	Dim objRE
	Set objRE = New RegExp
	objRE.Pattern = strKeyword
	objRE.Global = True
	SearchWord = objRE.Test(strSearchObject)
	Set objRE = Nothing
End Function

時間がある時にもう少しのバリエーション追加と、コードを読みやすくいたします。