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



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

本文分享自微信公众号 - VB小源码(vb_xym)

原文出处及转载信息见文内详细说明,如有侵权,请联系 yunjia_community@tencent.com 删除。

原始发表时间:2019-05-10

本文参与腾讯云自媒体分享计划,欢迎正在阅读的你也加入,一起分享。

发表于

我来说两句

0 条评论
登录 后参与评论

相关文章

来自专栏大数据在线

贴近中国开源需求,本土开源平台将走出差异化之路

2005年,Linux之父Linus Torvalds推出了版本控制系统Git,再一次改变了世界。在Git诞生之前,开发者们之间进行编程协作的方式很少,Git通...

15440
来自专栏量子位

字节跳动开源分布式训练框架BytePS,登上GitHub热榜

字节跳动开源了通用分布式训练框架BytePS,这个框架支持TensorFlow、Keras、PyTorch、MXNet,可以运行在TCP或RDMA网络中。

18030
来自专栏大数据在线

2019年云计算第一撕:AWS为什么和MongoDB怼上?

近日,AWS宣布正式推出文档数据库服务:DocumentDB。AWS DocumentDB是一项支持MongoDB工作负载的文档数据库服务,硬怼MongoDB的...

9330
来自专栏量子位

用自然语言从GitHub搜代码,跳过论坛提问环节,来自Facebook新研究

如果你是个Android入门开发者,去Stack Overflow论坛去寻找上非常热门的Android开发问题,很快会有别人贴出一段代码。

13260
来自专栏Bypass

PHP代码审计笔记--任意文件上传

基于安全方面的考虑,应增加用户上传文件的限制,比如检查文件类型、限制文件大小,限定文件路径,文件名重命名、白名单限制文件上传类型等。

10920
来自专栏大数据在线

2019年中国云计算十大预测:有重量级的并购发生?

前有BAT纷纷调整组织架构,云计算均被互联网巨头们提升为战略级业务,一场云计算大战在所难免;后有她拍起诉腾讯云,要求索赔一个亿,让腾讯云再次处于风口浪尖。可以预...

15940
来自专栏机器人课程与技术

使用Scratch3和ROS进行机器人图形化编程学习

为了让更多小朋友,尤其是小学以及幼儿园的孩子,可以接触和使用ROS,无缝对接scratch编程/AI/ROS。

22040
来自专栏腾讯开源的专栏

腾讯荣获唯一OSCAR尖峰开源企业奖

7月3日,由中国信息通信研究院主办的2019云计算开源产业大会在北京举办。腾讯开源独揽尖峰开源企业奖、尖峰开源技术创新奖(自主研发项目)、尖峰开源技术创新奖(...

12530
来自专栏量子位

被骂了三年,谷歌Dropout专利还是生效了,卡脖子预警

所谓Dropout是一种搞深度学习、训练神经网络时,普遍会用到的方法,由Hinton于2012年提出,可以有效防止过拟合。

12830
来自专栏Bypass

Nessus中文报告自动化脚本

在上一篇文章《利用Python半自动化生成Nessus报告》中,提供了一个demo和中文漏洞库,总感觉少了点什么。这两天,抽空完善了一下脚本,可支持中文...

24340

扫码关注云+社区

领取腾讯云代金券

年度创作总结 领取年终奖励