IHTMLDocument interface - navigate callback

[DevilDog]

Hi all,
The following code was provided by Freak and it tracks the mouse movement over an existing istance of IE and it works fine.

I have added some additional code concerning mydispatch2 in order to try to track when the browser's state changes, for example when the user clicks on a link to go to another page. So far no luck.

You'll notice that I'm trying to use the "put_onreadystatechange" and that it returns OK. But it never actually calls my callback procedure "Navigated" when you click a link.

If you have any advice on how to get this to work I would appreciate it!

Here's the code. Don't forget you'll need an open IE window in order to run this.

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 

Procedure Navigated(pDocument.IHTMLDocument2_FIXED)    
  CallDebugger 
  If pDocument\get_readyState(@state) = #S_OK 
    cState.s = ReadBSTR(state)
    
    SetGadgetText(0, cState) 
  Else  
    SetGadgetText(0, "event get_readystate failed") 
  EndIf 
  
EndProcedure 


; ****  CODE STARTS HERE ****

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

; get the interface: 
; 
Document.IHTMLDocument2_FIXED = GetIHTMLDocument2(ServerWindow) 
Global Document.IHTMLDocument2_FIXED
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) 
    MyDispatch2.IDispatch = CreateIDispatch(@Navigated(), Document) 
    
    ; 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 
    
    varDispatch2.VARIANT_SPLIT 
    varDispatch2\VAriant\vt = #VT_DISPATCH 
    varDispatch2\VAriant\pdispVal = MyDispatch2 
    
    ; 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, GetGadgetText(0) + "mouse callback set." + Chr(13) + Chr(10)) 
    Else 
      SetGadgetText(0, GetGadgetText(0) + "mouse callback failure!" + Chr(13) + Chr(10)) 
    EndIf 
    
    If Document\put_onreadystatechange(varDispatch2\split[0],varDispatch2\split[1],varDispatch2\split[2],varDispatch2\split[3]) = #S_OK 
      SetGadgetText(0, GetGadgetText(0) + "event callback set." + Chr(13) + Chr(10)) 
    Else 
      SetGadgetText(0, GetGadgetText(0) + "event callback failure!" + Chr(13) + Chr(10)) 
    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 

[DevilDog]

Hi all,
I have hit a wall with this. Just don't know enough to know what's wrong. Please if someone can help me with this I would very much appreciate it as I haven't made any progress in days.

The original code came from Freak and it works fine, the mousemove is tracked.

I then took that code and added another callback to the "Navigated" procedure in the same manner in hopes that I could catch the onreadystatechange event when the browser goes to a new url, but it doesn't work. What am I doing wrong?

Code: Select all

    MyDispatch.IDispatch = CreateIDispatch(@MouseMove(), Window) 
    MyDispatch2.IDispatch = CreateIDispatch(@Navigated(), Document) 

    varDispatch.VARIANT_SPLIT 
    varDispatch\VAriant\vt = #VT_DISPATCH 
    varDispatch\VAriant\pdispVal = MyDispatch 

    varDispatch2.VARIANT_SPLIT 
    varDispatch2\VAriant\vt = #VT_DISPATCH 
    varDispatch2\VAriant\pdispVal = MyDispatch2 
    
    ; 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, GetGadgetText(0) + "mouse callback set." + Chr(13) + Chr(10)) 
    Else 
      SetGadgetText(0, GetGadgetText(0) + "mouse callback failure!" + Chr(13) + Chr(10)) 
    EndIf 
    
    If Document\put_onreadystatechange(varDispatch2\split[0],varDispatch2\split[1],varDispatch2\split[2],varDispatch2\split[3]) = #S_OK 
      SetGadgetText(0, GetGadgetText(0) + "event callback set." + Chr(13) + Chr(10)) 
    Else 
      SetGadgetText(0, GetGadgetText(0) + "event callback failure!" + Chr(13) + Chr(10)) 
    EndIf 

[DevilDog]

I'm trying to promote PB a the language we need to use to develop the application we are now considering on using .Net for. The owner has decided that we try to develop this internal intranet tool first as proof that PB can be used.

I have gotten pretty far with the help of Freak and a few others but I've been stuck with this for the past few days and have not shown much progress. I don't want to give anyone a reason not to use PB so I need some help getting this tool done so we can actually do the larger project in PB too. Please help me. I know PB can do it.

OK. Let's take it one step at a time, here's the definition for the two events I'm dealing with:

Code: Select all

HRESULT IHTMLDocument2::put_onmousemove(VARIANT v);...
VARIANT of type VT_DISPATCH that specifies the IDispatch interface of an object with a default method that is invoked when the event occurs.


HRESULT IHTMLDocument2::put_onreadystatechange(VARIANT v);
VARIANT of type VT_DISPATCH that implements the event handler function.

You can see from the original program code from Freak how that put_onmousemove VARIANT_SPLIT parameter was defined.

I have used the same type for the put_onreadystatechange parameter but of course it does not work.

I have also tried defining it as Variant1 based on the structure in the program but that also did not appear to work. It does seem to set the callback but the code never in the callback never executes.

If anyone can help with this. Thanks

[freak]

Sorry for not responding earlier, but my answers to this tend to get long
and i had quite a busy week

I think you are simply looking at the wrong event. I think this event is never
fired when the page is left.

There is IWebBrowser2::get_ReadyState(), and it has a corresponding READYSTATE enumeration.
I am assuming that this ready state enumeratuion also applies to the onreadystatechange event.

The enum is this:
READYSTATE_UNINITIALIZED = 0,
READYSTATE_LOADING = 1,
READYSTATE_LOADED = 2,
READYSTATE_INTERACTIVE = 3,
READYSTATE_COMPLETE = 4

You see, the readystate only applies to loading an object, from uninitialized to complete. (There is no state of "unloading").

I think the reason why you never get any event is the fact that you set
the onreadystatechange handler for the current document. (which is
allready fully loaded and thus fires no event.)
As said above, unloading this page does not seem to generate a readystate change.

And when the new page gets loaded, what actually happens is that the
new document is actually a new instance of IHTMLDocument, and therefore
no longer connected to your handler. This is why you do not get an
event here either.


Ok, here is probably how i would do it:

Not every element had the onunload event (as you probably noticed), but the body element has it.
Each element has, apart from the various IHTMLElement... implementations
also special interfaces specific to the html element.
For the body element, this is IHTMLBodyElement & IHTMLBodyElement2.
(To find these special interfaces, just look at the IHTML... Interface list here:
http://msdn.microsoft.com/library/defau ... erface.asp )

Ok, so there is IHTMLBodyElement::put_onunload(VARIANT v), which should do the trick.

To get to these special interfaces, get a pointer to a IHTMLElement as usual,
and then call QueryInterface on it for the other interface.

btw, if you do not allready know this, i would suggest you get this tool
from my site, which provides all the IID values for the Interfaces.
It generates a datasection as is used in my codes, where you can then access the IID with ?IID_Something:
viewtopic.php?t=15755


Ok, as you can see from the definition above, we once again have the problem that a whole
VARIANT structure is expected, not a pointer to it. I have to say i got pretty
tired of the workaround i showed before (with the VARIANT_SPLIT), as it
requires to change all the Interface definitions to have 4 parameters instead of the
one that the PB definitions have. So i started looking for a new solution,
and came up with this procedure:

Code: Select all

Procedure PushVARIANT(*pvar.VARIANT)
  !add esp, 4  ; remove the local copy of *pvar
  
  !pop edi  ; pop saved registers again
  !pop esi
  !pop ebp
  !pop ecx
  !pop ebx
    
  !pop edx    ; pop procedure address
  !pop eax    ; get original procedure argument (*pvar pointer)
  
  !push dword [eax+12]    ; push 3/4 of the variant structure
  !push dword [eax+8]
  !push dword [eax+4]
  !mov eax, [eax]         ; move last part to eax, so it gets pushed after the return
  
  !push edx ; push return address
  !ret      ; return
EndProcedure

What it does is it uses a pointer to a variant and pushes the whole thing on the stack,
correcting the stack data to have the expected result, even though PB
thinks there is only one long value on it.

So what you do is you use the original PB interface definition, which has 1 long in
the place where the VARIANT should go. And at this point you use PushVARIANT(@variant.VARIANT) as parameter.
The resulting procedure call will be correct. (See the code below for an example).

So all the VARIANT_SPLIT and fixed interfaces is no longer required.

Ok, here the final piece of code for the unload:

Code: Select all

DataSection

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

EndDataSection

Procedure PageUnload(Dummy)

  Debug "Page is being unloaded"
  
EndProcedure

; A Pointer to IHTMLDocument is required here...
;
MyDispatch2.IDispatch = CreateIDispatch(@PageUnload(), 0)
If Document\get_Body(@BodyElement.IHTMLElement) = #S_OK
  Debug "body element"
  If BodyElement\QueryInterface(?IID_IHTMLBodyElement, @Body.IHTMLBodyElement) = #S_OK
    Debug "body special interface"
    
    varDisp2.VARIANT\vt = #VT_DISPATCH
    varDisp2\pdispVal = MyDispatch2
    If Body\put_onunload(PushVARIANT(@varDisp2)) = #S_OK
      Debug "handler installed"
    EndIf
    
    Body\Release()
  EndIf
  BodyElement\Release()
EndIf

Of course you must have a window and call WaitWindowEvent() for all this
to work, as with the other examples.

Good luck with this...

[DevilDog]

Thanks for that. That will really help me start rolling again.

Let me ask you something.

What advice would you give me to get on the right track to learn and be able to figure this out for myself?

I'm sure that you probably have many years of C/C++ programming experience and that's why you can figure all this out.

But I feel I just have to be able to get to a point where I can do this.

So what would you recommend?

C++ courses?

Thanks again.

[freak]

I am not sure what advice to give there really. I have no C++ experience (only C)
I can read most C++ codes, but thats about it. I learned all this stuff directly in PB.

I think it just took time, a lot of reading and a lot of trying.

Most of my information comes from the MS Platform SDK (which has a big section on this stuff). You can get an ISO image of it here:
http://www.microsoft.com/downloads/deta ... laylang=en

Other than that, searching the MSDN Knowledge Base sometimes turns
up very helpfull articles too:
http://msdn.microsoft.com/

I think all the examples i posted so far should help you to use the sources
of information above and access the stuff from PB.
The basic scheme is mostly very similar.

Other than that, all i can say is try it, and if it doesn't work just ask here again.

[Kwai chang caine]

Hello at all

Excuse my very bad english.

I congratulate DEVILDOG for this brilliant code.

But i have a problem, the value of MouseY = 0 and MouseX = 0 when the mouse is other the beginning of a text, a button or an image.

How can we make to correct that ?? :roll:

I need the real position of every object, and not the position into object after object

Thank you for your help

[Kwai chang caine]

Nobody have an idea ????

[PB]

Give us some more time. People don't always reply within a day.

[Kwai chang caine]

Excuse me PB

That's right, i'm too excited.

I believed that nobody want to give me an answer
Or nobody as seen my question.

I don't want disturb anybody

This code is very important for me.
I wait this for 2 years ago.

When i see this code, i was so excited, i look hour by hour, if it was an answer at my question.

Excuse me once again

[PB]

> Excuse me once again

Relax, I wasn't angry. Just saying that answers sometimes aren't quick.
For what it's worth, I've had a play but not worked it out yet. Others might
be doing the same thing.

[Kwai chang caine]

Ok, i wait a solution at my problem.
Perhaps a miracle

Thanks PB

[DevilDog]

Hi Kwai,
Sorry I can't help you very much. As you can see from the posts, most of the code actually came from Freak.

I wasn't able to go much further with the code since I'm just not as good at figuring out how to work with code that is that advanced like in the examples Freak posted.

You might want to ask Freak and see if he can help you.

[Kwai chang caine]

Thank's for your answer

[ricardo]

Now the page unload works fine with 4.20 without the need to push variant.

But... im trying to catch the onerror, without succes. It register the callback function, but never gets fired. I make a HTML page with an javascript error anc cant catch the error.

This is what im doing:

Code: Select all

MyDispatch2.IDispatch = CreateIDispatch(@PageUnload(), 0) 
                MyDispatch3.IDispatch = CreateIDispatch(@PageError(),Window)
                
                varDisp2.VARIANT\vt = #VT_DISPATCH 
                varDisp2\pdispVal = MyDispatch2 
                varDisp3.VARIANT\vt = #VT_DISPATCH 
                varDisp3\pdispVal = MyDispatch3 
                
                If Body\put_onunload(varDisp2) = #S_OK ;works fine
                  Debug "handler installed" 
                EndIf 
                If Window\put_onerror(varDisp3) = #S_OK ;answer OK but never get to the function registered
                  Debug "handler installed" 
                EndIf 

Any idea of why is not working?