使用ASP建立Http组件

　2000-08-21 10:10:43　来源：WEB开发网　　　

核心提示：如何生成自己的aspHttp组件:使用Winsock控件，下面将介绍怎么来建立一个简单的HTTP组件，使用ASP建立Http组件，记住先选择mswinsck.ocx控件,下面的代码是在VB6中编译的，代码如下：PRivate WithEvents objWinSock As MSWinsockLib.WinsockPr

如何生成自己的aspHttp组件:
使用Winsock控件，下面将介绍怎么来建立一个简单的HTTP组件。
记住先选择mswinsck.ocx控件,下面的代码是在VB6中编译的。
代码如下：
　　　　　　　PRivate WithEvents objWinSock As MSWinsockLib.Winsock
　　　　　　　　　　Private strURL As String
　　　　　　　　　　Private strURI As String
　　　　　　　　　　Private strServer As String
　　　　　　　　　　Private nPort As Long
　　　　　　　　　　Private strHead As String
　　　　　　　　　　Private strData As String
　　　　　　　　　　Private bConnected As Boolean

　　　　　　　　　　Public Function httpGet(URL As String) As String
　　　　　　　　　　　　 Set objWinSock = New MSWinsockLib.Winsock
　　　　　　　　　　　　 strURL = URL
　　　　　　　　　　　　 ParseURL
　　　　　　　　　　　　 Connect
　　　　　　　　　　　　 SendRequest
　　　　　　　　　　　　 objWinSock.Close
　　　　　　　　　　　　 strHead = Left(strData, InStr(strData, vbCrLf & vbCrLf))
　　　　　　　　　　　　 strData = Right(strData, Len(strData) - InStr(strData, vbCrLf & vbCrLf))
　　　　　　　　　　　　 httpGet = strData
　　　　　　　　　　End Function

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

　　　　　　　　　　Private Sub Connect()
　　　　　　　　　　　　 Dim dtStart As Date
　　　　　　　　　　　　 dtStart = Now()
　　　　　　　　　　　　 objWinSock.RemoteHost = strServer
　　　　　　　　　　　　 objWinSock.RemotePort = nPort
　　　　　　　　　　　　 objWinSock.Connect
　　　　　　　　　　　　 Do Until bConnected
　　　　　　　　　　　　　　　DoEvents
　　　　　　　　　　　　　　　If DateDiff("s", dtStart, Now) > 30 Then
　　　　　　　　　　　　　　　　　 Err.Raise vbObjectError, "Error", "连接超时"
　　　　　　　　　　　　　　　End If
　　　　　　　　　　　　 Loop
　　　　　　　　　　End Sub

　　　　　　　　　　Private Sub SendRequest()
　　　　　　　　　　　　 Dim strCmd
　　　　　　　　　　　　 Dim dtStart As Date
　　　　　　　　　　　　 dtStart = Now()
　　　　　　　　　　　　 strCmd = "GET " & strURI & " HTTP/1.0" & vbCrLf
　　　　　　　　　　　　 strCmd = strCmd & "User-Agent: aspHttp.http" & vbCrLf
　　　　　　　　　　　　 strCmd = strCmd & "Accept: */*" & vbCrLf
　　　　　　　　　　　　 strCmd = strCmd & vbCrLf
　　　　　　　　　　　　 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 Head() As Variant
　　　　　　　　　　　　 Head = strHead
　　　　　　　　　　End Property

　　　　　　　　　　Public Property Get Body() As Variant
　　　　　　　　　　　　 Body = strData
　　　　　　　　　　End Property

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

　　　　　　　　　　Private Sub objWinSock_Connect()
　　　　　　　　　　　　 bConnected = 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
编译该组件，然后按照下面的步骤注册该组件
　　　　　　　　　　C:\net stop iisadmin /y
　　　　　　　　　　C:\mtxstop
编译成Active Dll
　　　　　　　　　　C:\net start w3svc
在ASP中调用这个组件

　　　　　　　　　　<%@ Language=VBScript %>
　　　　　　　　　　<HTML>
　　　　　　　　　　<HEAD>
　　　　　　　　　　<META NAME="GENERATOR" Content="Microsoft Visual Studio 6.0">
　　　　　　　　　　</HEAD>
　　　　　　　　　　<BODY>
　　　　　　　　　　<%
　　　　　　　　　　Dim obj
　　　　　　　　　　Set obj = Server.CreateObject("aspHttp.http")
　　　　　　　　　　Response.Write obj.httpGet("http://www.chinaasp.com.cn")
　　　　　　　　　　%>
　　　　　　　　　　</BODY>
　　　　　　　　　　</HTML>