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