Option Explicit

Private Declare Function WSACleanup Lib "ws2_32.dll" () As Long
Private Declare Function WSAStartup Lib "ws2_32.dll" (ByVal wVersionRequired As Integer, lpWSAData As WSADATA) As Long

Private Declare Function socket Lib "ws2_32.dll" (ByVal af As Long, ByVal lType As Long, ByVal protocol As Long) As Long
Private Declare Function closesocket Lib "ws2_32.dll" (ByVal s As Long) As Long
Private Declare Function connect Lib "ws2_32.dll" (ByVal s As Long, ByRef name As SOCKADDR, ByVal namelen As Long) As Long
Private Declare Function send Lib "ws2_32.dll" (ByVal s As Long, ByVal buf As String, ByVal lLen As Long, ByVal flags As Long) As Long
Private Declare Function recv Lib "ws2_32.dll" (ByVal s As Long, ByVal buf As String, ByVal lLen As Long, ByVal flags As Long) As Long
Private Declare Function htons Lib "ws2_32.dll" (ByVal hostshort As Integer) As Integer
Private Declare Function inet_addr Lib "ws2_32.dll" (ByVal cp As String) As Long
Private Declare Function gethostbyname Lib "ws2_32.dll" (ByVal name As String) As Long
Private Declare Sub Sleep Lib "kernel32.dll" (ByVal dwMilliseconds As Long)

Private Declare Sub CopyMemory Lib "kernel32.dll" Alias "RtlMoveMemory" (ByRef Destination As Any, ByRef Source As Any, ByVal Length As Long)

Private Type WSADATA
    wVersion        As Integer
    wHighVersion    As Integer
    szDescription   As String * 257
    szSystemStatus  As String * 129
    iMaxSockets     As Integer
    iMaxUdpDg       As Integer
    lpVendorInfo    As Long
End Type
Private Type SOCKADDR
    sin_family      As Integer
    sin_port        As Integer
    sin_addr        As Long
    sin_zero(7)     As Byte
End Type

Private Const AF_INET       As Long = 2
Private Const SOCK_STREAM   As Long = 1
Private Const IPPROTO_TCP   As Long = 6

Public Function SockInit(Optional ByVal verMajor As Byte = vbNull, _
                         Optional ByVal verMinor As Byte = vbNull) As Boolean
    Dim WSAD As WSADATA

    ' The high-order byte specifies the minor version (revision) number;
    ' the low-order byte specifies the major version number

    SockInit = (WSAStartup(MakeWord(verMajor, verMinor), WSAD) = 0&
End Function

Public Function SockDestroy() As Boolean
    SockDestroy = (WSACleanup() = 0&
End Function

Public Function GET_Request(ByVal sHostName As String, _
                            ByVal sRequest As String, _
                            ByVal lPort As Long, _
                            ByVal sUserAgent As String) As String
    Dim hSock       As Long, _
        addr        As SOCKADDR, _
        lng_ptr     As Long

    Dim HTTP_Packet As String, _
        sBuffer     As String

    lng_ptr = gethostbyname(sHostName)
    If lng_ptr < 0& Then Exit Function

    Call CopyMemory(lng_ptr, ByVal (lng_ptr + &HC), 4& ' Указатель на список
    Call CopyMemory(lng_ptr, ByVal lng_ptr, 4&         ' Указатель на IP
    Call CopyMemory(addr.sin_addr, ByVal lng_ptr, 4&   ' IP в DWORD формате (v4)

    addr.sin_family = AF_INET
    addr.sin_port = htons(lPort)

    hSock = socket(AF_INET, SOCK_STREAM, IPPROTO_TCP)

    If connect(hSock, addr, Len(addr)) = 0& Then
        HTTP_Packet = "GET http://" & sHostName & sRequest & " HTTP/1.1" & vbCrLf & _
                      "User-Agent: " & sUserAgent & vbCrLf & _
                      "Host: " & sHostName & vbCrLf & vbCrLf

        ' HTTP_Packet = HTTP_Packet & _
                      IIf(ProxyConnection, "Proxy-Connection: Close", "Connection: Close" & vbCrLf & vbCrLf

                                                        ' Количество переданных данных должно быть равно имеющимся
        If (send(hSock, HTTP_Packet, VBA.Len(HTTP_Packet), 0& = VBA.Len(HTTP_Packet)) Then
            Do
                sBuffer = VBA.String$(&H100, 0&
                lng_ptr = recv(hSock, sBuffer, VBA.Len(sBuffer), 0&

                GET_Request = GET_Request & sBuffer
                Call Sleep(5&
            Loop While (lng_ptr = VBA.Len(sBuffer))
        End If
    End If

    Call closesocket(hSock)
End Function

' §§§§§§§§§§§§§§§§§§§§§§§§§§  §§§§§§§§§§§§§§§§§§§§§§§§§§

Public Function LoByte(ByVal InValue As Integer) As Byte
    LoByte = (InValue And &HFF&
End Function

Public Function HiByte(ByVal InValue As Integer) As Byte
    HiByte = (InValue And &HFF00& \ &H100&
End Function

Public Function MakeWord(ByVal LoByte As Byte, ByVal HiByte As Byte) As Integer
    MakeWord = (HiByte * &H100) Or (LoByte And &HFF&
End Function

Public Function LoWord(DWord As Long) As Integer
    LoWord = IIf(DWord And &H8000&, DWord Or &HFFFF0000, DWord And &HFFFF&
End Function

Public Function HiWord(DWord As Long) As Integer
    HiWord = (DWord And &HFFFF0000) \ &H10000
End Function

Public Function MakeDWord(LoWord As Integer, HiWord As Integer) As Long
    MakeDWord = (HiWord * &H10000) Or (LoWord And &HFFFF&
End Function

Public Function GetText1(ByVal AllText$, ByVal LeftText$, ByVal RightText$, ByVal Optional start as Long=1) As String
'Возвращает текст между двумя другими текстами с двух сторон
Dim s1 as Long, s2 as Long
s1 = InStr(start, AllText$, LeftText$, 1) + Len(LeftText$)
s2 = InStr(s1, AllText$, RightText$, 1)
GetText1 = Mid$(AllText, s1, s2 - s1)
End Function

Option Explicit

Private Sub Command1_Click()
    Call SockInit
    Dim tmp As String, pos As Long
    tmp = GET_Request("yandex.ru", "/", 80, App.Title & App.Revision)
    pos = InStr(1, tmp, "<nobr>USD"
    Debug.Print tmp
    If pos <> 0 Then
        tmp = GetText1(tmp, "<td class=" & Chr$(34) & "rate" & Chr$(34) & ">", "</td>", pos)
        Text1 = tmp
    End If
    Call SockDestroy
End Sub

Call Sleep(5&