mima .frm

此系统用于教学所用,用于老师进行教学所用

            Begin VB.Label L1 
               BackStyle       =   0  'Transparent
               Caption         =   "注册用户>>"
               Height          =   495
               Left            =   240
               TabIndex        =   15
               Top             =   360
               Width           =   1575
            End
         End
         Begin VB.Label Label2 
            BackStyle       =   0  'Transparent
            Caption         =   "高级选项"
            BeginProperty Font 
               Name            =   "宋体"
               Size            =   24
               Charset         =   134
               Weight          =   700
               Underline       =   0   'False
               Italic          =   0   'False
               Strikethrough   =   0   'False
            EndProperty
            ForeColor       =   &H00FF00FF&
            Height          =   495
            Left            =   1200
            TabIndex        =   13
            Top             =   360
            Width           =   2175
         End
      End
      Begin VB.PictureBox P1 
         BackColor       =   &H00C0C0FF&
         BorderStyle     =   0  'None
         Height          =   3135
         Left            =   120
         ScaleHeight     =   3135
         ScaleWidth      =   4695
         TabIndex        =   1
         Top             =   120
         Width           =   4695
         Begin VB.CommandButton xuanxiang 
            Appearance      =   0  'Flat
            BackColor       =   &H00E0E0E0&
            Caption         =   "高级选项"
            Height          =   375
            Left            =   2640
            Style           =   1  'Graphical
            TabIndex        =   10
            Top             =   2160
            Width           =   975
         End
         Begin VB.CommandButton no 
            Appearance      =   0  'Flat
            BackColor       =   &H00E0E0E0&
            Caption         =   "取消"
            Height          =   375
            Left            =   1680
            Style           =   1  'Graphical
            TabIndex        =   9
            Top             =   2160
            Width           =   615
         End
         Begin VB.CommandButton cmdok 
            Appearance      =   0  'Flat
            BackColor       =   &H00E0E0E0&
            Caption         =   "确定"
            Height          =   375
            Left            =   600
            Style           =   1  'Graphical
            TabIndex        =   8
            Top             =   2160
            Width           =   615
         End
         Begin VB.TextBox passwardtxt 
            Appearance      =   0  'Flat
            Height          =   375
            IMEMode         =   3  'DISABLE
            Left            =   1200
            PasswordChar    =   "*"
            TabIndex        =   7
            Top             =   1560
            Width           =   2055
         End
         Begin VB.TextBox nametxt 
            Appearance      =   0  'Flat
            BackColor       =   &H00FFFFFF&
            Height          =   375
            Left            =   1200
            TabIndex        =   5
            Top             =   960
            Width           =   2055
         End
         Begin VB.PictureBox P1_1 
            BackColor       =   &H00C0C0FF&
            BorderStyle     =   0  'None
            Height          =   855
            Left            =   -1200
            ScaleHeight     =   855
            ScaleWidth      =   6975
            TabIndex        =   2
            Top             =   2400
            Width           =   6975
         End
         Begin VB.Label passward 
            BackStyle       =   0  'Transparent
            Caption         =   "密  码："
            Height          =   375
            Left            =   480
            TabIndex        =   6
            Top             =   1680
            Width           =   855
         End
         Begin VB.Label username 
            BackStyle       =   0  'Transparent
            Caption         =   "用户名："
            Height          =   255
            Left            =   480
            TabIndex        =   4
            Top             =   1080
            Width           =   735
         End
         Begin VB.Label Label1 
            BackStyle       =   0  'Transparent
            Caption         =   "用户登录"
            BeginProperty Font 
               Name            =   "宋体"
               Size            =   26.25
               Charset         =   134
               Weight          =   700
               Underline       =   0   'False
               Italic          =   0   'False
               Strikethrough   =   0   'False
            EndProperty
            ForeColor       =   &H00FF00FF&
            Height          =   615
            Left            =   1080
            TabIndex        =   3
            Top             =   360
            Width           =   2175
         End
      End
   End
End
Attribute VB_Name = "mima"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim username0 As String
Option Explicit
Dim micount As Integer
Public ok As Boolean
Dim mybookmark As Variant
Dim mcclean As Boolean
Public Sub viewdata()
Dim txtsql, msgtxt As String
Dim mrc As ADODB.Recordset
txtsql = "select * from zhucebiao"
Set mrc = ExecuteSQL(txtsql, msgtxt)
p3_3nametxt.Text = mrc.Fields(0)
p3_3passwardtxt.Text = mrc.Fields(1)
End Sub
Private Sub Frame1_DragDrop(Source As Control, X As Single, Y As Single)

End Sub

Private Sub Command1_Click()

End Sub

Private Sub Form_Load()
Dim txtsql, msgtxt As String
Dim mrc As ADODB.Recordset
txtsql = "select * from zhucebiao"
Set mrc = ExecuteSQL(txtsql, msgtxt)
mrc.MoveFirst
Call viewdata
mybookmark = mrc.Bookmark
mcclean = True
p3_3nametxt.Text = ""
p3_3passwardtxt.Text = ""
End Sub

Private Sub L1_DblClick()
P2_1.Visible = False
P2_2.Visible = True
End Sub
Private Sub Label10_DblClick()
p3_1.Visible = False
p3_3.Visible = True
End Sub

Private Sub Label8_DblClick()
Me.Hide
shitiguanli.Show
End Sub
Private Sub Label9_DblClick()
p3_1.Visible = False
p3_2.Visible = True
End Sub

Private Sub no_Click()
nametxt.SetFocus
nametxt.Text = ""
passwardtxt.Text = ""
End Sub

Private Sub cmdok_Click()
Dim sqltxt As String
Dim msgtxt As String
Dim mrc As ADODB.Recordset
username0 = ""
If Trim(nametxt.Text) = "" Then
   MsgBox "没有这个用户名，请您重新输入！", vbOKOnly + vbExclamation, "警告!"
   nametxt.SetFocus
   nametxt.Text = ""
   passwardtxt.Text = ""
   Exit Sub
Else
   sqltxt = "select * from zhucebiao where username='" & nametxt.Text & "'"
   Set mrc = ExecuteSQL(sqltxt, msgtxt)
   If mrc.EOF = True Then
      MsgBox "没有这个用户名，请您重新输入！", vbOKOnly + vbExclamation, "警告!"
      nametxt.SetFocus
      nametxt.Text = ""
      passwardtxt.Text = ""
      Exit Sub
   Else
      If Trim(mrc.Fields(1)) = Trim(passwardtxt.Text) Then
         ok = True
         mrc.Close
         username0 = Trim(nametxt.Text)
         P1.Visible = False
         p3.Visible = True
         p2.Visible = False
      Else
         MsgBox "密码不正确，请您重新输入密码！", vbOKOnly + vbExclamation, "警告！"
         passwardtxt.SetFocus
         passwardtxt.Text = ""
         micount = micount + 1
         If micount = 3 Then
            P1.Visible = False
            p2.Visible = True
            p3.Visible = False
         End If
         Exit Sub
      End If
   End If
End If
End Sub




Private Sub p3_3no_Click()
p3_3.Visible = False
p3_1.Visible = True
End Sub

Private Sub p3_3yes_Click()
Dim txtsql, msgtxt As String
Dim mrc As ADODB.Recordset
Dim str2 As String
txtsql = "select * from zhucebiao"
Set mrc = ExecuteSQL(txtsql, msgtxt)
mybookmark = mrc.Bookmark
str2 = MsgBox("是否删除当前用户?", vbOKCancel, "删除当前用户")
If str2 = vbOK Then
   mrc.MoveNext
   If mrc.EOF Then
      mrc.MoveFirst
      mybookmark = mrc.Bookmark
      mrc.MoveLast
      mrc.delete
      mrc.Bookmark = mybookmark
      Call viewdata
      Else
      mybookmark = mrc.Bookmark
      mrc.MovePrevious
      mrc.delete
      mrc.Bookmark = mybookmark
      Call viewdata
      End If
      Else
      mrc.Bookmark = mybookmark
      Call viewdata
 End If
p3.Visible = False
P1.Visible = True
p2.Visible = False
nametxt.Text = ""
passwardtxt.Text = ""
End Sub

Private Sub p3no_Click()
p3_2.Visible = False
p3_1.Visible = True
p3passwardtxt1.Text = ""
p3passwardtxt2.Text = ""
End Sub

Private Sub p3ok_Click()
Dim txtsql, msgtxt As String
Dim mrc As ADODB.Recordset
If Trim(p3passwardtxt1.Text) = "" Then
   MsgBox "新密码不能为空,请重新输入!", vbOKOnly + vbExclamation, "警告!"
   p3passwardtxt1.SetFocus
   Exit Sub
End If
If Trim(p3passwardtxt1.Text) <> Trim(p3passwardtxt2.Text) Then
   MsgBox "密码输入错误,请重新输入!", vbOKOnly + vbExclamation, "警告!"
   p3passwardtxt1.SetFocus
   p3passwardtxt1.Text = ""
   p3passwardtxt2.Text = ""
   Exit Sub
End If
txtsql = "select * from zhucebiao where username='" & username0 & "'"
Set mrc = ExecuteSQL(txtsql, msgtxt)
mrc.Fields(1) = Trim(p3passwardtxt1.Text)
mrc.Update
mrc.Close
MsgBox "密码修改成功!", vbOKOnly + vbInformation, "提示!"
p3_2.Visible = False
p3_1.Visible = True
p3passwardtxt1.Text = ""
p3passwardtxt2.Text = ""
End Sub

Private Sub quxiao_Click()
p2.Visible = False
P1.Visible = True
End Sub

Private Sub xuanxiang_Click()
P1.Visible = False
p2.Visible = True
End Sub

Private Sub yes_Click()
Dim mrc As ADODB.Recordset
Dim msgtxt As String
Dim sqltxt As String
If Trim(n_nametxt.Text) = "" Then
   MsgBox "用户名不能为空,请您全新输入!", vbOKOnly + vbExclamation, "警告!"
   n_nametxt.SetFocus
   Exit Sub
Else
   sqltxt = "select * from zhucebiao"
   Set mrc = ExecuteSQL(sqltxt, msgtxt)
   While (mrc.EOF = False)
      If Trim(mrc.Fields(0)) = Trim(n_nametxt) Then
         MsgBox "用户名已经存在,请重新输入用户名!", vbOKOnly + vbExclamation, "警告!"
         n_nametxt.SetFocus
         n_nametxt.Text = ""
         n_passwardtxt.Text = ""
         passwardtxt2.Text = ""
         Exit Sub
       Else
          mrc.MoveNext
       End If
    Wend
 End If
 username0 = Trim(n_nametxt.Text)
 If Trim(n_passwardtxt.Text) = "" Then
    MsgBox "请输入您的新密码!", vbOKOnly + vbExclamation, "警告!"
    n_passwardtxt.SetFocus
    Exit Sub
 Else
    If Trim(n_passwardtxt.Text) <> Trim(passwardtxt2.Text) Then
       MsgBox "密码输入不正,请重新输入!", vbOKOnly + vbExclamation, "警告!"
       n_passwardtxt.SetFocus
       n_passwardtxt.Text = ""
       passwardtxt2.Text = ""
    Else
       mrc.AddNew
       mrc.Fields(0) = Trim(n_nametxt.Text)
       mrc.Fields(1) = Trim(n_passwardtxt.Text)
       mrc.Update
       mrc.Close
       p2.Visible = False
       p3.Visible = True
       MsgBox "添加用户成功!", vbOKOnly + vbInformation, "提示!"
     End If
End If
n_passwardtxt.Text = ""
passwardtxt2.Text = ""
End Sub