frmoperec.frm

<Visual Basic 数据库开发实例精粹（第二版）>一书首先介绍了Visual Basic(简称VB)开发的技巧和重点技术

   Begin VB.Frame fraQueryResult 
      Height          =   3735
      Left            =   315
      TabIndex        =   15
      Top             =   1155
      Width           =   7140
      Begin MSComctlLib.ListView LvUsrRec 
         Height          =   2670
         Left            =   165
         TabIndex        =   16
         Top             =   855
         Width           =   6765
         _ExtentX        =   11933
         _ExtentY        =   4710
         View            =   3
         Arrange         =   2
         Sorted          =   -1  'True
         LabelWrap       =   -1  'True
         HideSelection   =   -1  'True
         FullRowSelect   =   -1  'True
         GridLines       =   -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           =   2753
         EndProperty
      End
      Begin VB.Label Label2 
         AutoSize        =   -1  'True
         BackStyle       =   0  'Transparent
         Caption         =   "用户操作记录查询结果"
         BeginProperty Font 
            Name            =   "宋体"
            Size            =   14.25
            Charset         =   134
            Weight          =   700
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         Height          =   285
         Left            =   1800
         TabIndex        =   17
         Top             =   300
         Width           =   3000
      End
   End
End
Attribute VB_Name = "frmQueryRec"
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.fraQueryCondition.Visible = False
  Me.fraQueryResult.Visible = True
    
  '记录该操作
  AddRec (6)
        
End Sub

Private Sub CmdRecQuery_Click() '显示查询框架
  Me.fraQueryResult.Visible = False
  Me.fraQueryCondition.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