Interner TWebBrowser füllt Arbeitsspeicher bis KnockOut

[bogdan]

@nahpets:
Ja, die Schleife ist zum Testen da.
Es spielt aber auch keine Rolle ob nur 1x TWebBrowser während der Laufzeit erstellt wird und dann 100 oder mehr Seiten in der einen Instanz navigiert werden oder ob die TWebBrowser-Instanz immer wieder erstellt wird -> Seite lädt -> Instanz wieder frei geben. Das Ergebnis ist immer das gleiche, irgendwann mal ist der RAM voll.

Mit IdHTTP habe ich den gleichen Sachverhalt getestet, da ist alles in Ordnung.

@Bernhard:
"about:blank" hat schon mal bewirkt, dass der RAM nicht so schnell dicht wird.
d.h. bei 100 Seiten war schnell der RAM mit 1 GB zugebaut.
Mit "about:blank" waren bei 1000 Seiten erst mal "nur" 600 MB im RAM.

Anbei der Test-Code:

Code:

function sBrowser(sBrowserName: String; sUrl: String): String;
var
  xBrowser: TWebBrowser;
begin
  if sBrowserName = 'BrowserOnFly' then
  begin
    xBrowser := TWebBrowser.Create(Form1);
    TWinControl(xBrowser).Name := 'BrowserOnFly';
    TWinControl(xBrowser).Parent := Form1.Panel1;
    xBrowser.Align := alClient;
    xBrowser.Silent := True;
    xBrowser.OnBeforeNavigate2 := Form1.WebBrowser1BeforeNavigate2;
    xBrowser.OnDocumentComplete := Form1.WebBrowser1DocumentComplete;
    xBrowser.OnNavigateComplete2 := Form1.WebBrowser1NavigateComplete2;
    xBrowser.OnStatusTextChange := Form1.WebBrowser1StatusTextChange;
    Form1.AdvComboBox1.Text := sUrl;
  end;

  if sBrowserName = 'WebBrowser1' then
  begin
    xBrowser := Form1.WebBrowser1;
  end;

  try
    xBrowser.Navigate(sUrl);
    repeat
      Application.ProcessMessages
    until Form1.FDocLoaded;
  finally
    if sBrowserName = 'BrowserOnFly' then
    begin
      xBrowser.Navigate('about:blank');
      xBrowser.Free;
    end;
  end;
end;

procedure TestBrowser(sBrowserName: String);
var
  i : Integer;
begin
  for i := 1 to 100 do
  begin
    sBrowser(sBrowserName, sGetUrlFromLine(i));
  end;
end;

procedure TForm1.sButton38Click(Sender: TObject);
begin
  TestBrowser(Edit1.Text);
end;

[Bernhard Geyer]

Und was passiert in den Events:

Delphi-Quellcode:

    xBrowser.OnBeforeNavigate2 := Form1.WebBrowser1BeforeNavigate2;
    xBrowser.OnDocumentComplete := Form1.WebBrowser1DocumentComplete;
    xBrowser.OnNavigateComplete2 := Form1.WebBrowser1NavigateComplete2;
    xBrowser.OnStatusTextChange := Form1.WebBrowser1StatusTextChange;

Bis XE8 "fette" Speicherlücken wenn man mit dem Defaultinterface gearbeitet hat.
Siehe: https://marc.durdin.net/2012/07/unde...-olectrls-pas/

[bogdan]

@Bernhard:
In den Ereignissen passiert folgendes:

Code:

public
    CurDispatch: IDispatch;
    FDocLoaded: Boolean;

procedure TForm1.WebBrowser1BeforeNavigate2(ASender: TObject;
  const pDisp: IDispatch; const URL, Flags, TargetFrameName, PostData,
  Headers: OleVariant; var Cancel: WordBool);
begin
  CurDispatch := nil;
  FDocLoaded := False;
end;

procedure TForm1.WebBrowser1DocumentComplete(ASender: TObject; const pDisp: IDispatch; const URL: OleVariant);
begin
  if (pDisp = CurDispatch) then
  begin
    FDocLoaded := True;
    CurDispatch := nil;
  end;
end;

procedure TForm1.WebBrowser1NavigateComplete2(ASender: TObject; const pDisp: IDispatch; const URL: OleVariant);
begin
  if CurDispatch = nil then CurDispatch := pDisp;
end;

procedure TForm1.WebBrowser1StatusTextChange(ASender: TObject; const Text: WideString);
begin
  StatusBar1.SimpleText := Text;
end;