先谢谢了。我用Socket控件编写了一个控件,代码如下。结果应该返回10000多个字节,可是,只接受到1460个字节,请问为什么?如何才能取得所有数据?Option Explicit'Default Property Values:
Const m_def_sCookie = ""
Const m_def_sURL = ""
Const m_def_sHostIP = "localhost"
Const m_def_sHostPort = "80"
Const m_def_sData = ""
'Property Variables:
Dim m_sCookie As String   ''''返回的Cookie串
Dim m_sURL As String      ''''提交的地址
Dim m_sHostIP As String   ''''服务端主机IP
Dim m_sHostPort As String ''''服务端主机端口
Dim m_sData As String     ''''数据串正文Private sHTTPReturn As String ''''返回的HTTP全文
Private bSuccessReturnData As Boolean  '''成功返回数据
Public bDataArrival As BooleanPublic bKeepCookie As Boolean  ''''是否保持上次连接的Cookie
Public bKeepAlive As Boolean   ''''是否保持长连接
Public sErrorDesc As String   ''''错误描述
Private psData As String''''调用示例
Private Sub test1()
  ucSocket1.sHostIP = "192.168.0.117"
  ucSocket1.sHostPort = "8080"
  ucSocket1.sUrl = "/servlet1?sql=select t1.customerid ,count(t1.orderid)  from orders t1 where t1.customerid like '%25' and t1.orderid>100  group by t1.customerid"
  ucSocket1.bKeepCookie = False
  ucSocket1.bKeepAlive = False  Call ucSocket1.sendData  Text1.Text = ucSocket1.getData
  if ucSocket1.sErrorDesc<>"" then msgbox ucSocket1.sErrorDesc
End SubPublic Property Get sUrl() As String
    sUrl = m_sURL
End PropertyPublic Property Let sUrl(ByVal New_sURL As String)
    m_sURL = New_sURL
    PropertyChanged "sURL"
End PropertyPublic Property Get sHostIp() As String
    sHostIp = m_sHostIP
End PropertyPublic Property Let sHostIp(ByVal New_sHostIP As String)
    m_sHostIP = New_sHostIP
    PropertyChanged "sHostIP"
End PropertyPublic Property Get sHostPort() As String
    sHostPort = m_sHostPort
End PropertyPublic Property Let sHostPort(ByVal New_sHostPort As String)
    m_sHostPort = New_sHostPort
    PropertyChanged "sHostPort"
End PropertyPublic Property Get sData() As String
    sData = m_sData
End PropertyPublic Property Let sData(ByVal New_sData As String)
    m_sData = New_sData
    PropertyChanged "sData"
End PropertyPrivate Sub UserControl_Initialize()
    bKeepCookie = False
    bKeepAlive = False
    sErrorDesc = ""
End Sub'Initialize Properties for User Control
Private Sub UserControl_InitProperties()
    m_sURL = m_def_sURL
    m_sHostIP = m_def_sHostIP
    m_sHostPort = m_def_sHostPort
    m_sData = m_def_sData
    m_sCookie = m_def_sCookie
End Sub'Load property values from storage
Private Sub UserControl_ReadProperties(PropBag As PropertyBag)
    m_sURL = PropBag.ReadProperty("sURL", m_def_sURL)
    m_sHostIP = PropBag.ReadProperty("sHostIP", m_def_sHostIP)
    m_sHostPort = PropBag.ReadProperty("sHostPort", m_def_sHostPort)
    m_sData = PropBag.ReadProperty("sData", m_def_sData)
    m_sCookie = PropBag.ReadProperty("sCookie", m_def_sCookie)
End Sub'Write property values to storage
Private Sub UserControl_WriteProperties(PropBag As PropertyBag)
    Call PropBag.WriteProperty("sURL", m_sURL, m_def_sURL)
    Call PropBag.WriteProperty("sHostIP", m_sHostIP, m_def_sHostIP)
    Call PropBag.WriteProperty("sHostPort", m_sHostPort, m_def_sHostPort)
    Call PropBag.WriteProperty("sData", m_sData, m_def_sData)
    Call PropBag.WriteProperty("sCookie", m_sCookie, m_def_sCookie)
End SubPublic Function getData() As String
    Do
       DoEvents
       If bDataArrival Then
          Exit Do
       End If
    Loop
    getData = m_sData
    'getData = sHTTPReturn  '''临时用于调试
End FunctionPublic Function sendData() As String
    If Winsock1.state <> sckClosed Then Winsock1.Close
    Call Winsock1.Connect(m_sHostIP, m_sHostPort)
    bDataArrival = False
    
    Dim Data1
    Dim sConnect, sCookieDesc As String
    
    If bKeepAlive Then
       sConnect = "Connection: Keep-Alive" & vbCrLf
    Else
       sConnect = ""
    End If
    
    If bKeepCookie And (m_sCookie <> "") Then
       sCookieDesc = m_sCookie & vbCrLf
    Else
       sCookieDesc = ""
    End If
        
    Data1 = "POST " & sUrl & " HTTP/1.1" & vbCrLf _
    & "Accept: image/gif, image/x-xbitmap, image/jpeg, image/pjpeg, application/vnd.ms-powerpoint, application/vnd.ms-excel, application/msword, application/x-shockwave-flash, */*" & vbCrLf _
    & "Accept -Language: zh -cn" & vbCrLf _
    & "Accept -Encoding: gzip , deflate" & vbCrLf _
    & "User-Agent: Mozilla/4.0 (compatible; MSIE 5.01; Windows NT 5.0)" & vbCrLf _
    & "Host: " & m_sHostIP & ":" & m_sHostPort & vbCrLf _
    & sConnect _
    & sCookieDesc _
    & vbCrLf
        
    'Debug.Print data1
    
    Do
        DoEvents
        If (Winsock1.state = sckConnected) Then
            Exit Do
        End If
        ''''超时处理
    Loop
    
    Call Winsock1.sendData(Data1)
End FunctionPublic Property Get sCookie() As String
    sCookie = m_sCookie
End PropertyPublic Property Let sCookie(ByVal New_sCookie As String)
    m_sCookie = New_sCookie
    PropertyChanged "sCookie"
End PropertyPrivate Sub Winsock1_DataArrival(ByVal bytesTotal As Long)
    Dim Data1 As String    Call Winsock1.getData(Data1, vbString)
    sHTTPReturn = Data1
           
    Winsock1.Close    'Debug.Print data1    bDataArrival = TrueEnd SubPrivate Sub Winsock1_Error(ByVal Number As Integer, Description As String, ByVal Scode As Long, ByVal Source As String, ByVal HelpFile As String, ByVal HelpContext As Long, CancelDisplay As Boolean)
    ''''错误处理有待于进一步细化
    If Number <> 0 Then
       'Call MsgBox("错误代码:" & CStr(Number) & vbCrLf & "错误描述:" & Description, vbOKOnly, "错误提示")
       sErrorDesc = "错误代码:" & CStr(Number) & vbCrLf & "错误描述:" & Description
       bDataArrival = True
    End If
End Sub

解决方案 »

  1.   

    数据大了要分段接收。
    http://community.csdn.net/Expert/topic/3515/3515059.xml?temp=.6225397
      

  2.   

    你等等嘛,不要急...dataarrival事件会继续发生的,直到数据完了!
      

  3.   

    楼主说的对,再加一个等待的函数,dataarrival会有事件继续发生,一直到接收完
      

  4.   

    winsock传送东西会有以下两种情况 一个大的数据包会分多次触发dataarrival事件;如果数据包长度比较小 还有可能在一次dataarrival事件中,收到多个(一个以上的)数据包 楼主要注意到这个问题对于一次dataarrival收到的数据不全 你可以这样解决 设个全局变量getDataFromSock 存放每次dataarrival中getdata得到的数据 ,每次dataarrival 前要判断getDataFromsock时否已经是一个完整的数据包 如果不是 把这次得到的数据接到getdatafromsock后边 如果已经是完整的数据包 则清空getdatafromsock 从新接收下个数据包
      

  5.   

    你打sp5补丁,我之前也是不打补丁,用inet控件下载文件经常出现下载文件小于2k ,大概就是1k多,这个问题让我头疼了两个星期,你打补丁试试
      

  6.   

    http://www.smartmaildemo.com 有例子