网页刷新器

最新推荐文章于 2024-08-26 08:23:37 发布

jesters

最新推荐文章于 2024-08-26 08:23:37 发布

阅读量1.3k

点赞数

分类专栏： VB 文章标签： command function timer string user

本文链接：https://blog.csdn.net/jesters/article/details/293256

版权

VB 专栏收录该内容

4 篇文章 0 订阅

订阅专栏

Private Declare Function GetWindow Lib "user32" (ByVal hwnd As Long, ByVal wCmd As Long) As Long
Private Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal hwnd As Long, ByVal lpString As String, ByVal cch As Long) As Long
Private Declare Function GetWindowTextLength Lib "user32" Alias "GetWindowTextLengthA" (ByVal hwnd As Long) As Long

Private Const GW_HWNDLAST = 1
Private Const GW_HWNDNEXT = 2

Function GetWin(webadd As String) As String
   On Error Resume Next

   Dim NhWnd As Long
   Dim Length, WinTitle$
   Dim OkWin As String

   NhWnd = GetWindow(hwnd, GW_HWNDFIRST)

   While NhWnd <> 0
       Length = GetWindowTextLength(NhWnd)
       WinTitle$ = Space$(Length + 1)

       Length = GetWindowText(NhWnd, WinTitle$, Length + 1)

       If InStr(LCase(WinTitle$), webadd) > 0 Then
           OkWin = OkWin & "//" & NhWnd
       End If

       NhWnd = GetWindow(NhWnd, GW_HWNDNEXT)
   Wend

   GetWin = OkWin
End Function

Sub SendInfo(webaddr As String)
   On Error Resume Next

   Dim OkWin, hCount
   OkWin = GetWin(webaddr)
   'MsgBox OkWin
   If Len(OkWin) > 0 Then
       OkWin = Split(OkWin, "//")
       For hCount = 0 To UBound(OkWin)
           If Len(OkWin(hCount)) > 0 Then
               'MsgBox OkWin(hCount)
               'MsgBox GetWinName(OkWin(hCount))
               AppActivate GetWinName(OkWin(hCount))
               SendKeys "{F5}"
           End If
       Next
   End If
End Sub

Function GetWinName(ByVal WinID As Long) As String
   On Error Resume Next

   If WinID < 1 Then Exit Function
   Dim Length, WinTitle$
   Length = GetWindowTextLength(WinID)
   WinTitle$ = Space$(Length + 1)
   Length = GetWindowText(WinID, WinTitle$, Length + 1)
   GetWinName = WinTitle$
End Function

Private Sub Command1_Click()
    If Text1.Text = "" Or Text2.Text = "" Then
        MsgBox "输入不全", vbCritical, "提示"
        Exit Sub
    End If
    Timer1.Enabled = True
    Timer1.Interval = Val(Text2.Text) * 500
    Command1.Enabled = False
    Command2.Enabled = True
    Text1.Enabled = False
    Text2.Enabled = False
End Sub

Private Sub Command2_Click()
    Timer1.Enabled = False
    Command1.Enabled = True
    Command2.Enabled = False
    Text1.Enabled = True
    Text2.Enabled = True
End Sub

Private Sub Form_Load()
Command1.Enabled = True
Command2.Enabled = False
End Sub

Private Sub Timer1_Timer()
   On Error Resume Next

   Call SendInfo(Text1.Text)
End Sub