先谢谢了。我用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
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
解决方案 »
- 如何检测系统是否连接了鼠标?
- combox下拉列表打開是用甚麼事件或方法
- vb连接oracle获得记录数总为0?
- B\S系统设计
- 单击datagrid中某一单元时,如何获得其所在的列标题和行标题
- 最近想学学串口通讯方面的知识,请给个简单例子观摩一下,谢谢!!!
- 我编译的应用程序打开自己的一个form窗口,windows下面的任务栏就多出一个,可是我想不需要多出来,怎么班?
- vb6在XP下的小BUG!
- 有没有哪位高手精通installshield,我都快死了!高手救命!
- 请教,如何将文本框(text)里面的字符打印出来?或者有什么更好的方法打印出来?我只能一次给这么多分了,谢谢!!
- !!!!!!!!!!!!!!我的程序,希望大家来测试,并提出宝贵意见。刚出炉的哦,新鲜着呢!
- 多页面显示中的一点小问题
http://community.csdn.net/Expert/topic/3515/3515059.xml?temp=.6225397