IAccessible: Get Active url with Access violation

[Luiz Eduardo]

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_1
IMAGE_2

Here is my code:

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.

[darkagn]

Are you able to run in the IDE debugger and see which line throws the AV error?