明輝手游網中心:是一個免費提供流行視頻軟件教程、在線學習分享的學習平臺!

使用ASP創(chuàng)建Http組件

[摘要]如何生成自己的AspHttp組件:使用Winsock控件,下面將介紹怎么來建立一個簡單的HTTP組件。記住先選擇mswinsck.ocx控件,下面的代碼是在VB6中編譯的。代碼如下: Private WithEvents objWinSock As MSWinsockLi...
如何生成自己的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>