获取URL所属的站点类型

Retrieve the Zone Icon for the specified URL in a TWebbrowser?

Author: Thomas Stutz  

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;