SQL2000与WINSOCK传输数据

Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Byte, Source As Byte, ByVal Length As Long)
Dim wArr(30, 2)       As StringPublic Sub Command1_Click()
    If sockServer(0).State <> sckClosed Then sockServer(0).Close   '如果在监听状态,那么关闭控件
    sockServer(0).LocalPort = "1228"     '设置监听端口为1228
    sockServer(0).Listen                 '开始监听
    StateInfo.Text = "开始侦听"          '在TEXT控件中显示状态
    Me.SockList.AddItem "sockserver(0) 开始侦听"  '添加到事件列表
    Command1.Enabled = False           '更改开启服务按钮的状态
    Command2.Enabled = True           '更改关闭退出按钮的状态
End Sub 
                                                                     
Private Sub Form_Unload(Cancel As Integer)
    If sockServer(0).State <> sckClosed Then                    '判断服务器端是否关闭
        sockServer(0).Close                                      '关闭服务端连接
    End If
End Sub                                                               
Public Function RsToBin(Rs As Recordset) As Variant              '记录集转换为二进制数据
    Dim objStream As Stream
    Set objStream = New Stream
    objStream.Open
    objStream.Type = adTypeBinary
    Rs.Save objStream, adPersistADTG
    objStream.Position = 0
    RsToBin = objStream.Read()
    Set objStream = Nothing
End Function
                                                                    
Private Sub sockServer_Close(Index As Integer)
 On Error GoTo acd
  SockList.AddItem "客户端:" & sockServer(Index).RemoteHostIP & "已经关闭连接"     '添加客户端关闭到事件列表
  wArr(Index, 0) = ""                              '更改数组的状态为关闭
  Unload sockServer(Index)                         '释放相应的SOCK控件
  Exit Sub
acd:
End SubPrivate Sub sockServer_ConnectionRequest(Index As Integer, ByVal requestID As Long) '服务器收到请求
Dim i As Integer, pi As Integer
  Dim bi As Boolean
  If Index = 0 Then
          For i = 1 To 30                            '循环整个数组,判断是否有连接可用
                  If wArr(i, 0) = "" Then            '搜索到没有装载的控件时
                          pi = i                     '记录控件序号
                          bi = True                  '记录有可用控件
                          Exit For
                  End If
          Next i
            
          If bi = True Then              '当有可用控件时
              wArr(pi, 0) = sockServer(0).RemoteHostIP    '将客户端IP记录到数组
              Load sockServer(pi)                         '装载相应的控件
              sockServer(pi).LocalPort = 10000 + pi       '设置连接端口为10000+控件序号
              sockServer(pi).Accept requestID                   '回应连接请求并允许连接
              SockList.AddItem "客户端:" & sockServer(pi).RemoteHostIP & "已经连接"
          Else
                  MsgBox "客户端连接已满"           '连接数已满的情况下显示消息
          End If
  End If
End Sub
Private Sub sockServer_DataArrival(Index As Integer, ByVal bytesTotal As Long)
    Dim strsql As String
    Dim objRec As Recordset
    Dim arrData() As Byte
    Dim arrLength As Long
    Dim FinisData() As Byte
    Dim cnn As New ADODB.Connection
    Dim Rs As New ADODB.Recordset
    sockServer(Index).GetData strsql     
    '定义ADO连接字符    
    a = InStr(strsql, ",")
    b = Left(strsql, a - 1)
    c = Len(strsql) - a
    d = Mid(strsql, a + 1, c)
    strsql1 = b
    strsql2 = d       
    cnn.Open "DRIVER={SQL Server};SERVER=" + Text1.Text + ";UID=sa;PWD=" + Text2.Text + ";DATABASE=" + b + ""  
    Rs.Open strsql2, cnn, , 1, 1                 '返回查询结果    
    arrData() = RsToBin(Rs)                      ' 记录集转换成字节数组
    arrLength = UBound(arrData)                   '获取字节数组长度
    Set Rs = Nothing                              '释放
    Set cnn = Nothing                             '释放
    FinisData = "`!" '添加数据包结束标志
 ReDim Preserve arrData(arrLength + 4)         '不破坏原有数据的情况下重定义原有二进制数组
 CopyMemory arrData(arrLength + 1), FinisData(0), 4  'API命令,添加数据包结果标志到二进制数组结尾
 sockServer(Index).SendData arrData                  ' 送回客户段
    DoEvents                                         '转移控制权,以处理其它客户端的响应
End Sub

解决方案 »

  1.   

    Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Byte, Source As Byte, ByVal Length As Long)
    Dim rs1 As ADODB.Recordset
    Private Sub Command1_Click()
    If sockClient.State <> sckClosed Then sockClient.Close
        If txtServerName.Text <> vbNullString Then
            sockClient.RemoteHost = txtServerName.Text  '设置远程计算机名称
        Else
            MsgBox "必须输入服务器名称或IP地址", vbInformation, "提示"
            Exit Sub
        End If
        If txtServerPort.Text <> vbNullString Then
            sockClient.RemotePort = txtServerPort.Text  '设置远程端口名称
        Else
            MsgBox "必须输入远程端口", vbInformation, "提示"
            Exit Sub
        End If
        sockClient.Protocol = sckTCPProtocol             '设置 Winsock 控件所使用的协议是TCP。
        sockClient.Connect                               '要求连接到远程计算机
    End Sub
    Private Sub Command2_Click()
        Dim strSQL As String
         strSQL = "master," & Text1.Text
      If sockClient.State = sckConnected Then
            sockClient.SendData strSQL
            DoEvents
       End If
    End Sub
    Private Sub Form_Load()
    Text1.Text = "select * from sysdatabases " 'order by "
    txtServerName = Me.sockClient.LocalHostName
    End Sub
    Private Sub sockClient_DataArrival(ByVal bytesTotal As Long)
    Dim tmpData() As Byte
    Dim Finis As String, FinisData(3) As Byte   '存取结尾标志
    Static rsLength As Long
    Static iCount As Integer
    Static rsData() As Byte  '记录集数组
    Dim arrData() As Byte
    Dim objRec As Recordset
    sockClient.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的长度
        CopyMemory FinisData(0), rsData(rsLength - 3), 4
        Finis = FinisData
        If Finis = "`!" Then   '假如是结尾，截断结尾标志数据
            ReDim Preserve tmpData(rsLength - 4)
            Set objRec = BinToRs(rsData)     '还原记录集
            Set MSHFlexGrid1.DataSource = objRec ' 显示数据     
            Erase rsData
            iCount = 0
            rsLength = 0
        End If
    End Sub
    Public Function BinToRs(vData As Variant) As Recordset '将服务器返回的二进制转换为记录集
    Dim objStream As Stream
    Dim objRs As Recordset
    Set objRs = New Recordset
    Set objStream = New Stream
    objStream.Open
    objStream.Type = adTypeBinary
    objStream.Write vData
    objStream.Position = 0
    objRs.Open objStream
    Set BinToRs = objRs
    Set objRs = Nothing
    Set objStream = Nothing
    End Function这样虽能通讯，但使用起来很不方便，也不好统计记录多少条，有高手指点下
      

  2.   

    有几个方案你可以看看：
    1、直接换个支持网络的数据库，其实ACCESS的支持不怎么好，如存储过程、UTF-8编码、网络、数据库最大容量、查询效率、稳定性、安全性等等都有很多缺陷，换个数据库解决这种问题最简单，建议采用。2、用 ASP+XMLHTTP+VB 实现这种远程数据的读写，有点类似AJAX方案，这种方案从稳定性和开发效率来看是比较可行，因为避免了你自己去写NT服务和网络通讯的很多问题，只用关心一些数据的逻辑处理问题，相对自己开发C/S结构的方案要简单稳定而且高效很多，硬是想自己弄建议用这个方案。3、自己用Socket写三层结构访问数据库，不过VB要做能抗压和稳定的NT服务端是不大现实的，只适用于网络要求不高的开发需求，如果要有一定的抗压能力和稳定性，必须换工具，因为网络服务这一块的有些技术在VB里很难稳定实现的，这受限于VB本身的架构问题，这个方案如果纯用VB做，基本上做出来的是玩具级别的东西，用作技术研究还可以，千万不要妄想把这种东西投入项目或产品中使用，这时徒劳的，当然，服务器端换工具开发或直接用现成的服务程序还是可以的，不过相对上面的两个方案会复杂一点。
     
    4、写个OLEDB驱动，然后再写个NT服务，这样你的代码基本上不用改动就可以通过ADO访问数据库了，只需要改动数据库连接语句，其他的都不用怎么改动，其实这和开发一个新的数据库已经不太远了，这个难度会比上面的方案都大，而且开发工具是必需换的，有时间并想了解底层数据库技术的话可以用这个方案。
      

  3.   

    我现在就是直接写SQL语句，连接SQL2000数据库，局域网速度还行，远程的话，数据量大一点就太慢了，有时还连接不上，大家都用1433端口，如果和别的软件放在一台主机上，会有冲突的吧？
      

  4.   

    直接写SQL语句，连接SQL2000数据库，局域网速度还行，远程的话，数据量大一点就太慢了