Javascript in Delphi TWebBrowser, Closing Threads

孤人 提交于 2019-12-18 02:47:55

问题


I am attempting to build a system in delphi that allows users to use Google Maps. It all works fine, but i'm noticing that every time a new TWebBrowser object is created and the javascript that handles Google Maps is loaded, a number of new Threads is generated.

My problem is that even once the webbrowser is destroyed (and it is definately destroyed) the created threads persist. I'm designing this program to have long running times and the opening and closing of google maps to happen many times and as such, after a while, so many threads have been generated and not terminated that the program slows down dramatically.

Is there any way to Destroy these threads myself, or am I doing something wrong which is causing the threads to persist?

I am basing my program off of the following code:

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.

Program uses a basic destructor that sets the HTMLWindow to navigate to about:blank. Thanks in advance


回答1:


This does not answer this question, it only simplifies the problem to be simulated.

See how many threads is running after each button click. It uses the Simple Google Maps example, so the problem is not even in your javascript part.

Unit1 - contains main form, where is just a button with OnClick event handler

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.

Unit2 - contains form with the TWebBrowser on it and the form's OnCreate event handler

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.


来源:https://stackoverflow.com/questions/9518594/javascript-in-delphi-twebbrowser-closing-threads

易学教程内所有资源均来自网络或用户发布的内容,如有违反法律规定的内容欢迎反馈
该文章没有解决你所遇到的问题?点击提问,说说你的问题,让更多的人一起探讨吧!