Вкладки TEventObject & IE дают фатальную ошибку - PullRequest
Новая
       29

Вкладки TEventObject & IE дают фатальную ошибку

0 голосов
/ 07 декабря 2009

Я использую этот код 

  try
  document := (pDisp as  IWebbrowser2).Document AS IHTMLDocument2;
  Body := Document.body;
  Links := Document.links;
  for i := 0 to (Links.length-1) do
    begin
      tmp := (Links.item(i, 0) as IHTMLElement);
      tmp.onclick := TEventObject.Create(MyProcedure) as IDispatch; // THIS LINE
    end;
  except
    on E : Exception do
      ShowMessage(E.ClassName+' error raised, with message : '+E.Message);
  end;

В событии DocumentComplete веб-браузера IE все работает нормально, но когда я открываю новую вкладку, у меня появляется Microsoft Internet Explorer, возникла проблема, и ее необходимо закрыть ».

Строка, помеченная // ЭТОЙ ЛИНИЙ в приведенном выше коде, является причиной, вызывающей ее (я прокомментировал ее, но она не показала ошибку).

Вот остаток кода: 

  TEventObject = class(TInterfacedObject, IDispatch)
  private
    FOnEvent: TProcedure;
  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;
  public
    constructor Create(const OnEvent: TProcedure);
    property OnEvent: TProcedure read FOnEvent write FOnEvent;
  end;


...........

constructor TEventObject.Create(const OnEvent: TProcedure);
begin
  inherited Create;
  FOnEvent := OnEvent;
end;

function TEventObject.GetIDsOfNames(const IID: TGUID; Names: Pointer;
  NameCount, LocaleID: Integer; DispIDs: Pointer): HResult;
begin
  Result := E_NOTIMPL;
end;

function TEventObject.GetTypeInfo(Index, LocaleID: Integer;
  out TypeInfo): HResult;
begin
  Result := E_NOTIMPL;
end;

function TEventObject.GetTypeInfoCount(out Count: Integer): HResult;
begin
  Result := E_NOTIMPL;
end;

function TEventObject.Invoke(DispID: Integer; const IID: TGUID;
  LocaleID: Integer; Flags: Word; var Params; VarResult, ExcepInfo,
  ArgErr: Pointer): HResult;
begin
  if (Dispid = DISPID_VALUE) then
  begin
    if Assigned(FOnEvent) then
      FOnEvent;
    Result := S_OK;
  end
  else Result := E_NOTIMPL;
end;

Как я могу заставить его работать на вкладках?

1 Ответ

1 голос
/ 08 декабря 2009

Я нашел обходной путь: 

  URL := AnsiLowerCase(URL);
  if (URL='')  or (URL='about:blank') or (URL='about:tabs') then Exit;

События нажатия работают нормально на других страницах, которые не относятся к вкладкам.

...