员工管理系统设计与实现
2.4、数据流图
具有相应权限的用户在正确登陆后，可以打开并添加新员工的个人档案，添加完成后可以使用数据导出功能，导出数据。数据流图如下图2-1所示：
2.5、模块图
如图：
图2-2 系统功能模块图
第三章 数据库设计
3.1、概述
在数据库应用系统的开发过程中，数据库的结构设计是其中非常重要的一个环节。数据库结构设计的好坏将直接对应用系统的效率以及实现的效果产生影响。所以在尽量全面考虑用户的各种需求的前提下，进行了数据库设计。
3.2、数据库概念结构设计
数据库需求分析是数据库结构设计的第一个阶段，是非常重要的一个阶段。这个阶段主要是确定基本数据、数据结构以及数据处理的流程，组成一份详尽的数据字典，为以后进一步设计打好基础。
对一个数据管理员来说，设计良好的数据库应使之开始于一个合理的逻辑设计。概念模型是用户和数据库设计人员之间进行交流的工具
根据上面的设计规划的实体有：职工基本信息实体、工资项目设置信息实体、职工应发款信息实体、职工代扣款信息实体、职工工资信息实体。
3.3、数据库设计
数据库中共有18张表，如图3-1所示。其中分为12张主表,分别为：t_br（基本档案表）、t_login（操作员登录记录表）、系统用户（用户表）、AttendanceInfo（员工考勤信息表）、LeaveInfo(员工请假信息)、OvertimeInfo(员工加班信息) 、BasicSar（基本工资设定表）、kouchu（扣除）、timekaoqin（记时考勤）、salarysta（产品单价设定表）、salary（员工工资表）、YGZJS（月工资结算表）等详细信息如下。
图3-1 数据库表
各个实体具体的描述E-R图如下。基本档案表t_br E-R模型如图3-2所示，系统用户E-R模型如图3-3所示，员工考勤信息表 AttendanceInfo E-R模型如图3-4所示。
图3-2基本档案表E-R图
图3-3系统用户
图3-4员工考勤信息表 AttendanceInfo
1、职工基本档案表t_br，其结构如表3-1所示。保存员工的相关信息，是管理系统核心数据，所有其它的信息都是依附与这张表而存在的。以工号作为主关键字，尽量减少数据的冗余，保证数据的一致性。
表3-1 基本档案表 t_br
| 字段 |
类型 |
长度 |
必填字段 |
| 工号 |
文本 |
6 |
是 |
| 姓名 |
文本 |
10 |
是 |
| 性别 |
文本 |
10 |
是 |
| 部门 |
文本 |
10 |
是 |
| 薪金 |
数字 |
10 |
是 |
| 所学专业 |
文本 |
20 |
是 |
| 职务 |
文本 |
10 |
否 |
| 工资类别 |
数字 |
10 |
是 |
| 合同开始时间 |
日期/时间 |
是 |
|
| 合同终止时间 |
日期/时间 |
是 |
|
| 职工类型 |
文本 |
10 |
是 |
| 生日 |
日期/时间 |
否 |
|
| 工龄 |
数字 |
10 |
否 |
| 年龄 |
数字 |
3 |
是 |
| 文化程度 |
文本 |
10 |
否 |
| 民族 |
文本 |
10 |
否 |
| 政治面貌 |
文本 |
10 |
否 |
| 身份证号 |
文本 |
18 |
是 |
| 籍贯 |
文本 |
200 |
是 |
| 联系电话 |
数字 |
15 |
否 |
| 手机 |
数字 |
15 |
是 |
| 家庭住址 |
文本 |
200 |
是 |
| 健康状况 |
文本 |
10 |
是 |
| 照片 |
OLE 对象 |
否 |
2、员工考勤信息表，其结构如表3-2所示。保存员工考勤信息的相关信息。此表数据只保存员工的出勤情况，并不包括每日生产产量的考勤信息。
表3-2 员工考勤信息表 AttendanceInfo
| 字段 |
类型 |
长度 |
必填字段 |
| 工号 |
文本 |
6 |
是 |
| 姓名 |
文本 |
10 |
是 |
| 当前日期 |
文本 |
10 |
是 |
| 出入标志 |
文本 |
2 |
是 |
| 上班时间 |
日期/时间 |
是 |
|
| 下班时间 |
日期/时间 |
是 |
|
| 迟到次数 |
数字 |
10 |
否 |
| 早退次数 |
数字 |
10 |
否 |
3、LeaveInfo员工请假信息表，其结构如表3-3所示。用户所有请假信息保存在此表中。工资结算时根据记录进行扣除。
表3-3 员工请假信息表 LeaveInfo
| 字段 |
类型 |
长度 |
必填字段 |
| 工号 |
文本 |
5 |
是 |
| 姓名 |
文本 |
10 |
是 |
| 病假天数 |
数字 |
长整型 |
是 |
| 事假天数 |
数字 |
长整型 |
是 |
| 假期开始时间 |
日期/时间 |
是 |
4、员工加班信息表，结构如表3-4所示。为了方便系统的管理，员工加班信息同样也作为一个独立的表存储。
表3-4 员工加班信息表 OverTimeInfo
| 字段 |
类型 |
长度 |
必填字段 |
| 工号 |
文本 |
5 |
是 |
| 姓名 |
文本 |
10 |
是 |
| 特殊加班天数 |
数字 |
长整型 |
否 |
| 正常加班天数 |
数字 |
长整型 |
否 |
| 加班日期 |
日期/时间 |
是 |
5、员工工资表，结构如表3-5所示。该表即完成每日产品考勤，同时也保存由系统自动计算出的每天的员工工资，月底时只要汇总出这些每天的工资和即可。然后转存到其它表作进一步处理。
表3-5 员工工资表 salary
| 字段 |
类型 |
长度 |
必填字段 |
| ID |
自动编号 |
是 |
|
| 工号 |
文本 |
5 |
是 |
| 姓名 |
文本 |
10 |
是 |
| 工作日 |
日期/时间 |
是 |
|
| 产品类型一 文本 |
文本 |
否 |
|
| 产品类型二 |
文本 |
否 |
|
| 产品类型三 |
文本 |
否 |
|
| 数量一 |
数字 |
否 |
|
| 数量二 |
数字 |
否 |
|
| 数量三 |
数字 |
否 |
|
| 单价一 |
数字 |
否 |
|
| 单价二 |
数字 |
否 |
|
| 单价三 |
数字 |
否 |
|
| 每日汇总 |
数字 |
是 |
最后，设计数据库时，考虑数据库的安全性，防止非管理人员用第三方软件打开数据库，特对数据库文件也进行了处理，将数据库的扩展名mdb替换为ldl， 起到了一定的迷惑性。在改扩展名的同时也对数据库进行了加密。在用ACCESS数据库打开时要求输入打开密码，如图3-5所示。只有正确输入打开密码时才能打开数据库。为了方便记忆，本数据库的打开密码为：wlz。
图3-5 要求输入密码
第四章 各功能的实现
4.1、系统安全及权限的实现
为了确保系统的安全，对数据库进行加密处理，采用了用户和组管理，并记录用户登录信息。拥有高级权限的用户，可以创建不同的组，并可将全部或部分权限分配给创建用户。
为了实现该功能，系统采用了递归方式，使高一级别的用户可以管理低级用户，最高权限属于管理员。
具体描述如下:
4.2、登录窗口的实现
系统登陆时，要求正确输入用户名和密码。成功登陆后显示如图4-2所示工资管理系统主界面。用户名分为管理员用户和普通用户。如图4-1所示：
图4-1 登录窗口
实现功能的部分主要代码：
Private Sub Comok_Click()
On Error GoTo Dealerror
Dim strSql As String
Dim strMsg As String
'On Error GoTo Dealerror
Dim objCn As New Connection
strcn = CS()
objCn.ConnectionString = strcn
objCn.Open
Set objRs = New Recordset
Set objRs.ActiveConnection = objCn
objRs.CursorLocation = adUseClient
strSql = "SELECT * FROM 系统用户"
objRs.Open strSql
objRs.ActiveConnection = Nothing
objCn.Close
Set objCn = Nothing
If Logontimes >= 3 Then
MsgBox "你已经超过最大登陆次数！退出系统", vbOKOnly + vbCritical, "系统登录"
End
Else
objRs.MoveFirst
objRs.Find "用户名='" & txtUserName & "'"
If objRs.EOF Then
MsgBox "用户名错误！", vbOKOnly + vbCritical, "系统登录"
txtUserName.SetFocus
txtUserName.Text = ""
Else
If objRs!口令 <> txtPassword Then
MsgBox "密码错误!请重新输入!", vbOKOnly + vbCritical, "系统登录"
txtPassword.SetFocus
txtPassword.Text = ""
Else
'MsgBox "欢迎使用工资管理系统", vbOKCancel + vbOKOnly, "系统登录"
strusername = txtUserName
userpassword = txtPassword
If CmbStatus = "" Then
MsgBox "请选择登陆身份!", vbOKOnly + vbCritical, "系统登录"
CmbStatus.SetFocus
Else
If CmbStatus.ListIndex = 0 And objRs!admin = True Then
UserAdmin = 1
End If
If CmbStatus.ListIndex = 0 And objRs!admin = False Then
X = MsgBox("你不是管理员，将以普通用户登陆", vbOKCancel + vbOKOnly, "系统登录")
End If
If X = 2 Then
txtUserName.SetFocus
txtUserName.Text = ""
txtPassword.Text = ""
Else
'添加操作员登陆时间
strSql = "insert into t_login (用户,登录时间) values('" & txtUserName & "','" & Now & "')"
Set objRs = ExecuteSQL(strSql, strMsg)
Unload Me
MDIForm1.Show
End If
End If
End If
End If
End If
Logontimes = Logontimes + 1 '登陆次数
Exit Sub
Dealerror:
msg = "程序执行出错,错误信息如下:" & vbCrLf & Err.Description
ShowError msg
End Sub
Dim objRs As Recordset
Dim i As Integer
Dim Logontimes As Integer
Private Sub Comcancle_Click()
n = MsgBox("你选择了退出系统登陆,退出将不能启动管理系统!" & vbCrLf & "是否真的退出?", vbYesNo, "系统验证")
If n = vbYes Then
Unload Me
End If
End Sub
图4-2 工资管理系统主窗体
4.3、员工基本档案信息的实现
员工基本档案信息管理，在窗体中完成员工基本信息的录入工作。根据提示在该窗体中输入相应的信息，最后单击“保存”按钮，进行信息的保存。如图4-3所示
图4-3 员工基本档案信息录入窗口
相应部分代码如下：
'添加员工基本信息
Private Sub cmdOK_Click()
Dim rs As ADODB.Recordset
Dim strSql As String
Dim strMsg As String
Dim tmpPath As String
Dim iStm As ADODB.Stream
'如果是修改(保存照片--删除原记录--保存记录)
If blnChange = True Then
'如果不要删除
If blnDelPhoto = False Then
strSql = "select * from t_br where 工号='" & txtGH.Text & "'"
Set rs = ExecuteSQL(strSql, strMsg)
'保存到文件
tmpPath = App.path & "\temp.jpg"
If Not IsNull(rs.Fields("照片").Value) Then
Set iStm = New ADODB.Stream
With iStm
.Mode = adModeReadWrite
.Type = adTypeBinary
.Open
.Write rs.Fields("照片").Value
.SaveToFile tmpPath
blnDel = True
End With
strFileName = tmpPath
'pic.Picture = LoadPicture(tmpPath)
iStm.Close
Else
blnDel = False
End If
rs.Close
End If
'删除记录
strSql = "delete * from t_br where 工号='" & txtGH.Text & "'"
Set rs = ExecuteSQL(strSql, strMsg)
Else
strSql = "select * from t_br where 工号='" & txtGH.Text & "'"
Set rs = ExecuteSQL(strSql, strMsg)
If rs.EOF = False Then
MsgBox "已有相同的工号，无法添加到数据库！", vbOKOnly + vbExclamation, "警告"
TextFocus txtGH
Exit Sub
End If
rs.Close
End If
strSql = "select * from t_br"
Set rs = ExecuteSQL(strSql, strMsg)
rs.AddNew
rs.Fields("工号") = txtGH.Text
rs.Fields("姓名") = txtName.Text
If cboPayStyle.Text = "" Then
rs.Fields("工资类别") = Null
Else
rs.Fields("工资类别") = cboPayStyle.Text
End If
If cboHealthy.Text = "" Then
rs.Fields("健康状况") = Null
Else
rs.Fields("健康状况") = cboHealthy.Text
End If
If cboSex.Text = "" Then
rs.Fields("性别") = Null
Else
rs.Fields("性别") = cboSex.Text
End If
If cboEmployeeStyle.Text = "" Then
rs.Fields("职工类型") = Null
Else
rs.Fields("职工类型") = cboEmployeeStyle.Text
End If
If cboPart.Text = "" Then
rs.Fields("部门") = Null
Else
rs.Fields("部门") = cboPart.Text
End If
If cboDuty.Text = "" Then
rs.Fields("职务") = Null
Else
rs.Fields("职务") = cboDuty.Text
End If
If cboCulture.Text = "" Then
rs.Fields("文化程度") = Null
Else
rs.Fields("文化程度") = cboCulture.Text
End If
If cboNation.Text = "" Then
rs.Fields("民族") = Null
Else
rs.Fields("民族") = cboNation.Text
End If
'数字型
If txtMoney.Text = "" Then
rs.Fields("薪金") = 0
Else
rs.Fields("薪金") = txtMoney.Text
End If
If cboSpec.Text = "" Then
rs.Fields("所学专业") = Null
Else
rs.Fields("所学专业") = cboSpec.Text
End If
'年龄为数字型
If txtAge.Text = "" Then
rs.Fields("年龄") = 0
Else
rs.Fields("年龄") = txtAge.Text
End If
'日期型
rs.Fields("生日") = dtpBirthday.Value
If cboPolity.Text = "" Then
rs.Fields("政治面貌") = Null
Else
rs.Fields("政治面貌") = cboPolity.Text
End If
If cboMarry.Text = "" Then
rs.Fields("婚姻状况") = Null
Else
rs.Fields("婚姻状况") = cboMarry.Text
End If
If cboNativePlace.Text = "" Then
rs.Fields("籍贯") = Null
Else
rs.Fields("籍贯") = cboNativePlace.Text
End If
If txtHandset.Text = "" Then
rs.Fields("手机") = 0
Else
rs.Fields("手机") = txtHandset.Text
End If
If txtIdentity.Text = "" Then
rs.Fields("身份证号") = Null
Else
rs.Fields("身份证号") = txtIdentity.Text
End If
If txtTelphone.Text = "" Then
rs.Fields("联系电话") = Null
Else
rs.Fields("联系电话") = txtTelphone.Text
End If
If txtHomeAddress.Text = "" Then
rs.Fields("家庭住址") = Null
Else
rs.Fields("家庭住址") = txtHomeAddress.Text
End If
'日期型
rs.Fields("合同开始时间") = dtpBBargain.Value
rs.Fields("合同终止时间") = dtpEBargain.Value
If txtLong.Text = "" Then
rs.Fields("工龄") = 0
Else
rs.Fields("工龄") = txtLong.Text
End If
'添加照片
Set iStm = New ADODB.Stream
If Len(strFileName) > 0 Then
With iStm
.Type = adTypeBinary '二进制模式
.Open
.LoadFromFile strFileName
End With
rs.Fields("照片") = iStm.Read
rs.Update
iStm.Close
Else
rs.Update
End If
rs.Close
Set rs = Nothing
cmdDel.Enabled = True
Call DisabledControl
cmdNew.Enabled = True
MsgBox "添加成功"
If blnDel Then
If tmpPath <> "" Then
Kill tmpPath
End If
End If
Call RefreshGrid
End Sub
4.4、员工考勤信息的实现
4.4.1、设置员工上下班时间
在该窗体中输入相应的上下班信息，具体如图4-4所示，相应部分代码如下：
图4-4 设置上下班时间
Private Sub cmdOK_Click() '设置上下班时间
Dim sql As String
Dim rs As New ADODB.Recordset
Dim strMsg As String
sql = "delete * from TimeSetting"
Set rs = ExecuteSQL(sql, strMsg) ' 查找数据库，读取记录
If dtpBT.Value >= DTPicker1.Value Then ' 判断下班时间大于上班时间
MsgBox "请正确的输入时间", vbOKOnly + vbExclamation, "警告！"
Me.dtpBT.SetFocus '设置焦点
Exit Sub
End If
If dtpBT2.Value >= DTPicker2.Value Or dtpBT2.Value <= DTPicker1.Value Or dtpBT2.Value <= dtpBT.Value Then '判断下班时间大于上班时间
MsgBox "请正确的输入时间", vbOKOnly + vbExclamation, "警告！"
Me.dtpBT2.SetFocus '设置焦点
Exit Sub
End If
sql = "select * from TimeSetting"
Set rs = ExecuteSQL(sql, strMsg)
rs.AddNew
rs.Fields("上午上班时间") = CDate(dtpBT.Hour & ":" & dtpBT.Minute & ":" & dtpBT.Second)
rs.Fields("上午下班时间") = CDate(DTPicker1.Hour & ":" & DTPicker1.Minute & ":" & DTPicker1.Second)
rs.Fields("下午上班时间") = CDate(dtpBT2.Hour & ":" & dtpBT2.Minute & ":" & dtpBT2.Second)
rs.Fields("下午下班时间") = CDate(DTPicker2.Hour & ":" & DTPicker2.Minute & ":" & DTPicker2.Second)
rs.Update
rs.Close
MsgBox "时间已经设置", vbOKOnly + vbInformation, "设置结果！"
Unload Me
End Sub
Private Sub Form_Load()
Dim sql As String
Dim rs As New ADODB.Recordset
Dim strMsg As String
sql = "select * from TimeSetting"
Set rs = ExecuteSQL(sql, strMsg)
If rs.EOF Then Exit Sub
dtpBT.Value = rs.Fields("上午上班时间")
DTPicker1.Value = rs.Fields("上午下班时间")
dtpBT2.Value = rs.Fields("下午上班时间")
DTPicker2.Value = rs.Fields("下午下班时间")
End Sub
4.4.2、添加员工考勤信息
1、添加上下班信息
窗体如图4-5所示，填入相应的信息，部分代码如下：
图4-5 添加员工考勤信息
添加上下班信息
Private Sub cmdOK_Click()
Dim sql As String
Dim sql2 As String
Dim rs As New ADODB.Recordset
Dim strMsg As String
Dim strmsg2 As String
Dim rsTime As New ADODB.Recordset
Dim tmsetswsb, tmsetswxb, tmsetxwsb, tmsetxwxb As Date
Dim tmsb1, tmxb1 As Date
sql = "select * from AttendanceInfo order by ID desc"
sql2 = "select * from TimeSetting"
Set rs = ExecuteSQL(sql, strMsg)
Set rsTime = ExecuteSQL(sql2, strmsg2)
If InFlag = False And OutFlag = False Then
MsgBox "请选择上下班", vbOKOnly + vbExclamation, "警告!"
End If
'添加上班信息
If InFlag = True Then
If txtID.Text = "" Or txtName.Text = "" Then
MsgBox "要添加上班信息,员工编号与姓名不能为空,请输入", vbOKOnly, "提示"
Exit Sub
End If
'判断上下午上班时间是否迟到
tmsb1 = dtpBT.Value
h = Hour(tmsb1)
m = Minute(tmsb1)
s = Second(tmsb1)
tmsb1 = CDate(h & ":" & m & ":" & s)
tmsetswsb = CDate(rsTime.Fields("上午上班时间"))
tmsetswxb = CDate(rsTime.Fields("上午下班时间"))
tmsetxwsb = CDate(rsTime.Fields("下午上班时间"))
'判断上午上班时间是否迟到
If tmsb1 < tmsetswxb Then
If tmsb1 > tmsetswsb Then
ilate = 1
MsgBox "迟到"
Else
ilate = 0
MsgBox "正常上班"
End If
'判断下午上班时间是否迟到
Else
If tmsb1 > tmsetxwsb Then
ilate = 1
MsgBox "迟到"
Else
ilate = 0
MsgBox "正常上班"
End If
End If
aflag = "入"
rs.AddNew
rs.Fields("工号") = txtID.Text
rs.Fields("姓名") = txtName.Text
rs.Fields("当前日期") = dtpET.Value
rs.Fields("上班时间") = dtpBT.Hour & ":" & dtpBT.Minute & ":" & dtpBT.Second
rs.Fields("出入标志") = aflag
rs.Fields("迟到次数") = ilate
rs.Update
rs.Close
MsgBox "已完成添加上班信息", vbOKOnly + vbInformation, "添加结果！"
Unload Me
Exit Sub
End If
'添加下班信息
If OutFlag = True Then
If txtID.Text = "" Or txtName.Text = "" Then
MsgBox "要添加下班信息,员工编号与姓名不能为空,请输入", vbOKOnly + vbExclamation, "警告"
Exit Sub
End If
'判断上下午下班时间是否早退
tmxb1 = DTPicker1.Value
h = Hour(tmxb1)
m = Minute(tmxb1)
s = Second(tmxb1)
tmxb1 = CDate(h & ":" & m & ":" & s)
tmsetxwsb = CDate(rsTime.Fields("下午上班时间"))
tmsetswxb = CDate(rsTime.Fields("上午下班时间"))
tmsetxwxb = CDate(rsTime.Fields("下午下班时间"))
'判断上午下班时间
If tmxb1 < tmsetxwsb Then
If tmxb1 < tmsetswxb Then
iearly = 1
MsgBox "早退"
Else
iearly = 0
MsgBox "正常下班"
End If
'判断下午下班时间
Else
If tmxb1 < tmsetxwxb Then
iearly = 1
MsgBox "早退"
Else
iearly = 0
MsgBox "正常下班"
End If
End If
aflag = "出"
rs.AddNew
rs.Fields("工号") = txtID.Text
rs.Fields("姓名") = txtName.Text
rs.Fields("当前日期") = dtpET.Value
rs.Fields("下班时间") = DTPicker1.Hour & ":" & DTPicker1.Minute & ":" & DTPicker1.Second
rs.Fields("出入标志") = aflag
rs.Fields("早退次数") = iearly
rs.Update
rs.Close
MsgBox "已完成添加下班信息", vbOKOnly + vbInformation, "添加结果！"
Unload Me
Exit Sub
End If
End Sub
Private Sub Form_Load()
dtpET.Value = Date '初始化为当天时间
End Sub
2、设置员工每日产量考勤
在该窗体中输入相应的信息，完成每日产量考勤具体如图4-6所示，相应部分代码如下：
图4-6 员工每日产量考勤
“保存”按钮代码如下：
Private Sub cmdOK_Click()
Dim rs As ADODB.Recordset
Dim strSql As String
Dim strMsg As String
'根据需要进行字段限制
If ChkBoxJJ.Value = True Then
If Combo1.Text = "" Then
MsgBox "产品类型不能为空"
TextFocus Combo1
Exit Sub
End If
If ChkBoxCP.Value = True Then
If Combo2.Text = "" Then
MsgBox "产品类型二不能为空"
TextFocus Combo2
Exit Sub
End If
If Txt3.Text = 0 Then
MsgBox "数量不能为空"
TextFocus Txt3
Exit Sub
End If
End If
If ChkBoxCR.Value = True Then
If Combo3.Text = "" Then
MsgBox "产品类型三不能为空"
TextFocus Combo3
Exit Sub
End If
If Txt5.Text = 0 Then
MsgBox "数量不能为空"
TextFocus Txt5
Exit Sub
End If
End If
End If
strSql = "select * from checkinfo where 工号='" & txtGH1 & "'"
Set rs = ExecuteSQL(strSql, strMsg)
If rs.EOF = False Then
MsgBox "已有相同的记录，无法添加到数据库！", vbOKOnly + vbExclamation, "警告"
TextFocus txtGH1
rs.Close
If ChkBoxJJ.Value = True Then
strSql = "select * from salary"
Set rs = ExecuteSQL(strSql, strMsg)
rs.AddNew
rs.Fields("工号") = txtGH1.Text
rs.Fields("姓名") = txtName.Text
rs.Fields("工作日") = dtpBirthday.Value
rs.Fields("产品类型一") = Combo1.Text
rs.Fields("产品类型二") = Combo2.Text
rs.Fields("产品类型三") = Combo3.Text
If Txt1.Text = "" Then
rs.Fields("数量一") = 0
Else
rs.Fields("数量一") = Txt1.Text
End If
If Txt3.Text = "" Then
rs.Fields("数量二") = 0
Else
rs.Fields("数量二") = Txt3.Text
End If
If Txt5.Text = "" Then
rs.Fields("数量三") = 0
Else
rs.Fields("数量三") = Txt5.Text
End If
If txt2.Text = "" Then
rs.Fields("单价一") = 0
Else
rs.Fields("单价一") = txt2.Text
End If
If txt4.Text = "" Then
rs.Fields("单价二") = 0
Else
rs.Fields("单价二") = txt4.Text
End If
If txt6.Text = "" Then
rs.Fields("单价三") = 0
Else
rs.Fields("单价三") = txt6.Text
End If
rs.Fields("每日汇总") = Txt7.Text
rs.Update
rs.Close
Set rs = Nothing
End If
If ChkBoxJS.Value = True Then
strSql = "select * from timekaoqin"
Set rs = ExecuteSQL(strSql, strMsg)
rs.AddNew
rs.Fields("工号") = txtGH1.Text
rs.Fields("工作日") = dtpBirthday.Value
rs.Fields("上班时间") = dtpBT(0).Value
rs.Fields("下班时间") = DTPicker1(0).Value
rs.Fields("PM上班时间") = dtpBT(1).Value
rs.Fields("PM下班时间") = DTPicker1(1).Value
rs.Fields("单价") = MoTxt.Text
rs.Fields("工作小时数") = Timetxt6.Text
rs.Fields("加班时间") = Combo4.Text
rs.Fields("加班单价") = Text12.Text
rs.Fields("记时汇总") = MoTxt8.Text
rs.Update
rs.Close
Set rs = Nothing
End If
If ChkBoxJJ.Value = True Or ChkBoxJS.Value = True Then
MsgBox "添加成功"
Else
MsgBox "添加失败"
same = 2: same2 = 4
End If
If same = 2 And same2 = 4 Then
Exit Sub
Else
strSql = "select * from checkinfo "
Set rs = ExecuteSQL(strSql, strMsg)
rs.AddNew
rs.Fields("工号") = txtGH1.Text
rs.Fields("工作日") = dtpBirthday.Value
rs.Update
End If
'Call RefreshGrid
End If
End Sub
4.5、员工月工资结算、产量汇总、综合处理
在该窗体中输入相应的信息，完成月工资结算、产量汇总、综合处理具体如图4-7所示，相应部分代码如下：
图4-7 月工资结算、产量汇总、综合处理
相应部分代码如下：
Dim strSql As String
Dim strMsg As String
Dim rs As ADODB.Recordset
Dim dj1 As Integer
Dim dj2 As Integer
Dim dj3 As Integer
'记件统计
strSql = "select * from salary where 工号='" & gh & "'"
Set rs = ExecuteSQL(strSql, strMsg)
If rs.EOF = False Then
TextNO.Text = rs.Fields("工号").Value
TextNAMe.Text = rs.Fields("姓名").Value
Combod.Value = rs.Fields("工作日").Value
Textlx(0).Text = rs.Fields("产品类型一").Value
dj1 = rs.Fields("单价一").Value
dj2 = rs.Fields("单价二").Value
dj3 = rs.Fields("单价三").Value
Textlx(1).Text = rs.Fields("产品类型二").Value
Textlx(2).Text = rs.Fields("产品类型三").Value
rs.Close
strSql = "select sum(数量一) as 数量一,sum(数量二) as 数量二,sum(数量三) as 数量三,sum(每日汇总) as 每日汇总 from salary group by 工号='" & gh & "' "
Set rs = ExecuteSQL(strSql, strMsg)
Textsl(0).Text = rs.Fields("数量一").Value
Textsl(1).Text = rs.Fields("数量二").Value
Textsl(2).Text = rs.Fields("数量三").Value
Textzj(0).Text = Val(Textsl(0).Text) * dj1
Textzj(1).Text = Val(Textsl(1).Text) * dj2
Textzj(2).Text = Val(Textsl(2).Text) * dj3
Txtgj.Text = Val(Textzj(0).Text) + Val(Textzj(1).Text) + Val(Textzj(2).Text)
'奖金 福利结算
rs.Close
strSql = "select * from Sar_other where 工号='" & TextNO & "'"
Set rs = ExecuteSQL(strSql, strMsg)
Text(0).Text = rs.Fields("奖金").Value
Text(1).Text = rs.Fields("津贴").Value
Text(2).Text = rs.Fields("福利").Value
Text(3).Text = rs.Fields("其他项目").Value
'扣除
rs.Close
strSql = "select * from kouchu where 工号='" & TextNO & "'"
Set rs = ExecuteSQL(strSql, strMsg)
Tet(0).Text = rs.Fields("住宿费")
Tet(1).Text = rs.Fields("火食费")
Tet(2).Text = rs.Fields("公基金")
Tet(3).Text = rs.Fields("垃圾处理费")
Tet(4).Text = rs.Fields("医疗保险费")
Tet(5).Text = rs.Fields("其它")
Else
MsgBox "数据库还没有此工号的工资记录", vbOKOnly + vbExclamation, "提示"
ChkBoxJJ.Value = False
ChkBoxCP.Value = False
ChkBoxCR.Value = False
ChkBoxJS.Value = False
Exit Sub
End If
'记时统计
rs.Close
strSql = "select sum(加班时间) as 加班总时间,sum(工作小时数) as 工作小时数,sum(记时汇总) as 记时汇总 from timekaoqin group by 工号='" & gh & "' "
Set rs = ExecuteSQL(strSql, strMsg)
Txt(0).Text = rs.Fields("工作小时数").Value
Txt(2).Text = rs.Fields("加班总时间").Value
Textgj.Text = rs.Fields("记时汇总").Value
strSql = "select 单价,加班单价 from timekaoqin where 工号='" & gh & "'"
Set rs = ExecuteSQL(strSql, strMsg)
Txt(1).Text = rs.Fields("单价").Value
Txt(3).Text = rs.Fields("加班单价").Value
Text5.Text = Val(Txtgj.Text) + Val(Textgj.Text) + Val(Text(0).Text) _
+ Val(Text(1).Text) + Val(Text(2).Text) + Val(Text(3).Text)
Text3.Text = Val(Txtgj.Text) - Val(Tet(0).Text) - Val(Tet(1).Text) _
- Val(Tet(2).Text) - Val(Tet(3).Text) - Val(Tet(4).Text) - Val(Tet(5).Text)
End Sub
4.6、系统工具－聊天室的实现
本系统为了给企业提供一个更好的、方便的服务，有效而快速的进行网内各部门之间的通信，更好的协同工作，特增加了系统内部的聊天模块。详见图4-8、图4-9所示
图4-8 服务器端 图4-9 客户端
服务器端相应代码：
Const maxn = 200 '最大同时连接本机的客户数
Dim user(maxn) As Boolean
Private Sub Command1_Click()
Form2.Hide
End Sub
Private Sub Command2_Click()
Load Form1
Form1.Show
End Sub
Private Sub Form_Load()
Dim str1 As String
nowuser = 0
Form2.Caption = "管理系统通信软件"
'注释：winsock控件 a 作为服务器程序监听
a.LocalPort = 3000
a.Listen
End Sub
Private Sub a_ConnectionRequest(ByVal requestID As Long)
Dim i As Long
For i = 1 To maxn '当一客户请求时给启动一Winsock控件标志号
If Not user(i) Then
user(i) = True
Exit For
End If
Next i
If i > maxn Then
Exit Sub
End If
Load b(i) '当一客户请求时启动一Winsock控件
b(i).Accept requestID '注释：实际建立连接
If Text1.Text = "" Then '注释: 发送数据
b(i).SendData Chr(0)
Else
b(i).SendData Text1.Text
End If
Form2.Show
End Sub
Private Sub s_Close(Index As Integer)
b(Index).Close ' 注释: 关闭连接
Unload b(Index) '注释：卸载 一个WinSock 控件
user(Index) = False
End Sub
Private Sub b_DataArrival(Index As Integer, ByVal bytesTotal As Long)
Dim str As String
Dim i As Long
Dim n As Integer
On Error Resume Next '忽略已断开的主机
b(Index).GetData str
Text1.Text = Text1.Text + str
For i = 1 To maxn
If user(i) Then
b(i).SendData str
End If
Next i
End Sub
4.7、系统测试
性能测试与分析
这个阶段的关键任务是通过各种类型的测试及相应的调试，使软件达到预定的的要求，根据分工本人负责整个程序运行以及整个程序调试。
1、测试环境
测试环境为：
操作系统：Windows2000及以上
数据库系统：Access2000。
2、系统测试需求分析
科技成果管理系统作为信息管理系统应用程序，应具有设计文件所规定的功能，各个功能模块都能完成相应的任务，保证用户所输入数据的正确性和安全性。程序设计及相关功能是否符合要求，只有通过严密的测试才能发现问题，尽可能减少错误的发生。所以，必须对系统进行测试，达到纠错改错的目的。
测试方法
软件测试主要分静态和动态分析方法，动态法有白盒和黑盒法，本系统主要采用黑盒法进行测试对程序功能进行测试。
3、系统测试策略说明
4、系统测试方案设计
功能测试采用黑盒测试法，数据设计如下：测试报告见
系统管理模块测试用例：
4.1.1设置操作员、密码、权限 设计测试用例，如表（表4.1.1）：
表4.1.1
| 操作员编号 |
操作员姓名 |
操作员类别 |
用户密码 |
| 01 |
wlz |
系统管理员 |
wlz |
| 02 |
wanglingzhing |
普通用户 |
wlz |
4.1.2设置快捷键用户和登陆密码－测试用例设计如下表
| 第一次测试用例（设计两组相同数据） |
第二次测试用例（两次密码输入不同） |
||||
| 用户名 |
用户密码 |
确认密码 |
用户名 |
用户密码 |
确认密码 |
| 1 |
1 |
1 |
111 |
111 |
11 |
| 第一次输入与预期结果一致、第二次不一致 |
与预期结果不一致 |
||||
此次毕业设计，不尽巩固了所学知识, 而且在这基础上也提高了自己，使我明白需求分析、合理设计数据库，编写代码对软件设计的好坏起了非常重要的作用。由于本身能力的局限性，所以做编写的代码，即使经过反复检查也难免出错所以在本阶段力求使用有限的时间找出尽可能多的错误，力求系统尽量正确。我们在本系统的测试中使用了黑盒法（即不关心程序内部的逻辑结构，而是根据程序的功能来设计是检测）请一位不熟悉本系统的人来进行随意性的操作，打破习惯的操作顺序，从中发现错误，在此阶段系统的大量错误得到了改正。
致 谢
本系统能够顺利完成，非常感谢唐昊老师和周雷老师的精心指导，同时也很感谢二年来各位老师对我的栽培。对于本人来说，这次的毕业设计，是对自己在这二年学习的一个检验和平时学习的一种积累。从中也使我学到了不少东西。希望以后有足够的时间更深入的了解，做好需求分析，为使自己能设计出更好的软件。
参考文献
附 录
添加用户窗体代码如下：
Private Sub cmdCancel_Click()
Unload Me
Exit Sub
End Sub
Private Sub cmdOK_Click()
Dim sql As String
Dim rs As ADODB.Recordset
If Trim(username.Text) = "" Then
MsgBox "请输入用户名称", vbOKOnly + vbExclamation, "警告"
'Exit Sub
username.SetFocus
Else
sql = "select * from 系统用户 where 用户名='" & username & "'"
Set re = getrs(sql, "gzgl")
If re.EOF = False Then
MsgBox "这个用户已经存在，请重新输入用户名", vbOKOnly + vbExclamation, "警告"
username.SetFocus
username.Text = ""
password.Text = ""
confirmpwd.Text = ""
Exit Sub
Else
If Trim(password.Text) <> Trim(confirmpwd.Text) Then
MsgBox "两次输入密码不一致，请重新输入密码", vbOKOnly + vbExclamation, "警告"
password.Text = ""
confirmpwd.Text = ""
password.SetFocus
Exit Sub
ElseIf Trim(password.Text) = "" Then
MsgBox "密码不能为空", vbOKOnly + vbExclamation, "警告"
password.Text = ""
confirmpwd = ""
password.SetFocus
Else
If AdminCheck = False Then
sql = "insert into 系统用户 (用户名,口令) values('" & username
sql = sql & "','" & password & "')"
Call transactsql(sql, "gzgl")
Else
sql = "insert into 系统用户 (用户名,口令,admin) values('" & username
sql = sql & "','" & password
sql = sql & "','" & UserAdmin & "')"
End If
Call transactsql(sql, "gzgl")
MsgBox "添加成功", vbOKOnly + vbExclamation, "添加结果"
username.Text = ""
password.Text = ""
confirmpwd.Text = ""
username.SetFocus
If Check1 = False Then
Unload Me
End If
End If
End If
End If
End Sub
Private Sub Form_Load()
Me.Left = ReadIni("添加用户", "left")
Me.Top = ReadIni("添加用户", "top")
End Sub
Private Sub Form_Unload(Cancel As Integer)
Call WriteIni("添加用户", "left", Me.Left)
Call WriteIni("添加用户", "top", Me.Top)
End Sub
修改密码窗体代码如下：
Private Sub cmdCancel_Click()
Unload Me
Exit Sub
End Sub
Private Sub cmdOK_Click()
Dim sql As String
Dim rs As ADODB.Recordset
If Trim(oldpwd.Text) = "" Then
MsgBox "请输入旧密码", vbOKOnly + vbExclamation, "提示"
oldpwd.SetFocus
Exit Sub
Else
If Trim(oldpwd.Text) <> Trim(userpassword) Then
MsgBox "旧密码与登录的密码不同，请重新输入！", vbOKOnly + vbExclamation, "提示"
oldpwd.Text = ""
oldpwd.SetFocus
ElseIf Trim(newpwd.Text) = "" Then
MsgBox "请输入新密码", vbOKOnly + vbExclamation, "提示"
newpwd.SetFocus
Exit Sub
ElseIf Trim(newpwd.Text) <> Trim(confirmpwd.Text) Then
MsgBox "两次密码不同", vbOKOnly + vbExclamation, "警告"
newpwd.Text = ""
confirmpwd.Text = ""
newpwd.SetFocus
Else
userpassword = newpwd
sql = "update 系统用户 set 口令='" & newpwd & "'where 用户名='" & strusername & "'"
Call transactsql(sql, "gzgl")
MsgBox "密码已经修改", vbOKOnly + vbExclamation, "修改结果"
Unload Me
End If
End If
End Sub
Private Sub Form_Load()
Me.Left = ReadIni("修改密码", "left")
Me.Top = ReadIni("修改密码", "top")
End Sub
Private Sub Form_Unload(Cancel As Integer)
Call WriteIni("修改密码", "left", Me.Left)
Call WriteIni("修改密码", "top", Me.Top)
End Sub
数据导出：
Dim outType As Integer '导出类型
Dim outPath As String
Dim outSql As String
Private Function outToExcel(ByVal strSql As String, ByVal WorksheeName As String, path As String) As Boolean
On Error GoTo err_outToExcel
'声明excel
Dim objExcel As Excel.Application
Dim objWorkbook As Workbook
Dim objWorksheet As Worksheet
Set objExcel = CreateObject("Excel.Application")
Set objWorkbook = objExcel.Workbooks.Add
Set objWorksheet = objWorkbook.Worksheets("sheet1")
objWorksheet.Name = WorksheeName
'声明adodb
Dim rs As ADODB.Recordset
Dim strMsg As String
Set rs = ExecuteSQL(strSql, strMsg)
i = 1
rs.MoveFirst
Do While Not rs.EOF
For j = 1 To rs.Fields.Count
objExcel.Cells(i, j) = rs.Fields(j - 1)
Next
i = i + 1
rs.MoveNext
Loop
objWorkbook.SaveAs path
objWorkbook.Close
objExcel.Quit
Set objWorksheet = Nothing
Set objWorkbook = Nothing
Set objExcel = Nothing
outToExcel = True
Exit Function
'错误处理
err_outToExcel:
MsgBox Err.Description
On Error Resume Next
objWorkbook.Close
objExcel.Quit
Set objWorksheet = Nothing
Set objWorkbook = Nothing
Set objExcel = Nothing
outToExcel = False
End Function
Private Sub cmdOut_Click()
Select Case outType
Case 1 '导出到Excel
If outToExcel(outSql, "s1", outPath) = True Then
MsgBox "导出成功"
Else
MsgBox "导出失败"
End If
Case 2
If outToWord(outSql, outPath) = True Then
MsgBox "导出成功"
Else
MsgBox "导出失败"
End If
Case 3
If outToText(outSql, outPath) = True Then
MsgBox "导出成功"
Else
MsgBox "导出失败"
End If
End Select
End Sub
Private Sub cmdPath_Click()
Select Case outType
Case 1
cdgPath.Filter = "Excel文件(*.xls)|*.xls"
Case 2
cdgPath.Filter = "Word文件(*.doc)|*.doc"
Case 3
cdgPath.Filter = "记事本(*.txt)|*.txt"
End Select
cdgPath.ShowSave
txtPath.Text = cdgPath.FileName
End Sub
Private Sub cmdPre_Click()
SSTab1.Tab = 1
End Sub
Private Sub cmdSelNext_Click()
If optExcel.Value = True Then
outType = 1
txtMessage.Text = "导出到Excel" & vbCrLf
txtPath = App.path & "\DBBackup\1.xls"
ElseIf optWord.Value = True Then
txtMessage.Text = "导出到Word" & vbCrLf
outType = 2
txtPath = App.path & "\DBBackup\1.doc"
Else
txtMessage.Text = "导出到记事本" & vbCrLf
outType = 3
txtPath = App.path & "\DBBackup\1.txt"
End If
txtSql = "select 工号,姓名,性别,薪金,所学专业,职务,工资类别,合同开始时间,合同终止时间,职工类型,工龄,生日,年龄,文化程度,民族,婚姻状况,政治面貌,身份证号,籍贯,联系电话,手机,家庭住址,健康状况 from t_br"
SSTab1.Tab = 1
End Sub
Private Sub cmdSetNext_Click()
txtMessage.Text = ""
If optExcel.Value = True Then
txtMessage.Text = "导出到Excel" & vbCrLf
ElseIf optWord.Value = True Then
txtMessage.Text = "导出到Word" & vbCrLf
Else
txtMessage.Text = "导出到记事本" & vbCrLf
End If
outPath = Trim(txtPath.Text)
outSql = txtSql.Text
txtMessage.Text = txtMessage.Text & vbCrLf & "导出路径为：" & outPath
txtMessage.Text = txtMessage.Text & vbCrLf & "查询语句为：" & outSql
SSTab1.Tab = 2
End Sub
Private Sub cmdSetPre_Click()
SSTab1.Tab = 0
End Sub
Private Function outToWord(ByVal strSql As String, ByVal path As String) As Boolean
On Error GoTo err_outToWord
Dim wRow As Integer
Dim wCol As Integer
'声明Adodb
Dim rs As ADODB.Recordset
Dim strMsg As String
Set rs = ExecuteSQL(strSql, strMsg)
wRow = rs.RecordCount
wCol = rs.Fields.Count
'声明Word对象
Dim objWord As Word.Application
Set objWord = CreateObject("word.application")
Dim objDocument As New Document
Set objDocument = objWord.Documents.Add
objDocument.Tables.Add Range:=objWord.Selection.Range, NumRows:=wRow, NumColumns:=wCol
rs.MoveFirst
j = 1
Do While Not rs.EOF
For i = 1 To wCol
objDocument.Tables(1).Cell(j, i).Select
objWord.Selection.Range.Text = rs.Fields(i - 1).Value
Next
j = j + 1
rs.MoveNext
Loop
objDocument.SaveAs FileName:=path
objDocument.Close
Set objDocument = Nothing
objWord.Quit
Set objWord = Nothing
outToWord = True
Exit Function
'错误处理
err_outToWord:
MsgBox Err.Description
On Error Resume Next
objDocument.Close
Set objDocument = Nothing
objWord.Quit
Set objWord = Nothing
outToWord = False
End Function
Private Function outToText(ByVal strSql As String, ByVal path As String) As Boolean
On Error GoTo err_outToText
Dim rs As ADODB.Recordset
Dim strMsg As String
Dim field_with() As Integer
Set rs = ExecuteSQL(strSql, strMsg)
Dim f1
f1 = FreeFile
Open path For Output As f1
ReDim field_width(rs.Fields.Count - 1)
rs.MoveFirst
Do While Not rs.EOF
For i = 0 To rs.Fields.Count - 1
field_width(i) = rs.Fields(i).DefinedSize
If field_width(i) < Len(rs.Fields(i).Name) Then
field_width(i) = Len(rs.Fields(i).Name)
End If
Print #f1, rs.Fields(i).Value;
Print #f1, Space$(field_width(i) - Len(rs.Fields(i).Value));
Next
Print #f1, ""
rs.MoveNext
Loop
Close f1
rs.Close
Set rs = Nothing
outToText = True
Exit Function
err_outToText:
MsgBox Err.Description
On Error Resume Next
Close f1
rs.Close
Set rs = Nothing
outToText = False
End Function
Private Sub Form_Load()
SSTab1.Tab = 0
End Sub
聊天室客户端相应代码：
Dim flag As Boolean '注释：连接状态变量
Private Sub a_Connect()
flag = True
End Sub
Private Sub a_DataArrival(ByVal bytesTotal As Long)
Dim i As String
a.GetData i
send.Enabled = True
Label3.Caption = "连接成功！"
comm2.MousePointer = 0
Form1.MousePointer = 0
Timer1.Enabled = False
If i = Chr(0) Then
Text2.Text = txtName.Text + " 你好！ " + Chr(13) + Chr(10) + " 你是今天第一个进入本聊天室的客户。" + Chr(13) + Chr(10)
Else
Text2.Text = Text2.Text + i
End If
Text2.SelStart = Len(Text2.Text)
send.MousePointer = 0
combo1.Enabled = False
comm2.Caption = "断开连接"
Text1.SetFocus
End Sub
Private Sub a_Error(ByVal Number As Integer, Description As String, ByVal Scode As Long, ByVal Source As String, ByVal HelpFile As String, ByVal HelpContext As Long, CancelDisplay As Boolean)
flag = False
Timer1.Enabled = False
comm2.MousePointer = 0
Form1.MousePointer = 0
MsgBox "网络连接失败 ！"
Label3.Caption = "等待连接"
combo1.Enabled = True
combo1.SetFocus
a.Close
comm2.Caption = "连接"
End Sub
Private Sub Comm1_Click()
If MsgBox("关闭本聊天室! 确认吗?", 36, "退出系统") = 6 Then
a.Close '注释: 关闭连接
Form1.WindowState = 1
Unload Me
End If
End Sub
Private Sub Comm2_Click()
If comm2.Caption = "断开连接" Then
a.Close
send.Enabled = False
comm2.Caption = "连接"
Label3.Caption = "等待连接"
combo1.Enabled = True
Timer1.Enabled = False
comm2.MousePointer = 0
Form1.MousePointer = 0
Else
Text2.Text = ""
Label3.Caption = "正在连接.."
comm2.MousePointer = 11
Form1.MousePointer = 11
Timer1.Enabled = True
flag = False
a.Protocol = sckTCPProtocol
a.RemoteHost = combo1.Text
a.RemotePort = 3000
a.Connect
End If
End Sub
Private Sub Form_Load()
If App.PrevInstance Then
MsgBox "本系统已经加载，请看任务拦！", 48, "提示"
End
End If
flag = False
Load Form2 '读入form2进入监听
End Sub
Private Sub Send_Click()
Dim S As String
Dim k As Integer
On Error GoTo ffff '防止链路中断
send.MousePointer = 11
If Right(Text1.Text, 1) <> Chr(10) Then
S = txtName.Text + "： " + Chr(13) + Chr(10) + " " + Text1.Text + Chr(13) + Chr(10)
Else
S = Text1.Text
End If
If Len(Trim(txtName.Text)) = 0 Then
MsgBox "请输入尼称!", vbOKOnly, "聊天室"
txtName.SetFocus
send.MousePointer = 0
Else
k = Len(Trim(Text1.Text))
If k = 0 Then
send.MousePointer = 0
MsgBox "不能发送空消息!", vbOKOnly, "聊天室"
Text1.SetFocus
Else
If flag Then
a.SendData S
Text1.Text = ""
End If
End If
End If
Exit Sub
ffff:
MsgBox "连接中断!", 48, "提示"
a.Close
send.MousePointer = 0
comm2.Caption = "连接"
Label3.Caption = "等待连接"
combo1.Enabled = True
comm2.MousePointer = 0
Form1.MousePointer = 0
Exit Sub
End Sub
Private Sub Timer1_Timer()
flag = False
Timer1.Enabled = False
comm2.MousePointer = 0
Form1.MousePointer = 0
MsgBox "网络连接失败(超时) ！"
Label3.Caption = "等待连接"
combo1.Enabled = True
combo1.SetFocus
a.Close
comm2.Caption = "连接"
End Sub
- 引 言
-
1.1、开发背景
随着计算机技术的不断发展，计算机作为知识经济时代的产物，已被广泛应用于社会各个行业和领域。随着我国国企改革的深入和社会主义市场经济的日趋繁荣，导致各企业间的竞争日益激烈，迫使企业采取先进的计算机硬件设备以及高质量的辅助软件来管理企业的各项运作，以提高本企业的劳动生产率以及人员效率。工资管理系统软件作为一种管理软件正在各企事业单位中得到越来越广泛的应用。
企业的工资管理是公司管理的一个重要内容。随着企业人员数量增加，企业的工资管理工作也变得越来越复杂。工资管理既涉及到企业劳动人事的管理，同时也是企业财务管理的重要组成部分。工资管理需要和人事管理相联系，同时连接工时考勤和医疗保险等等，来生成企业每个职工的基本工资、津贴、医疗保险、保险费、实际发放工资等。资金是企业生存的主要元素，资金的流动影响到企业的整体运作，企业员工的工资是企业资金管理的一个重要的组成部分。早期的工资统计和发放都是使用人工方式处理纸质材料，不仅花费财务人员大量的时间且不易保存，往往由于个人的因素抄写不慎或计算疏忽，出现工资发放错误的现象。早期工资管理多采取纸质材料和具有较强的时间限制。基于以上原因，企业工资管理系统使用电脑安全保存、快速计算、全面统计，实现工资管理的系统化、规范化、自动化。企业工资管理系统是典型的信息管理系统（MIS），前台程序开发工具采用微软的VB6，后台数据库采用Access数据库。VB6是一种面向对象的开发工具，具有组件丰富、语言简单、功能强大的优点。 Access数据库具有与VB6无缝连接、操作简单、易于使用的优点。运行结果证明，本企业工资管理系统极大提高了工作效率，节省了人力和物力，最终满足企业财务管理、员工工资发放的需要，同时也成为现代化企业管理的标志
1.2、系统说明
1.2.1、数据模型分析
数据库是某个企业、组织或部门所设计的数据的一个综合，它不仅要反映数据本身的内容，而且要反映数据之间的联系。在数据库中用数据模型这个工具来抽象、表示和处理现实世界中的数据和信息。简单地说，数据模型是现实世界的模拟。
数据模型通常由三个要素组成：数据结构；数据操作；数据的约束条件。
数据模型有良种不同的类型：概念模型和数据模型。概念模型是现实世界到信息世界的第一层抽象，这种信息结构并不依赖于具体的计算机系统，也不是某一个数据库管理系统支持的数据模型，它是现实世界到机器世界的一个中间层次。
关系模型的数据结构，即所研究的对象类型包括有：关系，对应一张二维表，它由行和列组成；元组，对应表中的一行；属性，对应表中的一列；主码，对应某个属性值，它可以唯一确定一个元组；分量，对应元组中的一个属性值。关系模型的数据操纵包括查询、插入、删除和更新数据。这些操作必须满足关系的完整性约束条件：实体完整性、参照完整性和用户定义的完整性。
1.2.2、数据库系统的模式结构分析
模式是数据库中全体数据的逻辑结构和特征的描述，它不设计具体的值。从数据库管理系统的角度看，虽然它们支持的数据模型、使用的数据库语言、所基于的操作系统平台都可能不同，但在体系机构上通常都采用三级模式结构（个别小型数据库系统除外），并提供两级映像功能。
三级模式结构是指数据库系统是由外模式、模式和内模式三级构成，如图1.2所示。
图1-1三级模式结构图
模式是数据库数据在逻辑级上的视图，它以某一种数据模型为基础，不仅要定义数据的逻辑结构（如数据项构成、名字、类型、值域等），而且要定义与数据有关的安全性、完整性以及数据之间的联系。外模式是模式的子集，是局部数据的逻辑结构描述。它面向具体的应用程序。因为不同的应用可能需要不同的局部数据视图，所以一个数据库可以有多个外模式，但只有一个模式。内模式也称存储模式，它是数据物理结构和存储结构的描述，是数据在数据库内部的表示方式。一个数据库只有一个内模式。
三级模式是对数据的三个抽象级别，使用户能逻辑地处理数据，而不必关系数据在计算机中的具体表示方式和存储方式。但这三个抽象层次之间必须能够相互联系和转换，数据库系统提供了两层映象来完成该功能。外模式/模式映象定义了外模式与模式之间的对应关系。这些映象定义通常包含在各自外模式的描述中。当模式改变时，只须对映象作相应改变，可以使外模式保持不变，从而应用程序不必修改，保证了数据的逻辑独立性。模式/内模式映象定影了数据全局逻辑结构与存储结构之间的对应关系。该映象定义通常包含在模式描述中。数据库的存储结构改变了，只须对映象作出相应改变，可以使模式保持不变，从而保证了数据的物理独立性。
1.2.3、数据库系统的体系结构分析
数据库的模式结构对最终用户和程序员是透明的，他们见到的仅是数据库的外模式和应用程序。从最终用户角度看，数据库系统分为单用户结构、主从式结构、分布式结构和客户/服务器结构。
1.2.4、数据库管理系统分析
在数据库系统中，应用程序、数据库管理系统、操作系统、硬件等几个方面必须协同工作。其中数据库管理系统起着关键的中介作用。当应用程序从数据库中读取一个数据时，它向数据库管理系统发出读取数据记录的命令。数据库管理系统对该命令进行语法、语义检查，并调用应用程序对应的子模式，检查应用程序的存取权限，决定是否执行该命令。如果拒绝执行，则向用户返回错误信息。在决定执行该命令后，数据库管理系统调用模式，依据子模式/模式映象的定义，确定应读入模式中的那些记录。数据库管理系统再调用物理模式，依据模式/物理模式映象的定义，决定应从哪个文件、用什么存取方式、读入哪个或那些物理记录。然后，数据库管理系统向操作系统发出执行读取所需物理记录的命令。操作系统执行后，将数据送至系统缓冲区。数据库管理系统再依据子模式/模式映象的定义导出应用程序所要读取的记录格式，将数据从系统缓冲区传送到应用程序的用户工作区，并返回命令执行情况的状态信息。
根据数据库管理系统所具有的功能，可将它分为四个组成部分。数据定义语言及其翻译处理程序：首先用数据定义语言定义数据库的模式、存储模式、外模式、各级模式间的映射、有关的约束条件等。然后，翻译处理程序将它们翻译成相应的内部表示，即对数据库框架的描述。这些描述存放在数据字典（系统目录）中，作为数据库管理系统存取和管理数据的依据。数据操纵语言及其翻译处理程序：提供了岁数据库的检索、插入、修改、删除等基本操作。数据库运行控制程序：负责数据库运行过程中的控制和管理。实用程序：完成数据库的建立与维护，以及数据格式的转换与通信等功能。
整个系统从符合操作简便、界面友好、灵活、实用、安全的要求出发，完成工资管理的全过程，包括用户管理、系统管理、信息初始化、工具箱、帮助十一大模块。经过实际使用证明，本文所设计的工资管理系统可以满足公司工资管理方面的需要。
论文主要介绍了本课题的开发背景，所要完成的功能和开发的过程。重点的说明了系统设计的重点、设计思想、难点技术和解决方案。
1.3、VB的选用和简介
现在，市场上可以选购的应用开发产品很多，流行的也有数十种。目前在我国市场上最为流行、使用最多、最为先进的可用作企业级开发工具的产品有：
Microsoft公司的Visual Basic
Microsoft公司的Visual C
Borland 公司的Delphi
Sun 公司的Java等等
在目前市场上这些众多的程序开发工具中，有些强调程序语言的弹性与执行效率；有些则偏重于可视化程序开发工具所带来的便利性与效率的提高，各有各的优点和特色，也满足了不同用户的需求。然而，语言的弹性和工具的便利性是密不可分的，只有便利的工具，却没有弹性的语言作支持，许多特殊化的处理动作必需要耗费数倍的工夫来处理，使得原来所标榜的效率提高的优点失去了作用；相反，如果只强调程序语言的弹性，却没有便利的工具作配合，会使一些即使非常简单的界面处理动作，也会严重地浪费程序设计师的宝贵时间。
作为数据库系统的开发，VB是一个非常理想选择。VB因简单易学、功能强大、编译速度快而从众多的软件开发工具中脱颖而出。它提供了灵活的可视化设计工具，将可视化界面与面向对象技术完善、紧密地结合起来，并封装了Windows编程的复杂性。程序的规模小到简单的个人数据库应用，大到复杂的企业的多层次分布式系统，都可以使用VB进行开发，其友好的集成开发界面，可视化的双向开发模式，良好的数据库应用支持高效的程序开发和程序运行，备受广大程序开发人员的好评。尤其是VB对数据库应用的强大支持，大大提高了数据库应用软件开发的效率，缩短了开发周期，深受广大数据库应用程序设计人员的喜爱。VB为数据库应用开发人员提供了丰富的数据库开发组件，使数据库应用开发功能更强大，控制更灵活，编译后的程序运行速度更快，VB是微软公司出品的一个快速可视化程序开发工具软件，借助微软在操作系统和办公软件的垄断地位，VB在短短的几年内风靡全球。VB是极有和功能强大的软件，主要表现在：所见即所得的界面设计，基于对象的设计方法，极短的软件开发周期，较易维护的生成代码。
美国微软公司在1991年推出VB1.0至今已经经历了6个版本，VB6.0运行在win9x或winme，win2000，winxp，windowsNT等操作系统下，是一个32位的应用程序开发工具。
1、VB语言的基本特点及VB应用程序的基本持点
VB程序语言具有许多优秀的特性，用其设计应用程序时有两个基本特点：可视化设计和事件驱动编程。
Visual Basic 系统除了一般高级语言所具有的一些名词术语外，还有几个系统常用的名词。其基本含义如下：
- 视窗（Form）
-
视窗是进行人机交互的界面或接口，也叫窗体。VB系统的人机交互界面或接口，无论是在设计时或是在运行时，都是Windows 系统的标准视窗。
- 对象 (Object)
-
对象是VB系统内部提供给设计者可以直接使用的处理输出的控制工具。本程序所应用到的对象类型有标签框 (Label Box)，文本框 (Text Box)，命令按扭 (Command Button)，网格 (Data Grid)，ADO控件 (Adodc1)等。当把这些工具放置到用户界面对应的窗体上时，被称为对象或控件。用户可以通过设置对象的“属性”和“方法”，便于对象适应自己所设计应用程序的输入输出内容，对象的生成过程及结构都被封装起来。正确使用对象可以减少程序和开发时间，提高程序设计者的工作效率。
- 属性 (Properties)
-
属性是VB系统提供的有关对象的参数或数据接口。用户通过适当地设置或改变对象的属性来确定对象的外观及性能特征，从而有效地使用系统提供的对象。比如，对象的名称、在屏幕上显示的位置、大小、颜色、接收或容纳的数据内容及数据的表现格式等。
- 事件 (Events)
-
事件是指用户或操作者对计算机进行的某一操作（如击键、单击或移动鼠标等）的行为或系统状态发生的变化。VB系统常用事件来引导计算机执行一段程序。程序所用的键盘事件有KeyPress（按键）事件，KeyDown事件和KeyUp事件；鼠标事件有Click（单击鼠标）事件，DbDlicd（双击鼠标）。
- 方法 (Method)
-
方法主要是指对一个对象使用某种作用的过程。它是在程序执行的过程中要计算机执行的某种操作。其程序的方法有Show（显示）方法，Hide（隐藏）方法，Refresh（刷新）方法。
- 过程 (Procedure)
-
过程是指经过定义或说明的，或基于某一对象对应的事件所引发的程序段。
- 模块 (Module)
-
模块是指一些运算量或过程进行声明或定义的一个集合。系统程序大体可分成四个模块：数据输入、根据查询、数据打印和通讯。
2、可视化设计
同其他的一些可视化程序开发工具一样,VB具有可视化设计的特点,微软的Word在刚刚进入市场时,同WPS竞争的一个重要的功能砝码就是"所见即所得"的字处理功能,VB在设计应用程序界面时也可以说是"所见即所得".在设计时,头脑中所想象的应用程序界面,完全可以通过键盘鼠标以及徒手画出来,而不是编制大量的代码然后再编译生成,如果需要修改,也是利用键盘鼠标和手画,而底层的一些程序代码由VB自动生成或修改。
VB为用户提供大量的界面元素(在VB中称为控件对象),这些控件对象对于熟悉Windows应用程序的用户而言是一点也不陌生,如"窗体"、"菜单"、"命令按钮"、"工具按钮"、"检查框"等等,用户只需要利用鼠标、键盘把这些控件对象拖动到适当的位置,设置它们的大小、形状、属性等,就可以设计出所需的应用程序界面。
3、事件驱动编程
Windows操作系统出现以来,图形化的用户界面和多任务多进程的应用程序要求程序设计不能是单一性的,在使用VB设计应用程序时,必须首先确定应用程序如何同用户进行交互.例如发生鼠标单击、键盘输入等事件时,由用户编写的代码控制这些事件的响应,这就是所谓的事件驱动编程。
4、实现菜单选项
菜单是程序最重要的特性之一，大多数程序都依赖一个定义良好的菜单使程序易于使用和维护，Visual Basic 也提供了强大的创建菜单功能是程序更加标准。
本系统使用 Visual Basic 的菜单编辑器建立菜单或者修改已经存在的菜单，您也可以使用Visual Basic 的Application Wizard 来操作。
5、实现工具栏
CoolBar控件与Office2000 中看到的CoolBar是类似的。CoolBar就是一个可以在窗体上浮动的工具，同时也是其他ActiveX的容器。通过在CoolBar中迁入其他空间你也可以向用户提供更好的灵活性和义用性。
选择“工程”下拉菜单中的“部件”选项，显示“部件”对话框。在“控件”选项卡列表中选择“Microsoft Windows Common Controls 6.0”后工具相中增加改控件。
本系统就用了Cool工具中的Statubar控件，在系统这一界面中，添加了状态栏，在第一个栏中，在样式这一栏中选择了文本，在第二个栏中，选择了系统日期，第三个栏中选择了系统时间，这样，任何时候操作本系统，都可以看到当前的时间和日期。
使用Access2000 实现关系型数据库
- 数据库的概念
-
数据库是一种存储数据并对数据进行操作的工具。数据库的作用在于组织和表达信息，简而言之，数据库就是信息的集合。计算机的数据库可以分为两类：非关系数据库（flat-file）和关系数据库（relational）。关系数据库中包含了多个数据表的信息，数据库含有各个不同部分的术语，对象记录、域等。
- 新建一个数据库
-
创建任何一个数据库的第一步是仔细的规划数据库，设计必须是灵活的、有逻辑的。创建一个数据库结构的过程被认为是数据模型设计。
1．标识需要的数据；
2．收集被标识的字段到表中；
3．标识主关键字字段；
4．绘制一个简单的数据图表；
5．规范数据；
6．标识指定字段的信息；
7．创建物理表。
- 修改已建的数据库
-
数据库的修改分为：添加、编辑和删除记录。这三种操作均可由Visual Basic 创建的程序来完成，下面的章节将详细描述实现的具体方法。
6、实现数据库之间的联系
数据库之间的关系指明两个库之间共享一个共同的关键字值。一个连接是指一种虚拟的表，这种表是在当用户要求从相互关联的各个不同的表中获取信息时建立的，关键字段用于在相互连接的不同表中查找匹配的记录。一个更高级的连接形式称为自连接。这种连接是指一个表被连接到它自己的一个字段，或在不同的记录中由重复数据的组合字段。数据库中有三种不同类型的关键字：主关键字、组合关键字和外关键字。在表中使用的关键字类型用于描述库表示什么以及在数据库中如何与其它的库建立关系。
第二章 概要设计
2.1、系统概述
纵观各企业工资管理软件、一个好的企业工资管理软件，应具有简单友好的操作界面、安全性好的数据库、分级用户权限管理、强大数据导出及备份功能、联机帮肋文档。本系统着重围绕这几点进行开发设计。
基于以上众多问题的分析，和企业管理制度的参考。将系统具体分为系统管理、员工信息设定、工资信息管理、工资结算管理、数据库管理、工具箱、帮助七大模块:
系统管理分为操作员登录管理，用户管理，锁定操作画面及退出。操作员登录管理记录用户登录的时间，方便管理员查看。
在用户暂时离开时可锁定操作画面，防止非法操作。
用户管理分为新建普通用户，新建管理员用户，修改密码三部分。
2.2、员工考勤信息
1、设置上下班的时间：设置公司的上下班时间。
2、添加员工考勤信息：主要分为上下班信息和其它考勤信息，上下班信息主要是记录每天上下班的时间：而其它考勤信息包括：请假，旷工、迟到等基本信息。
3、修改员工考勤信息：当考勤信息出现错误需要修改的时候，可以从这里修改相应的记录。
4、查询员工考勤信息：根据员工编号或时间进行查询得到所有的考勤信息。包括上下班，加班和出差信息，但是不能够对信息进行任何的操作。
5、删除考勤信息：分为删除上下班信息和删除其它考勤信息。
6、考勤信息列表：分为员工上下班信息列表和员工其它考勤信息列表。
信息初始化部分，由于公司的不同，其部门、职务、工资类别、职工类型信息设定可能不同，采取设定方式，可以减少输入次数，以方便用户。
工具箱部分，带有常用的工具，如计算器、记事本，EMIAL发送等。
帮助部分，为帮助主题，版本信息和关于。
2.3、系统功能
本系统将实现以下主要功能：
- 用户和组管理功能
- 数据的添加、删除、修改功能
- 数据统计功能
- 信息保存功能
- 数据导出功能
- 方便的数据库备份功能
- 提供实用的工具箱
- 整个系统界面窗口的测试项目
- 相关输入或输出命令能否正常打开？
- 页面显示是否正常，读数据库时是否出错？
- 业务流程是否合理，是否适合用户操作？
- 数据项测试项目
- 能否识别输入数据的类型和长度？
- 异常处理能否保证系统在不正确的操作下运行，能否识别非法数据？
- 数据库在大量的数据输入输出时能否正常运行？
- 数据写入数据库时能否写入到对应的字段？
- 结束语
- 孙 越 ，Visual Basic数据库开发自学教程，人民邮电出版社，2003
- 龚沛曾， 面向对象程序设计系列教材，高等教育出版社，2004
- 潭 浩， 学用Visual Basic 编程 ，西安电子科技大学出版社，2000
- 刘 萌， Visual Basic6.0 数据库开发与实例导航，人民邮电出版社，2004
- 汤发良， 我国企业内部冲突状态的评价测度模型 ，1999
- Visual Basic6.0 数据库精讲100例，电子工业出版社，2003
- Visual Basic6.0程序设计实验， 中央广播电视大学出版社，2006
- Professional Developer Community vb开发技术论坛
- 引 言
1.1、开发背景
随着计算机技术的不断发展，计算机作为知识经济时代的产物，已被广泛应用于社会各个行业和领域。随着我国国企改革的深入和社会主义市场经济的日趋繁荣，导致各企业间的竞争日益激烈，迫使企业采取先进的计算机硬件设备以及高质量的辅助软件来管理企业的各项运作，以提高本企业的劳动生产率以及人员效率。工资管理系统软件作为一种管理软件正在各企事业单位中得到越来越广泛的应用。
企业的工资管理是公司管理的一个重要内容。随着企业人员数量增加，企业的工资管理工作也变得越来越复杂。工资管理既涉及到企业劳动人事的管理，同时也是企业财务管理的重要组成部分。工资管理需要和人事管理相联系，同时连接工时考勤和医疗保险等等，来生成企业每个职工的基本工资、津贴、医疗保险、保险费、实际发放工资等。资金是企业生存的主要元素，资金的流动影响到企业的整体运作，企业员工的工资是企业资金管理的一个重要的组成部分。早期的工资统计和发放都是使用人工方式处理纸质材料，不仅花费财务人员大量的时间且不易保存，往往由于个人的因素抄写不慎或计算疏忽，出现工资发放错误的现象。早期工资管理多采取纸质材料和具有较强的时间限制。基于以上原因，企业工资管理系统使用电脑安全保存、快速计算、全面统计，实现工资管理的系统化、规范化、自动化。企业工资管理系统是典型的信息管理系统（MIS），前台程序开发工具采用微软的VB6，后台数据库采用Access数据库。VB6是一种面向对象的开发工具，具有组件丰富、语言简单、功能强大的优点。 Access数据库具有与VB6无缝连接、操作简单、易于使用的优点。运行结果证明，本企业工资管理系统极大提高了工作效率，节省了人力和物力，最终满足企业财务管理、员工工资发放的需要，同时也成为现代化企业管理的标志
1.2、系统说明
1.2.1、数据模型分析
数据库是某个企业、组织或部门所设计的数据的一个综合，它不仅要反映数据本身的内容，而且要反映数据之间的联系。在数据库中用数据模型这个工具来抽象、表示和处理现实世界中的数据和信息。简单地说，数据模型是现实世界的模拟。
数据模型通常由三个要素组成：数据结构；数据操作；数据的约束条件。
数据模型有良种不同的类型：概念模型和数据模型。概念模型是现实世界到信息世界的第一层抽象，这种信息结构并不依赖于具体的计算机系统，也不是某一个数据库管理系统支持的数据模型，它是现实世界到机器世界的一个中间层次。
关系模型的数据结构，即所研究的对象类型包括有：关系，对应一张二维表，它由行和列组成；元组，对应表中的一行；属性，对应表中的一列；主码，对应某个属性值，它可以唯一确定一个元组；分量，对应元组中的一个属性值。关系模型的数据操纵包括查询、插入、删除和更新数据。这些操作必须满足关系的完整性约束条件：实体完整性、参照完整性和用户定义的完整性。
1.2.2、数据库系统的模式结构分析
模式是数据库中全体数据的逻辑结构和特征的描述，它不设计具体的值。从数据库管理系统的角度看，虽然它们支持的数据模型、使用的数据库语言、所基于的操作系统平台都可能不同，但在体系机构上通常都采用三级模式结构（个别小型数据库系统除外），并提供两级映像功能。
三级模式结构是指数据库系统是由外模式、模式和内模式三级构成，如图1.2所示。
图1-1三级模式结构图
模式是数据库数据在逻辑级上的视图，它以某一种数据模型为基础，不仅要定义数据的逻辑结构（如数据项构成、名字、类型、值域等），而且要定义与数据有关的安全性、完整性以及数据之间的联系。外模式是模式的子集，是局部数据的逻辑结构描述。它面向具体的应用程序。因为不同的应用可能需要不同的局部数据视图，所以一个数据库可以有多个外模式，但只有一个模式。内模式也称存储模式，它是数据物理结构和存储结构的描述，是数据在数据库内部的表示方式。一个数据库只有一个内模式。
三级模式是对数据的三个抽象级别，使用户能逻辑地处理数据，而不必关系数据在计算机中的具体表示方式和存储方式。但这三个抽象层次之间必须能够相互联系和转换，数据库系统提供了两层映象来完成该功能。外模式/模式映象定义了外模式与模式之间的对应关系。这些映象定义通常包含在各自外模式的描述中。当模式改变时，只须对映象作相应改变，可以使外模式保持不变，从而应用程序不必修改，保证了数据的逻辑独立性。模式/内模式映象定影了数据全局逻辑结构与存储结构之间的对应关系。该映象定义通常包含在模式描述中。数据库的存储结构改变了，只须对映象作出相应改变，可以使模式保持不变，从而保证了数据的物理独立性。
1.2.3、数据库系统的体系结构分析
数据库的模式结构对最终用户和程序员是透明的，他们见到的仅是数据库的外模式和应用程序。从最终用户角度看，数据库系统分为单用户结构、主从式结构、分布式结构和客户/服务器结构。
1.2.4、数据库管理系统分析
在数据库系统中，应用程序、数据库管理系统、操作系统、硬件等几个方面必须协同工作。其中数据库管理系统起着关键的中介作用。当应用程序从数据库中读取一个数据时，它向数据库管理系统发出读取数据记录的命令。数据库管理系统对该命令进行语法、语义检查，并调用应用程序对应的子模式，检查应用程序的存取权限，决定是否执行该命令。如果拒绝执行，则向用户返回错误信息。在决定执行该命令后，数据库管理系统调用模式，依据子模式/模式映象的定义，确定应读入模式中的那些记录。数据库管理系统再调用物理模式，依据模式/物理模式映象的定义，决定应从哪个文件、用什么存取方式、读入哪个或那些物理记录。然后，数据库管理系统向操作系统发出执行读取所需物理记录的命令。操作系统执行后，将数据送至系统缓冲区。数据库管理系统再依据子模式/模式映象的定义导出应用程序所要读取的记录格式，将数据从系统缓冲区传送到应用程序的用户工作区，并返回命令执行情况的状态信息。
根据数据库管理系统所具有的功能，可将它分为四个组成部分。数据定义语言及其翻译处理程序：首先用数据定义语言定义数据库的模式、存储模式、外模式、各级模式间的映射、有关的约束条件等。然后，翻译处理程序将它们翻译成相应的内部表示，即对数据库框架的描述。这些描述存放在数据字典（系统目录）中，作为数据库管理系统存取和管理数据的依据。数据操纵语言及其翻译处理程序：提供了岁数据库的检索、插入、修改、删除等基本操作。数据库运行控制程序：负责数据库运行过程中的控制和管理。实用程序：完成数据库的建立与维护，以及数据格式的转换与通信等功能。
整个系统从符合操作简便、界面友好、灵活、实用、安全的要求出发，完成工资管理的全过程，包括用户管理、系统管理、信息初始化、工具箱、帮助十一大模块。经过实际使用证明，本文所设计的工资管理系统可以满足公司工资管理方面的需要。
论文主要介绍了本课题的开发背景，所要完成的功能和开发的过程。重点的说明了系统设计的重点、设计思想、难点技术和解决方案。
1.3、VB的选用和简介
现在，市场上可以选购的应用开发产品很多，流行的也有数十种。目前在我国市场上最为流行、使用最多、最为先进的可用作企业级开发工具的产品有：
Microsoft公司的Visual Basic
Microsoft公司的Visual C
Borland 公司的Delphi
Sun 公司的Java等等
在目前市场上这些众多的程序开发工具中，有些强调程序语言的弹性与执行效率；有些则偏重于可视化程序开发工具所带来的便利性与效率的提高，各有各的优点和特色，也满足了不同用户的需求。然而，语言的弹性和工具的便利性是密不可分的，只有便利的工具，却没有弹性的语言作支持，许多特殊化的处理动作必需要耗费数倍的工夫来处理，使得原来所标榜的效率提高的优点失去了作用；相反，如果只强调程序语言的弹性，却没有便利的工具作配合，会使一些即使非常简单的界面处理动作，也会严重地浪费程序设计师的宝贵时间。
作为数据库系统的开发，VB是一个非常理想选择。VB因简单易学、功能强大、编译速度快而从众多的软件开发工具中脱颖而出。它提供了灵活的可视化设计工具，将可视化界面与面向对象技术完善、紧密地结合起来，并封装了Windows编程的复杂性。程序的规模小到简单的个人数据库应用，大到复杂的企业的多层次分布式系统，都可以使用VB进行开发，其友好的集成开发界面，可视化的双向开发模式，良好的数据库应用支持高效的程序开发和程序运行，备受广大程序开发人员的好评。尤其是VB对数据库应用的强大支持，大大提高了数据库应用软件开发的效率，缩短了开发周期，深受广大数据库应用程序设计人员的喜爱。VB为数据库应用开发人员提供了丰富的数据库开发组件，使数据库应用开发功能更强大，控制更灵活，编译后的程序运行速度更快，VB是微软公司出品的一个快速可视化程序开发工具软件，借助微软在操作系统和办公软件的垄断地位，VB在短短的几年内风靡全球。VB是极有和功能强大的软件，主要表现在：所见即所得的界面设计，基于对象的设计方法，极短的软件开发周期，较易维护的生成代码。
美国微软公司在1991年推出VB1.0至今已经经历了6个版本，VB6.0运行在win9x或winme，win2000，winxp，windowsNT等操作系统下，是一个32位的应用程序开发工具。
1、VB语言的基本特点及VB应用程序的基本持点
VB程序语言具有许多优秀的特性，用其设计应用程序时有两个基本特点：可视化设计和事件驱动编程。
Visual Basic 系统除了一般高级语言所具有的一些名词术语外，还有几个系统常用的名词。其基本含义如下：
视窗（Form）
视窗是进行人机交互的界面或接口，也叫窗体。VB系统的人机交互界面或接口，无论是在设计时或是在运行时，都是Windows 系统的标准视窗。
对象是VB系统内部提供给设计者可以直接使用的处理输出的控制工具。本程序所应用到的对象类型有标签框 (Label Box)，文本框 (Text Box)，命令按扭 (Command Button)，网格 (Data Grid)，ADO控件 (Adodc1)等。当把这些工具放置到用户界面对应的窗体上时，被称为对象或控件。用户可以通过设置对象的“属性”和“方法”，便于对象适应自己所设计应用程序的输入输出内容，对象的生成过程及结构都被封装起来。正确使用对象可以减少程序和开发时间，提高程序设计者的工作效率。
属性是VB系统提供的有关对象的参数或数据接口。用户通过适当地设置或改变对象的属性来确定对象的外观及性能特征，从而有效地使用系统提供的对象。比如，对象的名称、在屏幕上显示的位置、大小、颜色、接收或容纳的数据内容及数据的表现格式等。
事件是指用户或操作者对计算机进行的某一操作（如击键、单击或移动鼠标等）的行为或系统状态发生的变化。VB系统常用事件来引导计算机执行一段程序。程序所用的键盘事件有KeyPress（按键）事件，KeyDown事件和KeyUp事件；鼠标事件有Click（单击鼠标）事件，DbDlicd（双击鼠标）。
方法主要是指对一个对象使用某种作用的过程。它是在程序执行的过程中要计算机执行的某种操作。其程序的方法有Show（显示）方法，Hide（隐藏）方法，Refresh（刷新）方法。
过程是指经过定义或说明的，或基于某一对象对应的事件所引发的程序段。
模块是指一些运算量或过程进行声明或定义的一个集合。系统程序大体可分成四个模块：数据输入、根据查询、数据打印和通讯。
2、可视化设计
同其他的一些可视化程序开发工具一样,VB具有可视化设计的特点,微软的Word在刚刚进入市场时,同WPS竞争的一个重要的功能砝码就是"所见即所得"的字处理功能,VB在设计应用程序界面时也可以说是"所见即所得".在设计时,头脑中所想象的应用程序界面,完全可以通过键盘鼠标以及徒手画出来,而不是编制大量的代码然后再编译生成,如果需要修改,也是利用键盘鼠标和手画,而底层的一些程序代码由VB自动生成或修改。
VB为用户提供大量的界面元素(在VB中称为控件对象),这些控件对象对于熟悉Windows应用程序的用户而言是一点也不陌生,如"窗体"、"菜单"、"命令按钮"、"工具按钮"、"检查框"等等,用户只需要利用鼠标、键盘把这些控件对象拖动到适当的位置,设置它们的大小、形状、属性等,就可以设计出所需的应用程序界面。
3、事件驱动编程
Windows操作系统出现以来,图形化的用户界面和多任务多进程的应用程序要求程序设计不能是单一性的,在使用VB设计应用程序时,必须首先确定应用程序如何同用户进行交互.例如发生鼠标单击、键盘输入等事件时,由用户编写的代码控制这些事件的响应,这就是所谓的事件驱动编程。
4、实现菜单选项
菜单是程序最重要的特性之一，大多数程序都依赖一个定义良好的菜单使程序易于使用和维护，Visual Basic 也提供了强大的创建菜单功能是程序更加标准。
本系统使用 Visual Basic 的菜单编辑器建立菜单或者修改已经存在的菜单，您也可以使用Visual Basic 的Application Wizard 来操作。
5、实现工具栏
CoolBar控件与Office2000 中看到的CoolBar是类似的。CoolBar就是一个可以在窗体上浮动的工具，同时也是其他ActiveX的容器。通过在CoolBar中迁入其他空间你也可以向用户提供更好的灵活性和义用性。
选择“工程”下拉菜单中的“部件”选项，显示“部件”对话框。在“控件”选项卡列表中选择“Microsoft Windows Common Controls 6.0”后工具相中增加改控件。
本系统就用了Cool工具中的Statubar控件，在系统这一界面中，添加了状态栏，在第一个栏中，在样式这一栏中选择了文本，在第二个栏中，选择了系统日期，第三个栏中选择了系统时间，这样，任何时候操作本系统，都可以看到当前的时间和日期。
使用Access2000 实现关系型数据库
数据库是一种存储数据并对数据进行操作的工具。数据库的作用在于组织和表达信息，简而言之，数据库就是信息的集合。计算机的数据库可以分为两类：非关系数据库（flat-file）和关系数据库（relational）。关系数据库中包含了多个数据表的信息，数据库含有各个不同部分的术语，对象记录、域等。
创建任何一个数据库的第一步是仔细的规划数据库，设计必须是灵活的、有逻辑的。创建一个数据库结构的过程被认为是数据模型设计。
1．标识需要的数据；
2．收集被标识的字段到表中；
3．标识主关键字字段；
4．绘制一个简单的数据图表；
5．规范数据；
6．标识指定字段的信息；
7．创建物理表。
数据库的修改分为：添加、编辑和删除记录。这三种操作均可由Visual Basic 创建的程序来完成，下面的章节将详细描述实现的具体方法。
6、实现数据库之间的联系
数据库之间的关系指明两个库之间共享一个共同的关键字值。一个连接是指一种虚拟的表，这种表是在当用户要求从相互关联的各个不同的表中获取信息时建立的，关键字段用于在相互连接的不同表中查找匹配的记录。一个更高级的连接形式称为自连接。这种连接是指一个表被连接到它自己的一个字段，或在不同的记录中由重复数据的组合字段。数据库中有三种不同类型的关键字：主关键字、组合关键字和外关键字。在表中使用的关键字类型用于描述库表示什么以及在数据库中如何与其它的库建立关系。
第二章 概要设计
2.1、系统概述
纵观各企业工资管理软件、一个好的企业工资管理软件，应具有简单友好的操作界面、安全性好的数据库、分级用户权限管理、强大数据导出及备份功能、联机帮肋文档。本系统着重围绕这几点进行开发设计。
基于以上众多问题的分析，和企业管理制度的参考。将系统具体分为系统管理、员工信息设定、工资信息管理、工资结算管理、数据库管理、工具箱、帮助七大模块:
系统管理分为操作员登录管理，用户管理，锁定操作画面及退出。操作员登录管理记录用户登录的时间，方便管理员查看。
在用户暂时离开时可锁定操作画面，防止非法操作。
用户管理分为新建普通用户，新建管理员用户，修改密码三部分。
2.2、员工考勤信息
1、设置上下班的时间：设置公司的上下班时间。
2、添加员工考勤信息：主要分为上下班信息和其它考勤信息，上下班信息主要是记录每天上下班的时间：而其它考勤信息包括：请假，旷工、迟到等基本信息。
3、修改员工考勤信息：当考勤信息出现错误需要修改的时候，可以从这里修改相应的记录。
4、查询员工考勤信息：根据员工编号或时间进行查询得到所有的考勤信息。包括上下班，加班和出差信息，但是不能够对信息进行任何的操作。
5、删除考勤信息：分为删除上下班信息和删除其它考勤信息。
6、考勤信息列表：分为员工上下班信息列表和员工其它考勤信息列表。
信息初始化部分，由于公司的不同，其部门、职务、工资类别、职工类型信息设定可能不同，采取设定方式，可以减少输入次数，以方便用户。
工具箱部分，带有常用的工具，如计算器、记事本，EMIAL发送等。
帮助部分，为帮助主题，版本信息和关于。
2.3、系统功能
本系统将实现以下主要功能：
2.4、数据流图
具有相应权限的用户在正确登陆后，可以打开并添加新员工的个人档案，添加完成后可以使用数据导出功能，导出数据。数据流图如下图2-1所示：
2.5、模块图
如图：
图2-2 系统功能模块图
第三章 数据库设计
3.1、概述
在数据库应用系统的开发过程中，数据库的结构设计是其中非常重要的一个环节。数据库结构设计的好坏将直接对应用系统的效率以及实现的效果产生影响。所以在尽量全面考虑用户的各种需求的前提下，进行了数据库设计。
3.2、数据库概念结构设计
数据库需求分析是数据库结构设计的第一个阶段，是非常重要的一个阶段。这个阶段主要是确定基本数据、数据结构以及数据处理的流程，组成一份详尽的数据字典，为以后进一步设计打好基础。
对一个数据管理员来说，设计良好的数据库应使之开始于一个合理的逻辑设计。概念模型是用户和数据库设计人员之间进行交流的工具
根据上面的设计规划的实体有：职工基本信息实体、工资项目设置信息实体、职工应发款信息实体、职工代扣款信息实体、职工工资信息实体。
3.3、数据库设计
数据库中共有18张表，如图3-1所示。其中分为12张主表,分别为：t_br（基本档案表）、t_login（操作员登录记录表）、系统用户（用户表）、AttendanceInfo（员工考勤信息表）、LeaveInfo(员工请假信息)、OvertimeInfo(员工加班信息) 、BasicSar（基本工资设定表）、kouchu（扣除）、timekaoqin（记时考勤）、salarysta（产品单价设定表）、salary（员工工资表）、YGZJS（月工资结算表）等详细信息如下。
图3-1 数据库表
各个实体具体的描述E-R图如下。基本档案表t_br E-R模型如图3-2所示，系统用户E-R模型如图3-3所示，员工考勤信息表 AttendanceInfo E-R模型如图3-4所示。
图3-2基本档案表E-R图
图3-3系统用户
图3-4员工考勤信息表 AttendanceInfo
1、职工基本档案表t_br，其结构如表3-1所示。保存员工的相关信息，是管理系统核心数据，所有其它的信息都是依附与这张表而存在的。以工号作为主关键字，尽量减少数据的冗余，保证数据的一致性。
表3-1 基本档案表 t_br
| 字段 |
类型 |
长度 |
必填字段 |
| 工号 |
文本 |
6 |
是 |
| 姓名 |
文本 |
10 |
是 |
| 性别 |
文本 |
10 |
是 |
| 部门 |
文本 |
10 |
是 |
| 薪金 |
数字 |
10 |
是 |
| 所学专业 |
文本 |
20 |
是 |
| 职务 |
文本 |
10 |
否 |
| 工资类别 |
数字 |
10 |
是 |
| 合同开始时间 |
日期/时间 |
是 |
|
| 合同终止时间 |
日期/时间 |
是 |
|
| 职工类型 |
文本 |
10 |
是 |
| 生日 |
日期/时间 |
否 |
|
| 工龄 |
数字 |
10 |
否 |
| 年龄 |
数字 |
3 |
是 |
| 文化程度 |
文本 |
10 |
否 |
| 民族 |
文本 |
10 |
否 |
| 政治面貌 |
文本 |
10 |
否 |
| 身份证号 |
文本 |
18 |
是 |
| 籍贯 |
文本 |
200 |
是 |
| 联系电话 |
数字 |
15 |
否 |
| 手机 |
数字 |
15 |
是 |
| 家庭住址 |
文本 |
200 |
是 |
| 健康状况 |
文本 |
10 |
是 |
| 照片 |
OLE 对象 |
否 |
2、员工考勤信息表，其结构如表3-2所示。保存员工考勤信息的相关信息。此表数据只保存员工的出勤情况，并不包括每日生产产量的考勤信息。
表3-2 员工考勤信息表 AttendanceInfo
| 字段 |
类型 |
长度 |
必填字段 |
| 工号 |
文本 |
6 |
是 |
| 姓名 |
文本 |
10 |
是 |
| 当前日期 |
文本 |
10 |
是 |
| 出入标志 |
文本 |
2 |
是 |
| 上班时间 |
日期/时间 |
是 |
|
| 下班时间 |
日期/时间 |
是 |
|
| 迟到次数 |
数字 |
10 |
否 |
| 早退次数 |
数字 |
10 |
否 |
3、LeaveInfo员工请假信息表，其结构如表3-3所示。用户所有请假信息保存在此表中。工资结算时根据记录进行扣除。
表3-3 员工请假信息表 LeaveInfo
| 字段 |
类型 |
长度 |
必填字段 |
| 工号 |
文本 |
5 |
是 |
| 姓名 |
文本 |
10 |
是 |
| 病假天数 |
数字 |
长整型 |
是 |
| 事假天数 |
数字 |
长整型 |
是 |
| 假期开始时间 |
日期/时间 |
是 |
4、员工加班信息表，结构如表3-4所示。为了方便系统的管理，员工加班信息同样也作为一个独立的表存储。
表3-4 员工加班信息表 OverTimeInfo
| 字段 |
类型 |
长度 |
必填字段 |
| 工号 |
文本 |
5 |
是 |
| 姓名 |
文本 |
10 |
是 |
| 特殊加班天数 |
数字 |
长整型 |
否 |
| 正常加班天数 |
数字 |
长整型 |
否 |
| 加班日期 |
日期/时间 |
是 |
5、员工工资表，结构如表3-5所示。该表即完成每日产品考勤，同时也保存由系统自动计算出的每天的员工工资，月底时只要汇总出这些每天的工资和即可。然后转存到其它表作进一步处理。
表3-5 员工工资表 salary
| 字段 |
类型 |
长度 |
必填字段 |
| ID |
自动编号 |
是 |
|
| 工号 |
文本 |
5 |
是 |
| 姓名 |
文本 |
10 |
是 |
| 工作日 |
日期/时间 |
是 |
|
| 产品类型一 文本 |
文本 |
否 |
|
| 产品类型二 |
文本 |
否 |
|
| 产品类型三 |
文本 |
否 |
|
| 数量一 |
数字 |
否 |
|
| 数量二 |
数字 |
否 |
|
| 数量三 |
数字 |
否 |
|
| 单价一 |
数字 |
否 |
|
| 单价二 |
数字 |
否 |
|
| 单价三 |
数字 |
否 |
|
| 每日汇总 |
数字 |
是 |
最后，设计数据库时，考虑数据库的安全性，防止非管理人员用第三方软件打开数据库，特对数据库文件也进行了处理，将数据库的扩展名mdb替换为ldl， 起到了一定的迷惑性。在改扩展名的同时也对数据库进行了加密。在用ACCESS数据库打开时要求输入打开密码，如图3-5所示。只有正确输入打开密码时才能打开数据库。为了方便记忆，本数据库的打开密码为：wlz。
图3-5 要求输入密码
第四章 各功能的实现
4.1、系统安全及权限的实现
为了确保系统的安全，对数据库进行加密处理，采用了用户和组管理，并记录用户登录信息。拥有高级权限的用户，可以创建不同的组，并可将全部或部分权限分配给创建用户。
为了实现该功能，系统采用了递归方式，使高一级别的用户可以管理低级用户，最高权限属于管理员。
具体描述如下:
4.2、登录窗口的实现
系统登陆时，要求正确输入用户名和密码。成功登陆后显示如图4-2所示工资管理系统主界面。用户名分为管理员用户和普通用户。如图4-1所示：
图4-1 登录窗口
实现功能的部分主要代码：
Private Sub Comok_Click()
On Error GoTo Dealerror
Dim strSql As String
Dim strMsg As String
'On Error GoTo Dealerror
Dim objCn As New Connection
strcn = CS()
objCn.ConnectionString = strcn
objCn.Open
Set objRs = New Recordset
Set objRs.ActiveConnection = objCn
objRs.CursorLocation = adUseClient
strSql = "SELECT * FROM 系统用户"
objRs.Open strSql
objRs.ActiveConnection = Nothing
objCn.Close
Set objCn = Nothing
If Logontimes >= 3 Then
MsgBox "你已经超过最大登陆次数！退出系统", vbOKOnly + vbCritical, "系统登录"
End
Else
objRs.MoveFirst
objRs.Find "用户名='" & txtUserName & "'"
If objRs.EOF Then
MsgBox "用户名错误！", vbOKOnly + vbCritical, "系统登录"
txtUserName.SetFocus
txtUserName.Text = ""
Else
If objRs!口令 <> txtPassword Then
MsgBox "密码错误!请重新输入!", vbOKOnly + vbCritical, "系统登录"
txtPassword.SetFocus
txtPassword.Text = ""
Else
'MsgBox "欢迎使用工资管理系统", vbOKCancel + vbOKOnly, "系统登录"
strusername = txtUserName
userpassword = txtPassword
If CmbStatus = "" Then
MsgBox "请选择登陆身份!", vbOKOnly + vbCritical, "系统登录"
CmbStatus.SetFocus
Else
If CmbStatus.ListIndex = 0 And objRs!admin = True Then
UserAdmin = 1
End If
If CmbStatus.ListIndex = 0 And objRs!admin = False Then
X = MsgBox("你不是管理员，将以普通用户登陆", vbOKCancel + vbOKOnly, "系统登录")
End If
If X = 2 Then
txtUserName.SetFocus
txtUserName.Text = ""
txtPassword.Text = ""
Else
'添加操作员登陆时间
strSql = "insert into t_login (用户,登录时间) values('" & txtUserName & "','" & Now & "')"
Set objRs = ExecuteSQL(strSql, strMsg)
Unload Me
MDIForm1.Show
End If
End If
End If
End If
End If
Logontimes = Logontimes + 1 '登陆次数
Exit Sub
Dealerror:
msg = "程序执行出错,错误信息如下:" & vbCrLf & Err.Description
ShowError msg
End Sub
Dim objRs As Recordset
Dim i As Integer
Dim Logontimes As Integer
Private Sub Comcancle_Click()
n = MsgBox("你选择了退出系统登陆,退出将不能启动管理系统!" & vbCrLf & "是否真的退出?", vbYesNo, "系统验证")
If n = vbYes Then
Unload Me
End If
End Sub
图4-2 工资管理系统主窗体
4.3、员工基本档案信息的实现
员工基本档案信息管理，在窗体中完成员工基本信息的录入工作。根据提示在该窗体中输入相应的信息，最后单击“保存”按钮，进行信息的保存。如图4-3所示
图4-3 员工基本档案信息录入窗口
相应部分代码如下：
'添加员工基本信息
Private Sub cmdOK_Click()
Dim rs As ADODB.Recordset
Dim strSql As String
Dim strMsg As String
Dim tmpPath As String
Dim iStm As ADODB.Stream
'如果是修改(保存照片--删除原记录--保存记录)
If blnChange = True Then
'如果不要删除
If blnDelPhoto = False Then
strSql = "select * from t_br where 工号='" & txtGH.Text & "'"
Set rs = ExecuteSQL(strSql, strMsg)
'保存到文件
tmpPath = App.path & "\temp.jpg"
If Not IsNull(rs.Fields("照片").Value) Then
Set iStm = New ADODB.Stream
With iStm
.Mode = adModeReadWrite
.Type = adTypeBinary
.Open
.Write rs.Fields("照片").Value
.SaveToFile tmpPath
blnDel = True
End With
strFileName = tmpPath
'pic.Picture = LoadPicture(tmpPath)
iStm.Close
Else
blnDel = False
End If
rs.Close
End If
'删除记录
strSql = "delete * from t_br where 工号='" & txtGH.Text & "'"
Set rs = ExecuteSQL(strSql, strMsg)
Else
strSql = "select * from t_br where 工号='" & txtGH.Text & "'"
Set rs = ExecuteSQL(strSql, strMsg)
If rs.EOF = False Then
MsgBox "已有相同的工号，无法添加到数据库！", vbOKOnly + vbExclamation, "警告"
TextFocus txtGH
Exit Sub
End If
rs.Close
End If
strSql = "select * from t_br"
Set rs = ExecuteSQL(strSql, strMsg)
rs.AddNew
rs.Fields("工号") = txtGH.Text
rs.Fields("姓名") = txtName.Text
If cboPayStyle.Text = "" Then
rs.Fields("工资类别") = Null
Else
rs.Fields("工资类别") = cboPayStyle.Text
End If
If cboHealthy.Text = "" Then
rs.Fields("健康状况") = Null
Else
rs.Fields("健康状况") = cboHealthy.Text
End If
If cboSex.Text = "" Then
rs.Fields("性别") = Null
Else
rs.Fields("性别") = cboSex.Text
End If
If cboEmployeeStyle.Text = "" Then
rs.Fields("职工类型") = Null
Else
rs.Fields("职工类型") = cboEmployeeStyle.Text
End If
If cboPart.Text = "" Then
rs.Fields("部门") = Null
Else
rs.Fields("部门") = cboPart.Text
End If
If cboDuty.Text = "" Then
rs.Fields("职务") = Null
Else
rs.Fields("职务") = cboDuty.Text
End If
If cboCulture.Text = "" Then
rs.Fields("文化程度") = Null
Else
rs.Fields("文化程度") = cboCulture.Text
End If
If cboNation.Text = "" Then
rs.Fields("民族") = Null
Else
rs.Fields("民族") = cboNation.Text
End If
'数字型
If txtMoney.Text = "" Then
rs.Fields("薪金") = 0
Else
rs.Fields("薪金") = txtMoney.Text
End If
If cboSpec.Text = "" Then
rs.Fields("所学专业") = Null
Else
rs.Fields("所学专业") = cboSpec.Text
End If
'年龄为数字型
If txtAge.Text = "" Then
rs.Fields("年龄") = 0
Else
rs.Fields("年龄") = txtAge.Text
End If
'日期型
rs.Fields("生日") = dtpBirthday.Value
If cboPolity.Text = "" Then
rs.Fields("政治面貌") = Null
Else
rs.Fields("政治面貌") = cboPolity.Text
End If
If cboMarry.Text = "" Then
rs.Fields("婚姻状况") = Null
Else
rs.Fields("婚姻状况") = cboMarry.Text
End If
If cboNativePlace.Text = "" Then
rs.Fields("籍贯") = Null
Else
rs.Fields("籍贯") = cboNativePlace.Text
End If
If txtHandset.Text = "" Then
rs.Fields("手机") = 0
Else
rs.Fields("手机") = txtHandset.Text
End If
If txtIdentity.Text = "" Then
rs.Fields("身份证号") = Null
Else
rs.Fields("身份证号") = txtIdentity.Text
End If
If txtTelphone.Text = "" Then
rs.Fields("联系电话") = Null
Else
rs.Fields("联系电话") = txtTelphone.Text
End If
If txtHomeAddress.Text = "" Then
rs.Fields("家庭住址") = Null
Else
rs.Fields("家庭住址") = txtHomeAddress.Text
End If
'日期型
rs.Fields("合同开始时间") = dtpBBargain.Value
rs.Fields("合同终止时间") = dtpEBargain.Value
If txtLong.Text = "" Then
rs.Fields("工龄") = 0
Else
rs.Fields("工龄") = txtLong.Text
End If
'添加照片
Set iStm = New ADODB.Stream
If Len(strFileName) > 0 Then
With iStm
.Type = adTypeBinary '二进制模式
.Open
.LoadFromFile strFileName
End With
rs.Fields("照片") = iStm.Read
rs.Update
iStm.Close
Else
rs.Update
End If
rs.Close
Set rs = Nothing
cmdDel.Enabled = True
Call DisabledControl
cmdNew.Enabled = True
MsgBox "添加成功"
If blnDel Then
If tmpPath <> "" Then
Kill tmpPath
End If
End If
Call RefreshGrid
End Sub
4.4、员工考勤信息的实现
4.4.1、设置员工上下班时间
在该窗体中输入相应的上下班信息，具体如图4-4所示，相应部分代码如下：
图4-4 设置上下班时间
Private Sub cmdOK_Click() '设置上下班时间
Dim sql As String
Dim rs As New ADODB.Recordset
Dim strMsg As String
sql = "delete * from TimeSetting"
Set rs = ExecuteSQL(sql, strMsg) ' 查找数据库，读取记录
If dtpBT.Value >= DTPicker1.Value Then ' 判断下班时间大于上班时间
MsgBox "请正确的输入时间", vbOKOnly + vbExclamation, "警告！"
Me.dtpBT.SetFocus '设置焦点
Exit Sub
End If
If dtpBT2.Value >= DTPicker2.Value Or dtpBT2.Value <= DTPicker1.Value Or dtpBT2.Value <= dtpBT.Value Then '判断下班时间大于上班时间
MsgBox "请正确的输入时间", vbOKOnly + vbExclamation, "警告！"
Me.dtpBT2.SetFocus '设置焦点
Exit Sub
End If
sql = "select * from TimeSetting"
Set rs = ExecuteSQL(sql, strMsg)
rs.AddNew
rs.Fields("上午上班时间") = CDate(dtpBT.Hour & ":" & dtpBT.Minute & ":" & dtpBT.Second)
rs.Fields("上午下班时间") = CDate(DTPicker1.Hour & ":" & DTPicker1.Minute & ":" & DTPicker1.Second)
rs.Fields("下午上班时间") = CDate(dtpBT2.Hour & ":" & dtpBT2.Minute & ":" & dtpBT2.Second)
rs.Fields("下午下班时间") = CDate(DTPicker2.Hour & ":" & DTPicker2.Minute & ":" & DTPicker2.Second)
rs.Update
rs.Close
MsgBox "时间已经设置", vbOKOnly + vbInformation, "设置结果！"
Unload Me
End Sub
Private Sub Form_Load()
Dim sql As String
Dim rs As New ADODB.Recordset
Dim strMsg As String
sql = "select * from TimeSetting"
Set rs = ExecuteSQL(sql, strMsg)
If rs.EOF Then Exit Sub
dtpBT.Value = rs.Fields("上午上班时间")
DTPicker1.Value = rs.Fields("上午下班时间")
dtpBT2.Value = rs.Fields("下午上班时间")
DTPicker2.Value = rs.Fields("下午下班时间")
End Sub
4.4.2、添加员工考勤信息
1、添加上下班信息
窗体如图4-5所示，填入相应的信息，部分代码如下：
图4-5 添加员工考勤信息
添加上下班信息
Private Sub cmdOK_Click()
Dim sql As String
Dim sql2 As String
Dim rs As New ADODB.Recordset
Dim strMsg As String
Dim strmsg2 As String
Dim rsTime As New ADODB.Recordset
Dim tmsetswsb, tmsetswxb, tmsetxwsb, tmsetxwxb As Date
Dim tmsb1, tmxb1 As Date
sql = "select * from AttendanceInfo order by ID desc"
sql2 = "select * from TimeSetting"
Set rs = ExecuteSQL(sql, strMsg)
Set rsTime = ExecuteSQL(sql2, strmsg2)
If InFlag = False And OutFlag = False Then
MsgBox "请选择上下班", vbOKOnly + vbExclamation, "警告!"
End If
'添加上班信息
If InFlag = True Then
If txtID.Text = "" Or txtName.Text = "" Then
MsgBox "要添加上班信息,员工编号与姓名不能为空,请输入", vbOKOnly, "提示"
Exit Sub
End If
'判断上下午上班时间是否迟到
tmsb1 = dtpBT.Value
h = Hour(tmsb1)
m = Minute(tmsb1)
s = Second(tmsb1)
tmsb1 = CDate(h & ":" & m & ":" & s)
tmsetswsb = CDate(rsTime.Fields("上午上班时间"))
tmsetswxb = CDate(rsTime.Fields("上午下班时间"))
tmsetxwsb = CDate(rsTime.Fields("下午上班时间"))
'判断上午上班时间是否迟到
If tmsb1 < tmsetswxb Then
If tmsb1 > tmsetswsb Then
ilate = 1
MsgBox "迟到"
Else
ilate = 0
MsgBox "正常上班"
End If
'判断下午上班时间是否迟到
Else
If tmsb1 > tmsetxwsb Then
ilate = 1
MsgBox "迟到"
Else
ilate = 0
MsgBox "正常上班"
End If
End If
aflag = "入"
rs.AddNew
rs.Fields("工号") = txtID.Text
rs.Fields("姓名") = txtName.Text
rs.Fields("当前日期") = dtpET.Value
rs.Fields("上班时间") = dtpBT.Hour & ":" & dtpBT.Minute & ":" & dtpBT.Second
rs.Fields("出入标志") = aflag
rs.Fields("迟到次数") = ilate
rs.Update
rs.Close
MsgBox "已完成添加上班信息", vbOKOnly + vbInformation, "添加结果！"
Unload Me
Exit Sub
End If
'添加下班信息
If OutFlag = True Then
If txtID.Text = "" Or txtName.Text = "" Then
MsgBox "要添加下班信息,员工编号与姓名不能为空,请输入", vbOKOnly + vbExclamation, "警告"
Exit Sub
End If
'判断上下午下班时间是否早退
tmxb1 = DTPicker1.Value
h = Hour(tmxb1)
m = Minute(tmxb1)
s = Second(tmxb1)
tmxb1 = CDate(h & ":" & m & ":" & s)
tmsetxwsb = CDate(rsTime.Fields("下午上班时间"))
tmsetswxb = CDate(rsTime.Fields("上午下班时间"))
tmsetxwxb = CDate(rsTime.Fields("下午下班时间"))
'判断上午下班时间
If tmxb1 < tmsetxwsb Then
If tmxb1 < tmsetswxb Then
iearly = 1
MsgBox "早退"
Else
iearly = 0
MsgBox "正常下班"
End If
'判断下午下班时间
Else
If tmxb1 < tmsetxwxb Then
iearly = 1
MsgBox "早退"
Else
iearly = 0
MsgBox "正常下班"
End If
End If
aflag = "出"
rs.AddNew
rs.Fields("工号") = txtID.Text
rs.Fields("姓名") = txtName.Text
rs.Fields("当前日期") = dtpET.Value
rs.Fields("下班时间") = DTPicker1.Hour & ":" & DTPicker1.Minute & ":" & DTPicker1.Second
rs.Fields("出入标志") = aflag
rs.Fields("早退次数") = iearly
rs.Update
rs.Close
MsgBox "已完成添加下班信息", vbOKOnly + vbInformation, "添加结果！"
Unload Me
Exit Sub
End If
End Sub
Private Sub Form_Load()
dtpET.Value = Date '初始化为当天时间
End Sub
2、设置员工每日产量考勤
在该窗体中输入相应的信息，完成每日产量考勤具体如图4-6所示，相应部分代码如下：
图4-6 员工每日产量考勤
“保存”按钮代码如下：
Private Sub cmdOK_Click()
Dim rs As ADODB.Recordset
Dim strSql As String
Dim strMsg As String
'根据需要进行字段限制
If ChkBoxJJ.Value = True Then
If Combo1.Text = "" Then
MsgBox "产品类型不能为空"
TextFocus Combo1
Exit Sub
End If
If ChkBoxCP.Value = True Then
If Combo2.Text = "" Then
MsgBox "产品类型二不能为空"
TextFocus Combo2
Exit Sub
End If
If Txt3.Text = 0 Then
MsgBox "数量不能为空"
TextFocus Txt3
Exit Sub
End If
End If
If ChkBoxCR.Value = True Then
If Combo3.Text = "" Then
MsgBox "产品类型三不能为空"
TextFocus Combo3
Exit Sub
End If
If Txt5.Text = 0 Then
MsgBox "数量不能为空"
TextFocus Txt5
Exit Sub
End If
End If
End If
strSql = "select * from checkinfo where 工号='" & txtGH1 & "'"
Set rs = ExecuteSQL(strSql, strMsg)
If rs.EOF = False Then
MsgBox "已有相同的记录，无法添加到数据库！", vbOKOnly + vbExclamation, "警告"
TextFocus txtGH1
rs.Close
If ChkBoxJJ.Value = True Then
strSql = "select * from salary"
Set rs = ExecuteSQL(strSql, strMsg)
rs.AddNew
rs.Fields("工号") = txtGH1.Text
rs.Fields("姓名") = txtName.Text
rs.Fields("工作日") = dtpBirthday.Value
rs.Fields("产品类型一") = Combo1.Text
rs.Fields("产品类型二") = Combo2.Text
rs.Fields("产品类型三") = Combo3.Text
If Txt1.Text = "" Then
rs.Fields("数量一") = 0
Else
rs.Fields("数量一") = Txt1.Text
End If
If Txt3.Text = "" Then
rs.Fields("数量二") = 0
Else
rs.Fields("数量二") = Txt3.Text
End If
If Txt5.Text = "" Then
rs.Fields("数量三") = 0
Else
rs.Fields("数量三") = Txt5.Text
End If
If txt2.Text = "" Then
rs.Fields("单价一") = 0
Else
rs.Fields("单价一") = txt2.Text
End If
If txt4.Text = "" Then
rs.Fields("单价二") = 0
Else
rs.Fields("单价二") = txt4.Text
End If
If txt6.Text = "" Then
rs.Fields("单价三") = 0
Else
rs.Fields("单价三") = txt6.Text
End If
rs.Fields("每日汇总") = Txt7.Text
rs.Update
rs.Close
Set rs = Nothing
End If
If ChkBoxJS.Value = True Then
strSql = "select * from timekaoqin"
Set rs = ExecuteSQL(strSql, strMsg)
rs.AddNew
rs.Fields("工号") = txtGH1.Text
rs.Fields("工作日") = dtpBirthday.Value
rs.Fields("上班时间") = dtpBT(0).Value
rs.Fields("下班时间") = DTPicker1(0).Value
rs.Fields("PM上班时间") = dtpBT(1).Value
rs.Fields("PM下班时间") = DTPicker1(1).Value
rs.Fields("单价") = MoTxt.Text
rs.Fields("工作小时数") = Timetxt6.Text
rs.Fields("加班时间") = Combo4.Text
rs.Fields("加班单价") = Text12.Text
rs.Fields("记时汇总") = MoTxt8.Text
rs.Update
rs.Close
Set rs = Nothing
End If
If ChkBoxJJ.Value = True Or ChkBoxJS.Value = True Then
MsgBox "添加成功"
Else
MsgBox "添加失败"
same = 2: same2 = 4
End If
If same = 2 And same2 = 4 Then
Exit Sub
Else
strSql = "select * from checkinfo "
Set rs = ExecuteSQL(strSql, strMsg)
rs.AddNew
rs.Fields("工号") = txtGH1.Text
rs.Fields("工作日") = dtpBirthday.Value
rs.Update
End If
'Call RefreshGrid
End If
End Sub
4.5、员工月工资结算、产量汇总、综合处理
在该窗体中输入相应的信息，完成月工资结算、产量汇总、综合处理具体如图4-7所示，相应部分代码如下：
图4-7 月工资结算、产量汇总、综合处理
相应部分代码如下：
Dim strSql As String
Dim strMsg As String
Dim rs As ADODB.Recordset
Dim dj1 As Integer
Dim dj2 As Integer
Dim dj3 As Integer
'记件统计
strSql = "select * from salary where 工号='" & gh & "'"
Set rs = ExecuteSQL(strSql, strMsg)
If rs.EOF = False Then
TextNO.Text = rs.Fields("工号").Value
TextNAMe.Text = rs.Fields("姓名").Value
Combod.Value = rs.Fields("工作日").Value
Textlx(0).Text = rs.Fields("产品类型一").Value
dj1 = rs.Fields("单价一").Value
dj2 = rs.Fields("单价二").Value
dj3 = rs.Fields("单价三").Value
Textlx(1).Text = rs.Fields("产品类型二").Value
Textlx(2).Text = rs.Fields("产品类型三").Value
rs.Close
strSql = "select sum(数量一) as 数量一,sum(数量二) as 数量二,sum(数量三) as 数量三,sum(每日汇总) as 每日汇总 from salary group by 工号='" & gh & "' "
Set rs = ExecuteSQL(strSql, strMsg)
Textsl(0).Text = rs.Fields("数量一").Value
Textsl(1).Text = rs.Fields("数量二").Value
Textsl(2).Text = rs.Fields("数量三").Value
Textzj(0).Text = Val(Textsl(0).Text) * dj1
Textzj(1).Text = Val(Textsl(1).Text) * dj2
Textzj(2).Text = Val(Textsl(2).Text) * dj3
Txtgj.Text = Val(Textzj(0).Text) + Val(Textzj(1).Text) + Val(Textzj(2).Text)
'奖金 福利结算
rs.Close
strSql = "select * from Sar_other where 工号='" & TextNO & "'"
Set rs = ExecuteSQL(strSql, strMsg)
Text(0).Text = rs.Fields("奖金").Value
Text(1).Text = rs.Fields("津贴").Value
Text(2).Text = rs.Fields("福利").Value
Text(3).Text = rs.Fields("其他项目").Value
'扣除
rs.Close
strSql = "select * from kouchu where 工号='" & TextNO & "'"
Set rs = ExecuteSQL(strSql, strMsg)
Tet(0).Text = rs.Fields("住宿费")
Tet(1).Text = rs.Fields("火食费")
Tet(2).Text = rs.Fields("公基金")
Tet(3).Text = rs.Fields("垃圾处理费")
Tet(4).Text = rs.Fields("医疗保险费")
Tet(5).Text = rs.Fields("其它")
Else
MsgBox "数据库还没有此工号的工资记录", vbOKOnly + vbExclamation, "提示"
ChkBoxJJ.Value = False
ChkBoxCP.Value = False
ChkBoxCR.Value = False
ChkBoxJS.Value = False
Exit Sub
End If
'记时统计
rs.Close
strSql = "select sum(加班时间) as 加班总时间,sum(工作小时数) as 工作小时数,sum(记时汇总) as 记时汇总 from timekaoqin group by 工号='" & gh & "' "
Set rs = ExecuteSQL(strSql, strMsg)
Txt(0).Text = rs.Fields("工作小时数").Value
Txt(2).Text = rs.Fields("加班总时间").Value
Textgj.Text = rs.Fields("记时汇总").Value
strSql = "select 单价,加班单价 from timekaoqin where 工号='" & gh & "'"
Set rs = ExecuteSQL(strSql, strMsg)
Txt(1).Text = rs.Fields("单价").Value
Txt(3).Text = rs.Fields("加班单价").Value
Text5.Text = Val(Txtgj.Text) + Val(Textgj.Text) + Val(Text(0).Text) _
+ Val(Text(1).Text) + Val(Text(2).Text) + Val(Text(3).Text)
Text3.Text = Val(Txtgj.Text) - Val(Tet(0).Text) - Val(Tet(1).Text) _
- Val(Tet(2).Text) - Val(Tet(3).Text) - Val(Tet(4).Text) - Val(Tet(5).Text)
End Sub
4.6、系统工具－聊天室的实现
本系统为了给企业提供一个更好的、方便的服务，有效而快速的进行网内各部门之间的通信，更好的协同工作，特增加了系统内部的聊天模块。详见图4-8、图4-9所示
图4-8 服务器端 图4-9 客户端
服务器端相应代码：
Const maxn = 200 '最大同时连接本机的客户数
Dim user(maxn) As Boolean
Private Sub Command1_Click()
Form2.Hide
End Sub
Private Sub Command2_Click()
Load Form1
Form1.Show
End Sub
Private Sub Form_Load()
Dim str1 As String
nowuser = 0
Form2.Caption = "管理系统通信软件"
'注释：winsock控件 a 作为服务器程序监听
a.LocalPort = 3000
a.Listen
End Sub
Private Sub a_ConnectionRequest(ByVal requestID As Long)
Dim i As Long
For i = 1 To maxn '当一客户请求时给启动一Winsock控件标志号
If Not user(i) Then
user(i) = True
Exit For
End If
Next i
If i > maxn Then
Exit Sub
End If
Load b(i) '当一客户请求时启动一Winsock控件
b(i).Accept requestID '注释：实际建立连接
If Text1.Text = "" Then '注释: 发送数据
b(i).SendData Chr(0)
Else
b(i).SendData Text1.Text
End If
Form2.Show
End Sub
Private Sub s_Close(Index As Integer)
b(Index).Close ' 注释: 关闭连接
Unload b(Index) '注释：卸载 一个WinSock 控件
user(Index) = False
End Sub
Private Sub b_DataArrival(Index As Integer, ByVal bytesTotal As Long)
Dim str As String
Dim i As Long
Dim n As Integer
On Error Resume Next '忽略已断开的主机
b(Index).GetData str
Text1.Text = Text1.Text + str
For i = 1 To maxn
If user(i) Then
b(i).SendData str
End If
Next i
End Sub
4.7、系统测试
性能测试与分析
这个阶段的关键任务是通过各种类型的测试及相应的调试，使软件达到预定的的要求，根据分工本人负责整个程序运行以及整个程序调试。
1、测试环境
测试环境为：
操作系统：Windows2000及以上
数据库系统：Access2000。
2、系统测试需求分析
科技成果管理系统作为信息管理系统应用程序，应具有设计文件所规定的功能，各个功能模块都能完成相应的任务，保证用户所输入数据的正确性和安全性。程序设计及相关功能是否符合要求，只有通过严密的测试才能发现问题，尽可能减少错误的发生。所以，必须对系统进行测试，达到纠错改错的目的。
测试方法
软件测试主要分静态和动态分析方法，动态法有白盒和黑盒法，本系统主要采用黑盒法进行测试对程序功能进行测试。
3、系统测试策略说明
4、系统测试方案设计
功能测试采用黑盒测试法，数据设计如下：测试报告见
系统管理模块测试用例：
4.1.1设置操作员、密码、权限 设计测试用例，如表（表4.1.1）：
表4.1.1
| 操作员编号 |
操作员姓名 |
操作员类别 |
用户密码 |
| 01 |
wlz |
系统管理员 |
wlz |
| 02 |
wanglingzhing |
普通用户 |
wlz |
4.1.2设置快捷键用户和登陆密码－测试用例设计如下表
| 第一次测试用例（设计两组相同数据） |
第二次测试用例（两次密码输入不同） |
||||
| 用户名 |
用户密码 |
确认密码 |
用户名 |
用户密码 |
确认密码 |
| 1 |
1 |
1 |
111 |
111 |
11 |
| 第一次输入与预期结果一致、第二次不一致 |
与预期结果不一致 |
||||
此次毕业设计，不尽巩固了所学知识, 而且在这基础上也提高了自己，使我明白需求分析、合理设计数据库，编写代码对软件设计的好坏起了非常重要的作用。由于本身能力的局限性，所以做编写的代码，即使经过反复检查也难免出错所以在本阶段力求使用有限的时间找出尽可能多的错误，力求系统尽量正确。我们在本系统的测试中使用了黑盒法（即不关心程序内部的逻辑结构，而是根据程序的功能来设计是检测）请一位不熟悉本系统的人来进行随意性的操作，打破习惯的操作顺序，从中发现错误，在此阶段系统的大量错误得到了改正。
致 谢
本系统能够顺利完成，非常感谢唐昊老师和周雷老师的精心指导，同时也很感谢二年来各位老师对我的栽培。对于本人来说，这次的毕业设计，是对自己在这二年学习的一个检验和平时学习的一种积累。从中也使我学到了不少东西。希望以后有足够的时间更深入的了解，做好需求分析，为使自己能设计出更好的软件。
参考文献
MsgBox "网络连接失败(超时) ！"
Label3.Caption = "等待连接"
combo1.Enabled = True
combo1.SetFocus
a.Close
comm2.Caption = "连接"
End Sub
附 录
添加用户窗体代码如下：
Private Sub cmdCancel_Click()
Unload Me
Exit Sub
End Sub
Private Sub cmdOK_Click()
Dim sql As String
Dim rs As ADODB.Recordset
If Trim(username.Text) = "" Then
MsgBox "请输入用户名称", vbOKOnly + vbExclamation, "警告"
'Exit Sub
username.SetFocus
Else
sql = "select * from 系统用户 where 用户名='" & username & "'"
Set re = getrs(sql, "gzgl")
If re.EOF = False Then
MsgBox "这个用户已经存在，请重新输入用户名", vbOKOnly + vbExclamation, "警告"
username.SetFocus
username.Text = ""
password.Text = ""
confirmpwd.Text = ""
Exit Sub
Else
If Trim(password.Text) <> Trim(confirmpwd.Text) Then
MsgBox "两次输入密码不一致，请重新输入密码", vbOKOnly + vbExclamation, "警告"
password.Text = ""
confirmpwd.Text = ""
password.SetFocus
Exit Sub
ElseIf Trim(password.Text) = "" Then
MsgBox "密码不能为空", vbOKOnly + vbExclamation, "警告"
password.Text = ""
confirmpwd = ""
password.SetFocus
Else
If AdminCheck = False Then
sql = "insert into 系统用户 (用户名,口令) values('" & username
sql = sql & "','" & password & "')"
Call transactsql(sql, "gzgl")
Else
sql = "insert into 系统用户 (用户名,口令,admin) values('" & username
sql = sql & "','" & password
sql = sql & "','" & UserAdmin & "')"
End If
Call transactsql(sql, "gzgl")
MsgBox "添加成功", vbOKOnly + vbExclamation, "添加结果"
username.Text = ""
password.Text = ""
confirmpwd.Text = ""
username.SetFocus
If Check1 = False Then
Unload Me
End If
End If
End If
End If
End Sub
Private Sub Form_Load()
Me.Left = ReadIni("添加用户", "left")
Me.Top = ReadIni("添加用户", "top")
End Sub
Private Sub Form_Unload(Cancel As Integer)
Call WriteIni("添加用户", "left", Me.Left)
Call WriteIni("添加用户", "top", Me.Top)
End Sub
修改密码窗体代码如下：
Private Sub cmdCancel_Click()
Unload Me
Exit Sub
End Sub
Private Sub cmdOK_Click()
Dim sql As String
Dim rs As ADODB.Recordset
If Trim(oldpwd.Text) = "" Then
MsgBox "请输入旧密码", vbOKOnly + vbExclamation, "提示"
oldpwd.SetFocus
Exit Sub
Else
If Trim(oldpwd.Text) <> Trim(userpassword) Then
MsgBox "旧密码与登录的密码不同，请重新输入！", vbOKOnly + vbExclamation, "提示"
oldpwd.Text = ""
oldpwd.SetFocus
ElseIf Trim(newpwd.Text) = "" Then
MsgBox "请输入新密码", vbOKOnly + vbExclamation, "提示"
newpwd.SetFocus
Exit Sub
ElseIf Trim(newpwd.Text) <> Trim(confirmpwd.Text) Then
MsgBox "两次密码不同", vbOKOnly + vbExclamation, "警告"
newpwd.Text = ""
confirmpwd.Text = ""
newpwd.SetFocus
Else
userpassword = newpwd
sql = "update 系统用户 set 口令='" & newpwd & "'where 用户名='" & strusername & "'"
Call transactsql(sql, "gzgl")
MsgBox "密码已经修改", vbOKOnly + vbExclamation, "修改结果"
Unload Me
End If
End If
End Sub
Private Sub Form_Load()
Me.Left = ReadIni("修改密码", "left")
Me.Top = ReadIni("修改密码", "top")
End Sub
Private Sub Form_Unload(Cancel As Integer)
Call WriteIni("修改密码", "left", Me.Left)
Call WriteIni("修改密码", "top", Me.Top)
End Sub
数据导出：
Dim outType As Integer '导出类型
Dim outPath As String
Dim outSql As String
Private Function outToExcel(ByVal strSql As String, ByVal WorksheeName As String, path As String) As Boolean
On Error GoTo err_outToExcel
'声明excel
Dim objExcel As Excel.Application
Dim objWorkbook As Workbook
Dim objWorksheet As Worksheet
Set objExcel = CreateObject("Excel.Application")
Set objWorkbook = objExcel.Workbooks.Add
Set objWorksheet = objWorkbook.Worksheets("sheet1")
objWorksheet.Name = WorksheeName
'声明adodb
Dim rs As ADODB.Recordset
Dim strMsg As String
Set rs = ExecuteSQL(strSql, strMsg)
i = 1
rs.MoveFirst
Do While Not rs.EOF
For j = 1 To rs.Fields.Count
objExcel.Cells(i, j) = rs.Fields(j - 1)
Next
i = i + 1
rs.MoveNext
Loop
objWorkbook.SaveAs path
objWorkbook.Close
objExcel.Quit
Set objWorksheet = Nothing
Set objWorkbook = Nothing
Set objExcel = Nothing
outToExcel = True
Exit Function
'错误处理
err_outToExcel:
MsgBox Err.Description
On Error Resume Next
objWorkbook.Close
objExcel.Quit
Set objWorksheet = Nothing
Set objWorkbook = Nothing
Set objExcel = Nothing
outToExcel = False
End Function
Private Sub cmdOut_Click()
Select Case outType
Case 1 '导出到Excel
If outToExcel(outSql, "s1", outPath) = True Then
MsgBox "导出成功"
Else
MsgBox "导出失败"
End If
Case 2
If outToWord(outSql, outPath) = True Then
MsgBox "导出成功"
Else
MsgBox "导出失败"
End If
Case 3
If outToText(outSql, outPath) = True Then
MsgBox "导出成功"
Else
MsgBox "导出失败"
End If
End Select
End Sub
Private Sub cmdPath_Click()
Select Case outType
Case 1
cdgPath.Filter = "Excel文件(*.xls)|*.xls"
Case 2
cdgPath.Filter = "Word文件(*.doc)|*.doc"
Case 3
cdgPath.Filter = "记事本(*.txt)|*.txt"
End Select
cdgPath.ShowSave
txtPath.Text = cdgPath.FileName
End Sub
Private Sub cmdPre_Click()
SSTab1.Tab = 1
End Sub
Private Sub cmdSelNext_Click()
If optExcel.Value = True Then
outType = 1
txtMessage.Text = "导出到Excel" & vbCrLf
txtPath = App.path & "\DBBackup\1.xls"
ElseIf optWord.Value = True Then
txtMessage.Text = "导出到Word" & vbCrLf
outType = 2
txtPath = App.path & "\DBBackup\1.doc"
Else
txtMessage.Text = "导出到记事本" & vbCrLf
outType = 3
txtPath = App.path & "\DBBackup\1.txt"
End If
txtSql = "select 工号,姓名,性别,薪金,所学专业,职务,工资类别,合同开始时间,合同终止时间,职工类型,工龄,生日,年龄,文化程度,民族,婚姻状况,政治面貌,身份证号,籍贯,联系电话,手机,家庭住址,健康状况 from t_br"
SSTab1.Tab = 1
End Sub
Private Sub cmdSetNext_Click()
txtMessage.Text = ""
If optExcel.Value = True Then
txtMessage.Text = "导出到Excel" & vbCrLf
ElseIf optWord.Value = True Then
txtMessage.Text = "导出到Word" & vbCrLf
Else
txtMessage.Text = "导出到记事本" & vbCrLf
End If
outPath = Trim(txtPath.Text)
outSql = txtSql.Text
txtMessage.Text = txtMessage.Text & vbCrLf & "导出路径为：" & outPath
txtMessage.Text = txtMessage.Text & vbCrLf & "查询语句为：" & outSql
SSTab1.Tab = 2
End Sub
Private Sub cmdSetPre_Click()
SSTab1.Tab = 0
End Sub
Private Function outToWord(ByVal strSql As String, ByVal path As String) As Boolean
On Error GoTo err_outToWord
Dim wRow As Integer
Dim wCol As Integer
'声明Adodb
Dim rs As ADODB.Recordset
Dim strMsg As String
Set rs = ExecuteSQL(strSql, strMsg)
wRow = rs.RecordCount
wCol = rs.Fields.Count
'声明Word对象
Dim objWord As Word.Application
Set objWord = CreateObject("word.application")
Dim objDocument As New Document
Set objDocument = objWord.Documents.Add
objDocument.Tables.Add Range:=objWord.Selection.Range, NumRows:=wRow, NumColumns:=wCol
rs.MoveFirst
j = 1
Do While Not rs.EOF
For i = 1 To wCol
objDocument.Tables(1).Cell(j, i).Select
objWord.Selection.Range.Text = rs.Fields(i - 1).Value
Next
j = j + 1
rs.MoveNext
Loop
objDocument.SaveAs FileName:=path
objDocument.Close
Set objDocument = Nothing
objWord.Quit
Set objWord = Nothing
outToWord = True
Exit Function
'错误处理
err_outToWord:
MsgBox Err.Description
On Error Resume Next
objDocument.Close
Set objDocument = Nothing
objWord.Quit
Set objWord = Nothing
outToWord = False
End Function
Private Function outToText(ByVal strSql As String, ByVal path As String) As Boolean
On Error GoTo err_outToText
Dim rs As ADODB.Recordset
Dim strMsg As String
Dim field_with() As Integer
Set rs = ExecuteSQL(strSql, strMsg)
Dim f1
f1 = FreeFile
Open path For Output As f1
ReDim field_width(rs.Fields.Count - 1)
rs.MoveFirst
Do While Not rs.EOF
For i = 0 To rs.Fields.Count - 1
field_width(i) = rs.Fields(i).DefinedSize
If field_width(i) < Len(rs.Fields(i).Name) Then
field_width(i) = Len(rs.Fields(i).Name)
End If
Print #f1, rs.Fields(i).Value;
Print #f1, Space$(field_width(i) - Len(rs.Fields(i).Value));
Next
Print #f1, ""
rs.MoveNext
Loop
Close f1
rs.Close
Set rs = Nothing
outToText = True
Exit Function
err_outToText:
MsgBox Err.Description
On Error Resume Next
Close f1
rs.Close
Set rs = Nothing
outToText = False
End Function
Private Sub Form_Load()
SSTab1.Tab = 0
End Sub
聊天室客户端相应代码：
Dim flag As Boolean '注释：连接状态变量
Private Sub a_Connect()
flag = True
End Sub
Private Sub a_DataArrival(ByVal bytesTotal As Long)
Dim i As String
a.GetData i
send.Enabled = True
Label3.Caption = "连接成功！"
comm2.MousePointer = 0
Form1.MousePointer = 0
Timer1.Enabled = False
If i = Chr(0) Then
Text2.Text = txtName.Text + " 你好！ " + Chr(13) + Chr(10) + " 你是今天第一个进入本聊天室的客户。" + Chr(13) + Chr(10)
Else
Text2.Text = Text2.Text + i
End If
Text2.SelStart = Len(Text2.Text)
send.MousePointer = 0
combo1.Enabled = False
comm2.Caption = "断开连接"
Text1.SetFocus
End Sub
Private Sub a_Error(ByVal Number As Integer, Description As String, ByVal Scode As Long, ByVal Source As String, ByVal HelpFile As String, ByVal HelpContext As Long, CancelDisplay As Boolean)
flag = False
Timer1.Enabled = False
comm2.MousePointer = 0
Form1.MousePointer = 0
MsgBox "网络连接失败 ！"
Label3.Caption = "等待连接"
combo1.Enabled = True
combo1.SetFocus
a.Close
comm2.Caption = "连接"
End Sub
Private Sub Comm1_Click()
If MsgBox("关闭本聊天室! 确认吗?", 36, "退出系统") = 6 Then
a.Close '注释: 关闭连接
Form1.WindowState = 1
Unload Me
End If
End Sub
Private Sub Comm2_Click()
If comm2.Caption = "断开连接" Then
a.Close
send.Enabled = False
comm2.Caption = "连接"
Label3.Caption = "等待连接"
combo1.Enabled = True
Timer1.Enabled = False
comm2.MousePointer = 0
Form1.MousePointer = 0
Else
Text2.Text = ""
Label3.Caption = "正在连接.."
comm2.MousePointer = 11
Form1.MousePointer = 11
Timer1.Enabled = True
flag = False
a.Protocol = sckTCPProtocol
a.RemoteHost = combo1.Text
a.RemotePort = 3000
a.Connect
End If
End Sub
Private Sub Form_Load()
If App.PrevInstance Then
MsgBox "本系统已经加载，请看任务拦！", 48, "提示"
End
End If
flag = False
Load Form2 '读入form2进入监听
End Sub
Private Sub Send_Click()
Dim S As String
Dim k As Integer
On Error GoTo ffff '防止链路中断
send.MousePointer = 11
If Right(Text1.Text, 1) <> Chr(10) Then
S = txtName.Text + "： " + Chr(13) + Chr(10) + " " + Text1.Text + Chr(13) + Chr(10)
Else
S = Text1.Text
End If
If Len(Trim(txtName.Text)) = 0 Then
MsgBox "请输入尼称!", vbOKOnly, "聊天室"
txtName.SetFocus
send.MousePointer = 0
Else
k = Len(Trim(Text1.Text))
If k = 0 Then
send.MousePointer = 0
MsgBox "不能发送空消息!", vbOKOnly, "聊天室"
Text1.SetFocus
Else
If flag Then
a.SendData S
Text1.Text = ""
End If
End If
End If
Exit Sub
ffff:
MsgBox "连接中断!", 48, "提示"
a.Close
send.MousePointer = 0
comm2.Caption = "连接"
Label3.Caption = "等待连接"
combo1.Enabled = True
comm2.MousePointer = 0
Form1.MousePointer = 0
Exit Sub
End Sub
Private Sub Timer1_Timer()
flag = False
Timer1.Enabled = False
comm2.MousePointer = 0
Form1.MousePointer = 0
- 对象 (Object)
- 属性 (Properties)
- 事件 (Events)
- 方法 (Method)
- 过程 (Procedure)
- 模块 (Module)
- 数据库的概念
- 新建一个数据库
- 修改已建的数据库
- 用户和组管理功能
- 数据的添加、删除、修改功能
- 数据统计功能
- 信息保存功能
- 数据导出功能
- 方便的数据库备份功能
- 提供实用的工具箱
- 整个系统界面窗口的测试项目
- 相关输入或输出命令能否正常打开？
- 页面显示是否正常，读数据库时是否出错？
- 业务流程是否合理，是否适合用户操作？
- 数据项测试项目
- 能否识别输入数据的类型和长度？
- 异常处理能否保证系统在不正确的操作下运行，能否识别非法数据？
- 数据库在大量的数据输入输出时能否正常运行？
- 数据写入数据库时能否写入到对应的字段？
- 结束语
- 孙 越 ，Visual Basic数据库开发自学教程，人民邮电出版社，2003
- 龚沛曾， 面向对象程序设计系列教材，高等教育出版社，2004
- 潭 浩， 学用Visual Basic 编程 ，西安电子科技大学出版社，2000
- 刘 萌， Visual Basic6.0 数据库开发与实例导航，人民邮电出版社，2004
- 汤发良， 我国企业内部冲突状态的评价测度模型 ，1999
- Visual Basic6.0 数据库精讲100例，电子工业出版社，2003
- Visual Basic6.0程序设计实验， 中央广播电视大学出版社，2006
- Professional Developer Community vb开发技术论坛