dtsource.cls

这是基于MapX4.0的房屋测绘管理信息系统

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 1  'vbDataSource
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "DtSource"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit
Private mCnnString As String
Private mFilter As String
Private mSQL As String
Private rs As ADODB.Recordset
Private cnn As ADODB.Connection
'数据库连接字符串
Public Property Let cnnString(ByVal cnnCs As String)
    mCnnString = cnnCs
End Property
'记录集字符串
Public Property Let Source(ByVal csSQL As String)
    mSQL = csSQL
End Property
Public Sub OpenDtSource()
    If mCnnString = "" And mSQL = "" Then
        Err.Raise vbObjectError + 1, , "自定义数据源没有输入连接串和查询语句！"
    Else
        Set cnn = New ADODB.Connection
        With cnn
            .ConnectionString = mCnnString
            .CursorLocation = adUseClient
            .Open
        End With
        
        Set rs = New ADODB.Recordset
        With rs
            .CursorLocation = adUseClient
            .CursorType = adOpenKeyset
            .LockType = adLockPessimistic
            .ActiveConnection = cnn
            .Open mSQL, , , , adCmdText
            .Filter = mFilter
        End With
    End If
End Sub
Private Sub Class_GetDataMember(DataMember As String, Data As Object)
    Select Case DataMember
        Case "Command1"
            Set Data = rs
        Case Else
    End Select
End Sub

Private Sub Class_Initialize()
    mCnnString = ""
    mSQL = ""
    mFilter = ""
    With DataMembers
        .Add "Command1"
    End With
End Sub

Private Sub Class_Terminate()
    If Not cnn Is Nothing Then
        If cnn.State = adStateOpen Then
            cnn.Close
        End If
        Set cnn = Nothing
    End If
    If Not rs Is Nothing Then
        If rs.State = adStateOpen Then
            rs.Close
        End If
        Set rs = Nothing
    End If
End Sub
Public Property Get Recordset() As ADODB.Recordset
    Set Recordset = rs
End Property
Public Property Let Recordset(ByVal vNewRS As ADODB.Recordset)
    If Not rs Is Nothing Then
        If rs.State = adStateOpen Then
            rs.Close
        End If
        Set rs = Nothing
    End If
    
    Set rs = vNewRS
End Property
Public Property Let DataMember(vNewValue As String)
    With DataMembers
        .Add vNewValue
    End With
End Property
Public Property Let Filter(vNewValue As String)
    mFilter = vNewValue
End Property