职工项目管理系统.doc

分类编号 理工学院 数据库应用 课程设计专 业 班 级 电商L071 学 生 姓 名苏红艳 学 号 071609131 指 导 教 师 张娜萍、张冬丽 2009 年 12 月 25 日职工项目管理系统一 系统功能分析系统开发的总体任务是实现职工项目信息关系的系统化，规范化和自动化。主要功能有：1 有关职工等信息的输入，包括输入职工基本信息(职工号,职工姓名,性别,生日,评价)，所在部门，所参加项目和奖金等。2 职工信息的查询，包括查询职工基本信息，所在部门，所参加项目和奖金等3 部门管理信息(部门编号,部门名称,部门负责人,地址,电话)的输入，信息查询，信息修改4 项目基本信息(项目编号,项目名称,负责人,项目类型,成员,开始时间,结束时间,金额)输入，信息修改，查询及统计，5职工项目情况的设置和修改6 职工参与项目情况的统计及查询二系统功能模块设计 职工项目管理系统职工基本年息管理部门信息管理项目信息管理系统管理职工信息添加职工信息修改职工信息查询部门信息添加部门信息修改部门信息查询项目信息添加项目信息修改项目信息查询用户管理密码管理先设置部门，再添加职工基本情况和项目情况。三表1职工信息基本表（职工号、职工姓名、性别、生日、基本工资、联系电话、奖金、评价）2部门（部门编号、部门名称、部门负责人、地址、办公电话）3项目（项目编号、项目名称、合作单位、负责人、项目类型(设计类、工程类、开发类)、成员、开始时间、完工时间、项目金额）4职工项目表（职工号、项目号、分工）5分工系数表（分工、系数）6用户表（用户名、用户密码）四数据库概念结构设计根据数据库的设计规划出的实体有：职工实体，部门实体，项目实体，各个实体具体的描述E-R图如下职工实体 职工基本信息职工系数信息职工项目信息职工部门信息部门实体 部门编号部门名称领导人办公电话部门地址 项目金额完工时间开始时间合作单位参加成员项目类型负责人项目名称项目编号项目实体 实体和实体之间的关系E-R如下项目进行分工职工项目设置部门部门设置五程序总体结构：ZGXMSYSTEM系统的module1模块Public fMainForm As frmmainPublic UserName As StringSub Main() Dim fLogin As New frmlogin fLogin.Show vbModal If Not fLogin.OK Then Login Failed so exit app End End If Unload fLogin Set fMainForm = New frmmain fMainForm.ShowEnd SubPublic Function ConnectString() _ As Stringreturns a DB ConnectString ConnectString = FileDSN=zgxmsystem.dsn;UID=;PWD=End FunctionPublic Function ExecuteSQL(ByVal SQL _ As String, MsgString As String) _ As ADODB.Recordsetexecutes SQL and returns Recordset Dim cnn As ADODB.Connection Dim rst As ADODB.Recordset Dim sTokens() As String On Error GoTo ExecuteSQL_Error sTokens = Split(SQL) Set cnn = New ADODB.Connection cnn.Open ConnectString If InStr(INSERT,DELETE,UPDATE, _ UCase$(sTokens(0) Then cnn.Execute SQL MsgString = sTokens(0) & _ query successful Else Set rst = New ADODB.Recordset rst.Open Trim$(SQL), cnn, _ adOpenKeyset, _ adLockOptimistic rst.MoveLast get RecordCount Set ExecuteSQL = rst MsgString = 查询到 & rst.RecordCount & _ 条记录 End IfExecuteSQL_Exit: Set rst = Nothing Set cnn = Nothing Exit Function ExecuteSQL_Error: MsgString = 查询错误: & _ Err.Description Resume ExecuteSQL_ExitEnd FunctionPublic Function Testtxt(txt As String) As Boolean If Trim(txt) = Then Testtxt = False Else Testtxt = True End IfEnd FunctionODBC配置 系统用户管理模块的创建主要实现：1 用户登录2 添加用户3 修改用户密码系统启动后，将首先出现如下图所示的用户登录窗体，用户首先输入用户名，然后输入密码，如果用户3次输入密码不正确，将退出程序。用户登录窗体中放置两个文本文档（TextBox）,用来输入用户名和用户密码；两个按钮（CommandButton）用来确定或取消登录；4个标签（Label）用来标示窗体的信息。为窗体定义全局变量OK，用来判断登陆是否成功；定义miCount，用来记载输入密码的次数，并且在载入窗体时初始化这两个变量，代码如下：用户登录窗体创建强制变量声明代码实现如下：Option ExplicitPublic OK As Boolean记录确定次数Dim miCount As IntegerPrivate Sub Form_Load()OK = False miCount = 0End SubOption Explicit 是用来规定所有变量使用前必须定义。这样可以避免由于输入错误而产生的新变量。当用户输入完用户名和用户密码，单击cmdOK按钮将对用户输入信息进行判断。用户单击按钮，将触发按钮cmdOK的Click事件，代码如下：Private Sub cmdOK_Click()用来存放SQL语句 Dim txtSQL As String 用来存放记录集对象Dim mrc As ADODB.Recordset 用来存放返回信息 Dim MsgText As String ToDo: create test for correct password check for correct password UserName = If Trim(txtUserName.Text = ) Then 判断输入用户名为空 MsgBox 没有这个用户，请重新输入用户名！, vbOKOnly + vbExclamation, 警告 txtUserName.SetFocus Else txtSQL = select * from unser where user_name = & txtUserName.Text & Set mrc = ExecuteSQL(txtSQL, MsgText) If mrc.EOF = True Then MsgBox 没有这个用户，请重新输入用户名!, vbOKOnly + vbExclamation, 警告 txtUserName.SetFocus Else If Trim(mrc.Fields(1) = Trim(txtPassword.Text) Then OK = True mrc.Close Me.Hide UserName = Trim(txtUserName.Text) Else MsgBox 输入密码不正确，请重新输入！, vbOKOnly + vbExclamation, 警告 txtPassword.SetFocus txtPassword.Text = End If End If End If miCount = miCount + 1 If miCount = 3 Then Me.Hide End If Exit SubEnd Sub用户如果没有输入用户名密码，将出现消息框给予提示。如果输入的用户名在用户表格中没有找到，将提示重新输入用户名，文本档txtUserName将重新获得输入焦点。如果用户输入密码不正确，文本档txtUserName将重新获得输入焦点。用户登录成功，全局变量OK将被赋值为Ture；一旦三次输入密码均不正确，全局变量OK将被赋值为False。公用模块中的Main过程将根据OK的值决定是退出，或者进入系统。如果用户取消登录，单击“取消”按钮，将触发按钮的Click事件；代码如下： OK=False me.HideMe是Visual Basic中一个常用的对象，用来指代当前对象本身。 添加用户窗体创建用户需要两次输入密码，用来确保输入密码的正确。用户输入信息完毕，单击“确定”按键将触发Click事件，代码如下：Private Sub CommOK_Click() Dim txtSQL As String Dim mrc As ADODB.Recordset Dim MsgText As String If Trim(text1(0).Text) = Then MsgBox 请输入用户名称！, vbOKOnly + vbExclamation, 警告 Exit Sub text1(0).SetFocus Else txtSQL = select * from unser Set mrc = ExecuteSQL(txtSQL, MsgText) While (mrc.EOF = False) If Trim(mrc.Fields(0) = Trim(text1(0) Then MsgBox 用户已经存在，请重新输入用户名！, vbOKOnly + vbExclamation, 警告 text1(0).SetFocus text1(0).Text = text1(1).Text = text1(2).Text = Exit Sub Else mrc.MoveNext End If Wend End If If Trim(text1(1).Text) Trim(text1(2).Text) Then MsgBox 两次输入密码不一样，请确认！, vbOKOnly + vbExclamation, 警告 text1(1).SetFocus text1(1).Text = text1(2).Text = Exit Sub Else If text1(1).Text = Then MsgBox 密码不能为空！, vbOKOnly + vbExclamation, 警告 text1(1).SetFocus text1(1).Text = text1(2).Text = Else mrc.AddNew mrc.Fields(0) = Trim(text1(0).Text) mrc.Fields(1) = Trim(text1(1).Text) mrc.Update mrc.Close Me.Hide MsgBox 添加用户成功！, vbOKOnly + vbExclamation, 添加用户 End If End If End SubPrivate Sub Commcancel_Click() Unload MeEnd Sub一旦输入密码完毕，系统将首先查询数据库中与新建用户名相同的记录，如果有相同的记录将提示用户重新输入用户名。但确定数据库中没有相同的用户名，并且两次输入密码一致的时候，将把该条记录添加到数据库中。单击取消按钮将取消添加用户的操作。 修改用户密码窗体创建两次输入密码后，单击“确认”按钮，将触发Click事件判断是否修改密码，代码如下:Private Sub Command2_Click() Unload MeEnd SubPrivate Sub Command1_Click() Dim txtSQL, MsgText As String Dim mrc As ADODB.Recordset If Trim(Text1(1).Text) Trim(Text1(2).Text) Then MsgBox 密码输入不正确！, vbOKOnly + vbExclamation, 警告 Text1(1).SetFocus Text1(1).Text = Else txtSQL = select * from unser where user_name = & UserName & Set mrc = ExecuteSQL(txtSQL, MsgText) mrc.Fields(1) = Text1(1).Text mrc.Update mrc.Close MsgBox 密码修改成功！, vbOKOnly + vbExclamation, 修改密码 Me.Hide End If End Sub 职工管理模块的创建功能如下1添加职工信息2 修改职工信息3 查询职工信息代码如下：添加代码如下：添加职工信息窗体创建Private Sub Command1_Click() 定义数据集对象Dim mrc As ADODB.Recordset 定义字符串变量，表示查询语句Dim txtSQL As String 定义字符串变量，返回查询信息 Dim MsgText As String是否输入职工号If Not Testtxt(txtSID.Text) Then MsgBox 请输入职工号！, vbOKOnly + vbExclamation, 警告 txtSID.SetFocus Exit Sub End If If Not Testtxt(txtName.Text) Then MsgBox 请输入姓名！, vbOKOnly + vbExclamation, 警告 txtName.SetFocus Exit Sub End If If Not Testtxt(comboSex.Text) Then MsgBox 请选择性别！, vbOKOnly + vbExclamation, 警告 comboSex.SetFocus Exit Sub End If If Not Testtxt(txtBorndate.Text) Then MsgBox 请输入出生日期！, vbOKOnly + vbExclamation, 警告 txtBorndate.SetFocus Exit Sub End If If Not Testtxt(txtwage.Text) Then MsgBox 请输入基本工资！, vbOKOnly + vbExclamation, 警告 txtwage.SetFocus Exit Sub End If If Not Testtxt(txtTel.Text) Then MsgBox 请输入联系电话！, vbOKOnly + vbExclamation, 警告 txtTel.SetFocus Exit Sub End If If Not Testtxt(Text1.Text) Then MsgBox 请输入奖金数额！, vbOKOnly + vbExclamation, 警告 Text1.SetFocus Exit Sub End If If Not Testtxt(txtComment.Text) Then MsgBox 请输入对此员工的评价！, vbOKOnly + vbExclamation, 警告 txtComment.SetFocus Exit Sub End If If Not IsNumeric(Trim(txtSID.Text) Then MsgBox 请输入数字！, vbOKOnly + vbExclamation, 警告 Exit Sub txtSID.SetFocus End If txtSQL = select * from employee where employee_id = & Trim(txtSID.Text) & Set mrc = ExecuteSQL(txtSQL, MsgText) If mrc.EOF = False Then MsgBox 职工号重复，请重新输入！, vbOKOnly + vbExclamation, 警告 mrc.Close txtSID.SetFocus Else mrc.Close If Not IsDate(txtBorndate.Text) Then MsgBox 出生时间应输入日期格式（yyyy-mm-dd）！, vbOKOnly + vbExclamation, 警告 txtBorndate.SetFocus Else txtSQL = select * from employee Set mrc = ExecuteSQL(txtSQL, MsgText) mrc.AddNew mrc.Fields(0) = Trim(txtSID.Text) mrc.Fields(1) = Trim(txtName.Text) mrc.Fields(2) = Trim(comboSex.Text) mrc.Fields(3) = Trim(txtBorndate.Text) mrc.Fields(4) = Trim(txtwage.Text) mrc.Fields(5) = Trim(txtTel.Text) mrc.Fields(6) = Trim(Text1.Text) mrc.Fields(7) = Trim(txtComment.Text) mrc.Update MsgBox 添加职工信息成功！, vbOKOnly + vbExclamation, 警告 mrc.Close Me.Hide End If End If End SubPrivate Sub Command2_Click() Unload MeEnd SubPrivate Sub Form_Load() Dim mrc As ADODB.Recordset Dim txtSQL As String Dim MsgText As String Dim i As Integer comboSex.AddItem 男 comboSex.AddItem 女 txtSQL = select * from employee Set mrc = ExecuteSQL(txtSQL, MsgText) mrc.CloseEnd Sub程序首先对是否输入内容进行判断，然后进行格式判断，使用了下面函数判断数据是否日期格式IsDate(txtBorndate.Text)判断是否有重复记录是很重要的，否则数据库中将发生错误。修改职工信息窗体创建定义数据集对象Dim mrc As ADODB.Recordset定义书签，用来记载当前记录位置Dim myBookmark As Variant判断是否修改记录Dim mcclean As Boolean程序在窗体载入时自动加入各条记录Private Sub editCommand_Click() mcclean = False Frame2.Enabled = False firstCommand.Enabled = False previousCommand.Enabled = False nextCommand.Enabled = False lastCommand.Enabled = False txtSID.Enabled = True txtName.Enabled = True comboSex.Enabled = True txtBorndate.Enabled = True txtRudate.Enabled = True txtTel.Enabled = True Txt1.Enabled = True txtComment.Enabled = True myBookmark = mrc.BookmarkEnd SubPrivate Sub cancelCommand_Click() If Not mcclean Then Frame2.Enabled = True firstCommand.Enabled = True previousCommand.Enabled = True nextCommand.Enabled = True lastCommand.Enabled = True txtSID.Enabled = False txtName.Enabled = False comboSex.Enabled = False txtBorndate.Enabled = False txtRudate.Enabled = False txtTel.Enabled = False Txt1.Enabled = False txtComment.Enabled = False mrc.Bookmark = myBookmark Call viewData Else MsgBox 什么都没有修改，有什么好取消的！, vbOKOnly + vbExclamation, 警告 End If End SubPrivate Sub deleteCommand_Click() myBookmark = mrc.Bookmark str2$ = MsgBox(是否删除当前记录？, vbOKCancel, 删除当前记录) If str2$ = vbOK Then mrc.MoveNext If mrc.EOF Then mrc.MoveFirst myBookmark = mrc.Bookmark mrc.MoveLast mrc.Delete mrc.Bookmark = myBookmark Call viewData Else myBookmark = mrc.Bookmark mrc.MovePrevious mrc.Delete mrc.Bookmark = myBookmark Call viewData End If Else mrc.Bookmark = myBookmark Call viewData End IfEnd SubPrivate Sub firstCommand_Click() mrc.MoveFirst Call viewDataEnd SubPrivate Sub Form_Load() Dim txtSQL As String Dim MsgText As String txtSQL = select * from employee Set mrc = ExecuteSQL(txtSQL, MsgText) mrc.MoveFirst显示数据 Call viewData mcbookmark = mrc.Bookmark mcclean = TrueEnd Sub由于程序各处需要显示数据，定义函数viewDataPublic Sub viewData() txtSID.Text = mrc.Fields(0) txtName.Text = mrc.Fields(1) comboSex.Text = mrc.Fields(2) txtBorndate.Text = mrc.Fields(3) txtTel.Text = mrc.Fields(4) txtRudate.Text = mrc.Fields(5) Txt1.Text = mrc.Fields(6) txtComment.Text = mrc.Fields(7)End SubPrivate Sub lastCommand_Click() mrc.MoveLast Call viewDataEnd SubPrivate Sub nextCommand_Click() mrc.MoveNext If mrc.EOF Then mrc.MoveFirst End If Call viewDataEnd SubPrivate Sub previousCommand_Click() mrc.MovePrevious If mrc.BOF Then mrc.MoveLast End If Call viewDataEnd SubPrivate Sub updateCommand_Click() Dim txtSQL As String Dim MsgText As String Dim mrcc As ADODB.Recordset If mcclean Then MsgBox 请先修改职工信息, vbOKOnly + vbExclamation, 警告 Exit Sub End If If Not Testtxt(txtSID.Text) Then MsgBox 请输入职工号！, vbOKOnly + vbExclamation, 警告 txtSID.SetFocus Exit Sub End If If Not Testtxt(txtName.Text) Then MsgBox 请输入姓名！, vbOKOnly + vbExclamation, 警告 txtName.SetFocus Exit Sub End If If Not Testtxt(comboSex.Text) Then MsgBox 请选择性别！, vbOKOnly + vbExclamation, 警告 comboSex.SetFocus Exit Sub End If If Not Testtxt(txtBorndate.Text) Then MsgBox 请输入出生日期！, vbOKOnly + vbExclamation, 警告 txtBorndate.SetFocus Exit Sub End If If Not Testtxt(txtRudate.Text) Then MsgBox 请输入基本工资！, vbOKOnly + vbExclamation, 警告 txtRudate.SetFocus Exit Sub End If If Not Testtxt(txtTel.Text) Then MsgBox 请输入联系电话！, vbOKOnly + vbExclamation, 警告 txtTel.SetFocus Exit Sub End If If Not Testtxt(Txt1.Text) Then MsgBox 请输入所获奖金！, vbOKOnly + vbExclamation, 警告 Txt1.SetFocus Exit Sub End If If Not Testtxt(txtComment.Text) Then MsgBox 请输入评价！, vbOKOnly + vbExclamation, 警告 txtAddress.SetFocus Exit Sub End If If Not IsNumeric(Trim(txtSID.Text) Then MsgBox 职工号请输入数字！, vbOKOnly + vbExclamation, 警告 txtSID.SetFocus Exit Sub End If mrc.Delete txtSQL = select * from employee where employee_id = & Trim(txtSID.Text) & Set mrcc = ExecuteSQL(txtSQL, MsgText) If mrcc.EOF = False Then MsgBox 学号重复，请重新输入！, vbOKOnly + vbExclamation, 警告 mrcc.Close txtSID.SetFocus Else mrcc.Close If Not IsDate(txtBorndate.Text) Then MsgBox 出生时间应输入日期格式（yyyy-mm-dd）！, vbOKOnly + vbExclamation, 警告 txtBorndate.SetFocus Else txtBorndate = Format(txtBorndate, yyyy-mm-dd mrc.AddNew mrc.Fields(0) = Trim(txtSID.Text) mrc.Fields(1) = Trim(txtName.Text) mrc.Fields(2) = Trim(comboSex.Text) mrc.Fields(3) = Trim(txtBorndate.Text) mrc.Fields(4) = Trim(txtRudate.Text) mrc.Fields(5) = Trim(txtTel.Text) mrc.Fields(6) = Trim(Txt1.Text) mrc.Fields(7) = Trim(txtComment.Text) mrc.Update MsgBox 修改职工信息成功！, vbOKOnly + vbExclamation, 修改职工信息 mrc.Bookmark = myBookmark Call viewData Frame2.Enabled = True firstCommand.Enabled = True previousCommand.Enabled = True nextCommand.Enabled = True lastCommand.Enabled = True txtSID.Enabled = False txtName.Enabled = False comboSex.Enabled = False txtBorndate.Enabled = False txtRudate.Enabled = False txtTel.Enabled = False Txt1.Enabled = False txtComment.Enabled = False mcclean = True End If End If End End Sub 查询职工信息窗体的创建Private Sub cmdExit_Click() Unload MeEnd SubPrivate Sub cmdInquire_Click() Dim txtSQL A