VPF::Утечка памяти (IWebBrowser2, PeekMessage) - Форум программистов

M1ndAction

Дата 6.10.2011, 06:01 (ссылка)

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

Загрузка ...

Шустрый

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

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

Была проблема с загрузкой полного исходного кода с помощью TWebBrowser. Обсуждение: http://forum.vingrad.ru/forum/topic-338492...0%BE%D0%B4.html

В итоге был получен код:

Код


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

Как можно поправить?

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