|
接要 本文主要介绍了基于三层体系结构的网络数据库设计，并结合面向对象，分布式数据库开发等理论。全文围绕一个典型而简单的例子，通过VB编程语言，从分析、建模、设计、编码等各个角度对三层体系与数据库进行了全面而详细的阐述，文中提供了全部源代码。 关键词
三层体系
数据库
面向对象
分布式开发 1.
三层体系结构我们经常会看到许多应聘者在简历上写着“精通数据库编程”的字样，也经常会在招聘网站上看到软件公司的招聘要求中某一项为“精通数据库编程”。于是这些应聘者去这些软件公司面试，于是我们看到了许多“精通”者落选的现象。 一些程序员在设计数据库应用时，通常会采用数据控件绑定的方法实现。用鼠标拉几个控件，再用鼠标设置几个属性，连键盘都不用动，就完成了一个数据库应用的开发！当然，这的确是一种快速的数据库应用开发方式，但快速并不意味着精通。 对于大型的数据库应用系统，或是拥有众多客户端的应用系统，我们需要另外一种“精通”，这就是几乎每个程序员都听说过的“三层体系结构”。 1.1.
传统的C/S模式在传统的数据库应用体系中，客户端与数据库完全分开，在客户端上运行了大部分服务，如数据访问规则、业务规则、合法性校验等等。每一个客户端都存在数据引擎，并且每个客户端与数据库服务器建立独立的数据库连接（DB Connection）。 基于该种体系的数据库应用系统的优势：开发周期较短，能够适应大部分中小型数据库应用系统的要求（当客户端数量少于50时）。 但是，随着数据库应用的日渐发展、数据容量的不断增加、客户端数量的不断增加，该种体系结构显示出了诸多缺陷，主要体现在以下几个方面： 1、
可扩充性：对于数据库服务器端，每当建立一个数据连接，就会占用大量的系统资源，当数据连接达到一定数量（如20个）时，数据库服务器的响应速度与处理速度将大打折扣。 2、
可维护性：基于传统C/S的数据库应用系统，业务规则通常置于客户端应用程序中。如果业务规则一旦发生变化（随便举个例子，如身份证号码有可能升为19位）时，我们就必须修改客户端应用程序，并且将每个客户端进行相应的升级工作。 3、
可重用性：采用传统C/S的设计模式时，数据库访问、业务规则等都固化在客户端应用程序中。如果客户另外提出了B/S的应用需求，则需要在WEB服务器中重新进行数据库访问、业务规则、合法性校验等编码（例如将数据库访问写入ASP代码），而所做的工作与客户端应用程序中的功能完全重复，从而加大了工作量，又使得程序开发者心里感到极不舒服。 正因为以上的诸多缺陷，使得三层（多层）体系结构成为目前数据库应用开发的首选，甚至客户有时也会提出该种技术需求。 1.2.
三层体系结构所谓三层体系结构，是在客户端与数据库之间加入了一个“中间层”，也叫组件层。这里所说的三层体系，不是指物理上的三层，不是简单地放置三台机器就是三层体系结构，也不仅仅有B/S应用才是三层体系结构，三层是指逻辑上的三层，即使这三个层放置到一台机器上。 三层体系的应用程序将业务规则、数据访问、合法性校验等工作放到了中间层进行处理。通常情况下，客户端不直接与数据库进行交互，而是通过COM/DCOM通讯与中间层建立连接，再经由中间层与数据库进行交互。 这样的好处显而易见： 1、
由于数据访问是通过中间层进行的，因此客户端不再与数据库直接建立数据连接。也就是说，建立在数据库服务器上的连接数量将大大减少。例如一个500个客户端的应用系统，500个客户端分别与中间层服务器建立DCOM连接，而DCOM通讯所占用的系统资源极为有限，并且是动态建立与释放连接，因此客户端数量将不再受到限制。同时，中间层与数据库服务器之间的数据连接通过“连接池”进行连接数量的控制，动态分配与释放数据连接，因此数据连接的数量将远远小于客户端数量。 2、
可维护性得以提高。因为业务规则、合法性校验存在于中间层，因此当业务规则发生改变时，只需更改中间层服务器上的某个组件（如某个DLL文件），而客户端应用程序不需做任何处理，有些时候，甚至不必修改中间层组件，只需要修改数据库中的某个存储过程就可以了。 3、
良好的可重用性。同样，如果需要开发B/S应用，则不必要重新进行数据访问、业务规则等的开发，可以直接在WEB服务器端调用现有的中间层（如可以采用基于IIS的WebClass开发，或直接编写ASP代码）。 4、
事务处理更加灵活，可以在数据库端、组件层、MTS（或COM+）管理器中进行事务处理。 如果现在你仍然感到不理解，没关系，请看下面的例子。 2.
简单的人事管理系统下面以一个极为简单的人事管理系统为例详细讲述如何实现三层体系结构。编程语言为Visual Basic 6.0。 为了全面介绍程序设计方法，VB代码中采用了不同的方法实现相同的功能，如数据库访问中，同时采用了存储过程与ADO连接。读者可自行选择最适合的方法。 由于在代码中加入了大量注释，因此不再过多地说明函数功能与原理。 在团队开发中，代码中注释部分应占整个代码的1/3左右，而且应在代码编写前就写好注释。如果另一个程序员认为你的代码中注释全部是废话，那么这些注释肯定是在写完代码之后才加上去的！ 2.1.
需求简单的部门/人员管理系统，要求： 1、
部门的属性有部门名称，人员的属性有姓名、年龄、性别； 2、
部门存在上下级关系； 3、
人员必须属于一个部门； 4、
人员、部门需要实现增加、删除、修改功能 5、
可以按人员的名称、年龄查询人员 6、
如果一个部门存在人员，或存在下级部门，则该部门不可删除 以上即为系统的简单需求。 2.2.
数据库数据库采用SQL Server 7设计，数据库名称为“TEST”，存在两个数据表（此处假设读者已掌握数据库设计，因为这个数据库实在太简单了）。 表tDept tEmployee
其中，tDept中nID与SuperID为表内关联。 2.3.
中间层打开VB6，选择“新建ActiveX DLL”，并引用ADO 2.5。 新添加一个模块，命名为mdlPublic，新填加5个类，分别命名为cDept、cEmp、cDepts、cEmps、cPublic。其中，cEmps与cDepts分别为cEmp与cDept的集合类，cPublic为定义枚举的类，无实际意义。将工程的启动模块设为“Sub Main”（重要！）。 在SQL Server的TEST库中，添加一个存储过程AddDept。 全部代码如下： 2.3.1.
mdlPublic.basOption Explicit
Public g_Cn As Connection '用于全局的数据连接
'ActiveX DLL的启动程序，为DLL初始化时执行 Public Sub Main()
If ConnectToDatabase = False Then
Err.Raise vbObjectError + 1, , "连接数据库出错！"
End If
End Sub
'连接到数据库 Public Function ConnectToDatabase() As Boolean
On Error GoTo ERR_CONN
Set g_Cn = New Connection
'设置服务器名称，数据库名称，登录名（此时假设密码为空）
Dim ServerName As String, DBName As String, UserName As String
ServerName = "gxc-notepad"
DBName = "TEST"
UserName = "sa"
'连接到数据库
With g_Cn
.CursorLocation = adUseClient
.CommandTimeout = 10
.ConnectionString = "undefinedrovider=SQLOLEDB.1undefinedersist Security Info=True;User ID=" & UserName & ";Initial Catalog=" & DBName & ";Data Source=" & ServerName
.Open
End With
ConnectToDatabase = True
Exit Function
ERR_CONN:
ConnectToDatabase = False
End Function
'去掉字符串中的单引号 Public Function RealString(strOrigional) As String
RealString = Replace(strOrigional, "'", "")
End Function
'得到某个数据表中主键的下一个值，即当前主键值加1 Public Function NextID(ByVal strTable As String, ByVal strID As String) As Long
'两个参数分别是表的名称与主键的名称
Dim rs As Recordset
Set rs = g_Cn.Execute("SELECT MAX(" & strID & ") FROM " & strTable)
If IsNull(rs(0)) Then
'如果值为NULL，则说明无任何数据记录，此时ID应为1
NextID = 1
Else
'使新ID为最大ID值+1
NextID = rs(0).Value + 1
End If
End Function
'查看某个数据表中，是否存在某个字段等于某个值的记录（整型） Public Function ExistByID(ByVal strTable As String, ByVal strID As String, ByVal lngID As Long) As Boolean
'第一个参数为表名，第二个为字段名，第三个为具体的字段值
Dim rs As Recordset
Set rs = g_Cn.Execute("Select Count(*) from " & strTable & " where " & strID & "=" & lngID)
ExistByID = (rs(0).Value = 1)
End Function
'查看某个数据表中，是否存在某个字段等于某个值的记录（字符型） Public Function ExistByName(ByVal strTable As String, ByVal strFieldName As String, ByVal strName As String, ByVal ThisID As Long) As Boolean
'第一个参数为表名，第二个为字段名，第三个为具体的字段值
Dim rs As Recordset
Set rs = g_Cn.Execute("Select Count(*) from " & strTable & " where " & strFieldName & "='" & strName & "' and nID<>" & ThisID)
ExistByName = (rs(0).Value = 1)
End Function '以上两个函数实际上可以合并，本程序中为了说明问题，故而分开 2.3.2.
cPublic.clsOption Explicit '该类无实际意义，只为保存一些自定义枚举
'自定义枚举，用于表示性别 Public Enum gxcGender
Male = 1
Female = 0
End Enum
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' '以下枚举用于“部门”对象的操作
'用于表示部门删除结果的枚举 Public Enum gxcDelete
DeleteOK = 0
DeleteFail = 1 '未知原因导致不能删除
DeleteSubExists = 2 '由于存在子部，因此不能删除
DeleteEmpExists = 3 '该部门存在人员，不能删除
End Enum
'用于表示部门更新结果的枚举 Public Enum gxcUpdate
UpdateOK = 0
UpdateFail = 1
DuplicateName_Update = 2 '名字不可重复
RecordNotExist = 3 '当前更新的记录已被其它客户端删除
End Enum
'用于表示部门新增结果的枚举 Public Enum gxcAddNew
AddNewOK = 0
AddNewFail = 1
DuplicateName_AddNew = 2 '名字不可重复
SuperNotExist = 3 '指定的上级部门的ID不存在
End Enum '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' 2.3.3.
cDept.clsOption Explicit
Private mvarDeptName As String Private mvarID As Long Private mvarSuperID As Long
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' '以下为部门的属性
'上级部门ID Public Property Let SuperID(ByVal vData As Long)
mvarSuperID = vData
End Property Public Property Get SuperID() As Long
SuperID = mvarSuperID
End Property
'本部门的ID Public Property Let ID(ByVal vData As Long)
mvarID = vData
End Property Public Property Get ID() As Long
ID = mvarID
End Property
'本部门的名称 Public Property Let DeptName(ByVal vData As String)
vData = Trim(vData) '去除两边的空格
'控制名称的长度不可大于50
If Len(vData) > 50 Then vData = Left(vData, 50)
mvarDeptName = vData
End Property Public Property Get DeptName() As String
DeptName = mvarDeptName
End Property '属性结束 ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
''''''''''''''''''''''''''''''''''''''''''''''''''''''' '以下为方法
'新增一个部门，并返回操作的结果 Public Function AddNew(Optional strName As String = "", _
Optional lngSuperID As Long = -1) As gxcAddNew
'根据传入的参数更新属性值
On Error GoTo ERR_ADDNEW
'如果参数被传入，则以传入的参数更新属性
If strName <> "" Then Me.DeptName = strName
If lngSuperID <> -1 Then Me.SuperID = lngSuperID '上级部门的ID
'通过Command对象调用存储过程，由存储过程
'进行添加部门的操作，并由存储过程返回操作结果
Dim cmd As ADODB.Command
Set cmd = New ADODB.Command
With cmd
Set .ActiveConnection = g_Cn
.CommandType = adCmdStoredProc '设置Command类型为“存储过程”
.CommandText = "AddDept" '存储过程的名称
'传入两个参数，分别为部门的名称与上级部门的ID
.Parameters.Append .CreateParameter("@Name", adChar, adParamInput, 50, Me.DeptName)
.Parameters.Append .CreateParameter("@SuperID", adInteger, adParamInput, , Me.SuperID)
'传入两个返回型的参数，分别返回新记录的ID与操作结果
.Parameters.Append .CreateParameter("@ID", adInteger, adParamOutput)
.Parameters.Append .CreateParameter("@Return", adInteger, adParamOutput)
.Execute
End With
Dim RTN As gxcAddNew
RTN = cmd.Parameters("@Return").Value '得到操作结果
'如果操作成功，则给对象赋以ID值
If RTN = AddNewOK Then Me.ID = cmd.Parameters("@ID").Value
AddNew = RTN '返回操作结果
Set cmd = Nothing
Exit Function
ERR_ADDNEW:
'来到这里，则说明出错了
If Not cmd Is Nothing Then Set cmd = Nothing
AddNew = AddNewFail
End Function
'修改部门信息，返回操作结果 Public Function Update() As gxcUpdate
'通过ID判断是否存在该记录，即该记录是否被其它客户端删除
'如果不存在该记录，则返回相应的操作结果给调用者
If Not ExistByID("tDept", "nID", Me.ID) Then
Update = RecordNotExist
Exit Function
End If
'通过名称判断是否存在相同名称的记录，如果存在相同的名称，
'则返回调用者“存在相同名称”的信息
If ExistByName("tDept", "DeptName", Me.DeptName, Me.ID) Then
Update = DuplicateName_Update
Exit Function
End If
On Error Resume Next
Dim strSQL As String
'构造SQL语句，注意需调用RealString函数去除字符串中的单引号
strSQL = "Update tDept Set DeptName='" & RealString(Me.DeptName) & "',"
strSQL = strSQL & "SuperID=" & IIf(Me.SuperID = 0, "null", Me.SuperID)
strSQL = strSQL & " where nID=" & Me.ID
g_Cn.Execute strSQL '执行SQL语句
'根据是否出错，返回给调用者相应的信息
If Err.Number = 0 Then
Update = UpdateOK
Else
Update = UpdateFail
End If
End Function
'删除一个部门 Public Function Delete(Optional ByVal lngID As Long = 0) As gxcDelete
'如果调用该函数时传入了ID，则更新该对象的ID
If lngID <> 0 Then Me.ID = lngID
'如果该部门下面有人员，则也不能删除
If ExistByID("tEmployee", "DeptID", Me.ID) Then
Delete = DeleteEmpExists
Exit Function
End If
'如果该部门下有子部门，则不能删除
If ExistByID("tDept", "SuperID", Me.ID) Then
Delete = DeleteSubExists
Exit Function
End If
On Error Resume Next
'执行删除操作并返回操作结果
g_Cn.Execute "Delete from tDept where nID=" & Me.ID
Delete = IIf(Err.Number = 0, DeleteOK, DeleteFail)
End Function
'得到本部门的所有员工 Public Function Employees() As cEmps
Dim objEmps As New cEmps
'调用cEmps类的Find方法，只传第三个参数，即“部门ID”
Set Employees = objEmps.Find(, , Me.ID)
End Function
'得到本部门的所有子部门 Public Function SubDepartments() As cDepts
Dim objDepts As New cDepts
'调用cDepts的Find方法，通过上级部门的ID查找
Set SubDepartments = objDepts.Find(, Me.ID)
End Function
'得到本部门的上级部门，以对象返回 Public Function SuperDepartment() As cDept
Dim objDepts As New cDepts
'调用cDepts的Find方法，将该类的“SuperID”作为查找条件
'从而查找出其上级部门
objDepts.Find Me.SuperID
If objDepts.Count > 0 Then Set SuperDepartment = objDepts.Item(1)
End Function '方法结束 ''''''''''''''''''''''''''''''''''''''''''''''''''''''' 2.3.4.
cDepts.clsOption Explicit
Private mCol As Collection
'往集合中加入一个“部门”对象 Public Sub Add(objDept As cDept)
mCol.Add objDept, "A" & objDept.ID
'在加入对象是，最好同时加入其“KEY”属性
'“KEY”属性不可以是数字型，因此在前面随便加
'一个字母，此处加了一个“A”
End Sub
Public Property Get Item(vntIndexKey As Variant) As cDept
Set Item = mCol(vntIndexKey)
End Property
Public Property Get Count() As Long
Count = mCol.Count
End Property
Public Sub Remove(vntIndexKey As Variant)
mCol.Remove vntIndexKey
End Sub
Public Property Get NewEnum() As IUnknown
'本属性允许用 For...Each 语法枚举该集合。
Set NewEnum = mCol.[_NewEnum]
End Property
'清除集合中的全部元素 Public Sub Clear()
'注意！在清除时必须倒序清除，否则要出错！
Dim i As Long
For i = mCol.Count To 1 Step -1
mCol.Remove i
Next i
End Sub
Private Sub Class_Initialize()
Set mCol = New Collection
End Sub
Private Sub Class_Terminate()
Set mCol = Nothing
End Sub
'按条件查找部门，以集合类的方式返回 Public Function Find(Optional lngID As Long = 0, Optional lngSuperID As Long = -1) As cDepts
'按输入的参数查询，并返回一个集合类
Dim strSQL As String
'构造SQL语句
strSQL = "Select * from tDept where "
If lngID <> 0 Then strSQL = strSQL & "nID=" & lngID & " and "
If lngSuperID <> -1 Then
If lngSuperID = 0 Then '如果传入0，则表示没有上级部门
strSQL = strSQL & "SuperID is null and "
Else
strSQL = strSQL & "SuperID=" & lngSuperID & " and "
End If
End If
strSQL = strSQL & "nID>0"
'清空当前集合
Me.Clear
Dim rs As Recordset
Set rs = g_Cn.Execute(strSQL)
'往集合中添加查询结果
Dim i As Long
Dim objDept As cDept
For i = 1 To rs.RecordCount
Set objDept = New cDept
With objDept
.ID = rs("nID").Value
.DeptName = Trim(rs("DeptName").Value)
.SuperID = IIf(IsNull(rs("SuperID").Value), 0, rs("SuperID").Value)
End With
Me.Add objDept
Set objDept = Nothing
rs.MoveNext
Next i
Set rs = Nothing
Set Find = Me
End Function 2.3.5.
cEmp.clsOption Explicit
Private mvarID As Long Private mvarEmpName As String Private mvarEmpAge As Integer Private mvarEmpGender As gxcGender Private mvarDeptID As Long Private mvarDeptName As String
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' '以下为类的属性
'部门名称 Public Property Let DeptName(ByVal vData As String)
mvarDeptName = vData
End Property Public Property Get DeptName() As String
DeptName = mvarDeptName
End Property
'部门ID Public Property Let DeptID(ByVal vData As Long)
mvarDeptID = vData
End Property Public Property Get DeptID() As Long
DeptID = mvarDeptID
End Property
'性别 Public Property Let EmpGender(ByVal vData As gxcGender)
mvarEmpGender = vData
End Property Public Property Get EmpGender() As gxcGender
EmpGender = mvarEmpGender
End Property
'年龄 Public Property Let EmpAge(ByVal vData As Integer)
If vData < 0 Then vData = 1 '年龄不可小于0
mvarEmpAge = vData
End Property Public Property Get EmpAge() As Integer
EmpAge = mvarEmpAge
End Property
'姓名 Public Property Let EmpName(ByVal vData As String)
vData = Trim(vData) '去除两边的空格
'控制名称的长度不可大于10
If Len(vData) > 10 Then vData = Left(vData, 10)
mvarEmpName = vData
End Property Public Property Get EmpName() As String
EmpName = mvarEmpName
End Property
'ID Public Property Let ID(ByVal vData As Long)
mvarID = vData
End Property Public Property Get ID() As Long
ID = mvarID
End Property '属性结束 '''''''''''''''''''''''''''''''''''''''''''''''''''''''
''''''''''''''''''''''''''''''''''''''''''''''''''''''' '以下为方法
'添加一个人员 Public Function AddNew(Optional ByVal strName As String = "", _
Optional ByVal intAge As Integer = 0, _
Optional varGender As gxcGender = -1, _
Optional lngDeptID As Long = 0) As Boolean
On Error Resume Next
'如果参数为缺省值，即未传入，则直接调和类中的参数，否则调用传入的参数
If strName <> "" Then Me.EmpName = strName
If intAge <> 0 Then Me.EmpAge = intAge
If varGender <> -1 Then Me.EmpGender = varGender
If lngDeptID <> 0 Then Me.DeptID = lngDeptID
Dim strSQL As String
g_Cn.BeginTrans
'开始一个事务，以免费得到的ID值已被其它客户端所使用
'此处调用NextID方法，得到该类对应的数据表的下一个ID，即最大ID+1
Me.ID = NextID("tEmployee", "nID")
'构造SQL语句，注意需调用RealString去除字符串中的单引号
strSQL = "Insert into tEmployee (nID,DeptID,EmpName,EmpAge,EmpGender) values ("
strSQL = strSQL & Me.ID & "," & Me.DeptID & ","
strSQL = strSQL & "'" & RealString(Me.EmpName) & "',"
strSQL = strSQL & Me.EmpAge & "," & Me.EmpGender & ")"
'执行SQL语句，并提交事务
g_Cn.Execute strSQL
g_Cn.CommitTrans
'如果发生错误，则返回FALSE，表示未成功添加
AddNew = (Err.Number = 0)
End Function
'修改人员信息 Public Function Update() As Boolean
On Error Resume Next
Dim strSQL As String
'构造SQL语句
strSQL = "Update tEmployee set DeptID=" & Me.DeptID & ","
strSQL = strSQL & "EmpName='" & RealString(Me.EmpName) & "',"
strSQL = strSQL & "EmpAge=" & Me.EmpAge & ","
strSQL = strSQL & "EmpGender=" & Me.EmpGender & " "
strSQL = strSQL & "Where nID=" & Me.ID
g_Cn.Execute strSQL
'如果发生错误，则返回FALSE，表示未成功更新
Update = (Err.Number = 0)
End Function
'删除人员资料 Public Function Delete(Optional ByVal lngID As Long = 0) As Boolean
Dim strSQL As String
On Error Resume Next
'如果已传入了要删除的ID，则按此ID删除
If lngID <> 0 Then Me.ID = lngID
strSQL = "DELETE FROM tEmployee WHERE nID=" & Me.ID
g_Cn.Execute strSQL
'如果发生错误，则返回FALSE，表示未删除成功
Delete = (Err.Number = 0)
End Function '方法结束 '''''''''''''''''''''''''''''''''''''''''''''''''''''''
'将某个人员移到指定的部门 Public Function AssignToDepartment(ByVal DeptID As Long) As Boolean
'实现很简单，将部门ID变一下，然后调用Update方法就行了
Me.DeptID = DeptID
AssignToDepartment = Me.Update
End Function
'得到该人员所在部门，以对象返回 Public Function Department() As cDept
Dim objDepts As New cDepts
'调用cDepts的Find方法，得到部门
objDepts.Find Me.DeptID
If objDepts.Count > 0 Then Set Department = objDepts.Item(1)
End Function 2.3.6.
cEmps.clsOption Explicit
Private mCol As Collection '局部变量，保存集合
'将一个“人员”对象加入集合 Public Sub Add(objEmp As cEmp)
mCol.Add objEmp, "A" & objEmp.ID
'在加入对象时，最好同时加入其“KEY”属性
'“KEY”属性不可以是数字型，因此在前面随便加
'一个字母，此处加了一个“A”
End Sub
Public Property Get Item(vntIndexKey As Variant) As cEmp
Set Item = mCol(vntIndexKey)
End Property
Public Property Get Count() As Long
Count = mCol.Count
End Property
Public Sub Remove(vntIndexKey As Variant)
mCol.Remove vntIndexKey
End Sub
Public Property Get NewEnum() As IUnknown
'本属性允许用 For...Each 语法枚举该集合。
Set NewEnum = mCol.[_NewEnum]
End Property
'清除集合中的全部元素 Public Sub Clear()
'清除时应倒序清除！
Dim i As Long
For i = mCol.Count To 1 Step -1
mCol.Remove i
Next i
End Sub
Private Sub Class_Initialize()
Set mCol = New Collection
End Sub
Private Sub Class_Terminate()
Set mCol = Nothing
End Sub
'按条件查找人员，以集合类的方式返回 Public Function Find(Optional ByVal lngID As Long = 0, _
Optional ByVal strName As String = "", _
Optional ByVal lngDeptID As Long = 0) As cEmps
'构造查询SQL
Dim strSQL As String
strSQL = "Select tEmployee.*,tDept.DeptName from tEmployee left outer join tDept "
strSQL = strSQL & " ON tDept.nID=tEmployee.DeptID Where "
If lngID <> 0 Then strSQL = strSQL & "tEmployee.nID=" & lngID & " and "
'如果是按名称查询，则采用“包含”的查询方法
If strName <> "" Then strSQL = strSQL & "tEmployee.EmpName like'%" & RealString(strName) & "'% and "
If lngDeptID <> 0 Then strSQL = strSQL & "tEmployee.DeptID=" & lngDeptID & " and "
strSQL = strSQL & "tEmployee.nID>0"
'将查询结果加入集合类
Dim rs As Recordset
Set rs = g_Cn.Execute(strSQL)
Dim i As Long
Dim objEmp As cEmp
For i = 1 To rs.RecordCount
Set objEmp = New cEmp
With objEmp
.ID = rs("nID").Value
.EmpName = Trim(rs("EmpName").Value)
.EmpAge = rs("EmpAge").Value
.EmpGender = Abs(rs("EmpGender").Value)
.DeptID = rs("DeptID").Value
.DeptName = Trim(rs("DeptName").Value)
End With
Me.Add objEmp
Set objEmp = Nothing
rs.MoveNext
Next i
Set rs = Nothing
Set Find = Me
End Function 2.3.7.
AddDept存储过程CREATE PROCEDURE AddDept
@Name char(50),
@SuperID int,
@ID int output,
@Return int output
AS
begin transaction
--如果上级部门ID为0，则在些将其设为NULL，表示无上级部门
if @SuperID=0 Select @SuperID=Null
--当前的ID为最大ID值+1
Select @ID=(Select Max(nID) from tDept)+1
--如果ID值为空，则表示尚无记录，人为地赋值为1
if @ID is null select @ID=1
--如果存在相同的部门名称，则返回VB代码中定义的枚举类型
if Exists(Select * from tDept where DeptName=@Name) begin
select @Return=2
rollback transaction
return
end
--如果不存在指定的上级部门ID，则返回VB中指定的枚举类型
if not Exists(Select * from tDept where nID=@SuperID) and not(@SuperID is null) begin
select @Return=3
rollback transaction
return
end
insert into tDept (nID,SuperID,DeptName) values (@ID,@SuperID,@Name)
if @@error=0 begin
select @Return=0
commit transaction
end else begin
Select @Return=1
rollback transaction
end
2.3.8.
组件设计注意事项至此，你可以仔细研究一下上面的代码，主要是两个基本类（人员对象与部门对象），两个集合类（人员集合与部门集合）。在这里，你可以将集合理解为“对象的数组”。 然后，仔细分析一下这四个类的结构、接口、相互关系，然后将它们画出来（请一定这样做一下，它会有助于你更好地理解面向对象）。你是不是发现，还可以再加入新的接口函数？当然是的！因为本文中的代码仅仅是个示例，它们有待于你的继续完善，比如你可以将“发工资”封装到“人员”类中。 将上述代码保存为myCom.vbp并编译，生成myCom.dll文件。该DLL文件即是一个中间层组件。 在此组件中，我们加入了大量的业务规则，如“年龄不可小于0”、不能删除有子部门或上级部门、部门内有人员时不可删除、部门名称不可大于50个字符等等。 在进行任何程序设计时，都必须考虑到用户使用的方便性。比如设计应用程序时，我们总是在考虑如何让直接用户更为方便地操作，如果使得操作逻辑更为用户所接受。 同样地，COM组件的设计也应为用户做相同考虑，如何让用户更加方便地使用。COM组件的用户不是最终用户，而是程序员！ 是制作交互界面的程序员！因此在设计COM接口与结构时，应充分考虑到界面程序员的思维方式与使用方便性，例如函数应以表义性较强的字母组合命名等等。 最完美的状态是这样：使用你的COM组件的程序员心里想着：应该有这样的一个函数吧，并且名字应该是GetCustomerName，于是他真的在你的组件中发现了这个函数，而且函数名称，甚至输入参数都与他想象的完全一样，那么，你真的成功了！ 在COM组件编写完成后，应经过大量测试，测试到每一个函数与属性。可以编写简单的测试程序进行测试（有时为了节省时间，可以直接在界面中进行测试，但可能公增加程序员的沟通时间，有时反而会得不偿失）。 2.4.
客户端既然COM组件（或中间层）已编写完成并通过测试，下面就可以进行界面的编写了。 很有趣的是，采用基于三层体系结构的设计模式，界面程序员可以完全不懂数据库编程！他完全不必知道数据库的格式，甚至不必了解是何种类型的数据库。 请看以下的例子： 首先，新建一个工程，然后引用myCom.DLL。 2.4.1.
先举几个例子2.4.1.1.
添加一个部门
Dim objDept As New cDept '定义一个部门对象
Dim Result As gxcAddNew, strResult As String
With objDept
.DeptName = "总部"
.SuperID = 0 '0表示无上级部门
Result = .AddNew '得到操作结果
If Result = AddNewFail Then
strResult = "添加失败！"
ElseIf Result = DuplicateName_AddNew Then
strResult = "存在相同名称的部门，请修改名称后重新添加！"
ElseIf Result = SuperNotExist Then
strResult = "指定的上级部门不存在或已被删除！"
Else
strResult = "添加成功！"
End If
End With
MsgBox strResult, vbInformation
通过上面的代码，已完成了“增加一个部门”的操作，并且可以清楚地知道操作的结果。而代码中没有任何地方体现出这是对数据库进行编程。 上面代码中With块中的前三行还可以用下面的一行代码替换（因为你的AddNew函数中的参数全部都是可选的）：
Result = .AddNew("总部", 0)
2.4.1.2.
删除一个部门
Dim objDept As New cDept '定义部门对象
Dim Result As gxcDelete, strResult As String
Result = objDept.Delete(1) '删除ID为1的部门
If Result = DeleteEmpExists Then
strResult = "该部门内存在人员，不能删除！"
ElseIf Result = DeleteFail Then
strResult = "删除失败！"
ElseIf Result = DeleteSubExists Then
strResult = "该部门内存在子部门，不能删除！"
Else
strResult = "成功删除"
End If
MsgBox strResult, vbInformation
2.4.1.3.
查询所有子部门与部门内人员
以下代码查找出ID为12的部门，然后得到该部门下的所有人员与所有子部门。
Dim objDepts As New cDepts, objEmps As New cEmps '定义部门集合与人员集合
If objDepts.Find(12).Count > 0 Then
Set objEmps = objDepts(1).Employees '得到了部门内所有人员
Set objDepts = objDepts(1).SubDepartments '得到了部门内的所有子部门
End If
2.4.1.4.
更为有趣的操作以下代码查找出名称中包含“张三”的第一个人员，然后找出同部门的所有同事。
Dim objEmps As New cEmps
If objEmps.Find(, "张三").Count > 0 Then
'得到了同一部门的所有人员
Set objEmps = objEmps(1).Department.Employees
End If
以下代码查看张三是否是李四的直接上司。
On Error Resume Next
Dim objEmps As New cEmps
If objEmps.Find(, "张三").Item(1).Department Is objEmps.Find(, "李四").Item(1).Department.SuperDepartment Then
MsgBox "张三是李四的顶头上司！"
End If
以上的代码在实际编程中可能很少用到，或者永远不可能用到，但这也从另一个方面反映了组件开发的灵活性。 看到这，如果你还感觉不理解的话，请随便买一本VB初级入门的书，仔细研究研究。 2.4.2.
详细的界面例子打开VB，新建一个工程。引用刚才生成的myCom.dll，加入微软通常控件（Common Control 6.0）。 添加一个窗口frmMain，加入一个Treeviw，用于显示分级显示的部门与人员，命名为tvwShow。 加入一个ListView，用于显示人员的列表，命名为lvwEmp。 加入六个按钮，分别用于部门/人员的增、改、删（为了更好地说明问题，特意加入六个按钮，在实际开发中没这么麻烦），分别命名为cmdAddDept, cmdEditDept, cmdDeleteDept, cmdAddEmp, cmdEditEmp, cmdDeleteEmp。 加入一个图像列表，加入三个具有表义性的图标，其Key属性分别为“O”，“D”，“E”，用于根节点、部门、人员的图标。并将tvwShow的图像列表设为该控件。 2.4.2.1.
显示部门、人员到树型图加入以下代码，实现部门与人员的加载。 '将所有部门加入树型图 Private Sub DepartmentToTreeview(ByRef tvw As TreeView)
Dim objDepts As New cDepts
Dim i As Long
'先加入没有上级部门的部门
objDepts.Find , 0
Dim Nd As Node
Set Nd = tvw.Nodes.Add(, , "O0", "所有部门", "O") '加入原始根节点。“O0”中，第一个为字母O，第二个为数字0
Nd.Expanded = True
For i = 1 To objDepts.Count
'加入没有上级部门的部门节点，图形列表ID为“D”
Set Nd = tvw.Nodes.Add("O0", tvwChild, "A" & objDepts(i).ID, objDepts(i).DeptName, "D")
Nd.Expanded = True
'加载其下级部门节点
LoadSubNodes tvw, Nd, objDepts(i).ID
Next i
End Sub
'调用递归，显示树型的部门结构 Private Sub LoadSubNodes(ByRef tvw As TreeView, Nd As Node, NodeID As Long)
Dim Nd1 As Node
Dim objDepts As New cDepts
Dim i As Long
objDepts.Find , NodeID '找到部门的所有子部门
For i = 1 To objDepts.Count
Set Nd1 = tvw.Nodes.Add(Nd, tvwChild, "A" & objDepts(i).ID, objDepts(i).DeptName, "D")
Nd1.Expanded = True
'递归加载下级部门.....
LoadSubNodes tvw, Nd1, objDepts(i).ID
Next i
End Sub
'将人员加入到树型图，树型图中已有部门节点 Private Sub EmployeeToTreeview(ByRef tvw As TreeView)
On Error Resume Next '该代码为了防止错误而加入，实际编程中需要做判断，本处为了说明问题。
Dim objEmps As New cEmps
objEmps.Find '找到所有的人员
Dim i As Long
For i = 1 To objEmps.Count
AddEmpToTvw objEmps(i), tvw
Next i
End Sub
'本来EmployeeToTreeview一个函数就可以完成“加入人员到树型图”，但 '考虑到在单独新增人员时需用到下面的函数，因此将下面的代码单独提取 '出来，做了一个单独的函数。（详见后面的代码） '将一个人员加入到树型图中，显示到相应的部门下面 Private Sub AddEmpToTvw(ByVal objEmp As cEmp, ByRef tvw As TreeView)
On Error Resume Next
tvw.Nodes.Add "A" & objEmp.DeptID, tvwChild, "B" & objEmp.ID, objEmp.EmpName, "E"
End Sub
'将一个部门加入到树型图中 Private Sub AddDeptToTvw(ByVal objDept As cDept, ByRef tvw As TreeView)
On Error Resume Next
If objDept.SuperID = 0 Then
'“O0”中，第一个为字母O，第二个为数字0
tvw.Nodes.Add "O0", tvwChild, "A" & objDept.ID, objDept.DeptName, "D"
Else
tvw.Nodes.Add "A" & objDept.SuperID, tvwChild, "A" & objDept.ID, objDept.DeptName, "D"
End If
End Sub 在Form_Load事件中加入如下代码： Private Sub Form_Load()
DepartmentToTreeview tvwShow '将部门显示到树型图中
EmployeeToTreeview tvwShow '将人员也加入到相同的树型图中
End Sub 此时，你可以手工在数据库中加入一些记录，然后运行程序。你会发现这些代码已实现了部门与人员的显示。 在上面的代码中，你仍然未看出任何数据库编程的特征。 2.4.2.2.
人员显示到列表框以下代码实现了将人员显示到列表框的功能，参看代码中备注。 '按照“人员”类的结构，设置ListView的显示样式 Public Sub InitEmployeeListview(ByRef lvw As ListView)
With lvw
.View = lvwReport
.LabelEdit = lvwManual
.GridLines = True
.ColumnHeaders.Clear
'加入四个列首
.ColumnHeaders.Add , , "姓名", 1000
.ColumnHeaders.Add , , "所属部门", 2000
.ColumnHeaders.Add , , "年龄", 800
.ColumnHeaders.Add , , "性别", 700
End With
End Sub
'将人员集合显示到ListView中 Public Sub EmployeesToListview(ByVal objEmps As cEmps, ByRef lvw As ListView)
'传入参数为人员的集合类与列表框
Dim i As Long
'如果列表还未初始化，则初始化之(你可以采用其它方法判断是否初始化，这里是个笨办法)
If lvw.ColumnHeaders.Count = 0 Then InitEmployeeListview lvw
lvw.ListItems.Clear '清除当前的列表内容
For i = 1 To objEmps.Count
'将每个“人员”都加入到该列表中，调用了单独的函数，没有全部做到这
'个函数中，为什么呢？参看AddEmpToLvw函数
AddEmpToLvw objEmps.Item(i), lvw, False
Next i
End Sub
'将单个人员加入列表，或在列表中更新 '特意将该函数单独做出来，而没有将本函数中的代码完全在EmployeesToListview函数中实现 'Why? '因为在设计该功能时，你还应考虑到在以后的编程过程中，很可能要用到 '将某个单独的“人员”对象加入列表框（比如新增加了一个人员）。 Public Sub AddEmpToLvw(ByVal objEmp As cEmp, ByRef lvw As ListView, ByVal IsOverWrite As Boolean)
'第三个参数如果是TRUE，则说明是更新当前已存在的某个列表项，否则是新加一个列表项
Dim Itm As ListItem
If IsOverWrite Then
Set Itm = lvw.SelectedItem
If Itm Is Nothing Then Exit Sub
Else
Set Itm = lvw.ListItems.Add(, "A" & objEmp.ID)
End If
With objEmp
Itm.Text = .EmpName
Itm.SubItems(1) = .DeptName
Itm.SubItems(2) = .EmpAge
Itm.SubItems(3) = IIf(.EmpGender = Female, "女", "男")
End With
Set Itm = Nothing
End Sub 在Form_Load中加入以下代码行（使之成为第一行代码）： InitEmployeeListview lvwEmp '初始化列表 到此为止，我们已完成了基本的显示操作，下来一个问题是：当你选中了一个树型图节点后（比如一个部门节点），如何才能实例化这个对象，即从界面中取得对象？请继续看。 2.4.2.3.
从控件中取回对象在上面的代码中，我们看到，将对象加入控件时，如果控件是树型图，我们将节点的Key值设为字母“A+对象的ID”（对于根节点是字母O+数字0，对于部门节点是字母A，人员节点是字母B，这样做是为了防止Key重复），如果控件是列表框，将列表项的Key值也设为相同的值。 这样，可以通过Key属性取回其ID值。因此再加入以下一个函数，取回ID值。 '得到某个节点或列表项所表示的对象的实际ID，如“A1”，则得到1，“B2”，则得到2 Private Function GetID(strKey As String) As Long GetID = Val(Right(strKey, Len(strKey) - 1)) End Function 再加入以下几个函数，函数功能与原理参看代码注释（别担心，很简单的）。 '从列表或树型图中中得到一个人员对象 Public Function GetEmpFromControl(ByVal ctl As Object, ByRef objEmp As cEmp) As Boolean
'如果列表中没有被选择的项，则直接退出
If ctl.SelectedItem Is Nothing Then
GetEmpFromControl = False
Exit Function
End If
Dim objEmps As New cEmps
Dim ID As Long
'去除控件中节点或列表项的KEY属性前的字母“A”，即为该人员的ID值
ID = GetID(ctl.SelectedItem.Key)
On Error Resume Next '为了防止未查找到，因此加入了错误判断语句
Set objEmp = objEmps.Find(ID).Item(1)
GetEmpFromControl = (Err.Number = 0)
End Function
'从树型图中得到部门对象 Public Function GetDeptFromTreeview(ByVal tvw As TreeView, ByRef objDept As cDept) As Boolean
If tvw.SelectedItem Is Nothing Then Exit Function
Dim objDepts As New cDepts
'按选择的节点的KEY查找对象
If objDepts.Find(GetID(tvw.SelectedItem.Key)).Count = 0 Then Exit Function
On Error Resume Next '为了防止未查找到，因此加入了错误判断语句
Set objDept = objDepts.Item(1)
GetDeptFromTreeview = (Err.Number = 0)
End Function 以上函数的用法见后面的代码。 2.4.2.4.
部门的增、删、改因为部门、人员都存在于一个树型图中，因此用户点击不同的节点后应有不同的操作功能，参看以下代码。 Private Sub tvwShow_NodeClick(ByVal Node As MSComctlLib.Node)
Dim Flag As String
Flag = Left(Node.Key, 1) '得到当前选择的节点类型
'将所有按钮设为不可用
Dim ctl As Control
For Each ctl In Controls
If TypeOf ctl Is CommandButton Then ctl.Enabled = False
Next
Select Case Flag
'选择了根节点，此时加以增加部门
Case "O"
cmdAddDept.Enabled = True
Case "A"
'选择了部门节点，此时可增、删、改部门与增人员
cmdAddDept.Enabled = True
cmdEditDept.Enabled = True
cmdDeleteDept.Enabled = True
cmdAddEmp.Enabled = True
'显示该部门下的所有人员到列表框中
'此处纯粹是为了演示，实际应用情况可能会有更多要求
Dim objEmps As New cEmps
objEmps.Find , , GetID(Node.Key)
EmployeesToListview objEmps, lvwEmp
Case "B"
'选择了人员节点，此时可删除、修改人员
cmdEditEmp.Enabled = True
cmdDeleteEmp.Enabled = True
End Select
End Sub 下面演示如何实现部门的增加、修改与删除功能。注意，因为部门只有一个“部门名称”属性，因此我们可以用输入框进行部门的编辑。 Private Sub cmdAddDept_Click()
''增加部门
Dim strName As String
strName = Trim(InputBox("请输入部门名称:"))
If strName = "" Then Exit Sub
Dim objDept As New cDept
Dim Result As gxcAddNew
Result = objDept.AddNew(strName, GetID(tvwShow.SelectedItem.Key))
If Result = AddNewOK Then
'将部门加入树型图
AddDeptToTvw objDept, tvwShow
ElseIf Result = DuplicateName_AddNew Then
MsgBox "有重名的部门存在，重新命名！"
Else
MsgBox "失败！"
End If
End Sub
Private Sub cmdDeleteDept_Click()
'删除部门
If MsgBox("真的要删除？", vbQuestion + vbYesNo + vbDefaultButton2) = vbNo Then Exit Sub
Dim objDept As cDept
If GetDeptFromTreeview(tvwShow, objDept) = False Then Exit Sub
Dim Result As gxcDelete
Result = objDept.Delete
If Result = DeleteEmpExists Then
MsgBox "存在人员，不能删除"
ElseIf Result = DeleteSubExists Then
MsgBox "存在子部门，不能删除"
ElseIf Result = DeleteFail Then
MsgBox "删除失败！"
Else
'来到这，说明删除成功，从树型图中删除节点
tvwShow.Nodes.Remove tvwShow.SelectedItem.Index
RefreshButton
End If
End Sub
Private Sub cmdEditDept_Click()
'编辑部门
Dim objDept As cDept
If GetDeptFromTreeview(tvwShow, objDept) = False Then Exit Sub
Dim strName As String
'缺省显示原部门的部门名称
strName = Trim(InputBox("请输入新的部门名称:", , objDept.DeptName))
If strName = "" Then Exit Sub
Dim Result As gxcUpdate
objDept.DeptName = strName
Result = objDept.Update
If Result = UpdateOK Then
'将部门加入树型图
tvwShow.SelectedItem.Text = objDept.DeptName
ElseIf Result = DuplicateName_Update Then
MsgBox "有重名的部门存在，重新命名！"
Else
MsgBox "失败！"
End If
End Sub 再加入下面的一个函数。 Private Sub RefreshButton()
'刷新界面上的六个按钮。
'为什么要这样做呢？比如：
'你现在选择了一个“人员”节点，此时你可以点击“修改人员”按钮。
'但如果你将这个人员删除，此时树型图中已没有这个人员节点，而被
'选择的可能是一个部门节点，此时你的“修改人员”按钮应变为不可用
'状态。因此每当删除人员或部门后，都应调用这个函数
If tvwShow.SelectedItem Is Nothing Then Exit Sub
tvwShow_NodeClick tvwShow.SelectedItem
End Sub 试试吧，你可以进行部门的增加、删除、修改了！ 2.4.2.5.
人员的增加、删除、修改为什么将人员与部门分开介绍？我们可以通过一个输入框进行部门的新增与修改工作，但由于人员有许多属性，因此可能需要通过一个单独的窗口实现，例如该窗口中可能有一些文本框，下拉列表框，两个按钮分别用于确认与取消。 面向对象编程的一个特点是整个程序代码中充满了“对象”的概念。比如你需要增加或编辑一个“人员”，而且决定弹出一个单独的窗口进行编辑与显示（如一个模态窗口，名称为fEmp），则该窗口与主窗口间必然要进行数据通讯。 你可能想到编写以下的代码。
Private Sub AddNewEmployeeDemo()
'在这个函数中进行“修改一个人员”的操作
'假设在这里已经实例化了一个objEmp对象
With fEmp’fEmp为编辑人员的模态窗口
.Show '显示编辑窗口
'以下从编辑窗口中取得值
objEmp.EmpName = .txtName.Text
objEmp.EmpAge = Val(.txtAge.Text)
If .cboGender.ListIndex = 0 Then
objEmp.EmpGender = Female
Else
objEmp.EmpGender = Male
End If
'在下面可能还要判断合法性，比如年龄不能输入字母等等
''''If 输入不合法 Then
End With
'通过以上代码，我们从“增加/修改人员”的窗口中取得了
'部分数据，从而构造了了一个“人员”对象，即可用于下面的
'增加或删除或修改操作，如：
If objEmp.Update = True Then
'.....
Else
'.....
End If
End Sub 上面的代码当然可以正确运行，但如果在fEmp窗口中多做一些工作，则会使得代码更好看，以下为fEmp窗口的代码： Option Explicit
Private OK As Boolean '确定用户按了OK还是CANCEL按钮 Private objEmp As cEmp Private isAddNew As Boolean '这个参数表示该窗口打开是用于新增还是修改 Private DepartmentID As Long '所在部门的ID，如果是修改，则这个变量没用
Private Sub cmdOK_Click()
'检验是否输入了名字，或是否正确输入了年龄
If Trim(txtName) = "" Or Not IsNumeric(txtAge) Then
MsgBox "请输入合法的姓名与年龄"
Exit Sub
End If
OK = True
'如果是新增状态，则新建立一个“人员”对象
If isAddNew Then Set objEmp = New cEmp
'给“人员”对象赋值
objEmp.EmpAge = Val(txtAge)
objEmp.EmpName = Trim(txtName)
objEmp.EmpGender = cboGender.ListIndex
'如果是新增状态，则设置人员的部门ID
If isAddNew Then objEmp.DeptID = DepartmentID
Me.Hide
End Sub
Private Sub cmdCancel_Click()
'按了取消按钮
OK = False
Me.Hide
End Sub
Private Sub SetStatus()
'根据是“新增”还是修改，确定显示内容
If isAddNew Then
txtName.Text = ""
txtAge.Text = "20"
cboGender.ListIndex = 0
Else
txtName.Text = objEmp.EmpName
txtAge.Text = objEmp.EmpAge
cboGender.ListIndex = objEmp.EmpGender
End If
End Sub
Public Function RetrieveEmp(ByRef oEmp As cEmp, Optional DeptID As Long = -1) As Boolean
Set objEmp = oEmp
'得到所属部门的ID，如果是编辑状态，则此ID没用
DepartmentID = DeptID
isAddNew = (DeptID <> -1) '根据是否传入了“部门ID”来确定是新增还是编辑状态
SetStatus '根据新增或编辑状态设置显示内容
Me.Show vbModal
If OK = False Then Exit Function
Set oEmp = objEmp
RetriveEmp = True
Unload Me
End Function 上面即为fEmp窗口的所有代码，该窗口有两个文本框，分别用于姓名与年龄的输入，一个下拉列表框用于性别输入（列表索引刚好与类中定义的枚举一一对应），两个按钮（OK与Cancel）。 可以看出，该窗口提供了一个唯一入口函数RetrieveEmp，该函数有两个参数，第一个参数为一对象变量，第二个参数是可选参数，表示人员所属的部门ID。 这样，我们可以通过下面代码实现修改人员的信息：
'假设在这里已经实例化了一个objEmp对象
If fEmp.RetriveEmp(objEmp) = False Then Exit Sub
If objEmp.Update = True Then
Else
End If
我们可以看到，只通过一个函数，即可以完成从“修改”窗口中获取人员信息。不同的是，我们在fEmp窗口中写了大量代码。这就是封装的概念，即我们将fEmp窗口封装成了一个类，用于新增/修改人员信息。该类只有一个入口即RetrieveEmp。如果你还需要在程序的其它地方新增或修改人员信息，只需简单地调用这个函数就行了，而不需要重复编写代码。 甚至，你可以单独做一个函数，如下： Public Function GetMyEmp(Byref objEmp As cEmp) As Boolean
'这里只是为了举例子，在程序代码中未这样做
GetMyEmp = fEmp.RetriveEmp(objEmp)
End Sub 下面继续介绍。 在frmMain中加入以下代码用于人员的增、删、改： Private Sub cmdAddEmp_Click()
'新增人员
Dim objEmp As cEmp
If fEmp.RetriveEmp(objEmp, GetID(tvwShow.SelectedItem.Key)) = False Then Exit Sub
If objEmp.AddNew = True Then
AddEmpToTvw objEmp, tvwShow
Else
MsgBox "错误"
End If
End Sub
Private Sub cmdDeleteEmp_Click()
'删除人员
If MsgBox("要删除人员？", vbInformation + vbYesNo + vbDefaultButton2) = vbNo Then Exit Sub
Dim objEmp As cEmp
If GetEmpFromControl(tvwShow, objEmp) = False Then Exit Sub
If objEmp.Delete = True Then
tvwShow.Nodes.Remove tvwShow.SelectedItem.Index
RefreshButton
Else
MsgBox "错误"
End If
End Sub
Private Sub cmdEditEmp_Click()
'编辑人员
Dim objEmp As cEmp
If GetEmpFromControl(tvwShow, objEmp) = False Then Exit Sub
If fEmp.RetriveEmp(objEmp) = False Then Exit Sub
If objEmp.Update = True Then
AddEmpToLvw objEmp, lvwEmp, True
tvwShow.SelectedItem.Text = objEmp.EmpName
Else
MsgBox "错误"
End If
End Sub OK！你可以运行整个程序了！ 2.4.3.
扩展上面的例子讲述了如何实现对象与界面的显示与获取。你可能会想到将这些方法封装在类里面，操作可能会更容易些。当然你可以这么做！ 但有时候可能没必要这么做，只需在界面端做一个独立的模块用于界面显示操作就可以了，如果中间层与用户界面不在一台机器上，这样的结果可能会加大网络传输量。况且有些客户端可能需要将内容显示到不同的控件中（如网格、下拉列表等等）。 对于VB语言，界面设计实际上可以更为灵活。但不管采用哪一种方式，始终注意一点：你所做的东西应该让你的客户用起来舒服！ 比如上面的fEmp窗口，只提供了一个函数接口，该窗口封装了大量代码（当然你还可以将该窗口做得更健壮）。记住，当你做这个窗口时，你的用户是其它程序员----其它调用该窗口的程序员，因此，多多为他们考虑一下，如何才能让他们调用起来更为方便。当你真正做到了这一点，你将是一个真正“具有团队精神”的程序员！ 记住，对于这些封装性很强的代码，尽量一次做好，全面测试通过，然后永远将其抛到脑后！ 2.5.
扩展为B/S一旦做好了“部门”与“人员”两个类，我们可以在程序的任何地方使用其接口，而不用多次编写重复的代码—这也是为何在组件中编写了大量代码的原因。 现在，如果要做一个B/S版本的程序，工作就简单多了。既然有了中间层组件，而且组件中包含了全部的业务逻辑与接口，因此在ASP代码中（假设采用ASP开发）可以直接使用组件中提供的各种对象和接口，不必为建立数据库连接、记录集的返回、合法性较验而做过多的重复工作。下图显示了这种可重用性的原理。 3.
总结通过上述例子可以看出，在中间层的开发过程中编写了大量代码，而且界面中的代码量也很吓人。实际上，在上面的例子中，采用多层体系结构的代码量和工作量大概是传统C/S工作量的2-3倍以上。 那么，为何还要采用三层体系结构呢？ 你可以认为上面的例子是一个“纯粹”的三层体系结构，它是一种最理想化的体系结构。而且为了更为详细地介绍，我写了许多注释在里面；再者，其中有些代码是完全可以通过编程技巧进行简化与优化的，之所以如此详细是介绍，纯粹是为了更好地说明问题。优化后的代码量大概可以减少一半。 当你第一次开始使用这种方法时，可能会因此而延长开发周期，而你的不懂计算机的上司（假设他真的不懂）也可能会因此而感到不解，为何采用了新技术反而会加大开发成本，延长开发周期？ 答案很简单。因为你或你的开发团队没有积累。当你采用这种方法做了两个项目的时候，你会发现许多做好的组件是完全可以重用的，也许只需经过一点很小的修改。 一点建议：为了减少代码输入量，可以采用VB自带的“类生成工具”进行类的生成。 如果仔细研究，会发现所有的实体类（即实际存在的业务对象）都与数据库中的某个实体表一一对应，且其属性也对应着数据表中的相应字段。并且都存在AddNew、Delete、Update方法。要是你的项目组经常要做类似的项目，你完全可以做一个“代码生成器”，从数据库中读取数据库结构，直接生成所有的类模块—当然你还需进行少量的修改工作。 如果你是一个优秀项目经理，你可以组织掌握不同技能的人成为一个项目组，有些成员可能擅长于界面制作，有些擅长于数据库编程，有些擅长组件设计，甚至有些人根本不会VB，他们使用Delphi或C++。一个优秀的项目经理完全可以通过合理的分工使得项目顺利进行，然而可能直至项目结束时，有些项目组员也没机会了解数据库的结构，有些程序员甚至根本不知道程序界面长什么样子，但项目的确是按时按质完成了！ 本文全部用VB完成了整个代码设计，如果你不使用VB，或不屑于使用VB，那么上面的方法依然适用，我们注重的是体系结构与整体思路。 其实，经常见到许多程序员对于编程语言级为挑剔，他们很在乎编程语言的先进性。但是，作为一个软件人员，或软件开发团队，甚至一个软件公司，什么是先进？作者认为，有效才是先进！同理，最先进的往往不一定有效。 我相信，对于任何一个程序员来说，既然从事了软件行业，那你的目标不可能永远是程序员，你可能将系统分析员、项目经理、高层开发管理逐一列为你的奋斗目标。既然这样，别再挑剔编程语言了，否则，你永远只能是一个程序员！尽管你可能会是一个很棒的程序员。 当然，三层体系结构的概念远远不至于此，优秀的分布式应用开发的过程，用到了向对象的分析/设计/编程/测试，UML建模、软件开发过程控制、并行开发、迭代增量开发等诸多先进技术与理念。 面向对象的技术，不仅可以使得软件开发过程更易于控制，软件稳定性、质量得以提高，而且对于其它领域分析问题的方法、思路都颇为有益。长期从事此道，你会发现其中的乐趣有如滔滔的江水，连绵不绝！接要 本文主要介绍了基于三层体系结构的网络数据库设计，并结合面向对象，分布式数据库开发等理论。全文围绕一个典型而简单的例子，通过VB编程语言，从分析、建模、设计、编码等各个角度对三层体系与数据库进行了全面而详细的阐述，文中提供了全部源代码。 关键词
三层体系
数据库
面向对象
分布式开发 1.
三层体系结构我们经常会看到许多应聘者在简历上写着“精通数据库编程”的字样，也经常会在招聘网站上看到软件公司的招聘要求中某一项为“精通数据库编程”。于是这些应聘者去这些软件公司面试，于是我们看到了许多“精通”者落选的现象。 一些程序员在设计数据库应用时，通常会采用数据控件绑定的方法实现。用鼠标拉几个控件，再用鼠标设置几个属性，连键盘都不用动，就完成了一个数据库应用的开发！当然，这的确是一种快速的数据库应用开发方式，但快速并不意味着精通。 对于大型的数据库应用系统，或是拥有众多客户端的应用系统，我们需要另外一种“精通”，这就是几乎每个程序员都听说过的“三层体系结构”。 1.1.
传统的C/S模式在传统的数据库应用体系中，客户端与数据库完全分开，在客户端上运行了大部分服务，如数据访问规则、业务规则、合法性校验等等。每一个客户端都存在数据引擎，并且每个客户端与数据库服务器建立独立的数据库连接（DB Connection）。 基于该种体系的数据库应用系统的优势：开发周期较短，能够适应大部分中小型数据库应用系统的要求（当客户端数量少于50时）。 但是，随着数据库应用的日渐发展、数据容量的不断增加、客户端数量的不断增加，该种体系结构显示出了诸多缺陷，主要体现在以下几个方面： 1、
可扩充性：对于数据库服务器端，每当建立一个数据连接，就会占用大量的系统资源，当数据连接达到一定数量（如20个）时，数据库服务器的响应速度与处理速度将大打折扣。 2、
可维护性：基于传统C/S的数据库应用系统，业务规则通常置于客户端应用程序中。如果业务规则一旦发生变化（随便举个例子，如身份证号码有可能升为19位）时，我们就必须修改客户端应用程序，并且将每个客户端进行相应的升级工作。 3、
可重用性：采用传统C/S的设计模式时，数据库访问、业务规则等都固化在客户端应用程序中。如果客户另外提出了B/S的应用需求，则需要在WEB服务器中重新进行数据库访问、业务规则、合法性校验等编码（例如将数据库访问写入ASP代码），而所做的工作与客户端应用程序中的功能完全重复，从而加大了工作量，又使得程序开发者心里感到极不舒服。 正因为以上的诸多缺陷，使得三层（多层）体系结构成为目前数据库应用开发的首选，甚至客户有时也会提出该种技术需求。 1.2.
三层体系结构所谓三层体系结构，是在客户端与数据库之间加入了一个“中间层”，也叫组件层。这里所说的三层体系，不是指物理上的三层，不是简单地放置三台机器就是三层体系结构，也不仅仅有B/S应用才是三层体系结构，三层是指逻辑上的三层，即使这三个层放置到一台机器上。 三层体系的应用程序将业务规则、数据访问、合法性校验等工作放到了中间层进行处理。通常情况下，客户端不直接与数据库进行交互，而是通过COM/DCOM通讯与中间层建立连接，再经由中间层与数据库进行交互。 这样的好处显而易见： 1、
由于数据访问是通过中间层进行的，因此客户端不再与数据库直接建立数据连接。也就是说，建立在数据库服务器上的连接数量将大大减少。例如一个500个客户端的应用系统，500个客户端分别与中间层服务器建立DCOM连接，而DCOM通讯所占用的系统资源极为有限，并且是动态建立与释放连接，因此客户端数量将不再受到限制。同时，中间层与数据库服务器之间的数据连接通过“连接池”进行连接数量的控制，动态分配与释放数据连接，因此数据连接的数量将远远小于客户端数量。 2、
可维护性得以提高。因为业务规则、合法性校验存在于中间层，因此当业务规则发生改变时，只需更改中间层服务器上的某个组件（如某个DLL文件），而客户端应用程序不需做任何处理，有些时候，甚至不必修改中间层组件，只需要修改数据库中的某个存储过程就可以了。 3、
良好的可重用性。同样，如果需要开发B/S应用，则不必要重新进行数据访问、业务规则等的开发，可以直接在WEB服务器端调用现有的中间层（如可以采用基于IIS的WebClass开发，或直接编写ASP代码）。 4、
事务处理更加灵活，可以在数据库端、组件层、MTS（或COM+）管理器中进行事务处理。 如果现在你仍然感到不理解，没关系，请看下面的例子。 2.
简单的人事管理系统下面以一个极为简单的人事管理系统为例详细讲述如何实现三层体系结构。编程语言为Visual Basic 6.0。 为了全面介绍程序设计方法，VB代码中采用了不同的方法实现相同的功能，如数据库访问中，同时采用了存储过程与ADO连接。读者可自行选择最适合的方法。 由于在代码中加入了大量注释，因此不再过多地说明函数功能与原理。 在团队开发中，代码中注释部分应占整个代码的1/3左右，而且应在代码编写前就写好注释。如果另一个程序员认为你的代码中注释全部是废话，那么这些注释肯定是在写完代码之后才加上去的！ 2.1.
需求简单的部门/人员管理系统，要求： 1、
部门的属性有部门名称，人员的属性有姓名、年龄、性别； 2、
部门存在上下级关系； 3、
人员必须属于一个部门； 4、
人员、部门需要实现增加、删除、修改功能 5、
可以按人员的名称、年龄查询人员 6、
如果一个部门存在人员，或存在下级部门，则该部门不可删除 以上即为系统的简单需求。 2.2.
数据库数据库采用SQL Server 7设计，数据库名称为“TEST”，存在两个数据表（此处假设读者已掌握数据库设计，因为这个数据库实在太简单了）。 表tDept tEmployee
其中，tDept中nID与SuperID为表内关联。 2.3.
中间层打开VB6，选择“新建ActiveX DLL”，并引用ADO 2.5。 新添加一个模块，命名为mdlPublic，新填加5个类，分别命名为cDept、cEmp、cDepts、cEmps、cPublic。其中，cEmps与cDepts分别为cEmp与cDept的集合类，cPublic为定义枚举的类，无实际意义。将工程的启动模块设为“Sub Main”（重要！）。 在SQL Server的TEST库中，添加一个存储过程AddDept。 全部代码如下： 2.3.1.
mdlPublic.basOption Explicit
Public g_Cn As Connection '用于全局的数据连接
'ActiveX DLL的启动程序，为DLL初始化时执行 Public Sub Main()
If ConnectToDatabase = False Then
Err.Raise vbObjectError + 1, , "连接数据库出错！"
End If
End Sub
'连接到数据库 Public Function ConnectToDatabase() As Boolean
On Error GoTo ERR_CONN
Set g_Cn = New Connection
'设置服务器名称，数据库名称，登录名（此时假设密码为空）
Dim ServerName As String, DBName As String, UserName As String
ServerName = "gxc-notepad"
DBName = "TEST"
UserName = "sa"
'连接到数据库
With g_Cn
.CursorLocation = adUseClient
.CommandTimeout = 10
.ConnectionString = "undefinedrovider=SQLOLEDB.1undefinedersist Security Info=True;User ID=" & UserName & ";Initial Catalog=" & DBName & ";Data Source=" & ServerName
.Open
End With
ConnectToDatabase = True
Exit Function
ERR_CONN:
ConnectToDatabase = False
End Function
'去掉字符串中的单引号 Public Function RealString(strOrigional) As String
RealString = Replace(strOrigional, "'", "")
End Function
'得到某个数据表中主键的下一个值，即当前主键值加1 Public Function NextID(ByVal strTable As String, ByVal strID As String) As Long
'两个参数分别是表的名称与主键的名称
Dim rs As Recordset
Set rs = g_Cn.Execute("SELECT MAX(" & strID & ") FROM " & strTable)
If IsNull(rs(0)) Then
'如果值为NULL，则说明无任何数据记录，此时ID应为1
NextID = 1
Else
'使新ID为最大ID值+1
NextID = rs(0).Value + 1
End If
End Function
'查看某个数据表中，是否存在某个字段等于某个值的记录（整型） Public Function ExistByID(ByVal strTable As String, ByVal strID As String, ByVal lngID As Long) As Boolean
'第一个参数为表名，第二个为字段名，第三个为具体的字段值
Dim rs As Recordset
Set rs = g_Cn.Execute("Select Count(*) from " & strTable & " where " & strID & "=" & lngID)
ExistByID = (rs(0).Value = 1)
End Function
'查看某个数据表中，是否存在某个字段等于某个值的记录（字符型） Public Function ExistByName(ByVal strTable As String, ByVal strFieldName As String, ByVal strName As String, ByVal ThisID As Long) As Boolean
'第一个参数为表名，第二个为字段名，第三个为具体的字段值
Dim rs As Recordset
Set rs = g_Cn.Execute("Select Count(*) from " & strTable & " where " & strFieldName & "='" & strName & "' and nID<>" & ThisID)
ExistByName = (rs(0).Value = 1)
End Function '以上两个函数实际上可以合并，本程序中为了说明问题，故而分开 2.3.2.
cPublic.clsOption Explicit '该类无实际意义，只为保存一些自定义枚举
'自定义枚举，用于表示性别 Public Enum gxcGender
Male = 1
Female = 0
End Enum
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' '以下枚举用于“部门”对象的操作
'用于表示部门删除结果的枚举 Public Enum gxcDelete
DeleteOK = 0
DeleteFail = 1 '未知原因导致不能删除
DeleteSubExists = 2 '由于存在子部，因此不能删除
DeleteEmpExists = 3 '该部门存在人员，不能删除
End Enum
'用于表示部门更新结果的枚举 Public Enum gxcUpdate
UpdateOK = 0
UpdateFail = 1
DuplicateName_Update = 2 '名字不可重复
RecordNotExist = 3 '当前更新的记录已被其它客户端删除
End Enum
'用于表示部门新增结果的枚举 Public Enum gxcAddNew
AddNewOK = 0
AddNewFail = 1
DuplicateName_AddNew = 2 '名字不可重复
SuperNotExist = 3 '指定的上级部门的ID不存在
End Enum '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' 2.3.3.
cDept.clsOption Explicit
Private mvarDeptName As String Private mvarID As Long Private mvarSuperID As Long
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' '以下为部门的属性
'上级部门ID Public Property Let SuperID(ByVal vData As Long)
mvarSuperID = vData
End Property Public Property Get SuperID() As Long
SuperID = mvarSuperID
End Property
'本部门的ID Public Property Let ID(ByVal vData As Long)
mvarID = vData
End Property Public Property Get ID() As Long
ID = mvarID
End Property
'本部门的名称 Public Property Let DeptName(ByVal vData As String)
vData = Trim(vData) '去除两边的空格
'控制名称的长度不可大于50
If Len(vData) > 50 Then vData = Left(vData, 50)
mvarDeptName = vData
End Property Public Property Get DeptName() As String
DeptName = mvarDeptName
End Property '属性结束 ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
''''''''''''''''''''''''''''''''''''''''''''''''''''''' '以下为方法
'新增一个部门，并返回操作的结果 Public Function AddNew(Optional strName As String = "", _
Optional lngSuperID As Long = -1) As gxcAddNew
'根据传入的参数更新属性值
On Error GoTo ERR_ADDNEW
'如果参数被传入，则以传入的参数更新属性
If strName <> "" Then Me.DeptName = strName
If lngSuperID <> -1 Then Me.SuperID = lngSuperID '上级部门的ID
'通过Command对象调用存储过程，由存储过程
'进行添加部门的操作，并由存储过程返回操作结果
Dim cmd As ADODB.Command
Set cmd = New ADODB.Command
With cmd
Set .ActiveConnection = g_Cn
.CommandType = adCmdStoredProc '设置Command类型为“存储过程”
.CommandText = "AddDept" '存储过程的名称
'传入两个参数，分别为部门的名称与上级部门的ID
.Parameters.Append .CreateParameter("@Name", adChar, adParamInput, 50, Me.DeptName)
.Parameters.Append .CreateParameter("@SuperID", adInteger, adParamInput, , Me.SuperID)
'传入两个返回型的参数，分别返回新记录的ID与操作结果
.Parameters.Append .CreateParameter("@ID", adInteger, adParamOutput)
.Parameters.Append .CreateParameter("@Return", adInteger, adParamOutput)
.Execute
End With
Dim RTN As gxcAddNew
RTN = cmd.Parameters("@Return").Value '得到操作结果
'如果操作成功，则给对象赋以ID值
If RTN = AddNewOK Then Me.ID = cmd.Parameters("@ID").Value
AddNew = RTN '返回操作结果
Set cmd = Nothing
Exit Function
ERR_ADDNEW:
'来到这里，则说明出错了
If Not cmd Is Nothing Then Set cmd = Nothing
AddNew = AddNewFail
End Function
'修改部门信息，返回操作结果 Public Function Update() As gxcUpdate
'通过ID判断是否存在该记录，即该记录是否被其它客户端删除
'如果不存在该记录，则返回相应的操作结果给调用者
If Not ExistByID("tDept", "nID", Me.ID) Then
Update = RecordNotExist
Exit Function
End If
'通过名称判断是否存在相同名称的记录，如果存在相同的名称，
'则返回调用者“存在相同名称”的信息
If ExistByName("tDept", "DeptName", Me.DeptName, Me.ID) Then
Update = DuplicateName_Update
Exit Function
End If
On Error Resume Next
Dim strSQL As String
'构造SQL语句，注意需调用RealString函数去除字符串中的单引号
strSQL = "Update tDept Set DeptName='" & RealString(Me.DeptName) & "',"
strSQL = strSQL & "SuperID=" & IIf(Me.SuperID = 0, "null", Me.SuperID)
strSQL = strSQL & " where nID=" & Me.ID
g_Cn.Execute strSQL '执行SQL语句
'根据是否出错，返回给调用者相应的信息
If Err.Number = 0 Then
Update = UpdateOK
Else
Update = UpdateFail
End If
End Function
'删除一个部门 Public Function Delete(Optional ByVal lngID As Long = 0) As gxcDelete
'如果调用该函数时传入了ID，则更新该对象的ID
If lngID <> 0 Then Me.ID = lngID
'如果该部门下面有人员，则也不能删除
If ExistByID("tEmployee", "DeptID", Me.ID) Then
Delete = DeleteEmpExists
Exit Function
End If
'如果该部门下有子部门，则不能删除
If ExistByID("tDept", "SuperID", Me.ID) Then
Delete = DeleteSubExists
Exit Function
End If
On Error Resume Next
'执行删除操作并返回操作结果
g_Cn.Execute "Delete from tDept where nID=" & Me.ID
Delete = IIf(Err.Number = 0, DeleteOK, DeleteFail)
End Function
'得到本部门的所有员工 Public Function Employees() As cEmps
Dim objEmps As New cEmps
'调用cEmps类的Find方法，只传第三个参数，即“部门ID”
Set Employees = objEmps.Find(, , Me.ID)
End Function
'得到本部门的所有子部门 Public Function SubDepartments() As cDepts
Dim objDepts As New cDepts
'调用cDepts的Find方法，通过上级部门的ID查找
Set SubDepartments = objDepts.Find(, Me.ID)
End Function
'得到本部门的上级部门，以对象返回 Public Function SuperDepartment() As cDept
Dim objDepts As New cDepts
'调用cDepts的Find方法，将该类的“SuperID”作为查找条件
'从而查找出其上级部门
objDepts.Find Me.SuperID
If objDepts.Count > 0 Then Set SuperDepartment = objDepts.Item(1)
End Function '方法结束 ''''''''''''''''''''''''''''''''''''''''''''''''''''''' 2.3.4.
cDepts.clsOption Explicit
Private mCol As Collection
'往集合中加入一个“部门”对象 Public Sub Add(objDept As cDept)
mCol.Add objDept, "A" & objDept.ID
'在加入对象是，最好同时加入其“KEY”属性
'“KEY”属性不可以是数字型，因此在前面随便加
'一个字母，此处加了一个“A”
End Sub
Public Property Get Item(vntIndexKey As Variant) As cDept
Set Item = mCol(vntIndexKey)
End Property
Public Property Get Count() As Long
Count = mCol.Count
End Property
Public Sub Remove(vntIndexKey As Variant)
mCol.Remove vntIndexKey
End Sub
Public Property Get NewEnum() As IUnknown
'本属性允许用 For...Each 语法枚举该集合。
Set NewEnum = mCol.[_NewEnum]
End Property
'清除集合中的全部元素 Public Sub Clear()
'注意！在清除时必须倒序清除，否则要出错！
Dim i As Long
For i = mCol.Count To 1 Step -1
mCol.Remove i
Next i
End Sub
Private Sub Class_Initialize()
Set mCol = New Collection
End Sub
Private Sub Class_Terminate()
Set mCol = Nothing
End Sub
'按条件查找部门，以集合类的方式返回 Public Function Find(Optional lngID As Long = 0, Optional lngSuperID As Long = -1) As cDepts
'按输入的参数查询，并返回一个集合类
Dim strSQL As String
'构造SQL语句
strSQL = "Select * from tDept where "
If lngID <> 0 Then strSQL = strSQL & "nID=" & lngID & " and "
If lngSuperID <> -1 Then
If lngSuperID = 0 Then '如果传入0，则表示没有上级部门
strSQL = strSQL & "SuperID is null and "
Else
strSQL = strSQL & "SuperID=" & lngSuperID & " and "
End If
End If
strSQL = strSQL & "nID>0"
'清空当前集合
Me.Clear
Dim rs As Recordset
Set rs = g_Cn.Execute(strSQL)
'往集合中添加查询结果
Dim i As Long
Dim objDept As cDept
For i = 1 To rs.RecordCount
Set objDept = New cDept
With objDept
.ID = rs("nID").Value
.DeptName = Trim(rs("DeptName").Value)
.SuperID = IIf(IsNull(rs("SuperID").Value), 0, rs("SuperID").Value)
End With
Me.Add objDept
Set objDept = Nothing
rs.MoveNext
Next i
Set rs = Nothing
Set Find = Me
End Function 2.3.5.
cEmp.clsOption Explicit
Private mvarID As Long Private mvarEmpName As String Private mvarEmpAge As Integer Private mvarEmpGender As gxcGender Private mvarDeptID As Long Private mvarDeptName As String
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' '以下为类的属性
'部门名称 Public Property Let DeptName(ByVal vData As String)
mvarDeptName = vData
End Property Public Property Get DeptName() As String
DeptName = mvarDeptName
End Property
'部门ID Public Property Let DeptID(ByVal vData As Long)
mvarDeptID = vData
End Property Public Property Get DeptID() As Long
DeptID = mvarDeptID
End Property
'性别 Public Property Let EmpGender(ByVal vData As gxcGender)
mvarEmpGender = vData
End Property Public Property Get EmpGender() As gxcGender
EmpGender = mvarEmpGender
End Property
'年龄 Public Property Let EmpAge(ByVal vData As Integer)
If vData < 0 Then vData = 1 '年龄不可小于0
mvarEmpAge = vData
End Property Public Property Get EmpAge() As Integer
EmpAge = mvarEmpAge
End Property
'姓名 Public Property Let EmpName(ByVal vData As String)
vData = Trim(vData) '去除两边的空格
'控制名称的长度不可大于10
If Len(vData) > 10 Then vData = Left(vData, 10)
mvarEmpName = vData
End Property Public Property Get EmpName() As String
EmpName = mvarEmpName
End Property
'ID Public Property Let ID(ByVal vData As Long)
mvarID = vData
End Property Public Property Get ID() As Long
ID = mvarID
End Property '属性结束 '''''''''''''''''''''''''''''''''''''''''''''''''''''''
''''''''''''''''''''''''''''''''''''''''''''''''''''''' '以下为方法
'添加一个人员 Public Function AddNew(Optional ByVal strName As String = "", _
Optional ByVal intAge As Integer = 0, _
Optional varGender As gxcGender = -1, _
Optional lngDeptID As Long = 0) As Boolean
On Error Resume Next
'如果参数为缺省值，即未传入，则直接调和类中的参数，否则调用传入的参数
If strName <> "" Then Me.EmpName = strName
If intAge <> 0 Then Me.EmpAge = intAge
If varGender <> -1 Then Me.EmpGender = varGender
If lngDeptID <> 0 Then Me.DeptID = lngDeptID
Dim strSQL As String
g_Cn.BeginTrans
'开始一个事务，以免费得到的ID值已被其它客户端所使用
'此处调用NextID方法，得到该类对应的数据表的下一个ID，即最大ID+1
Me.ID = NextID("tEmployee", "nID")
'构造SQL语句，注意需调用RealString去除字符串中的单引号
strSQL = "Insert into tEmployee (nID,DeptID,EmpName,EmpAge,EmpGender) values ("
strSQL = strSQL & Me.ID & "," & Me.DeptID & ","
strSQL = strSQL & "'" & RealString(Me.EmpName) & "',"
strSQL = strSQL & Me.EmpAge & "," & Me.EmpGender & ")"
'执行SQL语句，并提交事务
g_Cn.Execute strSQL
g_Cn.CommitTrans
'如果发生错误，则返回FALSE，表示未成功添加
AddNew = (Err.Number = 0)
End Function
'修改人员信息 Public Function Update() As Boolean
On Error Resume Next
Dim strSQL As String
'构造SQL语句
strSQL = "Update tEmployee set DeptID=" & Me.DeptID & ","
strSQL = strSQL & "EmpName='" & RealString(Me.EmpName) & "',"
strSQL = strSQL & "EmpAge=" & Me.EmpAge & ","
strSQL = strSQL & "EmpGender=" & Me.EmpGender & " "
strSQL = strSQL & "Where nID=" & Me.ID
g_Cn.Execute strSQL
'如果发生错误，则返回FALSE，表示未成功更新
Update = (Err.Number = 0)
End Function
'删除人员资料 Public Function Delete(Optional ByVal lngID As Long = 0) As Boolean
Dim strSQL As String
On Error Resume Next
'如果已传入了要删除的ID，则按此ID删除
If lngID <> 0 Then Me.ID = lngID
strSQL = "DELETE FROM tEmployee WHERE nID=" & Me.ID
g_Cn.Execute strSQL
'如果发生错误，则返回FALSE，表示未删除成功
Delete = (Err.Number = 0)
End Function '方法结束 '''''''''''''''''''''''''''''''''''''''''''''''''''''''
'将某个人员移到指定的部门 Public Function AssignToDepartment(ByVal DeptID As Long) As Boolean
'实现很简单，将部门ID变一下，然后调用Update方法就行了
Me.DeptID = DeptID
AssignToDepartment = Me.Update
End Function
'得到该人员所在部门，以对象返回 Public Function Department() As cDept
Dim objDepts As New cDepts
'调用cDepts的Find方法，得到部门
objDepts.Find Me.DeptID
If objDepts.Count > 0 Then Set Department = objDepts.Item(1)
End Function 2.3.6.
cEmps.clsOption Explicit
Private mCol As Collection '局部变量，保存集合
'将一个“人员”对象加入集合 Public Sub Add(objEmp As cEmp)
mCol.Add objEmp, "A" & objEmp.ID
'在加入对象时，最好同时加入其“KEY”属性
'“KEY”属性不可以是数字型，因此在前面随便加
'一个字母，此处加了一个“A”
End Sub
Public Property Get Item(vntIndexKey As Variant) As cEmp
Set Item = mCol(vntIndexKey)
End Property
Public Property Get Count() As Long
Count = mCol.Count
End Property
Public Sub Remove(vntIndexKey As Variant)
mCol.Remove vntIndexKey
End Sub
Public Property Get NewEnum() As IUnknown
'本属性允许用 For...Each 语法枚举该集合。
Set NewEnum = mCol.[_NewEnum]
End Property
'清除集合中的全部元素 Public Sub Clear()
'清除时应倒序清除！
Dim i As Long
For i = mCol.Count To 1 Step -1
mCol.Remove i
Next i
End Sub
Private Sub Class_Initialize()
Set mCol = New Collection
End Sub
Private Sub Class_Terminate()
Set mCol = Nothing
End Sub
'按条件查找人员，以集合类的方式返回 Public Function Find(Optional ByVal lngID As Long = 0, _
Optional ByVal strName As String = "", _
Optional ByVal lngDeptID As Long = 0) As cEmps
'构造查询SQL
Dim strSQL As String
strSQL = "Select tEmployee.*,tDept.DeptName from tEmployee left outer join tDept "
strSQL = strSQL & " ON tDept.nID=tEmployee.DeptID Where "
If lngID <> 0 Then strSQL = strSQL & "tEmployee.nID=" & lngID & " and "
'如果是按名称查询，则采用“包含”的查询方法
If strName <> "" Then strSQL = strSQL & "tEmployee.EmpName like'%" & RealString(strName) & "'% and "
If lngDeptID <> 0 Then strSQL = strSQL & "tEmployee.DeptID=" & lngDeptID & " and "
strSQL = strSQL & "tEmployee.nID>0"
'将查询结果加入集合类
Dim rs As Recordset
Set rs = g_Cn.Execute(strSQL)
Dim i As Long
Dim objEmp As cEmp
For i = 1 To rs.RecordCount
Set objEmp = New cEmp
With objEmp
.ID = rs("nID").Value
.EmpName = Trim(rs("EmpName").Value)
.EmpAge = rs("EmpAge").Value
.EmpGender = Abs(rs("EmpGender").Value)
.DeptID = rs("DeptID").Value
.DeptName = Trim(rs("DeptName").Value)
End With
Me.Add objEmp
Set objEmp = Nothing
rs.MoveNext
Next i
Set rs = Nothing
Set Find = Me
End Function 2.3.7.
AddDept存储过程CREATE PROCEDURE AddDept
@Name char(50),
@SuperID int,
@ID int output,
@Return int output
AS
begin transaction
--如果上级部门ID为0，则在些将其设为NULL，表示无上级部门
if @SuperID=0 Select @SuperID=Null
--当前的ID为最大ID值+1
Select @ID=(Select Max(nID) from tDept)+1
--如果ID值为空，则表示尚无记录，人为地赋值为1
if @ID is null select @ID=1
--如果存在相同的部门名称，则返回VB代码中定义的枚举类型
if Exists(Select * from tDept where DeptName=@Name) begin
select @Return=2
rollback transaction
return
end
--如果不存在指定的上级部门ID，则返回VB中指定的枚举类型
if not Exists(Select * from tDept where nID=@SuperID) and not(@SuperID is null) begin
select @Return=3
rollback transaction
return
end
insert into tDept (nID,SuperID,DeptName) values (@ID,@SuperID,@Name)
if @@error=0 begin
select @Return=0
commit transaction
end else begin
Select @Return=1
rollback transaction
end
2.3.8.
组件设计注意事项至此，你可以仔细研究一下上面的代码，主要是两个基本类（人员对象与部门对象），两个集合类（人员集合与部门集合）。在这里，你可以将集合理解为“对象的数组”。 然后，仔细分析一下这四个类的结构、接口、相互关系，然后将它们画出来（请一定这样做一下，它会有助于你更好地理解面向对象）。你是不是发现，还可以再加入新的接口函数？当然是的！因为本文中的代码仅仅是个示例，它们有待于你的继续完善，比如你可以将“发工资”封装到“人员”类中。 将上述代码保存为myCom.vbp并编译，生成myCom.dll文件。该DLL文件即是一个中间层组件。 在此组件中，我们加入了大量的业务规则，如“年龄不可小于0”、不能删除有子部门或上级部门、部门内有人员时不可删除、部门名称不可大于50个字符等等。 在进行任何程序设计时，都必须考虑到用户使用的方便性。比如设计应用程序时，我们总是在考虑如何让直接用户更为方便地操作，如果使得操作逻辑更为用户所接受。 同样地，COM组件的设计也应为用户做相同考虑，如何让用户更加方便地使用。COM组件的用户不是最终用户，而是程序员！ 是制作交互界面的程序员！因此在设计COM接口与结构时，应充分考虑到界面程序员的思维方式与使用方便性，例如函数应以表义性较强的字母组合命名等等。 最完美的状态是这样：使用你的COM组件的程序员心里想着：应该有这样的一个函数吧，并且名字应该是GetCustomerName，于是他真的在你的组件中发现了这个函数，而且函数名称，甚至输入参数都与他想象的完全一样，那么，你真的成功了！ 在COM组件编写完成后，应经过大量测试，测试到每一个函数与属性。可以编写简单的测试程序进行测试（有时为了节省时间，可以直接在界面中进行测试，但可能公增加程序员的沟通时间，有时反而会得不偿失）。 2.4.
客户端既然COM组件（或中间层）已编写完成并通过测试，下面就可以进行界面的编写了。 很有趣的是，采用基于三层体系结构的设计模式，界面程序员可以完全不懂数据库编程！他完全不必知道数据库的格式，甚至不必了解是何种类型的数据库。 请看以下的例子： 首先，新建一个工程，然后引用myCom.DLL。 2.4.1.
先举几个例子2.4.1.1.
添加一个部门
Dim objDept As New cDept '定义一个部门对象
Dim Result As gxcAddNew, strResult As String
With objDept
.DeptName = "总部"
.SuperID = 0 '0表示无上级部门
Result = .AddNew '得到操作结果
If Result = AddNewFail Then
strResult = "添加失败！"
ElseIf Result = DuplicateName_AddNew Then
strResult = "存在相同名称的部门，请修改名称后重新添加！"
ElseIf Result = SuperNotExist Then
strResult = "指定的上级部门不存在或已被删除！"
Else
strResult = "添加成功！"
End If
End With
MsgBox strResult, vbInformation
通过上面的代码，已完成了“增加一个部门”的操作，并且可以清楚地知道操作的结果。而代码中没有任何地方体现出这是对数据库进行编程。 上面代码中With块中的前三行还可以用下面的一行代码替换（因为你的AddNew函数中的参数全部都是可选的）：
Result = .AddNew("总部", 0)
2.4.1.2.
删除一个部门
Dim objDept As New cDept '定义部门对象
Dim Result As gxcDelete, strResult As String
Result = objDept.Delete(1) '删除ID为1的部门
If Result = DeleteEmpExists Then
strResult = "该部门内存在人员，不能删除！"
ElseIf Result = DeleteFail Then
strResult = "删除失败！"
ElseIf Result = DeleteSubExists Then
strResult = "该部门内存在子部门，不能删除！"
Else
strResult = "成功删除"
End If
MsgBox strResult, vbInformation
2.4.1.3.
查询所有子部门与部门内人员
以下代码查找出ID为12的部门，然后得到该部门下的所有人员与所有子部门。
Dim objDepts As New cDepts, objEmps As New cEmps '定义部门集合与人员集合
If objDepts.Find(12).Count > 0 Then
Set objEmps = objDepts(1).Employees '得到了部门内所有人员
Set objDepts = objDepts(1).SubDepartments '得到了部门内的所有子部门
End If
2.4.1.4.
更为有趣的操作以下代码查找出名称中包含“张三”的第一个人员，然后找出同部门的所有同事。
Dim objEmps As New cEmps
If objEmps.Find(, "张三").Count > 0 Then
'得到了同一部门的所有人员
Set objEmps = objEmps(1).Department.Employees
End If
以下代码查看张三是否是李四的直接上司。
On Error Resume Next
Dim objEmps As New cEmps
If objEmps.Find(, "张三").Item(1).Department Is objEmps.Find(, "李四").Item(1).Department.SuperDepartment Then
MsgBox "张三是李四的顶头上司！"
End If
以上的代码在实际编程中可能很少用到，或者永远不可能用到，但这也从另一个方面反映了组件开发的灵活性。 看到这，如果你还感觉不理解的话，请随便买一本VB初级入门的书，仔细研究研究。 2.4.2.
详细的界面例子打开VB，新建一个工程。引用刚才生成的myCom.dll，加入微软通常控件（Common Control 6.0）。 添加一个窗口frmMain，加入一个Treeviw，用于显示分级显示的部门与人员，命名为tvwShow。 加入一个ListView，用于显示人员的列表，命名为lvwEmp。 加入六个按钮，分别用于部门/人员的增、改、删（为了更好地说明问题，特意加入六个按钮，在实际开发中没这么麻烦），分别命名为cmdAddDept, cmdEditDept, cmdDeleteDept, cmdAddEmp, cmdEditEmp, cmdDeleteEmp。 加入一个图像列表，加入三个具有表义性的图标，其Key属性分别为“O”，“D”，“E”，用于根节点、部门、人员的图标。并将tvwShow的图像列表设为该控件。 2.4.2.1.
显示部门、人员到树型图加入以下代码，实现部门与人员的加载。 '将所有部门加入树型图 Private Sub DepartmentToTreeview(ByRef tvw As TreeView)
Dim objDepts As New cDepts
Dim i As Long
'先加入没有上级部门的部门
objDepts.Find , 0
Dim Nd As Node
Set Nd = tvw.Nodes.Add(, , "O0", "所有部门", "O") '加入原始根节点。“O0”中，第一个为字母O，第二个为数字0
Nd.Expanded = True
For i = 1 To objDepts.Count
'加入没有上级部门的部门节点，图形列表ID为“D”
Set Nd = tvw.Nodes.Add("O0", tvwChild, "A" & objDepts(i).ID, objDepts(i).DeptName, "D")
Nd.Expanded = True
'加载其下级部门节点
LoadSubNodes tvw, Nd, objDepts(i).ID
Next i
End Sub
'调用递归，显示树型的部门结构 Private Sub LoadSubNodes(ByRef tvw As TreeView, Nd As Node, NodeID As Long)
Dim Nd1 As Node
Dim objDepts As New cDepts
Dim i As Long
objDepts.Find , NodeID '找到部门的所有子部门
For i = 1 To objDepts.Count
Set Nd1 = tvw.Nodes.Add(Nd, tvwChild, "A" & objDepts(i).ID, objDepts(i).DeptName, "D")
Nd1.Expanded = True
'递归加载下级部门.....
LoadSubNodes tvw, Nd1, objDepts(i).ID
Next i
End Sub
'将人员加入到树型图，树型图中已有部门节点 Private Sub EmployeeToTreeview(ByRef tvw As TreeView)
On Error Resume Next '该代码为了防止错误而加入，实际编程中需要做判断，本处为了说明问题。
Dim objEmps As New cEmps
objEmps.Find '找到所有的人员
Dim i As Long
For i = 1 To objEmps.Count
AddEmpToTvw objEmps(i), tvw
Next i
End Sub
'本来EmployeeToTreeview一个函数就可以完成“加入人员到树型图”，但 '考虑到在单独新增人员时需用到下面的函数，因此将下面的代码单独提取 '出来，做了一个单独的函数。（详见后面的代码） '将一个人员加入到树型图中，显示到相应的部门下面 Private Sub AddEmpToTvw(ByVal objEmp As cEmp, ByRef tvw As TreeView)
On Error Resume Next
tvw.Nodes.Add "A" & objEmp.DeptID, tvwChild, "B" & objEmp.ID, objEmp.EmpName, "E"
End Sub
'将一个部门加入到树型图中 Private Sub AddDeptToTvw(ByVal objDept As cDept, ByRef tvw As TreeView)
On Error Resume Next
If objDept.SuperID = 0 Then
'“O0”中，第一个为字母O，第二个为数字0
tvw.Nodes.Add "O0", tvwChild, "A" & objDept.ID, objDept.DeptName, "D"
Else
tvw.Nodes.Add "A" & objDept.SuperID, tvwChild, "A" & objDept.ID, objDept.DeptName, "D"
End If
End Sub 在Form_Load事件中加入如下代码： Private Sub Form_Load()
DepartmentToTreeview tvwShow '将部门显示到树型图中
EmployeeToTreeview tvwShow '将人员也加入到相同的树型图中
End Sub 此时，你可以手工在数据库中加入一些记录，然后运行程序。你会发现这些代码已实现了部门与人员的显示。 在上面的代码中，你仍然未看出任何数据库编程的特征。 2.4.2.2.
人员显示到列表框以下代码实现了将人员显示到列表框的功能，参看代码中备注。 '按照“人员”类的结构，设置ListView的显示样式 Public Sub InitEmployeeListview(ByRef lvw As ListView)
With lvw
.View = lvwReport
.LabelEdit = lvwManual
.GridLines = True
.ColumnHeaders.Clear
'加入四个列首
.ColumnHeaders.Add , , "姓名", 1000
.ColumnHeaders.Add , , "所属部门", 2000
.ColumnHeaders.Add , , "年龄", 800
.ColumnHeaders.Add , , "性别", 700
End With
End Sub
'将人员集合显示到ListView中 Public Sub EmployeesToListview(ByVal objEmps As cEmps, ByRef lvw As ListView)
'传入参数为人员的集合类与列表框
Dim i As Long
'如果列表还未初始化，则初始化之(你可以采用其它方法判断是否初始化，这里是个笨办法)
If lvw.ColumnHeaders.Count = 0 Then InitEmployeeListview lvw
lvw.ListItems.Clear '清除当前的列表内容
For i = 1 To objEmps.Count
'将每个“人员”都加入到该列表中，调用了单独的函数，没有全部做到这
'个函数中，为什么呢？参看AddEmpToLvw函数
AddEmpToLvw objEmps.Item(i), lvw, False
Next i
End Sub
'将单个人员加入列表，或在列表中更新 '特意将该函数单独做出来，而没有将本函数中的代码完全在EmployeesToListview函数中实现 'Why? '因为在设计该功能时，你还应考虑到在以后的编程过程中，很可能要用到 '将某个单独的“人员”对象加入列表框（比如新增加了一个人员）。 Public Sub AddEmpToLvw(ByVal objEmp As cEmp, ByRef lvw As ListView, ByVal IsOverWrite As Boolean)
'第三个参数如果是TRUE，则说明是更新当前已存在的某个列表项，否则是新加一个列表项
Dim Itm As ListItem
If IsOverWrite Then
Set Itm = lvw.SelectedItem
If Itm Is Nothing Then Exit Sub
Else
Set Itm = lvw.ListItems.Add(, "A" & objEmp.ID)
End If
With objEmp
Itm.Text = .EmpName
Itm.SubItems(1) = .DeptName
Itm.SubItems(2) = .EmpAge
Itm.SubItems(3) = IIf(.EmpGender = Female, "女", "男")
End With
Set Itm = Nothing
End Sub 在Form_Load中加入以下代码行（使之成为第一行代码）： InitEmployeeListview lvwEmp '初始化列表 到此为止，我们已完成了基本的显示操作，下来一个问题是：当你选中了一个树型图节点后（比如一个部门节点），如何才能实例化这个对象，即从界面中取得对象？请继续看。 2.4.2.3.
从控件中取回对象在上面的代码中，我们看到，将对象加入控件时，如果控件是树型图，我们将节点的Key值设为字母“A+对象的ID”（对于根节点是字母O+数字0，对于部门节点是字母A，人员节点是字母B，这样做是为了防止Key重复），如果控件是列表框，将列表项的Key值也设为相同的值。 这样，可以通过Key属性取回其ID值。因此再加入以下一个函数，取回ID值。 '得到某个节点或列表项所表示的对象的实际ID，如“A1”，则得到1，“B2”，则得到2 Private Function GetID(strKey As String) As Long GetID = Val(Right(strKey, Len(strKey) - 1)) End Function 再加入以下几个函数，函数功能与原理参看代码注释（别担心，很简单的）。 '从列表或树型图中中得到一个人员对象 Public Function GetEmpFromControl(ByVal ctl As Object, ByRef objEmp As cEmp) As Boolean
'如果列表中没有被选择的项，则直接退出
If ctl.SelectedItem Is Nothing Then
GetEmpFromControl = False
Exit Function
End If
Dim objEmps As New cEmps
Dim ID As Long
'去除控件中节点或列表项的KEY属性前的字母“A”，即为该人员的ID值
ID = GetID(ctl.SelectedItem.Key)
On Error Resume Next '为了防止未查找到，因此加入了错误判断语句
Set objEmp = objEmps.Find(ID).Item(1)
GetEmpFromControl = (Err.Number = 0)
End Function
'从树型图中得到部门对象 Public Function GetDeptFromTreeview(ByVal tvw As TreeView, ByRef objDept As cDept) As Boolean
If tvw.SelectedItem Is Nothing Then Exit Function
Dim objDepts As New cDepts
'按选择的节点的KEY查找对象
If objDepts.Find(GetID(tvw.SelectedItem.Key)).Count = 0 Then Exit Function
On Error Resume Next '为了防止未查找到，因此加入了错误判断语句
Set objDept = objDepts.Item(1)
GetDeptFromTreeview = (Err.Number = 0)
End Function 以上函数的用法见后面的代码。 2.4.2.4.
部门的增、删、改因为部门、人员都存在于一个树型图中，因此用户点击不同的节点后应有不同的操作功能，参看以下代码。 Private Sub tvwShow_NodeClick(ByVal Node As MSComctlLib.Node)
Dim Flag As String
Flag = Left(Node.Key, 1) '得到当前选择的节点类型
'将所有按钮设为不可用
Dim ctl As Control
For Each ctl In Controls
If TypeOf ctl Is CommandButton Then ctl.Enabled = False
Next
Select Case Flag
'选择了根节点，此时加以增加部门
Case "O"
cmdAddDept.Enabled = True
Case "A"
'选择了部门节点，此时可增、删、改部门与增人员
cmdAddDept.Enabled = True
cmdEditDept.Enabled = True
cmdDeleteDept.Enabled = True
cmdAddEmp.Enabled = True
'显示该部门下的所有人员到列表框中
'此处纯粹是为了演示，实际应用情况可能会有更多要求
Dim objEmps As New cEmps
objEmps.Find , , GetID(Node.Key)
EmployeesToListview objEmps, lvwEmp
Case "B"
'选择了人员节点，此时可删除、修改人员
cmdEditEmp.Enabled = True
cmdDeleteEmp.Enabled = True
End Select
End Sub 下面演示如何实现部门的增加、修改与删除功能。注意，因为部门只有一个“部门名称”属性，因此我们可以用输入框进行部门的编辑。 Private Sub cmdAddDept_Click()
''增加部门
Dim strName As String
strName = Trim(InputBox("请输入部门名称:"))
If strName = "" Then Exit Sub
Dim objDept As New cDept
Dim Result As gxcAddNew
Result = objDept.AddNew(strName, GetID(tvwShow.SelectedItem.Key))
If Result = AddNewOK Then
'将部门加入树型图
AddDeptToTvw objDept, tvwShow
ElseIf Result = DuplicateName_AddNew Then
MsgBox "有重名的部门存在，重新命名！"
Else
MsgBox "失败！"
End If
End Sub
Private Sub cmdDeleteDept_Click()
'删除部门
If MsgBox("真的要删除？", vbQuestion + vbYesNo + vbDefaultButton2) = vbNo Then Exit Sub
Dim objDept As cDept
If GetDeptFromTreeview(tvwShow, objDept) = False Then Exit Sub
Dim Result As gxcDelete
Result = objDept.Delete
If Result = DeleteEmpExists Then
MsgBox "存在人员，不能删除"
ElseIf Result = DeleteSubExists Then
MsgBox "存在子部门，不能删除"
ElseIf Result = DeleteFail Then
MsgBox "删除失败！"
Else
'来到这，说明删除成功，从树型图中删除节点
tvwShow.Nodes.Remove tvwShow.SelectedItem.Index
RefreshButton
End If
End Sub
Private Sub cmdEditDept_Click()
'编辑部门
Dim objDept As cDept
If GetDeptFromTreeview(tvwShow, objDept) = False Then Exit Sub
Dim strName As String
'缺省显示原部门的部门名称
strName = Trim(InputBox("请输入新的部门名称:", , objDept.DeptName))
If strName = "" Then Exit Sub
Dim Result As gxcUpdate
objDept.DeptName = strName
Result = objDept.Update
If Result = UpdateOK Then
'将部门加入树型图
tvwShow.SelectedItem.Text = objDept.DeptName
ElseIf Result = DuplicateName_Update Then
MsgBox "有重名的部门存在，重新命名！"
Else
MsgBox "失败！"
End If
End Sub 再加入下面的一个函数。 Private Sub RefreshButton()
'刷新界面上的六个按钮。
'为什么要这样做呢？比如：
'你现在选择了一个“人员”节点，此时你可以点击“修改人员”按钮。
'但如果你将这个人员删除，此时树型图中已没有这个人员节点，而被
'选择的可能是一个部门节点，此时你的“修改人员”按钮应变为不可用
'状态。因此每当删除人员或部门后，都应调用这个函数
If tvwShow.SelectedItem Is Nothing Then Exit Sub
tvwShow_NodeClick tvwShow.SelectedItem
End Sub 试试吧，你可以进行部门的增加、删除、修改了！ 2.4.2.5.
人员的增加、删除、修改为什么将人员与部门分开介绍？我们可以通过一个输入框进行部门的新增与修改工作，但由于人员有许多属性，因此可能需要通过一个单独的窗口实现，例如该窗口中可能有一些文本框，下拉列表框，两个按钮分别用于确认与取消。 面向对象编程的一个特点是整个程序代码中充满了“对象”的概念。比如你需要增加或编辑一个“人员”，而且决定弹出一个单独的窗口进行编辑与显示（如一个模态窗口，名称为fEmp），则该窗口与主窗口间必然要进行数据通讯。 你可能想到编写以下的代码。
Private Sub AddNewEmployeeDemo()
'在这个函数中进行“修改一个人员”的操作
'假设在这里已经实例化了一个objEmp对象
With fEmp’fEmp为编辑人员的模态窗口
.Show '显示编辑窗口
'以下从编辑窗口中取得值
objEmp.EmpName = .txtName.Text
objEmp.EmpAge = Val(.txtAge.Text)
If .cboGender.ListIndex = 0 Then
objEmp.EmpGender = Female
Else
objEmp.EmpGender = Male
End If
'在下面可能还要判断合法性，比如年龄不能输入字母等等
''''If 输入不合法 Then
End With
'通过以上代码，我们从“增加/修改人员”的窗口中取得了
'部分数据，从而构造了了一个“人员”对象，即可用于下面的
'增加或删除或修改操作，如：
If objEmp.Update = True Then
'.....
Else
'.....
End If
End Sub 上面的代码当然可以正确运行，但如果在fEmp窗口中多做一些工作，则会使得代码更好看，以下为fEmp窗口的代码： Option Explicit
Private OK As Boolean '确定用户按了OK还是CANCEL按钮 Private objEmp As cEmp Private isAddNew As Boolean '这个参数表示该窗口打开是用于新增还是修改 Private DepartmentID As Long '所在部门的ID，如果是修改，则这个变量没用
Private Sub cmdOK_Click()
'检验是否输入了名字，或是否正确输入了年龄
If Trim(txtName) = "" Or Not IsNumeric(txtAge) Then
MsgBox "请输入合法的姓名与年龄"
Exit Sub
End If
OK = True
'如果是新增状态，则新建立一个“人员”对象
If isAddNew Then Set objEmp = New cEmp
'给“人员”对象赋值
objEmp.EmpAge = Val(txtAge)
objEmp.EmpName = Trim(txtName)
objEmp.EmpGender = cboGender.ListIndex
'如果是新增状态，则设置人员的部门ID
If isAddNew Then objEmp.DeptID = DepartmentID
Me.Hide
End Sub
Private Sub cmdCancel_Click()
'按了取消按钮
OK = False
Me.Hide
End Sub
Private Sub SetStatus()
'根据是“新增”还是修改，确定显示内容
If isAddNew Then
txtName.Text = ""
txtAge.Text = "20"
cboGender.ListIndex = 0
Else
txtName.Text = objEmp.EmpName
txtAge.Text = objEmp.EmpAge
cboGender.ListIndex = objEmp.EmpGender
End If
End Sub
Public Function RetrieveEmp(ByRef oEmp As cEmp, Optional DeptID As Long = -1) As Boolean
Set objEmp = oEmp
'得到所属部门的ID，如果是编辑状态，则此ID没用
DepartmentID = DeptID
isAddNew = (DeptID <> -1) '根据是否传入了“部门ID”来确定是新增还是编辑状态
SetStatus '根据新增或编辑状态设置显示内容
Me.Show vbModal
If OK = False Then Exit Function
Set oEmp = objEmp
RetriveEmp = True
Unload Me
End Function 上面即为fEmp窗口的所有代码，该窗口有两个文本框，分别用于姓名与年龄的输入，一个下拉列表框用于性别输入（列表索引刚好与类中定义的枚举一一对应），两个按钮（OK与Cancel）。 可以看出，该窗口提供了一个唯一入口函数RetrieveEmp，该函数有两个参数，第一个参数为一对象变量，第二个参数是可选参数，表示人员所属的部门ID。 这样，我们可以通过下面代码实现修改人员的信息：
'假设在这里已经实例化了一个objEmp对象
If fEmp.RetriveEmp(objEmp) = False Then Exit Sub
If objEmp.Update = True Then
Else
End If
我们可以看到，只通过一个函数，即可以完成从“修改”窗口中获取人员信息。不同的是，我们在fEmp窗口中写了大量代码。这就是封装的概念，即我们将fEmp窗口封装成了一个类，用于新增/修改人员信息。该类只有一个入口即RetrieveEmp。如果你还需要在程序的其它地方新增或修改人员信息，只需简单地调用这个函数就行了，而不需要重复编写代码。 甚至，你可以单独做一个函数，如下： Public Function GetMyEmp(Byref objEmp As cEmp) As Boolean
'这里只是为了举例子，在程序代码中未这样做
GetMyEmp = fEmp.RetriveEmp(objEmp)
End Sub 下面继续介绍。 在frmMain中加入以下代码用于人员的增、删、改： Private Sub cmdAddEmp_Click()
'新增人员
Dim objEmp As cEmp
If fEmp.RetriveEmp(objEmp, GetID(tvwShow.SelectedItem.Key)) = False Then Exit Sub
If objEmp.AddNew = True Then
AddEmpToTvw objEmp, tvwShow
Else
MsgBox "错误"
End If
End Sub
Private Sub cmdDeleteEmp_Click()
'删除人员
If MsgBox("要删除人员？", vbInformation + vbYesNo + vbDefaultButton2) = vbNo Then Exit Sub
Dim objEmp As cEmp
If GetEmpFromControl(tvwShow, objEmp) = False Then Exit Sub
If objEmp.Delete = True Then
tvwShow.Nodes.Remove tvwShow.SelectedItem.Index
RefreshButton
Else
MsgBox "错误"
End If
End Sub
Private Sub cmdEditEmp_Click()
'编辑人员
Dim objEmp As cEmp
If GetEmpFromControl(tvwShow, objEmp) = False Then Exit Sub
If fEmp.RetriveEmp(objEmp) = False Then Exit Sub
If objEmp.Update = True Then
AddEmpToLvw objEmp, lvwEmp, True
tvwShow.SelectedItem.Text = objEmp.EmpName
Else
MsgBox "错误"
End If
End Sub OK！你可以运行整个程序了！ 2.4.3.
扩展上面的例子讲述了如何实现对象与界面的显示与获取。你可能会想到将这些方法封装在类里面，操作可能会更容易些。当然你可以这么做！ 但有时候可能没必要这么做，只需在界面端做一个独立的模块用于界面显示操作就可以了，如果中间层与用户界面不在一台机器上，这样的结果可能会加大网络传输量。况且有些客户端可能需要将内容显示到不同的控件中（如网格、下拉列表等等）。 对于VB语言，界面设计实际上可以更为灵活。但不管采用哪一种方式，始终注意一点：你所做的东西应该让你的客户用起来舒服！ 比如上面的fEmp窗口，只提供了一个函数接口，该窗口封装了大量代码（当然你还可以将该窗口做得更健壮）。记住，当你做这个窗口时，你的用户是其它程序员----其它调用该窗口的程序员，因此，多多为他们考虑一下，如何才能让他们调用起来更为方便。当你真正做到了这一点，你将是一个真正“具有团队精神”的程序员！ 记住，对于这些封装性很强的代码，尽量一次做好，全面测试通过，然后永远将其抛到脑后！ 2.5.
扩展为B/S一旦做好了“部门”与“人员”两个类，我们可以在程序的任何地方使用其接口，而不用多次编写重复的代码—这也是为何在组件中编写了大量代码的原因。 现在，如果要做一个B/S版本的程序，工作就简单多了。既然有了中间层组件，而且组件中包含了全部的业务逻辑与接口，因此在ASP代码中（假设采用ASP开发）可以直接使用组件中提供的各种对象和接口，不必为建立数据库连接、记录集的返回、合法性较验而做过多的重复工作。下图显示了这种可重用性的原理。 3.
总结通过上述例子可以看出，在中间层的开发过程中编写了大量代码，而且界面中的代码量也很吓人。实际上，在上面的例子中，采用多层体系结构的代码量和工作量大概是传统C/S工作量的2-3倍以上。 那么，为何还要采用三层体系结构呢？ 你可以认为上面的例子是一个“纯粹”的三层体系结构，它是一种最理想化的体系结构。而且为了更为详细地介绍，我写了许多注释在里面；再者，其中有些代码是完全可以通过编程技巧进行简化与优化的，之所以如此详细是介绍，纯粹是为了更好地说明问题。优化后的代码量大概可以减少一半。 当你第一次开始使用这种方法时，可能会因此而延长开发周期，而你的不懂计算机的上司（假设他真的不懂）也可能会因此而感到不解，为何采用了新技术反而会加大开发成本，延长开发周期？ 答案很简单。因为你或你的开发团队没有积累。当你采用这种方法做了两个项目的时候，你会发现许多做好的组件是完全可以重用的，也许只需经过一点很小的修改。 一点建议：为了减少代码输入量，可以采用VB自带的“类生成工具”进行类的生成。 如果仔细研究，会发现所有的实体类（即实际存在的业务对象）都与数据库中的某个实体表一一对应，且其属性也对应着数据表中的相应字段。并且都存在AddNew、Delete、Update方法。要是你的项目组经常要做类似的项目，你完全可以做一个“代码生成器”，从数据库中读取数据库结构，直接生成所有的类模块—当然你还需进行少量的修改工作。 如果你是一个优秀项目经理，你可以组织掌握不同技能的人成为一个项目组，有些成员可能擅长于界面制作，有些擅长于数据库编程，有些擅长组件设计，甚至有些人根本不会VB，他们使用Delphi或C++。一个优秀的项目经理完全可以通过合理的分工使得项目顺利进行，然而可能直至项目结束时，有些项目组员也没机会了解数据库的结构，有些程序员甚至根本不知道程序界面长什么样子，但项目的确是按时按质完成了！ 本文全部用VB完成了整个代码设计，如果你不使用VB，或不屑于使用VB，那么上面的方法依然适用，我们注重的是体系结构与整体思路。 其实，经常见到许多程序员对于编程语言级为挑剔，他们很在乎编程语言的先进性。但是，作为一个软件人员，或软件开发团队，甚至一个软件公司，什么是先进？作者认为，有效才是先进！同理，最先进的往往不一定有效。 我相信，对于任何一个程序员来说，既然从事了软件行业，那你的目标不可能永远是程序员，你可能将系统分析员、项目经理、高层开发管理逐一列为你的奋斗目标。既然这样，别再挑剔编程语言了，否则，你永远只能是一个程序员！尽管你可能会是一个很棒的程序员。 当然，三层体系结构的概念远远不至于此，优秀的分布式应用开发的过程，用到了向对象的分析/设计/编程/测试，UML建模、软件开发过程控制、并行开发、迭代增量开发等诸多先进技术与理念。 面向对象的技术，不仅可以使得软件开发过程更易于控制，软件稳定性、质量得以提高，而且对于其它领域分析问题的方法、思路都颇为有益。长期从事此道，你会发现其中的乐趣有如滔滔的江水，连绵不绝！接要 本文主要介绍了基于三层体系结构的网络数据库设计，并结合面向对象，分布式数据库开发等理论。全文围绕一个典型而简单的例子，通过VB编程语言，从分析、建模、设计、编码等各个角度对三层体系与数据库进行了全面而详细的阐述，文中提供了全部源代码。 关键词
三层体系
数据库
面向对象
分布式开发 1.
三层体系结构我们经常会看到许多应聘者在简历上写着“精通数据库编程”的字样，也经常会在招聘网站上看到软件公司的招聘要求中某一项为“精通数据库编程”。于是这些应聘者去这些软件公司面试，于是我们看到了许多“精通”者落选的现象。 一些程序员在设计数据库应用时，通常会采用数据控件绑定的方法实现。用鼠标拉几个控件，再用鼠标设置几个属性，连键盘都不用动，就完成了一个数据库应用的开发！当然，这的确是一种快速的数据库应用开发方式，但快速并不意味着精通。 对于大型的数据库应用系统，或是拥有众多客户端的应用系统，我们需要另外一种“精通”，这就是几乎每个程序员都听说过的“三层体系结构”。 1.1.
传统的C/S模式在传统的数据库应用体系中，客户端与数据库完全分开，在客户端上运行了大部分服务，如数据访问规则、业务规则、合法性校验等等。每一个客户端都存在数据引擎，并且每个客户端与数据库服务器建立独立的数据库连接（DB Connection）。 基于该种体系的数据库应用系统的优势：开发周期较短，能够适应大部分中小型数据库应用系统的要求（当客户端数量少于50时）。 但是，随着数据库应用的日渐发展、数据容量的不断增加、客户端数量的不断增加，该种体系结构显示出了诸多缺陷，主要体现在以下几个方面： 1、
可扩充性：对于数据库服务器端，每当建立一个数据连接，就会占用大量的系统资源，当数据连接达到一定数量（如20个）时，数据库服务器的响应速度与处理速度将大打折扣。 2、
可维护性：基于传统C/S的数据库应用系统，业务规则通常置于客户端应用程序中。如果业务规则一旦发生变化（随便举个例子，如身份证号码有可能升为19位）时，我们就必须修改客户端应用程序，并且将每个客户端进行相应的升级工作。 3、
可重用性：采用传统C/S的设计模式时，数据库访问、业务规则等都固化在客户端应用程序中。如果客户另外提出了B/S的应用需求，则需要在WEB服务器中重新进行数据库访问、业务规则、合法性校验等编码（例如将数据库访问写入ASP代码），而所做的工作与客户端应用程序中的功能完全重复，从而加大了工作量，又使得程序开发者心里感到极不舒服。 正因为以上的诸多缺陷，使得三层（多层）体系结构成为目前数据库应用开发的首选，甚至客户有时也会提出该种技术需求。 1.2.
三层体系结构所谓三层体系结构，是在客户端与数据库之间加入了一个“中间层”，也叫组件层。这里所说的三层体系，不是指物理上的三层，不是简单地放置三台机器就是三层体系结构，也不仅仅有B/S应用才是三层体系结构，三层是指逻辑上的三层，即使这三个层放置到一台机器上。 三层体系的应用程序将业务规则、数据访问、合法性校验等工作放到了中间层进行处理。通常情况下，客户端不直接与数据库进行交互，而是通过COM/DCOM通讯与中间层建立连接，再经由中间层与数据库进行交互。 这样的好处显而易见： 1、
由于数据访问是通过中间层进行的，因此客户端不再与数据库直接建立数据连接。也就是说，建立在数据库服务器上的连接数量将大大减少。例如一个500个客户端的应用系统，500个客户端分别与中间层服务器建立DCOM连接，而DCOM通讯所占用的系统资源极为有限，并且是动态建立与释放连接，因此客户端数量将不再受到限制。同时，中间层与数据库服务器之间的数据连接通过“连接池”进行连接数量的控制，动态分配与释放数据连接，因此数据连接的数量将远远小于客户端数量。 2、
可维护性得以提高。因为业务规则、合法性校验存在于中间层，因此当业务规则发生改变时，只需更改中间层服务器上的某个组件（如某个DLL文件），而客户端应用程序不需做任何处理，有些时候，甚至不必修改中间层组件，只需要修改数据库中的某个存储过程就可以了。 3、
良好的可重用性。同样，如果需要开发B/S应用，则不必要重新进行数据访问、业务规则等的开发，可以直接在WEB服务器端调用现有的中间层（如可以采用基于IIS的WebClass开发，或直接编写ASP代码）。 4、
事务处理更加灵活，可以在数据库端、组件层、MTS（或COM+）管理器中进行事务处理。 如果现在你仍然感到不理解，没关系，请看下面的例子。 2.
简单的人事管理系统下面以一个极为简单的人事管理系统为例详细讲述如何实现三层体系结构。编程语言为Visual Basic 6.0。 为了全面介绍程序设计方法，VB代码中采用了不同的方法实现相同的功能，如数据库访问中，同时采用了存储过程与ADO连接。读者可自行选择最适合的方法。 由于在代码中加入了大量注释，因此不再过多地说明函数功能与原理。 在团队开发中，代码中注释部分应占整个代码的1/3左右，而且应在代码编写前就写好注释。如果另一个程序员认为你的代码中注释全部是废话，那么这些注释肯定是在写完代码之后才加上去的！ 2.1.
需求简单的部门/人员管理系统，要求： 1、
部门的属性有部门名称，人员的属性有姓名、年龄、性别； 2、
部门存在上下级关系； 3、
人员必须属于一个部门； 4、
人员、部门需要实现增加、删除、修改功能 5、
可以按人员的名称、年龄查询人员 6、
如果一个部门存在人员，或存在下级部门，则该部门不可删除 以上即为系统的简单需求。 2.2.
数据库数据库采用SQL Server 7设计，数据库名称为“TEST”，存在两个数据表（此处假设读者已掌握数据库设计，因为这个数据库实在太简单了）。 表tDept tEmployee
其中，tDept中nID与SuperID为表内关联。 2.3.
中间层打开VB6，选择“新建ActiveX DLL”，并引用ADO 2.5。 新添加一个模块，命名为mdlPublic，新填加5个类，分别命名为cDept、cEmp、cDepts、cEmps、cPublic。其中，cEmps与cDepts分别为cEmp与cDept的集合类，cPublic为定义枚举的类，无实际意义。将工程的启动模块设为“Sub Main”（重要！）。 在SQL Server的TEST库中，添加一个存储过程AddDept。 全部代码如下： 2.3.1.
mdlPublic.basOption Explicit
Public g_Cn As Connection '用于全局的数据连接
'ActiveX DLL的启动程序，为DLL初始化时执行 Public Sub Main()
If ConnectToDatabase = False Then
Err.Raise vbObjectError + 1, , "连接数据库出错！"
End If
End Sub
'连接到数据库 Public Function ConnectToDatabase() As Boolean
On Error GoTo ERR_CONN
Set g_Cn = New Connection
'设置服务器名称，数据库名称，登录名（此时假设密码为空）
Dim ServerName As String, DBName As String, UserName As String
ServerName = "gxc-notepad"
DBName = "TEST"
UserName = "sa"
'连接到数据库
With g_Cn
.CursorLocation = adUseClient
.CommandTimeout = 10
.ConnectionString = "undefinedrovider=SQLOLEDB.1undefinedersist Security Info=True;User ID=" & UserName & ";Initial Catalog=" & DBName & ";Data Source=" & ServerName
.Open
End With
ConnectToDatabase = True
Exit Function
ERR_CONN:
ConnectToDatabase = False
End Function
'去掉字符串中的单引号 Public Function RealString(strOrigional) As String
RealString = Replace(strOrigional, "'", "")
End Function
'得到某个数据表中主键的下一个值，即当前主键值加1 Public Function NextID(ByVal strTable As String, ByVal strID As String) As Long
'两个参数分别是表的名称与主键的名称
Dim rs As Recordset
Set rs = g_Cn.Execute("SELECT MAX(" & strID & ") FROM " & strTable)
If IsNull(rs(0)) Then
'如果值为NULL，则说明无任何数据记录，此时ID应为1
NextID = 1
Else
'使新ID为最大ID值+1
NextID = rs(0).Value + 1
End If
End Function
'查看某个数据表中，是否存在某个字段等于某个值的记录（整型） Public Function ExistByID(ByVal strTable As String, ByVal strID As String, ByVal lngID As Long) As Boolean
'第一个参数为表名，第二个为字段名，第三个为具体的字段值
Dim rs As Recordset
Set rs = g_Cn.Execute("Select Count(*) from " & strTable & " where " & strID & "=" & lngID)
ExistByID = (rs(0).Value = 1)
End Function
'查看某个数据表中，是否存在某个字段等于某个值的记录（字符型） Public Function ExistByName(ByVal strTable As String, ByVal strFieldName As String, ByVal strName As String, ByVal ThisID As Long) As Boolean
'第一个参数为表名，第二个为字段名，第三个为具体的字段值
Dim rs As Recordset
Set rs = g_Cn.Execute("Select Count(*) from " & strTable & " where " & strFieldName & "='" & strName & "' and nID<>" & ThisID)
ExistByName = (rs(0).Value = 1)
End Function '以上两个函数实际上可以合并，本程序中为了说明问题，故而分开 2.3.2.
cPublic.clsOption Explicit '该类无实际意义，只为保存一些自定义枚举
'自定义枚举，用于表示性别 Public Enum gxcGender
Male = 1
Female = 0
End Enum
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' '以下枚举用于“部门”对象的操作
'用于表示部门删除结果的枚举 Public Enum gxcDelete
DeleteOK = 0
DeleteFail = 1 '未知原因导致不能删除
DeleteSubExists = 2 '由于存在子部，因此不能删除
DeleteEmpExists = 3 '该部门存在人员，不能删除
End Enum
'用于表示部门更新结果的枚举 Public Enum gxcUpdate
UpdateOK = 0
UpdateFail = 1
DuplicateName_Update = 2 '名字不可重复
RecordNotExist = 3 '当前更新的记录已被其它客户端删除
End Enum
'用于表示部门新增结果的枚举 Public Enum gxcAddNew
AddNewOK = 0
AddNewFail = 1
DuplicateName_AddNew = 2 '名字不可重复
SuperNotExist = 3 '指定的上级部门的ID不存在
End Enum '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' 2.3.3.
cDept.clsOption Explicit
Private mvarDeptName As String Private mvarID As Long Private mvarSuperID As Long
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' '以下为部门的属性
'上级部门ID Public Property Let SuperID(ByVal vData As Long)
mvarSuperID = vData
End Property Public Property Get SuperID() As Long
SuperID = mvarSuperID
End Property
'本部门的ID Public Property Let ID(ByVal vData As Long)
mvarID = vData
End Property Public Property Get ID() As Long
ID = mvarID
End Property
'本部门的名称 Public Property Let DeptName(ByVal vData As String)
vData = Trim(vData) '去除两边的空格
'控制名称的长度不可大于50
If Len(vData) > 50 Then vData = Left(vData, 50)
mvarDeptName = vData
End Property Public Property Get DeptName() As String
DeptName = mvarDeptName
End Property '属性结束 ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
''''''''''''''''''''''''''''''''''''''''''''''''''''''' '以下为方法
'新增一个部门，并返回操作的结果 Public Function AddNew(Optional strName As String = "", _
Optional lngSuperID As Long = -1) As gxcAddNew
'根据传入的参数更新属性值
On Error GoTo ERR_ADDNEW
'如果参数被传入，则以传入的参数更新属性
If strName <> "" Then Me.DeptName = strName
If lngSuperID <> -1 Then Me.SuperID = lngSuperID '上级部门的ID
'通过Command对象调用存储过程，由存储过程
'进行添加部门的操作，并由存储过程返回操作结果
Dim cmd As ADODB.Command
Set cmd = New ADODB.Command
With cmd
Set .ActiveConnection = g_Cn
.CommandType = adCmdStoredProc '设置Command类型为“存储过程”
.CommandText = "AddDept" '存储过程的名称
'传入两个参数，分别为部门的名称与上级部门的ID
.Parameters.Append .CreateParameter("@Name", adChar, adParamInput, 50, Me.DeptName)
.Parameters.Append .CreateParameter("@SuperID", adInteger, adParamInput, , Me.SuperID)
'传入两个返回型的参数，分别返回新记录的ID与操作结果
.Parameters.Append .CreateParameter("@ID", adInteger, adParamOutput)
.Parameters.Append .CreateParameter("@Return", adInteger, adParamOutput)
.Execute
End With
Dim RTN As gxcAddNew
RTN = cmd.Parameters("@Return").Value '得到操作结果
'如果操作成功，则给对象赋以ID值
If RTN = AddNewOK Then Me.ID = cmd.Parameters("@ID").Value
AddNew = RTN '返回操作结果
Set cmd = Nothing
Exit Function
ERR_ADDNEW:
'来到这里，则说明出错了
If Not cmd Is Nothing Then Set cmd = Nothing
AddNew = AddNewFail
End Function
'修改部门信息，返回操作结果 Public Function Update() As gxcUpdate
'通过ID判断是否存在该记录，即该记录是否被其它客户端删除
'如果不存在该记录，则返回相应的操作结果给调用者
If Not ExistByID("tDept", "nID", Me.ID) Then
Update = RecordNotExist
Exit Function
End If
'通过名称判断是否存在相同名称的记录，如果存在相同的名称，
'则返回调用者“存在相同名称”的信息
If ExistByName("tDept", "DeptName", Me.DeptName, Me.ID) Then
Update = DuplicateName_Update
Exit Function
End If
On Error Resume Next
Dim strSQL As String
'构造SQL语句，注意需调用RealString函数去除字符串中的单引号
strSQL = "Update tDept Set DeptName='" & RealString(Me.DeptName) & "',"
strSQL = strSQL & "SuperID=" & IIf(Me.SuperID = 0, "null", Me.SuperID)
strSQL = strSQL & " where nID=" & Me.ID
g_Cn.Execute strSQL '执行SQL语句
'根据是否出错，返回给调用者相应的信息
If Err.Number = 0 Then
Update = UpdateOK
Else
Update = UpdateFail
End If
End Function
'删除一个部门 Public Function Delete(Optional ByVal lngID As Long = 0) As gxcDelete
'如果调用该函数时传入了ID，则更新该对象的ID
If lngID <> 0 Then Me.ID = lngID
'如果该部门下面有人员，则也不能删除
If ExistByID("tEmployee", "DeptID", Me.ID) Then
Delete = DeleteEmpExists
Exit Function
End If
'如果该部门下有子部门，则不能删除
If ExistByID("tDept", "SuperID", Me.ID) Then
Delete = DeleteSubExists
Exit Function
End If
On Error Resume Next
'执行删除操作并返回操作结果
g_Cn.Execute "Delete from tDept where nID=" & Me.ID
Delete = IIf(Err.Number = 0, DeleteOK, DeleteFail)
End Function
'得到本部门的所有员工 Public Function Employees() As cEmps
Dim objEmps As New cEmps
'调用cEmps类的Find方法，只传第三个参数，即“部门ID”
Set Employees = objEmps.Find(, , Me.ID)
End Function
'得到本部门的所有子部门 Public Function SubDepartments() As cDepts
Dim objDepts As New cDepts
'调用cDepts的Find方法，通过上级部门的ID查找
Set SubDepartments = objDepts.Find(, Me.ID)
End Function
'得到本部门的上级部门，以对象返回 Public Function SuperDepartment() As cDept
Dim objDepts As New cDepts
'调用cDepts的Find方法，将该类的“SuperID”作为查找条件
'从而查找出其上级部门
objDepts.Find Me.SuperID
If objDepts.Count > 0 Then Set SuperDepartment = objDepts.Item(1)
End Function '方法结束 ''''''''''''''''''''''''''''''''''''''''''''''''''''''' 2.3.4.
cDepts.clsOption Explicit
Private mCol As Collection
'往集合中加入一个“部门”对象 Public Sub Add(objDept As cDept)
mCol.Add objDept, "A" & objDept.ID
'在加入对象是，最好同时加入其“KEY”属性
'“KEY”属性不可以是数字型，因此在前面随便加
'一个字母，此处加了一个“A”
End Sub
Public Property Get Item(vntIndexKey As Variant) As cDept
Set Item = mCol(vntIndexKey)
End Property
Public Property Get Count() As Long
Count = mCol.Count
End Property
Public Sub Remove(vntIndexKey As Variant)
mCol.Remove vntIndexKey
End Sub
Public Property Get NewEnum() As IUnknown
'本属性允许用 For...Each 语法枚举该集合。
Set NewEnum = mCol.[_NewEnum]
End Property
'清除集合中的全部元素 Public Sub Clear()
'注意！在清除时必须倒序清除，否则要出错！
Dim i As Long
For i = mCol.Count To 1 Step -1
mCol.Remove i
Next i
End Sub
Private Sub Class_Initialize()
Set mCol = New Collection
End Sub
Private Sub Class_Terminate()
Set mCol = Nothing
End Sub
'按条件查找部门，以集合类的方式返回 Public Function Find(Optional lngID As Long = 0, Optional lngSuperID As Long = -1) As cDepts
'按输入的参数查询，并返回一个集合类
Dim strSQL As String
'构造SQL语句
strSQL = "Select * from tDept where "
If lngID <> 0 Then strSQL = strSQL & "nID=" & lngID & " and "
If lngSuperID <> -1 Then
If lngSuperID = 0 Then '如果传入0，则表示没有上级部门
strSQL = strSQL & "SuperID is null and "
Else
strSQL = strSQL & "SuperID=" & lngSuperID & " and "
End If
End If
strSQL = strSQL & "nID>0"
'清空当前集合
Me.Clear
Dim rs As Recordset
Set rs = g_Cn.Execute(strSQL)
'往集合中添加查询结果
Dim i As Long
Dim objDept As cDept
For i = 1 To rs.RecordCount
Set objDept = New cDept
With objDept
.ID = rs("nID").Value
.DeptName = Trim(rs("DeptName").Value)
.SuperID = IIf(IsNull(rs("SuperID").Value), 0, rs("SuperID").Value)
End With
Me.Add objDept
Set objDept = Nothing
rs.MoveNext
Next i
Set rs = Nothing
Set Find = Me
End Function 2.3.5.
cEmp.clsOption Explicit
Private mvarID As Long Private mvarEmpName As String Private mvarEmpAge As Integer Private mvarEmpGender As gxcGender Private mvarDeptID As Long Private mvarDeptName As String
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' '以下为类的属性
'部门名称 Public Property Let DeptName(ByVal vData As String)
mvarDeptName = vData
End Property Public Property Get DeptName() As String
DeptName = mvarDeptName
End Property
'部门ID Public Property Let DeptID(ByVal vData As Long)
mvarDeptID = vData
End Property Public Property Get DeptID() As Long
DeptID = mvarDeptID
End Property
'性别 Public Property Let EmpGender(ByVal vData As gxcGender)
mvarEmpGender = vData
End Property Public Property Get EmpGender() As gxcGender
EmpGender = mvarEmpGender
End Property
'年龄 Public Property Let EmpAge(ByVal vData As Integer)
If vData < 0 Then vData = 1 '年龄不可小于0
mvarEmpAge = vData
End Property Public Property Get EmpAge() As Integer
EmpAge = mvarEmpAge
End Property
'姓名 Public Property Let EmpName(ByVal vData As String)
vData = Trim(vData) '去除两边的空格
'控制名称的长度不可大于10
If Len(vData) > 10 Then vData = Left(vData, 10)
mvarEmpName = vData
End Property Public Property Get EmpName() As String
EmpName = mvarEmpName
End Property
'ID Public Property Let ID(ByVal vData As Long)
mvarID = vData
End Property Public Property Get ID() As Long
ID = mvarID
End Property '属性结束 '''''''''''''''''''''''''''''''''''''''''''''''''''''''
''''''''''''''''''''''''''''''''''''''''''''''''''''''' '以下为方法
'添加一个人员 Public Function AddNew(Optional ByVal strName As String = "", _
Optional ByVal intAge As Integer = 0, _
Optional varGender As gxcGender = -1, _
Optional lngDeptID As Long = 0) As Boolean
On Error Resume Next
'如果参数为缺省值，即未传入，则直接调和类中的参数，否则调用传入的参数
If strName <> "" Then Me.EmpName = strName
If intAge <> 0 Then Me.EmpAge = intAge
If varGender <> -1 Then Me.EmpGender = varGender
If lngDeptID <> 0 Then Me.DeptID = lngDeptID
Dim strSQL As String
g_Cn.BeginTrans
'开始一个事务，以免费得到的ID值已被其它客户端所使用
'此处调用NextID方法，得到该类对应的数据表的下一个ID，即最大ID+1
Me.ID = NextID("tEmployee", "nID")
'构造SQL语句，注意需调用RealString去除字符串中的单引号
strSQL = "Insert into tEmployee (nID,DeptID,EmpName,EmpAge,EmpGender) values ("
strSQL = strSQL & Me.ID & "," & Me.DeptID & ","
strSQL = strSQL & "'" & RealString(Me.EmpName) & "',"
strSQL = strSQL & Me.EmpAge & "," & Me.EmpGender & ")"
'执行SQL语句，并提交事务
g_Cn.Execute strSQL
g_Cn.CommitTrans
'如果发生错误，则返回FALSE，表示未成功添加
AddNew = (Err.Number = 0)
End Function
'修改人员信息 Public Function Update() As Boolean
On Error Resume Next
Dim strSQL As String
'构造SQL语句
strSQL = "Update tEmployee set DeptID=" & Me.DeptID & ","
strSQL = strSQL & "EmpName='" & RealString(Me.EmpName) & "',"
strSQL = strSQL & "EmpAge=" & Me.EmpAge & ","
strSQL = strSQL & "EmpGender=" & Me.EmpGender & " "
strSQL = strSQL & "Where nID=" & Me.ID
g_Cn.Execute strSQL
'如果发生错误，则返回FALSE，表示未成功更新
Update = (Err.Number = 0)
End Function
'删除人员资料 Public Function Delete(Optional ByVal lngID As Long = 0) As Boolean
Dim strSQL As String
On Error Resume Next
'如果已传入了要删除的ID，则按此ID删除
If lngID <> 0 Then Me.ID = lngID
strSQL = "DELETE FROM tEmployee WHERE nID=" & Me.ID
g_Cn.Execute strSQL
'如果发生错误，则返回FALSE，表示未删除成功
Delete = (Err.Number = 0)
End Function '方法结束 '''''''''''''''''''''''''''''''''''''''''''''''''''''''
'将某个人员移到指定的部门 Public Function AssignToDepartment(ByVal DeptID As Long) As Boolean
'实现很简单，将部门ID变一下，然后调用Update方法就行了
Me.DeptID = DeptID
AssignToDepartment = Me.Update
End Function
'得到该人员所在部门，以对象返回 Public Function Department() As cDept
Dim objDepts As New cDepts
'调用cDepts的Find方法，得到部门
objDepts.Find Me.DeptID
If objDepts.Count > 0 Then Set Department = objDepts.Item(1)
End Function 2.3.6.
cEmps.clsOption Explicit
Private mCol As Collection '局部变量，保存集合
'将一个“人员”对象加入集合 Public Sub Add(objEmp As cEmp)
mCol.Add objEmp, "A" & objEmp.ID
'在加入对象时，最好同时加入其“KEY”属性
'“KEY”属性不可以是数字型，因此在前面随便加
'一个字母，此处加了一个“A”
End Sub
Public Property Get Item(vntIndexKey As Variant) As cEmp
Set Item = mCol(vntIndexKey)
End Property
Public Property Get Count() As Long
Count = mCol.Count
End Property
Public Sub Remove(vntIndexKey As Variant)
mCol.Remove vntIndexKey
End Sub
Public Property Get NewEnum() As IUnknown
'本属性允许用 For...Each 语法枚举该集合。
Set NewEnum = mCol.[_NewEnum]
End Property
'清除集合中的全部元素 Public Sub Clear()
'清除时应倒序清除！
Dim i As Long
For i = mCol.Count To 1 Step -1
mCol.Remove i
Next i
End Sub
Private Sub Class_Initialize()
Set mCol = New Collection
End Sub
Private Sub Class_Terminate()
Set mCol = Nothing
End Sub
'按条件查找人员，以集合类的方式返回 Public Function Find(Optional ByVal lngID As Long = 0, _
Optional ByVal strName As String = "", _
Optional ByVal lngDeptID As Long = 0) As cEmps
'构造查询SQL
Dim strSQL As String
strSQL = "Select tEmployee.*,tDept.DeptName from tEmployee left outer join tDept "
strSQL = strSQL & " ON tDept.nID=tEmployee.DeptID Where "
If lngID <> 0 Then strSQL = strSQL & "tEmployee.nID=" & lngID & " and "
'如果是按名称查询，则采用“包含”的查询方法
If strName <> "" Then strSQL = strSQL & "tEmployee.EmpName like'%" & RealString(strName) & "'% and "
If lngDeptID <> 0 Then strSQL = strSQL & "tEmployee.DeptID=" & lngDeptID & " and "
strSQL = strSQL & "tEmployee.nID>0"
'将查询结果加入集合类
Dim rs As Recordset
Set rs = g_Cn.Execute(strSQL)
Dim i As Long
Dim objEmp As cEmp
For i = 1 To rs.RecordCount
Set objEmp = New cEmp
With objEmp
.ID = rs("nID").Value
.EmpName = Trim(rs("EmpName").Value)
.EmpAge = rs("EmpAge").Value
.EmpGender = Abs(rs("EmpGender").Value)
.DeptID = rs("DeptID").Value
.DeptName = Trim(rs("DeptName").Value)
End With
Me.Add objEmp
Set objEmp = Nothing
rs.MoveNext
Next i
Set rs = Nothing
Set Find = Me
End Function 2.3.7.
AddDept存储过程CREATE PROCEDURE AddDept
@Name char(50),
@SuperID int,
@ID int output,
@Return int output
AS
begin transaction
--如果上级部门ID为0，则在些将其设为NULL，表示无上级部门
if @SuperID=0 Select @SuperID=Null
--当前的ID为最大ID值+1
Select @ID=(Select Max(nID) from tDept)+1
--如果ID值为空，则表示尚无记录，人为地赋值为1
if @ID is null select @ID=1
--如果存在相同的部门名称，则返回VB代码中定义的枚举类型
if Exists(Select * from tDept where DeptName=@Name) begin
select @Return=2
rollback transaction
return
end
--如果不存在指定的上级部门ID，则返回VB中指定的枚举类型
if not Exists(Select * from tDept where nID=@SuperID) and not(@SuperID is null) begin
select @Return=3
rollback transaction
return
end
insert into tDept (nID,SuperID,DeptName) values (@ID,@SuperID,@Name)
if @@error=0 begin
select @Return=0
commit transaction
end else begin
Select @Return=1
rollback transaction
end
2.3.8.
组件设计注意事项至此，你可以仔细研究一下上面的代码，主要是两个基本类（人员对象与部门对象），两个集合类（人员集合与部门集合）。在这里，你可以将集合理解为“对象的数组”。 然后，仔细分析一下这四个类的结构、接口、相互关系，然后将它们画出来（请一定这样做一下，它会有助于你更好地理解面向对象）。你是不是发现，还可以再加入新的接口函数？当然是的！因为本文中的代码仅仅是个示例，它们有待于你的继续完善，比如你可以将“发工资”封装到“人员”类中。 将上述代码保存为myCom.vbp并编译，生成myCom.dll文件。该DLL文件即是一个中间层组件。 在此组件中，我们加入了大量的业务规则，如“年龄不可小于0”、不能删除有子部门或上级部门、部门内有人员时不可删除、部门名称不可大于50个字符等等。 在进行任何程序设计时，都必须考虑到用户使用的方便性。比如设计应用程序时，我们总是在考虑如何让直接用户更为方便地操作，如果使得操作逻辑更为用户所接受。 同样地，COM组件的设计也应为用户做相同考虑，如何让用户更加方便地使用。COM组件的用户不是最终用户，而是程序员！ 是制作交互界面的程序员！因此在设计COM接口与结构时，应充分考虑到界面程序员的思维方式与使用方便性，例如函数应以表义性较强的字母组合命名等等。 最完美的状态是这样：使用你的COM组件的程序员心里想着：应该有这样的一个函数吧，并且名字应该是GetCustomerName，于是他真的在你的组件中发现了这个函数，而且函数名称，甚至输入参数都与他想象的完全一样，那么，你真的成功了！ 在COM组件编写完成后，应经过大量测试，测试到每一个函数与属性。可以编写简单的测试程序进行测试（有时为了节省时间，可以直接在界面中进行测试，但可能公增加程序员的沟通时间，有时反而会得不偿失）。 2.4.
客户端既然COM组件（或中间层）已编写完成并通过测试，下面就可以进行界面的编写了。 很有趣的是，采用基于三层体系结构的设计模式，界面程序员可以完全不懂数据库编程！他完全不必知道数据库的格式，甚至不必了解是何种类型的数据库。 请看以下的例子： 首先，新建一个工程，然后引用myCom.DLL。 2.4.1.
先举几个例子2.4.1.1.
添加一个部门
Dim objDept As New cDept '定义一个部门对象
Dim Result As gxcAddNew, strResult As String
With objDept
.DeptName = "总部"
.SuperID = 0 '0表示无上级部门
Result = .AddNew '得到操作结果
If Result = AddNewFail Then
strResult = "添加失败！"
ElseIf Result = DuplicateName_AddNew Then
strResult = "存在相同名称的部门，请修改名称后重新添加！"
ElseIf Result = SuperNotExist Then
strResult = "指定的上级部门不存在或已被删除！"
Else
strResult = "添加成功！"
End If
End With
MsgBox strResult, vbInformation
通过上面的代码，已完成了“增加一个部门”的操作，并且可以清楚地知道操作的结果。而代码中没有任何地方体现出这是对数据库进行编程。 上面代码中With块中的前三行还可以用下面的一行代码替换（因为你的AddNew函数中的参数全部都是可选的）：
Result = .AddNew("总部", 0)
2.4.1.2.
删除一个部门
Dim objDept As New cDept '定义部门对象
Dim Result As gxcDelete, strResult As String
Result = objDept.Delete(1) '删除ID为1的部门
If Result = DeleteEmpExists Then
strResult = "该部门内存在人员，不能删除！"
ElseIf Result = DeleteFail Then
strResult = "删除失败！"
ElseIf Result = DeleteSubExists Then
strResult = "该部门内存在子部门，不能删除！"
Else
strResult = "成功删除"
End If
MsgBox strResult, vbInformation
2.4.1.3.
查询所有子部门与部门内人员
以下代码查找出ID为12的部门，然后得到该部门下的所有人员与所有子部门。
Dim objDepts As New cDepts, objEmps As New cEmps '定义部门集合与人员集合
If objDepts.Find(12).Count > 0 Then
Set objEmps = objDepts(1).Employees '得到了部门内所有人员
Set objDepts = objDepts(1).SubDepartments '得到了部门内的所有子部门
End If
2.4.1.4.
更为有趣的操作以下代码查找出名称中包含“张三”的第一个人员，然后找出同部门的所有同事。
Dim objEmps As New cEmps
If objEmps.Find(, "张三").Count > 0 Then
'得到了同一部门的所有人员
Set objEmps = objEmps(1).Department.Employees
End If
以下代码查看张三是否是李四的直接上司。
On Error Resume Next
Dim objEmps As New cEmps
If objEmps.Find(, "张三").Item(1).Department Is objEmps.Find(, "李四").Item(1).Department.SuperDepartment Then
MsgBox "张三是李四的顶头上司！"
End If
以上的代码在实际编程中可能很少用到，或者永远不可能用到，但这也从另一个方面反映了组件开发的灵活性。 看到这，如果你还感觉不理解的话，请随便买一本VB初级入门的书，仔细研究研究。 2.4.2.
详细的界面例子打开VB，新建一个工程。引用刚才生成的myCom.dll，加入微软通常控件（Common Control 6.0）。 添加一个窗口frmMain，加入一个Treeviw，用于显示分级显示的部门与人员，命名为tvwShow。 加入一个ListView，用于显示人员的列表，命名为lvwEmp。 加入六个按钮，分别用于部门/人员的增、改、删（为了更好地说明问题，特意加入六个按钮，在实际开发中没这么麻烦），分别命名为cmdAddDept, cmdEditDept, cmdDeleteDept, cmdAddEmp, cmdEditEmp, cmdDeleteEmp。 加入一个图像列表，加入三个具有表义性的图标，其Key属性分别为“O”，“D”，“E”，用于根节点、部门、人员的图标。并将tvwShow的图像列表设为该控件。 2.4.2.1.
显示部门、人员到树型图加入以下代码，实现部门与人员的加载。 '将所有部门加入树型图 Private Sub DepartmentToTreeview(ByRef tvw As TreeView)
Dim objDepts As New cDepts
Dim i As Long
'先加入没有上级部门的部门
objDepts.Find , 0
Dim Nd As Node
Set Nd = tvw.Nodes.Add(, , "O0", "所有部门", "O") '加入原始根节点。“O0”中，第一个为字母O，第二个为数字0
Nd.Expanded = True
For i = 1 To objDepts.Count
'加入没有上级部门的部门节点，图形列表ID为“D”
Set Nd = tvw.Nodes.Add("O0", tvwChild, "A" & objDepts(i).ID, objDepts(i).DeptName, "D")
Nd.Expanded = True
'加载其下级部门节点
LoadSubNodes tvw, Nd, objDepts(i).ID
Next i
End Sub
'调用递归，显示树型的部门结构 Private Sub LoadSubNodes(ByRef tvw As TreeView, Nd As Node, NodeID As Long)
Dim Nd1 As Node
Dim objDepts As New cDepts
Dim i As Long
objDepts.Find , NodeID '找到部门的所有子部门
For i = 1 To objDepts.Count
Set Nd1 = tvw.Nodes.Add(Nd, tvwChild, "A" & objDepts(i).ID, objDepts(i).DeptName, "D")
Nd1.Expanded = True
'递归加载下级部门.....
LoadSubNodes tvw, Nd1, objDepts(i).ID
Next i
End Sub
'将人员加入到树型图，树型图中已有部门节点 Private Sub EmployeeToTreeview(ByRef tvw As TreeView)
On Error Resume Next '该代码为了防止错误而加入，实际编程中需要做判断，本处为了说明问题。
Dim objEmps As New cEmps
objEmps.Find '找到所有的人员
Dim i As Long
For i = 1 To objEmps.Count
AddEmpToTvw objEmps(i), tvw
Next i
End Sub
'本来EmployeeToTreeview一个函数就可以完成“加入人员到树型图”，但 '考虑到在单独新增人员时需用到下面的函数，因此将下面的代码单独提取 '出来，做了一个单独的函数。（详见后面的代码） '将一个人员加入到树型图中，显示到相应的部门下面 Private Sub AddEmpToTvw(ByVal objEmp As cEmp, ByRef tvw As TreeView)
On Error Resume Next
tvw.Nodes.Add "A" & objEmp.DeptID, tvwChild, "B" & objEmp.ID, objEmp.EmpName, "E"
End Sub
'将一个部门加入到树型图中 Private Sub AddDeptToTvw(ByVal objDept As cDept, ByRef tvw As TreeView)
On Error Resume Next
If objDept.SuperID = 0 Then
'“O0”中，第一个为字母O，第二个为数字0
tvw.Nodes.Add "O0", tvwChild, "A" & objDept.ID, objDept.DeptName, "D"
Else
tvw.Nodes.Add "A" & objDept.SuperID, tvwChild, "A" & objDept.ID, objDept.DeptName, "D"
End If
End Sub 在Form_Load事件中加入如下代码： Private Sub Form_Load()
DepartmentToTreeview tvwShow '将部门显示到树型图中
EmployeeToTreeview tvwShow '将人员也加入到相同的树型图中
End Sub 此时，你可以手工在数据库中加入一些记录，然后运行程序。你会发现这些代码已实现了部门与人员的显示。 在上面的代码中，你仍然未看出任何数据库编程的特征。 2.4.2.2.
人员显示到列表框以下代码实现了将人员显示到列表框的功能，参看代码中备注。 '按照“人员”类的结构，设置ListView的显示样式 Public Sub InitEmployeeListview(ByRef lvw As ListView)
With lvw
.View = lvwReport
.LabelEdit = lvwManual
.GridLines = True
.ColumnHeaders.Clear
'加入四个列首
.ColumnHeaders.Add , , "姓名", 1000
.ColumnHeaders.Add , , "所属部门", 2000
.ColumnHeaders.Add , , "年龄", 800
.ColumnHeaders.Add , , "性别", 700
End With
End Sub
'将人员集合显示到ListView中 Public Sub EmployeesToListview(ByVal objEmps As cEmps, ByRef lvw As ListView)
'传入参数为人员的集合类与列表框
Dim i As Long
'如果列表还未初始化，则初始化之(你可以采用其它方法判断是否初始化，这里是个笨办法)
If lvw.ColumnHeaders.Count = 0 Then InitEmployeeListview lvw
lvw.ListItems.Clear '清除当前的列表内容
For i = 1 To objEmps.Count
'将每个“人员”都加入到该列表中，调用了单独的函数，没有全部做到这
'个函数中，为什么呢？参看AddEmpToLvw函数
AddEmpToLvw objEmps.Item(i), lvw, False
Next i
End Sub
'将单个人员加入列表，或在列表中更新 '特意将该函数单独做出来，而没有将本函数中的代码完全在EmployeesToListview函数中实现 'Why? '因为在设计该功能时，你还应考虑到在以后的编程过程中，很可能要用到 '将某个单独的“人员”对象加入列表框（比如新增加了一个人员）。 Public Sub AddEmpToLvw(ByVal objEmp As cEmp, ByRef lvw As ListView, ByVal IsOverWrite As Boolean)
'第三个参数如果是TRUE，则说明是更新当前已存在的某个列表项，否则是新加一个列表项
Dim Itm As ListItem
If IsOverWrite Then
Set Itm = lvw.SelectedItem
If Itm Is Nothing Then Exit Sub
Else
Set Itm = lvw.ListItems.Add(, "A" & objEmp.ID)
End If
With objEmp
Itm.Text = .EmpName
Itm.SubItems(1) = .DeptName
Itm.SubItems(2) = .EmpAge
Itm.SubItems(3) = IIf(.EmpGender = Female, "女", "男")
End With
Set Itm = Nothing
End Sub 在Form_Load中加入以下代码行（使之成为第一行代码）： InitEmployeeListview lvwEmp '初始化列表 到此为止，我们已完成了基本的显示操作，下来一个问题是：当你选中了一个树型图节点后（比如一个部门节点），如何才能实例化这个对象，即从界面中取得对象？请继续看。 2.4.2.3.
从控件中取回对象在上面的代码中，我们看到，将对象加入控件时，如果控件是树型图，我们将节点的Key值设为字母“A+对象的ID”（对于根节点是字母O+数字0，对于部门节点是字母A，人员节点是字母B，这样做是为了防止Key重复），如果控件是列表框，将列表项的Key值也设为相同的值。 这样，可以通过Key属性取回其ID值。因此再加入以下一个函数，取回ID值。 '得到某个节点或列表项所表示的对象的实际ID，如“A1”，则得到1，“B2”，则得到2 Private Function GetID(strKey As String) As Long GetID = Val(Right(strKey, Len(strKey) - 1)) End Function 再加入以下几个函数，函数功能与原理参看代码注释（别担心，很简单的）。 '从列表或树型图中中得到一个人员对象 Public Function GetEmpFromControl(ByVal ctl As Object, ByRef objEmp As cEmp) As Boolean
'如果列表中没有被选择的项，则直接退出
If ctl.SelectedItem Is Nothing Then
GetEmpFromControl = False
Exit Function
End If
Dim objEmps As New cEmps
Dim ID As Long
'去除控件中节点或列表项的KEY属性前的字母“A”，即为该人员的ID值
ID = GetID(ctl.SelectedItem.Key)
On Error Resume Next '为了防止未查找到，因此加入了错误判断语句
Set objEmp = objEmps.Find(ID).Item(1)
GetEmpFromControl = (Err.Number = 0)
End Function
'从树型图中得到部门对象 Public Function GetDeptFromTreeview(ByVal tvw As TreeView, ByRef objDept As cDept) As Boolean
If tvw.SelectedItem Is Nothing Then Exit Function
Dim objDepts As New cDepts
'按选择的节点的KEY查找对象
If objDepts.Find(GetID(tvw.SelectedItem.Key)).Count = 0 Then Exit Function
On Error Resume Next '为了防止未查找到，因此加入了错误判断语句
Set objDept = objDepts.Item(1)
GetDeptFromTreeview = (Err.Number = 0)
End Function 以上函数的用法见后面的代码。 2.4.2.4.
部门的增、删、改因为部门、人员都存在于一个树型图中，因此用户点击不同的节点后应有不同的操作功能，参看以下代码。 Private Sub tvwShow_NodeClick(ByVal Node As MSComctlLib.Node)
Dim Flag As String
Flag = Left(Node.Key, 1) '得到当前选择的节点类型
'将所有按钮设为不可用
Dim ctl As Control
For Each ctl In Controls
If TypeOf ctl Is CommandButton Then ctl.Enabled = False
Next
Select Case Flag
'选择了根节点，此时加以增加部门
Case "O"
cmdAddDept.Enabled = True
Case "A"
'选择了部门节点，此时可增、删、改部门与增人员
cmdAddDept.Enabled = True
cmdEditDept.Enabled = True
cmdDeleteDept.Enabled = True
cmdAddEmp.Enabled = True
'显示该部门下的所有人员到列表框中
'此处纯粹是为了演示，实际应用情况可能会有更多要求
Dim objEmps As New cEmps
objEmps.Find , , GetID(Node.Key)
EmployeesToListview objEmps, lvwEmp
Case "B"
'选择了人员节点，此时可删除、修改人员
cmdEditEmp.Enabled = True
cmdDeleteEmp.Enabled = True
End Select
End Sub 下面演示如何实现部门的增加、修改与删除功能。注意，因为部门只有一个“部门名称”属性，因此我们可以用输入框进行部门的编辑。 Private Sub cmdAddDept_Click()
''增加部门
Dim strName As String
strName = Trim(InputBox("请输入部门名称:"))
If strName = "" Then Exit Sub
Dim objDept As New cDept
Dim Result As gxcAddNew
Result = objDept.AddNew(strName, GetID(tvwShow.SelectedItem.Key))
If Result = AddNewOK Then
'将部门加入树型图
AddDeptToTvw objDept, tvwShow
ElseIf Result = DuplicateName_AddNew Then
MsgBox "有重名的部门存在，重新命名！"
Else
MsgBox "失败！"
End If
End Sub
Private Sub cmdDeleteDept_Click()
'删除部门
If MsgBox("真的要删除？", vbQuestion + vbYesNo + vbDefaultButton2) = vbNo Then Exit Sub
Dim objDept As cDept
If GetDeptFromTreeview(tvwShow, objDept) = False Then Exit Sub
Dim Result As gxcDelete
Result = objDept.Delete
If Result = DeleteEmpExists Then
MsgBox "存在人员，不能删除"
ElseIf Result = DeleteSubExists Then
MsgBox "存在子部门，不能删除"
ElseIf Result = DeleteFail Then
MsgBox "删除失败！"
Else
'来到这，说明删除成功，从树型图中删除节点
tvwShow.Nodes.Remove tvwShow.SelectedItem.Index
RefreshButton
End If
End Sub
Private Sub cmdEditDept_Click()
'编辑部门
Dim objDept As cDept
If GetDeptFromTreeview(tvwShow, objDept) = False Then Exit Sub
Dim strName As String
'缺省显示原部门的部门名称
strName = Trim(InputBox("请输入新的部门名称:", , objDept.DeptName))
If strName = "" Then Exit Sub
Dim Result As gxcUpdate
objDept.DeptName = strName
Result = objDept.Update
If Result = UpdateOK Then
'将部门加入树型图
tvwShow.SelectedItem.Text = objDept.DeptName
ElseIf Result = DuplicateName_Update Then
MsgBox "有重名的部门存在，重新命名！"
Else
MsgBox "失败！"
End If
End Sub 再加入下面的一个函数。 Private Sub RefreshButton()
'刷新界面上的六个按钮。
'为什么要这样做呢？比如：
'你现在选择了一个“人员”节点，此时你可以点击“修改人员”按钮。
'但如果你将这个人员删除，此时树型图中已没有这个人员节点，而被
'选择的可能是一个部门节点，此时你的“修改人员”按钮应变为不可用
'状态。因此每当删除人员或部门后，都应调用这个函数
If tvwShow.SelectedItem Is Nothing Then Exit Sub
tvwShow_NodeClick tvwShow.SelectedItem
End Sub 试试吧，你可以进行部门的增加、删除、修改了！ 2.4.2.5.
人员的增加、删除、修改为什么将人员与部门分开介绍？我们可以通过一个输入框进行部门的新增与修改工作，但由于人员有许多属性，因此可能需要通过一个单独的窗口实现，例如该窗口中可能有一些文本框，下拉列表框，两个按钮分别用于确认与取消。 面向对象编程的一个特点是整个程序代码中充满了“对象”的概念。比如你需要增加或编辑一个“人员”，而且决定弹出一个单独的窗口进行编辑与显示（如一个模态窗口，名称为fEmp），则该窗口与主窗口间必然要进行数据通讯。 你可能想到编写以下的代码。
Private Sub AddNewEmployeeDemo()
'在这个函数中进行“修改一个人员”的操作
'假设在这里已经实例化了一个objEmp对象
With fEmp’fEmp为编辑人员的模态窗口
.Show '显示编辑窗口
'以下从编辑窗口中取得值
objEmp.EmpName = .txtName.Text
objEmp.EmpAge = Val(.txtAge.Text)
If .cboGender.ListIndex = 0 Then
objEmp.EmpGender = Female
Else
objEmp.EmpGender = Male
End If
'在下面可能还要判断合法性，比如年龄不能输入字母等等
''''If 输入不合法 Then
End With
'通过以上代码，我们从“增加/修改人员”的窗口中取得了
'部分数据，从而构造了了一个“人员”对象，即可用于下面的
'增加或删除或修改操作，如：
If objEmp.Update = True Then
'.....
Else
'.....
End If
End Sub 上面的代码当然可以正确运行，但如果在fEmp窗口中多做一些工作，则会使得代码更好看，以下为fEmp窗口的代码： Option Explicit
Private OK As Boolean '确定用户按了OK还是CANCEL按钮 Private objEmp As cEmp Private isAddNew As Boolean '这个参数表示该窗口打开是用于新增还是修改 Private DepartmentID As Long '所在部门的ID，如果是修改，则这个变量没用
Private Sub cmdOK_Click()
'检验是否输入了名字，或是否正确输入了年龄
If Trim(txtName) = "" Or Not IsNumeric(txtAge) Then
MsgBox "请输入合法的姓名与年龄"
Exit Sub
End If
OK = True
'如果是新增状态，则新建立一个“人员”对象
If isAddNew Then Set objEmp = New cEmp
'给“人员”对象赋值
objEmp.EmpAge = Val(txtAge)
objEmp.EmpName = Trim(txtName)
objEmp.EmpGender = cboGender.ListIndex
'如果是新增状态，则设置人员的部门ID
If isAddNew Then objEmp.DeptID = DepartmentID
Me.Hide
End Sub
Private Sub cmdCancel_Click()
'按了取消按钮
OK = False
Me.Hide
End Sub
Private Sub SetStatus()
'根据是“新增”还是修改，确定显示内容
If isAddNew Then
txtName.Text = ""
txtAge.Text = "20"
cboGender.ListIndex = 0
Else
txtName.Text = objEmp.EmpName
txtAge.Text = objEmp.EmpAge
cboGender.ListIndex = objEmp.EmpGender
End If
End Sub
Public Function RetrieveEmp(ByRef oEmp As cEmp, Optional DeptID As Long = -1) As Boolean
Set objEmp = oEmp
'得到所属部门的ID，如果是编辑状态，则此ID没用
DepartmentID = DeptID
isAddNew = (DeptID <> -1) '根据是否传入了“部门ID”来确定是新增还是编辑状态
SetStatus '根据新增或编辑状态设置显示内容
Me.Show vbModal
If OK = False Then Exit Function
Set oEmp = objEmp
RetriveEmp = True
Unload Me
End Function 上面即为fEmp窗口的所有代码，该窗口有两个文本框，分别用于姓名与年龄的输入，一个下拉列表框用于性别输入（列表索引刚好与类中定义的枚举一一对应），两个按钮（OK与Cancel）。 可以看出，该窗口提供了一个唯一入口函数RetrieveEmp，该函数有两个参数，第一个参数为一对象变量，第二个参数是可选参数，表示人员所属的部门ID。 这样，我们可以通过下面代码实现修改人员的信息：
'假设在这里已经实例化了一个objEmp对象
If fEmp.RetriveEmp(objEmp) = False Then Exit Sub
If objEmp.Update = True Then
Else
End If
我们可以看到，只通过一个函数，即可以完成从“修改”窗口中获取人员信息。不同的是，我们在fEmp窗口中写了大量代码。这就是封装的概念，即我们将fEmp窗口封装成了一个类，用于新增/修改人员信息。该类只有一个入口即RetrieveEmp。如果你还需要在程序的其它地方新增或修改人员信息，只需简单地调用这个函数就行了，而不需要重复编写代码。 甚至，你可以单独做一个函数，如下： Public Function GetMyEmp(Byref objEmp As cEmp) As Boolean
'这里只是为了举例子，在程序代码中未这样做
GetMyEmp = fEmp.RetriveEmp(objEmp)
End Sub 下面继续介绍。 在frmMain中加入以下代码用于人员的增、删、改： Private Sub cmdAddEmp_Click()
'新增人员
Dim objEmp As cEmp
If fEmp.RetriveEmp(objEmp, GetID(tvwShow.SelectedItem.Key)) = False Then Exit Sub
If objEmp.AddNew = True Then
AddEmpToTvw objEmp, tvwShow
Else
MsgBox "错误"
End If
End Sub
Private Sub cmdDeleteEmp_Click()
'删除人员
If MsgBox("要删除人员？", vbInformation + vbYesNo + vbDefaultButton2) = vbNo Then Exit Sub
Dim objEmp As cEmp
If GetEmpFromControl(tvwShow, objEmp) = False Then Exit Sub
If objEmp.Delete = True Then
tvwShow.Nodes.Remove tvwShow.SelectedItem.Index
RefreshButton
Else
MsgBox "错误"
End If
End Sub
Private Sub cmdEditEmp_Click()
'编辑人员
Dim objEmp As cEmp
If GetEmpFromControl(tvwShow, objEmp) = False Then Exit Sub
If fEmp.RetriveEmp(objEmp) = False Then Exit Sub
If objEmp.Update = True Then
AddEmpToLvw objEmp, lvwEmp, True
tvwShow.SelectedItem.Text = objEmp.EmpName
Else
MsgBox "错误"
End If
End Sub OK！你可以运行整个程序了！ 2.4.3.
扩展上面的例子讲述了如何实现对象与界面的显示与获取。你可能会想到将这些方法封装在类里面，操作可能会更容易些。当然你可以这么做！ 但有时候可能没必要这么做，只需在界面端做一个独立的模块用于界面显示操作就可以了，如果中间层与用户界面不在一台机器上，这样的结果可能会加大网络传输量。况且有些客户端可能需要将内容显示到不同的控件中（如网格、下拉列表等等）。 对于VB语言，界面设计实际上可以更为灵活。但不管采用哪一种方式，始终注意一点：你所做的东西应该让你的客户用起来舒服！ 比如上面的fEmp窗口，只提供了一个函数接口，该窗口封装了大量代码（当然你还可以将该窗口做得更健壮）。记住，当你做这个窗口时，你的用户是其它程序员----其它调用该窗口的程序员，因此，多多为他们考虑一下，如何才能让他们调用起来更为方便。当你真正做到了这一点，你将是一个真正“具有团队精神”的程序员！ 记住，对于这些封装性很强的代码，尽量一次做好，全面测试通过，然后永远将其抛到脑后！ 2.5.
扩展为B/S一旦做好了“部门”与“人员”两个类，我们可以在程序的任何地方使用其接口，而不用多次编写重复的代码—这也是为何在组件中编写了大量代码的原因。 现在，如果要做一个B/S版本的程序，工作就简单多了。既然有了中间层组件，而且组件中包含了全部的业务逻辑与接口，因此在ASP代码中（假设采用ASP开发）可以直接使用组件中提供的各种对象和接口，不必为建立数据库连接、记录集的返回、合法性较验而做过多的重复工作。下图显示了这种可重用性的原理。 3.
总结通过上述例子可以看出，在中间层的开发过程中编写了大量代码，而且界面中的代码量也很吓人。实际上，在上面的例子中，采用多层体系结构的代码量和工作量大概是传统C/S工作量的2-3倍以上。 那么，为何还要采用三层体系结构呢？ 你可以认为上面的例子是一个“纯粹”的三层体系结构，它是一种最理想化的体系结构。而且为了更为详细地介绍，我写了许多注释在里面；再者，其中有些代码是完全可以通过编程技巧进行简化与优化的，之所以如此详细是介绍，纯粹是为了更好地说明问题。优化后的代码量大概可以减少一半。 当你第一次开始使用这种方法时，可能会因此而延长开发周期，而你的不懂计算机的上司（假设他真的不懂）也可能会因此而感到不解，为何采用了新技术反而会加大开发成本，延长开发周期？ 答案很简单。因为你或你的开发团队没有积累。当你采用这种方法做了两个项目的时候，你会发现许多做好的组件是完全可以重用的，也许只需经过一点很小的修改。 一点建议：为了减少代码输入量，可以采用VB自带的“类生成工具”进行类的生成。 如果仔细研究，会发现所有的实体类（即实际存在的业务对象）都与数据库中的某个实体表一一对应，且其属性也对应着数据表中的相应字段。并且都存在AddNew、Delete、Update方法。要是你的项目组经常要做类似的项目，你完全可以做一个“代码生成器”，从数据库中读取数据库结构，直接生成所有的类模块—当然你还需进行少量的修改工作。 如果你是一个优秀项目经理，你可以组织掌握不同技能的人成为一个项目组，有些成员可能擅长于界面制作，有些擅长于数据库编程，有些擅长组件设计，甚至有些人根本不会VB，他们使用Delphi或C++。一个优秀的项目经理完全可以通过合理的分工使得项目顺利进行，然而可能直至项目结束时，有些项目组员也没机会了解数据库的结构，有些程序员甚至根本不知道程序界面长什么样子，但项目的确是按时按质完成了！ 本文全部用VB完成了整个代码设计，如果你不使用VB，或不屑于使用VB，那么上面的方法依然适用，我们注重的是体系结构与整体思路。 其实，经常见到许多程序员对于编程语言级为挑剔，他们很在乎编程语言的先进性。但是，作为一个软件人员，或软件开发团队，甚至一个软件公司，什么是先进？作者认为，有效才是先进！同理，最先进的往往不一定有效。 我相信，对于任何一个程序员来说，既然从事了软件行业，那你的目标不可能永远是程序员，你可能将系统分析员、项目经理、高层开发管理逐一列为你的奋斗目标。既然这样，别再挑剔编程语言了，否则，你永远只能是一个程序员！尽管你可能会是一个很棒的程序员。 当然，三层体系结构的概念远远不至于此，优秀的分布式应用开发的过程，用到了向对象的分析/设计/编程/测试，UML建模、软件开发过程控制、并行开发、迭代增量开发等诸多先进技术与理念。 面向对象的技术，不仅可以使得软件开发过程更易于控制，软件稳定性、质量得以提高，而且对于其它领域分析问题的方法、思路都颇为有益。长期从事此道，你会发现其中的乐趣有如滔滔的江水，连绵不绝！
| 
|EaBIM网
( 苏ICP备2020058923号-1 ) 
苏公网安备32011502011255号
IP卡
狗仔卡
发表于 2014-1-10 14:41:46
QQ好友和群
QQ空间
腾讯微博
腾讯朋友
微信
收藏
转播
分享
淘帖
支持
反对
提升卡
置顶卡
沉默卡
喧嚣卡
变色卡
显身卡
发表于 2014-5-19 14:40:58
