function TGetMailBand.SetSite(const pUnkSite: IUnknown): HResult; stdcall;
var
pOleWindow:IOleWindow;
pOleEcmd:IOleCommandTarget;
pSP :IServiceProvider;
rc:TRect;
begin
if Assigned(pUnkSite) then
begin
m_hwndParent:=0;
m_pSite:=pUnkSite as IInputObjectSite;
pOleWindow:=punkSite as IOLeWindow;
//获得父窗口IE面板窗口的句柄
pOleWindow.GetWindow(m_hwndParent);
if (m_hwndParent=0) then
begin
Result:=E_FAIL;
exit;
end;
//获得父窗口区域
GetClientRect(m_hwndParent,rc);
if not Assigned(frmIE) then
begin
//建立TIEForm窗口,父窗口为m_hwndParent
frmIE:=TForm1.CreateParented(m_hwndParent);
m_Hwnd:=frmIE.Handle;
SetWindowLong(frmIE.Handle,GWL_STYLE,GetWindowLong(frmIE.Handle ,GWL_STYLE) or WS_CHILD);
//根据父窗口区域设置窗口位置
with frmIE do begin
Left:=rc.Left;
Top:=rc.Top;
Width:=rc.Right-rc.Left;
Height:=rc.Bottom-rc.Top;
end;
frmIE.Visible:=True;
//获得与浏览器相关联的Webbrower对象。
pOLEcmd:=pUnkSite as IOleCommandTarget; //205
pSP:=pOLEcmd as IServiceProvider; //206
if Assigned(pSP) then begin
pSP.QueryService(IWebbrowserApp,IWebbrowser2,frmIE.IEThis);
end;
end;
end;
Result:=S_OK;
end;function TGetMailBand.ShowDW(fShow: BOOL): HResult; stdcall;
begin
if m_hWnd<>0 then
if fShow then
ShowWindow(m_hWnd,SW_SHOW)
else
ShowWindow(m_hWnd,SW_HIDE) ;
Result:=S_OK;
end;//TIEClassFac类实现COM组件的注册
Type
TIEClassFac=class(TComObjectFactory)
public
procedure UpdateRegistry(Register:Boolean);override;
end;{ TIEClassFac }procedure TIEClassFac.UpdateRegistry(Register: Boolean);
var
ClassID:String;
a:Integer;
begin
inherited UpdateRegistry(Register);
if Register then begin
ClassID:=GUIDToString(Class_GetMailBand) ;
with TRegistry.Create do
try
//添加附加的注册表项
RootKey:=HKEY_LOCAL_MACHINE;
OpenKey('\SOFTWARE\Microsoft\Internet Explorer\Toolbar',False);
a:=0;
WriteBinaryData(GUIDToString(Class_GetMailBand),a,0);
OpenKey('\SOFTWARE\Microsoft\Windows\CurrentVersion\Shell Extensions\Approved',True);
WriteString(GUIDToString(Class_GetMailBand),EB_CLASS_NAME);
RootKey:=HKEY_CLASSES_ROOT;
OpenKey('\CLSID\'+GUIDToString(Class_GetMailBand),False);
WriteString('',EB_CLASS_NAME);
finally
Free;
end;
end
else begin
with TRegistry.Create do
try
RootKey:=HKEY_LOCAL_MACHINE;
OpenKey('\SOFTWARE\Microsoft\Internet Explorer\Toolbar\',False);
DeleteValue(GUIDToString(Class_GetMailBand));
OpenKey('\SOFTWARE\Microsoft\Windows\CurrentVersion\Shell Extensions\Approved\',False);
DeleteValue(GUIDToString(Class_GetMailBand));
finally;
Free;
end;
end;
end;initialization
TIEClassFac.Create(ComServer, TGetMailBand, Class_GetMailBand, 'GetMailAddress', '', ciMultiInstance, tmApartment);
end.
library MailIEBand;uses
ComServ,
BandUnit in 'BandUnit.pas',
IEForm in 'IEForm.pas' {Form1};
MailIEBand_TLB in 'MailIEBand_TLB.pas',
exports
DllGetClassObject,
DllCanUnloadNow,
DllRegisterServer,
DllUnregisterServer;{$R *.TLB}{$R *.RES}begin
end.unit IEForm;interfaceuses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
ShDocVW, MSHTML, StdCtrls;type
TForm1 = class(TForm)
Button1: TButton;
ComboBox1: TComboBox;
procedure FormResize(Sender: TObject);
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
IEThis:IWebbrowser2;
{ Public declarations }
end;var
Form1: TForm1;implementation{$R *.DFM}procedure TForm1.FormResize(Sender: TObject);
begin
with Button1 do begin
Left:=0;
Top:=0;
Height:=Self.ClientHeight ;
end;
with ComboBox1 do begin
Left:=Button1.Width +3;
Top:=0;
Height:=Self.ClientHeight;
Width:=Self.ClientWidth -Left;
end;
end;procedure TForm1.Button1Click(Sender: TObject);
var
doc:IHTMLDocument2;
all:IHTMLElementCollection;
len,i,flag:integer;
item:IHTMLElement;
vAttri:Variant;
begin
if Assigned(IEThis) then begin
ComboBox1.Clear ;
//获得Webbrowser对象中的文档对象
doc:=IEThis.Document as IHTMLDocument2;
//获得文档中所有的HTML元素集合
all:=doc.Get_all;
len:=all.Get_length ;
//访问HTML元素集合中的每一个元素
for i:=0 to len-1 do begin
item:=all.item(i,varempty) as IHTMLElement;
//如果该元素是一个链接
if item.Get_tagName='A' then begin
flag:=0;
vAttri:=item.getAttribute('protocal',flag);//获得链接属性
//如果是mailto链接则将链接的目标地址添加到ComboBox1
if vAttri='mailto:' then begin
vAttri:=item.getAttribute('href',flag);
ComboBox1.Items.Add(vAttri);
end;
end;
end;
end;
end;end.
var
pOleWindow:IOleWindow;
pOleEcmd:IOleCommandTarget;
pSP :IServiceProvider;
rc:TRect;
begin
if Assigned(pUnkSite) then
begin
m_hwndParent:=0;
m_pSite:=pUnkSite as IInputObjectSite;
pOleWindow:=punkSite as IOLeWindow;
//获得父窗口IE面板窗口的句柄
pOleWindow.GetWindow(m_hwndParent);
if (m_hwndParent=0) then
begin
Result:=E_FAIL;
exit;
end;
//获得父窗口区域
GetClientRect(m_hwndParent,rc);
if not Assigned(frmIE) then
begin
//建立TIEForm窗口,父窗口为m_hwndParent
frmIE:=TForm1.CreateParented(m_hwndParent);
m_Hwnd:=frmIE.Handle;
SetWindowLong(frmIE.Handle,GWL_STYLE,GetWindowLong(frmIE.Handle ,GWL_STYLE) or WS_CHILD);
//根据父窗口区域设置窗口位置
with frmIE do begin
Left:=rc.Left;
Top:=rc.Top;
Width:=rc.Right-rc.Left;
Height:=rc.Bottom-rc.Top;
end;
frmIE.Visible:=True;
//获得与浏览器相关联的Webbrower对象。
pOLEcmd:=pUnkSite as IOleCommandTarget; //205
pSP:=pOLEcmd as IServiceProvider; //206
if Assigned(pSP) then begin
pSP.QueryService(IWebbrowserApp,IWebbrowser2,frmIE.IEThis);
end;
end;
end;
Result:=S_OK;
end;function TGetMailBand.ShowDW(fShow: BOOL): HResult; stdcall;
begin
if m_hWnd<>0 then
if fShow then
ShowWindow(m_hWnd,SW_SHOW)
else
ShowWindow(m_hWnd,SW_HIDE) ;
Result:=S_OK;
end;//TIEClassFac类实现COM组件的注册
Type
TIEClassFac=class(TComObjectFactory)
public
procedure UpdateRegistry(Register:Boolean);override;
end;{ TIEClassFac }procedure TIEClassFac.UpdateRegistry(Register: Boolean);
var
ClassID:String;
a:Integer;
begin
inherited UpdateRegistry(Register);
if Register then begin
ClassID:=GUIDToString(Class_GetMailBand) ;
with TRegistry.Create do
try
//添加附加的注册表项
RootKey:=HKEY_LOCAL_MACHINE;
OpenKey('\SOFTWARE\Microsoft\Internet Explorer\Toolbar',False);
a:=0;
WriteBinaryData(GUIDToString(Class_GetMailBand),a,0);
OpenKey('\SOFTWARE\Microsoft\Windows\CurrentVersion\Shell Extensions\Approved',True);
WriteString(GUIDToString(Class_GetMailBand),EB_CLASS_NAME);
RootKey:=HKEY_CLASSES_ROOT;
OpenKey('\CLSID\'+GUIDToString(Class_GetMailBand),False);
WriteString('',EB_CLASS_NAME);
finally
Free;
end;
end
else begin
with TRegistry.Create do
try
RootKey:=HKEY_LOCAL_MACHINE;
OpenKey('\SOFTWARE\Microsoft\Internet Explorer\Toolbar\',False);
DeleteValue(GUIDToString(Class_GetMailBand));
OpenKey('\SOFTWARE\Microsoft\Windows\CurrentVersion\Shell Extensions\Approved\',False);
DeleteValue(GUIDToString(Class_GetMailBand));
finally;
Free;
end;
end;
end;initialization
TIEClassFac.Create(ComServer, TGetMailBand, Class_GetMailBand, 'GetMailAddress', '', ciMultiInstance, tmApartment);
end.
library MailIEBand;uses
ComServ,
BandUnit in 'BandUnit.pas',
IEForm in 'IEForm.pas' {Form1};
MailIEBand_TLB in 'MailIEBand_TLB.pas',
exports
DllGetClassObject,
DllCanUnloadNow,
DllRegisterServer,
DllUnregisterServer;{$R *.TLB}{$R *.RES}begin
end.unit IEForm;interfaceuses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
ShDocVW, MSHTML, StdCtrls;type
TForm1 = class(TForm)
Button1: TButton;
ComboBox1: TComboBox;
procedure FormResize(Sender: TObject);
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
IEThis:IWebbrowser2;
{ Public declarations }
end;var
Form1: TForm1;implementation{$R *.DFM}procedure TForm1.FormResize(Sender: TObject);
begin
with Button1 do begin
Left:=0;
Top:=0;
Height:=Self.ClientHeight ;
end;
with ComboBox1 do begin
Left:=Button1.Width +3;
Top:=0;
Height:=Self.ClientHeight;
Width:=Self.ClientWidth -Left;
end;
end;procedure TForm1.Button1Click(Sender: TObject);
var
doc:IHTMLDocument2;
all:IHTMLElementCollection;
len,i,flag:integer;
item:IHTMLElement;
vAttri:Variant;
begin
if Assigned(IEThis) then begin
ComboBox1.Clear ;
//获得Webbrowser对象中的文档对象
doc:=IEThis.Document as IHTMLDocument2;
//获得文档中所有的HTML元素集合
all:=doc.Get_all;
len:=all.Get_length ;
//访问HTML元素集合中的每一个元素
for i:=0 to len-1 do begin
item:=all.item(i,varempty) as IHTMLElement;
//如果该元素是一个链接
if item.Get_tagName='A' then begin
flag:=0;
vAttri:=item.getAttribute('protocal',flag);//获得链接属性
//如果是mailto链接则将链接的目标地址添加到ComboBox1
if vAttri='mailto:' then begin
vAttri:=item.getAttribute('href',flag);
ComboBox1.Items.Add(vAttri);
end;
end;
end;
end;
end;end.
解决方案 »
- 请问,我写出了一个WEB服务器的程序,还想集成WINDOWS身份验证 请问该怎么写?
- 谁能帮我看看这段代码 就是看看他是怎样循环的 谢谢啦 菜鸟帮帮我啊
- 用ADO和SQL数据库连接几种现象
- 图标丢失的问题
- 如何用delphi 建立一个类,再使用对象?
- IC卡开发,在DELPHI中如何直接调用WINDOWS API(ScardTransmit)?
- 如何设置DBGridEh的PickList显示高度
- 在delphi中如何才能像vb中创建模块!!!
- 怎么取opendialog1.filename的文件名? 如:opendialog1.filename:='c:\data\ddd.txt'我要取结果'ddd'
- 关于D7环境存储XML文件到Access字段类型OLE,取数据。
- 初学者很难入门的问题:请问,
- 请教关于学习DELPHI的问题
[email protected]
多谢了!
http://www.applevb.com/IEBand.rar
http://www.csdn.net/Expert/TopicView1.asp?id=1004220
200分!