VB.NET 结合Access数据库开发的含有<验证码>系统登录示例

Imports System.Data.OleDb
Public Class FRM_LOGIN
    Public userpass As String
    Public qqx As String
    Dim yzm_m As String = "**************"

    Private Sub FRM_LOGIN_Load(sender As Object, e As EventArgs) Handles MyBase.Load
        ''**********************************
        BT_OK.BackColor = Color.Transparent
        BT_QX.BackColor = Color.Transparent
        PICC1.BackColor = Color.Transparent
        PICC2.BackColor = Color.Transparent
        PICC3.BackColor = Color.Transparent
        PICC4.BackColor = Color.Transparent
        ''**********************************

    End Sub

#Region "返回验证码"
    Sub GET_YZM()
        Try
            Randomize()
            Dim YZM_TMP As String = ""
            Do While Len(YZM_TMP) < 4
                Dim YZM As String = Chr((57 - 48) * Rnd() + 48)
                YZM_TMP &= YZM
            Loop
            ''*****************
            For j As Integer = 1 To Len(YZM_TMP)
                Dim STR As String = Mid(YZM_TMP, j, 1)
                Dim I As Integer = Int(STR)
                Dim pic As PictureBox = Controls("PICC" & j)
                pic.Image = ImgList.Images.Item(I)
            Next
            ''******************
            yzm_m = YZM_TMP
            ''*******************
            CN_DB(userpass, qqx)
        Catch ex As Exception
            MsgBox("无法创建验证码:" & ex.Message, vbCritical, "VB小源码")
        End Try
    End Sub
#End Region

#Region "验证码事件"
    Dim TF_CODE As Boolean = True
    Private Sub TXT_YZM_Click(sender As Object, e As EventArgs) Handles TXT_YZM.Click
        If TF_CODE = True And TXT_USER.Text <> "" And TXT_PASS.Text <> "" Then
            GET_YZM()
            TF_CODE = False
        End If
    End Sub

    Private Sub PICC1_Click(sender As Object, e As EventArgs) Handles PICC1.Click
        If TXT_USER.Text <> "" And TXT_PASS.Text <> "" Then
            GET_YZM()
            TF_CODE = False
        End If
    End Sub

    Private Sub PICC2_Click(sender As Object, e As EventArgs) Handles PICC2.Click
        If TXT_USER.Text <> "" And TXT_PASS.Text <> "" Then
            GET_YZM()
            TF_CODE = False
        End If
    End Sub

    Private Sub PICC3_Click(sender As Object, e As EventArgs) Handles PICC3.Click
        If TXT_USER.Text <> "" And TXT_PASS.Text <> "" Then
            GET_YZM()
            TF_CODE = False
        End If
    End Sub

    Private Sub PICC4_Click(sender As Object, e As EventArgs) Handles PICC4.Click
        If TXT_USER.Text <> "" And TXT_PASS.Text <> "" Then
            GET_YZM()
            TF_CODE = False
        End If
    End Sub

#End Region

    Private Sub BT_OK_Click(sender As Object, e As EventArgs) Handles BT_OK.Click
        If yzm_m = TXT_YZM.Text Then
            If userpass = TXT_PASS.Text Then
                FRM_MAIN.Show()
                Visible = False
            Else
                MsgBox("密码错误!", vbCritical, "警告")
            End If
        Else
                If TXT_YZM.Text = "" Then
                MsgBox("请输入验证码!", vbCritical, "警告")
            Else
                MsgBox("验证码错误!", vbCritical, "警告")
            End If
        End If
    End Sub

#Region "窗体事件"
    Dim mo_ok As Boolean = False
    Dim sele_ok As Point
    Dim mo_wz As Point
    Private Sub FRM_LOGIN_MouseDown(sender As Object, e As MouseEventArgs) Handles Me.MouseDown
        mo_ok = True
        sele_ok = New Point(e.X, e.Y)
    End Sub
    Private Sub FRM_LOGIN_MouseMove(sender As Object, e As MouseEventArgs) Handles Me.MouseMove
        mo_wz = New Point(e.X, e.Y)
        If mo_ok = True Then
            Location = PointToScreen(mo_wz) - sele_ok
        End If
    End Sub

    Private Sub FRM_LOGIN_MouseUp(sender As Object, e As MouseEventArgs) Handles Me.MouseUp
        mo_ok = False
    End Sub

    Private Sub BT_CL_Click(sender As Object, e As EventArgs) Handles BT_CL.Click
        If MsgBox("您确定要退出吗?", vbYesNo, "退出") = vbYes Then
            Close()
        End If

    End Sub

    Private Sub BT_QX_Click(sender As Object, e As EventArgs) Handles BT_QX.Click
        If MsgBox("您确定要退出吗?", vbYesNo, "退出") = vbYes Then
            Close()
        End If
    End Sub
#End Region

#Region "获取用户信息"
    Function CN_DB(ByRef user As String, ByRef ad_qx As String) As Boolean
        Try
            Dim cnStr As String = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & Application.StartupPath & "\userdata.mdb;Persist Security Info=False"
            Dim CN As OleDbConnection = New OleDbConnection(cnStr)
            Dim sql As String = "select `密码`,`管理员` from tb_user where 用户名='" & TXT_USER.Text & "';"
            Dim DA As OleDbDataAdapter = New OleDbDataAdapter(sql, CN)
            Dim DS As DataSet = New DataSet
            DA.Fill(DS, "tb_user")
            user = DS.Tables(0).Rows(0)(0).ToString
            ad_qx = DS.Tables(0).Rows(0)(1).ToString
            Return True
        Catch ex As Exception
            Return False
        End Try
    End Function
#End Region

End Class

Imports System.Data.OleDb
Public Class FRM_MAIN
    Private Sub FRM_MAIN_Load(sender As Object, e As EventArgs) Handles MyBase.Load
        Dim qx As String = FRM_LOGIN.qqx
        Dim name As String
        If qx = 1 Then
            name = "管理员"
        Else
            name = "会员"
        End If
        Label1.Text = "当前用户:" & FRM_LOGIN.TXT_USER.Text & "-->" & name
        Label1.BackColor = Color.Transparent
        ''**********************************
        Dim cnStr As String = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & Application.StartupPath & "\userdata.mdb;Persist Security Info=False"
        Dim CN As OleDbConnection = New OleDbConnection(cnStr)
        Dim sql As String = "select * from tb_user"
        Dim DA As OleDbDataAdapter = New OleDbDataAdapter(sql, CN)
        Dim DS As DataSet = New DataSet
        DA.Fill(DS, "tb_user")
        DataGridView1.DataSource = DS.Tables(0)
    End Sub

    Private Sub FRM_MAIN_Closed(sender As Object, e As EventArgs) Handles Me.Closed
        If MsgBox("您确定要退出吗?", vbYesNo, "退出") = vbYes Then
            FRM_LOGIN.Close()
        End If
    End Sub

    Private Sub DataGridView1_CellContentClick(sender As Object, e As DataGridViewCellEventArgs) Handles DataGridView1.CellContentClick

    End Sub
End Class

源码下载:
https://www.lanzous.com/i43y93i