unit HTTPReader;

{
  05.10.2005
  Получение HTML страниц из интернета и разбор их с помощью MSHTML, без
  использования TWebBrowser.
  Как-то понадобилось вытягивать курсы валют с одной веб странички, причем не
  хотелось тянуть графику и использовать TWebBrowser.
  Вот что из этого получилось.

  Разработал: Федоров А.
}

interface

uses
  Windows, MSHTML;

{
Пример:
var
  ht: THTTPReader;
  doc: IHTMLDocument2;
begin
  ht := THTTPReader.Create;
  try
    ht.Get(Handle, 'www.delphikingdom.com', '/index.asp');
    doc := ht.Parse;
    ShowMessage(doc.body.innerHTML);
  finally
    ht.Free;
  end;
end;
}

type
  THTTPReader = class
  private
    FBuffer: string;
    FDocument: IHTMLDocument2;
  public
    // Get - читает html-документ
    // Handle - дескриптор окна, относительно которого будут выводится сообщения
    // ServerName - имя сервера, например www.delphikingdom.com
    // Путь к html-документу, относительно имени сервера, например /index.asp
    procedure Get(Handle: THandle; ServerName, RelativePath: string);

    // HTMLDocument - разбирает html-код, хранящийся в буфере
    // и возвращает IHTMLDocument2
    function Parse: IHTMLDocument2;

    procedure LoadFromFile(const FileName: string);
    procedure SaveToFile(const FileName: string);

    // Буфер для хранения HTML кода
    property Buffer: string read FBuffer write FBuffer;
  end;

implementation

uses
  WinInet, SysUtils, ActiveX, Classes;

{ THTTPReader }

procedure THTTPReader.Get(Handle: THandle; ServerName,
  RelativePath: string);
const
  BUF_SIZE = 65536;
var
  Internet, Connection, Request: HINTERNET;
  ErrorCode: Integer;
  Data: Pointer;
  Buf: string;
  bytes_read: Cardinal;
begin
  FBuffer := EmptyStr;
  Internet := InternetOpen('HTTP Reader', INTERNET_OPEN_TYPE_PRECONFIG,
    nil, nil, 0);
  if not Assigned(Internet) then
    RaiseLastWin32Error;
  try
    Connection := InternetConnect(Internet, PChar(ServerName),
      INTERNET_INVALID_PORT_NUMBER, nil, nil, INTERNET_SERVICE_HTTP, 0, 0);
    if not Assigned(Connection) then
      RaiseLastWin32Error;
    try
      Request := HttpOpenRequest(Connection, 'GET', PChar(RelativePath),
        nil, nil, nil, INTERNET_FLAG_KEEP_CONNECTION, 0);
      if not Assigned(Request) then
        RaiseLastWin32Error;
      try
        repeat
          if not HttpSendRequest(Request, nil, 0, nil, 0) then
            RaiseLastWin32Error;
          Data := nil;
          ErrorCode := InternetErrorDlg(Handle, Request, ERROR_SUCCESS,
            FLAGS_ERROR_UI_FILTER_FOR_ERRORS or
            FLAGS_ERROR_UI_FLAGS_CHANGE_OPTIONS or
            FLAGS_ERROR_UI_FLAGS_GENERATE_DATA, Data);
        until ErrorCode <> ERROR_INTERNET_FORCE_RETRY;

        SetLength(Buf, BUF_SIZE);
        while InternetReadFile(Request, PChar(Buf), BUF_SIZE, bytes_read)
          and (bytes_read > 0) do
          FBuffer := FBuffer + Copy(Buf, 1, bytes_read);
      finally
        InternetCloseHandle(Request);
      end;
    finally
      InternetCloseHandle(Connection);
    end;
  finally
    InternetCloseHandle(Internet);
  end;
end;

procedure THTTPReader.LoadFromFile(const FileName: string);
var
  fs: TFileStream;
begin
  FBuffer := EmptyStr;
  fs := TFileStream.Create(FileName, fmOpenRead);
  try
    SetLength(FBuffer, fs.Size);
    fs.Read(PChar(FBuffer)^, fs.Size);
  finally
    fs.Free;
  end;
end;

function THTTPReader.Parse: IHTMLDocument2;
const
  IID_IPersistStreamInit: TGUID = (
    D1:$7FD52380;D2:$4E07;D3:$101B;D4:($AE,$2D,$08,$00,$2B,$2E,$C7,$13));
var
  pst: IPersistStreamInit;
  ws: WideString;
  mk_start, mk_finish: IMarkupPointer;
  ms: IMarkupServices;
  mc: IMarkupContainer;
begin
  Result := nil;
  CoCreateInstance(CLASS_HTMLDocument, nil, CLSCTX_INPROC_SERVER,
    IID_IHTMLDocument2, FDocument);
  if Assigned(FDocument) then
  begin
    FDocument.QueryInterface(IID_IPersistStreamInit, pst);
    if Assigned(pst) then
    begin
      pst.InitNew;
      pst := nil;
      FDocument.QueryInterface(IID_IMarkupServices, ms);
      if Assigned(ms) then
      begin
        ms.CreateMarkupPointer(mk_start);
        ms.CreateMarkupPointer(mk_finish);
        ws := FBuffer + #0;
//        ms.ParseString(PWideString(@ws[1]), 0, mc, mk_start, mk_finish); // pchHTML: PWideString;
        ms.ParseString(PWord(@ws[1])^, 0, mc, mk_start, mk_finish); // var pchHTML: Word;
        if Assigned(mc) then
          mc.QueryInterface(IID_IHTMLDocument, Result);
      end;
    end;
  end;
end;

procedure THTTPReader.SaveToFile(const FileName: string);
var
  fs: TFileStream;
begin
  fs := TFileStream.Create(FileName, fmCreate);
  try
    fs.Write(PChar(FBuffer)^, Length(FBuffer));
  finally
    fs.Free;
  end;
end;

end.

HTTPClient.Get('http://weather.yandex.ru/city.xml?city=28224')