Page 1 sur 4

Position souris dans internet explorer

Publié : lun. 18/juin/2007 11:11
par Kwai chang caine
Bonjour à tous

Sur le forum US j'ai trouvé un super code de la mort de DEVILDOG qui permet de connaitre exactement la position de la souris dans la fenetre IE.

Je cherchais ça depuis 2 ans.

Il est en 3.94, hélas c'est la qu'est l'os.

Y aurait il une ame charitable pour finir de le convertir, car il coince sur les constantes comme dab.

Si au passage quelqu'un connait d'autre codes du meme acabi, c'est à dire la gestion des liens IE ou les positionnements, etc ..., je lui en serais reconnaissant pendant 3 générations :D

Je vous remercie
Bonne journée

Code : Tout sélectionner

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 GetFunction(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 

Global 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, "mouse move", #PB_Window_SystemMenu) 
CreateGadgetList(WindowID(0)) 
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 


Publié : lun. 18/juin/2007 11:25
par Progi1984
As tu le lien vers le code de DevilDog ?

Publié : lun. 18/juin/2007 12:16
par Flype
c'est juste qq structures à ne pas redéclarer, pas plus de conversion que çà,
ca devait déjà etre du code PB4.

pour éviter de redéclarer une structure déjà existante :

Code : Tout sélectionner

CompilerIf Defined(DISPPARAMS, #PB_Structure) = #False
par example :

Code : Tout sélectionner

CompilerIf Defined(DISPPARAMS, #PB_Structure) = #False
Structure DISPPARAMS
  *rgvarg;            // Array of arguments.
  *rgdispidNamedArgs;   // Dispatch IDs of named arguments.
  cArgs.l;            // Number of arguments.
  cNamedArgs.l;         // Number of named arguments.
EndStructure
CompilerEndIf
source modifié :

Code : Tout sélectionner

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 GetFunction(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

CompilerIf Defined(DISPPARAMS, #PB_Structure) = #False
Structure DISPPARAMS
  *rgvarg;            // Array of arguments.
  *rgdispidNamedArgs;   // Dispatch IDs of named arguments.
  cArgs.l;            // Number of arguments.
  cNamedArgs.l;         // Number of named arguments.
EndStructure
CompilerEndIf

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

CompilerIf Defined(IID, #PB_Structure) = #False
Structure IID Extends GUID
  ;
EndStructure
CompilerEndIf

CompilerIf Defined(IDispatchVtbl, #PB_Structure) = #False
Structure IDispatchVtbl
  QueryInterface.l
  AddRef.l
  Release.l
  GetTypeInfoCount.l
  GetTypeInfo.l
  GetIDsOfNames.l
  Invoke.l
EndStructure
CompilerEndIf

CompilerIf Defined(IDispatchObject, #PB_Structure) = #False
Structure IDispatchObject
  Vtbl.l 
  RefCount.l
  UserData.l
  Function.l
EndStructure
CompilerEndIf

Global 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, "mouse move", #PB_Window_SystemMenu)
CreateGadgetList(WindowID(0))
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 
çà fonctionne chez moi avec pb4.02 mais je suis sûr que çà ne marchera chez toi encore :)

Publié : lun. 18/juin/2007 12:18
par Flype
juste pour préciser, pour ceux qui veulent tester, qu'il faut lancer un IE avant d'exécuter le source. :wink:

Publié : lun. 18/juin/2007 12:36
par Kwai chang caine
@Flype

Je te remecie beaucoup de ton aide et aussi de sa rapidité. 8)

ça démarre bien plus de bug comme tu l'a dit, mais rien ne se passe :cry:

J'ai exactement le meme probleme avec le code de sparkie

http://www.purebasic.fr/english/viewtop ... 11&start=0

J'ai windows 2000 est-ce la raison ??? :roll:
J'ai éssayé avec mon anglais de prof espagnol de poser la question, mais je suis meme pas sur de comprendre la reponse :lol:

Encore merci de ton aide précieuse


@Progi1984

Par ici la bonne soupe :lol:
http://www.purebasic.fr/english/viewtop ... k+internet

Publié : lun. 18/juin/2007 12:45
par Kwai chang caine
@Flype
J'ai rien dit :oops: ou presque

ça marche mais que si je n'ai qu'une fenetre d'ouverte, sinon j'ai l'impression qu'il ne connait que la premiere fenetre ouverte

Y'a un moyen que le code marche sur celle qui a le focus par exemple ou bien encore mieux sur toutes les fenetres ??

Publié : lun. 18/juin/2007 13:05
par Progi1984
Flype a écrit :juste pour préciser, pour ceux qui veulent tester, qu'il faut lancer un IE avant d'exécuter le source. :wink:
Merci de ce renseignement ! Je comprends maintenant ca ne fonctionnait pas chez moi :p

Publié : lun. 18/juin/2007 15:28
par nico
Je n'ai pas aucun message dans l'éditeur de la position de la souris!

J'ai bien par contre les messages "mouse callback set" et "event callback set" mais à part ça rien d'autre, j'ai bien lancé Internet explorer avant!

Publié : lun. 18/juin/2007 15:46
par Kwai chang caine
C'est bizarre, normalement ça marche, puisque meme moi j'y arrive, alors ça si c'est pas une preuve :lol:

Faut avoir qu'une fenetre IE.
Donc ferme les toutes.
Redémarre en une.
Démarre le prg apres.

Y'a meme pas besoin que la fenetre IE est le focus
Apparement il prend la premiere fenetre de la liste et la garde.
Si tu en ouvre une 2e la fenetre ne reagit pas sur cette nouvelle page.
Si tu ferme la 1ere, la 2e ne fait pas mieux réagir le prg, c'est cuit, y'a plus qu'a tout reprendre du debut

Publié : lun. 18/juin/2007 16:10
par Flype
vous avez quel IE, le 6 ou le 7 ?

moi j'ai testé avec le 6, ca fonctionne.


pour ce qui est de faire fonctionner sur plusieurs pages en meme temps c'est à priori possible... mais un peu long à écrire à froid...

Publié : lun. 18/juin/2007 16:33
par Kwai chang caine
Pour moi c'est le 6.0.2800.1106CO

Dis voir flype connaitrais tu un code qui permette de connaitre le nom des objets que l'on survole avec la souris dans IE.

J'essaye de faire une telecommande IE, j'ai donc trouvé ce super code mais le bleme c'est que quand on est dans un champs texte (par exemple Google) les coordonées repartent à 0 8O

Donc on est perdu,moi je croyais que les coordonnées Mouse ne s'occupait pas de ce qui etait dans la page.

Donc me voila encore coincé :?

Merci

Publié : lun. 18/juin/2007 19:14
par brossden
Kwai ... je pense que trouveras des trucs utiles dans le post :


http://www.purebasic.fr/french/viewtopic.php?t=6757

Publié : mer. 20/juin/2007 8:29
par Kwai chang caine
L plus dur c'est de se positionner dans la page et toujours savoir ou on est, et c'est la que le code de DEVILDOG est exceptionnel mais le seul probleme de son code, c'est que comme apparement les boutons, champs textes, et images sont considérés (je crois) comme des fenetres elle doivent avoir un handle et donc le code donne les coordonnées du handle qu'il survole et donc celui de l'objet et non plus de la page.

Ce qui fait que l'on est perdu des que l'on survole un de ces objets.

J'ai tenté de poser la question sur le forum US avec mon EnglishPatois bien de chez nous, mais pour l'instant pas de reponses :cry:

Ils doivent etre moins patient que vous les UsMans

Quelqu'un connaitrait 'il le moyen de garder les coordonnées de la page meme quand on survole un de ses objets ??

Publié : mer. 20/juin/2007 13:40
par Flype
peut etre en allant regarder les propriétés de la 'frame' parente.

il doit bien y avoir une méthode 'Parent()'

voilà comme çà juste en passant... :)

Publié : mer. 20/juin/2007 13:53
par Kwai chang caine
Alors la pour etre en passant, c'est en passant :D

ça fait deux jours que j'attend en bavant, et faisant F5 toute les 1/2 heures pour voir si tu pouvais me donner une de tes super méga combines dont seul toi a le secret........

Je te remercie de ta réponse, deja que je sais que je suis un BB programmeur, il faut que je recherche la methode de mes "PARENT" :lol: