VB6源码 webbrowser 自动登录网页批量下载文件 IE下载弹窗控制

VB6源码 webbrowser 网抓 自动登录网页批量下载文件 IE下载弹窗控制,网页元素控制等！！

'===========================================================================================================

'日期：2018-6-10

'作者：巴西_prince

'===========================================================================================================

Option Explicit

Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) 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 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 SetWindowPos Lib "user32" (ByVal hWnd As Long, ByVal hWndInsertAfter As Long, ByVal x As Long, ByVal y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long '窗口置顶

Private Declare Function ShowWindow Lib "user32" (ByVal hWnd As Long, ByVal nCmdShow As Long) As Long '窗口激活

Private Declare Function GetTickCount Lib "kernel32" () As Long '延时

Private WithEvents webd As MSHTML.HTMLDocument 'html文档

Private Const WM_LBUTTONDOWN = &H201 '鼠标按下

Private Const WM_LBUTTONUP = &H202 '鼠标松开

Private Const SW_SHOW = 0 '5为显示

Private Const SWP_NOSIZE = &H1

Private Const HWND_TOPMOST& = -1

Dim clsWb1 As New clsWBMaster '定义wbmaster控件

'============================================================================================================

' SetWindowPos 另存为句柄, HWND_TOPMOST, 1600, 800, 0, 0, SWP_NOSIZE 窗体移动代码

'============================================================================================================

'延时方法

Private Function Delay(MSceond As Long)

Dim i As Long

If MSceond < 2 Then Exit Function

i = GetTickCount

Do While GetTickCount - i < MSceond

DoEvents

Loop

End Function

'============================================================================================================

'一键下载

Private Sub Command1_Click()

Label1.Caption = "☆程序正在运行请不要对屏幕进行操作☆"

'开始计时点击

Timer1.Interval = 500

Timer1.Enabled = True

List1.Clear

Dim a, b, sou

a = Split(Text1.Text, vbCrLf)

For b = LBound(a) To UBound(a)

List1.AddItem a(b)

Next

For sou = 0 To List1.ListCount

clsWb1.SetAttribEx WebBrowser1, wmTagInput, wmAttribType, "text", wmAttribValue, List1.List(sou) & ".pdf"

clsWb1.ClickTag WebBrowser1, wmTagA, wmAttribTitle, "搜索"

Delay (4000)

clsWb1.ClickTag WebBrowser1, wmTagSpan, wmAttribClassName, "edocDocTabsetSelectorText"

clsWb1.ClickTag WebBrowser1, wmTagDiv, wmAttribClassName, "ls out"

'clsWb1.ClickTag WebBrowser1, wmTagA, wmAttribClassName, "jueChkBox"

clsWb1.ClickTag WebBrowser1, wmTagSpan, wmAttribId, "docTbiDownload"

clsWb1.ClickTag WebBrowser1, wmTagSpan, wmAttribClassName, "edocDocTabsetBtnClose"

Next sou

Delay (20000)

Timer1.Enabled = False

Label1.Caption = "PDF文件下载完成"

Delay (1000)

Label1.Caption = ""

End Sub

Private Sub Command2_Click()

'填写登录信息

clsWb1.SetAttribEx WebBrowser1, wmTagInput, wmAttribId, "txtAccount", wmAttribValue, "用户名" '自行根据网页元素更改

clsWb1.SetAttribEx WebBrowser1, wmTagInput, wmAttribId, "password", wmAttribValue, "密码" '自行根据网页元素更改

clsWb1.ClickTag WebBrowser1, wmTagInput, wmAttribType, "submit"

End Sub

'============================================================================================================

'窗体启动动作

Private Sub Form_Load()

SetWindowPos Me.hWnd, -1, 0, 0, 0, 0, 2 Or 1

SetWindowStyle Me.hWnd, GWL_ExStyle, WS_EX_CLIENTEDGE, AddStyle

SetWindowStyle Me.hWnd, GWL_Style, WS_HSCROLL, AddStyle

'API postmessge开始计时

' Timer1.Interval = 500

' Timer1.Enabled = True

Me.Width = Screen.Width / 2

Me.Height = Screen.Height / 1.3

Me.Move 0, 0

WebBrowser1.Top = 48 * 15

WebBrowser1.Left = 50

WebBrowser1.Silent = True

'建立空网页

WebBrowser1.Navigate "about:blank"

Set webd = WebBrowser1.Document

'填写网址

WebBrowser1.Navigate "填写网址"

End Sub

'============================================================================================================

'窗体及webbrowser大小调节

Private Sub Form_Resize()

If Me.WindowState = 1 Then Exit Sub

WebBrowser1.Width = Me.ScaleWidth

WebBrowser1.Height = Me.ScaleHeight - WebBrowser1.Top

End Sub

'============================================================================================================

'窗体关闭事件

Private Sub Form_Unload(Cancel As Integer)

Set clsWb1 = Nothing

End Sub

'============================================================================================================

'间隔查询窗体，并获取句柄

Private Sub Timer1_Timer()

Dim 文件下载窗口句柄, 另存为句柄, 确认另存为句柄, 取消句柄 As Long

Dim 文件保存1, 文件保存2, 另存为, 取消窗体 As Long

Dim 点击按钮1, 点击按钮2, 是按钮, 取消按钮 As Long

文件下载窗口句柄 = FindWindow("#32770", "文件下载")

If 文件下载窗口句柄 <> 0 Then

SetWindowPos 另存为句柄, -1, 0, 0, 0, 0, 2 Or 1

ShowWindow 文件下载窗口句柄, SW_SHOW

文件保存1 = FindWindowEx(文件下载窗口句柄, 0&, "Button", "保存(&S)")

点击按钮1 = PostMessage(文件保存1, WM_LBUTTONDOWN, &H0, &H0)

点击按钮1 = PostMessage(文件保存1, WM_LBUTTONUP, &H0, &H0)

End If

另存为句柄 = FindWindow("#32770", "另存为")

If 另存为句柄 <> 0 Then

SetWindowPos 另存为句柄, -1, 0, 0, 0, 0, 2 Or 1

ShowWindow 另存为句柄, SW_SHOW

文件保存2 = FindWindowEx(另存为句柄, 0&, "Button", "保存(&S)")

点击按钮2 = PostMessage(文件保存2, WM_LBUTTONDOWN, &H0, &H0)

点击按钮2 = PostMessage(文件保存2, WM_LBUTTONUP, &H0, &H0)

End If

确认另存为句柄 = FindWindow("#32770", "相应窗口标题，自行查找")

If 确认另存为句柄 > 0 Then

SetWindowPos 确认另存为句柄, -1, 0, 0, 0, 0, 2 Or 1

另存为 = FindWindowEx(确认另存为句柄, ByVal 0&, "#32770", "另存为")

If 另存为 > 0 Then

另存为 = FindWindowEx(另存为, ByVal 0&, "#32770", "确认另存为")

If 另存为 > 0 Then

另存为 = FindWindowEx(另存为, ByVal 0&, "DirectUIHWND", vbNullString)

If 另存为 > 0 Then

另存为 = FindWindowEx(另存为, ByVal 0&, "CtrlNotifySink", vbNullString)

If 另存为 > 0 Then

另存为 = FindWindowEx(另存为, ByVal 0&, "Button", "是(&Y)")

是按钮 = PostMessage(另存为, WM_LBUTTONDOWN, &H0, &H0)

是按钮 = PostMessage(另存为, WM_LBUTTONUP, &H0, &H0)

End If

End If

End If

End If

End If

取消句柄 = FindWindow("#32770", "相应窗口标题，自行查找")

If 取消句柄 > 0 Then

SetWindowPos 取消句柄, -1, 0, 0, 0, 0, 2 Or 1

取消窗体 = FindWindowEx(取消句柄, ByVal 0&, "Button", "取消")

取消按钮 = PostMessage(取消窗体, WM_LBUTTONDOWN, &H0, &H0)

取消按钮 = PostMessage(取消窗体, WM_LBUTTONUP, &H0, &H0)

End If

End Sub

'============================================================================================================

'判断网页是否加载完毕

'clsWb1.Wait 2000'延时演示

Private Sub WebBrowser1_DocumentComplete(ByVal pDisp As Object, URL As Variant)

If pDisp Is WebBrowser1.object Then

End If

End Sub

'============================================================================================================

'禁止弹出webbrowser窗体

Private Sub WebBrowser1_NavigateComplete2(ByVal pDisp As Object, URL As Variant)

WebBrowser1.Document.parentWindow.ExecScript "window.alert=null;"

End Sub

'============================================================================================================

具体代码及插件自行下载体验！

链接：https://pan.baidu.com/s/1gQHblnKTZDwR2CGrjIL-Tw 密码：qs04

转载请注明出处！