Fórum URL ativa no browser #344199

procedure TForm1.GetCurrentURL(out URL,Title: string);
var
DDEClient: TDDEClientConv;
p,q: PChar;
i: Integer;
begin
DDEClient := TDDEClientConv.Create(nil);
try
with DDEClient do

if SetLink(´IExplore´, ´WWW_GetWindowInfo´) or
SetLink(´Netscape´, ´WWW_GetWindowInfo´) or
SetLink(´Mosaic´, ´WWW_GetWindowInfo´) or
SetLink(´Netscp6´, ´WWW_GetWindowInfo´) or
SetLink(´Opera´, ´WWW_GetWindowInfo´) or
SetLink(´Mozilla´, ´WWW_GetWindowInfo´) or
SetLink(´Firefox´, ´WWW_GetWindowInfo´) then
p := RequestData(´0xFFFFFFFF´)
else
exit;

if Assigned(p) then
try
q := p;
Assert(q^ = ´´´);
SetLength(URL,StrLen(q));
Inc(q);
i := 0;
while q^ <> ´´´ do
begin
if (q^ = ´\´) and (q[1] = ´´´) then
Inc(q);
Inc(i);
URL[i] := q^;
Inc(q);
end;
SetLength(URL,i);
SetLength(Title,StrLen(q));
i := 0;
Inc(q,3);
while q^ <> ´´´ do
begin
if (q^ = ´\´) and (q[1] = ´´´) then
Inc(q);
Inc(i);
Title[i] := q^;
Inc(q);
end;
SetLength(Title,i);
finally
StrDispose(p);
end
finally
DDEClient.Free;
end;
end;

***************************
Use assim:

var
URL, Text: string;
begin
GetCurrentURL(URL,Text);
Label1.Caption := URL;
end;