关于delphiwebbrowser二次点击来路问题

webbrowser二次点击webb可以实现二次点击但是二次点击的来路为空。这里先说明一下为什么是没有来路的。
二次点击的代码本质是2个内置浏览器webbrowser,webb1点击的网页的时候把新打开的网页地址赋值给webb2去打开。就相当于webb是从新打开了一个新的地址,来路当然是空的。下面的代码附上解决的办法。

代码比较长 我把关键的地方标注一下
var
  curUrl:string;///定义的地址变量
implementation
{$R *.dfm}
procedure TForm1.EmbeddedWB1NewWindow3(ASender: TObject;
  var ppDisp: IDispatch; var Cancel: WordBool; dwFlags: Cardinal;
  const bstrUrlContext, bstrUrl: WideString);
begin
  Cancel := True;
  curUrl:=bstrUrl;///这里是解决2次来路不统一的地方
  self.Timer12.Interval:=100;
  self.Timer12.Enabled:=true;
end;

procedure TForm1.Timer12Timer(Sender: TObject);
begin
  self.Timer12.Enabled:=false;
  MyNavigate (curUrl);这里比较关键
end;

procedure TForm1.Button3Click(Sender: TObject);
begin

 DelCookie;
  DeleteIECache;
swzjl := EmbeddedWB1.LocationURL;
  if swzjl <> swz then
  begin
    timer5.Enabled := true;
  end;
  if swzjl = swz then
  begin
    timer6.Enabled := true;
  end;
end;

procedure TForm1.Timer2Timer(Sender: TObject);
begin
  self.Timer11.Enabled:=true;
  self.Timer13.Interval:=5000;  //停留等鼠标移动几秒后,开始点击///
  self.Timer13.Enabled:=true;
end;

procedure TForm1.MyNavigate(url: string);
var
  Flags, Headers, TargetFrameName, PostData: OLEVariant;
begin
  Flags := ”;
  TargetFrameName := ”;
  PostData := ”;
  EmbeddedWB1.Stop;//这是设置来路的函数
  Headers := ‘Referer:’+self.EmbeddedWB1.LocationURL+#10#13;
  EmbeddedWB1.Navigate(url,Flags, TargetFrameName, PostData, Headers);
end;

procedure TForm1.CloseSound;
var
  hDSound: Cardinal;
  pDirectSoundCreate: Pointer;
  hWinmm: Cardinal;
  pmidiStreamOpen: Pointer;
  pwaveOutWrite: Pointer;
  lp: Cardinal;
begin
  try
    hDSound := LoadLibrary(‘DSound.dll’);
    if hDSound > 0 then
      pDirectSoundCreate := GetProcAddress(hDSound, ‘DirectSoundCreate’);
    if pDirectSoundCreate <> nil then
    begin
      VirtualProtect(pDirectSoundCreate, 3, PAGE_EXECUTE_READWRITE, lp);
      Move(#$C2#$0C#$00, pDirectSoundCreate^, 3);
    end;

    hWinmm := LoadLibrary(‘Winmm.dll’);
    if hWinmm > 0 then
      pmidiStreamOpen := GetProcAddress(hWinmm, ‘midiStreamOpen’);
    if pmidiStreamOpen <> nil then
    begin
      VirtualProtect(pmidiStreamOpen, 3, PAGE_EXECUTE_READWRITE, lp);
      Move(#$C2#$04#$00, pmidiStreamOpen^, 3);
    end;

    if hWinmm > 0 then
      pwaveOutWrite := GetProcAddress(hWinmm, ‘waveOutWrite’);
    if pwaveOutWrite <> nil then
    begin
      VirtualProtect(pwaveOutWrite, 3, PAGE_EXECUTE_READWRITE, lp);
      Move(#$C2#$0C#$00, pwaveOutWrite^, 3);
    end;
  except
  end;
end;

procedure TForm1.EmbeddedWB1NavigateComplete2(ASender: TObject;
  const pDisp: IDispatch; var URL: OleVariant);
var
  Doc2:IHTMLDocument2;
begin
  Doc2:=EmbeddedWB1.Document as IHTMLDocument2;
  Doc2.parentWindow.execScript(‘function open(){return;}’,'Javascript’);
  Doc2.parentWindow.execScript(‘function alert(){return;}’,'Javascript’);
  Doc2.parentWindow.execScript(‘function confirm(){return;}’,'Javascript’);
  Doc2.parentWindow.execScript(‘function showModalDialog(){return;}’,'Javascript’);
  Doc2.parentWindow.execScript(‘function attachEvent(){return;}’,'Javascript’); //禁止动态添加事件
  Doc2.parentWindow.execScript(‘function document.createElement(){return;}’,'Javascript’);//禁止动态创建
end;
function TForm1.EmbeddedWB1ShowMessage(Sender: TObject; HWND: Cardinal;
  lpstrText, lpstrCaption: PWideChar; dwType: Integer;
  lpstrHelpFile: PWideChar; dwHelpContext: Integer;
  var plResult: Integer): HRESULT;
begin
  result:=s_OK;     //禁止弹出各种脚本对话框
end;
procedure TForm1.Button9Click(Sender: TObject);
begin
  //self.EmbeddedWB1.Navigate(‘http://www.jlrenti.com/html/ribenrentiyishu/200912/03-1095.html’);
self.EmbeddedWB1.Navigate(‘http://180.123.89.103/’);
  DeleteIECache;
end;

  • 0
    点赞
  • 0
    收藏
    觉得还不错? 一键收藏
  • 0
    评论
评论
添加红包

请填写红包祝福语或标题

红包个数最小为10个

红包金额最低5元

当前余额3.43前往充值 >
需支付:10.00
成就一亿技术人!
领取后你会自动成为博主和红包主的粉丝 规则
hope_wisdom
发出的红包
实付
使用余额支付
点击重新获取
扫码支付
钱包余额 0

抵扣说明:

1.余额是钱包充值的虚拟货币,按照1:1的比例进行支付金额的抵扣。
2.余额无法直接购买下载,可以购买VIP、付费专栏及课程。

余额充值