Option Explicit

'***************************************************************************************
'*                     Написано: 13.01.2005 (Team HomeWork)                            *
'*                           e-mail: sne_pro@mail.ru                                   *
'***************************************************************************************

Private Declare Function GlobalAlloc Lib "kernel32.dll" (ByVal wFlags As Long, ByVal dwBytes As Long) As Long
Private Declare Function GlobalFree Lib "kernel32.dll" (ByVal hMem As Long) As Long

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

Private Declare Function InternetOpen Lib "wininet.dll" Alias "InternetOpenA" (ByVal lpszAgent As String, ByVal dwAccessType As Long, ByVal lpszProxy As String, ByVal lpszProxyBypass As String, ByVal dwFlags As Long) As Long
Private Declare Function InternetConnect Lib "wininet.dll" Alias "InternetConnectA" (ByVal hInternet As Long, ByVal lpszServerName As String, ByVal nServerPort As Long, ByVal lpszUserName As String, ByVal lpszPassword As String, ByVal dwService As Long, ByVal dwFlags As Long, ByVal dwContext As Long) As Long
Private Declare Function InternetSetStatusCallback Lib "wininet.dll" (ByVal hInternet As Long, ByVal lpfnInternetCallback As Long) As Long
Private Declare Function HttpOpenRequest Lib "wininet.dll" Alias "HttpOpenRequestA" (ByVal hConnect As Long, ByVal lpszVerb As String, ByVal lpszObjectName As String, ByVal lpszVersion As String, ByVal lpszReferrer As String, ByVal lplpszAcceptTypes As String, ByVal dwFlags As Long, ByVal dwContext As Long) As Long
Private Declare Function HttpSendRequest Lib "wininet.dll" Alias "HttpSendRequestA" (ByVal hRequest As Long, ByVal lpszHeaders As String, ByVal dwHeadersLength As Long, ByVal lpOptional As Long, ByVal dwOptionalLength As Long) As Long
Private Declare Function InternetReadFile Lib "wininet.dll" (ByVal hFile As Long, ByRef lpBuffer As Any, ByVal dwNumberOfBytesToRead As Long, ByRef lpdwNumberOfBytesRead As Long) As Integer
Private Declare Function InternetCloseHandle Lib "wininet.dll" (ByRef hInternet As Long) As Boolean

Private Type prWinInetContext
    dwExitFlag  As Long
    dwRetCode   As Long
    dwErrCode   As Long
End Type

Private Const GMEM_FIXED                    As Long = &H0
Private Const GMEM_MOVEABLE                 As Long = &H2
Private Const GMEM_ZEROINIT                 As Long = &H40
Private Const GPTR                          As Long = (GMEM_FIXED Or GMEM_ZEROINIT)
Private Const GHND                          As Long = (GMEM_MOVEABLE Or GMEM_ZEROINIT)

Private Const INTERNET_FLAG_ASYNC           As Long = &H10000000
Private Const INTERNET_FLAG_KEEP_CONNECTION As Long = &H400000
Private Const INTERNET_SERVICE_HTTP         As Long = 3
Private Const INTERNET_DEFAULT_HTTP_PORT    As Long = 80

Private Const INTERNET_STATUS_CLOSING_CONNECTION    As Long = 50
Private Const INTERNET_STATUS_CONNECTED_TO_SERVER   As Long = 21
Private Const INTERNET_STATUS_CONNECTING_TO_SERVER  As Long = 20
Private Const INTERNET_STATUS_CONNECTION_CLOSED     As Long = 51
Private Const INTERNET_STATUS_HANDLE_CLOSING        As Long = 70
Private Const INTERNET_STATUS_HANDLE_CREATED        As Long = 60
Private Const INTERNET_STATUS_NAME_RESOLVED         As Long = 11
Private Const INTERNET_STATUS_RECEIVING_RESPONSE    As Long = 40
Private Const INTERNET_STATUS_REDIRECT              As Long = 110
Private Const INTERNET_STATUS_REQUEST_COMPLETE      As Long = 100
Private Const INTERNET_STATUS_REQUEST_SENT          As Long = 31
Private Const INTERNET_STATUS_RESPONSE_RECEIVED     As Long = 41
Private Const INTERNET_STATUS_SENDING_REQUEST       As Long = 30

Private Const szAgent   As String = "VBNet OfflineClient VB6"

Private Const szSvrName As String = "www.vbnet.ru"

Private sOutBuffer  As String
Private szRequest   As String

'--------------------------------------------------------------------------------
' Проект     :  OfflineClient
' Процедура  :  SendRequest
' Описание   :  Собственно, отправка запроса GET через WinInet
' Кем создан :  SNE
' Дата-Время :  13.01.2005-23:25:33
'
' Параметры  :  sServerName - [in]  Имя сервера
'               sRequest    - [in]  Запрос
'               ErrCode     - [out] Ошибка
'--------------------------------------------------------------------------------
Public Function SendRequest(ByVal sRequest As String, _
                   Optional ByRef ErrCode As Long) As String
    Dim hInternet   As Long, _
        hConnect    As Long, _
        hRequest    As Long

    Dim dwContext   As prWinInetContext

    sOutBuffer = vbNullString
    szRequest = sRequest & vbNullChar

    hInternet = InternetOpen(szAgent, 0&, 0&, 0&, INTERNET_FLAG_ASYNC)
    If Not hInternet = 0& Then
                                            ' Ставим CallBack
        Call InternetSetStatusCallback(hInternet, AddressOf InternetCallbackFunc)
                                            ' открываем HTTP сессию
        hConnect = InternetConnect(hInternet, szSvrName, INTERNET_DEFAULT_HTTP_PORT, 0&, 0&, INTERNET_SERVICE_HTTP, 0&, VarPtr(dwContext))
        If Not hConnect = 0& Then
            hRequest = HttpOpenRequest(hConnect, "GET", szRequest, 0&, 0&, 0&, INTERNET_FLAG_KEEP_CONNECTION, VarPtr(dwContext))
            If Not hRequest = 0& Then
                Call HttpSendRequest(hRequest, vbNullString, 0&, 0&, 0&
                                            ' Псевдо-синхронность
                Do Until dwContext.dwExitFlag = vbNull
                    DoEvents
                    Call Sleep(0&
                Loop
                SendRequest = sOutBuffer

                Call InternetCloseHandle(hRequest)
            End If

            Call InternetCloseHandle(hConnect)
        End If
        Call InternetCloseHandle(hInternet)
    End If

    ErrCode = dwContext.dwErrCode
End Function

' §§§§§§§§§§§§§§§§§§§§§§§§§§ CallBack §§§§§§§§§§§§§§§§§§§§§§§§§§

'--------------------------------------------------------------------------------
' Проект     :  OfflineClient
' Процедура  :  InternetCallbackFunc
' Описание   :  Для асинхронного режима в WinInet
' Кем создан :  SNE
' Дата-Время :  13.01.2005-23:34:57
'--------------------------------------------------------------------------------
Private Sub InternetCallbackFunc(ByVal hInternet As Long, ByVal dwContext As Long, _
                                                          ByVal dwInternetStatus As Long, _
                                                          ByVal pbStatusInformation As Long, _
                                                          ByVal dwStatusInformationLength As Long)
    Dim lng         As Long, _
        szTmpBuffer As String * &H100
    Dim stContext   As prWinInetContext

    If Not dwContext = 0& Then Call CopyMemory(stContext, ByVal dwContext, Len(stContext))

    stContext.dwRetCode = dwInternetStatus

    Select Case dwInternetStatus
        Case Is = INTERNET_STATUS_REQUEST_COMPLETE
            Call CopyMemory(lng, ByVal pbStatusInformation + 4&, 4&    ' dwError
            stContext.dwErrCode = lng

            If lng = 0& Then
                Call CopyMemory(lng, ByVal pbStatusInformation, 4&     ' bool value (is suses = true)
                If lng = 1& Then

                    Do Until InternetReadFile(hInternet, ByVal szTmpBuffer, Len(szTmpBuffer), lng) = 0&
                        If lng = 0& Then
                            stContext.dwExitFlag = vbNull
                            Exit Do
                        Else
                            sOutBuffer = sOutBuffer & VBA.Left$(szTmpBuffer, lng)
                        End If
                    Loop
                End If
            End If
    End Select

    If Not dwContext = 0& Then Call CopyMemory(ByVal dwContext, stContext, Len(stContext))
End Sub

hRequest = HttpOpenRequest(hConnect, "GET", szRequest, 0&, 0&, 0&, INTERNET_FLAG_KEEP_CONNECTION, VarPtr(dwContext))

Ты говорил через ocx можно это сделать, плизз напиши....