HttpCli1.URL:='http://delphimaster.ru';
 HttpCli1.RcvdStream:=TStringStream.Create('');
 HttpCli1.Get;
 Memo1.Lines.LoadFromStream(HttpCli1.RcvdStream)

unit HTTPClientImpl;

{$Q-}
{$R-}

interface

uses
  Classes, Windows, SysUtils, WinINet;

type
  THTTPClientImpl = class sealed(TObject)

     // == <<public>>

     // Синхронно выполняет запрос.
     public procedure Request(
        const aServerTimeout: Integer; // в секундах
        const aServerAddress: String;
        const aServerPort: Integer;
        const aServerPath: String;
        const aServerUserName: String;
        const aServerPassword: String;
        const aAccessType: Cardinal;
        const aProxyServerAddress: String;
        const aProxyServerPort: Integer;
        const aProxyServerUserName: String;
        const aProxyServerPassword: String;
        const aRequestData: TMemoryStream;
        const aReplyData: TMemoryStream);

     // == <<private>>

     strict private class procedure fRaiseLastWinINetError(
        const aDetails: String = ''); static;
     strict private class procedure fAddHttpHeader(
        const aRequest: HINTERNET; const aValue: String); static;
     strict private const CLRF = #13#10;
  end;

implementation

procedure THTTPClientImpl.Request;
label
  ResendRequest;
const
  cAgent = 'BC_HTTP_CLIENT_V1.1';
var
  kSession, kConnect, kRequest: HINTERNET;
  kBytesRead: Cardinal;
  kReplyStatusCode, kReplyStatusCodeBufferSize,
  kReplyContentLength, kReplyContentLengthBufferSize,
  kHTTPQueryInfoIndex, kBytesAvailable: DWORD;
  kReplyStatusMessage: String;
  kReplyData: TMemoryStream;
  kReplyBuff: packed array of Byte;
  kServerTimeout: DWord;
  kServerPath: String;
  kProxyServerAuthIsSet, kServerAuthIsSet: Boolean;
begin
  kHTTPQueryInfoIndex := 0;

  kSession := nil;
  kConnect := nil;
  kRequest := nil;
  kReplyData := nil;
  try

     case aAccessType of

        INTERNET_OPEN_TYPE_DIRECT:
        begin
           kSession := InternetOpen(
              cAgent,
              INTERNET_OPEN_TYPE_DIRECT,
              '',
              '',
              0);
           if kSession = nil then
              fRaiseLastWinINetError('InternetOpen');
        end;

        INTERNET_OPEN_TYPE_PROXY:
        begin
           kSession := InternetOpen(
              cAgent,
              INTERNET_OPEN_TYPE_PROXY,
              PChar(aProxyServerAddress + ':' + IntToStr(aProxyServerPort)),
              '',
              0);
           if kSession = nil then
              fRaiseLastWinINetError('InternetOpen');
        end;

        INTERNET_OPEN_TYPE_PRECONFIG:
        begin
           kSession := InternetOpen(
              cAgent,
              INTERNET_OPEN_TYPE_PRECONFIG,
              '',
              '',
              0);
           if kSession = nil then
              fRaiseLastWinINetError('InternetOpen');
        end;

        else
           Assert(False);
     end;

     // Установка параметров сессии
     kServerTimeout := aServerTimeout * 1000;

     if not InternetSetOption(kSession, INTERNET_OPTION_CONNECT_TIMEOUT,
        @kServerTimeout, SizeOf(kServerTimeout))
     then
        fRaiseLastWinINetError('InternetSetOption');

     if not InternetSetOption(kSession, INTERNET_OPTION_SEND_TIMEOUT,
        @kServerTimeout, SizeOf(kServerTimeout))
     then
        fRaiseLastWinINetError('InternetSetOption');

     if not InternetSetOption(kSession, INTERNET_OPTION_RECEIVE_TIMEOUT,
        @kServerTimeout, SizeOf(kServerTimeout))
     then
        fRaiseLastWinINetError('InternetSetOption');

     // Попытка соединения с сервером
     kConnect := InternetConnect(
        kSession,
        PChar(Trim(aServerAddress)),
        aServerPort,
        '',
        '',
        INTERNET_SERVICE_HTTP,
        0,
        0);
     if kConnect = nil then
        fRaiseLastWinINetError('InternetConnect');

     // Подготавливаем запрос
     kServerPath := Trim(aServerPath);
     if (Length(kServerPath) > 0) and (kServerPath[1] <> '/') then
        kServerPath := '/' + kServerPath;
     // Добавляем параметр, чтобы заведомо предотвратить кеширование
     kServerPath := kServerPath + '?param=' + IntToStr(Random(MaxInt));
     kRequest := HttpOpenRequest(
        kConnect,
        'POST',
        PChar(kServerPath),
        '',
        '',
        nil,
        INTERNET_FLAG_RELOAD or INTERNET_FLAG_NO_CACHE_WRITE or INTERNET_FLAG_KEEP_CONNECTION,
        0);
     if kRequest = nil then
        fRaiseLastWinINetError('HttpOpenRequest');

     // Добавление заголовков
     fAddHttpHeader(kRequest, 'Pragma: no-cache');
     fAddHttpHeader(kRequest, 'Accept: */*');
     fAddHttpHeader(kRequest, 'Content-Type: application/x-www-form-urlencoded');
     fAddHttpHeader(kRequest, 'Content-Length: ' + IntToStr(aRequestData.Size));
     fAddHttpHeader(kRequest, 'Connection: Keep-Alive');
     // Cтрока важна для работы через прокси.
     // Без этой строки в режиме INTERNET_OPEN_TYPE_PROXY происходит подвисание,
     // причем вроде как со стороны клиента.
     // Видимо причина в том, что рвется соединение.
     fAddHttpHeader(kRequest, 'Proxy-Connection: Keep-Alive');

     // Отправляем запрос

     kServerAuthIsSet := False;
     kProxyServerAuthIsSet := False;

     ResendRequest:

     if not HttpSendRequest(kRequest, nil, 0, aRequestData.Memory, aRequestData.Size) then
        fRaiseLastWinINetError('HttpSendRequest');

     // Получаем status code
     kReplyStatusCodeBufferSize := 4;
     if not HttpQueryInfo(kRequest, HTTP_QUERY_STATUS_CODE or HTTP_QUERY_FLAG_NUMBER,
        @kReplyStatusCode, kReplyStatusCodeBufferSize, kHTTPQueryInfoIndex)
     then
        fRaiseLastWinINetError('HttpQueryInfo');

     // Обработаем известные ошибки сразу
     if kReplyStatusCode = 407 then
     begin
        if kProxyServerAuthIsSet or (aProxyServerUserName = '') then
        begin
           raise Exception.Create(
              'Для доступа к прокси-серверу необходимо задать '+
              'имя пользователя и пароль!');
        end
        else
        begin
           InternetSetOption(
              kRequest,
              INTERNET_OPTION_PROXY_USERNAME,
              PChar(aProxyServerUserName),
              Length(aProxyServerUserName)+1);

           InternetSetOption(
              kRequest,
              INTERNET_OPTION_PROXY_PASSWORD,
              PChar(aProxyServerPassword),
              Length(aProxyServerPassword)+1);

           kProxyServerAuthIsSet := True;

           goto ResendRequest;
        end;
     end;

to be continued

     if kReplyStatusCode = 401 then
     begin
        if kServerAuthIsSet or (aServerUserName = '') then
        begin
           raise Exception.Create(
              'Для доступа к серверу необходимо задать '+
              'имя пользователя и пароль!');
        end
        else
        begin
           InternetSetOption(
              kRequest,
              INTERNET_OPTION_USERNAME,
              PChar(aServerUserName),
              Length(aServerUserName)+1);

           InternetSetOption(
              kRequest,
              INTERNET_OPTION_PASSWORD,
              PChar(aServerPassword),
              Length(aServerPassword)+1);

           kServerAuthIsSet := True;

           goto ResendRequest;
        end;
     end;

     if kReplyStatusCode = 403 then
        raise Exception.Create(
           'Доступ к указанному пути на сервере запрещен!');

     if (kReplyStatusCode = 404) or
        (kReplyStatusCode = 405)
     then
        raise Exception.Create(
           'Неверно задан путь!');

     if kReplyStatusCode = 502 then
        raise Exception.Create(
           'Неверно заданы параметры прокси-сервера!');

     // Временный поток для ответа. Потом либо получаем из него детали ошибки,
     // либо (если нет ошибки) преобразуем его к aReplyData.
     kReplyData := TMemoryStream.Create();

     // Получаем длину данных
     kReplyContentLengthBufferSize := 4;
     kHTTPQueryInfoIndex := 0;
     if HttpQueryInfo(kRequest, HTTP_QUERY_CONTENT_LENGTH or HTTP_QUERY_FLAG_NUMBER,
        @kReplyContentLength, kReplyContentLengthBufferSize, kHTTPQueryInfoIndex) then
     begin
        while kReplyData.Size < kReplyContentLength do
        begin
           if not InternetQueryDataAvailable(kRequest, kBytesAvailable, 0, 0) then
              fRaiseLastWinINetError('InternetQueryDataAvailable');

           SetLength(kReplyBuff, kBytesAvailable);

           if not InternetReadFile(kRequest, @kReplyBuff[0], kBytesAvailable, kBytesRead) then
              fRaiseLastWinINetError('InternetReadFile');

           kReplyData.Write(kReplyBuff[0], kBytesRead);
        end;
     end
     else
     begin
        // Я плохо разбираюсь в HTTP, но я понял, что вообще говоря
        // Content-Length может часто не возвращаться. В этом случае
        // WinInet сам как-то определит, длину сообщения. Насколько я понимаю
        // это может быть либо по разрыву соедения, либо по специальному
        // кодированию тела с помощью заголовка Transfer-Endoding.

        if GetLastError <> ERROR_HTTP_HEADER_NOT_FOUND then
           fRaiseLastWinINetError('HttpQueryInfo.2');

        // Считаем, что прочтется
        SetLength(kReplyBuff, 8*1024);
        while InternetReadFile(kRequest, @kReplyBuff[0],
           Length(kReplyBuff), kBytesRead) do
        begin
           if kBytesRead > 0 then
              kReplyData.Write(kReplyBuff[0], kBytesRead)
           else
             Break;
        end;
     end;

     // В зависимости от статуса считаем - либо ошибкой HTTP, либо нет.
     if kReplyStatusCode = 200 then
     begin
        aReplyData.Size := 0;
        aReplyData.CopyFrom(kReplyData, 0{т.е. все копируем});
        aReplyData.Position := 0; // Так вроде где-то в контракте обещал делать
     end
     else
     begin
        // Далее нужно решить, что показывать пользователю: если сообщение
        // не является HTML и не длинней заданной длины, то покажем его,
        // иначе покажем только строку c номером ошибки.

        SetLength(kReplyStatusMessage, kReplyData.Size);
        kReplyData.Position := 0;
        kReplyData.Read(Pointer(kReplyStatusMessage)^, kReplyData.Size);

        if (Length(kReplyStatusMessage) < 300) and
           (Pos('<', kReplyStatusMessage) = 0) and
           (Pos('>', kReplyStatusMessage) = 0) and
           (Pos('</', kReplyStatusMessage) = 0)
        then
           raise Exception.Create(Format('Неверный ответ сервера %d:'#13'%s!',
              [kReplyStatusCode, kReplyStatusMessage]))
        else
           raise Exception.Create(Format('Неверный ответ сервера %d',
              [kReplyStatusCode]));
     end;
  finally
     if kRequest <> nil then
        InternetCloseHandle(kRequest);
     if kConnect <> nil then
        InternetCloseHandle(kConnect);
     if kSession <> nil then
        InternetCloseHandle(kSession);
     if kReplyData <> nil then
        kReplyData.Free;
  end;
end;

class procedure THTTPClientImpl.fRaiseLastWinINetError(const aDetails: String = '');
var
  kLastError: DWORD;
begin
  kLastError := GetLastError();

  if (kLastError >= INTERNET_ERROR_BASE) and (kLastError <= INTERNET_ERROR_LAST) then
  begin
     case kLastError of
        ERROR_INTERNET_TIMEOUT:
           raise Exception.CreateFmt(
              'Первышено время выполнения операции (12002, %s)', [aDetails]);
        ERROR_INTERNET_INVALID_URL:
           raise Exception.CreateFmt(
              'Не корректный URL (12005, %s)', [aDetails]);
        ERROR_INTERNET_NAME_NOT_RESOLVED:
           raise Exception.CreateFmt(
              'Сервер не найден по имени (12007, %s)', [aDetails]);
        ERROR_INTERNET_CANNOT_CONNECT:
           raise Exception.CreateFmt(
              'Не могу соединиться с сервером (12029, %s)', [aDetails]);
        else
           RaiseLastOsError();
     end;
  end
  else
  begin
     RaiseLastOsError();
  end;
end;

class procedure THTTPClientImpl.fAddHttpHeader(
  const aRequest: HINTERNET; const aValue: String);
var
  kValue: String;
begin
  kValue := aValue + CLRF;
  if not HttpAddRequestHeaders(aRequest, PChar(kValue),
     Length(kValue), HTTP_ADDREQ_FLAG_REPLACE or HTTP_ADDREQ_FLAG_ADD)
  then
     fRaiseLastWinINetError('HttpAddRequestHeaders');
end;

end.