frmoperator.frm

星级酒店管理系统（附带系统自写控件源码）

      End
      Begin VB.Menu mnuModify 
         Caption         =   "&M 修改帐号"
         Shortcut        =   {F12}
      End
      Begin VB.Menu Line01 
         Caption         =   "-"
      End
      Begin VB.Menu MnuDelete 
         Caption         =   "&D 删除帐号 ..."
         Shortcut        =   {DEL}
      End
   End
   Begin VB.Menu MnuReturn 
      Caption         =   "返回首页(&R)"
   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 cmbEmploy_Change()

   On Error Resume Next
   Text1.Text = cmbEmploy.Text
   Text1.SelStart = 0
   Text1.SelLength = Len(Text1.Text)
   Text1.SetFocus
   
End Sub

Private Sub cmbEmploy_Click()

   On Error Resume Next
   Text1.Text = cmbEmploy.Text
   Text1.SelStart = 0
   Text1.SelLength = Len(Text1.Text)
   Text1.SetFocus
   
End Sub

Private Sub cmdModify_Click()

  If Grid1.Text = "" Then
     MsgBox "请选择用户名后再修改？  ", vbInformation
     Exit Sub
  End If
  
  If cmdModify.Caption = "保存(&S)" Then
     cmdModify.Caption = "修改(&M)"
     
     If Trim(Text2.Text) = Trim(Text3.Text) Then
       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
        
       '=========================================================
        Dim DB As Connection, RecStr As String
        Set DB = CreateObject("ADODB.Connection")
            DB.Open Constr
            
            RecStr = "Update Main Set 口令='" & SureStr & "' Where 操作员='" & Trim(Text1.Text) & "'"
            DB.Execute RecStr
            DB.Close
            Set DB = Nothing
        
        Command1.Enabled = True
        Command2.Enabled = True
        mnuModify.Enabled = True
        MnuDelete.Enabled = True
        Grid1.Enabled = True
        Text1.Enabled = True
        ConfigGrid
        Text1.Text = "": Text2.Text = "": Text3.Text = ""
        Text1.SetFocus
        Exit Sub
       Else
        MsgBox "对不起，两次口令不一致，请重新输入？  ", vbInformation
        Text2.Text = ""
        Text3.Text = ""
        Text2.SetFocus
        Exit Sub
     End If
    Else
     cmdModify.Caption = "保存(&S)"
        Text1.Text = Grid1.Text
        Text1.Enabled = False
        Text2.SetFocus
     Command1.Enabled = False
     Command2.Enabled = False
     mnuModify.Enabled = False
     MnuDelete.Enabled = False
     Grid1.Enabled = False
  End If
  
End Sub

Private Sub Command1_Click()
 
 On Error GoTo AddERR
 
'校对数据库是否已经存在该操作员
 Dim DB As Connection, EF As Recordset, RecStr As String
  
  Set DB = CreateObject("ADODB.Connection")
  Set EF = CreateObject("ADODB.Recordset")
      DB.Open Constr
      EF.Open "Main", DB, adOpenStatic, adLockOptimistic, adCmdTable
      RecStr = "操作员='" & Trim(Text1.Text) & "'"
      EF.Find RecStr
   '已经有该操作员时提示
   If Not EF.EOF Then
      EF.Close
      Set EF = Nothing
      DB.Close
      Set DB = Nothing
      MsgBox "操作员< " & Trim(Text1.Text) & " >已经存在,不能继续!    ", vbInformation
      Text1.Text = ""
      Text1.SetFocus
      Exit Sub
   End If
      EF.Close
      Set EF = Nothing
'保存
'如果要加密的话，请将 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
      
     '添加该记录
      RecStr = "Insert into Main (操作员,口令) values('" & Trim(Text1.Text) & "','" & Trim(SureStr) & "')"
      DB.Execute RecStr
      DB.Close
      Set DB = Nothing
      
      ConfigGrid
   
      Text1.Text = ""
      Text2.Text = ""
      Text3.Text = ""
      Text1.SetFocus
        
 Exit Sub
AddERR:
 MsgBox "对不起,启动操作员错误:" & Err.Description, vbCritical
 
 End Sub

Private Sub Command2_Click()
Unload Me
End Sub

Private Sub Form_Activate()

   frmMain.lbControl.Caption = "操作员管理"

End Sub

Private Sub Form_Load()

On Error GoTo LoadERR

frmOperator.HelpContextID = 5

GetFormSet Me, frmMain
OperatorFocus = True

'给出员工内容
GetEmployList cmbEmploy

'配置网格
Grid1.Visible = False
Grid1.Cols = 2
Grid1.FormatString = "^ 操作员 |^  口令 "
Grid1.ColWidth(0) = 800
Grid1.ColWidth(1) = 1210
Dim DB As Connection, 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 = CreateObject("ADODB.Connection")
    Set EF = CreateObject("ADODB.Recordset")
        DB.Open Constr
        EF.ActiveConnection = DB
        EF.Open "MAIN", , adOpenStatic, adLockReadOnly, adCmdTable
        DelNO = EF.RecordCount
        Grid1.Rows = EF.RecordCount + 1
        EF.Close
        EF.Open "Select * From MAIN", , adOpenStatic, adLockReadOnly, adCmdText
        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 = SureStr
        End If
          EF.MoveNext
          HH = HH + 1
        Loop
        
 EF.Close
 Set EF = Nothing
 DB.Close
 Set DB = Nothing
 
 Grid1.Col = 0
 Grid1.Row = 1
 Grid1.ColSel = 1
 Grid1.Visible = True
 
 Exit Sub
LoadERR:
  MsgBox "启动操作员管理错误:" & Err.Description, vbCritical
  Exit Sub
End Sub

Private Sub Form_Unload(Cancel As Integer)

 SaveFormSet Me
 frmMain.lbControl.Caption = "收银控制中心"
 OperatorFocus = False
 
End Sub

Private Sub Grid1_DblClick()
 
 If Grid1.Text = "" Then
    MnuDelete.Enabled = False
    MnuAuthority.Enabled = False
    cmdModify.Enabled = False
    mnuModify.Enabled = False
 Else
    MnuDelete.Enabled = True
    MnuAuthority.Enabled = True
    mnuModify.Enabled = True
    cmdModify.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
    mnuModify.Enabled = False
    cmdModify.Enabled = False
 Else
    MnuDelete.Enabled = True
    MnuAuthority.Enabled = True
    mnuModify.Enabled = True
    cmdModify.Enabled = True
 End If
 
 If Button = 2 Then
    PopupMenu MnuOperate
 End If
 
End Sub

Private Sub MnuAuthority_Click()

 Me.MousePointer = 11
    If Grid1.Rows = 1 Then Exit Sub
    If Grid1.Text = "" Then Exit Sub
    If Grid1.Text = "超级用户" Then
       Me.MousePointer = 0
       MsgBox "超级用户不用设置权限,其已经拥有所有权限。  ", vbInformation
       Exit Sub
    End If
    frmAuthor.suserID = Grid1.Text
    frmAuthor.Show 1
 Me.MousePointer = 0
 
End Sub

Private Sub MnuDelete_Click()

 DeleteRecord
 
End Sub

Private Sub mnuModify_Click()

  cmdModify_Click
  
End Sub

Private Sub MnuReturn_Click()

 Unload Me
 
End Sub

Private Sub Text1_Change()

If cmdModify.Caption = "修改(&M)" Then
If Trim(Text1.Text) <> "" Then
   Command1.Enabled = True
   Else
   Command1.Enabled = False
End If
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 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

Private Sub DeleteRecord()

On Error GoTo DelERR

If Grid1.Text = "" Or Grid1.MouseRow = 0 Then Exit Sub

'超级用户时
If Grid1.Text = "超级用户" Then
    MsgBox "超级用户不能删除，只能修改其密码!    ", vbOKOnly + 32, "不能删除"
    Exit Sub
End If
If DelNO = 1 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 Connection, RecStr As String
  
  Set DB = CreateObject("ADODB.Connection")
      DB.Open Constr
      
      RecStr = "Delete * From Main Where 操作员='" & Grid1.Text & "'"
      DB.Execute RecStr
      DB.Close
      Set DB = Nothing
      
      ConfigGrid

 Exit Sub
DelERR:
 MsgBox "删除操作员错误:" & Err.Description, vbCritical
 Exit Sub
 
End Sub

Private Sub ConfigGrid()

  '配置网格
  Grid1.Visible = False
  Grid1.Clear
  Grid1.Cols = 2
  Grid1.FormatString = "^ 操作员 |^  口令 "
  Grid1.ColWidth(0) = 800
  Grid1.ColWidth(1) = 1210
  Grid1.Rows = 1
  
 Dim DB As Connection
 Dim HH As Integer
 Dim EF As Recordset
 
      SureStr = ""
      shiftStr = ""
      shiftStrL = ""
      shiftStrR = ""
      shiftNum = 0
      ili = 0
      tempStr = ""
      Qy = 0
  
  Set DB = CreateObject("ADODB.connection")
  Set EF = CreateObject("ADODB.Recordset")
      DB.Open Constr
      EF.Open "MAIN", DB, adOpenStatic, adLockReadOnly, adCmdTable
        DelNO = EF.RecordCount
        Grid1.Rows = EF.RecordCount + 1
      EF.Close
      EF.Open "Select * From MAIN", DB, adOpenDynamic, adLockReadOnly, adCmdText
        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 = SureStr
        End If
          EF.MoveNext
          HH = HH + 1
        Loop
        EF.Close
        Set EF = Nothing
        DB.Close
        Set DB = Nothing
 Grid1.Col = 0
 Grid1.Row = 1
 Grid1.ColSel = 1
 Grid1.Visible = True

End Sub