请教 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