Работа с Url в Delphi

16K

10 мая 2006 года

3 / / 03.05.2006

Вот все что я мог откопать!

Как получить активный url из браузера

Приводимая здесь функция показывает, как Ваше приложение может извлечь из браузера (ie или netscape) url , как, например, это делает аська.
Совместимость: delphi 4.x (или выше)
Не забудьте добавить ddeman в Ваш проект!

Собственно сам исходничек функции:

uses windows, ddeman, ......

function get_url(servicio: string): string;
var
cliente_dde: tddeclientconv;
temp:pchar; //<<-------------------------this is new
begin
result := '';
cliente_dde:= tddeclientconv.create( nil );
with cliente_dde do
begin
setlink( servicio,'www_getwindowinfo');
temp := requestdata('0xffffffff');
result := strpas(temp);
strdispose(temp); //<<-Предотвращаем утечку памяти
closelink;
end;
cliente_dde.free;
end;

procedure tform1.button1click(sender);
begin
showmessage(get_url('netscape'));
или
showmessage(get_url('iexplore'));
end;

Взять часть url, которая следует после названия сайта

{
internetcrackurl() takes a url as a parameter and breaks it down into components,
which are then accessible via the turlcomponents structure.

internetcrackurl() zerlegt eine url in seine komponenten, welche dann ьber die
turlcomponents struktur zugдnglich sind.
}

uses
wininet;

procedure tform1.button1click(sender: tobject);
var
aurlc: turlcomponents;
const
test_url = 'http://www.swissdelphicenter.ch/de/tipsindex.php';
begin
fillchar(aurlc, sizeof(turlcomponents), 0);
with aurlc do
begin
lpszscheme := nil;
dwschemelength := internet_max_scheme_length;
lpszhostname := nil;
dwhostnamelength := internet_max_host_name_length;
lpszusername := nil;
dwusernamelength := internet_max_user_name_length;
lpszpassword := nil;
dwpasswordlength := internet_max_password_length;
lpszurlpath := nil;
dwurlpathlength := internet_max_path_length;
lpszextrainfo := nil;
dwextrainfolength := internet_max_path_length;
dwstructsize := sizeof(aurlc);
end;
if internetcrackurl(pchar(test_url), length(test_url), 0, aurlc) then
begin
showmessage(aurlc.lpszurlpath);
end;
end;

Вывести типы url для internet explorer

uses registry;

procedure showtypedurls(urls: tstrings);
var
reg: tregistry;
s: tstringlist;
i: integer;
begin
reg := tregistry.create;
try
reg.rootkey := hkey_current_user;
if reg.openkey('softwaremicrosoftinternet explorertypedurls', false) then
begin
s := tstringlist.create;
try
reg.getvaluenames(s);
for i := 0 to s.count - 1 do
begin
urls.add(reg.readstring(s.strings));
end;
finally
s.free;
end;
reg.closekey;
end;
finally
reg.free;
end;
end;

procedure tform1.button1click(sender: tobject);
begin
showtypedurls(listbox1.items);
end;

Извлечь имя файла из строки url

function extracturlfilename(const aurl: string): string;
var
i: integer;
begin
i := lastdelimiter('/', aurl);
result := copy(aurl, i + 1, length(aurl) - (i));
end;

procedure tform1.button1click(sender: tobject);
var
s: string;
begin
s := extracturlfilename('http://www.delphimania.de/index.php');
showmessage(s); //index.php
end

Как захватить текущий url из окна internet explorer

Описываем две функции gettext и geturl:

function gettext(windowhandle: hwnd):string;
var
txtlength : integer;
buffer: string;
begin
txtlength := sendmessage(windowhandle, wm_gettextlength, 0, 0);
txtlength := txtlength + 1;
setlength (buffer, txtlength);
sendmessage (windowhandle,wm_gettext, txtlength, longint(@buffer[1]));
result := buffer;
end;

function geturl:string;
var
ie,toolbar,combo,
comboboxex,edit,
worker,toolbarwindow:hwnd;
begin
ie := findwindow(pchar('ieframe'),nil);
worker := findwindowex(ie,0,'workera',nil);
toolbar := findwindowex(worker,0,'rebarwindow32',nil);
comboboxex := findwindowex(toolbar, 0, 'comboboxex32', nil);
combo := findwindowex(comboboxex,0,'combobox',nil);
edit := findwindowex(combo,0,'edit',nil);
toolbarwindow := findwindowex(comboboxex, 0, 'toolbarwindow32', nil);
result := gettext(edit);
end;

Ну а затем пользуемся функцией geturl, например, можем в поле ввода по нажатию на кнопку выводит текущий url:

procedure tform1.button1click(sender: tobject);
begin
edit1.text := geturl;
end;