frmmain.frm

这是我做的一个管理系统以及所含有的论文

         Left            =   2760
         TabIndex        =   11
         Top             =   3960
         Width           =   1095
      End
      Begin MSComCtl2.DTPicker DTPickerQuery 
         Height          =   330
         Left            =   2280
         TabIndex        =   14
         Top             =   1560
         Width           =   1320
         _ExtentX        =   2328
         _ExtentY        =   582
         _Version        =   393216
         Format          =   20054017
         CurrentDate     =   37987
      End
   End
   Begin VB.Frame FrameResult 
      Caption         =   "查询结果"
      BeginProperty Font 
         Name            =   "楷体_GB2312"
         Size            =   14.25
         Charset         =   134
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H00004080&
      Height          =   4215
      Left            =   2880
      TabIndex        =   19
      Top             =   1080
      Visible         =   0   'False
      Width           =   5535
      Begin MSComctlLib.ListView LvResult 
         Height          =   3735
         Left            =   120
         TabIndex        =   20
         Top             =   360
         Width           =   5600
         _ExtentX        =   9869
         _ExtentY        =   6588
         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        =   6
         BeginProperty ColumnHeader(1) {BDD1F052-858B-11D1-B16A-00C0F0283628} 
            Text            =   "姓名"
            Object.Width           =   1587
         EndProperty
         BeginProperty ColumnHeader(2) {BDD1F052-858B-11D1-B16A-00C0F0283628} 
            SubItemIndex    =   1
            Text            =   "性别"
            Object.Width           =   1060
         EndProperty
         BeginProperty ColumnHeader(3) {BDD1F052-858B-11D1-B16A-00C0F0283628} 
            SubItemIndex    =   2
            Text            =   "来访时间"
            Object.Width           =   4234
         EndProperty
         BeginProperty ColumnHeader(4) {BDD1F052-858B-11D1-B16A-00C0F0283628} 
            SubItemIndex    =   3
            Text            =   "来访理由"
            Object.Width           =   3175
         EndProperty
         BeginProperty ColumnHeader(5) {BDD1F052-858B-11D1-B16A-00C0F0283628} 
            SubItemIndex    =   4
            Text            =   "记录用户"
            Object.Width           =   1589
         EndProperty
         BeginProperty ColumnHeader(6) {BDD1F052-858B-11D1-B16A-00C0F0283628} 
            SubItemIndex    =   5
            Text            =   "备注"
            Object.Width           =   2540
         EndProperty
      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          =   375
      Left            =   3000
      TabIndex        =   26
      Top             =   720
      Width           =   5895
   End
   Begin VB.Menu File 
      Caption         =   "系统管理"
      Begin VB.Menu File_Exit 
         Caption         =   "退出"
      End
   End
   Begin VB.Menu Operate 
      Caption         =   "客户操作"
      Begin VB.Menu Ope_Record 
         Caption         =   "客户登记"
      End
      Begin VB.Menu Ope_Query 
         Caption         =   "客户查询"
      End
   End
   Begin VB.Menu Manage 
      Caption         =   "系统管理"
      Begin VB.Menu Mng_User 
         Caption         =   "用户管理"
      End
      Begin VB.Menu Mng_Operate 
         Caption         =   "操作记录"
      End
   End
   Begin VB.Menu Help 
      Caption         =   "帮助"
      Begin VB.Menu Sys_new 
         Caption         =   "系统信息"
      End
      Begin VB.Menu Hlp_About 
         Caption         =   "关于"
      End
   End
End
Attribute VB_Name = "Frm_Main"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

Private Sub CmdQuery_Click()    '查询访客资料
Dim i As Integer
Dim LtItm As ListItem
Dim UserQuery As New ADODB.Recordset
Dim QueryDate1 As Date
Dim QueryDate2 As Date
Dim DBstr As String
Dim GuestName As String
Dim GuestReason As String
Dim UsrID As String

    If UserNow.Type <> 0 And UserNow.Type <> 2 Then
        MsgBox "对不起，您的权限不能查询访客记录！"
        Exit Sub
    End If

    '按姓名查询
    If Me.OptionQuery(0).Value = True Then
    
        If Me.TxtQueryName.Text = "" Then
            MsgBox "请输入要查询的访客姓名！"
            Exit Sub
        ElseIf Len(Trim(Me.TxtQueryName.Text)) > 4 Then
            MsgBox "访客姓名长度超出范围！"
            Exit Sub
        End If
        
        '替换单引号
        GuestName = Replace(Trim(Me.TxtQueryName.Text), "'", "''")
        
        '读用户资料
        DBstr = "select * from GuestInfo where GuestName Like "
        DBstr = DBstr & "'%" & GuestName & "%'"
        '打开数据集
        UserQuery.Open DBstr, DBCnn, adOpenStatic, adLockOptimistic
        
    '按性别查询
    ElseIf Me.OptionQuery(1).Value = True Then
        If Me.CmbQuerySex.Text = "" Then
            MsgBox "请选择查询性别！"
            Exit Sub
        End If
        '读用户资料
        DBstr = "select * from GuestInfo where GuestSex='"
        DBstr = DBstr & Me.CmbQuerySex.Text & "'"
        UserQuery.Open DBstr, DBCnn, adOpenStatic, adLockOptimistic
        
    '按时间查询
    ElseIf Me.OptionQuery(2).Value = True Then
        QueryDate1 = Format(DTPickerQuery, "yyyy-mm-dd")
        QueryDate2 = DateAdd("d", 1, QueryDate1)
        '读用户资料
        DBstr = "select * from GuestInfo where GuestTime>#"
        DBstr = DBstr & QueryDate1
        DBstr = DBstr & "# and GuestTime<#" & QueryDate2 & "#"
        UserQuery.Open DBstr, DBCnn, adOpenStatic, adLockOptimistic
    
    '按来访原因查询
    ElseIf Me.OptionQuery(3).Value = True Then
        If Me.TxtQueryRes.Text = "" Then
            MsgBox "请输入要查询的来访原因！"
            Exit Sub
        End If
        GuestReason = Replace(Trim(Me.TxtQueryRes.Text), "'", "''")
        
        '读用户资料
        DBstr = "select * from GuestInfo where GuestReason Like"
        DBstr = DBstr & "'%" & GuestReason & "%'"
        UserQuery.Open DBstr, DBCnn, adOpenStatic, adLockOptimistic
    
    '按记录员ID查询
    Else
        If Me.TxtQueryRecID.Text = "" Then
            MsgBox "请输入要查询的记录员ID！"
            Exit Sub
        ElseIf Len(Trim(Me.TxtQueryRecID.Text)) > 16 Then
            MsgBox "记录员ID长度超出范围！"
            Exit Sub
        End If
        UsrID = Replace(Trim(Me.TxtQueryRecID.Text), "'", "''")
        
        '读用户资料
        DBstr = "select * from GuestInfo where GuestRecID Like"
        DBstr = DBstr & "'%" & UsrID & "%'"
        UserQuery.Open DBstr, DBCnn, adOpenStatic, adLockOptimistic
    
    End If
        
    '显示查询结果
    If UserQuery.EOF Then
        MsgBox "数据库中没有符合要求的记录！"
        Exit Sub
    End If
    
    Me.LvResult.ListItems.Clear '清空列表
    '数据集指针指向第一个记录
    UserQuery.MoveFirst
    For i = 1 To UserQuery.RecordCount
        Set LtItm = Me.LvResult.ListItems.Add()
            LtItm.Text = UserQuery.Fields("GuestName").Value
            LtItm.SubItems(1) = UserQuery.Fields("GuestSex").Value
            LtItm.SubItems(2) = UserQuery.Fields("GuestTime").Value
            LtItm.SubItems(3) = UserQuery.Fields("GuestReason").Value
            LtItm.SubItems(4) = UserQuery.Fields("GuestRecID").Value
            If UserQuery.Fields("Remark").Value <> "" Then
                LtItm.SubItems(5) = UserQuery.Fields("Remark").Value
            End If
        '数据集指针指向下一条记录
        UserQuery.MoveNext
    Next i
    '关闭数据集
    UserQuery.Close
    
    Me.FrameQuery.Visible = False
    Me.FrameResult.Visible = True
    
    '记录该操作
    AddRec (2)
    
End Sub

Private Sub CmdRecord_Click()   '添加新访客记录
Dim AddGuest As New ADODB.Recordset
Dim SqlStr As String
Dim GuestSex As String
Dim Remark As String
Dim sNow As String
Dim GuestName As String
Dim GuestReson As String
Dim UsrID As String

    '检查输入
    If Me.TextName.Text = "" Then
        MsgBox "请输入访客姓名！"
        Exit Sub
    ElseIf Len(Trim(Me.TextName.Text)) > 4 Then
        MsgBox "访客姓名长度超出范围！"
        Exit Sub
    ElseIf Me.TextReason.Text = "" Then
        MsgBox "请输入来访原因！"
        Exit Sub
    ElseIf Len(Me.TextReason.Text) > 50 Then
        MsgBox "来访原因过长！"
        Exit Sub
    End If
    GuestName = Replace(Trim(Me.TextName.Text), "'", "''")
    GuestReson = Replace(Trim(Me.TextReason.Text), "'", "''")
    UsrID = Replace(UserNow.ID, "'", "''")
    '访客信息入库
    If Option1.Value = True Then
        GuestSex = "男"
    Else
        GuestSex = "女"
    End If
    
    '备注项可选
    If Me.TextRemark.Text = vbNullString Then '没有备注项
        sNow = Format(Now, "yyyy-mm-dd hh:mm:ss")
        
        SqlStr = "INSERT INTO GuestInfo"
        SqlStr = SqlStr & "(GuestName,GuestSex,GuestTime,GuestReason,GuestRecID) "
        SqlStr = SqlStr & "VALUES ('" & GuestName & "',"
        SqlStr = SqlStr & "'" & GuestSex & "',"
        SqlStr = SqlStr & "#" & sNow & "#,"
        SqlStr = SqlStr & "'" & GuestReson & "',"
        SqlStr = SqlStr & "'" & UsrID & "');"
        DBCnn.Execute SqlStr
    
    Else    '有备注项
        Remark = Replace(Trim(Me.TextRemark.Text), "'", "''")
        sNow = Format(Now, "yyyy-mm-dd hh:mm:ss")
        
        SqlStr = "INSERT INTO GuestInfo"
        SqlStr = SqlStr & "(GuestName,GuestSex,GuestTime,GuestReason,GuestRecID,Remark) "
        SqlStr = SqlStr & "VALUES ('" & GuestName & "',"
        SqlStr = SqlStr & "'" & GuestSex & "',"
        SqlStr = SqlStr & "#" & sNow & "#,"
        SqlStr = SqlStr & "'" & GuestReson & "',"
        SqlStr = SqlStr & "'" & UsrID & "',"
        SqlStr = SqlStr & "'" & Remark & "');"
        DBCnn.Execute SqlStr
        
    End If
        
    '清空界面
    Me.TextName.Text = ""
    Me.TextReason.Text = ""
    Me.TextRemark.Text = ""
    
    '记录该操作
    AddRec (1)
    
    '提示用户
    MsgBox "添加记录成功！"
    
End Sub

Private Sub File_Exit_Click()   '退出
Dim MyExit As Integer
    MyExit = MsgBox("是否要退出程序？", vbYesNo, "退出")
    If MyExit = vbYes Then End
End Sub

Private Sub Form_Load()
Dim str As String

    '显示当前用户状态
    Select Case UserNow.Type
    Case 0
        str = "系统管理员"
    Case 1
        str = "普通用户"
    Case 2
        str = "高级用户"
    End Select
    Me.LblUser.Caption = "当前用户：" & UserNow.ID & "     用户类型：" & str
    
End Sub

Private Sub Form_Unload(Cancel As Integer)
    '关闭数据库连接
    DBCnn.Close
    
    '如果其他窗口没有关闭，则关闭其他窗口
    Unload Frm_User
    Unload Frm_OpeRec
    Unload Frm_About
    End
End Sub

Private Sub Hlp_About_Click()   '关于
    Frm_About.Show
End Sub

Private Sub Mng_Operate_Click() '操作记录
    If UserNow.Type <> 0 Then
        MsgBox "对不起，您不是系统管理员，不能查询用户！"
        Exit Sub
    End If
    
    Frm_OpeRec.Show
End Sub

Private Sub Mng_User_Click()    '人员管理
    Frm_User.Show
End Sub

Private Sub Ope_Query_Click()   '查询
    Me.FrameRecord.Visible = False
    Me.FrameQuery.Visible = True
    Me.DTPickerQuery.Value = Format(Now, "yyyy - mm - dd")
    Me.FrameResult.Visible = False
    '清空界面
    Me.TxtQueryName.Text = ""
    Me.TxtQueryRes.Text = ""
    Me.TxtQueryRecID.Text = ""
    
End Sub

Private Sub Ope_Record_Click()  '登记
    Me.FrameRecord.Visible = True
    Me.FrameQuery.Visible = False
    Me.FrameResult.Visible = False
End Sub

Private Sub Sys_new_Click()
Frm_Sysnew.Show
End Sub

'响应工具栏
Private Sub Toolbar1_ButtonClick(ByVal Button As MSComctlLib.Button)
    Select Case Button.Key
    '退出系统
    Case "Key_Exit"
        Call File_Exit_Click
    '访客登记
    Case "Key_Rec"
        Call Ope_Record_Click
    '访客查询
    Case "Key_Query"
        Call Ope_Query_Click
    '用户管理
    Case "Key_User"
        Call Mng_User_Click
    '操作记录
    Case "Key_Ope"
        Call Mng_Operate_Click
    '关于
    Case "Key_About"
        Call Hlp_About_Click
    End Select
End Sub