|
一、窗口界面设计
建立一个窗体，定义为login。 窗体分别加入以下控件： 1.1 选择数据库的控件--ComboBox
1.2 用户名控件--Text1
1.3 密码控件--Text2
注意：passwordchar设置为* 1.4 确定按钮控件
1.5 【退出】
1.6 【注册】
1.7 数据源控件
1.8 时钟控件
二、建议一个pass.mdb数据库
三、代码编写 Private Sub Command1_Click() '==============================本地数据库== If Trim(sql_LR.text) = Trim("本地数据库") Then Dim sql As String Dim conn As New ADODB.Connection Dim rs_login As New ADODB.Recordset Dim connectionstring As String connectionstring = "Provider = Microsoft.Jet.OLEDB.4.0;Data Source=" & App.Path & "\Pass.mdb; Jet OLEDB:Database Password=csu" conn.Open connectionstring sql_local = sql_LR.text If Trim(username.text) = "" Then MsgBox "输入的用户名为空", vbOKOnly + vbExclamation, "错误！！" username.SetFocus Else sql = "select * from 登陆信息 where 用户名='" & username.text & "'" rs_login.Open sql, conn, adOpenKeyset, adLockPessimistic If rs_login.EOF = True Then MsgBox "输入的用户名不存在", vbOKOnly + vbExclamation, "错误！！" username.text = "" username.SetFocus Else If Trim(rs_login.Fields(2)) = Trim(password.text) Then name1 = username.text rs_login.Close login.Hide main_w.Show sql_local = sql_LR.text Else MsgBox "密码错误，请重新输入", vbOKOnly + vbExclamation, "错误！！" password.SetFocus Set conn = Nothing End If End If End If End If '================云端数据库 If Trim(sql_LR.text) <> Trim("本地数据库") Then Dim sql2 As String Dim conn3 As New ADODB.Connection Dim rs As New ADODB.Recordset Dim connectionstring3 As String connectionstring3 = "Provider = MSDASQL.1;Persist Security Info=False;Data Source=aliyun_sql;Initial Catalog=soft_market" conn.Open connectionstring3 If Trim(Text1.text) = "" Then MsgBox "输入的用户名为空", vbOKOnly + vbExclamation, "错误！！" Text1.SetFocus Else sql2 = "select * from 登陆信息 where 用户名='" & Text1.text & "'" rs.Open sql2, conn, adOpenKeyset, adLockPessimistic '=====授权 If Trim(rs.Fields(6)) = Trim("1") Then remark = True End If If Trim(rs.Fields(6)) <> Trim("1") Then remark = False End If sql_local = sql_LR.text If rs.EOF = True Then MsgBox "输入的用户名不存在", vbOKOnly + vbExclamation, "错误！！" Text1.text = "" Text1.SetFocus Else If Trim(rs.Fields(2)) = Trim(password.text) Then name1 = Text1.text rs.Close Set conn3 = Nothing login.Hide main_w.Show sql_local = sql_LR.text Else MsgBox "密码错误，请重新输入", vbOKOnly + vbExclamation, "错误！！" password.SetFocus Set conn = Nothing End If End If End If End If End Sub Private Sub Form_Load() '====================选择数据库 sql_LR.text = "本地数据库" username.Visible = True Text1.Visible = False With sql_LR .AddItem "本地数据库" .AddItem "云端数据库" End With '=============================获取本地用户名，初始化 If Trim(sql_LR.text) = Trim("本地数据库") Then Dim Cnn1 As ADODB.Connection Dim Rst1 As ADODB.Recordset Set Cnn1 = New ADODB.Connection Dim connectionstring2 As String connectionstring2 = "Provider = Microsoft.Jet.OLEDB.4.0;Data Source=" & App.Path & "\Price.mdb; Jet OLEDB:Database Password=csu" Cnn1.Open connectionstring2 Set Rst1 = New ADODB.Recordset Rst1.CursorType = adOpenKey Dim connstring3 As String connstring3 = "Provider = Microsoft.Jet.OLEDB.4.0;Data Source=" & App.Path & "\Pass.mdb; Jet OLEDB:Database Password=csu" Adodc1.connectionstring = connstring3 Adodc1.CommandType = adCmdText Adodc1.RecordSource = "select * from 登陆信息" Adodc1.Refresh If Adodc1.Recordset.RecordCount > 0 Then username.Clear Adodc1.Recordset.MoveFirst Do While Not Adodc1.Recordset.EOF username.AddItem (Adodc1.Recordset.Fields(1)) '这里把字段名修改成数据表里的实际字段名 Adodc1.Recordset.MoveNext Loop Adodc1.Recordset.MoveFirst End If username.text = Adodc1.Recordset.Fields(1) End If End Sub Private Sub Form_Unload(Cancel As Integer) End End Sub Private Sub reg_Click() reg_w.Show End Sub Private Sub sql_LR_Click() If Trim(sql_LR.text) <> Trim("本地数据库") Then reg.Visible = True username.Visible = False Text1.Visible = True End If If Trim(sql_LR.text) = Trim("本地数据库") Then reg.Visible = False username.Visible = True Text1.Visible = False End If '====================================获取云端用户名 If Trim(sql_LR.text) <> Trim("本地数据库") Then Dim cn As New ADODB.Connection Dim rs As New ADODB.Recordset Set cn = ConnMySQL("honeytree", "Honey123!", "soft_maket", "47.99.45.61") If cn.State = adStateOpen Then MsgBox "打开远程MySQL数据库成功" If cn Is Nothing Then If Err.Number <> 0 Then MsgBox Err.Number & " " & Err.Description, vbOKOnly & "连接MySQL发生错误" MsgBox "连接成功", vbOKOnly & "提示" Else MsgBox "连接失败", vbOKOnly & "提示" End If Exit Sub End If '云端用户名 Dim connstring1 As String connstring1 = "Provider = Microsoft.Jet.OLEDB.4.0;Data Source=" & App.Path & "\Pass.mdb; Jet OLEDB:Database Password=csu" Adodc1.connectionstring = connstring1 Adodc1.CommandType = adCmdText Adodc1.RecordSource = "select * from 登陆信息" Adodc1.Refresh If Adodc1.Recordset.RecordCount > 0 Then username.Clear Adodc1.Recordset.MoveFirst Do While Not Adodc1.Recordset.EOF username.AddItem (Adodc1.Recordset.Fields(1)) '这里把字段名修改成数据表里的实际字段名 Adodc1.Recordset.MoveNext Loop Adodc1.Recordset.MoveFirst End If username.text = Adodc1.Recordset.Fields(1) End If '=============================获取本地用户名 If Trim(sql_LR.text) = Trim("本地数据库") Then Dim Cnn1 As ADODB.Connection Dim Rst1 As ADODB.Recordset Set Cnn1 = New ADODB.Connection Dim connectionstring2 As String connectionstring2 = "Provider = Microsoft.Jet.OLEDB.4.0;Data Source=" & App.Path & "\Price.mdb; Jet OLEDB:Database Password=csu" Cnn1.Open connectionstring2 Set Rst1 = New ADODB.Recordset Rst1.CursorType = adOpenKey Dim connstring3 As String connstring3 = "Provider = Microsoft.Jet.OLEDB.4.0;Data Source=" & App.Path & "\Pass.mdb; Jet OLEDB:Database Password=csu" Adodc1.connectionstring = connstring3 Adodc1.CommandType = adCmdText Adodc1.RecordSource = "select * from 登陆信息" Adodc1.Refresh If Adodc1.Recordset.RecordCount > 0 Then username.Clear Adodc1.Recordset.MoveFirst Do While Not Adodc1.Recordset.EOF username.AddItem (Adodc1.Recordset.Fields(1)) '这里把字段名修改成数据表里的实际字段名 Adodc1.Recordset.MoveNext Loop Adodc1.Recordset.MoveFirst End If username.text = Adodc1.Recordset.Fields(1) End If End Sub Private Sub Timer1_Timer() login.Caption = "欢迎使用" & " " & "现在时间是：" & " " & Now() & " " & weekday1 End Sub Private Sub 取消_Click() 'MsgBox "您已成功退出！", vbOKOnly + vbExclamation, "提示" Unload Me End Sub 四、运行效果
点击用户名的选择，可以看到数据库已经有的账号
注册一个账号
|
|
|
