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
参考资料
