【问题标题】:VB.NET: Idle Time external ApplicationVB.NET:空闲时间外部应用程序
【发布时间】:2021-11-06 07:13:16
【问题描述】:

我看到很多关于在程序中计算空闲时间的帖子,但我想做的是计算一个单独的 Windows 程序的空闲时间。长话短说,我们有 12 个非常昂贵的会计软件许可证。我们有大约 20 名员工,但并不是每个人都使用该软件。有时,我们会使用所有 12 个许可证——公司内部有一个层次结构,即谁应该能够根据需要访问该软件。

我的任务是编写一个程序,让我们“启动”用户。我编写了一个简单的程序,它将在后台运行并检查软件是否已加载。另一个程序只是通过共享网络驱动器发送命令,告诉程序在必要时关闭。

它有效。我现在被要求做的是包括软件的空闲时间。我有什么方法可以监控外部应用程序的击键或鼠标点击吗?我想我基本上可以报告上次使用应用程序的时间,并通过从当前时间中减去空闲时间来得出空闲时间。但是,我正在努力弄清楚是否有任何密钥被发送到特定的应用程序?从逻辑上讲,我认为这就像一个键盘记录器(没有日志记录),但前提是特定应用程序是焦点。

有没有人有我可以探索的想法?我愿意进行研究,但只是想知道是否有人知道任何 API 或其他可以使用的技巧。

【问题讨论】:

标签: vb.net idle-timer


【解决方案1】:

您可以将GetForgroundWindowGetLastInputInfo(Win32 函数)组合在一个合理的循环中。
如果目标应用程序(target)正在运行,并且目标不是前台窗口那么我们可以假设应用程序是空闲的。只需记录它从前台过渡到后台的时间。

如果目标是前台窗口,那么您可以使用GetLastInputInfo 来确定应用程序上次接收鼠标或键盘输入的时间。

** 不幸的是,MSDN 现在已关闭,因此我无法链接到文档。

【讨论】:

  • 非常感谢@Sam Axe!这个想法非常有效,但我从未想过!谢谢!
  • @AlexS。我很高兴这对你有用。您可以考虑在此处发布适当的代码作为答案,以帮助有相同问题的其他人。
【解决方案2】:

所以我将设置与用户日志的位置一起存储。如果我发现用户打开了一个应用程序(Axys),那么我使用他们的 Windows 用户名创建一个文件(一个 .usr 文件)。在该文件中,我保存了应用程序上次处于活动状态的时间。

    Dim strFileName As String = My.Settings.UserLogs & "\" & strWinUser & ".usr"
    Dim strTime As String = String.Empty
    lastInputInf.cbSize = Marshal.SizeOf(lastInputInf)
    lastInputInf.dwTime = 0
    GetLastInputInfo(lastInputInf)

        Dim Caption As New System.Text.StringBuilder(256)
        GetWindowText(GetForegroundWindow, Caption, Caption.Capacity)

        If Caption.ToString.Contains("Axys")  Then
            If (CInt((Environment.TickCount - lastInputInf.dwTime) / 1000)) > 0 Then
                Dim timeDbl As Double = CDbl((Environment.TickCount - lastInputInf.dwTime) / 1000)
                strTime = DateTime.Now.AddSeconds(-1 * timeDbl).ToString
            Else
                strTime = DateTime.Now.ToString
            End If

            Dim objWriter As New System.IO.StreamWriter(strFileName)
            objWriter.Write(strTime)
            objWriter.Close()

        Else
        End If

【讨论】:

    【解决方案3】:

    不确定这是否有帮助,但也许通过 Microsoft 的 UPTIME.exe 可以获得很好的信息。它是一个跟踪正常运行时间、启动、蓝屏等的工具。

    这是一个 vbscript,它可能有一些线索来获取 VB.NET 的此信息

    我不是在这里找到的作者: https://community.spiceworks.com/scripts/show/57-uptime-vbs

    ' ========================================================
    ' Script:           UpTime.vbs
    ' Description:      Create spreadsheet of uptime stats for all servers
    ' Note:         Change the variables below as required.
    '               This program requires a copy of Microsoft's UPTIME.EXE tool available from http://support.microsoft.com/kb/232243
    ' Author:           Alan Kobb
    '               Herley-CTI
    ' Originally created:   8/26/09
    '  Copyright 2009, Herley-CTI.  ALL RIGHTS RESERVED.
    ' ========================================================
    
    Set objShell = CreateObject("WScript.Shell")
    Set dServers = CreateObject("Scripting.Dictionary")
    Dim objExcel, objWorkbook, nPos, strXLFile, objWorksheet, sUpTime
    
    ' **********************************************************************************************************
    ' Variables to set values for
    
    ' Add an array element with the name of each server you want to track.  Set the DIM to the number of servers.
    Dim aServers(2)
    aServers(0) = "Server1"
    aServers(1) = "Server2"
    
    ' The path and name of the Excel file created.
    strXLFile = "C:\UpTimes.xls"
    
    ' How many days to track for each server.
    nDays = "365"
    
    ' Path and filename of Uptime.exe (Required.  Download from Microsoft at http://support.microsoft.com/kb/232243)
    sUpTime = "C:\tools\uptime.exe"
    
    ' **********************************************************************************************************
    
    'REGION Open Excel File
    Set objExcel = CreateObject("Excel.Application")
    objExcel.Visible = False
    Set objWorkbook = objExcel.Workbooks.Add()
    Set objWorksheet = objWorkbook.Worksheets(1)
    'ENDREGION
    objWorksheet.Cells(2,1) = "Server"
    objWorksheet.cells(1,2) = "% Time"
    objWorksheet.cells(2,2) = "Avail"
    objWorksheet.Cells(1,3) = "#"
    objWorksheet.Cells(2,3) = "Reboot"
    objWorksheet.Cells(1,4) = "Current"
    objWorksheet.Cells(2,4) = "Uptime"
    objWorksheet.Cells(3,4) = "(days)"
    objWorksheet.Cells(2,5) = "MTBR"
    objWorksheet.Cells(3,5) = "(days)"
    objWorksheet.Cells(1,6) = "#"
    objWorksheet.Cells(2,6) = "Bluescreens"
    objWorksheet.Cells(1,7) = "Abnormal"
    objWorksheet.Cells(2,7) = "Shutdowns"
    objWorksheet.Cells(2,8) = "Reboots"
    objWorksheet.Cells(2,9) = "Shutdowns"
    objWorksheet.Cells(2,10) = "Notes"
    nRow = 5
    
    For i = 0 To UBound(aServers)
        If Len(aServers(i)) > 1 Then
            strServer = "\\" & aServers(i)
    
            strCmd = sUpTime & " /p:" & nDays & " " & strserver
            WScript.Echo strCmd
    
            Set objExec = objShell.Exec(strCmd)
    
            Do While objExec.Status = 0
                WScript.Sleep 2000
            Loop
    
            nAvailablePercent = 0
            nTotalReboots = 0
            nCurrentDays = 0
            nMTBR = 0
            bTooLittleData = False
            bInconsistant = False
            nBlues = 0
            nAbnormals = 0
            nBoots = 0
            nShuts = 0
    
            Do While Not(objExec.StdOut.AtEndOfStream)
                strLine = objExec.StdOut.ReadLine
                'WScript.Echo strLine
                If InStr(strLine,"Availability") >= 1 Then nAvailablePercent = field(strLine,":",2)
                If InStr(strLine,"Total Reboots") >= 1 Then nTotalReboots = field(strLine,":",2)
                If InStr(strLine,"Current System") >= 1 Then nCurrentDays = field(field(field(strLine,":",2),",",1),"d",1)
                If InStr(strLine,"Mean") >= 1 Then nMTBR = field(field(strLine,":",2),"d",1)
                If InStr(strLine,"earliest") >= 1 Then bTooLittleData = True
                If InStr(strLine,"Bluescreen ") >= 1 Then nBlues = nBlues + 1
                If InStr(strLine,"Abnormal") >= 1 Then nAbnormals = nAbnormals + 1
                If InStr(strLine,"Boot") >= 1 Then nBoots = nBoots + 1
                If InStr(strLine,"  Shutdown") >= 1 Then nShuts = nShuts + 1
            Loop
    
            objWorksheet.Cells(nRow,1) = Mid(strServer,3)
            objWorksheet.cells(nRow,2) = nAvailablePercent
            objWorksheet.Cells(nRow,3) = nTotalReboots
            objWorksheet.Cells(nRow,4) = nCurrentDays
            objWorksheet.Cells(nRow,5) = nMTBR
            objWorksheet.Cells(nRow,6) = nBlues
            objWorksheet.Cells(nRow,7) = nAbnormals
            objWorksheet.Cells(nRow,8) = nTotalReboots
            objWorksheet.Cells(nRow,9) = nShuts
            If bTooLittleData Then objWorksheet.Cells(nRow,10) = "Insufficient Data"
            nRow = nRow + 1
        End If
    Next
    
    ' Save
    objExcel.Visible = True
    'objExcel.ActiveWorkbook.SaveAs strXLFile
    
    Function Field(Str,Delim,Pos)
    Dim aString
    aString = Split(Str,Delim)
    Field = aString(Pos-1)
    End Function
    

    我还想知道查询 Windows Management Instrumentation 是否有帮助。

    我希望这里能有所帮助。祝你好运。

    【讨论】:

      猜你喜欢
      • 1970-01-01
      • 1970-01-01
      • 1970-01-01
      • 1970-01-01
      • 2023-03-08
      • 2015-11-03
      • 2013-09-05
      • 2020-09-23
      • 1970-01-01
      相关资源
      最近更新 更多