logo标签列表

Delphi中的Javascript TWebBrowser，关闭线程

javascriptdelphigoogle-mapstwebbrowseriwebbrowser2
10
我正在尝试使用Delphi构建一个系统，允许用户使用谷歌地图。它可以正常工作，但是我注意到每次创建新的TWebBrowser对象并加载处理谷歌地图的JavaScript时，都会生成大量新的线程。
我的问题是，即使销毁了webbrowser（它肯定已被销毁），创建的线程仍然存在。我设计这个程序运行时间很长，并且打开和关闭谷歌地图会发生很多次，因此，经过一段时间，生成了太多未终止的线程，导致程序明显减慢。
是否有任何方法可以自己销毁这些线程，或者我做错了什么导致线程持久存在？
我基于以下代码编写我的程序:
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.

程序使用基本析构函数，将HTMLWindow设置为导航到about:blank。

谢谢！

WebBrowser位于由父TForm处理的TForm上，我销毁了子TForm并使用以下析构代码：destructor TGoogleMap.Destroy; begin HTMLWindow2.navigate('about:blank'); HTMLWindow2 := nil; WebBrowser1.DestroyComponents; WebBrowser1.Destroy; inherited end; - user1242937
4
起始，您的“析构函数”完全不需要。您在那里搞了一堆混乱。拥有者表单将会自行释放“TWebBrowser”组件。 - kobik
2
@whosrdaddy: Destroy() 是实际的析构函数，可以直接调用。Free() 仅是一个包装器，只有在 Self 指针不为 nil 时才调用 Destroy()。 - Remy Lebeau
1
“Destroy” 可以直接调用，但通常不建议这样做。但是，为了释放模式窗体，你也不应该调用 Free，而是应该调用 Release，它会向表单发送消息，告诉它应该释放自己。如果你不这样做，表单上的控件可能仍然尝试与已经被销毁的表单交互。但我怀疑这不是问题所在。 - GolezTrol
1
顺便提一下，如果构造函数失败（由于任何原因引发异常），析构函数仍然会被调用。在构造函数中异常抛出后本应创建的每个对象仍将是“nil”，如果您调用Destroy而不是Free，则析构函数将再次失败，因此这至少是调用Free而不是Destroy的一个很好的理由。即使您的代码结构规定了其他方式，对象也可能为nil。 - GolezTrol
显示剩余3条评论
1个回答
2

这并没有回答这个问题，它只是简化了需要模拟的问题。

看看每次按钮点击后有多少线程在运行。它使用了Simple Google Maps example，所以问题甚至不在你的javascript部分。

Unit1 - 包含主表单，其中只有一个带有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.

第二单元 - 包含一个带有TWebBrowser的表单和该表单的OnCreate事件处理程序

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.
问题是GoogleMaps的站点相关还是在加载任何页面的TWebBrowser泄漏？ - EMBarbosa
1
@EMBarbosa，这种情况只发生在某些页面上，而不是所有页面。因此，它不仅与GoogleMaps有关。 - TLama
网页内容由stack overflow 提供, 点击上面的
可以查看英文原文，
原文链接