使用ASP建立Http组件

March 25,2004

生成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>