VPF::Полный исходный код страницы в TWebBrowser

M1ndAction

Дата 22.9.2011, 08:51 (ссылка)

(нет голосов)

Загрузка ...

Шустрый

Профиль
Группа: Участник
Сообщений: 51
Регистрация: 19.1.2008

Репутация: нет
Всего: нет

Добрый день!

Не могу получить полный исходный код страницы, скачанной TWebBrowser. Загружается только часть. Видел в сети большое количество методов, но самый рабочий (на первый взгляд) оказался через IPersistStreamInit.

Код


function GetHtmlSource(WB: TWebBrowser): String;
var
  PersistStream: IPersistStreamInit;
  Stream: IStream;
  ss: TStringStream;
  SaveResult: HRESULT;
begin
  PersistStream := WB.Document as IPersistStreamInit;

  ss := TStringStream.Create;
  try
    Stream := TStreamAdapter.Create(ss, soReference) as IStream;
    SaveResult := PersistStream.Save(Stream, True);
    //Result := ss.DataString;
    Result := StringOf(TEncoding.Convert(TEncoding.UTF8,
      TEncoding.GetEncoding(1251), BytesOf(ss.DataString)));

  finally
    ss.Free;
  end;
end;

В данном случае задача узкоспециализированная - нужно делать запросы только к Яндексу. Приведенным выше методом получаю часть кода, вижу количество найденных страниц, а ссылок нет. TWebBrowser динамически создается в отдельном потоке:

Код


  function GetValue(domain: String): String;
  var
    resp: String;
    url: String;
    //http: TidHttp;
    ipos, from, till: Integer;
    //b: Boolean;
    err: Boolean;
    web: TWebBrowser;
  begin
    
    CoInitialize(nil);
    web := TWebBrowser.Create(nil);
    try
      try
        response.Clear;
        resp := '';
        url := 'http://yandex.ru/yandsearch?text='+HTTPEncode('host:'+domain+' | host:www.'+domain);
        err := True;

        while (err) and (not Terminated) do
        begin
          //resp := http.Get(url);
          web.Navigate(url, navNoReadFromCache);
          while (web.Busy) do
          begin
            Application.ProcessMessages;
            Sleep(1);
          end;

          resp := GetHtmlSource(web);
          ...
        end;
      except
      end;
    finally
      web.Free;
      CoUnInitialize;
    end;
  end;

WebBrowser для таких целей раньше не использовал, предпочитал Indy или Synapse, поэтому поражает такое количество методов, функций, выглядит совершенно нелогично на первый взгляд, например, чем отличаются IHtmlDocument2 и IHtmlDocument3 догадаться сложно smile

Неужто нет простого и надежного метода получить нормальный код, по типу того, что возвращает idHttp.Get?

M1ndAction

Дата 2.10.2011, 14:28 (ссылка)

(нет голосов)

Загрузка ...

Шустрый

Профиль
Группа: Участник
Сообщений: 51
Регистрация: 19.1.2008

Репутация: нет
Всего: нет

Проблема оказалась в другом - просто страница не полностью загружалась, а текст страницы определялся верно. Полностью переделал код загрузки страницы, можно теперь свободно использовать в потоках (написано на основе этого обсуждения http://forum.codenet.ru/threads/59960-TWeb...-%D0%B2-Thread).

Код


unit WBPages2;

interface

{var
  FURLString: string;
  wb: IWebBrowser2; // бразуер
  wHandle: HWND; // handle созданного окна
}

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, StdCtrls,
  ActiveX, OleCtrls, SHDocVw, MSHTML, HttpApp;

var
  wb: IWebBrowser2; // бразуер
  wHandle: HWND; // handle созданного окна

function GetWBHtml2(url: String): String;

implementation

const
  CLSID_InternetExplorer: TGUID = '{8856F961-340A-11D0-A96B-00C04FD705A2}';

function AtlAxAttachControl(const pControl: IUnknown;
  hWnd: HWND; ppUnkContainer: IUnknown): DWORD; stdcall; external 'ATL.DLL';

function GetWBHtml2(url: String): String;
var
  WndClass: TWndClassEx;
  pData: OleVariant;
  Msg: tagMSG;
  HTMLDocument: IHTMLDocument2;
  PersistFile: IPersistFile;

  ss: TStringStream;
  PersistStream: IPersistStreamInit;
  Stream: IStream;
  res: String;

begin
  FillChar(WndClass, SizeOf(WndClass), 0);
  with WndClass do
  begin
    cbSize := SizeOf(WndClass);
    lpszClassName := 'MESSAGE_ONLY_WINDOW';
    lpfnWndProc := @DefWindowProc;
  end;
  RegisterClassEx(WndClass);

  wHandle := CreateWindowEx(0, WndClass.lpszClassName, nil,
    0, 0, 0, 0, 0, DWORD(HWND_MESSAGE), 0, 0, nil);
  if (wHandle = 0) then
    raise Exception.Create('CreateWindowEx');

  try

    CoInitializeEx(nil, COINIT_APARTMENTTHREADED);

    if (CoCreateInstance(CLSID_InternetExplorer, nil, CLSCTX_INPROC_SERVER,
      IID_IWebBrowser2, wb) <> S_OK) then
      raise Exception.Create('CoCreateInstance');
    try

      AtlAxAttachControl(wb, wHandle, nil);

      pData := EmptyParam;
      wb.Navigate(url, EmptyParam, EmptyParam, pData, EmptyParam) ;

      while (wb.ReadyState <> READYSTATE_COMPLETE) do
      begin
        while PeekMessage(Msg, 0, 0, 0, PM_REMOVE) do
          DispatchMessage(Msg);
        Sleep(1);
      end;

      {HTMLDocument := wb.Document as IHTMLDocument2;
      PersistFile := HTMLDocument as IPersistFile;
      PersistFile.Save(StringToOleStr('WBPages2_'+
        FormatDateTime('yyyy-mm-dd-hh-mm-ss-zzz', Now)+'.htm'), True);}


      HTMLDocument := (wb.Document) as IHTMLDocument2;
      PersistStream := HTMLDocument as IPersistStreamInit;
      ss := TStringStream.Create;
      try
        Stream := TStreamAdapter.Create(ss, soReference) as IStream;
        PersistStream.Save(Stream, True);
        //Result := ss.DataString;
        Result := StringOf(TEncoding.Convert(TEncoding.UTF8,
          TEncoding.GetEncoding(1251), BytesOf(ss.DataString)));
      finally
        ss.Free;
      end;
      //MessageBoxW(0, PWideChar((wb.Document as IHTMLDocument2).title), '', 0);


    finally
      wb := nil;
    end;

  finally
    DestroyWindow(wHandle);
  end;
end;


end.

0 Пользователей читают эту тему (0 Гостей и 0 Скрытых Пользователей)
0 Пользователей:
« Предыдущая тема \| Delphi: Сети \| Следующая тема »