使用ASP建立Http组件

来源：china asp 作者：batman 出处：巧巧读书 2006-01-19 进入讨论组

• 关 键 词：
• winsock控件
• microsoft
• vbscript
• server
• html

　　生成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, ":") $#@60;$#@62; 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

　? DateDiff("s", dtStart, Now) $#@62; 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) $#@62; 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中调用这个组件

　　$#@60;%@ Language=VBScript %$#@62;

　　$#@60;HTML$#@62;

　　$#@60;HEAD$#@62;

　　$#@60;META NAME="GENERATOR" Content="Microsoft Visual Studio 6.0"$#@62;

　　$#@60;/HEAD$#@62;

　　$#@60;BODY$#@62;

　　$#@60;%

　　Dim obj

　　Set obj = Server.CreateObject("aspHttp.http")

　　Response.Write obj.httpGet("http://www.chinaasp.com.cn")

　　%$#@62;

　　$#@60;/BODY$#@62;

　　$#@60;/HTML$#@62;

本文：http://www.qqread.com/asp/u502231001.html 更多内容请看HTTP协议专题，或进入讨论组讨论。

【收藏此文】【大 中 小】【打印】【关闭】

较早的文章：关于ASP,ASP.NET,VB.NET里的MD5加密函数

较新的文章：关于学习ASP和编程的28个观点