frmsetuser.frm

智能门锁的程序,用于控制门锁发卡程序,是科布尔的

         BackColor       =   &H00C0C0C0&
         Caption         =   "楼号和客房设置"
         BeginProperty Font 
            Name            =   "宋体"
            Size            =   9
            Charset         =   134
            Weight          =   400
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         Height          =   375
         Left            =   2160
         TabIndex        =   24
         Top             =   2880
         Width           =   1695
      End
      Begin VB.CheckBox ChkMnuClearSect 
         BackColor       =   &H00C0C0C0&
         Caption         =   "清洁区域设置"
         BeginProperty Font 
            Name            =   "宋体"
            Size            =   9
            Charset         =   134
            Weight          =   400
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         Height          =   375
         Left            =   6120
         TabIndex        =   26
         Top             =   2880
         Width           =   1455
      End
      Begin VB.CheckBox ChkMnuManager 
         BackColor       =   &H00C0C0C0&
         Caption         =   "用户管理"
         BeginProperty Font 
            Name            =   "宋体"
            Size            =   9
            Charset         =   134
            Weight          =   400
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         Height          =   375
         Left            =   4200
         TabIndex        =   25
         Top             =   2880
         Width           =   1335
      End
   End
   Begin VB.TextBox TxtUserCode 
      Height          =   375
      Left            =   1320
      MaxLength       =   8
      TabIndex        =   0
      Top             =   480
      Width           =   1815
   End
   Begin VB.TextBox TxtUserName 
      Height          =   375
      Left            =   1320
      MaxLength       =   8
      TabIndex        =   1
      Top             =   1080
      Width           =   1815
   End
   Begin VB.TextBox TxtPassWord 
      Height          =   375
      IMEMode         =   3  'DISABLE
      Left            =   1320
      MaxLength       =   6
      PasswordChar    =   "*"
      TabIndex        =   2
      Top             =   1680
      Width           =   1815
   End
   Begin VB.CommandButton CmdAdd 
      Caption         =   "添加"
      Height          =   375
      Left            =   360
      TabIndex        =   3
      Top             =   2760
      Width           =   1455
   End
   Begin VB.CommandButton CmdDelete 
      Caption         =   "删除"
      Enabled         =   0   'False
      Height          =   375
      Left            =   3360
      TabIndex        =   5
      Top             =   2760
      Width           =   1335
   End
   Begin VB.CommandButton CmdCancel 
      Caption         =   "取消"
      Height          =   375
      Left            =   4800
      TabIndex        =   6
      Top             =   2760
      Width           =   1335
   End
   Begin VB.Label LblUserCode 
      Caption         =   "用户代码"
      Height          =   375
      Left            =   240
      TabIndex        =   30
      Top             =   480
      Width           =   975
   End
   Begin VB.Label Label2 
      Caption         =   "用户姓名"
      Height          =   375
      Left            =   240
      TabIndex        =   29
      Top             =   1080
      Width           =   975
   End
   Begin VB.Label Label3 
      Caption         =   "密码"
      Height          =   255
      Left            =   240
      TabIndex        =   28
      Top             =   1680
      Width           =   1095
   End
End
Attribute VB_Name = "FrmSetUser"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim tUserType, tUserCode, tUserName As String
Sub TxtToField()
   With RC_Operator
        .Fields("UserName") = TxtUserName.Text
        .Fields("UserCode") = TxtUserCode.Text
        .Fields("PassWord") = TxtPassWord.Text
        
        
        .Fields("FrmOutSeting") = ChkFrmOutSeting.Value
        .Fields("FrmOutTime") = ChkFrmOutTime.Value
        .Fields("FrmOutCheckOut") = ChkFrmOutCheckOut.Value
        .Fields("FrmOutTemp") = ChkFrmOutTemp.Value
        .Fields("FrmOutControl") = ChkFrmOutControl.Value
        .Fields("FrmOutBuilding") = ChkFrmOutBuilding.Value
        .Fields("FrmOutFloor") = ChkFrmOutFloor.Value
        .Fields("FrmOutZone") = ChkFrmOutZone.Value
        .Fields("FrmOutRepair") = ChkFrmOutRepair.Value
        .Fields("FrmOutMeeting") = ChkFrmOutMeeting.Value
        .Fields("FrmOutChannel") = ChkFrmOutChannel.Value
        .Fields("MnuICCancel") = ChkMnuICCancel.Value
        .Fields("MnuICDataRead") = ChkMnuICDataRead.Value
        
        .Fields("MnuPutOutClientIC") = ChkMnuPutOutClientIC.Value
        .Fields("MnuCancelClientIC") = ChkMnuCancelClientIC.Value
        .Fields("MnuModifyClientIC") = ChkMnuModifyClientIC.Value
        
        .Fields("MnuSetSystem") = ChkMnuSetSystem.Value
        .Fields("MnuSetRoom") = ChkMnuSetRoom.Value
        .Fields("MnuManager") = ChkMnuManager.Value
        .Fields("MnuClearSect") = ChkMnuClearSect.Value
   End With
End Sub
Sub FieldToTxt()
   With RC_Operator
        TxtUserName.Text = .Fields("UserName")
        TxtUserCode.Text = .Fields("UserCode")
        TxtPassWord.Text = .Fields("PassWord")
                
        ChkFrmOutSeting.Value = IIf(.Fields("FrmOutSeting"), Checked, Unchecked)
        ChkFrmOutTime.Value = IIf(.Fields("FrmOutTime"), Checked, Unchecked)
        ChkFrmOutCheckOut.Value = IIf(.Fields("FrmOutCheckOut"), Checked, Unchecked)
        ChkFrmOutTemp.Value = IIf(.Fields("FrmOutTemp"), Checked, Unchecked)
        ChkFrmOutControl.Value = IIf(.Fields("FrmOutControl"), Checked, Unchecked)
        ChkFrmOutBuilding.Value = IIf(.Fields("FrmOutBuilding"), Checked, Unchecked)
        ChkFrmOutFloor.Value = IIf(.Fields("FrmOutFloor"), Checked, Unchecked)
        ChkFrmOutZone.Value = IIf(.Fields("FrmOutZone"), Checked, Unchecked)
        ChkFrmOutRepair.Value = IIf(.Fields("FrmOutRepair"), Checked, Unchecked)
        ChkFrmOutMeeting.Value = IIf(.Fields("FrmOutMeeting"), Checked, Unchecked)
        ChkFrmOutChannel.Value = IIf(.Fields("FrmOutChannel"), Checked, Unchecked)
        ChkMnuICCancel.Value = IIf(.Fields("MnuICCancel"), Checked, Unchecked)
        ChkMnuICDataRead.Value = IIf(.Fields("MnuICDataRead"), Checked, Unchecked)
        
        ChkMnuPutOutClientIC.Value = IIf(.Fields("MnuPutOutClientIC"), Checked, Unchecked)
        ChkMnuCancelClientIC.Value = IIf(.Fields("MnuCancelClientIC"), Checked, Unchecked)
        ChkMnuModifyClientIC.Value = IIf(.Fields("MnuModifyClientIC"), Checked, Unchecked)
        
        ChkMnuSetSystem.Value = IIf(.Fields("MnuSetSystem"), Checked, Unchecked)
        ChkMnuSetRoom.Value = IIf(.Fields("MnuSetRoom"), Checked, Unchecked)
        ChkMnuManager.Value = IIf(.Fields("MnuManager"), Checked, Unchecked)
        ChkMnuClearSect.Value = IIf(.Fields("MnuClearSect"), Checked, Unchecked)
   End With
End Sub
'各字段初始化
Private Sub Fields_Init()
        TxtUserName.Text = ""
        TxtUserCode.Text = ""
        TxtPassWord.Text = ""
        
        ChkMnuICCancel.Value = Unchecked
        ChkMnuICDataRead.Value = Unchecked
        
        ChkFrmOutSeting.Value = Unchecked
        ChkFrmOutTime.Value = Unchecked
        ChkFrmOutCheckOut.Value = Unchecked
        ChkFrmOutTemp.Value = Unchecked
        ChkFrmOutControl.Value = Unchecked
        ChkFrmOutBuilding.Value = Unchecked
        ChkFrmOutFloor.Value = Unchecked
        ChkFrmOutZone.Value = Unchecked
        ChkFrmOutRepair.Value = Unchecked
        ChkFrmOutMeeting.Value = Unchecked
        ChkFrmOutChannel.Value = Unchecked
        
        
        ChkMnuPutOutClientIC.Value = Unchecked
        ChkMnuCancelClientIC.Value = Unchecked
        ChkMnuModifyClientIC.Value = Unchecked
        
        ChkMnuSetSystem.Value = Unchecked
        ChkMnuSetRoom.Value = Unchecked
        ChkMnuManager.Value = Unchecked
        ChkMnuClearSect.Value = Unchecked
End Sub
Function Operator_Srh(pUserName As String, pUserCode As String) As Boolean
    Dim sTmp  As String
    On Error GoTo ErrHand:
       sTmp = "UserCode='" & pUserCode & "' or UserName='" & pUserName & "'"
       With RC_Operator
           If Not (.BOF And .EOF) Then
              .MoveFirst
              .FindLast sTmp
              If Not .NoMatch Then
                    FieldToTxt
                    Exit Function
              End If
            End If
        End With
        Exit Function
ErrHand:
        Operator_Srh = False
End Function
Function Operator_Del(pUserName, pUserCode As String) As Boolean
    Dim sTmp  As String
    Dim iACount As Integer
    On Error GoTo ErrHand:
    If StrComp(pUserName, "Admin", vbTextCompare) = 0 Then
       Operator_Del = False
       Exit Function
    End If
       sTmp = "UserCode='" & pUserCode & "' or UserName='" & pUserName & "'"
       With RC_Operator
           If Not (.BOF And .EOF) Then
              .MoveFirst
              .FindLast sTmp
              If Not .NoMatch Then
                    .Delete
                    Data1.Refresh
                    Fields_Init
                    Operator_Del = True
                    Exit Function
              End If
            End If
        End With
         Operator_Del = False
        Exit Function
ErrHand:
        Operator_Del = False
End Function
Private Sub CmdAdd_Click()
On Error GoTo ErrHand:
    If CmdAdd.Caption = "更新" Then
     If TxtUserName = "" Or TxtUserCode.Text = "" Or TxtPassWord.Text = "" Then
        iTmp = MsgBox("正确录入信息", vbInformation, "提示")
         Exit Sub
     End If
       With RC_Operator
          If Operator_Add(TxtUserCode.Text, TxtUserName.Text, TxtPassWord) Then
             Data1.Refresh
             Call RC_EventLog_Add("添加用户" & TxtUserName.Text, gUserName, "用户代码：" & TxtUserCode.Text)
            Else
             MsgBox "添加失败", vbInformation + vbOKOnly, "提示"
          End If
       End With
       CmdAdd.Caption = "添加"
       iTmp = MsgBox("添加成功", vbInformation, "提示")
       Fields_Init
      Else
       CmdAdd.Caption = "更新"
       Fields_Init
       CmdEdit.Enabled = False
       CmdDelete.Enabled = False
    End If
    Exit Sub
ErrHand:
    MsgBox "添加错误！"
End Sub
Function Operator_Add(pUserCode, pUserName, pPassWord) As Boolean
    Dim sTmp  As String
'    On Error GoTo ErrHand:
       sTmp = "UserCode='" & pUserCode & "' or UserName='" & pUserName & "'"
       With RC_Operator
           If Not (.BOF And .EOF) Then
              .MoveFirst
              .FindLast sTmp
              If Not .NoMatch Then
                 Operator_Add = False
                 Exit Function
              End If
            End If
            .AddNew
            TxtToField
            .UpDate
            Fields_Init
        End With
        Operator_Add = True
        Exit Function
'ErrHand:
'        Operator_Add = False
End Function

Private Sub CmdCancel_Click()
    Unload Me
End Sub

Private Sub CmdDelete_Click()
    If tUserName = "" And tUserCode = "" Then
           MsgBox "无可删除项！", vbInformation + vbOKOnly, "提示"
       Else
           If Operator_Del(tUserName, (tUserCode)) Then
              Data1.Refresh
              Call RC_EventLog_Add("删除用户" & tUserName, gUserName, "用户代码：" & tUserCode)
           End If
    End If
End Sub

Private Sub CmdEdit_Click()
    Dim sTmp  As String
    On Error GoTo ErrHand:
       sTmp = "UserCode='" & TxtUserCode & "' or UserName='" & TxtUserName & "'"
       With RC_Operator
           If Not (.BOF And .EOF) Then
              .MoveFirst
              .FindLast sTmp
              If Not .NoMatch Then
                    .Edit
                    TxtToField
                    .UpDate
                    Exit Sub
              End If
            End If
        End With
        Exit Sub
ErrHand:
        MsgBox "修改失败！", vbCritical, "警告"
End Sub

Private Sub DBGrid1_RowColChange(LastRow As Variant, ByVal LastCol As Integer)
    tUserCode = DBGrid1.Columns(1)
    tUserName = DBGrid1.Columns(0)
    
    If tUserName = "" And tUserCode = "" Then
       CmdDelete.Enabled = False
       Else
       CmdDelete.Enabled = True
       Call Operator_Srh(tUserName, (tUserCode))
    End If
End Sub

Private Sub Form_Load()
     Data1.DatabaseName = SystemDir & "ICData.mdb"
   '  Data1.RecordSource = " select Username as 用户名,usercode as 代码,password1 as 密码, usertype as 用户类型 from Operator"
     tUserName = ""
     tUserCode = ""
End Sub