frmoperator.frm

银行定储模拟程序

   End
   Begin VB.Line Line4 
      X1              =   3600
      X2              =   5940
      Y1              =   2835
      Y2              =   2835
   End
   Begin VB.Menu MnuOperate 
      Caption         =   "帐号操作^&C)"
      Begin VB.Menu MnuAdd 
         Caption         =   "添加帐号[&A]"
         Shortcut        =   ^A
      End
      Begin VB.Menu Line02 
         Caption         =   "-"
      End
      Begin VB.Menu MnuDelete 
         Caption         =   "删除帐号[&D] ..."
         Shortcut        =   {DEL}
      End
      Begin VB.Menu Line01 
         Caption         =   "-"
         Visible         =   0   'False
      End
   End
   Begin VB.Menu MnuReturn 
      Caption         =   "关闭选择^&O)"
      Begin VB.Menu MnuAuthority 
         Caption         =   "返回首页[&A]..."
         Shortcut        =   ^R
      End
   End
End
Attribute VB_Name = "frmOperator"
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 cmbAuthority_Change()

If KeyAscii = 13 Then
   SendKeys "{tab}"
End If

End Sub

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

Private Sub Command1_Click()
 
 If InStr(1, Trim(Text1.Text), "'", vbTextCompare) Then
    MsgBox "操作员姓名之中有特殊字符" + "<'>,请删除。", vbOKOnly + 48, "提示："
    Text1.SetFocus
    Exit Sub
 End If
 
 On Error Resume Next
'校对数据库是否已经存在该操作员
 Dim db As Database, EF As Recordset, RecStr As String
  
  DBEngine.BeginTrans
  
  Set db = OpenDatabase(ConData, False, False, ConStr)
  Set EF = db.OpenRecordset("User", dbOpenDynaset)
      RecStr = "UID='" & Trim(Text1.Text) & "'"
      EF.FindFirst RecStr
   If Not EF.NoMatch Then
      EF.Close
      db.Close
      MsgBox "操作员< " & Trim(Text1.Text) & " >已经存在,不能继续!    ", vbInformation
      Text1.Text = ""
      Text1.SetFocus
      Exit Sub
   End If
      EF.Close

 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
 '保存记录
      RecStr = "Insert into User (UID,PWD,权限,工号) values('" & Trim(Text1.Text) & "','" & Cipher(Trim(SureStr)) & "','" & cmbAuthority.Text & "','" & Text3.Text & "')"
      db.Execute RecStr
      db.Close
  
  DBEngine.CommitTrans
  
 '刷新记录
 LoadOperator
 
 Text1.Text = ""  '刷新数据
 Text2.Text = ""
 Text3.Text = ""
 Text1.SetFocus
 
 End Sub

Private Sub Command2_Click()
Unload Me
End Sub

Private Sub Form_Load()
On Error Resume Next
frmOperator.HelpContextID = 5

'安装操作员
LoadOperator
cmbAuthority.ListIndex = 0
End Sub
Private Sub Form_Unload(Cancel As Integer)
 AniUnloadFrm Me.hwnd
End Sub

Private Sub Grid1_DblClick()
 
 If Grid1.Text = "" Then
    MnuDelete.Enabled = False
    MnuAuthority.Enabled = False
 Else
    MnuDelete.Enabled = True
    MnuAuthority.Enabled = True
 End If
 
 PopupMenu MnuOperate
 
End Sub

Private Sub Grid1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)


 If Grid1.Text = "" Then
    MnuDelete.Enabled = False
    MnuAuthority.Enabled = False
 Else
    MnuDelete.Enabled = True
    MnuAuthority.Enabled = True
 End If
 
 If Button = 2 Then
    PopupMenu MnuOperate
 End If
 
End Sub


Private Sub MnuAdd_Click()

 Text1.SetFocus
 
End Sub

Private Sub MnuAuthority_Click()

  GetStatus "返回首页"
  Unload Me
  
End Sub

Private Sub MnuDelete_Click()

 DeleteRecord
 
End Sub

Private Sub MnuOperate_Click()
 
  GetStatus "帐号删除、添加操作"
  
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 And Trim(Text1.Text) <> "" 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 DeleteRecord()

On Error Resume Next

If Grid1.Text = "" Then Exit Sub
If DelNO = 1 Then
   MsgBox "仅剩下当前用户了,不能继续,请注意!    ", vbOKOnly + 32, "不能删除"
   Exit Sub
End If
   Dim Qp As Integer
   Qp = MsgBox("真的要删除[" & Grid1.Text & "]操作员吗（Y/N）？", vbYesNo + 16 + vbDefaultButton2, "确认删除")
   If Qp = 7 Then
      Exit Sub
   End If
Dim db As Database, RecStr As String
    DBEngine.BeginTrans
  Set db = OpenDatabase(ConData, False, False, ConStr)
      RecStr = "Delete * From User Where UID='" & Grid1.Text & "'"
      db.Execute RecStr
      db.Close
    DBEngine.CommitTrans
  '刷新记录
  LoadOperator

End Sub

Private Sub LoadOperator()

  '配置网格
Grid1.Visible = False
Grid1.Clear
Grid1.Cols = 4
Grid1.FormatString = "^ 操作员 |^  口令 |^ 权限 |^ 工号 "
Grid1.ColWidth(0) = 800
Grid1.ColWidth(1) = 800
Grid1.ColWidth(2) = 900
Grid1.ColWidth(3) = 700
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(ConData, False, False, ConStr)
    Set EF = db.OpenRecordset("User", dbOpenTable)
        DelNO = EF.RecordCount
        Grid1.Rows = EF.RecordCount + 4
    Set EF = db.OpenRecordset("Select * From User", 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
              '因为是超级用户,所以可以看见所有的帐号密码
            Grid1.Text = "******"
        End If
           Grid1.Row = HH
           Grid1.Col = 2
           Grid1.CellAlignment = 1
        If Not IsNull(EF.Fields(2).Value) Then
           Grid1.Text = EF.Fields(2).Value
        End If
           Grid1.Row = HH
           Grid1.Col = 3
           Grid1.CellAlignment = 1
        If Not IsNull(EF.Fields(3).Value) Then
           Grid1.Text = EF.Fields(3).Value
        End If
          EF.MoveNext
          HH = HH + 1
        Loop
        EF.Close
        db.Close
        
 Grid1.Col = 0
 Grid1.Row = 1
 Grid1.ColSel = 2
 Grid1.Visible = True

End Sub