📄 form9.frm
字号:
VERSION 5.00
Object = "{E95A2510-F3D1-416D-823B-4F840FE98091}#3.0#0"; "Command.ocx"
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "Mscomctl.ocx"
Begin VB.Form Form9
BackColor = &H00FFFFFF&
BorderStyle = 1 'Fixed Single
Caption = "人员管理"
ClientHeight = 4095
ClientLeft = 45
ClientTop = 330
ClientWidth = 8100
Icon = "Form9.frx":0000
LinkTopic = "Form9"
MaxButton = 0 'False
MDIChild = -1 'True
MinButton = 0 'False
ScaleHeight = 4095
ScaleWidth = 8100
Begin MSComctlLib.ListView ListView1
Height = 3015
Left = 120
TabIndex = 1
Top = 960
Width = 4815
_ExtentX = 8493
_ExtentY = 5318
LabelWrap = -1 'True
HideSelection = -1 'True
FullRowSelect = -1 'True
GridLines = -1 'True
_Version = 393217
ForeColor = -2147483640
BackColor = -2147483643
BorderStyle = 1
Appearance = 1
NumItems = 0
End
Begin VB.Frame Frame1
BackColor = &H00FFFFFF&
Caption = "操作面板"
Height = 3135
Left = 5040
TabIndex = 0
Top = 840
Width = 2895
Begin CSCommand.Command Command1
Default = -1 'True
Height = 375
Left = 240
TabIndex = 10
Top = 2520
Width = 1095
_ExtentX = 1931
_ExtentY = 661
IconAlign = 0
Icon = "Form9.frx":84CA
Caption = "新增用户"
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "宋体"
Size = 9
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
End
Begin VB.ComboBox Combo1
Height = 300
ItemData = "Form9.frx":84E6
Left = 1200
List = "Form9.frx":84F3
TabIndex = 9
Text = "普通用户"
Top = 1920
Width = 1575
End
Begin VB.TextBox Text1
Height = 270
Index = 2
Left = 1200
TabIndex = 4
Top = 1440
Width = 1575
End
Begin VB.TextBox Text1
Height = 270
IMEMode = 3 'DISABLE
Index = 1
Left = 1200
PasswordChar = "*"
TabIndex = 3
Top = 960
Width = 1575
End
Begin VB.TextBox Text1
Height = 270
Index = 0
Left = 1200
TabIndex = 2
Top = 480
Width = 1575
End
Begin CSCommand.Command Command3
Height = 375
Left = 1560
TabIndex = 11
Top = 2520
Width = 1095
_ExtentX = 1931
_ExtentY = 661
IconAlign = 0
Icon = "Form9.frx":8515
Enabled = 0 'False
Caption = "删除用户"
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "宋体"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
End
Begin VB.Label Label2
BackStyle = 0 'Transparent
Caption = "用户类型"
Height = 255
Index = 3
Left = 240
TabIndex = 8
Top = 1920
Width = 735
End
Begin VB.Label Label2
BackStyle = 0 'Transparent
Caption = "姓 名"
Height = 255
Index = 2
Left = 240
TabIndex = 7
Top = 1440
Width = 735
End
Begin VB.Label Label2
BackStyle = 0 'Transparent
Caption = "密 码"
Height = 255
Index = 1
Left = 240
TabIndex = 6
Top = 960
Width = 735
End
Begin VB.Label Label2
BackStyle = 0 'Transparent
Caption = "登 录 名"
Height = 255
Index = 0
Left = 240
TabIndex = 5
Top = 480
Width = 735
End
End
Begin VB.Image Image1
Height = 645
Left = 2040
Picture = "Form9.frx":8531
Top = 0
Width = 3585
End
End
Attribute VB_Name = "Form9"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim conn As ADODB.Connection
Dim rs As ADODB.Recordset
Dim SQL, connstr As String
Dim did As Integer
Private Sub Command1_Click()
On Error Resume Next
SQL = "select * from admins where users='" & Text1(0).Text & "'"
rs.Open SQL, conn, 1, 1
If Not (rs.EOF) And did = 0 Then
MDIForm1.StatusBar1.Panels(1).Text = "用户名不能重复."
rs.Close
Exit Sub
End If
rs.Close
SQL = "select * from admins where id=" & did
rs.Open SQL, conn, 1, 3
If rs.EOF Then
rs.AddNew
rs("addtimes") = Now()
End If
rs("users") = Text1(0).Text
rs("pass") = Text1(1).Text
rs("name") = Text1(2).Text
rs("area") = CInt(Combo1.ListIndex)
rs.Update
rs.Close
If Err.Number = 0 Then
Call RefillList(ListView1)
Text1(0).Text = ""
Text1(1).Text = ""
Text1(2).Text = ""
Combo1.ListIndex = 0
did = 0
Text1(0).Enabled = True
Command3.Enabled = False
Command1.Caption = "新增用户"
Else
MDIForm1.StatusBar1.Panels(1).Text = "数据库更新失败,可能用户名重复."
End If
End Sub
Private Sub Command3_Click()
On Error Resume Next
SQL = "delete from admins where id=" & did
conn.Execute SQL
If Err.Number = 0 Then
Call RefillList(ListView1)
Text1(0).Text = ""
Text1(1).Text = ""
Text1(2).Text = ""
Combo1.ListIndex = 0
did = 0
Text1(0).Enabled = True
Command3.Enabled = False
Command1.Caption = "新增用户"
Else
MDIForm1.StatusBar1.Panels(1).Text = "数据库删除失败."
End If
End Sub
Private Sub Form_Load()
On Error Resume Next
connstr = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & App.Path & "\GLNHHY.DLL;Persist Security Info=False"
Set conn = New ADODB.Connection
conn.Open connstr
Set rs = New ADODB.Recordset
did = 0
Call RefillList(ListView1)
End Sub
Private Sub RefillList(ByVal lv As ListView)
On Error Resume Next
Dim clm As ColumnHeader
Dim itm As ListItem
Dim i As Long, j As Long
lv.ListItems.Clear
lv.ColumnHeaders.Clear
lv.View = lvwReport
lv.LabelEdit = lvwManual
'
'
Set clm = lv.ColumnHeaders.Add(, , "姓名")
Set clm = lv.ColumnHeaders.Add(, , "登录名")
Set clm = lv.ColumnHeaders.Add(, , "用户类型")
Set clm = lv.ColumnHeaders.Add(, , "最后登录时间")
i = 0
SQL = "select * from admins"
rs.Open SQL, conn, 1, 1
If rs.EOF Then
rs.Close
Exit Sub
End If
Do Until rs.EOF
If rs.EOF Then Exit Do
i = i + 1
Set itm = lv.ListItems.Add(, "Row" & i, rs("name"))
itm.SubItems(1) = rs("users") & ""
Select Case CInt(rs("area"))
Case 0
itm.SubItems(2) = "开票用户"
Case 1
itm.SubItems(2) = "高级用户"
Case 2
itm.SubItems(2) = "超级用户"
End Select
itm.SubItems(3) = Format(CDate(rs("addtimes")), "ddddd ttttt")
rs.MoveNext
Loop
rs.Close
End Sub
Private Sub ListView1_ColumnClick(ByVal ColumnHeader As MSComctlLib.ColumnHeader)
On Error Resume Next
ListView1.SortKey = ColumnHeader.Index - 1
ListView1.Sorted = True
If ListView1.SortOrder = lvwDescending Then
ListView1.SortOrder = lvwAscending
Else
ListView1.SortOrder = lvwDescending
End If
End Sub
Private Sub ListView1_ItemClick(ByVal Item As MSComctlLib.ListItem)
On Error Resume Next
If Err.Number = 3705 Then rs.Close
SQL = "select * from admins where users='" & ListView1.ListItems(Item.Index).SubItems(1) & "'"
rs.Open SQL, conn, 1, 1
If Not (rs.EOF) Then
did = rs("id")
Text1(0).Text = rs("users")
Text1(1).Text = rs("pass")
Text1(2).Text = rs("name")
Combo1.ListIndex = rs("area")
End If
rs.Close
Text1(0).Enabled = False
Command3.Enabled = True
Command1.Caption = "修改用户"
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -