jjzjj

Delphi TWebBrowser 中的 Javascript,关闭线程

coder 2024-07-16 原文

我正尝试在 Delphi 中构建一个允许用户使用 Google map 的系统。一切正常,但我注意到每次创建新的 TWebBrowser 对象并加载处理 Google map 的 javascript 时,都会生成许多新线程。

我的问题是,即使网络浏览器被销毁(并且肯定被销毁),创建的线程仍然存在。我正在设计这个程序,使其运行时间长,并且谷歌地图的打开和关闭发生多次,因此,一段时间后,生成了如此多的线程并且没有终止,以至于程序速度急剧下降。

有什么方法可以自己销毁这些线程,还是我做错了什么导致线程持续存在?

我的程序基于以下代码:

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。 提前致谢

最佳答案

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

查看每次单击按钮后有多少线程正在运行。它使用 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.

单元 2 - 包含带有 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.

关于Delphi TWebBrowser 中的 Javascript,关闭线程,我们在Stack Overflow上找到一个类似的问题: https://stackoverflow.com/questions/9518594/

有关Delphi TWebBrowser 中的 Javascript,关闭线程的更多相关文章

  1. ruby - 如何从 ruby​​ 中的字符串运行任意对象方法? - 2

    总的来说,我对ruby​​还比较陌生,我正在为我正在创建的对象编写一些rspec测试用例。许多测试用例都非常基础,我只是想确保正确填充和返回值。我想知道是否有办法使用循环结构来执行此操作。不必为我要测试的每个方法都设置一个assertEquals。例如:describeitem,"TestingtheItem"doit"willhaveanullvaluetostart"doitem=Item.new#HereIcoulddotheitem.name.shouldbe_nil#thenIcoulddoitem.category.shouldbe_nilendend但我想要一些方法来使用

  2. ruby - 其他文件中的 Rake 任务 - 2

    我试图在一个项目中使用rake,如果我把所有东西都放到Rakefile中,它会很大并且很难读取/找到东西,所以我试着将每个命名空间放在lib/rake中它自己的文件中,我添加了这个到我的rake文件的顶部:Dir['#{File.dirname(__FILE__)}/lib/rake/*.rake'].map{|f|requiref}它加载文件没问题,但没有任务。我现在只有一个.rake文件作为测试,名为“servers.rake”,它看起来像这样:namespace:serverdotask:testdoputs"test"endend所以当我运行rakeserver:testid时

  3. ruby-on-rails - Ruby net/ldap 模块中的内存泄漏 - 2

    作为我的Rails应用程序的一部分,我编写了一个小导入程序,它从我们的LDAP系统中吸取数据并将其塞入一个用户表中。不幸的是,与LDAP相关的代码在遍历我们的32K用户时泄漏了大量内存,我一直无法弄清楚如何解决这个问题。这个问题似乎在某种程度上与LDAP库有关,因为当我删除对LDAP内容的调用时,内存使用情况会很好地稳定下来。此外,不断增加的对象是Net::BER::BerIdentifiedString和Net::BER::BerIdentifiedArray,它们都是LDAP库的一部分。当我运行导入时,内存使用量最终达到超过1GB的峰值。如果问题存在,我需要找到一些方法来更正我的代

  4. ruby-on-rails - Rails 3 中的多个路由文件 - 2

    Rails2.3可以选择随时使用RouteSet#add_configuration_file添加更多路由。是否可以在Rails3项目中做同样的事情? 最佳答案 在config/application.rb中:config.paths.config.routes在Rails3.2(也可能是Rails3.1)中,使用:config.paths["config/routes"] 关于ruby-on-rails-Rails3中的多个路由文件,我们在StackOverflow上找到一个类似的问题

  5. ruby-on-rails - Rails - 一个 View 中的多个模型 - 2

    我需要从一个View访问多个模型。以前,我的links_controller仅用于提供以不同方式排序的链接资源。现在我想包括一个部分(我假设)显示按分数排序的顶级用户(@users=User.all.sort_by(&:score))我知道我可以将此代码插入每个链接操作并从View访问它,但这似乎不是“ruby方式”,我将需要在不久的将来访问更多模型。这可能会变得很脏,是否有针对这种情况的任何技术?注意事项:我认为我的应用程序正朝着单一格式和动态页面内容的方向发展,本质上是一个典型的网络应用程序。我知道before_filter但考虑到我希望应用程序进入的方向,这似乎很麻烦。最终从任何

  6. ruby-on-rails - Rails 3.2.1 中 ActionMailer 中的未定义方法 'default_content_type=' - 2

    我在我的项目中添加了一个系统来重置用户密码并通过电子邮件将密码发送给他,以防他忘记密码。昨天它运行良好(当我实现它时)。当我今天尝试启动服务器时,出现以下错误。=>BootingWEBrick=>Rails3.2.1applicationstartingindevelopmentonhttp://0.0.0.0:3000=>Callwith-dtodetach=>Ctrl-CtoshutdownserverExiting/Users/vinayshenoy/.rvm/gems/ruby-1.9.3-p0/gems/actionmailer-3.2.1/lib/action_mailer

  7. ruby-on-rails - Rails 应用程序中的 Rails : How are you using application_controller. rb 是新手吗? - 2

    刚入门rails,开始慢慢理解。有人可以解释或给我一些关于在application_controller中编码的好处或时间和原因的想法吗?有哪些用例。您如何为Rails应用程序使用应用程序Controller?我不想在那里放太多代码,因为据我了解,每个请求都会调用此Controller。这是真的? 最佳答案 ApplicationController实际上是您应用程序中的每个其他Controller都将从中继承的类(尽管这不是强制性的)。我同意不要用太多代码弄乱它并保持干净整洁的态度,尽管在某些情况下ApplicationContr

  8. ruby-on-rails - form_for 中不在模型中的自定义字段 - 2

    我想向我的Controller传递一个参数,它是一个简单的复选框,但我不知道如何在模型的form_for中引入它,这是我的观点:{:id=>'go_finance'}do|f|%>Transferirde:para:Entrada:"input",:placeholder=>"Quantofoiganho?"%>Saída:"output",:placeholder=>"Quantofoigasto?"%>Nota:我想做一个额外的复选框,但我该怎么做,模型中没有一个对象,而是一个要检查的对象,以便在Controller中创建一个ifelse,如果没有检查,请帮助我,非常感谢,谢谢

  9. ruby - rspec 需要 .rspec 文件中的 spec_helper - 2

    我注意到像bundler这样的项目在每个specfile中执行requirespec_helper我还注意到rspec使用选项--require,它允许您在引导rspec时要求一个文件。您还可以将其添加到.rspec文件中,因此只要您运行不带参数的rspec就会添加它。使用上述方法有什么缺点可以解释为什么像bundler这样的项目选择在每个规范文件中都需要spec_helper吗? 最佳答案 我不在Bundler上工作,所以我不能直接谈论他们的做法。并非所有项目都checkin.rspec文件。原因是这个文件,通常按照当前的惯例,只

  10. ruby-on-rails - active_admin 目录中的常量警告重新声明 - 2

    我正在使用active_admin,我在Rails3应用程序的应用程序中有一个目录管理,其中包含模型和页面的声明。时不时地我也有一个类,当那个类有一个常量时,就像这样:classFooBAR="bar"end然后,我在每个必须在我的Rails应用程序中重新加载一些代码的请求中收到此警告:/Users/pupeno/helloworld/app/admin/billing.rb:12:warning:alreadyinitializedconstantBAR知道发生了什么以及如何避免这些警告吗? 最佳答案 在纯Ruby中:classA

随机推荐