Справочник функций

Ваш аккаунт

Войти через: 
Забыли пароль?
Регистрация
Информацию о новых материалах можно получать и без регистрации:

Почтовая рассылка

Подписчиков: -1
Последний выпуск: 19.06.2015

Утечка памяти (IWebBrowser2, PeekMessage)

74K
06 октября 2011 года
M1ndAction
3 / / 06.10.2011
Добрый день!

Была проблема с загрузкой полного исходного кода с помощью TWebBrowser (в отдельном потоке). Проблему решил благодаря обсуждению http://forum.codenet.ru/threads/59960-TWebBrowser-%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;
const
  UserAgents: array [0..7] of String=
  ('Mozilla/5.0 (Windows; U; Windows NT 5.1; ru; rv:1.9.2.22) Gecko/20110902 Firefox/3.6.22',
  'Mozilla/5.0 (Windows; U; Windows NT 6.1; ru; rv:1.9.2.22) Gecko/20110902 Firefox/3.6.22',
  'Mozilla/5.0 (Windows NT 6.1; WOW64) AppleWebKit/535.1 (KHTML, like Gecko) Chrome/14.0.835.202 Safari/535.1',
  'Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.1; SV1; EmbeddedWB 14.52 from: http://www.bsalsa.com/ EmbeddedWB 14.52; .NET CLR 2.0.50727)',
  'Mozilla/5.0 (compatible; MSIE 9.0; Windows NT 6.1; Win64; x64; Trident/5.0)',
  'Mozilla/5.0 (compatible; MSIE 9.0; Windows NT 6.1; WOW64; Trident/5.0)',
  'Mozilla/5.0 (Windows NT 6.1; WOW64; rv:7.0.1) Gecko/20100101 Firefox/7.0.1',
  'Mozilla/5.0 (Windows NT 6.1; WOW64) AppleWebKit/534.50 (KHTML, like Gecko) Version/5.1 Safari/534.50'
  );

var
  WndClass: TWndClassEx;
  pData, Headers, Flags: OleVariant;
  Msg: tagMSG;
  HTMLDocument: IHTMLDocument2;
  PersistFile: IPersistFile;

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

begin
  Randomize;
  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);

      Headers := 'User-Agent: '+UserAgents[Random(Length(UserAgents))]+#10#13#0;
      pData := EmptyParam;
      Flags := NavNoHistory or NavNoReadFromCache or NavNoWriteToCache;
      wb.Navigate(url, Flags, EmptyParam, pData, Headers) ;

      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;
      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);
    CoUnInitialize;
  end;
end;


end.


Но идет сильная утечка памяти. На одной машине с Win7x64 этого не наблюдается, зато на другой c Win7x64 и виртуальной WinXP c 250 МБ (изначально такой большой объем из-за таблицы TAdvStringGrid c 9000 строками) за минуты увеличивается до 400 МБ и выше.

Опытным путем было установлено, что проблема в этом участке:
 
Код:
while (wb.ReadyState <> READYSTATE_COMPLETE) do
      begin
        while PeekMessage(Msg, 0, 0, 0, PM_REMOVE) do
          DispatchMessage(Msg);
        Sleep(1);
      end;


Если его убрать, то память в порядке.

В программе запускается дочерний поток и в Execute вызывается GetWBHtml2(url);

Как можно поправить?
14
07 октября 2011 года
Phodopus
3.3K / / 19.06.2008
И если убрать этот кусок то все работает?
74K
07 октября 2011 года
M1ndAction
3 / / 06.10.2011
Цитата: Phodopus
И если убрать этот кусок то все работает?


Если убрать, то утечки нет, но тогда страница (и сопутствующие файлы) не скачивается.

14
08 октября 2011 года
Phodopus
3.3K / / 19.06.2008
Мне вообще не нравится там этот цикл посреди сада. Стоило бы вынести его граммотно и полноценно в основную часть и сделать обработку на событиях оконной процедуры.
74K
08 октября 2011 года
M1ndAction
3 / / 06.10.2011
Поподробнее, пожалуйста :)
14
09 октября 2011 года
Phodopus
3.3K / / 19.06.2008
Сделать для треда отдельную полноценную петлю сообщений и все-такое-прочее как в обычном WinAPI приложении
Реклама на сайте | Обмен ссылками | Ссылки | Экспорт (RSS) | Контакты
Добавить статью | Добавить исходник | Добавить хостинг-провайдера | Добавить сайт в каталог