IAccessible：获取具有访问冲突的活动URL [英] IAccessible: Get Active url with Access violation

问题描述

我在显示Form1并在浏览器中侦听活动的URL时遇到问题。在以下代码中，使用showmessage函数进行测试后，在我的项目中对Acess进行了封装，如下图所示：

I'm with a problem for show my Form1 and listen the active url in on browser. In code following, after the test with showmessage function, apper an Acess violation in my project as on following images:

IMAGE_！和
IMAGE_2

IMAGE_! and IMAGE_2

这是我的代码：

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, { MSAAIntf, } Oleacc, ActiveX;

type
  HWINEVENTHOOK = DWORD;

  TForm1 = class(TForm)
    Memo1: TMemo;
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  Memo1: TMemo;
  vHook: HWINEVENTHOOK = 0;
  Eventos: Boolean = false;
  UrlAtiva, UrlVelha: WideString;

implementation

{$R *.dfm}

procedure WinEventProc(HWINEVENTHOOK: THandle; event: DWORD; hwnd: hwnd;
  idObject, idChild: Longint; idEventThread, dwmsEventTime: DWORD); stdcall;

var
  vAccObj: IAccessible;
  varChild: OleVariant;
  vWSName, vWSValue: WideString;
  ClassName: String;
  Acesso: HResult;

begin
  vAccObj := nil;
  Acesso := AccessibleObjectFromEvent(hwnd, idObject, idChild, vAccObj,
    varChild);
  SetLength(ClassName, 255);
  SetLength(ClassName, GetClassName(hwnd, pchar(ClassName), 255));

  IF (Acesso = S_OK) and (vAccObj <> nil) THEN
  BEGIN
    vAccObj.Get_accName( { CHILDID_SELF } varChild, vWSName);
    vAccObj.Get_accValue( { CHILDID_SELF } varChild, vWSValue);
  END;

  IF (pchar(ClassName) = 'Chrome_WidgetWin_1') AND (Eventos = true) AND
    (vWSName = 'Address and search bar') AND (vWSValue <> '<null>') THEN

    UrlAtiva := vWSValue;

  IF (UrlAtiva <> UrlVelha) THEN

  BEGIN
    UrlVelha := UrlAtiva;
    Memo1.Lines.Add(UrlAtiva);
  end;

  vAccObj._Release;
end;

procedure Unhook;

begin
  if (vHook = 0) then
    Exit;

  UnhookWinEvent(vHook);
  CoUninitialize;
end;

procedure Hook;

begin
  if (vHook <> 0) then
    Exit;

  CoInitialize(nil);
  vHook := SetWinEventHook(EVENT_OBJECT_FOCUS, EVENT_OBJECT_VALUECHANGE, 0,
    WinEventProc, 0, 0, WINEVENT_SKIPOWNPROCESS);
end;

function Thread_Infinite(navegador: Pointer = nil): DWORD; stdcall;

var

  wH: array of THandle;
  wR: DWORD;
  Msg: TMSG;
  leave: Boolean;

begin
  wH := navegador;
  leave := false;
  Hook;

  repeat
    wR := MsgWaitForMultipleObjects(1, wH, false, INFINITE, QS_ALLEVENTS);

    case wR of

      WAIT_ABANDONED:
        ;
      WAIT_FAILED:
        ;
      WAIT_OBJECT_0:
        begin
          leave := true;
          break;
        end;

      WAIT_OBJECT_0 + 1:
        while PeekMessage(Msg, 0, 0, 0, PM_REMOVE) do
        begin
          TranslateMessage(Msg);
          DispatchMessage(Msg);
        end;
    end;
    break;

  Until not leave;
  Unhook;
  Result := 0;
end;

function inicia_tudo: integer;

var
  szFileName: array [0 .. 100] of char;
  szModuleName: array [0 .. 19] of char;
  iSize: integer;
  threadId: DWORD;
  Stop, Thread: THandle;
begin
  StrPCopy(szModuleName, 'Project1');
  iSize := GetModuleFileName(GetModuleHandle(szModuleName), szFileName,
    SizeOf(szFileName));
  if iSize > 0 then
  begin
    ShowMessage(StrPas(szFileName));
    Eventos := true;
  end;

  Stop := CreateEvent(nil, true, false, nil);
  Thread := CreateThread(nil, 0, (Pointer(Thread_Infinite)), (Pointer(Stop)),
    0, threadId);

  SetEvent(Stop);

  WaitForSingleObject(Thread, 5000);

  CloseHandle(Thread);
  CloseHandle(Stop);

  Result := 0;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  inicia_tudo;
end;

end.

推荐答案

尝试其他类似方法：

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls;

  TForm1 = class(TForm)
    Memo1: TMemo;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  private
    { Private declarations }
    procedure AddUrlToMemo;
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

uses
  { MSAAIntf, } Oleacc, ActiveX;

{$R *.dfm}

type
  HWINEVENTHOOK = THandle;

var
  UrlVelha: WideString;
  Thread: THandle = 0;
  ThreadId: DWORD = 0;

procedure WinEventProc(hWinEventHook: HWINEVENTHOOK; event: DWORD; hwnd: HWND;
  idObject, idChild: Longint; idEventThread, dwmsEventTime: DWORD); stdcall;
var
  vAccObj: IAccessible;
  varChild: OleVariant;
  vWSName, vWSValue: WideString;
  ClassName: String;
  Acesso: HResult;
begin
  SetLength(ClassName, 255);
  SetLength(ClassName, GetClassName(hwnd, PChar(ClassName), 255));

  if (ClassName = 'Chrome_WidgetWin_1') then
  begin
    Acesso := AccessibleObjectFromEvent(hwnd, idObject, idChild, vAccObj, varChild);
    If (Acesso = S_OK) and (vAccObj <> nil) then
    begin
      vAccObj.Get_accName( { CHILDID_SELF } varChild, vWSName);
      if (vWSName = 'Address and search bar') then
      begin
        vAccObj.Get_accValue( { CHILDID_SELF } varChild, vWSValue);
        if (vWSValue <> '') and (vWSValue <> '<null>') and (UrlVelha <> vWSValue) then
        begin
          UrlVelha := vWSValue;
          TThread.Synchronize(nil, Form1.AddUrlToMemo);
        end;
      end;
    end;
  end;
end;

function Thread_Infinite(param: Pointer): DWORD; stdcall;
var
  Msg: TMSG;
  vHook: HWINEVENTHOOK;
begin
  CoInitialize(nil);

  vHook := SetWinEventHook(EVENT_OBJECT_FOCUS, EVENT_OBJECT_VALUECHANGE, 0,
    @WinEventProc, 0, 0, WINEVENT_SKIPOWNPROCESS);

  while GetMessage(Msg, 0, 0, 0) do
  begin
    TranslateMessage(Msg);
    DispatchMessage(Msg);
  end;

  if (vHook <> 0) then
    UnhookWinEvent(vHook);

  CoUninitialize;
  Result := 0;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  Thread := CreateThread(nil, 0, @Thread_Infinite, nil, 0, ThreadId);
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  if (ThreadId <> 0) then
    PostThreadMessage(ThreadId, WM_QUIT, 0, 0);
  if (Thread <> 0) then
  begin
    repeat
      if (WaitForSingleObject(Thread, 5000) <> WAIT_TIMEOUT) then
        Break;
      CheckSynchronize;
    until False;
    CloseHandle(Thread);
  end;
end;

procedure TForm1.AddUrlToMemo;
begin
  if (Memo1 <> nil) and (not (csDestroying in ComponentState)) then
    Memo1.Lines.Add(UrlVelha);
end;

end.

这篇关于IAccessible：获取具有访问冲突的活动URL的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！