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, '');
-------------------------------------------------------------------------------------
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
