如何用VB连接SQL数据库做登录

一、界面设计

各控件名称属性分别为：label1  、text1 、label2、text2、commandok、cmdcancel

登录成功后显示的窗体：

代码设计如下：

'首先添加一个模块，写上以下通用声明和Sub main()：

Public conn As ADODB.Connection    '通用（声明）

Sub main()

  Set conn = New ADODB.Connection   '通用（main）

   conn.ConnectionString = "Provider=SQLOLEDB.1Persist Security Info=False" _

   + "User ID=sapassword=123Initial Catalog=dengluData Source=127.0.0.1"      '连接数据库代码

  conn.Open

frmLogin.Show     '首先显示登录界面。也可以在工程属性中设置启动对象为Sub main()或者frmlogin窗体

End Sub

'在Frmlogin 代码窗口，为cmdok控件写以下代码：

Private Sub cmdok_Click()

If text1.Text = "" Then

      MsgBox "用户名不能为空！", vbOKOnly + vbInformation, "友情提示"

      text1.SetFocus

      Exit Sub       '若用户名文本框内为空，则出现提示框

  End If

  If text2.Text = "" Then

      MsgBox "密码不能为空！", vbOKOnly + vbInformation, "友情提示"

      text2.SetFocus

      Exit Sub     '若输入密码文本框为空，也出现提示框

  End If

  Dim strSQl As String  

  strSQl = "select * from User1 where username='" &Trim$(text1.Text) &"' and pwd='" &Trim$(text2.Text) &"' "  

  '书写SQL代码，查询User1表中是否存在窗体中用户输入的信息。

  Dim str As New ADODB.Recordset

  Set str = New ADODB.Recordset

  str.CursorLocation = adUseClient

  str.Open strSQl, conn, adOpenStatic, adLockReadOnly

  With str

      If .State = adStateOpen Then .Close

      .Open strSQl

      If .EOF Then

          Try_times = Try_times + 1

          If Try_times >= 3 Then

              MsgBox "您已连续三次输入错误，系统将自动关闭", vbOKOnly + vbCritical, "警告"

              Unload Me            '若用户连续输入3次错误密码，则系统关闭

          Else

              MsgBox "对不起，用户名不存在或密码错误 ！", vbOKOnly + vbQuestion, "警告"

              text1.SetFocus

              text1.Text = ""

              text2.Text = ""

          End If

      Else

       

          Unload Me    '若登录成功，则隐藏当前窗体

       

        Form2.Show    '然后显示Form窗体          

      End If

  End With

End Sub

Private Sub cmdCancel_Click()  

End         '若单击Cmdcel按钮，则结束应用程序

End Sub

运行中存在的问题：

代码中有Dim conn As adodb.connection，运行时显示"用户定义类型未定义"

解决方法：点击“工程”--“引用”找到“Microsoft ActiveX Data Object 2.6”

然后就就可以正常运行了。

界面设计:

1.ComboBox 名为: CboName 用来输入或显示用户名

2.TextBox 名为:TxtPassword 用来输入密码

3.TextBox 名为:TxtPasswordSure 在注册时用来输入确认密码

4.CheckBox 名为:ChkNew 用来新注册 Caption属性:新建用户

5.CommandButton 名为:CmdLoad 用来登陆或注册 Caption属性:登陆

6.CommandButton 名为:CmdExit 用以退出 Caption 属性:退出

7.Data 不需要多设置,这个控件不用的,只是第一次加载时起作用.Visible属性:False

代码如下:

Dim MyTable As TableDef

Dim MyField As Field

Dim MyDatabase As Database

Dim Myrs As Recordset

Dim StrRule As String

Private Sub CboName_Change()

If Len(CboName.Text) >8 Then

CboName.SelStart = 0

CboName.SelLength = 8

CboName.Text = CboName.SelText

CboName.SelStart = 8

End If

End Sub

Private Sub ChkNew_Click()

If ChkNew.Value = 0 Then

LblPasswordsure.Visible = False

TxtPasswordSure.Visible = False

CmdLoad.Caption = "登陆"

Else

LblPasswordsure.Visible = True

TxtPasswordSure.Visible = True

CmdLoad.Caption = "注册"

End If

CboName.SetFocus

End Sub

Private Sub CmdExit_Click()

End

End Sub

Private Sub CmdLoad_Click()

If CboName.Text = "" Then

MsgBox "请输入用户名!", vbExclamation, "友情提示"

CboName.SetFocus

Exit Sub

ElseIf TxtPassword.Text = "" Then

MsgBox "请输入密码!", vbExclamation, "友情提示"

TxtPassword.SetFocus

Exit Sub

ElseIf TxtPasswordSure.Text = "" And TxtPasswordSure.Visible = True Then

MsgBox "请输入确认密码!", vbExclamation, "友情提示"

TxtPasswordSure.SetFocus

Exit Sub

End If

If CmdLoad.Caption = "注册" Then

If TxtPasswordSure.Text <>TxtPassword.Text Then

MsgBox "密码和确认密码不同!", vbExclamation, "Sorry"

TxtPasswordSure.SetFocus

Exit Sub

End If

If CheckStr(CboName.Text) Then

MsgBox "用户名可以是中文,也可以是英文或数字,但其中不能带有" &vbNewLine &"像“" &StrRule &"”的字符!", vbExclamation, "友情提示"

CboName.SetFocus

Exit Sub

ElseIf CboName.Text = "user" Then

MsgBox "user是保留用字,不能用作用户名!", vbExclamation, "Sorry"

Exit Sub

End If

Set MyDatabase = Workspaces(0).OpenDatabase(App.Path &"\save")

Set Myrs = MyDatabase.OpenRecordset("select * from user where Name = " &Chr(34) &CboName.Text &Chr(34))

If Myrs.RecordCount >0 Then

MsgBox "用户已经存在", vbExclamation, "友情提示"

CboName.SetFocus

Exit Sub

End If

Set Myrs = MyDatabase.OpenRecordset("select * from user")

Myrs.AddNew

Myrs.Fields("name") = CboName.Text

Myrs.Fields("password") = TxtPassword.Text

Myrs.Fields("logontime") = Now

Myrs.Fields("Best") = "0"

Myrs.Fields("Run") = "0"

Myrs.Update

Myrs.Close

Set MyTable = MyDatabase.CreateTableDef(CboName.Text)

Set MyField = MyTable.CreateField("Result", 10, 4)

MyTable.Fields.Append MyField

Set MyField = MyTable.CreateField("RightRatio", 10, 6)

MyTable.Fields.Append MyField

Set MyField = MyTable.CreateField("TestTime", 10, 19)

MyTable.Fields.Append MyField

MyDatabase.TableDefs.Append MyTable

MsgBox "注册成功!", vbExclamation, "恭喜你"

CboName.AddItem (CboName.Text)

ChkNew.Value = 0

MyDatabase.Close

Else '登陆

If TxtPassword.Text <>TxtPasswordSure.Text And TxtPasswordSure.Visible = True Then

MsgBox "密码与确认密码不同,请重新输入!", vbExclamation, "友情提示"

TxtPassword.SetFocus

Exit Sub

End If

Set MyDatabase = Workspaces(0).OpenDatabase(App.Path &"\save")

Set Myrs = MyDatabase.OpenRecordset("select * from user where name =" &Chr(34) &CboName.Text &Chr(34))

If Myrs.RecordCount = 0 Then

MsgBox "用户不存在!", vbExclamation, "友情提示"

Exit Sub

End If

Myrs.MoveFirst

If TxtPassword.Text = Myrs.Fields("password") Then '登陆成功

Myrs.Close

Set Myrs = MyDatabase.OpenRecordset("select * from user")

If Myrs.BOF = False Then Myrs.MoveLast

If Myrs.BOF = False Then Myrs.MoveFirst

Myrs.MoveFirst

For i = 0 To Myrs.RecordCount - 1

Myrs.Edit

If Myrs.Fields("Name") = CboName.Text Then

Myrs.Fields("Run") = "1"

Else

Myrs.Fields("Run") = "0"

End If

Myrs.Update

Myrs.MoveNext

Next

'登陆成功,你加入要执行的 *** 作.

Unload Me'登陆窗口卸载

Else

Static WrongTime As Integer

WrongTime = WrongTime + 1

If WrongTime = 2 Then End

MsgBox "密码错误!", vbExclamation, "友情提示"

End If

Myrs.Close

MyDatabase.Close

End If

End Sub

Private Sub Form_Activate()

StrRule = "`~!@#$%^&*()_-+=|\:<,>.?/" &Chr(34) &Chr(39)

If Dir(App.Path &"\save.mdb", vbHidden) = "" Then '数据文件不见了

Set MyDatabase = CreateDatabase(App.Path &"\save", dbLangGeneral)

Set MyTable = MyDatabase.CreateTableDef("user")

Set MyField = MyTable.CreateField("Name", 10, 16)

MyTable.Fields.Append MyField

Set MyField = MyTable.CreateField("Password", 10, 6)

MyTable.Fields.Append MyField

Set MyField = MyTable.CreateField("LogonTime", 10, 19)

MyTable.Fields.Append MyField

Set MyField = MyTable.CreateField("Best", 10, 4)

MyTable.Fields.Append MyField

Set MyField = MyTable.CreateField("Run", 10, 1)

MyTable.Fields.Append MyField

MyDatabase.TableDefs.Append MyTable

ChkNew.Value = 2

Else

Set MyDatabase = Workspaces(0).OpenDatabase(App.Path &"\save")

Set Myrs = MyDatabase.OpenRecordset("select * from user")

If Myrs.EOF = False Then Myrs.MoveLast

If Myrs.BOF = False Then Myrs.MoveFirst

Dim i As Integer

Dim ShowIndex As Integer

For i = 0 To Myrs.RecordCount - 1

CboName.AddItem (Myrs.Fields("Name"))

If Myrs.Fields("Run") = "1" Then ShowIndex = i

Myrs.MoveNext

Next

If CboName.ListCount >0 Then

CboName.ListIndex = ShowIndex

Else

ChkNew.Value = 2

End If

Myrs.Close

MyDatabase.Close

End If

TxtPassword.SetFocus

End Sub

Private Function CheckStr(StrTheword As String) As Boolean

Dim i As Integer

For i = 1 To Len(StrRule)

If InStr(1, StrTheword, Mid(StrRule, i, 1)) <>0 Then '含有这样的字符

CheckStr = True

Exit Function

End If

Next

CheckStr = False

End Function

'你要源文件可以发EMail给我索要.

'我的电邮地址是:[email protected]

界面自己写咯。也可以添加一下VB默认的登录对话框，然后改改。读ACCESS数据库时添加ADO2.7的引用，然后再定义一下public Conn as Adodb.Connection '定义连接对象public rs as Adodb.Recordset'定义数据集....set Conn=New Adodb.Connectionconn.open "Provider=Microsoft.Jet.OLEDB.4.0Data Source=数据库文件名(如C:\ABC.mdb)Persist Security Info=False" '这里打上Access的连接串set rs=New Adodb.Recordsetrs.Open "Select 用户名 from 验证表 where 用户名='" &用户名字串 &"' and 密码='" &密码字串 &"'",ad,adOpenDynamic,adLockOptimisticif rs.RecordCount<>1 thenmsgbox "用户名或密码错误exit sub ' 或者 exit function之类的end if.....这里之后的就是登录成功之后的代码咯。

---