在IE的工具栏添加一个按钮，只要在注册表里写一个键值就可以了
键名：
HKEY_LOCAL_MACHINE/SOFTWARE/Microsoft/Internet Explorer/Extensions
在改键中添加相应的字串值：
procedure TForm1.BitBtn1Click(Sender: TObject);
var
rg:Tregistry;
begin
rg:=Tregistry.create;
rg.rootkey:=HKEY_LOCAL_MACHINE;
rg.openkey('SOFTWARE/MICROSOFT/INTERNET EXPLORER/EXTENSIONS/{0713E8D2-850A-101B-AFC0-4210102A8DA7}',true);
rg.writestring('BUTTONTEXT',Ewenzi.text);
rg.writestring('CLSID','{1FBA04EE-3024-11D2-8F1F-0000F87ABD16}');
rg.writestring('DEFAULT VISIBLE','YES');
rg.writestring('EXEC',c:/my.exe);
rg.writestring('ICON',c:/icon1.ico);
rg.writestring('HOTICON',c:/icon2.ico);
rg.closekey;
rg.free;
end;
你可以参考这个源程序：
http://www.playicq.com/dispdoc.asp?id=371
至于得到该IE窗口中的网页地址，你可以参考这个程序：
http://www.playicq.com/dispdoc.asp?id=201
它连当前IE窗口中的源码都能得到 ，看过之后相信你应该知道怎么得到地址：
unit Unit1;
interface
uses
Windows, Messages, SysUtils, {Variants,} Classes, Graphics, Controls, Forms,
Dialogs, {SHDocVW_TLB, MSHTML_TLB,} ActiveX, OleCtrls, SHDocVw, StdCtrls,
ComCtrls, ImgList;
type
TForm1 = class(TForm)
SourceView: TMemo;
Button1: TButton;
Button2: TButton;
Button3: TButton;
TreeView1: TTreeView;
ImageList1: TImageList;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure Button3Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
private
{ Private declarations }
FileName:string;
public
{ Public declarations }
end;
var
Form1: TForm1;
const
RSPSIMPLESERVICE = 1;
RSPUNREGISTERSERVICE = 0;
implementation
uses MSHTML;
{$R *.dfm}
type
TObjectFromLResult = function(LRESULT: lResult; const IID: TIID; WPARAM: wParam; out pObject): HRESULT; stdcall;
//This function detects the Window
function GetIEFromHWND(WHandle: HWND; var IE: IWebbrowser2): HRESULT;
var
hInst: HWND;
lRes: Cardinal;
MSG: Integer;
pDoc: IHTMLDocument2;
ObjectFromLresult: TObjectFromLresult;
begin
hInst := LoadLibrary('Oleacc.dll');
@ObjectFromLresult := GetProcAddress(hInst, 'ObjectFromLresult');
if @ObjectFromLresult <> nil then begin
try
MSG := RegisterWindowMessage('WM_HTML_GETOBJECT');
SendMessageTimeOut(WHandle, MSG, 0, 0, SMTO_ABORTIFHUNG, 1000, lRes);
Result := ObjectFromLresult(lRes, IHTMLDocument2, 0, pDoc);
if Result = S_OK then
(pDoc.parentWindow as IServiceprovider).QueryService(IWebbrowserApp, IWebbrowser2, IE);
finally
FreeLibrary(hInst);
end;
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
var
All: IHtmlElementCollection;
HtmlElement: IHtmlElement;
I: Integer;
Document: IHtmlDocument2;
IE: IWebBrowser2;
Wnd: HWND;
WndChild: HWND;
begin
Wnd := FindWindow('IEFrame', nil);
if Wnd = 0 then
begin
MessageDlg ('No Running instance of Internet Explorer!',mtError, [mbOK], 0);
end;
// walk Shell DocObject View->Internet Explorer_Server
WndChild := FindWindowEX(Wnd, 0, 'Shell DocObject View', nil);
if WndChild <> 0 then begin
WndChild := FindWindowEX(WndChild, 0, 'Internet Explorer_Server', nil);
if WndChild <> 0 then
begin
GetIEFromHWnd(WndChild, IE); //Get Iwebbrowser2 from Handle
Document := IE.Document as IHtmlDocument2;
if (assigned(Document)) then
begin
{All := Document.All;
for I := 0 to All.Length -1 do
begin
HtmlElement := All.item(i,0) as IhtmlElement;
if (assigned(Document)) then
SourceView.Lines.Add (HTmlElement.innerHTML);
end; }
FileName:=Document.title;
//Caption:=FileName;
caption:=Document.Get_url; //得到地址
SourceView.Lines.clear;
SourceView.Lines.Add(IHtmlDocument2(Document).Body.OuterHtml);
end;
end;
end;
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
SourceView.Lines.SaveToFile('c:/tem.htm');
end;
procedure TForm1.Button3Click(Sender: TObject);
begin
SourceView.Lines.clear;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
SetWindowPos(Handle, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOSIZE or SWP_NOMOVE or SWP_NOACTIVATE);
end;
end.
