最近Webbrower遇到一个没能触发IID_IDownloadManager,弹出了下载窗口,被逼要通过抓取窗口,从而实现程序可控的下载管理。
首先是要查找本进程创建的(以确保不找到别的进程创建的)含“保存”按钮“文件下载”下载窗口:
Case 36 '捕获下载窗口
TimerRun_Loop_count += 1
Dim sss As StringBuilder
sss = New StringBuilder("", 256)
F_hWnd = FindWindowEx(0, 0, "#32770", "文件下载") '以参数1(0:桌面窗口)为父窗口,参数2(0:第一个),参数4(“文件下载”)查找第一个窗口
While F_hWnd
'看看此下载窗口是否为本进程创建的
Dim processId As Integer
GetWindowThreadProcessId(F_hWnd, processId)
Dim hProcess As Integer = OpenProcess(PROCESS_QUERY_INFORMATION Xor PROCESS_VM_READ, False, processId)
If hProcess <> Nothing Then
Dim szExePath As StringBuilder
szExePath = New StringBuilder("", MAX_PATH)
If GetModuleFileNameEx(hProcess, 0, szExePath, MAX_PATH) Then
' szExePath 就是程序的可执行文件路径
If Path.GetDirectoryName(szExePath.ToString) = System.Windows.Forms.Application.StartupPath Then
'查找是否有保存按钮,有该按钮的窗口才是要找的父窗口
F_Btn_hWnd = FindWindowEx(F_hWnd, 0&, "Button", "保存(&S)")
If F_Btn_hWnd Then
TimerRun_Loop_count = 0
EntOfficialQuery_step = 40
Exit Select
End If
End If
End If
CloseHandle(hProcess)
End If
F_hWnd = GetWindow(F_hWnd, GW_HWNDNEXT)
End While
发送消息BM_CLICK到“保存”按钮,实现点击效果。在微软关于"BM_CLICK消息"文档中提到:如果按钮位于对话框中,而对话框未处于活动状态, 则BM_CLICK 消息可能会失败。 若要确保在这种情况下成功,请在将BM_CLICK消息发送到按钮之前调用 SetActiveWindow 函数来激活对话框。但发现无论如何,用SetActiveWindow都不能成功激活对话框,返回永远是False。
只好用SetForegroundWindow激活对话窗口:
Case 40 '将下载窗口置顶激活
If SetForegroundWindow(F_hWnd) Then
WriteRunLog("SetForegroundWindow成功")
Else
WriteRunLog("SetForegroundWindow失败")
End If
If BringWindowToTop(F_hWnd) Then
WriteRunLog("BringWindowToTop成功")
Else
WriteRunLog("BringWindowToTop失败")
End If
EntOfficialQuery_step = 48
特别要注意:窗口激活后,至少要延时0.5秒(具体可能不同机器有不同,自己在可靠性与时效性之间取均衡就好),发送BM_CLICK消息才有效。
Case 48 '点击“保存(&S)”按钮
TimerRun_Loop_count += 1
If TimerRun_Loop_count < 5 Then '窗口激活后,至少要延时0.5秒,发送消息才有效。
Exit Select
End If
PostMessage(F_Btn_hWnd, BM_CLICK, 0, 0)
为了方便查找所需窗口,编写了程序MyFindWindowEx,递归调用以遍历所有子窗口。与原FindWindowExA 不同的地方是:FindWindowExA 对 lpszWindow 是全文匹配查找,MyFindWindowEx 则可以进行部分匹配查找。例如要查找地址栏以获取文件下载路径,用FindWindowExA ,lpszWindow 要=“地址:E:\Web2023下载文件夹” 才能找到,lpszWindow 要=“地址:”是无法找到的,而我们无法预知地址栏窗口名称全部内容,只知道窗口名称包含“地址:”,而MyFindWindowEx则可以。
'参数 hWndParent, hWndChildAfter :只是定位查找的范围,不是我们要查找的目标主要参数
'参数 lpszClass, lpszWindow :这两个才是我们要查找的目标主要参数
'如果 lpszWindow 不为空时,是要全部匹配的,现在增加如果全部匹配找不到的话,能查找部分匹配
Private Function MyFindWindowEx(ByVal hWndParent As Integer, ByVal hWndChildAfter As Integer, ByVal lpszClass As String, ByVal lpszWindow As String, Optional ByVal StrictMatching As Boolean = True) As Integer
Dim hWnd As Integer
If StrictMatching Or IsNullOrEmpty(lpszWindow) Then
MyFindWindowEx = FindWindowEx(hWndParent, hWndChildAfter, lpszClass, lpszWindow)
Else
MyFindWindowEx = FindWindowEx(hWndParent, hWndChildAfter, lpszClass, Nothing)
If MyFindWindowEx Then
Dim sss As StringBuilder
sss = New StringBuilder("", 256)
GetWindowText(MyFindWindowEx, sss, 256)
If InStr(sss.ToString, lpszWindow) < 1 Then '不包含lpszWindow,则置MyFindWindowEx = 0
MyFindWindowEx = 0
End If
End If
End If
If MyFindWindowEx Then '找到,函数结束
Exit Function
End If
'没找到,设置参数lpszClass, lpszWindow为NULL,查找所有子窗口中的子窗口
hWnd = FindWindowEx(hWndParent, hWndChildAfter, Nothing, Nothing)
While hWnd
MyFindWindowEx = MyFindWindowEx(hWnd, 0, lpszClass, lpszWindow, StrictMatching) '递归调用
If MyFindWindowEx Then '找到窗口,退出
Exit Function
End If
'hWnd = FindWindowEx(hWndParent, hWnd, Nothing, Nothing) '这两行效果是一样的
hWnd = GetWindow(hWnd, GW_HWNDNEXT)
End While
End Function
用MyFindWindowEx就可以方便查找“另存为”窗口中的“地址:”栏子窗口(不再需要逐级找到该地址栏窗口) ,获得文件保存路径,
F_Btn_hWnd = MyFindWindowEx(F_hWnd, 0&, "ToolbarWindow32", "地址:", False) '地址: E:\Web2023下载文件夹
这是用Spy++分析得到的窗口嵌套的关系,没有MyFindWindowEx的话,你将要逐级才能找到地址栏。
所有这些代码执行,全部通过1个Timer来分时(设置计时器1/10秒)、分步执行。
Dim TimerRun_isRuning As Boolean = False
Private Sub TimerRun_Tick(sender As Object, e As EventArgs) Handles TimerRun.Tick
If TimerRun_isRuning Then
Exit Sub
End If
TimerRun_isRuning = True
EntOfficialQuery_step ()
If EntOfficialQuery_step_step = -1 Then
TimerRun.Enabled = False '执行完毕,终止TimerRun执行
End If
TimerRun_isRuning = False
End Sub
DLL函数声明:
Private Declare Function BringWindowToTop Lib "user32" (ByVal hwnd As Integer) As Integer
Private Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWndParent As Integer, ByVal hWndChildAfter As Integer, ByVal lpszClass As String, ByVal lpszWindow As String) As Integer
Private Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal hwnd As Integer, ByVal lpString As StringBuilder, ByVal cch As Int32) As Integer
Private Declare Function PostMessage Lib "user32" Alias "PostMessageA" (ByVal hwnd As Integer, ByVal wMsg As Integer, ByVal wParam As Integer, ByVal lParam As Integer) As Integer
Private Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Integer, ByVal bInheritHandle As Integer, ByVal dwProcId As Integer) As Integer
Private Declare Function GetWindowThreadProcessId Lib "user32" (ByVal hwnd As Integer, ByRef lpdwProcessId As Integer) As Integer
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Integer) As Integer
Declare Auto Function SetForegroundWindow Lib "USER32.DLL" (ByVal hWnd As IntPtr) As Boolean
Private Const BM_CLICK = &HF5
Private Const WM_GETTEXT = &HD
Private Const WM_SETTEXT = &HC
Private Const PROCESS_QUERY_INFORMATION = &H400
Private Const PROCESS_VM_READ = &H10
Private Const MAX_PATH = 260
EntOfficialQuery_step ()的完整函数(其中有对发送BM_CLICK消息失败的重试次数设定,以确保尽可能成功):
Dim EntOfficialQuery_step As Integer = 0
Dim TimerRun_Loop_count As Integer = 0 '
Dim EntOfficialQuery_isRuning As Boolean = False '控制代码未执行完时,不会触发重复执行
Dim F_hWnd As Integer
Dim F_hWnd_2 As Integer
Dim F_Btn_hWnd As Integer
Dim Get_DldFname As String = ""
Dim Get_DldDir As String = ""
Private Sub EntOfficialQuery() '
If EntOfficialQuery_isRuning Then
Exit Sub
End If
EntOfficialQuery_isRuning = True
Select Case EntOfficialQuery_step
Case 0 '初始化一些参数
EntOfficialQuery_step = 36
ErrTry = 0
TimerRun_Loop_count = 0
Case 36 '捕获下载窗口
TimerRun_Loop_count += 1
Dim sss As StringBuilder
sss = New StringBuilder("", 256)
F_hWnd = FindWindowEx(0, 0, "#32770", "文件下载") '以参数1(0:桌面窗口)为父窗口,参数2(0:第一个),参数4(“文件下载”)查找第一个窗口
While F_hWnd
'看看此下载窗口是否为本进程创建的
Dim processId As Integer
GetWindowThreadProcessId(F_hWnd, processId)
Dim hProcess As Integer = OpenProcess(PROCESS_QUERY_INFORMATION Xor PROCESS_VM_READ, False, processId)
If hProcess <> Nothing Then
Dim szExePath As StringBuilder
szExePath = New StringBuilder("", MAX_PATH)
If GetModuleFileNameEx(hProcess, 0, szExePath, MAX_PATH) Then
' szExePath 就是程序的可执行文件路径
If Path.GetDirectoryName(szExePath.ToString) = System.Windows.Forms.Application.StartupPath Then
'查找是否有保存按钮,有该按钮的窗口才是要找的父窗口
F_Btn_hWnd = FindWindowEx(F_hWnd, 0&, "Button", "保存(&S)")
If F_Btn_hWnd Then
'获取文件名:第一个类名 SysLink 的子窗口包含文件名
F_hWnd_2 = FindWindowEx(F_hWnd, 0&, "SysLink", Nothing)
If F_hWnd_2 Then
GetWindowText(F_hWnd_2, sss, 256)
Get_DldFname = sss.ToString '获取“文件下载”窗口中的下载文件名
WriteRunLog("下载文件名:" + Get_DldFname)
Else
WriteRunLog("程序出错,没找到下载文件名")
End If
TimerRun_Loop_count = 0
EntOfficialQuery_step = 40
Exit Select
Else
'WriteRunLog("窗口" + UCase(Convert.ToString(F_hWnd, 16)) + "中没找到 保存 按钮")
End If
End If
End If
CloseHandle(hProcess)
End If
F_hWnd = GetWindow(F_hWnd, GW_HWNDNEXT)
End While
If TimerRun_Loop_count > 100 Then
WriteRunLog("EntOfficialQuery_step = " + EntOfficialQuery_step.ToString + " 超时 1") '超时,则终止
EntOfficialQuery_step = 99
End If
Case 40 '将下载窗口置顶激活
If SetForegroundWindow(F_hWnd) Then
WriteRunLog("SetForegroundWindow成功")
Else
WriteRunLog("SetForegroundWindow失败")
End If
If BringWindowToTop(F_hWnd) Then
WriteRunLog("BringWindowToTop成功")
Else
WriteRunLog("BringWindowToTop失败")
End If
EntOfficialQuery_step = 48
Case 48 '点击“保存(&S)”按钮
TimerRun_Loop_count += 1
If TimerRun_Loop_count < 5 Then '窗口激活后,至少要延时0.5秒,发送消息才有效。
Exit Select
End If
PostMessage(F_Btn_hWnd, BM_CLICK, 0, 0)
EntOfficialQuery_step = 52
Case 52 '等待“另存为”窗口出现
'“另存为”窗口子窗口类名:DUIViewWndClassName(里面有文件名子窗口:ComboBox、Edit)、WorkerW(里面有文件路径子窗口:ComboBox、Edit)
'因为还没找到办法更改“另存为”窗口中的下载文件夹,所有采用变通办法,获取下载文件夹、文件名,下载完成后再移动文件到自己想要的路径(就像从IE缓存文件中复制文件一样)
TimerRun_Loop_count += 1
Dim sss As StringBuilder
sss = New StringBuilder("", 256)
F_hWnd = FindWindowEx(0, 0, Nothing, "另存为") '以参数1(0:桌面窗口)为父窗口,参数2(0:第一个),参数4(“文件下载”)查找第一个窗口
While F_hWnd
'看看此下载窗口是否为本进程创建的
Dim processId As Integer
GetWindowThreadProcessId(F_hWnd, processId)
Dim hProcess As Integer = OpenProcess(PROCESS_QUERY_INFORMATION Xor PROCESS_VM_READ, False, processId)
If hProcess <> Nothing Then
Dim szExePath As StringBuilder
szExePath = New StringBuilder("", MAX_PATH)
If GetModuleFileNameEx(hProcess, 0, szExePath, MAX_PATH) Then
' szExePath 就是程序的可执行文件路径
If Path.GetDirectoryName(szExePath.ToString) = System.Windows.Forms.Application.StartupPath Then
ErrTry = 0
EntOfficialQuery_step = 53
CloseHandle(hProcess)
TimerRun_Loop_count = 0
Exit Select
End If
End If
CloseHandle(hProcess)
End If
F_hWnd = FindWindowEx(0, F_hWnd, Nothing, "另存为") '以参数1(0:桌面窗口)为父窗口,参数2(F_hWnd),参数4(“文件下载”)查找下一个窗口
End While
If TimerRun_Loop_count > 100 Then
ErrTry += 1
If ErrTry < 3 Then '重试
EntOfficialQuery_step = 36
Exit Select
End If
EntOfficialQuery_step = 99
End If
Case 53 ''获取“另存为”窗口中的下载保存路径
TimerRun_Loop_count += 1
'“另存为”窗口子窗口类名:DUIViewWndClassName(里面有文件名子窗口:ComboBox、Edit)、WorkerW(里面有文件路径子窗口:ToolbarWindow32、ComboBox、Edit)
'在地址栏没有点击激活时, Edit输入框为空
F_Btn_hWnd = MyFindWindowEx(F_hWnd, 0&, "ToolbarWindow32", "地址:", False) '地址: E:\Web2023下载文件夹
If F_Btn_hWnd Then
Dim sss As StringBuilder
sss = New StringBuilder("", 256)
GetWindowText(F_Btn_hWnd, sss, 256)
Get_DldDir = sss.ToString.Substring(3) '获取“另存为”窗口中的下载保存路径
EntOfficialQuery_step = 55
Exit Select
Else
WriteRunLog("没找到 文件夹输入 窗口2:" + UCase(Convert.ToString(F_hWnd, 16)))
End If
If TimerRun_Loop_count > 100 Then
EntOfficialQuery_step = 99 '超时,则终止
End If
Case 55 '找到“另存为”窗口中的“保存”按钮
'“另存为”窗口子窗口类名:DUIViewWndClassName(里面有文件名子窗口:ComboBox、Edit)、WorkerW(里面有文件路径子窗口:ComboBox、Edit)
F_Btn_hWnd = FindWindowEx(F_hWnd, 0&, "Button", "保存(&S)")
If F_Btn_hWnd Then
EntOfficialQuery_step = 57
Exit Select
Else
WriteRunLog("没找到 保存 窗口2")
End If
EntOfficialQuery_step = 99
Case 57 '将下载窗口置顶激活
If SetForegroundWindow(F_hWnd) Then
WriteRunLog("SetForegroundWindow成功")
Else
WriteRunLog("SetForegroundWindow失败")
End If
If BringWindowToTop(F_hWnd) Then
WriteRunLog("BringWindowToTop成功")
Else
WriteRunLog("BringWindowToTop失败")
End If
EntOfficialQuery_step = 58
Case 58 '点击“保存(&S)”按钮
TimerRun_Loop_count += 1
If TimerRun_Loop_count < 5 Then '窗口激活后,至少要延时0.5秒,发送消息才有效。
Exit Select
End If
PostMessage(F_Btn_hWnd, BM_CLICK, 0, 0)
TimerRun_Loop_count = 0
EntOfficialQuery_step = 62
Case 62 '将下载的文件Get_DldFname 移动到目标文件夹,需要判断文件是否已经下载完成
TimerRun_Loop_count += 1
'通过窗口“下载完成后关闭此对话框(&C)”是否关闭来判断文件是否下载完毕。
F_Btn_hWnd = FindWindowEx(0, 0&, "Button", "下载完成后关闭此对话框(&C)")
If F_Btn_hWnd Then
WriteRunLog("文件未下载完...")
If TimerRun_Loop_count < 5 Then
Exit Select
Else
ErrTry += 1
If ErrTry < 3 Then '重试点击“保存”按钮
WriteRunLog("EntOfficialQuery_step = " + EntOfficialQuery_step.ToString + " 超时 1,重试:" + ErrTry.ToString)
EntOfficialQuery_step = 55
Exit Select
End If
WriteRunLog("EntOfficialQuery_step = " + EntOfficialQuery_step.ToString + " 超时 1,多次重试失败!") '超时,则终止
EntOfficialQuery_step = 99
Exit Select
End If
End If
'查询路径下是否已经有文件,获取完整文件名(含后缀名)
If Not File.Exists(Get_DldDir + "\" + Get_DldFname) Then
If TimerRun_Loop_count < 50 Then
Exit Select
Else
WriteRunLog("超时未等待下载文件")
End If
End If
Try
File.Move(Get_DldDir + "\" + Get_DldFname, LSet(System.Windows.Forms.Application.StartupPath, 3) + "Web2023下载文件夹\" + "(" + EntOfficialQueryTxt.Text + ")" + Get_DldFname)
Catch ex As Exception
WriteRunLog("移动文件发生错误:" + ex.ToString)
EntOfficialQuery_StateLabel.Text = "文件已经下载到:" + Get_DldDir + "\" + Get_DldFname
Finally
EntOfficialQuery_StateLabel.Text = "文件已经下载到:" + LSet(System.Windows.Forms.Application.StartupPath, 3) + "Web2023下载文件夹\" + "(" + EntOfficialQueryTxt.Text + ")" + Get_DldFname
End Try
EntOfficialQuery_step = 99
Case 99
EntOfficialQuery_step = -1
End Select
EntOfficialQuery_isRuning = False
End Sub