system.frm

利用VB开发的作品!包括宾馆系统的开发,名片管理系统,查询系统及字库查询 希望大家喜欢

      End
      Begin VB.CommandButton load1 
         Caption         =   "登陆系统"
         Height          =   495
         Left            =   240
         TabIndex        =   1
         Top             =   480
         Width           =   975
      End
   End
End
Attribute VB_Name = "system"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim TIM As Integer
Dim mydb As Database
Dim mydb1 As Database
Dim myrs As Recordset
Dim sql As String
Dim str1 As String
Dim str2 As String
Dim MESSAGE As String

Private Sub abs_Click()
Dim mydb2 As Database
Set mydb2 = Workspaces(0).OpenDatabase(App.Path & "\data\data.mdb")
Set myrs = mydb2.OpenRecordset("管理表", dbOpenDynaset)
myrs.FindFirst "用户名 = " + Chr(34) + Combo1.Text + Chr(34) + ""
myrs.Delete
myrs.MoveNext
myrs.Close
mydb2.Close
For i = Combo1.ListCount - 1 To 0 Step -1
   Combo1.RemoveItem j
   Next
Set mydb2 = Workspaces(0).OpenDatabase(App.Path & "\data\data.mdb") '设置数据库
  sql = "select 用户名 from 管理表"
  Set myrs = mydb2.OpenRecordset(sql)
  If myrs.EOF = False Then myrs.MoveLast
  If myrs.BOF = False Then myrs.MoveFirst
  For i = 0 To myrs.RecordCount - 1
      If myrs.Fields(0) <> "" Then Combo1.AddItem (myrs.Fields(0))   '将管理员添加到管理员列表框
      myrs.MoveNext
  Next i
  If Combo1.ListCount > 0 Then Combo1.ListIndex = 0  '移动记录到第一条
  mydb2.Close
End Sub

Private Sub add_Click()
Dim mydb2 As Database
Set mydb2 = Workspaces(0).OpenDatabase(App.Path & "\data\data.mdb")
Set myrs = mydb2.OpenRecordset("管理表", dbOpenDynaset)
myrs.AddNew
myrs.Fields("用户名") = Combo1.Text
myrs.Fields("密码") = key.Text
myrs.Update
myrs.Close
mydb2.Close
For i = Combo1.ListCount - 1 To 0 Step -1
   Combo1.RemoveItem j
   Next
Set mydb2 = Workspaces(0).OpenDatabase(App.Path & "\data\data.mdb") '设置数据库
  sql = "select 用户名 from 管理表"
  Set myrs = mydb2.OpenRecordset(sql)
  If myrs.EOF = False Then myrs.MoveLast
  If myrs.BOF = False Then myrs.MoveFirst
  For i = 0 To myrs.RecordCount - 1
      If myrs.Fields(0) <> "" Then Combo1.AddItem (myrs.Fields(0))   '将管理员添加到管理员列表框
      myrs.MoveNext
  Next i
  If Combo1.ListCount > 0 Then Combo1.ListIndex = 0  '移动记录到第一条
  mydb2.Close
End Sub

Private Sub cancel_Click()
able (0)
Unload Me
End Sub

Private Sub cancel2_Click()
Frame3.Visible = False
olduser.Text = ""
oldkey.Text = ""
newuser.Text = ""
newkey1.Text = ""
newkey2.Text = ""
End Sub

Private Sub change1_Click()
Frame2.Visible = False
Frame3.Visible = True
Frame4.Visible = False
End Sub

Private Sub changeok_Click()
 If olduser.Text <> "" Then
     Set mydb = Workspaces(0).OpenDatabase(App.Path & "\data\data.mdb")
     Set myrs = mydb.OpenRecordset("管理表", dbOpenDynaset)
     myrs.FindFirst "用户名 = " + Chr(34) + olduser.Text + Chr(34) + ""   ' 查找用户
     If myrs.NoMatch Then                                     '没查到记录
        MsgBox ("无此用户名！")
         olduser.Text = ""
         oldkey.Text = ""
         newuser.Text = ""
         newkey1.Text = ""
         newkey2.Text = ""
         olduser.SetFocus
       Else
        If oldkey.Text = myrs.Fields("密码") Then               '确认密码
          If newuser.Text = "" Then
           MsgBox ("新用户名为空!")
           newuser.SetFocus
           Else
             If newkey1.Text = "" Or newkey2.Text = "" Then
               MsgBox ("新密码为空,请重新输入密码!")
               newkey1.SetFocus
             Else
              If newkey1.Text <> newkey2.Text Then
               newkey1.Text = ""
               newkey2.Text = ""
               newkey1.SetFocus
               MsgBox ("新密码错误,请重新输入密码!")
            Else
              myrs.Edit
              myrs.Fields("用户名") = newuser.Text
              myrs.Fields("密码") = newkey2.Text
              myrs.Update
              MsgBox "您的用户名和密码更改成功！" '更改成功
              olduser.Text = ""
              oldkey.Text = ""
              newuser.Text = ""
              newkey1.Text = ""
              newkey2.Text = ""
            End If
            End If
           End If
         Else
           If TIM = 3 Then
              TIM = 0
              MESSAGE = MsgBox("密码输入错误,请向系统管理员查询!", 0, "")
              If MESSAGE = vbOK Then End
           End If
           MsgBox ("密码错误,请重新输入密码!")
           TIM = TIM + 1 '密码输入错误次数
           olduser.Text = ""
           oldkey.Text = ""
           newuser.Text = ""
           newkey1.Text = ""
           newkey2.Text = ""
           olduser.SetFocus
        End If
     End If
     End If
myrs.Close
mydb.Close
End Sub

Private Sub Combo1_Change()
Combo1_Click
End Sub

Private Sub Combo1_Click()
Set mydb = Workspaces(0).OpenDatabase(App.Path & "\data\data.mdb")
  Set myrs = mydb.OpenRecordset("管理表", dbOpenDynaset)
  myrs.FindFirst "用户名 = " + Chr(34) + Combo1.Text + Chr(34) + ""
  key.Text = myrs.Fields("密码")
  myrs.Close
  mydb.Close
End Sub

Private Sub Form_Load()
left = 100
Top = 100
End Sub

Private Sub makeych_Click()
Frame5.Visible = False
Frame6.Visible = True
maname.Text = ""
makey.Text = ""
keytokey.Text = ""
End Sub

Private Sub findmakey_Click()
On Error GoTo errorhandler
If findmakey.Caption = "管理员校验码查询" Then
  Set mydb = Workspaces(0).OpenDatabase(App.Path & "\data\data.mdb")
     Set myrs = mydb.OpenRecordset("管理表", dbOpenDynaset)
     myrs.FindFirst "用户名 = " + Chr(34) + maname.Text + Chr(34) + ""   ' 查找用户
     If myrs.NoMatch Then                                     '没查到记录
        MsgBox ("无此用户！"), 48, "警告"
        maname.Text = ""
        makey.Text = ""
       Else
        If makey.Text = myrs.Fields("密码") Then               '????????????确认密码
          
          keytokey.Text = myrs.Fields("姓名")
          findmakey.Caption = "ok"
          MsgBox ("管理员系统登录,单击ok后校验码将更改！") '系统登录成功
          Else
             If TIM = 2 Then
                 TIM = 0
                  MsgBox ("密码输入错误,请向系统管理员查询!" & Chr(34) & "点击确认后将退出程序")
                 'MESSAGE = MsgBox("密码输入错误,请向系统管理员查询!", 0, "")
                 'If MESSAGE = vbOK Then End
           End If
           MsgBox ("密码错误,请重新输入密码!")
           TIM = TIM + 1 '密码输入错误次数
           makey.Text = ""
           makey.SetFocus
        End If
     End If
     myrs.Close
     mydb.Close
Else
    findmakey.Caption = "管理员校验码查询"
    Set mydb = Workspaces(0).OpenDatabase(App.Path & "\data\data.mdb")
     Set myrs = mydb.OpenRecordset("管理表", dbOpenDynaset)
     myrs.FindFirst "用户名 = " + Chr(34) + maname.Text + Chr(34) + ""
     myrs.Edit
              myrs.Fields("用户名") = maname.Text
              myrs.Fields("密码") = makey.Text
              myrs.Fields("姓名") = keytokey.Text
              myrs.Update
              MsgBox "管理员用户名、密码和校验码更改成功！请确认"
        myrs.Close
        mydb.Close
End If
errorhandler:
Select Case Err.Number
  Case 94
     MsgBox ("此管理员用户不对，请确认!")
     findmakey.Caption = "管理员校验码查询"
     maname.Text = ""
     makey.Text = ""
     keytokey.Text = ""
     End Select
End Sub

Private Sub play_Click()
On Error Resume Next
Dim sql1 As String
Frame5.Visible = True
Frame6.Visible = False
For i = Combo1.ListCount - 1 To 0 Step -1
   Combo1.RemoveItem j
   Next
Set mydb = Workspaces(0).OpenDatabase(App.Path & "\data\data.mdb") '设置数据库
  sql = "select 用户名 from 管理表"
  Set myrs = mydb.OpenRecordset(sql)
  If myrs.EOF = False Then myrs.MoveLast
  If myrs.BOF = False Then myrs.MoveFirst
  For i = 0 To myrs.RecordCount - 1
      If myrs.Fields(0) <> "" Then Combo1.AddItem (myrs.Fields(0))   '将管理员添加到管理员列表框
      myrs.MoveNext
  Next i
  If Combo1.ListCount > 0 Then Combo1.ListIndex = 0  '移动记录到第一条
  Set mydb1 = Workspaces(0).OpenDatabase(App.Path & "\data\data.mdb")
  sql1 = "select 密码 from 管理表"
  Set myrs = mydb1.OpenRecordset(sql1)
  key.Text = myrs.Fields("密码")
  myrs.Close
End Sub

Private Sub finish_Click()
Frame5.Visible = False
Frame6.Visible = False
maname.Text = ""
makey.Text = ""
keytokey.Text = ""
For i = Combo1.ListCount - 1 To 0 Step -1
   Combo1.RemoveItem j
   Next
End Sub

Private Sub exit_Click()
Unload main
End Sub
Private Sub load1_Click()
Frame2.Visible = True
Frame3.Visible = False
Frame4.Visible = False
End Sub

Private Sub load2_Click()
 If username.Text <> "" Then
     Set mydb = Workspaces(0).OpenDatabase(App.Path & "\data\data.mdb")
     Set myrs = mydb.OpenRecordset("管理表", dbOpenDynaset)
     myrs.FindFirst "用户名 = " + Chr(34) + username.Text + Chr(34) + ""   ' 查找用户
     If myrs.NoMatch Then                                     '没查到记录
        MsgBox ("无此用户！")
       username.Text = ""
       password.Text = ""
       Else
        If password.Text = myrs.Fields("密码") Then               '????????????确认密码
           MsgBox "系统登陆成功！" '系统登录成功
           ok.Enabled = True
           str1 = username.Text
           str2 = password.Text
          username.Text = ""
          password.Text = ""
         Else
           If TIM = 3 Then
              TIM = 0
              MESSAGE = MsgBox("密码输入错误,请向系统管理员查询!", 0, "")
              If MESSAGE = vbOK Then End
           End If
           MsgBox ("密码错误,请重新输入密码!")
           TIM = TIM + 1 '密码输入错误次数
           password.Text = ""
           password.SetFocus
        End If
     End If
     myrs.Close
     mydb.Close
  End If
End Sub

Private Sub ok_Click()
able (1)
ok.Enabled = False
If key1 = True Then
 sql = "请输入管理员校验码" + Chr(13) + Chr(10) + "然后单击确定"
  MESSAGE = InputBox$(sql, "输入框")
   If MESSAGE <> "" Then
         Set mydb = Workspaces(0).OpenDatabase(App.Path & "\data\data.mdb")
         Set myrs = mydb.OpenRecordset("管理表", dbOpenDynaset)
         myrs.FindFirst "用户名 = " + Chr(34) + str1 + Chr(34) + ""
         If str2 = myrs.Fields("密码") Then
            If MESSAGE = myrs.Fields("姓名") Then
               Frame4.Visible = True
               Frame2.Visible = False
               able (2)
            Else
               If TIM = 3 Then
                    TIM = 0
                    MsgBox ("管理员校验码输入错误！请查实管理员用户.")
                    If vbOK Then End
               End If
              MsgBox ("管理员校验码输入错误！请重新输入!")
              TIM = TIM + 1 '密码输入错误次数
              End If
        End If
        myrs.Close
        mydb.Close
        key1 = False
    End If
    Frame2.Visible = False
  Else
  Frame2.Visible = False
  Unload Me
End If
End Sub

Private Sub unload1_Click()
Unload Me
End Sub

Private Sub username_KeyDown(KeyCode As Integer, Shift As Integer)  '回车换行
  If KeyCode = vbKeyReturn Then
     password.SetFocus
  End If
End Sub
Private Sub password_KeyDown(KeyCode As Integer, Shift As Integer)
  If KeyCode = vbKeyReturn Then
     load2.SetFocus
  End If
  If KeyCode = vbKeyDown Then
     load2.SetFocus
  End If
  If KeyCode = vbKeyUp Then
     username.SetFocus
  End If
End Sub