form1.vb

将数据库内的信息到指定网站验证,验证通过的记入数据库.利用webbrowser控件.

Public Class Form1
   

    Inherits System.Windows.Forms.Form

   
    Dim result As Byte              '验证结果,修改bz字段用,初始值0,未找到1,找到2,信息已发送3
    Dim info As String
    Dim ready As Boolean            '验证页面状态
    Dim cmdid2 As Byte, url As String


#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 AxWebBrowser1 As AxSHDocVw.AxWebBrowser
    Friend WithEvents cmd1 As System.Windows.Forms.Button
    Friend WithEvents cmd2 As System.Windows.Forms.Button
    Friend WithEvents lbl As System.Windows.Forms.Label
    Friend WithEvents TextBox1 As System.Windows.Forms.TextBox
    <System.Diagnostics.DebuggerStepThrough()> Private Sub InitializeComponent()
        Dim resources As System.Resources.ResourceManager = New System.Resources.ResourceManager(GetType(Form1))
        Me.AxWebBrowser1 = New AxSHDocVw.AxWebBrowser
        Me.lbl = New System.Windows.Forms.Label
        Me.cmd1 = New System.Windows.Forms.Button
        Me.cmd2 = New System.Windows.Forms.Button
        Me.TextBox1 = New System.Windows.Forms.TextBox
        CType(Me.AxWebBrowser1, System.ComponentModel.ISupportInitialize).BeginInit()
        Me.SuspendLayout()
        '
        'AxWebBrowser1
        '
        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(368, 150)
        Me.AxWebBrowser1.TabIndex = 0
        '
        'lbl
        '
        Me.lbl.Location = New System.Drawing.Point(0, 200)
        Me.lbl.Name = "lbl"
        Me.lbl.Size = New System.Drawing.Size(368, 48)
        Me.lbl.TabIndex = 1
        Me.lbl.Text = "Label1"
        '
        'cmd1
        '
        Me.cmd1.Location = New System.Drawing.Point(40, 160)
        Me.cmd1.Name = "cmd1"
        Me.cmd1.TabIndex = 2
        Me.cmd1.Text = "找到"
        '
        'cmd2
        '
        Me.cmd2.Location = New System.Drawing.Point(168, 160)
        Me.cmd2.Name = "cmd2"
        Me.cmd2.TabIndex = 3
        Me.cmd2.Text = "测试"
        '
        'TextBox1
        '
        Me.TextBox1.Location = New System.Drawing.Point(24, 208)
        Me.TextBox1.Name = "TextBox1"
        Me.TextBox1.Size = New System.Drawing.Size(320, 21)
        Me.TextBox1.TabIndex = 4
        Me.TextBox1.Text = "TextBox1"
        '
        'Form1
        '
        Me.AutoScaleBaseSize = New System.Drawing.Size(6, 14)
        Me.ClientSize = New System.Drawing.Size(368, 254)
        Me.Controls.Add(Me.TextBox1)
        Me.Controls.Add(Me.cmd2)
        Me.Controls.Add(Me.cmd1)
        Me.Controls.Add(Me.lbl)
        Me.Controls.Add(Me.AxWebBrowser1)
        Me.Name = "Form1"
        Me.Text = "Form1"
        CType(Me.AxWebBrowser1, System.ComponentModel.ISupportInitialize).EndInit()
        Me.ResumeLayout(False)

    End Sub

#End Region




    Private Sub cmd1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles cmd1.Click
        Try
            Dim conn As New ADODB.Connection
            Dim rs As ADODB.Recordset
            Dim SQL As String
            Dim rs1 As ADODB.Recordset
            Dim SQL1 As String
            AxWebBrowser1.Refresh()
            AxWebBrowser1.Navigate("http://www.sdzydfy.com/3.asp")
            cmdid2 = 1
            Do While AxWebBrowser1.Busy
                Application.DoEvents()
            Loop

            conn = New ADODB.Connection

            With conn
                .Provider = "Microsoft.Jet.OLEDB.4.0"
                .ConnectionString = Application.StartupPath() & "\sdszy.Mdb"
                .Open()
            End With
            rs = New ADODB.Recordset
            SQL = "select * from ztry where bz=0 "
            rs.Open(SQL, conn, ADODB.CursorTypeEnum.adOpenForwardOnly, ADODB.LockTypeEnum.adLockPessimistic)

            rs1 = New ADODB.Recordset
            SQL1 = "select * from result "
            rs1.Open(SQL1, conn, ADODB.CursorTypeEnum.adOpenForwardOnly, ADODB.LockTypeEnum.adLockPessimistic)
            Do While Not rs.EOF
                url = "http://www.sdzydfy.com/5.asp?condition=" & rs.Fields("sfzh").Value
                AxWebBrowser1.Navigate(url)
                ready = False
                Do While ready = False
                    Application.DoEvents()
                Loop
                If result = 1 Then
                    rs.Fields("bz").Value = 1
                    rs.Update()
                ElseIf result = 2 Then
                    rs.Fields("bz").Value = 2
                    rs.Update()
                    rs1.AddNew()
                    rs1.Fields("name").Value = rs.Fields("name").Value
                    rs1.Fields("sex").Value = rs.Fields("sex").Value
                    rs1.Fields("sfzh").Value = rs.Fields("sfzh").Value
                    rs1.Fields("ajlb").Value = rs.Fields("ajlb").Value
                    rs1.Fields("ladw").Value = rs.Fields("ladw").Value
                    rs1.Fields("date").Value = rs.Fields("date").Value
                    rs1.Fields("info").Value = info
                    rs1.Update()

                End If
                lbl.Text = rs.Fields("name").Value
                rs.MoveNext()
            Loop
            lbl.Text = "完毕"
        Catch ex As Exception
            MsgBox(ex.Message)
            MsgBox(ex.StackTrace)
        End Try
    End Sub

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

        Try
            lbl.Text = lbl.Text & "," & AxWebBrowser1.LocationURL
            Dim table1, row As Object
            Dim doc As Object, tables As Object, i As Integer
            Dim j As Integer
            tables = AxWebBrowser1.Document.getElementsByTagName("table")
            result = 1
            For i = 0 To tables.length - 1
                If Trim(Strings.Left(tables(i).innertext(), 2)) = "详情" Then
                    result = 2
                    For j = 1 To tables(i).rows.length - 1         '每行
                        row = tables(i).rows(j)        '定义本行
                        If Strings.Left(row.innertext(), 2) = "详情" Then
                            info = Trim(row.cells(5).innerText) & "," & Trim(row.cells(6).innerText)
                        End If
                    Next j
                End If
            Next
            ready = True


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

    End Sub

    Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
       
    End Sub

    Private Sub cmd2_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles cmd2.Click
        
        AxWebBrowser1.Refresh()
        AxWebBrowser1.Navigate("http://www.sdzydfy.com/3.asp")
        cmdid2 = 1
     
       
    End Sub
End Class