📄 frmoperec.frm
字号:
VERSION 5.00
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCTL.OCX"
Object = "{86CF1D34-0C5F-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCT2.OCX"
Begin VB.Form Frm_OpeRec
BorderStyle = 1 'Fixed Single
Caption = "操作记录"
ClientHeight = 3810
ClientLeft = 6570
ClientTop = 3015
ClientWidth = 5265
LinkTopic = "Form1"
MaxButton = 0 'False
ScaleHeight = 3810
ScaleWidth = 5265
Begin VB.CommandButton CmdRecQuery
Caption = "查询"
Height = 375
Left = 2640
TabIndex = 2
Top = 3360
Width = 1095
End
Begin VB.CommandButton CmdCancel
Cancel = -1 'True
Caption = "返回"
Height = 375
Left = 3960
TabIndex = 1
Top = 3360
Width = 1095
End
Begin MSComctlLib.ListView LvUsrRec
Height = 2775
Left = 120
TabIndex = 0
Top = 480
Width = 5055
_ExtentX = 8916
_ExtentY = 4895
View = 3
Arrange = 2
Sorted = -1 'True
LabelWrap = -1 'True
HideSelection = -1 'True
FullRowSelect = -1 'True
_Version = 393217
ForeColor = -2147483640
BackColor = -2147483643
BorderStyle = 1
Appearance = 1
NumItems = 3
BeginProperty ColumnHeader(1) {BDD1F052-858B-11D1-B16A-00C0F0283628}
Text = "用户ID"
Object.Width = 1764
EndProperty
BeginProperty ColumnHeader(2) {BDD1F052-858B-11D1-B16A-00C0F0283628}
SubItemIndex = 1
Text = "使用时间"
Object.Width = 4164
EndProperty
BeginProperty ColumnHeader(3) {BDD1F052-858B-11D1-B16A-00C0F0283628}
SubItemIndex = 2
Text = "用户操作"
Object.Width = 2400
EndProperty
End
Begin VB.Frame FrameRecQuery
Caption = "操作记录查询"
BeginProperty Font
Name = "楷体_GB2312"
Size = 14.25
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00FF0000&
Height = 2775
Left = 120
TabIndex = 3
Top = 480
Visible = 0 'False
Width = 5055
Begin VB.CommandButton CmdQueryOK
Caption = "确定"
Default = -1 'True
Height = 375
Left = 3600
TabIndex = 11
Top = 2280
Width = 1095
End
Begin VB.ComboBox CmbOpeType
Height = 300
ItemData = "FrmOpeRec.frx":0000
Left = 2880
List = "FrmOpeRec.frx":0016
Style = 2 'Dropdown List
TabIndex = 10
Top = 1800
Width = 1695
End
Begin VB.OptionButton Option1
Caption = "按操作类型查询："
BeginProperty Font
Name = "楷体_GB2312"
Size = 12
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00FF0000&
Height = 375
Index = 2
Left = 240
TabIndex = 8
Top = 1800
Width = 2415
End
Begin VB.OptionButton Option1
Caption = "按操作时间查询："
BeginProperty Font
Name = "楷体_GB2312"
Size = 12
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00FF0000&
Height = 375
Index = 1
Left = 240
TabIndex = 7
Top = 1080
Width = 2415
End
Begin VB.TextBox TxtQeuryUsr
Height = 375
Left = 2880
TabIndex = 6
Top = 480
Width = 1695
End
Begin VB.OptionButton Option1
Caption = "按操作用户查询："
BeginProperty Font
Name = "楷体_GB2312"
Size = 12
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00FF0000&
Height = 375
Index = 0
Left = 240
TabIndex = 5
Top = 480
Value = -1 'True
Width = 2415
End
Begin MSComCtl2.DTPicker DTPickerQuery
Height = 330
Left = 2880
TabIndex = 9
Top = 1100
Width = 1680
_ExtentX = 2963
_ExtentY = 582
_Version = 393216
CustomFormat = "HHmm"
Format = 19660801
CurrentDate = 37987
End
End
Begin VB.Label LblUser
Caption = "当前用户："
BeginProperty Font
Name = "楷体_GB2312"
Size = 12
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00800080&
Height = 255
Left = 240
TabIndex = 4
Top = 120
Width = 4935
End
End
Attribute VB_Name = "Frm_OpeRec"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Private Sub CmdCancel_Click() '取消
Unload Me
End Sub
Private Sub CmdQueryOK_Click() '查询操作记录
Dim i As Integer
Dim LtItm As ListItem
Dim OpeQuery As New ADODB.Recordset
Dim QueryDate1 As Date
Dim QueryDate2 As Date
Dim DBstr As String
Dim UsrID As String
'按用户ID查询
If Option1(0).Value = True Then
If Me.TxtQeuryUsr.Text = "" Then
MsgBox "请输入要查询的用户ID！"
Exit Sub
ElseIf Len(Trim(Me.TxtQeuryUsr.Text)) > 16 Then
MsgBox "用户ID长度超出范围！"
Exit Sub
End If
UsrID = Replace(Trim(Me.TxtQeuryUsr.Text), "'", "''")
'读用户资料
DBstr = "select * from UserRecord where UserID Like"
DBstr = DBstr & "'%" & UsrID & "%'"
'打开数据集
OpeQuery.Open DBstr, DBCnn, adOpenStatic, adLockOptimistic
'按操作时间查询
ElseIf Option1(1).Value = True Then
QueryDate1 = Format(DTPickerQuery, "yyyy-mm-dd")
QueryDate2 = DateAdd("d", 1, QueryDate1)
'读用户资料
DBstr = "select * from UserRecord where UserTime>#"
DBstr = DBstr & QueryDate1
DBstr = DBstr & "# and UserTime<#"
DBstr = DBstr & QueryDate2 & "#"
OpeQuery.Open DBstr, DBCnn, adOpenStatic, adLockOptimistic
'按操作类型查询
ElseIf Option1(2).Value = True Then
If Me.CmbOpeType.Text = "" Then
MsgBox "请选择要查询的操作类型！"
Exit Sub
End If
'读用户资料
DBstr = "select * from UserRecord where UserOperate="
DBstr = DBstr & Val(Me.CmbOpeType.Text)
OpeQuery.Open DBstr, DBCnn, adOpenStatic, adLockOptimistic
End If
'显示查询结果
If OpeQuery.EOF Then
MsgBox "数据库中没有符合要求的记录！"
Exit Sub
End If
'将查询结果显示在列表框中
Me.LvUsrRec.ListItems.Clear '清空列表
'数据集指针指向数据集的第一个记录
OpeQuery.MoveFirst
For i = 1 To OpeQuery.RecordCount
Set LtItm = Me.LvUsrRec.ListItems.Add()
LtItm.Text = OpeQuery.Fields("UserID").Value
LtItm.SubItems(1) = OpeQuery.Fields("UserTime").Value
LtItm.SubItems(2) = GetOperate(OpeQuery.Fields("UserOperate").Value)
'数据集指针指向下一条记录
OpeQuery.MoveNext
Next i
'关闭数据集
OpeQuery.Close
Me.FrameRecQuery.Visible = False
Me.LvUsrRec.Visible = True
'记录该操作
AddRec (6)
End Sub
Private Sub CmdRecQuery_Click() '显示查询框架
Me.LvUsrRec.Visible = False
Me.FrameRecQuery.Visible = True
Me.DTPickerQuery.Value = Format(Now, "yyyy - mm - dd")
Me.TxtQeuryUsr.Text = ""
End Sub
Private Sub Form_Load()
Dim i As Integer
Dim LtItm As ListItem
Dim RecQuery As New ADODB.Recordset
Me.LblUser.Caption = "当前用户：" & UserNow.ID & " 用户类型：系统管理员"
'读用户资料
'打开数据集
RecQuery.Open "select * from UserRecord ", DBCnn, adOpenStatic, adLockReadOnly
If RecQuery.EOF Then
MsgBox "目前没有操作记录！"
Exit Sub
End If
'数据集指针指向数据集的第一个记录
RecQuery.MoveFirst
'默认在列表中显示所有记录
For i = 1 To RecQuery.RecordCount
Set LtItm = Me.LvUsrRec.ListItems.Add()
LtItm.Text = RecQuery.Fields("UserID").Value
LtItm.SubItems(1) = RecQuery.Fields("UserTime").Value
LtItm.SubItems(2) = GetOperate(RecQuery.Fields("UserOperate").Value)
If RecQuery.Fields("Remark").Value <> "" Then
LtItm.SubItems(3) = RecQuery.Fields("Remark").Value
End If
'数据集指针指向下一条记录
RecQuery.MoveNext
Next i
'关闭数据集
RecQuery.Close
End Sub
'********************************************************************
'得到操作类型字符串的函数 GetOperate
'功能：从用数字记录的操作类型中得到操作类型字符串
'输入：操作类型 1-6
'输出：操作类型字符串 1＝登记访客资料 2=查询访客资料
'3=更改密码 4=添加新用户 5=查看用户资料 6=查看操作记录
'********************************************************************
Private Function GetOperate(ByVal OpeType As Integer) As String
Select Case OpeType
Case 1
GetOperate = "登记访客资料"
Case 2
GetOperate = "查询访客资料"
Case 3
GetOperate = "更改密码"
Case 4
GetOperate = "添加新用户"
Case 5
GetOperate = "查看用户资料"
Case 6
GetOperate = "查看操作记录"
Case Else
GetOperate = "类型错误！"
End Select
End Function
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -