我设计VB6的三存架构模式：一、DataAccess层

VB6的三层架构的相关资料在网络上只有很少的资料,流传开来的我知道的只有两种模式:

1.集合模式:该模式在广为流传,但是效率很差且并也没有DataAccess层,BusinessRule和DataAccess混在一起.

2.Type数组模式:效较较集合有所提升,但是灵活性较差,字段没有Null状态,且由于Type数组是值类型,实际调用时有可能放于栈空间,如果Type数组过大可能溢出.

经过分析.Net中的MS的例子,我考虑将.Net中的使用ADO.Net实现的三层架构拿到VB6上来运行,ADO.Net使用ADO的Recordset来代替.由于ADO.Net先天的优越性,使用RecordSet遇到了好多问题,即使到现在依然有一些问题的存在,且于由RecordSet的先天不足而使其实现的方式很别扭,但是总算是模拟了三层架构.

下面简单的给出三层架构的部分源码以供分析：

一、DataAccess层：

 mdlDAErrorConst模块：

Public Const PROBEGINNUMBER = vbObjectError + 10000
'**************************************程序编写错误****************************************
Public Const OBJECTTYPEERROR = PROBEGINNUMBER                               '对象类型错误
Public Const OBJECTTYPEERRORDESCRIPTION = "对象类型错误"

Public Const RECORDCOUNTISZERO = PROBEGINNUMBER + 1                         '记录集记录数
Public Const RECORDCOUNTISZERODESCRIPTION = "对象数集记录数为0"

Public Const PARAMETERCOUNTERROR = PROBEGINNUMBER + 2                       '参数错误
Public Const PARAMETERCOUNTERRORDESCRIPTION = "传递的参数错误"

Public Const NOKEYFIELD = PROBEGINNUMBER + 3
Public Const NOKEYFIELDDESCRIPTION = "对象没有设置关键字段列表"

Public Const KEYFIELDNOVALUE = PROBEGINNUMBER + 4
Public Const KEYFIELDNOVALUEDESCRIPTION = "对关键字段没有设定值"

mdlGlobal模块：

Option Explicit

'***********************************************全局变量***************************************
'全局的数据库连接
Public objDatabase As clsDatabase

'***********************************************全局常量***************************************
Public Const DATAERROR = "数据库操作发生错误:"
'********************************************行状态枚举*********************************
Public Enum DataRowState
    Added = 1
    Deleted = 2
    Modified = 3
    Unchanged = 4
End Enum
'***********************************************全局函数***************************************
'判断是否为空值或未设过值
Public Function CheckIsNull(vValue As Variant) As Boolean
    If IsNull(vValue) Or IsEmpty(vValue) Then
        CheckIsNull = True
    Else
        CheckIsNull = False
    End If
End Function

'返回指定的ICommon接口的所有可用的数据库字段,用逗号分隔
Public Function GetFieldNames(objCommon As prjCommon.ICommon) As String
    Dim vData As Variant
    Dim str As String
    Dim i As Integer
    vData = objCommon.GetFieldNames
    For i = LBound(vData) To UBound(vData)
        If str = "" Then
            str = CStr(vData(i))
        Else
            str = str & "," & CStr(vData(i))
        End If
    Next
    GetFieldNames = str
End Function

'返回指定的ICommonDesc接口的所有可用的数据库字段,用逗号分隔
Public Function GetFieldNamesForDesc(objCommon As prjCommon.ICommonDesc) As String
    Dim vData As Variant
    Dim str As String
    Dim i As Integer
    vData = objCommon.GetFieldNames
    For i = LBound(vData) To UBound(vData)
        If str = "" Then
            str = CStr(vData(i))
        Else
            str = str & "," & CStr(vData(i))
        End If
    Next
    GetFieldNamesForDesc = str
End Function
'得到字段的真实值,如果未赋值返回为"NULL"
'得到字段的值
Public Function GetFieldValue(objField As ADODB.Field) As String
    With objField
        If .Type = adBigInt _
                Or .Type = adBoolean _
                Or .Type = adCurrency _
                Or .Type = adDecimal _
                Or .Type = adDouble _
                Or .Type = adInteger _
                Or .Type = adNumeric _
                Or .Type = adSingle _
                Or .Type = adSmallInt _
                Or .Type = adTinyInt Then
            If CheckIsNull(objField.Value) = False Then
                GetFieldValue = CStr(CDbl(objField.Value))
            Else
                GetFieldValue = "NULL"
            End If
        Else
            If CheckIsNull(objField.Value) = False Then
                GetFieldValue = "'" & CStr(objField.Value) & "'"
            Else
                GetFieldValue = "NULL"
            End If
        End If
    End With
End Function
'得到关于Desc内部的Rst使用的字段名
'str处理方式:(1)有" AS "的取后面的为字段名
'           (2)有小数量的,则取小数点后
Public Function GetInsideFieldName(str As Variant) As String
    Dim i As Integer, stmp As String, b() As String
    str = CStr(str)
    i = InStr(1, LCase(str), LCase(" AS "), vbTextCompare)
    If i <> 0 Then
        stmp = Right(str, Len(str) - i - Len(" AS ") + 1)
    Else
        b = Split(str, ".")
        If UBound(b) = 1 Then
            stmp = b(1)
        Else
            stmp = vbNullString
        End If
    End If
    GetInsideFieldName = stmp
End Funct