frmadmin.frm

自己用vb开发的局域网考试系统

         _Version        =   393216
         BeginProperty Images {2C247F25-8591-11D1-B16A-00C0F0283628} 
            NumListImages   =   7
            BeginProperty ListImage1 {2C247F27-8591-11D1-B16A-00C0F0283628} 
               Picture         =   "FrmAdmin.frx":02D1
               Key             =   "save"
            EndProperty
            BeginProperty ListImage2 {2C247F27-8591-11D1-B16A-00C0F0283628} 
               Picture         =   "FrmAdmin.frx":0365
               Key             =   "undo"
            EndProperty
            BeginProperty ListImage3 {2C247F27-8591-11D1-B16A-00C0F0283628} 
               Picture         =   "FrmAdmin.frx":03D5
               Key             =   "new"
            EndProperty
            BeginProperty ListImage4 {2C247F27-8591-11D1-B16A-00C0F0283628} 
               Picture         =   "FrmAdmin.frx":0455
               Key             =   "edit"
            EndProperty
            BeginProperty ListImage5 {2C247F27-8591-11D1-B16A-00C0F0283628} 
               Picture         =   "FrmAdmin.frx":04F1
               Key             =   "student"
            EndProperty
            BeginProperty ListImage6 {2C247F27-8591-11D1-B16A-00C0F0283628} 
               Picture         =   "FrmAdmin.frx":0945
               Key             =   "grade"
            EndProperty
            BeginProperty ListImage7 {2C247F27-8591-11D1-B16A-00C0F0283628} 
               Picture         =   "FrmAdmin.frx":0D99
               Key             =   "class"
            EndProperty
         EndProperty
      End
      Begin VB.Label Label3 
         Caption         =   "菜单操作权限是设置该操作员是否可以对相应模块进行操作,admin可以操作所有权限."
         BeginProperty Font 
            Name            =   "宋体"
            Size            =   10.5
            Charset         =   134
            Weight          =   400
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         ForeColor       =   &H00FF0000&
         Height          =   900
         Left            =   4665
         TabIndex        =   18
         Top             =   3600
         Width           =   2760
      End
   End
End
Attribute VB_Name = "FrmAdmin"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'保存添加还是修改的标志
Dim NewOrEdit As String
'保存科目的ID
Dim KeMuIdArr() As Long

Private Sub CmdDel_Click()
  If DGadmin.Columns(0).Text = "admin" Then
    MsgBox "这是系统默认的总管理员，只能修改密码，不能删除！"
    Exit Sub
  End If
  If MsgBox("你真的要删除这个操作员吗？", vbYesNo, "提问？") = vbYes Then
    Dim sql As String
    sql = "delete from admin where code='" + DGadmin.Columns(0).Text + "'"
    adoCn.Execute sql
    '更新
    Dim adoRs As Recordset
    Set adoRs = New Recordset
    adoRs.Open "select code as 编号,name as 姓名 from admin", adoCn, adOpenStatic, adLockOptimistic
    Set DGadmin.DataSource = adoRs
    ViewQX DGadmin.Columns(0).Text
  End If
End Sub

Private Sub CmdEdit_Click()
 If DGadmin.Columns(0).Text = "admin" Then
    MsgBox "这是系统默认的总管理员，只能修改密码，不能修改权限！"
    Exit Sub
 End If
 If CmdNew.ToolTipText = "添加操作员信息" Then
  SetEnabled True
  CmdNew.Picture = ImgLst.ListImages(1).Picture
  CmdEdit.Picture = ImgLst.ListImages(2).Picture
  CmdNew.ToolTipText = "保存操作员信息"
  CmdEdit.ToolTipText = "取消保存"
  NewOrEdit = "Edit"
 Else
  ClsXS
  ViewQX DGadmin.Columns(0).Text
  SetEnabled False
  CmdNew.Picture = ImgLst.ListImages(3).Picture
  CmdEdit.Picture = ImgLst.ListImages(4).Picture
  CmdNew.ToolTipText = "添加操作员信息"
  CmdEdit.ToolTipText = "编辑操作员信息"
 End If
End Sub

Private Sub CmdNew_Click()
 If CmdNew.ToolTipText = "添加操作员信息" Then
  SetEnabled True
  CmdNew.Picture = ImgLst.ListImages(1).Picture
  CmdEdit.Picture = ImgLst.ListImages(2).Picture
  CmdNew.ToolTipText = "保存操作员信息"
  CmdEdit.ToolTipText = "取消保存"
  NewOrEdit = "New"
  '清空
  ClsXS
 Else
  '判断是新建还是编辑
  Dim sql As String
  If NewOrEdit = "New" Then
   '检查输入
    If TXTCode = "" Then
     MsgBox "请输入操作员编号！"
     TXTCode.SetFocus
     Exit Sub
    End If
    If TXTName = "" Then
     MsgBox "请输入操作员姓名！"
     TXTName.SetFocus
     Exit Sub
    End If
    '判断是否已经存在这个编号
    Dim adoRs As Recordset
    Set adoRs = New Recordset
    adoRs.Open "select code from admin where code='" + TXTCode + "'", adoCn, adOpenStatic, adLockOptimistic
    If adoRs.RecordCount > 0 Then
     MsgBox "这个编号已经存在！请重新输入编号！"
     TXTCode.SetFocus
     TXTCode.SelStart = 0
     TXTCode.SelLength = Len(TXTCode.Text)
     adoRs.Close
     Exit Sub
    End If
    adoRs.Close
    sql = "insert into admin(code,name,pass,quanxian,kemuQX) values('" + TXTCode + "','" + TXTName + "','" + TXTPass + "','" + CreateQX + "','" + CreateKMQX + "')"
    adoCn.Execute sql
    adoRs.Open "select code as 编号,name as 姓名 from admin", adoCn, adOpenStatic, adLockOptimistic
    Set DGadmin.DataSource = adoRs
    ViewQX DGadmin.Columns(0).Text
  Else
    sql = "update admin set quanxian='" + CreateQX + "',kemuQX='" + CreateKMQX + "' where code='" + DGadmin.Columns(0).Text + "'"
    adoCn.Execute sql
  End If
  SetEnabled False
  CmdNew.Picture = ImgLst.ListImages(3).Picture
  CmdEdit.Picture = ImgLst.ListImages(4).Picture
  CmdNew.ToolTipText = "添加操作员信息"
  CmdEdit.ToolTipText = "编辑操作员信息"
 End If

End Sub
'清除控件
Sub ClsXS()
 Dim i As Integer
 TXTName = ""
 TXTCode = ""
 TXTPass = ""
 For i = 0 To LstQX.ListCount - 1
  LstQX.Selected(i) = False
 Next i
 TXTCode.SetFocus
End Sub
'设置控件是否可以编辑
Sub SetEnabled(ByVal TF As Boolean)
  Frame3.Enabled = TF
  Frame2.Enabled = TF
  DGadmin.Enabled = Not TF
  CmdDel.Enabled = Not TF
  Frame4.Enabled = TF
End Sub
'生成权限的函数
Function CreateQX() As String
 Dim i As Integer
 Dim QX As String
 For i = 0 To LstQX.ListCount - 1
  If LstQX.Selected(i) = True Then
   QX = QX + "Y,"
   Else
   QX = QX + "N,"
  End If
 Next i
 CreateQX = Left(QX, Len(QX) - 1)
End Function
'生成科目权限字符串函数
Function CreateKMQX() As String
  Dim i As Integer
  Dim QX As String
  For i = 0 To LstKM.ListCount - 1
   If LstKM.Selected(i) = True Then
     QX = QX + Int2Str(KeMuIdArr(i)) + ","
   End If
  Next i
  If QX = "" Then QX = ","
  CreateKMQX = Left(QX, Len(QX) - 1)
End Function
'显示权限
Sub ViewQX(ByVal ID As String)
''''''''''''''菜单顺序
'试卷生成/修改
'考试设置
'考生信息录入
'选择题录入/修改
'填空题录入/修改
'判断题录入/修改
'问答题录入/修改
'作文题录入/修改
'题目查询
'考生查询
'考生成绩查询
'系统数据库初始化
'单位信息设置
'科目信息维护
'年份信息维护
'操作员维护
'数据备份/恢复
'判卷处理
On Error Resume Next
  Dim adoRs As Recordset
  Dim strArr() As String
  Dim i As Integer
  Dim j As Integer
  Set adoRs = New Recordset
  adoRs.Open "select quanxian,kemuQX from admin where code='" + ID + "'", adoCn, adOpenStatic, adLockOptimistic
  strArr = Split(adoRs.Fields("quanxian"), ",")
  For i = 0 To LstQX.ListCount - 1
    If strArr(i) = "Y" Then
      LstQX.Selected(i) = True
     Else
      LstQX.Selected(i) = False
    End If
  Next i
'显示科目的权限
 For i = 0 To LstKM.ListCount - 1
    LstKM.Selected(i) = False
 Next i
 If adoRs.Fields("kemuQX").Value <> "" Then
  strArr = Split(adoRs.Fields("kemuQX").Value, ",")
  For i = 0 To UBound(strArr)
     For j = 0 To LstKM.ListCount - 1
        If KeMuIdArr(j) = strArr(i) Then
           LstKM.Selected(j) = True
        End If
     Next j
  Next i
 End If
 
 Set adoRs = Nothing

End Sub

Private Sub Command1_Click()
'更新菜单权限
FrmMain.SetMeun
Unload Me
End Sub

Private Sub DGadmin_RowColChange(LastRow As Variant, ByVal LastCol As Integer)
 ViewQX DGadmin.Columns(0).Text
End Sub
Private Sub Form_Load()
 Dim sql As String
 Dim adoRs As Recordset
 Set adoRs = New Recordset
 sql = "select code as 编号,name as 姓名 from admin"
 adoRs.Open sql, adoCn, adOpenStatic, adLockOptimistic
 Set DGadmin.DataSource = adoRs
 'adoRS.Close
 ViewQX DGadmin.Columns(0).Text
 
 Dim kemuRs As Recordset
 Set kemuRs = New Recordset
 kemuRs.Open "kemu", adoCn, adOpenStatic, adLockOptimistic
 If Not kemuRs.EOF Then
  kemuRs.MoveLast
  kemuRs.MoveFirst
  ReDim KeMuIdArr(kemuRs.RecordCount) As Long
    '添加到控件
  LstKM.Clear
  Do While Not kemuRs.EOF
     KeMuIdArr(1) = kemuRs.Fields("id").Value
     LstKM.AddItem kemuRs.Fields("name").Value
     kemuRs.MoveNext
  Loop
  LstKM.ListIndex = 0
 End If
Set kemuRs = Nothing
End Sub

Private Sub TXTCode_KeyPress(KeyAscii As Integer)
   If KeyAscii = 39 Then KeyAscii = -24145

End Sub

Private Sub TXTName_KeyPress(KeyAscii As Integer)
   If KeyAscii = 39 Then KeyAscii = -24145

End Sub

Private Sub TXTpass_KeyPress(KeyAscii As Integer)
    If KeyAscii = 39 Then KeyAscii = -24145

End Sub