' ' 初期設定 ' Const LOG_ROW = 16 ' ログファイル名が書かれたセルの行数 Const LOG_COLUMN = 3 ' ログファイル名が書かれたセルの桁数 Const INTERVAL_ROW = 30 ' 監視間隔が書かれたセルの行数 Const INTERVAL_COLUMN = 3 ' 監視間隔が書かれたセルの桁数 Const DEFAULT_INTERVAL_MIN = 5 ' 監視間隔に記入がなかった場合のデフォルト値(分) Dim Table As Variant ' プロセス名を記憶するハッシュテーブル Private Sub Worksheet_Activate() ' ' 使用方法タブが初めて Active になった時のみ初期化を行う ' Static InitFlag As Boolean If InitFlag <> True Then InitFlag = True ToggleButton1.Value = False ToggleButton1.Caption = "監視開始" End If End Sub Private Sub CommandButton1_Click() Call データ読込 End Sub Private Sub ToggleButton1_Click() If ToggleButton1.Value = True Then ToggleButton1.Caption = "監視停止" Call 監視開始 Else ToggleButton1.Caption = "監視開始" End If End Sub Private Sub CommandButton2_Click() Call クリア End Sub Private Sub 監視開始() Dim TimeString As String ' ' マクロ動作の隠蔽 ' Application.ScreenUpdating = False ' ' この book ' With Workbooks(ThisWorkbook.Name) ' ' 監視間隔値の取得 ' Interval_min = .Sheets("使用方法").Cells(INTERVAL_ROW, INTERVAL_COLUMN) If Interval_min <= 0 Or 60 <= Interval_min Then Interval_min = DEFAULT_INTERVAL_MIN End If TimeString = "00:" & Right$("00" & Mid$(Str(Interval_min), 2, Len(Str(Interval_min)) - 1), 2) & ":00" ' ' 次の監視をスケジュール ' StartTime = Now() + TimeValue(TimeString) Application.OnTime StartTime, "Sheet1.監視開始" ' ' 監視実行 ' If .Sheets("使用方法").ToggleButton1.Value = True Then Call データ読込 End If End With End Sub Private Sub データ読込() Dim intRow As Integer ' 行数 Dim intFileNo As Integer ' ファイル番号 Dim buff As String ' 読み込みバッファ Dim noSpace As String ' 読み込みバッファの連続する空白を省いたもの Dim Flag As Boolean ' 既に日付がある行は True としてスキップ Dim Period As String ' Windows 起動からの Total 時間 Dim UserTime As String ' User Time Dim KernelTime As String ' Kernel Time Dim Faults As Long ' Faults数 Dim Commit As Long ' Commit数 Dim Hnd As Long ' ハンドル数 Dim process As String ' プロセス名 Dim strArray() As String ' 空白区切りで配列にしたもの With Workbooks(ThisWorkbook.Name) ' ' 初期化 ' If IsObject(Table) = False Then Set Table = CreateObject("Scripting.Dictionary") For p = 2 To .Sheets("Hnd").Cells.SpecialCells(xlLastCell).Column process = .Sheets("Hnd").Cells(1, p) Table.Add process, p Next p End If Flag = False intRow = 1 intFileNo = FreeFile Filename = .Sheets("使用方法").Cells(LOG_ROW, LOG_COLUMN) Open Filename For Input Access Read As intFileNo Do Until EOF(intFileNo) ' ' 1行読み込み ' Line Input #intFileNo, buff ' ' 先頭行の最後に Windows 起動からの Total 時間が記されている ' If Left$(buff, 13) = "Pstat version" Then intRow = intRow + 1 ' ' 連続した空白をカット ' noSpace = "" strText = Trim(buff) For i = 1 To Len(strText) If Mid$(strText, i, 2) <> " " Then noSpace = noSpace & Mid$(strText, i, 1) End If Next ' ' 空白区切りで配列に展開 ' strArray = Split(noSpace, " ") Period = strArray(7) & " " & strArray(8) If .Sheets("Hnd").Cells(intRow, 1) = Period Then Flag = True Else Flag = False .Sheets("UserTime").Cells(intRow, 1) = Period .Sheets("KernelTime").Cells(intRow, 1) = Period .Sheets("Faults").Cells(intRow, 1) = Period .Sheets("Commit").Cells(intRow, 1) = Period .Sheets("Hnd").Cells(intRow, 1) = Period End If ' ' 4文字目が : でない行は読み飛ばす ' ElseIf Mid$(buff, 4, 1) <> ":" Or Mid$(buff, 7, 1) <> ":" Then ' ' そうでない場合は空白区切りで pid, ppid, CPU, メモリ, プロセス名 を取り出す ' ElseIf Flag = False Then ' ' 連続した空白をカット ' noSpace = "" strText = Trim(Mid$(buff, 28)) For i = 1 To Len(strText) If Mid$(strText, i, 2) <> " " Then noSpace = noSpace & Mid$(strText, i, 1) End If Next ' ' 空白区切りで配列に展開 ' strArray = Split(noSpace, " ") ' UserTime KernelTime Ws Faults Commit Pri Hnd Thd Pid Name UserTime = Trim(Mid$(buff, 1, 13)) KernelTime = Trim(Mid$(buff, 14, 14)) Faults = strArray(1) Commit = strArray(2) Hnd = strArray(4) process = strArray(7) ' ' プロセス名が合致するかを検索 ' If Table.Exists(process) Then p = Table.Item(process) Else p = Table.Count + 2 Table.Add process, p .Sheets("UserTime").Cells(1, p) = process .Sheets("KernelTime").Cells(1, p) = process .Sheets("Faults").Cells(1, p) = process .Sheets("Commit").Cells(1, p) = process .Sheets("Hnd").Cells(1, p) = process End If worktime = .Sheets("UserTime").Cells(intRow, p) .Sheets("UserTime").Cells(intRow, p) = UserTime .Sheets("UserTime").Cells(intRow, p) = .Sheets("UserTime").Cells(intRow, p) + worktime worktime = .Sheets("KernelTime").Cells(intRow, p) .Sheets("KernelTime").Cells(intRow, p) = KernelTime .Sheets("KernelTime").Cells(intRow, p) = .Sheets("KernelTime").Cells(intRow, p) + worktime .Sheets("Faults").Cells(intRow, p) = .Sheets("Faults").Cells(intRow, p) + Faults .Sheets("Commit").Cells(intRow, p) = .Sheets("Commit").Cells(intRow, p) + Commit .Sheets("Hnd").Cells(intRow, p) = .Sheets("Hnd").Cells(intRow, p) + Hnd End If Loop Close intFileNo .Charts("UserTime(Graph)").SetSourceData Source:=.Sheets("UserTime").UsedRange, PlotBy:=xlColumns .Charts("KernelTime(Graph)").SetSourceData Source:=.Sheets("KernelTime").UsedRange, PlotBy:=xlColumns .Charts("Faults(Graph)").SetSourceData Source:=.Sheets("Faults").UsedRange, PlotBy:=xlColumns .Charts("Commit(Graph)").SetSourceData Source:=.Sheets("Commit").UsedRange, PlotBy:=xlColumns .Charts("Hnd(Graph)").SetSourceData Source:=.Sheets("Hnd").UsedRange, PlotBy:=xlColumns For no = 2 To .Sheets.Count .Sheets(no).Visible = xlSheetVisible Next no For no = 1 To .Charts.Count .Charts(no).Visible = xlSheetVisible Next no End With End Sub Private Sub クリア() ' ' マクロ動作の隠蔽 ' Application.ScreenUpdating = False With Workbooks(ThisWorkbook.Name) For no = 2 To .Sheets.Count .Sheets(no).Visible = xlSheetVisible Next no .Sheets("KernelTime").Rows("1:65536").Delete .Sheets("UserTime").Rows("1:65536").Delete .Sheets("KernelTime").Rows("1:65536").Delete .Sheets("Faults").Rows("1:65536").Delete .Sheets("Commit").Rows("1:65536").Delete .Sheets("Hnd").Rows("1:65536").Delete For no = 2 To .Sheets.Count .Sheets(no).Visible = xlSheetHidden Next no For no = 1 To .Charts.Count .Charts(no).Visible = xlSheetHidden Next no If IsObject(Table) = True Then Table.RemoveAll End If ToggleButton1.Value = False ToggleButton1.Caption = "監視開始" End With End Sub