TEventObject&IEのタブは、致命的なエラーを与えます
-
16-09-2019 - |
質問
私はこのコードを使用しています。
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;
IEのWebブラウザのDocumentCompleteイベントでは、それが正常に動作しますが、私は新しいタブを開いたとき、私は、Microsoft Internet Explorerが問題が発生した「エラーを終了する必要があり得る。
上記のコードでTHIS LINE //でマークされた行は、(私はそれをコメントし、それがエラーを示さなかった)、それを引き起こしているものです。
ここで残りのコードです:
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;
どのように私はそれが、タブのために動作させることができるか。
解決
私は回避策を見つけます:
URL := AnsiLowerCase(URL);
if (URL='') or (URL='about:blank') or (URL='about:tabs') then Exit;
クリックイベントについてではない、他のページで[OK]を動作します。タブ
所属していません StackOverflow