时间戳

首页 > 解决方案 > 如何读取网络连接窗口上的计时器值？

excel - 如何读取网络连接窗口上的计时器值？

问题描述

我有一个需要有效 VPN 连接的进程，但连接会每 8 小时自动断开一次。我需要能够控制连接处于活动状态以及剩余时间达到 8 小时限制。在 windows 连接的属性中会出现时间（附上我需要的数据的捕获），但我需要知道如何读取这些数据。

在此处输入图像描述

标签： excelvba

解决方案

请尝试下一种方法：

编辑，因为最后一个请求：

请添加两个新声明

  1. 在标准模块之上复制下一个 API 函数：
Option Explicit

Private Declare PtrSafe Function FindWindow Lib "User32" Alias "FindWindowA" _
             (ByVal lpClassName As String, ByVal lpWindowName As String) As LongPtr
Private Declare PtrSafe Function FindWindowEx Lib "User32" Alias "FindWindowExA" (ByVal hWnd1 As LongPtr, _
                            ByVal hWnd2 As LongPtr, ByVal lpsz1 As String, ByVal lpsz2 As String) As LongPtr
Private Declare PtrSafe Function SendMessage Lib "User32" Alias "SendMessageA" (ByVal hwnd As LongPtr, _
                                        ByVal wMsg As Long, ByVal wParam As LongPtr, lParam As Any) As Long
Private Declare PtrSafe Function GetWindowTextLength Lib "User32" Alias "GetWindowTextLengthA" (ByVal hwnd As LongPtr) As Long
Private Declare PtrSafe Function GetWindowText Lib "User32" Alias "GetWindowTextA" (ByVal hwnd As LongPtr, _
        ByVal lpString As String, ByVal cch As Long) As Long
Private Declare PtrSafe Function GetWindow Lib "User32" (ByVal hwnd As LongPtr, ByVal wCmd As Long) As Long

下一个常数：

Private Const GW_HWNDNEXT = 2
'Added after editing:__________________
Private Const WM_LBUTTON_DOWN = &H201
Private Const BM_CLICK = &HF5
'______________________________________
  1. 在同一个标​​准模块中，复制下一个Sub. 请注意Duration:使用西班牙语正确变体（'Duración' [带有必要的口音]）更改代码：
Sub DurationAPI()
   Dim hwndEth As LongPtr, hwndGen As LongPtr, hwndDurlbl As LongPtr, hwndDur As LongPtr
   Dim sStr As String, strWindowTitle As String, durationLbl As String, durT As Date, limitD As Date

   'added after editing:_____________________________
    OpenWiFiConnectionWindow  'open connection window
    AppActivate Application.ActiveWindow.Caption
   '_________________________________________________

   limitD = CDate("08:00:00")
   strWindowTitle = "Estado de Wi-Fi"
   durationLbl = "Duration:" 'Please change here with your exact label title (in Spanish...)
                             'I cannot write duracion: with the necessary accent...
   hwndEth = FindWindow(vbNullString, strWindowTitle): Debug.Print Hex(hwndEth)
    hwndGen = FindWindowEx(hwndEth, 0&, vbNullString, "General"): Debug.Print Hex(hwndGen)
     hwndDurlbl = FindWindowEx(hwndGen, 0&, vbNullString, durationLbl): Debug.Print Hex(hwndDurlbl)
      hwndDur = GetWindow(hwndDurlbl, GW_HWNDNEXT): Debug.Print Hex(hwndDur)
     
      sStr = String(GetWindowTextLength(hwndDur) + 1, Chr$(0))
      GetWindowText hwndDur, sStr, Len(sStr)
      durT = CDate(sStr)
      MsgBox Format(limitD - durT, "hh:mm:ss") & " left until connection will be interrupted!", _
                                          vbInformation, "Time to connection interruption"

      'Added after editing: ____________________________________________________
      Dim hwndClose As LongPtr
      'closing the connection window:
      hwndClose = FindWindowEx(hwndEth, 0&, vbNullString, "&Close"): Debug.Print Hex(hwndClose)
      SendMessage hwndClose, WM_LBUTTON_DOWN, 0&, 0&
      SendMessage hwndClose, BM_CLICK, 0, ByVal 0&
      '_________________________________________________________________________
End Sub
  1. 之二 复制Sub能够显示必要的连接窗口：
Private Sub OpenWiFiConnectionWindow()
 Dim objApp As Object: Set objApp = CreateObject("Shell.Application")
 Dim objFolder As Object: Set objFolder = objApp.Namespace(&H31&).self.GetFolder
 Dim interface As Variant, interfaceTarget As Object, InterfaceName As String
 
 InterfaceName = "Wi-Fi" 'Please, check here what is show your "Network Connections" folder. It maybe can be slightly different... 
                  'I tested the code on my Ethernet connection, which not was simple "Ethernet". It was "Ethernet 2"...

 For Each interface In objFolder.Items
    If LCase(interface.Name) = LCase(InterfaceName) Then
        Set interfaceTarget = interface:  Exit For
    End If
 Next

 Dim Verb As Variant
 For Each Verb In interfaceTarget.Verbs
    If Verb.Name = "Stat&us" Then
        Verb.DoIt
        Application.Wait Now + TimeValue("0:00:01")
        Exit For
    End If
 Next
End Sub

请先尝试此Sub操作，以确保它显示必要的连接窗口。如果没有，请查看“网络连接”文件夹并更改InterfaceName为适当的文件夹。

  1. 运行上面的DurationAPI() Sub。

所有必要的窗口处理程序都在即时窗口中返回。如果其中之一是 0（零），则必须检查以了解发生了什么...我使用 Spy++ 查找 Windows 标题/类...

对于带有英文标题的窗口，它会正确且几乎立即返回必要的连接持续时间。

推荐阅读