This seem to work better than the original delphi exe if that's possible (if I'm not dreaming).
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.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
Protected *enum.IEnumVARIANT
vt\vt = #VT_I4 ; needed here too
vt\lVal = #CHILDID_SELF ; lVal (was iVal, wrong)
If *aAccessible
BSTR_wsText = SysAllocString_("")
If *aAccessible\get_accName(vt, @BSTR_wsText) = #S_OK
Debug aOffset$ + "Name: " + GetBSTR(BSTR_wsText)
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
;
;now we use the returned *enum as was logical
*enum\Reset() ; for good measure
For i = 0 To count - 1
If *enum\Next(1, @Child, @dwnum) = #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)
EndIf
EndProcedure
hwnd = FindWindow_( "CabinetWClass", 0)
If hwnd
If AccessibleObjectFromWindow(hwnd, 0, @IID_IAccessible, @*Accessible) = #S_OK
DisplayInfo(*Accessible, "")
EndIf
EndIf
The delphi exe give this result on my virtualized XP
Code: Select all
Name: My Computer
Children: 7
Name: System
Description: Contains commands to manipulate the window
Children: 1
Name: System
Children: 1
Name: System
Children: 7
Name: Empty
Value: My Computer
Description: Displays the name of the window and contains controls to manipulate it
Children: 5
Name: Application
Children: 6
Name: Edit
Description: Edit
Children: 1
Name: View
Description: View
Children: 1
Name: Favorites
Description: Favorites
Children: 1
Name:
Children: 5
Name: Organize Favorites...
Description: Organize Favorites...
Name: Separator
Description: Separator
Name: Favorites Bar
Description: Favorites Bar
Children: 1
Name: Microsoft Websites
Description: Microsoft Websites
Children: 1
Name: Tools
Description: Tools
Children: 1
Name: Help
Description: Help
Children: 1
... continue
My last code give this:
Code: Select all
Name: My Computer
Children: 7
Name: System
Description: Contains commands to manipulate the window
Children: 1
Name: System
Children: 1
Name: System
Children: 7
Name: Empty
Value: My Computer
Description: Displays the name of the window and contains controls to manipulate it
Children: 5
Name: Application
Children: 6
Name: File
Description: File
Children: 1
Name: Edit
Description: Edit
Children: 1
Name: View
Description: View
Children: 1
Name: Favorites
Description: Favorites
Children: 1
Name:
Children: 5
Name: Add to Favorites...
Description: Add to Favorites...
Name: Organize Favorites...
Description: Organize Favorites...
Name: Separator
Description: Separator
Name: Favorites Bar
Description: Favorites Bar
Children: 1
Name: Microsoft Websites
Description: Microsoft Websites
Children: 1
Name: Tools
Description: Tools
Children: 1
Name: Help
Description: Help
Children: 1
... continue
In the original there is a "File" missing
Code: Select all
Name: File
Description: File
Children: 1
In "My Computer" I have in the menu: File, Edit, View, Favorites, Tools, Help
The delphi exe seem to miss the first one: "File", the latest PB code get this one too.
Does it happen on your system too ?
И зачем нужен @dwnum, если он нигде не используется?
Because the Next() method needs it. It can works with arrays so the first param is the num of childs you want retrieve, the second is the base address of the array and the last (dwnum) will contain the actual number of children retrieved. The docs says for that param:
The number of elements returned in rgVar, or NULL.
So the sentence is poorly written IMHO and it's not clear if it will be set to null if there are no children returned OR if it can be replaced by null if you are not interested in its value. Replacing @dwnum with 0 seems to work anyway, but I'm not sure it is worth the risk.