frmloginuser.frm

利用VB+ACCESS开发的专用布料管理系统

         Name            =   "宋体"
         Size            =   10.5
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   210
      Left            =   5175
      TabIndex        =   14
      Top             =   3780
      Width           =   1050
   End
   Begin VB.Label Label4 
      AutoSize        =   -1  'True
      BackColor       =   &H00FFC0C0&
      BackStyle       =   0  'Transparent
      Caption         =   "用户编号："
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   10.5
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   210
      Left            =   5175
      TabIndex        =   13
      Top             =   1215
      Width           =   1050
   End
   Begin VB.Menu modifyuser 
      Caption         =   "modifyuser"
      Visible         =   0   'False
      Begin VB.Menu addusermnu 
         Caption         =   "增加用户"
      End
      Begin VB.Menu delusermnu 
         Caption         =   "删除用户"
      End
      Begin VB.Menu linemnu 
         Caption         =   "-"
      End
      Begin VB.Menu exitusermnu 
         Caption         =   "退出用户管理器"
      End
   End
End
Attribute VB_Name = "FrmLoginUser"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim Cnn As New ADODB.Connection
Dim Rec As New ADODB.Recordset
Dim Ssql As String
Dim IsAdd As Boolean
Dim i As Integer
Dim j As Integer

Private Sub addusermnu_Click()
    If MdlMain.LoginUser = "supervistor" Then
        Call IsModify("true")
        Text1.Text = ""
        Text2.Text = ""
        Text3.Text = ""
        Text4.Text = ""
        Text4.SetFocus
        IsAdd = True
    Else
        MsgBox "你不是《supervistor》用户，无权增加。", vbOKOnly + vbCritical, "系统提示"
    End If
End Sub

Private Sub Command2_Click()
    Unload Me
End Sub

Private Sub Command3_Click()
    If Trim(Text1.Text) = "supervistor" Then
        MsgBox "supervistor 为系统预置管理员，" & Chr$(13) & Chr$(10) & Chr$(13) _
                & "不能进行修改，请选其它好吗？", vbOKOnly + vbExclamation, "系统提示"
        Text1.SetFocus
        Exit Sub
    End If
    If Trim(Text4.Text) = "" Then
        MsgBox "用户编码不能为空！", vbOKOnly + vbExclamation, "不能为空"
        Text4.SetFocus
        Exit Sub
    End If
    If Trim(Text1.Text) = "" Then
        MsgBox "用户不能为空！", vbOKOnly + vbExclamation, "不能为空"
        Text1.SetFocus
        Exit Sub
    End If
    If Text2.Text <> Text3.Text Then
        MsgBox "请确认密码输入是否相同！", vbOKOnly + vbInformation, "出错提示"
        Text2.SetFocus
        Exit Sub
    End If
    If IsAdd = False Then
        Ssql = "select * from LoginUser where userbh='" & ListView1.SelectedItem.Text & "' order by userbh"
        Rec.Close
        Rec.CursorLocation = adUseClient
        Rec.Open Ssql, Cnn, adOpenDynamic, adLockOptimistic
        Rec.Fields("username").Value = Trim(Text1.Text)
        Rec.Fields("password").Value = MdlMain.ConVertPwd(Text2.Text)
        Rec.Update
        If ListView1.SelectedItem.Text = MdlMain.LoginBh Then
            MdlMain.LoginUser = Trim(Text1.Text)
            MdlMain.Password = MdlMain.ConVertPwd(Text2.Text)
        End If
    Else
        IsAdd = False
        Ssql = "select * from LoginUser where userbh='" & Trim(Text4.Text) & "'  order by userbh"
        Rec.Close
        Rec.CursorLocation = adUseClient
        Rec.Open Ssql, Cnn, adOpenDynamic, adLockOptimistic
        
        If Rec.BOF = False And Rec.EOF = False Then
            If MsgBox("此用户已存在，要重写它吗？", vbOKCancel + vbQuestion, "提示...") = vbCancel Then
                GoTo nochange
            Else
                Rec.Fields("username").Value = Trim(Text1.Text)
                Rec.Fields("password").Value = MdlMain.ConVertPwd(Text2.Text)
                Rec.Update
                MdlMain.LoginUser = Trim(Text1.Text)
            End If
        Else
            Rec.AddNew
            Rec.Fields("userbh").Value = Trim(Text4.Text)
            Rec.Fields("username").Value = Trim(Text1.Text)
            Rec.Fields("password").Value = MdlMain.ConVertPwd(Text2.Text)
            Rec.Update
        End If
    End If
nochange:
    Ssql = "select * from LoginUser order by userbh"
    Rec.Close
    Rec.CursorLocation = adUseClient
    Rec.Open Ssql, Cnn, adOpenDynamic, adLockOptimistic
    Call InitLisTview(Rec)
    Call IsModify("false")
    Call ListView1_Click
End Sub

Private Sub delusermnu_Click()
    If ListView1.ListItems.Count = 0 Then Exit Sub
    If ListView1.SelectedItem.SubItems(1) = "supervistor" Then
        MsgBox "supervistor 为系统预置管理员，" & Chr$(13) & Chr$(10) & Chr$(13) _
                & "不能删除，请选其它好吗？", vbOKOnly + vbExclamation, "系统提示"
        Exit Sub
    End If
    If MdlMain.LoginUser = "supervistor" Then
        If MsgBox("你真的要删除选定的用户吗？", vbOKCancel + vbQuestion, "确认删除") = vbOK Then
            Cnn.BeginTrans
            For i = 1 To ListView1.ListItems.Count
                If ListView1.ListItems(i).Selected = True And ListView1.ListItems(i).Text <> "000" Then
                    Cnn.Execute "delete from LoginUser where userbh='" & ListView1.ListItems(i).Text & "'"
                End If
            Next i
            Cnn.CommitTrans
            Ssql = "select * from LoginUser order by userbh"
            Rec.Close
            Rec.CursorLocation = adUseClient
            Rec.Open Ssql, Cnn, adOpenDynamic, adLockOptimistic
            Call InitLisTview(Rec)
            Call IsModify("false")
            Call ListView1_Click
        End If
    Else
        MsgBox "你不是《supervistor》用户，不能删除。", vbOKOnly + vbCritical, "系统提示"
    End If
End Sub

Private Sub exitusermnu_Click()
    Unload Me
End Sub

Private Sub Form_KeyPress(KeyAscii As Integer)
    If KeyAscii = vbKeyEscape Then Unload Me
End Sub

Private Sub Form_Load()
    Me.KeyPreview = True
    Me.Left = GetSetting(App.EXEName, "用户设置", "left", (Screen.Width - Me.Width) / 2)
    Me.Top = GetSetting(App.EXEName, "用户设置", "top", (Screen.Height - Me.Height) / 2)
    IsAdd = False
    Ssql = "select * from LoginUser order by userbh"
    Cnn.Open DbLoginSql
    Rec.CursorLocation = adUseClient
    Rec.Open Ssql, Cnn, adOpenDynamic, adLockOptimistic
    Call InitLisTview(Rec)
    Text1.Text = ""
    Text2.Text = ""
    Text3.Text = ""
    Text4.Text = ""
    Call IsModify("false")
End Sub

Private Sub InitLisTview(Rrec As ADODB.Recordset)
    If Rrec.EOF And Rrec.BOF Then Exit Sub
    ListView1.ListItems.Clear
    With Rrec
        Do While Not .EOF
            ListView1.ListItems.Add , "r" & .AbsolutePosition, .Fields("userbh")
            ListView1.ListItems("r" & .AbsolutePosition).SubItems(1) = _
                .Fields("username").Value
            ListView1.ListItems("r" & .AbsolutePosition).SubItems(2) = "********"
            .MoveNext
        Loop
    End With
End Sub

Private Sub Form_Unload(Cancel As Integer)
    On Error Resume Next
    SaveSetting App.EXEName, "用户设置", "left", Me.Left
    SaveSetting App.EXEName, "用户设置", "top", Me.Top
    FrmMain.Caption = "布料管理系统（当前用户：" & MdlMain.LoginUser & "）"
    Rec.Close: Set Rec = Nothing
    Cnn.Close: Set Cnn = Nothing
End Sub

Private Sub ListView1_Click()
    Call IsModify("false")
    Text4.Text = ListView1.SelectedItem.Text
    Text1.Text = ListView1.SelectedItem.SubItems(1)
    Text2.Text = ListView1.SelectedItem.SubItems(2)
    Text3.Text = ListView1.SelectedItem.SubItems(2)
End Sub

Private Sub ListView1_DblClick()
    If ListView1.SelectedItem.Text = "000" Then Exit Sub
    If MdlMain.LoginBh = "000" Then
        Call IsModify("true")
        Text1.SetFocus
    ElseIf ListView1.SelectedItem.Text = MdlMain.LoginBh Then
        Call IsModify("true")
        Text1.SetFocus
    End If
End Sub

Private Sub listview1_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
    If Button = 2 Then PopupMenu modifyuser
End Sub

Private Sub IsModify(IsS As String)
    Select Case IsS
        Case "false"
            Text1.Enabled = False
            Text2.Enabled = False
            Text3.Enabled = False
            Text4.Enabled = False
            Command3.Enabled = False
        Case "true"
            Text1.Enabled = True
            Text2.Enabled = True
            Text3.Enabled = True
            Text4.Enabled = True
            Command3.Enabled = True
    End Select
End Sub

Private Sub Text1_GotFocus()
    Text1.SelStart = 0
    Text1.SelLength = Len(Text1.Text)
    Text1.BackColor = &H80FF80
End Sub

Private Sub Text1_KeyPress(KeyAscii As Integer)
    If KeyAscii = vbKeyReturn Then SendKeys "{tab}"
End Sub

Private Sub Text2_KeyPress(KeyAscii As Integer)
    If KeyAscii = vbKeyReturn Then SendKeys "{tab}"
End Sub

Private Sub Text3_KeyPress(KeyAscii As Integer)
    If KeyAscii = vbKeyReturn Then SendKeys "{tab}"
End Sub

Private Sub Text4_KeyPress(KeyAscii As Integer)
    If KeyAscii = vbKeyReturn Then SendKeys "{tab}"
End Sub

Private Sub Text2_GotFocus()
    Text2.SelStart = 0
    Text2.SelLength = Len(Text2.Text)
    Text2.BackColor = &H80FF80
End Sub

Private Sub Text3_GotFocus()
    Text3.SelStart = 0
    Text3.SelLength = Len(Text3.Text)
    Text3.BackColor = &H80FF80
End Sub

Private Sub Text4_GotFocus()
    Text4.SelStart = 0
    Text4.SelLength = Len(Text4.Text)
    Text4.BackColor = &H80FF80
End Sub

Private Sub Text1_LostFocus()
    Text1.BackColor = &HFFFFFF
End Sub

Private Sub Text2_LostFocus()
    Text2.BackColor = &HFFFFFF
End Sub

Private Sub Text3_LostFocus()
    Text3.BackColor = &HFFFFFF
End Sub

Private Sub Text4_LostFocus()
    Text4.BackColor = &HFFFFFF
End Sub