unit UserAgentBrowser;
interface
uses
Windows, Messages, SysUtils, Classes, Controls, OleCtrls, SHDocVw;
const
DISPID_AMBIENT_USERAGENT = - 5513;
type
TUserAgentBrowser =
class(SHDocVw.TWebbrowser, IDispatch)
private
{ Private declarations }
FUserAgent:
string;
function GetUserAgent:
string;
procedure SetUserAgent(
const Value:
string);
function GetIEUserAgent:
string;
protected
function Invoke(
DispID: Integer;
const IID: TGUID; LocaleID: Integer;
Flags: Word;
var Params; VarResult, ExcepInfo, ArgErr: Pointer):
HRESULT;
stdcall;
public
{ Public declarations }
constructor Create(AOwner: TComponent);
override;
destructor Destroy;
override;
published
{ Published declarations }
property UserAgent:
string read GetUserAgent
write SetUserAgent;
end;
procedure Register;
implementation
uses
Registry,
ActiveX;
procedure Register;
begin
RegisterComponents('
Internet', [TUserAgentBrowser]);
end;
constructor TUserAgentBrowser.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
FUserAgent := '
';
end;
destructor TUserAgentBrowser.Destroy;
begin
inherited Destroy;
end;
function TUserAgentBrowser.Invoke(
DispID: Integer;
const IID: TGUID;
LocaleID: Integer; Flags: Word;
var Params; VarResult, ExcepInfo,
ArgErr: Pointer): HRESULT;
begin
if (Flags
and DISPATCH_PROPERTYGET <> 0)
and (VarResult <>
nil)
then
case DispId of
DISPID_AMBIENT_USERAGENT:
begin
if FUserAgent <> '
'
then
begin
POleVariant(VarResult)^ := FUserAgent + #13#10;
// POleVariant(VarResult)^ := GetIEUserAgent + '; ' + FUserAgent+ #13#10 ;
Result := S_OK;
Exit;
end;
end;
end;
Result :=
inherited Invoke(
DispID, IID, LocaleID, Flags, Params,
VarResult, ExcepInfo, ArgErr);
end;
function TUserAgentBrowser.GetIEUserAgent:
string;
var
reg: TRegistry;
begin
Result := '
';
Reg := TRegistry.Create;
with Reg
do
begin
RootKey := HKEY_CURRENT_USER;
try
if OpenKey('
\Software\Microsoft\Windows\CurrentVersion\Internet Settings\User Agent\Post Platform', True)
then
Result := ReadString(UserAgent);
finally
CloseKey;
Free;
end;
end;
end;
procedure TUserAgentBrowser.SetUserAgent(
const Value:
string);
var
Control: IOleControl;
begin
FUserAgent := Value;
// Weiß nicht ganz genau, ob der folgende Aufruf nötig ist:
if DefaultInterface.QueryInterface(IOleControl, Control) = 0
then
Control.OnAmbientPropertyChange(DISPID_AMBIENT_USERAGENT);
end;
function TUserAgentBrowser.GetUserAgent:
string;
begin
Result := FUserAgent;
end;
end.