frmyhmm.frm

来自「企业工资管理系统的具体实现」· FRM 代码 · 共 290 行

VERSION 5.00
Begin VB.Form frmyhsz 
   Caption         =   "用户设置"
   ClientHeight    =   5685
   ClientLeft      =   3165
   ClientTop       =   1545
   ClientWidth     =   5235
   Icon            =   "frmyhmm.frx":0000
   LinkTopic       =   "Form1"
   ScaleHeight     =   5685
   ScaleWidth      =   5235
   Begin VB.CommandButton Command5 
      Caption         =   "关  闭"
      Height          =   375
      Left            =   3825
      TabIndex        =   15
      Top             =   5220
      Width           =   1260
   End
   Begin VB.Frame Frame2 
      Caption         =   "修改用户密码"
      Height          =   2250
      Left            =   30
      TabIndex        =   1
      Top             =   2895
      Width           =   5145
      Begin VB.CommandButton Command4 
         Caption         =   "取  消"
         Enabled         =   0   'False
         Height          =   360
         Left            =   3795
         TabIndex        =   11
         Top             =   1455
         Width           =   1260
      End
      Begin VB.CommandButton Command3 
         Caption         =   "密码更改"
         Enabled         =   0   'False
         Height          =   360
         Left            =   3795
         TabIndex        =   10
         Top             =   1005
         Width           =   1260
      End
      Begin VB.TextBox Text4 
         Height          =   375
         IMEMode         =   3  'DISABLE
         Left            =   1635
         PasswordChar    =   "*"
         TabIndex        =   9
         Top             =   1815
         Width           =   1815
      End
      Begin VB.TextBox Text3 
         Height          =   375
         IMEMode         =   3  'DISABLE
         Left            =   1635
         PasswordChar    =   "*"
         TabIndex        =   7
         Top             =   1410
         Width           =   1815
      End
      Begin VB.TextBox Text2 
         Height          =   375
         IMEMode         =   3  'DISABLE
         Left            =   1635
         PasswordChar    =   "*"
         TabIndex        =   5
         Top             =   1005
         Width           =   1815
      End
      Begin VB.Label Label5 
         Caption         =   "为了便于软件系统的安全，每个用户都可以进行密码修改。利用以下按钮即可。"
         Height          =   510
         Left            =   1125
         TabIndex        =   14
         Top             =   240
         Width           =   3795
      End
      Begin VB.Image Image2 
         Height          =   765
         Left            =   150
         Picture         =   "frmyhmm.frx":030A
         Stretch         =   -1  'True
         Top             =   210
         Width           =   765
      End
      Begin VB.Label Label3 
         AutoSize        =   -1  'True
         Caption         =   "确认新密码："
         Height          =   180
         Left            =   180
         TabIndex        =   8
         Top             =   1950
         Width           =   1080
      End
      Begin VB.Label Label2 
         AutoSize        =   -1  'True
         Caption         =   "新密码："
         Height          =   180
         Left            =   180
         TabIndex        =   6
         Top             =   1530
         Width           =   720
      End
      Begin VB.Label Label1 
         AutoSize        =   -1  'True
         Caption         =   "旧密码："
         Height          =   180
         Left            =   180
         TabIndex        =   4
         Top             =   1080
         Width           =   720
      End
   End
   Begin VB.Frame Frame1 
      Caption         =   "创建和删除用户"
      Height          =   2775
      Left            =   0
      TabIndex        =   0
      Top             =   75
      Width           =   5190
      Begin VB.ListBox List1 
         Height          =   1680
         Left            =   135
         TabIndex        =   12
         Top             =   1050
         Width           =   3360
      End
      Begin VB.CommandButton Command2 
         Caption         =   "删除"
         Enabled         =   0   'False
         Height          =   360
         Left            =   3810
         TabIndex        =   3
         Top             =   1485
         Width           =   1275
      End
      Begin VB.CommandButton Command1 
         Caption         =   "新用户"
         Height          =   360
         Left            =   3810
         TabIndex        =   2
         Top             =   1050
         Width           =   1275
      End
      Begin VB.Label Label4 
         Caption         =   "以下列出所有建立的用户，每个用户都有自己的用户名和密码。"
         Height          =   525
         Left            =   1125
         TabIndex        =   13
         Top             =   240
         Width           =   3855
      End
      Begin VB.Image Image1 
         Height          =   765
         Left            =   150
         Picture         =   "frmyhmm.frx":1B64
         Stretch         =   -1  'True
         Top             =   225
         Width           =   780
      End
   End
End
Attribute VB_Name = "frmyhsz"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Sub Command1_Click()
frmyhcj.Show 1
End Sub

Private Sub Command2_Click()
Dim cnn As New ADODB.Connection
If MsgBox("该操作将删除此用户，还要继续吗？", vbInformation + vbYesNo, "提示") = vbNo Then
    Exit Sub
End If
With cnn
    .Open constr
    .Execute "delete * from mmb where yhm='" & Trim(List1.List(List1.ListIndex)) & "'"
    .Close
End With
Set cnn = Nothing
List1.RemoveItem (List1.ListIndex)
Command2.Enabled = False
Command3.Enabled = False
Command4.Enabled = False
Frame2.Caption = "修改用户密码"
End Sub

Private Sub Command3_Click()
Call cmmodify
End Sub

Private Sub Command4_Click()
Text2.Text = ""
Text3.Text = ""
Text4.Text = ""
Text2.SetFocus
End Sub

Private Sub Command5_Click()
Unload Me
End Sub

Private Sub Form_Load()
Dim cnn As New ADODB.Recordset
With cnn
    .ActiveConnection = constr
    .CursorLocation = adUseClient
    .CursorType = adOpenDynamic
    .LockType = adLockBatchOptimistic
    .Open "select * from mmb order by yhm asc"
    If Not (.EOF And .BOF) Then .MoveFirst
    Do While Not .EOF
        List1.AddItem .Fields("yhm").Value
        .MoveNext
    Loop
    .Close
End With
Set cnn = Nothing
End Sub

Private Sub List1_Click()
Frame2.Caption = List1.List(List1.ListIndex) & "用户更改密码"
Command2.Enabled = True
Command3.Enabled = True
Command4.Enabled = True
End Sub
Sub cmmodify()
Dim cnn As New ADODB.Recordset
With cnn
    .ActiveConnection = constr
    .CursorLocation = adUseClient
    .CursorType = adOpenDynamic
    .LockType = adLockPessimistic
    
        .Open "select * from mmb where yhm='" & Trim(List1.List(List1.ListIndex)) & "'"
'    Else
'        .Open "select * from mmb where yhmm=null"
'    End If
'    .Open "select * from mmb where yhm='" & Trim(List1.List(List1.ListIndex)) & "'"
    If Not (.EOF And .BOF) Then
        If Text2.Text <> "" Then
            If IsNull(.Fields("yhmm").Value) Or .Fields("yhmm").Value <> Trim(Text2.Text) Then
                MsgBox "旧密码不对！", vbCritical, "密码设置"
                Text2.Text = ""
                Text2.SetFocus
                Exit Sub
            End If
        Else
            If IsNull(.Fields("yhmm").Value) = False Then
                MsgBox "旧密码不对！", vbCritical, "密码设置"
                Text2.Text = ""
                Text2.SetFocus
                Exit Sub
            End If
        End If
    End If
    If Trim(Text3.Text) = Trim(Text4.Text) Then
'        !yhm = Trim(Text3.Text)
        If Text3.Text <> "" Then
            !yhmm = Trim(Text3.Text)
        Else
            !yhmm = Null
        End If
        .Update
        boorecordadded = True
        MsgBox "用户密码设置成功！", vbInformation, "提示"
        Text2.Text = ""
        Text3.Text = ""
        Text4.Text = ""
        Text2.SetFocus
    Else
        MsgBox "输入密码不对，请重新输入！", vbCritical, "密码设置"
        Text4.Text = ""
        Text4.SetFocus
    End If
.Close
End With
Set cnn = Nothing
End Sub

Private Sub Text4_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
    Call cmmodify
End If
End Sub