项目实训代码_(1).doc

FORM1 Me.frmPrivate Sub Form1_Load()Option ExplicitPublic LoginSucceeded As Boolean引用Microsoft ActiveX Data Objects 2.6 Library定义连接对象和记录集Dim conn As ADODB.ConnectionDim rs As ADODB.Recordset对取消按钮单击事件的响应Private Sub cmdCancel_Click()设置全局变量为 false不提示失败的登录LoginSucceeded = FalseMe.HideEnd Sub对登录按钮单击事件的响应Private Sub cmdOK_Click()Set conn = New ADODB.ConnectionSet rs = New ADODB.Recordset建立无源数据库连接conn.ConnectionString = driver=sql server;server=Dell-181;uid=sa;pwd=;Database=人事系统管理conn.ConnectionTimeout = 50conn.OpenDim str As String连接连接对象Set rs.ActiveConnection = conn设置游标类型rs.CursorType = adOpenDynamicIf Trim(txtUserName.Text = ) ThenMsgBox 用户名不能为空，请重新输入用户名！, vbOKOnly + vbExclamation, 警告txtUserName.SetFocusElse设置查询字符串str = select * from login_user where name = & Trim(txtUserName.Text) & rs.Open strIf rs.EOF = True ThenMsgBox 没有这个用户，请重新输入用户名!, vbOKOnly + vbExclamation, 警告txtUserName.SetFocusElse登录成功，连接主窗口If (Trim(txtPassword.Text) = Trim(rs.Fields(password) ThenLoginSucceeded = TrueMe.HideForm2.ShowElseMsgBox 密码不正确，请重输入密码!, , 警告txtPassword.SetFocusSendKeys Home+EndEnd IfEnd IfEnd IfEnd SubPrivate Sub Label5_Click()Form8.ShowMe.HideEnd SubForm 2 人事管理系统菜单Private Sub Command1_Click()Form2.HideForm4.ShowEnd SubPrivate Sub Command2_Click()Form2.HideForm5.ShowEnd SubPrivate Sub Command3_Click()Form2.HideForm6.ShowEnd SubPrivate Sub Command4_Click()Dim strResult As String strResult = MsgBox(请在原处修改员工信息，修改后请刷新!, vbOKOnly + vbExclamation, 编辑员工信息) Exit SubEnd SubPrivate Sub Command5_Click()Dim strResult As String strResult = MsgBox(是否真的要删除该员工信息?, vbYesNoCancel + vbQuestion + vbDefaultButton1, 退出询问) If strResult = vbYes Then Adodc1.Recordset.Delete Adodc1.Recordset.MovePrevious Else If strResult = vbNo Then End IfEnd IfEnd SubPrivate Sub Command6_Click() Dim name$ Adodc1.Recordset.MoveFirst name = Trim(InputBox(请输入姓名) Adodc1.Recordset.Find 姓名= & & name & If Not Adodc1.Recordset.EOF Then MsgBox Adodc1.Recordset.Fields(姓名) & & Adodc1.Recordset.Fields(职工编号) & & Adodc1.Recordset.Fields(电话) Else MsgBox 没有该职工记录 End IfEnd SubPrivate Sub Command7_Click()EndEnd SubPrivate Sub Command8_Click()Adodc1.Recordset.AddNewcmdAdd.Enabled = Flasecmdexit.Enabled = FalseCmddel.Enabled = FalsecmdUpdate.Enabled = TruecmdFind.Enabled = TrueEnd SubPrivate Sub fenlei_Click()Form2.HideForm12.ShowEnd SubPrivate Sub guanyu_Click()Form2.HideForm10.ShowEnd SubPrivate Sub menuexit_Click()Form2.HideForm1.ShowEnd SubPrivate Sub menufzxmglsubgzbmgl_Click()Form2.HideForm7.ShowEnd SubPrivate Sub menufzxmglygbb_Click()Form2.HideForm9.ShowEnd SubPrivate Sub menusalarysubsearch_Click()Form2.HideForm6.ShowEnd SubPrivate Sub menuxsglsubxsadd_Click()Form2.HideForm3.ShowEnd SubPrivate Sub menuxsglsubxscx_Click()Form2.HideForm4.ShowEnd SubPrivate Sub menuxsglsubxsdel_Click()Form2.HideForm5.ShowEnd SubPrivate Sub zhuce_Click()Form2.HideForm8.ShowEnd SubPrivate Sub zhuti_Click()Form2.HideForm11.ShowEnd SubPrivate Sub zhuxiao_Click()Form2.HideForm1.ShowEnd SubForm3 员工信息添加Private Sub cmdAdd_Click()If cmdAdd.Caption = 确定 ThenAdodc1.Recordset.updatecmdAdd.Caption = 添加记录ElseAdodc1.Recordset.AddNewcmdAdd.Caption = 确定update.Enabled = TrueEnd IfEnd SubPrivate Sub cmdexit_Click()Form3.HideForm2.ShowEnd SubPrivate Sub Cmdnext_Click()Adodc1.Recordset.MoveNextCmdnext.Enabled = TrueIf Adodc1.Recordset.EOF ThenAdodc1.Recordset.MoveLastCmdnext.Enabled = FalseEnd IfEnd SubPrivate Sub Cmdprev_Click()Adodc1.Recordset.MovePreviousCmdnext.Enabled = TrueIf Adodc1.Recordset.BOF ThenAdodc1.Recordset.MoveFirstCmdprev.Enabled = FalseEnd IfEnd SubPrivate Sub Command2_Click(Index As Integer)Set DataGrid1.DataSource = Adodc1MsgBox 员工人数 = & Adodc1.Recordset.RecordCountEnd SubPrivate Sub update_Click()Adodc1.Recordset.updateEnd SubForm4 员工信息查询Private Sub cmdFind_Click()If Txtfind.Text = ThenMsgBox 请选择查询项目并输入查询内容！, 48, 提示 Exit Sub End IfAdodc1.RefreshAdodc1.Recordset.MoveFirst Adodc1.Recordset.Find CombFind.Text & = & & Txtfind.Text & If Adodc1.Recordset.EOF Then MsgBox 记录不存在, 64, 提示 End If End SubPrivate Sub Command3_Click()Form4.HideForm2.ShowEnd SubPrivate Sub Form_Load()Adodc1.Visible = FalseCombFind.AddItem 姓名CombFind.AddItem 职工编号CombFind.AddItem 身份证号CombFind.AddItem 电话End SubForm5 员工信息删除Private Sub Cmddel_Click()Dim strResult As String strResult = MsgBox(是否真的要删除该员工信息?, vbYesNoCancel + vbQuestion + vbDefaultButton1, 退出询问) If strResult = vbYes Then Adodc1.Recordset.Delete Adodc1.Recordset.MovePrevious Else If strResult = vbNo Then End IfEnd IfEnd SubPrivate Sub Command1_Click()Set DataGrid1.DataSource = Adodc1MsgBox 员工人数 = & Adodc1.Recordset.RecordCountEnd SubPrivate Sub Command2_Click()Adodc1.Recordset.updateEnd SubPrivate Sub Command3_Click()Form5.HideForm2.ShowEnd SubPrivate Sub Label7_Click()Adodc1.Refresh Adodc1.Recordset.MoveFirst Adodc1.CommandType = adCmdText Adodc1.RecordSource = select * from yuangong order by 职工编号 asc Adodc1.RefreshEnd SubPrivate Sub Label8_Click()Adodc1.Refresh Adodc1.Recordset.MoveFirst Adodc1.CommandType = adCmdText Adodc1.RecordSource = select * from yuangong order by 职工编号 desc Adodc1.RefreshEnd SubForm6 薪酬Private Sub cmdAdd_Click()If cmdAdd.Caption = 确定 ThenAdodc1.Recordset.updatecmdAdd.Caption = 添加记录ElseAdodc1.Recordset.AddNewcmdAdd.Caption = 确定update.Enabled = TrueEnd IfEnd SubPrivate Sub cmdFind_Click()Dim 职工编号$ Adodc1.Recordset.MoveFirst 职工编号 = Trim(InputBox(请输入职工编号) Adodc1.Recordset.Find 职工编号= & & 职工编号 & If Not Adodc1.Recordset.EOF Then Else MsgBox 没有该职工记录 End IfEnd SubPrivate Sub Command1_Click()Dim strResult As String strResult = MsgBox(是否真的要删除该员工信息?, vbYesNoCancel + vbQuestion + vbDefaultButton1, 退出询问) If strResult = vbYes Then Adodc1.Recordset.Delete Adodc1.Recordset.MovePrevious Else If strResult = vbNo Then End IfEnd IfEnd SubPrivate Sub Command3_Click()Form6.HideForm2.ShowEnd SubPrivate Sub Command4_Click()Dim strResult As String strResult = MsgBox(请在原处修改员工薪酬信息，修改后请刷新!, vbOKOnly + vbExclamation, 编辑员工薪酬信息) Exit SubEnd SubPrivate Sub update_Click()Adodc1.Recordset.updateEnd SubForm7 部门管理Private Sub cmdAdd_Click()If cmdAdd.Caption = 确定 ThenAdodc1.Recordset.updatecmdAdd.Caption = 添加记录ElseAdodc1.Recordset.AddNewcmdAdd.Caption = 确定update.Enabled = TrueEnd IfEnd SubPrivate Sub Cmddel_Click()Dim strResult As String strResult = MsgBox(是否真的要删除该部门信息?, vbYesNoCancel + vbQuestion + vbDefaultButton1, 退出询问) If strResult = vbYes Then Adodc1.Recordset.Delete Adodc1.Recordset.MovePrevious Else If strResult = vbNo Then End IfEnd IfEnd SubPrivate Sub cmdFind_Click()Dim 部门名称$ Adodc1.Recordset.MoveFirst 部门名称 = Trim(InputBox(请输入部门名称) Adodc1.Recordset.Find 部门名称= & & 部门名称 & If Not Adodc1.Recordset.EOF Then Else MsgBox 没有该部门记录 End IfEnd SubPrivate Sub Cmdnext_Click()Adodc1.Recordset.MoveNextCmdnext.Enabled = TrueIf Adodc1.Recordset.EOF ThenAdodc1.Recordset.MoveLastCmdnext.Enabled = FalseEnd IfEnd SubPrivate Sub Cmdprev_Click()Adodc1.Recordset.MovePreviousCmdnext.Enabled = TrueIf Adodc1.Recordset.BOF ThenAdodc1.Recordset.MoveFirstCmdprev.Enabled = FalseEnd IfEnd SubPrivate Sub Command11_Click()Form7.HideForm2.ShowEnd SubPrivate Sub Command2_Click()Dim strResult As String strResult = MsgBox(请在原处修改公司工信息，修改后请刷新!, vbOKOnly + vbExclamation, 编辑公司信息) Exit SubEnd SubPrivate Sub Command3_Click()End SubPrivate Sub Command9_Click()Unload Form7End SubPrivate Sub update_Click()Adodc1.Recordset.updateEnd SubForm8 注册Private Sub Cmd1_Click()Dim mrc As ADODB.RecordsetDim txtsql As String判断文本框中是否有内容If Len(user1.Text) = 0 ThenMsgBox 请输入用户名！, , 提示user1.SetFocusExit SubEnd IfIf Len(user_password.Text) = 0 ThenMsgBox 请输入密码！, , 提示user_password.SetFocusExit SubEnd IfIf Len(password_ch.Text) = 0 ThenMsgBox 请输入确认密码！, , 提示password_ch.SetFocusExit SubEnd IfIf Len(yanzh.Text) = 0 ThenMsgBox 请输入验证码！, , 提示yanzh.SetFocusExit SubEnd IfIf Trim(user_password.Text) Trim(password_ch.Text) Then MsgBox 密码前后输入不一致，请重新输入！, vbOKOnly + vbExclamation, 系统提示 user_password.SetFocus password_ch.Text = Exit Sub End If 判断输入验证码是否等于显示的 If Trim(yanzh.Text) Pic1.Tag Then MsgBox 验证码输入错误，请重新输入！, vbOKOnly + vbExclamation, 系统提示 yanzh.Text = yanzh.SetFocus Call Form_Activate Exit Sub End If txtsql = Select * from login_user where name = & Trim(user1.Text) & 查询是否已存在该用户名 Set mrc = ExecuteSQL(txtsql) If mrc.EOF = False Then MsgBox 该用户名已存在！, vbOKOnly + vbExclamation, 系统提示 user1.SetFocus user1.Text = user_password.Text = password_ch.Text = yanzh.Text = mrc.Close Exit Sub End If txtsql = Select * from login_user Set mrc = ExecuteSQL(txtsql) mrc.AddNew mrc.Fields(0) = Trim(user1.Text) mrc.Fields(1) = Trim(password_ch.Text) 调用加密函数，并储存加密后的密码 mrc.update mrc.Close MsgBox 用户添加成功！, vbOKOnly + vbInformation, 系统提示 user1.SetFocus user1.Text = user_password.Text = password_ch.Text = yanzh.Text = Call Form_Activate Unload Form8 Me.Show End Sub Private Sub Cmd2_Click()Unload Form8Form1.ShowEnd Sub随机产生4个数值Private Sub Form_Activate() Dim i As Integer Randomize i = Int(Rnd * (9999 - 1000 + 1) + 1000) Pic1.Cls Pic1.Print i Pic1.Tag = iEnd SubPrivate Sub Form_Load()Pic1.FontBold = True Pic1.FontName = 黑体 Pic1.FontSize = 15 Pic1.FontItalic = True Pic1.ForeColor = vbRed Pic1.FontStrikethru = True Pic1.FontItalic = True Pic1.FontUnderline = TrueEnd SubForm9 员工报表Private Sub Command1_Click()DataReport1.ShowEnd SubPrivate Sub Command2_Click()Unload DataReport1Form2.ShowEnd SubForm10 关于人事管理Private Sub Command1_Click()Form10.HideForm2.ShowEnd SubForm11 帮助Private Sub Command1_Click()Form11.HideForm2.ShowEnd SubForm12 分类管理Private Sub Command1_Click() 确定Dim condstr As Stringcondstr = If Option1.Value = True Then If condstr = Then condstr = 性别=男 Else condstr = condstr + and 性别= 男End If End If If Option2.Value = True Then If condstr = Then condstr = 性别=女 Else condstr = condstr + and 性别= 女End If End If If condstr Then 有条件 Adodc1.RecordSource = select * from yuangong where + condstr Adodc1.CommandType = adCmdText Adodc1.Refresh Else 无条件 Adodc1.RecordSource = select * from yuangong Adodc1.CommandType = adCmdText Adodc1.Refresh End IfEnd SubPrivate Sub Command2_Click()Form12.HideForm2.ShowEnd Sub模块Public PublicStr As StringPublic Function cnn() As ADODB.Connection建立无源数据库连接Set conn = Server.CreateObject(ADODB.Connection)conn.ConnectionString = driver=SQL Server;server=Dell-181;uid=sa;pwd=sa;database=人事系统管理conn.OpenEnd SubPublic Sub Main() PublicStr = Provider=SQLOLEDB.1;Integrated Security=SSPI;Persist Security Info=False;Initial Catalog=人事系统管理;Data Source=DELL-181 Provider=SQLOLEDB.1;Integrated Security=SSPI;Persist Security Info=False;Initial Catalog=人事管理系统;Data Source= & App.Path & H:人事管理人事管理_Data=FalseMe.ShowEnd SubPublic Function EncodePassWord(ByVal PWD As String) As String Dim CodePwd As String Dim OnePwd As String * 1 Dim i As Integer CodePwd = 初始化 OnePwd = PWD = Trim(PWD) i = 0 If Len(PWD) = 0 Then EncodePassWord = Exit Function End If For i = 1 To Len(PWD) OnePwd = Mid(PWD, i, 1) 从代加密的密码中取出一位字符进行ASCII变换 CodePwd = CodePwd & Chr(Asc(OnePwd) + (3 * i + 1) Next EncodePassWord = CodePwdEnd FunctionPublic Function DecodePassWord(ByVal PWD As String) As String Dim CodePwd As String Dim OnePwd As Str