Javascript en Delphi TWebBrowser, Closing Threads

Estoy intentando construir un sistema en Delphi que permita a los usuarios usar Google Maps. Todo funciona bien, pero me doy cuenta de que cada vez que se crea un nuevo objeto TWebBrowser y se carga el javascript que maneja Google Maps, se genera una cantidad de Threads nuevos.Javascript en Delphi TWebBrowser, Closing Threads

Mi problema es que incluso una vez que el webbrowser se destruye (y definitivamente se destruye) los hilos creados persisten. Estoy diseñando este programa para tener largos tiempos de ejecución y la apertura y cierre de los mapas de Google para que ocurran muchas veces y, como tal, después de un tiempo, se han generado tantos subprocesos que el programa se desacelera drásticamente.

¿Hay alguna forma de destruir estos hilos por mi cuenta, o estoy haciendo algo mal que está causando que los hilos persistan?

Estoy basando mi programa fuera del código siguiente:

const 
HTMLStr: AnsiString = 
'<html> '+  
'<head> '+ 
'<meta name="viewport" content="initial-scale=1.0, user-scalable=yes" /> '+ 
'<script type="text/javascript" src="http://maps.google.com/maps/api/js?sensor=true">  </script> '+ 
'<script type="text/javascript"> '+ 
''+ 
''+ 
' var geocoder; '+ 
' var map; '+ 
' var trafficLayer;'+ 
' var bikeLayer;'+ 
' var markersArray = [];'+ 
''+ 
''+ 
' function initialize() { '+ 
' geocoder = new google.maps.Geocoder();'+ 
' var latlng = new google.maps.LatLng(40.714776,-74.019213); '+ 
' var myOptions = { '+ 
'  zoom: 13, '+ 
'  center: latlng, '+ 
'  mapTypeId: google.maps.MapTypeId.ROADMAP '+ 
' }; '+ 
' map = new google.maps.Map(document.getElementById("map_canvas"), myOptions); '+ 
' trafficLayer = new google.maps.TrafficLayer();'+ 
' bikeLayer = new google.maps.BicyclingLayer();'+ 
' map.set("streetViewControl", false);'+ 
' } '+ 
''+ 
''+ 
' function codeAddress(address) { '+ 
' if (geocoder) {'+ 
'  geocoder.geocode({ address: address}, function(results, status) { '+ 
'  if (status == google.maps.GeocoderStatus.OK) {'+ 
'   map.setCenter(results[0].geometry.location);'+ 
'   PutMarker(results[0].geometry.location.lat(),  results[0].geometry.location.lng(),  results[0].geometry.location.lat()+","+results[0].geometry.location.lng());'+ 
'  } else {'+ 
'   alert("Geocode was not successful for the following reason: " + status);'+ 
'  }'+ 
'  });'+ 
' }'+ 
' }'+ 
''+ 
''+ 
' function GotoLatLng(Lat, Lang) { '+ 
' var latlng = new google.maps.LatLng(Lat,Lang);'+ 
' map.setCenter(latlng);'+ 
' PutMarker(Lat, Lang, Lat+","+Lang);'+ 
' }'+ 
''+ 
''+ 
'function ClearMarkers() { '+ 
' if (markersArray) {  '+ 
' for (i in markersArray) { '+ 
'  markersArray[i].setMap(null); '+ 
' } '+ 
' } '+ 
'} '+ 
''+ 
' function PutMarker(Lat, Lang, Msg) { '+ 
' var latlng = new google.maps.LatLng(Lat,Lang);'+ 
' var marker = new google.maps.Marker({'+ 
'  position: latlng, '+ 
'  map: map,'+ 
'  title: Msg+" ("+Lat+","+Lang+")"'+ 
' });'+ 
' markersArray.push(marker); '+ 
' }'+ 
''+ 
''+ 
' function TrafficOn() { trafficLayer.setMap(map); }'+ 
''+ 
' function TrafficOff() { trafficLayer.setMap(null); }'+ 
''+''+ 
' function BicyclingOn() { bikeLayer.setMap(map); }'+ 
''+ 
' function BicyclingOff(){ bikeLayer.setMap(null);}'+ 
''+ 
' function StreetViewOn() { map.set("streetViewControl", true); }'+ 
''+ 
' function StreetViewOff() { map.set("streetViewControl", false); }'+ 
''+ 
''+'</script> '+ 
'</head> '+ 
'<body onload="initialize()"> '+ 
' <div id="map_canvas" style="width:100%; height:100%"></div> '+ 
'</body> '+ 
'</html> '; 


procedure TfrmMain.FormCreate(Sender: TObject); 
var 
    aStream  : TMemoryStream; 
begin 
    WebBrowser1.Navigate('about:blank'); 
    if Assigned(WebBrowser1.Document) then 
    begin 
     aStream := TMemoryStream.Create; 
     try 
    aStream.WriteBuffer(Pointer(HTMLStr)^, Length(HTMLStr)); 
    //aStream.Write(HTMLStr[1], Length(HTMLStr)); 
    aStream.Seek(0, soFromBeginning); 
    (WebBrowser1.Document as IPersistStreamInit).Load(TStreamAdapter.Create(aStream)); 
    finally 
    aStream.Free; 
    end; 
    HTMLWindow2 := (WebBrowser1.Document as IHTMLDocument2).parentWindow; 

end; 
end; 


procedure TfrmMain.ButtonGotoLocationClick(Sender: TObject); 
begin 
    HTMLWindow2.execScript(Format('GotoLatLng(%s,%s)',[Latitude.Text,Longitude.Text]),   'JavaScript'); 
end; 

procedure TfrmMain.ButtonClearMarkersClick(Sender: TObject); 
begin 
    HTMLWindow2.execScript('ClearMarkers()', 'JavaScript') 
end; 

procedure TfrmMain.ButtonGotoAddressClick(Sender: TObject); 
var 
    address : string; 
begin 
    address := MemoAddress.Lines.Text; 
    address := StringReplace(StringReplace(Trim(address), #13, ' ', [rfReplaceAll]), #10, ' ' , [rfReplaceAll]); 
    HTMLWindow2.execScript(Format('codeAddress(%s)',[QuotedStr(address)]),  'JavaScript'); 
end; 

procedure TfrmMain.CheckBoxStreeViewClick(Sender: TObject); 
begin 
    if CheckBoxStreeView.Checked then 
    HTMLWindow2.execScript('StreetViewOn()', 'JavaScript') 
    else 
    HTMLWindow2.execScript('StreetViewOff()', 'JavaScript'); 

end; 

procedure TfrmMain.CheckBoxBicyclingClick(Sender: TObject); 
begin 
    if CheckBoxBicycling.Checked then 
    HTMLWindow2.execScript('BicyclingOn()', 'JavaScript') 
    else 
    HTMLWindow2.execScript('BicyclingOff()', 'JavaScript'); 
end; 


procedure TfrmMain.CheckBoxTrafficClick(Sender: TObject); 
begin 
    if CheckBoxTraffic.Checked then 
    HTMLWindow2.execScript('TrafficOn()', 'JavaScript') 
    else 
    HTMLWindow2.execScript('TrafficOff()', 'JavaScript'); 
end; 


end.

programa utiliza un destructor básica que establece el HTMLWindow para navegar a about: blank. Gracias de antemano

Fuente

2012-03-01 user1242937

¿Dónde y cómo destruyes el navegador web? – GolezTrol

El explorador web se encuentra en un TForm manejado por un TForm padre, destruyo el TForm hijo y uso el siguiente código de destructor: 'destructor TGoogleMap.Destroy; begin HTMLWindow2.navigate ('about: blank'); HTMLWindow2: = nil; WebBrowser1.DestroyComponents; WebBrowser1.Destroy; heredado final; ' – user1242937

Para empezar, su' destructor' no es necesario en absoluto. estás haciendo una gran ensalada allí. el formulario de propietario liberará el 'TWebBrowser'. – kobik

Esto no responde a esta pregunta, solo simplifica el problema que se va a simular.

Vea cuántos subprocesos se ejecutan después de cada clic de botón. Utiliza el Simple Google Maps example, por lo que el problema ni siquiera está en la parte de JavaScript.

Unit1 - contiene formulario principal, donde se encuentra un botón con controlador de eventos OnClick

unit Unit1; 

interface 

uses 
    Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, 
    Dialogs, StdCtrls, PsAPI, TlHelp32, Unit2; 

type 
    TForm1 = class(TForm) 
    Button1: TButton; 
    procedure Button1Click(Sender: TObject); 
    private 
    { Private declarations } 
    public 
    { Public declarations } 
    end; 

var 
    Form1: TForm1; 

implementation 

{$R *.dfm} 

function GetThreadCount(const APID: Cardinal): Integer; 
var 
    NextProc: Boolean; 
    ProcHandle: THandle; 
    ThreadEntry: TThreadEntry32; 
begin 
    Result := 0; 
    ProcHandle := CreateToolhelp32Snapshot(TH32CS_SNAPTHREAD, 0); 
    if (ProcHandle <> INVALID_HANDLE_VALUE) then 
    try 
    ThreadEntry.dwSize := SizeOf(ThreadEntry); 
    NextProc := Thread32First(ProcHandle, ThreadEntry); 
    while NextProc do 
    begin 
     if ThreadEntry.th32OwnerProcessID = APID then 
     Inc(Result); 
     NextProc := Thread32Next(ProcHandle, ThreadEntry); 
    end; 
    finally 
    CloseHandle(ProcHandle); 
    end; 
end; 

procedure TForm1.Button1Click(Sender: TObject); 
var 
    ModalForm: TForm2; 
begin 
    ModalForm := TForm2.Create(nil); 
    try 
    ModalForm.ShowModal; 
    finally 
    ModalForm.Free; 
    end; 
    ShowMessage('Thread count: ' + 
    IntToStr(GetThreadCount(GetCurrentProcessId))); 
end; 

end.

Unit 2 - contiene formulario con el TWebBrowser en él y evento OnCreate del formulario

unit Unit2; 

interface 

uses 
    Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, 
    Dialogs, StdCtrls, OleCtrls, SHDocVw, ActiveX; 

type 
    TForm2 = class(TForm) 
    WebBrowser1: TWebBrowser; 
    procedure FormCreate(Sender: TObject); 
    private 
    { Private declarations } 
    public 
    { Public declarations } 
    end; 

var 
    Form2: TForm2; 

implementation 

{$R *.dfm} 

const 
    HTMLString: AnsiString = 
    '<!DOCTYPE html>' + 
    '<html>' + 
    ' <head>' + 
    ' <title>Google Maps JavaScript API v3 Example: Map Simple</title>' + 
    ' <meta name="viewport"' + 
    '  content="width=device-width, initial-scale=1.0, user-scalable=no">' + 
    ' <meta charset="UTF-8">' + 
    ' <style type="text/css">' + 
    '  html, body, #map_canvas {' + 
    '  margin: 0;' + 
    '  padding: 0;' + 
    '  height: 100%;' + 
    '  }' + 
    ' </style>' + 
    ' <script type="text/javascript"' + 
    '  src="http://maps.googleapis.com/maps/api/js?sensor=false"></script>' + 
    ' <script type="text/javascript">' + 
    '  var map;' + 
    '  function initialize() {' + 
    '  var myOptions = {' + 
    '   zoom: 8,' + 
    '   center: new google.maps.LatLng(-34.397, 150.644),' + 
    '   mapTypeId: google.maps.MapTypeId.ROADMAP' + 
    '  };' + 
    '  map = new google.maps.Map(document.getElementById(''map_canvas''),' + 
    '   myOptions);' + 
    '  }' + 
    '  google.maps.event.addDomListener(window, ''load'', initialize);' + 
    ' </script>' + 
    ' </head>' + 
    ' <body>' + 
    ' <div id="map_canvas"></div>' + 
    ' </body>' + 
    '</html>'; 

procedure TForm2.FormCreate(Sender: TObject); 
var 
    HTMLStream: TMemoryStream; 
begin 
    WebBrowser1.Navigate('about:blank'); 
    if Assigned(WebBrowser1.Document) then 
    begin 
    HTMLStream := TMemoryStream.Create; 
    try 
     HTMLStream.WriteBuffer(Pointer(HTMLString)^, Length(HTMLString)); 
     HTMLStream.Seek(0, soFromBeginning); 
     (WebBrowser1.Document as IPersistStreamInit).Load(TStreamAdapter.Create(HTMLStream)); 
    finally 
     HTMLStream.Free; 
    end; 
    end; 
end; 

end.

Fuente

2012-03-02 12:14:33 TLama

¿El problema es el sitio de GoogleMaps relacionado o en cualquier página cargada las fugas de TWebBrowser? – EMBarbosa

@EMBarbosa, sucede en algunas páginas, pero no en todas. Entonces, no solo está relacionado con GoogleMaps. – TLama

Javascript en Delphi TWebBrowser, Closing Threads

Respuesta

Cuestiones relacionadas