<p>使用ASP建立Http組件</p>
<p></p>
<p>p>生成HTTP組件自己動手，豐衣足食，下面介紹如何生成自己的AspHttp組件。</p>
<p></p>
<p>　　使用Winsock控件，下面將介紹怎么來建立一個簡單的HTTP組件。</p>
<p></p>
<p>　　記住先選擇mswinsck.ocx控件下面的代碼是在VB6中編譯的。</p>
<p></p>
<p>　　代碼如下：</p>
<p></p>
<p>　　Private WithEvents objWinSock As MSWinsockLib.Winsock</p>
<p></p>
<p>　　Private strURL As String</p>
<p></p>
<p>　　Private strURI As String</p>
<p></p>
<p>　　Private strServer As String</p>
<p></p>
<p>　　Private nPort As Long</p>
<p></p>
<p>　　Private strHead As String</p>
<p></p>
<p>　　Private strData As String</p>
<p></p>
<p>　　Private bConnected As Boolean</p>
<p></p>
<p>　　</p>
<p></p>
<p>　　Public Function httpGet(URL As String) As String</p>
<p></p>
<p>　　Set objWinSock = New MSWinsockLib.Winsock</p>
<p></p>
<p>　　strURL = URL</p>
<p></p>
<p>　　ParseURL</p>
<p></p>
<p>　　Connect</p>
<p></p>
<p>　　SendRequest</p>
<p></p>
<p>　　objWinSock.Close</p>
<p></p>
<p>　　strHead = Left(strData, InStr(strData, vbCrLf & vbCrLf))</p>
<p></p>
<p>　　strData = Right(strData, Len(strData) - InStr(strData, vbCrLf & vbCrLf))</p>
<p></p>
<p>　　httpGet = strData</p>
<p></p>
<p>　　End Function </p>
<p></p>
<p>　　Private Sub ParseURL()</p>
<p></p>
<p>　　If LCase(Left(strURL, 7)) = "http://" Then</p>
<p></p>
<p>　　If InStr(8, strURL, "/") = 0 Then</p>
<p></p>
<p>　　strServer = Right(strURL, Len(strURL) - 7)</p>
<p></p>
<p>　　strURI = "/"</p>
<p></p>
<p>　　Else</p>
<p></p>
<p>　　strServer = Mid(strURL, 8, InStr(8, strURL, "/") - 8)</p>
<p></p>
<p>　　strURI = Right(strURL, Len(strURL) - InStr(8, strURL, "/") + 1)</p>
<p></p>
<p>　　End If</p>
<p></p>
<p>　　If InStr(strServer, ":") $#@60;$#@62; 0 Then</p>
<p></p>
<p>　　nPort = CLng(Right(strServer, Len(strServer) - InStr(strServer,</p>
<p></p>
<p>　　":")))</p>
<p></p>
<p>　　strServer = Left(strServer, InStr(strServer, ":") - 1)</p>
<p></p>
<p>　　End If</p>
<p></p>
<p>　　If nPort = 0 Then nPort = 80</p>
<p></p>
<p>　　Else</p>
<p></p>
<p>　　Err.Raise vbObjectError, "Error", "錯誤的URL"</p>
<p></p>
<p>　　End If</p>
<p></p>
<p>　　End Sub </p>
<p></p>
<p>　　Private Sub Connect()</p>
<p></p>
<p>　　Dim dtStart As Date</p>
<p></p>
<p>　　dtStart = Now()</p>
<p></p>
<p>　　objWinSock.RemoteHost = strServer</p>
<p></p>
<p>　　objWinSock.RemotePort = nPort</p>
<p></p>
<p>　　objWinSock.Connect</p>
<p></p>
<p>　　Do Until bConnected</p>
<p></p>
<p>　　DoEvents</p>
<p></p>
<p>　? DateDiff("s", dtStart, Now) $#@62; 30 Then</p>
<p></p>
<p>　　Err.Raise vbObjectError, "Error", "連接超時"</p>
<p></p>
<p>　　End If</p>
<p></p>
<p>　　Loop</p>
<p></p>
<p>　　End Sub </p>
<p></p>
<p>　　Private Sub SendRequest()</p>
<p></p>
<p>　　Dim strCmd</p>
<p></p>
<p>　　Dim dtStart As Date</p>
<p></p>
<p>　　dtStart = Now()</p>
<p></p>
<p>　　strCmd = "GET " & strURI & " HTTP/1.0" & vbCrLf</p>
<p></p>
<p>　　strCmd = strCmd & "User-Agent: aspHttp.http" & vbCrLf</p>
<p></p>
<p>　　strCmd = strCmd & "Accept: */*" & vbCrLf</p>
<p></p>
<p>　　strCmd = strCmd & vbCrLf</p>
<p></p>
<p>　　objWinSock.SendData strCmd</p>
<p></p>
<p>　　Do Until objWinSock.State = sckClosing</p>
<p></p>
<p>　　DoEvents</p>
<p></p>
<p>　　If DateDiff("s", dtStart, Now) $#@62; 60 Then</p>
<p></p>
<p>　　Err.Raise vbObjectError, "Error", "請求超時"</p>
<p></p>
<p>　　End If</p>
<p></p>
<p>　　Loop</p>
<p></p>
<p>　　End Sub </p>
<p></p>
<p>　　Public Property Get Head() As Variant</p>
<p></p>
<p>　　Head = strHead</p>
<p></p>
<p>　　End Property </p>
<p></p>
<p>　　Public Property Get Body() As Variant</p>
<p></p>
<p>　　Body = strData</p>
<p></p>
<p>　　End Property </p>
<p></p>
<p>　　Private Sub objWinSock_DataArrival(ByVal bytesTotal As Long)</p>
<p></p>
<p>　　Dim strTemp</p>
<p></p>
<p>　　objWinSock.GetData strTemp, vbString</p>
<p></p>
<p>　　strData = strData & strTemp</p>
<p></p>
<p>　　End Sub</p>
<p></p>
<p>　　Private Sub objWinSock_Connect()</p>
<p></p>
<p>　　bConnected = True</p>
<p></p>
<p>　　End Sub </p>
<p></p>
<p>　　Private Sub objWinSock_Error(ByVal Number As Integer, Description As String, _ </p>
<p></p>
<p>　　ByVal Scode As Long, ByVal Source As String, ByVal HelpFile As String, _</p>
<p></p>
<p>　　ByVal HelpContext As Long, CancelDisplay As Boolean)</p>
<p></p>
<p>　　Err.Raise vbObjectError, "Error", "Winsock Error: " & Number &</p>
<p></p>
<p>　　vbCrLf & Description</p>
<p></p>
<p>　　CancelDisplay = True</p>
<p></p>
<p>　　End Sub 編譯該組件，然后按照下面的步驟注冊該組件</p>
<p></p>
<p>　　C:\net stop iisadmin /y</p>
<p></p>
<p>　　C:\mtxstop編譯成Active Dll</p>
<p></p>
<p>　　C:\net start w3svc在ASP中調用這個組件</p>
<p></p>
<p>　　$#@60;%@ Language=VBScript %$#@62;</p>
<p></p>
<p>　　$#@60;HTML$#@62;</p>
<p></p>
<p>　　$#@60;HEAD$#@62;</p>
<p></p>
<p>　　$#@60;META NAME="GENERATOR" Content="Microsoft Visual Studio 6.0"$#@62;</p>
<p></p>
<p>　　$#@60;/HEAD$#@62;</p>
<p></p>
<p>　　$#@60;BODY$#@62;</p>
<p></p>
<p>　　$#@60;%</p>
<p></p>
<p>　　Dim obj</p>
<p></p>
<p>　　Set obj = Server.CreateObject("aspHttp.http")</p>
<p></p>
<p>　　Response.Write obj.httpGet("http://www.chinaasp.com.cn")</p>
<p></p>
<p>　　%$#@62;</p>
<p></p>
<p>　　$#@60;/BODY$#@62;</p>
<p></p>
<p>　　$#@60;/HTML$#@62;  </p>