winsock接收數據問題

Private Declare Sub CopyMemory Lib "kernel32" _

    Alias "RtlMoveMemory" ( _

    Destination As Byte, _

    Source As Byte, _

    ByVal Length As Long)



'记录集转化为二进制

Public Function RecordsetToBimary(rs As Recordset) As Byte()



    Dim stm As Stream

    

    Set stm = New Stream

    stm.Open

    stm.Type = adTypeBinary

    rs.Save stm, adPersistADTG

    stm.Position = 0

    RecordsetToBimary = stm.Read()

    Set stm = Nothing

    

End Function



'二进制还原为记录集

Private Function BimaryToRecordset(vData() As Byte) As Recordset

    

    Dim stm As Stream

    Dim rs As Recordset

    

    Set stm = New Stream

    stm.Open

    stm.Type = adTypeBinary

    stm.Write vData

    stm.Position = 0

    

    Set rs = New Recordset

    rs.Open stm

    Set BimaryToRecordset = rs

    

    Set rs = Nothing

    Set stm = Nothing

    

End Function



'客户端向器发送查询请求:

Private Sub Command1_Click()

    

    Dim strSql  As String

    strSql = "select * from so limit 1000"

    If Winsock1.State = sckConnected Then

        Winsock1.SendData strSql

        DoEvents

    End If

    

End Sub



'服务器收到查询请求后执行查询，返回数据

Private Sub Winsock1_DataArrival(Index As Integer, ByVal bytesTotal As Long)

    

    Dim strSql As String

    Dim arrData() As Byte

    Dim arrLength As Long

    Dim FinisData() As Byte

    Dim cn As ADODB.Connection

    Dim rs As ADODB.Recordset

    

    Winsock1(Index).GetData strSql, vbString

    Set cn = New ADODB.Connection

    cn.Open "ODBCName", "as", "123abc"

    Set rs = cn.Execute(strSql)

    arrData = RecordsetToBimary(rs)   '记录集转换成字节数组

    arrLength = UBound(arrData)

    Set rs = Nothing

    Set cn = Nothing

    '添加结束标志

    FinisData = "`!"

    ReDim Preserve arrData(arrLength + 4)

    CopyMemory arrData(arrLength + 1), FinisData(0), 4

    '向客户端发送数据

    Winsock1(Index).SendData arrData

    DoEvents

    

End Sub



'客户端接收返回的数据

Private Sub Winsock1_DataArrival(ByVal bytesTotal As Long)

    

    Dim tmpData() As Byte

    Dim Finis As String, FinisData(3) As Byte   '存取结尾标志

    Dim rs As Recordset

    

    '当数据超过8k时，winsock会分包发送

    '所以要组合结尾前的全部数据

    Static rsData() As Byte  '记录集数组

    Static rsLength As Long

    Static iCount As Integer

    

    'tmpData接收数据

    Winsock1.GetData tmpData, vbArray + vbByte

    

    '把接收的数据保存在rsData中

    If iCount = 0 Then              '第一次接收

        rsData = tmpData

        iCount = 1

    Else

        ReDim Preserve rsData(rsLength + bytesTotal)

        CopyMemory rsData(rsLength + 1), tmpData(0), bytesTotal

    End If

    rsLength = UBound(rsData)    'rsData的长度

    

    '判断结尾(结尾4个字节)

    CopyMemory FinisData(0), rsData(rsLength - 3), 4

    Finis = FinisData

    If Finis = "`!" Then

        '如果是结尾，截断结尾标志数据

        ReDim Preserve tmpData(rsLength - 4)

        Set rs = BimaryToRecordset(rsData)     '还原记录集

        'Call DebugPrintRs(rs)   '打印结果

        Erase rsData

        iCount = 0

        rsLength = 0

        Set rs = Nothing

        MsgBox "OK"

    End If

End Sub