我设计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 Function


clsDAOperator类，实现增、删、改功能：


Option Explicit
Private mRst As ADODB.Recordset
Private strSQL As String
Private objMakeSQL As clsSQLMaker

'初始化
Private Sub Class_Initialize()
    Set objMakeSQL = New clsSQLMaker
End Sub
'删除A
Public Function DeleteByCommon(objCommon As prjCommon.ICommon) As Integer
    On Error GoTo errHandle:
    strSQL = objMakeSQL.GetDeleteSqlByCommon(objCommon)
    DeleteByCommon = objDatabase.ExecuteNonRst(strSQL)
    Exit Function
errHandle:
    Err.Raise Err.Number, Err.Source, DATAERROR & Err.Description
End Function
'删除B
Public Function DeleteByCondition(objCommon As prjCommon.ICommon, _
                                            cstrWhere As String) As Integer
    On Error GoTo errHandle:
    strSQL = objMakeSQL.GetDeleteSqlByCommon(objCommon)
    If CStr(cstrWhere) <> "" Then
        strSQL = strSQL & " WHERE " & cstrWhere
    End If
    DeleteByCondition = objDatabase.ExecuteNonRst(strSQL)
    Exit Function
errHandle:
    Err.Raise Err.Number, Err.Source, DATAERROR & Err.Description
End Function
'查找A
Public Function FindByCommon(retCommon As prjCommon.ICommon, ConditionCommon As prjCommon.ICommon) As Boolean
    Dim vFields As Variant, i As Integer
    On Error GoTo errHandle:
    If TypeName(retCommon) <> TypeName(ConditionCommon) Then
        Err.Raise OBJECTTYPEERROR, TypeName(Me), OBJECTTYPEERRORDESCRIPTION
    End If
    strSQL = objMakeSQL.GetSelectSqlWithWhere(ConditionCommon)
    Set retCommon.Data = objDatabase.ExecuteRst(strSQL)
    FindByCommon = True
    Exit Function
errHandle:
    Err.Raise Err.Number, Err.Source, Err.Description
End Function
'查找B
Public Function FindByCondition(retCommon As prjCommon.ICommon, cstrWhere As String) As Boolean
    Dim vFields As Variant, i As Integer
    On Error GoTo errHandle:
    strSQL = objMakeSQL.GetSelectSQL(retCommon)
    If Trim(cstrWhere) <> "" Then
        strSQL = strSQL & " WHERE " & cstrWhere
    End If
    Set retCommon.Data = objDatabase.ExecuteRst(strSQL)
    FindByCondition = True
    Exit Function
errHandle:
    Err.Raise Err.Number, Err.Source, Err.Description
End Function

'插入
Public Function Insert(objCommon As prjCommon.ICommon) As Boolean
    On Error GoTo errHandle:
    Dim vFields As Variant, i As Integer, vKeyFields As Variant
    '取得字段列表
    vFields = objCommon.GetFieldNames
    vKeyFields = objCommon.GetKeyFields
    strSQL = objMakeSQL.GetSelectTop1SQL(objCommon)
    Set mRst = objDatabase.ExecuteRst(strSQL)
    mRst.AddNew
    For i = LBound(vFields) To UBound(vFields)
        '如果非空的话才赋值,否则会出错
        If CheckIsNull(objCommon.Data.Fields(vFields(i))) = False Then
            mRst.Fields(vFields(i)).Value = objCommon.Data.Fields(vFields(i)).Value
        Else
            Debug.Print vFields(i)
        End If
    Next
    mRst.Update
    '更新主关键字
    For i = LBound(vKeyFields) To UBound(vKeyFields)
        objCommon.Data.Fields(vKeyFields(i)).Value = mRst.Fields(vKeyFields(i)).Value
    Next
    Insert = True
    Exit Function
errHandle:
    Err.Raise Err.Number, TypeName(Me), DATAERROR & Err.Description
End Function
'更新A
Public Function UpdateByCondition(objCommon As prjCommon.ICommon, cstrWhere As String) As Integer
    On Error GoTo errHandle:
    strSQL = objMakeSQL.GetUpdateSqlByStrWhere(objCommon, cstrWhere)
    UpdateByCondition = objDatabase.ExecuteNonRst(strSQL)
    Exit Function
errHandle:
    Err.Raise Err.Number, Err.Source, Err.Description
End Function
'更新B
Public Function UpdateByConditionCommon(objCommon As prjCommon.ICommon, ConditionCommon As prjCommon.ICommon) As Integer
    On Error GoTo errHandle:
    If ConditionCommon.Data.RecordCount < 1 Then
        Err.Raise RECORDCOUNTISZERO, TypeName(Me), RECORDCOUNTISZERODESCRIPTION
    End If
    strSQL = objMakeSQL.GetUpdateSqlByCommon(objCommon, ConditionCommon)
    UpdateByConditionCommon = objDatabase.ExecuteNonRst(strSQL)
    Exit Function
errHandle:
    Err.Raise Err.Number, Err.Source, Err.Description
End Function
'更新C-查找objCommon的关键字段,然后更新
Public Function UpdateBySingleCommon(objCommon As prjCommon.ICommon) As Integer
    On Error GoTo errHandle:
    strSQL = objMakeSQL.GetUpdateSqlBySingleCommon(objCommon)
    UpdateBySingleCommon = objDatabase.ExecuteNonRst(strSQL)
    Exit Function
errHandle:
    Err.Raise Err.Number, Err.Source, Err.Description
End Function

Private Sub Class_Terminate()
    Set mRst = Nothing
    Set objMakeSQL = Nothing
End Sub

clsDataAccess类，对ADO的包装，实现对数据的实际操作调用：

'*************************************************************************
'**模 块 名：clsDatabase
'**说    明： 版权所有2005 - 2006(C)
'**创 建 人：吴东雷
'**日    期：2005-10-27
'**修 改 人：
'**日    期：
'**描    述：数据库组件
'**版    本：V1.0.0
'*************************************************************************
Option Explicit

Private cstrSql As String
Private cRst As ADODB.Recordset
Public Conn As ADODB.Connection
Public cCmd As ADODB.Command
Private cPara As ADODB.Parameter
Private boolTrans As Integer            '记录当前对象是否已经开始了事务
Private cConnectionString As String

Public Property Get ConnectionString() As String
    ConnectionString = Conn.ConnectionString
End Property
Public Property Let ConnectionString(vData As String)
    On Error GoTo errHandle:
    Call cSwitchCnn(Conn, False)
    Conn.ConnectionString = vData
    Call cSwitchCnn(Conn, True)
    Exit Property
errHandle:
    Err.Raise Err.Number, Err.Source, Err.Description
End Property

Private Sub Class_Initialize()
    Set cRst = New ADODB.Recordset
    Set Conn = New ADODB.Connection
    Set cCmd = New ADODB.Command
    Conn.CursorLocation = adUseClient
    'cCmd.ActiveConnection = Conn
    boolTrans = False
End Sub
Private Sub Class_Terminate()
    Set cRst = Nothing
    If Conn.State = adStateOpen Then
        Me.RollBackTransaction
        Conn.Close
    End If
    Set cCmd = Nothing
    Set Conn = Nothing
End Sub
'打开/关闭连接
Private Sub cSwitchCnn(Cnn As ADODB.Connection, _
                        OnOff As Boolean)
    On Error GoTo errHandle:
    If OnOff = True Then
        If Cnn.State <> adStateOpen Then
            Call Cnn.Open
        End If
    Else
        If Cnn.State <> adStateClosed Then
            Call Cnn.Close
        End If
    End If
    Exit Sub
errHandle:
    Err.Raise Err.Number, Err.Source, Err.Description
End Sub
''-------------------------用于主从表的事务处理--------------------
Public Sub BeginTransaction()
    If boolTrans < 0 Then boolTrans = 0
    If boolTrans = 0 Then
        Conn.BeginTrans
    End If
    boolTrans = boolTrans + 1
End Sub
Public Sub CommitTransaction()
    boolTrans = boolTrans - 1
    If boolTrans < 0 Then boolTrans = 0
    If boolTrans = 0 Then
        Conn.CommitTrans
    End If
End Sub
Public Sub RollBackTransaction()
    If boolTrans > 0 Then
        Conn.RollbackTrans
        boolTrans = 0
    End If
End Sub
'返回记录集
'参数:SQL语句
'返回结果:记录集
Public Function ExecuteRst(strSQL As String) As ADODB.Recordset
    On Error GoTo errHandle:
    Dim Msgstring As String
    Set cRst = New ADODB.Recordset
    '服务器游标将影响绑定
'    cRst.CursorLocation = adUseServer
    cRst.Open Trim$(strSQL), Conn, adOpenKeyset, adLockOptimistic
    Msgstring = "查询到" & cRst.RecordCount & _
                " 条记录 "
    Set ExecuteRst = cRst
    Exit Function
errHandle:
    Err.Raise Err.Number, Err.Source, Err.Description
End Function
'不返回记录集
'参数:SQL语句
Public Function ExecuteNonRst(strSQL As String) As Integer
    Dim AffNum As Long
    On Error GoTo errHandle:
    ExecuteNonRst = False
    Conn.Execute strSQL, AffNum
    ExecuteNonRst = AffNum
    Exit Function
errHandle:
    Err.Raise Err.Number, Err.Source, Err.Description
End Function
'追加一个参数
Public Sub AppendParameter(para As ADODB.Parameter)
    cCmd.Parameters.Append para
End Sub
'追加参数数组
Public Sub AppendParameters(para() As ADODB.Parameter)
    Dim i As Integer
    For i = LBound(para) To UBound(para)
        cCmd.Parameters.Append para(i)
    Next
End Sub
'执行存储过程,返回记录集
'参数:procName,存储过程名
'返回值:记录集
Public Function ExecuteProcRst(ProcName As String) As Recordset
    On Error GoTo errHandle:
    Set cCmd = New ADODB.Command
    cCmd.ActiveConnection = Conn
    cCmd.CommandType = adCmdStoredProc
    cCmd.CommandText = ProcName
    Set cRst = cCmd.Execute
    Set cCmd = Nothing
    Set ExecuteProcRst = cRst
    Exit Function
errHandle:
    Err.Raise Err.Number, Err.Source, Err.Source
End Function
'执行存储过程
'参数:procName,存储过程名
'返回值:记录集
Public Function ExecuteProcNonRst(ProcName As String) As Boolean
    On Error GoTo errHandle:
    ExecuteProcNonRst = False
    Set cCmd = New ADODB.Command
    cCmd.ActiveConnection = Conn
    cCmd.CommandType = adCmdStoredProc
    cCmd.CommandText = ProcName
    cCmd.Execute
    Set cCmd = Nothing
    ExecuteProcNonRst = False
    Exit Function
errHandle:
    Err.Raise Err.Number, Err.Source, Err.Source
End Function

clsInterface类：

'*************************************************************************
'**模 块 名：clsInterface
'**说    明： 版权所有2005 - 2006(C)
'**创 建 人：吴东雷
'**日    期：2005-10-22
'**修 改 人：
'**日    期：
'**描    述：用于接收外部的数据库连接对象,由外部连接来控制数据库的连接,比如事务的控制
'            类的Instancing为GlobalMultiUse,即不需要实例化,在调用这个组件时应该首先设定
'            连接,否则组件的其它部分可能会出错
'**版    本：V1.0.0
'*************************************************************************
Option Explicit
'设定连接字符串
Public Property Let ConnectString(strConn As String)
    On Error GoTo errHandle:
    If objDatabase.Conn.State <> adStateClosed Then
        objDatabase.Conn.Close
    End If
    DB.ConnectionString = strConn
    Exit Property
errHandle:
    Err.Raise Err.Number, Err.Source, Err.Description
End Property
Public Property Get ConnectString() As String
    ConnectString = DB.ConnectionString
End Property
'取得数据库连接对象
Public Property Get DB() As clsDatabase
    Set DB = objDatabase
End Property
Public Property Set DB(mdb As clsDatabase)
    Set objDatabase = mdb
End Property

'初始化时候创建一个全局的连接
Private Sub Class_Initialize()
    Set objDatabase = New clsDatabase
End Sub

Private Sub Class_Terminate()
    Set objDatabase = Nothing
End Sub

clsSQLMaker类：

'*************************************************************************
'**模 块 名：clsSQLMaker
'**说    明： 版权所有2005 - 2006(C)
'**创 建 人：吴东雷
'**日    期：2005-10-27
'**修 改 人：
'**日    期：
'**描    述：生成所需的SQL语句
'**版    本：V1.0.0
'*************************************************************************
Option Explicit

Dim strSQL As String

'获取查询语句
Public Function GetSelectSQL(objCommon As prjCommon.ICommon) As String
    Dim strSQL As String
    strSQL = GetFieldNames(objCommon)
    If objCommon.HaveDataRowState = True Then
        If strSQL = "" Then
            strSQL = "DataRowState"
        Else
            strSQL = strSQL & "," & DataRowState.Unchanged & " AS DataRowState"
        End If
    End If
    strSQL = "SELECT " & strSQL & " FROM " & objCommon.TableName
    GetSelectSQL = strSQL
End Function

'获取增加一条的查询语句
Public Function GetSelectTop1SQL(objCommon As prjCommon.ICommon) As String
    strSQL = GetFieldNames(objCommon)
    strSQL = "SELECT TOP 1 " & strSQL & " FROM " & objCommon.TableName
    GetSelectTop1SQL = strSQL
End Function

'获取指定条件的查询语句
Public Function GetSelectSqlWithWhere(objCommon As prjCommon.ICommon) As String
    Dim strWhere As String, vFields As Variant, i As Integer, tValue As String
    If objCommon.Data.RecordCount > 0 Then
        If objCommon.Data.RecordCount < 1 Then
            Err.Raise RECORDCOUNTISZERO, TypeName(Me), RECORDCOUNTISZERODESCRIPTION
            Exit Function
        End If
        vFields = objCommon.GetFieldNames
        For i = LBound(vFields) To UBound(vFields)
            '判断不为空,则认为是条件
            If CheckIsNull(objCommon.Data.Fields(vFields(i))) = False Then
                tValue = GetFieldValue(objCommon.Data.Fields(vFields(i)))
                If strWhere = "" Then
                    strWhere = vFields(i) & "=" & tValue
                Else
                    strWhere = strWhere & " AND " & vFields(i) & "=" & tValue
                End If
            End If
        Next
    End If
    strSQL = GetSelectSQL(objCommon)
    If strWhere <> "" Then
        strSQL = strSQL & " WHERE " & strWhere
    End If
    GetSelectSqlWithWhere = strSQL
End Function

'获取修改记录的查询语句---通过查滤条件
Public Function GetUpdateSqlByCommon(objCommon As ICommon, ConditionCommon As ICommon) As String
    Dim strWhere As String, vFields As Variant, i As Integer, tValue As String
    On Error GoTo errHandle:
    If ConditionCommon.Data.RecordCount < 1 Then
        Err.Raise RECORDCOUNTISZERO, TypeName(Me), RECORDCOUNTISZERODESCRIPTION
        Exit Function
    End If
    vFields = ConditionCommon.GetFieldNames
    For i = LBound(vFields) To UBound(vFields)
        '判断不为空,则认为是条件
        If CheckIsNull(ConditionCommon.Data.Fields(vFields(i))) = False Then
            tValue = GetFieldValue(ConditionCommon.Data.Fields(vFields(i)))
            If strWhere = "" Then
                strWhere = vFields(i) & "=" & tValue
            Else
                strWhere = strWhere & " AND " & vFields(i) & "=" & tValue
            End If
        End If
    Next
    strSQL = GetUpdateSqlByStrWhere(objCommon, strWhere)
    GetUpdateSqlByCommon = strSQL
    Exit Function
errHandle:
    Err.Raise Err.Number, Err.Source, Err.Description
End Function

'获取修改记录的查询语句---通过查滤条件
Public Function GetUpdateSqlByStrWhere(objCommon As ICommon, _
                                cstrWhere As String) As String
    On Error GoTo errHandle:
    Dim strWhere As String
    Dim vFields As Variant, i As Integer, tValue As String
    Dim strSet As String
    If objCommon.Data.RecordCount <= 0 Then
        Err.Raise RECORDCOUNTISZERO, TypeName(Me), RECORDCOUNTISZERODESCRIPTION
        Exit Function
    Else
        objCommon.Data.MoveFirst
    End If
    vFields = objCommon.GetFieldNames
    For i = LBound(vFields) To UBound(vFields)
        tValue = GetFieldValue(objCommon.Data.Fields(vFields(i)))
        If strSet = "" Then
            strSet = " " & vFields(i) & "=" & tValue
        Else
            strSet = strSet & "," & vFields(i) & "=" & tValue
        End If
    Next
    If Trim(strSet) = "" Then
        Err.Raise PARAMETERCOUNTERROR, TypeName(Me), PARAMETERCOUNTERRORDESCRIPTION
        Exit Function
    End If
    strSQL = "UPDATE " & objCommon.TableName & " SET " & strSet
    If cstrWhere <> "" Then
        strSQL = strSQL & " WHERE " & cstrWhere
    End If
    GetUpdateSqlByStrWhere = strSQL
    Exit Function
errHandle:
    Err.Raise Err.Number, Err.Source, Err.Description
End Function

'获取修改记录的查询语句--通过单一的ICommon对象,得到其Keys字段列表来处理
Public Function GetUpdateSqlBySingleCommon(objCommon As ICommon) As String
    Dim vFields As Variant, vKeyFields As Variant
    Dim i As Integer, j As Integer
    Dim strSet As String, strWhere As String, strSQL As String
    Dim tValue As String, Cl As Boolean
   
    vFields = objCommon.GetFieldNames
    vKeyFields = objCommon.GetKeyFields
    If objCommon.Data.RecordCount <= 0 Then
        Err.Raise RECORDCOUNTISZERO, TypeName(Me), RECORDCOUNTISZERODESCRIPTION
        Exit Function
    Else
        objCommon.Data.MoveFirst
    End If
   
    If IsArray(vKeyFields) = False Then
        Err.Raise NOKEYFIELD, TypeName(Me), NOKEYFIELDDESCRIPTION
        Exit Function
    End If
    '得到Set的字符串
    For i = LBound(vFields) To UBound(vFields)
        Cl = True
        '不处理Key字段
        For j = LBound(vKeyFields) To UBound(vKeyFields)
            If vKeyFields(j) = vFields(i) Then
                Cl = False
                Exit For
            End If
        Next
        If Cl = True Then
            tValue = GetFieldValue(objCommon.Data.Fields(vFields(i)))
            If tValue <> "NULL" Then
                If strSet = "" Then
                    strSet = " " & "[" & vFields(i) & "]" & "=" & tValue
                Else
                    strSet = strSet & "," & "[" & vFields(i) & "]" & "=" & tValue
                End If
            End If
        End If
    Next
    '得到Where字符串
    For i = LBound(vKeyFields) To UBound(vKeyFields)
        If CheckIsNull(objCommon.Data.Fields(vKeyFields(i))) = True Then
            Err.Raise KEYFIELDNOVALUE, TypeName(Me), objCommon.TableName & objCommon.Data.Fields(vKeyFields(i)).Name & _
                    KEYFIELDNOVALUEDESCRIPTION
            Exit Function
        End If
        tValue = GetFieldValue(objCommon.Data.Fields(vKeyFields(i)))
        If strWhere = "" Then
            strWhere = " " & vKeyFields(i) & "=" & tValue
        Else
            strWhere = strWhere & " AND " & vKeyFields(i) & "=" & tValue
        End If
    Next
    If Trim(strSet) = "" Then
        Err.Raise PARAMETERCOUNTERROR, TypeName(Me), PARAMETERCOUNTERRORDESCRIPTION
        Exit Function
    End If
    strSQL = "UPDATE " & objCommon.TableName & " SET " & strSet
    If Trim(strWhere) <> "" Then
        strSQL = strSQL & " WHERE " & strWhere
    End If
    GetUpdateSqlBySingleCommon = strSQL
    Exit Function
errHandle:
    Err.Raise Err.Number, Err.Source, Err.Description
End Function

'获取删除记录的查询语句
Public Function GetDeleteSqlByCommon(objCommon As prjCommon.ICommon) As String
    Dim strWhere As String
    Dim vFields As Variant, i As Integer, tValue As String
    If objCommon.Data.RecordCount <= 0 Then
        Err.Raise RECORDCOUNTISZERO, TypeName(Me), RECORDCOUNTISZERODESCRIPTION
        Exit Function
    Else
        objCommon.Data.MoveFirst
    End If
    vFields = objCommon.GetKeyFields
    For i = LBound(vFields) To UBound(vFields)
        '不为空取值为条件
        If CheckIsNull(objCommon.Data.Fields(vFields(i))) = False Then
            tValue = GetFieldValue(objCommon.Data.Fields(vFields(i)))
            '不为空视为条件
            If tValue <> "NULL" Then
                If strWhere = "" Then
                    strWhere = vFields(i) & "=" & tValue
                Else
                    strWhere = strWhere & " AND " & vFields(i) & "=" & tValue
                End If
            End If
        End If
    Next
    '如果没有任何主键的条键则看其它的字段
    If strWhere = "" Then
        vFields = objCommon.GetFieldNames
        For i = LBound(vFields) To UBound(vFields)
            '不为空取值为条件
            If CheckIsNull(objCommon.Data.Fields(vFields(i))) = False Then
                tValue = GetFieldValue(objCommon.Data.Fields(vFields(i)))
                '不为空视为条件
                If tValue <> "NULL" Then
                    If strWhere = "" Then
                        strWhere = vFields(i) & "=" & tValue
                    Else
                        strWhere = strWhere & " AND " & vFields(i) & "=" & tValue
                    End If
                End If
            End If
        Next
    End If
    If strWhere <> "" Then
        strSQL = "DELETE FROM " & objCommon.TableName & " WHERE " & strWhere
    Else
        strSQL = "DELETE FROM " & objCommon.TableName
    End If
    GetDeleteSqlByCommon = strSQL
End Function