BHO 中 HTMLDocumentEvents2 是怎样找进销存表格

记账软件版1楼: 有例子代码吗？我想获取 MouseDown 事件，来决定是否可以使用 NewWindow2

2楼: http://www.euromind.com/iedelphi/app.htm 如excel进销存系统

3楼: 用BHO可能会好一些

4楼: BHO怎样监听下载的东西？

5楼: unit uKiller;

{$WARN SYMBOL_PLATFORM OFF}

interface

uses
Windows, ActiveX, Classes, ComObj, Shdocvw, Dialogs, Variants;

type
TAdKillerBHO = class(TComObject, IObjectWithSite, IDispatch)
private
FIESite: IUnknown;
FIE: IWebBrowser2;
FCPC: IConnectionPointContainer;
FCP: IConnectionPoint;
FCookie: Integer;
protected
function SetSite(const pUnkSite: IUnknown): HResult; stdcall;
function GetSite(const riid: TIID; out site: IUnknown): HResult; stdcall;
function GetTypeInfoCount(out Count: Integer): HResult; stdcall;
function GetTypeInfo(Index, LocaleID: Integer; out TypeInfo): HResult;
stdcall;
function GetIDsOfNames(const IID: TGUID; Names: Pointer;

NameCount, LocaleID: Integer; DispIDs: Pointer): HResult; stdcall;
function Invoke(DispID: Integer; const IID: TGUID; LocaleID: Integer;
Flags: Word; var Params; VarResult, ExcepInfo, ArgErr: Pointer): HResult;
stdcall;
procedure DoBeforeNavigate2(const pDisp: IDispatch; var URL: OleVariant; var Flags: OleVariant;
var TargetFrameName: OleVariant; var PostData: OleVariant;
var Headers: OleVariant; var Cancel: WordBool);
end;

const
AdKillerBHO: TGUID = ＇＇{A692062A-11A1-461B-BE98-B520F01F96FC}＇＇;

implementation

uses ComServ, Sysutils, ComConst;

var
WM_ADKILLER: Cardinal;

{ TAdKillerBHO }

procedure TAdKillerBHO.DoBeforeNavigate2(const pDisp: IDispatch; var URL,
Flags, TargetFrameName, PostData, Headers: OleVariant; var Cancel: WordBool);
var
hOwner: THandle;
begin
if FIE.ToolBar = 0 then
begin
hOwner := FindWindow(＇＇TfrmAdKiller＇＇, PAnsiChar(＇＇秋风网页广告拦截器1.2＇＇));

if hOwner <> 0 then
begin
FIE.Quit;
PostMessage(hOwner, WM_ADKILLER, 0, GlobalAddAtom(PAnsiChar(VarToStrDef(URL, ＇＇＇＇))));
end;
end;
end;

function TAdKillerBHO.GetIDsOfNames(const IID: TGUID; Names: Pointer;
NameCount, LocaleID: Integer; DispIDs: Pointer): HResult;
begin
Result := E_NOTIMPL;
end;

function TAdKillerBHO.GetSite(const riid: TIID;
out site: IInterface): HResult;
begin
if Supports(FIESite, riid, site) then
Result := S_OK
else
Result := E_NOINTERFACE;
end;

function TAdKillerBHO.GetTypeInfo(Index, LocaleID: Integer;
out TypeInfo): HResult;
begin
Result := E_NOTIMPL;
pointer(TypeInfo) := nil;
end;

function TAdKillerBHO.GetTypeInfoCount(out Count: Integer): HResult;
begin
Result := E_NOTIMPL;
Count := 0;
end;

procedure BuildPositionalDispIds(pDispIds: PDispIdList; const dps: TDispParams);
var
i: integer;
begin
Assert(pDispIds <> nil);
for i := 0 to dps.cArgs - 1 do
pDispIds^[i] := dps.cArgs - 1 - i;
if (dps.cNamedArgs <= 0) then
Exit;
for i := 0 to dps.cNamedArgs - 1 do
pDispIds^[dps.rgdispidNamedArgs^[i]] := i;
end;

function TAdKillerBHO.Invoke(DispID: Integer; const IID: TGUID;
LocaleID: Integer; Flags: Word; var Params; VarResult, ExcepInfo,
ArgErr: Pointer): HResult;
var
dps: TDispParams absolute Params;
bHasParams: boolean;
pDispIds: PDispIdList;
iDispIdsSize: integer;
begin
pDispIds := nil;
iDispIdsSize := 0;
bHasParams := (dps.cArgs > 0);
if (bHasParams) then
begin
iDispIdsSize := dps.cArgs * SizeOf(TDispId);
GetMem(pDispIds, iDispIdsSize);
end;
try
if (bHasParams) then
BuildPositionalDispIds(pDispIds, dps);
Result := S_OK;
case DispId of
250:
DoBeforeNavigate2(IDispatch(dps.rgvarg^[pDispIds^[0]].dispval),
POleVariant(dps.rgvarg^[pDispIds^[1]].pvarval)^,
POleVariant(dps.rgvarg^[pDispIds^[2]].pvarval)^,
POleVariant(dps.rgvarg^[pDispIds^[3]].pvarval)^,
POleVariant(dps.rgvarg^[pDispIds^[4]].pvarval)^,
POleVariant(dps.rgvarg^[pDispIds^[5]].pvarval)^,
dps.rgvarg^[pDispIds^[6]].pbool^);
253:
FCP.Unadvise(FCookie);
else
Result := DISP_E_MEMBERNOTFOUND;
end;
finally
if (bHasParams) then FreeMem(pDispIds, iDispIdsSize);
end;
end;

function TAdKillerBHO.SetSite(const pUnkSite: IInterface): HResult;
begin
Result := E_FAIL;
FIESite := pUnkSite;
if not Supports(FIESite, IWebBrowser2, FIE) then Exit;
if not Supports(FIE, IConnectionPointContainer, FCPC) then Exit;
FCPC.FindConnectionPoint(DWebBrowserEvents2, FCP);
FCP.Advise(Self, FCookie);
Result := S_OK;
end;

procedure DeleteRegKeyValue(Root: DWORD; Key: string; ValueName: string = ＇＇＇＇);
var
KeyHandle: HKEY;
begin
if ValueName = ＇＇＇＇ then

RegDeleteKey(Root, PChar(Key));
if RegOpenKey(Root, PChar(Key), KeyHandle) = ERROR_SUCCESS then
try
RegDeleteValue(KeyHandle, PChar(ValueName));
finally
RegCloseKey(KeyHandle);
end;
end;

procedure CreateRegKeyValue(Root: DWORD; const Key, ValueName, Value: string);
var
Handle: HKey;
Status, Disposition: Integer;
begin
Status := RegCreateKeyEx(ROOT, PChar(Key), 0, ＇＇＇＇,
REG_OPTION_NON_VOLATILE, KEY_READ or KEY_WRITE, nil, Handle,
@Disposition);
if Status = 0 then
begin
Status := RegSetValueEx(Handle, PChar(ValueName), 0, REG_SZ,
PChar(Value), Length(Value) + 1);
RegCloseKey(Handle);
end;
if Status <> 0 then
raise EOleRegistrationError.CreateRes(@SCreateRegKeyError);
end;

type
TIEAdvBHOFactory = class(TComObjectFactory)
public
procedure UpdateRegistry(Register: Boolean); override;
end;

{ TIEAdvBHOFactory }

procedure TIEAdvBHOFactory.UpdateRegistry(Register: Boolean);

begin
inherited;
if Register then
CreateRegKeyValue(HKEY_LOCAL_MACHINE, ＇＇Software＼Microsoft＼Windows＼CurrentVersion＼explorer＼Browser Helper Objects＼＇＇ + GuidToString(ClassID), ＇＇＇＇, ＇＇＇＇)
else
DeleteRegKeyValue(HKEY_LOCAL_MACHINE, ＇＇Software＼Microsoft＼Windows＼CurrentVersion＼explorer＼Browser Helper Objects＼＇＇ + GuidToString(ClassID), ＇＇＇＇);
end;

initialization
TIEAdvBHOFactory.Create(ComServer, TAdKillerBHO, AdKillerBHO,
＇＇TAdKillerBHO＇＇, ＇＇＇＇, ciMultiInstance, tmApartment);
WM_ADKILLER := RegisterWindowMessage(＇＇AdKiller＇＇);
end.

6楼: 弹出窗口我用了另外一个方法，通过 CanOpen 变量决定 NewWindow2 的值
缺点是任务未停止就不能开新窗口了，所以我还想观察 document 的鼠标点击事件，但不会
我现在的问题主要是想过滤一些图片或Flash或其它网页内容

DISPID_NAVIGATECOMPLETE2: begin
if FWebBrowser.LocationURL=TDispParams(Params).rgvarg[0].pvarVal^ then
begin
for m:=0 to 254 do
begin

if MyTask[m]=0 then
begin
F_Time[m] :=Time();
while F_Time[m]=0 do
begin
SLEEP(100);
F_Time[m] :=Time();
end;

UrlTask[m]:=FWebBrowser.LocationURL;
StrTemp :=＇＇开始任务＇＇+IntToStr(m)+＇＇：＇＇+UrlTask[m];
InternalLogEvent(StrTemp);
MyTask[m] :=1;
CanOpen:=False;
Break;
end;
end;

if MyTask[254]=1 then FEventsDlg.ClearLog_BtnClick(nil);
end;
end;

DISPID_DOCUMENTCOMPLETE: begin
for m:=0 to 254 do
begin
if UrlTask[m]=TDispParams(Params).rgvarg[0].pvarVal^ then
begin
E_Time[m]:=Time();
while E_Time[m]=0 do
begin
SLEEP(100);
E_Time[m] :=Time();
end;
DecodeTime(E_Time[m]-F_Time[m], Hour, Min, Sec, MSec);
StrTemp:=＇＇结束任务＇＇+IntToStr(m)+＇＇：＇＇+TimeToStr(F_Time[m])+＇＇ - ＇＇+TimeToStr(E_Time[m])

+＇＇使用了＇＇+IntToStr(3600*Hour+60*Min+Sec)+＇＇.＇＇+IntToStr(MSec)+＇＇秒＇＇;
InternalLogEvent(StrTemp);
MyTask[m]:=0;
CanOpen:=True;
Break;
end;
end;
end;

DISPID_NewWindow2: begin
if NOT(CanOpen) then
begin
InternalLogEvent(＇＇过滤了弹出窗口!＇＇);
TDispParams(Params).rgvarg[0].pvarVal^:= False;
end;
end;

记账软件版7楼: 找到了一份笔记，调试通过了
http://www.delphibbs.com/keylife/iblog_show.asp？xid=606

我现在想把下载的路径改掉，有什么方法？

8楼: 路径就是ｓｔａｒｔ方法的第一个参数

9楼: 我把第一个参数改了，但还是不行

10楼: 成功获取了 HTMLDocumentEvents2，网页事件，如鼠标点击等
HTMLDocument:= FWebBrowser.Document as IHTMLDocument2;
InterfaceConnect(HTMLDocument, HTMLDocumentEvents2, Self, FConnection);

看了源码，事件相对的 ID，然后在 Invoke 里定义要处理的东西就好了
我加了
-600: begin
CanOpen:= True;
Sleep(100);
CanOpen:= False;
end;

HTMLDocumentEvents2 = dispinterface
[＇＇{3050F613-98B5-11CF-BB82-00AA00BDCE0B}＇＇]
function onhelp(const pEvtObj: IHTMLEventObj): WordBool; dispid -2147418102;
function onclick(const pEvtObj: IHTMLEventObj): WordBool; dispid -600;
function ondblclick(const pEvtObj: IHTMLEventObj): WordBool; dispid -601;
procedure onkeydown(const pEvtObj: IHTMLEventObj); dispid -602;
procedure onkeyup(const pEvtObj: IHTMLEventObj); dispid -604;
function onkeypress(const pEvtObj: IHTMLEventObj): WordBool; dispid -603;
procedure onmousedown(const pEvtObj: IHTMLEventObj); dispid -605;
procedure onmousemove(const pEvtObj: IHTMLEventObj); dispid -606;
procedure onmouseup(const pEvtObj: IHTMLEventObj); dispid -607;
procedure onmouseout(const pEvtObj: IHTMLEventObj); dispid -2147418103;
procedure onmouseover(const pEvtObj: IHTMLEventObj); dispid -2147418104;
procedure onreadystatechange(const pEvtObj: IHTMLEventObj); dispid -609;

function onbeforeupdate(const pEvtObj: IHTMLEventObj): WordBool; dispid -2147418108;
procedure onafterupdate(const pEvtObj: IHTMLEventObj); dispid -2147418107;
function onrowexit(const pEvtObj: IHTMLEventObj): WordBool; dispid -2147418106;
procedure onrowenter(const pEvtObj: IHTMLEventObj); dispid -2147418105;
function ondragstart(const pEvtObj: IHTMLEventObj): WordBool; dispid -2147418101;
function onselectstart(const pEvtObj: IHTMLEventObj): WordBool; dispid -2147418100;
function onerrorupdate(const pEvtObj: IHTMLEventObj): WordBool; dispid -2147418099;
function oncontextmenu(const pEvtObj: IHTMLEventObj): WordBool; dispid 1023;
function onstop(const pEvtObj: IHTMLEventObj): WordBool; dispid 1026;
procedure onrowsdelete(const pEvtObj: IHTMLEventObj); dispid -2147418080;
procedure onrowsinserted(const pEvtObj: IHTMLEventObj); dispid -2147418079;
procedure oncellchange(const pEvtObj: IHTMLEventObj); dispid -2147418078;
procedure onpropertychange(const pEvtObj: IHTMLEventObj); dispid -2147418093;
procedure ondatasetchanged(const pEvtObj: IHTMLEventObj); dispid -2147418098;
procedure ondataavailable(const pEvtObj: IHTMLEventObj); dispid -2147418097;
procedure ondatasetcomplete(const pEvtObj: IHTMLEventObj); dispid -2147418096;
procedure onbeforeeditfocus(const pEvtObj: IHTMLEventObj); dispid 1027;
end;

11楼: 第一个参数是系统传给你的,告诉你他要获得那个url,你根据这儿url去判断到那里去取数据,比如告诉你http://www.google.com,在你的算法里,这个对应c:＼google.htm,你就去读c:＼google.htm,然后传回系统(使用start传给你的OIProtSink)

12楼: to satanmonkey, 有例程吗？不是很明白如进销存数据库设计

13楼: app的资料看这里

http://www.euromind.com/iedelphi/app.htm

记账软件版14楼: 过滤网页元素，是否定时循环网页元素，然后替换？

15楼: 一次应该就够了.不过如果人家是用循环来检查是否被你屏蔽的话.你也需要循环.

16楼: 等页面下载完成再比较？其实用什么方法替换广告内容好？
我看了一下MYIE的原码，找不到相应的位置

终于找到相应的位置了，是在 IE 的 OnProgressChange 里面处理的
每发生一次这个事件，就执行一次 javascript

17楼: 不下载完是得不到IHTMLDocument2的

你要在下载过程中,可以用app,不过难度就不是一般的大.

18楼: app 只能禁止下载和替换下载的路径。如果我想在那个位置的内容
例如改为‘被过滤的广告’文字来表示
这样就不能用 app 吧？

19楼: http://www.euromind.com/iedelphi/app/mimefilter.htm

例子将网页中的字符Delphi替换为Borland Inprise
例子中的page1.htm在IE中打开最下面的链接是 IE & Delphi使用例子程序打开变成 IE & Borland Inprise。经测试对HTML标签同样有效

20楼: 我刚看了一下源码，好象是通过ReportData来取数据的，然后替换字符串
这样替换起来比较复杂
如果用元素的方法比较方便

记账软件版21楼: 用app的思路是,自己写个app替换原来的http的app,在自己的app调用原始的app取得数据,然后修改,再传给ie

22楼: 我现在的想法是 app 加网页元素的过滤方法
app 禁止下载，元素是替换那个HTML内容如进销存表格

23楼: IE已经可以实现了自己过滤广告，我认为可以脱离IE插件的思路，用FindWindow等函数枚举窗口，或者用Windows窗口Hook技术都可以。使用APP的mimefilter不是好主意，因为涉及到分析Html的问题，而且现在的广告大部分都是通过复杂的脚本来实现，有的已经能够跳过IE的过滤系统。脚本分析起来难度很大，而且用在产品里搞不好会破坏页面的布局，实用性不强。

24楼: to 爱元元的哥哥：你指的是过滤弹出窗口？还是包含网页元素（＇＇iframe＇＇,＇＇img＇＇,＇＇embed＇＇,＇＇object＇＇）？

25楼: 浮动广告一般好像是把z-index大于多少的都关了就可以了.

爱元元的哥哥明显说的是弹出窗口

26楼: [:D]，页面内浮动广告怎么定义呢？z-index本来就是HTML规范所支持的效果，你怎么来判定它是广告呢？

27楼: 浮动的一般z-index都是最上层.如果某个层只有一个div,而且位置老变,就可以判定是广告.
当然准确率不是100%

记账软件版28楼: 为什么javascript可以使用 objs.outerhtml=＇＇<广告>＇＇;（在delphi调用javascript也没有问题）
而直接用delphi的网页元素不行呢？我这里会提示出错~
objs是网页元素来的

29楼: ＂直接用delphi的网页元素＂

这个是什么意思

30楼: img:IHTMLElement
img:= imgList.item(i,EmptyParam) as IHTMLElement;
img.outerhtml:= ＇＇Test＇＇;（出错）

31楼: str:olevariant
...
str:=＇＇test＇＇;
...
img.outerhtml:=str;

32楼: 还是不行
Str_AD: OleVariant;

imgList:= HTMLDocument.all;
Str_AD:= ＇＇＇＇;
for i:= 0 to imgList.length-1 do begin
img:= imgList.item(i,EmptyParam) as IHTMLElement;
if LowerCase(img.tagName)=＇＇img＇＇ then
begin
img.outerHTML:= Str_AD; //出错
end;
end;

33楼: 出什么错？？？？？？？？

34楼: Microsoft Internet Explorer 遇到问题需要关闭。....
提示这个错误 Offset: 000673a7

如果把 img.outerhtml 这句注释了就没问题了

记账软件版35楼: 你这段代码放什么事件里了？

36楼: DISPID_DOCUMENTCOMPLETE

37楼: 试试写innerHTML

38楼: 试过了，也不行

39楼: 你要替换img,你直接取(wb1.Document as IHTMLDocument2).images不要取判断tagname

40楼: 不是替换img，是把这个元素改为其它
通过delphi掉用Javascript是可以的，
但我不想用Javascipt来实现

41楼: 我随便写了个,没发现你说的问题啊

unit Unit1;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, OleCtrls, SHDocVw,mshtml;

type
TForm1 = class(TForm)
wb1: TWebBrowser;
procedure FormCreate(Sender: TObject);
procedure wb1DocumentComplete(Sender: TObject; const pDisp: IDispatch;
var URL: OleVariant);
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
begin
wb1.Navigate(＇＇c:＼aa.html＇＇);
end;

procedure TForm1.wb1DocumentComplete(Sender: TObject;
const pDisp: IDispatch; var URL: OleVariant);
var
doc:IHTMLDocument2;
img:IHTMLElement;
begin
doc:=wb1.Document as IHTMLDocument2;
img:=doc.images.item(null,0) as IHTMLElement;
img.outerHTML:=＇＇dddd＇＇;
end;

end.

html为

Untitled Document

记账软件版42楼: 看了下,似乎是你这句的问题

img:= imgList.item(i,EmptyParam) as IHTMLElement;

item第一个参数是名字,第二个才是索引.你似乎用反了

43楼: img:= imgList.item(i,EmptyParam) as IHTMLElement;
这句没错呀
showmessagebox(img.tagname)
可以获取到网页的元素标记

44楼: 看我写的那些代码没有？可以成功替换,不出任何问题.不知道你那里是这么回事

45楼: 你试一下，有两个图的元素，会怎样？

46楼: 多图片也正常
procedure TForm1.wb1DocumentComplete(Sender: TObject;
const pDisp: IDispatch; var URL: OleVariant);
var
doc:IHTMLDocument2;
img:IHTMLElement;
i:Integer;
olei:OleVariant;
begin
doc:=wb1.Document as IHTMLDocument2;
for i:=0 to 4 do
begin
olei:=i;
img:=nil;
img:=doc.images.item(EmptyParam,olei) as IHTMLElement;
img.outerHTML:=＇＇dddd＇＇+inttostr(i);
end;
end;

---------------

Untitled Document