知人の会社でＰＣ周辺を保守しているのですが、簡易にＰＣの操作ログが取れないかと思案、、、。外部サービスだとMotexやSkySeaなどありますが小規模事業ではなかなか敷居が高いですからね。.netで簡易にできればラッキーぐらいで考えていたらアクティブウインドウからプロセスIDを取得して操作しているプロセスとウインドウヘッダがとれるようなので、ログ取得～PotgresSQLへデータインサートを行うプログラムを早速作成です。
まず適当なWindowsFormアプリケーションを作成してLabelとButtonを置いて、下記コードを作成します。
※NuGETでNPGSQLを参照しています。
サーバーのIPをC:\Work\Serverip\server-ip.txtに書いて配置しておきます。
Imports Npgsql
Imports System
Imports System.IO
Imports System.Runtime.InteropServices
Imports System.Text
Imports System.Net
Imports System.Diagnostics
Imports System.Diagnostics.Eventing.Reader
Public Class Form1
Public NpgSqlUIDPass As String
Public inTime As String = "60"
Public LastTime As Integer = 22
Public Var As String = "N11.0.0"
Public sComputer_Name As String = StrConv(System.Net.Dns.GetHostName, vbUpperCase)
Public adrList As IPAddress() = Dns.GetHostAddresses(sComputer_Name)
Public sIp As String
Public os As String
Public sLogPath As String = "c:\Pclog\"
Public sIpAddress As String
Public sUserName As String = Environment.UserName
Private previousWindow As IntPtr
Private previousWindowText As String
Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
End
End Sub
Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
Var = "11.0.1"
Dim adrList As IPAddress() = Dns.GetHostAddresses(sComputer_Name)
For Each address As IPAddress In adrList
sIpAddress = address.ToString()
Next
Dim ServerIP As String
Me.Text = "PcMonitor"
'===============================================================================
'PostgreSQLDB接続文字列 (TEXTファイルから接続先を取得する)
Dim cReader As New System.IO.StreamReader("C:\Work\Serverip\server-ip.txt", System.Text.Encoding.Default)
ServerIP = cReader.ReadLine()
cReader.Close()
NpgSqlUIDPass = "Server=" & ServerIP & ";Port=5432;User Id=あなたのユーザー;Password=あなたのパスワード;Database=あなたのDB;TimeOut=600;CommandTimeOut=3600;Pooling=false"
Dim sSql As String
For Each address As IPAddress In adrList
If address.AddressFamily = Net.Sockets.AddressFamily.InterNetwork Then
sIp = address.ToString
End If
Next
Dim moName As String = ""
Dim moVers As String = ""
Dim moRevi As String = ""
Dim mc As New System.Management.ManagementClass("Win32_OperatingSystem")
Dim moc As System.Management.ManagementObjectCollection = mc.GetInstances()
For Each mo As System.Management.ManagementObject In moc
moName = mo("Caption").ToString
moVers = mo("Version").ToString
moRevi = mo("BuildNumber").ToString
Next
os = moName.ToString & " Ver " & moVers
Try
'========================================
'NpgSQL-PostgreSqlデータベース接続
Dim PostgreCmd = New NpgsqlCommand
Dim PostgreReader As Object
Dim cPostgreSql As NpgsqlConnection = New NpgsqlConnection(NpgSqlUIDPass)
cPostgreSql.Open()
sSql = "delete from ms_pc where pc_name='" & sComputer_Name & "'"
PostgreCmd = New NpgsqlCommand(sSql, cPostgreSql)
PostgreCmd.ExecuteNonQuery()
sSql = "insert into ms_pc values('" & sComputer_Name & "','" & sIp & "','" & Date.Now & "')"
PostgreCmd = New NpgsqlCommand(sSql, cPostgreSql)
PostgreCmd.ExecuteNonQuery()
sSql = "select status from ms_status where status_no='00006'"
PostgreCmd = New NpgsqlCommand(sSql, cPostgreSql)
PostgreReader = PostgreCmd.ExecuteReader
PostgreReader.read()
LastTime = CInt(PostgreReader(0))
PostgreReader.close()
cPostgreSql.Close()
'========================================
'Me.Text = "最終" & LastTime & "迄使用可"
Catch ex As Exception
'オフラインの場合はPCの時間を見て対応
LastTime = 22
'Me.Text = "最終" & LastTime & "迄使用可"
End Try
Call FileLogMain()
'Call ActiveWindowMain()
Dim logger As New USBLogger()
logger.StartLogging()
Label1.Text = inTime
Timer1.Interval = 1000
Timer1.Start()
Timer2.Interval = 100
Timer2.Start()
End Sub
Private Sub Timer1_Tick(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Timer1.Tick
If Label1.Text = inTime Then
Me.Hide()
End If
Dim sSql As String
If CInt(Label1.Text) = 0 Then
Timer1.Stop()
'ここにソース
'=================================
'ディフェンダーイベントログの取得
'=================================
Dim eventString As String = ""
Dim eventString2 As String = ""
Dim eventLogName As String = "Microsoft-Windows-Windows Defender/Operational"
' 指定した日付範囲
Dim startDate As New DateTime(Date.Today.Year, Date.Today.Month, Date.Today.Day)
Dim endDate As New DateTime(Date.Today.Year, Date.Today.Month, Date.Today.Day + 1)
' イベントログを開く
Dim iEventLog As New EventLog(eventLogName)
Using eventLogReader As New EventLogReader(New EventLogQuery(eventLogName, PathType.LogName))
Dim eventRecord As EventRecord = eventLogReader.ReadEvent()
' 指定した日付範囲内のイベントログエントリを取得
While eventRecord IsNot Nothing
If eventRecord.TimeCreated >= startDate AndAlso eventRecord.TimeCreated <= endDate Then
eventString = ""
Select Case eventRecord.Id
Case 1000
eventString = eventRecord.TimeCreated.ToString() & "," & "ディフェンダー稼働ログ,ウイルス・マルウェア対策,スキャンの開始"
Case 1001
eventString = eventRecord.TimeCreated.ToString() & "," & "ディフェンダー稼働ログ,ウイルス・マルウェア対策,スキャンの終了"
Case 1002
eventString = eventRecord.TimeCreated.ToString() & "," & "ディフェンダー稼働ログ,ウイルス・マルウェア対策,スキャンのキャンセル"
Case 1003
eventString = eventRecord.TimeCreated.ToString() & "," & "ディフェンダー稼働ログ,ウイルス・マルウェア対策,スキャンの一時停止"
Case 1004
eventString = eventRecord.TimeCreated.ToString() & "," & "ディフェンダー稼働ログ,ウイルス・マルウェア対策,スキャンの再開"
Case 1005
eventString = eventRecord.TimeCreated.ToString() & "," & "ディフェンダー稼働ログ,ウイルス・マルウェア対策,スキャンの失敗"
Case 1006
eventString = eventRecord.TimeCreated.ToString() & "," & "ディフェンダー稼働ログ,ウイルス・マルウェア対策,望ましくないアプリを検出"
Case 1007
eventString = eventRecord.TimeCreated.ToString() & "," & "ディフェンダー稼働ログ,ウイルス・マルウェア対策,望ましくないアプリの保護実施"
Case 1008
eventString = eventRecord.TimeCreated.ToString() & "," & "ディフェンダー稼働ログ,ウイルス・マルウェア対策,望ましくないアプリの保護失敗"
Case 1015
eventString = eventRecord.TimeCreated.ToString() & "," & "ディフェンダー稼働ログ,ウイルス・マルウェア対策,疑わしい動作を検出"
Case 1016
eventString = eventRecord.TimeCreated.ToString() & "," & "ディフェンダー稼働ログ,ウイルス・マルウェア対策,疑わしいアプリを検出"
Case 1017
eventString = eventRecord.TimeCreated.ToString() & "," & "ディフェンダー稼働ログ,ウイルス・マルウェア対策,疑わしいアプリの対策実施"
Case 1018
eventString = eventRecord.TimeCreated.ToString() & "," & "ディフェンダー稼働ログ,ウイルス・マルウェア対策,疑わしいアプリの対策失敗"
Case 1019
eventString = eventRecord.TimeCreated.ToString() & "," & "ディフェンダー稼働ログ,ウイルス・マルウェア対策,疑わしいアプリの対策失敗"
Case 1020, 1150
eventString = eventRecord.TimeCreated.ToString() & "," & "ディフェンダー稼働ログ,ウイルス・マルウェア対策,正常に稼働しています"
Case 2000
eventString = eventRecord.TimeCreated.ToString() & "," & "ディフェンダー稼働ログ,ウイルス・マルウェア対策,定義が正常に更新されました"
Case 2002
eventString = eventRecord.TimeCreated.ToString() & "," & "ディフェンダー稼働ログ,ウイルス・マルウェア対策,ウイルス・マルウェアエンジンが正常に更新されました"
Case 2003
eventString = eventRecord.TimeCreated.ToString() & "," & "ディフェンダー稼働ログ,ウイルス・マルウェア対策,ウイルス・マルウェアエンジンの更新に失敗しました"
Case 2003
eventString = eventRecord.TimeCreated.ToString() & "," & "ディフェンダー稼働ログ,ウイルス・マルウェア対策,リアルタイム保護でエラーが発生しました"
Case 5000
eventString = eventRecord.TimeCreated.ToString() & "," & "ディフェンダー稼働ログ,ウイルス・マルウェア対策,リアルタイム保護が有効です"
Case 5001
eventString = eventRecord.TimeCreated.ToString() & "," & "ディフェンダー稼働ログ,ウイルス・マルウェア対策,リアルタイム保護が無効です"
Case 5009
eventString = eventRecord.TimeCreated.ToString() & "," & "ディフェンダー稼働ログ,ウイルス・マルウェア対策,望ましくないアプリの検出が有効です"
Case 5010
eventString = eventRecord.TimeCreated.ToString() & "," & "ディフェンダー稼働ログ,ウイルス・マルウェア対策,望ましくないアプリの検出が無効です"
Case 5011
eventString = eventRecord.TimeCreated.ToString() & "," & "ディフェンダー稼働ログ,ウイルス・マルウェア対策,ウイルススキャンが有効です"
Case 5010
eventString = eventRecord.TimeCreated.ToString() & "," & "ディフェンダー稼働ログ,ウイルス・マルウェア対策,ウイルススキャンが無効です"
End Select
If eventString <> "" Then
If eventString <> eventString2 Then
AppendToLog(eventString)
eventString2 = eventString
End If
End If
End If
eventRecord = eventLogReader.ReadEvent()
End While
End Using
Dim PostgreCmd = New NpgsqlCommand
Dim PostgreReader As Object
Try
'========================================
'NpgSQL-PostgreSqlデータベース接続
Dim cPostgreSql As NpgsqlConnection = New NpgsqlConnection(NpgSqlUIDPass)
cPostgreSql.Open()
'ステータスを確認して最新バージョンを確認
sSql = "select status from ms_status where status_no='00003' and status='" & Var & "'"
PostgreCmd = New NpgsqlCommand(sSql, cPostgreSql)
PostgreReader = PostgreCmd.ExecuteReader
If PostgreReader.hasrows = False Then
'ステータスが存在しなかったらリリースバッチ起動
System.Diagnostics.Process.Start("C:\WORK\bat\stcreate_real2.bat")
End
End If
PostgreReader.close()
sSql = "delete from ms_pc where pc_name='" & sComputer_Name & "';"
sSql &= " insert into ms_pc values('" & sComputer_Name & "','" & sIp & "','" & Date.Now & "','" & os & "');"
PostgreCmd = New NpgsqlCommand(sSql, cPostgreSql)
PostgreCmd.ExecuteNonQuery()
Select Case sComputer_Name
Case "114LC", "013LC", "201LC", "001LC", "211LC", "212LC", "STFILESERVER", "STASV01", "STESV01", "STESV02", "SOFTETHERSV"
GoTo 終了飛ばし
Case Else
GoTo 終了飛ばし
End Select
'=====================================================================
'ステータスを確認して最終時間を確認
sSql = "select status from ms_status where status_no='00007'"
PostgreCmd = New NpgsqlCommand(sSql, cPostgreSql)
PostgreReader = PostgreCmd.ExecuteReader
PostgreReader.read()
'ステータスが１の場合は定期シャットダウン運用中
If Trim(PostgreReader(0)) = "1" Then
PostgreReader.close()
'ステータスを確認して最終時間を確認
sSql = "select status from ms_status where status_no='00006'"
PostgreCmd = New NpgsqlCommand(sSql, cPostgreSql)
PostgreReader = PostgreCmd.ExecuteReader
PostgreReader.read()
LastTime = CInt(PostgreReader(0))
PostgreReader.close()
Me.Text = "最終" & LastTime & "迄使用可"
sSql = "select current_timestamp"
PostgreCmd = New NpgsqlCommand(sSql, cPostgreSql)
PostgreReader = PostgreCmd.ExecuteReader
PostgreReader.read()
If CDate(PostgreReader(0)).Hour >= LastTime Then
'業務時間超の場合
'業務時間外申請のチェック
sSql = "select * from d_pckyoka where ymd='" & CDate(PostgreReader(0)).ToString("yyyy/MM/dd") & "' and shinsei_pc='" & sComputer_Name & "' and kyoka='1'"
PostgreReader.close()
PostgreCmd = New NpgsqlCommand(sSql, cPostgreSql)
PostgreReader = PostgreCmd.ExecuteReader
If PostgreReader.hasrows = False Then
PostgreReader.close()
'ない場合
'sSql = "insert into ms_log values('" & Date.Now & "','" & sComputer_Name & "','自動実行','時間外シャットダウン','R" & Var & "','');"
'PostgreCmd = New NpgsqlCommand(sSql, cPostgreSql)
'PostgreCmd.ExecuteNonQuery()
'System.Diagnostics.Process.Start("C:\WORK\bat\ProcShutdown.bat")
'End
Else
PostgreReader.close()
End If
Else
PostgreReader.close()
End If
Else
PostgreReader.close()
End If
終了飛ばし:
'=============================
'ログテキストをDBにインサート
Dim lines As String()
Using sr As New StreamReader(sLogPath & Date.Today.ToString("yyyyMMdd") & ".log")
lines = sr.ReadToEnd().Split(Environment.NewLine)
End Using
Dim i As Integer
' SQL文の生成
For i = 0 To lines.Length - 1 ' ヘッダ行を除く
Dim values As String() = lines(i).Split(","c)
If values(2).Trim() = "ファイル更新" Then
sSql = "select * from"
sSql = sSql & vbLf & " ms_nlog"
sSql = sSql & vbLf & "where log_ymd = '" & values(0).Trim() & "'"
sSql = sSql & vbLf & "and log_kbn = '" & values(1).Trim() & "'"
sSql = sSql & vbLf & "and log_operation = 'ファイル作成'"
sSql = sSql & vbLf & "and log_substance = '" & values(3).Trim() & "'"
sSql = sSql & vbLf & "and log_tm = '" & sComputer_Name & "'"
sSql = sSql & vbLf & "and log_user = '" & sUserName & "'"
sSql = sSql & vbLf & "and ipaddress = '" & sIpAddress & "'"
sSql = sSql & vbLf & "and prg_ver = '" & Var & "'"
PostgreCmd = New NpgsqlCommand(sSql, cPostgreSql)
PostgreReader = PostgreCmd.ExecuteReader
PostgreReader.read()
If Not PostgreReader.hasrows Then
PostgreReader.close
sSql = "insert into ms_nlog"
sSql = sSql & vbLf & "("
sSql = sSql & vbLf & " log_ymd,"
sSql = sSql & vbLf & " log_kbn,"
sSql = sSql & vbLf & " log_operation,"
sSql = sSql & vbLf & " log_substance,"
sSql = sSql & vbLf & " log_tm,"
sSql = sSql & vbLf & " log_user,"
sSql = sSql & vbLf & " ipaddress,"
sSql = sSql & vbLf & " prg_ver"
sSql = sSql & vbLf & " )"
sSql = sSql & vbLf & " values"
sSql = sSql & vbLf & "("
sSql = sSql & vbLf & "'" & values(0).Trim() & "',"
sSql = sSql & vbLf & "'" & values(1).Trim() & "',"
sSql = sSql & vbLf & "'" & values(2).Trim() & "',"
sSql = sSql & vbLf & "'" & values(3).Trim() & "',"
sSql = sSql & vbLf & "'" & sComputer_Name & "',"
sSql = sSql & vbLf & "'" & sUserName & "',"
sSql = sSql & vbLf & "'" & sIpAddress & "',"
sSql = sSql & vbLf & "'" & Var & "'"
sSql = sSql & vbLf & " )"
sSql = sSql & vbLf & "On CONFLICT ON CONSTRAINT ms_nlog_pkey"
sSql = sSql & vbLf & "Do Nothing"
Try
PostgreCmd = New NpgsqlCommand(sSql, cPostgreSql)
PostgreCmd.ExecuteNonQuery()
Catch ex1 As Exception
End Try
Else
PostgreReader.close
End If
Else
sSql = "insert into ms_nlog"
sSql = sSql & vbLf & "("
sSql = sSql & vbLf & " log_ymd,"
sSql = sSql & vbLf & " log_kbn,"
sSql = sSql & vbLf & " log_operation,"
sSql = sSql & vbLf & " log_substance,"
sSql = sSql & vbLf & " log_tm,"
sSql = sSql & vbLf & " log_user,"
sSql = sSql & vbLf & " ipaddress,"
sSql = sSql & vbLf & " prg_ver"
sSql = sSql & vbLf & " )"
sSql = sSql & vbLf & " values"
sSql = sSql & vbLf & "("
sSql = sSql & vbLf & "'" & values(0).Trim() & "',"
sSql = sSql & vbLf & "'" & values(1).Trim() & "',"
sSql = sSql & vbLf & "'" & values(2).Trim() & "',"
sSql = sSql & vbLf & "'" & values(3).Trim() & "',"
sSql = sSql & vbLf & "'" & sComputer_Name & "',"
sSql = sSql & vbLf & "'" & sUserName & "',"
sSql = sSql & vbLf & "'" & sIpAddress & "',"
sSql = sSql & vbLf & "'" & Var & "'"
sSql = sSql & vbLf & " )"
sSql = sSql & vbLf & "On CONFLICT ON CONSTRAINT ms_nlog_pkey"
sSql = sSql & vbLf & "Do Nothing"
Try
PostgreCmd = New NpgsqlCommand(sSql, cPostgreSql)
PostgreCmd.ExecuteNonQuery()
Catch ex1 As Exception
End Try
End If
Next
Catch ex As Exception
'オフラインの場合はPCの時間を見て対応
Select Case sComputer_Name
Case "114LC", "013LC", "201LC", "001LC", "211LC", "212LC", "STFILESERVER", "STASV01", "STESV01", "STESV02", "SOFTETHERSV"
GoTo NextStep
Case Else
GoTo NextStep
If Now.Hour >= LastTime Then
'System.Diagnostics.Process.Start("C:\WORK\bat\ProcShutdown.bat")
End
End If
End Select
End Try
NextStep:
Label1.Text = inTime
Timer1.Start()
Else
Label1.Text = CInt(Label1.Text) - 1
End If
End Sub
Private Sub Timer2_Tick(sender As Object, e As EventArgs) Handles Timer1.Tick
' 現在のアクティブウィンドウを取得
Dim CurrentWindow As IntPtr = GetForegroundWindow()
Dim processId As Integer
GetWindowThreadProcessId(CurrentWindow, processId)
Dim processFilePath As String = GetProcessFilePath(processId)
Dim ProcessName As String = Path.GetFileName(processFilePath)
Dim process As Process = Process.GetProcessById(processId)
' アクティブウィンドウが変更された場合、ログに追記
If CurrentWindow <> previousWindow Or process.MainWindowTitle <> previousWindowText Then
Dim sb As New StringBuilder(256)
GetWindowText(CurrentWindow, sb, sb.Capacity)
Dim activeWindow As String = sb.ToString().Trim()
If Not String.IsNullOrEmpty(activeWindow) Then
'Dim logMessage As String = $"{DateTime.Now},ウインドウ操作ログ," & ProcessName & "," & $"{activeWindow}"
Dim logMessage As String = $"{DateTime.Now},ウインドウ操作ログ," & ProcessName & "," & process.MainWindowTitle
AppendToLog(logMessage)
End If
' アクティブウィンドウの更新
previousWindow = CurrentWindow
previousWindowText = process.MainWindowTitle
End If
End Sub
Private Sub AppendToLog(logMessage As String)
Dim inCount As Integer = 1
再実行:
' ログファイルにメッセージを追記
Try
Using writer As StreamWriter = File.AppendText(sLogPath & Date.Today.ToString("yyyyMMdd") & ".log")
writer.WriteLine(logMessage)
End Using
Catch ex As Exception
Wait(100)
inCount = inCount + 1
If inCount = 10 Then
GoTo EndStep
End If
GoTo 再実行
End Try
EndStep:
End Sub
Public Function GetProcessFilePath(ByVal processId As Integer) As String
Dim processHandle As IntPtr = OpenProcess(&H400 Or &H10, False, processId)
Dim sb As New StringBuilder(1024)
GetModuleFileNameEx(processHandle, IntPtr.Zero, sb, sb.Capacity)
Return sb.ToString()
End Function
Public Sub LogWebAccess(url As String)
Dim logMessage As String = String.Format("[{0}] Web Access: {1}", DateTime.Now.ToString(), url)
End Sub
Public Function GetEdgeBrowserHistory() As List(Of String)
Dim historyFilePath As String = Path.Combine(Environment.GetFolderPath(Environment.SpecialFolder.LocalApplicationData), "Microsoft", "Edge", "User Data", "個人", "History")
Dim historyItems As New List(Of String)()
' Historyファイルが存在するかチェックします
If File.Exists(historyFilePath) Then
' Historyファイルを開きます
Using stream As FileStream = File.Open(historyFilePath, FileMode.Open, FileAccess.Read, FileShare.ReadWrite)
' ファイルストリームを使用してバイナリリーダーを作成します
Using reader As New BinaryReader(stream)
' ヘッダー情報を読み飛ばします
reader.ReadBytes(16)
' レコード数を読み取ります
Dim recordCountBytes As Byte() = reader.ReadBytes(4)
Dim recordCount As Integer = BitConverter.ToInt32(recordCountBytes, 0)
' 各レコードを読み取ります
For i As Integer = 0 To recordCount - 1
' URLの長さを読み取ります
Try
Dim urlLengthBytes As Byte() = reader.ReadBytes(4)
Dim urlLength As Integer = BitConverter.ToInt32(urlLengthBytes, 0)
' URLを読み取ります
Dim urlBytes As Byte() = reader.ReadBytes(urlLength)
Dim url As String = System.Text.Encoding.UTF8.GetString(urlBytes)
' 閲覧履歴に追加します
historyItems.Add(url)
Catch ex As Exception
End Try
Next
End Using
End Using
End If
Return historyItems
End Function
End Class
続いてModuleを追加して、下記コードを作成します。
Imports System.IO
Imports System.Environment
Imports System.Management
Imports System.Threading
Imports System.Runtime.InteropServices
Imports System.Text
Imports System.Security.Principal
Imports System.Net
Module Module1
Public sCreateAftopen_Kb As Integer = 0
Public watcher As FileSystemWatcher
Public sLogPath As String = "c:\Pclog\"
Public logonUser = Environment.UserName
<DllImport("user32.dll", CharSet:=CharSet.Auto, SetLastError:=True)>
Public Function GetForegroundWindow() As IntPtr
End Function
<DllImport("user32.dll", CharSet:=CharSet.Auto, SetLastError:=True)>
Public Function GetWindowText(ByVal hWnd As IntPtr, ByVal lpString As StringBuilder, ByVal nMaxCount As Integer) As Integer
End Function
<DllImport("user32.dll", CharSet:=CharSet.Auto, SetLastError:=True)>
Public Function GetWindowThreadProcessId(ByVal hWnd As IntPtr, ByRef lpdwProcessId As Integer) As Integer
End Function
<DllImport("kernel32.dll", CharSet:=CharSet.Auto, SetLastError:=True)>
Public Function OpenProcess(ByVal dwDesiredAccess As Integer, ByVal bInheritHandle As Boolean, ByVal dwProcessId As Integer) As IntPtr
End Function
<DllImport("psapi.dll", CharSet:=CharSet.Auto, SetLastError:=True)>
Public Function GetModuleFileNameEx(ByVal hProcess As IntPtr, ByVal hModule As IntPtr, ByVal lpFilename As StringBuilder, ByVal nSize As Integer) As Integer
End Function
Function GetActiveWindowTitle() As String
Dim activeWindowHandle As IntPtr = GetForegroundWindow()
Dim titleBuilder As New StringBuilder(256)
Dim titleLength As Integer = GetWindowText(activeWindowHandle, titleBuilder, titleBuilder.Capacity)
If titleLength > 0 Then
Return titleBuilder.ToString()
Else
Return String.Empty
End If
End Function
Sub FileLogMain()
' FileSystemWatcherのインスタンスを作成
Dim userProfileDirectory As String = GetFolderPath(SpecialFolder.UserProfile)
Dim targetDirectories As String() = {userProfileDirectory}
'Dim targetDirectories As String() = {userProfileDirectory & "\desktop\", userProfileDirectory & "\Documents\"}
Dim watchers As New List(Of FileSystemWatcher)()
For Each directory As String In targetDirectories
' FileSystemWatcherのインスタンスを作成
watcher = New FileSystemWatcher()
' サブディレクトリも監視するように設定
watcher.IncludeSubdirectories = True
' 監視するディレクトリを指定
watcher.Path = directory
' 監視するイベントを指定
watcher.NotifyFilter = NotifyFilters.FileName Or
NotifyFilters.LastAccess Or
NotifyFilters.LastWrite
'NotifyFilters.DirectoryName Or
'watcher.NotifyFilter = NotifyFilters.LastAccess
' イベントハンドラを設定
AddHandler watcher.Created, AddressOf OnFileAccess
AddHandler watcher.Deleted, AddressOf OnFileAccess
AddHandler watcher.Changed, AddressOf OnFileAccess
AddHandler watcher.Renamed, AddressOf OnFileRenamed
' ファイルの変更監視を開始
watcher.EnableRaisingEvents = True
' FileSystemWatcherをリストに追加
watchers.Add(watcher)
Next
End Sub
Private Sub OnFileAccess(sender As Object, e As FileSystemEventArgs)
' ファイルアクセスのログを書き込む
Dim logMessage As String
Select Case e.ChangeType.ToString()
Case "Opened"
logMessage = $"ファイル閲覧,{e.FullPath}"
sCreateAftopen_Kb = 0
Case "Created"
logMessage = $"ファイル作成,{e.FullPath}"
sCreateAftopen_Kb = 1
Case "Changed"
logMessage = $"ファイル更新,{e.FullPath}"
sCreateAftopen_Kb = 0
Case "Deleted"
logMessage = $"ファイル削除,{e.FullPath}"
sCreateAftopen_Kb = 0
Case Else
logMessage = $"その他ファイル操作,{e.FullPath}"
sCreateAftopen_Kb = 0
End Select
If 文字列無視(logMessage) = True Then
Try
If File.GetAccessControl(e.FullPath).GetOwner(GetType(SecurityIdentifier)).ToString() = logonUser Then
End If
Select Case e.Name.ToUpper
Case "DOWNLOADS", "PICTURES", "DESKTOP", "DROPBOX", "DOCUMENTS", "SOURCE", "ONEDRIVE", "APPDATA"
Case Else
If e.ChangeType.ToString.ToUpper = "CREATED" Then
sCreateAftopen_Kb = 1
Else
sCreateAftopen_Kb = 0
End If
If e.ChangeType.ToString.ToUpper = "Opened" Then
If sCreateAftopen_Kb <> 1 Then
WriteLog(logMessage)
sCreateAftopen_Kb = 0
End If
Else
WriteLog(logMessage)
End If
End Select
Catch ex As Exception
End Try
End If
End Sub
Private Sub OnFileChanged(sender As Object, e As RenamedEventArgs)
' ファイル名変更のログを書き込む
Dim logMessage As String = $"ファイル閲覧,{e.FullPath}"
If 文字列無視(logMessage) = True Then
Try
'If File.GetAccessControl(e.FullPath).GetOwner(GetType(SecurityIdentifier)).ToString() = logonUser Then
'End If
Select Case e.Name.ToUpper
Case "DOWNLOADS", "PICTURES", "DESKTOP", "DROPBOX", "DOCUMENTS", "SOURCE", "ONEDRIVE", "APPDATA"
Case Else
If sCreateAftopen_Kb <> 1 Then
WriteLog(logMessage)
Else
sCreateAftopen_Kb = 0
End If
End Select
Catch ex As Exception
End Try
End If
End Sub
Private Sub OnFileRenamed(sender As Object, e As RenamedEventArgs)
' ファイル名変更のログを書き込む
Dim logMessage As String = $"ファイル名変更,{e.OldFullPath} -> {e.FullPath}"
If e.Name = Nothing Then
If 文字列無視(logMessage) = True Then
Try
'If File.GetAccessControl(e.FullPath).GetOwner(GetType(SecurityIdentifier)).ToString() = logonUser Then
'End If
WriteLog(logMessage)
Catch ex As Exception
End Try
End If
Else
If 文字列無視(logMessage) = True Then
Try
'If File.GetAccessControl(e.FullPath).GetOwner(GetType(SecurityIdentifier)).ToString() = logonUser Then
'End If
Select Case e.Name.ToUpper
Case "DOWNLOADS", "PICTURES", "DESKTOP", "DROPBOX", "DOCUMENTS", "SOURCE", "ONEDRIVE", "APPDATA"
Case Else
WriteLog(logMessage)
End Select
Catch ex As Exception
End Try
End If
End If
End Sub
Private Sub WriteLog(message As String)
' ログファイルにメッセージを追記
Dim inCount As Integer = 1
再実行:
Try
Using writer As New StreamWriter(sLogPath & Date.Today.ToString("yyyyMMdd") & ".log", True)
If 文字列無視($"{message}") = True Then
writer.WriteLine($"{DateTime.Now.ToString()}" & ",ファイル操作ログ," & $"{message}")
End If
End Using
Catch ex As Exception
Wait(100)
inCount = inCount + 1
If inCount = 10 Then
GoTo EndStep
End If
GoTo 再実行
End Try
EndStep:
End Sub
Private Function 文字列無視(sString As String) As Boolean
文字列無視 = False
If sString.ToUpper.Contains("\APPDATA\") = True Then
ElseIf sString.ToUpper.Contains(".TEMP") = True Then
ElseIf sString.ToUpper.Contains(".LNK") = True Then
ElseIf sString.ToUpper.Contains(".INI") = True Then
ElseIf sString.ToUpper.Contains(".DLL") = True Then
ElseIf sString.ToUpper.Contains(".DROPBOX") = True Then
ElseIf sString.ToUpper.Contains(".PST") = True Then
ElseIf sString.ToUpper.Contains(".TMP") = True Then
ElseIf sString.ToUpper.Contains(".NUGET") = True Then
ElseIf sString.ToUpper.Contains("~$") = True Then
ElseIf sString.ToUpper.Contains(".LOG") = True Then
ElseIf sString.ToUpper.Contains(".") = False Then
Else
文字列無視 = True
End If
End Function
Public Sub Wait(milliseconds As Integer)
Thread.Sleep(milliseconds)
End Sub
Public Class USBLogger
Public sLogPath As String = "c:\Pclog\"
Public WithEvents watcher As ManagementEventWatcher
Public Sub StartLogging()
Dim query As New WqlEventQuery("SELECT * FROM Win32_VolumeChangeEvent WHERE EventType = 2 or EventType = 3")
watcher = New ManagementEventWatcher(query)
watcher.Start()
End Sub
Public Sub StopLogging()
If watcher IsNot Nothing Then
watcher.Stop()
watcher.Dispose()
End If
End Sub
Public Sub HandleEvent(ByVal sender As Object, ByVal e As EventArrivedEventArgs) Handles watcher.EventArrived
Dim eventType As UInteger = CType(e.NewEvent("EventType"), UInteger)
Dim driveName As String = CType(e.NewEvent("DriveName"), String)
Select Case eventType
Case 2
' USBデバイスが接続された
Using writer As New StreamWriter(sLogPath & Date.Today.ToString("yyyyMMdd") & ".log", True)
writer.WriteLine($"{DateTime.Now.ToString()}" & ",外部ディバイス接続ログ," & "ドライブ接続,” & driveName)
End Using
Case 3
' USBデバイスが切断された
Using writer As New StreamWriter(sLogPath & Date.Today.ToString("yyyyMMdd") & ".log", True)
writer.WriteLine($"{DateTime.Now.ToString()}" & ",外部ディバイス接続ログ," & "ドライブ切断,” & driveName)
End Using
End Select
End Sub
Public Function GetProcessFilePath(ByVal processId As Integer) As String
Dim processHandle As IntPtr = OpenProcess(&H400 Or &H10, False, processId)
Dim sb As New StringBuilder(1024)
GetModuleFileNameEx(processHandle, IntPtr.Zero, sb, sb.Capacity)
Return sb.ToString()
End Function
End Class
Public Class MainClass
Sub UsbMain()
Dim logger As New USBLogger()
logger.StartLogging()
' ログを取得する間、アプリケーションが実行され続けます
Console.WriteLine("USBメモリの接続/切断のログを取得中...")
Console.ReadLine()
logger.StopLogging()
End Sub
End Class
End Module
これでコンパイルして実行すれば、ログインしているユーザー配下のファイル操作・アクティブウインドウのログとプロセス・USBデバイスの接続・MSDefenderの動作ログが c:\Pclog\ 配下に日別CSVファイルを作成され、PostgreSQLのテーブルに１分毎に書き込むようになります（それ以外も書いてありますが・・・汗）。
つたないネット上コードの切り貼りですが、ちゃんと動きましたので良しとしています。