module1.bas

模拟网站登陆

Attribute VB_Name = "Module1"
Private strsql As String
Private strconn As String
Private rs As New ADODB.Recordset
Private msg1 As String
Public tt1 As Integer  '是否可以更改密码的标记

Sub reg()
On Error Resume Next
If Form1.Text1.Text = "" Then
   MsgBox "用户名不能为空"
   Exit Sub     '如果用户名为空即退出
End If
If Form1.Text2.Text = "" Then
   MsgBox "密码不能为空"
   Exit Sub    '如果密码为空即退出
End If
strconn = "provider=microsoft.jet.oledb.4.0;data source=" & App.Path & "\reg.mdb"
strsql = "select * from xulang"
With rs  'rs获取reg.mdb的记录集，rs(0)为一记录的第一字段（name），rs(1)为一记录的第二字段（password）
   If .State = adStateOpen Then
      .Close
   End If
   .ActiveConnection = strconn
   .Source = strsql
   .LockType = adLockOptimistic
   .CursorLocation = adUseClient
   .CursorType = adOpenDynamic
   .Open     '用ADO接口打开access数据库reg.mdb
End With
rs.MoveFirst  '移到reg.mdb数据库的第一条记录
Do While Not rs.EOF   '从第一条记录开始查找满足条件的记录
   If rs(0) = Form1.Text1.Text Then   '首先叛断是否有此人
      If Form1.Option1.Value = True Then
         If rs(1) = Form1.Text2.Text Then  '有此人，且密码政正确则登录成功
            MsgBox "登录成功"
            Unload Form1
            Exit Sub
         End If
      End If
      If Form1.Option1.Value = True Then
         If rs(1) <> Form1.Text2.Text Then
            MsgBox "密码不正确"
            Form1.Text2.Text = ""
            Exit Sub
         End If
      End If
      If Form1.Option2.Value = True Then  '有此人，则不能注册
         MsgBox "此用户名已有人注册，请再试着用别的网名注册"
         Form1.Text2.Text = ""
         Form1.Text1.Text = ""
         Exit Sub
      End If
      If Form1.Option3.Value = True Then  '有此人，可以改写密码
         If rs(1) = Form1.Text2.Text Then '如果密码正确
           If tt1 = 1 Then   '如果tt1=1则用窗体2的数据改写旧密码
            rs(1) = Form2.Text1.Text
            tt1 = 0
            MsgBox "密码修改成功"
            Unload Form2
            Form1.Text1.Text = ""
            Form1.Text2.Text = ""
            Exit Sub
           Else             '显示窗体2输入新密码
            Form2.Show
            Exit Sub
           End If
         End If
         If rs(1) <> Form1.Text2.Text Then   '旧密码不正确
            MsgBox "密码不正确"
            Form1.Text2.Text = ""
            Exit Sub
         End If
      End If
   End If
   rs.MoveNext
Loop
If rs.EOF Then             '如果没有此人，则rs.eof必为真,这样可以进行"注册"
   If Form1.Option1.Value = True Then  '没有此人，不能登录
      MsgBox "此用户名还没有注册，请注册再使用"
      Form1.Text2.Text = ""
      Exit Sub
   End If
   If Form1.Option2.Value = True Then
      If rs(0) <> Form1.Text1.Text Then  '没有此人，可以"注册"
          msg1 = MsgBox("你要注册用户名 " & Form1.Text1.Text & " 密码 " & Form1.Text2.Text & " 吗？", vbYesNo, "注册提示")
          If msg1 = vbYes Then
            rs.AddNew                   '插入注册信息
            rs(0) = Form1.Text1.Text
            rs(1) = Form1.Text1.Text
            rs.Update
            MsgBox "注册成功"
            Unload Form1
            Exit Sub
          Else
            Form1.Text1.Text = ""
            Form1.Text2.Text = ""
            Exit Sub
          End If
     End If
   End If
End If
End Sub