formd7.frm

基于VB开

End Sub

Private Sub MSFlexGrid1_Click()                                ' 选中一用户
    With MSFlexGrid1
         m = .Row
        .Row = intRow: For i = 1 To 3: .Col = i: .CellBackColor = intCy1: Next
         intRow = m
        .Row = intRow: For i = 1 To 3: .Col = i: .CellBackColor = intCn1: Next
        .Col = 1: Text1.Text = .Text
        .Col = 2: Text2.Text = .Text
    End With
    strDmp = arrUsn(intRow, 0)
    strMcp = arrUsn(intRow, 1)
    strJcp = arrUsn(intRow, 2)
    strBzk = arrUsn(intRow, 3)                                 ' 用户级别
    Call P_atxt
    bytMod = 2                                                 ' 修改标志
    Command4.Enabled = True
    Command3.Enabled = True
    Command2.Enabled = True
    Command2.Caption = "修改用户"
    Command2.SetFocus
End Sub

Private Sub P_atxt()
    Text1.Visible = True
    Text2.Visible = True
    Label1.Visible = True
    Label2.Visible = True
End Sub

Private Sub Text1_Change()                                     ' 检查用户名
    StrUsm = Trim(Text1.Text)
    If myF_Len(StrUsm) > 6 Then
       MsgBox "  用户名最大长度为六个英文字符位，请修改 ... ", 48, "  请注意"
       Text1.Text = Left(StrUsm, 6)
       Text1.SetFocus                                          ' 重新输入
    End If
End Sub

Private Sub Text1_KeyPress(KeyAscii As Integer)                ' 用户名
    If KeyAscii = 13 Then
       StrUsm = Trim(Text1.Text)
       If StrUsm = "" Then
          Command1.SetFocus                                    ' Quit
       Else
          If bytMod > 1 Then
             If StrUsm = arrUsn(intRow, 2) Then
                Text2.Text = ""
                Text2.SetFocus: Exit Sub
             End If
          End If
          If P_HcUse(StrUsm) = True Then                       ' 用户名通过
             Text2.Text = ""
             Text2.Visible = True: Label2.Visible = True
             Text2.SetFocus
          Else
             MsgBox "  很抱歉，用户名重复，请重新设置 ...  ", 48, "  请注意"
             Text1.Text = ""
             Text1.SetFocus
          End If
       End If
    End If
End Sub

Function P_HcUse(Usn As String) As Boolean                     ' 核对用户名
    If bytUss < 1 Then P_HcUse = True: Exit Function
    MyRs0.MoveFirst
       Do While Not MyRs0.EOF
          If Usn = Trim(MyRs0![Mc]) Then
             P_HcUse = False
             Exit Function
             Exit Do
          End If
          MyRs0.MoveNext
       Loop
    P_HcUse = True                                             ' 用户名不重复
End Function

Private Sub Text2_Change()                                     ' 检查密码
    strUsk = Trim(Text2.Text)
    If strUsk = "" Then Exit Sub
    If myF_Len(strUsk) > 6 Then
       MsgBox "  密码最大长度为六个英文字符位，请修改 ... ", 48, "  请注意"
       Text2.Text = Left(strUsk, 6)
       Text2.SetFocus                                          ' 重新输入
    End If
End Sub

Private Sub Text2_KeyPress(KeyAscii As Integer)                ' txtPassword
    If KeyAscii <> 13 Then Exit Sub
       strUsk = Trim(Text2.Text)
    If strUsk = "" Then
       Command1.SetFocus                                       ' Quit
    Else
       If P_HcKls(strUsk) = False Then
          If MsgBox("  请注意：密码重复，是否修改 ...  ", 4 + 32 + 256, "  请确认") = 6 Then
             Text2.Text = ""
             Text2.SetFocus
          Else
             Command2.Enabled = True: Command2.SetFocus
          End If
       Else
          Command2.Enabled = True: Command2.SetFocus
       End If
    End If
End Sub

Function P_HcKls(Usk As String) As Boolean                     ' 核对密码
    If bytUss < 1 Then P_HcKls = True: Exit Function
    MyRs0.MoveFirst
       Do While Not MyRs0.EOF
          If Usk = Trim(MyRs0![Jc]) Then
             P_HcKls = False
             Exit Function
             Exit Do
          End If
          MyRs0.MoveNext
       Loop
    P_HcKls = True                                             ' 密码不重复
End Function

Private Sub Command1_KeyPress(KeyAscii As Integer)             ' cmdOK
    If KeyAscii = 13 Then Call Command1_Click
End Sub

Private Sub Command1_Click()                                   ' cmdCancel
    'StrUsj = "3"
    Unload Me
End Sub

Private Sub Command2_Click()                                   ' 确认处理
    
    If Command2.Caption = "修改用户" Then
       Command2.Caption = "确  认"
       bytMod = 2                                              ' 修改标志
       Text1.SetFocus
       Exit Sub
    End If
    
    strMck = Trim(Text1.Text)
    strJck = Trim(Text2.Text)
       If Len(strMck) = 0 Then
          Command1.SetFocus: Exit Sub
       End If
    If bytMod = 1 Then
       If Len(strJck) = 0 Then
          MsgBox "  应为新增用户 " & strMck & " 预置密码 ... ", 48, " 请注意"
          Text2.SetFocus: Exit Sub
       End If
       StrMsg = " 确实要将新增加的用户信息存盘吗 ？ "                    ' 追加
       If MsgBox(StrMsg, 33, " 请确认") = 1 Then
          strDmk = "Kl" & Right(Str(Val(Right(strDmk, 2)) + 1001), 3)    ' 新代码
          strXhk = Right(Str(Val(strXhk) + 1001), 3)                     ' 新序号
          StrSQL = "INSERT INTO  " & strT0 & "( Dm,Xh,Mc,Jc,Bz) VALUES " & _
                   "('" & strDmk & "','" & strXhk & "','" & strMck & "','" & strJck & "','" & strBzk & "' ) "
          cnnTce.Execute StrSQL
          Call P_RecorSet
       End If
    Else
       StrMsg = " 确实要将用户 " & strMcp & " 的信息修改存盘吗 ？ "
       If MsgBox(StrMsg, 33, " 请确认") = 1 Then
          MyRs0.MoveFirst
          Do While Not MyRs0.EOF
             If MyRs0![dm] = strDmp Then
                MyRs0![Mc] = strMck: arrUsn(intRow, 1) = strMck
                MyRs0![Jc] = strJck: arrUsn(intRow, 2) = strJck
                MyRs0.Update
                Exit Do
             End If
             MyRs0.MoveNext
          Loop
          With MSFlexGrid1
              .Row = intRow: .Col = 1: .Text = " " & strMck
               For i = 1 To 3: .Col = i: .CellBackColor = intCy1: Next
          End With
          Call P_dtxt
          MsgBox "  用户 " & strMck & " 信息修改完毕 ... ", 48, " Ok !"
       End If
    End If
End Sub

Private Sub P_dtxt()
    Text1.Visible = False
    Text2.Visible = False
    Label1.Visible = False
    Label2.Visible = False
    Command2.Enabled = False
    Command3.Enabled = False
    Command4.Caption = "添加用户"
    Command4.SetFocus
End Sub

Private Sub Command3_Click()                                             ' 删除
    strMcp = Trim(arrUsn(intRow, 1))
    StrMsg = " 确实要删除有关 " & strMcp & " 的条目信息吗 ？ "                          ' 追加
    If MsgBox(StrMsg, 33, " 请确认") = 1 Then
       strDmp = Trim(arrUsn(intRow, 0))
       StrSQL = "Delete From " & strT0 & " Where Dm = '" & strDmp & "'"
       cnnTce.Execute StrSQL
       Call P_RecorSet
       Call P_dtxt
    Else
       Call Command2_Click                                               ' 放弃
    End If
End Sub

Private Sub Command4_Click()                                             ' 追加按钮
       bytMod = 1
       Label1.Visible = True
       Text1.Text = ""
       Text1.Visible = True
       Label2.Visible = False
       Text2.Text = ""
       Text2.Visible = False
       Text1.SetFocus
End Sub

Private Sub Form_Unload(Cancel As Integer)
 On Error Resume Next
    MyRs0.Close: Set MyRs0 = Nothing
    MyRs1.Close: Set MyRs1 = Nothing
End Sub