Получение ответа от вебсервера через XmlHttpRequest на FreeBASIC

#ifndef unicode
#define unicode
#endif
 
#include once "windows.bi"
#include once "win\objbase.bi"

' Имя объекта из реестра
CONST ProgID_XmlHttpRequest = "Microsoft.XmlHttp"
' Имя сайта, с которого нужно получить ответ
CONST HttpUrl = "https://www.cyberforum.ru/"
' Метод доступа к сайту
CONST HttpMethod = "GET"
' Пустая строка
CONST EmptyWString = ""

DIM varFalse AS VARIANT = ANY
With varFalse
    .vt = VT_BOOL
    .boolVal = VARIANT_FALSE
END With
 
DIM varEmptyBSTR AS VARIANT = ANY
With varEmptyBSTR
    .vt = VT_BSTR
    .bstrVal = SysAllocString(@EmptyWString)
END With
 
DIM bstrMethod AS BSTR = SysAllocString(@HttpMethod)
DIM bstrUrl AS BSTR = SysAllocString(@HttpUrl)

IF CoInitialize(0) <> S_OK THEN
    PRINT "Не могу инициализировать COM"
    END(0)
END IF

DIM idclsidXmlHttpRequest AS CLSID
DIM hr AS HRESULT = CLSIDFromProgID(@ProgID_XmlHttpRequest, @idclsidXmlHttpRequest)
 
IF FAILED(hr) THEN
    PRINT "Не могу разрешить CLSID по ProgID", Hex(hr)
    END(1)
END IF

DIM pClassFactory AS IClassFactory Ptr = NULL
hr = CoGetClassObject(@idclsidXmlHttpRequest, CLSCTX_INPROC, NULL, @IID_IClassFactory, @pClassFactory)
 
IF FAILED(hr) THEN
    PRINT "Ошибка в CoGetClassObject", Hex(hr)
    END(1)
END IF

' Наш указатель на интерфейс
DIM pRequest AS IXMLHttpRequest Ptr = NULL
 
hr = pClassFactory->lpVtbl->CreateInstance(pClassFactory, NULL, @IID_IXmlHttpRequest, @pRequest)
IF FAILED(hr) THEN
    PRINT "Не могу создать XmlHttpRequest", Hex(hr)
ELSE
    
    Scope
        ' Метод Open подготавливает соединение с сайтом
        hr = pRequest->lpVtbl->OPEN(pRequest, bstrMethod, bstrUrl, varFalse, varEmptyBSTR, varEmptyBSTR)
        IF FAILED(hr) THEN
            PRINT "Не могу запустить метод Open из XmlHttpRequest", Hex(hr)
        END IF
        
        ' Метод Send отправляет запрос на сервер
        hr = pRequest->lpVtbl->Send(pRequest, varSendFileDataBSTR)
        IF FAILED(hr) THEN
            PRINT "Не могу запустить метод Send из XmlHttpRequest", Hex(hr)
        END IF
    END Scope
    
    Scope
        ' Получаем код ответа от сервера
        DIM StatusCode AS LONG
        hr = pRequest->lpVtbl->get_status(pRequest, @StatusCode)
        IF FAILED(hr) THEN
            PRINT "Не могу получить get_status из XmlHttpRequest", Hex(hr)
        ELSE
            PRINT "Код состояния", StatusCode
        END IF
    END Scope
    
    Scope
        ' Показываем все заголовки ответа
        DIM bstrHeaders AS BSTR
        hr = pRequest->lpVtbl->getAllResponseHeaders(pRequest, @bstrHeaders)
        IF FAILED(hr) THEN
            PRINT "Не могу получить getAllResponseHeaders из XmlHttpRequest", Hex(hr)
        ELSE
            IF bstrHeaders <> 0 THEN
                DIM HeadersValue AS WString Ptr = @bstrHeaders[0]
                PRINT "Заголовки ответа"
                PRINT *HeadersValue
                SysFreeString(bstrHeaders)
            END IF
        END IF
    END Scope
    
    Scope
        ' Показываем весь текст ответа
        DIM bstrResponseText AS BSTR
        hr = pRequest->lpVtbl->get_responseText(pRequest, @bstrResponseText)
        IF FAILED(hr) THEN
            PRINT "Не могу получить get_responseText из XmlHttpRequest", Hex(hr)
        ELSE
            IF bstrResponseText <> 0 THEN
                DIM ResponseText AS WString Ptr = @bstrResponseText[0]
                PRINT "Текст ответа"
                PRINT *ResponseText
                SysFreeString(bstrResponseText)
            END IF
        END IF
    END Scope
    
    ' Уничтожение объекта, он больше не нужен
    pRequest->lpVtbl->Release(pRequest)
END IF
 
' Уничтожение фабрики классов, она больше не нужна
pClassFactory->lpVtbl->Release(pClassFactory)
 
' Очистка среды COM
CoUninitialize()

VariantClear(@varEmptyBSTR)
VariantClear(@varFalse)
SysFreeString(bstrUrl)
SysFreeString(bstrMethod)