Dim objHTTP As New MSXML2.XMLHTTP
    With objHTTP
        .open "POST", HOST & "Default.asp?Action=" & Action, False
        .setRequestHeader "Content-Type", "text/html; charset=windows-1251"
        .setRequestHeader "Accept-Language", "ru, en"
        .setRequestHeader "Accept-Charset", "windows-1251;q=1"
        .setRequestHeader "User-Agent", "Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.0)"
        .send s
    End With

Dim s As String
Dim r() As Byte
        r() = Reqest.BinaryRead(Request.TotalBytes)
        s = StrConv(r, vbUnicode)
        Debug.Print s

Public Function Decode(UnicodeString As String) As String
Dim x As Long, y As Long
Dim i As Long, j As Long
Dim b_in() As Byte
Dim b_buff() As Byte
Dim s_out As String
    b_in = StrConv(UnicodeString, vbFromUnicode)
    x =  0 
    i =  1 
    s_out = ""
    While x <= Len(us) -  1 
        If b_in(x) =  208  Or b_in(x) =  209  Then
            s_out = s_out & Mid(us, i, x - i +  1 )
            i = x
            Do While b_in(x) =  208  Or b_in(x) =  209 
                x = x +  2 
                If x > UBound(b_in) Then Exit Do
            Loop
            j = x -  2 
            b_buff = StrConv(Mid(us, i +  1 , j - i +  2 ), vbFromUnicode)
            s_out = s_out & ConvPureUnic(b_buff)
            i = x +  1 
        End If
        x = x +  1 
    Wend
    Decode = s_out & Mid(us, i, x)
    Exit Function
errh:
    Decode = s_out
End Function

Private Function ConvPureUnic(b_in) As String
Dim c1 As Byte, c2 As Byte
Dim b_out() As Byte
Dim x As Long
Dim s As String
    ReDim b_out(UBound(b_in) /  2 )
    For x =  0  To UBound(b_in) Step  2 
        c1 = b_in(x)
        c2 = b_in(x +  1 )
        If c1 =  208  Then
            If c2 =  129  Then
                b_out(x /  2 ) =  168 
            Else
                b_out(x /  2 ) = c2 +  48 
            End If
        Else
            If c2 =  145  Then
                b_out(x /  2 ) =  184 
            Else
                b_out(x /  2 ) = c2 +  112 
            End If
        End If
    Next x
    s = StrConv(b_out, vbUnicode)
    If Asc(Right(s,  1 )) =  0  Then
        ConvPureUnic = Left(s, Len(s) -  1 )
    Else
        ConvPureUnic = s
    End If
End Function