Einzelnen Beitrag anzeigen

bogdan

Registriert seit: 15. Apr 2013
77 Beiträge
 
#9

AW: Interner TWebBrowser füllt Arbeitsspeicher bis KnockOut

  Alt 11. Apr 2017, 13:17
@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;
  Mit Zitat antworten Zitat