vb6通send和recv请求网络资源

最近为了弄清楚send和recv的用法，特意用vb6测试了一下，头文件冗余的比较多：

Option Explicit

Private 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
Private 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
Private Declare Function WSAGetLastError Lib "wsock32.dll" () As Long
Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private 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
Private Declare Function WSAIsBlocking Lib "wsock32.dll" () As Long
Private Declare Function WSACleanup Lib "wsock32.dll" () As Long
Private 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
Private Declare Function recv Lib "wsock32.dll" (ByVal s As Long, buf As Any, ByVal buflen As Long, ByVal flags As Long) As Long
Private Declare Function WSAStartup Lib "wsock32.dll" (ByVal wVR As Long, lpWSAD As WSADataType) As Long
Private Declare Function htons Lib "wsock32.dll" (ByVal hostshort As Long) As Integer
Private Declare Function ntohs Lib "wsock32.dll" (ByVal netshort As Long) As Integer
Private Declare Function socket Lib "wsock32.dll" (ByVal af As Long, ByVal s_type As Long, ByVal protocol As Long) As Long
Private Declare Function closesocket Lib "wsock32.dll" (ByVal s As Long) As Long
Private Declare Function Connect Lib "wsock32.dll" Alias "connect" (ByVal s As Long, addr As sockaddr, ByVal namelen As Long) As Long
Private Declare Function WSAAsyncSelect Lib "wsock32.dll" (ByVal s As Long, ByVal hwnd As Long, ByVal wMsg As Long, ByVal lEvent As Long) As Long
Private Declare Function inet_addr Lib "wsock32.dll" (ByVal cp As String) As Long
Private Declare Function gethostbyname Lib "wsock32.dll" (ByVal host_name As String) As Long
Private Declare Sub MemCopy Lib "kernel32" Alias "RtlMoveMemory" (Dest As Any, Src As Any, ByVal cb&)
Private Declare Function inet_ntoa Lib "wsock32.dll" (ByVal inn As Long) As Long
Private Declare Function lstrlen Lib "kernel32" Alias "lstrlenA" (ByVal lpString As Any) As Long
Private Declare Function WSACancelBlockingCall Lib "wsock32.dll" () As Long

Private Const AF_INET = 2
Private Const INVALID_SOCKET = -1
Private Const SOCKET_ERROR = -1
Private Const FD_READ = &H1&
Private Const FD_WRITE = &H2&
Private Const FD_CONNECT = &H10&
Private Const FD_CLOSE = &H20&
Private Const PF_INET = 2
Private Const SOCK_STREAM = 1
Private Const IPPROTO_TCP = 6
Private Const GWL_WNDPROC = (-4)
Private Const WINSOCKMSG = 1025
Private Const WSA_DESCRIPTIONLEN = 256
Private Const WSA_DescriptionSize = WSA_DESCRIPTIONLEN + 1
Private Const WSA_SYS_STATUS_LEN = 128
Private Const WSA_SysStatusSize = WSA_SYS_STATUS_LEN + 1
Private Const INADDR_NONE = &HFFFF
Private Const SOL_SOCKET = &HFFFF&
Private Const SO_LINGER = &H80&
Private Const hostent_size = 16
Private Const sockaddr_size = 16
Private Const WSAECONNRESET = 10054&

Private 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

Private Type sockaddr
    sin_family As Integer
    sin_port As Integer
    sin_addr As Long
    sin_zero As String * 8
End Type

Private Type LingerType
    l_onoff As Integer
    l_linger As Integer
End Type

Private 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

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 GetRequestPath(ByVal url As String) As String
    Dim host As String
    host = GetHostByNameAlias(url)
End Function

Private Sub btnGO_Click()
    If Trim(txtURL.Text) = "" Then
        Exit Sub
    End If
    
    Dim hostName As String
    hostName = Mid(txtURL.Text, 8)
    
    Dim StartupData As WSADataType
    If WSAStartup(&H101, StartupData) <> 0 Then
        Exit Sub
    End If
    
    Dim sck As Long
    sck = socket(PF_INET, SOCK_STREAM, IPPROTO_TCP)
    If sck < 0 Then
        WSACleanup
        Exit Sub
    End If

    Dim sckAddr As sockaddr
    sckAddr.sin_family = AF_INET
    sckAddr.sin_addr = GetHostByNameAlias(hostName)
    sckAddr.sin_port = htons(80)
    
    If Connect(sck, sckAddr, sockaddr_size) <> 0 Then
        If sck > 0 Then
            closesocket (sck)
        End If
        WSACleanup
        Exit Sub
    End If
    

    Dim bytesSent As Long
    Dim bytesRecv As Long
    Dim sendbuf() As Byte
    Dim recvbuf() As Byte
    Dim result  As String
    
    bytesRecv = 1
    sendbuf = "GET / HTTP/1.1" & vbCrLf _
        & "HOST:" & hostName & vbCrLf _
        & "Connection:Close" & vbCrLf _
        & "Accept:text/html,application/xhtml+xml,application/xml;q=0.9,*/*;q=0.8" & vbCrLf _
        & "Accept-Language:zh-cn,zh;q=0.8,en-us;q=0.5,en;q=0.3" & vbCrLf _
        & "User-Agent:Mozilla/5.0 (Windows NT 6.1; rv:18.0) Gecko/20100101 Firefox/18.0" & vbCrLf & vbCrLf
    sendbuf = StrConv(sendbuf, vbFromUnicode)

    bytesSent = Send(sck, sendbuf(0), UBound(sendbuf) + 1, 0)
    Debug.Print (bytesSent & "字节已发送")
    
    Do While (bytesRecv > 0)
        ReDim recvbuf(1023)
        bytesRecv = recv(sck, recvbuf(0), UBound(recvbuf) + 1, 0)
        Debug.Print (bytesRecv & "字节已接收")
        If (bytesRecv = 0 Or bytesRecv = WSAECONNRESET) Then
            Debug.Print ("连接已关闭")
            Exit Do
        End If
        result = result & StrConv(recvbuf, vbUnicode)
        
        Erase recvbuf
    Loop

    WSACleanup
    
    Debug.Print result
    
End Sub