Попробуй... например вот так : | Код | var Form1: TForm1; bRes:DWord=0;
implementation
{$R *.dfm}
//...
function ChangeFunc(sDWord:DWord):DWord; var DLL:DWord; fH:Pointer; OP:DWord; t:DWord; begin Result:=0; DLL:=LoadLibrary('user32.dll'); if DLL<>0 then begin fH:=GetProcAddress(DLL,'MessageBoxIndirectW'); if fH<>nil then begin OP:=OpenProcess(PROCESS_ALL_ACCESS,false,GetCurrentProcessID); if OP<>0 then begin ReadProcessMemory(OP,fH,@Result,4,t); WriteProcessMemory(OP,fH,@sDWord,4,t); CloseHandle(OP); end; end; FreeLibrary(DLL); end; end;
procedure TForm1.WebBrowser1NavigateComplete2(Sender: TObject; const pDisp: IDispatch; var URL: OleVariant); begin bRes:=ChangeFunc($c3c031); //ставим заглушку end;
procedure TForm1.WebBrowser1DocumentComplete(Sender: TObject; const pDisp: IDispatch; var URL: OleVariant); var i,j,n:integer; s,sb,se:string; begin if bRes<>0 then ChangeFunc(bRes); //первые скрипты обработаны и такая заглушка в принципе больше не нужна bRes:=0; //дальше: пытаемся вырезать из скриптов на странице windows.close(); if (Webbrowser1.Document<>nil) then if IDispatch(Variant(Webbrowser1.Document).scripts)<>nil then begin i:=Variant(Webbrowser1.Document).scripts.length; for j:=0 to i-1 do begin try s:=lowercase(trim(WideString(Variant(Webbrowser1.Document).scripts.item(j).outerHTML))); n:=Pos('window.close();',s); //На самом деле может записанна вот так: windows. close () ; и так windows . close () ; - Мне лень делать на все случаи жизни... :) if n<>0 then begin sb:=Copy(s,1,n-1); se:=Copy(s,n+15,Length(s)); s:=sb+se; Variant(Webbrowser1.Document).scripts.item(j).outerHTML:=WideString(s); end; except end; end; end; end; //...
|
PS: Можно просто засунуть в OnCreate формы только вот енто ChangeFunc($c3c031), а весь остальной код выкинуть(кроме самой конечно функции ChangeFunc)... если ты конечно уверен что MessageBoxIndirectW - тебе не нужен. |