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

[1] [2] 下一页

	输入您的搜索字词 提交搜索表单
	军旅同心论坛 军旅同心博客 军旅同心网