frmsystemadm.frm

采用面向负荷控制技术

         End
         Begin VB.Label Label9 
            AutoSize        =   -1  'True
            Caption         =   "部   门"
            BeginProperty Font 
               Name            =   "宋体"
               Size            =   10.5
               Charset         =   134
               Weight          =   400
               Underline       =   0   'False
               Italic          =   0   'False
               Strikethrough   =   0   'False
            EndProperty
            Height          =   210
            Left            =   240
            TabIndex        =   11
            Top             =   3480
            Width           =   735
         End
         Begin VB.Label Label10 
            AutoSize        =   -1  'True
            Caption         =   "权   限"
            BeginProperty Font 
               Name            =   "宋体"
               Size            =   10.5
               Charset         =   134
               Weight          =   400
               Underline       =   0   'False
               Italic          =   0   'False
               Strikethrough   =   0   'False
            EndProperty
            Height          =   210
            Left            =   3360
            TabIndex        =   10
            Top             =   720
            Width           =   735
         End
      End
      Begin MSDataGridLib.DataGrid dgd_opr 
         Height          =   4335
         Left            =   6960
         TabIndex        =   15
         Top             =   840
         Width           =   5895
         _ExtentX        =   10398
         _ExtentY        =   7646
         _Version        =   393216
         HeadLines       =   1
         RowHeight       =   15
         BeginProperty HeadFont {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
            Name            =   "宋体"
            Size            =   9
            Charset         =   134
            Weight          =   400
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
            Name            =   "宋体"
            Size            =   9
            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 
            BeginProperty Column00 
            EndProperty
            BeginProperty Column01 
            EndProperty
         EndProperty
      End
   End
End
Attribute VB_Name = "frmSystemAdm"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim mconn As New ADODB.Connection
Dim mrs_opr As New ADODB.Recordset
'

Private Sub dgd_opr_Click()
txt_code.Text = mrs_opr("opnumber")
txt_name.Text = mrs_opr("username")
cmb_group.Text = mrs_opr("groupname")
Select Case mrs_opr("power")
    Case "0"
    optSys.Value = True
    Case "1"
    optTra.Value = True
    Case "2"
    optOpr.Value = True
End Select
End Sub


Private Sub Form_Load()
mconn.Open gConnstr, "sa"
SSTab1.Tab = 0
Me.WindowState = 2
End Sub

Private Sub cmd_cancel_Click()
  cmd_add.Enabled = True
  cmd_del.Enabled = True
  cmd_ok.Enabled = False
  cmd_cancel.Enabled = False
  If SSTab1.Tab = 0 Then
    dgd_opr.Enabled = True
  ElseIf SSTab1.Tab = 1 Then
    
  End If
End Sub
Private Sub cmd_exit_Click()
    'On Error Resume Next
    Set mrs_opr = Nothing
    Set mconn = Nothing
    Unload Me
    fMainForm.mnuSystemAdm.Enabled = True
End Sub
Private Sub cmd_add_Click()
Dim i As Integer
    cmd_add.Enabled = False
    cmd_del.Enabled = False
    cmd_ok.Enabled = True
    cmd_cancel.Enabled = True
  If SSTab1.Tab = 0 Then
        dgd_opr.Enabled = False
        For i = 0 To mrs_opr.Fields.Count - 2
         'if i<>2 then
         '  pro_txt(i)=""
         'endif
         '
        Next
        txt_code.Text = ""
        txt_name.Text = ""
        cmb_group.Text = ""
        Call setopr_additem
    txt_name.SetFocus
  ElseIf SSTab1.Tab = 1 Then

  ElseIf SSTab1.Tab = 2 Then
   
  End If
End Sub
Private Sub cmd_Del_Click()
'On Error GoTo ErrMsg
Dim yn As Integer
   If SSTab1.Tab = 0 Then
    yn = MsgBox("", vbYesNo)
    If yn = vbNo Then
        Exit Sub
    End If
    mrs_opr.Delete
    If mrs_opr.EOF Then
        mrs_opr.MoveLast
    Else
        mrs_opr.MoveNext
    End If
    Call openopr
   End If
   If SSTab1.Tab = 1 Then
     
   End If
   
End Sub
Private Sub cmd_ok_Click()
Dim i As Integer
'On Error GoTo ErrMsg
  If SSTab1.Tab = 0 Then
    If txt_pass.Text <> txt_pass2.Text Then
        MsgBox "两次口令输入不一致", vbOKOnly
        Exit Sub
    End If
    mrs_opr.AddNew
    mrs_opr("opnumber") = Trim(txt_code.Text)
    mrs_opr("username") = Trim(txt_name.Text)
    mrs_opr("groupname") = Trim(cmb_group.Text)
    mrs_opr("pass") = Trim(txt_pass.Text)
    If optSys.Value = True Then
        mrs_opr("power") = 0
    ElseIf optTra.Value = True Then
        mrs_opr("power") = 1
    ElseIf optOpr.Value = True Then
        mrs_opr("power") = 2
    End If
    mrs_opr.Update
  ElseIf SSTab1.Tab = 1 Then


  End If

  cmd_add.Enabled = True
  cmd_del.Enabled = True
  cmd_ok.Enabled = False
  cmd_cancel.Enabled = False
  Exit Sub
ErrMsg:
    MsgBox err.Description, vbExclamation, " - Update"
End Sub


Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
Call cmd_exit_Click
End Sub

Private Sub SSTab1_Click(Index As Integer)
    ' On Error Resume Next
    cmd_add.Enabled = True
    cmd_del.Enabled = True
    cmd_ok.Enabled = False
    cmd_cancel.Enabled = False
     Select Case SSTab1.Tab
     Case 0
         openopr
         
     Case 1
         'Call opendevice
         
     Case 2
         Call cmd_exit_Click
    
     End Select
End Sub

Sub openopr()
Dim sql As String, i As Integer
Set mrs_opr = Nothing
sql = "select opnumber, username,groupname,power ,pass from passwd "
mrs_opr.CursorLocation = adUseClient
mrs_opr.Open sql, mconn, adOpenKeyset, adLockPessimistic
If mrs_opr.RecordCount = 0 Then
    Set dgd_opr.DataSource = Nothing
    dgd_opr.Refresh
Else
    mrs_opr.MoveFirst
    Set dgd_opr.DataSource = mrs_opr
    dgd_opr.Refresh
    dgd_opr.Columns.Item(1).Caption = " 代  码 "
    dgd_opr.Columns(1).Width = 0.7 * (dgd_opr.Width + 600) / 3
    dgd_opr.Columns.Item(1).Caption = " 姓  名 "
    dgd_opr.Columns(1).Width = 0.7 * (dgd_opr.Width + 600) / 3
    dgd_opr.Columns.Item(2).Caption = "  部 门 "
    dgd_opr.Columns(2).Width = 0.7 * (dgd_opr.Width + 600) / 3
    dgd_opr.Columns.Item(3).Caption = "权限"
    dgd_opr.Columns(3).Width = 0.7 * (dgd_opr.Width + 600) / 6
    dgd_opr.Columns(4).Visible = False
    txt_code.Text = mrs_opr("opnumber")
    txt_name.Text = mrs_opr("username")
    Select Case mrs_opr("power")
        Case "0"
        optSys.Value = True
        Case "1"
        optTra.Value = True
        Case "2"
        optOpr.Value = True
    End Select
    cmb_group.Text = mrs_opr("groupname")
End If

End Sub

Sub setopr_additem()
Dim ors As New ADODB.Recordset, sql As String
cmb_group.Clear
sql = "select distinct location from device "
ors.Open sql, mconn, adOpenKeyset, adLockPessimistic
ors.MoveFirst
While Not ors.EOF
    cmb_group.AddItem ors(0)
    ors.MoveNext
Wend
ors.Close

End Sub