如何用Winsock提http请求，并得到HTML代码？

Question

你看看这篇文章能用吗？Winsock Terminal示例程序 请注意如果你是用VB6，在装载此工程之前，请先安装ThreeD32.OCX。该文件可在VB6的安装盘中的common\tools\vb\controls目录中找到，同时在这个目录中还有一个Vbctrl.reg文件。将这两个文件拷贝到windows\system目录下，用regsvr32注册后，运行Vbctrl已获取该控件的设计许可证。另外还要注意的是，源程序的注释部分很多是乱码，至少在我的机上如此。不过不影响程序运行。本示例程序允许你通过选择通信协议同远程服务器连接。通过该程序你可以使用几乎所有的Internet服务，例如收发电子邮件，FTP等。一旦建立连接后，你就可以向服务器发送命令并接收来自服务器的回应了。该程序的工作方式有点象DOS操作。本程序并不是一个有完全功能的程序，因此它对最终用户来讲一点用也没有。它的目的是让你明白网络协议的基本原则，一旦你了解了两台计算机是如何通过Internet连接的话，对于快速开发Internet程序来说唯一的障碍就是缺乏足够的VB编程知识了。其实Internet编程最核心的东西就是字符串的处理。无论你选择哪种网络协议实际上都是在收发字符串。下图是本程序的工作界面。 Winsock Terminal是一个小巧且易于明白的应用程序。我们可以把我们要做的事分为六步： 用户界面开发。 
建立同远程计算机的联系 
编写代码，处理接收到消息 
编写代码，处理用户输入的命令并发送给远程计算机 
关闭与远程计算机的连接 
开发服务子程序 
用户界面开发本程序用到两个窗体，除上面你所见到的外，还有一个名为frmConnect的窗体，如下图。用户可在该窗体中输入服务器的地址并选择所需的网络协议。程序的主窗体（如上图）包含三个部份：工具栏、状态栏和工作区。前两个分别用到了ToolBar和StatusBar这两个控件，而工作区则是由一文本框控件组成的。当同远程计算机建立了连接后，工具栏的右边会显示发出及接收的字节数。状态栏中显示的信息表明Winsock控件当前的工作情况。另外为了能使工作区的大小随窗体大小的改变而改变，我们须将下面的代码放在窗体的Resize事件中。Private Sub Form_Resize()On Error Resume NextWith Me
    txtCommand.Move .ScaleLeft, _
      .ScaleTop + ToolBar.Height, _
      .ScaleWidth, .ScaleHeight - _
       ToolBar.Height - StatusBar.Height
End WithEnd Sub 
建立与服务器的连接为建立与服务器的连接，用户必须首先单击“连接”按钮，此时会弹出一个“连接到...”对话框。在远程服务器地址栏中输入要连接的服务器的地址，并选择网络协议（换句话说你是在选择要连接的端口）。该窗体另外还定义了两个属性，一个是port属性，另一个是RemoteHost属性，这两个属性用来接收你在文本框中输入的端口及服务器地址，并传递给Winsock控件。将下面的代码放在主窗体的“连接”按钮的Click事件中。 Private Sub cmdConnect_Click() Dim frm As New frmConnect frm.Show vbModal If cmdConnect.Tag = "Connect" Then If Not wsCommand.State = sckClosed Then 
wsCommand.Close Do Until wsCommand.State = sckClosed 
DoEvents 
Loop End If StatusBar.Caption = "" wsCommand.Connect frm.RemoteHost, frm.Port End If End Sub 显示服务器的回应 当你按下“连接”按钮，可能会出现两种情况：一种是由于连接不成功而返回错误事件（你可在Winsock控件的帮助文件中查到这些错误事件）；另一种是连接成功而返回一个Connect事件。如果连接成功，服务器会返回欢迎消息，从而触发DataArrival事件。下面的代码被放在该事件中： Private Sub wsCommand_DataArrival(ByVal bytesTotal As Long) Dim strData As String With StatusBar 
.ForeColor = vbBlack 
.Caption = "wsCommand : DataArrival ("& bytesTotal & " bytes)" 
End With lBytesRes = lBytesRes + bytesTotal ToolBar.Caption = "Received: " & lBytesRes & " Sent: " & lBytesSent & " " wsCommand.GetData strData With txtCommand 
.SetFocus 
.Text = .Text & strData 
.SelStart = Len(.Text) 
End With If Left(strData, 3) = "227" Then 
MakeDataConnection strData 
ElseIf Left(strData, 3) = "354" Then 
bMailData = True 
End If End Sub 每次当Winsock控件从远程服务器接收到数据时都会触发DataArrival事件。通过Winsock的GetData方法，我们可以提取这些数据，并将这些数据放在变量strData中。然后我们将这些收到的数据放进文本框中。.SelStart = Len(.Text)语句的作用是使光标跳到文本框中文本的结束处。 输入命令 我只有一个文本框来接收你想要发送的命令，同时这个文本框还担负着显示由服务器传来的信息。那么程序如何知道它就将哪一行文本看作是你输入的命令而发送给服务器呢？本程序通过在文本框的KeyPress事件中建立一个“缓冲”的方法来实现。这个“缓冲”实际上是在Keypress事件中的静态变量，当你敲击键盘时，你所输入的字符就被储存在这个静态变量中，当你按下回车发送命令时，程序将该变量的值清空。下面是程序代码： Private Sub txtCommand_KeyPress(KeyAscii As Integer) Static strBuffer As String On Error Resume Next If KeyAscii = 8 Then '捕获BackSpace键
strBuffer = Left$(strBuffer, _ Len(strBuffer) - 1) 
Else strBuffer = strBuffer & Chr$(KeyAscii) 
End If If KeyAscii = 13 Then '当按下回车键后发送命令。注意必须在命令后加上vbCrLf，否则服务器无法识别你所发出的命令
wsCommand.SendData strBuffer & vbCrLf 
strBuffer = "" 
End If End Sub 如果你按了方向键，程序将忽略它们，下面的代码轻松地解决了这个问题。 Private Sub txtCommand_KeyDown(KeyCode As Integer, Shift As Integer) If KeyCode > 36 And KeyCode < 41 Then 
KeyCode = 0 
End If End Sub 下面的代码使你在文本框中点击鼠标的动作无效，免得你到处乱输东西 Private Sub txtCommand_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single) txtCommand.SelStart = Len(txtCommand.Text) End Sub 断开与服务器的连接 如果你想关闭本程序或新建立一个连接，你必须断开当前的连接。为达到这一目的，你必须向服务器发送一个QUIT命令，或者调用Winsock的Close方法。同时有必要等待这一命令完成后再退出程序。通过Winsock的State属性，我们可以知道这一命令是否已经执行完毕。当Winsock的State属性等于sckClosed时，就表示socket已关闭了。这时就可以放心大胆地退出程序了。 Private Sub cmdClose_Click() If Not wsCommand.State = sckClosed 
Then wsCommand.Close 
Do Until wsCommand.State = sckClosed 
DoEvents
Loop 
End If Unload Me End Sub 开发服务子程序 为了跟踪Winsock的事件，在每一个子程序中都有一小段代码，用来在状态栏中写入各种消息。这样我们就能迅速知道结果以及Winsock事件产生的原因。该控件只有7个事件，所以不需要花太多的时间来写这些代码。“另存为”按钮中的代码是用来保存整个过程的，请注意，文本框最多允许32K的数据。不过清除按钮，你可以清空整个文本框。 

Answer 1

这个例子可以得到www.microsoft.com HTML代码
'放一个TextBox
'-> (Name)=Text1
'-> MultiLine=True
'in a form
Private Sub Form_Load()
    Dim sSave As String
    Me.AutoRedraw = True
    Set Obj = Me.Text1
    'Start subclassing
    HookForm Me
    'create a new winsock session
    StartWinsock sSave
    'show the winsock version on this form
    If InStr(1, sSave, Chr$(0)) > 0 Then sSave = Left$(sSave, InStr(1, sSave, Chr$(0)) - 1)
    Me.Print sSave
    'connect to Microsoft.com
    lSocket = ConnectSock("www.microsoft.com", 80, 0, Me.hwnd, False)
End Sub
Private Sub Form_Unload(Cancel As Integer)
    'close our connection to microsoft.com
    closesocket lSocket
    'end winsock session
    EndWinsock
    'stop subclassing
    UnHookForm Me
End Sub
'in a module
Public Const AF_INET = 2
Public Const INVALID_SOCKET = -1
Public Const SOCKET_ERROR = -1
Public Const FD_READ = &H1&
Public Const FD_WRITE = &H2&
Public Const FD_CONNECT = &H10&
Public Const FD_CLOSE = &H20&
Public Const PF_INET = 2
Public Const SOCK_STREAM = 1
Public Const IPPROTO_TCP = 6
Public Const GWL_WNDPROC = (-4)
Public Const WINSOCKMSG = 1025
Public Const WSA_DESCRIPTIONLEN = 256
Public Const WSA_DescriptionSize = WSA_DESCRIPTIONLEN + 1
Public Const WSA_SYS_STATUS_LEN = 128
Public Const WSA_SysStatusSize = WSA_SYS_STATUS_LEN + 1
Public Const INADDR_NONE = &HFFFF
Public Const SOL_SOCKET = &HFFFF&
Public Const SO_LINGER = &H80&
Public Const hostent_size = 16
Public Const sockaddr_size = 16
Type WSADataType
    wVersion As Integer
    wHighVersion As Integer
    szDescription As String * WSA_DescriptionSize
    szSystemStatus As String * WSA_SysStatusSize
    iMaxSockets As Integer
    iMaxUdpDg As Integer
    lpVendorInfo As Long
End Type
Type HostEnt
    h_name As Long
    h_aliases As Long
    h_addrtype As Integer
    h_length As Integer
    h_addr_list As Long
End Type
Type sockaddr
    sin_family As Integer
    sin_port As Integer
    sin_addr As Long
    sin_zero As String * 8
End Type
Type LingerType
    l_onoff As Integer
    l_linger As Integer
End Type
Public Declare Function setsockopt Lib "wsock32.dll" (ByVal s As Long, ByVal Level As Long, ByVal optname As Long, optval As Any, ByVal optlen As Long) As Long
Public Declare Function getsockopt Lib "wsock32.dll" (ByVal s As Long, ByVal Level As Long, ByVal optname As Long, optval As Any, optlen As Long) As Long
Public Declare Function WSAGetLastError Lib "wsock32.dll" () As Long
Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal hwnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Public Declare Function WSAIsBlocking Lib "wsock32.dll" () As Long
Public Declare Function WSACleanup Lib "wsock32.dll" () As Long
Public Declare Function Send Lib "wsock32.dll" Alias "send" (ByVal s As Long, buf As Any, ByVal buflen As Long, ByVal flags As Long) As Long
Public Declare Function recv Lib "wsock32.dll" (ByVal s As Long, buf As Any, ByVal buflen As Long, ByVal flags As Long) As Long
Public Declare Function WSAStartup Lib "wsock32.dll" (ByVal wVR As Long, lpWSAD As WSADataType) As Long
Public Declare Function htons Lib "wsock32.dll" (ByVal hostshort As Long) As Integer
Public Declare Function ntohs Lib "wsock32.dll" (ByVal netshort As Long) As Integer
Public Declare Function socket Lib "wsock32.dll" (ByVal af As Long, ByVal s_type As Long, ByVal protocol As Long) As Long
Public Declare Function closesocket Lib "wsock32.dll" (ByVal s As Long) As Long
Public Declare Function Connect Lib "wsock32.dll" Alias "connect" (ByVal s As Long, addr As sockaddr, ByVal namelen As Long) As Long
Public Declare Function WSAAsyncSelect Lib "wsock32.dll" (ByVal s As Long, ByVal hwnd As Long, ByVal wMsg As Long, ByVal lEvent As Long) As Long
Public Declare Function inet_addr Lib "wsock32.dll" (ByVal cp As String) As Long
Public Declare Function gethostbyname Lib "wsock32.dll" (ByVal host_name As String) As Long
Public Declare Sub MemCopy Lib "kernel32" Alias "RtlMoveMemory" (Dest As Any, Src As Any, ByVal cb&)
Public Declare Function inet_ntoa Lib "wsock32.dll" (ByVal inn As Long) As Long
Public Declare Function lstrlen Lib "kernel32" Alias "lstrlenA" (ByVal lpString As Any) As Long
Public Declare Function WSACancelBlockingCall Lib "wsock32.dll" () As Long
Public saZero As sockaddr
Public WSAStartedUp As Boolean, Obj As TextBox
Public PrevProc As Long, lSocket As Long
'subclassing functions
'for more information about subclassing,
'check out the subclassing tutorial at http://www.allapi.net/
Public Sub HookForm(F As Form)
    PrevProc = SetWindowLong(F.hwnd, GWL_WNDPROC, AddressOf WindowProc)
End Sub
Public Sub UnHookForm(F As Form)
    If PrevProc <> 0 Then
        SetWindowLong F.hwnd, GWL_WNDPROC, PrevProc
        PrevProc = 0
    End If
End Sub
Public Function WindowProc(ByVal hwnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
    If uMsg = WINSOCKMSG Then
        ProcessMessage wParam, lParam
    Else
        WindowProc = CallWindowProc(PrevProc, hwnd, uMsg, wParam, lParam)
    End If
End Function
'our Winsock-message handler
Public Sub ProcessMessage(ByVal lFromSocket As Long, ByVal lParam As Long)
    Dim X As Long, ReadBuffer(1 To 1024) As Byte, strCommand As String
    Select Case lParam
        Case FD_CONNECT 'we are connected to microsoft.com
        Case FD_WRITE 'we can write to our connection
            'this is a part of the HTTP protocol
            'for more information about this protocol, visit http://www.w3c.org/
            strCommand = "GET http://www.microsoft.com/ HTTP/1.0" + vbCrLf
            strcomand = strCommand + "Pragma: no-cache" + vbCrLf
            strCommand = strCommand + "Accept: */*" + vbCrLf
            strCommand = strCommand + "Accept: text/html" + vbCrLf + vbCrLf
            'send the data to our microsoft.com-connection
            SendData lFromSocket, strCommand
        Case FD_READ 'we have data waiting to be processed
            'start reading the data
            Do
                X = recv(lFromSocket, ReadBuffer(1), 1024, 0)
                If X > 0 Then
                    Obj.Text = Obj.Text + Left$(StrConv(ReadBuffer, vbUnicode), X)
                End If
                If X <> 1024 Then Exit Do
            Loop
        Case FD_CLOSE 'the connection with microsoft.com is closed
    End Select
End Sub
'the following functions are standard WinSock functions
'from the wsksock.bas-file
Public Function StartWinsock(sDescription As String) As Boolean
    Dim StartupData As WSADataType
    If Not WSAStartedUp Then
        If Not WSAStartup(&H101, StartupData) Then
            WSAStartedUp = True
            sDescription = StartupData.szDescription
        Else
            WSAStartedUp = False
        End If
    End If
    StartWinsock = WSAStartedUp
End Function
Sub EndWinsock()
    Dim Ret&
    If WSAIsBlocking() Then
        Ret = WSACancelBlockingCall()
    End If
    Ret = WSACleanup()
    WSAStartedUp = False
End Sub
Public Function SendData(ByVal s&, vMessage As Variant) As Long
    Dim TheMsg() As Byte, sTemp$
    TheMsg = ""
    Select Case VarType(vMessage)
        Case 8209   'byte array
            sTemp = vMessage
            TheMsg = sTemp
        Case 8      'string, if we recieve a string, its assumed we are linemode
            sTemp = StrConv(vMessage, vbFromUnicode)
        Case Else
            sTemp = CStr(vMessage)
            sTemp = StrConv(vMessage, vbFromUnicode)
    End Select
    TheMsg = sTemp
    If UBound(TheMsg) > -1 Then
        SendData = Send(s, TheMsg(0), (UBound(TheMsg) - LBound(TheMsg) + 1), 0)
    End If
End Function
Function ConnectSock(ByVal Host$, ByVal Port&, retIpPort$, ByVal HWndToMsg&, ByVal Async%) As Long
    Dim s&, SelectOps&, Dummy&
    Dim sockin As sockaddr
    SockReadBuffer$ = ""
    sockin = saZero
    sockin.sin_family = AF_INET
    sockin.sin_port = htons(Port)
    If sockin.sin_port = INVALID_SOCKET Then
        ConnectSock = INVALID_SOCKET
        Exit Function
    End If    sockin.sin_addr = GetHostByNameAlias(Host$)    If sockin.sin_addr = INADDR_NONE Then
        ConnectSock = INVALID_SOCKET
        Exit Function
    End If
    retIpPort$ = getascip$(sockin.sin_addr) & ":" & ntohs(sockin.sin_port)    s = socket(PF_INET, SOCK_STREAM, IPPROTO_TCP)
    If s < 0 Then
        ConnectSock = INVALID_SOCKET
        Exit Function
    End If
    If SetSockLinger(s, 1, 0) = SOCKET_ERROR Then
        If s > 0 Then
            Dummy = closesocket(s)
        End If
        ConnectSock = INVALID_SOCKET
        Exit Function
    End If
    If Not Async Then
        If Connect(s, sockin, sockaddr_size) <> 0 Then
            If s > 0 Then
                Dummy = closesocket(s)
            End If
            ConnectSock = INVALID_SOCKET
            Exit Function
        End If
        SelectOps = FD_READ Or FD_WRITE Or FD_CONNECT Or FD_CLOSE
        If WSAAsyncSelect(s, HWndToMsg, ByVal 1025, ByVal SelectOps) Then
            If s > 0 Then
                Dummy = closesocket(s)
            End If
            ConnectSock = INVALID_SOCKET
            Exit Function
        End If
    Else
        SelectOps = FD_READ Or FD_WRITE Or FD_CONNECT Or FD_CLOSE
        If WSAAsyncSelect(s, HWndToMsg, ByVal 1025, ByVal SelectOps) Then
            If s > 0 Then
                Dummy = closesocket(s)
            End If
            ConnectSock = INVALID_SOCKET
            Exit Function
        End If
        If Connect(s, sockin, sockaddr_size) <> -1 Then
            If s > 0 Then
                Dummy = closesocket(s)
            End If
            ConnectSock = INVALID_SOCKET
            Exit Function
        End If
    End If
    ConnectSock = s
End Function
Function GetHostByNameAlias(ByVal hostname$) As Long
    On Error Resume Next
    Dim phe&
    Dim heDestHost As HostEnt
    Dim addrList&
    Dim retIP&
    retIP = inet_addr(hostname)
    If retIP = INADDR_NONE Then
        phe = gethostbyname(hostname)
        If phe <> 0 Then
            MemCopy heDestHost, ByVal phe, hostent_size
            MemCopy addrList, ByVal heDestHost.h_addr_list, 4
            MemCopy retIP, ByVal addrList, heDestHost.h_length
        Else
            retIP = INADDR_NONE
        End If
    End If
    GetHostByNameAlias = retIP
    If Err Then GetHostByNameAlias = INADDR_NONE
End Function
Function getascip(ByVal inn As Long) As String
    On Error Resume Next
    Dim lpStr&
    Dim nStr&
    Dim retString$
    retString = String(32, 0)
    lpStr = inet_ntoa(inn)
    If lpStr = 0 Then
        getascip = "255.255.255.255"
        Exit Function
    End If
    nStr = lstrlen(lpStr)
    If nStr > 32 Then nStr = 32
    MemCopy ByVal retString, ByVal lpStr, nStr
    retString = Left(retString, nStr)
    getascip = retString
    If Err Then getascip = "255.255.255.255"
End Function
Public Function SetSockLinger(ByVal SockNum&, ByVal OnOff%, ByVal LingerTime%) As Long
    Dim Linger As LingerType
    Linger.l_onoff = OnOff
    Linger.l_linger = LingerTime
    If setsockopt(SockNum, SOL_SOCKET, SO_LINGER, Linger, 4) Then
        Debug.Print "Error setting linger info: " & WSAGetLastError()
        SetSockLinger = SOCKET_ERROR
    Else
        If getsockopt(SockNum, SOL_SOCKET, SO_LINGER, Linger, 4) Then
            Debug.Print "Error getting linger info: " & WSAGetLastError()
            SetSockLinger = SOCKET_ERROR
        End If
    End If
End Function