用VB6.0+Mysql Sever2008设计一个信息管理系统:职员信息可以查询,删除。增加新数据和修改数据则不行。望大佬看看问题出在哪儿了
全局变量:
```
Option Explicit
Public guserName As String '用户名称,该变量用于存储登录用户的名称
Public guserKind As String '用户类型,该变量用于确定登录用户的类型
Public gempID As String '员工编号,该变量用于记录当前职员的编号
Public gbLog As Boolean '登录成功,该变量用于标识是否登录成功
Public conn As ADODB.Connection '数据库的connection对象
Public Function ConnStr() As String
ConnStr = "Provider=SQLOLEDB.1 ;integerated Security =SSPI; Persist Security Info=False;User ID=sa;Password=LK19960217;Initial Catalog=DBEmp;Data Source=ThePower,1433"
End Function
Public Function ExeSQL(SQL As String, rs As ADODB.Recordset, Optional enWrite As Boolean = True) As Boolean
On Error GoTo Exe_Error '如果有错误,则转入Exe_Error处
Set rs = New ADODB.Recordset
If enWrite Then
rs.Open SQL, conn, adOpenStatic, adLockOptimistic '以写方式执行SQL语句
Else
rs.Open SQL, conn, adOpenStatic, adLockReadOnly '以只读方式执行SQL语句
End If
ExeSQL = True '执行成功,返回true
Exit Function
Exe_Error:
ExeSQL = False '执行失败,返回false
Exit Function
End Function
Public Function RecExist(SQL As String) As Integer
Dim flag As String '标识SQL语句是否成功执行
Dim rs As ADODB.Recordset
flag = ExeSQL(SQL, rs, False) '执行SQL语句并返回结果
If rs.RecordCount <> 0 Then
RecExist = rs.RecordCount 'RecExist 返回值为记录数
Else
RecExist = 0 '如果记录数不存在,则返回0
End If
End Function
Public Function RefData(txtSQL As String, dgRef As DataGrid) As Integer
Dim rsData As ADODB.Recordset
Dim result As String '定义ExeSQL函数返回结果
result = ExeSQL(txtSQL, rsData, False)
If rsData.RecordCount <> 0 Then '如果返回的Recordset对象中的记录数不为0
Set dgRef.DataSource = rsData '设置DataGrid 的数据源
RefData = rsData.RecordCount
Else
MsgBox "数据为空!", vbOKOnly + vbExclamation, "警告"
RefData = 0
End If
End Function
Public Function ISEquLen(txt As TextBox, intlen As Integer) As Boolean
If Len(txt.Text) <> intlen Then '如果输入的数据位数不符合规定
MsgBox "输入数据有误请重新输入!"
txt.SetFocus '输入文本框获得焦点,让用户重新输入
ISEquLen = False
Else
ISEquLen = True
End If
End Function
Public Function OpenConn() '建立数据库链接
Set conn = New ADODB.Connection '创建新的连接
conn.Open ConnStr '打开数据库连接
End Function
Public Function CloseConn()
conn.Close '关闭数据库连接
End Function
Sub Main() '应用程序启动入口
Dim frmLog As New frmLogin '定义登录窗体变量
Dim title As String '定义字符串变量用于记录程序标题
If App.PrevInstance Then '检查应用程序实例是否运行
title = App.title
MsgBox "应用程序已经运行!"
App.title = "" '设置应用程序标题为空
frmmain.Caption = "" '设置主窗体标题为空
AppActivate title
Else
OpenConn '打开数据库连接
frmLog.Show vbModal '显示登录窗体
End If
Unload frmLog '卸载登录窗体
End Sub
增删改查:
Option Explicit
Dim strSQL As String
Dim result As Integer
Dim rs As ADODB.Recordset
Dim str As String
Private Sub cmdADD_Click()
If txtID.Text = "" Then
MsgBox "请输入编号"
txtID.SetFocus
Exit Sub
ElseIf Len(Trim(txtID.Text)) <> 4 Then
MsgBox "输入的编号必须为4位"
txtID.SetFocus
Exit Sub
Else
If txtName.Text = "" Then
MsgBox "请输入姓名"
Exit Sub
End If
End If
If cboSex.Text = "" Then
MsgBox "请选择性别"
cboSex.SetFocus
Exit Sub
End If
strSQL = "select * from tbEmp where empID='" & Trim(txtID.Text) & " '"
If RecExist(strSQL) <> 0 Then
MsgBox "该员工编号已存在,请重新输入"
txtID.SetFocus
Exit Sub
Else
strSQL = "insert into tbEmp(empID,empName,empSex,empNation,"
strSQL = strSQL & "empBirthday,empDep,empEdu,empDuty,email,idenID,mobileTel,tencentID,empAddr)"
strSQL = strSQL & " value(' "
strSQL = strSQL & Trim(txtID.Text) & " ','"
strSQL = strSQL & Trim(txtName.Text) & " ','"
strSQL = strSQL & Trim(cboSex.Text) & "','"
strSQL = strSQL & Trim(cboNation.Text) & "','"
strSQL = strSQL & Trim(txtBirthday.Text) & "','"
strSQL = strSQL & Trim(cboDep.Text) & "','"
strSQL = strSQL & Trim(cboEdu.Text) & "','"
strSQL = strSQL & Trim(cboDuty.Text) & "','"
strSQL = strSQL & Trim(txtEmail.Text) & "','"
strSQL = strSQL & Trim(txtidenID.Text) & "','"
strSQL = strSQL & Trim(txtMoblieTel.Text) & "','"
strSQL = strSQL & Trim(txtTencent.Text) & "','"
strSQL = strSQL & Trim(txtAddr.Text) & "')"
result = ExeSQL(strSQL, rs, True)
strSQL = "select empID as 员工编号,empName as 姓名,empSex as 性别 from tbEmp"
result = RefData(strSQL, Me.dgEmp)
InfoClear
End If
End Sub
Private Sub cmdCancel_Click()
Unload Me
End Sub
Private Sub initcboFields()
Me.cboFields.AddItem "员工编号"
Me.cboFields.AddItem "姓名"
Me.cboFields.AddItem "性别"
Me.cboFields.AddItem "职务"
End Sub
Private Sub cmdDel_Click()
If txtID.Text = "" Then
MsgBox "请选择要删除的记录"
Exit Sub
End If
str = MsgBox("确认要删除该记录?", vbOKCancel, "警告")
If str = vbCancel Then
Exit Sub
End If
strSQL = "delete from tbEmp where empID='" & Trim(txtID.Text) & "'"
result = ExeSQL(strSQL, rs, True)
strSQL = "select empID as 员工编号,empName as 姓名,empSex as 性别 from tbEmp"
result = RefData(strSQL, Me.dgEmp)
MsgBox "记录删除成功"
InfoClear
End Sub
Private Sub cmdModify_Click()
If txtID.Text = "" Then
MsgBox "请输入编号"
txtID.SetFocus
Exit Sub
ElseIf Len(Trim(txtID.Text)) <> 4 Then
MsgBox "输入的编号必须为4位"
txtID.SetFocus
Exit Sub
Else
If txtName.Text = "" Then
MsgBox "请输入姓名"
Exit Sub
End If
End If
If cboSex.Text = "" Then
MsgBox "请选择性别"
cboSex.SetFocus
Exit Sub
End If
strSQL = "update tbEmp set empID='" & Trim(txtID.Text)
strSQL = strSQL & "',empName='" & Trim(txtName.Text)
strSQL = strSQL & "',empSex='" & Trim(cboSex.Text)
strSQL = strSQL & "',empNation='" & Trim(cboNation.Text)
strSQL = strSQL & "',empBirthday='" & Trim(txtBirthday.Text)
strSQL = strSQL & "',empDep='" & Trim(cboDep.Text)
strSQL = strSQL & "',empEdu='" & Trim(cboEdu.Text)
strSQL = strSQL & "',empDuty='" & Trim(cboDuty.Text)
strSQL = strSQL & "',email='" & Trim(txtEmail.Text)
strSQL = strSQL & "',idenID='" & Trim(txtidenID.Text)
strSQL = strSQL & "',mobileTel='" & Trim(txtMoblieTel.Text)
strSQL = strSQL & "',tencentID='" & Trim(txtTencent.Text)
strSQL = strSQL & "',empAddr='" & Trim(txtAddr.Text)
result = ExeSQL(strSQL, rs, True)
strSQL = "select empID as 员工编号,empName as 姓名,empSex as 性别 from tbEmp"
result = RefData(strSQL, Me.dgEmp)
MsgBox "修改记录成功"
End Sub
Private Sub cmdQuery_Click()
Dim strTemp As String '定义临时字段
If cboFields.Text = "员工编号" Then
strTemp = "empID"
ElseIf cboFields.Text = "姓名" Then
strTemp = "empName"
ElseIf cboFields.Text = "性别" Then
strTemp = "empSex"
Else
strTemp = "empDuty"
End If
strSQL = "select * from tbEmp where " & strTemp & "='" & txtSelect.Text & " ' "
result = ExeSQL(strSQL, rs)
result = RefData(strSQL, dgEmp)
dgEmp_RowColChange 1, 1
End Sub
Private Sub dgEmp_RowColChange(LastRow As Variant, ByVal LastCol As Integer)
Dim rsTemp As ADODB.Recordset
strSQL = "select * from tbEmp where empID='" & dgEmp.Columns(0) & "'"
result = ExeSQL(strSQL, rsTemp)
txtName.Text = rsTemp("empName")
txtID.Text = rsTemp("empID")
cboSex.Text = rsTemp("empSex")
txtBirthday.Text = rsTemp("empBirthday")
cboNation.Text = rsTemp("empNation")
cboDep.Text = rsTemp("empDep")
cboEdu.Text = rsTemp("empEdu")
cboDuty.Text = rsTemp("empDuty")
txtEmail.Text = rsTemp("email")
txtidenID.Text = rsTemp("idenID")
txtMoblieTel.Text = rsTemp("mobileTel")
txtTencent.Text = rsTemp("tencentID")
txtAddr.Text = rsTemp("empAddr")
End Sub
Private Sub Form_Load()
strSQL = "select empID as 员工编号,empName as 姓名,empSex as 性别 from tbEmp"
result = RefData(strSQL, Me.dgEmp) '查询结果显示在DataGrid控件中
dgEmp_RowColChange 1, 1
Call initcboFields '调用这个函数
Call initSex
Call initNation
Call initDep
Call initDuty
Call initEdu
InfoClear
End Sub
Private Sub initSex()
cboSex.AddItem "男"
cboSex.AddItem "女"
End Sub
Private Sub initNation()
Dim i As Integer
strSQL = "select * from tbNation"
result = ExeSQL(strSQL, rs)
For i = 0 To rs.RecordCount - 1
cboNation.AddItem rs.Fields(1)
rs.MoveNext
Next
End Sub
Private Sub initDep()
Dim i As Integer
strSQL = "select * from tbDep"
result = ExeSQL(strSQL, rs)
For i = 0 To rs.RecordCount - 1
cboDep.AddItem rs.Fields(1)
rs.MoveNext
Next
End Sub
Private Sub initDuty()
Dim i As Integer
strSQL = "select * from tbDuty"
result = ExeSQL(strSQL, rs)
For i = 0 To rs.RecordCount - 1
cboDuty.AddItem rs.Fields(1)
rs.MoveNext
Next
End Sub
Private Sub initEdu()
Dim i As Integer
strSQL = "select * from tbEdu"
result = ExeSQL(strSQL, rs)
For i = 0 To rs.RecordCount - 1
cboEdu.AddItem rs.Fields(1)
rs.MoveNext
Next
End Sub
Private Sub InfoClear() '清空详细情况文本框
txtName.Text = ""
txtID.Text = ""
cboSex.Text = ""
txtBirthday.Text = ""
cboNation.Text = ""
cboDep.Text = ""
cboEdu.Text = ""
cboDuty.Text = ""
txtEmail.Text = ""
txtidenID.Text = ""
txtMoblieTel.Text = ""
txtTencent.Text = ""
txtAddr.Text = ""
End Sub
还有就是登录界面:
```