Type 7 DB Serverを使ったクライアントアプリケーション

Option Explicit
Private unloadFlg As Integer
Private rsAuthor As MakeRecordsetCls
Private rsTitle As MakeRecordsetCls
Private colBind As BindingCollection
Private rsName As String
Dim resultSet As String

Private Sub getTitle()
    Dim SQLstat As String
    resultSet = ""
    SQLstat = "SELECT Title, Titles.ISBN, [Year Published], [Company Name] "
    SQLstat = SQLstat & "From Publishers "
    SQLstat = SQLstat & "Inner Join "
    SQLstat = SQLstat & "([title author] INNER JOIN Titles ON [title author］.ISBN = Titles.ISBN) "
    SQLstat = SQLstat & "ON Publishers.PubID = Titles.PubID "
    SQLstat = SQLstat & "Where Au_ID = "
    SQLstat = SQLstat & Trim(txt1.Text)
    rsName = "Title Query"
    Winsock2.SendData SQLstat
End Sub

Private Sub cmdConn_Click()
    Winsock2.Listen
    ' DBsvrRBへ接続
    ' DBsvrからの接続要求待ちにする
    cmdConn.Enabled = False
    If Winsock1.State <> sckClosed Then Winsock1.Close
    Winsock1.RemoteHost = frm_option.txt_host.Text
    Winsock1.Connect
End Sub

Private Sub cmdFirst_Click()
    rsAuthor.dsRecordset.MoveFirst
    cmdFirst.Enabled = False
    cmdBack.Enabled = False
    cmdNext.Enabled = True
    cmdLast.Enabled = True
    Call getTitle
End Sub

Private Sub cmdBack_Click()
    rsAuthor.dsRecordset.MovePrevious
    cmdNext.Enabled = True
    cmdLast.Enabled = True
    If rsAuthor.dsRecordset.BOF Then
        rsAuthor.dsRecordset.MoveNext
        cmdFirst.Enabled = False
        cmdBack.Enabled = False
    Else
        Call getTitle
    End If
End Sub

Private Sub cmdLast_Click()
    rsAuthor.dsRecordset.Movelast
    cmdFirst.Enabled = True
    cmdBack.Enabled = True
    cmdNext.Enabled = False
    cmdLast.Enabled = False
    Call getTitle
End Sub

Private Sub cmdNext_Click()
    rsAuthor.dsRecordset.MoveNext
    cmdFirst.Enabled = True
    cmdBack.Enabled = True
    If rsAuthor.dsRecordset.EOF Then
        rsAuthor.dsRecordset.MovePrevious
        cmdNext.Enabled = False
        cmdLast.Enabled = False
    Else
        Call getTitle
    End If
End Sub

Private Sub cmdSend_Click()
    ' DBsvrへSQL文を送信
    If Len(Trim(txt_param)) = 0 Then
      MsgBox "検索文字列を指定してください"
      Exit Sub
    End If
    resultSet = ""
    rsName = "Author"
    Winsock2.SendData "SELECT * FROM Authors WHERE Author like '" & Trim(txt_param.Text) & "%'"
End Sub

Private Sub Command1_Click()
    frm_option.Show
End Sub

Private Sub Form_Unload(Cancel As Integer)
    If Winsock2.State <> sckClosed Then Winsock2.Close
End Sub

Private Sub Winsock1_Connect()
    ' ローカルホスト名とODBCデータソース名をDBsvrRBへ送信
    Winsock1.SendData frm_option.txt_localHost.Text & "," & frm_option.txt_dsn.Text
End Sub

Private Sub Winsock1_SendComplete()
    ' 接続要求が終了
    Winsock1.Close
End Sub

Private Sub Winsock2_ConnectionRequest(ByVal requestID As Long)
    ' クライアントDBsvr（ActiveX EXE）からの接続要求時に発生
    ' 接続処理の完了
    If Winsock2.State <> sckClosed Then Winsock2.Close
    Winsock2.Accept requestID
    ' 検索ボタンを使用可にする
    cmdSend.Enabled = True
End Sub

Private Sub Winsock2_DataArrival(ByVal bytesTotal As Long)
    Dim strData As String
    ' クライアントDBsvr（ActiveX EXE）からデータを受け取る
    Winsock2.GetData strData, vbString
    resultSet = resultSet & strData
    '-------------------------------------
    If InStr(resultSet, "Result Start") > 0 And InStr(resultSet, "Result End") > 0 Then
        Select Case rsName ' 実行されたレコードセットによって作成するレコードセットを変更
            Case "Title Query"
                Set rsTitle = New MakeRecordsetCls
                ' テキスト（resultSet）を元にレコードセットを作成
                rsTitle.MakeRecordset (resultSet)
                ' クラスを使ってDataGridに連結
                Set DataGrid.DataSource = rsTitle
            Case "Author"
                Set rsAuthor = New MakeRecordsetCls
                ' テキスト（resultSet）を元にレコードセットを作成
                rsAuthor.MakeRecordset (resultSet)

                ' BindingCollectionオブジェクトを定義し，データソースにクラスを指定
                Set colBind = New BindingCollection
                Set colBind.DataSource = rsAuthor

                ' BindingCollectionオブジェクトを使ってテキストボックスにデータ連結
                colBind.Add txt1, "Text", rsAuthor.dsRecordset.Fields(0).Name
                colBind.Add txt2, "Text", rsAuthor.dsRecordset.Fields(1).Name
                colBind.Add txt3, "Text", rsAuthor.dsRecordset.Fields(2).Name

                MsgBox rsAuthor.RecordCount & "レコードのデータが見つかりました"

                ' ナビゲーションボタンの使用可
                If rsAuthor.RecordCount > 1 Then
                    cmdNext.Enabled = True
                    cmdLast.Enabled = True
                Else
                    cmdFirst.Enabled = False
                    cmdBack.Enabled = False
                    cmdNext.Enabled = False
                    cmdLast.Enabled = False
                End If
                Call getTitle
        End Select
    End If
End Sub