Question

怎样用VB编写一个登陆系统，可以注册账号的那种

这是我的代码
Private Sub Cmd1_Click()
If Txt1.Text = "a123456" And Txt2.Text = "123" Then
Form1.Hide
Form2.Show
Else
MsgBox "出错了"
Txt1.Text = ""
Txt2.Text = ""
Txt1.SetFocus
End If
End Sub

这个只能允许一个账户，不能多个，好麻烦，怎样可以搞多个账户登陆系统，即可以进行用户注册。

Answer 1

VB编写一个可以注册帐号的登录系统步骤：

1）1）首先需要用数据库软件（如ACCESS软件）建立一个数据库，新建几个表，用以记录帐号密码的表、登录日志表和其他与此有关的所需要的表等。

2）VB新建数据工程，此时VB6集成调试环境左边工具箱内已加载了有关数据库编程必须的控件。

3）然后在FORM1窗体中添加ADO数据控件，右键-ADODC1控件属性页-使用连接字符串，选生成，在提供者选项中选合适的OLE DB连接数据库等。在ADODC1控件属性页使用连接字符串空白文本窗口中就有一长串字符串，注意该字符串可复制到程序代码用于编程。

ADODC1控件属性页的数据源内有命令文本（SQL）编写窗口可编写SQL查询语言。该窗口的SQL语句可复制到程序代码用于编程。

4）可以将SQL查询语句赋值给ADO数据控件的RecordSource属性实现。

5）数据的输入、修改等可灵活应用文本框或数据表格控件与ADO数据控件通过代码绑定。

6）想使用ADO数据对象，也可将ADO数据控件所写的代码较方便的移植给ADO数据对象。

以下是用ADO数据对象编写的登录和注册的代码：

1）标准模块代码：

Option Explicit
    Public loginname As String
    Public cn As New ADODB.Connection '定义数据库的连接存放数据和代码
    Public rs As New ADODB.Recordset
    Public sql As String
    Public Newname As String

2）注册窗体代码：

Option Explicit
    Dim Password As String
    
Private Sub Text1_KeyPress(KeyAscii As Integer)
    If KeyAscii = 13 And Text1 <> "" Then
        sql = "select * from 用户管理 where 用户名='" & Text1.Text & "'" ' and 密码='" & Text2.Text & "'"
        cn.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & App.Path & "\data\data.mdb;Persist Security Info=False"
        cn.Open
        rs.CursorLocation = adUseClient
        rs.Open sql, cn, adOpenDynamic, adLockOptimistic
        If rs.EOF = True Then '没有该用户名可以注册
                MsgBox "用户名可以注册!"
                rs.Close
                cn.Close
                Newname = Text1.Text
                Text4 = Newname
                Text2.SetFocus
        Else
            MsgBox "该用户名已经存在，换名注册!"
                Text1.Text = ""
                Text1.SetFocus
        End If
    End If
    Exit Sub
finish:
    MsgBox Err.Description
End Sub

Private Sub Text2_KeyPress(KeyAscii As Integer)
    If KeyAscii = 13 And Text2 <> "" Then
        Password = Text2.Text
        Text5 = Password
        Text3.SetFocus
    End If
End Sub

Private Sub Text3_KeyPress(KeyAscii As Integer)
    If KeyAscii = 13 And Text3.Text = Text2.Text Then
        Command3.Enabled = True
        Command3.SetFocus
    ElseIf KeyAscii = 13 And Text3.Text <> Text2.Text Then
        Text3 = ""
        Text3.SetFocus
    End If
End Sub

Private Sub Command1_Click()
    Unload Me
End Sub

Private Sub Command3_Click()
    sql = "select * from 用户管理"
    cn.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & App.Path & "\data\data.mdb;Persist Security Info=False"
    cn.Open
    rs.CursorLocation = adUseClient
    rs.Open sql, cn, adOpenDynamic, adLockOptimistic
    rs.AddNew
    rs.Fields(0) = Newname
    rs.Fields(1) = Password
    rs.Update
    rs.Close
    cn.Close
    Command3.Enabled = False
End Sub

3）登录窗体代码：

Option Explicit
    Dim pnum As Integer

Private Sub Command1_Click()
    On Error GoTo finish '防错代码，防止意外而导致的退出
    sql = "select * from 用户管理 where 用户名='" & Text1.Text & "' and 密码='" & Text2.Text & "'"
    cn.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & App.Path & "\data\data.mdb;Persist Security Info=False"
    cn.Open
    rs.CursorLocation = adUseClient
    rs.Open sql, cn, adOpenDynamic, adLockOptimistic
    '以上使用最通用的方法来查询数据库中是否有匹配的记录
    If rs.EOF = True Then '如果没有记录则说明用户或密码为错误的
        If pnum < 2 Then 'pnum就是密码验证次数，当次数超过3次，系统会自动保护退出
            pnum = pnum + 1
            MsgBox "用户名或密码错误!", vbInformation, "错误次数：" & pnum
            rs.Close
            cn.Close
            Text1.Text = ""
            Text2.Text = ""
            Text1.SetFocus
            Exit Sub
        Else
            MsgBox "用户名或密码错误超过三次,系统会自动退出", vbInformation, "提示"
            End
        End If
    Else
        loginname = rs.Fields(0)
        Form1.Show
        rs.Close
        cn.Close
    End If
    Exit Sub
finish:
    MsgBox Err.Description
    rs.Close
    cn.Close
End Sub

Private Sub Text2_KeyPress(KeyAscii As Integer)
    If KeyAscii = 13 Then '获取按键，如果是回车就运行image_click按钮的内容
        Call Command1_Click
    End If
End Sub
Private Sub Text1_KeyPress(KeyAscii As Integer)
    If KeyAscii = 13 Then
        Text2.SetFocus
    End If
End Sub

Private Sub Command2_Click()
    End
End Sub

Private Sub Command3_Click()
    frmZhuce.Show
End Sub

 

Answer 2

1、打开“Microsoft Visual Basic 6.0 中文版”，选择“标准 EXE”，并单击“打开”按钮，进入软件界面。

2、建立如图所示窗体。

3、双击窗体，定义如下全局变量。

4、双击“开始”按钮。

5、输入如下代码。

6、双击“停止”按钮。

7、双击Timer控件，输入如下代码。

8、运行程序，单击“开始”按钮，计时器开始计时。

Answer 3

可以按照程序的大小选择存储方式。小程序保存在文本文件里就可以了，大程序就写数据库。如果觉得文本文件不安全再加个ASC加密。

Answer 4

配个数据库，读的时候去数据库读，注册的时候写入数据库

Answer 5

这个是登录界面代码

Private Sub close_Click()
    If MsgBox("确定退出系统吗？", vbOKCancel) = vbOK Then
        End
    End If
End Sub

Private Sub login_Click()
    If Not userName.Text = "" Then
       If Not userPassword.Text = "" Then
            Dim etpp As Excel.Application
            
            Dim uName As String
            Dim password As String
            Dim row As Integer
            Dim num As Integer
            num = 0
            Set etpp = CreateObject("excel.application")
            etpp.Workbooks.Open FileName:=App.Path & "\zhs.xls", ReadOnly:=True
            etpp.Worksheets(2).Activate
            row = etpp.ActiveSheet.UsedRange.Rows.Count
                For i = 2 To row + 1
                    uName = etpp.ActiveWorkbook.ActiveSheet.Cells.Item(i, 1).Value
                    num = num + 1
                    If uName = userName.Text Then
                        password = etpp.ActiveWorkbook.ActiveSheet.Cells.Item(i, 2).Value
                        If password = userPassword.Text Then
                            zww.Text = etpp.ActiveWorkbook.ActiveSheet.Cells.Item(i, 8).Value
                            InputDate.Show
                            i = row + 1
                        Else
                            MsgBox "密码错误！"
                            i = row + 1
                        End If
                    Else
                        If num = row Then
                            MsgBox "用户名不存在"
                        End If
                    End If
                Next i
            etpp.Quit
            Set etpp = Nothing
       Else
            MsgBox "请输入密码"
       End If
    Else
        userName.Text = "用户名不能为空"
    End If
End Sub
Private Sub result_Click()
    Unload Me
    Posts.Show
End Sub

这个是注册界面代码

Private Sub Command1_Click()
    If MsgBox("确定返回登录页面？", vbOKCancel) = vbOK Then
        Unload Me
        login.Show
    End If
End Sub

Private Sub Command2_Click()
    If MsgBox("退出系统？", vbOKCancel) = vbOK Then
        End
    End If
End Sub

Private Sub sumb_Click(Index As Integer)
    Dim epp As Excel.Application
    Dim rw As Integer
    Dim con As Integer
    Set epp = CreateObject("excel.Application")
    epp.Workbooks.close
    epp.Workbooks.Open FileName:=App.Path & "\zhs.xls", ReadOnly:=False
    epp.Workbooks(1).Worksheets(2).Activate
    If rs.Item(3).Text = rs.Item(7).Text Then
        rw = epp.ActiveWorkbook.ActiveSheet.UsedRange.Rows.Count + 1
        epp.ActiveWorkbook.ActiveSheet.Cells.Item(rw, 1).Value = rs.Item(0).Text
        epp.ActiveWorkbook.ActiveSheet.Cells.Item(rw, 2).Value = rs.Item(3).Text
        epp.ActiveWorkbook.ActiveSheet.Cells.Item(rw, 3).Value = rs.Item(4).Text
        epp.ActiveWorkbook.ActiveSheet.Cells.Item(rw, 4).Value = rs.Item(1).Text
        epp.ActiveWorkbook.ActiveSheet.Cells.Item(rw, 5).Value = rs.Item(2).Text
        epp.ActiveWorkbook.ActiveSheet.Cells.Item(rw, 6).Value = rs.Item(5).Text
        epp.ActiveWorkbook.ActiveSheet.Cells.Item(rw, 7).Value = rs.Item(6).Text
        epp.ActiveWorkbook.ActiveSheet.Cells.Item(rw, 8).Value = rs.Item(8).Text
        epp.ActiveWorkbook.Save
        con = epp.ActiveWorkbook.ActiveSheet.UsedRange.Rows.Count
        If con = rw Then
            If MsgBox("注册成功,是否现在登录", vbOKCancel) = vbOK Then
                epp.Quit
                Set epp = Nothing
                Unload Me
                login.Show
            Else
                epp.Quit
                Set epp = Nothing
                End
            End If
        Else
            epp.Quit
            Set epp = Nothing
            MsgBox "注册失败"
        End If
    Else
        epp.Quit
        Set epp = Nothing
        MsgBox "两次密码不一致"
    End If
End Sub

引用自CSDN，希望对你有所帮助。