form1.vb

利用webbrowser控件自动填写密码,并读取网页上指定数据的源码,实用价值高.

Public Class Form1
    Inherits System.Windows.Forms.Form

    Dim cmdid As Byte
#Region " Windows 窗体设计器生成的代码 "

    Public Sub New()
        MyBase.New()

        '该调用是 Windows 窗体设计器所必需的。
        InitializeComponent()

        '在 InitializeComponent() 调用之后添加任何初始化

    End Sub

    '窗体重写 dispose 以清理组件列表。
    Protected Overloads Overrides Sub Dispose(ByVal disposing As Boolean)
        If disposing Then
            If Not (components Is Nothing) Then
                components.Dispose()
            End If
        End If
        MyBase.Dispose(disposing)
    End Sub

    'Windows 窗体设计器所必需的
    Private components As System.ComponentModel.IContainer

    '注意: 以下过程是 Windows 窗体设计器所必需的
    '可以使用 Windows 窗体设计器修改此过程。
    '不要使用代码编辑器修改它。
    Friend WithEvents lbl As System.Windows.Forms.Label
    Friend WithEvents AxWebBrowser1 As AxSHDocVw.AxWebBrowser
    Friend WithEvents Timer1 As System.Windows.Forms.Timer
    Friend WithEvents NotifyIcon1 As System.Windows.Forms.NotifyIcon
    Friend WithEvents cmd As System.Windows.Forms.Button
    <System.Diagnostics.DebuggerStepThrough()> Private Sub InitializeComponent()
        Me.components = New System.ComponentModel.Container
        Dim resources As System.Resources.ResourceManager = New System.Resources.ResourceManager(GetType(Form1))
        Me.lbl = New System.Windows.Forms.Label
        Me.AxWebBrowser1 = New AxSHDocVw.AxWebBrowser
        Me.cmd = New System.Windows.Forms.Button
        Me.Timer1 = New System.Windows.Forms.Timer(Me.components)
        Me.NotifyIcon1 = New System.Windows.Forms.NotifyIcon(Me.components)
        CType(Me.AxWebBrowser1, System.ComponentModel.ISupportInitialize).BeginInit()
        Me.SuspendLayout()
        '
        'lbl
        '
        Me.lbl.Dock = System.Windows.Forms.DockStyle.Bottom
        Me.lbl.Location = New System.Drawing.Point(0, 226)
        Me.lbl.Name = "lbl"
        Me.lbl.Size = New System.Drawing.Size(384, 40)
        Me.lbl.TabIndex = 0
        Me.lbl.Text = "Label1"
        '
        'AxWebBrowser1
        '
        Me.AxWebBrowser1.Dock = System.Windows.Forms.DockStyle.Top
        Me.AxWebBrowser1.Enabled = True
        Me.AxWebBrowser1.Location = New System.Drawing.Point(0, 0)
        Me.AxWebBrowser1.OcxState = CType(resources.GetObject("AxWebBrowser1.OcxState"), System.Windows.Forms.AxHost.State)
        Me.AxWebBrowser1.Size = New System.Drawing.Size(384, 192)
        Me.AxWebBrowser1.TabIndex = 1
        '
        'cmd
        '
        Me.cmd.Location = New System.Drawing.Point(64, 200)
        Me.cmd.Name = "cmd"
        Me.cmd.Size = New System.Drawing.Size(224, 23)
        Me.cmd.TabIndex = 7
        Me.cmd.Text = "已存略过"
        '
        'Timer1
        '
        Me.Timer1.Interval = 600000
        '
        'NotifyIcon1
        '
        Me.NotifyIcon1.Icon = CType(resources.GetObject("NotifyIcon1.Icon"), System.Drawing.Icon)
        Me.NotifyIcon1.Text = "测试程序"
        Me.NotifyIcon1.Visible = True
        '
        'Form1
        '
        Me.AutoScaleBaseSize = New System.Drawing.Size(6, 14)
        Me.ClientSize = New System.Drawing.Size(384, 266)
        Me.Controls.Add(Me.cmd)
        Me.Controls.Add(Me.AxWebBrowser1)
        Me.Controls.Add(Me.lbl)
        Me.Icon = CType(resources.GetObject("$this.Icon"), System.Drawing.Icon)
        Me.Name = "Form1"
        Me.ShowInTaskbar = False
        Me.Text = "测试系统"
        Me.WindowState = System.Windows.Forms.FormWindowState.Minimized
        CType(Me.AxWebBrowser1, System.ComponentModel.ISupportInitialize).EndInit()
        Me.ResumeLayout(False)

    End Sub

#End Region

    Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
        FormatDateTime(Now, DateFormat.ShortDate)

        Timer1.Start()




    End Sub



    Private Sub AxWebBrowser1_DocumentComplete(ByVal sender As Object, ByVal e As AxSHDocVw.DWebBrowserEvents2_DocumentCompleteEvent) Handles AxWebBrowser1.DocumentComplete


     
        '网页加载完毕
        Try
            '条件页面,自动填写查询条件
            If cmdid = 1 Then
                Dim form
                form = AxWebBrowser1.Document.getElementsByTagName("form")(0)
                With form
                    .intperpagecount.value = CInt(99)
                    .rbksj_dj_xx.value = FormatDateTime(Now, DateFormat.ShortDate)      '起始日期
                    .rbksj_dj_sx.value = FormatDateTime(Now, DateFormat.ShortDate)      '结束日期
                    .submit.select()
                    .submit.click()                 '点击确定
                End With
                cmdid = 2

                '信息页面,读数据,存盘,翻页
            ElseIf cmdid = 2 Then

                Dim tables, table1, row, cell, links
                Dim t_no As Integer, i As Integer, j As Integer
                Dim sql1, sql As String
                Dim conn As ADODB.Connection
                Dim rs As ADODB.Recordset
                Dim rs1 As ADODB.Recordset
                conn = New ADODB.Connection

                With conn
                    .Provider = "Microsoft.Jet.OLEDB.4.0"
                    .ConnectionString = Application.StartupPath() & "\sdszy.Mdb"
                    .Open()
                End With

                tables = AxWebBrowser1.Document.getElementsByTagName("table")
                For t_no = 0 To tables.length - 1   '轮巡表格
                    If Strings.Left(tables(t_no).innertext, 2) = "序号" Then    '查找信息表格
                        table1 = tables(t_no)       '定义本表
                        For i = 1 To table1.rows.length - 1         '每行
                            row = table1.rows(i)        '定义本行
                            '检查有无重复
                            rs1 = New ADODB.Recordset
                            sql1 = "select sfzh from ztry where date=#" & FormatDateTime(Now, DateFormat.ShortDate) & "# and sfzh='" & Trim(row.cells(4).innerText) & "'"
                            rs1.Open(sql1, conn, ADODB.CursorTypeEnum.adOpenForwardOnly, ADODB.LockTypeEnum.adLockReadOnly)

                            'If rs1.EOF Then     '无重复,写入数据库
                            rs = New ADODB.Recordset
                            sql = "select * from ztry"
                            rs.Open(sql, conn, ADODB.CursorTypeEnum.adOpenForwardOnly, ADODB.LockTypeEnum.adLockPessimistic)
                            rs.AddNew()
                            rs.Fields("xh").Value = Trim(row.cells(0).innerText)
                            rs.Fields("name").Value = Trim(row.cells(2).innerText)
                            rs.Fields("sex").Value = Trim(row.cells(3).innerText)
                            rs.Fields("sfzh").Value = Trim(row.cells(4).innerText)
                            rs.Fields("ajlb").Value = Trim(row.cells(6).innerText)
                            rs.Fields("ladw").Value = Trim(row.cells(7).innerText)
                            rs.Fields("bz").Value = 0
                            'rs.Fields("date").Value = FormatDateTime(Now, DateFormat.ShortDate)
                            rs.Fields("date").Value = Now
                            rs.Update()
                            rs.Close()
                            rs = Nothing
                            'End If
                            rs1.Close()
                            rs1 = Nothing
                        Next i
                    ElseIf Strings.Left(tables(t_no).innertext, 2) = "查询" Then    '查找"下一页"所在表格
                        links = tables(t_no).getElementsByTagName("a")      '定义超级链接
                        For j = 0 To links.length - 1 '每个超级链接
                            If Trim(links(j).innertext) = "[下一页]" Then
                                links(j).click()
                                cmdid = 2
                            Else
                                cmdid = 0
                            End If
                        Next j
                    End If
                Next t_no
                conn.Close()
                conn = Nothing
            End If


        Catch ex As Exception
            MsgBox(ex.Message)
            MsgBox(ex.StackTrace)
        End Try

    End Sub





    Private Sub cmd_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles cmd.Click
        '翻页,已存掠过

        AxWebBrowser1.Refresh()
        'AxWebBrowser1.Navigate("http://ztry.xz.ga/ztrydj/DJQueryDetail.jsp?type=9")
        AxWebBrowser1.Navigate("http://www.sdzydfy.com/1.htm")
        AxWebBrowser1.AllowDrop = False
        AxWebBrowser1.Silent = True
        cmdid = 1
    End Sub

    Private Sub Timer1_Tick(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Timer1.Tick

        Try
            AxWebBrowser1.Refresh()
            'AxWebBrowser1.Navigate("http://ztry.xz.ga/ztrydj/DJQueryDetail.jsp?type=9")
            AxWebBrowser1.Navigate("http://www.sdzydfy.com/1.htm")
            AxWebBrowser1.AllowDrop = False
            AxWebBrowser1.Silent = True
            cmdid = 1

        Catch ex As Exception
            MsgBox(ex.Message)
            MsgBox(ex.StackTrace)
        End Try
    End Sub

    Private Sub Form1_Resize(ByVal sender As Object, ByVal e As System.EventArgs) Handles MyBase.Resize
        If Me.WindowState = FormWindowState.Minimized Then
            Me.Hide()
        End If
    End Sub

    Private Sub NotifyIcon1_DoubleClick(ByVal sender As Object, ByVal e As System.EventArgs) Handles NotifyIcon1.DoubleClick
        Me.ShowInTaskbar = True
        Me.Show()
        Me.WindowState = FormWindowState.Normal
    End Sub

    Private Sub chk(ByVal sfzh As String)

    End Sub

End Class