PureBasic Forums - English

http://www.purebasic.com
https://www.purebasic.fr/english/

COMate - control COM objects via automation - OBSOLETE!

https://www.purebasic.fr/english/viewtopic.php?t=33983

Page 24 of 39

Posted: Fri Feb 13, 2009 9:28 pm
by ricardo
...

Posted: Fri Feb 13, 2009 9:30 pm
by ricardo
Kwaï chang caïne

Try this one:

Code: Select all

DataSection 
  
  IID_IUnkown: ; 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 
  
  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_ICustomDoc: ; 3050F3F0-98B5-11CF-BB82-00AA00BDCE0B 
  Data.l $3050F3F0 
  Data.w $98B5, $11CF 
  Data.b $BB, $82, $00, $AA, $00, $BD, $CE, $0B 
  
  IID_IDocHostUIHandler: ; BD3F23C0-D43E-11CF-893B-00AA00BDCE1A 
  Data.l $BD3F23C0 
  Data.w $D43E, $11CF 
  Data.b $89, $3B, $00, $AA, $00, $BD, $CE, $1A 
  
  
EndDataSection 


#DOCHOSTUIDBLCLK_DEFAULT         = 0 
#DOCHOSTUIFLAG_OPENNEWWIN        = $20 
#DOCHOSTUIFLAG_DIV_BLOCKDEFAULT = $100  

#DOCHOSTUIFLAG_THEME = $40000
#DOCHOSTUIFLAG_NO3DBORDER = $4 


Structure DOCHOSTUIINFO 
  cbSize.l 
  dwFlags.l 
  dwDoubleClick.l 
  *pchHostCss 
  *pchHostNS 
EndStructure 

Structure IDocHostUIHandlerImpl 
  *VTable 
  RefCount.l 
  External.IDispatch 
EndStructure 

Procedure.l IDocHostUIHandlerImpl_QueryInterface ( *that.IDocHostUIHandlerImpl, riid.l, ppObj.l ) 
  hResult.l = #E_NOINTERFACE 
  TmpUnkown.IUnknown = *that 
  If ppObj <> #Null And riid <> #Null 
    PokeL(ppObj, 0) 
    If CompareMemory(riid, ?IID_IUnkown, 16) 
      PokeL(ppObj, *that) 
      TmpUnkown\AddRef() 
      hResult = #S_OK 
    ElseIf CompareMemory(riid, ?IID_IDocHostUIHandler, 16) 
      PokeL(ppObj, *that) 
      TmpUnkown\AddRef() 
      hResult = #S_OK 
    EndIf 
  EndIf 
  ProcedureReturn hResult 
EndProcedure 

Procedure.l IDocHostUIHandlerImpl_AddRef ( *that.IDocHostUIHandlerImpl ) 
  *that\RefCount = *that\RefCount + 1 
  ProcedureReturn *that\RefCount 
EndProcedure 

Procedure.l IDocHostUIHandlerImpl_Release ( *that.IDocHostUIHandlerImpl ) 
  *that\RefCount = *that\RefCount - 1 
  RefCount.l = *that\RefCount 
  If RefCount = 0 
    If *that\External <> #Null 
      *that\External\Release() 
    EndIf  
    FreeMemory(*that) 
  EndIf 
  ProcedureReturn RefCount 
EndProcedure 

Procedure.l IDocHostUIHandlerImpl_ShowContextMenu ( *that.IDocHostUIHandlerImpl, dwID, ppt, pcmdTarget, pdispReserved ) 
  ProcedureReturn #S_FALSE 
EndProcedure 

Procedure.l IDocHostUIHandlerImpl_GetHostInfo ( *that.IDocHostUIHandlerImpl, *pInfo.DOCHOSTUIINFO ) 
  *pInfo\cbSize        = 20 
  *pInfo\dwDoubleClick = #DOCHOSTUIDBLCLK_DEFAULT 
  *pInfo\dwFlags       = #DOCHOSTUIFLAG_DIV_BLOCKDEFAULT + #DOCHOSTUIFLAG_OPENNEWWIN + #DOCHOSTUIFLAG_NO3DBORDER + #DOCHOSTUIFLAG_THEME 
  *pInfo\pchHostCss    = #Null 
  *pInfo\pchHostNS     = #Null 
  ProcedureReturn #S_OK 
EndProcedure 

Procedure.l IDocHostUIHandlerImpl_ShowUI ( *that.IDocHostUIHandlerImpl, dwID, pActiveObject, pCommandTarget, pFrame, pDoc ) 
  ProcedureReturn #S_FALSE 
EndProcedure 

Procedure.l IDocHostUIHandlerImpl_HideUI ( *that.IDocHostUIHandlerImpl ) 
  ProcedureReturn #E_NOTIMPL 
EndProcedure 

Procedure.l IDocHostUIHandlerImpl_UpdateUI ( *that.IDocHostUIHandlerImpl ) 
  ProcedureReturn #S_OK 
EndProcedure 

Procedure.l IDocHostUIHandlerImpl_EnableModeless ( *that.IDocHostUIHandlerImpl, fEnable) 
  ProcedureReturn #E_NOTIMPL 
EndProcedure 

Procedure.l IDocHostUIHandlerImpl_OnDocWindowActivate ( *that.IDocHostUIHandlerImpl, fActivate ) 
  ProcedureReturn #E_NOTIMPL 
EndProcedure 

Procedure.l IDocHostUIHandlerImpl_OnFrameWindowActivate ( *that.IDocHostUIHandlerImpl, fActivate ) 
  ProcedureReturn #E_NOTIMPL 
EndProcedure 

Procedure.l IDocHostUIHandlerImpl_ResizeBorder ( *that.IDocHostUIHandlerImpl, prcBorder, pUIWindow, fFrameWindow ) 
  ProcedureReturn #E_NOTIMPL 
EndProcedure 

Procedure.l IDocHostUIHandlerImpl_TranslateAccelerator ( *that.IDocHostUIHandlerImpl, lpMsg, pguidCmdGroup, nCmdID ) 
  ProcedureReturn #E_NOTIMPL 
EndProcedure 

Procedure.l IDocHostUIHandlerImpl_GetOptionKeyPath ( *that.IDocHostUIHandlerImpl, pchKey, dw ) 
  ProcedureReturn #E_NOTIMPL 
EndProcedure 

Procedure.l IDocHostUIHandlerImpl_GetDropTarget ( *that.IDocHostUIHandlerImpl, pDropTarget, ppDropTarget ) 
  ProcedureReturn #E_NOTIMPL 
EndProcedure 

Procedure.l IDocHostUIHandlerImpl_GetExternal ( *that.IDocHostUIHandlerImpl, ppDispatch.l ) 
  If ppDispatch <> #Null 
    PokeL(ppDispatch, *that\External) 
    If *that\External <> #Null 
      *that\External\AddRef() 
      ProcedureReturn #S_OK 
    EndIf 
  EndIf 
  ProcedureReturn #S_FALSE 
EndProcedure 

Procedure.l IDocHostUIHandlerImpl_TranslateUrl ( *that.IDocHostUIHandlerImpl, dwTranslate, pchURLIn, ppchURLOut ) 
  ProcedureReturn #S_FALSE 
EndProcedure 

Procedure.l IDocHostUIHandlerImpl_FilterDataObject ( *that.IDocHostUIHandlerImpl, pDO, ppDORet ) 
  ProcedureReturn #S_FALSE 
EndProcedure 


DataSection 
  
  IDocHostUIHandlerImplFunctionTable: 
  Data.l @IDocHostUIHandlerImpl_QueryInterface() 
  Data.l @IDocHostUIHandlerImpl_AddRef() 
  Data.l @IDocHostUIHandlerImpl_Release() 
  Data.l @IDocHostUIHandlerImpl_ShowContextMenu() 
  Data.l @IDocHostUIHandlerImpl_GetHostInfo() 
  Data.l @IDocHostUIHandlerImpl_ShowUI() 
  Data.l @IDocHostUIHandlerImpl_HideUI() 
  Data.l @IDocHostUIHandlerImpl_UpdateUI() 
  Data.l @IDocHostUIHandlerImpl_EnableModeless() 
  Data.l @IDocHostUIHandlerImpl_OnDocWindowActivate() 
  Data.l @IDocHostUIHandlerImpl_OnFrameWindowActivate() 
  Data.l @IDocHostUIHandlerImpl_ResizeBorder() 
  Data.l @IDocHostUIHandlerImpl_TranslateAccelerator() 
  Data.l @IDocHostUIHandlerImpl_GetOptionKeyPath() 
  Data.l @IDocHostUIHandlerImpl_GetDropTarget() 
  Data.l @IDocHostUIHandlerImpl_GetExternal() 
  Data.l @IDocHostUIHandlerImpl_TranslateUrl() 
  Data.l @IDocHostUIHandlerImpl_FilterDataObject() 
  
EndDataSection 


Procedure CreateDocHostUIHandler ( External.IDispatch ) 
  Protected *that.IDocHostUIHandlerImpl = AllocateMemory(SizeOf(IDocHostUIHandlerImpl)) 
  If #Null <> *that 
    *that\VTable = ?IDocHostUIHandlerImplFunctionTable 
    *that\RefCount = 1 
    If External <> #Null 
      External\AddRef() 
    EndIf 
    *that\External = External 
  EndIf 
  ProcedureReturn *that 
EndProcedure 






#DISPID_RAISEEVENT  = 100 
#DISPID_UNKNOWN     = -1 

Structure ExternalIDispatchImpl 
  *VTable 
  RefCount.l 
  *CallbackFunction 
EndStructure 

Procedure.l ExternalIDispatchImpl_QueryInterface ( *that.ExternalIDispatchImpl, riid.l, ppObj.l ) 
  hResult.l = #E_NOINTERFACE 
  TmpUnkown.IUnknown = *that 
  If ppObj <> #Null And riid <> #Null 
    PokeL(ppObj, 0) 
    If CompareMemory(riid, ?IID_IUnkown, 16) 
      PokeL(ppObj, *that) 
      TmpUnkown\AddRef() 
      hResult = #S_OK 
    ElseIf CompareMemory(riid, ?IID_IDispatch, 16) 
      PokeL(ppObj, *that) 
      TmpUnkown\AddRef() 
      hResult = #S_OK 
    EndIf 
  EndIf 
  ProcedureReturn hResult 
EndProcedure 

Procedure.l ExternalIDispatchImpl_AddRef ( *that.ExternalIDispatchImpl ) 
  *that\RefCount = *that\RefCount + 1 
  ProcedureReturn *that\RefCount 
EndProcedure 

Procedure.l ExternalIDispatchImpl_Release ( *that.ExternalIDispatchImpl ) 
  *that\RefCount = *that\RefCount - 1 
  RefCount.l = *that\RefCount 
  If RefCount = 0 
    FreeMemory(*that) 
  EndIf 
  ProcedureReturn RefCount 
EndProcedure 

Procedure.l ExternalIDispatchImpl_GetTypeInfoCount ( *that.ExternalIDispatchImpl, *pcntInfo.Long ) 
  *pcntInfo\l = 0 
  ProcedureReturn #S_OK 
EndProcedure 

Procedure.l ExternalIDispatchImpl_GetTypeInfo ( *that.ExternalIDispatchImpl, itinfo, lcid, pptinfo ) 
  ProcedureReturn #E_NOTIMPL 
EndProcedure 

Procedure.l ExternalIDispatchImpl_GetIDsOfNames ( *that.ExternalIDispatchImpl, riid, ppNames.l, cntNames.l, lcid, rgdispid.l ) 
  hResult.l = #S_OK 
  For Index = 0 To cntNames - 1 
    name.s = UCase(PeekS(PeekL(ppNames + (Index * 4)), -1, #PB_Unicode)) 
    If name = "RAISEEVENT" 
      PokeL(rgdispid + (Index * 4), #DISPID_RAISEEVENT) 
    Else 
      PokeL(rgdispid + (Index * 4), #DISPID_UNKNOWN) 
      hResult = #DISP_E_UNKNOWNNAME 
    EndIf 
  Next Index 
  ProcedureReturn hResult 
EndProcedure 

Procedure.l ExternalIDispatchImpl_Invoke ( *that.ExternalIDispatchImpl, Dispid.l, riid, lcid, flags.w, *dispparams.DISPPARAMS, *result.VARIANT, *pexecpinfo, *puArgErr.Long) 
  If Dispid <> #DISPID_RAISEEVENT 
    ProcedureReturn #DISP_E_MEMBERNOTFOUND 
  EndIf  
  If 0 = #DISPATCH_METHOD & flags 
    ProcedureReturn #DISP_E_MEMBERNOTFOUND 
  EndIf  
  If *dispparams\cNamedArgs > 0 
    ProcedureReturn #DISP_E_NONAMEDARGS 
  EndIf 
  If *dispparams\cArgs <> 2 
    ProcedureReturn #DISP_E_BADPARAMCOUNT 
  EndIf 
  
  hResult.l = #S_OK 
  Dim argument.s(1) 
  Define.VARIANT TmpArg 
  For Index.l = 0 To 1 
    VariantInit_(@TmpArg) 
    If VariantChangeType_(@TmpArg, *dispparams\rgvarg + ((1 - Index) * SizeOf(VARIANT)), 0, #VT_BSTR) <> #S_OK 
      hResult = #DISP_E_TYPEMISMATCH 
      Break 
    EndIf 
    argument(Index) = PeekS(TmpArg\bstrVal, -1, #PB_Unicode) 
    VariantClear_(@TmpArg) 
  Next Index 
  If hResult <> #S_OK 
    ProcedureReturn hResult 
  EndIf 
  
  If *that\CallbackFunction <> #Null 
    CallFunctionFast(*that\CallbackFunction, argument(0), argument(1)) 
  EndIf 
  
  If *result <> #Null 
    VariantInit_(*result) 
    *result\vt = #VT_EMPTY 
  EndIf 
  
  ProcedureReturn #S_OK 
EndProcedure 

DataSection 
  
  ExternalIDispatchImplFunctionTable: 
  Data.l @ExternalIDispatchImpl_QueryInterface() 
  Data.l @ExternalIDispatchImpl_AddRef() 
  Data.l @ExternalIDispatchImpl_Release() 
  Data.l @ExternalIDispatchImpl_GetTypeInfoCount() 
  Data.l @ExternalIDispatchImpl_GetTypeInfo() 
  Data.l @ExternalIDispatchImpl_GetIDsOfNames() 
  Data.l @ExternalIDispatchImpl_Invoke() 
  
EndDataSection 

Procedure CreateExternalDispatch ( *CallbackFunction ) 
  Protected *that.ExternalIDispatchImpl = AllocateMemory(SizeOf(ExternalIDispatchImpl)) 
  If *that <> #Null 
    *that\VTable = ?ExternalIDispatchImplFunctionTable 
    *that\RefCount = 1 
    *that\CallbackFunction = *CallbackFunction 
  EndIf 
  ProcedureReturn *that 
EndProcedure 



    

Procedure GetIWebBrowser2 ( Gadget ) 
  Browser.IWebBrowser2 =  GetWindowLong_(GadgetID(Gadget), #GWL_USERDATA) 
  If Browser <> #Null 
    Browser\AddRef() 
  EndIf 
  ProcedureReturn Browser  
EndProcedure 

Procedure GetIHTMLDocument2( Gadget ) 
  result.IHTMLDocument2 = #Null 
  Browser.IWebBrowser2 = GetIWebBrowser2(Gadget) 
  If Browser <> #Null 
    If Browser\get_Document(@DocumentDispatch.IDispatch) = #S_OK 
      If DocumentDispatch\QueryInterface(?IID_IHTMLDocument2, @TmpDocument.IHTMLDocument2) = #S_OK 
        result = TmpDocument 
      EndIf 
      DocumentDispatch\Release() 
    EndIf 
    Browser\Release()  
  EndIf 
  ProcedureReturn result 
EndProcedure 

Procedure SetIDocHostUIHandler ( Gadget, UIHandler.IDocHostUIHandler ) 
  result.l = #False 
  Document.IHTMLDocument2 = GetIHTMLDocument2(Gadget) 
  If Document <> #Null 
    If Document\QueryInterface(?IID_ICustomDoc, @CustomDoc.ICustomDoc) = #S_OK 
      CustomDoc\SetUIHandler(UIHandler) 
      CustomDoc\Release() 
      result = #True 
    EndIf 
    Document\Release() 
  EndIf 
  ProcedureReturn result 
EndProcedure 

Procedure ScriptRaiseEventCallback ( EventType.s, EventParam.s ) 
  Text.s = "Type: " + Chr(34) + EventType + Chr(34) + Chr(10) 
  Text = Text + "Parameter: " + Chr(34) + EventParam + Chr(34) + Chr(10) 
  MessageRequester("Javascript Call", Text, #PB_MessageRequester_Ok) 
EndProcedure 

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 


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

DataSection 
  
  IID_IHTMLDocument: ; {626FC520-A41E-11CF-A731-00A0C9082637} 
  Data.l $626FC520 
  Data.w $A41E, $11CF 
  Data.b $A7, $31, $00, $A0, $C9, $08, $26, $37 
  
  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 

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.s StringFromVARIANT(*var.VARIANT) 
  
  If VariantChangeType_(*var, *var, $2, #VT_BSTR) = #S_OK 
    Result$ = ReadBSTR(*var\bstrVal) 
    SysFreeString_(*var\bstrVal) 
  Else 
    Result$ = "ERROR : Cannot convert VARIANT to String!" 
  EndIf 
  
  ProcedureReturn Result$ 
EndProcedure 

Procedure.s ExecuteJavaScript(Gadget, Function$, Arguments$, Separator$) 
  Result$ = "ERROR" 
  
  Browser.IWebBrowser2 = GetWindowLong_(GadgetID(Gadget), #GWL_USERDATA) 
  If Browser\get_Document(@DocumentDispatch.IDispatch) = #S_OK 
    If DocumentDispatch\QueryInterface(?IID_IHTMLDocument, @Document.IHTMLDocument) = #S_OK 
      If Document\get_Script(@Script.IDispatch) = #S_OK 
        
        bstr_command = MakeBSTR(Function$) 
        result = Script\GetIDsOfNames(?IID_NULL, @bstr_command, 1, 0, @Dispid.l) 
        If result = #S_OK 
          
          ; parse the arguments          
          ; 
          If Trim(Arguments$) = "" 
            Count = 0 
            *Arguments = 0 
          Else            
            Count = CountString(Arguments$, Separator$)+1 
            *Arguments = AllocateMemory(SizeOf(VARIANT)*Count)        
            *Arg.VARIANT = *Arguments 
            
            For i = 1 To Count            
              *Arg\vt = #VT_BSTR 
              *Arg\bstrVal = MakeBSTR(StringField(Arguments$, i, Separator$)) 
              *Arg + SizeOf(VARIANT) 
            Next i 
          EndIf 
          
          params.DISPPARAMS\cArgs = Count 
          params\cNamedArgs = 0 
          params\rgvarg = *Arguments 
          
          result = Script\Invoke(Dispid, ?IID_NULL, 0, #DISPATCH_METHOD, @params, @varResult.VARIANT, 0, 0) 
          If result = #S_OK 
            Result$ = StringFromVARIANT(@varResult) 
          Else 
            Message$ = Space(3000) 
            FormatMessage_(#FORMAT_MESSAGE_IGNORE_INSERTS|#FORMAT_MESSAGE_FROM_SYSTEM, 0, result, 0, @Message$, 3000, 0)          
            Result$ = "ERROR: Invoke() "+Message$            
          EndIf 
          
          If *Arguments 
            *Arg.VARIANT = *Arguments 
            For i = 1 To Count 
              SysFreeString_(*Arg\bstrVal) 
              *Arg + SizeOf(VARIANT) 
            Next i          
            FreeMemory(*Arguments) 
          EndIf 
          
        Else 
          Message$ = Space(3000) 
          FormatMessage_(#FORMAT_MESSAGE_IGNORE_INSERTS|#FORMAT_MESSAGE_FROM_SYSTEM, 0, result, 0, @Message$, 3000, 0)          
          Result$ = "ERROR: GetIDsOfNames() "+Message$          
          
        EndIf 
        SysFreeString_(bstr_command) 
        
        Script\Release() 
      EndIf 
      Document\Release() 
    EndIf 
    DocumentDispatch\Release() 
  EndIf 
  
  ProcedureReturn Result$ 
EndProcedure 



If OpenWindow(0, 10000, 0, 0, 0, "WebGadget",  #PB_Window_SystemMenu|#PB_Window_Maximize) And CreateGadgetList(WindowID(0)) 
  WebGadget(0, 0, 0, WindowWidth(0)+50,WindowHeight(0)-100, "http://www.purebasic.fr/english/posting.php?mode=reply&t=33983") 
  ButtonGadget(1,50,WindowHeight(0)-50,150,25,"Fill & Send")
  

  

  
  External.IDispatch  = CreateExternalDispatch(@ScriptRaiseEventCallback()) 
  UIHandler.IDocHostUIHandler = CreateDocHostUIHandler(External) 
  SetIDocHostUIHandler(0, UIHandler) 
  External\Release() 
  UIHandler\Release() 

  Repeat 
    Event = WaitWindowEvent(); 
    Select Event 
      Case #PB_Event_Gadget 
        Select EventGadget() 
          Case 1 
            xMessage$ = "Hello from PB :)"
            ExecuteJavaScript(0,"eval","document.all.message.value=" +  Chr(34) + xMessage$ + Chr(34),"")
            ;ExecuteJavaScript(0,"eval","document.all.preview.click()","")
            ExecuteJavaScript(0,"eval","document.post.post.click()","")
            
        EndSelect 
      Case #PB_Event_CloseWindow 
        Break 
    EndSelect 
  Until GetAsyncKeyState_(#VK_ESCAPE)
  
  
EndIf

Posted: Fri Feb 13, 2009 9:30 pm
by ricardo
Hello from PB :)

*Oops, i was testing the example :P

Posted: Fri Feb 13, 2009 9:39 pm
by Kwai chang caine
Hello from PB :)

Posted: Fri Feb 13, 2009 9:39 pm
by Kwai chang caine
Me too :D :lol: :lol:
It's a miracle, what is this code of the dead ???? :shock:
I don't believe my eyes, i return to see this jewel

Furthermore...it's the first time that i talk to you :D
For a first time......it's very a monstruous time 8)

At my job i can't see all your thread :cry:
Because your name "RICARDO" is begin like "RICARD" and RICARD in france is alcohol.
And this buffoon of PROXY server lock all thread who begin by alcohol :?
It's the only explication that i have found :roll:
Why only you...i don't know :evil:

I'm at my homme and i'm very happy to talk to you for the first time
One thousand of million thanks RICARDO

Posted: Fri Feb 13, 2009 9:49 pm
by srod
To correct the first part of your code Kwai ...

Code: Select all

IncludePath "..\"
XIncludeFile "COMate.pbi"

HTTPObject.COMateObject 
HTTPObject = COMate_CreateObject("InternetExplorer.Application") 

If HTTPObject 
  HTTPObject\SetProperty("Visible= #True") 
  HTTPObject\invoke("Navigate('http://www.google.fr/')") 
  HTTPObject\Release() 
EndIf
Notice the switch from 'Invoke' to 'SetProperty' and the use of brackets?

Posted: Fri Feb 13, 2009 10:24 pm
by Kwai chang caine
MASTER i'm happy to talk to you :D
There are a long time...no ??? :roll:

I know i know for you, it's never too much :oops:
Because no KCC, no stupid question :?

Thanks for have correct my lesson 8)

I have added a code of PB, for writing in GOOGLE
Is it the more simple method ???

But for a time, it's works :D , thanks to you obviously :oops:

Code: Select all

; http://www.purebasic.fr/english/viewtopic.php?p=277411#277411
 
IncludePath "..\"
XIncludeFile "COMate.pbi"

Procedure SendKeys(handle,window$,keys$) 
  If window$<>"" : handle=FindWindow_(0,window$) : EndIf ; Use window$ instead of handle. 
  If IsWindow_(handle)=0 ; Does the target window actually exist? 
    ProcedureReturn 0 ; Nope, so report 0 for failure to type. 
  Else 
    ; This block gives the target window the focus before typing. 
    thread1=GetWindowThreadProcessId_(GetForegroundWindow_(),0) 
    thread2=GetWindowThreadProcessId_(handle,0) 
    If thread1<>thread2 : AttachThreadInput_(thread1,thread2,#True) : EndIf 
    SetForegroundWindow_(handle) ; Target window now has the focus for typing. 
    Sleep_(125) ; 1/8 second pause before typing to prevent fast CPU problems. 
    ; Now the actual typing starts. 
    keybd_event_(#VK_MENU,0,#KEYEVENTF_KEYUP,0) ; Release ALT key before typing. 
    keybd_event_(#VK_CONTROL,0,#KEYEVENTF_KEYUP,0) ; Release CONTROL key before typing. 
    keybd_event_(#VK_SHIFT,0,#KEYEVENTF_KEYUP,0) ; Release SHIFT key before typing. 
    keybd_event_(#VK_LWIN,0,#KEYEVENTF_KEYUP,0) ; Release WINDOWS key before typing. 
    For r=1 To Len(keys$) 
      vk=0 : vk$=Mid(keys$,r,1) 
      If vk$="{" ; Special key found. 
        s=FindString(keys$,"}",r+1)-(r+1) ; Get length of special key. 
        s$=Mid(keys$,r+1,s) ; Get special key name. 
        Select s$ ; Get virtual key code of special key. 
          Case "ALTDOWN" : keybd_event_(#VK_MENU,0,0,0) ; Hold ALT down. 
          Case "ALTUP" : keybd_event_(#VK_MENU,0,#KEYEVENTF_KEYUP,0) ; Release ALT. 
          Case "BACKSPACE" : vk=#VK_BACK 
          Case "CONTROLDOWN" : keybd_event_(#VK_CONTROL,0,0,0) ; Hold CONTROL down. 
          Case "CONTROLUP" : keybd_event_(#VK_CONTROL,0,#KEYEVENTF_KEYUP,0) ; Release CONTROL. 
          Case "DELAY" : vk=0 : Sleep_(1000) ; Delay typing for one second. 
          Case "DELETE" : vk=#VK_DELETE 
          Case "DOWN" : vk=#VK_DOWN 
          Case "END" : vk=#VK_END 
          Case "ENTER" : vk=#VK_RETURN 
          Case "ESCAPE" : vk=#VK_ESCAPE 
          Case "F1" : vk=#VK_F1 
          Case "F2" : vk=#VK_F2 
          Case "F3" : vk=#VK_F3 
          Case "F4" : vk=#VK_F4 
          Case "F5" : vk=#VK_F5 
          Case "F6" : vk=#VK_F6 
          Case "F7" : vk=#VK_F7 
          Case "F8" : vk=#VK_F8 
          Case "F9" : vk=#VK_F9 
          Case "F10" : vk=#VK_F10 
          Case "F11" : vk=#VK_F11 
          Case "F12" : vk=#VK_F12 
          Case "HOME" : vk=#VK_HOME 
          Case "INSERT" : vk=#VK_INSERT 
          Case "LEFT" : vk=#VK_LEFT 
          Case "PAGEDOWN" : vk=#VK_NEXT 
          Case "PAGEUP" : vk=#VK_PRIOR 
          Case "PRINTSCREEN" : vk=#VK_SNAPSHOT 
          Case "RIGHT" : vk=#VK_RIGHT 
          Case "SCROLL" : vk=#VK_SCROLL 
          Case "SPACE" : vk=#VK_SPACE 
          Case "SHIFTDOWN" : shifted=1 : keybd_event_(#VK_SHIFT,0,0,0) ; Hold SHIFT down. 
          Case "SHIFTUP" : shifted=0 : keybd_event_(#VK_SHIFT,0,#KEYEVENTF_KEYUP,0) ; Release SHIFT. 
          Case "TAB" : vk=#VK_TAB 
          Case "UP" : vk=#VK_UP 
          Case "WINDOWS" : vk=#VK_LWIN 
        EndSelect 
        If Left(s$,3)<>"ALT" And Left(s$,7)<>"CONTROL" And Left(s$,5)<>"SHIFT" 
          If vk<>0 
            keybd_event_(vk,0,0,0) : keybd_event_(vk,0,#KEYEVENTF_KEYUP,0) ; Press the special key. 
          EndIf 
        EndIf 
        r+s+1 ; Continue getting the keystrokes that follow the special key. 
      Else 
        vk=VkKeyScanEx_(Asc(vk$),GetKeyboardLayout_(0)) ; Normal key found. 
        If vk>303 And shifted=0 : keybd_event_(#VK_SHIFT,0,0,0) : EndIf ; Due to shifted character. 
        keybd_event_(vk,0,0,0) : keybd_event_(vk,0,#KEYEVENTF_KEYUP,0) ; Press the normal key. 
        If vk>303 And shifted=0 : keybd_event_(#VK_SHIFT,0,#KEYEVENTF_KEYUP,0) : EndIf ; Due to shifted character. 
      EndIf 
    Next 
    If thread1<>thread2 : AttachThreadInput_(thread1,thread2,#False) : EndIf ; Finished typing to target window! 
    keybd_event_(#VK_MENU,0,#KEYEVENTF_KEYUP,0) ; Release ALT key in case user forgot. 
    keybd_event_(#VK_CONTROL,0,#KEYEVENTF_KEYUP,0) ; Release CONTROL key in case user forgot. 
    keybd_event_(#VK_SHIFT,0,#KEYEVENTF_KEYUP,0) ; Release SHIFT key in case user forgot. 
    keybd_event_(#VK_LWIN,0,#KEYEVENTF_KEYUP,0) ; Release WINDOWS key in case user forgot. 
    ProcedureReturn 1 ; Report successful typing!  :) 
  EndIf 
EndProcedure 

HTTPObject.COMateObject 
HTTPObject = COMate_CreateObject("InternetExplorer.Application") 

If HTTPObject 
 
 HTTPObject\SetProperty("Visible= #True") 
 HTTPObject\invoke("Navigate('http://www.google.fr/')") 
 
 While status$ <> "Terminé"
  status$ = HTTPObject\GetStringProperty("StatusText") 
  Delay(10)
 Wend 
 
 SendKeys(0,"Google - Microsoft Internet Explorer", "KCC have too much chance to know all the member of this forum !! ;){ENTER}") 
 
 HTTPObject\Release() 
 
EndIf

Posted: Fri Feb 13, 2009 11:08 pm
by Kwai chang caine
I have another question :oops:
If there are several field to write, must i use the code of ricardo, or the COMATE for the more simple ???

Posted: Sat Feb 14, 2009 12:28 am
by srod
Update - 13th Feb. 2009.

COMate version 1.2.0.

First, only the version of COMate for PB 4.3 has had this update. COMate for PB 4.2 remains at version 1.1.7

I finally encountered an ActiveX control (a grid control as it turns out) which fires some events in which some of the underlying parameters are sent 'by reference'. These parameters of course are intended to be altered (as appropriate) by the client application as an additional means of controlling the control. Indeed, I would guess that many ActiveX controls use such parameters instead of expecting return values from event handlers.

Anyhow, long story short; whilst COMate could retrieve such parameters sent by reference, it did not allow client applications to modify them and thus COMate driven apps could not make full use of these event handlers.

This 'hole' has now been plugged with the addition of a single method to the COMateObject class; namely IsParameterPassedByReference().

This method not only allows you to determine if a parameter has been sent by reference, but it also allows you to determine the exact nature of the parameter (it's underlying variant #VT_... type) and to also obtain the appropriate address of the parameter so that you can alter it etc. A more advanced option allows you to get a pointer to it's underlying 'dispatch parameter' in it's native variant form (as sent by the ActiveX control to COMate), just in case it is of a type which COMate does not natively cater for (SafeArrays etc.)

If this all seems complicated then take my word for it that it is actually quite easy to use. I have a nice demo of the aforementioned grid control which shows just how easy. You will need to download the demo version of the ActiveX grid control (FlexCell - details in the COMate download).

The help manual has been updated and it is worth a look at the entry for this new method because it really is for 'advanced users' only.

You can access the download through the nxSoftware site.

Posted: Sat Feb 14, 2009 2:12 am
by ricardo
Kwaï chang caïne wrote:Me too :D :lol: :lol:
It's a miracle, what is this code of the dead ???? :shock:
I don't believe my eyes, i return to see this jewel

Furthermore...it's the first time that i talk to you :D
For a first time......it's very a monstruous time 8)

At my job i can't see all your thread :cry:
Because your name "RICARDO" is begin like "RICARD" and RICARD in france is alcohol.
And this buffoon of PROXY server lock all thread who begin by alcohol :?
It's the only explication that i have found :roll:
Why only you...i don't know :evil:

I'm at my homme and i'm very happy to talk to you for the first time
One thousand of million thanks RICARDO
Hi

Nice to talk you too :)

The code i show was made putting together many pieces of code from this forum (Freak mainly code), i only put all this stuff in the same one code to show you how it can be achieved.

About the alcohol he he its funny to read what you told me, i had no idea about that!! ha ha

My real name is Ricardo (Richard is spanish), but know i now that its similar to alcohol in some language... that explain a lot of things :P

Posted: Sat Feb 14, 2009 2:42 am
by Kwai chang caine
The proxy of my job is regularly idiot, again to much that me :?
This is the thing of my unhappiness :lol:

Image

But i'm again alone to have this problem, i have ask on the french forum and nobody know why.
Then......, i have thinking to the possibility of the proxy :roll:

You believe, it's possible that your code can find the position of an element in the webpage ???? :roll:

Because i have found a javascript who do that, but i don't know how i can find the ID or how i can use this snippet :cry:

Code: Select all

<html>
<head>
<style>
#el2{
background: orchid;
width: 240px;
}
</style>
<script>
function testwidth(){
alert(document.getElementById('el1').style.width);
alert(document.getElementById('el2').style.width);
}
</script>
</head>
<body>
<div id="el1" style="background: red; width: 120px;">div1</div>
<br>
<div id="el2">div2</div>
<br>
<button onclick="testwidth();">tester</button>
</body>
</html>

Posted: Sat Feb 14, 2009 2:48 am
by ricardo
Kwaï chang caïne wrote:I have another question :oops:
If there are several field to write, must i use the code of ricardo, or the COMATE for the more simple ???
Im sure you can do this very simple with the GREAT COMate, its just that im not sure how to get into the Document using it. But once getting that just need to do the document.all.message.value= & document.post.post.click() part from there.

Posted: Sat Feb 14, 2009 2:50 am
by ricardo
Kwaï chang caïne wrote: Image
Ha ha :shock: :D

Posted: Sat Feb 14, 2009 10:59 am
by srod
Anyone who has downloaded the updated version of COMate (1.2.0) for PB 4.3 will need to download again as it had a schoolboy type bug in it! :oops: Doh!

Posted: Sat Feb 14, 2009 11:27 am
by srod
@Kwai : here is a translation to COMate of some of Ricardo's code :

Code: Select all

IncludePath "..\"
XIncludeFile "COMate.pbi"

Define.COMateObject WebObject


Procedure.i ExecuteJavaScript(Gadget, command$) 
  Protected browser.COMateObject, documentDispatch.COMateObject, script.COMateObject
  Protected result
  browser = COMate_WrapCOMObject(GetWindowLong_(GadgetID(gadget), #GWL_USERDATA)) 
  If browser 
    documentDispatch = browser\GetObjectProperty("Document")
    If documentDispatch
      script = documentDispatch\GetObjectProperty("script")
      If script
        result = script\Invoke("eval('" + command$ + "')")
        script\release()
      EndIf  
      documentDispatch\Release()
    EndIf
    browser\Release()
  EndIf 
  ProcedureReturn result
EndProcedure 


If OpenWindow(0, 10000, 0, 0, 0, "WebGadget",  #PB_Window_SystemMenu|#PB_Window_Maximize)
  WebGadget(0, 0, 0, WindowWidth(0)+50,WindowHeight(0)-100, "http://www.purebasic.fr/english/posting.php?mode=reply&t=33983") 
  ButtonGadget(1,50,WindowHeight(0)-50,150,25,"Fill & Send") 
  Repeat 
    Event = WaitWindowEvent(); 
    Select Event 
      Case #PB_Event_Gadget 
        Select EventGadget() 
          Case 1 
            xMessage$ = "Hello from PB :)" 
            ExecuteJavaScript(0,"document.all.message.value=" + Chr(34) + xMessage$ + Chr(34)) 
            ExecuteJavaScript(0,"document.all.preview.click()") 
;            ExecuteJavaScript(0,"document.post.post.click()")  ;DON'T run this command else it will post in this forum thread!
        EndSelect 
      Case #PB_Event_CloseWindow 
        Break 
    EndSelect 
  Until GetAsyncKeyState_(#VK_ESCAPE) 
EndIf
This is a cool example! :) I will post this in tips and tricks I think.

The thing is about Ricardo's code is that it reproduces a lot of what COMate does anyhow; hence the reason the COMate example is a lot smaller - COMate is taking care of all the iDispatch stuff! :) In fact, Ricardo's code is essentially a 'mini' version of COMate! :)
All times are UTC+01:00
Page 24 of 39

Powered by phpBB® Forum Software © phpBB Limited