IE IHTMLDocument2 interface

DevilDog · Post by **DevilDog** » Thu Sep 15, 2005 7:00 pm

Freak,
Your suggestion for looking in the Residents folder for a .res file that was pre-defining the Variant Structure and causing the one in the sample to fail was correct.

I was able to compile and run the IE mouse events sample. That said, moving the mouse over IE does not trigger the callback method and the text in the window never shows the x, y coordinates of the mouse.

Since the sample has code from a couple of your posts, I've included it below in case I'm missing something. I do not however receive any errors when compiling or running.

Code: Select all

Enumeration   ; VARENUM 
  #VT_EMPTY = 0 
  #VT_NULL = 1 
  #VT_I2 = 2 
  #VT_I4 = 3 
  #VT_R4 = 4 
  #VT_R8 = 5 
  #VT_CY = 6 
  #VT_DATE = 7 
  #VT_BSTR = 8 
  #VT_DISPATCH = 9 
  #VT_ERROR = 10 
  #VT_BOOL = 11 
  #VT_VARIANT = 12 
  #VT_UNKNOWN = 13 
  #VT_DECIMAL = 14 
  #VT_I1 = 16 
  #VT_UI1 = 17 
  #VT_UI2 = 18 
  #VT_UI4 = 19 
  #VT_I8 = 20 
  #VT_UI8 = 21 
  #VT_INT = 22 
  #VT_UINT = 23 
  #VT_VOID = 24 
  #VT_HRESULT = 25 
  #VT_PTR = 26 
  #VT_SAFEARRAY = 27 
  #VT_CARRAY = 28 
  #VT_USERDEFINED = 29 
  #VT_LPSTR = 30 
  #VT_LPWSTR = 31 
  #VT_RECORD = 36 
  #VT_INT_PTR = 37 
  #VT_UINT_PTR = 38 
  #VT_FILETIME = 64 
  #VT_BLOB = 65 
  #VT_STREAM = 66 
  #VT_STORAGE = 67 
  #VT_STREAMED_OBJECT = 68 
  #VT_STORED_OBJECT = 69 
  #VT_BLOB_OBJECT = 70 
  #VT_CF = 71 
  #VT_CLSID = 72 
  #VT_VERSIONED_STREAM = 73 
  #VT_BSTR_BLOB = $FFF 
  #VT_VECTOR = $1000 
  #VT_ARRAY = $2000 
  #VT_BYREF = $4000 
  #VT_RESERVED = $8000 
  #VT_ILLEGAL = $FFFF 
  #VT_ILLEGALMASKED = $FFF 
  #VT_TYPEMASK = $FFF 
EndEnumeration 

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


Structure VARIANT_SPLIT 
  StructureUnion 
    VAriant.VARIANT 
    split.l[4] 
  EndStructureUnion 
EndStructure 

Interface IHTMLElementCollection_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) 
  toString(a) 
  put_length(a) 
  get_length(a) 
  get__newEnum(a) 
  item(a1,a2,a3,a4,b1,b2,b3,b4,c) 
  tags(a,b) 
EndInterface 

Procedure MakeBSTR(String$) 
  Unicode$ = Space(Len(String$)*2+2) 
  MultiByteToWideChar_(#CP_ACP, 0, @String$, -1, @Unicode$, Len(String$)*2+2) 
  ProcedureReturn SysAllocString_(@Unicode$) 
EndProcedure 

Procedure.s ReadBSTR(bstr) 
  length = WideCharToMultiByte_(#CP_ACP, 0, bstr, -1, 0, 0, 0, 0) 
  Text$ = Space(length) 
  WideCharToMultiByte_(#CP_ACP, 0, bstr, -1, @Text$, length, 0, 0)    
  ProcedureReturn Text$ 
EndProcedure 

Procedure.l GetIHTMLDocument2(ExplorerServerWindow) 
  
  HtmlDoc.IHTMLDocument2 = 0 
  
  OleAcc = OpenLibrary(#PB_Any, "OLEACC.DLL") 
  If OleAcc And IsFunction(OleAcc, "ObjectFromLresult") 
    
    Message = RegisterWindowMessage_("WM_HTML_GETOBJECT") 
    SendMessageTimeout_(ExplorerServerWindow, Message, 0, 0, #SMTO_ABORTIFHUNG, 1000, @MessageResult) 
    
    CallFunction(OleAcc, "ObjectFromLresult", MessageResult, ?IID_IHTMLDocument2, 0, @HtmlDoc)    
    
    CloseLibrary(OleAcc) 
  EndIf 
  
  ProcedureReturn HtmlDoc 
EndProcedure 

Procedure EnumChildProc(hwnd, *hServer.LONG) 
  class$ = Space(100) 
  GetClassName_(hwnd, @class$, 100) 
  If class$ = "Internet Explorer_Server" 
    *hServer\l = hwnd ; server window found. 
    ProcedureReturn #False 
  Else 
    ProcedureReturn #True 
  EndIf 
EndProcedure 

DataSection 

IID_IHTMLDocument2: ; {332C4425-26CB-11D0-B483-00C04FD90119} 
Data.l $332C4425 
Data.w $26CB, $11D0 
Data.b $B4, $83, $00, $C0, $4F, $D9, $01, $19  
    
IID_IHTMLElement: ; {3050F1FF-98B5-11CF-BB82-00AA00BDCE0B} 
Data.l $3050F1FF 
Data.w $98B5, $11CF 
Data.b $BB, $82, $00, $AA, $00, $BD, $CE, $0B    
    
IID_IHTMLElementCollection: ; {3050F21F-98B5-11CF-BB82-00AA00BDCE0B} 
Data.l $3050F21F 
Data.w $98B5, $11CF 
Data.b $BB, $82, $00, $AA, $00, $BD, $CE, $0B        
    
IID_NULL: ; {00000000-0000-0000-0000-000000000000} 
Data.l $00000000 
Data.w $0000, $0000 
Data.b $00, $00, $00, $00, $00, $00, $00, $00      

EndDataSection

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


; code goes below
; This is our event callback. 
; The 'UserData' field is used to pass the IHTMLWindow2 pointer 
; 
Procedure MouseMove(Window.IHTMLWindow2)    
 CallDebugger 
  ; 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) 
CallDebugger 
; 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

Am I missing something?

DevilDog · Post by **DevilDog** » Fri Sep 16, 2005 5:03 pm

Can someone else test the code I copied above and verify whether or not it works for you please.

I'm not sure what the problem is but I want to make sure it does not work for someone else first before going any further.

To test it you need to have an open IE window and then run the compiled exe and as you move the mouse over the IE window the text in the application should show the mouse X, Y position.

Thanks

ricardo · Post by **ricardo** » Fri Sep 16, 2005 5:46 pm

What does your code is suppoused to do?

Here i can detect the mousemove under IE fine.

(AS i had duplicated the VARIANT structure too, i rename it to VARIANT1 in your code)

BTW, only works with IE, not with some browser using a webgadget.

DevilDog · Post by **DevilDog** » Fri Sep 16, 2005 5:58 pm

Ricardo,
Strange, when I run it and move the mouse over IE it does not update the X,Y position in the window.

Could you post the changes you made concerning the Variant structure so I can make sure to do the same and see if it works for me then?

Thanks

ricardo · Post by **ricardo** » Fri Sep 16, 2005 6:38 pm

As i read here, somewhere, that this Variant structure is different that the one i have in some .res file (or somewhere) and i dont want to mess anything, then just rename this one (and where its called) to VARIANT1.

Code: Select all



Enumeration   ; VARENUM 
    #VT_EMPTY = 0 
    #VT_NULL = 1 
    #VT_I2 = 2 
    #VT_I4 = 3 
    #VT_R4 = 4 
    #VT_R8 = 5 
    #VT_CY = 6 
    #VT_DATE = 7 
    #VT_BSTR = 8 
    #VT_DISPATCH = 9 
    #VT_ERROR = 10 
    #VT_BOOL = 11 
    #VT_VARIANT = 12 
    #VT_UNKNOWN = 13 
    #VT_DECIMAL = 14 
    #VT_I1 = 16 
    #VT_UI1 = 17 
    #VT_UI2 = 18 
    #VT_UI4 = 19 
    #VT_I8 = 20 
    #VT_UI8 = 21 
    #VT_INT = 22 
    #VT_UINT = 23 
    #VT_VOID = 24 
    #VT_HRESULT = 25 
    #VT_PTR = 26 
    #VT_SAFEARRAY = 27 
    #VT_CARRAY = 28 
    #VT_USERDEFINED = 29 
    #VT_LPSTR = 30 
    #VT_LPWSTR = 31 
    #VT_RECORD = 36 
    #VT_INT_PTR = 37 
    #VT_UINT_PTR = 38 
    #VT_FILETIME = 64 
    #VT_BLOB = 65 
    #VT_STREAM = 66 
    #VT_STORAGE = 67 
    #VT_STREAMED_OBJECT = 68 
    #VT_STORED_OBJECT = 69 
    #VT_BLOB_OBJECT = 70 
    #VT_CF = 71 
    #VT_CLSID = 72 
    #VT_VERSIONED_STREAM = 73 
    #VT_BSTR_BLOB = $FFF 
    #VT_VECTOR = $1000 
    #VT_ARRAY = $2000 
    #VT_BYREF = $4000 
    #VT_RESERVED = $8000 
    #VT_ILLEGAL = $FFFF 
    #VT_ILLEGALMASKED = $FFF 
    #VT_TYPEMASK = $FFF 
EndEnumeration 

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


Structure VARIANT_SPLIT 
    StructureUnion 
        VAriant.VARIANT1 
        split.l[4] 
    EndStructureUnion 
EndStructure 

Interface IHTMLElementCollection_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) 
    toString(a) 
    put_length(a) 
    get_length(a) 
    get__newEnum(a) 
    item(a1,a2,a3,a4,b1,b2,b3,b4,c) 
    tags(a,b) 
EndInterface 

Procedure MakeBSTR(String$) 
    Unicode$ = Space(Len(String$)*2+2) 
    MultiByteToWideChar_(#CP_ACP, 0, @String$, -1, @Unicode$, Len(String$)*2+2) 
    ProcedureReturn SysAllocString_(@Unicode$) 
EndProcedure 

Procedure.s ReadBSTR(bstr) 
    length = WideCharToMultiByte_(#CP_ACP, 0, bstr, -1, 0, 0, 0, 0) 
    Text$ = Space(length) 
    WideCharToMultiByte_(#CP_ACP, 0, bstr, -1, @Text$, length, 0, 0)    
    ProcedureReturn Text$ 
EndProcedure 

Procedure.l GetIHTMLDocument2(ExplorerServerWindow) 
    
    HtmlDoc.IHTMLDocument2 = 0 
    
    OleAcc = OpenLibrary(#PB_Any, "OLEACC.DLL") 
    If OleAcc And IsFunction(OleAcc, "ObjectFromLresult") 
        
        Message = RegisterWindowMessage_("WM_HTML_GETOBJECT") 
        SendMessageTimeout_(ExplorerServerWindow, Message, 0, 0, #SMTO_ABORTIFHUNG, 1000, @MessageResult) 
        
        CallFunction(OleAcc, "ObjectFromLresult", MessageResult, ?IID_IHTMLDocument2, 0, @HtmlDoc)    
        
        CloseLibrary(OleAcc) 
    EndIf 
    
    ProcedureReturn HtmlDoc 
EndProcedure 

Procedure EnumChildProc(hwnd, *hServer.LONG) 
    class$ = Space(100) 
    GetClassName_(hwnd, @class$, 100) 
    If class$ = "Internet Explorer_Server" 
        *hServer\l = hwnd ; server window found. 
        ProcedureReturn #False 
    Else 
        ProcedureReturn #True 
    EndIf 
EndProcedure 

DataSection 

IID_IHTMLDocument2: ; {332C4425-26CB-11D0-B483-00C04FD90119} 
Data.l $332C4425 
Data.w $26CB, $11D0 
Data.b $B4, $83, $00, $C0, $4F, $D9, $01, $19  
    
IID_IHTMLElement: ; {3050F1FF-98B5-11CF-BB82-00AA00BDCE0B} 
Data.l $3050F1FF 
Data.w $98B5, $11CF 
Data.b $BB, $82, $00, $AA, $00, $BD, $CE, $0B    
    
IID_IHTMLElementCollection: ; {3050F21F-98B5-11CF-BB82-00AA00BDCE0B} 
Data.l $3050F21F 
Data.w $98B5, $11CF 
Data.b $BB, $82, $00, $AA, $00, $BD, $CE, $0B        
    
IID_NULL: ; {00000000-0000-0000-0000-000000000000} 
Data.l $00000000 
Data.w $0000, $0000 
Data.b $00, $00, $00, $00, $00, $00, $00, $00      

EndDataSection 

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.VARIANT1, *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 


; code goes below 
; This is our event callback. 
; The 'UserData' field is used to pass the IHTMLWindow2 pointer 
; 
Procedure MouseMove(Window.IHTMLWindow2)    
    CallDebugger 
    ; 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) 
CallDebugger 
; 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

Im using PB 3.94 and IE SP2 with the latest (and ugly) windows update.

Here i see perfectly the X and Y when moving the mouse over the IE.

DevilDog · Post by **DevilDog** » Tue Sep 20, 2005 4:32 pm

Ricardo,
That's strange. I've copied the code you posted with the change in the Variant name and I still get no mouse move detection.

I'm using IE 6 SP 1 on Win 2000 pro.

Any one else have IE 6 SP 1 and Win 2000 pro that can try this out? Just copy the code posted above by Ricardo and have an instance of IE open when you run it.

You should see a little window and as you move the mouse over IE, the window should display the mouse X, Y.

Freak, any idea how I can track down why this does not work for me? As I mentioned earlier I don't get any errors, it goes right into the loop and waits.

ricardo · Post by **ricardo** » Tue Sep 20, 2005 4:45 pm

Im using IE6 SP2, maybe that makes any difference. Not sure but here works perfect. Its your code, the change i made is only to avoid the prompt about VARIANT already declared.

DevilDog · Post by **DevilDog** » Tue Sep 20, 2005 4:52 pm

I think SP 2 for IE is only available through the XP SP 2. I don't think there's an SP 2 that applies to Win 2000, is there?

I tried various combinations of changing the code concerning the Variant declaration and moving/leaving the .res file in the residents folder but nothing worked.

The hardest thing is that I get no error. The code seems to go through just fine it simply does not call the callback when I move the mouse. So I guess somehow the Callback is not getting set or being triggered.

Any ideas what I might check that could help track down the problem?

ricardo · Post by **ricardo** » Tue Sep 20, 2005 5:34 pm

Which version of PB are you using?

DevilDog · Post by **DevilDog** » Tue Sep 20, 2005 6:57 pm

I'm using 3.94 Windows version.

ricardo · Post by **ricardo** » Tue Sep 20, 2005 7:02 pm

How many IE instances do you have running when start running the PB code?

DevilDog · Post by **DevilDog** » Tue Sep 20, 2005 7:55 pm

Only one. I've checked task mgr as well to verify that.

DevilDog · Post by **DevilDog** » Tue Sep 20, 2005 11:07 pm

Ricardo,
OK, I've figured it out.

Seems the "Discuss" button in the IE toolbar when activated opens another window of the "Internet Explorer_Server" class at the bottom of the browser.

So the enum routine was returning the handle for it instead of the main browser window.

Good to know.

I'm turning it off for now and later I'm going to see if I can code to handle that it being on.

thanks for your help.

ricardo · Post by **ricardo** » Thu May 15, 2008 4:29 pm

This second one is a more complex example. It scans the DOM tree in the
order of the elements and fills a treegadget. You can edit the HTML code
of an element and modify it with the "Update Code" button to update the element.
(you should re-scan the tree after that to account for any changes made)

Code: Select all

; Structure to store our tag info. We actually do not release any of the
; items pointers, but store them here so we can later change their data.
;
Structure TagInfo
  Element.IHTMLElement
  Name$
  Class$
  Code$
  ID$  
  Title$
EndStructure

NewList HTMLTags.TagInfo()

Enumeration
  #GADGET_Progress
  #GADGET_Tree
  #GADGET_Info
  #GADGET_Code
  #GADGET_Splitter1
  #GADGET_Splitter2
  #GADGET_SetCode
  #GADGET_Refresh
EndEnumeration

Global ProcessedTags, TotalTags ; to monitor the reading progress.

; This procedure recursively walks through the tree of elements.
; It adds their info to the LinkedList and fills the TreeGadget.
; It starts with one element, and recursively walks through all children.
;
; (this must not be on the whole document, it can also be used to enumerate
; all childs of any Html element. We just start with the body tag, so we get the
; whole thing.)
;
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)+")")  

  ; 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  
  
  ; update the progress
  ProcessedTags + 1
  If TotalTags <> 0
    SetGadgetState(#GADGET_Progress, ProcessedTags*1000/TotalTags)
    While WindowEvent(): Wend
  EndIf
           
EndProcedure

; displays the information of a tag in the gadgets:
;
Procedure DisplayElement(index)
  SelectElement(HTMLTags(), index)
  
  Info$ = "Tag: "+HTMLTags()\Name$ + Chr(13)+Chr(10)
  Info$ + "Class: "+HTMLTags()\Class$ + Chr(13)+Chr(10)
  Info$ + "ID: "+HTMLTags()\ID$ + Chr(13)+Chr(10)
  Info$ + "Title: "+HTMLTags()\Title$ + Chr(13)+Chr(10)
  
  SetGadgetText(#GADGET_Info, Info$)
  SetGadgetText(#GADGET_Code, HTMLTags()\Code$)   
EndProcedure

; CoInitialize around the whole thing is important as otherwise it won't work.
CoInitialize_(0)

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

; get the interface:
;
Document.IHTMLDocument2 = GetIHTMLDocument2(ServerWindow)
If Document = 0
  MessageRequester("Error", "Could not connect to IE interfaces!")
  End
EndIf

; first some GUI code for display:
;
If OpenWindow(0, 0, 0, 500, 400, #PB_Window_ScreenCentered|#PB_Window_SystemMenu|#PB_Window_SizeGadget|#PB_Window_MaximizeGadget|#PB_Window_MinimizeGadget, "IE DOM Viewer")
  If CreateGadgetList(WindowID())
  
    ProgressBarGadget(#GADGET_Progress, 5, 5, 490, 15, 0, 1000)    
  
    TreeGadget(#GADGET_Tree, 0, 0, 0, 0)
    TextGadget(#GADGET_Info, 0, 0, 0, 0, "", #PB_Text_Border)
    EditorGadget(#GADGET_Code, 0, 0, 0, 0)
    SplitterGadget(#GADGET_Splitter1, 0, 0, 0, 0, #GADGET_Info, #GADGET_Code)
    SplitterGadget(#GADGET_Splitter2, 5, 25, 490, 340, #GADGET_Tree, #GADGET_Splitter1, #PB_Splitter_Vertical)
    
    ButtonGadget(#GADGET_Refresh, 5, 370, 100, 25, "Refresh Tree")
    ButtonGadget(#GADGET_SetCode, 395, 370, 100, 25, "Update Code")
    
    ; Ok, now we scan the tree. We get the body element to start scanning there:
    ;    
    If Document\get_body(@Body.IHTMLElement) = #S_OK
    
      ; get_all() returns a list of all items tool, but not with child/parent relations.
      ; we still use it here though to get a count of all the items in the body of the document.
      ;
      TotalTags = 0
      If Body\get_all(@AllDispatch.IDispatch) = #S_OK
        If AllDispatch\QueryInterface(?IID_IHTMLElementCollection, @AllElements.IHTMLElementCollection) = #S_OK              
          AllElements\get_length(@TotalTags)
          AllElements\Release()
        EndIf
        AllDispatch\Release()
      EndIf
      ProcessedTags = 0
    
      WalkDOMTree(Body) ; start scanning the tree on the body element
    EndIf
  
    ; expand the whole treegadget
    lastitem = CountGadgetItems(#GADGET_Tree) - 1
    For i = 0 To lastitem
      SetGadgetItemState(#GADGET_TRee, i, #PB_Tree_Expanded)
    Next i  
    
    SetGadgetState(#GADGET_Tree, 0)    
    DisplayElement(0)
    
    ; Main loop
    ;
    Repeat
      Event = WaitWindowEvent()
      
      If Event = #PB_Event_Gadget
        EventGadgetID = EventGadgetID()
      
        If EventGadgetID = #GADGET_Tree
          index = GetGadgetState(#GADGET_Tree)
          If index <> -1
            DisplayElement(index)
          Else
            SetGadgetText(#GADGET_Info, "")
            SetGadgetText(#GADGET_Code, "")
          EndIf
          
        ElseIf EventGadgetID = #GADGET_SetCode
          index = GetGadgetState(#GADGET_Tree)
          If index <> -1
            SelectElement(HTMLTags(), index)
            ;
            ; Changing the html code of the element is no big deal.
            ; Its just about calling put_outerHTML() with the bstr string of the
            ; new code using the IHTMLElement pointer we stored in the LinkedList
            ;            
            HTMLTags()\Code$ = GetGadgetText(#GADGET_Code)
            bstr_code = MakeBSTR(HTMLTags()\Code$)            
            HTMLTags()\Element\put_outerHTML(bstr_code)            
            SysFreeString_(bstr_code)            
          EndIf
          
        ElseIf EventGadgetID = #GADGET_Refresh   
        
          ; re-scan the document tree.
          ; first make sure all element pointers are properly released to prevent memory leaks          
          ;
          ForEach HTMLTags()
            HTMLTags()\Element\Release()
          Next
          
          ClearList(HTMLTags())
          ClearGadgetItemList(#GADGET_Tree)
          SetGadgetState(#GADGET_Progress, 0)      
          
          ; Do all the scan stuff like above again
          ;
          If Document\get_body(@Body.IHTMLElement) = #S_OK
          
            TotalTags = 0
            If Body\get_all(@AllDispatch.IDispatch) = #S_OK
              If AllDispatch\QueryInterface(?IID_IHTMLElementCollection, @AllElements.IHTMLElementCollection) = #S_OK              
                AllElements\get_length(@TotalTags)
                AllElements\Release()
              EndIf
              AllDispatch\Release()
            EndIf
            ProcessedTags = 0          
          
            WalkDOMTree(Body)
          EndIf
        
          lastitem = CountGadgetItems(#GADGET_Tree) - 1
          For i = 0 To lastitem
            SetGadgetItemState(#GADGET_TRee, i, #PB_Tree_Expanded)
          Next i       
          SetGadgetState(#GADGET_Tree, 0)           
          DisplayElement(0)
        
        EndIf
      
      ElseIf Event = #PB_Event_SizeWindow
        ResizeGadget(#GADGET_Progress, 5, 5, WindowWidth()-10, 15)
        ResizeGadget(#GADGET_Splitter2, 5, 25, WindowWidth()-10, WindowHeight()-60)
        ResizeGadget(#GADGET_Refresh, 5, WindowHeight()-30, 100, 25)
        ResizeGadget(#GADGET_SetCode, WindowWidth()-105, WindowHeight()-30, 100, 25)
      
      EndIf
      
    Until Event = #PB_Event_CloseWindow
    
  EndIf
EndIf

; make sure all pointers are properly released at the end
;
ForEach HTMLTags()
  HTMLTags()\Element\Release()
Next
    
Document\Release()

CoUninitialize_()

What im looking for now is to get the full DOM three (including header, title, scripts, etc).
I know i can search all this by separate, but as far as i notice is not easy to find if the script is in the header or not, so a nice way will having the complete DOM including header, from HTML as root.

How can this be done?

ricardo · Post by **ricardo** » Thu May 15, 2008 9:06 pm

Solution was easy and was in front of my face

For the records:

Code: Select all

If Document\get_all(@AllCollection.IHTMLElementCollection_FIXED) = #S_OK 
            AllCollection\get_length(@Total) 
            Debug "Number of todo: "+Str(Total) 
            For Index = 0 To Total-1 
              ; To simply get an element by index in the collection, all we need is one 
              ; VARIANT of long type with the index, and use it twice in the item() call. 
              ; 
              varIndex.VARIANT_SPLIT\Variant\vt = #VT_I4 
              varIndex\Variant\lVal = Index      
              ElementDispatch.IDispatch = 0 
              If AllCollection\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\QueryInterface(?IID_IHTMLElement, @Element.IHTMLElement) = #S_OK
                  If Element\get_tagName(@bstr_text) = #S_OK 
                    Text$ = ReadBSTR(bstr_text) 
                    If Text$ ="HTML"
                      Debug Text$
                      WalkDOMTree(Element)
                      ; expand the whole treegadget 
                      lastitem = CountGadgetItems(#GADGET_Tree) - 1 
                      For i = 0 To lastitem 
                        SetGadgetItemState(#GADGET_Tree, i, #PB_Tree_Expanded) 
                      Next i  
                      
                      SetGadgetState(#GADGET_Tree, 0)    
                      DisplayElement(0) 
                    EndIf
                    SysFreeString_(bstr_text) ; make sure returned strings are freed 
                  EndIf 
                EndIf
              EndIf
            Next
          EndIf

PureBasic Forums - English

IE IHTMLDocument2 interface

help verify problem