使用ASP建立Http组件

  如何生成自己的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>