Posted: Wed Sep 14, 2005 2:35 am
Freak, its awesome!
Need to study it carefully to undertand it.
REALLY thanks!!


Need to study it carefully to undertand it.
REALLY thanks!!


http://www.purebasic.com
https://www.purebasic.fr/english/
Code: Select all
Structure DISPPARAMS
*rgvarg; // Array of arguments.
*rgdispidNamedArgs; // Dispatch IDs of named arguments.
cArgs.l; // Number of arguments.
cNamedArgs.l; // Number of named arguments.
EndStructure
#DISPATCH_METHOD = $1
#DISPATCH_PROPERTYGET = $2
#DISPATCH_PROPERTYPUT = $4
#DISPATCH_PROPERTYPUTREF = $8
Structure IID Extends GUID: EndStructure
Structure IDispatchVtbl
QueryInterface.l
AddRef.l
Release.l
GetTypeInfoCount.l
GetTypeInfo.l
GetIDsOfNames.l
Invoke.l
EndStructure
Structure IDispatchObject
Vtbl.l
RefCount.l
UserData.l
Function.l
EndStructure
NewList IDispatchObjects.IDispatchObject()
DataSection
IID_IUnknown: ; {00000000-0000-0000-C000-000000000046}
Data.l $00000000
Data.w $0000, $0000
Data.b $C0, $00, $00, $00, $00, $00, $00, $46
IID_IDispatch: ; {00020400-0000-0000-C000-000000000046}
Data.l $00020400
Data.w $0000, $0000
Data.b $C0, $00, $00, $00, $00, $00, $00, $46
EndDataSection
Procedure IDispatch_QueryInterface(*THIS.IDispatchObject, *IID.IID, *Object.LONG)
If *Object = 0
ProcedureReturn #E_INVALIDARG
ElseIf CompareMemory(*IID, ?IID_IUnknown, SizeOf(IID)) Or CompareMemory(*IID, ?IID_IDispatch, SizeOf(IID))
*Object\l = *THIS
*THIS\RefCount + 1
ProcedureReturn #S_OK
Else
*Object\l = 0
ProcedureReturn #E_NOINTERFACE
EndIf
EndProcedure
Procedure IDispatch_AddRef(*THIS.IDispatchObject)
*THIS\RefCount + 1
ProcedureReturn *THIS\RefCount
EndProcedure
Procedure IDispatch_Release(*THIS.IDispatchObject)
*THIS\RefCount - 1
If *THIS\RefCount <= 0
ChangeCurrentElement(IDispatchObjects(), *THIS)
DeleteElement(IDispatchObjects())
ProcedureReturn 0
Else
ProcedureReturn *THIS\RefCount
EndIf
EndProcedure
Procedure IDispatch_GetTypeInfoCount(*THIS.IDispatchObject, *pctinfo.LONG)
If *pctinfo = 0
ProcedureReturn #E_INVALIDARG
Else
*pctinfo\l = 0
ProcedureReturn #S_OK
EndIf
EndProcedure
Procedure IDispatch_GetTypeInfo(*THIS.IDispatchObject, iTInfo, lcid, *pptInfo)
ProcedureReturn #E_NOTIMPL
EndProcedure
Procedure IDispatch_GetIDsOfNames(*THIS.IDispatchObject, *riid.IID, *rgszNames, cNames, lcid, *rgDispID.LONG)
If CompareMemory(*riid, ?IID_NULL, SizeOf(IID)) = 0
ProcedureReturn #DISP_E_UNKNOWNINTERFACE
ElseIf *rgDispID = 0 Or cNames = 0
ProcedureReturn #E_INVALIDARG
Else
While cNames > 0 ; we provide no names, so set all passed fields to DISPID_UNKNOWN (-1)
*rgDispID\l = -1
*rgDispID + 4
cNames - 1
Wend
ProcedureReturn #DISP_E_UNKNOWNNAME
EndIf
EndProcedure
Procedure IDispatch_Invoke(*THIS.IDispatchObject, dispIdMember, *riid.IID, lcid, wFlags.w, *pDispParams.DISPPARAMS, *pVarResult.VARIANT, *pExcpInfo, *puArgErr)
If CompareMemory(*riid, ?IID_NULL, SizeOf(IID)) = 0
ProcedureReturn #DISP_E_UNKNOWNINTERFACE
ElseIf dispIdMember <> 0 Or wFlags <> #DISPATCH_METHOD
ProcedureReturn #DISP_E_MEMBERNOTFOUND
ElseIf *pDispParams = 0
ProcedureReturn #E_INVALIDARG
ElseIf *pDispParams\cNamedArgs > 0
ProcedureReturn #DISP_E_NONAMEDARGS
ElseIf *pDispParams\cArgs > 0
ProcedureReturn #DISP_E_BADPARAMCOUNT
Else
CallFunctionFast(*THIS\Function, *THIS\UserData)
ProcedureReturn #S_OK
EndIf
EndProcedure
Global IDispatchVtbl.IDispatchVtbl
IDispatchVtbl\QueryInterface = @IDispatch_QueryInterface()
IDispatchVtbl\AddRef = @IDispatch_AddRef()
IDispatchVtbl\Release = @IDispatch_Release()
IDispatchVtbl\GetTypeInfoCount = @IDispatch_GetTypeInfoCount()
IDispatchVtbl\GetTypeInfo = @IDispatch_GetTypeInfo()
IDispatchVtbl\GetIDsOfNames = @IDispatch_GetIDsOfNames()
IDispatchVtbl\Invoke = @IDispatch_Invoke()
Procedure CreateIDispatch(DefaultFunction, UserData)
AddElement(IDispatchObjects())
IDispatchObjects()\Vtbl = @IDispatchVtbl
IDispatchObjects()\RefCount = 1
IDispatchObjects()\UserData = UserData
IDispatchObjects()\Function = DefaultFunction
ProcedureReturn @IDispatchObjects()
EndProcedure
; =============================================================
Interface IHTMLDocument2_FIXED
QueryInterface(a,b)
AddRef()
Release()
GetTypeInfoCount(a)
GetTypeInfo(a,b,c)
GetIDsOfNames(a,b,c,d,e)
Invoke(a,b,c,d,e,f,g,h)
get_Script(a)
get_all(a)
get_body(a)
get_activeElement(a)
get_images(a)
get_applets(a)
get_links(a)
get_forms(a)
get_anchors(a)
put_title(a)
get_title(a)
get_scripts(a)
put_designMode(a)
get_designMode(a)
get_selection(a)
get_readyState(a)
get_frames(a)
get_embeds(a)
get_plugins(a)
put_alinkColor(a)
get_alinkColor(a)
put_bgColor(a)
get_bgColor(a)
put_fgColor(a)
get_fgColor(a)
put_linkColor(a)
get_linkColor(a)
put_vlinkColor(a)
get_vlinkColor(a)
get_referrer(a)
get_location(a)
get_lastModified(a)
put_URL(a)
get_URL(a)
put_domain(a)
get_domain(a)
put_cookie(a)
get_cookie(a)
put_expando(a)
get_expando(a)
put_charset(a)
get_charset(a)
put_defaultCharset(a)
get_defaultCharset(a)
get_mimeType(a)
get_fileSize(a)
get_fileCreatedDate(a)
get_fileModifiedDate(a)
get_fileUpdatedDate(a)
get_security(a)
get_protocol(a)
get_nameProp(a)
write(a)
writeln(a)
open(a,b,c,d,e)
close()
clear()
queryCommandSupported(a,b)
queryCommandEnabled(a,b)
queryCommandState(a,b)
queryCommandIndeterm(a,b)
queryCommandText(a,b)
queryCommandValue(a,b)
execCommand(a,b,c,d)
execCommandShowHelp(a,b)
createElement(a,b)
put_onhelp(a1,a2,a3,a4)
get_onhelp(a)
put_onclick(a1,a2,a3,a4)
get_onclick(a)
put_ondblclick(a1,a2,a3,a4)
get_ondblclick(a)
put_onkeyup(a1,a2,a3,a4)
get_onkeyup(a)
put_onkeydown(a1,a2,a3,a4)
get_onkeydown(a)
put_onkeypress(a1,a2,a3,a4)
get_onkeypress(a)
put_onmouseup(a1,a2,a3,a4)
get_onmouseup(a)
put_onmousedown(a1,a2,a3,a4)
get_onmousedown(a)
put_onmousemove(a1,a2,a3,a4)
get_onmousemove(a)
put_onmouseout(a1,a2,a3,a4)
get_onmouseout(a)
put_onmouseover(a1,a2,a3,a4)
get_onmouseover(a)
put_onreadystatechange(a1,a2,a3,a4)
get_onreadystatechange(a)
put_onafterupdate(a1,a2,a3,a4)
get_onafterupdate(a)
put_onrowexit(a1,a2,a3,a4)
get_onrowexit(a)
put_onrowenter(a1,a2,a3,a4)
get_onrowenter(a)
put_ondragstart(a1,a2,a3,a4)
get_ondragstart(a)
put_onselectstart(a1,a2,a3,a4)
get_onselectstart(a)
elementFromPoint(a,b,c)
get_parentWindow(a)
get_styleSheets(a)
put_onbeforeupdate(a1,a2,a3,a4)
get_onbeforeupdate(a)
put_onerrorupdate(a1,a2,a3,a4)
get_onerrorupdate(a)
toString(a)
createStyleSheet(a,b,c)
EndInterface
Interface IHTMLElement_FIXED
QueryInterface(a,b)
AddRef()
Release()
GetTypeInfoCount(a)
GetTypeInfo(a,b,c)
GetIDsOfNames(a,b,c,d,e)
Invoke(a,b,c,d,e,f,g,h)
setAttribute(a,b,c)
getAttribute(a,b,c)
removeAttribute(a,b,c)
put_className(a)
get_className(a)
put_id(a)
get_id(a)
get_tagName(a)
get_parentElement(a)
get_style(a)
put_onhelp(a1,a2,a3,a4)
get_onhelp(a)
put_onclick(a1,a2,a3,a4)
get_onclick(a)
put_ondblclick(a1,a2,a3,a4)
get_ondblclick(a)
put_onkeydown(a1,a2,a3,a4)
get_onkeydown(a)
put_onkeyup(a1,a2,a3,a4)
get_onkeyup(a)
put_onkeypress(a1,a2,a3,a4)
get_onkeypress(a)
put_onmouseout(a1,a2,a3,a4)
get_onmouseout(a)
put_onmouseover(a1,a2,a3,a4)
get_onmouseover(a)
put_onmousemove(a1,a2,a3,a4)
get_onmousemove(a)
put_onmousedown(a1,a2,a3,a4)
get_onmousedown(a)
put_onmouseup(a1,a2,a3,a4)
get_onmouseup(a)
get_document(a)
put_title(a)
get_title(a)
put_language(a)
get_language(a)
put_onselectstart(a1,a2,a3,a4)
get_onselectstart(a)
scrollIntoView(a)
contains(a,b)
get_sourceIndex(a)
get_recordNumber(a)
put_lang(a)
get_lang(a)
get_offsetLeft(a)
get_offsetTop(a)
get_offsetWidth(a)
get_offsetHeight(a)
get_offsetParent(a)
put_innerHTML(a)
get_innerHTML(a)
put_innerText(a)
get_innerText(a)
put_outerHTML(a)
get_outerHTML(a)
put_outerText(a)
get_outerText(a)
insertAdjacentHTML(a,b)
insertAdjacentText(a,b)
get_parentTextEdit(a)
get_isTextEdit(a)
click()
get_filters(a)
put_ondragstart(a1,a2,a3,a4)
get_ondragstart(a)
toString(a)
put_onbeforeupdate(a1,a2,a3,a4)
get_onbeforeupdate(a)
put_onafterupdate(a1,a2,a3,a4)
get_onafterupdate(a)
put_onerrorupdate(a1,a2,a3,a4)
get_onerrorupdate(a)
put_onrowexit(a1,a2,a3,a4)
get_onrowexit(a)
put_onrowenter(a1,a2,a3,a4)
get_onrowenter(a)
put_ondatasetchanged(a1,a2,a3,a4)
get_ondatasetchanged(a)
put_ondataavailable(a1,a2,a3,a4)
get_ondataavailable(a)
put_ondatasetcomplete(a1,a2,a3,a4)
get_ondatasetcomplete(a)
put_onfilterchange(a1,a2,a3,a4)
get_onfilterchange(a)
get_children(a)
get_all(a)
EndInterface
Code: Select all
Procedure MyEvent(UserData) ; one parameter!
EndProcedure
Code: Select all
MyIDispatch.IDispatch = CreateIDispatch(@MyEvent(), UserData)
Code: Select all
; This is our event callback.
; The 'UserData' field is used to pass the IHTMLWindow2 pointer
;
Procedure MouseMove(Window.IHTMLWindow2)
; we can get IHTMLEventObj from IHTMLWindow2. This only
; works during an event so do not try it outside of the event callback.
;
If Window\get_event(@Event.IHTMLEventObj) = #S_OK
; lets get the mouse position
;
Event\get_offsetX(@MouseX)
Event\get_offsetY(@MouseY)
SetGadgetText(0, Str(MouseY)+" x " +Str(MouseX))
Event\Release() ; make sure everything is properly released!
Else
SetGadgetText(0, "mouse moved")
EndIf
EndProcedure
CoInitialize_(0)
; find the IE server window:
;
hWnd.l = FindWindow_("IEFrame", 0)
EnumChildWindows_(hWnd, @EnumChildProc(), @ServerWindow)
; get the interface:
;
Document.IHTMLDocument2_FIXED = GetIHTMLDocument2(ServerWindow)
OpenWindow(0, 0, 0, 200, 200, #PB_Window_SystemMenu, "mouse move")
CreateGadgetList(WindowID())
TextGadget(0, 5, 5, 190, 190, "", #PB_Text_Border)
If Document
; we get IHTMLWindow2 to later get the event object from it.
;
If Document\get_parentWindow(@Window.IHTMLWindow2) = #S_OK
; Here is where our own IDispatch is created. We use the 'UserData'
; parameter to pass the IHTMLWindow2 pointer to the callback.
;
MyDispatch.IDispatch = CreateIDispatch(@MouseMove(), Window)
; Ok, need a VARIANT of type VT_DISPATCH.
; The VARIANT_SPLIT workaround is needed for the below call.
;
varDispatch.VARIANT_SPLIT
varDispatch\Variant\vt = #VT_DISPATCH
varDispatch\Variant\pdispVal = MyDispatch
; call the method to set the mouse move handler.
;
If Document\put_onmousemove(varDispatch\Split[0],varDispatch\Split[1],varDispatch\Split[2],varDispatch\Split[3]) = #S_OK
SetGadgetText(0, "callback set.")
Else
SetGadgetText(0, "failure!")
EndIf
; lets just wait.
; WaitWindowEvent() or WindowEvent() MUST be called in order for the callback
; stuff to work correctly!
;
Repeat
Until WaitWindowEvent() = #PB_Event_CloseWindow
; release our own IDispatch (frees the LinkedList element)
;
MyDispatch\Release()
Window\Release()
EndIf
Document\Release()
EndIf
CoUninitialize_()
End
Code: Select all
#VARIANT_TRUE = $FFFF
#VARIANT_FALSE = 0
; Again the VARIANT problem. (with the put_returnValue() method.)
;
Interface IHTMLEventObj_FIXED
QueryInterface(a,b)
AddRef()
Release()
GetTypeInfoCount(a)
GetTypeInfo(a,b,c)
GetIDsOfNames(a,b,c,d,e)
Invoke(a,b,c,d,e,f,g,h)
get_srcElement(a)
get_altKey(a)
get_ctrlKey(a)
get_shiftKey(a)
put_returnValue(a1,a2,a3,a4)
get_returnValue(a)
put_cancelBubble(a)
get_cancelBubble(a)
get_fromElement(a)
get_toElement(a)
put_keyCode(a)
get_keyCode(a)
get_button(a)
get_type(a)
get_qualifier(a)
get_reason(a)
get_x(a)
get_y(a)
get_clientX(a)
get_clientY(a)
get_offsetX(a)
get_offsetY(a)
get_screenX(a)
get_screenY(a)
get_srcFilter(a)
EndInterface
Procedure LinkClicked(Window.IHTMLWindow2)
If Window\get_event(@Event.IHTMLEventObj_FIXED) = #S_OK
; Lets get the Element and read the link target
;
If Event\get_srcElement(@Element.IHTMLElement) = #S_OK
bstr_attribute = MakeBSTR("href")
If Element\getAttribute(bstr_attribute, 0, @varResult.VARIANT) = #S_OK
If varResult\vt = #VT_BSTR
AddGadgetItem(0, -1, "clicked: "+ReadBSTR(varResult\bstrVal))
SysFreeString_(varResult\bstrVal)
EndIf
EndIf
SysFreeString_(bstr_attribute)
Element\Release()
EndIf
; Now set the event returnvalue to false.
; This prevents IE from loading the new page.
;
varReturn.VARIANT_SPLIT\Variant\vt = #VT_BOOL
varReturn\Variant\boolVal = #VARIANT_FALSE
Event\put_returnValue(varReturn\Split[0], varReturn\Split[1], varReturn\Split[2], varReturn\Split[3])
Event\Release() ; make sure everything is properly released!
EndIf
EndProcedure
CoInitialize_(0)
; find the IE server window:
;
hWnd.l = FindWindow_("IEFrame", 0)
EnumChildWindows_(hWnd, @EnumChildProc(), @ServerWindow)
; get the interface:
;
Document.IHTMLDocument2 = GetIHTMLDocument2(ServerWindow)
OpenWindow(0, 0, 0, 400, 400, #PB_Window_SystemMenu, "link clicks")
CreateGadgetList(WindowID())
EditorGadget(0, 0, 0, 400, 400)
If Document
If Document\get_parentWindow(@Window.IHTMLWindow2) = #S_OK
If Document\get_links(@LinkCollection.IHTMLElementCollection_FIXED) = #S_OK
MyDispatch.IDispatch = CreateIDispatch(@LinkClicked(), Window)
varDispatch.VARIANT_SPLIT
varDispatch\Variant\vt = #VT_DISPATCH
varDispatch\Variant\pdispVal = MyDispatch
LinkCollection\get_length(@Total)
For index = 0 To Total-1
varIndex.VARIANT_SPLIT\Variant\vt = #VT_I4
varIndex\Variant\lVal = index
ElementDispatch.IDispatch = 0
If LinkCollection\item(varIndex\split[0], varIndex\split[1], varIndex\split[2], varIndex\split[3], varIndex\split[0], varIndex\split[1], varIndex\split[2], varIndex\split[3], @ElementDispatch.IDispatch) = #S_OK
If ElementDispatch ; must check this value according to the docs, as even on failure, #S_OK is returned
If ElementDispatch\QueryInterface(?IID_IHTMLElement, @Element.IHTMLElement_FIXED) = #S_OK
Element\put_onclick(varDispatch\Split[0], varDispatch\Split[1], varDispatch\Split[2], varDispatch\Split[3])
Element\Release()
EndIf
ElementDispatch\Release()
EndIf
EndIf
Next index
Repeat
Until WaitWindowEvent() = #PB_Event_CloseWindow
MyDispatch\Release()
EndIf
Window\Release()
EndIf
Document\Release()
EndIf
CoUninitialize_()
End
Just comment that structure.DevilDog wrote:Freak,
When I attempt to run the enum of all the elements example, I get an error saying "Structure or Interface already declared: VARIANT"
I don't see where else it could be getting that unless it's in some libraries perhaps?
Code: Select all
DataSection
IID_IHTMLFrameBase2: ; {3050F6DB-98B5-11CF-BB82-00AA00BDCE0B}
Data.l $3050F6DB
Data.w $98B5, $11CF
Data.b $BB, $82, $00, $AA, $00, $BD, $CE, $0B
EndDataSection
Procedure WalkDOMTree(CurrentElement.IHTMLElement)
AddElement(HTMLTags())
HTMLTags()\Element = CurrentElement ; save the interface pointer to this element
; reading the information about the element is not that difficult.
; its just a matter of using the right method.
;
If CurrentElement\get_tagName(@bstr_name) = #S_OK
HTMLTags()\Name$ = ReadBSTR(bstr_name)
SysFreeString_(bstr_name)
EndIf
If CurrentElement\get_className(@bstr_class) = #S_OK
HTMLTAgs()\Class$ = ReadBSTR(bstr_class)
SysFreeString_(bstr_class)
EndIf
If CurrentElement\get_outerHTML(@bstr_code) = #S_OK
HTMLTags()\Code$ = ReadBSTR(bstr_code)
SysFreeString_(bstr_code)
EndIf
If CurrentElement\get_id(@bstr_id) = #S_OK
HTMLTags()\ID$ = ReadBSTR(bstr_id)
SysFreeString_(bstr_id)
EndIf
If CurrentElement\get_title(@bstr_title) = #S_OK
HTMLTags()\Title$ = ReadBSTR(bstr_title)
SysFreeString_(bstr_title)
EndIf
AddGadgetItem(#GADGET_Tree, -1, HTMLTags()\Name$+" (class="+Chr(34)+HTMLTags()\Class$+Chr(34)+")")
; Expand the "FRAME" elements by getting the document object that is contained in them
;
If HTMLTags()\Name$ = "FRAME" Or HTMLTags()\Name$ = "IFRAME"
If CurrentElement\QueryInterface(?IID_IHTMLFrameBase2, @Frame.IHTMLFrameBase2) = #S_OK
If Frame\get_contentWindow(@FrameWindow.IHTMLWindow2) = #S_OK
If FrameWindow\get_document(@FrameDocument.IHTMLDocument2) = #S_OK
If FrameDocument\get_body(@FrameBody.IHTMLElement) = #S_OK
If FrameBody\get_all(@FrameElementsDispatch.IDispatch) = #S_OK
If FrameElementsDispatch\QueryInterface(?IID_IHTMLElementCollection, @FrameElements.IHTMLElementCollection) = #S_OK
If FrameElements\get_length(@framecount) = #S_OK
TotalTags + framecount + 1
EndIf
FrameElements\Release()
EndIf
FrameElementsDispatch\Release()
EndIf
OpenTreeGadgetNode(#GADGET_Tree)
WalkDOMTree(FrameBody)
CloseTreeGadgetNode(#GADGET_Tree)
EndIf
FrameDocument\Release()
EndIf
FrameWindow\Release()
EndIf
Frame\Release()
EndIf
; No Frame. Expand the child items
;
Else
; now we get all the direct child elements.
; get_children() returns an IDispatch, from which we can query for a IHTMLElementCollection,
; and enumerate the items like in the last code.
;
If CurrentElement\get_children(@ChildDispatch.IDispatch) = #S_OK
; get the IHTMLElementCollection interface
If ChildDispatch\QueryInterface(?IID_IHTMLElementCollection, @ChildCollection.IHTMLElementCollection_FIXED) = #S_OK
; get the count
If ChildCollection\get_length(@childcount) = #S_OK
OpenTreeGadgetNode(#GADGET_Tree)
; go through the elements like in the last code.
For index = 0 To childcount-1
varIndex.VARIANT_SPLIT\VAriant\vt = #VT_I4
varIndex\Variant\lVal = index
ElementDispatch.IDispatch = 0
If ChildCollection\item(varIndex\split[0], varIndex\split[1], varIndex\split[2], varIndex\split[3], varIndex\split[0], varIndex\split[1], varIndex\split[2], varIndex\split[3], @ElementDispatch.IDispatch) = #S_OK
If ElementDispatch ; must check this value according to the docs
NewElement.IHTMLElement = 0
If ElementDispatch\QueryInterface(?IID_IHTMLElement, @NewElement.IHTMLElement) = #S_OK
;
; recursively call this function for each found element.
;
WalkDOMTree(NewElement)
EndIf
ElementDispatch\Release() ; release the dispach interface, not the element itself though
EndIf
EndIf
Next index
CloseTreeGadgetNode(#GADGET_Tree)
EndIf
ChildCollection\Release()
EndIf
ChildDispatch\Release()
EndIf
EndIf
; update the progress
ProcessedTags + 1
If TotalTags <> 0
SetGadgetState(#GADGET_Progress, ProcessedTags*1000/TotalTags)
While WindowEvent(): Wend
EndIf
EndProcedure
Code: Select all
varDispatch\VAriant\pdispVal = MyDispatch