ウィンドウの起動時間を取得するには？

たつ 2003-05-28 03:21:00 No: 78058

はじめて質問させていただきます。
ウィンドウハンドル列挙を
コールバックプロシージャEnumWindowにより取得していますが、
同時にウィンドウ起動時間も取得し、
一番新しいウィンドウをアクティブにしようとしています。
時間取得をする方法はあるのでしょうか？
よろしくお願いします。

たかみちえ URL 2003-05-28 04:45:27 No: 78059

フォームに限らず、すべてのウィンドウはそういう情報を持っていません。

やりたいのなら、グローバルフックするなりして、ウィンドウの表示時の時間を取得するしかないです。
VBでに限らず、相当面倒なので、できればほかの方法でどうにかできないでしょうか？

たつ 2003-05-28 05:02:48 No: 78060

たかみちえさん、回答ありがとうございました。
時間取得は難しそうなので、違う方法を探します。

アプリをタスクトレイに常駐し、
Windowsのキーイベントを監視して、
ウィンドウを切り替えることはできるのでしょうか？

魔界の仮面弁士 2003-05-28 06:21:15 No: 78061

> 時間取得をする方法はあるのでしょうか？

ウィンドウ単位ではなく、プロセス単位でも良ければこんな感じで。
最小単位は、100ナノ秒(0.1マイクロ秒)です。

ListView1 と Command1 を貼っておいてください。

Option Explicit

Private Sub Command1_Click()
EnumProcess
End Sub

Private Sub Form_Load()
    With ListView1.ColumnHeaders
        .Clear
        .Add Text:="プロセス"
        .Add Text:="実行パス"
        .Add Text:="ハンドル", Alignment:=lvwColumnRight
        .Add Text:="セッション", Alignment:=lvwColumnRight
        .Add Text:="実行開始時間"
        .Add Text:="ユーザー時間", Alignment:=lvwColumnRight
        .Add Text:="カーネル時間", Alignment:=lvwColumnRight
    End With
    ListView1.View = lvwReport
    'ListView1.FullRowSelect = True
End Sub

Private Sub EnumProcess()
    Dim A As Object
    Dim B As Object
    Dim C As Object
    Dim LIs As ListItems

    Set LIs = ListView1.ListItems
    LIs.Clear

    Set A = GetObject("winmgmts:")
    Set B = A.InstancesOf("Win32_Process")
    For Each C In B
        With LIs.Add(Text:=Format(C.Description, "@;(null)"))
            .SubItems(1) = Format(C.ExecutablePath, "@;(null)")
            .SubItems(2) = ToHex(C.Handle)
            .SubItems(3) = ToHex(C.SessionId)
            .SubItems(4) = ToDateString(C.CreationDate)
            .SubItems(5) = Format(C.UserModeTime, "#,0\0\0ナノ秒;;;(null)")
            .SubItems(6) = Format(C.KernelModeTime, "#,0\0\0ナノ秒;;;(null)")
        End With
    Next
End Sub

Private Function ToHex(ByVal Value As Variant) As String
    If IsNull(Value) Then
        ToHex = "(null)"
    Else
        ToHex = "0x" & Right(String(8, "0") & Hex(CLng(Value)), 8)
    End If
End Function

Private Function ToDateString(ByVal Value As Variant) As String
    Dim DateTime As Object
    Dim buf As String

    If IsNull(Value) Then
        ToDateString = "(null)"
    Else
        Set DateTime = CreateObject("WbemScripting.SWbemDateTime")
        DateTime.Value = Value
        buf = Format(DateTime.GetVarDate, "yyyy年mm月dd日hh時nn分ss秒")
        buf = buf & "と" & CStr(DateTime.Microseconds) & "マイクロ秒"
        ToDateString = buf
    End If
End Function

たつ 2003-05-29 05:26:52 No: 78062

＞魔界の仮面弁士さん

早速試してみます。
ありがとうございます。