且构网

分享程序员开发的那些事...
且构网 - 分享程序员编程开发的那些事

vb 模拟 click 窗口上的按钮

更新时间:2022-08-13 09:54:10

引用: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

vb 模拟 click 窗口上的按钮

参考资料

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

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