第14回
Connectionコントロールの実装

Option Explicit
Private DSN As String
Private rsObjR As Object
Private resultSet As String
Private Const LOCAL_HOST As String = "localhost"

Public Property Get ServerName() As String
    ServerName = wscConnect.RemoteHost
End Property

Public Property Let ServerName(ByVal New_ServerName As String)
    wscConnect.RemoteHost() = New_ServerName
    PropertyChanged "ServerName"
End Property

Public Property Get ServerPort() As Long
    ServerPort = wscConnect.RemotePort
End Property

Public Property Let ServerPort(ByVal New_ServerPort As Long)
    wscConnect.RemotePort() = New_ServerPort
    PropertyChanged "ServerPort"
End Property

Public Sub cnOpen( _
 Optional ConnectionString As String, _
 Optional UserID As String, _
 Optional Password As String, _
 Optional OpenOptions As Long)
    DSN = ConnectionString
    If wscConnect.State <> sckClosed Then wscConnect.Close
    wscConnect.Connect
End Sub

Public Sub cnClose()
    wscConnect.Close
End Sub

' 記憶領域からプロパティ値を読み込みます
Private Sub UserControl_ReadProperties(PropBag As PropertyBag)
    wscConnect.RemoteHost = PropBag.ReadProperty("ServerName", "localhost")
    wscConnect.RemotePort = PropBag.ReadProperty("ServerPort", 1010)
End Sub

Private Sub UserControl_Terminate()
    wscConnect.Close
End Sub

' 記憶領域にプロパティ値を書き込みます
Private Sub UserControl_WriteProperties(PropBag As PropertyBag)
    Call PropBag.WriteProperty("ServerName", wscConnect.RemoteHost, "localhost")
    Call PropBag.WriteProperty("ServerPort", wscConnect.RemotePort, 1010)
End Sub

Public Function Execute( _
 CommandText As String, _
 Optional RecordsAffected As Long, _
 Optional Options As Long) As ADOR.Recordset
    wscConnect.SendData CommandText
End Function

Public Sub SelectRequest(SqlStatement As Variant, RecordsetObj As Object)
    Set rsObjR = RecordsetObj
    wscConnect.SendData SqlStatement
End Sub

Private Sub wscConnect_Close()
    wscConnect.Close
End Sub

Private Sub wscConnect_Connect()
    ' ローカルホスト名とODBCデータソース名を送信
    wscConnect.SendData LOCAL_HOST & "," & DSN
End Sub

Private Sub wscConnect_DataArrival(ByVal bytesTotal As Long)
    Dim strData As String
    ' DBsvr（ActiveXexe）からデータを受け取る
    wscConnect.GetData strData, vbString

    resultSet = resultSet & strData
    If InStr(resultSet, "Result Start") > 0 And InStr(resultSet, "Result End") > 0 Then
        ' テキスト（resultSet）を元にレコードセットを作成
        rsObjR.MakeRecordset resultSet
        resultSet = ""
    End If
End Sub

Option Explicit
Dim WithEvents cn As Connection
Dim WithEvents rs As Recordset

Private Sub cmdConn_Click()
    Set cn = Controls.Add("DBCliLib.Connection", "control1")
    cmdConn.Enabled = False
    cmdSend.Enabled = True

    cn.ServerName = "localhost"
    cn.ServerPort = 1010
    cn.cnOpen "BIBLIO"
End Sub

Private Sub cmdSend_Click()
    Set rs = Controls.Add("DBCliLib.Recordset", "control2")
    rs.rsOpen "SELECT * FROM Authors WHERE Author like 'a%'", cn
End Sub

Private Sub Form_Load()

End Sub

Private Sub rs_RecordsetComplete()
    Set DataGrid1.DataSource = rs
End Sub