operationer.frm

用VB做的一个数据库管理系统

VERSION 5.00
Object = "{5E9E78A0-531B-11CF-91F6-C2863C385E30}#1.0#0"; "MSFLXGRD.OCX"
Begin VB.Form Operationer 
   AutoRedraw      =   -1  'True
   BorderStyle     =   3  'Fixed Dialog
   Caption         =   "操作员配置"
   ClientHeight    =   3255
   ClientLeft      =   45
   ClientTop       =   330
   ClientWidth     =   5250
   Icon            =   "Operationer.frx":0000
   LinkTopic       =   "Form1"
   LockControls    =   -1  'True
   MaxButton       =   0   'False
   MDIChild        =   -1  'True
   MinButton       =   0   'False
   ScaleHeight     =   3255
   ScaleWidth      =   5250
   ShowInTaskbar   =   0   'False
   Begin VB.CommandButton Command2 
      Caption         =   "取消(&C)"
      Height          =   405
      Left            =   3720
      TabIndex        =   4
      Top             =   825
      Width           =   1185
   End
   Begin VB.CommandButton Command1 
      Caption         =   "保存(S)"
      Enabled         =   0   'False
      Height          =   405
      Left            =   3720
      TabIndex        =   3
      Top             =   360
      Width           =   1185
   End
   Begin VB.TextBox Text3 
      Height          =   300
      IMEMode         =   3  'DISABLE
      Left            =   3600
      MaxLength       =   20
      PasswordChar    =   "*"
      TabIndex        =   2
      Top             =   2520
      Width           =   1320
   End
   Begin VB.TextBox Text2 
      Height          =   300
      IMEMode         =   3  'DISABLE
      Left            =   3600
      MaxLength       =   20
      PasswordChar    =   "*"
      TabIndex        =   1
      Top             =   2115
      Width           =   1320
   End
   Begin VB.TextBox Text1 
      Height          =   300
      Left            =   3600
      MaxLength       =   5
      TabIndex        =   0
      Top             =   1725
      Width           =   1320
   End
   Begin VB.Frame Frame1 
      Caption         =   "操作员列表"
      Height          =   2730
      Left            =   165
      TabIndex        =   5
      Top             =   330
      Width           =   2385
      Begin MSFlexGridLib.MSFlexGrid Grid1 
         Height          =   2235
         Left            =   135
         TabIndex        =   6
         ToolTipText     =   "双击删除自己帐号,下次启动时生效!"
         Top             =   345
         Width           =   2100
         _ExtentX        =   3704
         _ExtentY        =   3942
         _Version        =   393216
         FixedCols       =   0
         BackColorSel    =   8421376
         BackColorBkg    =   12632256
         AllowBigSelection=   0   'False
         FocusRect       =   0
         ScrollBars      =   2
         SelectionMode   =   1
         AllowUserResizing=   1
      End
   End
   Begin VB.Label Label3 
      AutoSize        =   -1  'True
      Caption         =   "重复："
      Height          =   180
      Left            =   3000
      TabIndex        =   9
      Top             =   2580
      Width           =   540
   End
   Begin VB.Label Label2 
      AutoSize        =   -1  'True
      Caption         =   "口令："
      Height          =   180
      Left            =   3000
      TabIndex        =   8
      Top             =   2175
      Width           =   540
   End
   Begin VB.Label Label1 
      AutoSize        =   -1  'True
      Caption         =   "姓名："
      Height          =   180
      Left            =   3000
      TabIndex        =   7
      Top             =   1770
      Width           =   540
   End
End
Attribute VB_Name = "Operationer"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim DelNO As Integer, UserStr As String
Private Sub Command1_Click()
UserText = Text1.Text
'保存
'如果要加密的话，请将 Text2.text 的文本加密!
'别忘记在登录时，要进行解密!
 Dim shiftStr As String, shiftStrR As Variant, shiftNum As Integer, iLi As Integer, sureStr As String
      shiftStr = Trim(Text2.Text)
      shiftNum = Len(shiftStr)
      iLi = 1
      sureStr = ""
  For iLi = 1 To shiftNum
      shiftStrR = Mid(shiftStr, iLi, 1)
      shiftStrR = Asc(shiftStrR)
      shiftStrR = shiftStrR - 3
      shiftStrR = Chr(shiftStrR)
      sureStr = sureStr & shiftStrR
  Next
  '配置网格
  Grid1.Visible = False
  Grid1.Clear
  Grid1.Cols = 2
  Grid1.FormatString = "^ 操作员 |^  口令 "
  Grid1.ColWidth(0) = 800
  Grid1.ColWidth(1) = 1210
  Dim DB As Database, RecStr As String
  Set DB = OpenDatabase(App.Path & "\Sys\Store.mdb", 0, 0, Constr)
      RecStr = "Insert into Main (操作员,口令) values('" & Trim(Text1.Text) & "','" & Trim(sureStr) & "')"
      DB.Execute RecStr
      DB.Close
Dim Ef As Recordset, HH As Integer
        sureStr = ""
        shiftStr = ""
        shiftStrL = ""
        shiftStrR = ""
        shiftNum = 0
        iLi = 0
        TempStr = ""
        Qy = 0
    Set DB = OpenDatabase(App.Path & "\Sys\Store.mdb", 0, 0, Constr)
    Set Ef = DB.OpenRecordset("MAIN", dbOpenTable)
        DelNO = Ef.RecordCount
        Grid1.Rows = Ef.RecordCount + 4
    Set Ef = DB.OpenRecordset("Select * From MAIN", dbOpenDynaset)
        HH = 1
        Do While Not Ef.EOF()
           Grid1.Row = HH
           Grid1.Col = 0
           Grid1.CellAlignment = 1
        If Not IsNull(Ef.Fields(0).Value) Then
           Grid1.Text = Ef.Fields(0).Value
           UserStr = Grid1.Text
        End If
           Grid1.Row = HH
           Grid1.Col = 1
           Grid1.CellAlignment = 1
        If Not IsNull(Ef.Fields(1).Value) Then
           '解口令为可视
               shiftStr = Trim(Ef.Fields(1).Value)
               shiftNum = Len(shiftStr)
               iLi = 1
               sureStr = ""
               Qy = 0
        For iLi = 1 To shiftNum
            shiftStrR = Mid(shiftStr, iLi, 1)
            shiftStrR = Asc(shiftStrR)
            shiftStrR = shiftStrR + 3
            shiftStrR = Chr(shiftStrR)
            sureStr = sureStr & shiftStrR
        Next
           If UserStr = UserText Then
              Grid1.Text = sureStr
              Else
              Grid1.Text = "********"
          End If
        End If
          Ef.MoveNext
          HH = HH + 1
        Loop
        DB.Close
 Grid1.Col = 0
 Grid1.Row = 1
 Grid1.ColSel = 1
 Grid1.Visible = True
 Text1.Text = ""
 Text2.Text = ""
 Text3.Text = ""
 Text1.SetFocus
 End Sub

Private Sub Command2_Click()
Unload Me
End Sub

Private Sub Form_Load()
Operationer.Left = (MDIForm1.Width - Operationer.Width) / 2
Operationer.Top = (MDIForm1.Height - Operationer.Height) / 2 - 1000
'配置网格
Grid1.Visible = False
Grid1.Cols = 2
Grid1.FormatString = "^ 操作员 |^  口令 "
Grid1.ColWidth(0) = 800
Grid1.ColWidth(1) = 1210
Dim DB As Database, Ef As Recordset, HH As Integer
Dim shiftStr As String, shiftStrL As String, shiftStrR As String, shiftNum As Integer, iLi As Integer, TempStr As String, sureStr As String, Qy As Integer
    Set DB = OpenDatabase(App.Path & "\Sys\Store.mdb", 0, 0, Constr)
    Set Ef = DB.OpenRecordset("MAIN", dbOpenTable)
        DelNO = Ef.RecordCount
        Grid1.Rows = Ef.RecordCount + 4
    Set Ef = DB.OpenRecordset("Select * From MAIN", dbOpenDynaset)
        HH = 1
        Do While Not Ef.EOF()
           Grid1.Row = HH
           Grid1.Col = 0
           Grid1.CellAlignment = 1
        If Not IsNull(Ef.Fields(0).Value) Then
           Grid1.Text = Ef.Fields(0).Value
           UserStr = Grid1.Text
        End If
           Grid1.Row = HH
           Grid1.Col = 1
           Grid1.CellAlignment = 1
        If Not IsNull(Ef.Fields(1).Value) Then
           '解口令为可视
               shiftStr = Trim(Ef.Fields(1).Value)
               shiftNum = Len(shiftStr)
               iLi = 1
               sureStr = ""
               Qy = 0
        For iLi = 1 To shiftNum
            shiftStrR = Mid(shiftStr, iLi, 1)
            shiftStrR = Asc(shiftStrR)
            shiftStrR = shiftStrR + 3
            shiftStrR = Chr(shiftStrR)
            sureStr = sureStr & shiftStrR
        Next
           If UserStr = UserText Then
              Grid1.Text = sureStr
              Else
              Grid1.Text = "********"
           End If
        End If
          Ef.MoveNext
          HH = HH + 1
        Loop
        DB.Close
 Grid1.Col = 0
 Grid1.Row = 1
 Grid1.ColSel = 1
 Grid1.Visible = True
End Sub

Private Sub Grid1_DblClick()
If Grid1.Text = "" Or Grid1.MouseRow = 0 Then Exit Sub
If DelNO = 1 Or Grid1.Text <> UserText Then
   MsgBox "只剩下唯一的操作员或者你试图删除其他用户,请注意!", vbOKOnly + 32, "不能删除"
   Exit Sub
End If
   Dim Qp As Integer
   Qp = MsgBox("真的要删除[" & Grid1.Text & "]操作员吗（Y/N）？", vbYesNo + 16, "确认删除")
   If Qp = 7 Then
      Exit Sub
   End If
Dim DB As Database, RecStr As String
  Set DB = OpenDatabase(App.Path & "\Sys\Store.mdb", 0, 0, Constr)
      RecStr = "Delete * From Main Where 操作员='" & Grid1.Text & "'"
      DB.Execute RecStr
      DB.Close
'配置网格
Grid1.Visible = False
Grid1.Clear
Grid1.Cols = 2
Grid1.FormatString = "^ 操作员 |^  口令 "
Grid1.ColWidth(0) = 800
Grid1.ColWidth(1) = 1210
Dim Ef As Recordset, HH As Integer
Dim shiftStr As String, shiftStrL As String, shiftStrR As String, shiftNum As Integer, iLi As Integer, TempStr As String, sureStr As String, Qy As Integer
    Set DB = OpenDatabase(App.Path & "\Sys\Store.mdb", 0, 0, Constr)
    Set Ef = DB.OpenRecordset("MAIN", dbOpenTable)
        DelNO = Ef.RecordCount
        Grid1.Rows = Ef.RecordCount + 4
    Set Ef = DB.OpenRecordset("Select * From MAIN", dbOpenDynaset)
        HH = 1
        Do While Not Ef.EOF()
           Grid1.Row = HH
           Grid1.Col = 0
           Grid1.CellAlignment = 1
        If Not IsNull(Ef.Fields(0).Value) Then
           Grid1.Text = Ef.Fields(0).Value
           UserStr = Grid1.Text
        End If
           Grid1.Row = HH
           Grid1.Col = 1
           Grid1.CellAlignment = 1
        If Not IsNull(Ef.Fields(1).Value) Then
           '解口令为可视
               shiftStr = Trim(Ef.Fields(1).Value)
               shiftNum = Len(shiftStr)
               iLi = 1
               sureStr = ""
               Qy = 0
            For iLi = 1 To shiftNum
            shiftStrR = Mid(shiftStr, iLi, 1)
            shiftStrR = Asc(shiftStrR)
            shiftStrR = shiftStrR + 3
            shiftStrR = Chr(shiftStrR)
            sureStr = sureStr & shiftStrR
            Next
        If UserStr = UserText Then
              Grid1.Text = sureStr
              Else
              Grid1.Text = "********"
           End If
        End If
          Ef.MoveNext
          HH = HH + 1
        Loop
        DB.Close
 Grid1.Col = 0
 Grid1.Row = 1
 Grid1.ColSel = 1
 Grid1.Visible = True
End Sub

Private Sub Text1_Change()
If Trim(Text1.Text) <> "" Then
   Command1.Enabled = True
   Else
   Command1.Enabled = False
End If
End Sub

Private Sub Text1_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
   SendKeys "{tab}"
End If
End Sub

Private Sub Text2_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
   SendKeys "{tab}"
End If
End Sub

Private Sub Text3_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
   SendKeys "{tab}"
End If
End Sub

Private Sub Text3_LostFocus()
If Trim(Text3.Text) <> Trim(Text2.Text) Then
   MsgBox "两次口令不符，请重新再来", vbOKOnly + 64, "口令不符"
   Text2.Text = ""
   Text3.Text = ""
   Text2.SetFocus
End If
End Sub