'########数据库访问层##########
'返回一个ADOCN连接对象
'与C#不同，这里不能关闭连接及释放内存
Public Function GetCN(sDBPath As String) As ADODB.Connection
Const sPro As String = "provider=microsoft.jet.oledb.4.0;data source="
Const sDBPWD As String = ";jet oledb:database password=QQ:48403849"
Dim sDBPath As String
Dim m_cn As ADODB.Connection
Set m_cn = New ADODB.Connection
m_cn.CursorLocation = adUseClient '客户端游标
If m_cn.State <> adStateClosed Then m_cn.Close
On Error GoTo conerr
m_cn.Open sPro & sDBPath & sDBPWD
Set GetCN = m_cn
Exit Function
conerr:
Set GetCN = Nothing
MsgBox "数据库连接错误", vbCritical
End Function
'执行一句SQL语句，正确返回 1
Public Function ExcuteSQL(sSQL As String) As Integer
Dim m_cn As New ADODB.Connection
On Error GoTo err
Set m_cn = GetCN(sG_DBPath)
m_cn.Execute sSQL
m_cn.Close
Set m_cn = Nothing
ExcuteSQL = 1
Exit Function
err:
ExcuteSQL = 0
Set m_cn = Nothing
End Function
'执行一组SQL语句，正确返回1
Public Function ExcuteSQLEX(sSQL() As String) As Integer
'调用事务处理
Dim m_cn As New ADODB.Connection, i As Integer
If UBound(sSQL) < 0 Then Exit Function
On Error GoTo err
Set m_cn = GetCN(sG_DBPath)
m_cn.BeginTrans
For i = 0 To UBound(sSQL) - 1
m_cn.Execute sSQL(i)
Next i
m_cn.CommitTrans
m_cn.Close
Set m_cn = Nothing
ExcuteSQLEX = 1
Exit Function
err:
ExcuteSQLEX = 0
m_cn.RollbackTrans
m_cn = Nothing
End Function
'未完，待补充
本文地址：http://com.8s8s.com/it/it41736.htm