请教 vb6 关于 winsock 的一个问题。急急急!!!!

nkwen 2000-05-23 09:41:00

  我在 vb 下用winsock 开发一个网络应用,功能类似于asphttp控件。在调试过程中、我发现若下载的网页文件的字节数大于8K ,则不能下载,出现错误代号40006,“所需事物或请求的错误协议或连接状态 ”(wrong protocol or connection state for requested transaction or request. 我用timer 控件每1毫秒查询其状态,发现建立连接后 winsock 即停止工作(状态6-7—7),请教vb大虾是什么原因?代码贴在下面。请指教。所剩分数全部奉上。thanks


Dim i As Integer
Dim strt As String

Dim strURL As String
Dim strURI As String
Dim strServer As String
Dim nPort As Long
Dim strHead As String


Dim strData As String
Dim bConnected As Boolean


'''' 远程机器名 与 文件路径
Dim m_strServer As String
Dim m_strURI As String

''''' 定义属性
Dim m_Accept As String
Dim m_Authorization As String

Dim m_BinaryData As String
' dim m_BinaryData As Byte

Dim m_ContentType As String
Dim m_Error As String
Dim m_FollowRedirects As Boolean

Dim m_Headers As String
Dim m_Port As Long
Dim m_PostData As String
Dim m_Protocol As String
Dim m_Proxy As String
Dim m_ProxyPassword As String
Dim m_RequestMethod As String
Dim m_RegisteredUser As String
Dim m_Response As String
Dim m_SaveFileTo As String
Dim m_TimeOut As Integer
Dim m_URL As String
Dim m_UserAgent As String
Dim m_Version As String

Dim m_strHead As String
Dim m_strData As String
Dim m_bConnected As Boolean

Dim m_Content As String ' 请求头内容 ,由 winsock发送
Dim m_strReturnData As String
Dim m As String

Dim m_blConnected As Boolean

Private Sub Command2_Click()
Unload Me
End Sub

Private Sub Form_Load()
Text2.Text = "http://tiger/debug/tomeibao02.txt"

Timer1.Enabled = False

End Sub


Private Sub Command1_Click()

Timer1.Enabled = True

m_URL = Text2.Text
SetDefault
ParseURL
Connect
SendRequest

m_strHead = Left(m_strReturnData, InStr(m_strReturnData, vbCrLf & vbCrLf))
m_strData = Right(m_strReturnData, Len(m_strReturnData) - InStr(m_strReturnData, vbCrLf & vbCrLf))
' GetURL = m_strData

objWinSock.Close
Text1.Text = m_strReturnData

End Sub

Private Sub SetDefault()
If m_TimeoutTime = 0 Then
m_TimeoutTime = 35
End If

If m_URL = "" Then
m_URL = "http://www.china8.com"
'' Err.Raise vbObjectError, "Error", "没有指定URL,请设定URL属性!"
End If

If m_Port = 0 Then
m_Port = 80
End If

If m_RequestMethod = "" Then
m_RequestMethod = "GET"
'' Err.Raise vbObjectError, "Error", "没有指定请求方法,请设定RequestMethod属性!"
End If

If m_UserAgent = "" Then
'' 可以设定默认的请求头
' m_UserAgent = "Mozilla Compatible (MS IE 3.01 WinNT)"
m_UserAgent = "User-Agent: aspHttp.http"
End If

If m_Accept = "" Then
m_Accept = "*/*"
End If

If m_Protocol = "" Then
m_Protocol = "HTTP/1.0"
End If

End Sub



Private Sub ParseURL()
If LCase(Left(m_URL, 7)) = "http://" Then
If InStr(8, m_URL, "/") = 0 Then
m_strServer = Right(m_URL, Len(m_URL) - 7)
m_strURI = "/"
Else
m_strServer = Mid(m_URL, 8, InStr(8, m_URL, "/") - 8)
m_strURI = Right(m_URL, Len(m_URL) - InStr(8, m_URL, "/") + 1)
End If
If InStr(m_strServer, ":") <> 0 Then
m_Port = CLng(Right(m_strServer, Len(m_strServer) - InStr(m_strServer, ":")))
m_strServer = Left(m_strServer, InStr(m_strServer, ":") - 1)
End If
If m_Port = 0 Then m_Port = 80
Else
Err.Raise vbObjectError, "Error", "错误的URL"
End If
End Sub

Private Sub Connect()
Dim dtStart As Date
dtStart = Now()

objWinSock.Protocol = sckTCPProtocol
objWinSock.RemoteHost = m_strServer
objWinSock.RemotePort = m_Port
objWinSock.Connect

Do Until bConnected
DoEvents
If DateDiff("s", dtStart, Now) > 60 Then
Err.Raise vbObjectError, "Error", "连接超时"
End If
Loop

' MsgBox "connect"
End Sub


Private Sub SendRequest()
Dim strCmd
Dim dtStart As Date
dtStart = Now()

Select Case m_RequestMethod
Case "GET"
strCmd = "GET " & m_URL & " " & m_Protocol & vbCrLf
strCmd = strCmd & m_UserAgent & vbCrLf
strCmd = strCmd & "Accept:" & m_Accept & vbCrLf
strCmd = strCmd & vbCrLf
Case "POST"
strCmd = "POST " & m_URL & " " & m_Protocol & vbCrLf
strCmd = strCmd & m_UserAgent & vbCrLf
strCmd = strCmd & "Accept:" & m_Accept & vbCrLf
strCmd = strCmd & "content-type:application/x-www-form-urlencoded"
strCmd = strCmd & vbCrLf
Case "HEAD"
strCmd = "HEAD " & m_URL & " " & m_Protocol & vbCrLf
strCmd = strCmd & m_UserAgent & vbCrLf
strCmd = strCmd & "Accept:" & m_Accept & vbCrLf
strCmd = strCmd & vbCrLf
End Select


Text3.Text = strCmd

objWinSock.SendData strCmd


Do Until objWinSock.State = sckClosing
DoEvents
If DateDiff("s", dtStart, Now) > 60 Then
Err.Raise vbObjectError, "Error", "请求超时"
End If
Loop

End Sub



''Public Property Get Headers() As Variant
'' Headers = m_strHead
''End Property
''
''Public Property Get Body() As Variant
'' Body = m_strData
''End Property


Private Sub objWinSock_DataArrival(ByVal bytesTotal As Long)
Dim strTemp
objWinSock.GetData strTemp, vbString, bytesTotal + 1024
m_strReturnData = m_strReturnData & strTemp
End Sub

Private Sub objWinSock_Connect()
bConnected = True
m_blConnected = True
End Sub

Private Sub objWinSock_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)

Err.Raise vbObjectError, "Error", "Winsock Error: " & Number & vbCrLf & Description
CancelDisplay = True
End Sub



Private Sub Timer1_Timer()
Dim l As Integer
l = objWinSock.State
strt = strt & l
Text4.Text = strt
End Sub

...全文
251 3 打赏 收藏 转发到动态 举报
写回复
用AI写文章
3 条回复
切换为时间正序
请发表友善的回复…
发表回复
sanhan 2000-05-29
  • 打赏
  • 举报
回复
自己处理http是有点麻烦的事情,而且http 0.9, 1.0, 1.1还有所不同。
一定要自己写的话请仔细阅读协议RFC

另:你的程序比较乱,出问题不太好查。
Un1 2000-05-23
  • 打赏
  • 举报
回复
如果想利用Winsock传送数据必须同时对C/S编程,而不是一相情愿就可以。想操作某个URL上的文件应该使用Microsoft Internet Transfer 控件。
nkwen 2000-05-23
  • 打赏
  • 举报
回复
这个问题困扰了我好长时间,请大虾不吝指教. 谢谢!

4,354

社区成员

发帖
与我相关
我的任务
社区描述
通信技术相关讨论
社区管理员
  • 网络通信
加入社区
  • 近7日
  • 近30日
  • 至今
社区公告
暂无公告

试试用AI创作助手写篇文章吧