IE IHTMLDocument2 interface

[ricardo]

Freak, its awesome!

Need to study it carefully to undertand it.

REALLY thanks!!

[freak]

This one is a little more complicated.
I guess i should put all that stuff into a tutorial or something.

For the event stuff, you need to implement your own IDispatch interface with
at least a default method that will be called to receive the event.
To make things easy, i have written such an implementation, that calls a callback
function whenever Invoke() is called for the default method.

Here it is:
Note: to run the example on the bottom, you will need the structures and procedures
from my last post (1st code), as well as this IDispatch code.

Code: Select all

Structure DISPPARAMS
  *rgvarg;            // Array of arguments.
  *rgdispidNamedArgs;   // Dispatch IDs of named arguments.
  cArgs.l;            // Number of arguments.
  cNamedArgs.l;         // Number of named arguments.
EndStructure

#DISPATCH_METHOD = $1
#DISPATCH_PROPERTYGET = $2
#DISPATCH_PROPERTYPUT = $4
#DISPATCH_PROPERTYPUTREF = $8

Structure IID Extends GUID: EndStructure

Structure IDispatchVtbl
  QueryInterface.l
  AddRef.l
  Release.l
  GetTypeInfoCount.l
  GetTypeInfo.l
  GetIDsOfNames.l
  Invoke.l
EndStructure

Structure IDispatchObject
  Vtbl.l  
  RefCount.l
  UserData.l
  Function.l
EndStructure

NewList IDispatchObjects.IDispatchObject()

DataSection

  IID_IUnknown: ; {00000000-0000-0000-C000-000000000046}
    Data.l $00000000
    Data.w $0000, $0000
    Data.b $C0, $00, $00, $00, $00, $00, $00, $46

  IID_IDispatch: ; {00020400-0000-0000-C000-000000000046}
    Data.l $00020400
    Data.w $0000, $0000
    Data.b $C0, $00, $00, $00, $00, $00, $00, $46

EndDataSection

Procedure IDispatch_QueryInterface(*THIS.IDispatchObject, *IID.IID, *Object.LONG)
  If *Object = 0
    ProcedureReturn #E_INVALIDARG
  ElseIf CompareMemory(*IID, ?IID_IUnknown, SizeOf(IID)) Or CompareMemory(*IID, ?IID_IDispatch, SizeOf(IID))
    *Object\l = *THIS
    *THIS\RefCount + 1
    ProcedureReturn #S_OK  
  Else
    *Object\l = 0
    ProcedureReturn #E_NOINTERFACE  
  EndIf
EndProcedure

Procedure IDispatch_AddRef(*THIS.IDispatchObject)
  *THIS\RefCount + 1
  ProcedureReturn *THIS\RefCount
EndProcedure

Procedure IDispatch_Release(*THIS.IDispatchObject)
  *THIS\RefCount - 1
  If *THIS\RefCount <= 0    
    ChangeCurrentElement(IDispatchObjects(), *THIS)
    DeleteElement(IDispatchObjects())
    ProcedureReturn 0
  Else
    ProcedureReturn *THIS\RefCount
  EndIf
EndProcedure

Procedure IDispatch_GetTypeInfoCount(*THIS.IDispatchObject, *pctinfo.LONG)
  If *pctinfo = 0
    ProcedureReturn #E_INVALIDARG
  Else
    *pctinfo\l = 0
    ProcedureReturn #S_OK
  EndIf
EndProcedure

Procedure IDispatch_GetTypeInfo(*THIS.IDispatchObject, iTInfo, lcid, *pptInfo)
  ProcedureReturn #E_NOTIMPL
EndProcedure

Procedure IDispatch_GetIDsOfNames(*THIS.IDispatchObject, *riid.IID, *rgszNames, cNames, lcid, *rgDispID.LONG)
  If CompareMemory(*riid, ?IID_NULL, SizeOf(IID)) = 0
    ProcedureReturn #DISP_E_UNKNOWNINTERFACE
  ElseIf *rgDispID = 0 Or cNames = 0
    ProcedureReturn #E_INVALIDARG
  Else
    While cNames > 0 ; we provide no names, so set all passed fields to DISPID_UNKNOWN (-1)
      *rgDispID\l = -1
      *rgDispID + 4
      cNames - 1
    Wend
    ProcedureReturn #DISP_E_UNKNOWNNAME

  EndIf
EndProcedure

Procedure IDispatch_Invoke(*THIS.IDispatchObject, dispIdMember, *riid.IID, lcid, wFlags.w, *pDispParams.DISPPARAMS, *pVarResult.VARIANT, *pExcpInfo, *puArgErr)
  If CompareMemory(*riid, ?IID_NULL, SizeOf(IID)) = 0
    ProcedureReturn #DISP_E_UNKNOWNINTERFACE
  ElseIf dispIdMember <> 0 Or wFlags <> #DISPATCH_METHOD
    ProcedureReturn #DISP_E_MEMBERNOTFOUND
  ElseIf *pDispParams = 0
    ProcedureReturn #E_INVALIDARG
  ElseIf *pDispParams\cNamedArgs > 0
    ProcedureReturn #DISP_E_NONAMEDARGS
  ElseIf *pDispParams\cArgs > 0
    ProcedureReturn #DISP_E_BADPARAMCOUNT
  Else
    CallFunctionFast(*THIS\Function, *THIS\UserData)
    ProcedureReturn #S_OK
  EndIf
EndProcedure

Global IDispatchVtbl.IDispatchVtbl

IDispatchVtbl\QueryInterface   = @IDispatch_QueryInterface()
IDispatchVtbl\AddRef           = @IDispatch_AddRef()
IDispatchVtbl\Release          = @IDispatch_Release()
IDispatchVtbl\GetTypeInfoCount = @IDispatch_GetTypeInfoCount()
IDispatchVtbl\GetTypeInfo      = @IDispatch_GetTypeInfo()
IDispatchVtbl\GetIDsOfNames    = @IDispatch_GetIDsOfNames()
IDispatchVtbl\Invoke           = @IDispatch_Invoke()

Procedure CreateIDispatch(DefaultFunction, UserData)
  AddElement(IDispatchObjects())
  IDispatchObjects()\Vtbl     = @IDispatchVtbl
  IDispatchObjects()\RefCount = 1
  IDispatchObjects()\UserData = UserData
  IDispatchObjects()\Function = DefaultFunction
  ProcedureReturn @IDispatchObjects()
EndProcedure

; =============================================================

Interface IHTMLDocument2_FIXED
  QueryInterface(a,b)
  AddRef()
  Release()
  GetTypeInfoCount(a)
  GetTypeInfo(a,b,c)
  GetIDsOfNames(a,b,c,d,e)
  Invoke(a,b,c,d,e,f,g,h)
  get_Script(a)
  get_all(a)
  get_body(a)
  get_activeElement(a)
  get_images(a)
  get_applets(a)
  get_links(a)
  get_forms(a)
  get_anchors(a)
  put_title(a)
  get_title(a)
  get_scripts(a)
  put_designMode(a)
  get_designMode(a)
  get_selection(a)
  get_readyState(a)
  get_frames(a)
  get_embeds(a)
  get_plugins(a)
  put_alinkColor(a)
  get_alinkColor(a)
  put_bgColor(a)
  get_bgColor(a)
  put_fgColor(a)
  get_fgColor(a)
  put_linkColor(a)
  get_linkColor(a)
  put_vlinkColor(a)
  get_vlinkColor(a)
  get_referrer(a)
  get_location(a)
  get_lastModified(a)
  put_URL(a)
  get_URL(a)
  put_domain(a)
  get_domain(a)
  put_cookie(a)
  get_cookie(a)
  put_expando(a)
  get_expando(a)
  put_charset(a)
  get_charset(a)
  put_defaultCharset(a)
  get_defaultCharset(a)
  get_mimeType(a)
  get_fileSize(a)
  get_fileCreatedDate(a)
  get_fileModifiedDate(a)
  get_fileUpdatedDate(a)
  get_security(a)
  get_protocol(a)
  get_nameProp(a)
  write(a)
  writeln(a)
  open(a,b,c,d,e)
  close()
  clear()
  queryCommandSupported(a,b)
  queryCommandEnabled(a,b)
  queryCommandState(a,b)
  queryCommandIndeterm(a,b)
  queryCommandText(a,b)
  queryCommandValue(a,b)
  execCommand(a,b,c,d)
  execCommandShowHelp(a,b)
  createElement(a,b)
  put_onhelp(a1,a2,a3,a4)
  get_onhelp(a)
  put_onclick(a1,a2,a3,a4)
  get_onclick(a)
  put_ondblclick(a1,a2,a3,a4)
  get_ondblclick(a)
  put_onkeyup(a1,a2,a3,a4)
  get_onkeyup(a)
  put_onkeydown(a1,a2,a3,a4)
  get_onkeydown(a)
  put_onkeypress(a1,a2,a3,a4)
  get_onkeypress(a)
  put_onmouseup(a1,a2,a3,a4)
  get_onmouseup(a)
  put_onmousedown(a1,a2,a3,a4)
  get_onmousedown(a)
  put_onmousemove(a1,a2,a3,a4)
  get_onmousemove(a)
  put_onmouseout(a1,a2,a3,a4)
  get_onmouseout(a)
  put_onmouseover(a1,a2,a3,a4)
  get_onmouseover(a)
  put_onreadystatechange(a1,a2,a3,a4)
  get_onreadystatechange(a)
  put_onafterupdate(a1,a2,a3,a4)
  get_onafterupdate(a)
  put_onrowexit(a1,a2,a3,a4)
  get_onrowexit(a)
  put_onrowenter(a1,a2,a3,a4)
  get_onrowenter(a)
  put_ondragstart(a1,a2,a3,a4)
  get_ondragstart(a)
  put_onselectstart(a1,a2,a3,a4)
  get_onselectstart(a)
  elementFromPoint(a,b,c)
  get_parentWindow(a)
  get_styleSheets(a)
  put_onbeforeupdate(a1,a2,a3,a4)
  get_onbeforeupdate(a)
  put_onerrorupdate(a1,a2,a3,a4)
  get_onerrorupdate(a)
  toString(a)
  createStyleSheet(a,b,c)
EndInterface

Interface IHTMLElement_FIXED
  QueryInterface(a,b)
  AddRef()
  Release()
  GetTypeInfoCount(a)
  GetTypeInfo(a,b,c)
  GetIDsOfNames(a,b,c,d,e)
  Invoke(a,b,c,d,e,f,g,h)
  setAttribute(a,b,c)
  getAttribute(a,b,c)
  removeAttribute(a,b,c)
  put_className(a)
  get_className(a)
  put_id(a)
  get_id(a)
  get_tagName(a)
  get_parentElement(a)
  get_style(a)
  put_onhelp(a1,a2,a3,a4)
  get_onhelp(a)
  put_onclick(a1,a2,a3,a4)
  get_onclick(a)
  put_ondblclick(a1,a2,a3,a4)
  get_ondblclick(a)
  put_onkeydown(a1,a2,a3,a4)
  get_onkeydown(a)
  put_onkeyup(a1,a2,a3,a4)
  get_onkeyup(a)
  put_onkeypress(a1,a2,a3,a4)
  get_onkeypress(a)
  put_onmouseout(a1,a2,a3,a4)
  get_onmouseout(a)
  put_onmouseover(a1,a2,a3,a4)
  get_onmouseover(a)
  put_onmousemove(a1,a2,a3,a4)
  get_onmousemove(a)
  put_onmousedown(a1,a2,a3,a4)
  get_onmousedown(a)
  put_onmouseup(a1,a2,a3,a4)
  get_onmouseup(a)
  get_document(a)
  put_title(a)
  get_title(a)
  put_language(a)
  get_language(a)
  put_onselectstart(a1,a2,a3,a4)
  get_onselectstart(a)
  scrollIntoView(a)
  contains(a,b)
  get_sourceIndex(a)
  get_recordNumber(a)
  put_lang(a)
  get_lang(a)
  get_offsetLeft(a)
  get_offsetTop(a)
  get_offsetWidth(a)
  get_offsetHeight(a)
  get_offsetParent(a)
  put_innerHTML(a)
  get_innerHTML(a)
  put_innerText(a)
  get_innerText(a)
  put_outerHTML(a)
  get_outerHTML(a)
  put_outerText(a)
  get_outerText(a)
  insertAdjacentHTML(a,b)
  insertAdjacentText(a,b)
  get_parentTextEdit(a)
  get_isTextEdit(a)
  click()
  get_filters(a)
  put_ondragstart(a1,a2,a3,a4)
  get_ondragstart(a)
  toString(a)
  put_onbeforeupdate(a1,a2,a3,a4)
  get_onbeforeupdate(a)
  put_onafterupdate(a1,a2,a3,a4)
  get_onafterupdate(a)
  put_onerrorupdate(a1,a2,a3,a4)
  get_onerrorupdate(a)
  put_onrowexit(a1,a2,a3,a4)
  get_onrowexit(a)
  put_onrowenter(a1,a2,a3,a4)
  get_onrowenter(a)
  put_ondatasetchanged(a1,a2,a3,a4)
  get_ondatasetchanged(a)
  put_ondataavailable(a1,a2,a3,a4)
  get_ondataavailable(a)
  put_ondatasetcomplete(a1,a2,a3,a4)
  get_ondatasetcomplete(a)
  put_onfilterchange(a1,a2,a3,a4)
  get_onfilterchange(a)
  get_children(a)
  get_all(a)
EndInterface

The usage is very simple now. You will need a procedure like this:

Code: Select all

Procedure MyEvent(UserData) ; one parameter!
EndProcedure

Then you simply call this:

Code: Select all

MyIDispatch.IDispatch = CreateIDispatch(@MyEvent(), UserData)

Thats it. Now you have your own IDispatch interface. When its default
method is called (in case of an event), your callback will be called with
the "UserData" value that you passed to the create function.
This can be usefull to pass an interface pointer or something to the callback,
or to reuse one function for many events.

Well, once again we have the problem that all the "put_on...()" methods
to set the event handlers expect a full VARIANT on the stack.
To solve it, i have a fixed IHTMLDocument2 and IHTMLElement interface
put in the code above, and we need to use the workaround to call them.

Ok, here the example:
It also shows how to get the event object for extra information.

Code: Select all

; This is our event callback.
; The 'UserData' field is used to pass the IHTMLWindow2 pointer
;
Procedure MouseMove(Window.IHTMLWindow2)    
    
  ; we can get IHTMLEventObj from IHTMLWindow2. This only
  ; works during an event so do not try it outside of the event callback.
  ;
  If Window\get_event(@Event.IHTMLEventObj) = #S_OK
  
    ; lets get the mouse position
    ;
    Event\get_offsetX(@MouseX)
    Event\get_offsetY(@MouseY)
    
    SetGadgetText(0, Str(MouseY)+" x " +Str(MouseX))
    
    Event\Release() ; make sure everything is properly released!
  Else  
    SetGadgetText(0, "mouse moved")
  EndIf
  
EndProcedure



CoInitialize_(0)

; find the IE server window:
;
hWnd.l = FindWindow_("IEFrame", 0)
EnumChildWindows_(hWnd, @EnumChildProc(), @ServerWindow)

; get the interface:
;
Document.IHTMLDocument2_FIXED = GetIHTMLDocument2(ServerWindow)

OpenWindow(0, 0, 0, 200, 200, #PB_Window_SystemMenu, "mouse move")
CreateGadgetList(WindowID())
TextGadget(0, 5, 5, 190, 190, "", #PB_Text_Border)

If Document 

  ; we get IHTMLWindow2 to later get the event object from it.
  ;
  If Document\get_parentWindow(@Window.IHTMLWindow2) = #S_OK
  
    ; Here is where our own IDispatch is created. We use the 'UserData'
    ; parameter to pass the IHTMLWindow2 pointer to the callback.
    ;
    MyDispatch.IDispatch = CreateIDispatch(@MouseMove(), Window)
    
    ; Ok, need a VARIANT of type VT_DISPATCH. 
    ; The VARIANT_SPLIT workaround is needed for the below call.
    ;
    varDispatch.VARIANT_SPLIT
    varDispatch\Variant\vt = #VT_DISPATCH
    varDispatch\Variant\pdispVal = MyDispatch
    
    ; call the method to set the mouse move handler.
    ;
    If Document\put_onmousemove(varDispatch\Split[0],varDispatch\Split[1],varDispatch\Split[2],varDispatch\Split[3]) = #S_OK
      SetGadgetText(0, "callback set.")
    Else
      SetGadgetText(0, "failure!")
    EndIf
  
    ; lets just wait.
    ; WaitWindowEvent() or WindowEvent() MUST be called in order for the callback
    ; stuff to work correctly!
    ;
    Repeat
    Until WaitWindowEvent() = #PB_Event_CloseWindow
    
    ; release our own IDispatch (frees the LinkedList element)
    ;
    MyDispatch\Release()        
    Window\Release()
    
  EndIf
  
  Document\Release()  
EndIf

CoUninitialize_()
End

Note:

You can call CreateIDispatch() multiple times to get different IDispatch
interfaces for different callbacks. You can also reuse one interface and
set it for multiple events.

The event callback is called from within the main thread, so you do not
need to worry about strings and such.

Make sure you properly release all objects you get inside the
event callbacks. Otherwise you will have a big memory leak on your hands.

You MUST have a window open (can be invisible) and call WaitWindowEvent() or WindowEvent()
on a regular basis in order for this to work!
(Thats because the interprocess-communication between IE and the program
seems to depend on that.)
If you do not call these functions and an event happens, IE will hang!

This method should work for all the html events, also those on other
related Interfaces. You just have to make sure that if the method expects
a full VARIANT instead of a pointer (you see that on MSDN when there is no * on the argument for the call.),
you correct the interface to expect 4 values instead of 1 and call the
method with the workaround as shown above.

Well, thats it... have fun messing with IE

[DevilDog]

Thanks Freak,
That's a brain full! I'm going to start going through it to try to learn what it's doing.

Thanks again for your help with this, it's been invaluable.

If you do ever have a chance, I think a tutorial, where not necessarily the IE stuff is explained, but all the ins and outs of dealing with interfaces, pointers, bstr, etc. are explained.

I think for people like myself where I have many years of programming experience but next to nothing in C++, when we look at the MSDN examples and documentation it's basically like trying to teach someone Italian by using materials written in Italian. Make sense?

The best way I can see a tutorial being developed is to develop one where we can learn how to apply the documentation in MSDN, for example, where we basically need to learn to understand C++ syntax & examples and how they translate to PB.

I know that's not easy but with so much of what people need to do in PB reliant on the Windows API, I don't think there's much of a choice. And at least that way the tutorial would be teaching us to fish rather than handing us a fish.

Just a suggestion, I'll leave that to you as I've already got so much help from you!

Thanks again.

[freak]

One more example.
This one goes through all links in the document and set an onclick() handler.
Inside the callback, it reads & displays the target, and then prevents the link "execution" (Page change)

Code: Select all

#VARIANT_TRUE = $FFFF
#VARIANT_FALSE = 0

; Again the VARIANT problem. (with the put_returnValue() method.)
;
Interface IHTMLEventObj_FIXED
  QueryInterface(a,b)
  AddRef()
  Release()
  GetTypeInfoCount(a)
  GetTypeInfo(a,b,c)
  GetIDsOfNames(a,b,c,d,e)
  Invoke(a,b,c,d,e,f,g,h)
  get_srcElement(a)
  get_altKey(a)
  get_ctrlKey(a)
  get_shiftKey(a)
  put_returnValue(a1,a2,a3,a4)
  get_returnValue(a)
  put_cancelBubble(a)
  get_cancelBubble(a)
  get_fromElement(a)
  get_toElement(a)
  put_keyCode(a)
  get_keyCode(a)
  get_button(a)
  get_type(a)
  get_qualifier(a)
  get_reason(a)
  get_x(a)
  get_y(a)
  get_clientX(a)
  get_clientY(a)
  get_offsetX(a)
  get_offsetY(a)
  get_screenX(a)
  get_screenY(a)
  get_srcFilter(a)
EndInterface


Procedure LinkClicked(Window.IHTMLWindow2)

  If Window\get_event(@Event.IHTMLEventObj_FIXED) = #S_OK
  
    ; Lets get the Element and read the link target
    ;
    If Event\get_srcElement(@Element.IHTMLElement) = #S_OK
    
      bstr_attribute = MakeBSTR("href")
    
      If Element\getAttribute(bstr_attribute, 0, @varResult.VARIANT) = #S_OK
        If varResult\vt = #VT_BSTR
                    
          AddGadgetItem(0, -1, "clicked: "+ReadBSTR(varResult\bstrVal))
           
          SysFreeString_(varResult\bstrVal)
        EndIf
      EndIf    
      
      SysFreeString_(bstr_attribute) 
    
      Element\Release()
    EndIf
    
    ; Now set the event returnvalue to false.
    ; This prevents IE from loading the new page.
    ;
    varReturn.VARIANT_SPLIT\Variant\vt = #VT_BOOL
    varReturn\Variant\boolVal          = #VARIANT_FALSE
    Event\put_returnValue(varReturn\Split[0], varReturn\Split[1], varReturn\Split[2], varReturn\Split[3])
    
    Event\Release() ; make sure everything is properly released!
  EndIf

EndProcedure


CoInitialize_(0)

; find the IE server window:
;
hWnd.l = FindWindow_("IEFrame", 0)
EnumChildWindows_(hWnd, @EnumChildProc(), @ServerWindow)

; get the interface:
;
Document.IHTMLDocument2 = GetIHTMLDocument2(ServerWindow)

OpenWindow(0, 0, 0, 400, 400, #PB_Window_SystemMenu, "link clicks")
CreateGadgetList(WindowID())
EditorGadget(0, 0, 0, 400, 400)

If Document 

  If Document\get_parentWindow(@Window.IHTMLWindow2) = #S_OK
    
    If Document\get_links(@LinkCollection.IHTMLElementCollection_FIXED) = #S_OK
    
      MyDispatch.IDispatch = CreateIDispatch(@LinkClicked(), Window)
  
      varDispatch.VARIANT_SPLIT
      varDispatch\Variant\vt = #VT_DISPATCH
      varDispatch\Variant\pdispVal = MyDispatch
      
      LinkCollection\get_length(@Total)
      For index = 0 To Total-1
        varIndex.VARIANT_SPLIT\Variant\vt = #VT_I4
        varIndex\Variant\lVal = index      
        ElementDispatch.IDispatch = 0
        
        If LinkCollection\item(varIndex\split[0], varIndex\split[1], varIndex\split[2], varIndex\split[3], varIndex\split[0], varIndex\split[1], varIndex\split[2], varIndex\split[3], @ElementDispatch.IDispatch) = #S_OK
          If ElementDispatch ; must check this value according to the docs, as even on failure, #S_OK is returned
   
            If ElementDispatch\QueryInterface(?IID_IHTMLElement, @Element.IHTMLElement_FIXED) = #S_OK              
            
              Element\put_onclick(varDispatch\Split[0], varDispatch\Split[1], varDispatch\Split[2], varDispatch\Split[3]) 
              Element\Release()
              
            EndIf          
      
            ElementDispatch\Release()
          EndIf
        EndIf            
      
      Next index    
      
      Repeat
      Until WaitWindowEvent() = #PB_Event_CloseWindow
    
      MyDispatch\Release()
    EndIf  
    
    Window\Release()
  EndIf
  
  Document\Release()
EndIf

CoUninitialize_()
End

[DevilDog]

Freak,
When I attempt to run the enum of all the elements example, I get an error saying "Structure or Interface already declared: VARIANT"

I don't see where else it could be getting that unless it's in some libraries perhaps?

[ricardo]

Freak,
When I attempt to run the enum of all the elements example, I get an error saying "Structure or Interface already declared: VARIANT"

I don't see where else it could be getting that unless it's in some libraries perhaps?

Just comment that structure.

[ricardo]

Freak

Going back to my example of finding some specific Tag with some specific class and replacing/adding something it in real time inside the ie window, its possible to doing it fast?

Imagine this scenario, i develope some web chat into my webgadget and want to find/replace the smileys code using this approach (i know there could be another ones, but lets forget that and stay with this approach), but need to be done as faster as possible in real time, reading everytime that webgadget loads and, if needed, doing some replace in all <span> elements with the 'text' class.

I hope my explanation is clear (my english not )

[DevilDog]

Ricardo,
I don't think I can just comment out the structure since it's different from the one already declared.

I can use the Stucture Viewer to see the one already declared and it's not the same. Freaks' VARIANT structure is using a StructureUnion while the one already defined does not.

When I run the code currently to see the DOM of IE it shows a FRAMESET with two FRAME items below it and nothing else.

[ricardo]

if you see only frames is because you need to see the frame src for each frame and not the frameset page.

Look at the html of the webpage you are looking and you will notice what i mean.

[DevilDog]

Ricardo,
What I meant is that when I run the sample code that Freak put up, in particular the second example which builds a tree of all the elements in the IE page, I only see the 2 or 3 topmost elements (Frameset and Frame).

[freak]

ricardo:
I think it cannot be done much faster than this.
Using the "get_all()" method and enumerating this list is probably faster
than walking the tree in order. But still i thing for realtime stuff it is too slow.


DevilDog:
I think the structureviewer does not didplay StructureUnions correctly. Just use the allready defined structure. it should be ok.

About the Frames:
ricardo is right. You only see the frameset, because each frame is an individual document.

[freak]

DevilDog:

Replace the WalkDomTree() procedure with the following code. It expands the frame objects by
querying for the document pointer of the contained document.

Code: Select all

DataSection

  IID_IHTMLFrameBase2: ; {3050F6DB-98B5-11CF-BB82-00AA00BDCE0B}
    Data.l $3050F6DB
    Data.w $98B5, $11CF
    Data.b $BB, $82, $00, $AA, $00, $BD, $CE, $0B    

EndDataSection

Procedure WalkDOMTree(CurrentElement.IHTMLElement)

  AddElement(HTMLTags())
  
  HTMLTags()\Element = CurrentElement ; save the interface pointer to this element

  ; reading the information about the element is not that difficult.
  ; its just a matter of using the right method.
  ;
  If CurrentElement\get_tagName(@bstr_name) = #S_OK
    HTMLTags()\Name$ = ReadBSTR(bstr_name)
    SysFreeString_(bstr_name)
  EndIf
  
  If CurrentElement\get_className(@bstr_class) = #S_OK
    HTMLTAgs()\Class$ = ReadBSTR(bstr_class)
    SysFreeString_(bstr_class)
  EndIf
  
  If CurrentElement\get_outerHTML(@bstr_code) = #S_OK
    HTMLTags()\Code$ = ReadBSTR(bstr_code)
    SysFreeString_(bstr_code)
  EndIf
  
  If CurrentElement\get_id(@bstr_id) = #S_OK
    HTMLTags()\ID$ = ReadBSTR(bstr_id)
    SysFreeString_(bstr_id)
  EndIf
  
  If CurrentElement\get_title(@bstr_title) = #S_OK
    HTMLTags()\Title$ = ReadBSTR(bstr_title)
    SysFreeString_(bstr_title)
  EndIf
  
  AddGadgetItem(#GADGET_Tree, -1, HTMLTags()\Name$+" (class="+Chr(34)+HTMLTags()\Class$+Chr(34)+")")  
  
  ; Expand the "FRAME" elements by getting the document object that is contained in them
  ;
  If HTMLTags()\Name$ = "FRAME" Or HTMLTags()\Name$ = "IFRAME"
  
    If CurrentElement\QueryInterface(?IID_IHTMLFrameBase2, @Frame.IHTMLFrameBase2) = #S_OK
      
      If Frame\get_contentWindow(@FrameWindow.IHTMLWindow2) = #S_OK
      
        If FrameWindow\get_document(@FrameDocument.IHTMLDocument2) = #S_OK        
        
          If FrameDocument\get_body(@FrameBody.IHTMLElement) = #S_OK
          
            If FrameBody\get_all(@FrameElementsDispatch.IDispatch) = #S_OK
              If FrameElementsDispatch\QueryInterface(?IID_IHTMLElementCollection, @FrameElements.IHTMLElementCollection) = #S_OK
                If FrameElements\get_length(@framecount) = #S_OK
                  TotalTags + framecount + 1
                EndIf
                FrameElements\Release()
              EndIf
              FrameElementsDispatch\Release()
            EndIf          
          
            OpenTreeGadgetNode(#GADGET_Tree)
            WalkDOMTree(FrameBody)
            CloseTreeGadgetNode(#GADGET_Tree)
          
          EndIf
        
          FrameDocument\Release()
        EndIf
      
        FrameWindow\Release()
      EndIf
      
      Frame\Release()
    EndIf
  
  
  ; No Frame. Expand the child items
  ;
  Else

    ; now we get all the direct child elements.
    ; get_children() returns an IDispatch, from which we can query for a IHTMLElementCollection,
    ; and enumerate the items like in the last code.
    ;
    If CurrentElement\get_children(@ChildDispatch.IDispatch) = #S_OK
    
      ; get the IHTMLElementCollection interface
      If ChildDispatch\QueryInterface(?IID_IHTMLElementCollection, @ChildCollection.IHTMLElementCollection_FIXED) = #S_OK
        
        ; get the count
        If ChildCollection\get_length(@childcount) = #S_OK
        
          OpenTreeGadgetNode(#GADGET_Tree)
          
          ; go through the elements like in the last code.
          For index = 0 To childcount-1
            varIndex.VARIANT_SPLIT\VAriant\vt = #VT_I4
            varIndex\Variant\lVal = index
            
            ElementDispatch.IDispatch = 0
            If ChildCollection\item(varIndex\split[0], varIndex\split[1], varIndex\split[2], varIndex\split[3], varIndex\split[0], varIndex\split[1], varIndex\split[2], varIndex\split[3], @ElementDispatch.IDispatch) = #S_OK
              If ElementDispatch ; must check this value according to the docs
              
                NewElement.IHTMLElement = 0
                If ElementDispatch\QueryInterface(?IID_IHTMLElement, @NewElement.IHTMLElement) = #S_OK              
                  ;
                  ; recursively call this function for each found element.
                  ;
                  WalkDOMTree(NewElement)
                EndIf
              
                ElementDispatch\Release() ; release the dispach interface, not the element itself though
              EndIf
            EndIf          
          
          Next index
        
          CloseTreeGadgetNode(#GADGET_Tree)    
        EndIf      
      
        ChildCollection\Release()
      EndIf
      
      ChildDispatch\Release()  
    EndIf 
    
  EndIf 
  
  ; update the progress
  ProcessedTags + 1
  If TotalTags <> 0
    SetGadgetState(#GADGET_Progress, ProcessedTags*1000/TotalTags)
    While WindowEvent(): Wend
  EndIf
           
EndProcedure

[DevilDog]

That was it Freak. It now shows all the elements for the current IE document. Very cool!

Good to know about the structure viewer as well.

Thanks again.

[DevilDog]

Freak,
I'm trying to run the mouse event sample code at the bottom of your last post and I'm getting the following error:

"Structure field not found: pdispVal"

on the line:

Code: Select all

varDispatch\VAriant\pdispVal = MyDispatch

The structure as displayed in the structure viewer does not show that field but as you mentioned it doesn't show the StructureUnion fields at all.

Any suggestions?

[freak]

Well, looks like your structure is incomplete.
It is probably defined in on the the files in the Residents subdir of PB. (by some userlib)
Try removing the files one by one and see when the double definition goes away.