COMatePLUS version 1.2

[srod]

@hm : thanks!

@Besko : should be easy enough to convert to COMatePLUS if you wish; although it will not run as fast with COMatePLUS regardless of whether you use prepared statements etc. Nothing will run as fast as using early binding with the direct interfaces.

If you need me to translate then it will have to wait I'm afraid. Too busy right now.

[besko]

Tnx Srod i can wait. and i need translation coz native method work with errors

[srod]

Then any translation will probably produce the same errors!

It will help if you can post some demo code which I can run (using your code above) so that I can see what it is all about etc?

[besko]

This code search some keywords in web Frames

SearchTextInFrames(#Web, "123") - try find "123" in webpage

Code: Select all

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

Structure VARIANT_SPLIT
  StructureUnion
    Variant.VARIANT
    Split.l[4]
  EndStructureUnion
EndStructure

;Window
Enumeration
  #Main
EndEnumeration

;Gadget
Enumeration
  #Web
EndEnumeration

;COM
#DISPID_DOCUMENTCOMPLETE = 259
Structure DispatchFunctions
  QueryInterface.l
  AddRef.l
  Release.l
  GetTypeInfoCount.l
  GetTypeInfo.l
  GetIDsOfNames.l
  Invoke.l
EndStructure

Structure DispatchObject
  *IDispatch.IDispatch
  ObjectCount.l
  GadgetID.l
EndStructure

Global NewList dispatchObject.DispatchObject()
;/COM

Global webBrowser.IWebBrowser2, Url.s, mail.s, Password.s, radio.s, checkbox.s
Global Skip.b
Skip.b = 0

;///////////////////////////////////

Procedure.b SearchTextInFrames(WebGadget.l, StringToFind.s)
  
  Protected HTMLDocument.IHTMLDocument2
  Protected AllDocumentElems.IHTMLElementCollection
  Protected varReturn.VARIANT
  Protected URL.s
  
  Protected TagsDispatch.IDispatch
  Protected TagsDispatch2.IDispatch
  Protected TagName.VARIANT
  Protected TagsElemColl.IHTMLElementCollection
  Protected HTMLCodeElem.IHTMLElement
  
  Protected HTMLlength.l
  Protected HTMLcode.s
  
  Protected ZeroVariant.Variant
  
  ZeroVariant\vt = #VT_I4
  ZeroVariant\lval = 0
  
  TagName\vt = #VT_BSTR
  Protected MainTag.s = "HTML"
  
  Protected *bstr.l = SysAllocString_(Space((Len(MainTag)*2) + 2))
  
  PokeS(*bstr, MainTag, -1, #PB_Unicode)
  TagName\bstrVal = *bstr
  
  Protected *bstr_html.l = SysAllocString_(Space(14000))
  
  If HTMLDocument
    HTMLDocument\Release()
    HTMLDocument = 0
  EndIf
  Gadget.IWebBrowser2 = GetWindowLong_(GadgetID(WebGadget), #GWL_USERDATA)
  If (Gadget\get_Document(@Doc1.IDispatch) = #S_OK) And Doc1
    Doc1\QueryInterface(?IID_IHTMLDocument2, @HTMLDocument.IHTMLDocument2)
    If HTMLDocument\get_frames(@FrameCollection.IHTMLFramesCollection2) = #S_OK
      If FrameCollection\get_length(@FrameCount) = #S_OK
        If FrameCount>0
          For index = 0 To FrameCount-1
            varIndex.VARIANT\vt = #VT_UINT
            varIndex\lVal = index
            If FrameCollection\item(varIndex, varReturn) = #S_OK
              If varReturn\pdispVal\QueryInterface(?IID_IHTMLWindow2, @HTMLWindow.IHTMLWindow2) = #S_OK
                HTMLWindow\get_Document(@Doc2.IDispatch)
                If Doc2\QueryInterface(?IID_IHTMLDocument2, @FrameDocument.IHTMLDocument2) = #S_OK
                  ;Debug "Got frame."
                  If FrameDocument\get_all(@AllDocumentElems) = #S_OK
                    If AllDocumentElems\tags(TagName, @TagsDispatch) = #S_OK
                      If TagsDispatch\QueryInterface(?IID_IHTMLElementCollection, @TagsElemColl) = #S_OK
                        If TagsElemColl\item(ZeroVariant, ZeroVariant, @TagsDispatch2) = #S_OK
                          If TagsDispatch2\QueryInterface(?IID_IHTMLElement, @HTMLCodeElem) = #S_OK
                            HTMLCodeElem\get_innerHTML(@*bstr_html)
                            HTMLcode = PeekS(*bstr_html, -1, #PB_Unicode)
                            ;Debug HTMLcode
                            If (FindString(HTMLcode, StringToFind, 1)>0)
                              ProcedureReturn 1
                            EndIf
                            HTMLCodeElem\Release()
                            TagsDispatch2\Release()
                          EndIf
                          TagsElemColl\Release()
                        EndIf
                        TagsDispatch\Release()
                      EndIf
                    EndIf
                    FrameDocument\Release()
                  EndIf
                  Doc2\Release()
                EndIf
              EndIf
              HTMLWindow\Release()
            EndIf
          Next
        EndIf
        FrameCollection\Release()
      EndIf
      Doc1\Release()
    EndIf
  EndIf
  
  SysFreeString_(@*bstr)
  SysFreeString_(@*bstr_html)
  
  ProcedureReturn 0
EndProcedure

;///////////////////////////////////

Procedure.l AddRef(*THIS.DispatchObject)
  *THIS\ObjectCount + 1
  ProcedureReturn *THIS\ObjectCount
EndProcedure

Procedure.l QueryInterface(*THIS.DispatchObject, *iid.GUID, *Object.LONG)
  
  If CompareMemory(*iid, ?IID_DWebBrowserEvents2, 16)
    CallDebugger
  EndIf
  
  If CompareMemory(*iid, ?IID_IUnknown, SizeOf(GUID)) Or CompareMemory(*iid, ?IID_IDispatch, SizeOf(GUID))
    *Object\l = *THIS
    AddRef(*THIS.DispatchObject)
    ProcedureReturn #S_OK
  Else
    *Object\l = 0
    ProcedureReturn #E_NOINTERFACE
  EndIf
EndProcedure

;COM IWebBrowser2 functions

Procedure DocumentComplete(*THIS.DispatchObject, *pDisp.IDispatch, *URL.Variant)
  Debug "Web page loaded."
  Url$ = PeekS(*Url\bstrval, -1, #PB_Unicode)
  Debug Url$
  
  If SearchTextInFrames(#Web, "123") = 1
    Debug "Found"
  Else
    Debug "not found"
  EndIf
EndProcedure

Procedure.l Release(*THIS.DispatchObject)
  *THIS\ObjectCount-1
  ProcedureReturn *THIS\ObjectCount
EndProcedure

Procedure GetTypeInfoCount(*THIS.DispatchObject, pctinfo)
  ProcedureReturn #E_NOTIMPL
EndProcedure

Procedure GetTypeInfo(*THIS.DispatchObject, iTInfo, lcid, ppTInfo)
  ProcedureReturn #E_NOTIMPL
EndProcedure

Procedure GetIDsOfNames(*THIS.DispatchObject, riid, rgszNames, cNames, lcid, rgDispId) : EndProcedure

Procedure Invoke(*THIS.DispatchObject, dispIdMember, riid, lcid, wFlags, *pDispParams.DISPPARAMS, pVarResult, pExcepInfo, puArgErr)
  
  Select dispIDMember
    Case #DISPID_DOCUMENTCOMPLETE
      *params1.VARIANT = *pDispParams\rgvarg + (SizeOf(VARIANT)*1)
      *params2.VARIANT = *pDispParams\rgvarg + (SizeOf(VARIANT)*0)
      DocumentComplete(*THIS, *params1\pDispVal, *params2\pvarVal)
  EndSelect
EndProcedure

;/COM IWebBrowser2 functions

;////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

Url.s = "D:\frametest\index.htm"

;////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

If Not OpenWindow(#Main, 0, 0, 800, 600, "WebGadget", #PB_Window_SystemMenu | #PB_Window_ScreenCentered)
  End
EndIf
CreateGadgetList(WindowID(#Main))
WebGadget(#Web, 10, 10, 780, 580, URL.s)

webBrowser.IWebBrowser2 = GetWindowLong_(GadgetID(#Web), #GWL_USERDATA)
SetGadgetAttribute(#Web,#PB_Web_BlockPopups,1)

AddElement(DispatchObject())
DispatchObject()\IDispatch = ?dispatchFunctions
DispatchObject()\GadgetID=#Web
webBrowser.IWebBrowser2 = GetWindowLong_(GadgetID(#Web), #GWL_USERDATA)
webBrowser\QueryInterface(?IID_IConnectionPointContainer, @connectionPointContainer.IConnectionPointContainer)
connectionPointContainer\findconnectionpoint(?IID_DWebBrowserEvents2, @connectionPoint.IConnectionPoint)
connectionPoint\Advise(DispatchObject(), @Cookie)
connectionPoint\release()
connectionPointContainer\release()

Debug Str(webbrowser\put_Silent(#VARIANT_TRUE))+" ("+Str(#S_OK)+" - ok)"
;Debug Str(webbrowser\put_Silent(#VARIANT_FALSE))+" ("+Str(#S_OK)+" - ok)"

NeedToSend = 1
Quit = 0

Repeat
  event = WaitWindowEvent()
  Select event
    Case #PB_Event_Gadget
      Select EventGadget()
        Case #Web
          Select EventType()
              
          EndSelect
      EndSelect
    Case #WM_CLOSE
      Quit = 1
  EndSelect
Until Quit = 1

End

DataSection
  
  ;/////////////
  IID_IHTMLWindow2: ; {332c4427-26cb-11d0-b483-00c04fd90119}
  Data.l $332C4427
  Data.w $26CB, $11D0
  Data.b $B4, $83, $00, $C0, $4F, $D9, $01, $19
  
  IID_IHTMLElementCollection:
  Data.l $3050F21F
  Data.w $98B5, $11CF
  Data.b $BB, $82, $00, $AA, $00, $BD, $CE, $0B
  
  DIID_DWebBrowserEvents2:
  Data.l $34A715A0
  Data.w $6587, $11D0
  Data.b $92, $4A, $00, $20, $AF, $C7, $AC, $4D
  
  ;/////////////
  
  IID_IHTMLElement:
  Data.l $3050F1FF
  Data.w $98B5, $11CF
  Data.b $BB, $82, $00, $AA, $00, $BD, $CE, $0B
  
  IID_IHTMLDocument2:
  Data.l $332C4425
  Data.w $26CB, $11D0
  Data.b $B4, $83, $00, $C0, $4F, $D9, $01, $19
  
  dispatchFunctions:
  Data.l @QueryInterface(),@AddRef(),@Release(),@GetTypeInfoCount()
  Data.l @GetTypeInfo(),@GetIDsOfNames(),@Invoke()
  
  IID_IWebBrowser2:
  Data.l $D30C1661
  Data.w $CDAF, $11D0
  Data.b $8A, $3E, $00, $C0, $4F, $C9, $E2, $6E
  
  IID_IConnectionPointContainer:
  Data.l $B196B284
  Data.w $BAB4, $101A
  Data.b $B6, $9C, $00, $AA, $00, $34, $1D, $07
  
  IID_IDispatch:
  Data.l $00020400
  Data.w $0000, $0000
  Data.b $C0, $00, $00, $00, $00, $00, $00, $46
  
  IID_IUnknown:
  Data.l $00000000
  Data.w $0000, $0000
  Data.b $C0, $00, $00, $00, $00, $00, $00, $46
  
  IID_DWebBrowserEvents2:
  Data.l $34A715A0
  Data.w $6587, $11D0
  Data.b $92, $4A, $00, $20, $AF, $C7, $AC, $4D
EndDataSection

This is test page:

Code: Select all

http://rapidshare.com/files/228229342/frametest.rar.html

[srod]

Just looking at your code above... yes, not surprised it crashes on occasion! Your freeing incorrect memory!

I have it working okay after removing a lot of un-needed code. Let me see if we can get it working with COMatePLUS? No guarantees...

Mind you, why not use the MSXML2.XMLHTTP object (there is a COMatePLUS demo using this) to download the entire webpage as text and then search? Or must you search only text within frames etc?

[besko]

Srod if you can help me with old code i will love you too )

I must you search only text within frames coz my app accept only this way in algorithm.

And tnx for your time you are best

[srod]

Hey, old code or new code; which do you want? I don't deal with both!

[besko]

hehe maybe we can try old

[srod]

Here you are my old mucka!!! Translated to COMatePLUS.

Code: Select all

IncludePath "..\"
XIncludeFile "COMatePLUS.pbi"


Procedure.i SearchTextInFrames(Gadget, text$) 
  Protected result, browser.COMateObject, document.COMateObject, frames.COMateObject
  Protected frameCount, i, html$
  browser = COMate_WrapCOMObject(GetWindowLong_(GadgetID(gadget), #GWL_USERDATA)) 
  If browser 
    document = browser\GetObjectProperty("Document")
    If document
      frames = document\GetObjectProperty("frames")
      If frames
        frameCount = frames\GetIntegerProperty("length")
        For i = 0 To frameCount-1
          html$ = frames\GetStringProperty("item(" + Str(i) + ")\Document\All\Tags('HTML')\Item(0)\innerHTML")
          If FindString(html$,text$, 1)
            result = 1
            Break
          EndIf 
        Next
        frames\Release()
      EndIf
      document\Release()
    EndIf
    browser\Release()
  EndIf
  ProcedureReturn result
EndProcedure 



URL$ = "http://reportman.sourceforge.net/doc/index.html" 

If OpenWindow(0, 0, 0, 800, 600, "WebGadget", #PB_Window_SystemMenu | #PB_Window_ScreenCentered)
  WebGadget(0, 0, 0, WindowWidth(0),WindowHeight(0), URL$) 

  While GetGadgetAttribute(0, #PB_Web_Busy)
    WindowEvent() : Delay(1)
  Wend

  result = SearchTextInFrames(0, "Index")
  If result = 1 
    Debug "Found" 
  Else
    Debug "not found" 
  EndIf 

  Repeat 
    Event = WaitWindowEvent(); 
    Select Event 
      Case #PB_Event_CloseWindow 
        Break 
    EndSelect 
  ForEver 
EndIf 

The original code of yours sets up an out-going interface to receive events from the web-gadget etc. No longer needed with the new version of Purebasic - at least not needed really to trap the events that you were after. Any events PB does not cover can easily be trapped with COMatePLUS' event handlers. But that's another story!

[besko]

Code: Select all

Procedure.i COMateClass_INTERNAL_InvokeiDispatch(*this._membersCOMateClass, invokeType, returnType, *ret.VARIANT, iDisp.iDispatch, subObjectIndex, *statement._COMatePLUSStatement)
  Protected result.i = #S_OK
  Protected dispID, dp.DISPPARAMS, dispIDNamed, excep.EXCEPINFO, uiArgErr
  ;First task is to retrieve the dispID corresponding to the method/property.
    result = iDisp\GetIDsOfNames(?IID_NULL, @*statement\methodName[subObjectIndex], 1, #LOCALE_USER_DEFAULT, @dispID)

i have error here when add your code to my code

result = iDisp\GetIDsOfNames(?IID_NULL, @*statement\methodName[subObjectIndex], 1, #LOCALE_USER_DEFAULT, @dispID)

[23:20:09] [ERROR] COMatePLUS.pbi (Line: 1356)
[23:20:09] [ERROR] Invalid memory access. (read error at address 440)

What its can be?

[srod]

Well, without seeing your code it is a little difficult to assist!

Does the code I posted work okay on your system?

[besko]

yep work fine. with your code can i use old interfaces? Like this:
maybe coz i use 2 interfaces i have errors?

Code: Select all

Procedure.l QueryInterface(*THIS.DispatchObject, *iid.GUID, *Object.LONG)
  
  If CompareMemory(*iid, ?IID_DWebBrowserEvents2, 16)
    CallDebugger
  EndIf
  
  If CompareMemory(*iid, ?IID_IUnknown, SizeOf(GUID)) Or CompareMemory(*iid, ?IID_IDispatch, SizeOf(GUID))
    *Object\l = *THIS
    AddRef(*THIS.DispatchObject)
    ProcedureReturn #S_OK
  Else
    *Object\l = 0
    ProcedureReturn #E_NOINTERFACE
  EndIf
EndProcedure

Procedure.l Release(*THIS.DispatchObject)
  *THIS\ObjectCount-1
  ProcedureReturn *THIS\ObjectCount
EndProcedure

[srod]

Well yes, but if you are using COMatePLUS anyhow then there may not be much point in using such things!

Can you post the code which crashes? It needs to be code I can run though.

**EDIT : it was a threading issue; one in which a COM object was marshalled for a different thread etc.

[besko]

Srod The Best

If you post more examples for web it would be cool

[DoubleDutch]

+1