VB数据库编程报告——办公秘书系统

VB数据库编程报告——办公秘书系统 课程名称: 信息系统开发实习 实验项目: 办公秘书系统 专业班级: 软件0901 姓 名: XXX 学 号: 0912010XX 实验室号: 综合楼411 实验组号: 实验时间: 2011.12.21 批阅时间: 指导教师: XXX 成 绩: 1 沈阳工业大学 实验报告 化学实验报告单总流体力学实验报告观察种子结构实验报告观察种子结构实验报告单观察种子的结构实验报告单 (适用计算机程序设计类) 专业班级: 软件0901 学号: 0912010XX 姓名: XXX 实验名称:办公秘书系统 1.实验目的: (1)掌握ACCESS数据库的使用 (2)掌握Visual Basic 6.0 加ACCESS的编程方法 (3)掌握SQL结构化查询语言的运用 2.实验内容: (1)学习ACCESS数据库创建表、关系以及视图的方法。 (2)学习Visual Basic编程的基本方法。 (3)学习Visual Basic中各种控件的使用方法以及连接数据库的各种方法。 (4)学习SQL语言的语法规则以及在程序中的使用方法。 3. 实验方案(程序设计说明) 办公秘书系统主要是针对公司行政管理中存在的问题进行有效管理，可有效地提高公司的运作效益。 传统的行政管理工作可以说是千头万绪、纷繁复杂，工作人员面料着大量琐碎繁重的工作，因此该系统从企业实际需求出发，做到简单易用，系统界面友好美观，自定义功能强，权限管理可根据用户角色来设置，实施简单快速、操作简单明了。 办公秘书系统是一个非常具有代表性的管理企业内部事物的软件，系统由会议管理、办公管理、访客操作、辅助信息和系统管理模块组成。 ?会议管理模块 会议管理模块主要包括维护会议室信息、发送会议通知消息、记录会议内容、查询会议室信息和会议记录信息5个方面的内容。 ?办公管理模块 该模块主要由记事本、工作日志、 工作计划 幼儿园家访工作计划关于小学学校工作计划班级工作计划中职财务部门工作计划下载关于学校后勤工作计划 以及一周工作安排4部分组成。 ?访客操作模块 该模块可实现公司来访人员的登记与查询功能。 ?辅助信息 该模块主要包括国际电话代码和手机归属地查询功能。 ?系统管理模块 该模块包括查看日志、删除日志、用户管理、数据备份和数据恢复6个部分。 2 系统功能结构图: 一、系统设计目标: (1) 界面设计美观友好。 (2) 信息查询灵活、方便、快捷、准确。 (3) 采用模糊查询来查询数据。 (4) 操作员可以随时更改自己的口令。 (5) 对于用户输入的数据，系统进行严格的数据检验，尽可能排除人为的错误。 (6) 数据保密性强，为每个用户设置权限级别。 (7) 系统运行稳定可靠。 (8) 能够实现数据的备份与恢复，保证数据安全。 (9) 在修改信息时，系统自动生成日志。 二、数据库设计: 本系统数据库采用ACCESS 2003，系统数据库名称为Guest.mdb。数据库包含12张表。下面给 出部分数据表的逻辑结构。 (1) 工作计划数据表。 此表保存企业定制的工作计划信息。如下图所示。 3 (2) 会议记录数据表。 此表主要用于记录企业举行会议的详细信息。会议记录数据表的结构如图。 (3) 用户资料数据表。 此表主要用于记录操作员的各种资料。如图所示。 (4) 国际电话代码数据表。 此表记录了223个主要城市的电话代码以及时差。如图所示。 三、技术准备: 编程工具Viual Basic 6.0，此系统须多种ActiveX控件，因此需要提前添加“部件”。 所需部件:microsoft ADO Data Control 6.0 (SP4) Microsoft Common Dialog Control 6.0 (SP3) Microsoft DataGrid Control 6.0 (SP5) 4 Microsoft Hierarchical FlexGrid Control Microsoft Rich Textbox Control 6.0 (SP4) Microsoft Tabbed Dialog Control 6.0 (SP6) Microsoft Windows Common Controls 6.0 (SP6) Microsoft Windows Common Controls-2 6.0 (SP6) Microsoft Winsock Control 6.0 (SP6) 四、主要功能模块设计: (1)文件架构图: 主文件架构 文件与会议管理系统架构图 5 帮助与辅助信息架构图 办公管理与系统管理架构图 (2)公共模块设计 模块的作用是减少程序的代码量，提高应用程序代码的重用性和程序编码的可读性。在本系统中，将连接数据库的程序代码以及多个窗口用到的公共函数集中放置在一个数据模块mdl_pu- blic中，在应用程序需使用相关功能时调用该模块，从而完成相应任务。相关代码如下: '定义全局标量用于连接数据库 Public StrNum As Long '用于显示编号信息的变量 Public strtemp '用于显示编号信息的变量 Public StrIn '接收编号数值 Public PublicStr As String Public UserNow As UserType Public StrRs As String '保存查询字符串变量 Public StrCx As Integer '选择查询字符串变量 Public AdoRs As New ADODB.Recordset '后添加一个记录集对象 Public AdoRs1 As New ADODB.Recordset '后添加一个记录集对象 Public AdoRs2 As New ADODB.Recordset '后添加一个记录集对象 Public Declare Function CopyFile Lib "kernel32" Alias "CopyFileA" (ByVal lpExistingFileName As String, ByVal lpNewFileName As String, ByVal bFailIfExists As Long) As Long 6 '自定义用户类型 Type UserType ID As String '用户ID Type As Integer '用户类型 Name As String '用户姓名 End Type Public Function dbCnn() As ADODB.Connection '定义连接字符串函数 Set dbCnn = New ADODB.Connection dbCnn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & App.Path & "\mdb\Guest.mdb;Persist Security Info=False" End Function Public Sub main() PublicStr = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & App.Path & "\mdb\Guest.mdb;Persist Security Info=False" Frm_LogIn.Show End Sub '控制编号位数 Public Function Con_PublicNum() Select Case Len(Trim(StrNum)) '位数不足则补0 Case 1 strtemp = "000" Case 2 strtemp = "00" Case 3 strtemp = "0" Case 4 strtemp = "" End Select StrNum = StrNum + 1 StrIn = Trim(strtemp) & Trim(str(StrNum)) End Function '控制编号位数 Public Function Con_idNum() Select Case Len(Trim(StrNum)) '位数不足则补0 Case 1 strtemp = "00" Case 2 strtemp = "0" Case 3 strtemp = "" End Select StrNum = StrNum + 1 StrIn = Trim(strtemp) & Trim(str(StrNum)) 7 End Function '定义全局变量UserNow为UserType类型 '******************************************************************** '用户操作记录入库函数 AddRec '功能:将操作记录入库，以便查询。 '输入:操作类型RecType，Integer类型 ' 1,登记访客资料 2=查询访客资料 3=更改密码 ' 4=添加新用户 5=查看用户资料 6=查看操作记录 '输出:无 '******************************************************************** Public Sub AddRec(ByVal RecType As Integer) Dim AddUserRec As New ADODB.Recordset Dim DBstr As String Dim Unum As String DBstr = "select * from UserRecord order by UserNum" '打开数据集 AddUserRec.Open DBstr, dbCnn, adOpenKeyset '添加新记录 If AddUserRec.RecordCount > 0 Then AddUserRec.MoveLast StrNum = Mid(AddUserRec.Fields("UserNum"), 2, Len(AddUserRec.Fields("UserNum"))) Select Case Len(Trim(StrNum)) '位数不足则补0 Case 1 strtemp = "00" Case 2 strtemp = "0" Case 3 strtemp = "" End Select StrNum = StrNum + 1 StrIn = Trim(strtemp) & Trim(str(StrNum)) Unum = "L" & StrIn Else: Unum = "L001" End If AddUserRec.Close Set AddUserRec = dbCnn.Execute("insert into UserRecord values('" & Unum & " ','" & UserNow.ID & " ','" & Now & " ','" & RecType & " ',' ')") End Sub Public Function Tbr_cortrol(Tbr As Toolbar, Status As Boolean) '会议管理、办公管理模块中窗口的工具条按钮使用函数 With Tbr If Status = True Then .Buttons(1).Enabled = True 8 .Buttons(3).Enabled = True .Buttons(5).Enabled = True .Buttons(7).Enabled = False .Buttons(9).Enabled = True .Buttons(11).Enabled = True ElseIf Status = False Then .Buttons(1).Enabled = False .Buttons(3).Enabled = True .Buttons(5).Enabled = True .Buttons(7).Enabled = True .Buttons(9).Enabled = True .Buttons(11).Enabled = True End If End With End Function 4. 实验步骤或程序(经调试后正确的源程序) (见附件A) 5(程序运行结果 下面给出几项有代表性的程序功能测试。 (1) 登陆界面 9 (2) 进入主窗口 (3) 会议室查询，按座位数查询 10 (4) 会议室管理，添加名称为“daw2”的会议室 (5) 记事本功能，修改标题为“记事本测试1”的记事本。 11 (6) 一周工作安排，查询第一周工作安排。 (7) 国际电话代码查询，查询奥地利电话代码。 12 (8) 手机归属地查询 (9) 用户查询，查询用户名为”lijianwei”的用户的资料，头像成功显示。 13 (10) 数据备份 6(出现的问题及解决方法 (1)登陆窗口美化，实现鼠标移至控件之上，控件变色功能。 刚开始设计登陆窗口时，只是简单地画了几个控件，添加代码连接数据库，即完成了登陆的功能。后来想起QQ登陆窗口，非常美观，于是便上网查找控件颜色变化的方法，其原理并不复杂，就是利用鼠标移动到相应位置，图片自动更替的方法。 相关代码: Private Sub background_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) End Sub (2)实现网页式的导航栏菜单功能。 起初想使用TreeView控件，但并不十分美观，后来利用imagelist控件与pictureBox控件实 现了更为美观的网页式的导航栏菜单功能。效果如图: 14 相关代码: Private Sub lblMenu_Click(Index As Integer) strMenu = lblMenu(Index).Caption Dim M As Integer For i = 1 To Index picMenu(i).Top = picMenu(i - 1).Top + picMenu.Item(i - 1).Height Next i ListView1.Top = picMenu(i - 1).Top + picMenu.Item(i - 1).Height If Index < 6 Then picMenu(Index + 1).Top = ListView1.Top + ListView1.Height For i = Index + 2 To picMenu.Count - 1 picMenu(i).Top = picMenu.Item(i - 1).Top + picMenu.Item(i - 1).Height Next i Select Case Index Case 0 ListView1.ListItems.Clear ListView1.Enabled = True For i = 0 To M1.Count - 1 Key = "【" & M1.Item(i).Caption & "】" M = i + 1 Set itmX = ListView1.ListItems.Add(, , Key, M) Next i Case 1 ListView1.ListItems.Clear ListView1.Enabled = True For i = 0 To M2.Count - 1 Key = "【" & M2.Item(i).Caption & "】" M = i + M1.Count Set itmX = ListView1.ListItems.Add(, , Key, M) Next i Case 2 ListView1.ListItems.Clear ListView1.Enabled = True For i = 0 To M3.Count - 1 Key = "【" & M3.Item(i).Caption & "】" M = M1.Count + M2.Count + i Set itmX = ListView1.ListItems.Add(, , Key, M) Next i Case 3 ListView1.ListItems.Clear ListView1.Enabled = True For i = 0 To M4.Count - 1 Key = "【" & M4.Item(i).Caption & "】" M = M1.Count + M2.Count + M3.Count + i 15 Set itmX = ListView1.ListItems.Add(, , Key, M) Next i Case 4 ListView1.ListItems.Clear ListView1.Enabled = True For i = 0 To M5.Count - 1 Key = "【" & M5.Item(i).Caption & "】" M = M1.Count + M2.Count + M3.Count + M4.Count + i Set itmX = ListView1.ListItems.Add(, , Key, M) Next i Case 5 ListView1.ListItems.Clear ListView1.Enabled = True For i = 0 To M6.Count - 1 Key = "【" & M6.Item(i).Caption & "】" M = M1.Count + M2.Count + M3.Count + M4.Count + M5.Count + i Set itmX = ListView1.ListItems.Add(, , Key, M) Next i Case 6 ListView1.ListItems.Clear ListView1.Enabled = True For i = 0 To M7.Count - 1 Key = "【" & M7.Item(i).Caption & "】" M = M1.Count + M2.Count + M3.Count + M4.Count + M5.Count + M6.Count + i Set itmX = ListView1.ListItems.Add(, , Key, M) Next i End Select End Sub Private Sub ListView1_Click() Select Case strMenu Case "文件" M1_Click (ListView1.SelectedItem.Index - 1) Case "会议管理" M2_Click (ListView1.SelectedItem.Index - 1) Case "办公管理" M3_Click (ListView1.SelectedItem.Index - 1) Case "访客操作" M4_Click (ListView1.SelectedItem.Index - 1) Case "辅助信息" M5_Click (ListView1.SelectedItem.Index - 1) Case "系统管理" M6_Click (ListView1.SelectedItem.Index - 1) 16 Case "帮助" M7_Click (ListView1.SelectedItem.Index - 1) End Select End Sub (3) 更新数据库出现需求对象错误提示。 此现象是由于所更新项目数量与数据表中字段数量不一致造成，仔细检查即可解决。 (4) 更新数据库提示类型不符。 造成此错误的原因为所更新项目的数据类型与数据表中字段数据类型不一致。 (5) 利用StatusBar控件显示当前日期时间，时间无法显示。 首先，利用StatusBar控件显示系统时间，需添加Timer控件，第二，还要设置Timer控件的Interval属性，即周期，笔者设置为60，效果为显示到秒。 (6) 向Access数据库插入图片，并能在程序中读取的方法。 本程序对用户资料的管理有添加头像功能，开始时，仅仅将Access数据库中相关用户表的Photo字段设为OLE类型，效果是可以插入图片，但不能读取显示。上网搜索原因得知，Access 在图片前插入一些字符，这使程序不能识别图片。解决的办法是将图片转化为2进制码，插入到OLE字段中，读取时，程序再将2进制码转换为图片。相关代码如下。 插入图片: UsrPwd = Replace(Trim(Me.TextAddPwd1.Text), "'", "''") DBstr = "select * from UserInfo where UserID= '" & UsrID & "'" Set iStm = New ADODB.Stream With iStm .Type = adTypeBinary '二进制模式 .Open .LoadFromFile CommonDialog1.FileName End With '打开保存文件的表 With iRe .Open DBstr, dbCnn, adOpenForwardOnly, adLockOptimistic ' .Open "select * from student", iConc, 1, 3 .AddNew .Fields("UserID") = UsrID .Fields("UserName") = UsrName .Fields("UserPwd") = UsrPwd .Fields("UserType") = UsrType .Fields("photo") = iStm.Read .Update End With 读取图片: Set iRe = New ADODB.Recordset 17 Dim str2 As String str2 = "select * from UserInfo where UserID='" & str1 & "'" '得到最新添加的纪录 iRe.Open str2, iConc, adOpenKeyset, adLockReadOnly '保存到文件 Set iStm = New ADODB.Stream With iStm .Mode = adModeReadWrite .Type = adTypeBinary .Open .Write iRe("photo") '这里注意了,如果当前目录下存在test1.jpg,会报一个文件写入失败的错误. .SaveToFile App.Path & "\test1.jpg" End With Image1.Picture = LoadPicture(App.Path & "\test1.jpg") Kill App.Path & "\test1.jpg" 而这时，又出现一个问题，那就是用上面的方法，只能读取一张图片，因为读取其他图片依然保存为test1.jpg，会报错，于是我便想到了每次读取图片前，均进行一次对test1.jpg的删除操作。 (7) 对于ListView控件，如何实现选择的某行数据后进行相应操作的方法。 解决此问题用到了ListView的ListItems(LvQuery.SelectedItem.Index).Text属性，当鼠标选择某Item，将其Text值存在一个字符串中，然后对其进行某种操作。 (8) 编写数据恢复功能时，新数据库替换原数据库出错。 造成此问题的原因是，程序进行数据恢复操作时，与数据库的连接依然存在，数据库处于打开状态，系统无法对其执行替换操作。解决办法就是用API函数，可以在某文件打开时，使其被另外的文件替换。此函数声明为:Public Declare Function CopyFile Lib "kernel32" Alias "CopyFileA" (ByVal lpExistingFileName As String, ByVal lpNewFileName As String, ByVal bFailIfExists As Long) As Long 总之，在编写程序的过程中，总能遇到各式各样的问题，对于这些问题，我们不应该回避，应该迎难而上，想办法解决它们，每解决一个问题，都是能力的一次提高。 如今，互联网如此发达，更有很多编程论坛，我们编程过程中遇到的问题，大多比较普遍，别人也遇到过，有很多人会将问题发到网上，总是有完美解答的人，我们只需看懂这个 答案 八年级地理上册填图题岩土工程勘察试题省略号的作用及举例应急救援安全知识车间5s试题及答案 ，并对其作出修改以适应于我们的系统即可。 通过此次实践，我觉得编程最重要的就是要有一种自学的能力，课堂所学知识有限，实际操作中，往往会有“书到用书方恨少”的感觉，这时，就需要我们充分发挥自学能力，解决编程过程中遇到的各种问题。 18 附件A 沈阳工业大学实验报告 (适用计算机程序设计类) 专业班级: 软件0901 学号: 0912010XX 姓名: XXX 实验步骤或程序: Frm_LogIn(登陆窗口)源码 Option Explicit Private Sub Form_Load() Dim SqlStr As String '确定该程序没有被启动过 If App.PrevInstance Then MsgBox "您已经启动过了本程序!" End End If '连接数据库 ' SqlStr = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & App.Path & "\mdb\Guest.mdb;Persist Security Info=False" ' DBCnn.Open SqlStr End Sub Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer) '敲回车时相当于按 登录 Select Case KeyCode Case vbKeyReturn Call ImageLogIn_Click End Select End Sub Private Sub background_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) Image2 = Picture2 Image3 = Picture2 ImageLogIn = Picture2 ImageCancel = Picture2 ImageUser = Picture2 ImagePwd = Picture2 End Sub Private Sub ImageLogIn_Click() '登陆 Dim check As New ADODB.Recordset '定义Recordset对象 Dim DBstr As String Dim UsrID As String Dim UsrPwd As String '检验用户名和密码 '1.读出数据库中的记录 19 '2.找到输入的用户名 '3.比较输入的密码是否与数据库中的记录相符 If Len(Trim(Me.TextUser.Text)) <= 0 Then '没有输入用户名 MsgBox "请输入用户名～", , "登陆信息" Exit Sub End If If Len(Trim(Me.TextUser.Text)) > 16 Then '用户名过长 MsgBox "您输入用户名过长～", , "登陆信息" Exit Sub End If UsrID = Replace(Trim(Me.TextUser.Text), "'", "''") If Len(Trim(Me.TextPwd.Text)) <= 0 Then '没有输入密码 MsgBox "请输入密码～", , "登陆信息" Exit Sub End If If Len(Trim(Me.TextPwd.Text)) > 16 Then '密码过长 MsgBox "您输入密码过长～", , "登陆信息" Exit Sub End If UsrPwd = Trim(Me.TextPwd.Text) DBstr = "select * from UserInfo where UserID='" & UsrID & "'" '打开数据集 check.Open DBstr, dbCnn, adOpenStatic, adLockReadOnly, -1 UserNow.Name = check.Fields("Username").Value If check.RecordCount <= 0 Then '找不到该用户名 MsgBox "用户名不存在!" & vbCrLf & "请重新输入!", , "登陆信息" check.Close Exit Sub Else '数据集指针指向第一个记录，这里查找到的记录唯一 check.MoveFirst '检验密码 If TextPwd = check.Fields("UserPwd").Value Then UserNow.ID = Trim(Me.TextUser.Text) UserNow.Type = check.Fields("UserType").Value Else MsgBox "密码错误!", , "登陆信息" check.Close Exit Sub End If '关闭数据集 check.Close End If '用户名，密码都正确，进入主窗口 Unload Me Frm_Main.Show End Sub 20 Private Sub Image2_Click() '关闭 Unload Me End Sub Private Sub Image2_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) Image2 = Picture1 End Sub Private Sub Image3_Click() '最小化 Frm_LogIn.WindowState = 1 End Sub Private Sub Image3_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) Image3 = Picture3 End Sub Private Sub ImageCancel_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) ImageCancel = PictureCancel End Sub Private Sub ImageCancel_Click() Unload Me End Sub Private Sub ImageLogIn_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) ImageLogIn = PictureLogIn End Sub Private Sub ImageUser_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) ImageUser = PictureUser End Sub Private Sub ImagePwd_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) ImagePwd = PicturePwd End Sub Private Sub Label4_Click() End Sub Frm_main(主窗口)源码 Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hWnd As Long, ByVal lpOperation As String, ByVal lpFlie As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long Dim i, j As Integer Public strMenu As String Private Sub Form_Load() lblMenu_Click (0) StatusBar1.Panels.Item(3).Text = Format(Now, "yyyy年mm月dd日") StatusBar1.Panels.Item(2) = "当前用户:" & UserNow.ID & "" 21 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 lblMenu_Click(Index As Integer) strMenu = lblMenu(Index).Caption Dim M As Integer For i = 1 To Index picMenu(i).Top = picMenu(i - 1).Top + picMenu.Item(i - 1).Height Next i ListView1.Top = picMenu(i - 1).Top + picMenu.Item(i - 1).Height If Index < 6 Then picMenu(Index + 1).Top = ListView1.Top + ListView1.Height For i = Index + 2 To picMenu.Count - 1 picMenu(i).Top = picMenu.Item(i - 1).Top + picMenu.Item(i - 1).Height Next i Select Case Index Case 0 ListView1.ListItems.Clear ListView1.Enabled = True For i = 0 To M1.Count - 1 Key = "【" & M1.Item(i).Caption & "】" M = i + 1 Set itmX = ListView1.ListItems.Add(, , Key, M) Next i Case 1 ListView1.ListItems.Clear ListView1.Enabled = True For i = 0 To M2.Count - 1 Key = "【" & M2.Item(i).Caption & "】" M = i + M1.Count Set itmX = ListView1.ListItems.Add(, , Key, M) Next i Case 2 ListView1.ListItems.Clear ListView1.Enabled = True 22 For i = 0 To M3.Count - 1 Key = "【" & M3.Item(i).Caption & "】" M = M1.Count + M2.Count + i Set itmX = ListView1.ListItems.Add(, , Key, M) Next i Case 3 ListView1.ListItems.Clear ListView1.Enabled = True For i = 0 To M4.Count - 1 Key = "【" & M4.Item(i).Caption & "】" M = M1.Count + M2.Count + M3.Count + i Set itmX = ListView1.ListItems.Add(, , Key, M) Next i Case 4 ListView1.ListItems.Clear ListView1.Enabled = True For i = 0 To M5.Count - 1 Key = "【" & M5.Item(i).Caption & "】" M = M1.Count + M2.Count + M3.Count + M4.Count + i Set itmX = ListView1.ListItems.Add(, , Key, M) Next i Case 5 ListView1.ListItems.Clear ListView1.Enabled = True For i = 0 To M6.Count - 1 Key = "【" & M6.Item(i).Caption & "】" M = M1.Count + M2.Count + M3.Count + M4.Count + M5.Count + i Set itmX = ListView1.ListItems.Add(, , Key, M) Next i Case 6 ListView1.ListItems.Clear ListView1.Enabled = True For i = 0 To M7.Count - 1 Key = "【" & M7.Item(i).Caption & "】" M = M1.Count + M2.Count + M3.Count + M4.Count + M5.Count + M6.Count + i Set itmX = ListView1.ListItems.Add(, , Key, M) Next i End Select End Sub Private Sub ListView1_Click() Select Case strMenu Case "文件" M1_Click (ListView1.SelectedItem.Index - 1) Case "会议管理" 23 M2_Click (ListView1.SelectedItem.Index - 1) Case "办公管理" M3_Click (ListView1.SelectedItem.Index - 1) Case "访客操作" M4_Click (ListView1.SelectedItem.Index - 1) Case "辅助信息" M5_Click (ListView1.SelectedItem.Index - 1) Case "系统管理" M6_Click (ListView1.SelectedItem.Index - 1) Case "帮助" M7_Click (ListView1.SelectedItem.Index - 1) End Select End Sub Private Sub Meet_RecScan_Click() StrCx = 1 Frm_Scan.Show 1 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() FrmGuestScan.Show End Sub Private Sub Ope_Record_Click() FrmGuestRec.Show End Sub Private Sub M1_Click(Index As Integer) Select Case Index Case 0 Frm_LogIn.Show Case 1 Dim MyExit As Integer MyExit = MsgBox("是否要退出程序,", vbYesNo, "退出") If MyExit = vbYes Then End End Select End Sub Private Sub M2_Click(Index As Integer) 24 Select Case Index Case 0 frm_MeetRoom.Show Case 1 frm_MeetNtc.Show Case 2 frm_MeetRec.Show Case 3 StrCx = 2 Frm_Scan.Show Case 4 StrCx = 1 Frm_Scan.Show End Select End Sub Private Sub M3_Click(Index As Integer) Select Case Index Case 0 frm_Note.Show Case 1 frm_WkLog.Show Case 2 frm_WkPlan.Show Case 3 frm_WkArng.Show End Select End Sub Private Sub M4_Click(Index As Integer) Select Case Index Case 0 FrmGuestRec.Show Case 1 FrmGuestScan.Show End Select End Sub Private Sub M5_Click(Index As Integer) Select Case Index Case 0 frm_ItnlPhone.Show Case 1 frm_PhoneLct.Show End Select End Sub Private Sub M6_Click(Index As Integer) 25 Select Case Index Case 0 Frm_OpeRec.Show Case 1 frm_OpeDel.Show Case 2 Frm_User.Show Case 3 frm_backup.Show Case 4 frm_restore.Show End Select End Sub Private Sub M7_Click(Index As Integer) Select Case Index Case 0 Frm_About.Show End Select End Sub Private Sub Timer1_Timer() StatusBar1.Panels.Item(4).Text = Time End Sub frm_MeetRoom(会议室管理)源码(frm_MeetRec,frm_Note, frm_WkLog, frm_WkPlan窗口代码类似，不一一列举) Dim i As Integer Dim c Private Sub Dgr_Sjll_Click() On Error Resume Next If Adodc1.Recordset.RecordCount > 0 Then Text1(0).Text = Adodc1.Recordset.Fields("hys_id") Text1(1).Text = Adodc1.Recordset.Fields("hys_mc") Text1(2).Text = Adodc1.Recordset.Fields("hys_zws") Text1(3).Text = Adodc1.Recordset.Fields("hys_bz") Txt_Date.Text = Adodc1.Recordset.Fields("hys_xgrq") Txt_xgr.Text = Adodc1.Recordset.Fields("hys_xgr") End If For i = 0 To 3 Text1(i).Locked = False Next i End Sub Private Sub Form_Load() Call LoadFile Txt_xgr.Text = UserNow.Name Txt_xgr.Enabled = False 26 Txt_Date.Text = Data Txt_Date.Enabled = False For i = 1 To 3 Text1(i).Locked = True Next i Adodc1.ConnectionString = PublicStr Adodc1.RecordSource = "select * from 会议室管理 order by hys_id" Adodc1.Refresh Call DBGCon Call Tbr_cortrol(Tbr_xxcz, True) End Sub Private Sub Tbr_xxcz_ButtonClick(ByVal Button As MSComctlLib.Button) Select Case Button.Key Case "Add" Call Tbr_cortrol(Tbr_xxcz, False) For i = 0 To 3 Text1(i).Locked = False Text1(i).Text = "" Text1(0).SetFocus Next i AdoRs.Open "select * from 会议室管理 order by hys_id", dbCnn, adOpenKeyset If AdoRs.RecordCount > 0 Then AdoRs.MoveLast StrNum = Mid(AdoRs.Fields("hys_id"), 2, Len(AdoRs.Fields("hys_id"))) Call Con_idNum '调用位数转换函数 Text1(0).Text = "R" & StrIn Else Text1(0).Text = "R001" End If AdoRs.Close Case "Del" '删除信息 Call Deletes Call DBGCon Case "Edit" '修改信息 Call Edits Call DBGCon Case "Save" '保存信息 Call Saves Call DBGCon Case "Cancel" Call Tbr_cortrol(Tbr_xxcz, True) For i = 1 To 3 27 Text1(i).Text = "" Text1(1).SetFocus Next i Adodc1.RecordSource = "select * from 会议室管理 order by hys_id" Adodc1.Refresh Call DBGCon Case "Exit" Unload Me End Select End Sub Private Sub Text1_KeyDown(Index As Integer, KeyCode As Integer, Shift As Integer) On Error Resume Next If Index < 4 And KeyCode = 38 Then Text1(Index - 1).SetFocus If Index >= 0 And KeyCode = 40 Then Text1(Index + 1).SetFocus If Index >= 0 And KeyCode = 13 Then Text1(Index + 1).SetFocus If Index = 3 And KeyCode = 13 Then Call Saves End If End Sub Private Sub Saves() '保存信息的事件过程 If Text1(0).Text = "" Or Text1(1).Text = "" Then MsgBox "重要信息不能为空值", 48, "提示信息" Else If IsNumeric(Text1(2)) Then AdoRs.Open "select * from 会议室管理 where hys_mc='" + Text1(1).Text + "'", dbCnn, adOpenKeyset If AdoRs.RecordCount > 0 Then MsgBox "该信息已经存在", 48, "提示信息" AdoRs.Close Else AdoRs.Close c = MsgBox("确认保存信息吗", 33, "提示信息") If c = vbOK Then Set AdoRs = dbCnn.Execute("insert into 会议室管理 values('" & Text1(0) _ & "','" & Text1(1) & "','" & Text1(2) & "','" & Text1(3) & "',' ',' ')") MsgBox "数据保存成功", 64, "提示信息" Else End If Adodc1.RecordSource = "select * from 会议室管理 order by hys_id" Adodc1.Refresh Call DBGCon End If 28 Call Tbr_cortrol(Tbr_xxcz, True) Else MsgBox "输入的座位数值非法", 48, "提示信息" Text1(2).Text = "" Text1(2).SetFocus End If End If End Sub Private Sub Edits() '修改信息的事件过程 c = MsgBox("确认修改信息吗", 33, "提示信息") If c = vbOK Then Set AdoRs = dbCnn.Execute("UPDATE 会议室管理 SET hys_id='" + Text1(0) + "',hys_mc='" + Text1(1) + "',hys_zws='" + Text1(2) + "',hys_bz='" + Text1(3) + "',hys_xgrq='" + str(Date) + "',hys_xgr='" + UserNow.Name + "' where hys_id='" + Text1(0).Text + "'") MsgBox "数据修改成功", 64, "提示信息" Adodc1.RecordSource = "select * from 会议室管理 order by hys_id" Adodc1.Refresh Call DBGCon Else End If End Sub Private Sub LoadFile() AdoRs.Open "select * from 会议室管理", dbCnn, adOpenKeyset If AdoRs.RecordCount > 0 Then Text1(0).Text = AdoRs.Fields("hys_id") Text1(1).Text = AdoRs.Fields("hys_mc") Text1(2).Text = AdoRs.Fields("hys_zws") Text1(3).Text = AdoRs.Fields("hys_bz") Txt_Date.Text = AdoRs.Fields("hys_xgrq") Txt_xgr.Text = AdoRs.Fields("hys_xgr") End If AdoRs.Close End Sub Private Sub Deletes() '删除信息 c = MsgBox("确认删除该信息吗", 17, "提示信息") If c = vbOK Then Set AdoRs = dbCnn.Execute("Delete 会议室管理 from 会议室管理 where hys_id='" + Text1(0).Text + "'") Adodc1.Refresh End If For i = 0 To 3 Text1(i).Text = "" Next i 29 End Sub Private Sub DBGCon() Dgr_Sjll.Columns(0).Caption = "编号" Dgr_Sjll.Columns(1).Caption = "会议室名称" Dgr_Sjll.Columns(2).Caption = "座位数" Dgr_Sjll.Columns(3).Caption = "备注信息" Dgr_Sjll.Columns(4).Caption = "修改日期" Dgr_Sjll.Columns(5).Caption = "修改人" End Sub frm_MeetNtc(会议通知)重要部分源码 此处用CDONTS实现发送邮件功能，须计算机安装SMTP服务器。 Private Sub cmdSendMail_Click() Dim objMail as Object Set objMail=CreateObject( "CDFONTS.DLL ") ObjMail.Send "me@hotmail.net ", "abc@263.net ", "Title ", "Hello " Set objMail=nothing End Sub Frm_restore(数据恢复窗口)重要部分源码(数据备份类似) Me.MousePointer = 11 Cmd_Ok.Enabled = False If Txt_restore.Text = "" Then MsgBox "请您选择数据库恢复的路径!", 64, "提示信息" Else Dim connter As Integer Dim sql, workarea(12) As String mfile2 = App.Path & "\mdb\Guest.mdb" '恢复到此路径 mfile = CommonDialog2.FileName '要恢复文件的路径 ProgressBar2.Visible = True ProgressBar2.Max = UBound(workarea) ProgressBar2.Value = ProgressBar2.Min For connter = LBound(workarea) To UBound(workarea) workarea(connter) = "initial value" & connter ProgressBar2.Value = connter CopyFile mfile, mfile2, Not True Next connter ProgressBar2.Value = ProgressBar2.Min MsgBox "数据库恢复成功!!", 64, "提示信息" Cmd_Ok.Enabled = True Me.MousePointer = 0 End If 30 六、参考书 高春燕等，《Visual Basic数据库系统开发案例精选》，人民邮电出版社，2006。 李俊民等，《零基础学Viual Basic》，机械工业出版社，2009。 郭瑞军等，《Visual Basic数据库开发实例精粹》，电子工业出版社，2004。 31