www.pudn.com > textmanager.rar > FrmAdmin.frm, change:2005-04-12,size:20692b


VERSION 5.00 
Object = "{CDE57A40-8B86-11D0-B3C6-00A0C90AEA82}#1.0#0"; "MSDATGRD.OCX" 
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCTL.OCX" 
Begin VB.Form FrmAdmin  
   BorderStyle     =   3  'Fixed Dialog 
   Caption         =   "操作员信息设置" 
   ClientHeight    =   4770 
   ClientLeft      =   45 
   ClientTop       =   330 
   ClientWidth     =   9330 
   LinkTopic       =   "Form1" 
   LockControls    =   -1  'True 
   MaxButton       =   0   'False 
   MinButton       =   0   'False 
   ScaleHeight     =   4770 
   ScaleWidth      =   9330 
   ShowInTaskbar   =   0   'False 
   StartUpPosition =   1  '所有者中心 
   Begin VB.Frame Frame1  
      Height          =   4665 
      Left            =   30 
      TabIndex        =   0 
      Top             =   30 
      Width           =   9225 
      Begin VB.Frame Frame4  
         Caption         =   "科目操作权限" 
         Enabled         =   0   'False 
         ForeColor       =   &H00FF0000& 
         Height          =   3195 
         Left            =   6900 
         TabIndex        =   16 
         Top             =   180 
         Width           =   2235 
         Begin VB.ListBox LstKM  
            Appearance      =   0  'Flat 
            BackColor       =   &H00E8F4F8& 
            BeginProperty Font  
               Name            =   "宋体" 
               Size            =   10.5 
               Charset         =   134 
               Weight          =   400 
               Underline       =   0   'False 
               Italic          =   0   'False 
               Strikethrough   =   0   'False 
            EndProperty 
            Height          =   2910 
            ItemData        =   "FrmAdmin.frx":0000 
            Left            =   120 
            List            =   "FrmAdmin.frx":0002 
            Style           =   1  'Checkbox 
            TabIndex        =   17 
            Top             =   210 
            Width           =   2025 
         End 
      End 
      Begin VB.Frame Frame8  
         Caption         =   "编辑" 
         Height          =   1050 
         Left            =   6870 
         TabIndex        =   11 
         Top             =   3435 
         Width           =   2265 
         Begin VB.CommandButton Command1  
            Appearance      =   0  'Flat 
            Height          =   300 
            Left            =   1290 
            Picture         =   "FrmAdmin.frx":0004 
            Style           =   1  'Graphical 
            TabIndex        =   15 
            ToolTipText     =   "关闭窗口" 
            Top             =   630 
            Width           =   630 
         End 
         Begin VB.CommandButton CmdNew  
            Appearance      =   0  'Flat 
            Height          =   300 
            Left            =   420 
            Picture         =   "FrmAdmin.frx":008C 
            Style           =   1  'Graphical 
            TabIndex        =   14 
            ToolTipText     =   "添加操作员信息" 
            Top             =   210 
            Width           =   645 
         End 
         Begin VB.CommandButton CmdEdit  
            Appearance      =   0  'Flat 
            Height          =   300 
            Left            =   1245 
            Picture         =   "FrmAdmin.frx":00FA 
            Style           =   1  'Graphical 
            TabIndex        =   13 
            ToolTipText     =   "编辑操作员信息" 
            Top             =   210 
            Width           =   645 
         End 
         Begin VB.CommandButton CmdDel  
            Appearance      =   0  'Flat 
            Height          =   300 
            Left            =   435 
            Picture         =   "FrmAdmin.frx":0184 
            Style           =   1  'Graphical 
            TabIndex        =   12 
            ToolTipText     =   "删除该操作员信息" 
            Top             =   630 
            Width           =   630 
         End 
      End 
      Begin VB.Frame Frame3  
         Enabled         =   0   'False 
         Height          =   1185 
         Left            =   60 
         TabIndex        =   4 
         Top             =   120 
         Width           =   4455 
         Begin VB.TextBox TXTPass  
            Appearance      =   0  'Flat 
            BackColor       =   &H00E8F4F8& 
            BeginProperty Font  
               Name            =   "宋体" 
               Size            =   10.5 
               Charset         =   134 
               Weight          =   400 
               Underline       =   0   'False 
               Italic          =   0   'False 
               Strikethrough   =   0   'False 
            EndProperty 
            Height          =   285 
            IMEMode         =   3  'DISABLE 
            Left            =   1170 
            MaxLength       =   20 
            PasswordChar    =   "*" 
            TabIndex        =   10 
            Top             =   690 
            Width           =   1575 
         End 
         Begin VB.TextBox TXTName  
            Appearance      =   0  'Flat 
            BackColor       =   &H00E8F4F8& 
            BeginProperty Font  
               Name            =   "宋体" 
               Size            =   10.5 
               Charset         =   134 
               Weight          =   400 
               Underline       =   0   'False 
               Italic          =   0   'False 
               Strikethrough   =   0   'False 
            EndProperty 
            Height          =   285 
            Left            =   2700 
            MaxLength       =   10 
            TabIndex        =   8 
            Top             =   270 
            Width           =   1305 
         End 
         Begin VB.TextBox TXTCode  
            Appearance      =   0  'Flat 
            BackColor       =   &H00E8F4F8& 
            BeginProperty Font  
               Name            =   "宋体" 
               Size            =   10.5 
               Charset         =   134 
               Weight          =   400 
               Underline       =   0   'False 
               Italic          =   0   'False 
               Strikethrough   =   0   'False 
            EndProperty 
            Height          =   315 
            Left            =   630 
            MaxLength       =   10 
            TabIndex        =   6 
            Top             =   270 
            Width           =   1425 
         End 
         Begin VB.Label Label1  
            AutoSize        =   -1  'True 
            Caption         =   "密码" 
            Height          =   180 
            Index           =   1 
            Left            =   780 
            TabIndex        =   9 
            Top             =   750 
            Width           =   360 
         End 
         Begin VB.Label Label2  
            AutoSize        =   -1  'True 
            Caption         =   "姓名" 
            Height          =   180 
            Left            =   2310 
            TabIndex        =   7 
            Top             =   330 
            Width           =   360 
         End 
         Begin VB.Label Label1  
            AutoSize        =   -1  'True 
            Caption         =   "编号" 
            Height          =   180 
            Index           =   0 
            Left            =   240 
            TabIndex        =   5 
            Top             =   330 
            Width           =   360 
         End 
      End 
      Begin MSDataGridLib.DataGrid DGadmin  
         Height          =   3165 
         Left            =   60 
         TabIndex        =   3 
         Top             =   1380 
         Width           =   4485 
         _ExtentX        =   7911 
         _ExtentY        =   5583 
         _Version        =   393216 
         AllowUpdate     =   0   'False 
         BackColor       =   15267064 
         HeadLines       =   1 
         RowHeight       =   18 
         BeginProperty HeadFont {0BE35203-8F91-11CE-9DE3-00AA004BB851}  
            Name            =   "宋体" 
            Size            =   12 
            Charset         =   134 
            Weight          =   400 
            Underline       =   0   'False 
            Italic          =   0   'False 
            Strikethrough   =   0   'False 
         EndProperty 
         BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}  
            Name            =   "宋体" 
            Size            =   12 
            Charset         =   134 
            Weight          =   400 
            Underline       =   0   'False 
            Italic          =   0   'False 
            Strikethrough   =   0   'False 
         EndProperty 
         ColumnCount     =   2 
         BeginProperty Column00  
            DataField       =   "" 
            Caption         =   "" 
            BeginProperty DataFormat {6D835690-900B-11D0-9484-00A0C91110ED}  
               Type            =   0 
               Format          =   "" 
               HaveTrueFalseNull=   0 
               FirstDayOfWeek  =   0 
               FirstWeekOfYear =   0 
               LCID            =   2052 
               SubFormatType   =   0 
            EndProperty 
         EndProperty 
         BeginProperty Column01  
            DataField       =   "" 
            Caption         =   "" 
            BeginProperty DataFormat {6D835690-900B-11D0-9484-00A0C91110ED}  
               Type            =   0 
               Format          =   "" 
               HaveTrueFalseNull=   0 
               FirstDayOfWeek  =   0 
               FirstWeekOfYear =   0 
               LCID            =   2052 
               SubFormatType   =   0 
            EndProperty 
         EndProperty 
         SplitCount      =   1 
         BeginProperty Split0  
            MarqueeStyle    =   3 
            BeginProperty Column00  
            EndProperty 
            BeginProperty Column01  
            EndProperty 
         EndProperty 
      End 
      Begin VB.Frame Frame2  
         Caption         =   "菜单操作权限" 
         Enabled         =   0   'False 
         ForeColor       =   &H00FF0000& 
         Height          =   3195 
         Left            =   4590 
         TabIndex        =   1 
         Top             =   180 
         Width           =   2235 
         Begin VB.ListBox LstQX  
            Appearance      =   0  'Flat 
            BackColor       =   &H00E8F4F8& 
            BeginProperty Font  
               Name            =   "宋体" 
               Size            =   10.5 
               Charset         =   134 
               Weight          =   400 
               Underline       =   0   'False 
               Italic          =   0   'False 
               Strikethrough   =   0   'False 
            EndProperty 
            Height          =   2910 
            ItemData        =   "FrmAdmin.frx":0213 
            Left            =   120 
            List            =   "FrmAdmin.frx":024D 
            Style           =   1  'Checkbox 
            TabIndex        =   2 
            Top             =   210 
            Width           =   2025 
         End 
      End 
      Begin MSComctlLib.ImageList ImgLst  
         Left            =   0 
         Top             =   0 
         _ExtentX        =   1005 
         _ExtentY        =   1005 
         BackColor       =   -2147483643 
         ImageWidth      =   20 
         ImageHeight     =   20 
         MaskColor       =   12632256 
         _Version        =   393216 
         BeginProperty Images {2C247F25-8591-11D1-B16A-00C0F0283628}  
            NumListImages   =   7 
            BeginProperty ListImage1 {2C247F27-8591-11D1-B16A-00C0F0283628}  
               Picture         =   "FrmAdmin.frx":0350 
               Key             =   "save" 
            EndProperty 
            BeginProperty ListImage2 {2C247F27-8591-11D1-B16A-00C0F0283628}  
               Picture         =   "FrmAdmin.frx":03E4 
               Key             =   "undo" 
            EndProperty 
            BeginProperty ListImage3 {2C247F27-8591-11D1-B16A-00C0F0283628}  
               Picture         =   "FrmAdmin.frx":0454 
               Key             =   "new" 
            EndProperty 
            BeginProperty ListImage4 {2C247F27-8591-11D1-B16A-00C0F0283628}  
               Picture         =   "FrmAdmin.frx":04D4 
               Key             =   "edit" 
            EndProperty 
            BeginProperty ListImage5 {2C247F27-8591-11D1-B16A-00C0F0283628}  
               Picture         =   "FrmAdmin.frx":0570 
               Key             =   "student" 
            EndProperty 
            BeginProperty ListImage6 {2C247F27-8591-11D1-B16A-00C0F0283628}  
               Picture         =   "FrmAdmin.frx":09C4 
               Key             =   "grade" 
            EndProperty 
            BeginProperty ListImage7 {2C247F27-8591-11D1-B16A-00C0F0283628}  
               Picture         =   "FrmAdmin.frx":0E18 
               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           =   2175 
      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 + "'" 
    DB.Execute sql 
    '更新 
    Dim adoRs As Recordset 
    Set adoRs = New Recordset 
    adoRs.Open "select code as 编号,name as 姓名 from admin", DB, 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 + "'", DB, 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 + "')" 
    DB.Execute sql 
    adoRs.Open "select code as 编号,name as 姓名 from admin", DB, 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 + "'" 
    DB.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 + "'", DB, 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, DB, adOpenStatic, adLockOptimistic 
 Set DGadmin.DataSource = adoRs 
 'adoRS.Close 
 ViewQX DGadmin.Columns(0).Text 
  
 Dim kemuRs As Recordset 
 Set kemuRs = New Recordset 
 kemuRs.Open "kemu", DB, 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(kemuRs.AbsolutePosition - 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