怎样取IE地址栏的内容(20分)

  • 主题发起人 Michaelzhao
  • 开始时间
M

Michaelzhao

Unregistered / Unconfirmed
GUEST, unregistred user!
怎样取IE地址栏的内容,我已经限制IE下载功能,可是能从查看->浏览栏->文件夹访问
硬盘资源,用dll如何能取IE地址栏的内容及禁止访问硬盘,谢谢!
zqpowersite@sina.com
 
getwindowtext api就行了。
 
谢谢白河愁, 可是这个只能的到IE的标题啊,那怎样得到IE地址栏的窗体句柄呢?
 
先用findwindow找到ie的hwnd,然后在用findwindowsex找到地址栏的,然后再getwindowtext
 
我可以找到IE的句柄,可怎么用findwindowex找到地址栏的句柄,地址栏是IE的子窗口,是第
几层
 
43. 获得IE中的浏览地址
function GetIEAddress(IEHandle:THandle;var Address:string):Boolean;
Const WM_GETTEXT = $D;
WM_GETTEXTLENGTH =$E;
CtlNames:array[0..4] of string=(
'WorkerA', //获得IE窗口的工作区的句柄
'ReBarWindow32', //获得IE窗口的菜单栏的句柄
'ComboBoxEx32', //获得IE窗口的下拉菜单的句柄
'ComboBox', //获得IE窗口的下拉菜单当前项的句柄
'Edit' //获得这个下拉菜单的编辑框句柄
);
var
hwnd :THandle;
i,AddLen:integer;
AddBuf :Array[0..4095] of char;
s :string;
begin
Result:=True;
hwnd:=IEHandle;
try
for i:=0 to length(ctlnames)-1 do
hwnd:=FindWindowEx(hwnd,0,PChar(CtlNames),nil);
except
Result:=false;
end;
if (Result) then begin
AddLen:=SendMessage(Hwnd,WM_GETTEXTLENGTH,0,0);
//向系统发送获得IE窗口的地址栏中的字符串长度命令
SendMessage(Hwnd,WM_GETTEXT,AddLen+1,DWord(@AddBuf));
//向系统发送获得IE窗体地址栏中的字符串命令
if length(AddBuf)>0 then
begin
Address:=AddBuf;
GetWindowText(IEHandle,AddBuf,length(AddBuf)+1);
s:=Addbuf;
i:=pos(Uppercase(' - Microsoft Internet Explorer'),
Uppercase(s));
if i>0 then s:=Trim(copy(s,1,i-1));
Address:=Address+' ['+s+']';
end
else Result:=false;
end;
end;

function EnumIEProc(hwnd:THandle;Param:LPARAM):Boolean;stdcall;
const NAME_LEN=1024;
type
PStrings=^TStrings;
var
sClassName:Array[0..NAME_LEN] of char;
IEAddress:string;
AddLen:Integer;
begin
AddLen:=GetClassName(hwnd,@sClassName,NAME_LEN);
if (AddLen=7) and (sClassName='IEFrame') then
if GetIEAddress(hwnd,IEAddress) then
PStrings(Param).Add(IEAddress);
Result:=true;
end;

function GetAllIEAddress(var Addresses:TStrings):Integer;
var
s:TStrings;
begin
s:=TStringList.Create ;
EnumWindows(@EnumIEProc,LPARAM(@s));
Result:=s.Count ;
if Result>0 then Addresses.Assign (s);
s.free;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
s:TStrings;
begin
s:=TStringList.Create ;
GetAllIEAddress(s);
if s.Count >0 then Memo1.Lines.Assign (s);
s.free;
end;
 
来自IE&Delphi的IEHelper:
http://www.playicq.com/dispdoc.php?t=27&id=1770
稍微改改就可以,很简单。其原理参见:0918793
 
function URLInfo(sBrowerPrgFile, sServiceName: string; Netscape: boolean; var Title: string): pChar;
{
参数说明:
sBrowerPrgFile: 浏览器exe文件的完整路径名
sServiceName: 浏览器的DDE-Service名字
Netscape是'Netscape',IE是'iexplore'
Title: 返回当前网页的title
返回值: pChar的字符串
}
var
DDEClientConv: TDDEClientConv;
StartPtr, EndPtr: pchar;
browserWinName: string;
begin
result:= #0;
Title:= '';

if (sBrowerPrgFile = '') or (not FileExists(sBrowerPrgFile)) then
raise EBrowserNotFoundError.create('****!浏览器应用程序不存在!');

ddeClientConv:= TDDEClientConv.Create( nil );
try
with ddeClientConv do
begin
ServiceApplication := sBrowerPrgFile;
SetLink( sServiceName,'WWW_GetWindowInfo');
StartPtr:= RequestData('0xFFFFFFFF');
end;
finally
ddeClientConv.Free;
end;

if startPtr^ = #0 then
exit;
{skip leading "}
inc(StartPtr);
EndPtr:= StartPtr;
{proceed to next "}
while (EndPtr^ <> '"') do
inc(EndPtr);
{terminate URL string}
EndPtr^:= #0;
result:= StartPtr;
{skip ","}
StartPtr:= EndPtr+3;
if Netscape then
inc(StartPtr,12);

EndPtr:= StartPtr;
if Netscape then
while (EndPtr^ <> ']') do
inc(EndPtr)
else
while (EndPtr^ <> '"') do
inc(EndPtr);

EndPtr^:= #0;
Title:= strPas(StartPtr);
end;
 
>'****!浏览器应用程序不存在!'
[:D][:D][:D]
 
在 www.hensel-hk.com/yyh/index.asp 上的编程资料内有篇文章叫“监视IE的地址栏”,
讲得很细,有源代码,连通过“我的电脑”打开的网页也可监视到。
 
>连通过“我的电脑”打开的网页也可监视到
[:D]你看看这里http://www.delphibbs.com/delphibbs/dispq.asp?lid=1419654
 
顶部