Mega Code Archive
Retrieve the Zone Icon for the specified URL in a TWebbrowser
<![CDATA[
Title: Retrieve the Zone Icon for the specified URL in a TWebbrowser?
uses
Urlmon;
procedure GetZoneIcon(IconPath: string; var Icon: TIcon);
var
FName, ImageName: string;
h: hInst;
begin
FName := Copy(IconPath, 1, Pos('#', IconPath) - 1);
ImageName := Copy(IconPath, Pos('#', IconPath), Length(IconPath));
h := LoadLibrary(Pchar(FName));
try
if h 0 then
begin
Icon.Handle := LoadImage(h, Pchar(ImageName), IMAGE_ICON, 16, 16, 0);
end;
finally
FreeLibrary(h);
end;
end;
function GetZoneAttributes(const URL: string): TZoneAttributes;
var
pw: Pwidechar;
dwZone: Cardinal;
ZoneAttr: TZoneAttributes; //Defined in Urlmon.pas
var
ZoneManager: IInternetZoneManager;
SecManager: IInternetSecurityManager;
begin
ZeroMemory(@ZoneAttr, SizeOf(TZoneAttributes));
if CoInternetCreateSecuritymanager(nil, SecManager, 0) = S_OK then
if CoInternetCreateZoneManager(nil, ZoneManager, 0) = S_OK then
begin
SecManager.MapUrlToZone(PWideChar(WideString(URL)), dwZone, 0);
ZoneManager.GetZoneAttributes(dwZone, Result);
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
var
ZoneAttr: TZoneAttributes;
ZoneIcon: TIcon;
begin
ZoneAttr := GetZoneAttributes(Webbrowser1.LocationURL);
ZoneIcon := TIcon.Create;
try
GetZoneIcon(ZoneAttr.szIconPath, ZoneIcon);
Caption := ZoneAttr.szDisplayName
Application.Icon := ZoneIcon;
finally
ZoneIcon.Free;
end;
end;
]]>