まだまだ未熟なWSHスクリプトですが、リモートデスクトップ接続元の情報が取れない以外は、まぁまぁのスクリプトかなぁ。

ログオンスクリプトに仕掛けるVBS

strPath = "\network-drivesyslogaccess_log.txt"

Set objShell = CreateObject("WScript.Shell")
strClientPC = objShell.ExpandEnvironmentStrings("%CLIENTNAME%")

Set wshNetwork = WScript.CreateObject("WScript.Network")
strPC = WshNetwork.ComputerName
strUser = wshNetwork.UserName

Set objFS = CreateObject("Scripting.FileSystemObject")
Set objFile = objFS.OpenTextFile(strPath, 8, True)
objFile.WriteLine (Now & ",logon," & strClientPC & "," & strPC & "," & strUser & Chr(13))
objFile.Close

Set objFile = Nothing
Set objFS = Nothing
Set wshNetwork = Nothing

WScript.Networkではなく、WScript.Shellでも、同じ結果になるように、接続元のPC情報が取得できなかった。

Set objWSHShell = CreateObject("WScript.Shell")
 Set objFS = WScript.CreateObject("Scripting.FileSystemObject")
 strNow = Now
 strComputerName = objWSHShell.ExpandEnvironmentStrings("%ComputerName%")
 strClientName = objWSHShell.ExpandEnvironmentStrings("%ClientName%")
 strUserName = objWSHShell.ExpandEnvironmentStrings("%UserName%")
 strDo = "logon"

objWSHShell.Run "cmd /c echo " & strNow & "," & strDo & "," & strComputerName & "," & strUserName & "," & strClientName &   " >> \network-drivesysloglogin.txt", 0, True
' MsgBox strClientName

大半、どこかのソースから頂き、修正している。

'=================================================================
' アクセスログ メール送信スクリプト
'=================================================================

Set oWSHShell = CreateObject("WScript.Shell")
Set oFS = WScript.CreateObject("Scripting.FileSystemObject")
Set oMsg = CreateObject("CDO.Message")

sComputerName = oWSHShell.ExpandEnvironmentStrings("%ComputerName%")
sClientName = oWSHShell.ExpandEnvironmentStrings("%ClientName%")
sUserName = oWSHShell.ExpandEnvironmentStrings("%UserName%")
sDo = "sendmail"
sNow = Now

'■■■ログデータのメール送信
'メール送信元アドレス
oMsg.From = "fileserver@server.local"

'メール送信先アドレス
oMsg.To = "syslog_1@server.xxxx"

'CcとBccが必要な時はコメントを外す
'oMsg.Cc = "cc先メールアドレス"
'oMsg.Bcc = "bcc先メールアドレス"

'メールタイトル
oMsg.Subject = "サーバアクセスログ報告 - " & Now 

'メール本文はnを入れると改行できる。
oMsg.TextBody = "[" & sNow & "] " & sComputerName & ":" & "ログイン情報を報告します。 "

'添付ファイルが必要な時はコメントを外してファイルのフルパスを記入
oMsg.AddAttachment "\network-drivesysloglogin.txt"

'SMTPサーバとサーバポートの指定
oMsg.TextBodyPart.Charset = "ISO-2022-JP"
oMsg.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/" + "sendusing") = 2
oMsg.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/" + "smtpserver") = "mailserver"
oMsg.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/" + "smtpserverport") = 25

'SMTP認証が必要な時はコメントを外しユーザーネームとパスワードを記入
'oMsg.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/" + "smtpauthenticate") = true
'oMsg.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/" + "sendusername") = "ユーザーネーム記入"
'oMsg.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/" + "sendpassword") = "メールパスワード記入"

'SSL送信が必要な時はコメントを外す
'oMsg.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/" + "smtpusessl") = true

oMsg.Configuration.Fields.Update
oMsg.Send

'■■■ログファイルの移動
'oFromに該当ファイルが無い場合にエラーになる。oToに同一ファイル名がある場合にエラーになる。
oFrom = "\network-drivesyslogaccess_log.txt"

oTo = "\network-drivearchiveserverlogon"
oDay = "log_access_" & Year(Now()) & Right("0" & month(now()),2) & Right("0" & day(now()),2) & ".txt"
oTo2 = oTo & oDay

oFS.MoveFile oFrom,oTo2

'■■■データ格納用ログファイルの新規作成
oNew = "\network-drivesyslogaccess_log.txt"
oFS.CreateTextFile oNew

'■■■ログタイトル追加
oWSHShell.Run "cmd /c echo " & "日付" & "," & "処理" & "," & "対象マシン" & "," & "ユーザ名" & "," & "接続元" &   " >> \network-drivesyslogaccess_log.txt", 0, True
'oWSHShell.Run "cmd /c echo " & strNow & "," & strDo & "," & sComputerName & "," & sUserName & "," & sClientName &   " >> \network-drivesyslogaccess_log.txt", 0, True
' MsgBox strClientName

Set oWSHShell = Nothing
Set oFS = Nothing
Set oMes = Nothing
おすすめの記事