一个socket组件及其调用方法

　2005-05-20 10:31:36　来源：WEB开发网　闂侀潧妫撮幏锟�

婵犫拃鍛粶闁靛洤娲ㄩ埀顒佺⊕閵囩偟绱為敓锟�闂侀潧妫撮幏锟�　　闂佺ǹ绻楀▍鏇㈠极閻愭娑樷枎閹邦剛娉氶梺鍛婎殔濞层劌鈻撻幋婵愬殫妞ゆ梻鍘х憴锟�

核心提示：这个socket组件是由开发jmail的那家公司作的，很老的一个版本了，一个socket组件及其调用方法，不过挺好的，我一直在用，比较稳定，以前发现xmlhttp在win2003 server上不太好

这个socket组件是由开发jmail的那家公司作的。
很老的一个版本了。不过挺好的。我一直在用。
比较稳定。以前发现xmlhttp在win2003 server上不太好。流量大了iis容易当掉。用这个组件倒还算稳定。

　 paraHost ="www.cncms.com"　　 ' host
　 paraPort = 80　　　　　　　　　　 ' port
　 paraFileUrl ="/test/test.htm"
　
　 Set Socket = CreateObject("Socket.TCP")
　 Socket.Host = paraHost & ":" & paraPort
　 Socket.Timeout = paraTimeout
　 If Err.Number <> 0 Then Err.Clear
　 Socket.open
　 ' timeout error = 8000ffff
　 Socket.SendLine "GET " & paraFileUrl & " HTTP/1.0"
　 Socket.SendLine "HOST: " & paraHost
　 Socket.SendLine ""
　 Socket.SendLine ""
　 'Sleep 200
　 Socket.WaitForDisconnect
　 If Err.Number <> 0 Then
　　　 response.write Err.Number & " -- " & Err.Description

　 Err.Clear
　 Else
　 response.write HTTPResponse(Socket.Buffer, 1) ' output text from socket
　 End If
　 Socket.Close
　 Set Socket = Nothing

Private Function HTTPResponse(ByVal toHTTPResponse, ByVal whichHTTPResponse)
On Error Resume Next
Dim HTTPResponseDelimiter

HTTPResponseDelimiter = Chr(13) & Chr(10) & Chr(13) & Chr(10)
If (InStr(1, toHTTPResponse, HTTPResponseDelimiter, vbBinaryCompare) <> 0) Then
　 Select Case whichHTTPResponse
　 Case 0 'Header
　　 HTTPResponse = Mid(toHTTPResponse, 1, (InStr(1, toHTTPResponse, HTTPResponseDelimiter, vbBinaryCompare) - 1))
　 Case 1 'Body
　　 HTTPResponse = Mid(toHTTPResponse, (InStr(1, toHTTPResponse, HTTPResponseDelimiter, vbBinaryCompare) + Len(HTTPResponseDelimiter)), (Len(toHTTPResponse) - (InStr(1, toHTTPResponse, HTTPResponseDelimiter, vbBinaryCompare) - 1)))
　 End Select
End If

End Function