企业管理

开发平台：
Visual Basic

frmOperMan.frm：源码内容
							VERSION 5.00
Object = "{5E9E78A0-531B-11CF-91F6-C2863C385E30}#1.0#0"; "MSFLXGRD.OCX"
Object = "{0BA686C6-F7D3-101A-993E-0000C0EF6F5E}#1.0#0"; "THREED32.OCX"
Begin VB.Form frmOperMan 
   BackColor       =   &H8000000A&
   BorderStyle     =   3  'Fixed Dialog
   Caption         =   "操作员管理"
   ClientHeight    =   5985
   ClientLeft      =   2700
   ClientTop       =   2070
   ClientWidth     =   7965
   Icon            =   "frmOperMan.frx":0000
   KeyPreview      =   -1  'True
   LinkTopic       =   "Form1"
   LockControls    =   -1  'True
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   5985
   ScaleWidth      =   7965
   ShowInTaskbar   =   0   'False
   StartUpPosition =   1  '所有者中心
   Begin VB.Frame Frame1 
      Height          =   1335
      Left            =   120
      TabIndex        =   9
      Top             =   120
      Width           =   7695
      Begin VB.TextBox Text1 
         Appearance      =   0  'Flat
         Enabled         =   0   'False
         BeginProperty Font 
            Name            =   "宋体"
            Size            =   10.5
            Charset         =   134
            Weight          =   400
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         Height          =   315
         IMEMode         =   3  'DISABLE
         Index           =   0
         Left            =   960
         Locked          =   -1  'True
         MaxLength       =   20
         TabIndex        =   0
         Top             =   360
         Width           =   1515
      End
      Begin VB.OptionButton Option1 
         BackColor       =   &H8000000A&
         Caption         =   "普通用户"
         Enabled         =   0   'False
         BeginProperty Font 
            Name            =   "宋体"
            Size            =   10.5
            Charset         =   134
            Weight          =   400
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         ForeColor       =   &H80000007&
         Height          =   285
         Index           =   1
         Left            =   1770
         TabIndex        =   5
         Top             =   855
         Width           =   1410
      End
      Begin VB.OptionButton Option1 
         BackColor       =   &H8000000A&
         Caption         =   "超级用户"
         Enabled         =   0   'False
         BeginProperty Font 
            Name            =   "宋体"
            Size            =   10.5
            Charset         =   134
            Weight          =   400
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         ForeColor       =   &H80000007&
         Height          =   285
         Index           =   0
         Left            =   120
         TabIndex        =   4
         Top             =   855
         Value           =   -1  'True
         Width           =   1275
      End
      Begin VB.TextBox Text1 
         Appearance      =   0  'Flat
         Enabled         =   0   'False
         BeginProperty Font 
            Name            =   "宋体"
            Size            =   10.5
            Charset         =   134
            Weight          =   400
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         Height          =   315
         Index           =   3
         Left            =   4320
         Locked          =   -1  'True
         MaxLength       =   20
         TabIndex        =   3
         Top             =   840
         Width           =   3030
      End
      Begin VB.TextBox Text1 
         Appearance      =   0  'Flat
         Enabled         =   0   'False
         BeginProperty Font 
            Name            =   "宋体"
            Size            =   10.5
            Charset         =   134
            Weight          =   400
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         Height          =   315
         IMEMode         =   3  'DISABLE
         Index           =   2
         Left            =   5880
         Locked          =   -1  'True
         MaxLength       =   20
         PasswordChar    =   "*"
         TabIndex        =   2
         Top             =   360
         Width           =   1515
      End
      Begin VB.TextBox Text1 
         Appearance      =   0  'Flat
         Enabled         =   0   'False
         BeginProperty Font 
            Name            =   "宋体"
            Size            =   10.5
            Charset         =   134
            Weight          =   400
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         Height          =   315
         Index           =   1
         Left            =   3360
         Locked          =   -1  'True
         MaxLength       =   20
         TabIndex        =   1
         Top             =   360
         Width           =   1515
      End
      Begin VB.Label Label1 
         AutoSize        =   -1  'True
         BackStyle       =   0  'Transparent
         Caption         =   "备    注"
         BeginProperty Font 
            Name            =   "宋体"
            Size            =   10.5
            Charset         =   134
            Weight          =   400
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         ForeColor       =   &H80000007&
         Height          =   210
         Index           =   9
         Left            =   3240
         TabIndex        =   13
         Top             =   885
         Width           =   840
      End
      Begin VB.Label Label1 
         AutoSize        =   -1  'True
         BackStyle       =   0  'Transparent
         Caption         =   "代  码"
         BeginProperty Font 
            Name            =   "宋体"
            Size            =   10.5
            Charset         =   134
            Weight          =   400
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         ForeColor       =   &H80000007&
         Height          =   210
         Index           =   0
         Left            =   120
         TabIndex        =   12
         Top             =   412
         Width           =   630
      End
      Begin VB.Label Label1 
         AutoSize        =   -1  'True
         BackStyle       =   0  'Transparent
         Caption         =   "口  令"
         BeginProperty Font 
            Name            =   "宋体"
            Size            =   10.5
            Charset         =   134
            Weight          =   400
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         ForeColor       =   &H80000007&
         Height          =   210
         Index           =   8
         Left            =   5040
         TabIndex        =   11
         Top             =   412
         Width           =   630
      End
      Begin VB.Label Label1 
         AutoSize        =   -1  'True
         BackStyle       =   0  'Transparent
         Caption         =   "姓  名"
         BeginProperty Font 
            Name            =   "宋体"
            Size            =   10.5
            Charset         =   134
            Weight          =   400
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         ForeColor       =   &H80000007&
         Height          =   210
         Index           =   1
         Left            =   2640
         TabIndex        =   10
         Top             =   412
         Width           =   630
      End
   End
   Begin VB.Frame Frmbutton 
      BackColor       =   &H8000000A&
      Height          =   1155
      Left            =   120
      TabIndex        =   8
      Top             =   4680
      Width           =   7695
      Begin Threed.SSCommand cmdAdd 
         Height          =   495
         Left            =   480
         TabIndex        =   14
         Top             =   360
         Width           =   1095
         _Version        =   65536
         _ExtentX        =   1931
         _ExtentY        =   873
         _StockProps     =   78
         Caption         =   "&A.添 加"
         Picture         =   "frmOperMan.frx":0442
      End
      Begin Threed.SSCommand cmdEdit 
         Height          =   495
         Left            =   1920
         TabIndex        =   15
         Top             =   360
         Width           =   1095
         _Version        =   65536
         _ExtentX        =   1931
         _ExtentY        =   873
         _StockProps     =   78
         Caption         =   "&M 修 改"
         Picture         =   "frmOperMan.frx":045E
      End
      Begin Threed.SSCommand cmdDelete 
         Height          =   495
         Left            =   3240
         TabIndex        =   16
         Top             =   360
         Width           =   1095
         _Version        =   65536
         _ExtentX        =   1931
         _ExtentY        =   873
         _StockProps     =   78
         Caption         =   "&D 删 除"
         Picture         =   "frmOperMan.frx":047A
      End
      Begin Threed.SSCommand cmdclear 
         Height          =   495
         Left            =   4560
         TabIndex        =   17
         Top             =   360
         Width           =   1095
         _Version        =   65536
         _ExtentX        =   1931
         _ExtentY        =   873
         _StockProps     =   78
         Caption         =   "&C 清 空"
         Picture         =   "frmOperMan.frx":0496
      End
      Begin Threed.SSCommand cmdClose 
         Height          =   495
         Left            =   6000
         TabIndex        =   18
         Top             =   360
         Width           =   1095
         _Version        =   65536
         _ExtentX        =   1931
         _ExtentY        =   873
         _StockProps     =   78
         Caption         =   "&Q 退 出"
         Picture         =   "frmOperMan.frx":04B2
      End
   End
   Begin VB.Frame FrmOperInfo 
      BackColor       =   &H8000000A&
      Caption         =   "已有操作员列表"
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   10.5
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H8000000D&
      Height          =   3135
      Left            =   120
      TabIndex        =   7
      Top             =   1560
      Width           =   7695
      Begin MSFlexGridLib.MSFlexGrid MSFGOperator 
         Height          =   2595
         Left            =   240
         TabIndex        =   6
         Top             =   330
         Width           =   7215
         _ExtentX        =   12726
         _ExtentY        =   4577
         _Version        =   393216
         Rows            =   20
         Cols            =   3
         FixedCols       =   0
         GridColor       =   -2147483637
         AllowBigSelection=   0   'False
         ScrollTrack     =   -1  'True
         TextStyleFixed  =   1
         FocusRect       =   0
         GridLinesFixed  =   1
         ScrollBars      =   2
         SelectionMode   =   1
         FormatString    =   "^   操作员名  |^  权  限  |^          备           注               "
         BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
            Name            =   "宋体"
            Size            =   10.5
            Charset         =   134
            Weight          =   400
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
      End
   End
End
Attribute VB_Name = "frmOperMan"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim AddFlag As Boolean
'包含下一个变量的代码，是为输入法添加的
Dim lfrmIme As Long
Dim QX As String
Dim tUserInfo As t_User
Dim WithEvents RS As Recordset
Attribute RS.VB_VarHelpID = -1
Dim sSQL As String
Dim i As Long
Private Sub cmdadd_Click()
    If UserInfo.QX = 1 Then
        MsgBox "对不起，普通用户无权操作！", 48, "系统提示"
        Exit Sub
    End If
    If Trim(Me.cmdAdd.Caption) = "&A.添 加" Then
        Call HideButtons
        Text1(1).Text = ""
        Text1(2).Text = ""
        Text1(3).Text = ""
        Text1(0).SetFocus
    Else
        With tUserInfo
            .UserCode = Trim(Me.Text1(0))
            .UserName = Trim(Me.Text1(1))
            .Pwd = Trim(Me.Text1(2))
            If Me.Option1(0).Value = True Then
                .QX = 0
            ElseIf Me.Option1(1).Value = True Then
                .QX = 1
            End If
            .BeiZhu = Trim(Me.Text1(3))
        End With
        If AddOperData Then
            Me.cmdAdd.Caption = "&A.添 加"
            Me.cmdDelete.Enabled = True
            Me.cmdEdit.Enabled = True
            For i = 0 To 3
                Me.Text1(i).Enabled = False
            Next i
            Me.Option1(0).Enabled = False
            Me.Option1(1).Enabled = False
            Me.Text1(2) = "**********"
        End If
    End If
End Sub
Private Function AddOperData() As Boolean
    Dim re As String
    AddOperData = True
    re = MsgBox("确认添加新的操作员吗？", vbYesNo + vbQuestion, "系统提示")
    If re = vbNo Then
        AddOperData = False
    End If
    If Not Validate_Data Then
        AddOperData = False
        Exit Function
    End If
    Me.MousePointer = 11
    On Error GoTo ErrorHander
    sSQL = "select * from t_user where usercode='" & Trim(tUserInfo.UserCode) & "'"
        Set RS = ConnWZ.Execute(sSQL)
    If RS.EOF Then
        With tUserInfo
            sSQL = "insert t_user(usercode,username,password,qx,beizhu) values('" & .UserCode & "','" & .UserName & "','" & .Pwd & "'," & .QX & ",'" & .BeiZhu & "')"
                Set RS = ConnWZ.Execute(sSQL)
            
                Call ShowOperator
            
        End With
    Else
       MsgBox "代码为" & Trim(Me.Text1(0)) & "的操作员信息已存在，无法添加！", 48, "系统提示"
       RS.Close
       AddOperData = False
       Me.MousePointer = 0
       Exit Function
    End If
    RS.Close
    Me.MousePointer = 0
    On Error GoTo 0
    Exit Function
ErrorHander:
        MsgBox "添加操作员失败，请重试！", 48, "系统提示"
        AddOperData = False
        Me.MousePointer = 0
End Function
Private Sub cmdclear_Click()
    For i = 0 To 3
         Me.Text1(i).Text = ""
         Me.Text1(i).Enabled = True
    Next i
    Me.Text1(0).SetFocus
    Me.cmdAdd.Enabled = True
    Me.cmdDelete.Enabled = True
    Me.cmdEdit.Enabled = True
    Me.cmdAdd.Caption = "&A.添 加"
    Me.cmdEdit.Caption = "&M 修 改"
End Sub
Private Sub cmdClose_Click()
    Unload Me
End Sub
Private Sub cmddelete_Click()
    Dim re As String
    If UserInfo.QX = 1 Then
        MsgBox "对不起，普通用户无权操作！", 48, "系统提示"
        
        Exit Sub
    End If
    re = MsgBox("确认删除" & Trim(Me.Text1(0)) & "用户吗？", vbYesNo + vbQuestion, "系统提示")
    If re = vbNo Then Exit Sub
    Me.MousePointer = 11
    If Len(Me.Text1(0)) = 0 Then
        MsgBox "请选择操作员后再删除！", 48, "系统提示"
        
        Me.MousePointer = 0
        Exit Sub
    End If
    If Trim(UserInfo.UserCode) = Trim(Me.Text1(0)) Then
        MsgBox "此为当前操作员，无法删除！", 48, "系统提示"
        
        Me.MousePointer = 0
        Exit Sub
    End If
    sSQL = "select * from t_user where usercode='" & Trim(Me.Text1(0)) & "'"
        Set RS = ConnWZ.Execute(sSQL)
    If RS.EOF Then
        RS.Close
        MsgBox "找不到代码为" & Trim(Me.Text1(0)) & "的操作员信息，删除失败！", 48, "系统提示"
        
        Me.MousePointer = 0
        Exit Sub
    End If
    RS.Close
    sSQL = "delete t_user where usercode='" & Trim(Me.Text1(0)) & "'"
        ConnWZ.Execute (sSQL)
    
        Call ShowOperator
    
    Me.MousePointer = 0
End Sub
Private Sub cmdedit_Click()
If UserInfo.QX = 1 Then
    MsgBox "对不起，普通用户无权操作！", 48, "系统提示"
    
    Exit Sub
End If
If Len(Me.Text1(0)) = 0 Then
    MsgBox "请选择操作员信息后再操作！", 48, "系统提示"
    
    Exit Sub
End If
Me.Text1(0).Enabled = False
Me.Text1(2).Enabled = False
Me.Option1(0).Enabled = True
Me.Option1(1).Enabled = True
If Me.cmdEdit.Caption = "&M 修 改" Then
    For i = 0 To 3
        Me.Text1(i).Enabled = True
        Me.Text1(i).Locked = False
    Next i
    Me.cmdEdit.Caption = "&M 确 定"
    Me.Text1(0).Enabled = False
    Me.Text1(2).Enabled = False
    Me.cmdAdd.Enabled = False
    Me.cmdDelete.Enabled = False
    With Me.Text1(1)
        .SelStart = 0
        .SelLength = Len(.Text)
        .SetFocus
    End With
Else
    With tUserInfo
        .UserCode = Trim(Me.Text1(0))
        .UserName = Trim(Me.Text1(1))
        .BeiZhu = Trim(Me.Text1(3))
        If Me.Option1(0).Value = True Then
            .QX = 0
        ElseIf Me.Option1(1).Value = True Then
            .QX = 1
        End If
    End With
    
    If ModiOperData Then
        Me.cmdEdit.Caption = "&M 修 改"
        For i = 0 To 3
            Me.Text1(i).Enabled = False
        Next i
        Me.Option1(0).Enabled = False
        Me.Option1(1).Enabled = False
        Me.cmdAdd.Enabled = True
        Me.cmdDelete.Enabled = True
    End If
End If
End Sub
Private Function ModiOperData() As Boolean
    Dim re As String
    ModiOperData = True
    re = MsgBox("确认要修改代码为" & Trim(Me.Text1(0)) & "的操作员信息吗？", vbYesNo + vbQuestion, "系统提示")
    If re = vbNo Then
        ModiOperData = False
        Exit Function
    End If
    If Not Validate_Data Then
        ModiOperData = False
        Exit Function
    End If
    Me.MousePointer = 11
    sSQL = "select * from t_user where usercode='" & Trim(tUserInfo.UserCode) & "' "
        Set RS = ConnWZ.Execute(sSQL)
    If RS.EOF Then
        MsgBox "找不到代码为" & Trim(tUserInfo.UserCode) & "的操作员信息！", 48, "系统提示"
        
        ModiOperData = False
        RS.Close
        Me.MousePointer = 0
        Exit Function
    Else
        With tUserInfo
            sSQL = "update t_user set username='" & Trim(.UserName) & "',beizhu='" & .BeiZhu & "',qx=" & .QX & " where usercode='" & Trim(.UserCode) & "'"
               ConnWZ.Execute (sSQL)
            MsgBox "修改记录成功，信息已入库！", 64, "系统提示"
            Call ShowOperator
        End With
    End If
    RS.Close
    Me.MousePointer = 0
End Function
Private Sub Form_Activate()
    Call ShowOperator
    AddFlag = False
End Sub
Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
    If KeyCode = vbKeyEscape Then
        Unload Me
    End If
    
End Sub
Private Sub MSFGOperator_Click()
With Me.MSFGOperator
    Me.Text1(0) = Trim(.TextMatrix(.RowSel, 0))
    Me.Text1(1) = Trim(.TextMatrix(.RowSel, 1))
    Me.Text1(3) = Trim(.TextMatrix(.RowSel, 3))
    Me.Text1(2) = "**********"
    If Trim(.TextMatrix(.RowSel, 2)) = "超级用户" Then
        Me.Option1(0).Value = True
    ElseIf Trim(.TextMatrix(.RowSel, 2)) = "普通用户" Then
        Me.Option1(1).Value = True
    End If
End With
Me.cmdDelete.Enabled = True
Me.cmdEdit.Enabled = True
Me.cmdAdd.Caption = " 添 加(&A)"
End Sub
Private Sub MSFGOperator_KeyDown(KeyCode As Integer, Shift As Integer)
    If KeyCode = vbKeyReturn Then cmdAdd.SetFocus
End Sub
Private Sub Option1_Click(Index As Integer)
    QX = Index
End Sub
Private Sub Option1_KeyDown(Index As Integer, KeyCode As Integer, Shift As Integer)
    If KeyCode = vbKeyReturn Then SendKeys "{TAB}"
End Sub
Private Sub Text1_GotFocus(Index As Integer)
    Text1(Index).SelStart = 0
    Text1(Index).SelLength = Len(Text1(Index).Text)
End Sub
Private Sub Text1_KeyPress(Index As Integer, KeyAscii As Integer)
    If KeyAscii = vbKeyReturn Then SendKeys "{TAB}"
End Sub
Private Sub HideButtons()
    Text1(0).Locked = False
    Text1(1).Locked = False
    Text1(2).Locked = False
    Text1(3).Locked = False
    Text1(0).Enabled = True
    Text1(1).Enabled = True
    Text1(2).Enabled = True
    Text1(3).Enabled = True
    Option1(0).Enabled = True
    Option1(1).Enabled = True
    cmdAdd.Caption = " 确 定(&A)"
    cmdEdit.Enabled = False
    cmdDelete.Enabled = False
End Sub
Private Sub ShowButtons()
    Text1(1).Locked = True
    Text1(2).Locked = True
    Text1(3).Locked = True
    Text1(1).Enabled = False
    Text1(2).Enabled = False
    Text1(3).Enabled = False
    Option1(0).Enabled = False
    Option1(1).Enabled = False
    cmdAdd.Visible = True
    cmdEdit.Visible = True
    cmdDelete.Visible = True
    cmdClose.Visible = True
    cmdAdd.Enabled = True
    cmdEdit.Enabled = True
    cmdDelete.Enabled = True
    cmdClose.Enabled = True
End Sub
Private Sub ShowOperator()
    
    sSQL = "select * from t_user order by usercode"
        Set RS = ConnWZ.Execute(sSQL)
    If Not RS.EOF Then
        RS.MoveLast
        RS.MoveFirst
         With MSFGOperator
            .Clear
            .Rows = RS.RecordCount + 1
            .Cols = 4
            .FormatString = "^  操作员代码  |^  操作员名  |^  操作权限  |^         备 注          "
         End With
        For i = 0 To RS.RecordCount - 1
            With Me.MSFGOperator
                .TextMatrix(i + 1, 0) = Trim(RS!UserCode)
                .TextMatrix(i + 1, 1) = Trim(RS!UserName & "")
                If RS!QX = 0 Then
                    .TextMatrix(i + 1, 2) = "超级用户"
                ElseIf RS!QX = 1 Then
                    .TextMatrix(i + 1, 2) = "普通用户"
                End If
                .TextMatrix(i + 1, 3) = Trim(RS!BeiZhu & "")
            End With
            RS.MoveNext
        Next i
    Else
        With MSFGOperator
            .Clear
            .Rows = 2
            .Cols = 4
            .FormatString = "^  操作员代码  |^  操作员名  |^  操作权限  |^         备 注          "
         End With
    End If
End Sub
Private Function Validate_Data() As Boolean
Validate_Data = True
If LenB(StrConv(Trim$(Me.Text1(0)), vbFromUnicode)) > 10 Or Len(Me.Text1(0)) = 0 Then
    MsgBox "代码信息录入非法！", 48, "系统提示"
    
    With Me.Text1(0)
        .SelStart = 0
        .SelLength = Len(.Text)
    End With
    Validate_Data = False
    Exit Function
End If
If LenB(StrConv(Trim$(Me.Text1(1)), vbFromUnicode)) > 20 Or Len(Me.Text1(1)) = 0 Then
    MsgBox "姓名信息录入非法！", 48, "系统提示"
    
    With Me.Text1(1)
        .SelStart = 0
        .SelLength = Len(.Text)
        .SetFocus
    End With
    Validate_Data = False
    Exit Function
End If
If LenB(StrConv(Trim$(Me.Text1(2)), vbFromUnicode)) > 20 Or Len(Me.Text1(2)) = 0 Then
    MsgBox "口令信息录入非法！", 48, "系统提示"
    
    With Me.Text1(2)
        .SelStart = 0
        .SelLength = Len(.Text)
        .SetFocus
    End With
    Validate_Data = False
    Exit Function
End If
If LenB(StrConv(Trim$(Me.Text1(3)), vbFromUnicode)) > 50 Then
    MsgBox "备注信息录入非法！", 48, "系统提示"
    
    With Me.Text1(3)
        .SelStart = 0
        .SelLength = Len(.Text)
        .SetFocus
    End With
    Validate_Data = False
    Exit Function
End If
End Function

						