如何在自己的程序中确定指定网页中的按钮被单击了!--- 送1000分,请给出实现的代码,纸上谈兵的勿来! ( 积分: 300 )

呵呵,WebEvent在Delphi中默认情况下好像不存在哟:)
那个可能是自己写的或是第三方单元~
 
这个问题如果是在自己写的浏览器中就很容易办到了,如果在其他人上网上点击想知道的话可以用Javascript来实现,也就是那个Botton的OnClick=“Javascript事件”就可以了,在这时大多是用Javascript来调用一个动态页面来实现(比如用PHP写的一个动态页面),这个动态页面可以把当前用户的一些信息写回网站的数据库,不知道“setwin”兄到底是要如何的功能,这些只是我对问题的理解,如果那里不对,还请不吝赐教!
 
unit WebEvent;
{*****************************************************************
拦截Web页面上的事件的组件 by Lichaohui 2002-12-21

*****************************************************************}
interface

uses
Windows, Messages, SysUtils, Classes, ActiveX, ComObj,
OleCtrls, SHDocVw, {$IFDEF LZH911}StrCtn,{$ENDIF} MsHtml;

type
{ $message '支持多种事件添加模式,目前尚没有完成'}
//TAttachMode = (etAttach, etInstead, etConnect);

TWebEvt = procedure(Sender: IWebBrowser; event: OleVariant;
SrcElement: OleVariant) of object;

TWebEvents = class;
TWebEventItem = class;

{ TWebEvent }

TWebEvent = class(TComponent, IUnknown, IDispatch)
private
FEvtSource: IWebBrowser;
FWebEvents: TWebEvents;
//Fatm: TAttachMode;
procedure SetEvtSource(const Value: IWebBrowser);
procedure SetWebEvents(const Value: TWebEvents);
{$IFDEF LZH911}
function GetAboutStr: TAboutString;
procedure SetAboutStr(const Value: TAboutString);
{$ENDIF}
function GetEtf: String;
function GetObjLst: String;
function GetPgs: String;
function GetStg: String;
procedure SetEtf(const Value: String);
procedure SetObjLst(const Value: String);
procedure SetPgs(const Value: String);
procedure SetStg(const Value: String);
function GetOnEvent: TWebEvt;
procedure SetOnEvent(const Value: TWebEvt);
protected
DefEvent: TWebEvents;
procedure CheckDef;
procedure Notification(AComponent: TComponent; Operation: TOperation); override;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
function MatchPage(PageName: String): Boolean;
procedure AttachEvents;
published
{$IFDEF LZH911}
property About: TAboutString read GetAboutStr write SetAboutStr stored 0;
{$ENDIF}
property EvtSource: IWebBrowser read FEvtSource write SetEvtSource;
property OnEvent: TWebEvt read GetOnEvent write SetOnEvent;
property StandardTags: String read GetStg write SetStg;
property ObjectList: String read GetObjLst write SetObjLst;
property EventsToFire: String read GetEtf write SetEtf;
property PagesToRecv: String read GetPgs write SetPgs;
//property AttachMode: TAttachMode read Fatm write Fatm;
property WebEvents: TWebEvents read FWebEvents write SetWebEvents;
end;

{ TWebEvents }

TWebEvents = class(TCollection)
private
FOwner: TWebEvent;
function GetItem(Idx: Integer): TWebEventItem;
procedure SetItem(Idx: Integer; const Value: TWebEventItem);
protected
procedure Update(Item: TCollectionItem); override;
function GetOwner: TPersistent; override;
public
constructor Create(AOwner: TWebEvent);
function Add: TWebEventItem;
property Items[Idx: Integer]: TWebEventItem read GetItem write SetItem; default;
end;

{ TWebEventItem }

TWebEventItem = class(TCollectionItem, IUnknown, IDispatch)
private
FOnEvent: TWebEvt;
FObjLst: String;
FPgs: String;
FEtf: String;
FStg: String;
FPages: TStringList;
FEvents: TStringList;
FSdTags: TStringList;
FObjects: TStringList;
//Fatm: TAttachMode;
function GetEvtSource: IWebBrowser;
procedure SetEtf(const Value: String);
procedure SetObjLst(const Value: String);
procedure SetPgs(const Value: String);
procedure SetStg(const Value: String);
protected
FRefCount: Integer;
{ IUnknown }
function QueryInterface(const IID: TGUID; out Obj): HResult; stdcall;
function _AddRef: Integer; stdcall;
function _Release: Integer; stdcall;
{ IDispatch }
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;
// Call by innternal
procedure InitAttach;
function InPages(PageName: String): Boolean;
function InTags(TagName: String): Boolean;
function InEvts(EvtName: String): Boolean;
function InObjs(ObjName: String): Boolean;
procedure FinitAttach;
procedure AttachDocEvents(ADoc: IDispatch);
procedure AttachExtraEvents;
procedure AttachFrameEvents;
public
constructor Create(Collection: TCollection); override;
destructor Destroy; override;
procedure Assign(Source: TPersistent); override;
procedure AttachEvents;
function MatchPage(PageName: String): Boolean;
property EvtSource: IWebBrowser read GetEvtSource;
published
property OnEvent: TWebEvt read FOnEvent write FOnEvent;
property StandardTags: String read FStg write SetStg;
property ObjectList: String read FObjLst write SetObjLst;
property EventsToFire: String read FEtf write SetEtf;
property PagesToRecv: String read FPgs write SetPgs;
//property AttachMode: TAttachMode read Fatm write Fatm;
end;


{$IFNDEF LZH911}
procedure Register;
{$ENDIF}

implementation

{$IFNDEF LZH911}
procedure Register;
begin
//安装组件到系统页
RegisterComponents('System', [TWebEvent]);
end;
{$ENDIF}


{ TWebEvent }

constructor TWebEvent.Create(AOwner: TComponent);
begin
FWebEvents := TWebEvents.Create(Self);
DefEvent := TWebEvents.Create(Self);
inherited;
end;

destructor TWebEvent.Destroy;
begin
DefEvent.Free;
FWebEvents.Free;
inherited;
end;

procedure TWebEvent.SetEvtSource(const Value: IWebBrowser);
begin
FEvtSource := Value;
if Assigned(FEvtSource) then
begin
//FEvtSource.FreeNotification(Self);
end;
end;

procedure TWebEvent.Notification(AComponent: TComponent;
Operation: TOperation);
begin
inherited Notification(AComponent, Operation);
//if (Operation = opRemove) and (AComponent = FEvtSource) then
// FEvtSource := nil;
end;

procedure TWebEvent.AttachEvents;
var
i: Integer;
begin
for i := 0 to DefEvent.Count - 1 do
DefEvent.AttachEvents;
for i := 0 to FWebEvents.Count - 1 do
FWebEvents.AttachEvents;
end;

function TWebEvent.MatchPage(PageName: String): Boolean;
var
s: String;
p: Integer;
st: TStrings;
begin
s := LowerCase(Trim(ExtractFileName(PageName)));
p := Pos('.', s);
if p > 0 then s := Copy(s, 1, p - 1);
st := TStringList.Create;
try
st.CommaText := StringReplace(PagesToRecv, ';', ',', [rfReplaceAll]);
Result := (st.Count = 0) or (st.IndexOf(s) >= 0);
finally
st.Free;
end;
end;

procedure TWebEvent.SetWebEvents(const Value: TWebEvents);
begin
FWebEvents.Assign(Value);
end;

{$IFDEF LZH911}
function TWebEvent.GetAboutStr: TAboutString;
begin
Result := GetAboutString1;
end;

procedure TWebEvent.SetAboutStr(const Value: TAboutString);
begin
{ do nothing };
end;
{$ENDIF}

function TWebEvent.GetEtf: String;
begin
CheckDef;
Result := DefEvent.Items[0].EventsToFire;
end;

function TWebEvent.GetObjLst: String;
begin
CheckDef;
Result := DefEvent.Items[0].ObjectList;
end;

function TWebEvent.GetPgs: String;
begin
CheckDef;
Result := DefEvent.Items[0].PagesToRecv;
end;

function TWebEvent.GetStg: String;
begin
CheckDef;
Result := DefEvent.Items[0].StandardTags;
end;

procedure TWebEvent.SetEtf(const Value: String);
begin
CheckDef;
DefEvent.Items[0].EventsToFire := Value;
end;

procedure TWebEvent.SetObjLst(const Value: String);
begin
CheckDef;
DefEvent.Items[0].ObjectList := Value;
end;

procedure TWebEvent.SetPgs(const Value: String);
begin
CheckDef;
DefEvent.Items[0].PagesToRecv := Value;
end;

procedure TWebEvent.SetStg(const Value: String);
begin
CheckDef;
DefEvent.Items[0].StandardTags := Value;
end;

procedure TWebEvent.CheckDef;
begin
if DefEvent.Count < 1 then DefEvent.Add;
end;

function TWebEvent.GetOnEvent: TWebEvt;
begin
CheckDef;
Result := DefEvent.Items[0].OnEvent;
end;

procedure TWebEvent.SetOnEvent(const Value: TWebEvt);
begin
CheckDef;
DefEvent.Items[0].OnEvent := Value;
end;

{ TWebEvents }

function TWebEvents.Add: TWebEventItem;
begin
Result:=TWebEventItem(inherited Add);
end;

constructor TWebEvents.Create(AOwner: TWebEvent);
begin
inherited Create(TWebEventItem);
FOwner := AOwner;
end;

function TWebEvents.GetItem(Idx: Integer): TWebEventItem;
begin
Result := TWebEventItem(inherited GetItem(Idx));
end;

function TWebEvents.GetOwner: TPersistent;
begin
Result := FOwner;
end;

procedure TWebEvents.SetItem(Idx: Integer; const Value: TWebEventItem);
begin
inherited SetItem(Idx, Value);
end;

procedure TWebEvents.Update(Item: TCollectionItem);
begin
inherited;
end;

{ TWebEventItem }

constructor TWebEventItem.Create(Collection: TCollection);
begin
inherited;
end;

destructor TWebEventItem.Destroy;
begin
FinitAttach;
inherited;
end;


function TWebEventItem._AddRef: Integer;
begin
Inc(FRefCount);
Result := FRefCount;
end;

function TWebEventItem._Release: Integer;
begin
Dec(FRefCount);
Result := FRefCount;
end;

function TWebEventItem.QueryInterface(const IID: TGUID; out Obj): HResult;
begin
if GetInterface(IID, Obj) then
Result := S_OK
else
Result := E_NOINTERFACE;
end;

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

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

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

function TWebEventItem.Invoke(DispID: Integer; const IID: TGUID;
LocaleID: Integer; Flags: Word; var Params; VarResult, ExcepInfo,
ArgErr: Pointer): HResult;
var
vDoc: OleVariant;
vEle: OleVariant;
vEvt: OleVariant;
begin
Result := S_OK;
if Assigned(FOnEvent) and Assigned(EvtSource) then
begin
vDoc := EvtSource.Document;
vEvt := vDoc.parentWindow.event;
vEle := vEvt.srcElement;
FOnEvent(EvtSource, vEvt, vEle);
end;
end;

procedure TWebEventItem.AttachEvents;
var
Doc: IDispatch;
begin
{ $message '此方法需要进一步优化,加快速度和避免重复触发'
程序的目的,扫描页面中的所有元素,给符合条件的
设定事件,此外还需要对特殊对象的事件进行处理
如:document,window 目前仅处理这两个
目前,已经将IndexOf 改为Find了,进行排序后的二分查找,
可以从一定程度上加快速度
}
if not Assigned(EvtSource) then Exit;
//准备进行扫描,初始化扫描过程
InitAttach;
try
Doc := EvtSource.Document;
if Assigned(Doc) then
begin
//给特殊对象的事件赋值
AttachExtraEvents;
AttachFrameEvents;
AttachDocEvents(Doc);
end; //if Assigned(Doc)
//结束扫描
finally
//结束扫描,释放无用的对象
FinitAttach;
end;
end;

function TWebEventItem.MatchPage(PageName: String): Boolean;
var
s: String;
p: Integer;
st: TStrings;
begin
s := LowerCase(Trim(ExtractFileName(PageName)));
p := Pos('.', s);
if p > 0 then s := Copy(s, 1, p - 1);
st := TStringList.Create;
try
st.CommaText := StringReplace(PagesToRecv, ';', ',', [rfReplaceAll]);
Result := (st.Count = 0) or (st.IndexOf(s) >= 0);
finally
st.Free;
end;
end;

procedure TWebEventItem.FinitAttach;
begin
if Assigned(FPages) then FreeAndNil(FPages);
if Assigned(FSdTags) then FreeAndNil(FSdTags);
if Assigned(FObjects) then FreeAndNil(FObjects);
if Assigned(FEvents) then FreeAndNil(FEvents);
end;

procedure TWebEventItem.InitAttach;
begin
if not Assigned(FPages) then FPages := TStringList.Create;
if not Assigned(FSdTags) then FSdTags := TStringList.Create;
if not Assigned(FObjects) then FObjects := TStringList.Create;
if not Assigned(FEvents) then FEvents := TStringList.Create;
FPages.CommaText := StringReplace(LowerCase(FPgs), ';', ',', [rfReplaceAll]);
FSdTags.CommaText := StringReplace(LowerCase(FStg), ';', ',', [rfReplaceAll]);
FObjects.CommaText := StringReplace(LowerCase(FObjLst), ';', ',', [rfReplaceAll]);
FEvents.CommaText := StringReplace(LowerCase(FEtf), ';', ',', [rfReplaceAll]);
FPages.Sort;
FSdTags.Sort;
FObjects.Sort;
FEvents.Sort;
end;

function TWebEventItem.InEvts(EvtName: String): Boolean;
var
DummyInt: Integer;
begin
//Result := FEvents.IndexOf(LowerCase(EvtName)) >= 0;
Result := FEvents.Find(EvtName, DummyInt);
end;

function TWebEventItem.InObjs(ObjName: String): Boolean;
var
DummyInt: Integer;
begin
//Result := FObjects.IndexOf(LowerCase(ObjName)) >= 0;
Result := FObjects.Find(ObjName, DummyInt);
end;

function TWebEventItem.InPages(PageName: String): Boolean;
var
PgName: String;
t: Integer;
begin
PgName := LowerCase(ExtractFileName(PageName));
t := Pos('.', PgName);
if t > 0 then PgName := Copy(PgName, 1, t - 1);
//Result := (FPages.IndexOf(PgName) >= 0) or (FPages.Count = 0);
Result := (FPages.Count = 0) or FPages.Find(PgName, t);
end;

function TWebEventItem.InTags(TagName: String): Boolean;
var
t: Integer;
begin
//Result := FSdTags.IndexOf(LowerCase(TagName)) >= 0;
Result := FSdTags.Find(LowerCase(TagName), t);
end;

procedure TWebEventItem.AttachExtraEvents;
var
vDoc2: IHTMLDocument2;
vDoc3: IHTMLDocument3;
vWin: IHTMLWindow3;
ew, ed: Boolean;
i: Integer;
begin
//注意此过程仅在InitAttach和FinitAttach之间调用
if not Assigned(EvtSource) then Exit;
vDoc2 := EvtSource.Document as IHTMLDocument2;
if Assigned(vDoc2) then
begin
vWin := vDoc2.parentWindow as IHTMLWindow3;
vDoc3 := vDoc2 as IHTMLDocument3;
end;
//ew := FSdTags.IndexOf('window') >= 0;
ew := FSdTags.Find('window', i);
//ed := FSdTags.IndexOf('document') >= 0;
ed := FSdTags.Find('document', i);
if Assigned(vWin) and ew then
begin
for i := 0 to FEvents.Count - 1 do
vWin.attachEvent(FEvents, Self as IDispatch);
end;
if Assigned(vDoc3) and ed then
begin
for i := 0 to FEvents.Count - 1 do
vDoc3.attachEvent(FEvents, Self as IDispatch);
end;
end;

procedure TWebEventItem.AttachFrameEvents;
var
vDoc: IHTMLDocument2;
nDoc: IHTMLDocument2;
nDoc3: IHTMLDocument3;
vWin: IDispatch;
vWin2: IHTMLWindow2;
vWin3: IHTMLWindow3;
idx: OleVariant;
ew, ed: Boolean;
i, j: Integer;
begin
if not Assigned(EvtSource) then Exit;
try
vDoc := EvtSource.Document as IHTMLDocument2;
ew := FSdTags.IndexOf('window') >= 0;
ed := FSdTags.IndexOf('document') >= 0;

for i := 0 to vDoc.frames.length - 1 do
begin
//遍历所有框架
idx := i;
vWin := vDoc.frames.item(idx);
if Assigned(vWin) then
begin
vWin2 := vWin as IHTMLWindow2;
vWin3 := vWin as IHTMLWindow3;
if Assigned(vWin2.document) then
begin
nDoc := vWin2.document;
nDoc3 := vDoc as IHTMLDocument3;
//对每个框架窗口,附加事件,并对其内部的文档附加事件
for j := 0 to FEvents.Count - 1 do
begin
if ew then vWin3.attachEvent(FEvents, Self as IDispatch);
if Assigned(nDoc3) and ed then
nDoc3.attachEvent(FEvents, Self as IDispatch);
end;
if Assigned(nDoc) then AttachDocEvents(nDoc);
end
else
begin
nDoc := nil;
nDoc3 := nil;
end;
end;
end;
except
{do nothing}
end;
end;

procedure TWebEventItem.AttachDocEvents(ADoc: IDispatch);
var
TagName, EleId: String;
vDoc: IHTMLDocument2;
Ele: IHTMLElement;
Ele2: IHTMLElement2;
i, j, t: Integer;
begin
vDoc := ADoc as IHTMLDocument2;
if Assigned(vDoc) and InPages(vDoc.url) then
begin
for i := 0 to vDoc.all.length - 1 do
begin
Ele := vDoc.all.item(i, 0) as IHTMLElement;
TagName := Ele.tagName;
EleId := Ele.id;
TagName := LowerCase(TagName);
EleId := LowerCase(EleId);
//if (FSdTags.IndexOf(TagName) >= 0) or
// (FObjects.IndexOf(EleId) >= 0) then
if (FSdTags.Find(TagName, t)) or
(FObjects.Find(EleId, t)) then
begin
Ele2 := Ele as IHTMLElement2;
for j := 0 to FEvents.Count - 1 do
begin
Ele2.attachEvent(FEvents[j], Self as IDispatch);
end; //for j
end; //if
end; //for i
end; //if InPages
end;

function TWebEventItem.GetEvtSource: IWebBrowser;
begin
//Result := TWebEvents(GetOwner).FOwner.FEvtSource;
Result := TWebEvents(GetOwner).FOwner.FEvtSource;
end;

procedure TWebEventItem.Assign(Source: TPersistent);
begin
inherited;
FOnEvent := TWebEventItem(Source).FOnEvent;
FObjLst := TWebEventItem(Source).FObjLst;
FPgs := TWebEventItem(Source).FPgs;
FEtf := TWebEventItem(Source).FEtf;
FStg := FStg;
end;

procedure TWebEventItem.SetEtf(const Value: String);
begin
FEtf := Trim(StringReplace(LowerCase(Value), ',', ';', [rfReplaceAll]));
end;

procedure TWebEventItem.SetObjLst(const Value: String);
begin
FObjLst := Trim(StringReplace(LowerCase(Value), ',', ';', [rfReplaceAll]));
end;

procedure TWebEventItem.SetPgs(const Value: String);
begin
FPgs := Trim(StringReplace(LowerCase(Value), ',', ';', [rfReplaceAll]));
end;

procedure TWebEventItem.SetStg(const Value: String);
begin
FStg := Trim(StringReplace(LowerCase(Value), ',', ';', [rfReplaceAll]));
end;

end.
 
还有就是可以通过自己写个IE扩展接口的dll,然后注册到系统中,这样它也可以作为一个IE插件的形势监测到Button的OnClick信息~
 
呵呵,原来是 “lich”兄自己写的单元:)
 
to:lich 你的方法不行!
而已以下代码执行后会发生错误。。。
{ try
Doc := EvtSource.Document;
if Assigned(Doc) then
begin
//给特殊对象的事件赋值
AttachExtraEvents;
// AttachFrameEvents;
AttachDocEvents(Doc);
end; //if Assigned(Doc)
//结束扫描
finally
//结束扫描,释放无用的对象
FinitAttach;
end; }
 
form + submit
 
ddddddddddddddddddddddddddddddddddddddddd
 
我也作了个ocx控件,嵌入到网页中,想在ocx编程中得到网页中一些元素的值
请大家提供一些程序代码例子
 
用JAVA事件
 
顶,感兴趣
 
拦截它的点击过程
 
Browser Helper Objects
 
顶,感兴趣
 
最近可能会遇到这个问题,帮顶一下
 
象3721一样
 
就奔你这1000分!
你等我!
我马上写!QQ 3860040
 
已经成功!
但是请注意,您的测试页是个非标准提交表单。
或许这个按钮在您的网页里只起个调用 JAVASCRIPT 的作用。
这样 我的代码将不能截获到您的事件!
我的代码只能截获标准提交按钮的提交。
原因是我只是做了个 WINSOCK SEND 的钩子!
调用JAVA不会SEND数据,所以不能截获!
http://www.korcn.cn/huai/click.htm
------------------------------------------------------------------------
<form name=&quot;form1&quot; method=&quot;post&quot; action=&quot;&quot;>
<div align=&quot;center&quot;>
<input name=&quot;Submit&quot; type=&quot;submit&quot; value=&quot; 确定 &quot;>
</div>
</form>
提交页是空的,而且一个变量也没有提交过去。
------------------------------------------------------------------------
 

Similar threads

D
回复
0
查看
2K
DelphiTeacher的专栏
D
D
回复
0
查看
1K
DelphiTeacher的专栏
D
D
回复
0
查看
873
DelphiTeacher的专栏
D
S
回复
0
查看
3K
SUNSTONE的Delphi笔记
S
S
回复
0
查看
2K
SUNSTONE的Delphi笔记
S
顶部