關(guān)于delphiwebbrowser二次點擊來路問題

sumstars 2014-11-19

展開全文

webbrowser二次點擊webb可以實現(xiàn)二次點擊但是二次點擊的來路為空。這里先說明一下為什么是沒有來路的。
二次點擊的代碼本質(zhì)是2個內(nèi)置瀏覽器webbrowser，webb1點擊的網(wǎng)頁的時候把新打開的網(wǎng)頁地址賦值給webb2去打開。就相當(dāng)于webb是從新打開了一個新的地址，來路當(dāng)然是空的。下面的代碼附上解決的辦法。
代碼比較長我把關(guān)鍵的地方標(biāo)注一下
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次來路不統(tǒng)一的地方
self.Timer12.Interval:=100;
self.Timer12.Enabled:=true;
end;

procedure TForm1.Timer12Timer(Sender: TObject);
begin
self.Timer12.Enabled:=false;
MyNavigate (curUrl);////這里比較關(guān)鍵
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; //停留等鼠標(biāo)移動幾秒后，開始點擊///////////////////////////////////////////////////////////////
self.Timer13.Enabled:=true;
end;

procedure TForm1.MyNavigate(url: string);
var
Flags, Headers, TargetFrameName, PostData: OLEVariant;
begin
Flags := ”;
TargetFrameName := ”;
PostData := ”;
EmbeddedWB1.Stop;//這是設(shè)置來路的函數(shù)
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’); //禁止動態(tài)添加事件
Doc2.parentWindow.execScript(‘function document.createElement(){return;}’,'Javascript’);//禁止動態(tài)創(chuàng)建
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./html/ribenrentiyishu/200912/03-1095.html’);
self.EmbeddedWB1.Navigate(‘http://180.123.89.103/’);
DeleteIECache;
end;