UserAgent von TWebBrowser ändern

[bixi400]

Hi!

Kann man mit Delphi den UserAgent von TWebBrowser ändern,
wenn ja wie?

[toms]

Hallo,

Verwende stattdessen den TEmbeddedweb.

[ptown67]

Servus!

Also ich verwende ja für ein Projekt den EmbeddedWebBrowser. Aber ich konnte dort den kompletten Sting für UserAgent leider nicht ändern.

Ist es etwa doch möglich? Kann mir evtl. jemand ein Beispiel geben?

Viele Grüße ;)

[generic]

die Euromind Server haben schon seit paar Jahren den Download nicht mehr.
neue Location: http://www.bsalsa.com/

[toms]

So setzt der TEmbeddedWeb den Useragent. Es wird also noch "Eigenwerbung" angehängt.

Delphi-Quellcode:

procedure SetUserAgent(var UserAgent: string);
var
  reg: TRegistry;
begin
  Reg := TRegistry.Create;
  if UserAgent <> EWB_INFO then
    UserAgent := UserAgent + EWB_INFO;
  with Reg do
  begin
    RootKey := HKEY_CURRENT_USER;
    try
      if OpenKey('\Software\Microsoft\Windows\CurrentVersion\Internet Settings\User Agent\Post Platform', True) then
        WriteString(UserAgent, '');
    finally
      CloseKey;
      Free;
    end;
  end;
end;

Eine andere Möglichkeitvon hier:

Zitat:

Du musst zuerst deinen Browser Komponent
erweitern. Hier ist der Code *als Hinweis*. Und DISPID_AMBIENT_USERAGENT
ist in SHDocVW.h (Windows SDK) definiert.

Delphi-Quellcode:

TUserAgentBrowser = class(TWebBrowser, IDispatch) 
protected 
   function GetTypeInfoCount(out Count: Integer): HRESULT; stdcall; 
   function GetTypeInfo(Index, LocaleID: Integer; out TypeInfo): 
HRESULT; stdcall; 
   function GetIDsOfNames(const IID: TGUID; Names: Pointer; NameCount, 
LocaleID: Integer; DispIDs: Pointer): HRESULT; stdcall; 
   function Invoke(DispID: Integer; const IID: TGUID; LocaleID: Integer; 
Flags: Word; var Params; VarResult, ExcepInfo, ArgErr: Pointer): 
HRESULT; stdcall; 
end; 


function TUserAgentBrowser.GetTypeInfoCount(out Count: Integer): HRESULT; 
begin 
   Result := E_NOTIMPL; 
   Count  := 0; 
end; 


function TUserAgentBrowser.GetTypeInfo(Index, LocaleID: Integer; out 
TypeInfo): HRESULT; 
begin 
   Result := E_NOTIMPL; 
   Pointer(TypeInfo) := nil; 
end; 


function TUserAgentBrowser.GetIDsOfNames(const IID: TGUID; Names: 
Pointer; NameCount, LocaleID: Integer; DispIDs: Pointer): HRESULT; 
begin 
   PDispIDList(DispIDs)[0] := DISPID_UNKNOWN; 
   Result := DISP_E_UNKNOWNNAME; 
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 
      -5513{DISPID_AMBIENT_USERAGENT}: 
       begin 
         POleVariant(VarResult)^ := 'Owner User Agent' + #13#10; 
         Result := S_OK; 
         Exit; 
       end; 
     end; 
   Result := inherited Invoke(DispID, IID, LocaleID, Flags, Params, 
VarResult, ExcepInfo, ArgErr); 
end;

[toms]

Konntest du dies so umsetzen?

[ptown67]

hi toms!

danke für deine antwort.

das erste beispiel war mir bereits bekannt, bzw. ich wusste, dass man die werte in der registry anpassen kann. aber nach programmende ist ja dann auch mein wert für den nativen IE gesetzt. am besten vorher den eigentlichen wert irgendwo zwischenspeichern und dann bei programmende wieder setzen.

dein zweites beispiel, habe ich noch nicht so ganz verstanden, werde es aber mal testen...

thx & gruß ;)

[s4nity]

Hi,
ich habe dazu eine Frage ;)
wo genau muss der code hin ?
muss ich eine neue twebbrowser komponente erstellen ? oder reicht es wenn ich ihn in das aktuelle projekt einfüge ?

mfg
s4nity

[toms]

Zitat:

Zitat von s4nity

Hi,
ich habe dazu eine Frage ;)
wo genau muss der code hin ?
muss ich eine neue twebbrowser komponente erstellen ? oder reicht es wenn ich ihn in das aktuelle projekt einfüge ?

mfg
s4nity

Am besten erstellst du eine neue Komponente.
In der Eigeschaft UserAgent kannst du dann im OI deinen UserAgent eingeben.

Delphi-Quellcode:

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.