PureBasic Forums - English

Posted: **Tue Sep 27, 2005 2:06 am**

Here we go again with the WebGadget stuff

This function lets you execute a JavaScript function defined on the current
homepage, and get the returnvalue too. It works with any function
defined by the 'function' keyword in JavaScript, and also with the buildin
object-independant functions (like eval(), escape(), unescape()...).
I have not figured out how to directly access objects like document or window yet.

You can however execute methods of these objects, or read properties by
passing them as argument to the eval function.
Calling "eval" with "document.bgColor" as argument will return the document background color.
(Note: It seems that you can only call functions like eval if the html document
contains at least some JavaScript code.)

Usage:

Result$ = ExecuteJavaScript(#Gadget, Function$, Arguments$, Separator$)

#Gadget : The PB Number for the WebGadget
Function$ : Name of the function to execute.
Arguments$ : List of arguments for the function.
Separator$ : Character by which to split the parameter list.

ExecuteJavaScript() needs to split the arguments to call the function.
For this StringField() is used. The Separator$ Argument is used to define
char that separates the arguments. This is usefull if the arguments could contain
contain "," too. In this case you can use something else like Chr(1) as separator.

The return value is the result of the JavaScript function as a string, or if
the calling of the function failed, it is "ERROR", followed by a description.

Ok, here is the code:

Code: Select all

Enumeration   ; VARENUM
  #VT_EMPTY = 0
  #VT_NULL = 1
  #VT_I2 = 2
  #VT_I4 = 3
  #VT_R4 = 4
  #VT_R8 = 5
  #VT_CY = 6
  #VT_DATE = 7
  #VT_BSTR = 8
  #VT_DISPATCH = 9
  #VT_ERROR = 10
  #VT_BOOL = 11
  #VT_VARIANT = 12
  #VT_UNKNOWN = 13
  #VT_DECIMAL = 14
  #VT_I1 = 16
  #VT_UI1 = 17
  #VT_UI2 = 18
  #VT_UI4 = 19
  #VT_I8 = 20
  #VT_UI8 = 21
  #VT_INT = 22
  #VT_UINT = 23
  #VT_VOID = 24
  #VT_HRESULT = 25
  #VT_PTR = 26
  #VT_SAFEARRAY = 27
  #VT_CARRAY = 28
  #VT_USERDEFINED = 29
  #VT_LPSTR = 30
  #VT_LPWSTR = 31
  #VT_RECORD = 36
  #VT_INT_PTR = 37
  #VT_UINT_PTR = 38
  #VT_FILETIME = 64
  #VT_BLOB = 65
  #VT_STREAM = 66
  #VT_STORAGE = 67
  #VT_STREAMED_OBJECT = 68
  #VT_STORED_OBJECT = 69
  #VT_BLOB_OBJECT = 70
  #VT_CF = 71
  #VT_CLSID = 72
  #VT_VERSIONED_STREAM = 73
  #VT_BSTR_BLOB = $fff
  #VT_VECTOR = $1000
  #VT_ARRAY = $2000
  #VT_BYREF = $4000
  #VT_RESERVED = $8000
  #VT_ILLEGAL = $ffff
  #VT_ILLEGALMASKED = $fff
  #VT_TYPEMASK = $fff
EndEnumeration

Structure VARIANT
  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.VARIANT
    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 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

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

And here is an example:

HTML File:

Code: Select all

<html>
<script language="JavaScript">

function test(a, b)
{
  return "a="+a+" b="+b;
} 

</script>
<body>
Test
</body></html>

PB Code:

Code: Select all

#URL = "file:///C:/test.html"

Enumeration
  #Gadget_Web
  #Gadget_Command
  #Gadget_Args
  #Gadget_Text
  #Gadget_Button
EndEnumeration

Procedure Resize()
  Width = WindowWidth()
  Height = WindowHeight()
  ResizeGadget(#Gadget_Web, 5, 5, Width-10, Height-60)
  ResizeGadget(#Gadget_Command, 5, Height-50, (Width-105)/4, 20)
  ResizeGadget(#Gadget_Args, 10+(Width-105)/4, Height-50, ((Width-105)*3)/4, 20)
  ResizeGadget(#Gadget_Text, 5, Height-25, Width-10, 20)
  ResizeGadget(#Gadget_Button, Width-90, Height-50, 85, 20)
EndProcedure

If OpenWindow(0, 0, 0, 800, 600, #PB_Window_ScreenCentered|#PB_Window_SizeGadget|#PB_Window_MaximizeGadget|#PB_Window_MinimizeGadget, "Javascript test")
  If CreateGadgetList(WindowID())
  
    WebGadget(#Gadget_Web, 0, 0, 0, 0, #URL)
    StringGadget(#Gadget_Command, 0, 0, 0, 0, "test")
    StringGadget(#Gadget_Args, 0, 0, 0, 0, "argument1,argument2")
    TextGadget(#Gadget_Text, 0, 0, 0, 0, "Type commandname into the first, and arguments into the second box. Do not include ()", #PB_Text_Border)
    ButtonGadget(#Gadget_Button, 0, 0, 0, 0, "Execute")
    Resize()
    
    Repeat
      Event = WaitWindowEvent()
      
      If Event = #PB_Event_SizeWindow
        Resize()
        
      ElseIf Event = #PB_Event_Gadget And EventGadgetID() = #Gadget_Button
        Command$ = GetGadgetText(#GADGET_Command)
        Arguments$ = GetGadgetText(#GADGET_Args)
        
        Result$ = ExecuteJavaScript(#Gadget_Web, Command$, Arguments$, ",")            
        SetGadgetText(#Gadget_Text, "Result: "+Result$)         
           
      EndIf
    Until Event = #PB_Event_CloseWindow
  
  
  EndIf
EndIf

End

btw, if you want to mix this with the other WebGadget codes from me, just
cut out the double structure definitions and the helper functions and it should work.

Have fun with this...

Posted: **Tue Sep 27, 2005 2:36 am**

Great!!!!!!!!!!!!!!

Very nice!

Will test it right now

Posted: **Tue Sep 27, 2005 3:09 am**

This should come in real handy.

Many thanks.

Posted: **Tue Sep 27, 2005 4:04 am**

One question:

How to insert some script?

Posted: **Tue Sep 27, 2005 11:50 am**

What do you mean by insert?

Posted: **Tue Sep 27, 2005 2:16 pm**

Ok, here are two more usefull functions. They offer direct read & write access
to the global Javascript variables in the document.

Usage of them should be quite obvious:

Code: Select all

Procedure.s GetJSVariable(Gadget, Name$)
  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_name = MakeBSTR(Name$)
        result = Script\GetIDsOfNames(?IID_NULL, @bstr_name, 1, 0, @dispID.l)
        If result = #S_OK
        
          params.DISPPARAMS\cArgs = 0
          params\cNamedArgs = 0        
                   
          result = Script\Invoke(dispID, ?IID_NULL, 0, #DISPATCH_PROPERTYGET, @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
          
        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_name)
                      
        Script\Release()
      EndIf
      Document\Release()
    EndIf
    DocumentDispatch\Release()
  EndIf

  ProcedureReturn Result$
EndProcedure

Procedure SetJSVariable(Gadget, Name$, Value$)
  success = 0

  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_name = MakeBSTR(Name$)
        result = Script\GetIDsOfNames(?IID_NULL, @bstr_name, 1, 0, @dispID.l)
        If result = #S_OK
        
          varValue.VARIANT\vt = #VT_BSTR
          varValue\bstrVal = MakeBSTR(Value$)
        
          dispidNamed = -3 ; #DISPID_PROPERTYPUT
          params.DISPPARAMS\cArgs = 1
          params\cNamedArgs = 1
          params\rgvarg = @varValue
          params\rgdispidNamedArgs = @dispidNamed
 
          result = Script\Invoke(dispID, ?IID_NULL, 0, #DISPATCH_PROPERTYPUT, @params, 0, 0, 0)
          If result = #S_OK
            success = 1   
          EndIf
          
          SysFreeString_(varValue\bstrVal)
          
        EndIf
        SysFreeString_(bstr_name)
                      
        Script\Release()
      EndIf
      Document\Release()
    EndIf
    DocumentDispatch\Release()
  EndIf

  ProcedureReturn success
EndProcedure

Posted: **Tue Sep 27, 2005 5:46 pm**

Man this looks awesome !!!

Unfortanly i am noton my pc today so i cant test

For exemple can this do
a=document.createElement("div")
document.body.appendChild(a)

Thats build in functions can i call them loke that or i need to create a function to call that?

Posted: **Tue Sep 27, 2005 6:43 pm**

Erm... I'm n00b, the whole world knows that. Now to the n00b-ish question:

I tried to mix all those codes that you have posted here, freak, but even if you said to delete helper thing and double enumeration etc.. I can't get it work, can you please make one code were is all these 3 codes mixed that you posted?

Please as fast as you can, I'm on hurry. THANKS.

Posted: **Sat Oct 01, 2005 2:22 am**

freak wrote:What do you mean by insert?

Add some script to the existing HTML document.

Posted: **Sat Oct 01, 2005 11:57 am**

I don't know if that is possible, sorry.

Posted: **Sat Oct 01, 2005 1:43 pm**

Hi Freak,

Really good stuff again!

Are you intending to put all these snippets (this and other posts on this) together and put a tutorial on your site?

BTW, args entered in the example as, say: "A",14 are returned back to front (a=14,b="A").

Thanks again.

Posted: **Sat Oct 01, 2005 5:00 pm**

freak wrote:I don't know if that is possible, sorry.

Yes, its possible.

Its like inserting some other TAG but in javascript you need to use 'defer' attribute to be able to run it without reloading.

Posted: **Sat Nov 05, 2005 3:47 pm**

This is realy cool and usefull but...
How to make it work on mozilla webgadget

As far as i have read in mozilla controll webpage, mozilla controll have the same interface of IE so why this just dont work on it

Posted: **Sat Nov 05, 2005 3:58 pm**

porfirio wrote:This is realy cool and usefull but...
How to make it work on mozilla webgadget
As far as i have read in mozilla controll webpage, mozilla controll have the same interface of IE so why this just dont work on it

Did you install the Mozilla ActiveX ?

Posted: **Sat Nov 05, 2005 4:20 pm**

Why assign values to all the constants in Enumeration/EndEnumeration?

PureBasic Forums - English

Access JavaScript functions inside the WebGadget.

Access JavaScript functions inside the WebGadget.

Re: Access JavaScript functions inside the WebGadget.