'
' 初期設定
'
Const LOG_ROW = 21                              ' ログファイル名が書かれたセルの行数
Const LOG_COLUMN = 3                            ' ログファイル名が書かれたセルの桁数
Const INTERVAL_ROW = 35                         ' 監視間隔が書かれたセルの行数
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 strText        As String                       ' 読み込みバッファ
    Dim Flag        As Boolean                      ' 既に日付がある行は True としてスキップ
    Dim memory      As String                       ' Memory使用率
'   Dim cpu         As Double                       '　CPU使用率
    Dim process     As String                       ' プロセス名
    Dim strArray()  As String

    '
    ' マクロ動作をユーザーに意識させない
    '
    Application.ScreenUpdating = False
    
    With Workbooks(ThisWorkbook.Name)
        
        '
        ' 初期化
        '
        If IsObject(Table) = False Then
            Set Table = CreateObject("Scripting.Dictionary")
            Max = .Sheets("CPU").Cells.SpecialCells(xlLastCell).Column
            For p = 2 To Max
                process = .Sheets("CPU").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)
            
            '
            ' １行ずつ取り出し
            '
            strText = ""
            Do
                strSj = InputB(1, #intFileNo)
                strUni = StrConv(strSj, vbUnicode)
                If EOF(intFileNo) Or strUni = vbLf Then
                    Exit Do
                End If
                strText = strText & strUni
            Loop
        
            '
            ' スペースで分割
            '
            strArray = Split(strText)
            n = UBound(strArray)
            
            '
            ' 日付フォーマットの場合は日付処理
            '
            If Mid$(strText, 5, 1) = "/" And Mid$(strText, 8, 1) = "/" Then
                intRow = intRow + 1
                If .Sheets("Mem").Cells(intRow, 1) = strText Then
                    Flag = True
                Else
                    Flag = False
                    .Sheets("Mem").Cells(intRow, 1) = strText
                    .Sheets("CPU").Cells(intRow, 1) = strText
                End If
            '
            ' PID のヘッダ部分は読み飛ばす
            '
            ElseIf InStr(strText, "%CPU") > 0 Then
            '
            ' AIX の <defunct> 行は読み飛ばす
            '
            '   880732 946206             <defunct>
            '
            ElseIf InStr(strText, "<defunct>") > 0 Then
            
            ' Wall などの行は読み飛ばす
            '
            ElseIf InStr(strText, ".") <= 0 Then
            
            '
            ' そうでない場合は空白区切りで pid, ppid, CPU, メモリ, プロセス名 を取り出す
            '
            '   1234567890123456789012345678901234567890
            '     PID  PPID %CPU  VSZ COMMAND
            '      PID   PPID  %CPU   VSZ COMMAND
            '       PID    PPID  %CPU   VSZ COMMAND
            
            ElseIf Flag = False Then
                For i = 0 To n
                    If strArray(i) <> "" Then
                        pid = strArray(i)
                        i = i + 1
                        Exit For
                    End If
                Next i
                For i = i To n
                    If strArray(i) <> "" Then
                        ppid = strArray(i)
                        i = i + 1
                        Exit For
                    End If
                Next i
                For i = i To n
                    If strArray(i) <> "" Then
                        cpu = strArray(i)
                        i = i + 1
                        Exit For
                    End If
                Next i
                For i = i To n
                    If strArray(i) <> "" Then
                        memory = strArray(i)
                        i = i + 1
                        Exit For
                    End If
                Next i
                For i = i To n
                    If strArray(i) <> "" Then
                        process = strArray(i)
                        i = i + 1
                        Exit For
                    End If
                Next i
                For i = i To n
                    If strArray(i) <> "" Then
                        process = process & " " & strArray(i)
                    End If
                Next i
            
                '
                ' プロセス名が合致するかを検索
                '
                If Val(pid) > 0 And Val(ppid) > 0 Then
                
                    If Table.Exists(process) Then
                        p = Table.Item(process)
                    Else
                        p = Table.Count + 2
                        Table.Add process, p
                        .Sheets("Mem").Cells(1, p) = process
                        .Sheets("CPU").Cells(1, p) = process
                    End If
                    p = Table.Item(process)
                    .Sheets("Mem").Cells(intRow, p) = .Sheets("Mem").Cells(intRow, p) + memory
                    .Sheets("CPU").Cells(intRow, p) = .Sheets("CPU").Cells(intRow, p) + cpu
                End If
            End If
        
        Loop
        Close intFileNo
        
        .Charts("Mem(Graph)").SetSourceData Source:=.Sheets("Mem").UsedRange, PlotBy:=xlColumns
        .Charts("CPU(Graph)").SetSourceData Source:=.Sheets("CPU").UsedRange, PlotBy:=xlColumns

    End With

End Sub

Private Sub クリア()
        
    With Workbooks(ThisWorkbook.Name)
    
        .Sheets("Mem").Rows("1:65536").Delete
        .Sheets("CPU").Rows("1:65536").Delete
        
        .Charts("Mem(Graph)").SetSourceData Source:=.Sheets("Mem").UsedRange, PlotBy:=xlColumns
        .Charts("CPU(Graph)").SetSourceData Source:=.Sheets("CPU").UsedRange, PlotBy:=xlColumns
        
        If IsObject(Table) = True Then
            Table.RemoveAll
        End If
    
    End With
    
End Sub