Copyright (c) 1998 int21 Corporation All Rights Reserved.
For questions or comments, please send mail to: pcdn@int21.co.jp
秋月巌ソリューション事務所
秋月 巌 AKIZUKI,Iwao
| 前回までのあらすじ… |
|---|
| 真のC/Sデータベースシステム |
|---|
| ファイル共有型データベース |
|---|
| 誰が処理を担当するのか？ |
|---|
| C/Sシステムとして動作するサンプル |
|---|
| サーバー側の負荷分散も想定 |
|---|
| コールバックよる通信，そして問題点 |
|---|
| 最新サンプル・Type7 DB Server |
|---|
| Visual Basic 6.0で動作 |
|---|
| データ転送フォーマットの変更 |
|---|
SELECT * FROM Authors WHERE Au_ID < 10フィールド情報が付加された以外に，データ自体のフィールド区切りも従来のセミコロンから，TAB区切りに変更されている．そのため，Type7 DB Server／ClientとType6 DB Server／Clientは，相互に互換性がないものになっている．
Field information Au_ID 4 4 Author 12 50 Year Born 5 2 Lint 4 4 Sint 5 2 Dflot 8 8 Sflot 7 4 End field information Result Start : _ ［SELECT * FROM Authors WHERE Au_ID < 10］ 1 Jacobs, Russell 65 2 Metzger, Philip W. 54 3 Boddie, John 57 4 Sydow, Dan Parks 6 Lloyd, John 8 Thiel, James R. Result End : _ ［SELECT * FROM Authors WHERE Au_ID < 10］ Data send complete |
| フィールド情報の付加 |
|---|
MaxfieldCount = rs.rdoColumns.Count
RetResult = "Field information" & vbCrLf
For i = 0 To MaxfieldCount - 1
RetResult = RetResult & _
rs(i).Name & Chr(9) & _
rs(i).Type & Chr(9) & _
rs(i).Size & vbCrLf
Next
RecCount = 0
Winsock1.SendData RetResult & _
"End field information" & vbCrLf & vbCrLf & _
"Result Start :［" & sqlStat & "］" & vbCrLf
For〜Loopは，レコードセットにあるフィールドの項目の数だけループを行なう．ループ内ではRecordsetオブジェクトのNameプロパティ，Typeプロパティ，Sizeプロパティを使用してレコードセットの情報をテキスト化している．クライアントに送信するのは，ループを脱出してからである．| 最適化されたレコードセットの作成 |
|---|
Set mkRs = New MakeRecordsetCls
mkRs.MakeRecordset (resultSet)
MakeRecordsetClsクラスをインスタンス化し，メンバーであるMakeRecordset関数を呼び出している．MakeRecordsetClsクラスのMakeRecordset関数が記事末リスト2である．
この関数はType6 DB Serverでも実装されていたが，大量のレコードを含むRecordsetオブジェクトを受信したときのパフォーマンスに問題があったため，レコードセット作成のアルゴリズムも変更されている．
| フィールド型に応じたFieldオブジェクトの作成 |
|---|
Select Case i
Case 1
AppendParamName = strField
Case 2
AppendParamTypeVal = Val(AppendParamType)
' RDOのレコードセットのタイプをADOに変換
Select Case AppendParamTypeVal
Case 2 Or 3
strField = adNumeric
Case 4
strField = adInteger
Case 5
strField = adSmallInt
Case 6 Or 7 Or 8
strField = adDouble
Case -6
strField = adTinyInt
End Select
AppendParamType = strField
Case 3
AppendParamSize = Val(strField)
End Select
Next
dsRecordset.Fields. _
Append AppendParamName, adLongVarChar, _
AppendParamSize, adFldUpdatable ' adFldRowID
このコードでは，サーバーが返すRDOのフィールドの型をクライアントのADOのフィールド型に変換している．これは二者で使用される定数の値が違うことから必要になる処理である．将来的にはサーバー側もADOで実装しなおす可能性もあるが，現時点ではサーバーのデータベースアクセスはRDOを利用して行なっている．サーバー側にもADOを使用すれば，当然，この変換処理は必要なくなる．| DBグリッドへのデータ連結 |
|---|
Set DataGrid.DataSource = mkRsDBグリッドコントロールのDataSourceプロパティに作成したRecordsetオブジェクトを指定すればよい．テキストボックスにデータ連結する場合のように，BindingCollectionオブジェクトを作成する必要もない．
| まとめ |
|---|
Public Function MakeRecordset(strParam As String)
Dim fld As ADODB.Field
Dim strRow As String
Dim strField As String
Dim lngCurPointer As Long
Dim CurRecordLen As Integer
Dim intFieldStartPos As Integer
Dim intFieldNextPos As Integer
Dim i As Integer
CPOS = Chr(9)
CPOSlen = Len(CPOS)
'---------------------------------------
' フィールド情報の先頭に移動
Set dsRecordset = New ADODB.Recordset
lngCurPointer = InStr(strParam, "Field information")
Do While True ' intPosRow > 0
' 処理する行の先頭ポインタを取得
lngCurPointer = InStr(lngCurPointer, strParam, vbCrLf) + 2
' 処理する行の長さを取得
CurRecordLen = InStr(lngCurPointer, strParam, vbCrLf) - lngCurPointer
' 処理する行を取得
strRow = Mid(strParam, lngCurPointer, CurRecordLen)
' フィールド情報の最後ならば，ループを終了
If Left(strRow, 21) = "End field information" Then
Exit Do
End If
intFieldNextPos = 1
Dim AppendParamName As String
Dim AppendParamType As String
Dim AppendParamTypeVal As Integer
Dim AppendParamSize As String
For i = 1 To 3
intFieldStartPos = intFieldNextPos
' 区切り記号が見つかったら，左側がフィールドの値
intFieldNextPos = InStr(intFieldStartPos, strRow, CPOS) + CPOSlen
If intFieldNextPos <> 0 + CPOSlen Then
' 区切り記号まで位置を移動します
' intPos = InStr(intFieldStartPos, strRow, CPOS)
' 値を strField 変数に割り当てます
strField = Mid(strRow, intFieldStartPos, _
intFieldNextPos - intFieldStartPos - CPOSlen) ' Left(strRow, intPos - 1)
Else
' 区切り記号が見つからなければ，最後のフィールドです
strField = Mid(strRow, intFieldStartPos, Len(strField) - CPOSlen + 1)
End If
Select Case i
Case 1
AppendParamName = strField
Case 2
AppendParamTypeVal = Val(AppendParamType)
' RDOのレコードセットのタイプをADOに変換
Select Case AppendParamTypeVal
Case 2 Or 3
strField = adNumeric
Case 4
strField = adInteger
Case 5
strField = adSmallInt
Case 6 Or 7 Or 8
strField = adDouble
Case -6
strField = adTinyInt
End Select
AppendParamType = strField
Case 3
AppendParamSize = Val(strField)
End Select
Next
dsRecordset.Fields. Append AppendParamName, adLongVarChar, _
AppendParamSize, adFldUpdatable ' adFldRowID
Loop
dsRecordset.CursorType = adOpenKeyset
dsRecordset.LockType = adLockOptimistic
dsRecordset.Open
'---------------------------------------
' レコードのスタート位置にポインタを移動
lngCurPointer = InStr(strParam, "Result Start")
Do While True ' intPosRow > 0
' 処理するレコードの先頭ポインタを取得
lngCurPointer = InStr(lngCurPointer, strParam, vbCrLf) + 2
' 処理するレコードの長さを取得
CurRecordLen = InStr(lngCurPointer, strParam, vbCrLf) - lngCurPointer
' 処理するレコードを取得
strRow = Mid(strParam, lngCurPointer, CurRecordLen)
If Left(strRow, 10) = "Result End" Then ' Modi
Exit Do
End If
' 新規レコードを追加
dsRecordset.AddNew
intFieldNextPos = 1
For Each fld In dsRecordset.Fields
intFieldStartPos = intFieldNextPos
' 区切り記号が見つかったら，左側がフィールドの値
intFieldNextPos = InStr(intFieldStartPos, strRow, CPOS) + CPOSlen
If intFieldNextPos <> 0 + CPOSlen Then
' 値を strField 変数に割り当てます
strField = Mid(strRow, intFieldStartPos, _
intFieldNextPos - intFieldStartPos - CPOSlen) ' Left(strRow, intPos - 1)
Else
' 区切り記号が見つからなければ，最後のフィールドです
strField = Mid(strRow, intFieldStartPos, Len(strField) - CPOSlen + 1)
End If
If fld.Type = 17 Or fld.Type = 18 Or _
fld.Type = 19 Or fld.Type = 16 Or _
fld.Type = 2 Or fld.Type = 4 Or _
fld.Type = 131 Or fld.Type = 3 Or _
fld.Type = 5 Then ' 数値型の場合数値に変換
fld.Value = Val(strField)
Else
fld.Value = strField
End If
Next
dsRecordset.Update
dsRecordset.MoveFirst
Loop
End Function
|