难题:有没有人能根据一个IE实例的句柄获得对应的IhtmlDocument接口(不要Msaa支持)(请不要说以前有人答过,那些都不适用)(300分)

F

flyddl

Unregistered / Unconfirmed
GUEST, unregistred user!
1:有没有人能根据一个IE实例的句柄获得对应的IhtmlDocument接口,不过不能要Msaa支持,因为Msaa只有
windows2000和WindowsNT Sv6上才预装,我不希望我的作品才300K,却要一个几M的支持文件!

2:或者如果有人能通过其它方法获得当前浏览器(含以IE为内核的其它浏览器如:Netcaptor,MyIE等)
的URL地址,不要取地址框中的,那个不准确,如果有人能解决,我愿意出300分,不够可以再加!
只要解决的好!
 
我看到如下的一篇文章,好象可以用它来实现截获网页中的超联接,可我要如何调用,
我不熟悉com,请各位帮忙给个示例。

TIEHelper = class(TComObject, IDispatch, IObjectWithSite)
public
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;
function SetSite(const pUnkSite: IUnknown): HResult
stdcall;
function GetSite(const riid: TIID
out site: IUnknown): HResult
stdcall;
private
IE: IWebbrowser2;
Cookie: Integer;
end;

在SetSite方法中处理与IE的连接:
function TIEHelper.SetSite(const pUnkSite: IUnknown): HResult;
var
cmdTarget: IOleCommandTarget;
Sp: IServiceProvider;
CPC: IConnectionPointContainer;
CP: ICOnnectionPoint;
begin
if Assigned(pUnkSite) then begin
cmdTarget := pUnkSite as IOleCommandTarget;
Sp := CmdTarget as IServiceProvider;

if Assigned(Sp)then
Sp.QueryService(IWebbrowserApp, IWebbrowser2, IE);
if Assigned(IE) then begin
IE.QueryInterface(IConnectionPointContainer, CPC);
CPC.FindConnectionPoint(DWEBbrowserEvents2, CP);
CP.Advise(Self, Cookie)
end;
end;
Result := S_OK;
end;
然后当IE事件引发后,会调用服务器的Invoke事件,在事件中判断DispID并执行
相应的处理:
function TIEHelper.Invoke(DispID: Integer
const IID: TGUID
LocaleID: Integer;
Flags: Word
var Params
VarResult, ExcepInfo, ArgErr: Pointer): HResult;
type
POleVariant = ^OleVariant;
var
dps: TDispParams absolute Params;
bHasParams: boolean;
pDispIds: PDispIdList;
iDispIdsSize: integer;
begin
Result := DISP_E_MEMBERNOTFOUND;
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);
case DispId of
102:
begin
DoStatusTextChange(dps.rgvarg^[pDispIds^[0]].bstrval);
Result := S_OK;
end;
108:
begin
DoProgressChange(dps.rgvarg^[pDispIds^[0]].lval, dps.rgvarg^[pDispIds^[1]].lval);
Result := S_OK;
end;

最后,需要在注册时在注册表中添加附加信息以便IE调用:
type

TIEHelperFactory = class(TComObjectFactory)
private
procedure AddKeys;
procedure RemoveKeys;
public
procedure UpdateRegistry(Register: Boolean)
override;
end;

procedure TIEHelperFactory.AddKeys;
var S: string;
begin
S := GUIDToString(CLASS_IEHelper);
with TRegistry.Create do
try
RootKey := HKEY_LOCAL_MACHINE;
if OpenKey('Software/Microsoft/Windows/CurrentVersion/explorer/Browser Helper Objects/' + S, TRUE)
then CloseKey;
finally
free;
end;
end;

procedure TIEHelperFactory.RemoveKeys;
var S: string;
begin
S := GUIDToString(CLASS_IEHelper);
with TRegistry.Create do
try
RootKey := HKEY_LOCAL_MACHINE;
DeleteKey('Software/Microsoft/Windows/CurrentVersion/explorer/Browser Helper Objects/' + S);
finally
free;
end;
end;

procedure TIEHelperFactory.UpdateRegistry(Register: Boolean);
begin
inherited UpdateRegistry(Register);
if Register then AddKeys else RemoveKeys;
end;

initialization
TIEHelperFactory.Create(ComServer, TIEHelper, Class_IEHelper,
'IEHelper', '', ciMultiInstance, tmApartment);
end.
 
请问您这个问题解决没有?

请问:如果已知一个IE的句柄,如何用此IE浏览网页?
 
获得ie的URL
procedure TForm1.Button1Click(Sender: TObject);
var
xwin:IShellWindows;
xweb:iWebbrowser;
i:integer;
begin
xWin:=CoShellWindows.Create;
for i:=0 to xWin.Count-1 do begin
xWeb:=xWin.Item(i) as IWebbrowser;//注意
ListBox1.Items.Add(xWeb.LocationURL);
end;
end;
你应该知道下面做什么了吧?
 
To:zbwsh
你的这个方法我知道,但是只能取标准IE的实例对应的URL,对于其它以IE为核心的浏览器则不行(有些也可以),
从微软的网站有从HANDLE到IE实例的转换方法,该方法只有大概10行代码,但是确需要一个5M的
运行库,所以我想找其它办法。
 
多人接受答案了。
 

Similar threads

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