Page 1 of 4

Read DirectUIHWND class window and select item.[solved]

Posted: Tue Sep 11, 2012 5:42 am
by alfa
Great work has been done by luis. This example of delphi code is read item DirectUIHWND class window. (window explorer-My Computer for example)

Delphi source:

Code: Select all

function AccessibleChildren(paccContainer : Pointer; iChildStart : LONGINT; cChildren : LONGINT; out rgvarChildren : OleVariant; out pcObtained : LONGINT) : HRESULT; stdcall;
  stdcall; external 'oleacc.dll';
 
procedure TForm1.DisplayInfo(const aAccessible : IAccessible; const aOffset : string);
 
  procedure ProcessChild(const aChild : OleVariant);
  var
    ChildAccessible : IAccessible;
    ChildDispatch : IDispatch;
  begin
    ChildDispatch := nil;
    case VarType(aChild) of
      varInteger : aAccessible.Get_accChild(aChild, ChildDispatch);
      varDispatch : ChildDispatch := aChild;
    end;
    if (ChildDispatch <> nil) and (ChildDispatch.QueryInterface(IAccessible, ChildAccessible) = S_OK) then
      DisplayInfo(ChildAccessible, aOffset + ' ')
  end;
 
var
  Child, CurrentChild : OleVariant;
  ChildArray : array of OleVariant;
  dwNum : DWord;
  Enum : IEnumVARIANT;
  i, iChildCount, iObtained : Integer;
  wsText : WideString;
begin
  if aAccessible <> nil then begin
      if aAccessible.get_AccName(CHILDID_SELF, wsText) = S_OK then
        Memo1.Lines.Add(aOffset + 'Name: ' + wsText)
      else
        Memo1.Lines.Add(aOffset + 'Name: Empty');
      if aAccessible.get_AccValue(CHILDID_SELF, wsText) = S_OK then
        Memo1.Lines.Add(aOffset + ' Value: ' + wsText);
      if aAccessible.get_AccDescription(CHILDID_SELF, wsText) = S_OK then
        Memo1.Lines.Add(aOffset + ' Description: ' + wsText);
 
      if (aAccessible.Get_accChildCount(iChildCount) = S_OK) and (iChildCount > 0) then begin
          Form1.Memo1.Lines.Add(aOffset + ' Children: ' + IntToStr(iChildCount));
          SetLength(ChildArray, iChildCount);
          if AccessibleChildren(Pointer(aAccessible), 0, iChildCount, ChildArray[0], iObtained) = S_OK then begin
              for i := 0 to iObtained - 1 do
                ProcessChild(ChildArray[i])
            end else if aAccessible.QueryInterface(IEnumVARIANT, Enum) = S_OK then begin
              Enum := aAccessible as IEnumVARIANT;
              for i := 0 to iChildCount - 1 do
                if Enum.Next(1, Child, dwNum) = S_OK then
                  ProcessChild(Child);
            end else begin
              if aAccessible.accNavigate(NAVDIR_FIRSTCHILD, CHILDID_SELF, CurrentChild) = S_OK then begin
                  repeat
                    ProcessChild(CurrentChild)
                  until aAccessible.accNavigate(NAVDIR_NEXT, CurrentChild, CurrentChild) <> S_OK;
                end
            end
        end
    end
end;
 
-------------------------------------------------------------------------------------
var
  Accessible : IAccessible;
  hWindow : HWnd;
begin
  Memo1.Lines.Clear;
  hWindow := FindWindowA('CabinetWClass', nil);
  if AccessibleObjectFromWindow(hWindow, 0, IID_IAccessible, Accessible) = S_OK then
  DisplayInfo(Accessible, '');
-------------------------------------------------------------------------------------
For select use accSelect command http://msdn.microsoft.com/ru-ru/library ... cselect#Y0
But before use select you need to set this window to top-window. Else select didnt work.

Code: Select all

;port by luis
;http://www.purebasic.fr/english/viewtopic.php?f=17&t=51303
;PB 4.61

;EnableExplicit

CompilerIf (#PB_Compiler_Unicode = 0)
 CompilerError "Turn on: Create Unicode executable"
CompilerEndIf

Macro DEFINE_GUID(Name, l, w1, w2, b1, b2, b3, b4, b5, b6, b7, b8)
  CompilerIf Defined(Name, #PB_Variable)
  If SizeOf(Name) = SizeOf(GUID)
    Name\Data1    = l
    Name\Data2    = w1
    Name\Data3    = w2
    Name\Data4[0] = b1
    Name\Data4[1] = b2
    Name\Data4[2] = b3
    Name\Data4[3] = b4
    Name\Data4[4] = b5
    Name\Data4[5] = b6
    Name\Data4[6] = b7
    Name\Data4[7] = b8
  EndIf
  CompilerEndIf
EndMacro

Global IID_IAccessible.GUID
DEFINE_GUID(IID_IAccessible, $618736e0, $3c3d, $11cf, $81, $0c, $00, $aa, $00, $38, $9b, $71)

Global IID_IEnumVARIANT.GUID ; 00020404-0000-0000-C000-000000000046
DEFINE_GUID(IID_IEnumVARIANT, $00020404, $0000, $0000, $c0, $00, $00, $00, $00, $00, $00, $46)
;http://msdn.microsoft.com/en-us/library/system.runtime.interopservices.comtypes.ienumvariant.aspx


Prototype.l ProtoAccessibleObjectFromWindow(hwnd.i,dwObjectID.l, riid, *ppvObject)
Global AccessibleObjectFromWindow.ProtoAccessibleObjectFromWindow

Prototype.l ProtoAccessibleChildren(*paccContainer,iChildStart.l,cChildren.l,*rgvarChildren,*pcObtained)
Global AccessibleChildren.ProtoAccessibleChildren

Global hwnd
Define hdll 
Define *Accessible.IAccessible

CoInitialize_(0)

hdll=OpenLibrary(#PB_Any,"Oleacc.dll")

AccessibleObjectFromWindow = GetFunction(hdll,"AccessibleObjectFromWindow")
AccessibleChildren = GetFunction(hdll,"AccessibleChildren")

#NAVDIR_DOWN = 2
#NAVDIR_FIRSTCHILD = 7
#NAVDIR_LASTCHILD = 8
#NAVDIR_LEFT = 3
#NAVDIR_NEXT = 5
#NAVDIR_PREVIOUS = 6
#NAVDIR_RIGHT = 4
#NAVDIR_UP = 1

#CHILDID_SELF = 0

;http://msdn.microsoft.com/en-us/library/windows/desktop/dd318474(v=vs.85).aspx
#SELFLAG_TAKEFOCUS = 1
#SELFLAG_TAKESELECTION = 2
      
Declare    ProcessChild (*aAccessible.IAccessible, aOffset$, *aChild.VARIANT)
Declare    DisplayInfo (*aAccessible.IAccessible, aOffset$ )

Procedure.s GetBSTR (*BSTR_wsText) ; needed to trap NULL BSTR (seem it's possible and valid)
  If *BSTR_wsText 
    ProcedureReturn PeekS(*BSTR_wsText)
  EndIf
  ProcedureReturn ""
EndProcedure

Procedure ProcessChild (*aAccessible.IAccessible, aOffset$, *aChild.VARIANT)
 Protected *ChildAccessible.IAccessible
 Protected *ChildDispatch.IDispatch
 
 Select *aChild\vt
    Case #VT_I4 ; varInteger (was #VT_INT, wrong, see http://delphi.about.com/library/weekly/aa122104a.htm)
        *aAccessible\get_accChild(*aChild, @*ChildDispatch)
    Case #VT_DISPATCH ; varDispatch
        *ChildDispatch = *aChild\pdispVal
 EndSelect
 
 If *ChildDispatch <> #Null And *ChildDispatch\QueryInterface(@IID_IAccessible, @*ChildAccessible) = #S_OK
     DisplayInfo(*ChildAccessible, aOffset$ + " ")
 EndIf
EndProcedure

Procedure DisplayInfo (*aAccessible.IAccessible, aOffset$ )
 Protected count, iObtained
 Protected BSTR_wsText
 Protected vt.VARIANT, i, err
 Protected *enum.IEnumVARIANT
 
 vt\vt = #VT_I4 
 vt\lVal = #CHILDID_SELF 
 
 If *aAccessible
    BSTR_wsText = SysAllocString_("")
   
    If *aAccessible\get_accName(vt, @BSTR_wsText) = #S_OK
        Debug aOffset$ + "Name: " + GetBSTR(BSTR_wsText) 
        ;select operation
        If GetBSTR(BSTR_wsText) = "File"
          SetForegroundWindow_(hwnd)
          err = *aAccessible\accSelect(#SELFLAG_TAKEFOCUS | #SELFLAG_TAKESELECTION, vt)        
          Debug err
        EndIf            
    Else
        Debug aOffset$ + "Name: Empty"
    EndIf

    If *aAccessible\get_AccValue(vt, @BSTR_wsText) = #S_OK
        Debug aOffset$ + " Value: " + GetBSTR(BSTR_wsText) 
    EndIf
   
    If *aAccessible\get_AccDescription(vt, @BSTR_wsText) = #S_OK
        Debug aOffset$ + " Description: " + GetBSTR(BSTR_wsText) 
    EndIf
   
    If *aAccessible\get_accChildCount(@count) = #S_OK And count > 0     
        aOffset$ + " " ; fix indenting
        Debug aOffset$ + "Children: " + Str(count)
           
        Dim ChildArray.VARIANT(count)
        Protected Child.VARIANT, CurrentChild.VARIANT
        Protected dwNum.l
       
        If AccessibleChildren(*aAccessible, 0, count, @ChildArray(0), @iObtained) = #S_OK   
            For i = 0 To iObtained - 1
                ProcessChild(*aAccessible, aOffset$, ChildArray(i))         
            Next
        ElseIf *aAccessible\QueryInterface(@IID_IEnumVARIANT, @*enum) = #S_OK 
            ;
            ;*enum = *aAccessible ; this look definitely wrong, don't know how this did work in delphi
            ;         
            *enum\Reset() ; for good measure 
            
            For i = 0 To count - 1               
                If *enum\Next(1, @Child, 0) = #S_OK
                    ProcessChild(*aAccessible, aOffset$, @Child)
                EndIf
            Next
        Else
            If *aAccessible\accNavigate(#NAVDIR_FIRSTCHILD, vt, @CurrentChild) = #S_OK
                Repeat
                    ProcessChild(*aAccessible, aOffset$, @CurrentChild)
                Until *aAccessible\accNavigate(#NAVDIR_NEXT, @CurrentChild, @CurrentChild) <> #S_OK
            EndIf               
       EndIf
    EndIf
    
    
    SysFreeString_(BSTR_wsText) ; to be sure, no leak
    VariantClear_(vt) ; to be sure, no leak
   
 EndIf
EndProcedure


hwnd = FindWindow_( "CabinetWClass", 0)

If hwnd       
    SetForegroundWindow_(hwnd)
    If AccessibleObjectFromWindow(hwnd, 0, @IID_IAccessible, @*Accessible) = #S_OK     
        DisplayInfo(*Accessible, "")
    EndIf
EndIf



Re: pay task

Posted: Tue Sep 11, 2012 6:14 pm
by alfa
Anybody? We cant to do this ourselves - to many command, constant, variables... This is last function in programm. We want to finaly finish this project, but stuck on this code :(

Re: pay task

Posted: Tue Sep 11, 2012 10:39 pm
by MachineCode
Up your price. We're busy people. :)

Re: pay task

Posted: Wed Sep 12, 2012 5:38 am
by alfa
I am not have a lot of money :(. And the final program will be free.

Re: pay task

Posted: Wed Sep 12, 2012 4:22 pm
by alfa
Why i have only 1 child item in my code? That example have 7!

Open My Computer and check unicode in compiler:

Code: Select all

Macro DEFINE_GUID(Name, l, w1, w2, b1, b2, b3, b4, b5, b6, b7, b8)
  CompilerIf Defined(Name, #PB_Variable)
  If SizeOf(Name) = SizeOf(GUID)
    Name\Data1    = l
    Name\Data2    = w1
    Name\Data3    = w2
    Name\Data4[0] = b1
    Name\Data4[1] = b2
    Name\Data4[2] = b3
    Name\Data4[3] = b4
    Name\Data4[4] = b5
    Name\Data4[5] = b6
    Name\Data4[6] = b7
    Name\Data4[7] = b8
  EndIf
  CompilerEndIf
EndMacro

Define IID_IAccessible.GUID
DEFINE_GUID(IID_IAccessible, $618736e0, $3c3d, $11cf, $81, $0c, $0, $aa, $0, $38, $9b, $71)

#OBJID_SYSMENU = $FFFFFFFF

;-Prototypes
Prototype.l ProtoAccessibleObjectFromWindow(hwnd.i,dwObjectID.l,riid.c,*ppvObject)
Global AccessibleObjectFromWindow.ProtoAccessibleObjectFromWindow

Prototype.l ProtoAccessibleChildren(*paccContainer,iChildStart.l,cChildren.l,*rgvarChildren,*pcObtained)
Global AccessibleChildren.ProtoAccessibleChildren

Define hdll.l
CoInitialize_(0)
hdll=OpenLibrary(#PB_Any,"Oleacc.dll")
AccessibleObjectFromWindow = GetFunction(hdll,"AccessibleObjectFromWindow")
AccessibleChildren = GetFunction(hdll,"AccessibleChildren")



          hwnd = FindWindow_( "CabinetWClass", 0 )
          If hwnd
            *ppvObject.IAccessible
            If AccessibleObjectFromWindow(hwnd, #OBJID_SYSMENU, IID_IAccessible, @*ppvObject) = #S_OK;
              Debug ""
              Debug "AccessibleObjectFromWindow is ok"
              Debug ""
              
              If *ppvObject\get_accChildCount(@*count) = #S_OK
                Debug ""
                Debug "get_accChildCount is ok"
                Debug ""
                
                Debug *count
                Debug @*count
                Debug PeekU(@*count)
                ;I dont know how to read this variable
                ;It will show 1, but must show 7!

                
              EndIf
              
            EndIf
          EndIf
Image

Re: pay task

Posted: Wed Sep 12, 2012 5:30 pm
by luis
If you change #OBJID_SYSMENU to 0 as in the (DELPHI ?) example above it will return 7.

What all code is doing I don't know, so don't ask me more :)

Re: pay task

Posted: Wed Sep 12, 2012 5:50 pm
by alfa
What language of example i dont know. This code read window that have DirectUIHWND class. With youre 0 is work fine - show 7 :) But now how to make work next command - AccessibleChildren:

Code: Select all

Macro DEFINE_GUID(Name, l, w1, w2, b1, b2, b3, b4, b5, b6, b7, b8)
  CompilerIf Defined(Name, #PB_Variable)
  If SizeOf(Name) = SizeOf(GUID)
    Name\Data1    = l
    Name\Data2    = w1
    Name\Data3    = w2
    Name\Data4[0] = b1
    Name\Data4[1] = b2
    Name\Data4[2] = b3
    Name\Data4[3] = b4
    Name\Data4[4] = b5
    Name\Data4[5] = b6
    Name\Data4[6] = b7
    Name\Data4[7] = b8
  EndIf
  CompilerEndIf
EndMacro

Define IID_IAccessible.GUID
DEFINE_GUID(IID_IAccessible, $618736e0, $3c3d, $11cf, $81, $0c, $0, $aa, $0, $38, $9b, $71)

;#OBJID_SYSMENU = $FFFFFFFF
#OBJID_SYSMENU = 0

;-Prototypes
Prototype.l ProtoAccessibleObjectFromWindow(hwnd.i,dwObjectID.l,riid.c,*ppvObject)
Global AccessibleObjectFromWindow.ProtoAccessibleObjectFromWindow

Prototype.l ProtoAccessibleChildren(*paccContainer,iChildStart.l,cChildren.l,*rgvarChildren,*pcObtained)
Global AccessibleChildren.ProtoAccessibleChildren

Define hdll.l
CoInitialize_(0)
hdll=OpenLibrary(#PB_Any,"Oleacc.dll")
AccessibleObjectFromWindow = GetFunction(hdll,"AccessibleObjectFromWindow")
AccessibleChildren = GetFunction(hdll,"AccessibleChildren")


      hwnd = FindWindow_( "CabinetWClass", 0 )
      If hwnd
        *ppvObject.IAccessible
        If AccessibleObjectFromWindow(hwnd, #OBJID_SYSMENU, IID_IAccessible, @*ppvObject) = #S_OK;
          Debug ""
          Debug "AccessibleObjectFromWindow is ok"
          Debug ""
              
          If *ppvObject\get_accChildCount(@*count) = #S_OK
            Debug ""
            Debug "get_accChildCount is ok"
            Debug ""
               
            Debug *count
                
            Dim ChildArray(*count)
                
            If AccessibleChildren(*ppvObject, 0, *count, ChildArray(0), *iObtained) = #S_OK
              Debug ""
              Debug "AccessibleChildren is ok"
              Debug ""
            Else
              Debug ""
              Debug "AccessibleChildren is not ok2"
              Debug ""
            EndIf

                
          EndIf
              
        EndIf
      EndIf
I am not have knowledge about this things... can you make whole convert that code + select item? I will little pay for that. I am very long time search "truth" like Fox Mulder :)

msdn AccessibleChildren

Re: pay task

Posted: Wed Sep 12, 2012 8:07 pm
by luis
Try this way, I changed some things, not 100% sure since I never used these API before but it seems better:

Code: Select all

EnableExplicit

Macro DEFINE_GUID(Name, l, w1, w2, b1, b2, b3, b4, b5, b6, b7, b8)
  CompilerIf Defined(Name, #PB_Variable)
  If SizeOf(Name) = SizeOf(GUID)
    Name\Data1    = l
    Name\Data2    = w1
    Name\Data3    = w2
    Name\Data4[0] = b1
    Name\Data4[1] = b2
    Name\Data4[2] = b3
    Name\Data4[3] = b4
    Name\Data4[4] = b5
    Name\Data4[5] = b6
    Name\Data4[6] = b7
    Name\Data4[7] = b8
  EndIf
  CompilerEndIf
EndMacro

Define IID_IAccessible.GUID
DEFINE_GUID(IID_IAccessible, $618736e0, $3c3d, $11cf, $81, $0c, $0, $aa, $0, $38, $9b, $71)

;#OBJID_SYSMENU = $FFFFFFFF
#OBJID_SYSMENU = 0

;-Prototypes
Prototype.l ProtoAccessibleObjectFromWindow(hwnd.i,dwObjectID.l, riid, *ppvObject) ; hmmmm... why riid as .c ?
Global AccessibleObjectFromWindow.ProtoAccessibleObjectFromWindow

Prototype.l ProtoAccessibleChildren(*paccContainer,iChildStart.l,cChildren.l,*rgvarChildren,*pcObtained)
Global AccessibleChildren.ProtoAccessibleChildren

Define hdll, hwnd,  count, iObtained ; defined the two last vars as integers (no pointers)
Define *ppvObject.IAccessible

CoInitialize_(0)

hdll=OpenLibrary(#PB_Any,"Oleacc.dll")

AccessibleObjectFromWindow = GetFunction(hdll,"AccessibleObjectFromWindow")
AccessibleChildren = GetFunction(hdll,"AccessibleChildren")

hwnd = FindWindow_( "CabinetWClass", 0 )

If hwnd        
    If AccessibleObjectFromWindow(hwnd, #OBJID_SYSMENU, @IID_IAccessible, @*ppvObject) = #S_OK;
        Debug ""
        Debug "AccessibleObjectFromWindow is ok"
        Debug ""
     
        If *ppvObject\get_accChildCount(@count) = #S_OK ; no need for count to be a pointer
            Debug ""
            Debug "get_accChildCount is ok"       
            Debug count
           
            Dim ChildArray.VARIANT(count) ; ... I suppose it's an array of variant structures
           
            If AccessibleChildren(*ppvObject, 0, count, @ChildArray(0), @iObtained) = #S_OK ;  no need for iObtained to be a pointer
                Debug ""
                Debug "AccessibleChildren is ok"
                Debug iObtained      
            Else    
                Debug ""
                Debug "AccessibleChildren is not ok2"
                Debug ""
            EndIf
    
        EndIf    
    EndIf
EndIf

Re: pay task

Posted: Wed Sep 12, 2012 10:40 pm
by luis
BTW: I started a conversion of the original DELPHI code

Code: Select all

EnableExplicit

#CHILDID_SELF = 0

Procedure ProcessChild (*aAccessible.IAccessible, *aChild.VARIANT)
 Protected *ChildDispatch.IDispatch
 
 Select *aChild\vt
    Case #VT_INT ; integer
        *aAccessible\get_accChild(*aChild, @*ChildDispatch)
    Case #VT_DISPATCH
        ; .... todo
 EndSelect
 
 ; ... todo 

EndProcedure

Procedure DisplayInfo (*aAccessible.IAccessible, aOffset$ )
 Protected count, iObtained 
 Protected BSTR_wsText ; this should be a BSTR string I think
 If *aAccessible
    BSTR_wsText = SysAllocString_("")
    Debug SysStringByteLen_(BSTR_wsText) ; it works
   
   If *aAccessible\get_accName(#CHILDID_SELF, @BSTR_wsText) = #S_OK ; IMA here, don't know why   
        Debug aOffset$ + "Name: " + PeekS(BSTR_wsText)
    EndIf
 EndIf
EndProcedure

Macro DEFINE_GUID(Name, l, w1, w2, b1, b2, b3, b4, b5, b6, b7, b8)
  CompilerIf Defined(Name, #PB_Variable)
  If SizeOf(Name) = SizeOf(GUID)
    Name\Data1    = l
    Name\Data2    = w1
    Name\Data3    = w2
    Name\Data4[0] = b1
    Name\Data4[1] = b2
    Name\Data4[2] = b3
    Name\Data4[3] = b4
    Name\Data4[4] = b5
    Name\Data4[5] = b6
    Name\Data4[6] = b7
    Name\Data4[7] = b8
  EndIf
  CompilerEndIf
EndMacro

Define IID_IAccessible.GUID
DEFINE_GUID(IID_IAccessible, $618736e0, $3c3d, $11cf, $81, $0c, $0, $aa, $0, $38, $9b, $71)

#OBJID_SYSMENU = 0

Prototype.l ProtoAccessibleObjectFromWindow(hwnd.i,dwObjectID.l, riid, *ppvObject) 
Global AccessibleObjectFromWindow.ProtoAccessibleObjectFromWindow

Prototype.l ProtoAccessibleChildren(*paccContainer,iChildStart.l,cChildren.l,*rgvarChildren,*pcObtained)
Global AccessibleChildren.ProtoAccessibleChildren

Define hdll, hwnd
Define *Accessible.IAccessible

CoInitialize_(0)

hdll=OpenLibrary(#PB_Any,"Oleacc.dll")

AccessibleObjectFromWindow = GetFunction(hdll,"AccessibleObjectFromWindow")
AccessibleChildren = GetFunction(hdll,"AccessibleChildren")

hwnd = FindWindow_( "CabinetWClass", 0 )
Define count
If hwnd       
    If AccessibleObjectFromWindow(hwnd, #OBJID_SYSMENU, @IID_IAccessible, @*Accessible) = #S_OK;              
        DisplayInfo(*Accessible, "")
    EndIf
EndIf
But I stopped since I get an IMA to the indicated line (get_accName). I don't see why right now. But maybe this can help you nevertheless so I post it anyway.

Re: pay task

Posted: Thu Sep 13, 2012 5:28 am
by alfa
EnableExplicit - it is possible make this code without this EnableExplicit? I mean main code of program creates without this EnableExplicit. If i will turn on this command - it will need to define whooooole variables (for 4000 strings of code it will many many many variables) If is not, hmm, i do it.

In old my trying of convert i see this get_accName and get_accValue:

Code: Select all

If AccessibleObjectFromWindow(hwnd, #OBJID_SYSMENU, IID_IAccessible, @*ppvObject) = #S_OK;
  
  Debug "ok"
    *Name.s=""
    If *ppvObject\get_accName(vt, @pName) = #S_OK 
      len = SysStringLen_(pName)
      *Name = Space(len) 
      WideCharToMultiByte_(#CP_ACP, 0,pName, -1, @*Name, len, 0, 0)

      *Name = Unicode2String(pName) ; i add this string for unicode compiler.
      
      ;WideCharToMultiByte_(#CP_UTF8, 0,pName, -1, @*Name, len, 0, 0)
      
      Debug *Name

      SysFreeString_(pName)
    EndIf
    
    *Value.s=""
    If *ppvObject\get_accValue(vt, @pName) = #S_OK 
      len = SysStringLen_(pName)
      *Value = Space(len) 
      WideCharToMultiByte_(#CP_ACP, 0,pName, -1, @*Value, len, 0, 0)
      *Value = Unicode2String(pName)
      Debug *Value
      SysFreeString_(pName)
    Else
      Debug "not have value"
    EndIf

EndIf

I try to apply this to your code - i change parametr #CHILDID_SELF to vt.VARIANT, and anyway is stuck with ProcessChild:

Code: Select all

EnableExplicit

Macro DEFINE_GUID(Name, l, w1, w2, b1, b2, b3, b4, b5, b6, b7, b8)
  CompilerIf Defined(Name, #PB_Variable)
  If SizeOf(Name) = SizeOf(GUID)
    Name\Data1    = l
    Name\Data2    = w1
    Name\Data3    = w2
    Name\Data4[0] = b1
    Name\Data4[1] = b2
    Name\Data4[2] = b3
    Name\Data4[3] = b4
    Name\Data4[4] = b5
    Name\Data4[5] = b6
    Name\Data4[6] = b7
    Name\Data4[7] = b8
  EndIf
  CompilerEndIf
EndMacro

Define IID_IAccessible.GUID
DEFINE_GUID(IID_IAccessible, $618736e0, $3c3d, $11cf, $81, $0c, $0, $aa, $0, $38, $9b, $71)

#OBJID_SYSMENU = 0

Prototype.l ProtoAccessibleObjectFromWindow(hwnd.i,dwObjectID.l, riid, *ppvObject) 
Global AccessibleObjectFromWindow.ProtoAccessibleObjectFromWindow

Prototype.l ProtoAccessibleChildren(*paccContainer,iChildStart.l,cChildren.l,*rgvarChildren,*pcObtained)
Global AccessibleChildren.ProtoAccessibleChildren

Define hdll, hwnd
Define *Accessible.IAccessible

CoInitialize_(0)

hdll=OpenLibrary(#PB_Any,"Oleacc.dll")

AccessibleObjectFromWindow = GetFunction(hdll,"AccessibleObjectFromWindow")
AccessibleChildren = GetFunction(hdll,"AccessibleChildren")

#CHILDID_SELF = 0

Procedure ProcessChild (*aAccessible.IAccessible, *aChild.VARIANT)
 Protected *ChildDispatch.IDispatch
 
 Select *aChild\vt
    Case #VT_INT ; integer
        *aAccessible\get_accChild(*aChild, @*ChildDispatch)
    Case #VT_DISPATCH
        ; .... todo
 EndSelect
 
 ; ... todo 

EndProcedure

Procedure DisplayInfo (*aAccessible.IAccessible, aOffset$ )
  Protected count, iObtained 
  Protected BSTR_wsText ; this should be a BSTR string I think
  Define vt.VARIANT, i.i ; this is my add define
  If *aAccessible
    BSTR_wsText = SysAllocString_("")
    Debug SysStringByteLen_(BSTR_wsText) ; it works
   
    If *aAccessible\get_accName(vt, @BSTR_wsText) = #S_OK ; IMA here, don't know why   
      Debug aOffset$ + "Name: " + PeekS(BSTR_wsText)
    EndIf

    If *aAccessible\get_AccValue(vt, @BSTR_wsText) = #S_OK ;
      Debug aOffset$ + "Value: " + PeekS(BSTR_wsText)
    Else
      Debug "not have Value"
    EndIf
    
    If *aAccessible\get_AccDescription(vt, @BSTR_wsText) = #S_OK ;
      Debug aOffset$ + "Description: " + PeekS(BSTR_wsText)
    Else
      Debug "not have Description"
    EndIf 
    
    If *aAccessible\get_accChildCount(@count) = #S_OK And count > 0
      Debug count
      
      Dim ChildArray.VARIANT(count) ; ... I suppose it's an array of variant structures
           
      If AccessibleChildren(*aAccessible, 0, count, @ChildArray(0), @iObtained) = #S_OK ;  no need for iObtained to be a pointer
        Debug ""
        Debug "AccessibleChildren is ok"
        Debug iObtained
        Debug ""
        
        For i = 0 To iObtained - 1
          ;****************************
          ProcessChild(ChildArray(i));*
          ;****************************
        Next
        
      Else    
        Debug ""
        Debug "AccessibleChildren is not ok2"
        Debug ""
      EndIf
      
    EndIf 
    
  EndIf
EndProcedure


hwnd = FindWindow_( "CabinetWClass", 0 )
Define count
If hwnd       
    If AccessibleObjectFromWindow(hwnd, #OBJID_SYSMENU, @IID_IAccessible, @*Accessible) = #S_OK;              
        DisplayInfo(*Accessible, "")
    EndIf
EndIf

Re: pay task

Posted: Thu Sep 13, 2012 2:43 pm
by luis
About EnableExplicit, sure you can just remove it. I use it because it force me to declare all variables thinking about their type and avoid errors due to a mistyped varname. Without it the mistyped variable is just declared on the fly an initialized to 0, causing a lot of undetected problems.

I got a little further, but now there must be something wrong on the remarked line.
Anyway here it is, see if you spot where the problem can be:

Code: Select all

EnableExplicit

Macro DEFINE_GUID(Name, l, w1, w2, b1, b2, b3, b4, b5, b6, b7, b8)
  CompilerIf Defined(Name, #PB_Variable)
  If SizeOf(Name) = SizeOf(GUID)
    Name\Data1    = l
    Name\Data2    = w1
    Name\Data3    = w2
    Name\Data4[0] = b1
    Name\Data4[1] = b2
    Name\Data4[2] = b3
    Name\Data4[3] = b4
    Name\Data4[4] = b5
    Name\Data4[5] = b6
    Name\Data4[6] = b7
    Name\Data4[7] = b8
  EndIf
  CompilerEndIf
EndMacro

Global IID_IAccessible.GUID
DEFINE_GUID(IID_IAccessible, $618736e0, $3c3d, $11cf, $81, $0c, $0, $aa, $0, $38, $9b, $71)

#OBJID_SYSMENU = 0

Prototype.l ProtoAccessibleObjectFromWindow(hwnd.i,dwObjectID.l, riid, *ppvObject)
Global AccessibleObjectFromWindow.ProtoAccessibleObjectFromWindow

Prototype.l ProtoAccessibleChildren(*paccContainer,iChildStart.l,cChildren.l,*rgvarChildren,*pcObtained)
Global AccessibleChildren.ProtoAccessibleChildren

Define hdll, hwnd
Define *Accessible.IAccessible

CoInitialize_(0)

hdll=OpenLibrary(#PB_Any,"Oleacc.dll")

AccessibleObjectFromWindow = GetFunction(hdll,"AccessibleObjectFromWindow")
AccessibleChildren = GetFunction(hdll,"AccessibleChildren")

#CHILDID_SELF = 0

Declare 	ProcessChild (*aAccessible.IAccessible, aOffset$, *aChild.VARIANT)
Declare 	DisplayInfo (*aAccessible.IAccessible, aOffset$ )

Procedure ProcessChild (*aAccessible.IAccessible, aOffset$, *aChild.VARIANT)
 Protected *ChildAccessible.IAccessible
 Protected *ChildDispatch.IDispatch
 
 Select *aChild\vt
    Case #VT_INT ; varInteger 
        *aAccessible\get_accChild(*aChild, @*ChildDispatch)
    Case #VT_DISPATCH ; varDispatch 
        *ChildDispatch = *aChild
 EndSelect
  
 If *ChildDispatch <> #Null And *ChildDispatch\QueryInterface(@IID_IAccessible, @*ChildAccessible) = #S_OK ; *** now I get an IMA here ***
     DisplayInfo(*ChildAccessible, aOffset$ + " ")
 EndIf 
EndProcedure

Procedure DisplayInfo (*aAccessible.IAccessible, aOffset$ )
  Protected count, iObtained
  Protected BSTR_wsText ; this should be a BSTR string I think
  Define vt.VARIANT, i.i ; this is my add define
  
  vt\iVal = #CHILDID_SELF ; added this based on docs but since its value is ZERO your code with the unitialized var works anyway 
  
  If *aAccessible
    BSTR_wsText = SysAllocString_("")
    Debug SysStringByteLen_(BSTR_wsText) ; it works
   
    If *aAccessible\get_accName(vt, @BSTR_wsText) = #S_OK ; the ima was becasue I thought I could use the  #CHILDID_SELF directly, my bad
      Debug aOffset$ + "Name: " + PeekS(BSTR_wsText)
    Else
        Debug aOffset$ + "Name: Empty" 
    EndIf

    If *aAccessible\get_AccValue(vt, @BSTR_wsText) = #S_OK 
      Debug aOffset$ + "Value: " + PeekS(BSTR_wsText)
    Else
      Debug "not have Value"
    EndIf
   
    If *aAccessible\get_AccDescription(vt, @BSTR_wsText) = #S_OK 
      Debug aOffset$ + "Description: " + PeekS(BSTR_wsText)
    Else
      Debug "not have Description"
    EndIf
   
    If *aAccessible\get_accChildCount(@count) = #S_OK And count > 0
      Debug count
     
      Dim ChildArray.VARIANT(count) ; ... I suppose it's an array of variant structures
           
      If AccessibleChildren(*aAccessible, 0, count, @ChildArray(0), @iObtained) = #S_OK ;  no need for iObtained to be a pointer
        Debug ""
        Debug "AccessibleChildren is ok"
        Debug iObtained
        Debug ""
       
        For i = 0 To iObtained - 1
            ProcessChild(*aAccessible, aOffset$, ChildArray(i))          
        Next
        
        
        ; todo ...
       
      Else   
        Debug ""
        Debug "AccessibleChildren is not ok2"
        Debug ""
      EndIf
     
    EndIf
   
  EndIf
EndProcedure


hwnd = FindWindow_( "CabinetWClass", 0 )
Define count
If hwnd       
    If AccessibleObjectFromWindow(hwnd, #OBJID_SYSMENU, @IID_IAccessible, @*Accessible) = #S_OK;             
        DisplayInfo(*Accessible, "")
    EndIf
EndIf

Re: pay task

Posted: Thu Sep 13, 2012 4:55 pm
by luis
Hmm.. the problem is

Code: Select all

 Case #VT_DISPATCH ; varDispatch
        *ChildDispatch = *aChild
is wrong, *achild is a variant and *ChildDispatch is an IDispatch interface , the delphi code seems to copy one into another but probably something happen under the hood so we cannot copy this blindly.

The first element of *achild is vt (variant type) and it's set to 9 (dispatch) so blindly copy the pointer set the QueryInterface address in ChildDispatch to 9. Hence the IMA. Probably there is a way to convert from a variant of dispatch type into a dispatch interface. Just guessing.

EDIT: probably I got it, since inside the VARIANT structure there is a union, you have to pick the right field depending on the first one (vt or vartype).

Code: Select all

Structure VARIANT
    vt.w
    wReserved1.w
    wReserved2.w
    wReserved3.w
    StructureUnion
    llVal.q
    lVal.l
    bVal.b
    iVal.w
    fltVal.f
    dblVal.d
    boolVal.w
    bool.w
    scode.l
    cyVal.LARGE_INTEGER
    date.d
    bstrVal.i
    *punkVal.IUnknown
    *pdispVal.IDispatch
    *parray.l
    *pbVal.BYTE
    *piVal.WORD
    *plVal.LONG
    *pllVal.QUAD
    *pfltVal.FLOAT
    *pdblVal.DOUBLE
    *pboolVal.LONG
    *pbool.LONG
    *pscode.LONG
    *pcyVal.LONG
    *pdate.DOUBLE
    *pbstrVal.INTEGER
    *ppunkVal.INTEGER
    *ppdispVal.INTEGER
    *pparray.INTEGER
    *pvarVal.VARIANT
    *byref.l
    cVal.b
    uiVal.w
    ulVal.l
    ullVal.q
    intVal.l
    uintVal.l
    *pdecVal.LONG
    *pcVal.BYTE
    *puiVal.WORD
    *pulVal.LONG
    *pullVal.QUAD
    *pintVal.LONG
    *puintVal.LONG
    decVal.l
    brecord.VARIANT_BRECORD
    EndStructureUnion
EndStructure

*pdispVal.IDispatch looks like a good bet, change the code above to:

Code: Select all

*ChildDispatch = *aChild\pdispVal
This should work. DELPHI probably do this behind the scene.

It's a little hairy doing this conversion not knowing DELPHI well, but a piece at a time we are doing it, so insist!

I have too some work to do right now so see you later :)

Re: pay task

Posted: Thu Sep 13, 2012 7:19 pm
by alfa
That already done is awesome! :) Your little delphi knowledge for me is like great library.

Re: pay task

Posted: Thu Sep 13, 2012 11:09 pm
by luis
All converted should be something like this, not 100% sure but you should be able to fix it if there is something wrong :wink:

Code: Select all

EnableExplicit

CompilerIf (#PB_Compiler_Unicode = 0)
 CompilerError "Turn on: Create Unicode executable"
CompilerEndIf

Macro DEFINE_GUID(Name, l, w1, w2, b1, b2, b3, b4, b5, b6, b7, b8)
  CompilerIf Defined(Name, #PB_Variable)
  If SizeOf(Name) = SizeOf(GUID)
    Name\Data1    = l
    Name\Data2    = w1
    Name\Data3    = w2
    Name\Data4[0] = b1
    Name\Data4[1] = b2
    Name\Data4[2] = b3
    Name\Data4[3] = b4
    Name\Data4[4] = b5
    Name\Data4[5] = b6
    Name\Data4[6] = b7
    Name\Data4[7] = b8
  EndIf
  CompilerEndIf
EndMacro

Global IID_IAccessible.GUID
DEFINE_GUID(IID_IAccessible, $618736e0, $3c3d, $11cf, $81, $0c, $00, $aa, $00, $38, $9b, $71)

Global IID_IEnumVARIANT.GUID ; 00020404-0000-0000-C000-000000000046 
DEFINE_GUID(IID_IEnumVARIANT, $00020404, $0000, $0000, $c0, $00, $00, $00, $00, $00, $00, $46)
;http://msdn.microsoft.com/en-us/library/system.runtime.interopservices.comtypes.ienumvariant.aspx


Prototype.l ProtoAccessibleObjectFromWindow(hwnd.i,dwObjectID.l, riid, *ppvObject)
Global AccessibleObjectFromWindow.ProtoAccessibleObjectFromWindow

Prototype.l ProtoAccessibleChildren(*paccContainer,iChildStart.l,cChildren.l,*rgvarChildren,*pcObtained)
Global AccessibleChildren.ProtoAccessibleChildren

Define hdll, hwnd
Define *Accessible.IAccessible

CoInitialize_(0)

hdll=OpenLibrary(#PB_Any,"Oleacc.dll")

AccessibleObjectFromWindow = GetFunction(hdll,"AccessibleObjectFromWindow")
AccessibleChildren = GetFunction(hdll,"AccessibleChildren")

#NAVDIR_DOWN = 2
#NAVDIR_FIRSTCHILD = 7
#NAVDIR_LASTCHILD = 8
#NAVDIR_LEFT = 3
#NAVDIR_NEXT = 5
#NAVDIR_PREVIOUS = 6
#NAVDIR_RIGHT = 4
#NAVDIR_UP = 1

#CHILDID_SELF = 0

Declare    ProcessChild (*aAccessible.IAccessible, aOffset$, *aChild.VARIANT)
Declare    DisplayInfo (*aAccessible.IAccessible, aOffset$ )

Procedure ProcessChild (*aAccessible.IAccessible, aOffset$, *aChild.VARIANT)
 Protected *ChildAccessible.IAccessible
 Protected *ChildDispatch.IDispatch
 
 Select *aChild\vt
    Case #VT_INT ; varInteger
        *aAccessible\get_accChild(*aChild, @*ChildDispatch)
    Case #VT_DISPATCH ; varDispatch
        *ChildDispatch = *aChild\pdispVal
 EndSelect
 
 If *ChildDispatch <> #Null And *ChildDispatch\QueryInterface(@IID_IAccessible, @*ChildAccessible) = #S_OK 
     DisplayInfo(*ChildAccessible, aOffset$ + " ")
 EndIf
EndProcedure

Procedure DisplayInfo (*aAccessible.IAccessible, aOffset$ )
 Protected count, iObtained
 Protected BSTR_wsText 
 Protected vt.VARIANT, i
 Protected *enum.IEnumVARIANT
 
 vt\iVal = #CHILDID_SELF 
 
 If *aAccessible
    BSTR_wsText = SysAllocString_("")
   
    If *aAccessible\get_accName(vt, @BSTR_wsText) = #S_OK 
        Debug aOffset$ + "Name: " + PeekS(BSTR_wsText)
    Else
        Debug aOffset$ + "Name: Empty"
    EndIf

    If *aAccessible\get_AccValue(vt, @BSTR_wsText) = #S_OK
        Debug aOffset$ + "Value: " + PeekS(BSTR_wsText)
    EndIf
   
    If *aAccessible\get_AccDescription(vt, @BSTR_wsText) = #S_OK
        Debug aOffset$ + "Description: " + PeekS(BSTR_wsText)
    EndIf
   
    If *aAccessible\get_accChildCount(@count) = #S_OK And count > 0      
        Debug aOffset$ + "Children: " + Str(count)
           
        Dim ChildArray.VARIANT(count) 
        Protected Child.VARIANT, CurrentChild.VARIANT
        Protected dwNum.l
           
        If AccessibleChildren(*aAccessible, 0, count, @ChildArray(0), @iObtained) = #S_OK    
            For i = 0 To iObtained - 1
                ProcessChild(*aAccessible, aOffset$, ChildArray(i))         
            Next
        ElseIf *aAccessible\QueryInterface(@IID_IEnumVARIANT, @*enum) = #S_OK  
            *enum = *aAccessible        
            For i = 0 To count - 1                
                If *enum\Next(1, @Child, @dwnum) = #S_OK
                    ProcessChild(*aAccessible, aOffset$, @Child)
                ElseIf *aAccessible\accNavigate(#NAVDIR_FIRSTCHILD, vt, @CurrentChild) = #S_OK 
                    Repeat
                        ProcessChild(*aAccessible, aOffset$, @CurrentChild)
                    Until *aAccessible\accNavigate(#NAVDIR_NEXT, @CurrentChild, @CurrentChild) <> #S_OK
                EndIf   
            Next 
        EndIf     
    EndIf

    SysFreeString_(BSTR_wsText)
    
 EndIf
EndProcedure


hwnd = FindWindow_( "CabinetWClass", 0 )

If hwnd       
    If AccessibleObjectFromWindow(hwnd, 0, @IID_IAccessible, @*Accessible) = #S_OK;             
        DisplayInfo(*Accessible, "")
    EndIf
EndIf

Re: pay task

Posted: Fri Sep 14, 2012 5:56 am
by alfa
easy to say...

IMA

Code: Select all

If *enum\Next(1, @Child, @dwnum) = #S_OK