zoukankan      html  css  js  c++  java
  • vb 模拟 click 窗口上的按钮

    引用:http://tieba.baidu.com/f?kz=568803652   (19楼)

    最小化一样也没问题的, 你只要先找到它的句柄即可, 再找子线程句柄, 下面以计算器为例  

    '请先打开你的 计算器 再添加 Command1  


    Option Explicit  
    Private Declare FunXXction FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long  
    Private Declare FunXXction FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWnd1 As Long, ByVal hWnd2 As Long, ByVal lpsz1 As String, ByVal lpsz2 As String) As Long  
    Private Declare FunXXction SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long  
    Const WM_SETTEXT = &HC  
    Const BM_CLICK = &HF5  
    Dim HwndVal&, ChildHwnd&, i&  
    Private Sub Command1_Click()  
     HwndVal = FindWindow(vbNullString, "计算器")  
     If HwndVal = 0 Then MsgBox "计算器没运行": Exit Sub  
     Print "计算器的句柄是: " & CStr(HwndVal)  
     SendMessage HwndVal, WM_SETTEXT, 0, ByVal "CBM666 的计算器"  
     '标记的下面两行是直接给计算器的TextBox赋值  
     'ChildHwnd = FindWindowEx(HwndVal, 0, "Edit", vbNullString)  
     'If ChildHwnd <> 0 Then SendMessage ChildHwnd, WM_SETTEXT, 0, ByVal "123456789"  
     For i = 1 To 10  
     If i = 10 Then  
     ChildHwnd = FindWindowEx(HwndVal, 0, "Button", "=")  
     If ChildHwnd <> 0 Then SendMessage ChildHwnd, BM_CLICK, ByVal 0&, ByVal 0&  
     Else  
     ChildHwnd = FindWindowEx(HwndVal, 0, "Button", CStr(i))  
     If ChildHwnd <> 0 Then SendMessage ChildHwnd, BM_CLICK, ByVal 0&, ByVal 0&  
     If i < 9 Then  
     ChildHwnd = FindWindowEx(HwndVal, 0, "Button", "+")  
     If ChildHwnd <> 0 Then SendMessage ChildHwnd, BM_CLICK, ByVal 0&, ByVal 0&  
     End If  
     End If  
     Next i  
    End Sub  

    '*************************** 模拟键盘输入  
    'Dim Rtn&  
    'Private Sub Command1_Click()  
    ' Rtn = Shell("Calc.EXE", 1) '执行小算盘。  
    ' AppActivate Rtn '启动小算盘。  
    ' For i = 1 To 10 '设定回圈执行次数。  
    ' If i = 10 Then  
    ' SendKeys i & "=", True ' 按下按键给小算盘  
    ' Else  
    ' SendKeys i & "{+}", True ' 按下按键给小算盘  
    ' End If  
    ' Next i '将所有I 值相加。  
    'End Sub

    ---------------------------------------------------------

    点击例子

    Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
    Private Declare Function PostMessage Lib "user32" Alias "PostMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
    Private Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWnd1 As Long, ByVal hWnd2 As Long, ByVal lpsz1 As String, ByVal lpsz2 As String) As Long
    Private Declare Function SetForegroundWindow Lib "user32" (ByVal hwnd As Long) As Long
    Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long

    Private ConstWM_CLOSE
    Private ConstWM_QUIT
    Private ConstWM_LBUTTONDOWN
    Private ConstWM_LBUTTONUP
    Private ConstBM_CLICK

    Dim countNum As Single '下载次数'
    Dim DownloadUrlStr As String '下载页面'
    Dim DownloadTimes As Integer '下载间隔(秒)'

    Private Sub Form_Load() '初始化'
    TimerForStart.Enabled = False
    TimeForClear.Enabled = False
    TimeForClear.Interval = 1000
    ConstWM_CLOSE = &H10
    ConstWM_QUIT = &H12
    WM_LBUTTONDOWN = &H201
    WM_LBUTTONUP = &H202
    ConstBM_CLICK = &HF5

    End Sub

    Private Sub SaveBtn_Click() '保存'
    TimeForClear.Enabled = False
    DownloadUrlStr = UrlStr.Text
    DownloadTimes = TimersStr.Text
    TimerForStart.Interval = DownloadTimes * 1000
    countNum = 0
    TimersNow.Caption = 0

    If DownloadUrlStr = "" Then
    MsgBox "输入网址"
    Else
    WebBrowser1.Navigate DownloadUrlStr
    End If


    Dim indexForHiapk As Long
    Dim indexForAppChina As Long

    indexForHiapk = InStr(UrlStr, "http://static.apk.hiapk.com")
    indexForAppChina = InStr(UrlStr, "http://www.appchina.com")


    If indexForHiapk <> 0 Then
    StationName.Caption = "安卓网"
    End If
    If indexForAppChina <> 0 Then
    StationName.Caption = "应用汇"
    End If

    End Sub

    Private Sub CountDownload() '累计下载次数'
    countNum = countNum + 1
    TimersNow.Caption = countNum
    End Sub
    Private Sub StartBtn_Click() '开始按钮'
    TimeForClear.Enabled = True
    TimerForStart.Enabled = True
    End Sub


    Private Sub StopBtn_Click() '停止按钮'
    TimeForClear.Enabled = False
    TimerForStart.Enabled = False
    End Sub

    Private Sub TimerForStart_Timer() '开始执行要做的事'
    Call CountDownload
    Call StartDownload
    End Sub
    Private Sub TimeForClear_Timer() '清除下载窗口'
    Call SaveWinCon
    End Sub

    Private Sub StartDownload() '开始下载'


    Dim indexForHiapk As Long
    Dim indexForAppChina As Long

    indexForHiapk = InStr(UrlStr, "***")
    indexForAppChina = InStr(UrlStr, "***")


    If indexForHiapk <> 0 Then
    Call DownloadForHiapk
    End If
    If indexForAppChina <> 0 Then
    Call DownloadForAppChina
    End If
    End Sub
    Private Sub DownloadForHiapk() 'hiapk'

    Dim wb
    Set wb = WebBrowser1.Document
    For i = wb.All.length - 1 To 0 Step -1


    If LCase(wb.All(i).tagname) = "a" Then

    If wb.All(i).className = "d1" Then
    wb.All(i).Click
    End If

    End If
    Next
    End Sub

    Private Sub DownloadForAppChina() 'appchina'

    Dim wb
    Set wb = WebBrowser1.Document
    For i = wb.All.length - 1 To 0 Step -1


    If LCase(wb.All(i).tagname) = "a" Then

    If wb.All(i).id = "dtpc" Then
    wb.All(i).Click
    End If

    End If
    Next
    'MsgBox "这里"'
    Call SaveWinCon
    End Sub


    Private Sub SaveWinCon()
    Dim Hwnd_SaveFile As Long
    Dim Hwnd_ForBtn As Long

    Dim RetVal As Long '有没有关闭成功'
    Dim RetValDown As Long '有没有关闭成功'
    Dim RetValUp As Long '有没有关闭成功'
    Hwnd_SaveFile = FindWindow(vbNullString, "文件下载")

    Hwnd_ForBtn = FindWindowEx(Hwnd_SaveFile, 0, "Button", "取消")

    SetForegroundWindow Hwnd_SaveFile


    '关闭保存窗口'
    If Hwnd_ForBtn <> 0 Then

    ' RetVal = PostMessage(Hwnd_SaveFile, ConstWM_QUIT, 0&, 0&)'

    ' RetValDown = PostMessage(Hwnd_ForBtn, ConstWM_LBUTTONDOWN, 1&, 0&)'
    ' RetValUp = PostMessage(Hwnd_ForBtn, ConstWM_LBUTTONUP, 1&, 0&)'

    'MsgBox RetValDown'
    ' MsgBox RetValUp'

    SendMessage Hwnd_ForBtn, ConstBM_CLICK, ByVal 0&, ByVal 0&

    If RetVal = 0 Then
    'MsgBox "关闭出错! "'
    Else
    'MsgBox "成功关闭"'
    End If

    Else
    ' MsgBox "没找到"'
     End If

    End Sub

    参考资料

    http://www.cnblogs.com/del/archive/2008/02/28/1085432.html

    http://www.vbgood.com/api.html

  • 相关阅读:
    h5-canvas-渐变
    sublime text 3 无法安装Package Control插件解决办法
    ps;top;free;grep
    lambda
    服务注册与发现eureka
    https证书错误导致maven无法访问仓库出错
    Docker认识和安装
    spring项目发布到linux上遇到的错
    spring aop api
    spring事务
  • 原文地址:https://www.cnblogs.com/sode/p/2235879.html
Copyright © 2011-2022 走看看